forked from KolibriOS/kolibrios
fp rtl changes, lrl editor
git-svn-id: svn://kolibrios.org@775 a494cfbc-eb01-0410-851d-a64ba20cac60
This commit is contained in:
parent
66658538e4
commit
50724bd885
@ -94,6 +94,7 @@ asm
|
||||
movswl %ax, %ecx
|
||||
popl %ebx
|
||||
shrl $16, %eax
|
||||
movswl %ax, %eax
|
||||
movl %ecx, TKosPoint.Y(%ebx)
|
||||
movl %eax, TKosPoint.X(%ebx)
|
||||
popl %ecx
|
||||
@ -114,6 +115,7 @@ asm
|
||||
movswl %ax, %ecx
|
||||
popl %ebx
|
||||
shrl $16, %eax
|
||||
movswl %ax, %eax
|
||||
movl %ecx, TKosPoint.Y(%ebx)
|
||||
movl %eax, TKosPoint.X(%ebx)
|
||||
popl %ecx
|
||||
|
@ -9,17 +9,18 @@ uses
|
||||
LRLLevels,
|
||||
LRLMainMenu,
|
||||
LRLHighScores,
|
||||
{LRLEditor,}
|
||||
LRLEditor,
|
||||
LRLIntroduction;
|
||||
|
||||
const
|
||||
Version: PChar = 'Lode Runner LIVE. Version 1.4b';
|
||||
Version: PChar = 'Lode Runner LIVE. Version 1.5';
|
||||
|
||||
|
||||
procedure LRLInitialize;
|
||||
begin
|
||||
ImagesInitialize;
|
||||
KeyboardInitialize;
|
||||
MouseInitialize;
|
||||
ScreenMode(1);
|
||||
ScreenTitle := Version;
|
||||
end;
|
||||
@ -72,7 +73,7 @@ begin
|
||||
repeat
|
||||
LRLSelectItem(MenuSelection);
|
||||
if MenuSelection = 1 then LRLGameStart;
|
||||
{if MenuSelection = 2 then LRLEditLevels;}
|
||||
if MenuSelection = 2 then LRLEditLevels;
|
||||
if MenuSelection = 3 then LRLShowHighScores;
|
||||
until MenuSelection = 4;
|
||||
end;
|
||||
|
@ -1,209 +1,220 @@
|
||||
unit LRLEditor;
|
||||
|
||||
{$mode objfpc}
|
||||
{$asmmode intel}
|
||||
|
||||
|
||||
interface
|
||||
|
||||
uses DOSFileAccess, LRLRoutines, LRLSprites, LRLLevels;
|
||||
|
||||
uses
|
||||
LRLRoutines, LRLSprites, LRLLevels;
|
||||
|
||||
|
||||
procedure LRLEditLevels;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
const
|
||||
RefreshDelay = 5; { 1 = 1/100 sec }
|
||||
|
||||
var
|
||||
CurrentLevel: word;
|
||||
CurrentTool: word;
|
||||
TotalLevels: word;
|
||||
MouseX, MouseY: integer;
|
||||
TimeToRefresh: boolean;
|
||||
RefreshDelay: word;
|
||||
RefreshRemain: word;
|
||||
OldTimer: POINTER;
|
||||
CurrentLevel: Word;
|
||||
CurrentTool: Word;
|
||||
TotalLevels: Word;
|
||||
MouseX, MouseY: Integer;
|
||||
|
||||
TimeToRefresh : Boolean;
|
||||
LastRefreshTime: DWord;
|
||||
|
||||
|
||||
procedure LRLRedrawLevel;
|
||||
var
|
||||
i, j: integer;
|
||||
i, j: Integer;
|
||||
begin
|
||||
ImageClear(LRLScreen^);
|
||||
for i := 1 to 16 do
|
||||
for j := 1 to 30 do
|
||||
with LRLLevel.Field[j, i] do
|
||||
ImagePut(LRLScreen^, LRLEnvironment[Image].Image[Count].Data^, j * 10, i * 10, 0, 0, 319, 199);
|
||||
|
||||
for i := 1 to 16 do for j := 1 to 30 do
|
||||
with LRLLevel.Field[j, i] do
|
||||
ImagePut(LRLScreen^, LRLEnvironment[Image].Image[Count].Data^, j * 10, i * 10, 0, 0, 319, 199);
|
||||
|
||||
for i := 1 to 10 do
|
||||
with LRLLevel.Player[i] do
|
||||
begin
|
||||
if Controller <> 0 then
|
||||
ImagePutTransparent(LRLScreen^, LRLFigure[Colour, SpriteData].Image[Sprite].Data^,
|
||||
Position.x * 10 + Position.xoffs, Position.y * 10 + Position.yoffs, 0, 0, 319, 199);
|
||||
end;
|
||||
with LRLLevel.Player[i] do
|
||||
if Controller <> 0 then
|
||||
ImagePutTransparent(LRLScreen^, LRLFigure[Colour, SpriteData].Image[Sprite].Data^, Position.x * 10 + Position.xoffs, Position.y * 10 + Position.yoffs, 0, 0, 319, 199);
|
||||
|
||||
ImageFill(LRLFontBuffer^, 12, 12, 252);
|
||||
ImagePut(LRLScreen^, LRLFontBuffer^, 10, 184, 0, 0, 319, 199);
|
||||
|
||||
for i := 1 to 13 do
|
||||
begin
|
||||
if i > 9 then
|
||||
ImagePut(LRLScreen^, LRLFigure[i - 9, 1].Image[1].Data^, i * 15 - 4, 185, 0, 0, 319, 199)
|
||||
else
|
||||
ImagePut(LRLScreen^, LRLEnvironment[i].Image[1].Data^, i * 15 - 4, 185, 0, 0, 319, 199);
|
||||
end;
|
||||
if i > 9 then
|
||||
ImagePut(LRLScreen^, LRLFigure[i - 9, 1].Image[1].Data^, i * 15 - 4, 185, 0, 0, 319, 199) else
|
||||
ImagePut(LRLScreen^, LRLEnvironment[i].Image[1].Data^, i * 15 - 4, 185, 0, 0, 319, 199);
|
||||
|
||||
for i := 1 to 6 do
|
||||
begin
|
||||
if LRLEditorButton[i].Lit then
|
||||
ImagePut(LRLScreen^, LRLEditorButton[i].LightIcon^, LRLEditorButton[i].x1,
|
||||
LRLEditorButton[i].y1, 0, 0, 319, 199)
|
||||
else
|
||||
ImagePut(LRLScreen^, LRLEditorButton[i].DarkIcon^, LRLEditorButton[i].x1,
|
||||
LRLEditorButton[i].y1, 0, 0, 319, 199);
|
||||
end;
|
||||
if LRLEditorButton[i].Lit then
|
||||
ImagePut(LRLScreen^, LRLEditorButton[i].LightIcon^, LRLEditorButton[i].x1, LRLEditorButton[i].y1, 0, 0, 319, 199) else
|
||||
ImagePut(LRLScreen^, LRLEditorButton[i].DarkIcon^, LRLEditorButton[i].x1, LRLEditorButton[i].y1, 0, 0, 319, 199);
|
||||
|
||||
LRLDrawOrnamental(0, 0, 31, 17, 1);
|
||||
end;
|
||||
|
||||
procedure RefreshRunner;
|
||||
{INTERRUPT;
|
||||
ASSEMBLER;}
|
||||
asm
|
||||
DEC RefreshRemain
|
||||
JNZ @DoTimer
|
||||
|
||||
MOV AX,RefreshDelay
|
||||
MOV RefreshRemain,AX
|
||||
MOV TimeToRefresh,-1
|
||||
|
||||
@DoTimer:
|
||||
PUSHF
|
||||
CALL OldTimer
|
||||
end;
|
||||
|
||||
procedure LRLMoveMouse;
|
||||
var
|
||||
s, s2: string[20];
|
||||
s, s2: String[20];
|
||||
begin
|
||||
MSMouseGetXY(Mousex, Mousey);
|
||||
MSMouseGetXY(MouseX, MouseY);
|
||||
|
||||
if not MSMouseInArea(200, 180, 325, 205) then
|
||||
begin
|
||||
if CurrentTool < 10 then
|
||||
ImagePut(LRLScreen^, LRLEnvironment[CurrentTool].Image[1].Data^,
|
||||
Mousex - 5, Mousey - 5, 0, 0, 319, 199)
|
||||
else
|
||||
ImagePut(LRLScreen^, LRLFigure[CurrentTool - 9, 1].Image[1].Data^,
|
||||
Mousex - 5, Mousey - 5, 0, 0, 319, 199);
|
||||
end;
|
||||
ImagePut(LRLScreen^, LRLEnvironment[CurrentTool].Image[1].Data^, MouseX - 5, MouseY - 5, 0, 0, 319, 199) else
|
||||
ImagePut(LRLScreen^, LRLFigure[CurrentTool - 9, 1].Image[1].Data^, MouseX - 5, MouseY - 5, 0, 0, 319, 199);
|
||||
|
||||
if not MSMouseInArea(-2, -2, 55, 20) then
|
||||
begin
|
||||
ImageFill(LRLFontBuffer^, 50, 15, 0);
|
||||
ImagePut(LRLScreen^, LRLFontBuffer^, 0, 0, 0, 0, 319, 199);
|
||||
STR(CurrentLevel, s);
|
||||
STR(TotalLevels, s2);
|
||||
Str(CurrentLevel, s);
|
||||
Str(TotalLevels, s2);
|
||||
ImageStringGet(s + '/' + s2, LRLFont^, LRLFontBuffer^, 251);
|
||||
ImagePut(LRLScreen^, LRLFontBuffer^, 25 - ImageSizex(LRLFontBuffer^) div 2, 0, 0, 0, 319, 199);
|
||||
end;
|
||||
ImagePutTransparent(LRLScreen^, LRLMousePointer^, Mousex, Mousey, 0, 0, 319, 199);
|
||||
|
||||
ImagePutTransparent(LRLScreen^, LRLMousePointer^, MouseX, MouseY, 0, 0, 319, 199);
|
||||
end;
|
||||
|
||||
procedure RePress;
|
||||
|
||||
procedure Repress;
|
||||
var
|
||||
x, y: integer;
|
||||
x, y: Integer;
|
||||
begin
|
||||
MSMouseButtonWasPressed(0, x, y);
|
||||
MSMouseButtonWasReleased(0, x, y);
|
||||
MSMouseButtonWasPressed(1, x, y);
|
||||
MSMouseButtonWasReleased(1, x, y);
|
||||
MSMouseButtonWasPressed(4, x, y);
|
||||
MSMouseButtonWasReleased(4, x, y);
|
||||
end;
|
||||
|
||||
|
||||
procedure LRLEditLevels;
|
||||
var
|
||||
Keypress: word;
|
||||
NeedToFade: boolean;
|
||||
DrawNow: boolean;
|
||||
i, j: integer;
|
||||
x, y: integer;
|
||||
Cmd: word;
|
||||
Keypress: Word;
|
||||
DrawNow: Boolean;
|
||||
i, j: Integer;
|
||||
x, y: Integer;
|
||||
Cmd: Word;
|
||||
begin
|
||||
if not MSMouseDriverExist then Exit;
|
||||
Repress;
|
||||
Palette256Set(LRLPalette^);
|
||||
|
||||
ShowLives := False;
|
||||
ShowScore := False;
|
||||
Palette256Set(LRLPalette^);
|
||||
OldTimer := SetInterrupt($8, @RefreshRunner);
|
||||
Keypress := 0;
|
||||
RefreshDelay := 1;
|
||||
RefreshRemain := 1;
|
||||
Keypress := 0;
|
||||
CurrentLevel := 1;
|
||||
CurrentTool := 2;
|
||||
TotalLevels := LRLLevelCount;
|
||||
TimeToRefresh := True;
|
||||
DrawNow := False;
|
||||
CurrentTool := 2;
|
||||
TotalLevels := LRLLevelCount;
|
||||
|
||||
DrawNow := False;
|
||||
TimeToRefresh := True;
|
||||
LastRefreshTime := 0;
|
||||
|
||||
MSMouseSetXY(160, 100);
|
||||
LRLLoadLevel(CurrentLevel);
|
||||
|
||||
WaitForEvent(1);
|
||||
|
||||
repeat
|
||||
if not TimeToRefresh then
|
||||
TimeToRefresh := kos_timecounter() - LastRefreshTime >= RefreshDelay;
|
||||
|
||||
if TimeToRefresh then
|
||||
begin
|
||||
LRLRedrawLevel;
|
||||
LRLMoveMouse;
|
||||
ScreenApply(LRLScreen^);
|
||||
TimeToRefresh := False;
|
||||
TimeToRefresh := False;
|
||||
LastRefreshTime := kos_timecounter();
|
||||
end;
|
||||
|
||||
if Keypressed then
|
||||
begin
|
||||
Keypress := Readkey;
|
||||
end;
|
||||
|
||||
if MSMouseButtonWasReleased(1, x, y) then
|
||||
begin
|
||||
LRLScore := 0;
|
||||
|
||||
FadeClear;
|
||||
ImageClear(LRLScreen^);
|
||||
ScreenApply(LRLScreen^);
|
||||
Palette256Set(LRLPalette^);
|
||||
LRLPlayLevel(CurrentLevel);
|
||||
|
||||
FadeClear;
|
||||
ImageClear(LRLScreen^);
|
||||
ScreenApply(LRLScreen^);
|
||||
Palette256Set(LRLPalette^);
|
||||
LRLLoadLevel(CurrentLevel);
|
||||
|
||||
Repress;
|
||||
end;
|
||||
|
||||
if MSMouseButtonWasPressed(0, x, y) then
|
||||
begin
|
||||
DrawNow := True;
|
||||
end;
|
||||
|
||||
if MSMouseButtonWasReleased(0, x, y) then
|
||||
begin
|
||||
DrawNow := False;
|
||||
|
||||
Cmd := 0;
|
||||
|
||||
for i := 1 to 6 do
|
||||
LRLEditorButton[i].Lit := False;
|
||||
|
||||
for i := 1 to 6 do
|
||||
if MSMouseInArea(LRLEditorButton[i].x1, LRLEditorButton[i].y1, LRLEditorButton[i].x2, LRLEditorButton[i].y2) then
|
||||
begin
|
||||
if MSMouseInArea(LRLEditorButton[i].x1, LRLEditorButton[i].y1,
|
||||
LRLEditorButton[i].x2, LRLEditorButton[i].y2) then
|
||||
begin
|
||||
Cmd := LRLEditorButton[i].Command;
|
||||
BREAK;
|
||||
end;
|
||||
Cmd := LRLEditorButton[i].Command;
|
||||
Break;
|
||||
end;
|
||||
if (Cmd = 1) then
|
||||
|
||||
if Cmd = 1 then
|
||||
begin
|
||||
LRLSaveLevel(CurrentLevel);
|
||||
Repress;
|
||||
if (Cmd = 2) then
|
||||
|
||||
Repress;
|
||||
end;
|
||||
|
||||
if Cmd = 2 then
|
||||
begin
|
||||
LRLInsertLevel(CurrentLevel);
|
||||
Inc(CurrentLevel);
|
||||
TotalLevels := LRLLevelCount;
|
||||
LRLLoadLevel(CurrentLevel);
|
||||
|
||||
Repress;
|
||||
end;
|
||||
|
||||
if (Cmd = 3) and (CurrentLevel < TotalLevels) then
|
||||
begin
|
||||
Inc(CurrentLevel);
|
||||
LRLLoadLevel(CurrentLevel);
|
||||
|
||||
Repress;
|
||||
end;
|
||||
if (Cmd = 4) then
|
||||
|
||||
if Cmd = 4 then
|
||||
begin
|
||||
for i := 1 to 16 do
|
||||
for j := 1 to 30 do
|
||||
LRLLevel.Field[j, i].Image := 1;
|
||||
for i := 1 to 16 do for j := 1 to 30 do
|
||||
LRLLevel.Field[j, i].Image := 1;
|
||||
for i := 1 to 10 do
|
||||
LRLLevel.Player[i].Controller := 0;
|
||||
|
||||
Repress;
|
||||
end;
|
||||
|
||||
if (Cmd = 5) and (TotalLevels > 1) then
|
||||
begin
|
||||
LRLDeleteLevel(CurrentLevel);
|
||||
@ -211,94 +222,89 @@ begin
|
||||
if CurrentLevel > TotalLevels then
|
||||
CurrentLevel := TotalLevels;
|
||||
LRLLoadLevel(CurrentLevel);
|
||||
|
||||
Repress;
|
||||
end;
|
||||
|
||||
if (Cmd = 6) and (CurrentLevel > 1) then
|
||||
begin
|
||||
Dec(CurrentLevel);
|
||||
LRLLoadLevel(CurrentLevel);
|
||||
|
||||
Repress;
|
||||
end;
|
||||
MSMouseGetXY(Mousex, Mousey);
|
||||
if (Mousey > 180) then
|
||||
begin
|
||||
|
||||
MSMouseGetXY(MouseX, MouseY);
|
||||
|
||||
if MouseY > 180 then
|
||||
for i := 1 to 13 do
|
||||
if (MouseY > 184) and (MouseY < 195) and (MouseX > i * 15 - 5) and (MouseX < i * 15 + 6) then
|
||||
begin
|
||||
if (Mousey > 184) and (Mousey < 195) and (Mousex > i * 15 - 5) and (Mousex < i * 15 + 6) then
|
||||
begin
|
||||
CurrentTool := i;
|
||||
BREAK;
|
||||
end;
|
||||
CurrentTool := i;
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
if DrawNow then
|
||||
begin
|
||||
for i := 1 to 6 do
|
||||
LRLEditorButton[i].Lit := False;
|
||||
|
||||
for i := 1 to 6 do
|
||||
if MSMouseInArea(LRLEditorButton[i].x1, LRLEditorButton[i].y1, LRLEditorButton[i].x2, LRLEditorButton[i].y2) then
|
||||
begin
|
||||
if MSMouseInArea(LRLEditorButton[i].x1, LRLEditorButton[i].y1,
|
||||
LRLEditorButton[i].x2, LRLEditorButton[i].y2) then
|
||||
begin
|
||||
LRLEditorButton[i].Lit := True;
|
||||
BREAK;
|
||||
end;
|
||||
LRLEditorButton[i].Lit := True;
|
||||
Break;
|
||||
end;
|
||||
MSMouseGetXY(Mousex, Mousey);
|
||||
x := (Mousex) div 10;
|
||||
y := (Mousey) div 10;
|
||||
|
||||
MSMouseGetXY(MouseX, MouseY);
|
||||
|
||||
x := MouseX div 10;
|
||||
y := MouseY div 10;
|
||||
|
||||
if (x > 0) and (x < 31) and (y > 0) and (y < 17) then
|
||||
begin
|
||||
for i := 1 to 10 do
|
||||
begin
|
||||
if (LRLLevel.Player[i].Controller <> 0) and (LRLLevel.Player[i].Position.x = x) and
|
||||
(LRLLevel.Player[i].Position.y = y) then
|
||||
if (LRLLevel.Player[i].Controller <> 0) and (LRLLevel.Player[i].Position.x = x) and (LRLLevel.Player[i].Position.y = y) and
|
||||
(CurrentTool <> 2) and (CurrentTool <> 3) and (CurrentTool <> 4) and (CurrentTool <> 7) then
|
||||
begin
|
||||
if (CurrentTool <> 2) and (CurrentTool <> 3) and (CurrentTool <> 4) and
|
||||
(CurrentTool <> 7) then
|
||||
begin
|
||||
LRLLevel.Player[i].Controller := 0;
|
||||
BREAK;
|
||||
end;
|
||||
LRLLevel.Player[i].Controller := 0;
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
|
||||
if CurrentTool < 10 then
|
||||
LRLLevel.Field[x, y].Image := CurrentTool
|
||||
else
|
||||
LRLLevel.Field[x, y].Image := CurrentTool else
|
||||
if (LRLLevel.Field[x, y].Image = 2) or (LRLLevel.Field[x, y].Image = 3) or
|
||||
(LRLLevel.Field[x, y].Image = 4) or (LRLLevel.Field[x, y].Image = 1) then
|
||||
begin
|
||||
if (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
|
||||
if CurrentTool = 10 then
|
||||
begin
|
||||
if CurrentTool = 10 then
|
||||
LRLLevel.Player[1].Controller := 1;
|
||||
LRLLevel.Player[1].Position.x := x;
|
||||
LRLLevel.Player[1].Position.y := y;
|
||||
LRLLevel.Player[1].Colour := 1;
|
||||
end else
|
||||
begin
|
||||
j := 2;
|
||||
for i := 2 to 10 do
|
||||
if LRLLevel.Player[i].Controller = 0 then
|
||||
begin
|
||||
LRLLevel.Player[1].Controller := 1;
|
||||
LRLLevel.Player[1].Position.x := x;
|
||||
LRLLevel.Player[1].Position.y := y;
|
||||
LRLLevel.Player[1].Colour := 1;
|
||||
end
|
||||
else
|
||||
begin
|
||||
j := 2;
|
||||
for i := 2 to 10 do
|
||||
begin
|
||||
if LRLLevel.Player[i].Controller = 0 then
|
||||
begin
|
||||
j := i;
|
||||
BREAK;
|
||||
end;
|
||||
end;
|
||||
LRLLevel.Player[j].Controller := 2;
|
||||
LRLLevel.Player[j].Position.x := x;
|
||||
LRLLevel.Player[j].Position.y := y;
|
||||
LRLLevel.Player[j].Colour := CurrentTool - 9;
|
||||
j := i;
|
||||
Break;
|
||||
end;
|
||||
LRLLevel.Player[j].Controller := 2;
|
||||
LRLLevel.Player[j].Position.x := x;
|
||||
LRLLevel.Player[j].Position.y := y;
|
||||
LRLLevel.Player[j].Colour := CurrentTool - 9;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
until (LO(Keypress) = 27);
|
||||
SetInterrupt($8, OldTimer);
|
||||
|
||||
WaitForEvent(5);
|
||||
|
||||
until (Keypress = KEY_ESC);
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
@ -17,7 +17,7 @@ implementation
|
||||
|
||||
const
|
||||
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)',
|
||||
'Copyright (c) 1995 Aleksey V. Vaneev',
|
||||
'Copyright (c) 2008 bw',
|
||||
|
@ -7,8 +7,8 @@ unit LRLRoutines;
|
||||
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 ImagePut(var Screen, ImageBuffer; X, Y, WinX1, WinY1, WinX2, WinY2: Integer);
|
||||
procedure ImagePutTransparent(var Screen, ImageBuffer; X, Y, WinX1, WinY1, WinX2, WinY2: Integer);
|
||||
procedure ImageFill(var ImageBuffer; SizeX, SizeY: Word; Value: Byte);
|
||||
function ImageSizeX(var ImageBuffer): Word;
|
||||
function ImageSizeY(var ImageBuffer): Word;
|
||||
@ -17,11 +17,20 @@ procedure ScreenApply(var Buffer);
|
||||
procedure ImageClear(var Buffer);
|
||||
procedure ScreenMode(Mode: Integer);
|
||||
|
||||
function ScanToChar(Code: Word): Char;
|
||||
procedure KeyboardInitialize;
|
||||
function Keypressed: Boolean;
|
||||
function ReadKey: Word;
|
||||
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 Palette256Get(var Palette256);
|
||||
@ -39,15 +48,9 @@ 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;
|
||||
|
||||
function GetInterrupt(Int: Byte): Pointer;
|
||||
procedure WaitForEvent(Timeout: DWord = 0);
|
||||
procedure AssignFile(var AFile: File; AFileName: String);
|
||||
function LastDosTick(): Longword;
|
||||
|
||||
@ -292,9 +295,9 @@ begin
|
||||
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
|
||||
Width, Height: Word;
|
||||
Width, Height: Longint;
|
||||
I, J, K: Integer;
|
||||
P: Pointer;
|
||||
begin
|
||||
@ -309,9 +312,9 @@ begin
|
||||
if X < WinX1 then
|
||||
J := WinX1 - X else
|
||||
J := 0;
|
||||
K := Width - J;
|
||||
if WinX1 + K - 1 > WinX2 then
|
||||
K := WinX2 - WinX1 + 1;
|
||||
if X + Width - 1 > WinX2 then
|
||||
K := WinX2 - X - J + 1 else
|
||||
K := Width - J;
|
||||
Move((P + J)^, (@Screen + I * BUFFER_WIDTH + X + J)^, K);
|
||||
end;
|
||||
Inc(P, Width);
|
||||
@ -319,9 +322,9 @@ begin
|
||||
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
|
||||
Width, Height: Word;
|
||||
Width, Height: Longint;
|
||||
I, J, K, L: Integer;
|
||||
PI, PO: PByte;
|
||||
begin
|
||||
@ -337,9 +340,9 @@ begin
|
||||
if X < WinX1 then
|
||||
J := WinX1 - X else
|
||||
J := 0;
|
||||
K := Width - J;
|
||||
if WinX1 + K - 1 > WinX2 then
|
||||
K := WinX2 - WinX1 + 1;
|
||||
if X + Width - 1 > WinX2 then
|
||||
K := WinX2 - X - J + 1 else
|
||||
K := Width - J;
|
||||
|
||||
Inc(PI, 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;
|
||||
begin
|
||||
kos_setkeyboardmode(1);
|
||||
@ -569,33 +598,123 @@ procedure KeyboardFlush;
|
||||
begin
|
||||
end;
|
||||
|
||||
function ScanToChar(Code: Word): Char;
|
||||
var
|
||||
I: Word;
|
||||
procedure ProcessKeyboard;
|
||||
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;
|
||||
LastKeyEvent := TranslateKey(kos_getkey());
|
||||
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);
|
||||
var
|
||||
I: Longint;
|
||||
@ -812,50 +931,32 @@ begin
|
||||
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 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);
|
||||
begin
|
||||
Assign(AFile, IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0))) + AFileName);
|
||||
end;
|
||||
|
||||
|
||||
function LastDosTick(): Longword;
|
||||
begin
|
||||
Result := Round(kos_timecounter() * 0.182);
|
||||
|
Loading…
Reference in New Issue
Block a user