/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. |