Subversion Repositories Kolibri OS

Compare Revisions

No changes between revisions

Regard whitespace Rev 761 → Rev 762

/programs/games/lrl/LRL.pp
File deleted
/programs/games/lrl/LRLRoutines.pp
File deleted
/programs/games/lrl/LRLSprites.pp
File deleted
/programs/games/lrl/LRLLevels.pp
File deleted
/programs/games/lrl/LRLHighScores.pp
File deleted
/programs/games/lrl/readme-ru.txt
File deleted
/programs/games/lrl/LRLMainMenu.pp
File deleted
/programs/games/lrl/LRLEditor.pp
File deleted
/programs/games/lrl/LRLIntroduction.pp
File deleted
/programs/games/lrl/build.bat
File deleted
/programs/games/lrl/Makefile.fpc
0,0 → 1,49
# ¥à¥¬¥­­ ï ®ªà㦥­¨ï FPCDIR ¤®«¦­  㪠§ë¢ âì ­  ¯ ¯ªã á FreePascal,
# «¨¡® ¢ ᥪ樨 default ¢ ¯¥à¥¬¥­­®© fpcdir 㪠¦¨â¥ â®ç­ë© ¯ãâì ª ­¥©.
# ãâì 㪠§ë¢ ¥âáï ¡¥§ § ¢¥àè î饣® á«íè  (¨«¨ ®¡à â­®£® á«íè ).
 
# ¥à¥¬¥­­ ï ®ªà㦥­¨ï KFPCDIR ¤®«¦­  㪠§ë¢ âì ­  ¯ ¯ªã á ¯à®¥ªâ®¬
# KolibriOS FreePascal.
# ãâì 㪠§ë¢ ¥âáï ¡¥§ § ¢¥àè î饣® á«íè  (¨«¨ ®¡à â­®£® á«íè ).
 
[target]
programs=LRL
 
[default]
target=win32
cpu=i386
 
[compiler]
options=-dKOLIBRI
unittargetdir=build
targetdir=bin
sourcedir=src
 
[prerules]
ifdef KFPCDIR
override KFPCDIR:=$(subst \,/,$(KFPCDIR))
ifeq ($(wildcard $(KFPCDIR)/bin),)
override KFPCDIR=wrong
endif
else
override KFPCDIR=wrong
endif
 
ifeq ($(KFPCDIR),wrong)
$(error The KFPCDIR environment is wrong)
endif
 
UNITSDIR:=$(wildcard $(FPCDIR)/units/$(CPU_TARGET)-kolibri)
KOSEXT=.kex
EXE2KEX=$(KFPCDIR)/bin/exe2kos
 
[rules]
ifneq ($(TARGET_PROGRAMS),)
KOSFILES=$(addsuffix $(KOSEXT),$(TARGET_PROGRAMS))
endif
 
fpc_all: $(KOSFILES)
 
%$(KOSEXT): %$(EXEEXT)
@$(EXE2KEX) $(COMPILER_TARGETDIR)/$^ $(COMPILER_TARGETDIR)/$@
@$(DEL) $(COMPILER_TARGETDIR)/$^
/programs/games/lrl/bin/LRL.HSR
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/programs/games/lrl/bin/LRL.MAN
0,0 → 1,222
ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ
ÜÜ ÜÜÜÜ ÜÜÜÜÜ ÜÜÜÜÜÜ ÜÜÜÜÜ ÜÜ ÜÜ ÜÜ ÜÜ ÜÜ ÜÜ ÜÜÜÜÜÜ ÜÜÜÜÜ
ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ
ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛÛÜÛÛ ÛÛÛÜÛÛ ÛÛ ÛÛ ÛÛ
ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛßßß ÛÛßßÛÜ ÛÛ ÛÛ ÛÛ ßÛÛ ÛÛ ßÛÛ ÛÛßßß ÛÛßßÛÜ
ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ
ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ
ßßßßßß ßßßß ßßßßß ßßßßßß ßß ßß ßßßß ßß ßß ßß ßß ßßßßßß ßß ßß
ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
ÄÄÄÄÄÍÍÍÍ Û Û Û Û Ûßß ÍÍÍÍÄÄÄÄÄ
ÄÄÄÄÄÄÍÍÍÍÍ Û Û Û Û Ûß ÍÍÍÍÍÄÄÄÄÄÄ
FREEWARE ÄÄÄÄÄÄÄÍÍÍÍÍÍ ÛÜÜ Û ßÜß ÛÜÜ ÍÍÍÍÍÍÄÄÄÄÄÄÄ version 1.0
ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ
 
USER'S MANUAL
 
ÚÂÂÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
³³³³ DISCLAIMER AND LICENSING
 
Lode Runner Live version 1.0 is provided on "AS IS" basis without
warranty of any kind, either expressed or implied, including, but not
limited to, fitness for a particular purpose. In no event will
the authors or copyright holder be liable for any damages caused by the
use or inablility to use, of Lode Runner Live version 1.0.
 
Lode Runner Live version 1.0 is a FREEWARE program. It is illegal
to copy, distribute this program for any commercial profit except fee
for shipping and handling (no more than $2 USD). It is illegal to
inverse assemble this program in whole or partially.
 
Lode Runner Live version 1.0 can be included in PD-Disks, CD-ROMs,
shareware disks only with permission from the author. See last part for
details.
 
All trademarks, registered trademarks mentioned in this text belongs to
their respective owners and included only for informative purposes.
 
 
ÚÂÂÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
³³³³ GETTING STARTED
 
GAME REQUIREMENTS:
 
Intel 80386 or higher processor,
VGA,
MS-DOS 4.0 or higher,
About 340k of conventional memory.
 
OPTION:
 
100%-compatible Microsoft mouse and driver installed.
 
 
To start the game, simply go to directory where you copy this game,
type LRL at DOS prompt (e.g. C:\GAMES\LRL>) and press ENTER.
 
If your current system configuration enough for this game,
game immediately starts.
 
On game start you see an intro. Press any key to enter to main menu.
 
 
ÚÂÂÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
³³³³ MAIN MENU
 
After you bypass intro section you can see four menu options.
Current selected option lit.
 
START GAME
EDIT LEVELS
HIGH SCORES
EXIT TO DOS
 
Use arrow keys to select desired option and ENTER key to accept
selection.
 
 
ÚÂÂÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
³³³³ START GAME
 
When you accept START GAME option from main menu, the game starts.
 
Green Runner is Your Runner. Your goal is to gather all the prizes
(gold-coloured boxes) and after that reach top of level to finish it.
 
Bottom part of screen shows your current status:
 
"Score:" keyword shows your game points. For each prize you receive
100 points multiplied by current level number. After you finish
level you receive 10000 points multiplied by finished level number.
If game is over and your point status is great enough you will be
prompted to enter your name (or handle) and after you type and press
ENTER, high scores will be shown with your entry.
 
"Lives:" keyword shows actual number of lives. If "Lives:" shows "1"
and you died then the game is over. After you finish level you
receive one life.
 
"Level:" keyword shows number of level you currently playing.
 
During gameplay you can use following keys:
 
"<" and ">" to fire left and right.
Arrow keys to move Runner.
"P" key to pause game.
ESC key to cancel game and return to main menu.
 
 
ÚÂÂÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
³³³³ EDIT LEVELS
 
If you immediately returned to main menu then you don't have a
Microsoft-compatible mouse and driver installed.
 
If you have Microsoft-compatible mouse and driver installed then read
along.
 
All manipulations are done with mouse. Mouse cursor appears on screen
as a white arrow.
 
After you selected EDIT LEVELS from main menu and pressed ENTER, edit
screen will appear. It consists of three parts. First part is a
level-screen. It looks like an ordinary game. Second functional part
located in left-bottom part of screen. There you can see therteen
images. Third part is a button-pad and is located in right-bottom part
of screen.
 
You can use second part to select bricks or Runners to be put on
level-screen. Just move mouse cursor to desired image an press left
mouse button. To put selected image to level-screen move your mouse to
desired location on level-screen and press left mouse button. You can
draw on level-screen using current image not releasing left mouse
button.
 
Third functional part of screen is a button-pad. Buttons are:
SAVE INS NEXT
DEL REM PREV
 
After you finished designing level you need to save your work. Using
mouse cursor, press and release SAVE button. Current level will be
written to disk. (Current level and overall level count shown in
left-top part of level-screen).
 
If you need to fully redraw current level, DEL button can be handy.
Press DEL button to remove all bricks and players from the
level-screen.
 
You can insert new level by pressing INS button. REM button fully
removes current level. NEXT and PREV buttons used to select level to
modify.
 
Right mouse button used to test current level. Press right mouse
button to execute test. During test all looks and functions like in
ordinary game, except you can't see "Score:" and "Lives:". If your
Runner died you immediately return to edit mode. You can also press
ESC key to cancel test.
 
USEFUL ADVICES:
 
Before any operation (NEXT, PREV, test) it is clever to SAVE your
work, other way all modifications will not be saved!
 
When designing level you must leave first and second lines of
level maximally clear. Because dead Enemy Runner randomly appears in
these lines. If all places in these lines are used (not clear) game
can hang!
 
Also you need to make first line of level reachable to Green Runner by
putting Stairs in right places.
 
Good luck at this point!
 
 
ÚÂÂÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
³³³³ HIGH SCORES
 
By selecting HIGH SCORES from main menu you activate "High Scores"
screen. Press any key to return to main menu.
 
 
ÚÂÂÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
³³³³ EXIT TO DOS
 
This option is so standard! No explanation.
 
 
ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ
 
ÚÂÂÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
³³³³ GAME CONSISTENCE
 
Game packet must have following files:
 
LRL.EXE - main executable file
LRL.IMG - images data file
LRL.LEV - levels data file
LRL.MAN - text you are reading now
 
OPTION:
 
LRL.HSR - file with high scores
FILE_ID.DIZ - BBS description file
 
 
ÚÂÂÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
³³³³ CONTACTING THE AUTHOR
 
If you want to publish this game in any way contact author via E-mail:
 
ikomi@glas.apc.org
 
you can write in English (but preferably in Russian!)
 
for FidoNet-users: 2:5003/15.
 
 
ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ
Lode Runner Live version 1.0 Copyright (c) 1995 Aleksey V. Vaneev
ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ
 
END OF TEXT.
/programs/games/lrl/build.sh
0,0 → 1,3
#!/bin/sh
fpcmake -Twin32
make
Property changes:
Added: svn:executable
+*
\ No newline at end of property
/programs/games/lrl/dist.sh
0,0 → 1,19
#!/bin/sh
 
BIN="`pwd`/bin"
DIST="dist"
 
if ! [ -d $DIST ]; then
mkdir $DIST; fi
cd $DIST
 
rm -rf *
mkdir lrl
 
