ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra/Deliantra.pm
(Generate patch)

Comparing deliantra/Deliantra/Deliantra.pm (file contents):
Revision 1.1 by elmex, Sat Feb 4 23:24:03 2006 UTC vs.
Revision 1.5 by root, Sun Feb 5 00:25:33 2006 UTC

1package Crossfire;
2=head1 NAME 1=head1 NAME
3 2
4Crossfire - Crossfire maphandling 3Crossfire - Crossfire maphandling
5 4
6=cut 5=cut
7 6
7package Crossfire;
8
8our $VERSION = '1.21'; 9our $VERSION = '0.1';
9 10
10use strict; 11use strict;
11 12
12use Storable; 13use Storable;
13use List::Util qw(max);
14 14
15#use Gtk2;
16
17#init Gtk2::Gdk;
18
19my $LIB = $ENV{CROSSFIRE_LIBDIR} 15our $LIB = $ENV{CROSSFIRE_LIBDIR}
20 or die "\$CROSSFIRE_LIBDIR must be set\n"; 16 or die "\$CROSSFIRE_LIBDIR must be set\n";
21
22my $VARDIR = "$ENV{HOME}/.gcfedit";
23mkdir $VARDIR;
24 17
25sub T (){ 32 } 18sub T (){ 32 }
26 19
20our $ARCH;
21our $TILE;
22
27sub read_pak($) { 23sub read_pak($;$) {
28 my ($path) = @_; 24 my ($path, $cache) = @_;
29 25
30 eval { 26 eval {
31 -M "$VARDIR/crossfire.pak.pst" < -M $path 27 defined $cache
32 && Storable::retrieve "$VARDIR/crossfire.pak.pst" 28 && -M $cache < -M $path
29 && Storable::retrieve $cache
33 } or do { 30 } or do {
34 my %pak; 31 my %pak;
35 32
36 open my $fh, "<:raw", $path 33 open my $fh, "<:raw", $path
37 or die "$_[0]: $!"; 34 or die "$_[0]: $!";
39 my ($type, $id, $len, $path) = split; 36 my ($type, $id, $len, $path) = split;
40 $path =~ s/.*\///; 37 $path =~ s/.*\///;
41 read $fh, $pak{$path}, $len; 38 read $fh, $pak{$path}, $len;
42 } 39 }
43 40
44 Storable::nstore \%pak, "$VARDIR/crossfire.pak.pst"; 41 Storable::nstore \%pak, $cache
42 if defined $cache;
45 43
46 \%pak 44 \%pak
47 } 45 }
48} 46}
49 47
50sub read_arch($;$) { 48sub read_arch($;$) {
51 my ($path, $cache) = @_; 49 my ($path, $cache) = @_;
52 50
53 eval { 51 eval {
54 $cache 52 defined $cache
55 && -M "$VARDIR/$path.pst" < -M $path 53 && -M $cache < -M $path
56 && Storable::retrieve "$VARDIR/$path.pst" 54 && Storable::retrieve $cache
57 } or do { 55 } or do {
58 my %arc; 56 my %arc;
59 my ($more, $prev); 57 my ($more, $prev);
60 58
61 open my $fh, "<:raw", $path 59 open my $fh, "<:raw", $path
116 } 114 }
117 } 115 }
118 116
119 undef $parse_block; # work around bug in perl not freeing $fh etc. 117 undef $parse_block; # work around bug in perl not freeing $fh etc.
120 118
121 if ($cache) {
122 Storable::nstore \%arc, "$path.pst"; 119 Storable::nstore \%arc, $cache
123 utime +(stat $path)[8,9], "$path.pst"; 120 if defined $cache;
124 }
125 121
126 \%arc 122 \%arc
127 } 123 }
128} 124}
129 125
130sub cfmap_meta($;$) { 126sub arch2map($;$) {
131 my ($self, $mapa, $mapname) = @_; 127 my ($mapa) = @_;
132
133 my $arch = $self->{arch};
134 128
135 my %meta; 129 my %meta;
136 130
137 my ($mapx, $mapy); 131 my ($mapx, $mapy);
138 132
158 } 152 }
159 153
160 $meta{width} = $mapx; 154 $meta{width} = $mapx;
161 $meta{height} = $mapy; 155 $meta{height} = $mapy;
162 156
163 my %draw_info;
164 my %map_info;
165
166 # first pass, gather face stacking order, border and corner info
167 for my $x (0 .. $mapx - 1) {
168 my $col = $map->[$x];
169 for my $y (0 .. $mapy - 1) {
170 my $as = $col->[$y] || [];
171
172 for my $layer (0 .. $#$as) {
173 my $a = $as->[$layer];
174
175 my $o = $arch->{$a->{_name}}
176 or (warn "$mapname: arch '$a->{_name}' not found at ($x|$y)\n"), next;
177
178 #my $is_floor = exists $a->{is_floor} ? $a->{is_floor} : $o->{is_floor};
179 my $level = $layer * 256;
180
181 $level -= 100 * 256 if $o->{_name} eq "blocked";
182
183 while ($o) {
184 my $face = $a->{face} || $o->{face};
185
186 my $mx = $x + $o->{x};
187 my $my = $y + $o->{y};
188
189 last if 0 > $mx || $mx >= $mapx
190 || 0 > $my || $my >= $mapy;
191
192 push @{ $map_info{$level}{$mx, $my} }, $a;
193
194 $o = $o->{more};
195 $level = ($layer + 1000) * 2; # put "big things" on top, no matter what
196 }
197 }
198 }
199 }
200
201 # third pass, gather meta info
202 for my $level (sort { $a <=> $b } keys %map_info) {
203 my $info = $map_info{$level};
204
205 while (my ($xy, $as) = each %$info) {
206 my ($x, $y) = split $;, $xy;
207
208 next if $x < 0 || $x >= $mapx
209 || $y < 0 || $y >= $mapy;
210
211 push @{ $meta{map}[$x][$y] }, $_ for @$as;
212 }
213 }
214
215 \%meta 157 \%meta
216} 158}
217 159
218sub new { 160sub init($) {
219 my $class = shift; 161 my ($cachedir) = @_;
220 my $self = bless { }, $class;
221 $self->{arch} = read_arch "$LIB/archetypes";
222 $self->{tile} = read_pak "$LIB/crossfire.0";
223 $self
224}
225 162
226sub read { 163 $ARCH = read_arch "$LIB/archetypes", "$cachedir/archetypes.pst";
227 my ($self, $file) = @_; 164 $TILE = read_pak "$LIB/crossfire.0", "$cachedir/crossfire.0.pst";
228 my $mapa = read_arch $file;
229 my $map = $self->cfmap_meta ($mapa, $file);
230 print "READ: ".join(',', %{$map->{info}})."\n";
231 return $map;
232} 165}
233 166
234=head1 AUTHOR 167=head1 AUTHOR
235 168
236 Marc Lehmann <schmorp@schmorp.de> 169 Marc Lehmann <schmorp@schmorp.de>
238 171
239 Robin Redeker <elmex@ta-sa.org> 172 Robin Redeker <elmex@ta-sa.org>
240 http://www.ta-sa.org/ 173 http://www.ta-sa.org/
241 174
242=cut 175=cut
2431; 176
1771

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines