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.62 by root, Tue Mar 28 14:44:52 2006 UTC vs.
Revision 1.67 by root, Sun Jul 30 16:05:11 2006 UTC

… …
4 4
5=cut 5=cut
6 6
7package Crossfire; 7package Crossfire;
8 8
9our $VERSION = '0.1'; 9our $VERSION = '0.8';
10 10
11use strict; 11use strict;
12 12
13use base 'Exporter'; 13use base 'Exporter';
14 14
… …
130sub MOVE_ALL (){ 0x1001f } # very special value, more PITA 130sub MOVE_ALL (){ 0x1001f } # very special value, more PITA
131 131
132sub load_ref($) { 132sub load_ref($) {
133 my ($path) = @_; 133 my ($path) = @_;
134 134
135 open my $fh, "<", $path 135 open my $fh, "<:raw:perlio", $path
136 or die "$path: $!"; 136 or die "$path: $!";
137 binmode $fh;
138 local $/; 137 local $/;
139 138
140 thaw <$fh> 139 thaw <$fh>
141} 140}
142 141
143sub save_ref($$) { 142sub save_ref($$) {
144 my ($ref, $path) = @_; 143 my ($ref, $path) = @_;
145 144
146 open my $fh, ">", "$path~" 145 open my $fh, ">:raw:perlio", "$path~"
147 or die "$path~: $!"; 146 or die "$path~: $!";
148 binmode $fh;
149 print $fh freeze $ref; 147 print $fh freeze $ref;
150 close $fh; 148 close $fh;
151 rename "$path~", $path 149 rename "$path~", $path
152 or die "$path: $!"; 150 or die "$path: $!";
153} 151}
… …
201 if (defined (my $v = delete $ob->{slow_move})) { 199 if (defined (my $v = delete $ob->{slow_move})) {
202 $ob->{move_slow} |= MOVE_WALK; 200 $ob->{move_slow} |= MOVE_WALK;
203 $ob->{move_slow_penalty} = $v; 201 $ob->{move_slow_penalty} = $v;
204 } 202 }
205 if (defined (my $v = delete $ob->{walk_on})) { 203 if (defined (my $v = delete $ob->{walk_on})) {
204 $ob->{move_on} = MOVE_ALL unless exists $ob->{move_on};
206 $ob->{move_on} = $v ? $ob->{move_on} | MOVE_WALK 205 $ob->{move_on} = $v ? $ob->{move_on} | MOVE_WALK
207 : $ob->{move_on} & ~MOVE_WALK; 206 : $ob->{move_on} & ~MOVE_WALK;
208 } 207 }
209 if (defined (my $v = delete $ob->{walk_off})) { 208 if (defined (my $v = delete $ob->{walk_off})) {
209 $ob->{move_off} = MOVE_ALL unless exists $ob->{move_off};
210 $ob->{move_off} = $v ? $ob->{move_off} | MOVE_WALK 210 $ob->{move_off} = $v ? $ob->{move_off} | MOVE_WALK
211 : $ob->{move_off} & ~MOVE_WALK; 211 : $ob->{move_off} & ~MOVE_WALK;
212 } 212 }
213 if (defined (my $v = delete $ob->{fly_on})) { 213 if (defined (my $v = delete $ob->{fly_on})) {
214 $ob->{move_on} = MOVE_ALL unless exists $ob->{move_on};
214 $ob->{move_on} = $v ? $ob->{move_on} | MOVE_FLY_LOW 215 $ob->{move_on} = $v ? $ob->{move_on} | MOVE_FLY_LOW
215 : $ob->{move_on} & ~MOVE_FLY_LOW; 216 : $ob->{move_on} & ~MOVE_FLY_LOW;
216 } 217 }
217 if (defined (my $v = delete $ob->{fly_off})) { 218 if (defined (my $v = delete $ob->{fly_off})) {
219 $ob->{move_off} = MOVE_ALL unless exists $ob->{move_off};
218 $ob->{move_off} = $v ? $ob->{move_off} | MOVE_FLY_LOW 220 $ob->{move_off} = $v ? $ob->{move_off} | MOVE_FLY_LOW
219 : $ob->{move_off} & ~MOVE_FLY_LOW; 221 : $ob->{move_off} & ~MOVE_FLY_LOW;
220 } 222 }
221 if (defined (my $v = delete $ob->{flying})) { 223 if (defined (my $v = delete $ob->{flying})) {
224 $ob->{move_type} = MOVE_ALL unless exists $ob->{move_type};
222 $ob->{move_type} = $v ? $ob->{move_type} | MOVE_FLY_LOW 225 $ob->{move_type} = $v ? $ob->{move_type} | MOVE_FLY_LOW
223 : $ob->{move_type} & ~MOVE_FLY_LOW; 226 : $ob->{move_type} & ~MOVE_FLY_LOW;
224 } 227 }
225 228
226 # convert idiotic event_xxx things into objects 229 # convert idiotic event_xxx things into objects
… …
288sub read_pak($) { 291sub read_pak($) {
289 my ($path) = @_; 292 my ($path) = @_;
290 293
291 my %pak; 294 my %pak;
292 295
293 open my $fh, "<", $path 296 open my $fh, "<:raw:perlio", $path
294 or Carp::croak "$_[0]: $!"; 297 or Carp::croak "$_[0]: $!";
295 binmode $fh; 298 binmode $fh;
296 while (<$fh>) { 299 while (<$fh>) {
297 my ($type, $id, $len, $path) = split; 300 my ($type, $id, $len, $path) = split;
298 $path =~ s/.*\///; 301 $path =~ s/.*\///;
… …
300 } 303 }
301 304
302 \%pak 305 \%pak
303} 306}
304 307
305sub read_arch($) { 308sub read_arch($;$) {
306 my ($path) = @_; 309 my ($path, $toplevel) = @_;
307 310
308 my %arc; 311 my %arc;
309 my ($more, $prev); 312 my ($more, $prev);
310 313
311 open my $fh, "<", $path 314 open my $fh, "<:raw:perlio:utf8", $path
312 or Carp::croak "$path: $!"; 315 or Carp::croak "$path: $!";
313 316
314 binmode $fh; 317 binmode $fh;
315 318
316 my $parse_block; $parse_block = sub { 319 my $parse_block; $parse_block = sub {
… …
330 } elsif (/^msg$/i) { 333 } elsif (/^msg$/i) {
331 while (<$fh>) { 334 while (<$fh>) {
332 last if /^endmsg\s*$/i; 335 last if /^endmsg\s*$/i;
333 $arc{msg} .= $_; 336 $arc{msg} .= $_;
334 } 337 }
338 } elsif (/^anim$/i) {
339 while (<$fh>) {
340 last if /^mina\s*$/i;
341 chomp;
342 push @{ $arc{anim} }, $_;
343 }
335 } elsif (/^(\S+)\s*(.*)$/) { 344 } elsif (/^(\S+)\s*(.*)$/) {
336 $arc{lc $1} = $2; 345 $arc{lc $1} = $2;
337 } elsif (/^\s*($|#)/) { 346 } elsif (/^\s*($|#)/) {
338 # 347 #
339 } else { 348 } else {
… …
368 } else { 377 } else {
369 push @{ $arc{arch} }, $arc; 378 push @{ $arc{arch} }, $arc;
370 } 379 }
371 $prev = $arc; 380 $prev = $arc;
372 $more = undef; 381 $more = undef;
382 } elsif ($toplevel && /^(\S+)\s+(.*)$/) {
383 if ($1 eq "lev_array") {
384 while (<$fh>) {
385 last if /^endplst\s*$/;
386 push @{$toplevel->{lev_array}}, $_+0;
387 }
388 } else {
389 $toplevel->{$1} = $2;
390 }
373 } elsif (/^\s*($|#)/) { 391 } elsif (/^\s*($|#)/) {
374 # 392 #
375 } else { 393 } else {
376 warn "$path: unparseable top-level line '$_'"; 394 die "$path: unparseable top-level line '$_'";
377 } 395 }
378 } 396 }
379 397
380 undef $parse_block; # work around bug in perl not freeing $fh etc. 398 undef $parse_block; # work around bug in perl not freeing $fh etc.
381 399

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines