ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/util/gen_worldmap
Revision: 1.5
Committed: Sun Dec 17 22:46:27 2006 UTC (17 years, 5 months ago) by elmex
Branch: MAIN
Changes since 1.4: +2 -1 lines
Log Message:
some fixes on the worldmap and gen_worldmap

File Contents

# User Rev Content
1 root 1.1 #!/opt/bin/perl
2    
3     use strict;
4 root 1.2 no utf8;
5 root 1.1
6     use Crossfire::Map;
7     use Storable;
8     use POSIX;
9     use File::Compare;
10    
11     use Gtk2 -init;
12    
13     my %type = (
14     deep_sea => "#006",
15     sea => "#008",
16     shallow_sea => "#00a",
17    
18     beach => "#aa0",
19     dunes => "#bb0",
20     desert => "#cc0",
21     steppe => "#880",
22     steppelight => "#dd7",
23     small_stones => "#eeb",
24    
25     marsh => "#0f8",
26     grass => "#0f0",
27     grassmedium => "#0e0",
28     grassbrown => "#851",
29     grassdark => "#274",
30     desert => "#cc0",
31    
32     darkforest => "#040",
33     evergreens => "#0a0",
34     woods => "#080",
35 elmex 1.3
36 root 1.1 swamp => "#660",
37     deep_swamp => "#440",
38 elmex 1.3
39 root 1.1 jungle_1 => "#084",
40    
41     flagstone => "#bbb",
42     istone => "#bbc",
43    
44     hills_rocky => "#aa8",
45     treed_hills => "#6a4",
46     hills => "#aa4",
47     mountain => "#ccc",
48     mountain2 => "#cdd",
49     mountain3 => "#ddc",
50     mountain4 => "#ddb",
51     mountain5 => "#ddd",
52     s_mountain => "#dff",
53    
54     wasteland => "#ddf",
55     drifts => "#eef",
56     snow => "#eff",
57     cobblestones => "#ea2",
58     );
59    
60 elmex 1.4 my ($part_x, $part_y);
61    
62 elmex 1.3 if ($ARGV[0] eq 'palette') {
63     mkdir "/tmp/$$.palette"
64     or die "Couldn't make /tmp/$$.palette";
65    
66     for (keys %type) {
67     my $color = $type{$_};
68     $color =~ s/^#//;
69     system ("convert -size 300x30 xc:\\#$color -pointsize 32 -fill \"red\" -gravity east -draw \"text 0,0 \\\"$_\\\"\" /tmp/$$.palette/$color.png");
70     }
71    
72     system ("convert -append "
73     . join (' ',
74     map {
75     my $c = $_; $c =~ s/^#//; "/tmp/$$.palette/$c.png"
76     } sort values %type
77     )
78     . " palette.png"
79     );
80    
81     system ("rm -r /tmp/$$.palette");
82 elmex 1.4 exit
83    
84     } elsif ($ARGV[0] eq 'pixel2map') {
85     my ($x, $y) = ($ARGV[1], $ARGV[2]);
86     $x = int ($x / 50);
87     $y = int ($y / 50);
88     $x += 100;
89     $y += 100;
90     print "gce $ENV{CROSSFIRE_LIBDIR}/maps/world/world_${x}_${y}\n";
91     exit
92     } elsif ($ARGV[0] eq 'partial') {
93     ($part_x, $part_y) = ($ARGV[1], $ARGV[2]);
94     } elsif ($ARGV[0] =~ m/-*?:he?l?p?/) {
95     print <<USAGE;
96     gen_worldmap [<mode>]
97     possible modes are:
98     - palette generates the palette.png for drawing world.png
99     - pixel2map takes 2 further arguments representing coordinates in
100     world.png and returns the world map file where the coordinate
101     points to.
102     - partial takes 2 further arguments that should be X and Y coordinates
103     of the worldmap (starting at 100/100 and ending at 129/129).
104     it will only generate that particular worldmap.
105     (no overlay png is generated in this mode)
106     without any mode the complete world is regenerated from the world.png and
107     the overlay png is written.
108     USAGE
109 elmex 1.3 }
110    
111     Crossfire::load_archetypes;
112    
113     open my $png, "convert world.png -depth 8 rgb:- |"
114     or die "convert :$!";
115     1500*1500*3 == read $png, my $world, 1500*1500*3 or die;
116 elmex 1.4
117     my $mask;
118     my $maskfh;
119     unless (defined $part_x) {
120 elmex 1.5 open my $mmaskfh, "| convert -depth 8 -size 1500x1500 rgba:- mask.png"
121 elmex 1.4 or die "convert2: $!";
122 elmex 1.5 $maskfh = $mmaskfh;
123 elmex 1.4 $mask = "\x00\x00\x00\x00" x (1500*1500);
124     }
125 elmex 1.3
126     chdir ".." unless -d "maps/.";
127     -d "maps/world/." and -d "maps/world-overlay/." or die "need maps/world and maps/world-overlay in .";
128    
129 root 1.1 my %color;
130     my @pids;
131    
132     for my $k (keys %type) {
133     my $v = join "", map chr, (map $_*255/15, map hex, split //, substr $type{$k}, 1);
134     $color{$v} = $k;
135     }
136    
137 root 1.2 for my $Y (100..129) {
138 elmex 1.4 next if defined $part_y and $Y != $part_y;
139    
140 root 1.2 print "$Y\n";#d#
141 elmex 1.4
142 root 1.2 for my $X (100..129) {
143 elmex 1.4 next if defined $part_x and $X != $part_x;
144    
145 root 1.1 my $mapname = sprintf "world_%03d_%03d", $X, $Y;
146     my $map = new_from_file Crossfire::Map "maps/world-overlay/$mapname"
147     or die "maps/world-overlay/$mapname: $!";
148    
149     {
150     my $X = ($X - 100) * 50;
151     my $Y = ($Y - 100) * 50;
152 root 1.2 for my $y (0..49) {
153     for my $x (0..49) {
154     my $ofs = (($Y + $y)* 1500 + $X + $x);
155    
156 elmex 1.4 if (defined $mask) {
157     substr $mask, $ofs * 4, 4,
158     $map->{map}[$x][$y] ? "\xff\x00\x00\xff" : "\xff\xff\xff\x00";
159     }
160 root 1.2
161     unless (grep $Crossfire::ARCH{$_->{_name}}{is_floor}, @{ $map->{map}[$x][$y] }) {
162    
163     my $type = substr $world, $ofs * 3, 3;
164    
165     if (my $k = $color{$type}) {
166     unshift @{ $map->{map}[$x][$y] }, {
167     _name => "$k",
168     };
169     } else {
170     die sprintf "colour '%s' not defined at %s+%s+%s",
171     (unpack "H*", $type), $mapname, $x, $y,
172     }
173 root 1.1 }
174     }
175     }
176     }
177    
178     if ((my $pid = fork)) {
179     push @pids, $pid;
180     waitpid shift @pids, 0 if @pids >= 3;
181     } else {
182     $map->write_file ("maps/world/$mapname~");
183     if (File::Compare::cmp "maps/world/$mapname", "maps/world/$mapname~") {
184     print "replacing maps/world/$mapname\n";
185     rename "maps/world/$mapname~", "maps/world/$mapname";
186     } else {
187     unlink "maps/world/$mapname~";
188     }
189     warn $@ if $@;
190     POSIX::_exit 0;
191     }
192     }
193     }
194    
195 elmex 1.4 print $maskfh $mask if defined $mask;
196 root 1.2
197     waitpid shift @pids, 0 if @pids >= 1;
198 root 1.1