for name in $BIN/*; do
cp "$name" "lrl/`echo \`basename \"$name\"\` | tr [A-Z] [a-z]`"; done
 
tar cf - lrl | bzip2 -9f > lrl.tar.bz2
 
cd ..
Property changes:
Added: svn:executable
+*
\ No newline at end of property
/programs/games/lrl/src/LRL.pp
0,0 → 1,86
program LodeRunnerLive;
 
{$apptype gui}
 
 
uses
LRLRoutines,
LRLSprites,
LRLLevels,
LRLMainMenu,
LRLHighScores,
{LRLEditor,}
LRLIntroduction;
 
const
Version: PChar = 'Lode Runner LIVE. Version 1.4b';
 
 
procedure LRLInitialize;
begin
ImagesInitialize;
KeyboardInitialize;
ScreenMode(1);
ScreenTitle := Version;
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);
 
if (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.
/programs/games/lrl/src/LRLEditor.pp
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.
/programs/games/lrl/src/LRLHighScores.pp
0,0 → 1,264
unit LRLHighScores;
 
{$mode objfpc}
{$i-}
 
 
interface
 
 
uses
SysUtils,
LRLRoutines, LRLSprites;
 
 
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);
Seek(ImageFile, LRLImagesFilePosition);
BlockRead(ImageFile, MainScreen^, 7940, j);
DecompressRepByte(MainScreen^, HighFrame^, 7940, j);
BlockRead(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: File;
i, j: Word;
Dummy: String[30];
begin
FileMode := 0;
AssignFile(InFile, HighsFileName);
Reset(InFile, 1);
 
if IOResult <> 0 then
begin
for i := 1 to 5 do
begin
HighTable[i].Name := 'Lode Runner';
HighTable[i].score := 60000 - i * 10000;
end;
AssignFile(InFile, HighsFileName);
Rewrite(InFile, 1);
BlockWrite(InFile, HighsFileHeader[1], 29, i);
BlockWrite(InFile, HighTable, SizeOf(TSupers) * 5, j);
end else
begin
Seek(InFile, 0);
BlockRead(InFile, Dummy[1], 29, j);
if (IOResult <> 0) or (not DataIdentical(Dummy[1], HighsFileHeader[1], 29, 0, 0)) then
raise Exception.Create('Error: Invalid file with high scores! (try to remove LRL.HSR file)');
BlockRead(InFile, HighTable, SizeOf(TSupers) * 5, j);
end;
 
Close(InFile);
end;
 
 
procedure LRLSaveHighScores;
var
InFile: File;
j: Word;
begin
FileMode := 2;
AssignFile(InFile, HighsFileName);
Reset(InFile, 1);
Seek(InFile, 29);
BlockWrite(InFile, HighTable, SizeOf(TSupers) * 5, j);
Close(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;
RedrawName: Boolean;
Keypress: Word;
Name: String;
C: Char;
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 (Keypress = KEY_BACK) and (Length(Name) > 0) then
begin
SetLength(Name, Length(Name) - 1);
RedrawName := True;
end;
 
C := ScanToChar(Keypress);
if (C > #31) and (Length(Name) < 20) then
begin
Name := Name + C;
RedrawName := True;
end;
 
until Keypress = KEY_ENTER;
FadeClear;
 
Name := Trim(Name);
if Length(Name) = 0 then
Name := 'Anonymous';
LRLEnterName := Name;
end;
 
 
end.
/programs/games/lrl/src/LRLIntroduction.pp
0,0 → 1,129
unit LRLIntroduction;
 
 
interface
 
 
uses
SysUtils,
LRLRoutines, LRLSprites;
 
 
procedure LRLIntro;
 
 
implementation
 
 
const
IntroText: array[1..14] of String = (
'Lode Runner LIVE. FREEWARE Version 1.4b',
'KolibriOS port by bw (Vladimir V. Byrgazov)',
'Copyright (c) 1995 Aleksey V. Vaneev',
'Copyright (c) 2008 bw',
'',
'Send comments to Aleksey V. Vaneev',
'2:5003/15@FidoNet',
'ikomi@glas.apc.org',
'',
'Send comments to bw',
'bw@handsdriver.net',
'',
'',
'');
 
SPACE40 = ' ';
 
 
var
TimeToRefresh: Boolean;
 
 
procedure LRLIntro;
var
i, j, l: Integer;
Count: Word;
k: Word;
MainScreen: Pointer;
begin
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.
/programs/games/lrl/src/LRLLevels.pp
0,0 → 1,1194
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 = (
KEY_LEFT, 1, 1,
KEY_RIGHT, 1, 2,
KEY_UP, 1, 3,
KEY_DOWN, 1, 4,
KEY_GREY5, 1, 5,
KEY_END, 1, 6,
KEY_PGDN, 1, 7);
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);
procedure LRLPlayLevel(Number: Byte);
function LRLLevelCount: Word;
procedure LRLDeleteLevel(Count: Word);
procedure LRLInsertLevel(After: Word);
procedure LRLSaveLevel(Count: Word);
 
 
implementation
 
 
const
LevelFileName = 'LRL.LEV';
LevelFileHeader: ShortString = 'Lode Runner Live Levels'#26;
 
ERR_OPENFILE = '¥¢®§¬®¦­® ®âªàëâì ä ©« ã஢­¥©';
ERR_BADFILE = '¥¢¥à­ë© ¨«¨ ¯®¢à¥¦¤¥­­ë© ä ©« ã஢­¥©';
 
 
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;
FileMode := 2;
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;
j: Integer;
l: Longint;
k: Word;
begin
GetMem(Buffer, 1000);
j := LRLLevelCount;
if (j < Count) or (j < 2) or (Count = 0) then
Exit;
FileMode := 2;
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;
j: Integer;
l: Longint;
k: Word;
begin
GetMem(Buffer, 1000);
j := LRLLevelCount;
if (After > j) or (After = 0) then
Exit;
FileMode := 2;
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: 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;
 
 
{ GameResult:
1 - § ¬ã஢ «¨
2 - ¯®©¬ «¨
10 - ¢á¥ ᤥ« ­®
50 - ­¥â ¡®«ìè¥ ã஢­¥©
60 - ­¥â 祫®¢¥ç¥áª¨å ⮢
100 - ­ ¦ â  Esc }
 
procedure LRLUpdatePlayers;
var
i, 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) and
(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: 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;
 
 
procedure LRLPlayLevel(Number: Byte);
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 = KEY_P then
Paused := True;
end;
until (Keypress = KEY_ESC) or EndOfGame;
 
if EndOfGame then
LRLEndSequence else
GameResult := 100;
end;
 
 
end.
/programs/games/lrl/src/LRLMainMenu.pp
0,0 → 1,117
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
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 = KEY_DOWN) and (Item < 4) then
begin
Inc(Item);
RedrawAll := True;
end else
if (Keypress = KEY_UP) and (Item > 1) then
begin
Dec(Item);
RedrawAll := True;
end;
until Keypress = KEY_ENTER;
 
FadeClear;
ImageClear(LRLScreen^);
ScreenApply(LRLScreen^);
DisposeData;
end;
 
 
end.
/programs/games/lrl/src/LRLRoutines.pp
0,0 → 1,865
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 ScreenMode(Mode: Integer);
 
procedure KeyboardInitialize;
function Keypressed: Boolean;
function ReadKey: Word;
procedure KeyboardFlush;
function ScanToChar(Code: Word): Char;
 
procedure Palette256Set(var Palette256);
procedure Palette256Get(var Palette256);
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 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);
function GetInterrupt(Int: Byte): Pointer;
 
procedure AssignFile(var AFile: File; AFileName: String);
function LastDosTick(): Longword;
 
 
const
KEY_GREY = $E000;
KEY_UP_BASE = $8000;
KEY_ESC = $0100;
KEY_1 = $0200;
KEY_2 = $0300;
KEY_3 = $0400;
KEY_4 = $0500;
KEY_5 = $0600;
KEY_6 = $0700;
KEY_7 = $0800;
KEY_8 = $0900;
KEY_9 = $0A00;
KEY_0 = $0B00;
KEY_SUBTRACT = $0C00;
KEY_ADD = $0D00;
KEY_BACK = $0E00;
 
KEY_Q = $1000;
KEY_W = $1100;
KEY_E = $1200;
KEY_R = $1300;
KEY_T = $1400;
KEY_Y = $1500;
KEY_U = $1600;
KEY_I = $1700;
KEY_O = $1800;
KEY_P = $1900;
KEY_LBRACKET = $1A00;
KEY_RBRACKET = $1B00;
KEY_ENTER = $1C00;
 
KEY_A = $1E00;
KEY_S = $1F00;
KEY_D = $2000;
KEY_F = $2100;
KEY_G = $2200;
KEY_H = $2300;
KEY_J = $2400;
KEY_K = $2500;
KEY_L = $2600;
KEY_SEMICOLON = $2700;
KEY_QUOTE = $2800;
 
KEY_LSHIFT = $2A00;
KEY_Z = $2C00;
KEY_X = $2D00;
KEY_C = $2E00;
KEY_V = $2F00;
KEY_B = $3000;
KEY_N = $3100;
KEY_M = $3200;
KEY_COMMA = $3300;
KEY_DECIMAL = $3400;
KEY_DIVIDE = $3500;
KEY_RSHIFT = $3600;
 
KEY_ALT = $3800;
KEY_CAPITAL = $3600;
KEY_F1 = $3B00;
KEY_UP = $4800;
KEY_LEFT = $4B00;
KEY_GREY5 = $4C00;
KEY_RIGHT = $4D00;
KEY_END = $4F00;
KEY_DOWN = $5000;
KEY_PGDN = $5100;
 
type
ScanToCharRecord = record
Scan: Word;
CL: Char;
CU: Char;
Caps: Boolean;
end;
 
var
ScreenTitle: PChar = nil;
ScanToCharTable: array[1..45] of ScanToCharRecord = (
(Scan: KEY_0; CL: '0'; CU: ')'; Caps: False), (Scan: KEY_1; CL: '1'; CU: '!'; Caps: False),
(Scan: KEY_2; CL: '2'; CU: '@'; Caps: False), (Scan: KEY_3; CL: '3'; CU: '#'; Caps: False),
(Scan: KEY_4; CL: '4'; CU: '$'; Caps: False), (Scan: KEY_5; CL: '5'; CU: '%'; Caps: False),
(Scan: KEY_6; CL: '6'; CU: '^'; Caps: False), (Scan: KEY_7; CL: '7'; CU: '&'; Caps: False),
(Scan: KEY_8; CL: '8'; CU: '*'; Caps: False), (Scan: KEY_9; CL: '9'; CU: '('; Caps: False),
(Scan: KEY_SUBTRACT; CL: '-'; CU: '_'; Caps: False), (Scan: KEY_ADD; CL: '='; CU: '+'; Caps: False),
 
(Scan: KEY_Q; CL: 'q'; CU: 'Q'; Caps: True), (Scan: KEY_W; CL: 'w'; CU: 'W'; Caps: True),
(Scan: KEY_E; CL: 'e'; CU: 'E'; Caps: True), (Scan: KEY_R; CL: 'r'; CU: 'R'; Caps: True),
(Scan: KEY_T; CL: 't'; CU: 'T'; Caps: True), (Scan: KEY_Y; CL: 'y'; CU: 'Y'; Caps: True),
(Scan: KEY_U; CL: 'u'; CU: 'U'; Caps: True), (Scan: KEY_I; CL: 'i'; CU: 'I'; Caps: True),
(Scan: KEY_O; CL: 'o'; CU: 'O'; Caps: True), (Scan: KEY_P; CL: 'p'; CU: 'P'; Caps: True),
(Scan: KEY_LBRACKET; CL: '['; CU: '{'; Caps: False), (Scan: KEY_RBRACKET; CL: ']'; CU: '}'; Caps: False),
 
(Scan: KEY_A; CL: 'a'; CU: 'A'; Caps: True), (Scan: KEY_S; CL: 's'; CU: 'S'; Caps: True),
(Scan: KEY_D; CL: 'd'; CU: 'D'; Caps: True), (Scan: KEY_F; CL: 'f'; CU: 'F'; Caps: True),
(Scan: KEY_G; CL: 'g'; CU: 'G'; Caps: True), (Scan: KEY_H; CL: 'h'; CU: 'H'; Caps: True),
(Scan: KEY_J; CL: 'j'; CU: 'J'; Caps: True), (Scan: KEY_K; CL: 'k'; CU: 'K'; Caps: True),
(Scan: KEY_L; CL: 'l'; CU: 'L'; Caps: True),
(Scan: KEY_SEMICOLON; CL: ';'; CU: ':'; Caps: False), (Scan: KEY_QUOTE; CL: ''''; CU: '"'; Caps: False),
 
(Scan: KEY_Z; CL: 'z'; CU: 'Z'; Caps: True), (Scan: KEY_X; CL: 'x'; CU: 'X'; Caps: True),
(Scan: KEY_C; CL: 'c'; CU: 'C'; Caps: True), (Scan: KEY_V; CL: 'v'; CU: 'V'; Caps: True),
(Scan: KEY_B; CL: 'b'; CU: 'B'; Caps: True), (Scan: KEY_N; CL: 'n'; CU: 'N'; Caps: True),
(Scan: KEY_M; CL: 'm'; CU: 'M'; Caps: True),
(Scan: KEY_COMMA; CL: ','; CU: '<'; Caps: False), (Scan: KEY_DECIMAL; CL: '.'; CU: '>'; Caps: False),
(Scan: KEY_DIVIDE; CL: '/'; CU: '?'; Caps: False)
);
 
 
implementation
 
 
uses
SysUtils;
 
 
const
BUFFER_WIDTH = 320;
BUFFER_HEIGHT = 200;
 
type
PRGBColor = ^TRGBColor;
TRGBColor = packed record
R, G, B: Byte;
end;
 
PRGBPalette = ^TRGBPalette;
TRGBPalette = array[Byte] of TRGBColor;
 
 
var
ScreenRGBPalette: TRGBPalette;
ScreenRGBBuffer : PRGBColor = nil;
ScreenRGBTemporary: PRGBColor = nil;
ScreenPalBuffer : array[0..BUFFER_HEIGHT - 1, 0..BUFFER_WIDTH - 1] of Byte;
 
WindowWidth : Longint;
WindowHeight: Longint;
ScreenWidth : Longword;
ScreenHeight: Longword;
CurrentScreenMode: Integer = 0;
 
LastKeyEvent: Word = $FFFF;
LastKeyUp : Boolean = True;
LastKeyDown: Boolean = False;
AltDown : Boolean = False;
ShiftDown : Boolean = False;
LShiftDown : Boolean = False;
RShiftDown : Boolean = False;
CapsPressed: Boolean = False;
 
 
 
procedure Paint;
begin
kos_begindraw();
kos_definewindow(10, 10, 100, 100, $64000000);
if CurrentScreenMode <> 0 then
begin
kos_setcaption(ScreenTitle);
if Assigned(ScreenRGBBuffer) then
kos_drawimage24(0, 0, ScreenWidth, ScreenHeight, ScreenRGBBuffer) else
kos_drawrect(0, 0, ScreenWidth, ScreenHeight, $FF00FF);
end;
kos_enddraw();
end;
 
 
procedure UpdateRGBBuffer;
var
XStep, YStep: Longword;
 
procedure Horizontal;
var
X, Y, I: Longword;
B: PByte;
C: PRGBColor;
begin
C := ScreenRGBTemporary;
for Y := 0 to BUFFER_HEIGHT - 1 do
begin
I := 0;
B := @ScreenPalBuffer[Y, 0];
for X := 0 to ScreenWidth - 1 do
begin
C^ := ScreenRGBPalette[PByte(B + (I shr 16))^];
Inc(I, XStep);
Inc(C);
end;
end;
end;
 
procedure Vertical;
var
Y, I: Longword;
S: PRGBColor;
C: PRGBColor;
begin
I := 0;
S := ScreenRGBTemporary;
C := ScreenRGBBuffer;
for Y := 0 to ScreenHeight - 1 do
begin
Move(PRGBColor(S + (I shr 16) * ScreenWidth)^, C^, ScreenWidth * SizeOf(C^));
Inc(I, YStep);
Inc(C, ScreenWidth);
end;
end;
 
var
I, J: Longint;
B: PByte;
C: PRGBColor;
 
begin
if (ScreenWidth = BUFFER_WIDTH) and (ScreenHeight = BUFFER_HEIGHT) then
begin
{¯¥à¥­®á ®¤¨­ ¢ ®¤¨­}
B := @ScreenPalBuffer;
C := ScreenRGBBuffer;
for I := 0 to BUFFER_HEIGHT - 1 do
for J := 0 to BUFFER_WIDTH - 1 do
begin
C^ := ScreenRGBPalette[B^];
Inc(B);
Inc(C);
end;
end else
begin
{¬ áèâ ¡¨à®¢ ­¨¥}
XStep := (BUFFER_WIDTH shl 16) div ScreenWidth;
YStep := (BUFFER_HEIGHT shl 16) div ScreenHeight;
Horizontal;
Vertical;
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 < BUFFER_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 * BUFFER_WIDTH + X + J)^, K);
end;
Inc(P, Width);
end;
end;
 
 
procedure ImagePutTransparent(var Screen, ImageBuffer; X, Y: Integer; Winx1, Winy1, Winx2, Winy2: Word);
var
Width, Height: Word;
I, J, K, L: Integer;
PI, PO: PByte;
begin
Width := PWord(@ImageBuffer)[0];
Height := PWord(@ImageBuffer)[1];
PI := @ImageBuffer + 4;
 
for I := Y to Y + Height - 1 do
begin
if (I >= 0) and (I < BUFFER_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;
 
Inc(PI, J);
PO := @Screen + I * BUFFER_WIDTH + X + J;
for L := 1 to K do
begin
if PI^ > 0 then
PO^ := PI^;
Inc(PI);
Inc(PO);
end;
Dec(PI, J + K);
end;
Inc(PI, Width);
end;
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, ScreenPalBuffer, SizeOf(ScreenPalBuffer));
UpdateRGBBuffer;
end;
 
procedure ImageClear(var Buffer);
begin
FillChar(Buffer, BUFFER_WIDTH * BUFFER_HEIGHT, 0);
end;
 
procedure ScreenMode(Mode: Integer);
var
ThreadInfo: TKosThreadInfo;
begin
if Mode <> CurrentScreenMode then
begin
if Assigned(ScreenRGBBuffer) then FreeMem(ScreenRGBBuffer);
if Assigned(ScreenRGBTemporary) then FreeMem(ScreenRGBTemporary);
 
case Mode of
-2: begin
ScreenWidth := BUFFER_WIDTH div 2;
ScreenHeight := BUFFER_HEIGHT div 2;
end;
1..3: begin
ScreenWidth := BUFFER_WIDTH * Mode;
ScreenHeight := BUFFER_HEIGHT * Mode;
end;
end;
 
if CurrentScreenMode = 0 then Paint;
 
kos_threadinfo(@ThreadInfo);
 
with ThreadInfo, WindowRect do
begin
WindowWidth := Width - ClientRect.Width + Longint(ScreenWidth);
WindowHeight := Height - ClientRect.Height + Longint(ScreenHeight);
kos_movewindow(Left, Top, WindowWidth, WindowHeight);
end;
 
CurrentScreenMode := Mode;
 
ScreenRGBBuffer := GetMem(ScreenWidth * ScreenHeight * SizeOf(ScreenRGBBuffer^));
ScreenRGBTemporary := GetMem(ScreenWidth * BUFFER_HEIGHT * SizeOf(ScreenRGBTemporary^));
 
UpdateRGBBuffer;
end;
end;
 
 
 
procedure KeyboardInitialize;
begin
kos_setkeyboardmode(1);
end;
 
function ReadKeyLoop: Word;
var
Event: Word;
begin
kos_maskevents(ME_PAINT or ME_KEYBOARD);
repeat
Event := kos_getevent();
if Event = SE_PAINT then Paint;
until Event = SE_KEYBOARD;
Result := kos_getkey();
end;
 
function TranslateKey(Key: Word): Word;
begin
if Key = KEY_GREY then
Result := kos_getkey() else
Result := Key;
 
LastKeyDown := Result < KEY_UP_BASE;
LastKeyUp := not LastKeyDown;
if LastKeyUp then Dec(Result, KEY_UP_BASE);
 
if Result = KEY_ALT then
begin
AltDown := LastKeyDown;
Result := $FFFF;
end else
 
if Result = KEY_LSHIFT then
begin
LShiftDown := LastKeyDown;
ShiftDown := LShiftDown or RShiftDown;
Result := $FFFF;
end else
 
if Result = KEY_RSHIFT then
begin
RShiftDown := LastKeyDown;
ShiftDown := LShiftDown or RShiftDown;
Result := $FFFF;
end else
 
if AltDown then
case Result of
KEY_1: begin Result := $FFFF; if LastKeyDown then ScreenMode(1); end;
KEY_2: begin Result := $FFFF; if LastKeyDown then ScreenMode(2); end;
KEY_3: begin Result := $FFFF; if LastKeyDown then ScreenMode(3); end;
KEY_9: begin Result := $FFFF; if LastKeyDown then ScreenMode(-2); end;
KEY_0: begin Result := $FFFF; if LastKeyDown then ScreenMode(100); end;
end;
end;
 
function Keypressed: Boolean;
begin
if (LastKeyEvent < KEY_UP_BASE) and LastKeyDown then
Result := True else
begin
kos_maskevents(ME_KEYBOARD);
if kos_getevent(False) = SE_KEYBOARD then
begin
LastKeyEvent := TranslateKey(kos_getkey());
if LastKeyEvent < KEY_UP_BASE then
Result := LastKeyDown else
Result := False;
end else
begin
LastKeyEvent := $FFFF;
Result := False;
end;
end;
end;
 
function ReadKey: Word;
begin
repeat
if LastKeyEvent < KEY_UP_BASE then
Result := LastKeyEvent else
Result := TranslateKey(ReadKeyLoop);
LastKeyEvent := $FFFF;
until (Result < KEY_UP_BASE) and LastKeyDown;
end;
 
procedure KeyboardFlush;
begin
end;
 
function ScanToChar(Code: Word): Char;
var
I: Word;
begin
for I := Low(ScanToCharTable) to High(ScanToCharTable) do
with ScanToCharTable[I] do
if Scan = Code then
begin
if not CapsPressed then
if not ShiftDown then
Result := CL else
Result := CU
else
if not ShiftDown then
if not Caps then
Result := CL else
Result := CU
else
if not Caps then
Result := CL else
Result := CL;
Exit;
end;
Result := #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 Palette256Darken(var Palette256; StartElement, EndElement, Decrement, MinValue: Byte);
var
I, J: Byte;
PB : PByte;
begin
PB := @Palette256;
Inc(PB, StartElement * 3);
for I := StartElement to EndElement do
for J := 1 to 3 do
begin
if PB^ > MinValue then
if PB^ < Decrement then
PB^ := MinValue else
Dec(PB^, Decrement);
Inc(PB);
end;
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;
PB: PByte;
begin
PB := @Buffer + BufferOffset;
for I := 1 to Count do
begin
if PB^ > 0 then
Inc(PB^, Amount);
Inc(PB);
end;
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 32 do
begin
Palette256Transform(Pal1^, Pal^);
Palette256Transform(Pal1^, Pal^);
Palette256Set(Pal1^);
kos_delay(1);
end;
FreeMem(Pal1, 768);
end;
 
 
procedure DecompressRepByte(var InArray, OutArray; InArraySize: Word; var OutArraySize: Word);
var
I, J: Word;
PIn : PByte;
POut: PByte;
begin
I := 0;
PIn := @InArray;
POut := @OutArray;
 
while I < InArraySize do
begin
Inc(I);
 
if PIn^ = 0 then
begin
Inc(PIn);
J := PIn^;
Inc(I, 2);
Inc(PIn);
Inc(OutArraySize, J);
while J > 0 do
begin
POut^ := PIn^;
Inc(POut);
Dec(J);
end;
Inc(PIn);
end else
 
if PIn^ < 4 then
begin
J := PIn^;
Inc(I);
Inc(PIn);
Inc(OutArraySize, J);
while J > 0 do
begin
POut^ := PIn^;
Inc(POut);
Dec(J);
end;
Inc(PIn);
end else
 
begin
POut^ := PIn^;
Inc(PIn);
Inc(POut);
Inc(OutArraySize);
end;
end;
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.
/programs/games/lrl/src/LRLSprites.pp
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 = '¥¢®§¬®¦­® ®âªàëâì ä ©« ª à⨭®ª';
ERR_BADFILE = '¥¢¥à­ë© ¨«¨ ¯®¢à¥¦¤¥­­ë© ä ©« ª à⨭®ª';
 
 
procedure LoadImages;
var
InBuffer: Pointer;
i, j, k, l, x, y: Word;
a: 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.