arnavbhatt288/kolibrios
1
0
Fork 0
forked from KolibriOS/kolibrios
Code Pull Requests Activity

fp rtl changes, lrl editor

Browse Source 
git-svn-id: svn://kolibrios.org@775 a494cfbc-eb01-0410-851d-a64ba20cac60
This commit is contained in:
bw 2008-03-23 23:44:28 +00:00
parent 66658538e4
commit 50724bd885
5 changed files with 345 additions and 235 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
programs/develop/fp/rtl/kos.inc
View File

@ -94,6 +94,7 @@ asm
movswl %ax, %ecx movswl %ax, %ecx
popl %ebx popl %ebx
shrl $16, %eax shrl $16, %eax
movswl %ax, %eax
movl %ecx, TKosPoint.Y(%ebx) movl %ecx, TKosPoint.Y(%ebx)
movl %eax, TKosPoint.X(%ebx) movl %eax, TKosPoint.X(%ebx)
popl %ecx popl %ecx
@ -114,6 +115,7 @@ asm
movswl %ax, %ecx movswl %ax, %ecx
popl %ebx popl %ebx
shrl $16, %eax shrl $16, %eax
movswl %ax, %eax
movl %ecx, TKosPoint.Y(%ebx) movl %ecx, TKosPoint.Y(%ebx)
movl %eax, TKosPoint.X(%ebx) movl %eax, TKosPoint.X(%ebx)
popl %ecx popl %ecx

7
programs/games/lrl/src/LRL.pp
View File

@ -9,17 +9,18 @@ uses
LRLLevels, LRLLevels,
LRLMainMenu, LRLMainMenu,
LRLHighScores, LRLHighScores,
{LRLEditor,} LRLEditor,
LRLIntroduction; LRLIntroduction;
const const
Version: PChar = 'Lode Runner LIVE. Version 1.4b'; Version: PChar = 'Lode Runner LIVE. Version 1.5';
procedure LRLInitialize; procedure LRLInitialize;
begin begin
ImagesInitialize; ImagesInitialize;
KeyboardInitialize; KeyboardInitialize;
MouseInitialize;
ScreenMode(1); ScreenMode(1);
ScreenTitle := Version; ScreenTitle := Version;
end; end;
@ -72,7 +73,7 @@ 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;

244
programs/games/lrl/src/LRLEditor.pp
View File

