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

File Contents

# Content
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 my %type = (
13 deep_sea => "#006",
14 sea => "#008",
15 shallow_sea => "#00a",
16
17 beach => "#aa0",
18 dunes => "#bb0",
19 desert => "#cc0",
20 steppe => "#880",
21 steppelight => "#dd7",
22 small_stones => "#eeb",
23
24 marsh => "#0f8",
25 grass => "#0f0",
26 grassmedium => "#0e0",
27 grassbrown => "#851",
28 grassdark => "#274",
29 desert => "#cc0",
30
31 darkforest => "#040",
32 evergreens => "#0a0",
33 woods => "#080",
34
35 swamp => "#660",
36 deep_swamp => "#440",
37
38 jungle_1 => "#084",
39
40 flagstone => "#bbb",
41 istone => "#bbc",
42
43 hills_rocky => "#aa8",
44 treed_hills => "#6a4",
45 hills => "#aa4",
46 mountain => "#ccc",
47 mountain2 => "#cdd",
48 mountain3 => "#ddc",
49 mountain4 => "#ddb",
50 mountain5 => "#ddd",
51 s_mountain => "#dff",
52
53 wasteland => "#ddf",
54 drifts => "#eef",
55 snow => "#eff",
56 cobblestones => "#ea2",
57 );
58
59 for my $k (keys %type) {
60 my $v = join "", map chr, (map $_*255/15, map hex, split //, substr $type{$k}, 1), 255;
61 $color{$v} = $k;
62 }
63
64 my $maps = Storable::retrieve "worldmaps.pst";
65
66 for my $X (100..129) {
67 print "$X\n";#d#
68 for my $Y (100..129) {
69 my $map = Storable::retrieve "pst/$X,$Y"
70 or die;
71 {
72 my $X = ($X - 100) * 50;
73 my $Y = ($Y - 100) * 50;
74 for my $x (0..49) {
75 for my $y (0..49) {
76 my $ofs = (($Y + $y)* 1500 + $X + $x) * 4;
77
78 my $mask = substr $mask, $ofs, 4;
79 my $type = substr $type, $ofs, 4;
80
81 next if $mask eq "\xff\x00\x00\xff";
82
83 if (my $k = $color{$type}) {
84 $map->{map}[$x][$y] = [{
85 _name => "$k",
86 }];
87 }
88 }
89 }
90 }
91 if ((my $pid = fork)) {
92 push @pids, $pid;
93 waitpid shift @pids, 0 if @pids > 3;
94 } else {
95 eval { $map->write_file ("../maps/world/world_$X\_$Y") };
96 warn $@ if $@;
97 POSIX::_exit 0;
98 }
99 }
100 }
101
102 POSIX::_exit 0;
103