diff --git a/programs/games/lrl/LRLRoutines.pp b/programs/games/lrl/LRLRoutines.pp deleted file mode 100644 index 92c513fe74..0000000000 --- a/programs/games/lrl/LRLRoutines.pp +++ /dev/null @@ -1,499 +0,0 @@ -unit LRLRoutines; - -{$mode objfpc} -{$asmmode intel} - - -interface - - -procedure ImagePut(var Screen, ImageBuffer; X, Y: Integer; Winx1, Winy1, Winx2, Winy2: Word); -procedure ImagePutTransparent(var Screen, ImageBuffer; X, Y: Integer; Winx1, Winy1, Winx2, Winy2: Word); -procedure ImageFill(var ImageBuffer; SizeX, SizeY: Word; Value: Byte); -function ImageSizeX(var ImageBuffer): Word; -function ImageSizeY(var ImageBuffer): Word; -procedure ImageStringGet(Source: String; var FontData, Buffer; ColorOffs: Byte); -procedure ScreenApply(var Buffer); -procedure ImageClear(var Buffer); - -procedure Palette256Set(var Palette256); -procedure Palette256Get(var Palette256); -procedure Palette256Grayscale(var Palette256; StartElement, EndElement: Byte); -procedure Palette256Darken(var Palette256; StartElement, EndElement, Decrement, MinValue: Byte); -procedure Palette256Transform(var SourcePalette, DestinationPalette); -function DataByteGet(var Buffer; BufferOffset: Word): Byte; -procedure DataBytePut(var Buffer; BufferOffset: Word; Value: Byte); -function DataWordGet(var Buffer; BufferOffset: Word): Word; -procedure DataWordPut(var Buffer; BufferOffset: Word; Value: Word); -procedure DataMove(var Source, Destination; Count: Word; SourceOffset, DestinationOffset: Word); -procedure DataAdd(var Buffer; Count: Word; Amount: Byte; BufferOffset: Word); -procedure DataFill(var Buffer; Count: Word; Value: Byte; BufferOffset: Word); -function DataIdentical(var Array1, Array2; Count: Word; Array1Offset, Array2Offset: Word): Boolean; -function ReadKey: Word; -function Keypressed: Boolean; -function SetInterrupt(Int: Byte; NewAddress: Pointer): Pointer; -procedure FadeClear; -procedure FadeTo(pal: Pointer); -procedure DecompressRepByte(var InArray, OutArray; InArraySize: Word; var OutArraySize: Word); -function MSMouseInArea(x1, y1, x2, y2: Integer): Boolean; -function MSMouseDriverExist: Boolean; -procedure MSMouseGetXY(var x, y: Integer); -function MSMouseButtonStatusGet: Word; -function MSMouseButtonWasPressed(Button: Word; var x, y: Integer): Boolean; -function MSMouseButtonWasReleased(Button: Word; var x, y: Integer): Boolean; -procedure MSMouseSetXY(x, y: Integer); -procedure KeyboardFlush; -function GetInterrupt(Int: Byte): Pointer; - -procedure AssignFile(var AFile: File; AFileName: String); -function LastDosTick(): Longword; - - -implementation - - -uses - SysUtils; - - -const - SCREEN_WIDTH = 320; - SCREEN_HEIGHT = 200; - -type - PRGBColor = ^TRGBColor; - TRGBColor = packed record - R, G, B: Byte; - end; - - PRGBPalette = ^TRGBPalette; - TRGBPalette = array[Byte] of TRGBColor; - -var - ScreenRGBPalette: TRGBPalette; - ScreenRGBBuffer : array[0..SCREEN_HEIGHT - 1, 0..SCREEN_WIDTH - 1] of TRGBColor; - ScreenBuffer : array[0..SCREEN_WIDTH * SCREEN_HEIGHT - 1] of Byte; - - AlreadyKeyPressed: Boolean = False; - - -procedure Paint; -begin - kos_begindraw(); - kos_definewindow(500, 100, SCREEN_WIDTH - 1, SCREEN_HEIGHT - 1, $01000000); - kos_drawimage24(0, 0, SCREEN_WIDTH, SCREEN_HEIGHT, @ScreenRGBBuffer); - kos_enddraw(); -end; - -procedure UpdateRGBBuffer; -var - I, J: Longint; - B: PByte; -begin - B := @ScreenBuffer; - for I := 0 to SCREEN_HEIGHT - 1 do - for J := 0 to SCREEN_WIDTH - 1 do - begin - ScreenRGBBuffer[I, J] := ScreenRGBPalette[B^]; - Inc(B); - end; - Paint; -end; - - -procedure ImagePut(var Screen, ImageBuffer; X, Y: Integer; WinX1, WinY1, WinX2, WinY2: Word); -var - Width, Height: Word; - I, J, K: Integer; - P: Pointer; -begin - Width := PWord(@ImageBuffer)[0]; - Height := PWord(@ImageBuffer)[1]; - - P := @ImageBuffer + 4; - for I := Y to Y + Height - 1 do - begin - if (I >= 0) and (I < SCREEN_HEIGHT) and (I >= WinY1) and (I <= WinY2) then - begin - if X < WinX1 then - J := WinX1 - X else - J := 0; - K := Width - J; - if WinX1 + K - 1 > WinX2 then - K := WinX2 - WinX1 + 1; - Move((P + J)^, (@Screen + I * SCREEN_WIDTH + X + J)^, K); - end; - Inc(P, Width); - end; -end; - -procedure ImagePutTransparent(var Screen, ImageBuffer; X, Y: Integer; Winx1, Winy1, Winx2, Winy2: Word); -begin - ImagePut(Screen, ImageBuffer, X, Y, Winx1, Winy1, Winx2, Winy2); -end; - -procedure ImageFill(var ImageBuffer; SizeX, SizeY: Word; Value: Byte); -begin - PWord(@ImageBuffer)^ := SizeX; - PWord(@ImageBuffer + 2)^ := SizeY; - FillChar((@ImageBuffer + 4)^, SizeX * SizeY, Value); -end; - -function ImageSizeX(var ImageBuffer): Word; -begin - Result := PWord(@ImageBuffer)^; -end; - -function ImageSizeY(var ImageBuffer): Word; -begin - Result := PWord(@ImageBuffer + 2)^; -end; - -procedure ImageStringGet(Source: String; var FontData, Buffer; ColorOffs: Byte); -var - Width, Height: Word; - Table: PWord; - P, B: PByte; - X, I, J, K, C: Word; -begin - Height := PWord(@FontData + 2)^; - Table := PWord(@FontData + 4); - - { à áç¥â €«š­ë áâபš } - Width := 0; - for I := 1 to Length(Source) do - begin - P := @Table[Ord(Source[I])]; - Inc(Width, PWord(P + PWord(P)^)^); - end; - - PWord(@Buffer)^ := Width; - PWord(@Buffer + 2)^ := Height; - - { ¢ë¢®€ áâபš } - X := 0; - for I := 1 to Length(Source) do - begin - P := @Table[Ord(Source[I])]; - B := PByte(P + PWord(P)^); - C := PWord(B)^; - Inc(B, 2); - - P := PByte(@Buffer + 4 + X); - for K := 0 to Height - 1 do - begin - for J := 0 to C - 1 do - begin - if B^ = 0 then - P^ := 0 else - P^ := B^ + ColorOffs; - Inc(P); - Inc(B); - end; - Inc(P, Width - C); - end; - - Inc(X, C); - end; -end; - -procedure ScreenApply(var Buffer); -begin - Move(Buffer, ScreenBuffer, SizeOf(ScreenBuffer)); - UpdateRGBBuffer; -end; - - -procedure ImageClear(var Buffer); -begin - FillChar(Buffer, SCREEN_WIDTH * SCREEN_HEIGHT, 0); -end; - - -procedure Palette256Set(var Palette256); -var - I: Longint; - P: PRGBColor; -begin - P := @Palette256; - for I := 0 to 255 do - with ScreenRGBPalette[I] do - begin - R := Round(P^.B / 63 * 255); - G := Round(P^.G / 63 * 255); - B := Round(P^.R / 63 * 255); - Inc(P); - end; - UpdateRGBBuffer; -end; - -procedure Palette256Get(var Palette256); -var - I: Longint; - P: PRGBColor; -begin - P := @Palette256; - for I := 0 to 255 do - with ScreenRGBPalette[I] do - begin - P^.R := Round(B / 255 * 63); - P^.G := Round(G / 255 * 63); - P^.B := Round(R / 255 * 63); - Inc(P); - end; -end; - -procedure Palette256Grayscale(var Palette256; StartElement, EndElement: Byte); -begin -end; - -procedure Palette256Darken(var Palette256; StartElement, EndElement, Decrement, MinValue: Byte); -begin -end; - -procedure Palette256Transform(var SourcePalette, DestinationPalette); -var - I: Longint; - S, D: PByte; -begin - S := @SourcePalette; - D := @DestinationPalette; - for I := 0 to 767 do - begin - if S^ < D^ then Inc(S^) else - if S^ > D^ then Dec(S^); - Inc(S); - Inc(D); - end; -end; - -function DataByteGet(var Buffer; BufferOffset: Word): Byte; -begin - Result := PByte(@Buffer + BufferOffset)^; -end; - -procedure DataBytePut(var Buffer; BufferOffset: Word; Value: Byte); -begin - PByte(@Buffer + BufferOffset)^ := Value; -end; - -function DataWordGet(var Buffer; BufferOffset: Word): Word; -begin - Result := PWord(@Buffer + BufferOffset)^; -end; - -procedure DataWordPut(var Buffer; BufferOffset: Word; Value: Word); -begin - PWord(@Buffer + BufferOffset)^ := Value; -end; - -procedure DataMove(var Source, Destination; Count: Word; SourceOffset, DestinationOffset: Word); -begin - Move((@Source + SourceOffset)^, (@Destination + DestinationOffset)^, Count); -end; - -procedure DataFill(var Buffer; Count: Word; Value: Byte; BufferOffset: Word); -begin - FillChar((@Buffer + BufferOffset)^, Count, Value); -end; - -function DataIdentical(var Array1, Array2; Count: Word; Array1Offset, Array2Offset: Word): Boolean; -begin - Result := CompareByte((@Array1 + Array1Offset)^, (@Array2 + Array2Offset)^, Count) = 0; -end; - -procedure DataAdd(var Buffer; Count: Word; Amount: Byte; BufferOffset: Word); -var - I: Word; -begin - for I := 0 to Count do - Inc(PByte(@Buffer + BufferOffset + I)^, Amount); - {if >0 then += amount} -end; - -function ReadKey: Word; -var - Event: Word; -begin - if not AlreadyKeyPressed then - begin - kos_maskevents(ME_PAINT or ME_KEYBOARD); - repeat - Event := kos_getevent(); - if Event = SE_PAINT then Paint; - until Event = SE_KEYBOARD; - end; - Result := kos_getkey() shr 8; - AlreadyKeyPressed := False; - {WriteLn('ReadKey -> ', IntToHex(Result, 2));} -end; - -function Keypressed: Boolean; -begin - if AlreadyKeyPressed then - Result := True else - begin - kos_maskevents(ME_KEYBOARD); - Result := kos_getevent(False) = SE_KEYBOARD; - AlreadyKeyPressed := Result; - end; -end; - -procedure KeyboardFlush; -var - Event: Word; -begin - kos_maskevents(ME_KEYBOARD); - repeat - Event := kos_getevent(False); - if Event = SE_KEYBOARD then kos_getkey(); - until Event = 0; - AlreadyKeyPressed := False; -end; - -function SetInterrupt(Int: Byte; NewAddress: Pointer): Pointer; -begin - Result := nil; -end; - -procedure FadeClear; -var - Pal1, Pal2: Pointer; - i: Integer; -begin - GetMem(Pal1, 768); - GetMem(Pal2, 768); - Palette256Get(Pal1^); - for i := 0 to 32 do - begin - DataMove(Pal1^, Pal2^, 768, 0, 0); - Palette256Darken(Pal2^, 0, 255, i * 2, 0); - Palette256Set(Pal2^); - end; - FreeMem(Pal1, 768); - FreeMem(Pal2, 768); -end; - -procedure FadeTo(Pal: Pointer); -var - Pal1: Pointer; - I: Integer; -begin - GetMem(Pal1, 768); - Palette256Get(Pal1^); - for I := 0 to 63 do - begin - Palette256Transform(Pal1^, Pal^); - Palette256Set(Pal1^); - kos_delay(1); - end; - FreeMem(Pal1, 768); -end; - -procedure DecompressRepByte(var InArray, OutArray; InArraySize: Word; var OutArraySize: Word); -begin -{asm - PUSH DS - - xor DX,DX - xor AX,AX - - LDS SI,InArray - LES DI,OutArray - - MOV CX,InArraySize - JCXZ @Done - - @Loop1: - LODSB - CMP AL,0 - JE @VsePonyatno - CMP AL,4 - JB @MensheTreh - - INC DX - STOSB - JMP @DoLoop - - @MensheTreh: - SUB CX,1 - MOV BX,CX - - MOV CX,AX - ADD DX,AX - LODSB - REP STOSB - - MOV CX,BX - JMP @DoLoop - - @VsePonyatno: - LODSB - SUB CX,2 - MOV BX,CX - MOV CX,AX - ADD DX,AX - LODSB - REP STOSB - MOV CX,BX - - @DoLoop: - JCXZ @Done - LOOP @Loop1 - - @Done: - LES DI,OutArraySize - MOV[ES:DI],DX - POP DS} -end; - -function MSMouseInArea(x1, y1, x2, y2: Integer): Boolean; -begin - Result := False; -end; - -function MSMouseDriverExist: Boolean; -begin - Result := True; -end; - -procedure MSMouseGetXY(var x, y: Integer); -begin -end; - -function MSMouseButtonStatusGet: Word; -begin - Result := 0; -end; - -function MSMouseButtonWasPressed(Button: Word; var x, y: Integer): Boolean; -begin - Result := False; -end; - -function MSMouseButtonWasReleased(Button: Word; var x, y: Integer): Boolean; -begin - Result := False; -end; - -procedure MSMouseSetXY(x, y: Integer); -begin -end; - -function GetInterrupt(Int: Byte): Pointer; -begin - Result := nil; -end; - -procedure AssignFile(var AFile: File; AFileName: String); -begin - Assign(AFile, IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0))) + AFileName); -end; - -function LastDosTick(): Longword; -begin - Result := Round(kos_timecounter() * 0.182); -end; - - -end. diff --git a/programs/games/lrl/Makefile.fpc b/programs/games/lrl/Makefile.fpc new file mode 100644 index 0000000000..140f4ac340 --- /dev/null +++ b/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)/$^ diff --git a/programs/games/lrl/bin/LRL.HSR b/programs/games/lrl/bin/LRL.HSR new file mode 100644 index 0000000000..4c662e03d1 Binary files /dev/null and b/programs/games/lrl/bin/LRL.HSR differ diff --git a/programs/games/lrl/bin/LRL.MAN b/programs/games/lrl/bin/LRL.MAN new file mode 100644 index 0000000000..b1568f3750 --- /dev/null +++ b/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. diff --git a/programs/games/lrl/build.bat b/programs/games/lrl/build.bat deleted file mode 100644 index 2eee86df89..0000000000 --- a/programs/games/lrl/build.bat +++ /dev/null @@ -1,30 +0,0 @@ -@echo off - -rem „«ï ᡮચ š£àë ­¥®¡å®€š¬® ¢ ¯¥à¥¬¥­­®© UNITS (®¯à¥€¥«¥­  ­šŠ¥) -rem 㪠§ âì à á¯®«®Š¥­š¥ ¯ ¯ªš, ¢ ª®â®à®© ­ å®€ïâáï ®âª®¬¯š«šà®¢ ­­ë¥ ¬®€ã«š -rem RTL €«ï KolibriOS.  ¯àš¬¥à, ¥á«š šá宀­šªš RTL ­ å®€ïâáï ¢ ¯ ¯ª¥ my/rtl, -rem ⮠ᮡ࠭­ë¥ ¬®€ã«š RTL - ᪮॥ ¢á¥£® ¢ my/units. Œ®Š¥â ®ª § âìáï -rem €®áâ â®ç­ë¬ ¯à®áâ® ¯¥à¥­¥áâš íâã ¯ ¯ªã (lrl) ¢ €šà¥ªâ®àšî my. - -rem ’ ª Š¥, €«ï ᡮચ, ¢ ¬ ¯®­ €®¡šâáï ãâš«šâ  exe2kos.exe š FreePascal 2.2.0. - - -set NAME=lrl -set NAMEEXE=%NAME%.exe -set NAMEKEX=%NAME%.kex - -set BUILD=-FUbuild -set UNITS=-Fu../units - -fpc %NAME%.pp -n -Twin32 -Se5 -XXs -Sg -O3pPENTIUM3 -CfSSE -WB0 %BUILD% %UNITS% -if errorlevel 1 goto error - -exe2kos.exe %NAMEEXE% %NAMEKEX% -del %NAMEEXE% -move %NAMEKEX% bin -goto end - -:error -echo An error occured while building %NAME% - -:end diff --git a/programs/games/lrl/build.sh b/programs/games/lrl/build.sh new file mode 100755 index 0000000000..5d75a0e5d2 --- /dev/null +++ b/programs/games/lrl/build.sh @@ -0,0 +1,3 @@ +#!/bin/sh +fpcmake -Twin32 +make diff --git a/programs/games/lrl/dist.sh b/programs/games/lrl/dist.sh new file mode 100755 index 0000000000..f3a299eff5 --- /dev/null +++ b/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 .. diff --git a/programs/games/lrl/readme-ru.txt b/programs/games/lrl/readme-ru.txt deleted file mode 100644 index 0491b25f4b..0000000000 --- a/programs/games/lrl/readme-ru.txt +++ /dev/null @@ -1,10 +0,0 @@ - -Lode Runner Live 1.0 -==================== - -à®¥ªâ ¯® ¯¥à¥­®áã š£àë Lode Runner Live 1.0 á ¯« âä®à¬ë DOS ¢ KolibriOS. - -—šâ ©â¥ ª®¬¬¥­â àšš ¯® ª®¬¯š«ïæšš ¢ build.bat. - -  € ­­ë© ¬®¬¥­â â¥áâšà®¢ « áì ªà®áª®¬¯š«ïæšï ⮫쪮 š§ Windows 2000 SP4 -­  32å à §à®© ¬ èš­¥. diff --git a/programs/games/lrl/LRL.pp b/programs/games/lrl/src/LRL.pp similarity index 73% rename from programs/games/lrl/LRL.pp rename to programs/games/lrl/src/LRL.pp index e82bbb0c0b..797a930de0 100644 --- a/programs/games/lrl/LRL.pp +++ b/programs/games/lrl/src/LRL.pp @@ -8,18 +8,20 @@ uses LRLSprites, LRLLevels, LRLMainMenu, - {LRLHighScores, - LRLEditor,} + LRLHighScores, + {LRLEditor,} LRLIntroduction; const - Version: array [1..34] of char = 'Lode Runner LIVE. Version 1.0'#13#10#13#10'$'; + Version: PChar = 'Lode Runner LIVE. Version 1.4b'; procedure LRLInitialize; begin - kos_setkeyboardmode(0); ImagesInitialize; + KeyboardInitialize; + ScreenMode(1); + ScreenTitle := Version; end; @@ -45,20 +47,21 @@ begin repeat LRLPlayLevel(cl); KeyboardFlush; + if GameResult = 10 then begin Inc(LRLLives); - LRLScore := LRLScore + 10000 * longint(cl); + LRLScore := LRLScore + 10000 * Longint(cl); Inc(cl); end else Dec(LRLLives); until (LRLLives = 0) or (GameResult = 100); - {(GameResult <> 100) and LRLBestScore(LRLScore) then + if (GameResult <> 100) and LRLBestScore(LRLScore) then begin LRLInsertScore(LRLEnterName, LRLScore); LRLShowHighScores; - end;} + end; end; procedure LRLShell; @@ -69,8 +72,8 @@ begin repeat LRLSelectItem(MenuSelection); if MenuSelection = 1 then LRLGameStart; - {if MenuSelection = 2 then LRLEditLevels; - if MenuSelection = 3 then LRLShowHighScores;} + {if MenuSelection = 2 then LRLEditLevels;} + if MenuSelection = 3 then LRLShowHighScores; until MenuSelection = 4; end; diff --git a/programs/games/lrl/LRLEditor.pp b/programs/games/lrl/src/LRLEditor.pp similarity index 100% rename from programs/games/lrl/LRLEditor.pp rename to programs/games/lrl/src/LRLEditor.pp diff --git a/programs/games/lrl/LRLHighScores.pp b/programs/games/lrl/src/LRLHighScores.pp similarity index 55% rename from programs/games/lrl/LRLHighScores.pp rename to programs/games/lrl/src/LRLHighScores.pp index 46ca0f68ce..b138d9aa17 100644 --- a/programs/games/lrl/LRLHighScores.pp +++ b/programs/games/lrl/src/LRLHighScores.pp @@ -1,19 +1,23 @@ unit LRLHighScores; +{$mode objfpc} +{$i-} + interface uses - LRLRoutines, LRLSprites, StrUnit; + SysUtils, + LRLRoutines, LRLSprites; procedure LRLLoadHighScores; procedure LRLShowHighScores; -function LRLBestScore(Score: longint): boolean; -procedure LRLInsertScore(Name: string; Score: longint); +function LRLBestScore(Score: Longint): Boolean; +procedure LRLInsertScore(Name: String; Score: Longint); procedure LRLSaveHighScores; -function LRLEnterName: string; +function LRLEnterName: String; implementation @@ -21,114 +25,130 @@ implementation const HighsFileName = 'LRL.HSR'; - HighsFileHeader: string[29] = 'Lode Runner Live High Scores'#26; + HighsFileHeader: String[29] = 'Lode Runner Live High Scores'#26; type TSupers = packed record - Name: string[20]; - Score: longint; + Name: String[20]; + Score: Longint; end; var - MainScreen: POINTER; - HighFrame: POINTER; + MainScreen: Pointer; + HighFrame: Pointer; HighTable: array[1..5] of TSupers; + procedure LoadData; var - j: word; + j: Word; begin - GETMEM(MainScreen, 64004); - GETMEM(HighFrame, 45000); - DFAFilePositionSet(ImageFile, LRLImagesFilePosition, DFASeekFromStart); - DFAFileRead(ImageFile, MainScreen^, 7940, j); + GetMem(MainScreen, 64004); + GetMem(HighFrame, 45000); + Seek(ImageFile, LRLImagesFilePosition); + BlockRead(ImageFile, MainScreen^, 7940, j); DecompressRepByte(MainScreen^, HighFrame^, 7940, j); - DFAFileRead(ImageFile, MainScreen^, 64004, j); + BlockRead(ImageFile, MainScreen^, 64004, j); end; + procedure DisposeData; begin - FREEMEM(MainScreen, 64004); - FREEMEM(HighFrame, 45000); + FreeMem(MainScreen, 64004); + FreeMem(HighFrame, 45000); end; + procedure LRLShowHighScores; var - p: POINTER; - i: integer; - s: string; + p: Pointer; + i: Integer; + s: String; begin LRLLoadHighScores; - GETMEM(p, 768); + + GetMem(p, 768); DataFill(p^, 768, 0, 0); Palette256Set(p^); - FREEMEM(p, 768); + 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); + 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); + 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; + + ReadKey; + FadeClear; ImageClear(LRLScreen^); ScreenApply(LRLScreen^); + DisposeData; end; + procedure LRLLoadHighScores; var - InFile: TDFAFileHandle; - i, j: word; - high: TSupers; - dummy: string[30]; + InFile: File; + i, j: Word; + Dummy: String[30]; begin - high.Name := 'Lode Runner'; - DFAFileOpen(InFile, HighsFileName, DFAAccessReadWrite); - if DFALastResult(InFile) <> 0 then + FileMode := 0; + AssignFile(InFile, HighsFileName); + Reset(InFile, 1); + + if IOResult <> 0 then begin - DFAFileCreate(InFile, HighsFileName, DFAAttributeArchive); - DFAFileWrite(InFile, HighsFileHeader[1], 29, i); for i := 1 to 5 do begin - high.score := 60000 - i * 10000; - DFAFileWrite(InFile, high, SIZEOF(high), j); + HighTable[i].Name := 'Lode Runner'; + HighTable[i].score := 60000 - i * 10000; end; - end; - DFAFilePositionSet(InFile, 0, DFASeekFromStart); - DFAFileRead(InFile, dummy[1], 29, j); - if (DFALastResult(InFile) <> 0) or - (not DataIdentical(dummy[1], HighsFileHeader[1], 29, 0, 0)) then + AssignFile(InFile, HighsFileName); + Rewrite(InFile, 1); + BlockWrite(InFile, HighsFileHeader[1], 29, i); + BlockWrite(InFile, HighTable, SizeOf(TSupers) * 5, j); + end else begin - WRITELN('Error: Invalid file with high scores! (try to remove LRL.HSR file)'); - WRITELN('Žèš¡ª : ¥¢¥à­ë© ä ©« á ४®à€ ¬š! (¯®¯à®¡ã©â¥ 〠«šâì ä ©« LRL.HSR)'); - Halt(1); + 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; - DFAFileRead(InFile, HighTable, SIZEOF(TSupers) * 5, j); - DFAFileClose(InFile); + + Close(InFile); end; + procedure LRLSaveHighScores; var - InFile: TDFAFileHandle; - i, j: word; + InFile: File; + j: Word; begin - DFAFileOpen(InFile, HighsFileName, DFAAccessReadWrite); - DFAFilePositionSet(InFile, 29, DFASeekFromStart); - DFAFileWrite(InFile, HighTable, SIZEOF(TSupers) * 5, j); - DFAFileClose(InFile); + 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; + +function LRLBestScore(Score: Longint): Boolean; var - i: integer; + i: Integer; begin LRLBestScore := True; LRLLoadHighScores; @@ -136,19 +156,20 @@ begin while True do begin if Score >= HighTable[i].Score then - EXIT; + Exit; Inc(i); if i > 5 then begin LRLBestScore := False; - EXIT; + Exit; end; end; end; -procedure LRLInsertScore(Name: string; Score: longint); + +procedure LRLInsertScore(Name: String; Score: Longint); var - i, j: word; + i, j: Word; begin LRLLoadHighScores; i := 1; @@ -164,29 +185,32 @@ begin HighTable[i].Name := Name; HighTable[i].Score := Score; LRLSaveHighScores; - EXIT; + Exit; end; Inc(i); if i > 5 then begin - EXIT; + Exit; end; end; end; -function LRLEnterName: string; + +function LRLEnterName: String; var - p: POINTER; - i: integer; - RedrawName: boolean; - Keypress: word; - Name: string; + p: Pointer; + RedrawName: Boolean; + Keypress: Word; + Name: String; + C: Char; begin Name := ''; - GETMEM(p, 768); + + GetMem(p, 768); DataFill(p^, 768, 0, 0); Palette256Set(p^); - FREEMEM(p, 768); + FreeMem(p, 768); + ImageClear(LRLScreen^); ImagePut(LRLScreen^, LRLLogo^, 3, 3, 0, 0, 319, 199); ImageStringGet('Congratulations! You are in Top-Five!', LRLFont^, LRLFontBuffer^, 110); @@ -199,6 +223,7 @@ begin 1, 155, 0, 0, 319, 199); ScreenApply(LRLScreen^); FadeTo(LRLMenuPalette); + RedrawName := True; repeat if RedrawName = True then @@ -206,26 +231,31 @@ 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); + ImagePut(LRLScreen^, LRLFontBuffer^, 160 - ImageSizex(LRLFontBuffer^) shr 1, 140, 0, 0, 319, 199); ScreenApply(LRLScreen^); RedrawName := False; end; - Keypress := READKEY; - if (LO(Keypress) = 8) and (LENGTH(Name) > 0) then + + Keypress := ReadKey; + + if (Keypress = KEY_BACK) and (Length(Name) > 0) then begin - Name[0] := char(Ord(Name[0]) - 1); + SetLength(Name, Length(Name) - 1); RedrawName := True; end; - if (LO(Keypress) > 31) and (LENGTH(Name) < 20) then + + C := ScanToChar(Keypress); + if (C > #31) and (Length(Name) < 20) then begin - Name := Name + char(LO(Keypress)); + Name := Name + C; RedrawName := True; end; - until LO(Keypress) = 13; + + until Keypress = KEY_ENTER; FadeClear; - Name := StringTrimAll(Name, ' '); - if LENGTH(Name) = 0 then + + Name := Trim(Name); + if Length(Name) = 0 then Name := 'Anonymous'; LRLEnterName := Name; end; diff --git a/programs/games/lrl/LRLIntroduction.pp b/programs/games/lrl/src/LRLIntroduction.pp similarity index 92% rename from programs/games/lrl/LRLIntroduction.pp rename to programs/games/lrl/src/LRLIntroduction.pp index 80fab06d31..f713d08595 100644 --- a/programs/games/lrl/LRLIntroduction.pp +++ b/programs/games/lrl/src/LRLIntroduction.pp @@ -17,10 +17,10 @@ implementation const IntroText: array[1..14] of String = ( - 'Lode Runner LIVE. FREEWARE Version 1.0', + 'Lode Runner LIVE. FREEWARE Version 1.4b', 'KolibriOS port by bw (Vladimir V. Byrgazov)', 'Copyright (c) 1995 Aleksey V. Vaneev', - 'Copyright (c) 2007 bw', + 'Copyright (c) 2008 bw', '', 'Send comments to Aleksey V. Vaneev', '2:5003/15@FidoNet', @@ -30,17 +30,13 @@ const 'bw@handsdriver.net', '', '', - '' - ); + ''); SPACE40 = ' '; var - RefreshDelay: Word; - RefreshRemain: Word; TimeToRefresh: Boolean; - OldTimer: Pointer; procedure LRLIntro; @@ -50,8 +46,6 @@ var k: Word; MainScreen: Pointer; begin - RefreshDelay := 1; - RefreshRemain := 1; GetMem(MainScreen, 64004); Seek(ImageFile, LRLImagesFilePosition + 7940); diff --git a/programs/games/lrl/LRLLevels.pp b/programs/games/lrl/src/LRLLevels.pp similarity index 95% rename from programs/games/lrl/LRLLevels.pp rename to programs/games/lrl/src/LRLLevels.pp index ed811a13a3..29237207c4 100644 --- a/programs/games/lrl/LRLLevels.pp +++ b/programs/games/lrl/src/LRLLevels.pp @@ -91,13 +91,13 @@ const const KeyboardControls: array[1..21] of Word = ( - $00B0, 1, 1, - $00B3, 1, 2, - $00B2, 1, 3, - $00B1, 1, 4, - $00B5, 1, 6, - $00B7, 1, 7, - $0037, 1, 5); + 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; @@ -123,7 +123,7 @@ var procedure LRLLoadLevel(Number: Byte); procedure LRLUpdatePlayers; procedure LRLDrawOrnamental(x1, y1, x2, y2, ornament: Byte); -function LRLPlayLevel(Number: Byte): Word; +procedure LRLPlayLevel(Number: Byte); function LRLLevelCount: Word; procedure LRLDeleteLevel(Count: Word); procedure LRLInsertLevel(After: Word); @@ -135,7 +135,7 @@ implementation const LevelFileName = 'LRL.LEV'; - LevelFileHeader: String = 'Lode Runner Live Levels'#26; + LevelFileHeader: ShortString = 'Lode Runner Live Levels'#26; ERR_OPENFILE = '¥¢®§¬®Š­® ®âªàëâì ä ©« ã஢­¥©'; ERR_BADFILE = '¥¢¥à­ë© š«š ¯®¢à¥Š€¥­­ë© ä ©« ã஢­¥©'; @@ -166,6 +166,7 @@ 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))); @@ -178,8 +179,8 @@ begin 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); + 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); @@ -190,7 +191,7 @@ procedure LRLDeleteLevel(Count: Word); var Buffer: Pointer; LevelFile: File; - i, j: Integer; + j: Integer; l: Longint; k: Word; begin @@ -198,6 +199,7 @@ begin 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 @@ -221,7 +223,7 @@ procedure LRLInsertLevel(After: Word); var Buffer: Pointer; LevelFile: File; - i, j: Integer; + j: Integer; l: Longint; k: Word; begin @@ -229,6 +231,7 @@ begin 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 @@ -254,7 +257,7 @@ procedure LRLLoadLevel(Number: Byte); var LevelFile: File; InBuffer: Pointer; - i, j, k, l, x, y: Word; + i, j, k: Word; a, b, c: Byte; begin TotalPrizes := 0; @@ -445,18 +448,17 @@ begin end; -{ -game result: -1 - zamurovali -2 - poimali -10 - vse zdelano -50 - no more levels -60 - no human players -100 - esc was pressed -} +{ GameResult: + 1 - § ¬ã஢ «š + 2 - ¯®©¬ «š + 10 - ¢á¥ ဥ« ­® + 50 - ­¥â ¡®«ìè¥ ã஢­¥© + 60 - ­¥â 祫®¢¥ç¥áªšå ⮢ + 100 - ­ Š â  Esc } + procedure LRLUpdatePlayers; var - i, j, k: Integer; + i, k: Integer; spd: Word; begin for i := 1 to 10 do @@ -508,21 +510,21 @@ begin if (i = 1) then begin if (TotalPrizes = 0) and (Position.y = 1) and - (LRLLevel.Field[Position.x, Position.y].Image = 2) then + (LRLLevel.Field[Position.x, Position.y].Image = 2) then begin EndOfGame := True; GameResult := 10; Exit; end; for k := 2 to 10 do - if (LRLLevel.Player[k].Controller <> 0) then - if (LRLLevel.Player[k].Position.x = Position.x) and - (LRLLevel.Player[k].Position.y = Position.y) then - begin - EndOfGame := True; - GameResult := 2; - Exit; - end; + 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 @@ -703,12 +705,10 @@ begin 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 + 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; @@ -975,7 +975,7 @@ end; procedure LRLComputerPlayer; var - k, l, m, f1, f2, i, j: Integer; + k, l, m, f1, f2, i: Integer; begin if ComputerTurn >= ComputerReaction then begin @@ -1045,8 +1045,8 @@ begin NewCommand := 2; end; end; - end - else + end else + if (Position.y < LRLLevel.Player[1].Position.y) then begin if (((LRLLevel.Field[Position.x, Position.y + 1].Image = 2) and @@ -1114,13 +1114,12 @@ begin end; end; end; - end - else + end else Inc(ComputerTurn); end; -function LRLPlayLevel(Number: Byte): Word; +procedure LRLPlayLevel(Number: Byte); var Keypress: Word; i: Word; @@ -1181,14 +1180,15 @@ begin LRLLevel.Player[KeyboardControls[i * 3 + 2]].NewCommandWas := True; end; - if (Keypress = $50) or (Keypress = $70) then + if Keypress = KEY_P then Paused := True; end; - until (Keypress = $1B) or EndOfGame; + until (Keypress = KEY_ESC) or EndOfGame; if EndOfGame then LRLEndSequence else GameResult := 100; end; + end. diff --git a/programs/games/lrl/LRLMainMenu.pp b/programs/games/lrl/src/LRLMainMenu.pp similarity index 93% rename from programs/games/lrl/LRLMainMenu.pp rename to programs/games/lrl/src/LRLMainMenu.pp index ff24e4aa13..2b258d29ff 100644 --- a/programs/games/lrl/LRLMainMenu.pp +++ b/programs/games/lrl/src/LRLMainMenu.pp @@ -24,7 +24,7 @@ var procedure LoadData; var - size, j: Word; + j: Word; i: Integer; begin GetMem(MainScreen, 64004); @@ -67,6 +67,7 @@ begin DataFill(p^, 768, 0, 0); Palette256Set(p^); FreeMem(p, 768); + LoadData; NeedToFade := True; ImagePut(LRLScreen^, MainScreen^, 0, 0, 0, 0, 319, 199); @@ -94,17 +95,17 @@ begin Keypress := ReadKey; - if (Keypress = $B1) and (Item < 4) then + if (Keypress = KEY_DOWN) and (Item < 4) then begin Inc(Item); RedrawAll := True; - end; - if (Keypress = $B2) and (Item > 1) then + end else + if (Keypress = KEY_UP) and (Item > 1) then begin Dec(Item); RedrawAll := True; end; - until Keypress = $0D; + until Keypress = KEY_ENTER; FadeClear; ImageClear(LRLScreen^); diff --git a/programs/games/lrl/src/LRLRoutines.pp b/programs/games/lrl/src/LRLRoutines.pp new file mode 100644 index 0000000000..d90d28ef7c --- /dev/null +++ b/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. diff --git a/programs/games/lrl/LRLSprites.pp b/programs/games/lrl/src/LRLSprites.pp similarity index 99% rename from programs/games/lrl/LRLSprites.pp rename to programs/games/lrl/src/LRLSprites.pp index 706935e529..5c834fb819 100644 --- a/programs/games/lrl/LRLSprites.pp +++ b/programs/games/lrl/src/LRLSprites.pp @@ -86,7 +86,7 @@ procedure LoadImages; var InBuffer: Pointer; i, j, k, l, x, y: Word; - a, b, c: Byte; + a: Byte; begin GetMem(InBuffer, $FFF0);