WebSVN – Kolibri OS – Diff – /programs/games/lrl/src/LRLRoutines.pp

 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);
 function  ImageSizeX(var ImageBuffer): Word;
 function  ImageSizeY(var ImageBuffer): Word;
+procedure ImageStringGet(Source: String; var FontData, Buffer; ColorOffs: Byte);
-procedure ImageStringGet(Source: String; var FontData, Buffer; ColorOffs: Byte);
+procedure ScreenApply(var Buffer);
-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;
+function Keypressed: Boolean;
+function ReadKey: Word;
+procedure KeyboardFlush;
+procedure MouseInitialize;
+function MSMouseInArea(x1, y1, x2, y2: Integer): Boolean;
+function MSMouseDriverExist: Boolean;
-procedure KeyboardInitialize;
+procedure MSMouseGetXY(var x, y: Integer);
-function Keypressed: Boolean;
+function MSMouseButtonStatusGet: Word;
-function ReadKey: Word;
+function MSMouseButtonWasPressed(Button: Word; var x, y: Integer): Boolean;
-procedure KeyboardFlush;
+function MSMouseButtonWasReleased(Button: Word; var x, y: Integer): Boolean;
 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;
+function GetInterrupt(Int: Byte): Pointer;
 procedure WaitForEvent(Timeout: DWord = 0);
 procedure AssignFile(var AFile: File; AFileName: String);
 function LastDosTick(): Longword;
   Paint;
 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;
     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;
+      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);
     end;
     Inc(P, Width);
   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
-  Width, Height: Word;
+  Width, Height: Longint;
   I, J, K, L: Integer;
   PI, PO: PByte;
 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;
+      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);
       PO := @Screen + I * BUFFER_WIDTH + X + J;
       for L := 1 to K do
   end;
 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 KeyboardFlush;
 begin
+end;
-end;
+procedure ProcessKeyboard;
+begin
+  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;
-function ScanToChar(Code: Word): Char;
+procedure ProcessMouse;
+var
+  I: Longint;
-var
+  Buttons, ButtonMask: DWord;
-  I: Word;
-begin
+  NowPressed, WasPressed: Boolean;
+begin
-  for I := Low(ScanToCharTable) to High(ScanToCharTable) do
+  Buttons := kos_getmousebuttons();
   with ScanToCharTable[I] do
-  if Scan = Code then
+  for I := 1 to MouseButtonsCount do
   begin
-    if not CapsPressed then
+    ButtonMask := 1 shl (I - 1);
-      if not ShiftDown then
-        Result := CL else
+    NowPressed := (Buttons and ButtonMask) <> 0;
-        Result := CU
-    else
-      if not ShiftDown then
+    WasPressed := (MouseButtonsState and ButtonMask) <> 0;
-        if not Caps then
-          Result := CL else
-          Result := CU
-      else
-        if not Caps then
-          Result := CL else
-          Result := CL;
+    if NowPressed and not WasPressed then Inc(MouseButtonsPressed[I]) else
+    if not NowPressed and WasPressed then Inc(MouseButtonsReleased[I]);
-    Exit;
+  end;
   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;
   Result := #0;
 end;
     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;
+function GetInterrupt(Int: Byte): Pointer;
 begin
-  Result := 0;
-end;
-function MSMouseButtonWasPressed(Button: Word; var x, y: Integer): Boolean;
-begin
+  Result := nil;
+end;
   Result := False;
+procedure WaitForEvent(Timeout: DWord = 0);
+var
+  Event: Word;
-end;
+begin
+  kos_maskevents(ME_PAINT or ME_KEYBOARD or ME_MOUSE);
+  Event := kos_waitevent(Timeout);
   case Event of
-function MSMouseButtonWasReleased(Button: Word; var x, y: Integer): Boolean;
-begin
-  Result := False;
-end;
+    SE_PAINT: Paint;
-procedure MSMouseSetXY(x, y: Integer);
-begin
-end;
     SE_KEYBOARD: ProcessKeyboard;
-function GetInterrupt(Int: Byte): Pointer;
+    SE_MOUSE: ProcessMouse;
-begin
+  end;
-  Result := nil;
+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);

Subversion Repositories Kolibri OS

(root)/programs/games/lrl/src/LRLRoutines.pp – Rev 762 → 775