@ -1,209 +1,220 @@
unit LRLEditor; unit LRLEditor;
{$mode objfpc}
{$asmmode intel}
interface interface
uses DOSFileAccess, LRLRoutines, LRLSprites, LRLLevels;
uses
LRLRoutines, LRLSprites, LRLLevels;
procedure LRLEditLevels; procedure LRLEditLevels;
implementation implementation
const
RefreshDelay = 5; { 1 = 1/100 sec }
var var
CurrentLevel: word; CurrentLevel: Word;
CurrentTool: word; CurrentTool: Word;
TotalLevels: word; TotalLevels: Word;
MouseX, MouseY: integer; MouseX, MouseY: Integer;
TimeToRefresh: boolean;
RefreshDelay: word; TimeToRefresh : Boolean;
RefreshRemain: word; LastRefreshTime: DWord;
OldTimer: POINTER;
procedure LRLRedrawLevel; procedure LRLRedrawLevel;
var var
i, j: integer; i, j: Integer;
begin begin
ImageClear(LRLScreen^); ImageClear(LRLScreen^);
for i := 1 to 16 do
for j := 1 to 30 do for i := 1 to 16 do for j := 1 to 30 do
with LRLLevel.Field[j, i] do with LRLLevel.Field[j, i] do
ImagePut(LRLScreen^, LRLEnvironment[Image].Image[Count].Data^, j * 10, i * 10, 0, 0, 319, 199); ImagePut(LRLScreen^, LRLEnvironment[Image].Image[Count].Data^, j * 10, i * 10, 0, 0, 319, 199);
for i := 1 to 10 do for i := 1 to 10 do
with LRLLevel.Player[i] do with LRLLevel.Player[i] do
begin
if Controller <> 0 then if Controller <> 0 then
ImagePutTransparent(LRLScreen^, LRLFigure[Colour, SpriteData].Image[Sprite].Data^, ImagePutTransparent(LRLScreen^, LRLFigure[Colour, SpriteData].Image[Sprite].Data^, Position.x * 10 + Position.xoffs, Position.y * 10 + Position.yoffs, 0, 0, 319, 199);
Position.x * 10 + Position.xoffs, Position.y * 10 + Position.yoffs, 0, 0, 319, 199);
end;
ImageFill(LRLFontBuffer^, 12, 12, 252); ImageFill(LRLFontBuffer^, 12, 12, 252);
ImagePut(LRLScreen^, LRLFontBuffer^, 10, 184, 0, 0, 319, 199); ImagePut(LRLScreen^, LRLFontBuffer^, 10, 184, 0, 0, 319, 199);
for i := 1 to 13 do for i := 1 to 13 do
begin
if i > 9 then if i > 9 then
ImagePut(LRLScreen^, LRLFigure[i - 9, 1].Image[1].Data^, i * 15 - 4, 185, 0, 0, 319, 199) ImagePut(LRLScreen^, LRLFigure[i - 9, 1].Image[1].Data^, i * 15 - 4, 185, 0, 0, 319, 199) else
else
ImagePut(LRLScreen^, LRLEnvironment[i].Image[1].Data^, i * 15 - 4, 185, 0, 0, 319, 199); ImagePut(LRLScreen^, LRLEnvironment[i].Image[1].Data^, i * 15 - 4, 185, 0, 0, 319, 199);
end;
for i := 1 to 6 do for i := 1 to 6 do
begin
if LRLEditorButton[i].Lit then if LRLEditorButton[i].Lit then
ImagePut(LRLScreen^, LRLEditorButton[i].LightIcon^, LRLEditorButton[i].x1, ImagePut(LRLScreen^, LRLEditorButton[i].LightIcon^, LRLEditorButton[i].x1, LRLEditorButton[i].y1, 0, 0, 319, 199) else
LRLEditorButton[i].y1, 0, 0, 319, 199) ImagePut(LRLScreen^, LRLEditorButton[i].DarkIcon^, LRLEditorButton[i].x1, LRLEditorButton[i].y1, 0, 0, 319, 199);
else
ImagePut(LRLScreen^, LRLEditorButton[i].DarkIcon^, LRLEditorButton[i].x1,
LRLEditorButton[i].y1, 0, 0, 319, 199);
end;
LRLDrawOrnamental(0, 0, 31, 17, 1); LRLDrawOrnamental(0, 0, 31, 17, 1);
end; end;
procedure RefreshRunner;
{INTERRUPT;
ASSEMBLER;}
asm
DEC RefreshRemain
JNZ @DoTimer
MOV AX,RefreshDelay
MOV RefreshRemain,AX
MOV TimeToRefresh,-1
@DoTimer:
PUSHF
CALL OldTimer
end;
procedure LRLMoveMouse; procedure LRLMoveMouse;
var var
s, s2: string[20]; s, s2: String[20];
begin begin
MSMouseGetXY(Mousex, Mousey); MSMouseGetXY(MouseX, MouseY);
if not MSMouseInArea(200, 180, 325, 205) then if not MSMouseInArea(200, 180, 325, 205) then
begin
if CurrentTool < 10 then if CurrentTool < 10 then
ImagePut(LRLScreen^, LRLEnvironment[CurrentTool].Image[1].Data^, ImagePut(LRLScreen^, LRLEnvironment[CurrentTool].Image[1].Data^, MouseX - 5, MouseY - 5, 0, 0, 319, 199) else
Mousex - 5, Mousey - 5, 0, 0, 319, 199) ImagePut(LRLScreen^, LRLFigure[CurrentTool - 9, 1].Image[1].Data^, MouseX - 5, MouseY - 5, 0, 0, 319, 199);
else
ImagePut(LRLScreen^, LRLFigure[CurrentTool - 9, 1].Image[1].Data^,
Mousex - 5, Mousey - 5, 0, 0, 319, 199);
end;
if not MSMouseInArea(-2, -2, 55, 20) then if not MSMouseInArea(-2, -2, 55, 20) then
begin begin
ImageFill(LRLFontBuffer^, 50, 15, 0); ImageFill(LRLFontBuffer^, 50, 15, 0);
ImagePut(LRLScreen^, LRLFontBuffer^, 0, 0, 0, 0, 319, 199); ImagePut(LRLScreen^, LRLFontBuffer^, 0, 0, 0, 0, 319, 199);
STR(CurrentLevel, s); Str(CurrentLevel, s);
STR(TotalLevels, s2); Str(TotalLevels, s2);
ImageStringGet(s + '/' + s2, LRLFont^, LRLFontBuffer^, 251); ImageStringGet(s + '/' + s2, LRLFont^, LRLFontBuffer^, 251);
ImagePut(LRLScreen^, LRLFontBuffer^, 25 - ImageSizex(LRLFontBuffer^) div 2, 0, 0, 0, 319, 199); ImagePut(LRLScreen^, LRLFontBuffer^, 25 - ImageSizex(LRLFontBuffer^) div 2, 0, 0, 0, 319, 199);
end; end;
ImagePutTransparent(LRLScreen^, LRLMousePointer^, Mousex, Mousey, 0, 0, 319, 199);
ImagePutTransparent(LRLScreen^, LRLMousePointer^, MouseX, MouseY, 0, 0, 319, 199);
end; end;
procedure RePress;
procedure Repress;
var var
x, y: integer; x, y: Integer;
begin begin
MSMouseButtonWasPressed(0, x, y);
MSMouseButtonWasReleased(0, x, y);
MSMouseButtonWasPressed(1, x, y); MSMouseButtonWasPressed(1, x, y);
MSMouseButtonWasReleased(1, x, y); MSMouseButtonWasReleased(1, x, y);
MSMouseButtonWasPressed(4, x, y);
MSMouseButtonWasReleased(4, x, y);
end; end;
procedure LRLEditLevels; procedure LRLEditLevels;
var var
Keypress: word; Keypress: Word;
NeedToFade: boolean; DrawNow: Boolean;
DrawNow: boolean; i, j: Integer;
i, j: integer; x, y: Integer;
x, y: integer; Cmd: Word;
Cmd: word;
begin begin
if not MSMouseDriverExist then Exit; if not MSMouseDriverExist then Exit;
Repress; Repress;
Palette256Set(LRLPalette^);
ShowLives := False; ShowLives := False;
ShowScore := False; ShowScore := False;
Palette256Set(LRLPalette^);
OldTimer := SetInterrupt($8, @RefreshRunner);
Keypress := 0; Keypress := 0;
RefreshDelay := 1;
RefreshRemain := 1;
CurrentLevel := 1; CurrentLevel := 1;
CurrentTool := 2; CurrentTool := 2;
TotalLevels := LRLLevelCount; TotalLevels := LRLLevelCount;
TimeToRefresh := True;
DrawNow := False; DrawNow := False;
TimeToRefresh := True;
LastRefreshTime := 0;
MSMouseSetXY(160, 100); MSMouseSetXY(160, 100);
LRLLoadLevel(CurrentLevel); LRLLoadLevel(CurrentLevel);
WaitForEvent(1);
repeat repeat
if not TimeToRefresh then
TimeToRefresh := kos_timecounter() - LastRefreshTime >= RefreshDelay;
if TimeToRefresh then if TimeToRefresh then
begin begin
LRLRedrawLevel; LRLRedrawLevel;
LRLMoveMouse; LRLMoveMouse;
ScreenApply(LRLScreen^); ScreenApply(LRLScreen^);
TimeToRefresh := False; TimeToRefresh := False;
LastRefreshTime := kos_timecounter();
end; end;
if Keypressed then if Keypressed then
begin
Keypress := Readkey; Keypress := Readkey;
end;
if MSMouseButtonWasReleased(1, x, y) then if MSMouseButtonWasReleased(1, x, y) then
begin begin
LRLScore := 0; LRLScore := 0;
FadeClear; FadeClear;
ImageClear(LRLScreen^); ImageClear(LRLScreen^);
ScreenApply(LRLScreen^); ScreenApply(LRLScreen^);
Palette256Set(LRLPalette^); Palette256Set(LRLPalette^);
LRLPlayLevel(CurrentLevel); LRLPlayLevel(CurrentLevel);
FadeClear; FadeClear;
ImageClear(LRLScreen^); ImageClear(LRLScreen^);
ScreenApply(LRLScreen^); ScreenApply(LRLScreen^);
Palette256Set(LRLPalette^); Palette256Set(LRLPalette^);
LRLLoadLevel(CurrentLevel); LRLLoadLevel(CurrentLevel);
Repress; Repress;
end; end;
if MSMouseButtonWasPressed(0, x, y) then if MSMouseButtonWasPressed(0, x, y) then
begin
DrawNow := True; DrawNow := True;
end;
if MSMouseButtonWasReleased(0, x, y) then if MSMouseButtonWasReleased(0, x, y) then
begin begin
DrawNow := False; DrawNow := False;
Cmd := 0; Cmd := 0;
for i := 1 to 6 do for i := 1 to 6 do
LRLEditorButton[i].Lit := False; LRLEditorButton[i].Lit := False;
for i := 1 to 6 do for i := 1 to 6 do
begin if MSMouseInArea(LRLEditorButton[i].x1, LRLEditorButton[i].y1, LRLEditorButton[i].x2, LRLEditorButton[i].y2) then
if MSMouseInArea(LRLEditorButton[i].x1, LRLEditorButton[i].y1,
LRLEditorButton[i].x2, LRLEditorButton[i].y2) then
begin begin
Cmd := LRLEditorButton[i].Command; Cmd := LRLEditorButton[i].Command;
BREAK; Break;
end; end;
end;
if (Cmd = 1) then if Cmd = 1 then
begin
LRLSaveLevel(CurrentLevel); LRLSaveLevel(CurrentLevel);
Repress; Repress;
if (Cmd = 2) then end;
if Cmd = 2 then
begin begin
LRLInsertLevel(CurrentLevel); LRLInsertLevel(CurrentLevel);
Inc(CurrentLevel); Inc(CurrentLevel);
TotalLevels := LRLLevelCount; TotalLevels := LRLLevelCount;
LRLLoadLevel(CurrentLevel); LRLLoadLevel(CurrentLevel);
Repress; Repress;
end; end;
if (Cmd = 3) and (CurrentLevel < TotalLevels) then if (Cmd = 3) and (CurrentLevel < TotalLevels) then
begin begin
Inc(CurrentLevel); Inc(CurrentLevel);
LRLLoadLevel(CurrentLevel); LRLLoadLevel(CurrentLevel);
Repress; Repress;
end; end;
if (Cmd = 4) then
if Cmd = 4 then
begin begin
for i := 1 to 16 do for i := 1 to 16 do for j := 1 to 30 do
for j := 1 to 30 do
LRLLevel.Field[j, i].Image := 1; LRLLevel.Field[j, i].Image := 1;
for i := 1 to 10 do for i := 1 to 10 do
LRLLevel.Player[i].Controller := 0; LRLLevel.Player[i].Controller := 0;
Repress; Repress;
end; end;
if (Cmd = 5) and (TotalLevels > 1) then if (Cmd = 5) and (TotalLevels > 1) then
begin begin
LRLDeleteLevel(CurrentLevel); LRLDeleteLevel(CurrentLevel);
@ -211,62 +222,58 @@ begin
if CurrentLevel > TotalLevels then if CurrentLevel > TotalLevels then
CurrentLevel := TotalLevels; CurrentLevel := TotalLevels;
LRLLoadLevel(CurrentLevel); LRLLoadLevel(CurrentLevel);
Repress; Repress;
end; end;
if (Cmd = 6) and (CurrentLevel > 1) then if (Cmd = 6) and (CurrentLevel > 1) then
begin begin
Dec(CurrentLevel); Dec(CurrentLevel);
LRLLoadLevel(CurrentLevel); LRLLoadLevel(CurrentLevel);
Repress; Repress;
end; end;
MSMouseGetXY(Mousex, Mousey);
if (Mousey > 180) then MSMouseGetXY(MouseX, MouseY);
begin
if MouseY > 180 then
for i := 1 to 13 do for i := 1 to 13 do
begin if (MouseY > 184) and (MouseY < 195) and (MouseX > i * 15 - 5) and (MouseX < i * 15 + 6) then
if (Mousey > 184) and (Mousey < 195) and (Mousex > i * 15 - 5) and (Mousex < i * 15 + 6) then
begin begin
CurrentTool := i; CurrentTool := i;
BREAK; Break;
end;
end;
end; end;
end; end;
if DrawNow then if DrawNow then
begin begin
for i := 1 to 6 do for i := 1 to 6 do
LRLEditorButton[i].Lit := False; LRLEditorButton[i].Lit := False;
for i := 1 to 6 do for i := 1 to 6 do
begin if MSMouseInArea(LRLEditorButton[i].x1, LRLEditorButton[i].y1, LRLEditorButton[i].x2, LRLEditorButton[i].y2) then
if MSMouseInArea(LRLEditorButton[i].x1, LRLEditorButton[i].y1,
LRLEditorButton[i].x2, LRLEditorButton[i].y2) then
begin begin
LRLEditorButton[i].Lit := True; LRLEditorButton[i].Lit := True;
BREAK; Break;
end; end;
end;
MSMouseGetXY(Mousex, Mousey); MSMouseGetXY(MouseX, MouseY);
x := (Mousex) div 10;
y := (Mousey) div 10; x := MouseX div 10;
y := MouseY div 10;
if (x > 0) and (x < 31) and (y > 0) and (y < 17) then if (x > 0) and (x < 31) and (y > 0) and (y < 17) then
begin begin
for i := 1 to 10 do for i := 1 to 10 do
begin if (LRLLevel.Player[i].Controller <> 0) and (LRLLevel.Player[i].Position.x = x) and (LRLLevel.Player[i].Position.y = y) and
if (LRLLevel.Player[i].Controller <> 0) and (LRLLevel.Player[i].Position.x = x) and (CurrentTool <> 2) and (CurrentTool <> 3) and (CurrentTool <> 4) and (CurrentTool <> 7) then
(LRLLevel.Player[i].Position.y = y) then
begin
if (CurrentTool <> 2) and (CurrentTool <> 3) and (CurrentTool <> 4) and
(CurrentTool <> 7) then
begin begin
LRLLevel.Player[i].Controller := 0; LRLLevel.Player[i].Controller := 0;
BREAK; Break;
end;
end;
end; end;
if CurrentTool < 10 then if CurrentTool < 10 then
LRLLevel.Field[x, y].Image := CurrentTool LRLLevel.Field[x, y].Image := CurrentTool else
else
begin
if (LRLLevel.Field[x, y].Image = 2) or (LRLLevel.Field[x, y].Image = 3) or if (LRLLevel.Field[x, y].Image = 2) or (LRLLevel.Field[x, y].Image = 3) or
(LRLLevel.Field[x, y].Image = 4) or (LRLLevel.Field[x, y].Image = 1) then (LRLLevel.Field[x, y].Image = 4) or (LRLLevel.Field[x, y].Image = 1) then
begin begin
@ -276,17 +283,14 @@ begin
LRLLevel.Player[1].Position.x := x; LRLLevel.Player[1].Position.x := x;
LRLLevel.Player[1].Position.y := y; LRLLevel.Player[1].Position.y := y;
LRLLevel.Player[1].Colour := 1; LRLLevel.Player[1].Colour := 1;
end end else
else
begin begin
j := 2; j := 2;
for i := 2 to 10 do for i := 2 to 10 do
begin
if LRLLevel.Player[i].Controller = 0 then if LRLLevel.Player[i].Controller = 0 then
begin begin
j := i; j := i;
BREAK; Break;
end;
end; end;
LRLLevel.Player[j].Controller := 2; LRLLevel.Player[j].Controller := 2;
LRLLevel.Player[j].Position.x := x; LRLLevel.Player[j].Position.x := x;
@ -296,9 +300,11 @@ begin
end; end;
end; end;
end; end;
end;
until (LO(Keypress) = 27); WaitForEvent(5);
SetInterrupt($8, OldTimer);
until (Keypress = KEY_ESC);
end; end;
end. end.

