Subversion Repositories Kolibri OS

Rev

Rev 775 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | Download | RSS feed

  1. unit LRLRoutines;
  2.  
  3. {$mode objfpc}
  4. {$asmmode intel}
  5.  
  6.  
  7. interface
  8.  
  9.  
  10. procedure ImagePut(var Screen, ImageBuffer; X, Y: Integer; Winx1, Winy1, Winx2, Winy2: Word);
  11. procedure ImagePutTransparent(var Screen, ImageBuffer; X, Y: Integer; Winx1, Winy1, Winx2, Winy2: Word);
  12. procedure ImageFill(var ImageBuffer; SizeX, SizeY: Word; Value: Byte);
  13. function  ImageSizeX(var ImageBuffer): Word;
  14. function  ImageSizeY(var ImageBuffer): Word;
  15. procedure ImageStringGet(Source: String; var FontData, Buffer; ColorOffs: Byte);
  16. procedure ScreenApply(var Buffer);
  17. procedure ImageClear(var Buffer);
  18. procedure ScreenMode(Mode: Integer);
  19.  
  20. procedure KeyboardInitialize;
  21. function Keypressed: Boolean;
  22. function ReadKey: Word;
  23. procedure KeyboardFlush;
  24. function ScanToChar(Code: Word): Char;
  25.  
  26. procedure Palette256Set(var Palette256);
  27. procedure Palette256Get(var Palette256);
  28. procedure Palette256Darken(var Palette256; StartElement, EndElement, Decrement, MinValue: Byte);
  29. procedure Palette256Transform(var SourcePalette, DestinationPalette);
  30. function DataByteGet(var Buffer; BufferOffset: Word): Byte;
  31. procedure DataBytePut(var Buffer; BufferOffset: Word; Value: Byte);
  32. function DataWordGet(var Buffer; BufferOffset: Word): Word;
  33. procedure DataWordPut(var Buffer; BufferOffset: Word; Value: Word);
  34. procedure DataMove(var Source, Destination; Count: Word; SourceOffset, DestinationOffset: Word);
  35. procedure DataAdd(var Buffer; Count: Word; Amount: Byte; BufferOffset: Word);
  36. procedure DataFill(var Buffer; Count: Word; Value: Byte; BufferOffset: Word);
  37. function DataIdentical(var Array1, Array2; Count: Word; Array1Offset, Array2Offset: Word): Boolean;
  38. function SetInterrupt(Int: Byte; NewAddress: Pointer): Pointer;
  39. procedure FadeClear;
  40. procedure FadeTo(pal: Pointer);
  41. procedure DecompressRepByte(var InArray, OutArray; InArraySize: Word; var OutArraySize: Word);
  42. function MSMouseInArea(x1, y1, x2, y2: Integer): Boolean;
  43. function MSMouseDriverExist: Boolean;
  44. procedure MSMouseGetXY(var x, y: Integer);
  45. function MSMouseButtonStatusGet: Word;
  46. function MSMouseButtonWasPressed(Button: Word; var x, y: Integer): Boolean;
  47. function MSMouseButtonWasReleased(Button: Word; var x, y: Integer): Boolean;
  48. procedure MSMouseSetXY(x, y: Integer);
  49. function GetInterrupt(Int: Byte): Pointer;
  50.  
  51. procedure AssignFile(var AFile: File; AFileName: String);
  52. function LastDosTick(): Longword;
  53.  
  54.  
  55. const
  56.   KEY_GREY    = $E000;
  57.   KEY_UP_BASE = $8000;
  58.   KEY_ESC   = $0100;
  59.   KEY_1     = $0200;
  60.   KEY_2     = $0300;
  61.   KEY_3     = $0400;
  62.   KEY_4     = $0500;
  63.   KEY_5     = $0600;
  64.   KEY_6     = $0700;
  65.   KEY_7     = $0800;
  66.   KEY_8     = $0900;
  67.   KEY_9     = $0A00;
  68.   KEY_0     = $0B00;
  69.   KEY_SUBTRACT = $0C00;
  70.   KEY_ADD      = $0D00;
  71.   KEY_BACK  = $0E00;
  72.  
  73.   KEY_Q     = $1000;
  74.   KEY_W     = $1100;
  75.   KEY_E     = $1200;
  76.   KEY_R     = $1300;
  77.   KEY_T     = $1400;
  78.   KEY_Y     = $1500;
  79.   KEY_U     = $1600;
  80.   KEY_I     = $1700;
  81.   KEY_O     = $1800;
  82.   KEY_P     = $1900;
  83.   KEY_LBRACKET = $1A00;
  84.   KEY_RBRACKET = $1B00;
  85.   KEY_ENTER = $1C00;
  86.  
  87.   KEY_A     = $1E00;
  88.   KEY_S     = $1F00;
  89.   KEY_D     = $2000;
  90.   KEY_F     = $2100;
  91.   KEY_G     = $2200;
  92.   KEY_H     = $2300;
  93.   KEY_J     = $2400;
  94.   KEY_K     = $2500;
  95.   KEY_L     = $2600;
  96.   KEY_SEMICOLON = $2700;
  97.   KEY_QUOTE     = $2800;
  98.  
  99.   KEY_LSHIFT = $2A00;
  100.   KEY_Z     = $2C00;
  101.   KEY_X     = $2D00;
  102.   KEY_C     = $2E00;
  103.   KEY_V     = $2F00;
  104.   KEY_B     = $3000;
  105.   KEY_N     = $3100;
  106.   KEY_M     = $3200;
  107.   KEY_COMMA = $3300;
  108.   KEY_DECIMAL = $3400;
  109.   KEY_DIVIDE  = $3500;
  110.   KEY_RSHIFT  = $3600;
  111.  
  112.   KEY_ALT   = $3800;
  113.   KEY_CAPITAL = $3600;
  114.   KEY_F1    = $3B00;
  115.   KEY_UP    = $4800;
  116.   KEY_LEFT  = $4B00;
  117.   KEY_GREY5 = $4C00;
  118.   KEY_RIGHT = $4D00;
  119.   KEY_END   = $4F00;
  120.   KEY_DOWN  = $5000;
  121.   KEY_PGDN  = $5100;
  122.  
  123. type
  124.   ScanToCharRecord = record
  125.     Scan: Word;
  126.     CL: Char;
  127.     CU: Char;
  128.     Caps: Boolean;
  129.   end;
  130.  
  131. var
  132.   ScreenTitle: PChar = nil;
  133.   ScanToCharTable: array[1..45] of ScanToCharRecord = (
  134.     (Scan: KEY_0; CL: '0'; CU: ')'; Caps: False), (Scan: KEY_1; CL: '1'; CU: '!'; Caps: False),
  135.     (Scan: KEY_2; CL: '2'; CU: '@'; Caps: False), (Scan: KEY_3; CL: '3'; CU: '#'; Caps: False),
  136.     (Scan: KEY_4; CL: '4'; CU: '$'; Caps: False), (Scan: KEY_5; CL: '5'; CU: '%'; Caps: False),
  137.     (Scan: KEY_6; CL: '6'; CU: '^'; Caps: False), (Scan: KEY_7; CL: '7'; CU: '&'; Caps: False),
  138.     (Scan: KEY_8; CL: '8'; CU: '*'; Caps: False), (Scan: KEY_9; CL: '9'; CU: '('; Caps: False),
  139.     (Scan: KEY_SUBTRACT; CL: '-'; CU: '_'; Caps: False), (Scan: KEY_ADD; CL: '='; CU: '+'; Caps: False),
  140.  
  141.     (Scan: KEY_Q; CL: 'q'; CU: 'Q'; Caps: True), (Scan: KEY_W; CL: 'w'; CU: 'W'; Caps: True),
  142.     (Scan: KEY_E; CL: 'e'; CU: 'E'; Caps: True), (Scan: KEY_R; CL: 'r'; CU: 'R'; Caps: True),
  143.     (Scan: KEY_T; CL: 't'; CU: 'T'; Caps: True), (Scan: KEY_Y; CL: 'y'; CU: 'Y'; Caps: True),
  144.     (Scan: KEY_U; CL: 'u'; CU: 'U'; Caps: True), (Scan: KEY_I; CL: 'i'; CU: 'I'; Caps: True),
  145.     (Scan: KEY_O; CL: 'o'; CU: 'O'; Caps: True), (Scan: KEY_P; CL: 'p'; CU: 'P'; Caps: True),
  146.     (Scan: KEY_LBRACKET; CL: '['; CU: '{'; Caps: False), (Scan: KEY_RBRACKET; CL: ']'; CU: '}'; Caps: False),
  147.  
  148.     (Scan: KEY_A; CL: 'a'; CU: 'A'; Caps: True), (Scan: KEY_S; CL: 's'; CU: 'S'; Caps: True),
  149.     (Scan: KEY_D; CL: 'd'; CU: 'D'; Caps: True), (Scan: KEY_F; CL: 'f'; CU: 'F'; Caps: True),
  150.     (Scan: KEY_G; CL: 'g'; CU: 'G'; Caps: True), (Scan: KEY_H; CL: 'h'; CU: 'H'; Caps: True),
  151.     (Scan: KEY_J; CL: 'j'; CU: 'J'; Caps: True), (Scan: KEY_K; CL: 'k'; CU: 'K'; Caps: True),
  152.     (Scan: KEY_L; CL: 'l'; CU: 'L'; Caps: True),
  153.     (Scan: KEY_SEMICOLON; CL: ';'; CU: ':'; Caps: False), (Scan: KEY_QUOTE; CL: ''''; CU: '"'; Caps: False),
  154.  
  155.     (Scan: KEY_Z; CL: 'z'; CU: 'Z'; Caps: True), (Scan: KEY_X; CL: 'x'; CU: 'X'; Caps: True),
  156.     (Scan: KEY_C; CL: 'c'; CU: 'C'; Caps: True), (Scan: KEY_V; CL: 'v'; CU: 'V'; Caps: True),
  157.     (Scan: KEY_B; CL: 'b'; CU: 'B'; Caps: True), (Scan: KEY_N; CL: 'n'; CU: 'N'; Caps: True),
  158.     (Scan: KEY_M; CL: 'm'; CU: 'M'; Caps: True),
  159.     (Scan: KEY_COMMA; CL: ','; CU: '<'; Caps: False), (Scan: KEY_DECIMAL; CL: '.'; CU: '>'; Caps: False),
  160.     (Scan: KEY_DIVIDE; CL: '/'; CU: '?'; Caps: False)
  161.     );
  162.  
  163.  
  164. implementation
  165.  
  166.  
  167. uses
  168.   SysUtils;
  169.  
  170.  
  171. const
  172.   BUFFER_WIDTH  = 320;
  173.   BUFFER_HEIGHT = 200;
  174.  
  175. type
  176.   PRGBColor = ^TRGBColor;
  177.   TRGBColor = packed record
  178.     R, G, B: Byte;
  179.   end;
  180.  
  181.   PRGBPalette = ^TRGBPalette;
  182.   TRGBPalette = array[Byte] of TRGBColor;
  183.  
  184.  
  185. var
  186.   ScreenRGBPalette: TRGBPalette;
  187.   ScreenRGBBuffer : PRGBColor = nil;
  188.   ScreenRGBTemporary: PRGBColor = nil;
  189.   ScreenPalBuffer : array[0..BUFFER_HEIGHT - 1, 0..BUFFER_WIDTH - 1] of Byte;
  190.  
  191.   WindowWidth : Longint;
  192.   WindowHeight: Longint;
  193.   ScreenWidth : Longword;
  194.   ScreenHeight: Longword;
  195.   CurrentScreenMode: Integer = 0;
  196.  
  197.   LastKeyEvent: Word = $FFFF;
  198.   LastKeyUp  : Boolean = True;
  199.   LastKeyDown: Boolean = False;
  200.   AltDown    : Boolean = False;
  201.   ShiftDown  : Boolean = False;
  202.   LShiftDown : Boolean = False;
  203.   RShiftDown : Boolean = False;
  204.   CapsPressed: Boolean = False;
  205.  
  206.  
  207.  
  208. procedure Paint;
  209. begin
  210.   kos_begindraw();
  211.   kos_definewindow(10, 10, 100, 100, $64000000);
  212.   if CurrentScreenMode <> 0     then
  213.   begin
  214.     kos_setcaption(ScreenTitle);
  215.     if Assigned(ScreenRGBBuffer) then
  216.       kos_drawimage24(0, 0, ScreenWidth, ScreenHeight, ScreenRGBBuffer) else
  217.       kos_drawrect(0, 0, ScreenWidth, ScreenHeight, $FF00FF);
  218.   end;
  219.   kos_enddraw();
  220. end;
  221.  
  222.  
  223. procedure UpdateRGBBuffer;
  224. var
  225.   XStep, YStep: Longword;
  226.  
  227.   procedure Horizontal;
  228.   var
  229.     X, Y, I: Longword;
  230.     B: PByte;
  231.     C: PRGBColor;
  232.   begin
  233.     C := ScreenRGBTemporary;
  234.     for Y := 0 to BUFFER_HEIGHT - 1 do
  235.     begin
  236.       I := 0;
  237.       B := @ScreenPalBuffer[Y, 0];
  238.       for X := 0 to ScreenWidth - 1 do
  239.       begin
  240.         C^ := ScreenRGBPalette[PByte(B + (I shr 16))^];
  241.         Inc(I, XStep);
  242.         Inc(C);
  243.       end;
  244.     end;
  245.   end;
  246.  
  247.   procedure Vertical;
  248.   var
  249.     Y, I: Longword;
  250.     S: PRGBColor;
  251.     C: PRGBColor;
  252.   begin
  253.     I := 0;
  254.     S := ScreenRGBTemporary;
  255.     C := ScreenRGBBuffer;
  256.     for Y := 0 to ScreenHeight - 1 do
  257.     begin
  258.       Move(PRGBColor(S + (I shr 16) * ScreenWidth)^, C^, ScreenWidth * SizeOf(C^));
  259.       Inc(I, YStep);
  260.       Inc(C, ScreenWidth);
  261.     end;
  262.   end;
  263.  
  264. var
  265.   I, J: Longint;
  266.   B: PByte;
  267.   C: PRGBColor;
  268.  
  269. begin
  270.   if (ScreenWidth = BUFFER_WIDTH) and (ScreenHeight = BUFFER_HEIGHT) then
  271.   begin
  272.     {перенос один в один}
  273.     B := @ScreenPalBuffer;
  274.     C := ScreenRGBBuffer;
  275.     for I := 0 to BUFFER_HEIGHT - 1 do
  276.     for J := 0 to BUFFER_WIDTH - 1 do
  277.     begin
  278.       C^ := ScreenRGBPalette[B^];
  279.       Inc(B);
  280.       Inc(C);
  281.     end;
  282.   end else
  283.   begin
  284.     {масштабирование}
  285.     XStep := (BUFFER_WIDTH shl 16) div ScreenWidth;
  286.     YStep := (BUFFER_HEIGHT shl 16) div ScreenHeight;
  287.     Horizontal;
  288.     Vertical;
  289.   end;
  290.  
  291.   Paint;
  292. end;
  293.  
  294.  
  295. procedure ImagePut(var Screen, ImageBuffer; X, Y: Integer; WinX1, WinY1, WinX2, WinY2: Word);
  296. var
  297.   Width, Height: Word;
  298.   I, J, K: Integer;
  299.   P: Pointer;
  300. begin
  301.   Width  := PWord(@ImageBuffer)[0];
  302.   Height := PWord(@ImageBuffer)[1];
  303.  
  304.   P := @ImageBuffer + 4;
  305.   for I := Y to Y + Height - 1 do
  306.   begin
  307.     if (I >= 0) and (I < BUFFER_HEIGHT) and (I >= WinY1) and (I <= WinY2) then
  308.     begin
  309.       if X < WinX1 then
  310.         J := WinX1 - X else
  311.         J := 0;
  312.       K := Width - J;
  313.       if WinX1 + K - 1 > WinX2 then
  314.         K := WinX2 - WinX1 + 1;
  315.       Move((P + J)^, (@Screen + I * BUFFER_WIDTH + X + J)^, K);
  316.     end;
  317.     Inc(P, Width);
  318.   end;
  319. end;
  320.  
  321.  
  322. procedure ImagePutTransparent(var Screen, ImageBuffer; X, Y: Integer; Winx1, Winy1, Winx2, Winy2: Word);
  323. var
  324.   Width, Height: Word;
  325.   I, J, K, L: Integer;
  326.   PI, PO: PByte;
  327. begin
  328.   Width  := PWord(@ImageBuffer)[0];
  329.   Height := PWord(@ImageBuffer)[1];
  330.  
  331.   PI := @ImageBuffer + 4;
  332.  
  333.   for I := Y to Y + Height - 1 do
  334.   begin
  335.     if (I >= 0) and (I < BUFFER_HEIGHT) and (I >= WinY1) and (I <= WinY2) then
  336.     begin
  337.       if X < WinX1 then
  338.         J := WinX1 - X else
  339.         J := 0;
  340.       K := Width - J;
  341.       if WinX1 + K - 1 > WinX2 then
  342.         K := WinX2 - WinX1 + 1;
  343.  
  344.       Inc(PI, J);
  345.       PO := @Screen + I * BUFFER_WIDTH + X + J;
  346.       for L := 1 to K do
  347.       begin
  348.                 if PI^ > 0 then
  349.           PO^ := PI^;
  350.         Inc(PI);
  351.         Inc(PO);
  352.       end;
  353.       Dec(PI, J + K);
  354.     end;
  355.     Inc(PI, Width);
  356.   end;
  357. end;
  358.  
  359.  
  360. procedure ImageFill(var ImageBuffer; SizeX, SizeY: Word; Value: Byte);
  361. begin
  362.   PWord(@ImageBuffer)^     := SizeX;
  363.   PWord(@ImageBuffer + 2)^ := SizeY;
  364.   FillChar((@ImageBuffer + 4)^, SizeX * SizeY, Value);
  365. end;
  366.  
  367.  
  368. function ImageSizeX(var ImageBuffer): Word;
  369. begin
  370.   Result := PWord(@ImageBuffer)^;
  371. end;
  372.  
  373.  
  374. function ImageSizeY(var ImageBuffer): Word;
  375. begin
  376.   Result := PWord(@ImageBuffer + 2)^;
  377. end;
  378.  
  379.  
  380. procedure ImageStringGet(Source: String; var FontData, Buffer; ColorOffs: Byte);
  381. var
  382.   Width, Height: Word;
  383.   Table: PWord;
  384.   P, B: PByte;
  385.   X, I, J, K, C: Word;
  386. begin
  387.   Height := PWord(@FontData + 2)^;
  388.   Table  := PWord(@FontData + 4);
  389.  
  390.   { расчет длины строки }
  391.   Width := 0;
  392.   for I := 1 to Length(Source) do
  393.   begin
  394.     P := @Table[Ord(Source[I])];
  395.     Inc(Width, PWord(P + PWord(P)^)^);
  396.   end;
  397.  
  398.   PWord(@Buffer)^     := Width;
  399.   PWord(@Buffer + 2)^ := Height;
  400.  
  401.   { вывод строки }
  402.   X := 0;
  403.   for I := 1 to Length(Source) do
  404.   begin
  405.     P := @Table[Ord(Source[I])];
  406.     B := PByte(P + PWord(P)^);
  407.     C := PWord(B)^;
  408.     Inc(B, 2);
  409.  
  410.     P := PByte(@Buffer + 4 + X);
  411.     for K := 0 to Height - 1 do
  412.     begin
  413.       for J := 0 to C - 1 do
  414.       begin
  415.         if B^ = 0 then
  416.           P^ := 0 else
  417.           P^ := B^ + ColorOffs;
  418.         Inc(P);
  419.         Inc(B);
  420.       end;
  421.       Inc(P, Width - C);
  422.     end;
  423.  
  424.     Inc(X, C);
  425.   end;
  426. end;
  427.  
  428. procedure ScreenApply(var Buffer);
  429. begin
  430.   Move(Buffer, ScreenPalBuffer, SizeOf(ScreenPalBuffer));
  431.   UpdateRGBBuffer;
  432. end;
  433.  
  434. procedure ImageClear(var Buffer);
  435. begin
  436.   FillChar(Buffer, BUFFER_WIDTH * BUFFER_HEIGHT, 0);
  437. end;
  438.  
  439. procedure ScreenMode(Mode: Integer);
  440. var
  441.   ThreadInfo: TKosThreadInfo;
  442. begin
  443.   if Mode <> CurrentScreenMode then
  444.   begin
  445.     if Assigned(ScreenRGBBuffer) then FreeMem(ScreenRGBBuffer);
  446.     if Assigned(ScreenRGBTemporary) then FreeMem(ScreenRGBTemporary);
  447.  
  448.     case Mode of
  449.       -2: begin
  450.         ScreenWidth  := BUFFER_WIDTH div 2;
  451.         ScreenHeight := BUFFER_HEIGHT div 2;
  452.       end;
  453.       1..3: begin
  454.         ScreenWidth  := BUFFER_WIDTH * Mode;
  455.         ScreenHeight := BUFFER_HEIGHT * Mode;
  456.       end;
  457.     end;
  458.  
  459.     if CurrentScreenMode = 0 then Paint;
  460.  
  461.     kos_threadinfo(@ThreadInfo);
  462.  
  463.     with ThreadInfo, WindowRect do
  464.     begin
  465.       WindowWidth  := Width - ClientRect.Width + Longint(ScreenWidth);
  466.       WindowHeight := Height - ClientRect.Height + Longint(ScreenHeight);
  467.       kos_movewindow(Left, Top, WindowWidth, WindowHeight);
  468.     end;
  469.  
  470.     CurrentScreenMode := Mode;
  471.  
  472.     ScreenRGBBuffer    := GetMem(ScreenWidth * ScreenHeight * SizeOf(ScreenRGBBuffer^));
  473.     ScreenRGBTemporary := GetMem(ScreenWidth * BUFFER_HEIGHT * SizeOf(ScreenRGBTemporary^));
  474.  
  475.     UpdateRGBBuffer;
  476.   end;
  477. end;
  478.  
  479.  
  480.  
  481. procedure KeyboardInitialize;
  482. begin
  483.   kos_setkeyboardmode(1);
  484. end;
  485.  
  486. function ReadKeyLoop: Word;
  487. var
  488.   Event: Word;
  489. begin
  490.   kos_maskevents(ME_PAINT or ME_KEYBOARD);
  491.   repeat
  492.     Event := kos_getevent();
  493.     if Event = SE_PAINT then Paint;
  494.   until Event = SE_KEYBOARD;
  495.   Result := kos_getkey();
  496. end;
  497.  
  498. function TranslateKey(Key: Word): Word;
  499. begin
  500.   if Key = KEY_GREY then
  501.     Result := kos_getkey() else
  502.     Result := Key;
  503.  
  504.   LastKeyDown := Result < KEY_UP_BASE;
  505.   LastKeyUp   := not LastKeyDown;
  506.   if LastKeyUp then Dec(Result, KEY_UP_BASE);
  507.  
  508.   if Result = KEY_ALT then
  509.   begin
  510.     AltDown := LastKeyDown;
  511.     Result  := $FFFF;
  512.   end else
  513.  
  514.   if Result = KEY_LSHIFT then
  515.   begin
  516.     LShiftDown := LastKeyDown;
  517.     ShiftDown  := LShiftDown or RShiftDown;
  518.     Result     := $FFFF;
  519.   end else
  520.  
  521.   if Result = KEY_RSHIFT then
  522.   begin
  523.     RShiftDown := LastKeyDown;
  524.     ShiftDown  := LShiftDown or RShiftDown;
  525.     Result     := $FFFF;
  526.   end else
  527.  
  528.   if AltDown then
  529.   case Result of
  530.     KEY_1: begin Result := $FFFF; if LastKeyDown then ScreenMode(1); end;
  531.     KEY_2: begin Result := $FFFF; if LastKeyDown then ScreenMode(2); end;
  532.     KEY_3: begin Result := $FFFF; if LastKeyDown then ScreenMode(3); end;
  533.     KEY_9: begin Result := $FFFF; if LastKeyDown then ScreenMode(-2); end;
  534.     KEY_0: begin Result := $FFFF; if LastKeyDown then ScreenMode(100); end;
  535.   end;
  536. end;
  537.  
  538. function Keypressed: Boolean;
  539. begin
  540.   if (LastKeyEvent < KEY_UP_BASE) and LastKeyDown then
  541.     Result := True else
  542.   begin
  543.     kos_maskevents(ME_KEYBOARD);
  544.     if kos_getevent(False) = SE_KEYBOARD then
  545.     begin
  546.       LastKeyEvent := TranslateKey(kos_getkey());
  547.       if LastKeyEvent < KEY_UP_BASE then
  548.         Result := LastKeyDown else
  549.         Result := False;
  550.     end else
  551.     begin
  552.       LastKeyEvent := $FFFF;
  553.       Result := False;
  554.     end;
  555.   end;
  556. end;
  557.  
  558. function ReadKey: Word;
  559. begin
  560.   repeat
  561.     if LastKeyEvent < KEY_UP_BASE then
  562.       Result := LastKeyEvent else
  563.       Result := TranslateKey(ReadKeyLoop);
  564.     LastKeyEvent := $FFFF;
  565.   until (Result < KEY_UP_BASE) and LastKeyDown;
  566. end;
  567.  
  568. procedure KeyboardFlush;
  569. begin
  570. end;
  571.  
  572. function ScanToChar(Code: Word): Char;
  573. var
  574.   I: Word;
  575. begin
  576.   for I := Low(ScanToCharTable) to High(ScanToCharTable) do
  577.   with ScanToCharTable[I] do
  578.   if Scan = Code then
  579.   begin
  580.     if not CapsPressed then
  581.       if not ShiftDown then
  582.         Result := CL else
  583.         Result := CU
  584.     else
  585.       if not ShiftDown then
  586.         if not Caps then
  587.           Result := CL else
  588.           Result := CU
  589.       else
  590.         if not Caps then
  591.           Result := CL else
  592.           Result := CL;
  593.     Exit;
  594.   end;
  595.   Result := #0;
  596. end;
  597.  
  598.  
  599. procedure Palette256Set(var Palette256);
  600. var
  601.   I: Longint;
  602.   P: PRGBColor;
  603. begin
  604.   P := @Palette256;
  605.   for I := 0 to 255 do
  606.   with ScreenRGBPalette[I] do
  607.   begin
  608.     R := Round(P^.B / 63 * 255);
  609.     G := Round(P^.G / 63 * 255);
  610.     B := Round(P^.R / 63 * 255);
  611.     Inc(P);
  612.   end;
  613.   UpdateRGBBuffer;
  614. end;
  615.  
  616.  
  617. procedure Palette256Get(var Palette256);
  618. var
  619.   I: Longint;
  620.   P: PRGBColor;
  621. begin
  622.   P := @Palette256;
  623.   for I := 0 to 255 do
  624.   with ScreenRGBPalette[I] do
  625.   begin
  626.     P^.R := Round(B / 255 * 63);
  627.     P^.G := Round(G / 255 * 63);
  628.     P^.B := Round(R / 255 * 63);
  629.     Inc(P);
  630.   end;
  631. end;
  632.  
  633. procedure Palette256Darken(var Palette256; StartElement, EndElement, Decrement, MinValue: Byte);
  634. var
  635.   I, J: Byte;
  636.   PB  : PByte;
  637. begin
  638.   PB := @Palette256;
  639.   Inc(PB, StartElement * 3);
  640.   for I := StartElement to EndElement do
  641.   for J := 1 to 3 do
  642.   begin
  643.     if PB^ > MinValue then
  644.     if PB^ < Decrement then
  645.       PB^ := MinValue else
  646.       Dec(PB^, Decrement);
  647.     Inc(PB);
  648.   end;
  649. end;
  650.  
  651. procedure Palette256Transform(var SourcePalette, DestinationPalette);
  652. var
  653.   I: Longint;
  654.   S, D: PByte;
  655. begin
  656.   S := @SourcePalette;
  657.   D := @DestinationPalette;
  658.   for I := 0 to 767 do
  659.   begin
  660.     if S^ < D^ then Inc(S^) else
  661.     if S^ > D^ then Dec(S^);
  662.     Inc(S);
  663.     Inc(D);
  664.   end;
  665. end;
  666.  
  667.  
  668. function DataByteGet(var Buffer; BufferOffset: Word): Byte;
  669. begin
  670.   Result := PByte(@Buffer + BufferOffset)^;
  671. end;
  672.  
  673. procedure DataBytePut(var Buffer; BufferOffset: Word; Value: Byte);
  674. begin
  675.   PByte(@Buffer + BufferOffset)^ := Value;
  676. end;
  677.  
  678. function DataWordGet(var Buffer; BufferOffset: Word): Word;
  679. begin
  680.   Result := PWord(@Buffer + BufferOffset)^;
  681. end;
  682.  
  683. procedure DataWordPut(var Buffer; BufferOffset: Word; Value: Word);
  684. begin
  685.   PWord(@Buffer + BufferOffset)^ := Value;
  686. end;
  687.  
  688. procedure DataMove(var Source, Destination; Count: Word; SourceOffset, DestinationOffset: Word);
  689. begin
  690.   Move((@Source + SourceOffset)^, (@Destination + DestinationOffset)^, Count);
  691. end;
  692.  
  693. procedure DataFill(var Buffer; Count: Word; Value: Byte; BufferOffset: Word);
  694. begin
  695.   FillChar((@Buffer + BufferOffset)^, Count, Value);
  696. end;
  697.  
  698. function DataIdentical(var Array1, Array2; Count: Word; Array1Offset, Array2Offset: Word): Boolean;
  699. begin
  700.   Result := CompareByte((@Array1 + Array1Offset)^, (@Array2 + Array2Offset)^, Count) = 0;
  701. end;
  702.  
  703. procedure DataAdd(var Buffer; Count: Word; Amount: Byte; BufferOffset: Word);
  704. var
  705.   I: Word;
  706.   PB: PByte;
  707. begin
  708.   PB := @Buffer + BufferOffset;
  709.   for I := 1 to Count do
  710.   begin
  711.     if PB^ > 0 then
  712.       Inc(PB^, Amount);
  713.     Inc(PB);
  714.   end;
  715. end;
  716.  
  717.  
  718. function SetInterrupt(Int: Byte; NewAddress: Pointer): Pointer;
  719. begin
  720.   Result := nil;
  721. end;
  722.  
  723.  
  724. procedure FadeClear;
  725. var
  726.   Pal1, Pal2: Pointer;
  727.   i: Integer;
  728. begin
  729.   GetMem(Pal1, 768);
  730.   GetMem(Pal2, 768);
  731.   Palette256Get(Pal1^);
  732.   for i := 0 to 32 do
  733.   begin
  734.     DataMove(Pal1^, Pal2^, 768, 0, 0);
  735.     Palette256Darken(Pal2^, 0, 255, i * 2, 0);
  736.     Palette256Set(Pal2^);
  737.   end;
  738.   FreeMem(Pal1, 768);
  739.   FreeMem(Pal2, 768);
  740. end;
  741.  
  742. procedure FadeTo(Pal: Pointer);
  743. var
  744.   Pal1: Pointer;
  745.   I: Integer;
  746. begin
  747.   GetMem(Pal1, 768);
  748.   Palette256Get(Pal1^);
  749.   for I := 0 to 32 do
  750.   begin
  751.     Palette256Transform(Pal1^, Pal^);
  752.     Palette256Transform(Pal1^, Pal^);
  753.     Palette256Set(Pal1^);
  754.     kos_delay(1);
  755.   end;
  756.   FreeMem(Pal1, 768);
  757. end;
  758.  
  759.  
  760. procedure DecompressRepByte(var InArray, OutArray; InArraySize: Word; var OutArraySize: Word);
  761. var
  762.   I, J: Word;
  763.   PIn : PByte;
  764.   POut: PByte;
  765. begin
  766.   I := 0;
  767.   PIn  := @InArray;
  768.   POut := @OutArray;
  769.  
  770.   while I < InArraySize do
  771.   begin
  772.     Inc(I);
  773.  
  774.     if PIn^ = 0 then
  775.     begin
  776.       Inc(PIn);
  777.       J := PIn^;
  778.       Inc(I, 2);
  779.       Inc(PIn);
  780.       Inc(OutArraySize, J);
  781.       while J > 0 do
  782.       begin
  783.         POut^ := PIn^;
  784.         Inc(POut);
  785.         Dec(J);
  786.       end;
  787.       Inc(PIn);
  788.     end else
  789.  
  790.     if PIn^ < 4 then
  791.     begin
  792.       J := PIn^;
  793.       Inc(I);
  794.       Inc(PIn);
  795.       Inc(OutArraySize, J);
  796.       while J > 0 do
  797.       begin
  798.         POut^ := PIn^;
  799.         Inc(POut);
  800.         Dec(J);
  801.       end;
  802.       Inc(PIn);
  803.     end else
  804.  
  805.     begin
  806.       POut^ := PIn^;
  807.       Inc(PIn);
  808.       Inc(POut);
  809.       Inc(OutArraySize);
  810.     end;
  811.   end;
  812. end;
  813.  
  814.  
  815. function MSMouseInArea(x1, y1, x2, y2: Integer): Boolean;
  816. begin
  817.   Result := False;
  818. end;
  819.  
  820. function MSMouseDriverExist: Boolean;
  821. begin
  822.   Result := True;
  823. end;
  824.  
  825. procedure MSMouseGetXY(var x, y: Integer);
  826. begin
  827. end;
  828.  
  829. function MSMouseButtonStatusGet: Word;
  830. begin
  831.   Result := 0;
  832. end;
  833.  
  834. function MSMouseButtonWasPressed(Button: Word; var x, y: Integer): Boolean;
  835. begin
  836.   Result := False;
  837. end;
  838.  
  839. function MSMouseButtonWasReleased(Button: Word; var x, y: Integer): Boolean;
  840. begin
  841.   Result := False;
  842. end;
  843.  
  844. procedure MSMouseSetXY(x, y: Integer);
  845. begin
  846. end;
  847.  
  848.  
  849. function GetInterrupt(Int: Byte): Pointer;
  850. begin
  851.   Result := nil;
  852. end;
  853.  
  854. procedure AssignFile(var AFile: File; AFileName: String);
  855. begin
  856.   Assign(AFile, IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0))) + AFileName);
  857. end;
  858.  
  859. function LastDosTick(): Longword;
  860. begin
  861.   Result := Round(kos_timecounter() * 0.182);
  862. end;
  863.  
  864.  
  865. end.
  866.