KolibriOS/kolibrios
13
4
Fork 12
Code Issues 78 Pull Requests 5 Projects Releases Activity
df2ca4bbd5
kolibrios/programs/games/lrl/LRLLevels.pp

1195 lines
35 KiB
ObjectPascal
Raw Normal View History

Lode Runner Live game git-svn-id: svn://kolibrios.org@670 a494cfbc-eb01-0410-851d-a64ba20cac60
2007-11-01 13:36:59 +01:00
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.
Reference in New Issue Copy Permalink