forked from KolibriOS/kolibrios
Lode Runner Live game
git-svn-id: svn://kolibrios.org@670 a494cfbc-eb01-0410-851d-a64ba20cac60
This commit is contained in:
bw
parent
f259abc5ff
commit
4cc19614ca
83
programs/games/lrl/LRL.pp
Normal file
83
programs/games/lrl/LRL.pp
Normal file
@ -0,0 +1,83 @@
|
||||
program LodeRunnerLive;
|
||||
|
||||
{$apptype gui}
|
||||
|
||||
|
||||
uses
|
||||
LRLRoutines,
|
||||
LRLSprites,
|
||||
LRLLevels,
|
||||
LRLMainMenu,
|
||||
{LRLHighScores,
|
||||
LRLEditor,}
|
||||
LRLIntroduction;
|
||||
|
||||
const
|
||||
Version: array [1..34] of char = 'Lode Runner LIVE. Version 1.0'#13#10#13#10'$';
|
||||
|
||||
|
||||
procedure LRLInitialize;
|
||||
begin
|
||||
kos_setkeyboardmode(0);
|
||||
ImagesInitialize;
|
||||
end;
|
||||
|
||||
|
||||
procedure LRLDeinitialize;
|
||||
begin
|
||||
ImagesDeinitialize;
|
||||
end;
|
||||
|
||||
|
||||
procedure LRLGameStart;
|
||||
var
|
||||
cl: Integer;
|
||||
begin
|
||||
Palette256Set(LRLPalette^);
|
||||
|
||||
ShowLives := True;
|
||||
ShowScore := True;
|
||||
ShowLevel := True;
|
||||
LRLLives := 5;
|
||||
LRLScore := 0;
|
||||
|
||||
cl := 1;
|
||||
repeat
|
||||
LRLPlayLevel(cl);
|
||||
KeyboardFlush;
|
||||
if GameResult = 10 then
|
||||
begin
|
||||
Inc(LRLLives);
|
||||
LRLScore := LRLScore + 10000 * longint(cl);
|
||||
Inc(cl);
|
||||
end else
|
||||
Dec(LRLLives);
|
||||
until (LRLLives = 0) or (GameResult = 100);
|
||||
|
||||
{(GameResult <> 100) and LRLBestScore(LRLScore) then
|
||||
begin
|
||||
LRLInsertScore(LRLEnterName, LRLScore);
|
||||
LRLShowHighScores;
|
||||
end;}
|
||||
end;
|
||||
|
||||
procedure LRLShell;
|
||||
var
|
||||
MenuSelection: word;
|
||||
begin
|
||||
MenuSelection := 1;
|
||||
repeat
|
||||
LRLSelectItem(MenuSelection);
|
||||
if MenuSelection = 1 then LRLGameStart;
|
||||
{if MenuSelection = 2 then LRLEditLevels;
|
||||
if MenuSelection = 3 then LRLShowHighScores;}
|
||||
until MenuSelection = 4;
|
||||
end;
|
||||
|
||||
|
||||
begin
|
||||
LRLInitialize;
|
||||
LRLIntro;
|
||||
LRLShell;
|
||||
LRLDeinitialize;
|
||||
end.
|
||||
304
programs/games/lrl/LRLEditor.pp
Normal file
304
programs/games/lrl/LRLEditor.pp
Normal file
@ -0,0 +1,304 @@
|
||||
unit LRLEditor;
|
||||
|
||||
interface
|
||||
|
||||
uses DOSFileAccess, LRLRoutines, LRLSprites, LRLLevels;
|
||||
|
||||
procedure LRLEditLevels;
|
||||
|
||||
implementation
|
||||
|
||||
var
|
||||
CurrentLevel: word;
|
||||
CurrentTool: word;
|
||||
TotalLevels: word;
|
||||
MouseX, MouseY: integer;
|
||||
TimeToRefresh: boolean;
|
||||
RefreshDelay: word;
|
||||
RefreshRemain: word;
|
||||
OldTimer: POINTER;
|
||||
|
||||
procedure LRLRedrawLevel;
|
||||
var
|
||||
i, j: integer;
|
||||
begin
|
||||
ImageClear(LRLScreen^);
|
||||
for i := 1 to 16 do
|
||||
for j := 1 to 30 do
|
||||
with LRLLevel.Field[j, i] do
|
||||
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
|
||||
begin
|
||||
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);
|
||||
end;
|
||||
ImageFill(LRLFontBuffer^, 12, 12, 252);
|
||||
ImagePut(LRLScreen^, LRLFontBuffer^, 10, 184, 0, 0, 319, 199);
|
||||
for i := 1 to 13 do
|
||||
begin
|
||||
if i > 9 then
|
||||
ImagePut(LRLScreen^, LRLFigure[i - 9, 1].Image[1].Data^, i * 15 - 4, 185, 0, 0, 319, 199)
|
||||
else
|
||||
ImagePut(LRLScreen^, LRLEnvironment[i].Image[1].Data^, i * 15 - 4, 185, 0, 0, 319, 199);
|
||||
end;
|
||||
for i := 1 to 6 do
|
||||
begin
|
||||
if LRLEditorButton[i].Lit then
|
||||
ImagePut(LRLScreen^, LRLEditorButton[i].LightIcon^, LRLEditorButton[i].x1,
|
||||
LRLEditorButton[i].y1, 0, 0, 319, 199)
|
||||
else
|
||||
ImagePut(LRLScreen^, LRLEditorButton[i].DarkIcon^, LRLEditorButton[i].x1,
|
||||
LRLEditorButton[i].y1, 0, 0, 319, 199);
|
||||
end;
|
||||
LRLDrawOrnamental(0, 0, 31, 17, 1);
|
||||
end;
|
||||
|
||||
procedure RefreshRunner;
|
||||
{INTERRUPT;
|
||||
ASSEMBLER;}
|
||||
asm
|
||||
DEC RefreshRemain
|
||||
JNZ @DoTimer
|
||||
|
||||
MOV AX,RefreshDelay
|
||||
MOV RefreshRemain,AX
|
||||
MOV TimeToRefresh,-1
|
||||
|
||||
@DoTimer:
|
||||
PUSHF
|
||||
CALL OldTimer
|
||||
end;
|
||||
|
||||
procedure LRLMoveMouse;
|
||||
var
|
||||
s, s2: string[20];
|
||||
begin
|
||||
MSMouseGetXY(Mousex, Mousey);
|
||||
if not MSMouseInArea(200, 180, 325, 205) then
|
||||
begin
|
||||
if CurrentTool < 10 then
|
||||
ImagePut(LRLScreen^, LRLEnvironment[CurrentTool].Image[1].Data^,
|
||||
Mousex - 5, Mousey - 5, 0, 0, 319, 199)
|
||||
else
|
||||
ImagePut(LRLScreen^, LRLFigure[CurrentTool - 9, 1].Image[1].Data^,
|
||||
Mousex - 5, Mousey - 5, 0, 0, 319, 199);
|
||||
end;
|
||||
if not MSMouseInArea(-2, -2, 55, 20) then
|
||||
begin
|
||||
ImageFill(LRLFontBuffer^, 50, 15, 0);
|
||||
ImagePut(LRLScreen^, LRLFontBuffer^, 0, 0, 0, 0, 319, 199);
|
||||
STR(CurrentLevel, s);
|
||||
STR(TotalLevels, s2);
|
||||
ImageStringGet(s + '/' + s2, LRLFont^, LRLFontBuffer^, 251);
|
||||
ImagePut(LRLScreen^, LRLFontBuffer^, 25 - ImageSizex(LRLFontBuffer^) div 2, 0, 0, 0, 319, 199);
|
||||
end;
|
||||
ImagePutTransparent(LRLScreen^, LRLMousePointer^, Mousex, Mousey, 0, 0, 319, 199);
|
||||
end;
|
||||
|
||||
procedure RePress;
|
||||
var
|
||||
x, y: integer;
|
||||
begin
|
||||
MSMouseButtonWasPressed(1, x, y);
|
||||
MSMouseButtonWasReleased(1, x, y);
|
||||
MSMouseButtonWasPressed(4, x, y);
|
||||
MSMouseButtonWasReleased(4, x, y);
|
||||
end;
|
||||
|
||||
procedure LRLEditLevels;
|
||||
var
|
||||
Keypress: word;
|
||||
NeedToFade: boolean;
|
||||
DrawNow: boolean;
|
||||
i, j: integer;
|
||||
x, y: integer;
|
||||
Cmd: word;
|
||||
begin
|
||||
if not MSMouseDriverExist then Exit;
|
||||
Repress;
|
||||
ShowLives := False;
|
||||
ShowScore := False;
|
||||
Palette256Set(LRLPalette^);
|
||||
OldTimer := SetInterrupt($8, @RefreshRunner);
|
||||
Keypress := 0;
|
||||
RefreshDelay := 1;
|
||||
RefreshRemain := 1;
|
||||
CurrentLevel := 1;
|
||||
CurrentTool := 2;
|
||||
TotalLevels := LRLLevelCount;
|
||||
TimeToRefresh := True;
|
||||
DrawNow := False;
|
||||
MSMouseSetXY(160, 100);
|
||||
LRLLoadLevel(CurrentLevel);
|
||||
repeat
|
||||
if TimeToRefresh then
|
||||
begin
|
||||
LRLRedrawLevel;
|
||||
LRLMoveMouse;
|
||||
ScreenApply(LRLScreen^);
|
||||
TimeToRefresh := False;
|
||||
end;
|
||||
if Keypressed then
|
||||
begin
|
||||
Keypress := Readkey;
|
||||
end;
|
||||
if MSMouseButtonWasReleased(1, x, y) then
|
||||
begin
|
||||
LRLScore := 0;
|
||||
FadeClear;
|
||||
ImageClear(LRLScreen^);
|
||||
ScreenApply(LRLScreen^);
|
||||
Palette256Set(LRLPalette^);
|
||||
LRLPlayLevel(CurrentLevel);
|
||||
FadeClear;
|
||||
ImageClear(LRLScreen^);
|
||||
ScreenApply(LRLScreen^);
|
||||
Palette256Set(LRLPalette^);
|
||||
LRLLoadLevel(CurrentLevel);
|
||||
Repress;
|
||||
end;
|
||||
if MSMouseButtonWasPressed(0, x, y) then
|
||||
begin
|
||||
DrawNow := True;
|
||||
end;
|
||||
if MSMouseButtonWasReleased(0, x, y) then
|
||||
begin
|
||||
DrawNow := False;
|
||||
Cmd := 0;
|
||||
for i := 1 to 6 do
|
||||
LRLEditorButton[i].Lit := False;
|
||||
for i := 1 to 6 do
|
||||
begin
|
||||
if MSMouseInArea(LRLEditorButton[i].x1, LRLEditorButton[i].y1,
|
||||
LRLEditorButton[i].x2, LRLEditorButton[i].y2) then
|
||||
begin
|
||||
Cmd := LRLEditorButton[i].Command;
|
||||
BREAK;
|
||||
end;
|
||||
end;
|
||||
if (Cmd = 1) then
|
||||
LRLSaveLevel(CurrentLevel);
|
||||
Repress;
|
||||
if (Cmd = 2) then
|
||||
begin
|
||||
LRLInsertLevel(CurrentLevel);
|
||||
Inc(CurrentLevel);
|
||||
TotalLevels := LRLLevelCount;
|
||||
LRLLoadLevel(CurrentLevel);
|
||||
Repress;
|
||||
end;
|
||||
if (Cmd = 3) and (CurrentLevel < TotalLevels) then
|
||||
begin
|
||||
Inc(CurrentLevel);
|
||||
LRLLoadLevel(CurrentLevel);
|
||||
Repress;
|
||||
end;
|
||||
if (Cmd = 4) then
|
||||
begin
|
||||
for i := 1 to 16 do
|
||||
for j := 1 to 30 do
|
||||
LRLLevel.Field[j, i].Image := 1;
|
||||
for i := 1 to 10 do
|
||||
LRLLevel.Player[i].Controller := 0;
|
||||
Repress;
|
||||
end;
|
||||
if (Cmd = 5) and (TotalLevels > 1) then
|
||||
begin
|
||||
LRLDeleteLevel(CurrentLevel);
|
||||
TotalLevels := LRLLevelCount;
|
||||
if CurrentLevel > TotalLevels then
|
||||
CurrentLevel := TotalLevels;
|
||||
LRLLoadLevel(CurrentLevel);
|
||||
Repress;
|
||||
end;
|
||||
if (Cmd = 6) and (CurrentLevel > 1) then
|
||||
begin
|
||||
Dec(CurrentLevel);
|
||||
LRLLoadLevel(CurrentLevel);
|
||||
Repress;
|
||||
end;
|
||||
MSMouseGetXY(Mousex, Mousey);
|
||||
if (Mousey > 180) then
|
||||
begin
|
||||
for i := 1 to 13 do
|
||||
begin
|
||||
if (Mousey > 184) and (Mousey < 195) and (Mousex > i * 15 - 5) and (Mousex < i * 15 + 6) then
|
||||
begin
|
||||
CurrentTool := i;
|
||||
BREAK;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
if DrawNow then
|
||||
begin
|
||||
for i := 1 to 6 do
|
||||
LRLEditorButton[i].Lit := False;
|
||||
for i := 1 to 6 do
|
||||
begin
|
||||
if MSMouseInArea(LRLEditorButton[i].x1, LRLEditorButton[i].y1,
|
||||
LRLEditorButton[i].x2, LRLEditorButton[i].y2) then
|
||||
begin
|
||||
LRLEditorButton[i].Lit := True;
|
||||
BREAK;
|
||||
end;
|
||||
end;
|
||||
MSMouseGetXY(Mousex, Mousey);
|
||||
x := (Mousex) div 10;
|
||||
y := (Mousey) div 10;
|
||||
if (x > 0) and (x < 31) and (y > 0) and (y < 17) then
|
||||
begin
|
||||
for i := 1 to 10 do
|
||||
begin
|
||||
if (LRLLevel.Player[i].Controller <> 0) and (LRLLevel.Player[i].Position.x = x) and
|
||||
(LRLLevel.Player[i].Position.y = y) then
|
||||
begin
|
||||
if (CurrentTool <> 2) and (CurrentTool <> 3) and (CurrentTool <> 4) and
|
||||
(CurrentTool <> 7) then
|
||||
begin
|
||||
LRLLevel.Player[i].Controller := 0;
|
||||
BREAK;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
if CurrentTool < 10 then
|
||||
LRLLevel.Field[x, y].Image := CurrentTool
|
||||
else
|
||||
begin
|
||||
if (LRLLevel.Field[x, y].Image = 2) or (LRLLevel.Field[x, y].Image = 3) or
|
||||
(LRLLevel.Field[x, y].Image = 4) or (LRLLevel.Field[x, y].Image = 1) then
|
||||
begin
|
||||
if CurrentTool = 10 then
|
||||
begin
|
||||
LRLLevel.Player[1].Controller := 1;
|
||||
LRLLevel.Player[1].Position.x := x;
|
||||
LRLLevel.Player[1].Position.y := y;
|
||||
LRLLevel.Player[1].Colour := 1;
|
||||
end
|
||||
else
|
||||
begin
|
||||
j := 2;
|
||||
for i := 2 to 10 do
|
||||
begin
|
||||
if LRLLevel.Player[i].Controller = 0 then
|
||||
begin
|
||||
j := i;
|
||||
BREAK;
|
||||
end;
|
||||
end;
|
||||
LRLLevel.Player[j].Controller := 2;
|
||||
LRLLevel.Player[j].Position.x := x;
|
||||
LRLLevel.Player[j].Position.y := y;
|
||||
LRLLevel.Player[j].Colour := CurrentTool - 9;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
until (LO(Keypress) = 27);
|
||||
SetInterrupt($8, OldTimer);
|
||||
end;
|
||||
|
||||
end.
|
||||
234
programs/games/lrl/LRLHighScores.pp
Normal file
234
programs/games/lrl/LRLHighScores.pp
Normal file
@ -0,0 +1,234 @@
|
||||
unit LRLHighScores;
|
||||
|
||||
|
||||
interface
|
||||
|
||||
|
||||
uses
|
||||
LRLRoutines, LRLSprites, StrUnit;
|
||||
|
||||
|
||||
procedure LRLLoadHighScores;
|
||||
procedure LRLShowHighScores;
|
||||
function LRLBestScore(Score: longint): boolean;
|
||||
procedure LRLInsertScore(Name: string; Score: longint);
|
||||
procedure LRLSaveHighScores;
|
||||
function LRLEnterName: string;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
const
|
||||
HighsFileName = 'LRL.HSR';
|
||||
HighsFileHeader: string[29] = 'Lode Runner Live High Scores'#26;
|
||||
|
||||
type
|
||||
TSupers = packed record
|
||||
Name: string[20];
|
||||
Score: longint;
|
||||
end;
|
||||
|
||||
var
|
||||
MainScreen: POINTER;
|
||||
HighFrame: POINTER;
|
||||
HighTable: array[1..5] of TSupers;
|
||||
|
||||
procedure LoadData;
|
||||
var
|
||||
j: word;
|
||||
begin
|
||||
GETMEM(MainScreen, 64004);
|
||||
GETMEM(HighFrame, 45000);
|
||||
DFAFilePositionSet(ImageFile, LRLImagesFilePosition, DFASeekFromStart);
|
||||
DFAFileRead(ImageFile, MainScreen^, 7940, j);
|
||||
DecompressRepByte(MainScreen^, HighFrame^, 7940, j);
|
||||
DFAFileRead(ImageFile, MainScreen^, 64004, j);
|
||||
end;
|
||||
|
||||
procedure DisposeData;
|
||||
begin
|
||||
FREEMEM(MainScreen, 64004);
|
||||
FREEMEM(HighFrame, 45000);
|
||||
end;
|
||||
|
||||
procedure LRLShowHighScores;
|
||||
var
|
||||
p: POINTER;
|
||||
i: integer;
|
||||
s: string;
|
||||
begin
|
||||
LRLLoadHighScores;
|
||||
GETMEM(p, 768);
|
||||
DataFill(p^, 768, 0, 0);
|
||||
Palette256Set(p^);
|
||||
FREEMEM(p, 768);
|
||||
LoadData;
|
||||
ImagePut(LRLScreen^, MainScreen^, 0, 0, 0, 0, 319, 199);
|
||||
ImagePut(LRLScreen^, HighFrame^, 6, 50, 0, 0, 319, 199);
|
||||
for i := 1 to 5 do
|
||||
begin
|
||||
ImageStringGet(CHR(i + 48) + '. ' + HighTable[i].Name, LRLFont^, LRLFontBuffer^, 110);
|
||||
ImagePut(LRLScreen^, LRLFontBuffer^, 55, 85 + i * 17, 8, 0, 319, 199);
|
||||
STR(HighTable[i].Score, s);
|
||||
ImageStringGet(s, LRLFont^, LRLFontBuffer^, 46);
|
||||
ImagePut(LRLScreen^, LRLFontBuffer^, 260 - ImageSizex(LRLFontBuffer^), 85 + i * 17, 8, 0, 319, 199);
|
||||
end;
|
||||
ScreenApply(LRLScreen^);
|
||||
FadeTo(LRLMenuPalette);
|
||||
READKEY;
|
||||
FadeClear;
|
||||
ImageClear(LRLScreen^);
|
||||
ScreenApply(LRLScreen^);
|
||||
DisposeData;
|
||||
end;
|
||||
|
||||
procedure LRLLoadHighScores;
|
||||
var
|
||||
InFile: TDFAFileHandle;
|
||||
i, j: word;
|
||||
high: TSupers;
|
||||
dummy: string[30];
|
||||
begin
|
||||
high.Name := 'Lode Runner';
|
||||
DFAFileOpen(InFile, HighsFileName, DFAAccessReadWrite);
|
||||
if DFALastResult(InFile) <> 0 then
|
||||
begin
|
||||
DFAFileCreate(InFile, HighsFileName, DFAAttributeArchive);
|
||||
DFAFileWrite(InFile, HighsFileHeader[1], 29, i);
|
||||
for i := 1 to 5 do
|
||||
begin
|
||||
high.score := 60000 - i * 10000;
|
||||
DFAFileWrite(InFile, high, SIZEOF(high), j);
|
||||
end;
|
||||
end;
|
||||
DFAFilePositionSet(InFile, 0, DFASeekFromStart);
|
||||
DFAFileRead(InFile, dummy[1], 29, j);
|
||||
if (DFALastResult(InFile) <> 0) or
|
||||
(not DataIdentical(dummy[1], HighsFileHeader[1], 29, 0, 0)) then
|
||||
begin
|
||||
WRITELN('Error: Invalid file with high scores! (try to remove LRL.HSR file)');
|
||||
WRITELN('Žè¨¡ª : <20>¥¢¥àë© ä ©« á ४®à¤ ¬¨! (¯®¯à®¡ã©â¥ 㤠«¨âì ä ©« LRL.HSR)');
|
||||
Halt(1);
|
||||
end;
|
||||
DFAFileRead(InFile, HighTable, SIZEOF(TSupers) * 5, j);
|
||||
DFAFileClose(InFile);
|
||||
end;
|
||||
|
||||
procedure LRLSaveHighScores;
|
||||
var
|
||||
InFile: TDFAFileHandle;
|
||||
i, j: word;
|
||||
begin
|
||||
DFAFileOpen(InFile, HighsFileName, DFAAccessReadWrite);
|
||||
DFAFilePositionSet(InFile, 29, DFASeekFromStart);
|
||||
DFAFileWrite(InFile, HighTable, SIZEOF(TSupers) * 5, j);
|
||||
DFAFileClose(InFile);
|
||||
end;
|
||||
|
||||
function LRLBestScore(Score: longint): boolean;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
LRLBestScore := True;
|
||||
LRLLoadHighScores;
|
||||
i := 1;
|
||||
while True do
|
||||
begin
|
||||
if Score >= HighTable[i].Score then
|
||||
EXIT;
|
||||
Inc(i);
|
||||
if i > 5 then
|
||||
begin
|
||||
LRLBestScore := False;
|
||||
EXIT;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure LRLInsertScore(Name: string; Score: longint);
|
||||
var
|
||||
i, j: word;
|
||||
begin
|
||||
LRLLoadHighScores;
|
||||
i := 1;
|
||||
while True do
|
||||
begin
|
||||
if Score >= HighTable[i].Score then
|
||||
begin
|
||||
for j := 4 downto i do
|
||||
begin
|
||||
HighTable[j + 1].Name := HighTable[j].Name;
|
||||
HighTable[j + 1].Score := HighTable[j].Score;
|
||||
end;
|
||||
HighTable[i].Name := Name;
|
||||
HighTable[i].Score := Score;
|
||||
LRLSaveHighScores;
|
||||
EXIT;
|
||||
end;
|
||||
Inc(i);
|
||||
if i > 5 then
|
||||
begin
|
||||
EXIT;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function LRLEnterName: string;
|
||||
var
|
||||
p: POINTER;
|
||||
i: integer;
|
||||
RedrawName: boolean;
|
||||
Keypress: word;
|
||||
Name: string;
|
||||
begin
|
||||
Name := '';
|
||||
GETMEM(p, 768);
|
||||
DataFill(p^, 768, 0, 0);
|
||||
Palette256Set(p^);
|
||||
FREEMEM(p, 768);
|
||||
ImageClear(LRLScreen^);
|
||||
ImagePut(LRLScreen^, LRLLogo^, 3, 3, 0, 0, 319, 199);
|
||||
ImageStringGet('Congratulations! You are in Top-Five!', LRLFont^, LRLFontBuffer^, 110);
|
||||
ImagePut(LRLScreen^, LRLFontBuffer^, 160 - ImageSizex(LRLFontBuffer^) shr 1, 85, 0, 0, 319, 199);
|
||||
ImageStringGet('Enter your name below, Champ', LRLFont^, LRLFontBuffer^, 111);
|
||||
ImagePut(LRLScreen^, LRLFontBuffer^, 160 - ImageSizex(LRLFontBuffer^) shr
|
||||
1, 110, 0, 0, 319, 199);
|
||||
ImageStringGet('---------------------------', LRLFont^, LRLFontBuffer^, 100);
|
||||
ImagePut(LRLScreen^, LRLFontBuffer^, 160 - ImageSizex(LRLFontBuffer^) shr
|
||||
1, 155, 0, 0, 319, 199);
|
||||
ScreenApply(LRLScreen^);
|
||||
FadeTo(LRLMenuPalette);
|
||||
RedrawName := True;
|
||||
repeat
|
||||
if RedrawName = True then
|
||||
begin
|
||||
ImageFill(LRLFontBuffer^, 320, 20, 0);
|
||||
ImagePut(LRLScreen^, LRLFontBuffer^, 0, 140, 0, 0, 319, 199);
|
||||
ImageStringGet(Name, LRLFont^, LRLFontBuffer^, 100);
|
||||
ImagePut(LRLScreen^, LRLFontBuffer^, 160 - ImageSizex(LRLFontBuffer^) shr
|
||||
1, 140, 0, 0, 319, 199);
|
||||
ScreenApply(LRLScreen^);
|
||||
RedrawName := False;
|
||||
end;
|
||||
Keypress := READKEY;
|
||||
if (LO(Keypress) = 8) and (LENGTH(Name) > 0) then
|
||||
begin
|
||||
Name[0] := char(Ord(Name[0]) - 1);
|
||||
RedrawName := True;
|
||||
end;
|
||||
if (LO(Keypress) > 31) and (LENGTH(Name) < 20) then
|
||||
begin
|
||||
Name := Name + char(LO(Keypress));
|
||||
RedrawName := True;
|
||||
end;
|
||||
until LO(Keypress) = 13;
|
||||
FadeClear;
|
||||
Name := StringTrimAll(Name, ' ');
|
||||
if LENGTH(Name) = 0 then
|
||||
Name := 'Anonymous';
|
||||
LRLEnterName := Name;
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
135
programs/games/lrl/LRLIntroduction.pp
Normal file
135
programs/games/lrl/LRLIntroduction.pp
Normal file
@ -0,0 +1,135 @@
|
||||
unit LRLIntroduction;
|
||||
|
||||
|
||||
interface
|
||||
|
||||
|
||||
uses
|
||||
SysUtils,
|
||||
LRLRoutines, LRLSprites;
|
||||
|
||||
|
||||
procedure LRLIntro;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
const
|
||||
IntroText: array[1..14] of String = (
|
||||
'Lode Runner LIVE. FREEWARE Version 1.0',
|
||||
'KolibriOS port by bw (Vladimir V. Byrgazov)',
|
||||
'Copyright (c) 1995 Aleksey V. Vaneev',
|
||||
'Copyright (c) 2007 bw',
|
||||
'',
|
||||
'Send comments to Aleksey V. Vaneev',
|
||||
'2:5003/15@FidoNet',
|
||||
'ikomi@glas.apc.org',
|
||||
'',
|
||||
'Send comments to bw',
|
||||
'bw@handsdriver.net',
|
||||
'',
|
||||
'',
|
||||
''
|
||||
);
|
||||
|
||||
SPACE40 = ' ';
|
||||
|
||||
|
||||
var
|
||||
RefreshDelay: Word;
|
||||
RefreshRemain: Word;
|
||||
TimeToRefresh: Boolean;
|
||||
OldTimer: Pointer;
|
||||
|
||||
|
||||
procedure LRLIntro;
|
||||
var
|
||||
i, j, l: Integer;
|
||||
Count: Word;
|
||||
k: Word;
|
||||
MainScreen: Pointer;
|
||||
begin
|
||||
RefreshDelay := 1;
|
||||
RefreshRemain := 1;
|
||||
GetMem(MainScreen, 64004);
|
||||
|
||||
Seek(ImageFile, LRLImagesFilePosition + 7940);
|
||||
BlockRead(ImageFile, MainScreen^, 64004, k);
|
||||
Palette256Set(LRLMenuPalette^);
|
||||
ImageFill(LRLFontBuffer^, 320, 55, 0);
|
||||
ImageClear(LRLScreen^);
|
||||
|
||||
for i := -50 to 4 do
|
||||
begin
|
||||
ImagePut(LRLScreen^, LRLFontBuffer^, 0, 0, 0, 0, 319, 199);
|
||||
ImagePut(LRLScreen^, LRLLogo^, 3, i, 0, 0, 319, 199);
|
||||
ScreenApply(LRLScreen^);
|
||||
if Keypressed then
|
||||
begin
|
||||
ReadKey;
|
||||
FreeMem(MainScreen, 64004);
|
||||
Exit;
|
||||
end;
|
||||
Sleep(10);
|
||||
end;
|
||||
|
||||
ImageFill(LRLFontBuffer^, 320, 55, 0);
|
||||
for i := 0 to 10 do
|
||||
begin
|
||||
for k := 0 to 20 do
|
||||
for j := 0 to 16 do
|
||||
ImagePutTransparent(LRLScreen^, MainScreen^, 0, 0,
|
||||
j * 20 - 10 - i, k * 20 - 10 - i,
|
||||
j * 20 - 10 + i, k * 20 - 10 + i);
|
||||
|
||||
Sleep(50);
|
||||
|
||||
ImagePut(LRLScreen^, LRLFontBuffer^, 0, 182, 0, 0, 319, 199);
|
||||
ScreenApply(LRLScreen^);
|
||||
if Keypressed then
|
||||
begin
|
||||
ReadKey;
|
||||
FreeMem(MainScreen, 64004);
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
Count := 1;
|
||||
k := 1;
|
||||
repeat
|
||||
if TimeToRefresh then
|
||||
begin
|
||||
Inc(Count);
|
||||
TimeToRefresh := False;
|
||||
end;
|
||||
|
||||
if Count >= 2 then
|
||||
begin
|
||||
ImageStringGet(SPACE40 + IntroText[k] + SPACE40, LRLFont^, LRLFontBuffer^, 110);
|
||||
for l := 200 downto 184 do
|
||||
begin
|
||||
ImagePut(LRLScreen^, LRLFontBuffer^, 160 - ImageSizeX(LRLFontBuffer^) div 2, l, 0, 0, 319, 199);
|
||||
ScreenApply(LRLScreen^);
|
||||
Sleep(20);
|
||||
end;
|
||||
Inc(k);
|
||||
if k > Length(IntroText) then k := 1;
|
||||
Count := 0;
|
||||
end;
|
||||
|
||||
for I := 1 to 8 do
|
||||
if Keypressed then
|
||||
Break else
|
||||
Sleep(250);
|
||||
|
||||
TimeToRefresh := True;
|
||||
until KeyPressed;
|
||||
|
||||
ReadKey;
|
||||
FadeClear;
|
||||
FreeMem(MainScreen, 64004);
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
1194
programs/games/lrl/LRLLevels.pp
Normal file
1194
programs/games/lrl/LRLLevels.pp
Normal file
File diff suppressed because it is too large
Load Diff
116
programs/games/lrl/LRLMainMenu.pp
Normal file
116
programs/games/lrl/LRLMainMenu.pp
Normal file
@ -0,0 +1,116 @@
|
||||
unit LRLMainMenu;
|
||||
|
||||
|
||||
interface
|
||||
|
||||
|
||||
uses
|
||||
LRLRoutines, LRLSprites;
|
||||
|
||||
|
||||
procedure LRLSelectItem(var Item: Word);
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
var
|
||||
MainScreen: Pointer;
|
||||
Selection: array[1..4] of Pointer;
|
||||
SelectionDark: array[1..4] of Pointer;
|
||||
SelectionSize: array[1..4] of Word;
|
||||
SelectionDarkSize: array[1..4] of Word;
|
||||
|
||||
|
||||
procedure LoadData;
|
||||
var
|
||||
size, j: Word;
|
||||
i: Integer;
|
||||
begin
|
||||
GetMem(MainScreen, 64004);
|
||||
Seek(ImageFile, LRLImagesFilePosition + 7940);
|
||||
BlockRead(ImageFile, MainScreen^, 64004, j);
|
||||
for i := 1 to 4 do
|
||||
begin
|
||||
BlockRead(ImageFile, SelectionSize[i], 2, j);
|
||||
GetMem(Selection[i], SelectionSize[i]);
|
||||
BlockRead(ImageFile, Selection[i]^, SelectionSize[i], j);
|
||||
BlockRead(ImageFile, SelectionDarkSize[i], 2, j);
|
||||
GetMem(SelectionDark[i], SelectionDarkSize[i]);
|
||||
BlockRead(ImageFile, SelectionDark[i]^, SelectionDarkSize[i], j);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure DisposeData;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
FreeMem(MainScreen, 64004);
|
||||
for i := 1 to 4 do
|
||||
begin
|
||||
FreeMem(Selection[i], SelectionSize[i]);
|
||||
FreeMem(SelectionDark[i], SelectionDarkSize[i]);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure LRLSelectItem(var Item: Word);
|
||||
var
|
||||
Keypress: Word;
|
||||
RedrawAll: Boolean;
|
||||
NeedToFade: Boolean;
|
||||
p: Pointer;
|
||||
i: Integer;
|
||||
begin
|
||||
GetMem(p, 768);
|
||||
DataFill(p^, 768, 0, 0);
|
||||
Palette256Set(p^);
|
||||
FreeMem(p, 768);
|
||||
LoadData;
|
||||
NeedToFade := True;
|
||||
ImagePut(LRLScreen^, MainScreen^, 0, 0, 0, 0, 319, 199);
|
||||
RedrawAll := True;
|
||||
KeyboardFlush;
|
||||
|
||||
repeat
|
||||
if RedrawAll then
|
||||
begin
|
||||
for i := 1 to 4 do
|
||||
if i = Item then
|
||||
ImagePutTransparent(LRLScreen^, Selection[i]^, 63, 66 + (i - 1) * 30, 0, 0, 319, 199) else
|
||||
ImagePutTransparent(LRLScreen^, SelectionDark[i]^, 63, 66 + (i - 1) * 30, 0, 0, 319, 199);
|
||||
|
||||
ScreenApply(LRLScreen^);
|
||||
|
||||
if NeedToFade then
|
||||
begin
|
||||
FadeTo(LRLMenuPalette);
|
||||
NeedToFade := False;
|
||||
end;
|
||||
|
||||
RedrawAll := False;
|
||||
end;
|
||||
|
||||
Keypress := ReadKey;
|
||||
|
||||
if (Keypress = $B1) and (Item < 4) then
|
||||
begin
|
||||
Inc(Item);
|
||||
RedrawAll := True;
|
||||
end;
|
||||
if (Keypress = $B2) and (Item > 1) then
|
||||
begin
|
||||
Dec(Item);
|
||||
RedrawAll := True;
|
||||
end;
|
||||
until Keypress = $0D;
|
||||
|
||||
FadeClear;
|
||||
ImageClear(LRLScreen^);
|
||||
ScreenApply(LRLScreen^);
|
||||
DisposeData;
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
499
programs/games/lrl/LRLRoutines.pp
Normal file
499
programs/games/lrl/LRLRoutines.pp
Normal file
@ -0,0 +1,499 @@
|
||||
unit LRLRoutines;
|
||||
|
||||
{$mode objfpc}
|
||||
{$asmmode intel}
|
||||
|
||||
|
||||
interface
|
||||
|
||||
|
||||
procedure ImagePut(var Screen, ImageBuffer; X, Y: Integer; Winx1, Winy1, Winx2, Winy2: Word);
|
||||
procedure ImagePutTransparent(var Screen, ImageBuffer; X, Y: Integer; Winx1, Winy1, Winx2, Winy2: Word);
|
||||
procedure ImageFill(var ImageBuffer; SizeX, SizeY: Word; Value: Byte);
|
||||
function ImageSizeX(var ImageBuffer): Word;
|
||||
function ImageSizeY(var ImageBuffer): Word;
|
||||
procedure ImageStringGet(Source: String; var FontData, Buffer; ColorOffs: Byte);
|
||||
procedure ScreenApply(var Buffer);
|
||||
procedure ImageClear(var Buffer);
|
||||
|
||||
procedure Palette256Set(var Palette256);
|
||||
procedure Palette256Get(var Palette256);
|
||||
procedure Palette256Grayscale(var Palette256; StartElement, EndElement: Byte);
|
||||
procedure Palette256Darken(var Palette256; StartElement, EndElement, Decrement, MinValue: Byte);
|
||||
procedure Palette256Transform(var SourcePalette, DestinationPalette);
|
||||
function DataByteGet(var Buffer; BufferOffset: Word): Byte;
|
||||
procedure DataBytePut(var Buffer; BufferOffset: Word; Value: Byte);
|
||||
function DataWordGet(var Buffer; BufferOffset: Word): Word;
|
||||
procedure DataWordPut(var Buffer; BufferOffset: Word; Value: Word);
|
||||
procedure DataMove(var Source, Destination; Count: Word; SourceOffset, DestinationOffset: Word);
|
||||
procedure DataAdd(var Buffer; Count: Word; Amount: Byte; BufferOffset: Word);
|
||||
procedure DataFill(var Buffer; Count: Word; Value: Byte; BufferOffset: Word);
|
||||
function DataIdentical(var Array1, Array2; Count: Word; Array1Offset, Array2Offset: Word): Boolean;
|
||||
function ReadKey: Word;
|
||||
function Keypressed: Boolean;
|
||||
function SetInterrupt(Int: Byte; NewAddress: Pointer): Pointer;
|
||||
procedure FadeClear;
|
||||
procedure FadeTo(pal: Pointer);
|
||||
procedure DecompressRepByte(var InArray, OutArray; InArraySize: Word; var OutArraySize: Word);
|
||||
function MSMouseInArea(x1, y1, x2, y2: Integer): Boolean;
|
||||
function MSMouseDriverExist: Boolean;
|
||||
procedure MSMouseGetXY(var x, y: Integer);
|
||||
function MSMouseButtonStatusGet: Word;
|
||||
function MSMouseButtonWasPressed(Button: Word; var x, y: Integer): Boolean;
|
||||
function MSMouseButtonWasReleased(Button: Word; var x, y: Integer): Boolean;
|
||||
procedure MSMouseSetXY(x, y: Integer);
|
||||
procedure KeyboardFlush;
|
||||
function GetInterrupt(Int: Byte): Pointer;
|
||||
|
||||
procedure AssignFile(var AFile: File; AFileName: String);
|
||||
function LastDosTick(): Longword;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
uses
|
||||
SysUtils;
|
||||
|
||||
|
||||
const
|
||||
SCREEN_WIDTH = 320;
|
||||
SCREEN_HEIGHT = 200;
|
||||
|
||||
type
|
||||
PRGBColor = ^TRGBColor;
|
||||
TRGBColor = packed record
|
||||
R, G, B: Byte;
|
||||
end;
|
||||
|
||||
PRGBPalette = ^TRGBPalette;
|
||||
TRGBPalette = array[Byte] of TRGBColor;
|
||||
|
||||
var
|
||||
ScreenRGBPalette: TRGBPalette;
|
||||
ScreenRGBBuffer : array[0..SCREEN_HEIGHT - 1, 0..SCREEN_WIDTH - 1] of TRGBColor;
|
||||
ScreenBuffer : array[0..SCREEN_WIDTH * SCREEN_HEIGHT - 1] of Byte;
|
||||
|
||||
AlreadyKeyPressed: Boolean = False;
|
||||
|
||||
|
||||
procedure Paint;
|
||||
begin
|
||||
kos_begindraw();
|
||||
kos_definewindow(500, 100, SCREEN_WIDTH - 1, SCREEN_HEIGHT - 1, $01000000);
|
||||
kos_drawimage24(0, 0, SCREEN_WIDTH, SCREEN_HEIGHT, @ScreenRGBBuffer);
|
||||
kos_enddraw();
|
||||
end;
|
||||
|
||||
procedure UpdateRGBBuffer;
|
||||
var
|
||||
I, J: Longint;
|
||||
B: PByte;
|
||||
begin
|
||||
B := @ScreenBuffer;
|
||||
for I := 0 to SCREEN_HEIGHT - 1 do
|
||||
for J := 0 to SCREEN_WIDTH - 1 do
|
||||
begin
|
||||
ScreenRGBBuffer[I, J] := ScreenRGBPalette[B^];
|
||||
Inc(B);
|
||||
end;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
|
||||
procedure ImagePut(var Screen, ImageBuffer; X, Y: Integer; WinX1, WinY1, WinX2, WinY2: Word);
|
||||
var
|
||||
Width, Height: Word;
|
||||
I, J, K: Integer;
|
||||
P: Pointer;
|
||||
begin
|
||||
Width := PWord(@ImageBuffer)[0];
|
||||
Height := PWord(@ImageBuffer)[1];
|
||||
|
||||
P := @ImageBuffer + 4;
|
||||
for I := Y to Y + Height - 1 do
|
||||
begin
|
||||
if (I >= 0) and (I < SCREEN_HEIGHT) and (I >= WinY1) and (I <= WinY2) then
|
||||
begin
|
||||
if X < WinX1 then
|
||||
J := WinX1 - X else
|
||||
J := 0;
|
||||
K := Width - J;
|
||||
if WinX1 + K - 1 > WinX2 then
|
||||
K := WinX2 - WinX1 + 1;
|
||||
Move((P + J)^, (@Screen + I * SCREEN_WIDTH + X + J)^, K);
|
||||
end;
|
||||
Inc(P, Width);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure ImagePutTransparent(var Screen, ImageBuffer; X, Y: Integer; Winx1, Winy1, Winx2, Winy2: Word);
|
||||
begin
|
||||
ImagePut(Screen, ImageBuffer, X, Y, Winx1, Winy1, Winx2, Winy2);
|
||||
end;
|
||||
|
||||
procedure ImageFill(var ImageBuffer; SizeX, SizeY: Word; Value: Byte);
|
||||
begin
|
||||
PWord(@ImageBuffer)^ := SizeX;
|
||||
PWord(@ImageBuffer + 2)^ := SizeY;
|
||||
FillChar((@ImageBuffer + 4)^, SizeX * SizeY, Value);
|
||||
end;
|
||||
|
||||
function ImageSizeX(var ImageBuffer): Word;
|
||||
begin
|
||||
Result := PWord(@ImageBuffer)^;
|
||||
end;
|
||||
|
||||
function ImageSizeY(var ImageBuffer): Word;
|
||||
begin
|
||||
Result := PWord(@ImageBuffer + 2)^;
|
||||
end;
|
||||
|
||||
procedure ImageStringGet(Source: String; var FontData, Buffer; ColorOffs: Byte);
|
||||
var
|
||||
Width, Height: Word;
|
||||
Table: PWord;
|
||||
P, B: PByte;
|
||||
X, I, J, K, C: Word;
|
||||
begin
|
||||
Height := PWord(@FontData + 2)^;
|
||||
Table := PWord(@FontData + 4);
|
||||
|
||||
{ à áç¥â ¤«¨ë áâப¨ }
|
||||
Width := 0;
|
||||
for I := 1 to Length(Source) do
|
||||
begin
|
||||
P := @Table[Ord(Source[I])];
|
||||
Inc(Width, PWord(P + PWord(P)^)^);
|
||||
end;
|
||||
|
||||
PWord(@Buffer)^ := Width;
|
||||
PWord(@Buffer + 2)^ := Height;
|
||||
|
||||
{ ¢ë¢®¤ áâப¨ }
|
||||
X := 0;
|
||||
for I := 1 to Length(Source) do
|
||||
begin
|
||||
P := @Table[Ord(Source[I])];
|
||||
B := PByte(P + PWord(P)^);
|
||||
C := PWord(B)^;
|
||||
Inc(B, 2);
|
||||
|
||||
P := PByte(@Buffer + 4 + X);
|
||||
for K := 0 to Height - 1 do
|
||||
begin
|
||||
for J := 0 to C - 1 do
|
||||
begin
|
||||
if B^ = 0 then
|
||||
P^ := 0 else
|
||||
P^ := B^ + ColorOffs;
|
||||
Inc(P);
|
||||
Inc(B);
|
||||
end;
|
||||
Inc(P, Width - C);
|
||||
end;
|
||||
|
||||
Inc(X, C);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure ScreenApply(var Buffer);
|
||||
begin
|
||||
Move(Buffer, ScreenBuffer, SizeOf(ScreenBuffer));
|
||||
UpdateRGBBuffer;
|
||||
end;
|
||||
|
||||
|
||||
procedure ImageClear(var Buffer);
|
||||
begin
|
||||
FillChar(Buffer, SCREEN_WIDTH * SCREEN_HEIGHT, 0);
|
||||
end;
|
||||
|
||||
|
||||
procedure Palette256Set(var Palette256);
|
||||
var
|
||||
I: Longint;
|
||||
P: PRGBColor;
|
||||
begin
|
||||
P := @Palette256;
|
||||
for I := 0 to 255 do
|
||||
with ScreenRGBPalette[I] do
|
||||
begin
|
||||
R := Round(P^.B / 63 * 255);
|
||||
G := Round(P^.G / 63 * 255);
|
||||
B := Round(P^.R / 63 * 255);
|
||||
Inc(P);
|
||||
end;
|
||||
UpdateRGBBuffer;
|
||||
end;
|
||||
|
||||
procedure Palette256Get(var Palette256);
|
||||
var
|
||||
I: Longint;
|
||||
P: PRGBColor;
|
||||
begin
|
||||
P := @Palette256;
|
||||
for I := 0 to 255 do
|
||||
with ScreenRGBPalette[I] do
|
||||
begin
|
||||
P^.R := Round(B / 255 * 63);
|
||||
P^.G := Round(G / 255 * 63);
|
||||
P^.B := Round(R / 255 * 63);
|
||||
Inc(P);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Palette256Grayscale(var Palette256; StartElement, EndElement: Byte);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure Palette256Darken(var Palette256; StartElement, EndElement, Decrement, MinValue: Byte);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure Palette256Transform(var SourcePalette, DestinationPalette);
|
||||
var
|
||||
I: Longint;
|
||||
S, D: PByte;
|
||||
begin
|
||||
S := @SourcePalette;
|
||||
D := @DestinationPalette;
|
||||
for I := 0 to 767 do
|
||||
begin
|
||||
if S^ < D^ then Inc(S^) else
|
||||
if S^ > D^ then Dec(S^);
|
||||
Inc(S);
|
||||
Inc(D);
|
||||
end;
|
||||
end;
|
||||
|
||||
function DataByteGet(var Buffer; BufferOffset: Word): Byte;
|
||||
begin
|
||||
Result := PByte(@Buffer + BufferOffset)^;
|
||||
end;
|
||||
|
||||
procedure DataBytePut(var Buffer; BufferOffset: Word; Value: Byte);
|
||||
begin
|
||||
PByte(@Buffer + BufferOffset)^ := Value;
|
||||
end;
|
||||
|
||||
function DataWordGet(var Buffer; BufferOffset: Word): Word;
|
||||
begin
|
||||
Result := PWord(@Buffer + BufferOffset)^;
|
||||
end;
|
||||
|
||||
procedure DataWordPut(var Buffer; BufferOffset: Word; Value: Word);
|
||||
begin
|
||||
PWord(@Buffer + BufferOffset)^ := Value;
|
||||
end;
|
||||
|
||||
procedure DataMove(var Source, Destination; Count: Word; SourceOffset, DestinationOffset: Word);
|
||||
begin
|
||||
Move((@Source + SourceOffset)^, (@Destination + DestinationOffset)^, Count);
|
||||
end;
|
||||
|
||||
procedure DataFill(var Buffer; Count: Word; Value: Byte; BufferOffset: Word);
|
||||
begin
|
||||
FillChar((@Buffer + BufferOffset)^, Count, Value);
|
||||
end;
|
||||
|
||||
function DataIdentical(var Array1, Array2; Count: Word; Array1Offset, Array2Offset: Word): Boolean;
|
||||
begin
|
||||
Result := CompareByte((@Array1 + Array1Offset)^, (@Array2 + Array2Offset)^, Count) = 0;
|
||||
end;
|
||||
|
||||
procedure DataAdd(var Buffer; Count: Word; Amount: Byte; BufferOffset: Word);
|
||||
var
|
||||
I: Word;
|
||||
begin
|
||||
for I := 0 to Count do
|
||||
Inc(PByte(@Buffer + BufferOffset + I)^, Amount);
|
||||
{if >0 then += amount}
|
||||
end;
|
||||
|
||||
function ReadKey: Word;
|
||||
var
|
||||
Event: Word;
|
||||
begin
|
||||
if not AlreadyKeyPressed then
|
||||
begin
|
||||
kos_maskevents(ME_PAINT or ME_KEYBOARD);
|
||||
repeat
|
||||
Event := kos_getevent();
|
||||
if Event = SE_PAINT then Paint;
|
||||
until Event = SE_KEYBOARD;
|
||||
end;
|
||||
Result := kos_getkey() shr 8;
|
||||
AlreadyKeyPressed := False;
|
||||
{WriteLn('ReadKey -> ', IntToHex(Result, 2));}
|
||||
end;
|
||||
|
||||
function Keypressed: Boolean;
|
||||
begin
|
||||
if AlreadyKeyPressed then
|
||||
Result := True else
|
||||
begin
|
||||
kos_maskevents(ME_KEYBOARD);
|
||||
Result := kos_getevent(False) = SE_KEYBOARD;
|
||||
AlreadyKeyPressed := Result;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure KeyboardFlush;
|
||||
var
|
||||
Event: Word;
|
||||
begin
|
||||
kos_maskevents(ME_KEYBOARD);
|
||||
repeat
|
||||
Event := kos_getevent(False);
|
||||
if Event = SE_KEYBOARD then kos_getkey();
|
||||
until Event = 0;
|
||||
AlreadyKeyPressed := False;
|
||||
end;
|
||||
|
||||
function SetInterrupt(Int: Byte; NewAddress: Pointer): Pointer;
|
||||
begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
procedure FadeClear;
|
||||
var
|
||||
Pal1, Pal2: Pointer;
|
||||
i: Integer;
|
||||
begin
|
||||
GetMem(Pal1, 768);
|
||||
GetMem(Pal2, 768);
|
||||
Palette256Get(Pal1^);
|
||||
for i := 0 to 32 do
|
||||
begin
|
||||
DataMove(Pal1^, Pal2^, 768, 0, 0);
|
||||
Palette256Darken(Pal2^, 0, 255, i * 2, 0);
|
||||
Palette256Set(Pal2^);
|
||||
end;
|
||||
FreeMem(Pal1, 768);
|
||||
FreeMem(Pal2, 768);
|
||||
end;
|
||||
|
||||
procedure FadeTo(Pal: Pointer);
|
||||
var
|
||||
Pal1: Pointer;
|
||||
I: Integer;
|
||||
begin
|
||||
GetMem(Pal1, 768);
|
||||
Palette256Get(Pal1^);
|
||||
for I := 0 to 63 do
|
||||
begin
|
||||
Palette256Transform(Pal1^, Pal^);
|
||||
Palette256Set(Pal1^);
|
||||
kos_delay(1);
|
||||
end;
|
||||
FreeMem(Pal1, 768);
|
||||
end;
|
||||
|
||||
procedure DecompressRepByte(var InArray, OutArray; InArraySize: Word; var OutArraySize: Word);
|
||||
begin
|
||||
{asm
|
||||
PUSH DS
|
||||
|
||||
xor DX,DX
|
||||
xor AX,AX
|
||||
|
||||
LDS SI,InArray
|
||||
LES DI,OutArray
|
||||
|
||||
MOV CX,InArraySize
|
||||
JCXZ @Done
|
||||
|
||||
@Loop1:
|
||||
LODSB
|
||||
CMP AL,0
|
||||
JE @VsePonyatno
|
||||
CMP AL,4
|
||||
JB @MensheTreh
|
||||
|
||||
INC DX
|
||||
STOSB
|
||||
JMP @DoLoop
|
||||
|
||||
@MensheTreh:
|
||||
SUB CX,1
|
||||
MOV BX,CX
|
||||
|
||||
MOV CX,AX
|
||||
ADD DX,AX
|
||||
LODSB
|
||||
REP STOSB
|
||||
|
||||
MOV CX,BX
|
||||
JMP @DoLoop
|
||||
|
||||
@VsePonyatno:
|
||||
LODSB
|
||||
SUB CX,2
|
||||
MOV BX,CX
|
||||
MOV CX,AX
|
||||
ADD DX,AX
|
||||
LODSB
|
||||
REP STOSB
|
||||
MOV CX,BX
|
||||
|
||||
@DoLoop:
|
||||
JCXZ @Done
|
||||
LOOP @Loop1
|
||||
|
||||
@Done:
|
||||
LES DI,OutArraySize
|
||||
MOV[ES:DI],DX
|
||||
POP DS}
|
||||
end;
|
||||
|
||||
function MSMouseInArea(x1, y1, x2, y2: Integer): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function MSMouseDriverExist: Boolean;
|
||||
begin
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
procedure MSMouseGetXY(var x, y: Integer);
|
||||
begin
|
||||
end;
|
||||
|
||||
function MSMouseButtonStatusGet: Word;
|
||||
begin
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
function MSMouseButtonWasPressed(Button: Word; var x, y: Integer): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function MSMouseButtonWasReleased(Button: Word; var x, y: Integer): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
procedure MSMouseSetXY(x, y: Integer);
|
||||
begin
|
||||
end;
|
||||
|
||||
function GetInterrupt(Int: Byte): Pointer;
|
||||
begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
procedure AssignFile(var AFile: File; AFileName: String);
|
||||
begin
|
||||
Assign(AFile, IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0))) + AFileName);
|
||||
end;
|
||||
|
||||
function LastDosTick(): Longword;
|
||||
begin
|
||||
Result := Round(kos_timecounter() * 0.182);
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
255
programs/games/lrl/LRLSprites.pp
Normal file
255
programs/games/lrl/LRLSprites.pp
Normal file
@ -0,0 +1,255 @@
|
||||
unit LRLSprites;
|
||||
|
||||
{$mode objfpc}
|
||||
{$i-}
|
||||
|
||||
|
||||
interface
|
||||
|
||||
|
||||
uses
|
||||
SysUtils,
|
||||
LRLRoutines;
|
||||
|
||||
{
|
||||
all coordinates in standard style:
|
||||
0 +
|
||||
0 +----------> x
|
||||
|
|
||||
|
|
||||
|
|
||||
|
|
||||
+ v
|
||||
|
||||
y
|
||||
}
|
||||
|
||||
type
|
||||
TLRLImage = packed record
|
||||
Data: Pointer; { standard 256-colour image data }
|
||||
Size: Word; { size of image (for destruction) }
|
||||
end;
|
||||
|
||||
PLRLSprite = ^TLRLSprite;
|
||||
|
||||
TLRLSprite = packed record
|
||||
Image: array[1..12] of TLRLImage; { moving image }
|
||||
ImageCount: Byte; { how many images there }
|
||||
end;
|
||||
|
||||
|
||||
type
|
||||
TButton = packed record
|
||||
Lit: Boolean;
|
||||
DarkIcon: Pointer;
|
||||
LightIcon: Pointer;
|
||||
DarkIconSize: Word;
|
||||
LightIconSize: Word;
|
||||
x1, y1: Integer;
|
||||
x2, y2: Integer;
|
||||
Command: Word;
|
||||
end;
|
||||
|
||||
|
||||
var
|
||||
ImageFile: File;
|
||||
LRLEnvironment: array[1..20] of TLRLSprite;
|
||||
LRLFigure: array[1..4, 1..9] of TLRLSprite;
|
||||
LRLDecoration: array[1..1] of TLRLSprite;
|
||||
LRLPalette: Pointer;
|
||||
LRLScreen: Pointer;
|
||||
LRLMenuPalette: Pointer;
|
||||
LRLLogo: Pointer;
|
||||
LRLFont: Pointer;
|
||||
LRLFontBuffer: Pointer;
|
||||
LRLMousePointer: Pointer;
|
||||
LRLImagesFilePosition: longint;
|
||||
LRLEditorButton: array[1..6] of TButton;
|
||||
|
||||
|
||||
procedure ImagesInitialize;
|
||||
procedure ImagesDeinitialize;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
const
|
||||
ImageFileName = 'LRL.IMG';
|
||||
ImageFileHeader: ShortString = 'Lode Runner Live Images'#26;
|
||||
|
||||
ERR_OPENFILE = '<27>¥¢®§¬®¦® ®âªàëâì ä ©« ª à⨮ª';
|
||||
ERR_BADFILE = '<27>¥¢¥àë© ¨«¨ ¯®¢à¥¦¤¥ë© ä ©« ª à⨮ª';
|
||||
|
||||
|
||||
procedure LoadImages;
|
||||
var
|
||||
InBuffer: Pointer;
|
||||
i, j, k, l, x, y: Word;
|
||||
a, b, c: Byte;
|
||||
begin
|
||||
GetMem(InBuffer, $FFF0);
|
||||
|
||||
AssignFile(ImageFile, ImageFileName);
|
||||
Reset(ImageFile, 1);
|
||||
if IOResult <> 0 then
|
||||
raise Exception.Create(ERR_OPENFILE);
|
||||
|
||||
BlockRead(ImageFile, InBuffer^, 24, k);
|
||||
if (IOResult <> 0) or not DataIdentical(InBuffer^, ImageFileHeader[1], 24, 0, 0) then
|
||||
raise Exception.Create(ERR_BADFILE);
|
||||
|
||||
{ load palette }
|
||||
GetMem(LRLPalette, 768);
|
||||
BlockRead(ImageFile, LRLPalette^, 768, k);
|
||||
|
||||
{ figures loading loop }
|
||||
for i := 1 to 9 do
|
||||
begin
|
||||
BlockRead(ImageFile, a, 1, k);
|
||||
LRLFigure[1, i].ImageCount := a;
|
||||
for j := 1 to a do
|
||||
begin
|
||||
GetMem(LRLFigure[1, i].Image[j].Data, 104);
|
||||
BlockRead(ImageFile, LRLFigure[1, i].Image[j].Data^, 104, k);
|
||||
x := DataWordGet(LRLFigure[1, i].Image[j].Data^, 0);
|
||||
y := DataWordGet(LRLFigure[1, i].Image[j].Data^, 2);
|
||||
LRLFigure[1, i].Image[j].Size := x * y + 4;
|
||||
for l := 2 to 4 do
|
||||
begin
|
||||
LRLFigure[l, i].Image[j].Size := LRLFigure[1, i].Image[j].Size;
|
||||
LRLFigure[l, i].ImageCount := a;
|
||||
GetMem(LRLFigure[l, i].Image[j].Data, LRLFigure[l, i].Image[j].Size);
|
||||
DataMove(LRLFigure[1, i].Image[j].Data^, LRLFigure[l, i].Image[j].Data^, LRLFigure[l, i].Image[j].Size, 0, 0);
|
||||
DataAdd(LRLFigure[l, i].Image[j].Data^, LRLFigure[l, i].Image[j].Size, (l - 1) shl 5, 4);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ decoration loading loop }
|
||||
for i := 1 to 1 do
|
||||
begin
|
||||
BlockRead(ImageFile, a, 1, k);
|
||||
LRLDecoration[i].ImageCount := a;
|
||||
for j := 1 to a do
|
||||
begin
|
||||
GetMem(LRLDecoration[i].Image[j].Data, 104);
|
||||
BlockRead(ImageFile, LRLDecoration[i].Image[j].Data^, 104, k);
|
||||
x := DataWordGet(LRLDecoration[i].Image[j].Data^, 0);
|
||||
y := DataWordGet(LRLDecoration[i].Image[j].Data^, 2);
|
||||
LRLDecoration[i].Image[j].Size := x * y + 4;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ environment loading loop }
|
||||
for i := 1 to 9 do
|
||||
begin
|
||||
BlockRead(ImageFile, a, 1, k);
|
||||
LRLEnvironment[i].ImageCount := a;
|
||||
for j := 1 to a do
|
||||
begin
|
||||
GetMem(LRLEnvironment[i].Image[j].Data, 104);
|
||||
BlockRead(ImageFile, LRLEnvironment[i].Image[j].Data^, 104, k);
|
||||
x := DataWordGet(LRLEnvironment[i].Image[j].Data^, 0);
|
||||
y := DataWordGet(LRLEnvironment[i].Image[j].Data^, 2);
|
||||
LRLEnvironment[i].Image[j].Size := x * y + 4;
|
||||
end;
|
||||
end;
|
||||
|
||||
y := 181;
|
||||
x := 212;
|
||||
|
||||
for i := 1 to 6 do
|
||||
begin
|
||||
if i = 4 then
|
||||
begin
|
||||
y := 191;
|
||||
x := 212;
|
||||
end;
|
||||
|
||||
LRLEditorButton[i].x1 := x;
|
||||
LRLEditorButton[i].y1 := y;
|
||||
LRLEditorButton[i].x2 := x + 32;
|
||||
LRLEditorButton[i].y2 := y + 9;
|
||||
LRLEditorButton[i].Lit := False;
|
||||
LRLEditorButton[i].Command := i;
|
||||
LRLEditorButton[i].DarkIconSize := 292;
|
||||
LRLEditorButton[i].LightIconSize := 292;
|
||||
|
||||
GetMem(LRLEditorButton[i].DarkIcon, LRLEditorButton[i].DarkIconSize);
|
||||
GetMem(LRLEditorButton[i].LightIcon, LRLEditorButton[i].LightIconSize);
|
||||
BlockRead(ImageFile, LRLEditorButton[i].LightIcon^, 292, l);
|
||||
BlockRead(ImageFile, LRLEditorButton[i].DarkIcon^, 292, l);
|
||||
|
||||
Inc(x, 33);
|
||||
end;
|
||||
|
||||
{ load font }
|
||||
GetMem(LRLFont, 20455);
|
||||
BlockRead(ImageFile, LRLFont^, 20455, k);
|
||||
|
||||
{ load Pointer }
|
||||
GetMem(LRLMousePointer, 174);
|
||||
BlockRead(ImageFile, LRLMousePointer^, 174, k);
|
||||
|
||||
{ load palette }
|
||||
GetMem(LRLMenuPalette, 768);
|
||||
BlockRead(ImageFile, LRLMenuPalette^, 768, k);
|
||||
|
||||
{ load logo }
|
||||
GetMem(LRLLogo, 12524);
|
||||
BlockRead(ImageFile, LRLLogo^, 12524, k);
|
||||
|
||||
LRLImagesFilePosition := FilePos(ImageFile);
|
||||
FreeMem(InBuffer, $FFF0);
|
||||
end;
|
||||
|
||||
|
||||
procedure ImagesInitialize;
|
||||
begin
|
||||
LoadImages;
|
||||
GetMem(LRLScreen, 64000);
|
||||
GetMem(LRLFontBuffer, 32000);
|
||||
end;
|
||||
|
||||
|
||||
procedure ImagesDeinitialize;
|
||||
var
|
||||
i, j, l: Integer;
|
||||
begin
|
||||
FreeMem(LRLPalette, 768);
|
||||
|
||||
for i := 1 to 9 do
|
||||
for j := 1 to LRLFigure[1, i].ImageCount do
|
||||
begin
|
||||
FreeMem(LRLFigure[1, i].Image[j].Data, 104);
|
||||
for l := 2 to 4 do
|
||||
FreeMem(LRLFigure[l, i].Image[j].Data, LRLFigure[l, i].Image[j].Size);
|
||||
end;
|
||||
|
||||
for i := 1 to 1 do
|
||||
for j := 1 to LRLDecoration[i].ImageCount do
|
||||
FreeMem(LRLDecoration[i].Image[j].Data, 104);
|
||||
|
||||
for i := 1 to 9 do
|
||||
for j := 1 to LRLEnvironment[i].ImageCount do
|
||||
FreeMem(LRLEnvironment[i].Image[j].Data, 104);
|
||||
|
||||
for i := 1 to 6 do
|
||||
begin
|
||||
FreeMem(LRLEditorButton[i].DarkIcon, LRLEditorButton[i].DarkIconSize);
|
||||
FreeMem(LRLEditorButton[i].LightIcon, LRLEditorButton[i].LightIconSize);
|
||||
end;
|
||||
|
||||
FreeMem(LRLFont, 20455);
|
||||
FreeMem(LRLMousePointer, 174);
|
||||
FreeMem(LRLMenuPalette, 768);
|
||||
FreeMem(LRLLogo, 12524);
|
||||
FreeMem(LRLScreen, 64000);
|
||||
FreeMem(LRLFontBuffer, 32000);
|
||||
|
||||
Close(ImageFile);
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
BIN
programs/games/lrl/bin/lrl.img
Normal file
BIN
programs/games/lrl/bin/lrl.img
Normal file
Binary file not shown.
BIN
programs/games/lrl/bin/lrl.lev
Normal file
BIN
programs/games/lrl/bin/lrl.lev
Normal file
Binary file not shown.
30
programs/games/lrl/build.bat
Normal file
30
programs/games/lrl/build.bat
Normal file
@ -0,0 +1,30 @@
|
||||
@echo off
|
||||
|
||||
rem „«ï ᡮન ¨£àë ¥®¡å®¤¨¬® ¢ ¯¥à¥¬¥®© UNITS (®¯à¥¤¥«¥ ¨¦¥)
|
||||
rem 㪠§ âì à ᯮ«®¦¥¨¥ ¯ ¯ª¨, ¢ ª®â®à®© 室ïâáï ®âª®¬¯¨«¨à®¢ ë¥ ¬®¤ã«¨
|
||||
rem RTL ¤«ï KolibriOS. <20> ¯à¨¬¥à, ¥á«¨ ¨á室¨ª¨ RTL 室ïâáï ¢ ¯ ¯ª¥ my/rtl,
|
||||
rem ⮠ᮡà ë¥ ¬®¤ã«¨ RTL - ᪮॥ ¢á¥£® ¢ my/units. Œ®¦¥â ®ª § âìáï
|
||||
rem ¤®áâ â®çë¬ ¯à®áâ® ¯¥à¥¥á⨠íâã ¯ ¯ªã (lrl) ¢ ¤¨à¥ªâ®à¨î my.
|
||||
|
||||
rem ’ ª ¦¥, ¤«ï ᡮન, ¢ ¬ ¯® ¤®¡¨âáï ã⨫¨â exe2kos.exe ¨ FreePascal 2.2.0.
|
||||
|
||||
|
||||
set NAME=lrl
|
||||
set NAMEEXE=%NAME%.exe
|
||||
set NAMEKEX=%NAME%.kex
|
||||
|
||||
set BUILD=-FUbuild
|
||||
set UNITS=-Fu../units
|
||||
|
||||
fpc %NAME%.pp -n -Twin32 -Se5 -XXs -Sg -O3pPENTIUM3 -CfSSE -WB0 %BUILD% %UNITS%
|
||||
if errorlevel 1 goto error
|
||||
|
||||
exe2kos.exe %NAMEEXE% %NAMEKEX%
|
||||
del %NAMEEXE%
|
||||
move %NAMEKEX% bin
|
||||
goto end
|
||||
|
||||
:error
|
||||
echo An error occured while building %NAME%
|
||||
|
||||
:end
|
||||
10
programs/games/lrl/readme-ru.txt
Normal file
10
programs/games/lrl/readme-ru.txt
Normal file
@ -0,0 +1,10 @@
|
||||
|
||||
Lode Runner Live 1.0
|
||||
====================
|
||||
|
||||
<EFBFBD>஥ªâ ¯® ¯¥à¥®áã ¨£àë Lode Runner Live 1.0 á ¯« âä®à¬ë DOS ¢ KolibriOS.
|
||||
|
||||
—¨â ©â¥ ª®¬¬¥â ਨ ¯® ª®¬¯¨«ï樨 ¢ build.bat.
|
||||
|
||||
<EFBFBD> ¤ ë© ¬®¬¥â â¥áâ¨à®¢ « áì ªà®áª®¬¯¨«ïæ¨ï ⮫쪮 ¨§ Windows 2000 SP4
|
||||
32å à §à冷© ¬ 訥.
|
||||
Loading…
Reference in New Issue
Block a user