forked from KolibriOS/kolibrios
LRL 1.4b
git-svn-id: svn://kolibrios.org@762 a494cfbc-eb01-0410-851d-a64ba20cac60
This commit is contained in:
bw
parent
119066a890
commit
a5131135c4
@ -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.
|
|
||||||
49
programs/games/lrl/Makefile.fpc
Normal file
49
programs/games/lrl/Makefile.fpc
Normal file
@ -0,0 +1,49 @@
|
|||||||
|
# <20>¥à¥¬¥ ï ®ªà㦥¨ï FPCDIR ¤®«¦ 㪠§ë¢ âì ¯ ¯ªã á FreePascal,
|
||||||
|
# «¨¡® ¢ ᥪ樨 default ¢ ¯¥à¥¬¥®© fpcdir 㪠¦¨â¥ â®çë© ¯ãâì ª ¥©.
|
||||||
|
# <20>ãâì 㪠§ë¢ ¥âáï ¡¥§ § ¢¥àè î饣® á«íè (¨«¨ ®¡à ⮣® á«íè ).
|
||||||
|
|
||||||
|
# <20>¥à¥¬¥ ï ®ªà㦥¨ï KFPCDIR ¤®«¦ 㪠§ë¢ âì ¯ ¯ªã á ¯à®¥ªâ®¬
|
||||||
|
# KolibriOS FreePascal.
|
||||||
|
# <20>ãâì 㪠§ë¢ ¥âáï ¡¥§ § ¢¥àè î饣® á«íè (¨«¨ ®¡à ⮣® á«íè ).
|
||||||
|
|
||||||
|
[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)/$^
|
||||||
BIN
programs/games/lrl/bin/LRL.HSR
Normal file
BIN
programs/games/lrl/bin/LRL.HSR
Normal file
Binary file not shown.
222
programs/games/lrl/bin/LRL.MAN
Normal file
222
programs/games/lrl/bin/LRL.MAN
Normal file
@ -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.
|
||||||
@ -1,30 +0,0 @@
|
|||||||
@echo off
|
|
||||||
|
|
||||||
rem „«ï ᡮન ¨£àë ¥®¡å®¤¨¬® ¢ ¯¥à¥¬¥®© UNITS (®¯à¥¤¥«¥ ¨¦¥)
|
|
||||||
rem 㪠§ âì à ᯮ«®¦¥¨¥ ¯ ¯ª¨, ¢ ª®â®à®© 室ïâáï ®âª®¬¯¨«¨à®¢ ë¥ ¬®¤ã«¨
|
|
||||||
rem RTL ¤«ï KolibriOS. <20> ¯à¨¬¥à, ¥á«¨ ¨á室¨ª¨ RTL 室ïâáï ¢ ¯ ¯ª¥ my/rtl,
|
|
||||||
rem ⮠ᮡà ë¥ ¬®¤ã«¨ RTL - ᪮॥ ¢á¥£® ¢ my/units. Œ®¦¥â ®ª § âìáï
|
|
||||||
rem ¤®áâ â®çë¬ ¯à®áâ® ¯¥à¥¥á⨠íâã ¯ ¯ªã (lrl) ¢ ¤¨à¥ªâ®à¨î my.
|
|
||||||
|
|
||||||
rem ’ ª ¦¥, ¤«ï ᡮન, ¢ ¬ ¯® ¤®¡¨âáï ã⨫¨â exe2kos.exe ¨ FreePascal 2.2.0.
|
|
||||||
|
|
||||||
|
|
||||||
set NAME=lrl
|
|
||||||
set NAMEEXE=%NAME%.exe
|
|
||||||
set NAMEKEX=%NAME%.kex
|
|
||||||
|
|
||||||
set BUILD=-FUbuild
|
|
||||||
set UNITS=-Fu../units
|
|
||||||
|
|
||||||
fpc %NAME%.pp -n -Twin32 -Se5 -XXs -Sg -O3pPENTIUM3 -CfSSE -WB0 %BUILD% %UNITS%
|
|
||||||
if errorlevel 1 goto error
|
|
||||||
|
|
||||||
exe2kos.exe %NAMEEXE% %NAMEKEX%
|
|
||||||
del %NAMEEXE%
|
|
||||||
move %NAMEKEX% bin
|
|
||||||
goto end
|
|
||||||
|
|
||||||
:error
|
|
||||||
echo An error occured while building %NAME%
|
|
||||||
|
|
||||||
:end
|
|
||||||
3
programs/games/lrl/build.sh
Executable file
3
programs/games/lrl/build.sh
Executable file
@ -0,0 +1,3 @@
|
|||||||
|
#!/bin/sh
|
||||||
|
fpcmake -Twin32
|
||||||
|
make
|
||||||
19
programs/games/lrl/dist.sh
Executable file
19
programs/games/lrl/dist.sh
Executable file
@ -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 ..
|
||||||
@ -1,10 +0,0 @@
|
|||||||
|
|
||||||
Lode Runner Live 1.0
|
|
||||||
====================
|
|
||||||
|
|
||||||
<EFBFBD>஥ªâ ¯® ¯¥à¥®áã ¨£àë Lode Runner Live 1.0 á ¯« âä®à¬ë DOS ¢ KolibriOS.
|
|
||||||
|
|
||||||
—¨â ©â¥ ª®¬¬¥â ਨ ¯® ª®¬¯¨«ï樨 ¢ build.bat.
|
|
||||||
|
|
||||||
<EFBFBD> ¤ ë© ¬®¬¥â â¥áâ¨à®¢ « áì ªà®áª®¬¯¨«ïæ¨ï ⮫쪮 ¨§ Windows 2000 SP4
|
|
||||||
32å à §à冷© ¬ 訥.
|
|
||||||
@ -8,18 +8,20 @@ uses
|
|||||||
LRLSprites,
|
LRLSprites,
|
||||||
LRLLevels,
|
LRLLevels,
|
||||||
LRLMainMenu,
|
LRLMainMenu,
|
||||||
{LRLHighScores,
|
LRLHighScores,
|
||||||
LRLEditor,}
|
{LRLEditor,}
|
||||||
LRLIntroduction;
|
LRLIntroduction;
|
||||||
|
|
||||||
const
|
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;
|
procedure LRLInitialize;
|
||||||
begin
|
begin
|
||||||
kos_setkeyboardmode(0);
|
|
||||||
ImagesInitialize;
|
ImagesInitialize;
|
||||||
|
KeyboardInitialize;
|
||||||
|
ScreenMode(1);
|
||||||
|
ScreenTitle := Version;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@ -45,20 +47,21 @@ begin
|
|||||||
repeat
|
repeat
|
||||||
LRLPlayLevel(cl);
|
LRLPlayLevel(cl);
|
||||||
KeyboardFlush;
|
KeyboardFlush;
|
||||||
|
|
||||||
if GameResult = 10 then
|
if GameResult = 10 then
|
||||||
begin
|
begin
|
||||||
Inc(LRLLives);
|
Inc(LRLLives);
|
||||||
LRLScore := LRLScore + 10000 * longint(cl);
|
LRLScore := LRLScore + 10000 * Longint(cl);
|
||||||
Inc(cl);
|
Inc(cl);
|
||||||
end else
|
end else
|
||||||
Dec(LRLLives);
|
Dec(LRLLives);
|
||||||
until (LRLLives = 0) or (GameResult = 100);
|
until (LRLLives = 0) or (GameResult = 100);
|
||||||
|
|
||||||
{(GameResult <> 100) and LRLBestScore(LRLScore) then
|
if (GameResult <> 100) and LRLBestScore(LRLScore) then
|
||||||
begin
|
begin
|
||||||
LRLInsertScore(LRLEnterName, LRLScore);
|
LRLInsertScore(LRLEnterName, LRLScore);
|
||||||
LRLShowHighScores;
|
LRLShowHighScores;
|
||||||
end;}
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure LRLShell;
|
procedure LRLShell;
|
||||||
@ -69,8 +72,8 @@ begin
|
|||||||
repeat
|
repeat
|
||||||
LRLSelectItem(MenuSelection);
|
LRLSelectItem(MenuSelection);
|
||||||
if MenuSelection = 1 then LRLGameStart;
|
if MenuSelection = 1 then LRLGameStart;
|
||||||
{if MenuSelection = 2 then LRLEditLevels;
|
{if MenuSelection = 2 then LRLEditLevels;}
|
||||||
if MenuSelection = 3 then LRLShowHighScores;}
|
if MenuSelection = 3 then LRLShowHighScores;
|
||||||
until MenuSelection = 4;
|
until MenuSelection = 4;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -1,19 +1,23 @@
|
|||||||
unit LRLHighScores;
|
unit LRLHighScores;
|
||||||
|
|
||||||
|
{$mode objfpc}
|
||||||
|
{$i-}
|
||||||
|
|
||||||
|
|
||||||
interface
|
interface
|
||||||
|
|
||||||
|
|
||||||
uses
|
uses
|
||||||
LRLRoutines, LRLSprites, StrUnit;
|
SysUtils,
|
||||||
|
LRLRoutines, LRLSprites;
|
||||||
|
|
||||||
|
|
||||||
procedure LRLLoadHighScores;
|
procedure LRLLoadHighScores;
|
||||||
procedure LRLShowHighScores;
|
procedure LRLShowHighScores;
|
||||||
function LRLBestScore(Score: longint): boolean;
|
function LRLBestScore(Score: Longint): Boolean;
|
||||||
procedure LRLInsertScore(Name: string; Score: longint);
|
procedure LRLInsertScore(Name: String; Score: Longint);
|
||||||
procedure LRLSaveHighScores;
|
procedure LRLSaveHighScores;
|
||||||
function LRLEnterName: string;
|
function LRLEnterName: String;
|
||||||
|
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
@ -21,114 +25,130 @@ implementation
|
|||||||
|
|
||||||
const
|
const
|
||||||
HighsFileName = 'LRL.HSR';
|
HighsFileName = 'LRL.HSR';
|
||||||
HighsFileHeader: string[29] = 'Lode Runner Live High Scores'#26;
|
HighsFileHeader: String[29] = 'Lode Runner Live High Scores'#26;
|
||||||
|
|
||||||
type
|
type
|
||||||
TSupers = packed record
|
TSupers = packed record
|
||||||
Name: string[20];
|
Name: String[20];
|
||||||
Score: longint;
|
Score: Longint;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
var
|
var
|
||||||
MainScreen: POINTER;
|
MainScreen: Pointer;
|
||||||
HighFrame: POINTER;
|
HighFrame: Pointer;
|
||||||
HighTable: array[1..5] of TSupers;
|
HighTable: array[1..5] of TSupers;
|
||||||
|
|
||||||
|
|
||||||
procedure LoadData;
|
procedure LoadData;
|
||||||
var
|
var
|
||||||
j: word;
|
j: Word;
|
||||||
begin
|
begin
|
||||||
GETMEM(MainScreen, 64004);
|
GetMem(MainScreen, 64004);
|
||||||
GETMEM(HighFrame, 45000);
|
GetMem(HighFrame, 45000);
|
||||||
DFAFilePositionSet(ImageFile, LRLImagesFilePosition, DFASeekFromStart);
|
Seek(ImageFile, LRLImagesFilePosition);
|
||||||
DFAFileRead(ImageFile, MainScreen^, 7940, j);
|
BlockRead(ImageFile, MainScreen^, 7940, j);
|
||||||
DecompressRepByte(MainScreen^, HighFrame^, 7940, j);
|
DecompressRepByte(MainScreen^, HighFrame^, 7940, j);
|
||||||
DFAFileRead(ImageFile, MainScreen^, 64004, j);
|
BlockRead(ImageFile, MainScreen^, 64004, j);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure DisposeData;
|
procedure DisposeData;
|
||||||
begin
|
begin
|
||||||
FREEMEM(MainScreen, 64004);
|
FreeMem(MainScreen, 64004);
|
||||||
FREEMEM(HighFrame, 45000);
|
FreeMem(HighFrame, 45000);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure LRLShowHighScores;
|
procedure LRLShowHighScores;
|
||||||
var
|
var
|
||||||
p: POINTER;
|
p: Pointer;
|
||||||
i: integer;
|
i: Integer;
|
||||||
s: string;
|
s: String;
|
||||||
begin
|
begin
|
||||||
LRLLoadHighScores;
|
LRLLoadHighScores;
|
||||||
GETMEM(p, 768);
|
|
||||||
|
GetMem(p, 768);
|
||||||
DataFill(p^, 768, 0, 0);
|
DataFill(p^, 768, 0, 0);
|
||||||
Palette256Set(p^);
|
Palette256Set(p^);
|
||||||
FREEMEM(p, 768);
|
FreeMem(p, 768);
|
||||||
|
|
||||||
LoadData;
|
LoadData;
|
||||||
ImagePut(LRLScreen^, MainScreen^, 0, 0, 0, 0, 319, 199);
|
ImagePut(LRLScreen^, MainScreen^, 0, 0, 0, 0, 319, 199);
|
||||||
ImagePut(LRLScreen^, HighFrame^, 6, 50, 0, 0, 319, 199);
|
ImagePut(LRLScreen^, HighFrame^, 6, 50, 0, 0, 319, 199);
|
||||||
|
|
||||||
for i := 1 to 5 do
|
for i := 1 to 5 do
|
||||||
begin
|
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);
|
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);
|
ImageStringGet(s, LRLFont^, LRLFontBuffer^, 46);
|
||||||
ImagePut(LRLScreen^, LRLFontBuffer^, 260 - ImageSizex(LRLFontBuffer^), 85 + i * 17, 8, 0, 319, 199);
|
ImagePut(LRLScreen^, LRLFontBuffer^, 260 - ImageSizex(LRLFontBuffer^), 85 + i * 17, 8, 0, 319, 199);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
ScreenApply(LRLScreen^);
|
ScreenApply(LRLScreen^);
|
||||||
FadeTo(LRLMenuPalette);
|
FadeTo(LRLMenuPalette);
|
||||||
READKEY;
|
|
||||||
|
ReadKey;
|
||||||
|
|
||||||
FadeClear;
|
FadeClear;
|
||||||
ImageClear(LRLScreen^);
|
ImageClear(LRLScreen^);
|
||||||
ScreenApply(LRLScreen^);
|
ScreenApply(LRLScreen^);
|
||||||
|
|
||||||
DisposeData;
|
DisposeData;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure LRLLoadHighScores;
|
procedure LRLLoadHighScores;
|
||||||
var
|
var
|
||||||
InFile: TDFAFileHandle;
|
InFile: File;
|
||||||
i, j: word;
|
i, j: Word;
|
||||||
high: TSupers;
|
Dummy: String[30];
|
||||||
dummy: string[30];
|
|
||||||
begin
|
begin
|
||||||
high.Name := 'Lode Runner';
|
FileMode := 0;
|
||||||
DFAFileOpen(InFile, HighsFileName, DFAAccessReadWrite);
|
AssignFile(InFile, HighsFileName);
|
||||||
if DFALastResult(InFile) <> 0 then
|
Reset(InFile, 1);
|
||||||
|
|
||||||
|
if IOResult <> 0 then
|
||||||
begin
|
begin
|
||||||
DFAFileCreate(InFile, HighsFileName, DFAAttributeArchive);
|
|
||||||
DFAFileWrite(InFile, HighsFileHeader[1], 29, i);
|
|
||||||
for i := 1 to 5 do
|
for i := 1 to 5 do
|
||||||
begin
|
begin
|
||||||
high.score := 60000 - i * 10000;
|
HighTable[i].Name := 'Lode Runner';
|
||||||
DFAFileWrite(InFile, high, SIZEOF(high), j);
|
HighTable[i].score := 60000 - i * 10000;
|
||||||
end;
|
end;
|
||||||
end;
|
AssignFile(InFile, HighsFileName);
|
||||||
DFAFilePositionSet(InFile, 0, DFASeekFromStart);
|
Rewrite(InFile, 1);
|
||||||
DFAFileRead(InFile, dummy[1], 29, j);
|
BlockWrite(InFile, HighsFileHeader[1], 29, i);
|
||||||
if (DFALastResult(InFile) <> 0) or
|
BlockWrite(InFile, HighTable, SizeOf(TSupers) * 5, j);
|
||||||
(not DataIdentical(dummy[1], HighsFileHeader[1], 29, 0, 0)) then
|
end else
|
||||||
begin
|
begin
|
||||||
WRITELN('Error: Invalid file with high scores! (try to remove LRL.HSR file)');
|
Seek(InFile, 0);
|
||||||
WRITELN('Žè¨¡ª : <20>¥¢¥àë© ä ©« á ४®à¤ ¬¨! (¯®¯à®¡ã©â¥ 㤠«¨âì ä ©« LRL.HSR)');
|
BlockRead(InFile, Dummy[1], 29, j);
|
||||||
Halt(1);
|
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;
|
end;
|
||||||
DFAFileRead(InFile, HighTable, SIZEOF(TSupers) * 5, j);
|
|
||||||
DFAFileClose(InFile);
|
Close(InFile);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure LRLSaveHighScores;
|
procedure LRLSaveHighScores;
|
||||||
var
|
var
|
||||||
InFile: TDFAFileHandle;
|
InFile: File;
|
||||||
i, j: word;
|
j: Word;
|
||||||
begin
|
begin
|
||||||
DFAFileOpen(InFile, HighsFileName, DFAAccessReadWrite);
|
FileMode := 2;
|
||||||
DFAFilePositionSet(InFile, 29, DFASeekFromStart);
|
AssignFile(InFile, HighsFileName);
|
||||||
DFAFileWrite(InFile, HighTable, SIZEOF(TSupers) * 5, j);
|
Reset(InFile, 1);
|
||||||
DFAFileClose(InFile);
|
Seek(InFile, 29);
|
||||||
|
BlockWrite(InFile, HighTable, SizeOf(TSupers) * 5, j);
|
||||||
|
Close(InFile);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function LRLBestScore(Score: longint): boolean;
|
|
||||||
|
function LRLBestScore(Score: Longint): Boolean;
|
||||||
var
|
var
|
||||||
i: integer;
|
i: Integer;
|
||||||
begin
|
begin
|
||||||
LRLBestScore := True;
|
LRLBestScore := True;
|
||||||
LRLLoadHighScores;
|
LRLLoadHighScores;
|
||||||
@ -136,19 +156,20 @@ begin
|
|||||||
while True do
|
while True do
|
||||||
begin
|
begin
|
||||||
if Score >= HighTable[i].Score then
|
if Score >= HighTable[i].Score then
|
||||||
EXIT;
|
Exit;
|
||||||
Inc(i);
|
Inc(i);
|
||||||
if i > 5 then
|
if i > 5 then
|
||||||
begin
|
begin
|
||||||
LRLBestScore := False;
|
LRLBestScore := False;
|
||||||
EXIT;
|
Exit;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure LRLInsertScore(Name: string; Score: longint);
|
|
||||||
|
procedure LRLInsertScore(Name: String; Score: Longint);
|
||||||
var
|
var
|
||||||
i, j: word;
|
i, j: Word;
|
||||||
begin
|
begin
|
||||||
LRLLoadHighScores;
|
LRLLoadHighScores;
|
||||||
i := 1;
|
i := 1;
|
||||||
@ -164,29 +185,32 @@ begin
|
|||||||
HighTable[i].Name := Name;
|
HighTable[i].Name := Name;
|
||||||
HighTable[i].Score := Score;
|
HighTable[i].Score := Score;
|
||||||
LRLSaveHighScores;
|
LRLSaveHighScores;
|
||||||
EXIT;
|
Exit;
|
||||||
end;
|
end;
|
||||||
Inc(i);
|
Inc(i);
|
||||||
if i > 5 then
|
if i > 5 then
|
||||||
begin
|
begin
|
||||||
EXIT;
|
Exit;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function LRLEnterName: string;
|
|
||||||
|
function LRLEnterName: String;
|
||||||
var
|
var
|
||||||
p: POINTER;
|
p: Pointer;
|
||||||
i: integer;
|
RedrawName: Boolean;
|
||||||
RedrawName: boolean;
|
Keypress: Word;
|
||||||
Keypress: word;
|
Name: String;
|
||||||
Name: string;
|
C: Char;
|
||||||
begin
|
begin
|
||||||
Name := '';
|
Name := '';
|
||||||
GETMEM(p, 768);
|
|
||||||
|
GetMem(p, 768);
|
||||||
DataFill(p^, 768, 0, 0);
|
DataFill(p^, 768, 0, 0);
|
||||||
Palette256Set(p^);
|
Palette256Set(p^);
|
||||||
FREEMEM(p, 768);
|
FreeMem(p, 768);
|
||||||
|
|
||||||
ImageClear(LRLScreen^);
|
ImageClear(LRLScreen^);
|
||||||
ImagePut(LRLScreen^, LRLLogo^, 3, 3, 0, 0, 319, 199);
|
ImagePut(LRLScreen^, LRLLogo^, 3, 3, 0, 0, 319, 199);
|
||||||
ImageStringGet('Congratulations! You are in Top-Five!', LRLFont^, LRLFontBuffer^, 110);
|
ImageStringGet('Congratulations! You are in Top-Five!', LRLFont^, LRLFontBuffer^, 110);
|
||||||
@ -199,6 +223,7 @@ begin
|
|||||||
1, 155, 0, 0, 319, 199);
|
1, 155, 0, 0, 319, 199);
|
||||||
ScreenApply(LRLScreen^);
|
ScreenApply(LRLScreen^);
|
||||||
FadeTo(LRLMenuPalette);
|
FadeTo(LRLMenuPalette);
|
||||||
|
|
||||||
RedrawName := True;
|
RedrawName := True;
|
||||||
repeat
|
repeat
|
||||||
if RedrawName = True then
|
if RedrawName = True then
|
||||||
@ -206,26 +231,31 @@ begin
|
|||||||
ImageFill(LRLFontBuffer^, 320, 20, 0);
|
ImageFill(LRLFontBuffer^, 320, 20, 0);
|
||||||
ImagePut(LRLScreen^, LRLFontBuffer^, 0, 140, 0, 0, 319, 199);
|
ImagePut(LRLScreen^, LRLFontBuffer^, 0, 140, 0, 0, 319, 199);
|
||||||
ImageStringGet(Name, LRLFont^, LRLFontBuffer^, 100);
|
ImageStringGet(Name, LRLFont^, LRLFontBuffer^, 100);
|
||||||
ImagePut(LRLScreen^, LRLFontBuffer^, 160 - ImageSizex(LRLFontBuffer^) shr
|
ImagePut(LRLScreen^, LRLFontBuffer^, 160 - ImageSizex(LRLFontBuffer^) shr 1, 140, 0, 0, 319, 199);
|
||||||
1, 140, 0, 0, 319, 199);
|
|
||||||
ScreenApply(LRLScreen^);
|
ScreenApply(LRLScreen^);
|
||||||
RedrawName := False;
|
RedrawName := False;
|
||||||
end;
|
end;
|
||||||
Keypress := READKEY;
|
|
||||||
if (LO(Keypress) = 8) and (LENGTH(Name) > 0) then
|
Keypress := ReadKey;
|
||||||
|
|
||||||
|
if (Keypress = KEY_BACK) and (Length(Name) > 0) then
|
||||||
begin
|
begin
|
||||||
Name[0] := char(Ord(Name[0]) - 1);
|
SetLength(Name, Length(Name) - 1);
|
||||||
RedrawName := True;
|
RedrawName := True;
|
||||||
end;
|
end;
|
||||||
if (LO(Keypress) > 31) and (LENGTH(Name) < 20) then
|
|
||||||
|
C := ScanToChar(Keypress);
|
||||||
|
if (C > #31) and (Length(Name) < 20) then
|
||||||
begin
|
begin
|
||||||
Name := Name + char(LO(Keypress));
|
Name := Name + C;
|
||||||
RedrawName := True;
|
RedrawName := True;
|
||||||
end;
|
end;
|
||||||
until LO(Keypress) = 13;
|
|
||||||
|
until Keypress = KEY_ENTER;
|
||||||
FadeClear;
|
FadeClear;
|
||||||
Name := StringTrimAll(Name, ' ');
|
|
||||||
if LENGTH(Name) = 0 then
|
Name := Trim(Name);
|
||||||
|
if Length(Name) = 0 then
|
||||||
Name := 'Anonymous';
|
Name := 'Anonymous';
|
||||||
LRLEnterName := Name;
|
LRLEnterName := Name;
|
||||||
end;
|
end;
|
||||||
@ -17,10 +17,10 @@ implementation
|
|||||||
|
|
||||||
const
|
const
|
||||||
IntroText: array[1..14] of String = (
|
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)',
|
'KolibriOS port by bw (Vladimir V. Byrgazov)',
|
||||||
'Copyright (c) 1995 Aleksey V. Vaneev',
|
'Copyright (c) 1995 Aleksey V. Vaneev',
|
||||||
'Copyright (c) 2007 bw',
|
'Copyright (c) 2008 bw',
|
||||||
'',
|
'',
|
||||||
'Send comments to Aleksey V. Vaneev',
|
'Send comments to Aleksey V. Vaneev',
|
||||||
'2:5003/15@FidoNet',
|
'2:5003/15@FidoNet',
|
||||||
@ -30,17 +30,13 @@ const
|
|||||||
'bw@handsdriver.net',
|
'bw@handsdriver.net',
|
||||||
'',
|
'',
|
||||||
'',
|
'',
|
||||||
''
|
'');
|
||||||
);
|
|
||||||
|
|
||||||
SPACE40 = ' ';
|
SPACE40 = ' ';
|
||||||
|
|
||||||
|
|
||||||
var
|
var
|
||||||
RefreshDelay: Word;
|
|
||||||
RefreshRemain: Word;
|
|
||||||
TimeToRefresh: Boolean;
|
TimeToRefresh: Boolean;
|
||||||
OldTimer: Pointer;
|
|
||||||
|
|
||||||
|
|
||||||
procedure LRLIntro;
|
procedure LRLIntro;
|
||||||
@ -50,8 +46,6 @@ var
|
|||||||
k: Word;
|
k: Word;
|
||||||
MainScreen: Pointer;
|
MainScreen: Pointer;
|
||||||
begin
|
begin
|
||||||
RefreshDelay := 1;
|
|
||||||
RefreshRemain := 1;
|
|
||||||
GetMem(MainScreen, 64004);
|
GetMem(MainScreen, 64004);
|
||||||
|
|
||||||
Seek(ImageFile, LRLImagesFilePosition + 7940);
|
Seek(ImageFile, LRLImagesFilePosition + 7940);
|
||||||
@ -91,13 +91,13 @@ const
|
|||||||
|
|
||||||
const
|
const
|
||||||
KeyboardControls: array[1..21] of Word = (
|
KeyboardControls: array[1..21] of Word = (
|
||||||
$00B0, 1, 1,
|
KEY_LEFT, 1, 1,
|
||||||
$00B3, 1, 2,
|
KEY_RIGHT, 1, 2,
|
||||||
$00B2, 1, 3,
|
KEY_UP, 1, 3,
|
||||||
$00B1, 1, 4,
|
KEY_DOWN, 1, 4,
|
||||||
$00B5, 1, 6,
|
KEY_GREY5, 1, 5,
|
||||||
$00B7, 1, 7,
|
KEY_END, 1, 6,
|
||||||
$0037, 1, 5);
|
KEY_PGDN, 1, 7);
|
||||||
ControlNumber = 7;
|
ControlNumber = 7;
|
||||||
|
|
||||||
|
|
||||||
@ -123,7 +123,7 @@ var
|
|||||||
procedure LRLLoadLevel(Number: Byte);
|
procedure LRLLoadLevel(Number: Byte);
|
||||||
procedure LRLUpdatePlayers;
|
procedure LRLUpdatePlayers;
|
||||||
procedure LRLDrawOrnamental(x1, y1, x2, y2, ornament: Byte);
|
procedure LRLDrawOrnamental(x1, y1, x2, y2, ornament: Byte);
|
||||||
function LRLPlayLevel(Number: Byte): Word;
|
procedure LRLPlayLevel(Number: Byte);
|
||||||
function LRLLevelCount: Word;
|
function LRLLevelCount: Word;
|
||||||
procedure LRLDeleteLevel(Count: Word);
|
procedure LRLDeleteLevel(Count: Word);
|
||||||
procedure LRLInsertLevel(After: Word);
|
procedure LRLInsertLevel(After: Word);
|
||||||
@ -135,7 +135,7 @@ implementation
|
|||||||
|
|
||||||
const
|
const
|
||||||
LevelFileName = 'LRL.LEV';
|
LevelFileName = 'LRL.LEV';
|
||||||
LevelFileHeader: String = 'Lode Runner Live Levels'#26;
|
LevelFileHeader: ShortString = 'Lode Runner Live Levels'#26;
|
||||||
|
|
||||||
ERR_OPENFILE = '<27>¥¢®§¬®¦® ®âªàëâì ä ©« ã஢¥©';
|
ERR_OPENFILE = '<27>¥¢®§¬®¦® ®âªàëâì ä ©« ã஢¥©';
|
||||||
ERR_BADFILE = '<27>¥¢¥àë© ¨«¨ ¯®¢à¥¦¤¥ë© ä ©« ã஢¥©';
|
ERR_BADFILE = '<27>¥¢¥àë© ¨«¨ ¯®¢à¥¦¤¥ë© ä ©« ã஢¥©';
|
||||||
@ -166,6 +166,7 @@ begin
|
|||||||
GetMem(b, 480);
|
GetMem(b, 480);
|
||||||
if (Count = 0) or (Count > LRLLevelCount) then
|
if (Count = 0) or (Count > LRLLevelCount) then
|
||||||
Exit;
|
Exit;
|
||||||
|
FileMode := 2;
|
||||||
AssignFile(LevelFile, LevelFileName);
|
AssignFile(LevelFile, LevelFileName);
|
||||||
Reset(LevelFile, 1);
|
Reset(LevelFile, 1);
|
||||||
Seek(LevelFile, Longint(25 + 520 * (Longint(Count) - 1)));
|
Seek(LevelFile, Longint(25 + 520 * (Longint(Count) - 1)));
|
||||||
@ -190,7 +191,7 @@ procedure LRLDeleteLevel(Count: Word);
|
|||||||
var
|
var
|
||||||
Buffer: Pointer;
|
Buffer: Pointer;
|
||||||
LevelFile: File;
|
LevelFile: File;
|
||||||
i, j: Integer;
|
j: Integer;
|
||||||
l: Longint;
|
l: Longint;
|
||||||
k: Word;
|
k: Word;
|
||||||
begin
|
begin
|
||||||
@ -198,6 +199,7 @@ begin
|
|||||||
j := LRLLevelCount;
|
j := LRLLevelCount;
|
||||||
if (j < Count) or (j < 2) or (Count = 0) then
|
if (j < Count) or (j < 2) or (Count = 0) then
|
||||||
Exit;
|
Exit;
|
||||||
|
FileMode := 2;
|
||||||
AssignFile(LevelFile, LevelFileName);
|
AssignFile(LevelFile, LevelFileName);
|
||||||
Reset(LevelFile, 1);
|
Reset(LevelFile, 1);
|
||||||
for l := Count + 1 to j do
|
for l := Count + 1 to j do
|
||||||
@ -221,7 +223,7 @@ procedure LRLInsertLevel(After: Word);
|
|||||||
var
|
var
|
||||||
Buffer: Pointer;
|
Buffer: Pointer;
|
||||||
LevelFile: File;
|
LevelFile: File;
|
||||||
i, j: Integer;
|
j: Integer;
|
||||||
l: Longint;
|
l: Longint;
|
||||||
k: Word;
|
k: Word;
|
||||||
begin
|
begin
|
||||||
@ -229,6 +231,7 @@ begin
|
|||||||
j := LRLLevelCount;
|
j := LRLLevelCount;
|
||||||
if (After > j) or (After = 0) then
|
if (After > j) or (After = 0) then
|
||||||
Exit;
|
Exit;
|
||||||
|
FileMode := 2;
|
||||||
AssignFile(LevelFile, LevelFileName);
|
AssignFile(LevelFile, LevelFileName);
|
||||||
Reset(LevelFile, 1);
|
Reset(LevelFile, 1);
|
||||||
for l := j downto After + 1 do
|
for l := j downto After + 1 do
|
||||||
@ -254,7 +257,7 @@ procedure LRLLoadLevel(Number: Byte);
|
|||||||
var
|
var
|
||||||
LevelFile: File;
|
LevelFile: File;
|
||||||
InBuffer: Pointer;
|
InBuffer: Pointer;
|
||||||
i, j, k, l, x, y: Word;
|
i, j, k: Word;
|
||||||
a, b, c: Byte;
|
a, b, c: Byte;
|
||||||
begin
|
begin
|
||||||
TotalPrizes := 0;
|
TotalPrizes := 0;
|
||||||
@ -445,18 +448,17 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
{
|
{ GameResult:
|
||||||
game result:
|
1 - § ¬ã஢ «¨
|
||||||
1 - zamurovali
|
2 - ¯®©¬ «¨
|
||||||
2 - poimali
|
10 - ¢á¥ ᤥ« ®
|
||||||
10 - vse zdelano
|
50 - ¥â ¡®«ìè¥ ã஢¥©
|
||||||
50 - no more levels
|
60 - ¥â 祫®¢¥ç¥áª¨å î¨â®¢
|
||||||
60 - no human players
|
100 - ¦ â Esc }
|
||||||
100 - esc was pressed
|
|
||||||
}
|
|
||||||
procedure LRLUpdatePlayers;
|
procedure LRLUpdatePlayers;
|
||||||
var
|
var
|
||||||
i, j, k: Integer;
|
i, k: Integer;
|
||||||
spd: Word;
|
spd: Word;
|
||||||
begin
|
begin
|
||||||
for i := 1 to 10 do
|
for i := 1 to 10 do
|
||||||
@ -515,8 +517,8 @@ begin
|
|||||||
Exit;
|
Exit;
|
||||||
end;
|
end;
|
||||||
for k := 2 to 10 do
|
for k := 2 to 10 do
|
||||||
if (LRLLevel.Player[k].Controller <> 0) then
|
if (LRLLevel.Player[k].Controller <> 0) and
|
||||||
if (LRLLevel.Player[k].Position.x = Position.x) and
|
(LRLLevel.Player[k].Position.x = Position.x) and
|
||||||
(LRLLevel.Player[k].Position.y = Position.y) then
|
(LRLLevel.Player[k].Position.y = Position.y) then
|
||||||
begin
|
begin
|
||||||
EndOfGame := True;
|
EndOfGame := True;
|
||||||
@ -703,11 +705,9 @@ begin
|
|||||||
begin
|
begin
|
||||||
if Position.yoffs < 1 then
|
if Position.yoffs < 1 then
|
||||||
begin
|
begin
|
||||||
if ((LRLLevel.Field[Position.x, Position.y].Image <> 2) or
|
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].Flags and 16 <> 0)) or
|
|
||||||
((LRLLevel.Field[Position.x, Position.y - 1].Flags and 4 = 0) and
|
((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].Image <> 2) or (LRLLevel.Field[Position.x, Position.y - 1].Flags and 16 <> 0))) or
|
||||||
(LRLLevel.Field[Position.x, Position.y - 1].Flags and 16 <> 0))) or
|
|
||||||
(Position.y < 2) then
|
(Position.y < 2) then
|
||||||
begin
|
begin
|
||||||
Command := 10;
|
Command := 10;
|
||||||
@ -975,7 +975,7 @@ end;
|
|||||||
|
|
||||||
procedure LRLComputerPlayer;
|
procedure LRLComputerPlayer;
|
||||||
var
|
var
|
||||||
k, l, m, f1, f2, i, j: Integer;
|
k, l, m, f1, f2, i: Integer;
|
||||||
begin
|
begin
|
||||||
if ComputerTurn >= ComputerReaction then
|
if ComputerTurn >= ComputerReaction then
|
||||||
begin
|
begin
|
||||||
@ -1045,8 +1045,8 @@ begin
|
|||||||
NewCommand := 2;
|
NewCommand := 2;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
end
|
end else
|
||||||
else
|
|
||||||
if (Position.y < LRLLevel.Player[1].Position.y) then
|
if (Position.y < LRLLevel.Player[1].Position.y) then
|
||||||
begin
|
begin
|
||||||
if (((LRLLevel.Field[Position.x, Position.y + 1].Image = 2) and
|
if (((LRLLevel.Field[Position.x, Position.y + 1].Image = 2) and
|
||||||
@ -1114,13 +1114,12 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
end
|
end else
|
||||||
else
|
|
||||||
Inc(ComputerTurn);
|
Inc(ComputerTurn);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function LRLPlayLevel(Number: Byte): Word;
|
procedure LRLPlayLevel(Number: Byte);
|
||||||
var
|
var
|
||||||
Keypress: Word;
|
Keypress: Word;
|
||||||
i: Word;
|
i: Word;
|
||||||
@ -1181,14 +1180,15 @@ begin
|
|||||||
LRLLevel.Player[KeyboardControls[i * 3 + 2]].NewCommandWas := True;
|
LRLLevel.Player[KeyboardControls[i * 3 + 2]].NewCommandWas := True;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
if (Keypress = $50) or (Keypress = $70) then
|
if Keypress = KEY_P then
|
||||||
Paused := True;
|
Paused := True;
|
||||||
end;
|
end;
|
||||||
until (Keypress = $1B) or EndOfGame;
|
until (Keypress = KEY_ESC) or EndOfGame;
|
||||||
|
|
||||||
if EndOfGame then
|
if EndOfGame then
|
||||||
LRLEndSequence else
|
LRLEndSequence else
|
||||||
GameResult := 100;
|
GameResult := 100;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
end.
|
end.
|
||||||
@ -24,7 +24,7 @@ var
|
|||||||
|
|
||||||
procedure LoadData;
|
procedure LoadData;
|
||||||
var
|
var
|
||||||
size, j: Word;
|
j: Word;
|
||||||
i: Integer;
|
i: Integer;
|
||||||
begin
|
begin
|
||||||
GetMem(MainScreen, 64004);
|
GetMem(MainScreen, 64004);
|
||||||
@ -67,6 +67,7 @@ begin
|
|||||||
DataFill(p^, 768, 0, 0);
|
DataFill(p^, 768, 0, 0);
|
||||||
Palette256Set(p^);
|
Palette256Set(p^);
|
||||||
FreeMem(p, 768);
|
FreeMem(p, 768);
|
||||||
|
|
||||||
LoadData;
|
LoadData;
|
||||||
NeedToFade := True;
|
NeedToFade := True;
|
||||||
ImagePut(LRLScreen^, MainScreen^, 0, 0, 0, 0, 319, 199);
|
ImagePut(LRLScreen^, MainScreen^, 0, 0, 0, 0, 319, 199);
|
||||||
@ -94,17 +95,17 @@ begin
|
|||||||
|
|
||||||
Keypress := ReadKey;
|
Keypress := ReadKey;
|
||||||
|
|
||||||
if (Keypress = $B1) and (Item < 4) then
|
if (Keypress = KEY_DOWN) and (Item < 4) then
|
||||||
begin
|
begin
|
||||||
Inc(Item);
|
Inc(Item);
|
||||||
RedrawAll := True;
|
RedrawAll := True;
|
||||||
end;
|
end else
|
||||||
if (Keypress = $B2) and (Item > 1) then
|
if (Keypress = KEY_UP) and (Item > 1) then
|
||||||
begin
|
begin
|
||||||
Dec(Item);
|
Dec(Item);
|
||||||
RedrawAll := True;
|
RedrawAll := True;
|
||||||
end;
|
end;
|
||||||
until Keypress = $0D;
|
until Keypress = KEY_ENTER;
|
||||||
|
|
||||||
FadeClear;
|
FadeClear;
|
||||||
ImageClear(LRLScreen^);
|
ImageClear(LRLScreen^);
|
||||||
865
programs/games/lrl/src/LRLRoutines.pp
Normal file
865
programs/games/lrl/src/LRLRoutines.pp
Normal file
@ -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.
|
||||||
@ -86,7 +86,7 @@ procedure LoadImages;
|
|||||||
var
|
var
|
||||||
InBuffer: Pointer;
|
InBuffer: Pointer;
|
||||||
i, j, k, l, x, y: Word;
|
i, j, k, l, x, y: Word;
|
||||||
a, b, c: Byte;
|
a: Byte;
|
||||||
begin
|
begin
|
||||||
GetMem(InBuffer, $FFF0);
|
GetMem(InBuffer, $FFF0);
|
||||||
|
|
||||||
Loading…
Reference in New Issue
Block a user