ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/util/gen_worldmap
Revision: 1.1
Committed: Sun Dec 17 17:42:56 2006 UTC (17 years, 5 months ago) by root
Branch: MAIN
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 root 1.1 #!/opt/bin/perl
2    
3     use strict;
4    
5     use Crossfire::Map;
6     use Storable;
7     use POSIX;
8     use File::Compare;
9    
10     use Gtk2 -init;
11    
12     Crossfire::load_archetypes;
13    
14     open my $png, "convert world.png -depth 8 rgb:- |"
15     or die "convert :$!";
16     1500*1500*3 == read $png, my $world, 1500*1500*3 or die;
17    
18     chdir ".." unless -d "maps/.";
19     -d "maps/world/." and -d "maps/world-overlay/." or die "need maps/world and maps/world-overlay in .";
20    
21     my %type = (
22     deep_sea => "#006",
23     sea => "#008",
24     shallow_sea => "#00a",
25    
26     beach => "#aa0",
27     dunes => "#bb0",
28     desert => "#cc0",
29     steppe => "#880",
30     steppelight => "#dd7",
31     small_stones => "#eeb",
32    
33     marsh => "#0f8",
34     grass => "#0f0",
35     grassmedium => "#0e0",
36     grassbrown => "#851",
37     grassdark => "#274",
38     desert => "#cc0",
39    
40     darkforest => "#040",
41     evergreens => "#0a0",
42     woods => "#080",
43    
44     swamp => "#660",
45     deep_swamp => "#440",
46    
47     jungle_1 => "#084",
48    
49     flagstone => "#bbb",
50     istone => "#bbc",
51    
52     hills_rocky => "#aa8",
53     treed_hills => "#6a4",
54     hills => "#aa4",
55     mountain => "#ccc",
56     mountain2 => "#cdd",
57     mountain3 => "#ddc",
58     mountain4 => "#ddb",
59     mountain5 => "#ddd",
60     s_mountain => "#dff",
61    
62     wasteland => "#ddf",
63     drifts => "#eef",
64     snow => "#eff",
65     cobblestones => "#ea2",
66     );
67    
68     my %color;
69     my @pids;
70    
71     for my $k (keys %type) {
72     my $v = join "", map chr, (map $_*255/15, map hex, split //, substr $type{$k}, 1);
73     $color{$v} = $k;
74     }
75    
76     for my $X (100..129) {
77     print "$X\n";#d#
78     for my $Y (100..129) {
79     my $mapname = sprintf "world_%03d_%03d", $X, $Y;
80     my $map = new_from_file Crossfire::Map "maps/world-overlay/$mapname"
81     or die "maps/world-overlay/$mapname: $!";
82    
83     {
84     my $X = ($X - 100) * 50;
85     my $Y = ($Y - 100) * 50;
86     for my $x (0..49) {
87     for my $y (0..49) {
88     next if grep $Crossfire::ARCH{$_->{_name}}{is_floor}, @{ $map->{map}[$x][$y] };
89    
90     my $ofs = (($Y + $y)* 1500 + $X + $x) * 3;
91    
92     my $type = substr $world, $ofs, 3;
93    
94     if (my $k = $color{$type}) {
95     unshift @{ $map->{map}[$x][$y] }, {
96     _name => "$k",
97     };
98     } else {
99     die sprintf "colour '%s' not defined at %s+%s+%s",
100     (unpack "H*", $type), $mapname, $x, $y,
101     }
102     # delete $map->{map}[$x][$y];
103     }
104     }
105     }
106    
107     if ((my $pid = fork)) {
108     push @pids, $pid;
109     waitpid shift @pids, 0 if @pids >= 3;
110     } else {
111     $map->write_file ("maps/world/$mapname~");
112     if (File::Compare::cmp "maps/world/$mapname", "maps/world/$mapname~") {
113     print "replacing maps/world/$mapname\n";
114     rename "maps/world/$mapname~", "maps/world/$mapname";
115     } else {
116     unlink "maps/world/$mapname~";
117     }
118     warn $@ if $@;
119     POSIX::_exit 0;
120     }
121     }
122     }
123    
124     POSIX::_exit 0;
125