kolibrios/programs/games/lrl/LRLLevels.pp
bw 4cc19614ca Lode Runner Live game
git-svn-id: svn://kolibrios.org@670 a494cfbc-eb01-0410-851d-a64ba20cac60
2007-11-01 12:36:59 +00:00

1195 lines
35 KiB
ObjectPascal
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

unit LRLLevels;
{$mode objfpc}
interface
uses
SysUtils,
LRLRoutines, LRLSprites;
type
TLRLPlayerPosition = packed record
x, y: Byte;
xoffs, yoffs: ShortInt;
end;
TLRLPlayer = packed record
Command: Byte;
{ pictures:
1 - running left <-
2 - running right ->
3 - climbing up ^
4 - climbing down v
5 - falling
6 - ~~~~~ left <-
7 - ~~~~~ right ->
8 - firing left <-
9 - firing right ->
}
NewCommandWas: Boolean;
NewCommand: Byte;
Position: TLRLPlayerPosition;
Sprite: Byte;
SpriteData: Byte;
Controller: Byte;
{
controllers:
0 - not playing
1 - human/keyboard
2 - computer
}
Prizes: Byte;
{
max 1 if computer player
a) computer player leaves prize if falling into hole
b) takes prize if he has no prizes
}
Colour: Byte;
end;
TLRLBrick = packed record
Image: Byte;
Count: Byte;
Flags: Byte;
{ flags:
bit 0 - needed to animate this brick 5 sprites then pause
and then finnally 5 sprites
bit 1 - set if fatal brick
bit 2 - set if allowable to jump
bit 3 - allowable to walk thru
bit 4 - hidden
bit 5 - background
bit 6 - wait now
bit 7 - not draw it
}
IdleCount: Byte;
end;
TLRLLevel = packed record
Field: array[1..30, 1..16] of TLRLBrick;
Player: array[1..20] of TLRLPlayer;
end;
const
BrickFlags: array[1..20] of Byte = (
48, 4 + 8 + 32 + 128,
49, 8 + 32,
50, 4 + 8 + 32,
51, 4 + 8 + 32,
52, 2,
53, 4,
54, 4 + 8,
55, 2,
56, 2,
65, 4 + 8 + 16 + 32);
const
KeyboardControls: array[1..21] of Word = (
$00B0, 1, 1,
$00B3, 1, 2,
$00B2, 1, 3,
$00B1, 1, 4,
$00B5, 1, 6,
$00B7, 1, 7,
$0037, 1, 5);
ControlNumber = 7;
var
ShowLives: Boolean;
ShowScore: Boolean;
ShowLevel: Boolean;
LRLLevel: TLRLLevel;
LRLLives: Integer;
LRLScore: Longint;
LRLCLevel: Word;
ComputerTurn: Word;
ComputerReaction: Word;
TimeToRefresh: Boolean;
OldTimer: Pointer;
TotalPrizes: Integer;
GameStarted: Boolean;
EndOfGame: Boolean;
GameResult: Word;
Paused: Boolean;
procedure LRLLoadLevel(Number: Byte);
procedure LRLUpdatePlayers;
procedure LRLDrawOrnamental(x1, y1, x2, y2, ornament: Byte);
function LRLPlayLevel(Number: Byte): Word;
function LRLLevelCount: Word;
procedure LRLDeleteLevel(Count: Word);
procedure LRLInsertLevel(After: Word);
procedure LRLSaveLevel(Count: Word);
implementation
const
LevelFileName = 'LRL.LEV';
LevelFileHeader: String = 'Lode Runner Live Levels'#26;
ERR_OPENFILE = '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><> <20><EFBFBD><E0AEA2><EFBFBD>';
ERR_BADFILE = '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><E0A5A6><EFBFBD><EFBFBD><EFBFBD><EFBFBD><> <20><EFBFBD><E0AEA2><EFBFBD>';
function LRLLevelCount: Word;
var
LevelFile: File;
c, k: Word;
begin
c := 0;
AssignFile(LevelFile, LevelFileName);
Reset(LevelFile, 1);
Seek(LevelFile, 24);
BlockRead(LevelFile, c, 1, k);
LRLLevelCount := c;
Close(LevelFile);
end;
procedure LRLSaveLevel(Count: Word);
var
LevelFile: File;
i, j: Integer;
k: Word;
b: Pointer;
begin
GetMem(b, 480);
if (Count = 0) or (Count > LRLLevelCount) then
Exit;
AssignFile(LevelFile, LevelFileName);
Reset(LevelFile, 1);
Seek(LevelFile, Longint(25 + 520 * (Longint(Count) - 1)));
for i := 1 to 10 do
begin
DataBytePut(b^, (i - 1) * 4, LRLLevel.Player[i].Position.x);
DataBytePut(b^, (i - 1) * 4 + 1, LRLLevel.Player[i].Position.y);
DataBytePut(b^, (i - 1) * 4 + 2, LRLLevel.Player[i].Colour);
DataBytePut(b^, (i - 1) * 4 + 3, LRLLevel.Player[i].Controller);
end;
BlockWrite(LevelFile, b^, 40, k);
for i := 1 to 16 do
for j := 1 to 30 do
DataBytePut(b^, (i - 1) * 30 + j - 1, LRLLevel.Field[j, i].Image + 47);
BlockWrite(LevelFile, b^, 480, k);
Close(LevelFile);
FreeMem(b, 480);
end;
procedure LRLDeleteLevel(Count: Word);
var
Buffer: Pointer;
LevelFile: File;
i, j: Integer;
l: Longint;
k: Word;
begin
GetMem(Buffer, 1000);
j := LRLLevelCount;
if (j < Count) or (j < 2) or (Count = 0) then
Exit;
AssignFile(LevelFile, LevelFileName);
Reset(LevelFile, 1);
for l := Count + 1 to j do
begin
Seek(LevelFile, Longint(25 + 520 * (Longint(l) - 1)));
BlockRead(LevelFile, Buffer^, 520, k);
Seek(LevelFile, Longint(25 + 520 * (Longint(l - 1) - 1)));
BlockWrite(LevelFile, Buffer^, 520, k);
end;
Seek(LevelFile, 24);
Dec(j);
BlockWrite(LevelFile, j, 1, k);
Seek(LevelFile, FileSize(LevelFile) - 520);
Truncate(LevelFile);
Close(LevelFile);
FreeMem(Buffer, 1000);
end;
procedure LRLInsertLevel(After: Word);
var
Buffer: Pointer;
LevelFile: File;
i, j: Integer;
l: Longint;
k: Word;
begin
GetMem(Buffer, 1000);
j := LRLLevelCount;
if (After > j) or (After = 0) then
Exit;
AssignFile(LevelFile, LevelFileName);
Reset(LevelFile, 1);
for l := j downto After + 1 do
begin
Seek(LevelFile, Longint(25 + 520 * (Longint(l) - 1)));
BlockRead(LevelFile, Buffer^, 520, k);
Seek(LevelFile, Longint(25 + 520 * (Longint(l + 1) - 1)));
BlockWrite(LevelFile, Buffer^, 520, k);
end;
Seek(LevelFile, 24);
Inc(j);
BlockWrite(LevelFile, j, 1, k);
Seek(LevelFile, Longint(25 + 520 * (Longint(After + 1) - 1)));
DataFill(Buffer^, 40, 0, 0);
DataFill(Buffer^, 480, 48, 40);
BlockWrite(LevelFile, Buffer^, 520, k);
Close(LevelFile);
FreeMem(Buffer, 1000);
end;
procedure LRLLoadLevel(Number: Byte);
var
LevelFile: File;
InBuffer: Pointer;
i, j, k, l, x, y: Word;
a, b, c: Byte;
begin
TotalPrizes := 0;
GetMem(InBuffer, $FFF0);
AssignFile(LevelFile, LevelFileName);
Reset(LevelFile, 1);
if IOResult <> 0 then
raise Exception.Create(ERR_OPENFILE);
BlockRead(LevelFile, InBuffer^, 24, k);
BlockRead(LevelFile, c, 1, k);
if (c = 0) or (IOResult <> 0) or (not DataIdentical(InBuffer^, LevelFileHeader[1], 24, 0, 0)) then
raise Exception.Create(ERR_BADFILE);
if (Number = 0) or (Number > c) then Number := 1;
Seek(LevelFile, Longint(25 + 520 * (Longint(Number) - 1)));
BlockRead(LevelFile, InBuffer^, 40, k);
for i := 1 to 10 do
with LRLLevel.Player[i] do
begin
Command := 10;
NewCommandWas := False;
NewCommand := 10;
Position.x := DataByteGet(InBuffer^, (i - 1) * 4 + 0);
Position.y := DataByteGet(InBuffer^, (i - 1) * 4 + 1);
Position.xoffs := 0;
Position.yoffs := 0;
Sprite := 1;
SpriteData := 1;
Controller := DataByteGet(InBuffer^, (i - 1) * 4 + 3);
Prizes := 0;
Colour := DataByteGet(InBuffer^, (i - 1) * 4 + 2);
end;
BlockRead(LevelFile, InBuffer^, 480, k);
for i := 1 to 16 do for j := 1 to 30 do
with LRLLevel.Field[j, i] do
begin
a := DataByteGet(InBuffer^, (i - 1) * 30 + (j - 1));
for b := 1 to 10 do
if BrickFlags[b * 2 - 1] = a then
Flags := BrickFlags[b * 2];
Count := 1;
if a < 64 then
a := a - 47 else
a := a - 63;
Image := a;
IdleCount := 0;
if Image = 4 then Inc(TotalPrizes);
end;
BlockRead(LevelFile, InBuffer^, 480, k);
Close(LevelFile);
LRLCLevel := Number;
FreeMem(InBuffer, $FFF0);
end;
procedure LRLDrawOrnamental(x1, y1, x2, y2, ornament: Byte);
var
i: Integer;
begin
ImagePut(LRLScreen^, LRLDecoration[ornament].Image[6].Data^, x1 * 10, y1 * 10, 0, 0, 319, 199);
ImagePut(LRLScreen^, LRLDecoration[ornament].Image[7].Data^, x2 * 10, y1 * 10, 0, 0, 319, 199);
ImagePut(LRLScreen^, LRLDecoration[ornament].Image[5].Data^, x1 * 10, y2 * 10, 0, 0, 319, 199);
ImagePut(LRLScreen^, LRLDecoration[ornament].Image[8].Data^, x2 * 10, y2 * 10, 0, 0, 319, 199);
for i := x1 + 1 to x2 - 1 do
begin
ImagePut(LRLScreen^, LRLDecoration[ornament].Image[3].Data^, i * 10, y1 * 10, 0, 0, 319, 199);
ImagePut(LRLScreen^, LRLDecoration[ornament].Image[4].Data^, i * 10, y2 * 10, 0, 0, 319, 199);
end;
for i := y1 + 1 to y2 - 1 do
begin
ImagePut(LRLScreen^, LRLDecoration[ornament].Image[2].Data^, x1 * 10, i * 10, 0, 0, 319, 199);
ImagePut(LRLScreen^, LRLDecoration[ornament].Image[1].Data^, x2 * 10, i * 10, 0, 0, 319, 199);
end;
end;
procedure LRLRedrawLevel;
var
i, j: Integer;
s: string;
begin
ImageClear(LRLScreen^);
for i := 1 to 16 do for j := 1 to 30 do
with LRLLevel.Field[j, i] do
if ((Flags and 128) = 0) and ((Flags and 32) <> 0) and ((Flags and 16) = 0) then
ImagePut(LRLScreen^, LRLEnvironment[Image].Image[Count].Data^,j * 10, i * 10, 0, 0, 319, 199);
for i := 1 to 10 do
with LRLLevel.Player[i] do
if Controller <> 0 then
ImagePutTransparent(LRLScreen^, LRLFigure[Colour, SpriteData].Image[Sprite].Data^,Position.x * 10 + Position.xoffs, Position.y * 10 + Position.yoffs, 0, 0, 319, 199);
for i := 1 to 16 do for j := 1 to 30 do
with LRLLevel.Field[j, i] do
if ((Flags and 128) = 0) and ((Flags and 32) = 0) and ((Flags and 16) = 0) then
ImagePutTransparent(LRLScreen^, LRLEnvironment[Image].Image[LRLLevel.Field[j, i].Count].Data^, j * 10, i * 10, 0, 0, 319, 199);
if not Paused then
begin
if ShowScore then
begin
STR(LRLScore, s);
ImageStringGet(s, LRLFont^, LRLFontBuffer^, 222);
ImagePut(LRLScreen^, LRLFontBuffer^, 56, 185, 0, 0, 319, 199);
ImageStringGet('Score: ', LRLFont^, LRLFontBuffer^, 254);
ImagePut(LRLScreen^, LRLFontBuffer^, 10, 185, 0, 0, 319, 199);
end;
if ShowLives then
begin
STR(LRLLives, s);
ImageStringGet(s, LRLFont^, LRLFontBuffer^, 222);
ImagePut(LRLScreen^, LRLFontBuffer^, 177, 185, 0, 0, 319, 199);
ImageStringGet('Lives: ', LRLFont^, LRLFontBuffer^, 254);
ImagePut(LRLScreen^, LRLFontBuffer^, 135, 185, 0, 0, 319, 199);
end;
if ShowLevel then
begin
Str(LRLCLevel, s);
ImageStringGet(s, LRLFont^, LRLFontBuffer^, 222);
ImagePut(LRLScreen^, LRLFontBuffer^, 292, 185, 0, 0, 319, 199);
ImageStringGet('Level: ', LRLFont^, LRLFontBuffer^, 254);
ImagePut(LRLScreen^, LRLFontBuffer^, 250, 185, 0, 0, 319, 199);
end;
end
else
begin
ImageStringGet('Game now paused', LRLFont^, LRLFontBuffer^, 254);
ImagePut(LRLScreen^, LRLFontBuffer^, 160 - ImageSizex(LRLFontBuffer^) div
2, 185, 0, 0, 319, 199);
end;
LRLDrawOrnamental(0, 0, 31, 17, 1);
end;
procedure LRLStartSequence;
var
tmpScreen1: Pointer;
tmpScreen2: Pointer;
i: Integer;
begin
GetMem(tmpScreen1, 64000);
GetMem(tmpScreen2, 49000);
ImageFill(tmpScreen2^, 300, 160, 0);
LRLRedrawLevel;
i := 0;
while i < 100 do
begin
DataMove(LRLScreen^, tmpScreen1^, 64000, 0, 0);
ImagePut(tmpScreen1^, tmpScreen2^, 10, 10, 0, i, 319, 199 - i);
ScreenApply(tmpScreen1^);
Sleep(20);
i := i + 4;
end;
ScreenApply(LRLScreen^);
FreeMem(tmpScreen1, 64000);
FreeMem(tmpScreen2, 49000);
end;
procedure LRLEndSequence;
var
tmpScreen1: Pointer;
tmpScreen2: Pointer;
i: Integer;
begin
GetMem(tmpScreen1, 64000);
GetMem(tmpScreen2, 49000);
ImageFill(tmpScreen2^, 300, 160, 0);
LRLRedrawLevel;
i := 100;
while i > 0 do
begin
DataMove(LRLScreen^, tmpScreen1^, 64000, 0, 0);
ImagePut(tmpScreen1^, tmpScreen2^, 10, 10, 0, i, 319, 199 - i);
ScreenApply(tmpScreen1^);
Sleep(20);
i := i - 4;
end;
ImagePut(LRLScreen^, tmpScreen2^, 10, 10, 0, 0, 319, 199);
ScreenApply(LRLScreen^);
FreeMem(tmpScreen1, 64000);
FreeMem(tmpScreen2, 49000);
end;
{
game result:
1 - zamurovali
2 - poimali
10 - vse zdelano
50 - no more levels
60 - no human players
100 - esc was pressed
}
procedure LRLUpdatePlayers;
var
i, j, k: Integer;
spd: Word;
begin
for i := 1 to 10 do
begin
with LRLLevel.Player[i] do
begin
if Controller <> 0 then
begin
if (LRLLevel.Field[Position.x, Position.y].Flags and 2 <> 0) then
begin
if i = 1 then
begin
EndOfGame := True;
GameResult := 1;
Exit;
end;
if Prizes <> 0 then
begin
Prizes := 0;
LRLLevel.Field[Position.x, Position.y - 1].Image := 4;
LRLLevel.Field[Position.x, Position.y - 1].Flags := BrickFlags[8];
end;
repeat
Position.y := Random(2) + 1;
Position.x := Random(30) + 1;
until (LRLLevel.Field[Position.x, Position.y].Image = 1) or
(LRLLevel.Field[Position.x, Position.y].Image = 2) or
(LRLLevel.Field[Position.x, Position.y].Image = 3) or
(LRLLevel.Field[Position.x, Position.y].Image = 4);
Command := 10;
Continue;
end;
if LRLLevel.Field[Position.x, Position.y].Image = 4 then
if Controller = 2 then
if Prizes = 0 then
begin
Inc(Prizes);
LRLLevel.Field[Position.x, Position.y].Image := 1;
LRLLevel.Field[Position.x, Position.y].Flags := BrickFlags[2];
end else else
begin
Dec(TotalPrizes);
LRLScore := LRLScore + 100 * Longint(LRLCLevel);
LRLLevel.Field[Position.x, Position.y].Image := 1;
LRLLevel.Field[Position.x, Position.y].Flags := BrickFlags[2];
end;
if (i = 1) then
begin
if (TotalPrizes = 0) and (Position.y = 1) and
(LRLLevel.Field[Position.x, Position.y].Image = 2) then
begin
EndOfGame := True;
GameResult := 10;
Exit;
end;
for k := 2 to 10 do
if (LRLLevel.Player[k].Controller <> 0) then
if (LRLLevel.Player[k].Position.x = Position.x) and
(LRLLevel.Player[k].Position.y = Position.y) then
begin
EndOfGame := True;
GameResult := 2;
Exit;
end;
end;
if (LRLLevel.Field[Position.x, Position.y].Flags and 1 <> 0) then
begin
if (Controller = 2) then
begin
if Prizes <> 0 then
begin
Prizes := 0;
LRLLevel.Field[Position.x, Position.y - 1].Image := 4;
LRLLevel.Field[Position.x, Position.y - 1].Flags := BrickFlags[8];
end;
end;
end;
if Controller = 2 then
spd := 2
else
spd := 3;
if (LRLLevel.Field[Position.x, Position.y + 1].Flags and 4 <> 0) and
(LRLLevel.Field[Position.x, Position.y].Image <> 3) and
((LRLLevel.Field[Position.x, Position.y].Image <> 2) or
(LRLLevel.Field[Position.x, Position.y].Flags and 16 <> 0)) and
(Position.y < 16) then
begin
k := 2;
while k <= 10 do
if (k <> i) and (LRLLevel.Player[k].Controller <> 0) and
(LRLLevel.Player[k].Position.x = Position.x) and
(LRLLevel.Player[k].Position.y = Position.y + 1) and
(Position.y < 16) then
begin
k := 100;
Break;
end else
Inc(k);
if k <> 100 then
begin
NewCommand := 5;
NewCommandWas := True;
end;
end;
if NewCommandWas then
begin
if (NewCommand <> Command) and (Command <> 5) then
begin
Command := NewCommand;
Sprite := 1;
end;
NewCommandWas := False;
end;
if (Command = 1) then
begin
if (LRLLevel.Field[Position.x, Position.y].Image = 3) then
begin
if Position.xoffs < 1 then
begin
if ((LRLLevel.Field[Position.x - 1, Position.y].Flags and 8 = 0) and
(LRLLevel.Field[Position.x - 1, Position.y].Image <> 3)) or
(LRLLevel.Field[Position.x, Position.y].Image <> 3) or (Position.x = 1) then
begin
Command := 10;
Position.xoffs := 0;
end;
end;
if (Command <> 10) and (SpriteData <> 6) then
begin
SpriteData := 6;
Sprite := 1;
end;
end else
begin
if Position.xoffs < 1 then
begin
if (LRLLevel.Field[Position.x - 1, Position.y].Flags and 8 = 0) or (Position.x = 1) then
begin
Command := 10;
Position.xoffs := 0;
end;
end;
if (Command <> 10) and (SpriteData <> 1) then SpriteData := 1;
end;
if Command <> 10 then
begin
k := 1;
while (k > 0) do
begin
Inc(k);
if k = 11 then
begin
if (SpriteData = 6) then
begin
if (Sprite = 2) then Dec(Position.xoffs, 5) else
if (Sprite = 3) then Dec(Position.xoffs, 1);
end else
Dec(Position.xoffs, spd);
Break;
end;
if (k <> i) and (i <> 1) and
(LRLLevel.Player[k].Controller <> 0) and
(LRLLevel.Player[k].Position.x = Position.x - 1) and
(LRLLevel.Player[k].Position.y = Position.y) then
begin
Command := 10;
Break;
end;
end;
end;
end;
if (Command = 2) then
begin
if (LRLLevel.Field[Position.x, Position.y].Image = 3) then
begin
if Position.xoffs > -1 then
begin
if ((LRLLevel.Field[Position.x + 1, Position.y].Flags and 8 = 0) and
(LRLLevel.Field[Position.x + 1, Position.y].Image <> 3)) or
(LRLLevel.Field[Position.x, Position.y].Image <> 3) or (Position.x = 30) then
begin
Command := 10;
Position.xoffs := 0;
end;
end;
if (Command <> 10) and (SpriteData <> 7) then
begin
SpriteData := 7;
Sprite := 1;
end;
end
else
begin
if Position.xoffs > -1 then
begin
if (LRLLevel.Field[Position.x + 1, Position.y].Flags and 8 = 0) or (Position.x = 30) then
begin
Command := 10;
Position.xoffs := 0;
end;
end;
if (Command <> 10) and (SpriteData <> 2) then
SpriteData := 2;
end;
if Command <> 10 then
begin
k := 1;
while (k > 0) do
begin
Inc(k);
if k = 11 then
begin
if (SpriteData = 7) then
begin
if (Sprite = 2) then
Inc(Position.xoffs, 5);
if (Sprite = 3) then
Inc(Position.xoffs, 1);
end
else
Inc(Position.xoffs, spd);
Break;
end;
if (k <> i) and (i <> 1) and (LRLLevel.Player[k].Controller <> 0) then
if (LRLLevel.Player[k].Position.x = Position.x + 1) and
(LRLLevel.Player[k].Position.y = Position.y) then
begin
Command := 10;
Break;
end;
end;
end;
end;
if (Command = 3) then
begin
if Position.yoffs < 1 then
begin
if ((LRLLevel.Field[Position.x, Position.y].Image <> 2) or
(LRLLevel.Field[Position.x, Position.y].Flags and 16 <> 0)) or
((LRLLevel.Field[Position.x, Position.y - 1].Flags and 4 = 0) and
((LRLLevel.Field[Position.x, Position.y - 1].Image <> 2) or
(LRLLevel.Field[Position.x, Position.y - 1].Flags and 16 <> 0))) or
(Position.y < 2) then
begin
Command := 10;
Position.yoffs := 0;
end;
end;
if (Command <> 10) and (SpriteData <> 3) then
SpriteData := 3;
if Command <> 10 then
begin
k := 1;
while (k > 0) do
begin
Inc(k);
if k = 11 then
begin
Dec(Position.yoffs, spd);
Break;
end;
if (k <> i) and (i <> 1) and (LRLLevel.Player[k].Controller <> 0) then
if (LRLLevel.Player[k].Position.y = Position.y - 1) and
(LRLLevel.Player[k].Position.x = Position.x) then
begin
Command := 10;
Break;
end;
end;
end;
end;
if (Command = 4) then
begin
if (LRLLevel.Field[Position.x, Position.y].Image = 3) and
((LRLLevel.Field[Position.x, Position.y + 1].Image <> 2) or
(LRLLevel.Field[Position.x, Position.y + 1].Flags and 16 <> 0)) and
(Position.y < 16) then
begin
Command := 5;
Sprite := 1;
if (LRLLevel.Field[Position.x, Position.y + 1].Flags and 4 <> 0) then
Inc(Position.yoffs);
end
else
begin
if Position.yoffs > -1 then
begin
if (((LRLLevel.Field[Position.x, Position.y + 1].Image <> 2) or
(LRLLevel.Field[Position.x, Position.y + 1].Flags and 16 <> 0)) and
(LRLLevel.Field[Position.x, Position.y + 1].Flags and 4 = 0)) or
(Position.y = 16) then
begin
Command := 10;
Position.yoffs := 0;
end;
end;
if (Command <> 10) and (SpriteData <> 4) then
SpriteData := 4;
if Command <> 10 then
begin
k := 1;
while (k > 0) do
begin
Inc(k);
if k = 11 then
begin
Inc(Position.yoffs, spd);
Break;
end;
if (k <> i) and (i <> 1) and (LRLLevel.Player[k].Controller <> 0) then
if (LRLLevel.Player[k].Position.y = Position.y + 1) and
(LRLLevel.Player[k].Position.x = Position.x) then
begin
Command := 10;
Break;
end;
end;
end;
end;
end;
if (Command = 5) then
begin
if Position.yoffs < 1 then
begin
if (LRLLevel.Field[Position.x, Position.y + 1].Flags and 4 = 0) or
(Position.y = 16) or (LRLLevel.Field[Position.x, Position.y].Image = 3) or
((LRLLevel.Field[Position.x, Position.y].Flags and 1 <> 0) and (i <> 1)) then
begin
Command := 10;
if (LRLLevel.Field[Position.x, Position.y].Image = 3) then
SpriteData := 5;
Position.yoffs := 0;
Position.xoffs := 0;
end;
for k := 2 to 10 do
if (k <> i) and (LRLLevel.Player[k].Controller <> 0) then
if (LRLLevel.Player[k].Position.x = Position.x) and
(LRLLevel.Player[k].Position.y = Position.y + 1) and
(LRLLevel.Field[Position.x, Position.y + 1].Flags and 1 <> 0) and
(Position.y < 16) then
begin
Command := 10;
Position.yoffs := 0;
Break;
end;
end;
if (Command <> 10) and (SpriteData <> 5) then
begin
SpriteData := 5;
Sprite := 1;
end;
if Command <> 10 then
begin
Inc(Position.yoffs, 2);
end;
end;
if (Command = 6) then
begin
if (Position.y < 16) and (Position.x > 1) and
(LRLLevel.Field[Position.x - 1, Position.y + 1].Image = 9) and
(LRLLevel.Field[Position.x - 1, Position.y + 1].Flags and 1 = 0) and
(((LRLLevel.Field[Position.x - 1, Position.y].Image = 1) or
(LRLLevel.Field[Position.x - 1, Position.y].Flags and 1 <> 0)) or
(LRLLevel.Field[Position.x - 1, Position.y].Flags and 16 <> 0)) then
begin
NewCommandWas := True;
for k := 2 to 10 do
if (k <> i) and (LRLLevel.Player[k].Controller <> 0) then
if (LRLLevel.Player[k].Position.x = Position.x - 1) and
(LRLLevel.Player[k].Position.y = Position.y) then
begin
NewCommandWas := False;
Break;
end;
if NewCommandWas then
begin
LRLLevel.Field[Position.x - 1, Position.y + 1].Flags :=
LRLLevel.Field[Position.x - 1, Position.y + 1].Flags or 1;
Position.xoffs := 0;
SpriteData := 8;
NewCommandWas := False;
end;
end;
Command := 10;
end;
if (Command = 7) then
begin
if (Position.y < 16) and (Position.x < 30) and
(LRLLevel.Field[Position.x + 1, Position.y + 1].Image = 9) and
(LRLLevel.Field[Position.x + 1, Position.y + 1].Flags and 1 = 0) and
(((LRLLevel.Field[Position.x + 1, Position.y].Image = 1) or
(LRLLevel.Field[Position.x + 1, Position.y].Flags and 1 <> 0)) or
(LRLLevel.Field[Position.x + 1, Position.y].Flags and 16 <> 0)) then
begin
NewCommandWas := True;
for k := 2 to 10 do
if (k <> i) and (LRLLevel.Player[k].Controller <> 0) then
if (LRLLevel.Player[k].Position.x = Position.x + 1) and
(LRLLevel.Player[k].Position.y = Position.y) then
begin
NewCommandWas := False;
Break;
end;
if NewCommandWas then
begin
LRLLevel.Field[Position.x + 1, Position.y + 1].Flags :=
LRLLevel.Field[Position.x + 1, Position.y + 1].Flags or 1;
Position.xoffs := 0;
SpriteData := 9;
NewCommandWas := False;
end;
end;
Command := 10;
end;
if (Command = 1) or (Command = 2) then
if Position.yoffs < 0 then Inc(Position.yoffs) else
if Position.yoffs > 0 then Dec(Position.yoffs);
if (Command = 3) or (Command = 4) or (Command = 5) then
if Position.xoffs < 0 then Inc(Position.xoffs) else
if Position.xoffs > 0 then Dec(Position.xoffs);
if Command < 6 then
begin
Inc(Sprite);
if Sprite > LRLFigure[Colour, SpriteData].ImageCount then Sprite := 1;
if Position.xoffs < -4 then
begin
Dec(Position.x);
Position.xoffs := 10 + Position.xoffs;
end;
if Position.xoffs > 5 then
begin
Inc(Position.x);
Position.xoffs := Position.xoffs - 10;
end;
if Position.yoffs < -4 then
begin
Dec(Position.y);
Position.yoffs := 10 + Position.yoffs;
end;
if Position.yoffs > 5 then
begin
Inc(Position.y);
Position.yoffs := Position.yoffs - 10;
end;
end;
end;
end;
end;
end;
procedure LRLUpdateBricks;
var
i, j, k: Integer;
begin
for i := 1 to 16 do
for j := 1 to 30 do
begin
if LRLLevel.Field[j, i].Flags and 1 <> 0 then
begin
if LRLLevel.Field[j, i].Count = 1 then
begin
LRLLevel.Field[j, i].Flags := LRLLevel.Field[j, i].Flags and $FF - 2;
LRLLevel.Field[j, i].Flags := LRLLevel.Field[j, i].Flags or 4 + 8;
end;
if LRLLevel.Field[j, i].IdleCount = 0 then
begin
Inc(LRLLevel.Field[j, i].Count);
if LRLLevel.Field[j, i].Count < 6 then
begin
for k := 2 to 10 do
if (LRLLevel.Player[k].Controller <> 0) then
if (LRLLevel.Player[k].Position.x = j) and
(LRLLevel.Player[k].Position.y = i - 1) then
begin
LRLLevel.Field[j, i].Count := 13 - LRLLevel.Field[j, i].Count;
LRLLevel.Field[j, i].Flags := LRLLevel.Field[j, i].Flags or 2;
LRLLevel.Field[j, i].Flags := LRLLevel.Field[j, i].Flags and $FE - 4 - 8;
LRLLevel.Field[j, i].Count := 1;
Break;
end;
end;
if LRLLevel.Field[j, i].Count = 6 then
begin
LRLLevel.Field[j, i].IdleCount := 100;
end;
end
else
Dec(LRLLevel.Field[j, i].IdleCount);
if LRLLevel.Field[j, i].Count = 12 then
begin
LRLLevel.Field[j, i].Flags := LRLLevel.Field[j, i].Flags or 2;
LRLLevel.Field[j, i].Flags := LRLLevel.Field[j, i].Flags and $FE - 4 - 8;
LRLLevel.Field[j, i].Count := 1;
end;
end;
end;
end;
procedure LRLComputerPlayer;
var
k, l, m, f1, f2, i, j: Integer;
begin
if ComputerTurn >= ComputerReaction then
begin
ComputerTurn := 0;
for k := 1 to 10 do
begin
with LRLLevel.Player[k] do
begin
if Controller = 2 then
begin
NewCommandWas := True;
NewCommand := 10;
if (Position.y > LRLLevel.Player[1].Position.y) then
begin
if ((LRLLevel.Field[Position.x, Position.y].Image = 2) and
(LRLLevel.Field[Position.x, Position.y].Flags and 16 = 0) and
((LRLLevel.Field[Position.x, Position.y - 1].Image = 2) or
(LRLLevel.Field[Position.x, Position.y - 1].Flags and 4 <> 0)) and
(Position.y > 1)) then
begin
NewCommand := 3;
end
else
begin
m := 1;
l := Position.x;
i := 1;
while i <> 0 do
begin
l := l + i;
if ((LRLLevel.Field[l, Position.y].Image = 2) and
(LRLLevel.Field[l, Position.y].Flags and 16 = 0)) and
((LRLLevel.Field[l, Position.y - 1].Image = 2) and
(LRLLevel.Field[l, Position.y - 1].Flags and 16 = 0)) and (Position.y <> 1) then
begin
if m = 0 then
begin
f2 := Position.x - l;
Break;
end;
m := 0;
i := not i + 1;
f1 := l - Position.x;
l := Position.x;
end
else
if (LRLLevel.Field[l, Position.y].Flags and 8 = 0) or (l > 30) or (l < 1) then
begin
if m = 0 then
begin
f2 := 100;
Break;
end;
m := 0;
i := not i + 1;
l := Position.x;
f1 := 100;
end;
end;
if (f1 = 100) and (f2 = 100) then
NewCommand := 10
else
begin
if f1 > f2 then
NewCommand := 1
else
NewCommand := 2;
end;
end;
end
else
if (Position.y < LRLLevel.Player[1].Position.y) then
begin
if (((LRLLevel.Field[Position.x, Position.y + 1].Image = 2) and
(LRLLevel.Field[Position.x, Position.y + 1].Flags and 16 = 0)) or
(LRLLevel.Field[Position.x, Position.y + 1].Flags and 4 <> 0)) and
(Position.y < 16) and (LRLLevel.Field[Position.x, Position.y + 1].Flags and 1 = 0) then
begin
NewCommand := 4;
end
else
begin
m := 1;
l := Position.x;
i := 1;
while i <> 0 do
begin
l := l + i;
if ((LRLLevel.Field[l, Position.y + 1].Image = 2) and
(LRLLevel.Field[l, Position.y + 1].Flags and 16 = 0)) or
((LRLLevel.Field[l, Position.y + 1].Flags and 4 <> 0) and
(LRLLevel.Field[l, Position.y + 1].Flags and 1 = 0)) then
begin
if m = 0 then
begin
f2 := Position.x - l;
Break;
end;
m := 0;
i := not i + 1;
f1 := l - Position.x;
l := Position.x;
end
else
if (LRLLevel.Field[l, Position.y].Flags and 8 = 0) or (l > 30) or (l < 1) then
begin
if m = 0 then
begin
f2 := 100;
Break;
end;
m := 0;
i := not i + 1;
l := Position.x;
f1 := 100;
end;
end;
if (f1 = 100) and (f2 = 100) then
NewCommand := 10
else
begin
if f1 > f2 then
NewCommand := 1
else
NewCommand := 2;
end;
end;
end
else
begin
if (Position.x > LRLLevel.Player[1].Position.x) then
NewCommand := 1;
if (Position.x < LRLLevel.Player[1].Position.x) then
NewCommand := 2;
end;
end;
end;
end;
end
else
Inc(ComputerTurn);
end;
function LRLPlayLevel(Number: Byte): Word;
var
Keypress: Word;
i: Word;
L, C: Longword;
begin
Randomize;
ComputerReaction := 1;
LRLLoadLevel(Number);
if LRLCLevel <> Number then
begin
GameResult := 50;
Exit;
end;
if LRLLevel.Player[1].Controller <> 1 then
begin
GameResult := 60;
Exit;
end;
TimeToRefresh := True;
GameStarted := False;
GameResult := 0;
Paused := False;
EndOfGame := False;
LRLStartSequence;
Keypress := 0;
L := 0;
repeat
C := LastDosTick();
if L <> C then
begin
L := C;
if GameStarted and not Paused then
begin
LRLComputerPlayer;
LRLUpdatePlayers;
LRLUpdateBricks;
end;
LRLRedrawLevel;
ScreenApply(LRLScreen^);
end else
Sleep(20);
if Keypressed then
begin
Keypress := ReadKey;
GameStarted := True;
Paused := False;
for i := 0 to ControlNumber - 1 do
if KeyboardControls[i * 3 + 1] = Keypress then
begin
LRLLevel.Player[KeyboardControls[i * 3 + 2]].NewCommand := KeyboardControls[i * 3 + 3];
LRLLevel.Player[KeyboardControls[i * 3 + 2]].NewCommandWas := True;
end;
if (Keypress = $50) or (Keypress = $70) then
Paused := True;
end;
until (Keypress = $1B) or EndOfGame;
if EndOfGame then
LRLEndSequence else
GameResult := 100;
end;
end.