line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Data::ChipsChallenge; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
12594
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
21
|
|
4
|
1
|
|
|
1
|
|
3
|
use warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
19
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
# Note: this must be on the same line. See `perldoc version` |
7
|
1
|
|
|
1
|
|
747
|
use version; our $VERSION = version->declare('v1.0.0'); |
|
1
|
|
|
|
|
1215
|
|
|
1
|
|
|
|
|
5
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
# Holds the last error message. |
10
|
|
|
|
|
|
|
our $Error = ''; |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
=head1 NAME |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
Data::ChipsChallenge - Perl interface to Chip's Challenge data files. |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
=head1 SYNOPSIS |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
my $cc = new Data::ChipsChallenge("./CHIPS.DAT"); |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
print "This CHIPS.DAT file contains ", $cc->levels, " levels.\n\n"; |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
for (my $i = 1; $i <= $cc->levels; $i++) { |
23
|
|
|
|
|
|
|
my $info = $cc->getLevelInfo($i); |
24
|
|
|
|
|
|
|
print "Level $info->{level} - $info->{title}\n" |
25
|
|
|
|
|
|
|
. "Time Limit: $info->{time}\n" |
26
|
|
|
|
|
|
|
. " Chips: $info->{chips}\n" |
27
|
|
|
|
|
|
|
. " Password: $info->{password}\n\n"; |
28
|
|
|
|
|
|
|
} |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
=head1 DESCRIPTION |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
This module provides an interface for reading and writing to Chip's Challenge |
33
|
|
|
|
|
|
|
data files ("CHIPS.DAT") that is shipped with I
|
34
|
|
|
|
|
|
|
Pack>'s Chip's Challenge. |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
Chip's Challenge is a 2D tilebased maze game. The goal of each level is usually |
37
|
|
|
|
|
|
|
to collect a certain number of computer chips, so that a chip socket can be |
38
|
|
|
|
|
|
|
opened and the player can get to the exit and proceed to the next level. |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
This module is able to read and manipulate the data file that contains all these |
41
|
|
|
|
|
|
|
levels. For some examples, see those in the "eg" folder shipped with this |
42
|
|
|
|
|
|
|
module. |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
Documentation on the CHIPS.DAT file format can be found at this location: |
45
|
|
|
|
|
|
|
http://www.seasip.info/ccfile.html -- in case that page no longer exists, I've |
46
|
|
|
|
|
|
|
archived a copy of it in the C directory with this source distribution. |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
=head1 DISCLAIMER |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
This module only provides the mechanism for which you can read and manipulate |
51
|
|
|
|
|
|
|
a CHIPS.DAT game file. However, it cannot include a copy of the official |
52
|
|
|
|
|
|
|
CHIPS.DAT, as that file is copyrighted by its creators. If you have an original |
53
|
|
|
|
|
|
|
copy of the Chip's Challenge game from the I collection, you can use its |
54
|
|
|
|
|
|
|
CHIPS.DAT with this module. |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
=head1 METHODS |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
All of the following methods will return a value (or in the very least, 1). |
59
|
|
|
|
|
|
|
If any errors occur inside any methods, the method will return undef, and the |
60
|
|
|
|
|
|
|
error text can be obtained from C<$Data::ChipsChallenge::Error>. |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
=head2 new ([string FILE,] hash OPTIONS) |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
Create a new ChipsChallenge object. If you pass in an odd number of arguments, |
65
|
|
|
|
|
|
|
the first argument is taken as a default "CHIPS.DAT" file to load, and the rest |
66
|
|
|
|
|
|
|
is taken as a hash like 99% of the other CPAN modules. Loading the |
67
|
|
|
|
|
|
|
standard Chip's Challenge file with 149 levels takes a few seconds. |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
Alternatively, pass options in hash form: |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
bool debug = Enable or disable debug mode |
72
|
|
|
|
|
|
|
string file = The path to CHIPS.DAT |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
Ex: |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
my $cc = new Data::ChipsChallenge("CHIPS.DAT"); |
77
|
|
|
|
|
|
|
my $cc = new Data::ChipsChallenge("CHIPS.DAT", debug => 1); |
78
|
|
|
|
|
|
|
my $cc = new Data::ChipsChallenge(file => "CHIPS.DAT", debug => 1); |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
=cut |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
sub new { |
83
|
0
|
|
|
0
|
1
|
|
my $proto = shift; |
84
|
0
|
|
0
|
|
|
|
my $class = ref($proto) || $proto || "Data::ChipsChallenge"; |
85
|
|
|
|
|
|
|
|
86
|
0
|
|
|
|
|
|
my %args = (); |
87
|
0
|
0
|
|
|
|
|
if (scalar(@_) % 2) { |
88
|
0
|
|
|
|
|
|
$args{file} = shift; |
89
|
|
|
|
|
|
|
} |
90
|
0
|
|
|
|
|
|
my (%in) = (@_); |
91
|
0
|
|
|
|
|
|
foreach my $key (keys %in) { |
92
|
0
|
|
|
|
|
|
$args{$key} = $in{$key}; |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
|
95
|
0
|
|
|
|
|
|
my $self = { |
96
|
|
|
|
|
|
|
debug => 0, |
97
|
|
|
|
|
|
|
file => undef, |
98
|
|
|
|
|
|
|
levels => {}, # Level data |
99
|
|
|
|
|
|
|
(%args), |
100
|
|
|
|
|
|
|
}; |
101
|
|
|
|
|
|
|
|
102
|
0
|
|
|
|
|
|
bless ($self,$class); |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
# Did they give us a file? |
105
|
0
|
0
|
|
|
|
|
if (defined $self->{file}) { |
106
|
|
|
|
|
|
|
# Load it. |
107
|
0
|
|
|
|
|
|
$self->load($self->{file}); |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
|
110
|
0
|
|
|
|
|
|
return $self; |
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
sub debug { |
114
|
0
|
|
|
0
|
0
|
|
my ($self,$line) = @_; |
115
|
0
|
0
|
|
|
|
|
if ($self->{debug}) { |
116
|
0
|
|
|
|
|
|
print "$line\n"; |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
} |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
=head2 create (int LEVELS) |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
Create a new, blank, CHIPS.DAT file. Pass in the number of levels you want |
123
|
|
|
|
|
|
|
for your new CHIPS.DAT. This method will clear out any loaded data and |
124
|
|
|
|
|
|
|
initialize blank grids for each level specified. |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
Additional levels can be added or destroyed via the C and |
127
|
|
|
|
|
|
|
C functions. |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
=cut |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
sub create { |
132
|
0
|
|
|
0
|
1
|
|
my ($self,$levels) = @_; |
133
|
|
|
|
|
|
|
|
134
|
0
|
0
|
0
|
|
|
|
if (!defined $levels || $levels =~ /[^0-9]/) { |
135
|
0
|
|
|
|
|
|
$Error = "create must be given an integer number of levels!"; |
136
|
0
|
|
|
|
|
|
return undef; |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
# Flush any loaded data from memory. |
140
|
0
|
|
|
|
|
|
$self->{file} = undef; |
141
|
0
|
|
|
|
|
|
$self->{levels} = {}; |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
# Keep track of used passwords. |
144
|
0
|
|
|
|
|
|
my @letters = qw(A B C D E F G H I J K L M N O P Q R S T U V W X Y Z); |
145
|
0
|
|
|
|
|
|
my %passes = (); |
146
|
|
|
|
|
|
|
|
147
|
0
|
|
|
|
|
|
$self->debug("Creating a new quest with $levels levels."); |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
# Create all the levels. |
150
|
0
|
|
|
|
|
|
for (my $i = 1; $i <= $levels; $i++) { |
151
|
0
|
|
|
|
|
|
my $padded = sprintf("%03d", $i); |
152
|
|
|
|
|
|
|
|
153
|
0
|
|
|
|
|
|
$self->debug("Initializing level $padded"); |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
# Get a new password. |
156
|
0
|
|
|
|
|
|
my $pass = $self->random_password(); |
157
|
0
|
|
|
|
|
|
while (exists $passes{$pass}) { |
158
|
0
|
|
|
|
|
|
$self->debug("\tChosen password $pass was already taken; trying another"); |
159
|
0
|
|
|
|
|
|
$pass = $self->random_password(); |
160
|
|
|
|
|
|
|
} |
161
|
0
|
|
|
|
|
|
$passes{$pass} = 1; |
162
|
|
|
|
|
|
|
|
163
|
0
|
|
|
|
|
|
$self->debug("\tChosen password: $pass"); |
164
|
|
|
|
|
|
|
|
165
|
0
|
|
|
|
|
|
$self->{levels}->{$i} = { |
166
|
|
|
|
|
|
|
level => $i, |
167
|
|
|
|
|
|
|
title => "LEVEL $padded", |
168
|
|
|
|
|
|
|
password => $pass, |
169
|
|
|
|
|
|
|
hint => '', |
170
|
|
|
|
|
|
|
time => 0, |
171
|
|
|
|
|
|
|
chips => 0, |
172
|
|
|
|
|
|
|
compressed => 1, |
173
|
|
|
|
|
|
|
layer1 => [], |
174
|
|
|
|
|
|
|
layer2 => [], |
175
|
|
|
|
|
|
|
traps => [], |
176
|
|
|
|
|
|
|
cloners => [], |
177
|
|
|
|
|
|
|
movement => [], |
178
|
|
|
|
|
|
|
}; |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
# Initialize the map layers. |
181
|
0
|
|
|
|
|
|
$self->debug("Initializing the map layers"); |
182
|
0
|
|
|
|
|
|
for (my $row = 0; $row < 32; $row++) { |
183
|
0
|
|
|
|
|
|
for (my $col = 0; $col < 32; $col++) { |
184
|
0
|
|
|
|
|
|
my $sprite = '00'; |
185
|
0
|
0
|
0
|
|
|
|
if ($row == 0 && $col == 0) { |
|
|
0
|
0
|
|
|
|
|
186
|
0
|
|
|
|
|
|
$sprite = '6E'; |
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
elsif ($row == 0 && $col == 1) { |
189
|
0
|
|
|
|
|
|
$sprite = '15'; |
190
|
|
|
|
|
|
|
} |
191
|
0
|
|
|
|
|
|
$self->{levels}->{$i}->{layer1}->[$row]->[$col] = $sprite; |
192
|
0
|
|
|
|
|
|
$self->{levels}->{$i}->{layer2}->[$row]->[$col] = '00'; |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
} |
195
|
|
|
|
|
|
|
} |
196
|
|
|
|
|
|
|
|
197
|
0
|
|
|
|
|
|
return 1; |
198
|
|
|
|
|
|
|
} |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
=head2 load (string FILE) |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
Load a CHIPS.DAT file into memory. Returns undef on error, or 1 on success. |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
=cut |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
# Load the file. |
207
|
|
|
|
|
|
|
sub load { |
208
|
0
|
|
|
0
|
1
|
|
my ($self,$file) = @_; |
209
|
0
|
|
|
|
|
|
$self->{file} = $file; |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
# Open the file. |
212
|
0
|
0
|
|
|
|
|
if (!-f $file) { |
213
|
0
|
|
|
|
|
|
warn "Can't find file $file: doesn't exist!"; |
214
|
0
|
|
|
|
|
|
return undef; |
215
|
|
|
|
|
|
|
} |
216
|
0
|
|
|
|
|
|
open (READ, $file); |
217
|
0
|
|
|
|
|
|
binmode READ; |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
# Notes for unpacking the binary data: |
220
|
|
|
|
|
|
|
# C = Unsigned word |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
# Read off the headers. |
223
|
0
|
|
|
|
|
|
my $buffer; |
224
|
0
|
|
|
|
|
|
read(READ, $buffer, 4); |
225
|
0
|
|
|
|
|
|
my $header = $buffer; |
226
|
0
|
|
|
|
|
|
read(READ, $buffer, 2); |
227
|
0
|
|
|
|
|
|
my $levels = unpack("S",$buffer); |
228
|
0
|
|
|
|
|
|
$self->debug ("Number of Levels: $levels"); |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
# Begin loading the levels. |
231
|
0
|
|
|
|
|
|
for (my $parsed = 1; $parsed <= $levels; $parsed++) { |
232
|
0
|
|
|
|
|
|
$self->debug("Reading level $parsed"); |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
# See how long this level is. |
235
|
0
|
|
|
|
|
|
read(READ, $buffer, 2); |
236
|
0
|
|
|
|
|
|
my $lvl_length = unpack("s",$buffer); |
237
|
0
|
|
|
|
|
|
$self->debug ("\t Length of Data: $lvl_length"); |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
# Slurp out the entire contents of the level. |
240
|
0
|
|
|
|
|
|
read(READ, $buffer, $lvl_length); |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
# Get the number that THIS level claims to be. |
243
|
0
|
|
|
|
|
|
my $lvl_number = unpack("s",substr($buffer,0,2)); |
244
|
0
|
|
|
|
|
|
$self->debug ("\tReported Lvl Number: $lvl_number"); |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
# Get the time limit here. |
247
|
0
|
|
|
|
|
|
my $time = unpack("s", substr($buffer,2,2)); |
248
|
0
|
|
|
|
|
|
$self->debug ("\t Time Limit: $time"); |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
# Get the number of chips required. |
251
|
0
|
|
|
|
|
|
my $chips = unpack("s", substr($buffer,4,2)); |
252
|
0
|
|
|
|
|
|
$self->debug ("\t Chips Required: $chips"); |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
# Get whether the level is compressed or not (it always is). |
255
|
0
|
|
|
|
|
|
my $compressed = unpack("s", substr($buffer,6,2)); |
256
|
0
|
|
|
|
|
|
$self->debug ("\t Level Compressed: $compressed"); |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
# Store this metadata. |
259
|
0
|
|
|
|
|
|
$self->{levels}->{$lvl_number} = { |
260
|
|
|
|
|
|
|
level => $lvl_number, |
261
|
|
|
|
|
|
|
title => '', |
262
|
|
|
|
|
|
|
password => '', |
263
|
|
|
|
|
|
|
hint => '', |
264
|
|
|
|
|
|
|
time => $time, |
265
|
|
|
|
|
|
|
chips => $chips, |
266
|
|
|
|
|
|
|
compressed => $compressed, |
267
|
|
|
|
|
|
|
layer1 => [], # Layer 1 (Top) |
268
|
|
|
|
|
|
|
layer2 => [], # Layer 2 (Bottom) |
269
|
|
|
|
|
|
|
traps => [], # Traps |
270
|
|
|
|
|
|
|
cloners => [], # Clone machines |
271
|
|
|
|
|
|
|
movement => [], # Movement info |
272
|
|
|
|
|
|
|
}; |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
# Strip off all the header info that we don't need anymore. |
275
|
0
|
|
|
|
|
|
$buffer = substr($buffer, 8); |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
# Begin reading the upper layer. Get how many bytes it is. |
278
|
0
|
|
|
|
|
|
my $upper_bytes = unpack("s", substr($buffer,0,2)); |
279
|
0
|
|
|
|
|
|
$self->debug ("\tParsing Level Data: Upper Layer"); |
280
|
0
|
|
|
|
|
|
$self->debug ("\t\tLength of Data: $upper_bytes"); |
281
|
0
|
|
|
|
|
|
my $upper_layer = substr($buffer,2,$upper_bytes); |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
# Process the upper layer. |
284
|
0
|
|
|
|
|
|
my $layer1 = $self->process_map ($lvl_number,$upper_layer); |
285
|
0
|
|
|
|
|
|
$self->{levels}->{$lvl_number}->{layer1} = $layer1; |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
# Cut off the upper layer and begin reading the lower layer. |
288
|
0
|
|
|
|
|
|
$buffer = substr($buffer,$upper_bytes + 2); |
289
|
0
|
|
|
|
|
|
my $lower_bytes = unpack("s", substr($buffer,0,2)); |
290
|
0
|
|
|
|
|
|
$self->debug("\tParsing Level Data: Lower Layer"); |
291
|
0
|
|
|
|
|
|
$self->debug("\t\tLength of Data: $lower_bytes"); |
292
|
0
|
|
|
|
|
|
my $lower_layer = substr($buffer,2,$lower_bytes); |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
# Process the lower layer. |
295
|
0
|
|
|
|
|
|
my $layer2 = $self->process_map ($lvl_number,$lower_layer); |
296
|
0
|
|
|
|
|
|
$self->{levels}->{$lvl_number}->{layer2} = $layer2; |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
# Cut off the lower layer and see if there are any more fields. |
299
|
0
|
|
|
|
|
|
$buffer = substr($buffer,$lower_bytes + 2); |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
# Read any "optional" fields. |
302
|
0
|
0
|
|
|
|
|
if (length $buffer > 0) { |
303
|
|
|
|
|
|
|
# Get the bytes for optional fields. |
304
|
0
|
|
|
|
|
|
my $optional_bytes = unpack("s", substr($buffer,0,2)); |
305
|
0
|
|
|
|
|
|
$self->debug("\tOptional Field Length: $optional_bytes"); |
306
|
0
|
|
|
|
|
|
$buffer = substr($buffer,2); |
307
|
|
|
|
|
|
|
} |
308
|
|
|
|
|
|
|
|
309
|
0
|
|
|
|
|
|
while (length $buffer > 0) { |
310
|
|
|
|
|
|
|
# Get the field number. |
311
|
0
|
|
|
|
|
|
my $field = unpack("C", substr($buffer,0,1)); |
312
|
0
|
|
|
|
|
|
my $length = unpack("C", substr($buffer,1,1)); |
313
|
0
|
|
|
|
|
|
my $data = substr($buffer,2,$length); |
314
|
0
|
|
|
|
|
|
$buffer = substr($buffer,$length + 2); |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
# Handle the fields. |
317
|
0
|
0
|
|
|
|
|
if ($field == 3) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
318
|
|
|
|
|
|
|
# 3: Map Title |
319
|
0
|
|
|
|
|
|
my $title = substr($data,0,(length($data) - 1)); |
320
|
0
|
|
|
|
|
|
$self->debug("\t\tMap Title: $title"); |
321
|
0
|
|
|
|
|
|
$self->{levels}->{$lvl_number}->{title} = $title; |
322
|
|
|
|
|
|
|
} |
323
|
|
|
|
|
|
|
elsif ($field == 4) { |
324
|
|
|
|
|
|
|
# Trap Controls |
325
|
0
|
|
|
|
|
|
for (my $i = 0; $i < length($data); $i += 10) { |
326
|
0
|
|
|
|
|
|
my $buttonX = unpack("s",substr($data,$i,2)); |
327
|
0
|
|
|
|
|
|
my $buttonY = unpack("s",substr($data,$i + 2,2)); |
328
|
0
|
|
|
|
|
|
my $trapX = unpack("s",substr($data,$i + 4,2)); |
329
|
0
|
|
|
|
|
|
my $trapY = unpack("s",substr($data,$i + 6,2)); |
330
|
|
|
|
|
|
|
|
331
|
0
|
|
|
|
|
|
$self->debug("\t\tButton at ($buttonX,$buttonY) releases trap at ($trapX,$trapY)"); |
332
|
0
|
|
|
|
|
|
push (@{$self->{levels}->{$lvl_number}->{traps}}, { |
|
0
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
button => [ $buttonX, $buttonY ], |
334
|
|
|
|
|
|
|
trap => [ $trapX, $trapY ], |
335
|
|
|
|
|
|
|
}); |
336
|
|
|
|
|
|
|
} |
337
|
|
|
|
|
|
|
} |
338
|
|
|
|
|
|
|
elsif ($field == 5) { |
339
|
|
|
|
|
|
|
# Cloning Machine Controls |
340
|
0
|
|
|
|
|
|
for (my $i = 0; $i < length($data); $i += 8) { |
341
|
0
|
|
|
|
|
|
my $buttonX = unpack("s",substr($data,$i,2)); |
342
|
0
|
|
|
|
|
|
my $buttonY = unpack("s",substr($data,$i + 2,2)); |
343
|
0
|
|
|
|
|
|
my $cloneX = unpack("s",substr($data,$i + 4,2)); |
344
|
0
|
|
|
|
|
|
my $cloneY = unpack("s",substr($data,$i + 6,2)); |
345
|
|
|
|
|
|
|
|
346
|
0
|
|
|
|
|
|
$self->debug("\t\tButton at ($buttonX,$buttonY) clones object at ($cloneX,$cloneY)"); |
347
|
0
|
|
|
|
|
|
push (@{$self->{levels}->{$lvl_number}->{cloners}}, { |
|
0
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
button => [ $buttonX, $buttonY ], |
349
|
|
|
|
|
|
|
clone => [ $cloneX, $cloneY ], |
350
|
|
|
|
|
|
|
}); |
351
|
|
|
|
|
|
|
} |
352
|
|
|
|
|
|
|
} |
353
|
|
|
|
|
|
|
elsif ($field == 6) { |
354
|
|
|
|
|
|
|
# The password |
355
|
0
|
|
|
|
|
|
my $password = $self->decode_password($data); |
356
|
0
|
|
|
|
|
|
$self->debug("\t\tPassword: $password"); |
357
|
0
|
|
|
|
|
|
$self->{levels}->{$lvl_number}->{password} = $password; |
358
|
|
|
|
|
|
|
} |
359
|
|
|
|
|
|
|
elsif ($field == 7) { |
360
|
|
|
|
|
|
|
# Map Hint |
361
|
0
|
|
|
|
|
|
my $hint = substr($data,0,(length($data) - 1)); |
362
|
0
|
|
|
|
|
|
$self->debug("\t\tMap Hint: $hint"); |
363
|
0
|
|
|
|
|
|
$self->{levels}->{$lvl_number}->{hint} = $hint; |
364
|
|
|
|
|
|
|
} |
365
|
|
|
|
|
|
|
elsif ($field == 10) { |
366
|
|
|
|
|
|
|
# Movement |
367
|
0
|
|
|
|
|
|
for (my $i = 0; $i < length($data); $i += 2) { |
368
|
0
|
|
|
|
|
|
my $monsterX = unpack("C",substr($data,$i,1)); |
369
|
0
|
|
|
|
|
|
my $monsterY = unpack("C",substr($data,$i + 1,1)); |
370
|
|
|
|
|
|
|
|
371
|
0
|
|
|
|
|
|
$self->debug("\t\tMonster at ($monsterX,$monsterY) moves."); |
372
|
0
|
|
|
|
|
|
push (@{$self->{levels}->{$lvl_number}->{movement}}, [ $monsterX,$monsterY ]); |
|
0
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
} |
374
|
|
|
|
|
|
|
} |
375
|
|
|
|
|
|
|
} |
376
|
|
|
|
|
|
|
} |
377
|
|
|
|
|
|
|
|
378
|
0
|
|
|
|
|
|
close (READ); |
379
|
0
|
|
|
|
|
|
return 1; |
380
|
|
|
|
|
|
|
} |
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
=head2 write ([string FILE]) |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
Write the loaded data into a CHIPS.DAT file. This file should be able to be loaded |
385
|
|
|
|
|
|
|
into Chip's Challenge and played. Returns undef and sets C<$Data::ChipsChallenge::Error> |
386
|
|
|
|
|
|
|
on any errors. |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
If not given a filename, it will write to the same file that was last Ced. If |
389
|
|
|
|
|
|
|
no file was ever loaded then it would default to a file named "CHIPS.DAT". |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
=cut |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
sub write { |
394
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
395
|
0
|
|
0
|
|
|
|
my $file = shift || $self->{file} || "CHIPS.DAT"; |
396
|
|
|
|
|
|
|
|
397
|
0
|
|
|
|
|
|
$self->debug("Writing level data to $file"); |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
# Open the file for writing. |
400
|
0
|
0
|
|
|
|
|
open (WRITE, ">$file") or do { |
401
|
0
|
|
|
|
|
|
$Error = "Can't write to $file: $!"; |
402
|
0
|
|
|
|
|
|
return undef; |
403
|
|
|
|
|
|
|
}; |
404
|
0
|
|
|
|
|
|
binmode WRITE; |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
# Write the magic number. |
407
|
0
|
|
|
|
|
|
$self->debug("Writing magic number to header: ACAA0900"); |
408
|
0
|
|
|
|
|
|
my $magic = pack("C4", 0xAC, 0xAA, 0x02, 0x00); |
409
|
0
|
|
|
|
|
|
print WRITE $magic; |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
# Write the number of levels in this file. |
412
|
0
|
|
|
|
|
|
$self->debug("Writing number of levels into header"); |
413
|
0
|
|
|
|
|
|
my $levels = pack("S", $self->levels); |
414
|
0
|
|
|
|
|
|
print WRITE $levels; |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
# Begin writing the level data. |
417
|
0
|
|
|
|
|
|
for (my $i = 1; $i <= $self->levels; $i++) { |
418
|
|
|
|
|
|
|
# Begin chucking everything into a binary string. |
419
|
0
|
|
|
|
|
|
my $bin = ''; |
420
|
|
|
|
|
|
|
|
421
|
0
|
|
|
|
|
|
$self->debug("Writing data for level $i"); |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
# Get this level's meta data. |
424
|
0
|
|
|
|
|
|
my $meta = $self->getLevelInfo($i); |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
# Encode the level number that this level claims to be. |
427
|
0
|
|
|
|
|
|
$self->debug("\tLevel #: $meta->{level}"); |
428
|
0
|
|
|
|
|
|
my $alleged_level = pack("s", $meta->{level}); |
429
|
0
|
|
|
|
|
|
$bin .= $alleged_level; |
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
# Encode the time limit. |
432
|
0
|
|
|
|
|
|
$self->debug("\tTime Limit: $meta->{time}"); |
433
|
0
|
|
|
|
|
|
my $time = pack("s", $meta->{time}); |
434
|
0
|
|
|
|
|
|
$bin .= $time; |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
# Get the number of chips required. |
437
|
0
|
|
|
|
|
|
$self->debug("\tChips Required: $meta->{chips}"); |
438
|
0
|
|
|
|
|
|
my $chips = pack("s", $meta->{chips}); |
439
|
0
|
|
|
|
|
|
$bin .= $chips; |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
# The level is always compressed. |
442
|
0
|
|
|
|
|
|
$self->debug("\tCompressed: 1"); |
443
|
0
|
|
|
|
|
|
my $compressed = pack("s", 0x01); |
444
|
0
|
|
|
|
|
|
$bin .= $compressed; |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
# Get the level grids. |
447
|
0
|
|
|
|
|
|
my $gridUpper = $self->getUpperLayer ($i); |
448
|
0
|
|
|
|
|
|
my $gridLower = $self->getLowerLayer ($i); |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
# Compress and binaryify the grids. |
451
|
0
|
|
|
|
|
|
$self->debug("\tCompressing map layers"); |
452
|
0
|
|
|
|
|
|
my $binUpper = $self->compress_map ($gridUpper); |
453
|
0
|
|
|
|
|
|
my $binLower = $self->compress_map ($gridLower); |
454
|
0
|
|
|
|
|
|
$self->debug("\tLength of Upper Layer: " . length($binUpper)); |
455
|
0
|
|
|
|
|
|
$self->debug("\tLength of Lower Layer: " . length($binLower)); |
456
|
0
|
0
|
|
|
|
|
return undef unless defined $binUpper; |
457
|
0
|
0
|
|
|
|
|
return undef unless defined $binLower; |
458
|
0
|
|
|
|
|
|
my $lenUpper = pack("s", length($binUpper)); |
459
|
0
|
|
|
|
|
|
my $lenLower = pack("s", length($binLower)); |
460
|
0
|
|
|
|
|
|
$bin .= $lenUpper . $binUpper; |
461
|
0
|
|
|
|
|
|
$bin .= $lenLower . $binLower; |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
# Write the optional fields. |
464
|
0
|
|
|
|
|
|
my $obin = ''; |
465
|
0
|
|
|
|
|
|
foreach my $opt (qw(3 7 6 4 5 10)) { |
466
|
0
|
|
|
|
|
|
my $field = pack("C", $opt); |
467
|
0
|
0
|
|
|
|
|
if ($opt == 3) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
468
|
|
|
|
|
|
|
# 3: Map Title |
469
|
0
|
|
|
|
|
|
my $title = $meta->{title} . chr(0x00); |
470
|
0
|
|
|
|
|
|
my $len = pack("C", length($title)); |
471
|
0
|
|
|
|
|
|
$obin .= $field . $len . $title; |
472
|
0
|
|
|
|
|
|
$self->debug("\tWrote title: $title (len: " . length($title) . ")"); |
473
|
|
|
|
|
|
|
} |
474
|
|
|
|
|
|
|
elsif ($opt == 4) { |
475
|
|
|
|
|
|
|
# 4: Trap Controls |
476
|
0
|
|
|
|
|
|
my $traps = ''; |
477
|
0
|
|
|
|
|
|
my $coords = $self->getBearTraps($i); |
478
|
0
|
0
|
|
|
|
|
if (scalar @{$coords} > 0) { |
|
0
|
|
|
|
|
|
|
479
|
0
|
|
|
|
|
|
foreach my $trap (@{$coords}) { |
|
0
|
|
|
|
|
|
|
480
|
0
|
|
|
|
|
|
my $button = $trap->{button}; |
481
|
0
|
|
|
|
|
|
my $hole = $trap->{trap}; |
482
|
|
|
|
|
|
|
|
483
|
0
|
|
|
|
|
|
my $buttonX = pack("s", $button->[0]); |
484
|
0
|
|
|
|
|
|
my $buttonY = pack("s", $button->[1]); |
485
|
0
|
|
|
|
|
|
my $trapX = pack("s", $hole->[0]); |
486
|
0
|
|
|
|
|
|
my $trapY = pack("s", $hole->[1]); |
487
|
0
|
|
|
|
|
|
my $null = pack("s", 0x00); |
488
|
0
|
|
|
|
|
|
$traps .= join("", |
489
|
|
|
|
|
|
|
$buttonX, $buttonY, |
490
|
|
|
|
|
|
|
$trapX, $trapY, |
491
|
|
|
|
|
|
|
$null, |
492
|
|
|
|
|
|
|
); |
493
|
|
|
|
|
|
|
} |
494
|
0
|
|
|
|
|
|
$self->debug("\tWrote bear traps - length: " . length($traps)); |
495
|
0
|
|
|
|
|
|
my $len = pack("C", length($traps)); |
496
|
0
|
|
|
|
|
|
$obin .= $field . $len . $traps; |
497
|
|
|
|
|
|
|
} |
498
|
|
|
|
|
|
|
} |
499
|
|
|
|
|
|
|
elsif ($opt == 5) { |
500
|
|
|
|
|
|
|
# 5: Cloning Machine Controls |
501
|
0
|
|
|
|
|
|
my $machines = ''; |
502
|
0
|
|
|
|
|
|
my $coords = $self->getCloneMachines($i); |
503
|
0
|
0
|
|
|
|
|
if (scalar @{$coords} > 0) { |
|
0
|
|
|
|
|
|
|
504
|
0
|
|
|
|
|
|
foreach my $item (@{$coords}) { |
|
0
|
|
|
|
|
|
|
505
|
0
|
|
|
|
|
|
my $button = $item->{button}; |
506
|
0
|
|
|
|
|
|
my $clone = $item->{clone}; |
507
|
|
|
|
|
|
|
|
508
|
0
|
|
|
|
|
|
my $buttonX = pack("s", $button->[0]); |
509
|
0
|
|
|
|
|
|
my $buttonY = pack("s", $button->[1]); |
510
|
0
|
|
|
|
|
|
my $cloneX = pack("s", $clone->[0]); |
511
|
0
|
|
|
|
|
|
my $cloneY = pack("s", $clone->[1]); |
512
|
0
|
|
|
|
|
|
$machines .= join("", |
513
|
|
|
|
|
|
|
$buttonX, $buttonY, |
514
|
|
|
|
|
|
|
$cloneX, $cloneY, |
515
|
|
|
|
|
|
|
); |
516
|
|
|
|
|
|
|
} |
517
|
0
|
|
|
|
|
|
$self->debug("\tWrote clone machines - length: " . length($machines)); |
518
|
0
|
|
|
|
|
|
my $len = pack("C", length($machines)); |
519
|
0
|
|
|
|
|
|
$obin .= $field . $len . $machines; |
520
|
|
|
|
|
|
|
} |
521
|
|
|
|
|
|
|
} |
522
|
|
|
|
|
|
|
elsif ($opt == 6) { |
523
|
|
|
|
|
|
|
# 6: Map Password |
524
|
0
|
|
|
|
|
|
my $len = pack("C", 5); |
525
|
0
|
|
|
|
|
|
my $encoded = $self->encode_password ($meta->{password}); |
526
|
0
|
|
|
|
|
|
$self->debug("\tWrote password - length: 5"); |
527
|
0
|
|
|
|
|
|
$obin .= $field . $len . $encoded; |
528
|
|
|
|
|
|
|
} |
529
|
|
|
|
|
|
|
elsif ($opt == 7) { |
530
|
|
|
|
|
|
|
# 7: Map Hint |
531
|
0
|
0
|
|
|
|
|
if (exists $meta->{hint}) { |
532
|
0
|
|
|
|
|
|
my $hint = $meta->{hint} . chr(0x00); |
533
|
0
|
|
|
|
|
|
my $len = pack("C", length($hint)); |
534
|
0
|
|
|
|
|
|
$obin .= $field . $len . $hint; |
535
|
0
|
|
|
|
|
|
$self->debug("\tWrote map hint - length: " . length($hint)); |
536
|
|
|
|
|
|
|
} |
537
|
|
|
|
|
|
|
} |
538
|
|
|
|
|
|
|
elsif ($opt == 10) { |
539
|
|
|
|
|
|
|
# 10: Movement layer |
540
|
0
|
|
|
|
|
|
my $movement = $self->getMovement($i); |
541
|
0
|
0
|
|
|
|
|
if (scalar(@{$movement}) > 0) { |
|
0
|
|
|
|
|
|
|
542
|
0
|
|
|
|
|
|
my $move = ''; |
543
|
0
|
|
|
|
|
|
foreach my $coord (@{$movement}) { |
|
0
|
|
|
|
|
|
|
544
|
0
|
|
|
|
|
|
my ($x,$y) = @{$coord}; |
|
0
|
|
|
|
|
|
|
545
|
0
|
|
|
|
|
|
$x = pack("C", $x); |
546
|
0
|
|
|
|
|
|
$y = pack("C", $y); |
547
|
0
|
|
|
|
|
|
$move .= join("",$x,$y); |
548
|
|
|
|
|
|
|
} |
549
|
0
|
|
|
|
|
|
my $len = pack("C", length($move)); |
550
|
0
|
|
|
|
|
|
$obin .= $field . $len . $move; |
551
|
0
|
|
|
|
|
|
$self->debug("\tWrote movement layer - length: " . length($move)); |
552
|
|
|
|
|
|
|
} |
553
|
|
|
|
|
|
|
} |
554
|
|
|
|
|
|
|
} |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
# Get the length of the optionals. |
557
|
0
|
|
|
|
|
|
my $optlen = pack("s", length($obin)); |
558
|
0
|
|
|
|
|
|
$self->debug("\tLength of optional data: " . length($obin)); |
559
|
0
|
|
|
|
|
|
$bin .= $optlen . $obin; |
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
# Get the length of this binary. |
562
|
0
|
|
|
|
|
|
my $length = pack("s", length $bin); |
563
|
0
|
|
|
|
|
|
$self->debug("\tLength of level data: " . length($bin)); |
564
|
0
|
|
|
|
|
|
print WRITE $length; |
565
|
0
|
|
|
|
|
|
print WRITE $bin; |
566
|
|
|
|
|
|
|
} |
567
|
|
|
|
|
|
|
|
568
|
0
|
|
|
|
|
|
close (WRITE); |
569
|
|
|
|
|
|
|
|
570
|
0
|
|
|
|
|
|
$self->{file} = $file; |
571
|
0
|
|
|
|
|
|
return 1; |
572
|
|
|
|
|
|
|
} |
573
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
=head2 levels |
575
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
Returns the number of loaded levels. When loading the standard CHIPS.DAT, this |
577
|
|
|
|
|
|
|
method will probably return C<149>. |
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
print "There are ", $cc->levels, " levels in this file.\n"; |
580
|
|
|
|
|
|
|
|
581
|
|
|
|
|
|
|
=cut |
582
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
sub levels { |
584
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
585
|
0
|
|
|
|
|
|
my $levels = scalar(keys(%{$self->{levels}})); |
|
0
|
|
|
|
|
|
|
586
|
0
|
|
|
|
|
|
return $levels; |
587
|
|
|
|
|
|
|
} |
588
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
=head2 getLevelInfo (int LVL_NUMBER) |
590
|
|
|
|
|
|
|
|
591
|
|
|
|
|
|
|
Get information about a level. Returns a hashref of all the info available for |
592
|
|
|
|
|
|
|
the level, which may include some or all of the following keys: |
593
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
level: The level number of this map (3 digits, zero-padded, e.g. 001) |
595
|
|
|
|
|
|
|
title: The name of the map |
596
|
|
|
|
|
|
|
password: The four-letter password for this level |
597
|
|
|
|
|
|
|
time: The time limit (if 0, means there's no time limit) |
598
|
|
|
|
|
|
|
chips: Number of chips required to open the socket on this map |
599
|
|
|
|
|
|
|
hint: The text of the hint on this map (if no hint, this key won't exist) |
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
Example: |
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
for (my $i = 1; $i <= $cc->levels; $i++) { |
604
|
|
|
|
|
|
|
my $info = $cc->getLevelInfo($i); |
605
|
|
|
|
|
|
|
print "Level: $info->{level} - $info->{title}\n" |
606
|
|
|
|
|
|
|
. " Time: $info->{time} Chips: $info->{chips}\n" |
607
|
|
|
|
|
|
|
. " Pass: $info->{password}\n" |
608
|
|
|
|
|
|
|
. (exists $info->{hint} ? " Hint: $info->{hint}\n" : "") |
609
|
|
|
|
|
|
|
. "\n"; |
610
|
|
|
|
|
|
|
} |
611
|
|
|
|
|
|
|
|
612
|
|
|
|
|
|
|
Returns undef if the level isn't found, or if the level number wasn't given. |
613
|
|
|
|
|
|
|
|
614
|
|
|
|
|
|
|
=cut |
615
|
|
|
|
|
|
|
|
616
|
|
|
|
|
|
|
sub getLevelInfo { |
617
|
0
|
|
|
0
|
1
|
|
my ($self,$level) = @_; |
618
|
|
|
|
|
|
|
|
619
|
0
|
0
|
|
|
|
|
return undef unless defined $level; |
620
|
0
|
|
|
|
|
|
$level = int($level); # Just in case they gave us "001" instead of "1" |
621
|
0
|
0
|
|
|
|
|
return undef unless exists $self->{levels}->{$level}; |
622
|
|
|
|
|
|
|
|
623
|
0
|
|
|
|
|
|
my $return = {}; |
624
|
0
|
|
|
|
|
|
foreach my $key (qw(level title time chips hint password)) { |
625
|
0
|
0
|
0
|
|
|
|
if (defined $self->{levels}->{$level}->{$key} && |
|
|
|
0
|
|
|
|
|
626
|
|
|
|
|
|
|
defined $self->{levels}->{$level}->{$key} && |
627
|
|
|
|
|
|
|
length $self->{levels}->{$level}->{$key}) { |
628
|
0
|
|
|
|
|
|
$return->{$key} = $self->{levels}->{$level}->{$key}; |
629
|
|
|
|
|
|
|
} |
630
|
|
|
|
|
|
|
} |
631
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
$return->{level} = sprintf("%03d",$return->{level}) |
633
|
0
|
0
|
|
|
|
|
if exists $return->{level}; |
634
|
|
|
|
|
|
|
|
635
|
0
|
|
|
|
|
|
return $return; |
636
|
|
|
|
|
|
|
} |
637
|
|
|
|
|
|
|
|
638
|
|
|
|
|
|
|
=head2 setLevelInfo (int LVL_NUMBER, hash INFO) |
639
|
|
|
|
|
|
|
|
640
|
|
|
|
|
|
|
Set metadata about a level. The following information can be set: |
641
|
|
|
|
|
|
|
|
642
|
|
|
|
|
|
|
level |
643
|
|
|
|
|
|
|
title |
644
|
|
|
|
|
|
|
password |
645
|
|
|
|
|
|
|
time |
646
|
|
|
|
|
|
|
chips |
647
|
|
|
|
|
|
|
hint |
648
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
See L<"getLevelInfo"> for the definition of these fields. |
650
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
Note that the C field should equal C. It's I to |
652
|
|
|
|
|
|
|
override this to be something different, but it's not recommended. If you want |
653
|
|
|
|
|
|
|
to test your luck anyway, pass in the C field manually any time you call |
654
|
|
|
|
|
|
|
C. When the C field is not given, it defaults to the given |
655
|
|
|
|
|
|
|
C. |
656
|
|
|
|
|
|
|
|
657
|
|
|
|
|
|
|
You don't need to pass in every field. For example if you only want to change |
658
|
|
|
|
|
|
|
a level's time limit, you can pass only the time: |
659
|
|
|
|
|
|
|
|
660
|
|
|
|
|
|
|
# Level 131, "Totally Unfair", is indeed totally unfair - only 60 seconds to |
661
|
|
|
|
|
|
|
# haul butt to barely survive the level? Let's up the time limit. |
662
|
|
|
|
|
|
|
$cc->setLevelInfo (131, time => 999); |
663
|
|
|
|
|
|
|
|
664
|
|
|
|
|
|
|
# Or better yet, remove the time limit altogether! |
665
|
|
|
|
|
|
|
$cc->setLevelInfo (131, time => 0); |
666
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
Special considerations: |
668
|
|
|
|
|
|
|
|
669
|
|
|
|
|
|
|
* There must be a title |
670
|
|
|
|
|
|
|
* There must be a password |
671
|
|
|
|
|
|
|
* All level passwords must be unique |
672
|
|
|
|
|
|
|
|
673
|
|
|
|
|
|
|
If there's an error, this function returns undef and sets |
674
|
|
|
|
|
|
|
C<$Data::ChipsChallenge::Error> to the text of the error message. |
675
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
=cut |
677
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
sub setLevelInfo { |
679
|
0
|
|
|
0
|
1
|
|
my ($self,$level,%info) = @_; |
680
|
|
|
|
|
|
|
|
681
|
0
|
0
|
|
|
|
|
if (!defined $level) { |
682
|
0
|
|
|
|
|
|
$Error = "setLevelInfo requires a level number as the first argument!"; |
683
|
0
|
|
|
|
|
|
return undef; |
684
|
|
|
|
|
|
|
} |
685
|
0
|
|
|
|
|
|
$level = int($level); |
686
|
0
|
0
|
|
|
|
|
if (!exists $self->{levels}->{$level}) { |
687
|
0
|
|
|
|
|
|
$Error = "That level number doesn't seem to exist!"; |
688
|
0
|
|
|
|
|
|
return undef; |
689
|
|
|
|
|
|
|
} |
690
|
|
|
|
|
|
|
|
691
|
0
|
0
|
0
|
|
|
|
if (exists $info{title} && length $info{title} < 1) { |
692
|
0
|
|
|
|
|
|
$Error = "All levels must have titles!"; |
693
|
0
|
|
|
|
|
|
return undef; |
694
|
|
|
|
|
|
|
} |
695
|
0
|
0
|
0
|
|
|
|
if (exists $info{password} && length $info{password} != 4) { |
696
|
0
|
|
|
|
|
|
$Error = "All levels must have a 4 letter password!"; |
697
|
0
|
|
|
|
|
|
return undef; |
698
|
|
|
|
|
|
|
} |
699
|
0
|
0
|
0
|
|
|
|
if (exists $info{password} && $info{password} =~ /[^A-Za-z]/) { |
700
|
0
|
|
|
|
|
|
$Error = "Passwords can only contain letters!"; |
701
|
0
|
|
|
|
|
|
return undef; |
702
|
|
|
|
|
|
|
} |
703
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
# Did they give us a password? |
705
|
0
|
0
|
|
|
|
|
if (exists $info{password}) { |
706
|
|
|
|
|
|
|
# Uppercase it. |
707
|
0
|
|
|
|
|
|
$info{password} = uc($info{password}); |
708
|
|
|
|
|
|
|
|
709
|
|
|
|
|
|
|
# Make sure it doesn't exist. |
710
|
0
|
|
|
|
|
|
for (my $i = 1; $i <= $self->levels; $i++) { |
711
|
0
|
0
|
|
|
|
|
if ($self->{levels}->{$i}->{password} eq $info{password}) { |
712
|
0
|
|
|
|
|
|
$Error = "There is a password conflict with level $i"; |
713
|
0
|
|
|
|
|
|
return undef; |
714
|
|
|
|
|
|
|
} |
715
|
|
|
|
|
|
|
} |
716
|
|
|
|
|
|
|
} |
717
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
# Are they overriding the level number? |
719
|
0
|
0
|
|
|
|
|
if (exists $info{level}) { |
720
|
0
|
|
|
|
|
|
$info{level} = int($info{level}); |
721
|
|
|
|
|
|
|
} |
722
|
|
|
|
|
|
|
else { |
723
|
0
|
|
|
|
|
|
$info{level} = int($level); |
724
|
|
|
|
|
|
|
} |
725
|
|
|
|
|
|
|
|
726
|
|
|
|
|
|
|
# Store the data we were given. |
727
|
0
|
|
|
|
|
|
foreach my $key (keys %info) { |
728
|
0
|
|
|
|
|
|
$self->{levels}->{$level}->{$key} = $info{$key}; |
729
|
|
|
|
|
|
|
} |
730
|
|
|
|
|
|
|
|
731
|
0
|
|
|
|
|
|
return 1; |
732
|
|
|
|
|
|
|
} |
733
|
|
|
|
|
|
|
|
734
|
|
|
|
|
|
|
=head2 getUpperLayer (int LVL_NUMBER) |
735
|
|
|
|
|
|
|
|
736
|
|
|
|
|
|
|
Returns a 2D array of all the tiles in the "upper" (primary) layer of the map |
737
|
|
|
|
|
|
|
for level C. Each entry in the map is an uppercase plaintext |
738
|
|
|
|
|
|
|
hexadecimal code for the object that appears in that space. The grid is referenced |
739
|
|
|
|
|
|
|
by Y/X notation, not X/Y; that is, it's an array of rows (Y) and each row is an |
740
|
|
|
|
|
|
|
array of columns (X). |
741
|
|
|
|
|
|
|
|
742
|
|
|
|
|
|
|
The upper layer is where most of the stuff happens. The lower layer is primarily |
743
|
|
|
|
|
|
|
for things such as: traps hidden under movable blocks, clone machines underneath |
744
|
|
|
|
|
|
|
monsters, etc. |
745
|
|
|
|
|
|
|
|
746
|
|
|
|
|
|
|
Returns undef and sets C<$Data::ChipsChallenge::Error> on error. |
747
|
|
|
|
|
|
|
|
748
|
|
|
|
|
|
|
=cut |
749
|
|
|
|
|
|
|
|
750
|
|
|
|
|
|
|
sub getUpperLayer { |
751
|
0
|
|
|
0
|
1
|
|
my ($self,$level) = @_; |
752
|
|
|
|
|
|
|
|
753
|
0
|
0
|
|
|
|
|
if (!defined $level) { |
754
|
0
|
|
|
|
|
|
$Error = "getUpperLayer requires a level number!"; |
755
|
0
|
|
|
|
|
|
return undef; |
756
|
|
|
|
|
|
|
} |
757
|
0
|
|
|
|
|
|
$level = int($level); |
758
|
0
|
0
|
|
|
|
|
if (!exists $self->{levels}->{$level}) { |
759
|
0
|
|
|
|
|
|
$Error = "That level number wasn't found!"; |
760
|
0
|
|
|
|
|
|
return undef; |
761
|
|
|
|
|
|
|
} |
762
|
|
|
|
|
|
|
|
763
|
0
|
0
|
|
|
|
|
if (scalar(@{$self->{levels}->{$level}->{layer1}}) == 0) { |
|
0
|
|
|
|
|
|
|
764
|
0
|
|
|
|
|
|
$Error = "The upper layer data for this level wasn't found!"; |
765
|
0
|
|
|
|
|
|
return undef; |
766
|
|
|
|
|
|
|
} |
767
|
|
|
|
|
|
|
|
768
|
0
|
|
|
|
|
|
return $self->{levels}->{$level}->{layer1}; |
769
|
|
|
|
|
|
|
} |
770
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
=head2 getLowerLayer (int LVL_NUMBER) |
772
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
Returns a 2D array of all the tiles in the "lower" layer of the map for level |
774
|
|
|
|
|
|
|
C. On most maps the lower layer is made up only of floor tiles. |
775
|
|
|
|
|
|
|
|
776
|
|
|
|
|
|
|
See L<"getUpperLayer">. |
777
|
|
|
|
|
|
|
|
778
|
|
|
|
|
|
|
=cut |
779
|
|
|
|
|
|
|
|
780
|
|
|
|
|
|
|
sub getLowerLayer { |
781
|
0
|
|
|
0
|
1
|
|
my ($self,$level) = @_; |
782
|
|
|
|
|
|
|
|
783
|
0
|
0
|
|
|
|
|
if (!defined $level) { |
784
|
0
|
|
|
|
|
|
$Error = "getLowerLayer requires a level number!"; |
785
|
0
|
|
|
|
|
|
return undef; |
786
|
|
|
|
|
|
|
} |
787
|
0
|
|
|
|
|
|
$level = int($level); |
788
|
0
|
0
|
|
|
|
|
if (!exists $self->{levels}->{$level}) { |
789
|
0
|
|
|
|
|
|
$Error = "That level number wasn't found!"; |
790
|
0
|
|
|
|
|
|
return undef; |
791
|
|
|
|
|
|
|
} |
792
|
|
|
|
|
|
|
|
793
|
0
|
0
|
|
|
|
|
if (scalar(@{$self->{levels}->{$level}->{layer2}}) == 0) { |
|
0
|
|
|
|
|
|
|
794
|
0
|
|
|
|
|
|
$Error = "The lower layer data for this level wasn't found!"; |
795
|
0
|
|
|
|
|
|
return undef; |
796
|
|
|
|
|
|
|
} |
797
|
|
|
|
|
|
|
|
798
|
0
|
|
|
|
|
|
return $self->{levels}->{$level}->{layer2}; |
799
|
|
|
|
|
|
|
} |
800
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
=head2 setUpperLayer (int LVL_NUMBER, grid MAP_DATA) |
802
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
Sets the upper layer of a level with the 2D array in C. The array |
804
|
|
|
|
|
|
|
should be like the one given by C. The grid must have 32 rows |
805
|
|
|
|
|
|
|
and 32 columns in each row. Incomplete map data will be rejected. |
806
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
=cut |
808
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
sub setUpperLayer { |
810
|
0
|
|
|
0
|
1
|
|
my ($self,$level,$data) = @_; |
811
|
|
|
|
|
|
|
|
812
|
0
|
0
|
0
|
|
|
|
if (!defined $level || !defined $data) { |
813
|
0
|
|
|
|
|
|
$Error = "setUpperLayer requires a level number and map data!"; |
814
|
0
|
|
|
|
|
|
return undef; |
815
|
|
|
|
|
|
|
} |
816
|
0
|
|
|
|
|
|
$level = int($level); |
817
|
0
|
0
|
|
|
|
|
if (!exists $self->{levels}->{$level}) { |
818
|
0
|
|
|
|
|
|
$Error = "That level number wasn't found!"; |
819
|
0
|
|
|
|
|
|
return undef; |
820
|
|
|
|
|
|
|
} |
821
|
|
|
|
|
|
|
|
822
|
|
|
|
|
|
|
# Validate the map data. |
823
|
0
|
|
|
|
|
|
my $y = 0; |
824
|
0
|
0
|
|
|
|
|
if (scalar @{$data} != 32) { |
|
0
|
|
|
|
|
|
|
825
|
0
|
|
|
|
|
|
$Error = "The map data doesn't have 32 rows (Y)"; |
826
|
0
|
|
|
|
|
|
return undef; |
827
|
|
|
|
|
|
|
} |
828
|
0
|
|
|
|
|
|
foreach my $row (@{$data}) { |
|
0
|
|
|
|
|
|
|
829
|
0
|
0
|
|
|
|
|
if (scalar @{$row} != 32) { |
|
0
|
|
|
|
|
|
|
830
|
0
|
|
|
|
|
|
$Error = "Row $y doesn't have 32 columns (X)"; |
831
|
0
|
|
|
|
|
|
return undef; |
832
|
|
|
|
|
|
|
} |
833
|
0
|
|
|
|
|
|
$y++; |
834
|
|
|
|
|
|
|
} |
835
|
|
|
|
|
|
|
|
836
|
|
|
|
|
|
|
# Good? Good. |
837
|
0
|
|
|
|
|
|
$self->{levels}->{$level}->{layer1} = $data; |
838
|
0
|
|
|
|
|
|
return 1; |
839
|
|
|
|
|
|
|
} |
840
|
|
|
|
|
|
|
|
841
|
|
|
|
|
|
|
=head2 setLowerLayer (int LVL_NUMBER, grid MAP_DATA) |
842
|
|
|
|
|
|
|
|
843
|
|
|
|
|
|
|
Sets the lower layer of a level with the 2D array in C. The array |
844
|
|
|
|
|
|
|
should be like the one given by C. The grid must have 32 rows |
845
|
|
|
|
|
|
|
and 32 columns in each row. Incomplete map data will be rejected. |
846
|
|
|
|
|
|
|
|
847
|
|
|
|
|
|
|
=cut |
848
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
sub setLowerLayer { |
850
|
0
|
|
|
0
|
1
|
|
my ($self,$level,$data) = @_; |
851
|
|
|
|
|
|
|
|
852
|
0
|
0
|
0
|
|
|
|
if (!defined $level || !defined $data) { |
853
|
0
|
|
|
|
|
|
$Error = "setLowerLayer requires a level number and map data!"; |
854
|
0
|
|
|
|
|
|
return undef; |
855
|
|
|
|
|
|
|
} |
856
|
0
|
|
|
|
|
|
$level = int($level); |
857
|
0
|
0
|
|
|
|
|
if (!exists $self->{levels}->{$level}) { |
858
|
0
|
|
|
|
|
|
$Error = "That level number wasn't found!"; |
859
|
0
|
|
|
|
|
|
return undef; |
860
|
|
|
|
|
|
|
} |
861
|
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
# Validate the map data. |
863
|
0
|
|
|
|
|
|
my $y = 0; |
864
|
0
|
0
|
|
|
|
|
if (scalar @{$data} != 32) { |
|
0
|
|
|
|
|
|
|
865
|
0
|
|
|
|
|
|
$Error = "The map data doesn't have 32 rows (Y)"; |
866
|
0
|
|
|
|
|
|
return undef; |
867
|
|
|
|
|
|
|
} |
868
|
0
|
|
|
|
|
|
foreach my $row (@{$data}) { |
|
0
|
|
|
|
|
|
|
869
|
0
|
0
|
|
|
|
|
if (scalar @{$row} != 32) { |
|
0
|
|
|
|
|
|
|
870
|
0
|
|
|
|
|
|
$Error = "Row $y doesn't have 32 columns (X)"; |
871
|
0
|
|
|
|
|
|
return undef; |
872
|
|
|
|
|
|
|
} |
873
|
0
|
|
|
|
|
|
$y++; |
874
|
|
|
|
|
|
|
} |
875
|
|
|
|
|
|
|
|
876
|
|
|
|
|
|
|
# Good! |
877
|
0
|
|
|
|
|
|
$self->{levels}->{$level}->{layer2} = $data; |
878
|
0
|
|
|
|
|
|
return 1; |
879
|
|
|
|
|
|
|
} |
880
|
|
|
|
|
|
|
|
881
|
|
|
|
|
|
|
=head2 getBearTraps (int LVL_NUMBER) |
882
|
|
|
|
|
|
|
|
883
|
|
|
|
|
|
|
Get all the coordinates to bear traps and their release buttons. Returns an |
884
|
|
|
|
|
|
|
arrayref of hashrefs in the following format: |
885
|
|
|
|
|
|
|
|
886
|
|
|
|
|
|
|
[ |
887
|
|
|
|
|
|
|
{ |
888
|
|
|
|
|
|
|
button => [ X, Y ], |
889
|
|
|
|
|
|
|
trap => [ X, Y ], |
890
|
|
|
|
|
|
|
}, |
891
|
|
|
|
|
|
|
]; |
892
|
|
|
|
|
|
|
|
893
|
|
|
|
|
|
|
Where C are the coordinates of the tiles involved, beginning at |
894
|
|
|
|
|
|
|
C<0,0> and going to C<31,31>. |
895
|
|
|
|
|
|
|
|
896
|
|
|
|
|
|
|
=cut |
897
|
|
|
|
|
|
|
|
898
|
|
|
|
|
|
|
sub getBearTraps { |
899
|
0
|
|
|
0
|
1
|
|
my ($self,$level) = @_; |
900
|
|
|
|
|
|
|
|
901
|
0
|
0
|
|
|
|
|
if (!defined $level) { |
902
|
0
|
|
|
|
|
|
$Error = "getBearTraps requires the level number!"; |
903
|
0
|
|
|
|
|
|
return undef; |
904
|
|
|
|
|
|
|
} |
905
|
0
|
|
|
|
|
|
$level = int($level); |
906
|
0
|
0
|
|
|
|
|
if (!exists $self->{levels}->{$level}) { |
907
|
0
|
|
|
|
|
|
$Error = "The level $level doesn't exist!"; |
908
|
0
|
|
|
|
|
|
return undef; |
909
|
|
|
|
|
|
|
} |
910
|
|
|
|
|
|
|
|
911
|
0
|
|
|
|
|
|
return $self->{levels}->{$level}->{traps}; |
912
|
|
|
|
|
|
|
} |
913
|
|
|
|
|
|
|
|
914
|
|
|
|
|
|
|
=head2 setBearTraps (int LVL_NUMBER, arrayref BEARTRAPS) |
915
|
|
|
|
|
|
|
|
916
|
|
|
|
|
|
|
Define bear trap coordinates. You must define every bear trap with |
917
|
|
|
|
|
|
|
this method; calling it overwrites the existing bear trap data with |
918
|
|
|
|
|
|
|
the ones you provide. |
919
|
|
|
|
|
|
|
|
920
|
|
|
|
|
|
|
The arrayref should be formatted the same as the one you got from |
921
|
|
|
|
|
|
|
C. |
922
|
|
|
|
|
|
|
|
923
|
|
|
|
|
|
|
$cc->setBearTraps (5, [ |
924
|
|
|
|
|
|
|
{ |
925
|
|
|
|
|
|
|
button => [ 5, 6 ], |
926
|
|
|
|
|
|
|
trap => [ 7, 8 ], |
927
|
|
|
|
|
|
|
}, |
928
|
|
|
|
|
|
|
{ |
929
|
|
|
|
|
|
|
button => [ 1, 2 ], |
930
|
|
|
|
|
|
|
trap => [ 3, 4 ], |
931
|
|
|
|
|
|
|
}, |
932
|
|
|
|
|
|
|
]); |
933
|
|
|
|
|
|
|
|
934
|
|
|
|
|
|
|
=cut |
935
|
|
|
|
|
|
|
|
936
|
|
|
|
|
|
|
sub setBearTraps { |
937
|
0
|
|
|
0
|
1
|
|
my ($self,$level,$traps) = @_; |
938
|
|
|
|
|
|
|
|
939
|
0
|
0
|
|
|
|
|
if (!defined $level) { |
940
|
0
|
|
|
|
|
|
$Error = "setBearTraps requires the level number!"; |
941
|
0
|
|
|
|
|
|
return undef; |
942
|
|
|
|
|
|
|
} |
943
|
0
|
|
|
|
|
|
$level = int($level); |
944
|
0
|
0
|
|
|
|
|
if (!exists $self->{levels}->{$level}) { |
945
|
0
|
|
|
|
|
|
$Error = "The level $level doesn't exist!"; |
946
|
0
|
|
|
|
|
|
return undef; |
947
|
|
|
|
|
|
|
} |
948
|
0
|
0
|
|
|
|
|
if (ref($traps) ne "ARRAY") { |
949
|
0
|
|
|
|
|
|
$Error = "Must pass an arrayref in for the traps!"; |
950
|
0
|
|
|
|
|
|
return undef; |
951
|
|
|
|
|
|
|
} |
952
|
|
|
|
|
|
|
|
953
|
|
|
|
|
|
|
# Validate the data. |
954
|
0
|
|
|
|
|
|
foreach my $trap (@{$traps}) { |
|
0
|
|
|
|
|
|
|
955
|
0
|
0
|
|
|
|
|
if (ref($trap) ne "HASH") { |
956
|
0
|
|
|
|
|
|
$Error = "Beartrap array must be an array of hashes!"; |
957
|
0
|
|
|
|
|
|
return undef; |
958
|
|
|
|
|
|
|
} |
959
|
0
|
0
|
0
|
|
|
|
if (!exists $trap->{button} || ref($trap->{button}) ne "ARRAY") { |
960
|
0
|
|
|
|
|
|
$Error = "The 'button' key in hashes must be an array!"; |
961
|
0
|
|
|
|
|
|
return undef; |
962
|
|
|
|
|
|
|
} |
963
|
0
|
0
|
0
|
|
|
|
if (!exists $trap->{trap} || ref($trap->{trap}) ne "ARRAY") { |
964
|
0
|
|
|
|
|
|
$Error = "The 'trap' key in hashes must be an array!"; |
965
|
0
|
|
|
|
|
|
return undef; |
966
|
|
|
|
|
|
|
} |
967
|
|
|
|
|
|
|
} |
968
|
|
|
|
|
|
|
|
969
|
0
|
|
|
|
|
|
$self->{levels}->{$level}->{traps} = $traps; |
970
|
0
|
|
|
|
|
|
return 1; |
971
|
|
|
|
|
|
|
} |
972
|
|
|
|
|
|
|
|
973
|
|
|
|
|
|
|
=head2 getCloneMachines (int LVL_NUMBER) |
974
|
|
|
|
|
|
|
|
975
|
|
|
|
|
|
|
Get all the coordinates to clone machines and the buttons that activate |
976
|
|
|
|
|
|
|
them. Returns an arrayref of hashrefs in the following format: |
977
|
|
|
|
|
|
|
|
978
|
|
|
|
|
|
|
[ |
979
|
|
|
|
|
|
|
{ |
980
|
|
|
|
|
|
|
button => [ X, Y ], |
981
|
|
|
|
|
|
|
clone => [ X, Y ], |
982
|
|
|
|
|
|
|
}, |
983
|
|
|
|
|
|
|
]; |
984
|
|
|
|
|
|
|
|
985
|
|
|
|
|
|
|
Where C are the coordinates of the tiles involves, beginning at |
986
|
|
|
|
|
|
|
C<0,0> and going to C<31,31>. |
987
|
|
|
|
|
|
|
|
988
|
|
|
|
|
|
|
=cut |
989
|
|
|
|
|
|
|
|
990
|
|
|
|
|
|
|
sub getCloneMachines { |
991
|
0
|
|
|
0
|
1
|
|
my ($self,$level) = @_; |
992
|
|
|
|
|
|
|
|
993
|
0
|
0
|
|
|
|
|
if (!defined $level) { |
994
|
0
|
|
|
|
|
|
$Error = "getCloneMachines requires the level number!"; |
995
|
0
|
|
|
|
|
|
return undef; |
996
|
|
|
|
|
|
|
} |
997
|
0
|
|
|
|
|
|
$level = int($level); |
998
|
0
|
0
|
|
|
|
|
if (!exists $self->{levels}->{$level}) { |
999
|
0
|
|
|
|
|
|
$Error = "The level $level doesn't exist!"; |
1000
|
0
|
|
|
|
|
|
return undef; |
1001
|
|
|
|
|
|
|
} |
1002
|
|
|
|
|
|
|
|
1003
|
0
|
|
|
|
|
|
return $self->{levels}->{$level}->{cloners}; |
1004
|
|
|
|
|
|
|
} |
1005
|
|
|
|
|
|
|
|
1006
|
|
|
|
|
|
|
=head2 setCloneMachines (int LVL_NUMBER, arrayref CLONE_MACHINES) |
1007
|
|
|
|
|
|
|
|
1008
|
|
|
|
|
|
|
Define the coordinates for the clone machines in this level. Pass in the |
1009
|
|
|
|
|
|
|
complete list of clone machines, as calling this function will replace |
1010
|
|
|
|
|
|
|
the existing clone machine data. |
1011
|
|
|
|
|
|
|
|
1012
|
|
|
|
|
|
|
Give it a data structure in the same format as getCloneMachines. Ex: |
1013
|
|
|
|
|
|
|
|
1014
|
|
|
|
|
|
|
$cc->setCloneMachines (113, [ |
1015
|
|
|
|
|
|
|
{ |
1016
|
|
|
|
|
|
|
button => [ 25, 13 ], |
1017
|
|
|
|
|
|
|
clone => [ 16, 32 ], |
1018
|
|
|
|
|
|
|
}, |
1019
|
|
|
|
|
|
|
]); |
1020
|
|
|
|
|
|
|
|
1021
|
|
|
|
|
|
|
=cut |
1022
|
|
|
|
|
|
|
|
1023
|
|
|
|
|
|
|
sub setCloneMachines { |
1024
|
0
|
|
|
0
|
1
|
|
my ($self,$level,$coords) = @_; |
1025
|
|
|
|
|
|
|
|
1026
|
0
|
0
|
|
|
|
|
if (!defined $level) { |
1027
|
0
|
|
|
|
|
|
$Error = "setCloneMachines requires the level number!"; |
1028
|
0
|
|
|
|
|
|
return undef; |
1029
|
|
|
|
|
|
|
} |
1030
|
0
|
|
|
|
|
|
$level = int($level); |
1031
|
0
|
0
|
|
|
|
|
if (!exists $self->{levels}->{$level}) { |
1032
|
0
|
|
|
|
|
|
$Error = "The level $level doesn't exist!"; |
1033
|
0
|
|
|
|
|
|
return undef; |
1034
|
|
|
|
|
|
|
} |
1035
|
0
|
0
|
|
|
|
|
if (ref($coords) ne "ARRAY") { |
1036
|
0
|
|
|
|
|
|
$Error = "Must pass an arrayref in for the clone machines!"; |
1037
|
0
|
|
|
|
|
|
return undef; |
1038
|
|
|
|
|
|
|
} |
1039
|
|
|
|
|
|
|
|
1040
|
|
|
|
|
|
|
# Validate the data. |
1041
|
0
|
|
|
|
|
|
foreach my $link (@{$coords}) { |
|
0
|
|
|
|
|
|
|
1042
|
0
|
0
|
|
|
|
|
if (ref($link) ne "HASH") { |
1043
|
0
|
|
|
|
|
|
$Error = "Clone machine array must be an array of hashes!"; |
1044
|
0
|
|
|
|
|
|
return undef; |
1045
|
|
|
|
|
|
|
} |
1046
|
0
|
0
|
0
|
|
|
|
if (!exists $link->{button} || ref($link->{button}) ne "ARRAY") { |
1047
|
0
|
|
|
|
|
|
$Error = "The 'button' key in hashes must be an array!"; |
1048
|
0
|
|
|
|
|
|
return undef; |
1049
|
|
|
|
|
|
|
} |
1050
|
0
|
0
|
0
|
|
|
|
if (!exists $link->{clone} || ref($link->{clone}) ne "ARRAY") { |
1051
|
0
|
|
|
|
|
|
$Error = "The 'clone' key in hashes must be an array!"; |
1052
|
0
|
|
|
|
|
|
return undef; |
1053
|
|
|
|
|
|
|
} |
1054
|
|
|
|
|
|
|
} |
1055
|
|
|
|
|
|
|
|
1056
|
0
|
|
|
|
|
|
$self->{levels}->{$level}->{cloners} = $coords; |
1057
|
0
|
|
|
|
|
|
return 1; |
1058
|
|
|
|
|
|
|
} |
1059
|
|
|
|
|
|
|
|
1060
|
|
|
|
|
|
|
=head2 getMovement (int LVL_NUMBER) |
1061
|
|
|
|
|
|
|
|
1062
|
|
|
|
|
|
|
Get all the coordinates of every creature in the level that "moves". |
1063
|
|
|
|
|
|
|
Returns an arrayref of coordinates in the following format: |
1064
|
|
|
|
|
|
|
|
1065
|
|
|
|
|
|
|
[ |
1066
|
|
|
|
|
|
|
[ X, Y ], |
1067
|
|
|
|
|
|
|
[ X, Y ], |
1068
|
|
|
|
|
|
|
... |
1069
|
|
|
|
|
|
|
]; |
1070
|
|
|
|
|
|
|
|
1071
|
|
|
|
|
|
|
=cut |
1072
|
|
|
|
|
|
|
|
1073
|
|
|
|
|
|
|
sub getMovement { |
1074
|
0
|
|
|
0
|
1
|
|
my ($self,$level) = @_; |
1075
|
|
|
|
|
|
|
|
1076
|
0
|
0
|
|
|
|
|
if (!defined $level) { |
1077
|
0
|
|
|
|
|
|
$Error = "getMovement requires the level number!"; |
1078
|
0
|
|
|
|
|
|
return undef; |
1079
|
|
|
|
|
|
|
} |
1080
|
0
|
|
|
|
|
|
$level = int($level); |
1081
|
0
|
0
|
|
|
|
|
if (!exists $self->{levels}->{$level}) { |
1082
|
0
|
|
|
|
|
|
$Error = "The level $level doesn't exist!"; |
1083
|
0
|
|
|
|
|
|
return undef; |
1084
|
|
|
|
|
|
|
} |
1085
|
|
|
|
|
|
|
|
1086
|
0
|
|
|
|
|
|
return $self->{levels}->{$level}->{movement}; |
1087
|
|
|
|
|
|
|
} |
1088
|
|
|
|
|
|
|
|
1089
|
|
|
|
|
|
|
=head2 setMovement (int LVL_NUMBER, arrayref MOVEMENT) |
1090
|
|
|
|
|
|
|
|
1091
|
|
|
|
|
|
|
Define the movement coordinates. Give this method a similar data structure |
1092
|
|
|
|
|
|
|
to what getMovement returns: an arrayref of arrays of X/Y coordinates. |
1093
|
|
|
|
|
|
|
|
1094
|
|
|
|
|
|
|
Each coordinate given should point to a tile where a creature has been placed |
1095
|
|
|
|
|
|
|
in order for that creature to move when the map is loaded in-game. Any creature |
1096
|
|
|
|
|
|
|
that doesn't have its position in the Movement list won't move at all and will |
1097
|
|
|
|
|
|
|
stay put. This isn't very fun. |
1098
|
|
|
|
|
|
|
|
1099
|
|
|
|
|
|
|
$cc->setMovement (133, [ |
1100
|
|
|
|
|
|
|
[ 25, 25 ], |
1101
|
|
|
|
|
|
|
[ 25, 26 ], |
1102
|
|
|
|
|
|
|
[ 25, 27 ], |
1103
|
|
|
|
|
|
|
]); |
1104
|
|
|
|
|
|
|
|
1105
|
|
|
|
|
|
|
=cut |
1106
|
|
|
|
|
|
|
|
1107
|
|
|
|
|
|
|
sub setMovement { |
1108
|
0
|
|
|
0
|
1
|
|
my ($self,$level,$coords) = @_; |
1109
|
|
|
|
|
|
|
|
1110
|
0
|
0
|
|
|
|
|
if (!defined $level) { |
1111
|
0
|
|
|
|
|
|
$Error = "setMovement requires the level number!"; |
1112
|
0
|
|
|
|
|
|
return undef; |
1113
|
|
|
|
|
|
|
} |
1114
|
0
|
|
|
|
|
|
$level = int($level); |
1115
|
0
|
0
|
|
|
|
|
if (!exists $self->{levels}->{$level}) { |
1116
|
0
|
|
|
|
|
|
$Error = "The level $level doesn't exist!"; |
1117
|
0
|
|
|
|
|
|
return undef; |
1118
|
|
|
|
|
|
|
} |
1119
|
0
|
0
|
|
|
|
|
if (ref($coords) ne "ARRAY") { |
1120
|
0
|
|
|
|
|
|
$Error = "Must pass an arrayref in for the clone machines!"; |
1121
|
0
|
|
|
|
|
|
return undef; |
1122
|
|
|
|
|
|
|
} |
1123
|
|
|
|
|
|
|
|
1124
|
|
|
|
|
|
|
# Validate the data. |
1125
|
0
|
|
|
|
|
|
foreach my $link (@{$coords}) { |
|
0
|
|
|
|
|
|
|
1126
|
0
|
0
|
|
|
|
|
if (ref($link) ne "ARRAY") { |
1127
|
0
|
|
|
|
|
|
$Error = "Clone machine array must be an array of hashes!"; |
1128
|
0
|
|
|
|
|
|
return undef; |
1129
|
|
|
|
|
|
|
} |
1130
|
0
|
0
|
|
|
|
|
if (scalar(@{$link}) != 2) { |
|
0
|
|
|
|
|
|
|
1131
|
0
|
|
|
|
|
|
$Error = "Each coordinate pair must have only an X and Y coordinate!"; |
1132
|
0
|
|
|
|
|
|
return undef; |
1133
|
|
|
|
|
|
|
} |
1134
|
|
|
|
|
|
|
} |
1135
|
|
|
|
|
|
|
|
1136
|
0
|
|
|
|
|
|
$self->{levels}->{$level}->{movement} = $coords; |
1137
|
0
|
|
|
|
|
|
return 1; |
1138
|
|
|
|
|
|
|
} |
1139
|
|
|
|
|
|
|
|
1140
|
|
|
|
|
|
|
=head1 INTERNAL METHODS |
1141
|
|
|
|
|
|
|
|
1142
|
|
|
|
|
|
|
=head2 process_map (int LVL_NUMBER, bin RAW_BINARY) *Internal |
1143
|
|
|
|
|
|
|
|
1144
|
|
|
|
|
|
|
Used internally to process the C map data, which possibly belongs to |
1145
|
|
|
|
|
|
|
C, and returns a 2D array of the 32x32 tile grid. The grid consists |
1146
|
|
|
|
|
|
|
of uppercase hexadecimal bytes that represent what is on each tile. |
1147
|
|
|
|
|
|
|
|
1148
|
|
|
|
|
|
|
If the length of C is not 1024 bytes, your program WILL crash. This |
1149
|
|
|
|
|
|
|
shouldn't happen on a valid CHIPS.DAT file (if Chip's Challenge won't accept it, |
1150
|
|
|
|
|
|
|
that's an indicator that this Perl module won't either). |
1151
|
|
|
|
|
|
|
|
1152
|
|
|
|
|
|
|
=cut |
1153
|
|
|
|
|
|
|
|
1154
|
|
|
|
|
|
|
sub process_map { |
1155
|
0
|
|
|
0
|
1
|
|
my ($self,$lvl_number,$layer) = @_; |
1156
|
|
|
|
|
|
|
|
1157
|
|
|
|
|
|
|
# Prepare an arrayref to hold the raw data. |
1158
|
0
|
|
|
|
|
|
my $raw = []; |
1159
|
|
|
|
|
|
|
|
1160
|
|
|
|
|
|
|
# Read the map data one byte at a time. |
1161
|
0
|
|
|
|
|
|
my @bytes = split(//, $layer); |
1162
|
0
|
|
|
|
|
|
for (my $i = 0; $i < scalar(@bytes); $i++) { |
1163
|
0
|
|
|
|
|
|
my $byte = $bytes[$i]; |
1164
|
|
|
|
|
|
|
|
1165
|
|
|
|
|
|
|
# See what number this byte corresponds to. |
1166
|
0
|
|
|
|
|
|
my $dec = unpack("C", $byte); |
1167
|
0
|
|
|
|
|
|
my $hex = uc(sprintf("%02x",$dec)); |
1168
|
|
|
|
|
|
|
|
1169
|
|
|
|
|
|
|
# print "Byte: $hex\n"; |
1170
|
|
|
|
|
|
|
|
1171
|
|
|
|
|
|
|
# If this is an FF byte, it's a compression byte, so expand it. |
1172
|
0
|
0
|
|
|
|
|
if ($hex eq 'FF') { |
1173
|
|
|
|
|
|
|
# Read the following 2 bytes. |
1174
|
0
|
|
|
|
|
|
my $copies_byte = $bytes[$i + 1]; |
1175
|
0
|
|
|
|
|
|
my $object_byte = $bytes[$i + 2]; |
1176
|
0
|
|
|
|
|
|
$i += 2; |
1177
|
|
|
|
|
|
|
|
1178
|
|
|
|
|
|
|
# Unpack the bytes. |
1179
|
0
|
|
|
|
|
|
my $copies_dec = unpack("C",$copies_byte); |
1180
|
0
|
|
|
|
|
|
my $object_dec = unpack("C",$object_byte); |
1181
|
0
|
|
|
|
|
|
my $object_hex = uc(sprintf("%02x",$object_dec)); |
1182
|
|
|
|
|
|
|
|
1183
|
0
|
|
|
|
|
|
my $deb1 = uc(sprintf("%02x",$copies_dec)); |
1184
|
|
|
|
|
|
|
# print "This is an FF byte: copy byte $object_hex by $copies_dec times\n"; |
1185
|
|
|
|
|
|
|
|
1186
|
|
|
|
|
|
|
# Add it to the array this many times. |
1187
|
0
|
|
|
|
|
|
for (my $j = 0; $j < $copies_dec; $j++) { |
1188
|
0
|
|
|
|
|
|
push (@{$raw}, $object_hex); |
|
0
|
|
|
|
|
|
|
1189
|
|
|
|
|
|
|
} |
1190
|
|
|
|
|
|
|
} |
1191
|
|
|
|
|
|
|
else { |
1192
|
|
|
|
|
|
|
# Add it to the array. |
1193
|
0
|
|
|
|
|
|
push (@{$raw}, $hex); |
|
0
|
|
|
|
|
|
|
1194
|
|
|
|
|
|
|
} |
1195
|
|
|
|
|
|
|
} |
1196
|
|
|
|
|
|
|
|
1197
|
|
|
|
|
|
|
# We should have 1024 elements. |
1198
|
0
|
0
|
|
|
|
|
if (scalar(@{$raw}) != 1024) { |
|
0
|
|
|
|
|
|
|
1199
|
0
|
|
|
|
|
|
die "Data for level $lvl_number doesn't have a complete 32x32 grid! It has " . scalar(@{$raw}) . " bytes!"; |
|
0
|
|
|
|
|
|
|
1200
|
|
|
|
|
|
|
} |
1201
|
|
|
|
|
|
|
|
1202
|
|
|
|
|
|
|
# Turn it into a 2D array. |
1203
|
0
|
|
|
|
|
|
my $grid = []; |
1204
|
0
|
|
|
|
|
|
my $x = 0; |
1205
|
0
|
|
|
|
|
|
my $y = 0; |
1206
|
0
|
|
|
|
|
|
for (my $i = 0; $i < scalar(@{$raw}); $i++) { |
|
0
|
|
|
|
|
|
|
1207
|
0
|
0
|
|
|
|
|
if ($x > scalar @{$grid}) { |
|
0
|
|
|
|
|
|
|
1208
|
0
|
|
|
|
|
|
push (@{$grid}, []); |
|
0
|
|
|
|
|
|
|
1209
|
|
|
|
|
|
|
} |
1210
|
|
|
|
|
|
|
|
1211
|
|
|
|
|
|
|
# print "$raw->[$i] "; |
1212
|
0
|
|
|
|
|
|
$grid->[$y]->[$x] = $raw->[$i]; |
1213
|
0
|
|
|
|
|
|
$x++; |
1214
|
0
|
0
|
|
|
|
|
if ($x >= 32) { |
1215
|
|
|
|
|
|
|
# print "\n"; |
1216
|
0
|
|
|
|
|
|
$x = 0; |
1217
|
0
|
|
|
|
|
|
$y++; |
1218
|
|
|
|
|
|
|
} |
1219
|
|
|
|
|
|
|
} |
1220
|
|
|
|
|
|
|
|
1221
|
|
|
|
|
|
|
#die Dumper($grid); |
1222
|
|
|
|
|
|
|
|
1223
|
0
|
|
|
|
|
|
return $grid; |
1224
|
|
|
|
|
|
|
} |
1225
|
|
|
|
|
|
|
|
1226
|
|
|
|
|
|
|
=head2 compress_map (grid MAP_DATA) |
1227
|
|
|
|
|
|
|
|
1228
|
|
|
|
|
|
|
Given the 2D grid C, the map is compressed and returned in raw binary. |
1229
|
|
|
|
|
|
|
|
1230
|
|
|
|
|
|
|
=cut |
1231
|
|
|
|
|
|
|
|
1232
|
|
|
|
|
|
|
sub compress_map { |
1233
|
0
|
|
|
0
|
1
|
|
my ($self,$data) = @_; |
1234
|
|
|
|
|
|
|
|
1235
|
|
|
|
|
|
|
# Turn this 2D array into a flat array of binary tiles. |
1236
|
0
|
|
|
|
|
|
my @flat = (); |
1237
|
0
|
|
|
|
|
|
foreach my $row (@{$data}) { |
|
0
|
|
|
|
|
|
|
1238
|
0
|
|
|
|
|
|
foreach my $col (@{$row}) { |
|
0
|
|
|
|
|
|
|
1239
|
|
|
|
|
|
|
# Turn this tile into binary. |
1240
|
0
|
|
|
|
|
|
my $bin = pack("C", hex("0x$col")); |
1241
|
0
|
|
|
|
|
|
push (@flat,$bin); |
1242
|
|
|
|
|
|
|
} |
1243
|
|
|
|
|
|
|
} |
1244
|
|
|
|
|
|
|
|
1245
|
|
|
|
|
|
|
# Invalid? |
1246
|
0
|
0
|
|
|
|
|
if (scalar(@flat) != 1024) { |
1247
|
0
|
|
|
|
|
|
$Error = "Invalid map data given to compress_map: doesn't have 1024 tiles!"; |
1248
|
0
|
|
|
|
|
|
return undef; |
1249
|
|
|
|
|
|
|
} |
1250
|
|
|
|
|
|
|
|
1251
|
|
|
|
|
|
|
# Compress the map. |
1252
|
0
|
|
|
|
|
|
my @compressed = (); |
1253
|
0
|
|
|
|
|
|
my $ff = pack("C", 0xFF); # The compression indicator |
1254
|
|
|
|
|
|
|
# my $x = 0; |
1255
|
|
|
|
|
|
|
# for (my $i = 0; $i < scalar(@flat); $i++) { |
1256
|
|
|
|
|
|
|
# $x++; |
1257
|
|
|
|
|
|
|
# my $deb = sprintf("%02x", unpack("C", $flat[$i])); |
1258
|
|
|
|
|
|
|
# print "$deb "; |
1259
|
|
|
|
|
|
|
# print "\n" if $x >= 32; |
1260
|
|
|
|
|
|
|
# $x = 0 if $x >= 32; |
1261
|
|
|
|
|
|
|
# } |
1262
|
|
|
|
|
|
|
# print "\n"; |
1263
|
|
|
|
|
|
|
|
1264
|
0
|
|
|
|
|
|
my $i = 0; |
1265
|
0
|
|
|
|
|
|
while ($i < 1024) { |
1266
|
0
|
|
|
|
|
|
my $byte = $flat[$i]; |
1267
|
|
|
|
|
|
|
|
1268
|
0
|
|
|
|
|
|
my $deb1 = sprintf("%02x", unpack("C", $byte)); |
1269
|
|
|
|
|
|
|
# print "Byte: $deb1\n"; |
1270
|
|
|
|
|
|
|
|
1271
|
|
|
|
|
|
|
# See if the next 5 bytes are the same. |
1272
|
0
|
|
|
|
|
|
my $copies = 0; |
1273
|
0
|
|
|
|
|
|
for (my $j = 0; ($i + $j) < scalar(@flat); $j++) { |
1274
|
0
|
|
|
|
|
|
my $compare = $flat[$i + $j]; |
1275
|
0
|
0
|
|
|
|
|
if ($byte eq $compare) { |
1276
|
|
|
|
|
|
|
# print "Byte $i matches byte " . ($i+$j) . "\n"; |
1277
|
0
|
|
|
|
|
|
$copies++; |
1278
|
0
|
0
|
|
|
|
|
last if $copies >= 255; |
1279
|
|
|
|
|
|
|
} |
1280
|
|
|
|
|
|
|
else { |
1281
|
0
|
|
|
|
|
|
last; |
1282
|
|
|
|
|
|
|
} |
1283
|
|
|
|
|
|
|
} |
1284
|
|
|
|
|
|
|
|
1285
|
|
|
|
|
|
|
# Can we compress this? |
1286
|
0
|
0
|
|
|
|
|
if ($copies >= 4) { |
1287
|
|
|
|
|
|
|
# Yes! See how many copies there are exactly. |
1288
|
|
|
|
|
|
|
# print "Compress byte $deb1 by $copies times\n"; |
1289
|
0
|
|
|
|
|
|
$i += $copies; |
1290
|
0
|
|
|
|
|
|
my $len = pack("C", $copies); |
1291
|
0
|
|
|
|
|
|
push (@compressed, |
1292
|
|
|
|
|
|
|
$ff, |
1293
|
|
|
|
|
|
|
$len, |
1294
|
|
|
|
|
|
|
$byte, |
1295
|
|
|
|
|
|
|
); |
1296
|
|
|
|
|
|
|
} |
1297
|
|
|
|
|
|
|
else { |
1298
|
0
|
|
|
|
|
|
$i++; |
1299
|
0
|
|
|
|
|
|
push (@compressed, $byte); |
1300
|
|
|
|
|
|
|
} |
1301
|
|
|
|
|
|
|
} |
1302
|
|
|
|
|
|
|
|
1303
|
|
|
|
|
|
|
# Return the compressed binary. |
1304
|
0
|
|
|
|
|
|
my $bin = join("",@compressed); |
1305
|
0
|
|
|
|
|
|
return $bin; |
1306
|
|
|
|
|
|
|
} |
1307
|
|
|
|
|
|
|
|
1308
|
|
|
|
|
|
|
=head2 decode_password (bin RAW_BINARY) |
1309
|
|
|
|
|
|
|
|
1310
|
|
|
|
|
|
|
Given the encoded level password in raw binary (4 bytes followed by a null byte), |
1311
|
|
|
|
|
|
|
this function returns the 4 ASCII byte password in clear text. This is the password |
1312
|
|
|
|
|
|
|
you'd type into Chip's Challenge. |
1313
|
|
|
|
|
|
|
|
1314
|
|
|
|
|
|
|
Passwords are decoded by XORing the values in the raw binary by hex C<0x99>, |
1315
|
|
|
|
|
|
|
if you're curious. |
1316
|
|
|
|
|
|
|
|
1317
|
|
|
|
|
|
|
=cut |
1318
|
|
|
|
|
|
|
|
1319
|
|
|
|
|
|
|
sub decode_password { |
1320
|
0
|
|
|
0
|
1
|
|
my ($self,$data) = @_; |
1321
|
|
|
|
|
|
|
|
1322
|
0
|
|
|
|
|
|
my @chars = split(//, $data, 5); |
1323
|
|
|
|
|
|
|
|
1324
|
|
|
|
|
|
|
# Decode each character. |
1325
|
0
|
|
|
|
|
|
my $pass = ''; |
1326
|
0
|
|
|
|
|
|
for (my $i = 0; $i < 4; $i++) { |
1327
|
0
|
|
|
|
|
|
my $dec = unpack("C",$chars[$i]); |
1328
|
0
|
|
|
|
|
|
my $hex = uc(sprintf("%02x",$dec)); |
1329
|
|
|
|
|
|
|
|
1330
|
|
|
|
|
|
|
# Decode it with XOR 0x99 |
1331
|
0
|
|
|
|
|
|
my $xor = $dec ^ 0x99; |
1332
|
0
|
|
|
|
|
|
my $chr = chr($xor); |
1333
|
0
|
|
|
|
|
|
$pass .= $chr; |
1334
|
|
|
|
|
|
|
} |
1335
|
|
|
|
|
|
|
|
1336
|
0
|
|
|
|
|
|
return $pass; |
1337
|
|
|
|
|
|
|
} |
1338
|
|
|
|
|
|
|
|
1339
|
|
|
|
|
|
|
=head2 encode_password (string PASSWORD) |
1340
|
|
|
|
|
|
|
|
1341
|
|
|
|
|
|
|
Given the plain text password C, it encodes it and returns it as |
1342
|
|
|
|
|
|
|
a 5 byte binary string (including the trailing null byte). |
1343
|
|
|
|
|
|
|
|
1344
|
|
|
|
|
|
|
=cut |
1345
|
|
|
|
|
|
|
|
1346
|
|
|
|
|
|
|
sub encode_password { |
1347
|
0
|
|
|
0
|
1
|
|
my ($self,$pass) = @_; |
1348
|
|
|
|
|
|
|
|
1349
|
0
|
|
|
|
|
|
my @chars = split(//, $pass, 4); |
1350
|
|
|
|
|
|
|
|
1351
|
|
|
|
|
|
|
# Encode each character. |
1352
|
0
|
|
|
|
|
|
my $bin = ''; |
1353
|
0
|
|
|
|
|
|
for (my $i = 0; $i < 4; $i++) { |
1354
|
0
|
|
|
|
|
|
my $dec = unpack("C", $chars[$i]); |
1355
|
0
|
|
|
|
|
|
my $hex = sprintf("%02x",$dec); |
1356
|
|
|
|
|
|
|
|
1357
|
|
|
|
|
|
|
# XOR it with 0x99 |
1358
|
0
|
|
|
|
|
|
my $xor = hex("0x$hex") ^ 0x99; |
1359
|
0
|
|
|
|
|
|
$bin .= pack("C",$xor); |
1360
|
|
|
|
|
|
|
} |
1361
|
0
|
|
|
|
|
|
$bin .= chr(0x00); |
1362
|
|
|
|
|
|
|
|
1363
|
|
|
|
|
|
|
# try... |
1364
|
0
|
|
|
|
|
|
my $plain = $self->decode_password($bin); |
1365
|
|
|
|
|
|
|
|
1366
|
0
|
|
|
|
|
|
return $bin; |
1367
|
|
|
|
|
|
|
} |
1368
|
|
|
|
|
|
|
|
1369
|
|
|
|
|
|
|
=head2 random_password |
1370
|
|
|
|
|
|
|
|
1371
|
|
|
|
|
|
|
Returns a random 4-letter password. |
1372
|
|
|
|
|
|
|
|
1373
|
|
|
|
|
|
|
=cut |
1374
|
|
|
|
|
|
|
|
1375
|
|
|
|
|
|
|
sub random_password { |
1376
|
0
|
|
|
0
|
1
|
|
my ($self) = @_; |
1377
|
|
|
|
|
|
|
|
1378
|
0
|
|
|
|
|
|
my @letters = qw(A B C D E F G H I J K L M N O P Q R S T U V W X Y Z); |
1379
|
0
|
|
|
|
|
|
my $pass = ''; |
1380
|
0
|
|
|
|
|
|
for (my $i = 0; $i < 4; $i++) { |
1381
|
0
|
|
|
|
|
|
$pass .= $letters [ int(rand(scalar(@letters))) ]; |
1382
|
|
|
|
|
|
|
} |
1383
|
|
|
|
|
|
|
|
1384
|
0
|
|
|
|
|
|
return $pass; |
1385
|
|
|
|
|
|
|
} |
1386
|
|
|
|
|
|
|
|
1387
|
|
|
|
|
|
|
=head1 REFERENCE |
1388
|
|
|
|
|
|
|
|
1389
|
|
|
|
|
|
|
The following is some reference material relating to certain in-game data |
1390
|
|
|
|
|
|
|
structures. |
1391
|
|
|
|
|
|
|
|
1392
|
|
|
|
|
|
|
=head2 Option Fields Max Length |
1393
|
|
|
|
|
|
|
|
1394
|
|
|
|
|
|
|
If the "Option Fields" are more than 1152 bytes altogether, Chip's Challenge |
1395
|
|
|
|
|
|
|
will crash when loading the level. The "Option Fields" include the following: |
1396
|
|
|
|
|
|
|
|
1397
|
|
|
|
|
|
|
Map Title |
1398
|
|
|
|
|
|
|
Bear Trap Controls |
1399
|
|
|
|
|
|
|
Cloning Machine Controls |
1400
|
|
|
|
|
|
|
Map Password |
1401
|
|
|
|
|
|
|
Map Hint |
1402
|
|
|
|
|
|
|
Movement |
1403
|
|
|
|
|
|
|
|
1404
|
|
|
|
|
|
|
Bear Trap Controls use 10 bytes for every link. Cloning Machine Controls use |
1405
|
|
|
|
|
|
|
8 bytes for every link. Map passwords use 7 bytes. Movement data uses 2 bytes |
1406
|
|
|
|
|
|
|
per entry. |
1407
|
|
|
|
|
|
|
|
1408
|
|
|
|
|
|
|
In addition, bear traps, clone machines, and movement data use 2 bytes in |
1409
|
|
|
|
|
|
|
their headers. |
1410
|
|
|
|
|
|
|
|
1411
|
|
|
|
|
|
|
=head2 Object Hex Codes |
1412
|
|
|
|
|
|
|
|
1413
|
|
|
|
|
|
|
The two map layers on each level are 2D arrays of uppercase hexadecimal codes. Each of |
1414
|
|
|
|
|
|
|
these codes corresponds to a certain object that is placed at that location in the map. |
1415
|
|
|
|
|
|
|
This table outlines what each of these hex codes translates to, object-wise: |
1416
|
|
|
|
|
|
|
|
1417
|
|
|
|
|
|
|
00 Empty Tile (Space) |
1418
|
|
|
|
|
|
|
01 Wall |
1419
|
|
|
|
|
|
|
02 Computer Chip |
1420
|
|
|
|
|
|
|
03 Water |
1421
|
|
|
|
|
|
|
04 Fire |
1422
|
|
|
|
|
|
|
05 Invisible Wall (won't appear) |
1423
|
|
|
|
|
|
|
06 Blocked North |
1424
|
|
|
|
|
|
|
07 Blocked West |
1425
|
|
|
|
|
|
|
08 Blocked South |
1426
|
|
|
|
|
|
|
09 Blocked East |
1427
|
|
|
|
|
|
|
0A Movable Dirt Block |
1428
|
|
|
|
|
|
|
0B Dirt (mud, turns to floor) |
1429
|
|
|
|
|
|
|
0C Ice |
1430
|
|
|
|
|
|
|
0D Force South (S) |
1431
|
|
|
|
|
|
|
0E Cloning Block North (N) |
1432
|
|
|
|
|
|
|
0F Cloning Block West (W) |
1433
|
|
|
|
|
|
|
10 Cloning Block South (S) |
1434
|
|
|
|
|
|
|
11 Cloning Block East (E) |
1435
|
|
|
|
|
|
|
12 Force North (N) |
1436
|
|
|
|
|
|
|
13 Force East (E) |
1437
|
|
|
|
|
|
|
14 Force West (W) |
1438
|
|
|
|
|
|
|
15 Exit |
1439
|
|
|
|
|
|
|
16 Blue Door |
1440
|
|
|
|
|
|
|
17 Red Door |
1441
|
|
|
|
|
|
|
18 Green Door |
1442
|
|
|
|
|
|
|
19 Yellow Door |
1443
|
|
|
|
|
|
|
1A South/East Ice Slide |
1444
|
|
|
|
|
|
|
1B South/West Ice Slide |
1445
|
|
|
|
|
|
|
1C North/West Ice Slide |
1446
|
|
|
|
|
|
|
1D North/East Ice Slide |
1447
|
|
|
|
|
|
|
1E Blue Block (becomes Tile) |
1448
|
|
|
|
|
|
|
1F Blue Block (becomes Wall) |
1449
|
|
|
|
|
|
|
20 NOT USED |
1450
|
|
|
|
|
|
|
21 Thief |
1451
|
|
|
|
|
|
|
22 Chip Socket |
1452
|
|
|
|
|
|
|
23 Green Button - Switch Blocks |
1453
|
|
|
|
|
|
|
24 Red Button - Cloning |
1454
|
|
|
|
|
|
|
25 Switch Block - Closed |
1455
|
|
|
|
|
|
|
26 Switch Block - Open |
1456
|
|
|
|
|
|
|
27 Brown Button - Bear Traps |
1457
|
|
|
|
|
|
|
28 Blue Button - Tanks |
1458
|
|
|
|
|
|
|
29 Teleport |
1459
|
|
|
|
|
|
|
2A Bomb |
1460
|
|
|
|
|
|
|
2B Bear Trap |
1461
|
|
|
|
|
|
|
2C Invisible Wall (will appear) |
1462
|
|
|
|
|
|
|
2D Gravel |
1463
|
|
|
|
|
|
|
2E Pass Once |
1464
|
|
|
|
|
|
|
2F Hint |
1465
|
|
|
|
|
|
|
30 Blocked South/East |
1466
|
|
|
|
|
|
|
31 Cloning Machine |
1467
|
|
|
|
|
|
|
32 Force Random Direction |
1468
|
|
|
|
|
|
|
34 Burned Chip |
1469
|
|
|
|
|
|
|
35 Burned Chip (2) |
1470
|
|
|
|
|
|
|
36 NOT USED |
1471
|
|
|
|
|
|
|
37 NOT USED |
1472
|
|
|
|
|
|
|
38 NOT USED |
1473
|
|
|
|
|
|
|
39 Chip in Exit - End Game |
1474
|
|
|
|
|
|
|
3A Exit - End Game |
1475
|
|
|
|
|
|
|
3B Exit - End Game |
1476
|
|
|
|
|
|
|
3C Chip Swimming (N) |
1477
|
|
|
|
|
|
|
3D Chip Swimming (W) |
1478
|
|
|
|
|
|
|
3E Chip Swimming (S) |
1479
|
|
|
|
|
|
|
3F Chip Swimming (E) |
1480
|
|
|
|
|
|
|
40 Bug (N) |
1481
|
|
|
|
|
|
|
41 Bug (W) |
1482
|
|
|
|
|
|
|
42 Bug (S) |
1483
|
|
|
|
|
|
|
43 Bug (E) |
1484
|
|
|
|
|
|
|
44 Firebug (N) |
1485
|
|
|
|
|
|
|
45 Firebug (W) |
1486
|
|
|
|
|
|
|
46 Firebug (S) |
1487
|
|
|
|
|
|
|
47 Firebug (E) |
1488
|
|
|
|
|
|
|
48 Pink Ball (N) |
1489
|
|
|
|
|
|
|
49 Pink Ball (W) |
1490
|
|
|
|
|
|
|
4A Pink Ball (S) |
1491
|
|
|
|
|
|
|
4B Pink Ball (E) |
1492
|
|
|
|
|
|
|
4C Tank (N) |
1493
|
|
|
|
|
|
|
4D Tank (W) |
1494
|
|
|
|
|
|
|
4E Tank (S) |
1495
|
|
|
|
|
|
|
4F Tank (E) |
1496
|
|
|
|
|
|
|
50 Ghost (N) |
1497
|
|
|
|
|
|
|
51 Ghost (W) |
1498
|
|
|
|
|
|
|
52 Ghost (S) |
1499
|
|
|
|
|
|
|
53 Ghost (E) |
1500
|
|
|
|
|
|
|
54 Frog (N) |
1501
|
|
|
|
|
|
|
55 Frog (W) |
1502
|
|
|
|
|
|
|
56 Frog (S) |
1503
|
|
|
|
|
|
|
57 Frog (E) |
1504
|
|
|
|
|
|
|
58 Dumbbell (N) |
1505
|
|
|
|
|
|
|
59 Dumbbell (W) |
1506
|
|
|
|
|
|
|
5A Dumbbell (S) |
1507
|
|
|
|
|
|
|
5B Dumbbell (E) |
1508
|
|
|
|
|
|
|
5C Blob (N) |
1509
|
|
|
|
|
|
|
5D Blob (W) |
1510
|
|
|
|
|
|
|
5E Blob (S) |
1511
|
|
|
|
|
|
|
5F Blob (E) |
1512
|
|
|
|
|
|
|
60 Centipede (N) |
1513
|
|
|
|
|
|
|
61 Centipede (W) |
1514
|
|
|
|
|
|
|
62 Centipede (S) |
1515
|
|
|
|
|
|
|
63 Centipede (E) |
1516
|
|
|
|
|
|
|
64 Blue Key |
1517
|
|
|
|
|
|
|
65 Red Key |
1518
|
|
|
|
|
|
|
66 Green Key |
1519
|
|
|
|
|
|
|
67 Yellow Key |
1520
|
|
|
|
|
|
|
68 Flippers |
1521
|
|
|
|
|
|
|
69 Fire Boots |
1522
|
|
|
|
|
|
|
6A Ice Skates |
1523
|
|
|
|
|
|
|
6B Suction Boots |
1524
|
|
|
|
|
|
|
6C Chip (N) |
1525
|
|
|
|
|
|
|
6D Chip (W) |
1526
|
|
|
|
|
|
|
6E Chip (S) (always used) |
1527
|
|
|
|
|
|
|
6F Chip (E) |
1528
|
|
|
|
|
|
|
|
1529
|
|
|
|
|
|
|
=head1 BUGS |
1530
|
|
|
|
|
|
|
|
1531
|
|
|
|
|
|
|
Surely. |
1532
|
|
|
|
|
|
|
|
1533
|
|
|
|
|
|
|
During its development, this module was used by its author and could accomplish |
1534
|
|
|
|
|
|
|
the following things: |
1535
|
|
|
|
|
|
|
|
1536
|
|
|
|
|
|
|
* Load all 149 levels of the standard CHIPS.DAT, then plow through the data |
1537
|
|
|
|
|
|
|
and create JavaScript files that represented the information in each map |
1538
|
|
|
|
|
|
|
using JavaScript data structures (possibly for a JavaScript-based Chip's |
1539
|
|
|
|
|
|
|
Challenge clone -- although I won't admit to it until it's completed!) |
1540
|
|
|
|
|
|
|
|
1541
|
|
|
|
|
|
|
* Load the original CHIPS.DAT, create a new blank CHIPS.DAT with the same |
1542
|
|
|
|
|
|
|
number of levels, and randomly sort the levels into the new file. You get |
1543
|
|
|
|
|
|
|
the same Chip's Challenge gameplay experience, but with completely random |
1544
|
|
|
|
|
|
|
levels like ya don't remember. |
1545
|
|
|
|
|
|
|
|
1546
|
|
|
|
|
|
|
* Load the original CHIPS.DAT into memory, and write it to a different |
1547
|
|
|
|
|
|
|
output file, and both files computed the exact same MD5 sum. |
1548
|
|
|
|
|
|
|
|
1549
|
|
|
|
|
|
|
Your mileage may vary. If you do encounter any bugs, feel free to bother me |
1550
|
|
|
|
|
|
|
about them! |
1551
|
|
|
|
|
|
|
|
1552
|
|
|
|
|
|
|
=head1 CHANGES |
1553
|
|
|
|
|
|
|
|
1554
|
|
|
|
|
|
|
0.02 Wed Oct 5 2016 |
1555
|
|
|
|
|
|
|
- Updated the documentation, added a copy of the CHIPS.DAT format docs, |
1556
|
|
|
|
|
|
|
started hosting on GitHub: https://github.com/kirsle/Data-ChipsChallenge |
1557
|
|
|
|
|
|
|
- Switched to semantic versioning. |
1558
|
|
|
|
|
|
|
|
1559
|
|
|
|
|
|
|
0.01 Wed Jan 28 2009 |
1560
|
|
|
|
|
|
|
- Initial release. |
1561
|
|
|
|
|
|
|
|
1562
|
|
|
|
|
|
|
=head1 SEE ALSO |
1563
|
|
|
|
|
|
|
|
1564
|
|
|
|
|
|
|
CHIPS.DAT File Format: http://www.seasip.info/ccfile.html |
1565
|
|
|
|
|
|
|
|
1566
|
|
|
|
|
|
|
Chip's Challenge Corridor: http://chips.kaseorg.com/ |
1567
|
|
|
|
|
|
|
|
1568
|
|
|
|
|
|
|
Tile World, an Open Source Chip's Challenge Emulator: |
1569
|
|
|
|
|
|
|
http://www.muppetlabs.com/~breadbox/software/tworld/ |
1570
|
|
|
|
|
|
|
|
1571
|
|
|
|
|
|
|
=head1 LICENSE |
1572
|
|
|
|
|
|
|
|
1573
|
|
|
|
|
|
|
This module was written using information freely available on the Internet and |
1574
|
|
|
|
|
|
|
contains no proprietary works. |
1575
|
|
|
|
|
|
|
|
1576
|
|
|
|
|
|
|
The MIT License (MIT) |
1577
|
|
|
|
|
|
|
|
1578
|
|
|
|
|
|
|
Copyright (c) 2016 Noah Petherbridge |
1579
|
|
|
|
|
|
|
|
1580
|
|
|
|
|
|
|
Permission is hereby granted, free of charge, to any person obtaining a copy |
1581
|
|
|
|
|
|
|
of this software and associated documentation files (the "Software"), to deal |
1582
|
|
|
|
|
|
|
in the Software without restriction, including without limitation the rights |
1583
|
|
|
|
|
|
|
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell |
1584
|
|
|
|
|
|
|
copies of the Software, and to permit persons to whom the Software is |
1585
|
|
|
|
|
|
|
furnished to do so, subject to the following conditions: |
1586
|
|
|
|
|
|
|
|
1587
|
|
|
|
|
|
|
The above copyright notice and this permission notice shall be included in all |
1588
|
|
|
|
|
|
|
copies or substantial portions of the Software. |
1589
|
|
|
|
|
|
|
|
1590
|
|
|
|
|
|
|
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR |
1591
|
|
|
|
|
|
|
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, |
1592
|
|
|
|
|
|
|
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE |
1593
|
|
|
|
|
|
|
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER |
1594
|
|
|
|
|
|
|
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, |
1595
|
|
|
|
|
|
|
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE |
1596
|
|
|
|
|
|
|
SOFTWARE. |
1597
|
|
|
|
|
|
|
|
1598
|
|
|
|
|
|
|
=head1 AUTHOR |
1599
|
|
|
|
|
|
|
|
1600
|
|
|
|
|
|
|
Noah Petherbridge, https://www.kirsle.net/ |
1601
|
|
|
|
|
|
|
|
1602
|
|
|
|
|
|
|
=cut |
1603
|
|
|
|
|
|
|
|
1604
|
|
|
|
|
|
|
# Nothing to see down here! |
1605
|
|
|
|
|
|
|
1; |