… | |
… | |
22 | use common::sense; |
22 | use common::sense; |
23 | |
23 | |
24 | use Carp (); |
24 | use Carp (); |
25 | use List::Util (); |
25 | use List::Util (); |
26 | |
26 | |
27 | our $VERSION = '0.02'; |
27 | our $VERSION = '1.01'; |
28 | |
28 | |
29 | =item $level = new Games::Sokoban [format => "text|rle|binpack"], [data => "###..."] |
29 | =item $level = new Games::Sokoban [format => "text|rle|binpack"], [data => "###..."] |
30 | |
30 | |
31 | =cut |
31 | =cut |
32 | |
32 | |
… | |
… | |
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 | } |
… | |
… | |
162 | |
161 | |
163 | "$self->{data}\n" |
162 | "$self->{data}\n" |
164 | } |
163 | } |
165 | |
164 | |
166 | =item $binary = $level->as_binpack |
165 | =item $binary = $level->as_binpack |
|
|
166 | |
|
|
167 | Binpack is a very compact binary format (usually 17% of the size of an xsb |
|
|
168 | file), that is still reasonably easy to encode/decode. |
|
|
169 | |
|
|
170 | It only tries to store simplified levels with full fidelity - other levels |
|
|
171 | can be slightly changed outside the playable area. |
167 | |
172 | |
168 | =cut |
173 | =cut |
169 | |
174 | |
170 | sub as_binpack { |
175 | sub as_binpack { |
171 | my ($self) = @_; |
176 | my ($self) = @_; |
… | |
… | |
240 | $self->pos2xy ($-[0]); |
245 | $self->pos2xy ($-[0]); |
241 | } |
246 | } |
242 | |
247 | |
243 | =item $level->hflip |
248 | =item $level->hflip |
244 | |
249 | |
|
|
250 | Mirror horizontally. |
|
|
251 | |
245 | =item $level->vflip |
252 | =item $level->vflip |
246 | |
253 | |
247 | =item $level->transpose # topleft to bottomright |
254 | Mirror vertically. |
|
|
255 | |
|
|
256 | =item $level->transpose |
|
|
257 | |
|
|
258 | Transpose level (mirror at top-left/bottom-right diagonal). |
248 | |
259 | |
249 | =item $level->rotate_90 |
260 | =item $level->rotate_90 |
250 | |
261 | |
|
|
262 | Rotate by 90 degrees clockwise. |
|
|
263 | |
251 | =item $level->rotate_180 |
264 | =item $level->rotate_180 |
|
|
265 | |
|
|
266 | Rotate by 180 degrees clockwise. |
252 | |
267 | |
253 | =cut |
268 | =cut |
254 | |
269 | |
255 | sub hflip { |
270 | sub hflip { |
256 | $_[0]{data} = join "\n", map { scalar reverse $_ } split /\n/, $_[0]{data}; |
271 | $_[0]{data} = join "\n", map { scalar reverse $_ } split /\n/, $_[0]{data}; |
… | |
… | |
344 | # phew, done |
359 | # phew, done |
345 | } |
360 | } |
346 | |
361 | |
347 | =item $id = $level->normalise |
362 | =item $id = $level->normalise |
348 | |
363 | |
349 | normalises the level map and calculates/returns it's identity code |
364 | Simplifies the level map and calculates/returns its identity code. |
350 | |
365 | . |
351 | http://www.sourcecode.se/sokoban/level_id.php, assume uppercase and hex. |
366 | http://www.sourcecode.se/sokoban/level_id.php, assume uppercase and hex. |
352 | |
367 | |
353 | =cut |
368 | =cut |
354 | |
369 | |
355 | sub normalise { |
370 | sub normalise { |
… | |
… | |
389 | Games::Sokoban objects in an arrayref. |
404 | Games::Sokoban objects in an arrayref. |
390 | |
405 | |
391 | =cut |
406 | =cut |
392 | |
407 | |
393 | sub load_sokevo($) { |
408 | sub load_sokevo($) { |
394 | open my $fh, "<", $_[0] |
409 | open my $fh, "<:crlf", $_[0] |
395 | or Carp::croak "$_[0]: $!"; |
410 | or Carp::croak "$_[0]: $!"; |
396 | |
411 | |
397 | my @levels; |
412 | my @levels; |
398 | |
413 | |
|
|
414 | # skip file header |
|
|
415 | local $/ = "\n\n"; |
|
|
416 | scalar <$fh>; |
|
|
417 | |
399 | while (<$fh>) { |
418 | while (<$fh>) { |
400 | if (/^##+$/) { |
419 | chomp; |
401 | my $data = $_; |
420 | my %meta = split /(?:: |\n)/; |
402 | while (<$fh>) { |
|
|
403 | $data .= $_; |
|
|
404 | last if /^$/; |
|
|
405 | } |
|
|
406 | |
421 | |
|
|
422 | $_ = <$fh>; |
|
|
423 | |
|
|
424 | /^##+\n/ or last; |
|
|
425 | |
|
|
426 | # sokevo internally locks some cells |
|
|
427 | y/^%:,;-=?/ #.$* +#/; |
|
|
428 | |
|
|
429 | # skip levels without pusher |
|
|
430 | y/@+// or next; |
|
|
431 | |
407 | push @levels, new Games::Sokoban data => $data; |
432 | push @levels, new Games::Sokoban data => $_, meta => \%meta; |
408 | } |
|
|
409 | } |
433 | } |
410 | |
434 | |
411 | \@levels |
435 | \@levels |
412 | } |
436 | } |
413 | |
437 | |