| … | |
… | |
| 58 | sub detect_format($) { |
58 | sub detect_format($) { |
| 59 | my ($data) = @_; |
59 | my ($data) = @_; |
| 60 | |
60 | |
| 61 | return "text" if $data =~ /^[ #\@\*\$\.\+\015\012\-_]+$/; |
61 | return "text" if $data =~ /^[ #\@\*\$\.\+\015\012\-_]+$/; |
| 62 | |
62 | |
| 63 | warn $data;#d# |
|
|
| 64 | return "rle" if $data =~ /^[ #\@\*\$\.\+\015\012\-_|1-9]+$/; |
63 | return "rle" if $data =~ /^[ #\@\*\$\.\+\015\012\-_|1-9]+$/; |
| 65 | exit 5;#d# |
|
|
| 66 | |
64 | |
| 67 | my ($a, $b) = unpack "ww", $data; |
65 | my ($a, $b) = unpack "ww", $data; |
| 68 | return "binpack" if defined $a && defined $b; |
66 | return "binpack" if defined $a && defined $b; |
| 69 | |
67 | |
| 70 | Carp::croak "unable to autodetect sokoban level format"; |
68 | Carp::croak "unable to autodetect sokoban level format"; |
| 71 | } |
69 | } |
| 72 | |
70 | |
| 73 | =item $level->data ([$new_data, [$new_data_format]]]) |
71 | =item $level->data ([$new_data, [$new_data_format]]) |
| 74 | |
72 | |
| 75 | Sets the level from the given data. |
73 | Sets the level from the given data. |
| 76 | |
74 | |
| 77 | =cut |
75 | =cut |
| 78 | |
76 | |
| … | |
… | |
| 119 | |
117 | |
| 120 | } else { |
118 | } else { |
| 121 | Carp::croak "$format: unsupported sokoban level format requested"; |
119 | Carp::croak "$format: unsupported sokoban level format requested"; |
| 122 | } |
120 | } |
| 123 | |
121 | |
|
|
122 | $self->{format} = $format; |
| 124 | $self->update; |
123 | $self->update; |
| 125 | } |
124 | } |
| 126 | |
125 | |
| 127 | $_[0]{data} |
126 | $_[0]{data} |
| 128 | } |
127 | } |
| … | |
… | |
| 395 | Games::Sokoban objects in an arrayref. |
394 | Games::Sokoban objects in an arrayref. |
| 396 | |
395 | |
| 397 | =cut |
396 | =cut |
| 398 | |
397 | |
| 399 | sub load_sokevo($) { |
398 | sub load_sokevo($) { |
| 400 | open my $fh, "<", $_[0] |
399 | open my $fh, "<:crlf", $_[0] |
| 401 | or Carp::croak "$_[0]: $!"; |
400 | or Carp::croak "$_[0]: $!"; |
| 402 | |
401 | |
| 403 | my @levels; |
402 | my @levels; |
| 404 | |
403 | |
|
|
404 | # skip file header |
|
|
405 | local $/ = "\n\n"; |
|
|
406 | scalar <$fh>; |
|
|
407 | |
| 405 | while (<$fh>) { |
408 | while (<$fh>) { |
| 406 | if (/^##+$/) { |
409 | chomp; |
| 407 | my $data = $_; |
410 | my %meta = split /[:\n]/; |
| 408 | while (<$fh>) { |
|
|
| 409 | $data .= $_; |
|
|
| 410 | last if /^$/; |
|
|
| 411 | } |
|
|
| 412 | |
411 | |
|
|
412 | $_ = <$fh>; |
|
|
413 | |
|
|
414 | /^##+\n/ or last; |
|
|
415 | |
| 413 | # sokevo internally locks some cells |
416 | # sokevo internally locks some cells |
| 414 | $data =~ y/^%:,;-=?/ #.$* +#/; |
417 | y/^%:,;-=?/ #.$* +#/; |
| 415 | |
418 | |
| 416 | push @levels, new Games::Sokoban data => $data; |
419 | push @levels, new Games::Sokoban data => $_, meta => \%meta; |
| 417 | } |
|
|
| 418 | } |
420 | } |
| 419 | |
421 | |
| 420 | \@levels |
422 | \@levels |
| 421 | } |
423 | } |
| 422 | |
424 | |
