ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/util/png2world
Revision: 1.10
Committed: Fri Oct 6 16:58:15 2006 UTC (17 years, 8 months ago) by root
Branch: MAIN
Changes since 1.9: +10 -0 lines
Log Message:
move brest to worldmap

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