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

412 lines
10 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.

{
ReverseDirection makes the actor to go in the opposite direction,
it only works when the actor is moving left or right
}
PROCEDURE ReverseDirection(VAR a : ActorType);
BEGIN
CASE a.Dir OF
LEFT : a.Dir := RIGHT;
RIGHT : a.Dir := LEFT;
END;
END;
{
OnSolid returns true if standing on something solid i.e. Floor,
Disappearing floor or a Ladder
}
FUNCTION OnSolid(a : ActorType) : BOOLEAN;
BEGIN
OnSolid := (m.Field[a.Y + 1][a.X] IN ['=', '-', 'H', '|'])
OR (m.Field[a.Y][a.X] = 'H');
END;
FUNCTION EmptySpace(x, y : INTEGER) : BOOLEAN;
BEGIN
IF (x < 1) OR (x > LevelCols) THEN
EmptySpace := TRUE
ELSE
EmptySpace := NOT (m.Field[y][x] IN ['|', '=']);
END;
{
AboveLadder returns true when the actor is a above a Ladder
}
FUNCTION AboveLadder(a : ActorType) : BOOLEAN;
BEGIN
AboveLadder := m.Field[a.Y + 1][a.X] = 'H';
END;
{
OnEater returns true when the actor is standing on a Eater
}
FUNCTION OnEater(a : ActorType) : BOOLEAN;
BEGIN
OnEater := m.Field[a.Y][a.X] = '*';
END;
{
ClampToPlayfield makes sure that if the actor tries to walk or jump off
the playfield edges the actor stays inside the playfield and starts falling
}
PROCEDURE ClampToPlayfield(VAR a : ActorType);
BEGIN
IF a.Dir IN [LEFT, JUMPLEFT] THEN BEGIN
IF a.X < 1 THEN BEGIN
a.X := 1;
a.Dir := STOPPED;
a.DirRequest := NONE;
END;
END;
IF a.Dir IN [RIGHT, JUMPRIGHT] THEN BEGIN
IF a.X > LevelCols THEN BEGIN
a.X := LevelCols;
a.Dir := STOPPED;
a.DirRequest := NONE;
END;
END;
END;
{
InitActor set the fields of an Actor type to reasonable
initial values
}
PROCEDURE InitActor(VAR a : ActorType; t : KindType; xy : XYtype);
BEGIN
a.AType := t;
a.X := xy.x;
a.Y := xy.y;
a.Ch := 'X';
a.JumpStep := 0;
CASE t OF
ALAD:
BEGIN
a.Ch := 'g';
a.Dir := STOPPED;
a.DirRequest := NONE;
END;
AROCK:
BEGIN
a.Ch := 'o';
a.Dir := PENDING;
a.DirRequest := NONE;
END;
END;
END;
{
Set the Lad's character based on their current direction
}
PROCEDURE UpdateLadChar(VAR a : ActorType);
BEGIN
WITH a DO
CASE Dir OF
STOPPED: Ch := 'g';
RIGHT, JUMPRIGHT: Ch := 'p';
LEFT, JUMPLEFT: Ch := 'q';
FALLING: Ch := 'b';
UP, DOWN: Ch := 'p';
JUMP:
CASE a.DirRequest OF
NONE, STOPPED: Ch := 'g';
RIGHT, JUMPRIGHT: Ch := 'p';
LEFT, JUMPLEFT: Ch := 'q';
END;
END;
END;
{
Update an actor's direction to the latest's request
}
PROCEDURE UpdateDir(VAR a : ActorType);
BEGIN
a.Dir := a.DirRequest;
a.DirRequest := NONE;
END;
{
MoveActor handles the movements of an Actor
}
PROCEDURE MoveActor(VAR a : ActorType);
LABEL
loopAgain;
VAR
jd : ActionType;
i : INTEGER;
dispenser : DispenserPointerType;
BEGIN
loopAgain: { If just started falling we need to retest all conditions }
{ A STONE can only be LEFT/RIGHT/DOWN/FALLING or PENDING }
IF a.AType = AROCK THEN BEGIN
IF (a.Dir = PENDING) AND (a.DirRequest = NONE) THEN
EXIT;
{ If stopped select a random direction }
IF a.Dir = STOPPED THEN BEGIN
CASE Random(2) OF
0: IF (a.X > 1) THEN
IF EmptySpace(a.X - 1, a.Y) THEN
a.DirRequest := LEFT
ELSE
a.DirRequest := RIGHT
ELSE
a.DirRequest := RIGHT;
1: IF (a.X < LevelCols) THEN
IF EmptySpace(a.X + 1, a.Y) THEN
a.DirRequest := RIGHT
ELSE
a.DirRequest := LEFT
ELSE
a.DirRequest := LEFT;
END;
END;
{ Just reverse direction if at the playfield edge }
IF (a.X = 1) OR (a.X = LevelCols) THEN
ReverseDirection(a);
{ Start to fall if not on solid ground }
IF (a.Dir <> FALLING) AND NOT OnSolid(a) THEN
a.DirRequest := FALLING;
{ If Der rock just rolled over the top of a ladder then randomize direction }
IF AboveLadder(a) AND (a.Dir IN [LEFT, RIGHT]) THEN
CASE Random(4) OF
0: a.DirRequest := LEFT;
1: a.DirRequest := RIGHT;
ELSE a.DirRequest := DOWN;
END;
{ If on an Eater kill the stone }
IF OnEater(a) THEN BEGIN
dispenser := dispensers;
IF numDispensers > 1 THEN BEGIN
FOR i := 1 TO Random(numDispensers) DO
dispenser := dispenser^.next;
END;
InitActor(a, AROCK, dispenser^.xy);
m.AnyRocksPending := TRUE;
END;
END; { of stone only handling --------------------- }
{ If stopped or going left or going right and }
{ request to do something else, then try to do it }
IF (a.DirRequest <> NONE) THEN BEGIN
CASE a.Dir OF
STOPPED, PENDING:
IF a.DirRequest IN [LEFT, RIGHT, UP, DOWN, FALLING] THEN
UpdateDir(a);
JUMPUP:
IF a.DirRequest = LEFT THEN
a.Dir := JUMPLEFT
ELSE IF a.DirRequest = RIGHT THEN
a.Dir := JUMPRIGHT;
RIGHT:
IF a.DirRequest IN [LEFT, STOPPED] THEN
UpdateDir(a);
LEFT:
IF a.DirRequest IN [RIGHT, STOPPED] THEN
UpdateDir(a);
UP, DOWN:
IF a.DirRequest IN [STOPPED, UP, DOWN, RIGHT, LEFT] THEN
UpdateDir(a);
JUMPUP:
IF a.DirRequest = LEFT THEN
a.Dir := JUMPLEFT
ELSE
a.Dir := JUMPRIGHT;
JUMPRIGHT, JUMPLEFT:
IF a.DirRequest = STOPPED THEN
UpdateDir(a);
PENDING:
UpdateDir(a);
END;
END;
{ Handle starting of jumps }
IF (a.DirRequest = JUMP) THEN BEGIN
IF OnSolid(a) THEN BEGIN
CASE a.Dir OF
STOPPED, FALLING: BEGIN
a.DirRequest := STOPPED;
a.Dir := JUMPUP;
a.JumpStep := 1;
END;
LEFT: BEGIN
a.DirRequest := a.Dir;
a.Dir := JUMPLEFT;
a.JumpStep := 1;
END;
JUMPLEFT: BEGIN
a.DirRequest := LEFT;
a.Dir := JUMPLEFT;
a.JumpStep := 1;
END;
RIGHT: BEGIN
a.DirRequest := a.Dir;
a.Dir := JUMPRIGHT;
a.JumpStep := 1;
END;
JUMPRIGHT: BEGIN
a.DirRequest := RIGHT;
a.Dir := JumpRIGHT;
a.JumpStep := 1;
END;
END
END ELSE BEGIN
CASE a.Dir OF
JUMPUP, FALLING: a.DirRequest := STOPPED;
JUMPRIGHT: a.DirRequest := RIGHT;
JUMPLEFT: a.DirRequest := LEFT;
END;
END;
END ELSE IF (a.DirRequest = UP) AND (m.Field[a.Y][a.X] = 'H') THEN BEGIN
{ If at a ladder and want to go up }
a.Dir := UP;
a.DirRequest := NONE;
END ELSE IF(a.DirRequest = DOWN) AND
((m.Field[a.Y][a.X] = 'H') OR (m.Field[a.Y + 1][a.X] = 'H')) THEN BEGIN
a.Dir := DOWN;
a.DirRequest := NONE;
END;
CASE a.Dir OF
JUMPUP, JUMPLEFT, JUMPRIGHT: BEGIN
{ Do the jumping }
jd := jumpPaths[a.Dir, a.JumpStep];
IF (a.X + dirs[jd].x >= 1) AND (a.X + dirs[jd].x <= LevelCols) THEN BEGIN
CASE m.Field[a.Y + dirs[jd].y][a.X + dirs[jd].x] OF
'=', '|', '-' : BEGIN
{ If bumped into something try falling }
IF OnSolid(a) THEN BEGIN
a.Dir := a.DirRequest;
a.DirRequest := NONE;
END ELSE BEGIN
CASE a.Dir OF
JUMPUP: a.DirRequest := STOPPED;
JUMPRIGHT: a.DirRequest := RIGHT;
JUMPLEFT: a.DirRequest := LEFT;
END;
a.Dir := FALLING;
END;
a.JumpStep := 0;
END;
'H': BEGIN { Jumping onto a ladder }
a.Y := a.Y + dirs[jd].y;
a.X := a.X + dirs[jd].x;
a.Dir := STOPPED;
a.DirRequest := NONE;
a.JumpStep := 0;
END;
ELSE BEGIN
{ Just jumping in air }
a.X := a.X + dirs[jd].x;
a.Y := a.Y + dirs[jd].y;
a.JumpStep := SUCC(a.JumpStep);
IF (a.JumpStep > JumpsLen) THEN BEGIN
UpdateDir(a);
a.JumpStep := 0;
END ELSE IF (jumpPaths[a.Dir][a.JumpStep] = ACTIONEND) THEN BEGIN
UpdateDir(a);
a.JumpStep := 0;
END;
END;
END;
END ELSE BEGIN
IF OnSolid(a) THEN BEGIN
a.Dir := a.DirRequest;
a.DirRequest := NONE;
END ELSE BEGIN
a.Dir := FALLING;
a.DirRequest := STOPPED;
a.JumpStep := 0;
END;
END;
END;
STOPPED:
IF NOT OnSolid(a) THEN
a.Dir := FALLING;
FALLING: BEGIN
{ If falling then continue doing that until not in free space anymore, }
{ then continue the previous direction (if any) }
IF OnSolid(a) THEN
IF a.DirRequest = NONE THEN
a.DirRequest := STOPPED
ELSE
a.Dir := a.DirRequest
ELSE
a.Y := Succ(a.Y);
END;
UP:
{ Climb up until ladder is no more }
IF m.Field[a.Y - 1][a.X] IN ['H', '&', '$'] THEN
a.Y := Pred(a.Y)
ELSE
a.Dir := STOPPED;
DOWN:
{ Climb down until ladder is no more }
IF a.Dir = DOWN THEN
IF m.Field[a.Y + 1][a.X] IN ['H', '&', '$', ' ', '^', '.'] THEN
a.Y := Succ(a.Y)
ELSE
a.Dir := STOPPED;
LEFT: BEGIN
{ Stepped out into the void? Then start falling, }
{ but remember the previous direction }
IF NOT OnSolid(a) THEN BEGIN
a.DirRequest := a.Dir;
a.Dir := FALLING;
GOTO loopAgain;
END;
IF EmptySpace(a.X - 1, a.Y) THEN
a.X := Pred(a.X)
ELSE
a.DirRequest := STOPPED;
END;
RIGHT: BEGIN
{ Stepped out into the void? Then start falling, }
{ but remember the previous direction }
IF NOT OnSolid(a) THEN BEGIN
a.DirRequest := a.Dir;
a.Dir := FALLING;
GOTO loopAgain;
END;
IF EmptySpace(a.X + 1, a.Y) THEN
a.X := Succ(a.X)
ELSE
a.DirRequest := STOPPED;
END;
END;
{ Don't allow actor to end up outside of the playfield }
ClampToPlayfield(a);
IF a.AType = ALAD THEN
UpdateLadChar(a);
END;