ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/cf.schmorp.de/util/png2overlay
Revision: 1.5
Committed: Sun Dec 17 18:03:04 2006 UTC (17 years, 7 months ago) by root
Branch: MAIN
CVS Tags: HEAD
Changes since 1.4: +0 -0 lines
State: FILE REMOVED
Log Message:
*** empty log message ***

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 root 1.2
68     snow => 1,
69     drifts => 1,
70     flagstone => 1,
71     istone => 1,
72 root 1.1 );
73    
74     for my $X (100..129) {
75     print "$X\n";#d#
76     for my $Y (100..129) {
77 root 1.4 my $map = Storable::retrieve "pst/$X,$Y"
78     or die;
79    
80 root 1.1 {
81     my $X = ($X - 100) * 50;
82     my $Y = ($Y - 100) * 50;
83     for my $x (0..49) {
84     for my $y (0..49) {
85     my $ofs = (($Y + $y)* 1500 + $X + $x) * 4;
86    
87     my $mask = substr $mask, $ofs, 4;
88     my $type = substr $type, $ofs, 4;
89    
90 root 1.4 die if $type eq "\xff\xff\xff\xff";
91 root 1.1
92     # mask means: protect unnaturals from overwriting
93     if ($mask eq "\xff\x00\x00\xff") {
94 root 1.4 # $map->{map}[$x][$y] = [
95     # grep !$natural{$_->{_name}}, @{ $map->{map}[$x][$y] || [] }
96     # ];
97 root 1.1 } else {
98     delete $map->{map}[$x][$y];
99     }
100     }
101     }
102     }
103 root 1.4
104 root 1.1 if ((my $pid = fork)) {
105     push @pids, $pid;
106 root 1.3 waitpid shift @pids, 0 if @pids >= 1;
107 root 1.1 } else {
108     eval { $map->write_file ("../maps/world-overlay/world_$X\_$Y") };
109     warn $@ if $@;
110     POSIX::_exit 0;
111     }
112     }
113     }
114    
115 root 1.2 POSIX::_exit 0;
116