2
programs/games/lrl/src/LRLIntroduction.pp
View File

@ -17,7 +17,7 @@ implementation
const const
IntroText: array[1..14] of String = ( IntroText: array[1..14] of String = (
'Lode Runner LIVE. FREEWARE Version 1.4b', 'Lode Runner LIVE. FREEWARE Version 1.5',
'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) 2008 bw', 'Copyright (c) 2008 bw',

253
programs/games/lrl/src/LRLRoutines.pp
View File

@ -7,8 +7,8 @@ unit LRLRoutines;
interface interface
procedure ImagePut(var Screen, ImageBuffer; X, Y: Integer; Winx1, Winy1, Winx2, Winy2: Word); procedure ImagePut(var Screen, ImageBuffer; X, Y, WinX1, WinY1, WinX2, WinY2: Integer);
procedure ImagePutTransparent(var Screen, ImageBuffer; X, Y: Integer; Winx1, Winy1, Winx2, Winy2: Word); procedure ImagePutTransparent(var Screen, ImageBuffer; X, Y, WinX1, WinY1, WinX2, WinY2: Integer);
procedure ImageFill(var ImageBuffer; SizeX, SizeY: Word; Value: Byte); procedure ImageFill(var ImageBuffer; SizeX, SizeY: Word; Value: Byte);
function ImageSizeX(var ImageBuffer): Word; function ImageSizeX(var ImageBuffer): Word;
function ImageSizeY(var ImageBuffer): Word; function ImageSizeY(var ImageBuffer): Word;
@ -17,11 +17,20 @@ procedure ScreenApply(var Buffer);
procedure ImageClear(var Buffer); procedure ImageClear(var Buffer);
procedure ScreenMode(Mode: Integer); procedure ScreenMode(Mode: Integer);
function ScanToChar(Code: Word): Char;
procedure KeyboardInitialize; procedure KeyboardInitialize;
function Keypressed: Boolean; function Keypressed: Boolean;
function ReadKey: Word; function ReadKey: Word;
procedure KeyboardFlush; procedure KeyboardFlush;
function ScanToChar(Code: Word): Char;
procedure MouseInitialize;
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 Palette256Set(var Palette256); procedure Palette256Set(var Palette256);
procedure Palette256Get(var Palette256); procedure Palette256Get(var Palette256);
@ -39,15 +48,9 @@ function SetInterrupt(Int: Byte; NewAddress: Pointer): Pointer;
procedure FadeClear; procedure FadeClear;
procedure FadeTo(pal: Pointer); procedure FadeTo(pal: Pointer);
procedure DecompressRepByte(var InArray, OutArray; InArraySize: Word; var OutArraySize: Word); 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;
function GetInterrupt(Int: Byte): Pointer;
procedure WaitForEvent(Timeout: DWord = 0);
procedure AssignFile(var AFile: File; AFileName: String); procedure AssignFile(var AFile: File; AFileName: String);
function LastDosTick(): Longword; function LastDosTick(): Longword;
@ -292,9 +295,9 @@ begin
end; end;
procedure ImagePut(var Screen, ImageBuffer; X, Y: Integer; WinX1, WinY1, WinX2, WinY2: Word); procedure ImagePut(var Screen, ImageBuffer; X, Y, WinX1, WinY1, WinX2, WinY2: Integer);
var var
Width, Height: Word; Width, Height: Longint;
I, J, K: Integer; I, J, K: Integer;
P: Pointer; P: Pointer;
begin begin
@ -309,9 +312,9 @@ begin
if X < WinX1 then if X < WinX1 then
J := WinX1 - X else J := WinX1 - X else
J := 0; J := 0;
if X + Width - 1 > WinX2 then
K := WinX2 - X - J + 1 else
K := Width - J; K := Width - J;
if WinX1 + K - 1 > WinX2 then
K := WinX2 - WinX1 + 1;
Move((P + J)^, (@Screen + I * BUFFER_WIDTH + X + J)^, K); Move((P + J)^, (@Screen + I * BUFFER_WIDTH + X + J)^, K);
end; end;
Inc(P, Width); Inc(P, Width);
@ -319,9 +322,9 @@ begin
end; end;
procedure ImagePutTransparent(var Screen, ImageBuffer; X, Y: Integer; Winx1, Winy1, Winx2, Winy2: Word); procedure ImagePutTransparent(var Screen, ImageBuffer; X, Y, WinX1, WinY1, WinX2, WinY2: Integer);
var var
Width, Height: Word; Width, Height: Longint;
I, J, K, L: Integer; I, J, K, L: Integer;
PI, PO: PByte; PI, PO: PByte;
begin begin
@ -337,9 +340,9 @@ begin
if X < WinX1 then if X < WinX1 then
J := WinX1 - X else J := WinX1 - X else
J := 0; J := 0;
if X + Width - 1 > WinX2 then
K := WinX2 - X - J + 1 else
K := Width - J; K := Width - J;
if WinX1 + K - 1 > WinX2 then
K := WinX2 - WinX1 + 1;
Inc(PI, J); Inc(PI, J);
PO := @Screen + I * BUFFER_WIDTH + X + J; PO := @Screen + I * BUFFER_WIDTH + X + J;
@ -478,6 +481,32 @@ 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 KeyboardInitialize; procedure KeyboardInitialize;
begin begin
kos_setkeyboardmode(1); kos_setkeyboardmode(1);
@ -569,33 +598,123 @@ procedure KeyboardFlush;
begin begin
end; end;
function ScanToChar(Code: Word): Char; procedure ProcessKeyboard;
var
I: Word;
begin begin
for I := Low(ScanToCharTable) to High(ScanToCharTable) do LastKeyEvent := TranslateKey(kos_getkey());
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; end;
const
MK_LBUTTON = 1;
MK_RBUTTON = 2;
MK_MBUTTON = 4;
MouseButtonsCount = 3;
var
MouseButtonsState : DWord;
MouseButtonsPressed : array[1..MouseButtonsCount] of DWord;
MouseButtonsReleased: array[1..MouseButtonsCount] of DWord;
procedure ProcessMouse;
var
I: Longint;
Buttons, ButtonMask: DWord;
NowPressed, WasPressed: Boolean;
begin
Buttons := kos_getmousebuttons();
for I := 1 to MouseButtonsCount do
begin
ButtonMask := 1 shl (I - 1);
NowPressed := (Buttons and ButtonMask) <> 0;
WasPressed := (MouseButtonsState and ButtonMask) <> 0;
if NowPressed and not WasPressed then Inc(MouseButtonsPressed[I]) else
if not NowPressed and WasPressed then Inc(MouseButtonsReleased[I]);
end;
MouseButtonsState := Buttons;
end;
procedure MouseInitialize;
var
I: Longint;
begin
MouseButtonsState := kos_getmousebuttons();
for I := 1 to MouseButtonsCount do
begin
MouseButtonsPressed[I] := 0;
MouseButtonsReleased[I] := 0;
end;
ProcessMouse;
end;
function MSMouseInArea(x1, y1, x2, y2: Integer): Boolean;
var
X, Y: Integer;
begin
MSMouseGetXY(X, Y);
Result := (X >= x1) and (X <= x2) and (Y >= y1) and (Y <= y2);
end;
function MSMouseDriverExist: Boolean;
begin
Result := True;
end;
procedure MSMouseGetXY(var X, Y: Integer);
var
WinPos: TKosPoint;
begin
WinPos := kos_getmousewinpos();
X := Round(Double(WinPos.X) * BUFFER_WIDTH / ScreenWidth);
if X < 0 then X := 0 else
if X >= BUFFER_WIDTH then X := BUFFER_WIDTH - 1;
Y := Round(Double(WinPos.Y) * BUFFER_HEIGHT / ScreenHeight);
if Y < 0 then Y := 0 else
if Y >= BUFFER_HEIGHT then Y := BUFFER_HEIGHT - 1;
end;
function MSMouseButtonStatusGet: Word;
begin
Result := Word(kos_getmousebuttons());
end;
function MSMouseButtonWasPressed(Button: Word; var x, y: Integer): Boolean;
begin
Inc(Button);
if Button < MouseButtonsCount then
begin
Result := MouseButtonsPressed[Button] > 0;
MouseButtonsPressed[Button] := 0;
end else
Result := False;
MSMouseGetXY(x, y);
end;
function MSMouseButtonWasReleased(Button: Word; var x, y: Integer): Boolean;
begin
Inc(Button);
if Button < MouseButtonsCount then
begin
Result := MouseButtonsReleased[Button] > 0;
MouseButtonsReleased[Button] := 0;
end else
Result := False;
MSMouseGetXY(x, y);
end;
procedure MSMouseSetXY(x, y: Integer);
begin
end;
procedure Palette256Set(var Palette256); procedure Palette256Set(var Palette256);
var var
I: Longint; I: Longint;
@ -812,50 +931,32 @@ begin
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; function GetInterrupt(Int: Byte): Pointer;
begin begin
Result := nil; Result := nil;
end; end;
procedure WaitForEvent(Timeout: DWord = 0);
var
Event: Word;
begin
kos_maskevents(ME_PAINT or ME_KEYBOARD or ME_MOUSE);
Event := kos_waitevent(Timeout);
case Event of
SE_PAINT: Paint;
SE_KEYBOARD: ProcessKeyboard;
SE_MOUSE: ProcessMouse;
end;
end;
procedure AssignFile(var AFile: File; AFileName: String); procedure AssignFile(var AFile: File; AFileName: String);
begin begin
Assign(AFile, IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0))) + AFileName); Assign(AFile, IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0))) + AFileName);
end; end;
function LastDosTick(): Longword; function LastDosTick(): Longword;
begin begin
Result := Round(kos_timecounter() * 0.182); Result := Round(kos_timecounter() * 0.182);