1
0
Fork 0
vt100-games/LadderTP/LADPROCS.PAS

394 lines
11 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

PROCEDURE Instructions;
BEGIN
ClrScr;
WriteLN;
WriteLN('You are a Lad trapped in a maze. Your mission is is to explore the');
WriteLN('dark corridors never before seen by human eyes and find hidden');
WriteLN('treasures and riches');
WriteLN;
WriteLN('You control Lad by typing the direction buttons and jumping by');
WriteLN('typing SPACE. But beware of the falaling rocks called Der rocks.');
WriteLN('You must find and grasp the treasures (shown as $) BEFORE the');
WriteLN('bonus time runs out.');
WriteLN;
WriteLN('A new Lad will be awarded for every 10,000 points.');
WriteLN('Extra points are awarded for touching the gold');
WriteLN('statues (shown as &). You will receive the bonus time points');
WriteLN('that are left when you have finished the level.');
WriteLN;
WriteLN('Type an ESCape to pause the egame.');
WriteLN;
WriteLN('Remember, there is more than one way to skin a cat. (Chum)');
WriteLN;
WriteLN('Good luck Lad.');
WriteLN;
WriteLN;
WriteLN;
Write('Type RETURN to return to main menu: ');
Read;
END;
PROCEDURE ConfigureLadder;
VAR
configPgm : FILE;
Ok : BOOLEAN;
BEGIN
{$I-}
Assign(configPgm, ConfigFileName);
WriteLN('Linking to configuration program');
Execute(configPgm);
Ok := IOresult = 0; { IOresult must be called after failed Execute }
{$I+}
WriteLN;
WriteLN('Unable to link to LADCONF.COM');
WriteLN('Ladder configuration program missing');
Halt;
END;
PROCEDURE MainMenu;
VAR
ch : CHAR;
insult : BOOLEAN;
i, msecs : INTEGER;
configPgm : FILE;
BEGIN
REPEAT
ClrScr;
WriteLN(' LL dd dd');
WriteLN(' LL dd dd tm');
WriteLN(' LL aaaa ddddd ddddd eeee rrrrrrr');
WriteLN(' LL aa aa dd dd dd dd ee ee rr rr');
WriteLN(' LL aa aa dd dd dd dd eeeeee rr');
WriteLN(' LL aa aa dd dd dd dd ee rr');
WriteLN(' LLLLLLLL aaa aa ddd dd ddd dd eeee rr');
WriteLN;
WriteLN(' Version : ', Version);
WriteLN('(c) 1982, 1983 Yahoo Software Terminal: ', dataFileContents.TerminalName);
WriteLN('10970 Ashton Ave. Suite 312 Play speed: ', playSpeed);
Write( 'Los Angeles, Ca 90024 ');
WriteLN('Up = ', upKey, ' Down = ',downKey ,' Left = ', leftKey, ' Right = ', rightKey);
WriteLN(' Jump = Space Stop = Other');
WriteLN;
WriteLN('P = Play game High Scores');
WriteLN('L = Change level of difficulty');
WriteLN('C = Configure Ladder');
WriteLN('I = Instructions');
WriteLN('E = Exit Ladder');
WriteLN;
WriteLN;
Write('Enter one of the above: ');
{ show high scores }
FOR i := 1 TO NumHighScores DO BEGIN
GotoXY(40, i + 15);
Write(i, ') ');
IF highScores[i].Score <> 0 THEN
Write(highScores[i].Score:4, '00 ', highScores[i].Name);
END;
IF lastScore <> -1 THEN BEGIN
GotoXY(40, 22);
Write('Last Score: ',lastScore,'00');
END;
GotoXY(25, 22);
{ randomly prompt the user to get a move on }
insult := FALSE;
msecs := 0;
REPEAT
Delay(1);
msecs := Succ(msecs);
IF msecs >= 1000 THEN BEGIN
msecs := 0;
IF insults THEN BEGIN
IF insult THEN BEGIN
GotoXY(1, 24);
ClrEol;
insult := FALSE;
GotoXY(25, 22);
END ELSE BEGIN
i := Random(10);
IF i > 7 THEN BEGIN
insult := TRUE;
GotoXY(1, 24);
IF i = 8 THEN
Write('You eat quiche!')
ELSE
Write('Come on, we don''t have all day!');
GotoXY(25, 22);
END;
END;
END;
END;
ch := #0;
IF KeyPressed THEN BEGIN
Read(Kbd, ch);
ch := UpCase(ch);
IF ch = 'L' THEN BEGIN { change playing speed }
playSpeed := SUCC(playSpeed MOD NumPlaySpeeds);
GotoXY(52, 11); Write(playSpeed);
GotoXY(25, 22);
END ELSE IF ch = 'I' THEN
Instructions;
END;
UNTIL ch IN ['P','C','I','E'];
UNTIL ch in ['P', 'C', 'E'];
IF ch = 'E' THEN BEGIN
Write('Exiting...');
GotoXY(1, 24);
ClrEOL;
GotoXY(1, 23);
Halt;
END ELSE IF ch = 'C' THEN BEGIN { run configuration program }
GotoXY(1, 23);
ConfigureLadder;
END;
END;
{
Read the LADDER.DAT file. This is the same file used in the original
game. We don't use the cursor control stuff (that's handled by Turbo
Pascal, but do use the control keys, flags and high scores.
I'm sure this code could be better, but it does the job.
}
PROCEDURE ReadDataFile;
VAR
dataFile,configPgm : FILE;
i, j : INTEGER;
BEGIN
{$I-}
Assign(dataFile, DataFileName);
Reset(dataFile);
IF IOresult <> 0 THEN BEGIN
ConfigureLadder;
END;
BlockRead(dataFile, dataFileContents, SizeOf(dataFileContents) DIV 128);
IF IOresult <> 0 THEN BEGIN
WriteLN('Ladder not configred');
WriteLN;
ConfigureLadder;
END;
WITH dataFileContents DO BEGIN
sound := Flags[0] = 'Y';
insults := Flags[1] = 'Y';
downKey := Keys[0];
leftKey := Keys[1];
rightKey := Keys[2];
upKey := Keys[3];
FOR i := 1 TO NumHighScores DO BEGIN
highScores[i].Name[0] := CHAR(Highs[i][0]);
IF Highs[i][0] = 0 THEN
highScores[i].Score := 0
ELSE
highScores[i].Score := Highs[i][1] OR (Highs[i][2] SHL 8);
FOR j := 1 TO Highs[i][0] DO
highScores[i].Name[j] := CHAR(Highs[i][j + 2]);
END;
END;
Close(dataFile);
{$I+}
END;
{
Update the high scores in LADDER.DAT. See the comments in
ReadDataFile.
}
PROCEDURE WriteDataFile;
VAR
dataFile : FILE;
i, j : INTEGER;
BEGIN
{$I-}
Assign(dataFile, DataFileName);
Reset(dataFile);
IF IOresult <> 0 THEN BEGIN
WriteLN('Reset failed on LADDER.DAT');
Halt;
END;
WITH dataFileContents DO BEGIN
FOR i := 1 TO NumHighScores DO BEGIN
Highs[i][0] := Length(highScores[i].Name);
Highs[i][1] := Lo(highScores[i].Score);
Highs[i][2] := Hi(highScores[i].Score);
FOR j := 1 TO Highs[i][0] DO
Highs[i][j + 2] := ORD(highScores[i].Name[j]);
END;
BlockWrite(dataFile, dataFileContents, SizeOf(dataFileContents) DIV 128);
IF IOresult <> 0 THEN BEGIN
WriteLN('BlockWrite failed on LADDER.DAT');
Halt;
END;
END;
Close(dataFile);
{$I+}
END;
{
kill the lad off in a horrible death of mixed up characters.
}
FUNCTION LadDeath : BOOLEAN;
CONST
NumSymbols = 11;
symbols : ARRAY[1..NumSymbols] OF CHAR = ('p', 'b', 'd', 'q', 'p', 'b', 'd', 'q', '-', '-', '_');
VAR
i, j : INTEGER;
name: STRING[DataFileNameLength];
ch : CHAR;
BEGIN
FOR i := 1 TO NumSymbols DO BEGIN
Beep;
GotoXY(lad.X, lad.Y); Write(symbols[i]);
Delay(150);
END;
m.LadsRemaining := Pred(m.LadsRemaining);
GotoXY(8, 21); Write(m.ladsRemaining : 2);
LadDeath := m.LadsRemaining > 0;
IF m.LadsRemaining <= 0 THEN BEGIN
FOR i := 1 TO NumHighScores DO BEGIN
WriteLN(highScores[i].Score);
IF m.Score >= highScores[i].Score THEN BEGIN
FOR j := NumHighScores - 1 DOWNTO i DO BEGIN
highScores[j + 1] := highScores[j];
END;
ClrScr;
GotoXY(10, 7);
FOR j := 1 TO 7 DO
Write('YAHOO! ');
WriteLN;
WriteLN;
CASE levelCycle OF
1 : WriteLN('You really don''t deserve this but...');
2 : WriteLN('Not bad for a young Lad');
3 : WriteLN('Amazing! You rate!!');
4 : WriteLN('Looks like we have a Lad-Der here');
5 : WriteLN('Yeah! Now you are a Lad-Wiz!');
6 : WriteLN('Wow! You are now a Lad-Guru!');
ELSE WriteLN('You are a true Lad-Master!!!');
END;
WriteLN;
While KeyPressed DO
Read(Kbd, ch);
Write('Enter your name: ');
CursOn;
Read(name);
CursOff;
GotoXY(1, 17);
Write('Updating high scores...');
highScores[i].Score := m.Score;
highScores[i].Name := name;
WriteDataFile;
EXIT;
END;
END;
END;
END;
PROCEDURE DrawMap;
VAR
x, y : INTEGER;
ch : CHAR;
BEGIN
FOR y := 1 TO LevelRows DO BEGIN
GotoXY(1, y);
FOR x := 1 TO LevelCols DO
Write(m.Field[y][x]);
END;
{ Draw the lad at rest }
GotoXY(lad.X, lad.Y); Write('g');
{ Initialize the entire status line }
GotoXY(1, 21);
Write('Lads ',m.LadsRemaining : 2,
' Level ', displayLevel : 2,
' Score ', m.Score : 5, '00',
' Bonus time ', m.RemainingBonusTime : 2, '00');
GotoXY(1, 23); Write('Get ready!');
Delay(1000);
WHILE KeyPressed DO
Read(Kbd, ch);
GotoXY(1, 23); Write(' ');
END;
{
Adjusts the score according to some event.
}
PROCEDURE UpdateScore(scoreEvent : ScoreType);
BEGIN
CASE scoreEvent OF
ScoreStatue: BEGIN
m.Score := m.Score + m.RemainingBonusTime;
Beep;
END;
ScoreReset: m.Score := 0;
ScoreRock: BEGIN
m.Score := m.Score + 2;
Beep;
END;
ScoreMoney: BEGIN
WHILE m.RemainingBonusTime > 0 DO BEGIN
GotoXY(1, 23); Write('Hooka!'); Beep; Delay(100);
GotoXY(1, 23); Write(' '); Delay(100);
m.Score := Succ(m.Score);
m.RemainingBonusTime := Pred(m.RemainingBonusTime);
GotoXY(36, 21); Write(m.Score : 5);
GotoXY(74, 21); Write(m.RemainingBonusTime : 2);
END;
END;
END;
{ give a new lad if over 10,000 points }
IF m.Score >= nextNewLad THEN BEGIN
m.ladsRemaining := Succ(m.ladsRemaining);
nextNewLad := nextNewLad + 100;
GotoXY(8, 21); Write(m.ladsRemaining : 2);
END;
GotoXY(36, 21);
Write(m.Score : 5);
END;
{
Check to see if the Lad has collided with, or jumped over a rock.
}
FUNCTION Collision(rockPtr : RockPointerType) : BOOLEAN;
BEGIN
Collision := FALSE;
IF lad.X = rockPtr^.X THEN BEGIN
IF lad.Y = rockPtr^.Y THEN BEGIN
Collision := TRUE;
END ELSE IF (lad.Y = rockPtr^.Y - 1) AND
(m.Field[lad.Y + 1][lad.X] = ' ') THEN BEGIN
{ score for jumping rocks }
UpdateScore(ScoreRock);
END ELSE IF (lad.Y = rockPtr^.Y - 2) THEN
IF (m.Field[lad.Y + 1][lad.X] = ' ') AND (m.Field[lad.Y + 2][lad.X] = ' ') THEN BEGIN
{ score for jumping rocks }
UpdateScore(ScoreRock);
END;
END;
END;
{
Set each rock up in a random dispenser.
}
PROCEDURE DisperseRocks;
VAR
rockPtr : RockPointerType;
dispenserPtr : DispenserPointerType;
i : INTEGER;
BEGIN
rockPtr := m.Rocks;
WHILE rockPtr <> NIL DO BEGIN
dispenserPtr := dispensers;
IF numDispensers > 1 THEN
FOR i := 1 TO Random(numDispensers) DO
dispenserPtr := dispenserPtr^.Next;
InitActor(rockPtr^, AROCK, dispenserPtr^.xy);
rockPtr := rockPtr^.Next;
END;
m.AnyRocksPending := TRUE;
END;