| … | |
… | |
| 70 | Carp::croak "unable to autodetect sokoban level format"; |
70 | Carp::croak "unable to autodetect sokoban level format"; |
| 71 | } |
71 | } |
| 72 | |
72 | |
| 73 | =item $level->data ([$new_data, [$new_data_format]]]) |
73 | =item $level->data ([$new_data, [$new_data_format]]]) |
| 74 | |
74 | |
|
|
75 | Sets the level from the given data. |
|
|
76 | |
| 75 | =cut |
77 | =cut |
| 76 | |
78 | |
| 77 | sub data { |
79 | sub data { |
|
|
80 | if (@_ > 1) { |
| 78 | my ($self, $data, $format) = @_; |
81 | my ($self, $data, $format) = @_; |
| 79 | |
82 | |
| 80 | $format ||= detect_format $data; |
83 | $format ||= detect_format $data; |
| 81 | |
84 | |
| 82 | if ($format eq "text" or $format eq "rle") { |
85 | if ($format eq "text" or $format eq "rle") { |
| 83 | $data =~ y/-_|/ \n/; |
86 | $data =~ y/-_|/ \n/; |
| 84 | $data =~ s/(\d)(.)/$2 x $1/ge; |
87 | $data =~ s/(\d)(.)/$2 x $1/ge; |
| 85 | my @lines = split /[\015\012]+/, $data; |
88 | my @lines = split /[\015\012]+/, $data; |
| 86 | my $w = List::Util::max map length, @lines; |
89 | my $w = List::Util::max map length, @lines; |
| 87 | |
90 | |
| 88 | $_ .= " " x ($w - length) |
91 | $_ .= " " x ($w - length) |
| 89 | for @lines; |
92 | for @lines; |
| 90 | |
93 | |
| 91 | $self->{data} = join "\n", @lines; |
94 | $self->{data} = join "\n", @lines; |
| 92 | |
95 | |
| 93 | } elsif ($format eq "binpack") { |
96 | } elsif ($format eq "binpack") { |
| 94 | (my ($w, $s), $data) = unpack "wwB*", $data; |
97 | (my ($w, $s), $data) = unpack "wwB*", $data; |
| 95 | |
98 | |
| 96 | my @enc = ('#', '$', '.', ' ', ' ', '###', '*', '# '); |
99 | my @enc = ('#', '$', '.', ' ', ' ', '###', '*', '# '); |
| 97 | |
100 | |
| 98 | $data = join "", |
101 | $data = join "", |
| 99 | map $enc[$_], |
102 | map $enc[$_], |
| 100 | unpack "C*", |
103 | unpack "C*", |
| 101 | pack "(b*)*", |
104 | pack "(b*)*", |
| 102 | unpack "(a3)*", $data; |
105 | unpack "(a3)*", $data; |
| 103 | |
106 | |
| 104 | # clip extra chars (max. 2) |
107 | # clip extra chars (max. 2) |
| 105 | my $extra = (length $data) % $w; |
108 | my $extra = (length $data) % $w; |
| 106 | substr $data, -$extra, $extra, "" if $extra; |
109 | substr $data, -$extra, $extra, "" if $extra; |
| 107 | |
110 | |
| 108 | (substr $data, $s, 1) =~ y/ ./@+/; |
111 | (substr $data, $s, 1) =~ y/ ./@+/; |
| 109 | |
112 | |
| 110 | $self->{data} = |
113 | $self->{data} = |
| 111 | join "\n", |
114 | join "\n", |
| 112 | map "#$_#", |
115 | map "#$_#", |
| 113 | "#" x $w, |
116 | "#" x $w, |
| 114 | (unpack "(a$w)*", $data), |
117 | (unpack "(a$w)*", $data), |
| 115 | "#" x $w; |
118 | "#" x $w; |
| 116 | |
119 | |
| 117 | } else { |
120 | } else { |
| 118 | Carp::croak "$format: unsupported sokoban level format requested"; |
121 | Carp::croak "$format: unsupported sokoban level format requested"; |
| 119 | } |
122 | } |
| 120 | |
123 | |
| 121 | $self->update; |
124 | $self->update; |
|
|
125 | } |
| 122 | |
126 | |
| 123 | ($self->{data}) |
127 | $_[0]{data} |
| 124 | } |
128 | } |
| 125 | |
129 | |
| 126 | sub pos2xy { |
130 | sub pos2xy { |
| 127 | use integer; |
131 | use integer; |
| 128 | |
132 | |
| … | |
… | |
| 158 | |
162 | |
| 159 | "$self->{data}\n" |
163 | "$self->{data}\n" |
| 160 | } |
164 | } |
| 161 | |
165 | |
| 162 | =item $binary = $level->as_binpack |
166 | =item $binary = $level->as_binpack |
|
|
167 | |
|
|
168 | Binpack is a very compact binary format (usually 17% of the size of an xsb |
|
|
169 | file), that is still reasonably easy to encode/decode. |
|
|
170 | |
|
|
171 | It only tries to store simplified levels with full fidelity - other levels |
|
|
172 | can be slightly changed outside the playable area. |
| 163 | |
173 | |
| 164 | =cut |
174 | =cut |
| 165 | |
175 | |
| 166 | sub as_binpack { |
176 | sub as_binpack { |
| 167 | my ($self) = @_; |
177 | my ($self) = @_; |
| … | |
… | |
| 205 | |
215 | |
| 206 | sub as_lines { |
216 | sub as_lines { |
| 207 | split /\n/, $_[0]{data} |
217 | split /\n/, $_[0]{data} |
| 208 | } |
218 | } |
| 209 | |
219 | |
| 210 | =item @lines = $level->as_rle |
220 | =item $line = $level->as_rle |
| 211 | |
221 | |
| 212 | http://www.sokobano.de/wiki/index.php?title=Level_format |
222 | http://www.sokobano.de/wiki/index.php?title=Level_format |
| 213 | |
223 | |
| 214 | =cut |
224 | =cut |
| 215 | |
225 | |
| … | |
… | |
| 222 | |
232 | |
| 223 | $data |
233 | $data |
| 224 | } |
234 | } |
| 225 | |
235 | |
| 226 | =item ($x, $y) = $level->start |
236 | =item ($x, $y) = $level->start |
|
|
237 | |
|
|
238 | Returns (0-based) starting coordinate. |
| 227 | |
239 | |
| 228 | =cut |
240 | =cut |
| 229 | |
241 | |
| 230 | sub start { |
242 | sub start { |
| 231 | my ($self) = @_; |
243 | my ($self) = @_; |
| … | |
… | |
| 396 | while (<$fh>) { |
408 | while (<$fh>) { |
| 397 | $data .= $_; |
409 | $data .= $_; |
| 398 | last if /^$/; |
410 | last if /^$/; |
| 399 | } |
411 | } |
| 400 | |
412 | |
|
|
413 | # sokevo internally locks some cells |
|
|
414 | $data =~ y/^%:,;-=?/ #.$* +#/; |
|
|
415 | |
| 401 | push @levels, new Games::Sokoban data => $data; |
416 | push @levels, new Games::Sokoban data => $data; |
| 402 | } |
417 | } |
| 403 | } |
418 | } |
| 404 | |
419 | |
| 405 | \@levels |
420 | \@levels |
