ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/util/gen_worldmap
Revision: 1.4
Committed: Sun Dec 17 20:26:25 2006 UTC (17 years, 5 months ago) by elmex
Branch: MAIN
Changes since 1.3: +47 -7 lines
Log Message:
added some convenience functionality to gen_worldmap. see 'gen_worldmap -h'

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     open \*maskfh, "| convert -depth 8 -size 1500x1500 rgba:- mask.png"
121     or die "convert2: $!";
122     $mask = "\x00\x00\x00\x00" x (1500*1500);
123     }
124 elmex 1.3
125     chdir ".." unless -d "maps/.";
126     -d "maps/world/." and -d "maps/world-overlay/." or die "need maps/world and maps/world-overlay in .";
127    
128 root 1.1 my %color;
129     my @pids;
130    
131     for my $k (keys %type) {
132     my $v = join "", map chr, (map $_*255/15, map hex, split //, substr $type{$k}, 1);
133     $color{$v} = $k;
134     }
135    
136 root 1.2 for my $Y (100..129) {
137 elmex 1.4 next if defined $part_y and $Y != $part_y;
138    
139 root 1.2 print "$Y\n";#d#
140 elmex 1.4
141 root 1.2 for my $X (100..129) {
142 elmex 1.4 next if defined $part_x and $X != $part_x;
143    
144 root 1.1 my $mapname = sprintf "world_%03d_%03d", $X, $Y;
145     my $map = new_from_file Crossfire::Map "maps/world-overlay/$mapname"
146     or die "maps/world-overlay/$mapname: $!";
147    
148     {
149     my $X = ($X - 100) * 50;
150     my $Y = ($Y - 100) * 50;
151 root 1.2 for my $y (0..49) {
152     for my $x (0..49) {
153     my $ofs = (($Y + $y)* 1500 + $X + $x);
154    
155 elmex 1.4 if (defined $mask) {
156     substr $mask, $ofs * 4, 4,
157     $map->{map}[$x][$y] ? "\xff\x00\x00\xff" : "\xff\xff\xff\x00";
158     }
159 root 1.2
160     unless (grep $Crossfire::ARCH{$_->{_name}}{is_floor}, @{ $map->{map}[$x][$y] }) {
161    
162     my $type = substr $world, $ofs * 3, 3;
163    
164     if (my $k = $color{$type}) {
165     unshift @{ $map->{map}[$x][$y] }, {
166     _name => "$k",
167     };
168     } else {
169     die sprintf "colour '%s' not defined at %s+%s+%s",
170     (unpack "H*", $type), $mapname, $x, $y,
171     }
172 root 1.1 }
173     }
174     }
175     }
176    
177     if ((my $pid = fork)) {
178     push @pids, $pid;
179     waitpid shift @pids, 0 if @pids >= 3;
180     } else {
181     $map->write_file ("maps/world/$mapname~");
182     if (File::Compare::cmp "maps/world/$mapname", "maps/world/$mapname~") {
183     print "replacing maps/world/$mapname\n";
184     rename "maps/world/$mapname~", "maps/world/$mapname";
185     } else {
186     unlink "maps/world/$mapname~";
187     }
188     warn $@ if $@;
189     POSIX::_exit 0;
190     }
191     }
192     }
193    
194 elmex 1.4 print $maskfh $mask if defined $mask;
195 root 1.2
196     waitpid shift @pids, 0 if @pids >= 1;
197 root 1.1