module
24
One tested answer to each exercise. There are other right answers: if yours does what the exercise asks, it is right.
3.1
program Chop;
type
Str20 = string[20];
var
S: Str20;
procedure Trim(var S: Str20);
begin
while (Length(S) > 0) and
(S[Length(S)] = ' ') do
S[0] := Pred(S[0]);
end;
begin
S := 'LAMP ';
Writeln('[', S, '] ', Length(S));
Trim(S);
Writeln('[', S, '] ', Length(S));
end.
What you should see:
[LAMP ] 9
[LAMP] 4
3.2
program Back;
var
S: string[20];
I: Integer;
begin
S := 'LANTERN';
for I := Length(S) downto 1 do
Write(S[I]);
Writeln;
end.
What you should see:
NRETNAL
3.3
program Rooms;
var
Names: array[1..50] of string[30];
begin
Writeln('One name: ',
SizeOf(Names[1]), ' bytes');
Writeln('All fifty: ',
SizeOf(Names), ' bytes');
end.
What you should see:
One name: 31 bytes
All fifty: 1550 bytes
4.1 Start from TWOWAYS, the section's program.
Change:
else if (Ch in [' '..'Z'])
to:
else if (Ch in [' ', 'A'..'Z'])
What you should see:
Readln> SKIP
[SKIP]
GetLine> GO NORTH
[GO NORTH]
4.2 Start from TWOWAYS, the section's program.
After the line
end
add:
else if Ch = #24 then
while Length(S) > 0 do
begin
Write(#8, ' ', #8);
S[0] := Pred(S[0]);
end
What you should see:
Readln> SKIP
[SKIP]
GetLine> LOOK
[LOOK]
4.3 Start from TWOWAYS, the section's program.
Take out:
type
Str30 = string[30];
Change:
Line: Str30;
procedure GetLine(var S: Str30);
var
Ch: Char;
to:
Line: string[30];
Change:
S := '';
repeat
Read(Kbd, Ch);
Ch := UpCase(Ch);
if (Ch in [#8, #25])
and (Length(S) > 0) then
begin
Write(#8, ' ', #8);
S[0] := Pred(S[0]);
end
else if (Ch in [' '..'Z'])
and (Length(S) < 30) then
begin
Write(Ch);
S := S + Ch;
end;
until Ch = #13;
Writeln;
end;
begin
Write('Readln> ');
to:
Write('Command> ');
BufLen := 10;
Change:
Writeln('[', Line, ']');
Write('GetLine> ');
GetLine(Line);
Writeln('[', Line, ']');
to:
Writeln('[', Line, '] ', Length(Line));
What you should see:
Command> TAKE THE L
[TAKE THE L] 10
5.1 Start from TIDIER, the section's program.
After the line
end;
add:
function Words(S: Str40): Integer;
var
I, N: Integer;
begin
if S = '' then
N := 0
else
N := 1;
for I := 1 to Length(S) do
if S[I] = ' ' then
N := N + 1;
Words := N;
end;
Change:
Writeln('[', Line, ']');
to:
Writeln('[', Line, '] ',
Words(Line), ' words');
What you should see:
[TAKE THE LAMP] 3 words
[N] 1 words
[LOOK THEN GO NORTH] 4 words
[TURN DIAL TO] 3 words
[] 0 words
5.2 Start from TIDIER, the section's program.
Change:
Ch := UpCase(S[I]);
to:
Ch := S[I];
if Ch in ['a'..'z'] then
Ch := Chr(Ord(Ch) - 32);
What you should see:
[TAKE THE LAMP]
[N]
[LOOK THEN GO NORTH]
[TURN DIAL TO]
[]
5.3 Start from TIDIER, the section's program.
After the line
Tidy(Line);
add:
if Pos('PLEASE ', Line) = 1 then
Delete(Line, 1, 7);
What you should see:
[OPEN THE DOOR]
[GO NORTH]
[PLEASED TO MEET YOU]
[]
6.1 Start from SPLIT, the section's program.
After the lines
procedure Show;
var
I: Integer;
begin
add:
Writeln;
Change:
Write('[', W[I], ']');
Writeln;
to:
Writeln(I, ': ', W[I]);
What you should see:
Go
Pos:
1: TAKE
2: THE
3: BRASS
4: LANTERN
Walk:
1: TAKE
2: THE
3: BRASS
4: LANTERN
6.2
program Ends;
type
Str40 = string[40];
Str12 = string[12];
var
Line: Str40;
W: array[1..20] of Str12;
N, I, K: Integer;
procedure SplitPos(S: Str40);
var
P: Integer;
begin
N := 0;
S := S + ' ';
while S <> '' do
begin
P := Pos(' ', S);
if P > 1 then
begin
N := N + 1;
W[N] := Copy(S, 1, P - 1);
end;
Delete(S, 1, P);
end;
end;
procedure SplitWalk(var S: Str40);
var
I: Integer;
begin
N := 0;
for I := 1 to Length(S) do
if S[I] <> ' ' then
begin
if (I = 1) or (S[I - 1] = ' ') then
begin
N := N + 1;
W[N] := '';
end;
W[N] := W[N] + S[I];
end;
end;
procedure SplitEnds(var S: Str40);
var
I, Start: Integer;
begin
N := 0;
I := 1;
while I <= Length(S) do
begin
while (I <= Length(S)) and
(S[I] = ' ') do
I := I + 1;
Start := I;
while (I <= Length(S)) and
(S[I] <> ' ') do
I := I + 1;
if I > Start then
begin
N := N + 1;
W[N] := Copy(S, Start, I - Start);
end;
end;
end;
begin
Line := 'TAKE THE BRASS LANTERN';
Writeln('Go');
for K := 1 to 500 do
SplitPos(Line);
Writeln('Pos done');
for K := 1 to 500 do
SplitWalk(Line);
Writeln('Walk done');
for K := 1 to 500 do
SplitEnds(Line);
Writeln('Ends done');
for I := 1 to N do
Write('[', W[I], ']');
Writeln;
end.
What you should see:
Go
Pos done
Walk done
Ends done
[TAKE][THE][BRASS][LANTERN]
About 6 seconds for 500, slower than both: building the word with one Copy saves the letter-by-letter +, but the loops round it, written in Pascal, cost more.
6.3 Start from SPLIT, the section's program.
After the lines
Write('Walk: ');
Show;
add:
Line := 'PUT THE KEY IN THE LOCK';
SplitPos(Line);
K := 0;
for N := N downto 1 do
if W[N] = 'THE' then
K := K + 1;
Writeln('THE ', K, ' times');
What you should see:
Go
Pos: [TAKE][THE][BRASS][LANTERN]
Walk: [TAKE][THE][BRASS][LANTERN]
THE 2 times
7.1
program Ambig;
const
Count = 12;
Sig = 2;
type
Str12 = string[12];
const
Vocab: array[1..Count] of Str12 =
('NORTH', 'SOUTH', 'TAKE', 'DROP',
'LOOK', 'LANTERN', 'LAMP',
'LOGBOOK', 'MATCHES', 'KEY',
'CROWBAR', 'OIL');
var
W: Str12;
function Whole(W: Str12): Integer;
var
I, Found: Integer;
begin
Found := 0;
for I := 1 to Count do
if Vocab[I] = W then
Found := I;
Whole := Found;
end;
function First(W: Str12): Integer;
var
I, Found, Hits: Integer;
begin
Found := 0;
Hits := 0;
for I := 1 to Count do
if Copy(Vocab[I], 1, Sig) =
Copy(W, 1, Sig) then
begin
Found := I;
Hits := Hits + 1;
end;
if Hits > 1 then
Found := -1;
First := Found;
end;
begin
repeat
Write('Word? ');
Readln(W);
Writeln('Whole ', Whole(W),
' First ', First(W));
until W = '';
end.
What you should see:
Word? LANTERN
Whole 6 First -1
Word? LA
Whole 0 First -1
Word? OIL
Whole 12 First 12
Word? LO
Whole 0 First -1
Word?
Whole 0 First 0
7.2 Start from KNOW, the section's program.
Change:
Sig = 4;
to:
Sig = 6;
After the lines
First := Found;
end;
add:
var
I: Integer;
After the lines
begin
add:
for I := 1 to Count do
Vocab[I] := Copy(Vocab[I], 1, Sig);
After the line
Readln(W);
add:
W := Copy(W, 1, Sig);
What you should see:
Word? LANTERNXYZ
Whole 6 First 6
Word? LANTER
Whole 6 First 6
Word? LANTEX
Whole 0 First 0
Word? KEY
Whole 10 First 10
Word?
Whole 0 First 0
7.3 Start from KNOW, the section's program.
Change:
Writeln('Whole ', Whole(W),
' First ', First(W));
to:
if First(W) > 0 then
Writeln('You mean ',
Vocab[First(W)])
else
Writeln('I don''t know ', W);
What you should see:
Word? LANT
You mean LANTERN
Word? LANTERNS
You mean LANTERN
Word? LAMP
You mean LAMP
Word? KEYS
I don't know KEYS
Word? MATCH
You mean MATCHES
Word? LOGS
I don't know LOGS
Word?
I don't know
8.1
program Examine;
type
Str12 = string[12];
Verb = (Nothing, Go, Take, Drop,
Look, Inv, Quit, Exam);
const
Count = 13;
Words: array[1..Count] of Str12 =
('GO', 'WALK', 'TAKE', 'GET',
'DROP', 'LOOK', 'L', 'INVENTORY',
'I', 'QUIT', 'STOP',
'EXAMINE', 'X');
Means: array[1..Count] of Verb =
(Go, Go, Take, Take, Drop, Look,
Look, Inv, Inv, Quit, Quit,
Exam, Exam);
var
W: Str12;
V: Verb;
function Find(W: Str12): Verb;
var
I: Integer;
begin
Find := Nothing;
for I := 1 to Count do
if Words[I] = W then
Find := Means[I];
end;
begin
repeat
Write('> ');
Readln(W);
V := Find(W);
Write('Token ', Ord(V), ': ');
case V of
Go: Writeln('You walk.');
Take: Writeln('Taken.');
Drop: Writeln('Dropped.');
Look: Writeln('You look.');
Inv: Writeln('Empty hands.');
Quit: Writeln('Goodbye.');
Exam: Writeln('You see nothing special.');
Nothing:
Writeln('I don''t know ', W);
end;
until V = Quit;
end.
What you should see:
Token 7: You see nothing special.
Token 7: You see nothing special.
Token 6: Goodbye.
8.2 Start from TOKENS, the section's program.
After the line
V: Verb;
add:
Total: array[Verb] of Integer;
I: Integer;
After the lines
begin
add:
for V := Nothing to Quit do
Total[V] := 0;
for I := 1 to Count do
Total[Means[I]] := Total[Means[I]] + 1;
for V := Go to Quit do
Write(Total[V], ' ');
Writeln;
What you should see:
2 2 1 2 2 2
Token 2: Taken.
Token 2: Taken.
Token 4: You look.
Token 5: Empty hands.
Token 0: I don't know JUMP
Token 6: Goodbye.
8.3 Start from TOKENS, the section's program.
After the line
Look, Inv, Inv, Quit, Quit);
add:
Name: array[Verb] of Str12 =
('NOTHING', 'GO', 'TAKE', 'DROP',
'LOOK', 'INVENTORY', 'QUIT');
Change:
Write('Token ', Ord(V), ': ');
to:
Write(W, ' means ', Name[V], ': ');
What you should see:
GET means TAKE: Taken.
TAKE means TAKE: Taken.
L means LOOK: You look.
I means INVENTORY: Empty hands.
JUMP means NOTHING: I don't know JUMP
STOP means QUIT: Goodbye.
9.1 Start from FASTER, the section's program.
Change:
Count, K, N: Integer;
to:
Count, K, N, Tries: Integer;
After the lines
while (Found = 0) and (I <= Count) do
begin
add:
Tries := Tries + 1;
After the line
Mid := (Lo + Hi) div 2;
add:
Tries := Tries + 1;
Change:
for K := 1 to 300 do
N := Straight('YELL');
Writeln('Straight: ', N);
for K := 1 to 300 do
N := Binary('YELL');
Writeln('Binary: ', N);
to:
Tries := 0;
N := Straight('YELL');
Writeln('Straight: ', Tries);
Tries := 0;
N := Binary('YELL');
Writeln('Binary: ', Tries);
What you should see:
121 words
Straight: 121
Binary: 7
9.2 Start from FASTER, the section's program.
Change:
for K := 1 to 300 do
N := Straight('YELL');
Writeln('Straight: ', N);
for K := 1 to 300 do
N := Binary('YELL');
Writeln('Binary: ', N);
to:
N := 0;
for K := 2 to Count do
if Vocab[K - 1] >= Vocab[K] then
begin
Writeln('Out of order: ', Vocab[K]);
N := N + 1;
end;
Writeln(N, ' out of order');
What you should see:
121 words
0 out of order
9.3 Start from FASTER, the section's program.
After the line
F: Text;
add:
W: Str10;
Change:
for K := 1 to 300 do
N := Straight('YELL');
Writeln('Straight: ', N);
for K := 1 to 300 do
N := Binary('YELL');
Writeln('Binary: ', N);
to:
repeat
Write('Word? ');
Readln(W);
N := Binary(W);
if N > 0 then
Writeln(W, ' is word ', N)
else
Writeln('Not known');
until W = '';
What you should see:
121 words
Word? LANTERN
LANTERN is word 63
Word? ZEBRA
Not known
Word? ABOUT
ABOUT is word 1
Word?
Not known
(typed: LANTERN, ZEBRA, ABOUT, then ENTER)
10.1 Start from SENTENCE, the section's program.
After the line
V, N1, P, N2: Integer;
add:
procedure Tidy(var S: Str40);
var
T: Str40;
I: Integer;
Ch: Char;
begin
T := '';
for I := 1 to Length(S) do
begin
Ch := UpCase(S[I]);
if not (Ch in ['A'..'Z']) then
Ch := ' ';
if (Ch <> ' ') or ((T <> '')
and (T[Length(T)] <> ' ')) then
T := T + Ch;
end;
S := T;
end;
After the line
Readln(Line);
add:
Tidy(Line);
What you should see:
TAKE LAMP
UNLOCK DOOR WITH KEY
There is no verb.
10.2 Start from SENTENCE, the section's program.
After the line
Noise);
add:
Same: array[1..Count] of Byte =
(1, 1, 3, 4, 5, 6, 7, 8, 9, 10,
11, 12, 13, 14, 15, 16);
Change:
Verb: V := K;
to:
Verb: V := Same[K];
What you should see:
TAKE LAMP
UNLOCK DOOR WITH KEY
What do you want to TAKE?
LOOK
I don't know SWORD
There is no verb.
FILL LAMP WITH OIL
There is no verb.
10.3 Start from SENTENCE, the section's program.
After the line
Writeln('There is no verb.')
add:
else if (P > 0) and (N2 = 0) then
Writeln(Words[P], ' what?')
What you should see:
WITH what?
OPEN DOOR WITH CROWBAR
There is no verb.
11.1 Start from INARRAY, the section's program.
Change:
Msg: array[1..3] of Str25 =
to:
Msg: array[1..4] of Str25 =
Change:
'A wooden jetty.');
to:
'A wooden jetty.',
'A cramped shed.');
Change:
for N := 1 to 3 do
to:
for N := 1 to 4 do
What you should see:
You are on the beach.
A small cove.
A wooden jetty.
A cramped shed.
11.2 Start from INARRAY, the section's program.
Change:
Str25 = string[25];
to:
Str25 = string[255];
What you should see:
You are on the beach.
A small cove.
A wooden jetty.
Code: 865 bytes, against 177: each of the three entries now takes 256 bytes, 230 more than before.
11.3 Start from INCODE, the section's program.
After the line
3: Writeln('A wooden jetty.');
add:
else
Writeln('No message ', N);
Change:
for N := 1 to 3 do
to:
for N := 1 to 5 do
What you should see:
You are on the beach.
A small cove.
A wooden jetty.
No message 4
No message 5
12.1 Start from FROMFILE, the section's program.
After the lines
Readln(T, Line);
end;
end;
add:
var
Line: Str255;
Change:
Writeln('Go');
Say(1);
Say(27);
Say(14);
to:
Reset(T);
while not Eof(T) do
begin
Readln(T, Line);
if Copy(Line, 1, 5) = '*ROOM' then
Writeln(Copy(Line, 7, 30));
end;
What you should see:
Beach
Cove
Jetty
Store Shed
Cliff Path
Front Room
Kitchen
Bedroom
Lighthouse Base
Stairs
Lamp Room
Gallery
12.2 Start from FROMFILE, the section's program.
After the lines
Readln(T, Line);
end;
end;
add:
var
Line: Str255;
Lines, Chars: Integer;
Change:
Writeln('Go');
Say(1);
Say(27);
Say(14);
to:
Reset(T);
Lines := 0;
Chars := 0;
while not Eof(T) do
begin
Readln(T, Line);
Lines := Lines + 1;
Chars := Chars + Length(Line);
end;
After the line
Close(T);
add:
Writeln(Lines, ' lines, ', Chars,
' characters');
What you should see:
71 lines, 3399 characters
12.3
program FromFile;
type
Str255 = string[255];
var
T: Text;
procedure Wrap(S: Str255);
var
P: Integer;
begin
S := S + '|';
while S <> '' do
begin
P := Pos('|', S);
if P > 40 then
begin
P := 40;
while S[P] <> ' ' do
P := P - 1;
end;
Writeln(Copy(S, 1, P - 1));
Delete(S, 1, P);
end;
end;
procedure Say(Name: Str255);
var
Line: Str255;
Found: Boolean;
begin
Reset(T);
Found := False;
while not Found and not Eof(T) do
begin
Readln(T, Line);
Found := (Copy(Line, 1, 1) = '*')
and (Pos(Name, Line) > 0);
end;
Readln(T, Line);
while Copy(Line, 1, 1) <> '*' do
begin
if (Line <> '') and
not (Line[1] in ['0'..'9']) then
Wrap(Line);
Readln(T, Line);
end;
end;
begin
Assign(T, 'BEACON.TXT');
Writeln('Go');
Say('Logbook');
Say('Ship');
Close(T);
end.
What you should see:
Go
The keeper's log. The last entries
read: "Oct 12. Glass falling. Lamp
trimmed, oil low. Spare can in the
store, but the door is stuck fast
again."
"Oct 13. Gale. Going over to the
mainland for oil. Locked the tower. Key
in my drawer as usual."
The ship is close now. You can see her
lights rising and falling in the swell.
13.1 Start from SEEKMSG, the section's program.
After the line
Msg: Str255;
add:
Total: Integer;
Change:
Writeln('Go');
Say(1);
Say(27);
Say(14);
to:
Total := 0;
while not Eof(F) do
begin
Read(F, Msg);
Write(Length(Msg):4);
Total := Total + Length(Msg);
end;
Writeln;
Writeln('Text: ', Total, ' of ',
FileSize(F) * SizeOf(Msg));
What you should see:
209 122 92 93 172 113 108 76 131 86
151 164 36 243 24 49 68 53 72 49
237 53 34 50 48 41 78
Text: 2652 of 6912
13.2 Start from SEEKMSG, the section's program.
After the line
Msg: Str255;
add:
N: Integer;
Change:
Writeln('Go');
Say(1);
Say(27);
Say(14);
to:
repeat
Write('Message? ');
Readln(N);
if (N >= 1) and (N <= FileSize(F))
then
Say(N);
until N = 0;
What you should see:
Message? 15
The iron door is locked.
Message? 99
Message? 3
A wooden jetty, slick with spray. A
rowing boat bumps against the piles.
The beach is north.
Message? 0
13.3 Start from SEEKMSG, the section's program.
After the line
Msg: Str255;
add:
T: Text;
Change:
Writeln('Go');
Say(1);
Say(27);
Say(14);
to:
Assign(T, 'MSG.TXT');
Rewrite(T);
while not Eof(F) do
begin
Read(F, Msg);
Writeln(T, Msg);
end;
Close(T);
After the line
Close(F);
add:
Writeln('Done');
What you should see:
Done
D then lists MSG TXT, and the disc has 104k left: 6k less, 2k for the program and 4k for the text.
14.1 Start from SQUEEZE, the section's program.
After the line
Same := False;
add:
Write(Length(Msg):4, 2 * NW:4);
if K mod 4 = 0 then
Writeln;
After the lines
Bytes := Bytes + 2 * NW;
end;
add:
Writeln;
What you should see:
209 142 122 84 92 64 93 64
172 118 113 80 108 76 76 52
131 90 86 60 151 104 164 112
36 26 243 184 24 18 49 34
68 48 53 36 72 50 49 36
237 162 53 38 34 24 50 36
48 34 41 28 78 54
Characters: 2652
Packed bytes: 1854
All came back: TRUE
Go
14.2 Start from SQUEEZE, the section's program.
After the line
Same: Boolean;
add:
Escapes: Integer;
After the lines
else
begin
add:
Escapes := Escapes + 1;
After the line
Same := True;
add:
Escapes := 0;
After the line
Writeln('All came back: ', Same);
add:
Writeln('Escaped: ', Escapes);
What you should see:
Characters: 2652
Packed bytes: 1854
All came back: TRUE
Escaped: 14
Go
14.3 Start from SQUEEZE, the section's program.
After the line
W[NW] := W[NW] or $8000;
add:
end;
procedure Show;
var
I, J, C, Mode, Hi: Integer;
Done: Boolean;
begin
Mode := 0;
I := 0;
repeat
I := I + 1;
Done := W[I] < 0;
for J := 2 downto 0 do
begin
C := (W[I] shr (5 * J)) and 31;
case Mode of
0: case C of
0: Write(' ');
1..26: Write(Chr(C + 96));
27: Mode := 1;
28: Write('.');
29: Write(',');
30: Mode := 2;
end;
1: begin
Write(Chr(C + 64));
Mode := 0;
end;
2: begin
Hi := C;
Mode := 3;
end;
3: begin
Write(Chr(Hi shl 5 + C));
Mode := 0;
end;
end;
end;
until Done;
Writeln;
Change:
for K := 1 to 20 do
Back := Unpack;
Writeln('Unpacked');
Writeln(Copy(Back, 1, 38));
to:
for K := 1 to 3 do
Show;
Writeln('Shown');
What you should see:
y from the rocks. You have saved her.
You strike a match and hold it to the wi
ck. With a soft roar the great lamp blaz
es into life, and its beam sweeps out ac
ross the water. Far below, the ship's li
ghts swing slowly round as she turns awa
y from the rocks. You have saved her.
You strike a match and hold it to the wi
ck. With a soft roar the great lamp blaz
es into life, and its beam sweeps out ac
ross the water. Far below, the ship's li
ghts swing slowly round as she turns awa
y from the rocks. You have saved her.
Shown
Three Shows take about 2.8 seconds, printing included. Show writes straight to the screen, so the lines break at the 40th column, not at spaces.
15.1 Start from COMMON, the section's program.
After the line
Same: Boolean;
add:
Used: array[1..Count] of Integer;
After the line
T := T + Chr(127 + Hit);
add:
Used[Hit] := Used[Hit] + 1;
After the line
Same := True;
add:
for K := 1 to Count do
Used[K] := 0;
After the line
Writeln('All came back: ', Same);
add:
for K := 1 to Count do
Write(Used[K]:4);
Writeln;
What you should see:
Characters: 2652
Encoded bytes: 2089
All came back: TRUE
51 23 11 14 18 11 14 6 5 4
4 4 8 16 7 3
Go
15.2 Start from COMMON, the section's program.
Change:
Writeln('Go');
for K := 1 to 20 do
Back := Decode(Code);
Writeln('Decoded');
Writeln(Copy(Back, 1, 38));
to:
Seek(F, 0);
Read(F, Msg);
Code := Encode(Msg);
for K := 1 to Length(Code) do
if Code[K] >= #128 then
Write('{', Ord(Code[K]) - 127, '}')
else
Write(Code[K]);
Writeln;
What you should see:
Characters: 2652
Encoded bytes: 2089
All came back: TRUE
{6}are on {14}strip {7}shingle at {1}foo
t {7}{1}cliffs. Wreckage {16}your boat r
olls {13}{1}surf. A path climbs north. {
2}beach runs west {15}{14}cove {4}south
{15}{14}jetty, {4}{14}store shed stands
{15}{1}east.
15.3 Start from COMMON, the section's program.
Take out:
Code := Encode(Msg);
After the line
Writeln('Go');
add:
for K := 1 to 5 do
Code := Encode(Msg);
Writeln('Five done');
What you should see:
Characters: 2652
Encoded bytes: 2089
All came back: TRUE
Go
Five done
Five encodings take about 10 seconds: two seconds each.
16.1 Start from ZWORD, the section's program.
After the line
Write(W, ': ');
add:
for I := 1 to 6 do
Write(C[I], ' ');
Write('= ');
What you should see:
Word? MAILBOX
MAILBOX: 18 6 14 17 7 20 = 48 CE C4 F4
Word? LAMP
LAMP: 17 6 18 21 5 5 = 44 D2 D4 A5
Word? LANTERN
LANTERN: 17 6 19 25 10 23 = 44 D3 E5 57
Word?
16.2
program Unword;
var
A, B, I, C: Integer;
procedure Letters(X: Integer);
var
J: Integer;
begin
for J := 2 downto 0 do
begin
C := (X shr (5 * J)) and 31;
if C >= 6 then
Write(Chr(C + 59));
end;
end;
begin
A := $48CE;
B := $C4F4;
Letters(A);
Letters(B);
Writeln;
A := $44D2;
B := $D4A5;
Letters(A);
Letters(B);
Writeln;
end.
What you should see:
MAILBO
LAMP
16.3 Start from ZWORD, the section's program.
After the lines
Writeln;
end;
add:
var
F: Text;
Prev, Cut: Str12;
N: Integer;
Change:
repeat
Write('Word? ');
Readln(W);
if W <> '' then
Entry(W);
until W = '';
to:
Assign(F, 'VOCAB.TXT');
Reset(F);
Prev := '';
N := 0;
while not Eof(F) do
begin
Readln(F, W);
Cut := Copy(W, 1, 6);
if Cut = Prev then
begin
Writeln(W, ' is ', Cut);
N := N + 1;
end;
Prev := Cut;
end;
Close(F);
Writeln(N, ' clashes');
What you should see:
0 clashes
No two of VOCAB.TXT's words share their first six letters, so Zork's way would work for it too.
Each answer is a change to BEACON1, the program as the section left it.
17.1
Change:
Here := 1;
Look;
to:
for Here := 1 to Rooms do
Writeln(Here, ' ', Map[Here].Name);
What you should see: Prints 1 Beach to 12 Gallery, one to a line.
17.2
After the lines
Exits: array[1..6] of Byte;
end;
add:
const
Dir: array[1..6] of string[5] =
('North', 'South', 'East',
'West', 'Up', 'Down');
After the line
Map: array[1..Rooms] of Room;
add:
D: Integer;
After the line
Look;
add:
for D := 1 to 6 do
if Map[Here].Exits[D] > 0 then
Writeln(Dir[D], ' to ',
Map[Map[Here].Exits[D]].Name);
What you should see: After the beach's description: North to Cliff Path, South to Jetty, East to Store Shed, West to Cove.
17.3
Change:
Here := 1;
Look;
to:
Writeln(FileSize(Msg),
' messages in BEACON.MSG');
What you should see: 27 messages in BEACON.MSG.
Each answer is a change to BEACON2, the program as the section left it.
18.1
After the line
procedure Walk(D: Integer);
add:
const
Way: array[1..6] of Byte =
(35, 44, 15, 52, 50, 11);
Change:
Writeln('You can''t go that way.')
to:
begin
Write('You can go:');
for D := 1 to 6 do
if Map[Here].Exits[D] > 0 then
Write(' ', Words[Way[D]]);
Writeln('.');
end
What you should see: In the shed, E: You can go: WEST.
18.2
After the line
Line: Str40;
add:
Moves: Integer;
After the line
Quit := False;
add:
Moves := 0;
After the line
GetLine(Line);
add:
Moves := Moves + 1;
After the line
until Quit;
add:
Writeln('Moves: ', Moves);
What you should see: N, S, Q: Moves: 3.
18.3
After the line
procedure Look;
add:
var
I: Integer;
N: Str16;
Change:
Writeln(Map[Here].Name);
to:
N := Map[Here].Name;
for I := 1 to Length(N) do
N[I] := UpCase(N[I]);
Writeln(N);
What you should see: BEACH, CLIFF PATH and so on, in capitals.
Each answer is a change to BEACON3, the program as the section left it.
19.1
After the lines
Writeln(' nothing.');
end;
add:
function Held: Integer;
var
T, N: Integer;
begin
N := 0;
for T := 1 to Things do
if Carried(T) then
N := N + 1;
Held := N;
end;
After the line
Writeln('It isn''t here.')
add:
else if Held >= 4 then
Writeln('You can''t carry any more.')
What you should see: With the crowbar, lantern, oil can and logbook carried, TAKE MATCHES in the kitchen: You can't carry any more.
19.2
Change:
Writeln('Dropped.');
to:
Writeln('You drop ', Obj[T].Name,
'.');
What you should see: DROP CROWBAR: You drop a crowbar.
19.3
After the line
Say(27)
add:
else if (N1 >= 20) and (N1 <= 25)
and Near(N1 - 19) then
Writeln('It is ', Obj[N1 - 19].Name,
'.')
What you should see: On the jetty, EXAMINE LANTERN: It is a lantern.
Each answer is a change to BEACON4, the program as the section left it.
20.1
After the line
Say(Here);
add:
if (Here = 10) and Lit and Carried(2)
then
Writeln('Your lantern lights the',
' way up.');
What you should see: On the stairs with the lantern lit: the description, then Your lantern lights the way up.
20.2
After the lines
Won := True;
end;
end
add:
else if N1 = 24 then
Writeln('A match flares and dies.')
What you should see: LIGHT MATCHES, carrying them: A match flares and dies.
20.3
After the lines
Writeln('You see nothing special.');
end;
add:
procedure Hint;
begin
if not ShedOpen then
Writeln('The shed must open somehow.')
else if not TowerOpen then
Writeln('Has the keeper a key?')
else if not Lit then
Writeln('The stairs need a light.')
else
Writeln('The great lamp needs oil.');
end;
Change:
19: Writeln('Nothing happens.');
to:
19: Hint;
What you should see: XYZZY at the start: The shed must open somehow.; after the shed is open: Has the keeper a key?
Each answer is a change to BEACON5, the program as the section left it.
21.1
After the line
Writeln('You took ', Moves, ' moves.');
add:
Writeln('Puzzles solved: ',
Ord(ShedOpen) + Ord(TowerOpen) +
Ord(Lit) + Ord(Won), ' of 4');
What you should see: N, Q: You took 2 moves., Puzzles solved: 0 of 4.
21.2
After the line
Load;
add:
repeat
After the line
Writeln('You took ', Moves, ' moves.');
add:
Write('Play again (Y/N)? ');
Read(Kbd, Ch);
Writeln;
until UpCase(Ch) <> 'Y';
What you should see: Q, then Y: the title again, and a new game. N ends it.
21.3 At the menu, O, C, Q, then C: Turbo compiles to .COM (Free: 43966 bytes for the answer to 21.2). Q, and at 0: type the program's name: the title appears, and N at the end brings you back to 0:.
For 20.x and 21.x, and for anyone stuck. From the beach:
W, TAKE CROWBAR, E, S, TAKE THE LANTERN, N, E, OPEN DOOR WITH CROWBAR, E, TAKE OIL, W, N, W, TAKE LOGBOOK, READ LOGBOOK, S, OPEN CUPBOARD, TAKE MATCHES, N, N, OPEN DRAWER, TAKE KEY, S, E, N, UNLOCK THE DOOR WITH THE KEY, U, LIGHT LANTERN, U, FILL LAMP WITH OIL, LIGHT LAMP.
This form is protected by reCAPTCHA, and the Google Privacy Policy and Terms of Service apply.
