From 50724bd885880c1807ca53923fc9ff053c28433e Mon Sep 17 00:00:00 2001 From: bw Date: Sun, 23 Mar 2008 23:44:28 +0000 Subject: [PATCH] fp rtl changes, lrl editor git-svn-id: svn://kolibrios.org@775 a494cfbc-eb01-0410-851d-a64ba20cac60 --- programs/develop/fp/rtl/kos.inc | 2 + programs/games/lrl/src/LRL.pp | 7 +- programs/games/lrl/src/LRLEditor.pp | 312 +++++++++++----------- programs/games/lrl/src/LRLIntroduction.pp | 2 +- programs/games/lrl/src/LRLRoutines.pp | 257 ++++++++++++------ 5 files changed, 345 insertions(+), 235 deletions(-) diff --git a/programs/develop/fp/rtl/kos.inc b/programs/develop/fp/rtl/kos.inc index 83036d21a8..da8370d9df 100644 --- a/programs/develop/fp/rtl/kos.inc +++ b/programs/develop/fp/rtl/kos.inc @@ -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 diff --git a/programs/games/lrl/src/LRL.pp b/programs/games/lrl/src/LRL.pp index 797a930de0..c7a940c979 100644 --- a/programs/games/lrl/src/LRL.pp +++ b/programs/games/lrl/src/LRL.pp @@ -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; diff --git a/programs/games/lrl/src/LRLEditor.pp b/programs/games/lrl/src/LRLEditor.pp index 237ded35b4..e218066c1a 100644 --- a/programs/games/lrl/src/LRLEditor.pp +++ b/programs/games/lrl/src/LRLEditor.pp @@ -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. diff --git a/programs/games/lrl/src/LRLIntroduction.pp b/programs/games/lrl/src/LRLIntroduction.pp index f713d08595..ae9c8c0d8a 100644 --- a/programs/games/lrl/src/LRLIntroduction.pp +++ b/programs/games/lrl/src/LRLIntroduction.pp @@ -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', diff --git a/programs/games/lrl/src/LRLRoutines.pp b/programs/games/lrl/src/LRLRoutines.pp index d90d28ef7c..a02e9f17c5 100644 --- a/programs/games/lrl/src/LRLRoutines.pp +++ b/programs/games/lrl/src/LRLRoutines.pp @@ -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);