forked from KolibriOS/kolibrios
866 lines
20 KiB
ObjectPascal
866 lines
20 KiB
ObjectPascal
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
|
||
{<7B><>७<EFBFBD><E0A5AD> <20><><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD>}
|
||
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
|
||
{<7B><><EFBFBD><EFBFBD>⠡<EFBFBD><EFBFBD><E0AEA2><EFBFBD><EFBFBD>}
|
||
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);
|
||
|
||
{ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><>ப<EFBFBD> }
|
||
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;
|
||
|
||
{ <20>뢮<EFBFBD> <20><>ப<EFBFBD> }
|
||
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.
|