ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/util/png2overlay
Revision: 1.1
Committed: Sat Sep 16 21:26:04 2006 UTC (17 years, 8 months ago) by root
Branch: MAIN
Log Message:
cleanup

File Contents

# User Rev Content
1 root 1.1 #!/opt/bin/perl
2    
3     use Crossfire::Map;
4     use Storable;
5     use POSIX;
6    
7     use Gtk2 -init;
8    
9     { open my $fh, "<:raw", "mask.bin" or die; sysread $fh, $mask, 1500*1500*4 or die }
10     { open my $fh, "<:raw", "type.bin" or die; sysread $fh, $type, 1500*1500*4 or die }
11    
12     for my $k (keys %type) {
13     my $v = join "", map chr, (map $_*255/15, map hex, split //, substr $type{$k}, 1), 255;
14     $color{$v} = $k;
15     }
16    
17     my %natural = (
18     deep_sea => 1,
19     sea => 1,
20     shallow_sea => 1,
21    
22     beach => 1,
23     desert => 1,
24     brush => 1,
25     steppe => 1,
26    
27     marsh => 1,
28     grassbrown => 1,
29     grassmedium => 1,
30     grassdark => 1,
31     grass => 1,
32    
33     darkforest => 1,
34     evergreens => 1,
35     evergreen => 1,
36     tree => 1,
37     tree1 => 1,
38     tree2 => 1,
39     tree3 => 1,
40     tree4 => 1,
41     tree5 => 1,
42     tree6 => 1,
43     forestsparse=> 1,
44     woods => 1,
45     woods_2 => 1,
46     woods_3 => 1,
47    
48     swamp => 1,
49     deep_swamp => 1,
50    
51     jungle_1 => 1,
52     jungle_2 => 1,
53     jungle_3 => 1,
54    
55     wasteland => 1,
56    
57     hills_rocky => 1,
58     hills => 1,
59     treed_hills => 1,
60     mountain => 1,
61     mountain_2 => 1,
62     mountain2 => 1,
63     mountain3 => 1,
64     mountain4 => 1,
65     mountain5 => 1,
66     s_mountain => 1,
67     );
68    
69     my $maps = Storable::retrieve "worldmaps.pst";
70    
71     for my $X (100..129) {
72     print "$X\n";#d#
73     for my $Y (100..129) {
74     my $map = delete $maps->[$X][$Y];
75     {
76     my $X = ($X - 100) * 50;
77     my $Y = ($Y - 100) * 50;
78     for my $x (0..49) {
79     for my $y (0..49) {
80     my $ofs = (($Y + $y)* 1500 + $X + $x) * 4;
81    
82     my $mask = substr $mask, $ofs, 4;
83     my $type = substr $type, $ofs, 4;
84    
85     # only remove something if we have a worldmap replacement
86     next if $type eq "\xff\xff\xff\xff";
87    
88     # mask means: protect unnaturals from overwriting
89     if ($mask eq "\xff\x00\x00\xff") {
90     $map->{map}[$x][$y] = [
91     grep !$natural{$_->{_name}}, @{ $map->{map}[$x][$y] || [] }
92     ];
93     } else {
94     delete $map->{map}[$x][$y];
95     }
96     }
97     }
98     }
99     if ((my $pid = fork)) {
100     push @pids, $pid;
101     waitpid shift @pids, 0 if @pids > 3;
102     } else {
103     eval { $map->write_file ("../maps/world-overlay/world_$X\_$Y") };
104     warn $@ if $@;
105     POSIX::_exit 0;
106     }
107     }
108     }
109