(* Copyright 2016, 2019, 2021-2023 Anton Krotov This file is part of fb2read. fb2read is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. fb2read is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with fb2read. If not, see . *) MODULE SysUtils; IMPORT K := KOSAPI, sys := SYSTEM, S := Strings; CONST L_BUTTON* = 0; FontH* = 16; FontW* = 8; TYPE ENTRY* = PROCEDURE; VAR (*darkColor*,*) lightColor*, winColor*, textColor*, btnColor*, btnTextColor*, borderColor*: INTEGER; PROCEDURE GetParam*(VAR Param: S.STRING); VAR adr : INTEGER; c : CHAR; i, max : INTEGER; BEGIN adr := K.GetCommandLine(); i := 0; max := LEN(Param) - 1; REPEAT sys.GET(adr, c); INC(adr); Param[i] := c; INC(i) UNTIL (c = 0X) OR (i = max); Param[i] := 0X; S.Trim(Param, 20X); S.Trim(Param, 22X) END GetParam; PROCEDURE Halt*; BEGIN K.sysfunc1(-1) END Halt; PROCEDURE Run*(program: S.STRING; param: INTEGER); TYPE info_struct = RECORD subfunc : INTEGER; flags : INTEGER; param : INTEGER; rsrvd1 : INTEGER; rsrvd2 : INTEGER; fname : ARRAY 1024 OF CHAR END; VAR info: info_struct; BEGIN info.subfunc := 7; info.flags := 0; info.param := param; info.rsrvd1 := 0; info.rsrvd2 := 0; COPY(program, info.fname); K.sysfunc2(70, sys.ADR(info)) END Run; PROCEDURE ErrorIf*(condition: BOOLEAN; code: INTEGER); VAR str, str2: S.STRING; BEGIN IF condition THEN str := "'FB2 ERROR: "; S.IntToString(code, str2); S.Append(str, str2); S.Append(str, "' -E"); Run("/sys/@notify", sys.ADR(str[0])); Halt END END ErrorIf; PROCEDURE MemError*(err: BOOLEAN); BEGIN ErrorIf(err, 13) END MemError; PROCEDURE MinMax*(VAR value: INTEGER; min, max: INTEGER); BEGIN value := MIN(MAX(value, min), max) END MinMax; PROCEDURE MousePos*(VAR X, Y: INTEGER); VAR res: INTEGER; BEGIN res := K.sysfunc2(37, 0); X := LSR(res, 16); Y := ORD(BITS(res) * {0..15}); END MousePos; PROCEDURE MouseVScroll*(): INTEGER; RETURN ASR(LSL(K.sysfunc2(37, 7), 16), 16) END MouseVScroll; PROCEDURE MouseStatus*(): SET; RETURN BITS(K.sysfunc2(37, 3)) END MouseStatus; PROCEDURE WindowRedrawStatus*(status: INTEGER); BEGIN K.sysfunc2(12, status) END WindowRedrawStatus; PROCEDURE DefineAndDrawWindow*(Left, Top, Width, Height, Color, Style: INTEGER; Caption: ARRAY OF CHAR); BEGIN K.sysfunc6(0, LSL(Left, 16) + Width, LSL(Top, 16) + Height, Color + LSL(Style, 24), 0, sys.ADR(Caption[0])) END DefineAndDrawWindow; PROCEDURE WaitForEvent*(): INTEGER; RETURN K.sysfunc1(10) END WaitForEvent; PROCEDURE CheckEvent*(): INTEGER; RETURN K.sysfunc1(11) END CheckEvent; PROCEDURE SetEventsMask*(mask: SET); BEGIN K.sysfunc2(40, ORD(mask)) END SetEventsMask; PROCEDURE GetKey* (): INTEGER; RETURN K.sysfunc1(2) END GetKey; PROCEDURE GetControlKeys* (): SET; RETURN BITS(K.sysfunc2(66, 3)) END GetControlKeys; PROCEDURE getKBState* (VAR shift, ctrl: BOOLEAN); VAR kbState: SET; BEGIN kbState := GetControlKeys(); shift := {0, 1} * kbState # {}; ctrl := {2, 3} * kbState # {}; END getKBState; PROCEDURE GetButtonCode*(): INTEGER; VAR res, button_code: INTEGER; BEGIN res := K.sysfunc1(17); IF ORD(BITS(res) * {0..7}) = 0 THEN button_code := LSR(res, 8) ELSE button_code := 0 END RETURN button_code END GetButtonCode; PROCEDURE OutText*(X, Y: INTEGER; Text: ARRAY OF CHAR; length: INTEGER; color: INTEGER); BEGIN K.sysfunc6(4, LSL(X, 16) + Y, LSL(3 * 16, 24) + color, sys.ADR(Text[0]), length, 0) END OutText; PROCEDURE GetWindowPos*(VAR Left, Top: INTEGER); VAR info: ARRAY 1024 OF CHAR; BEGIN K.sysfunc3(9, sys.ADR(info[0]), -1); sys.GET(sys.ADR(info[34]), Left); sys.GET(sys.ADR(info[38]), Top) END GetWindowPos; PROCEDURE GetWindowSize*(VAR Width, Height: INTEGER); VAR info: ARRAY 1024 OF CHAR; BEGIN K.sysfunc3(9, sys.ADR(info[0]), -1); sys.GET(sys.ADR(info[42]), Width); sys.GET(sys.ADR(info[46]), Height) END GetWindowSize; PROCEDURE SetWindowSize*(Width, Height: INTEGER); BEGIN K.sysfunc5(67, -1, -1, Width, Height) END SetWindowSize; PROCEDURE GetScreenSize*(VAR Width, Height: INTEGER); VAR res: INTEGER; BEGIN res := K.sysfunc1(14); Width := LSR(res, 16) + 1; Height := ORD(BITS(res) * {0..15}) + 1 END GetScreenSize; PROCEDURE GetScreenArea*(VAR X1, Y1, X2, Y2: INTEGER); VAR eax, ebx: INTEGER; BEGIN eax := K.sysfunc22(48, 5, ebx); X1 := LSR(eax, 16); Y1 := LSR(ebx, 16); X2 := ORD(BITS(eax) * {0..15}); Y2 := ORD(BITS(ebx) * {0..15}) END GetScreenArea; PROCEDURE SkinHeight*(): INTEGER; RETURN K.sysfunc2(48, 4) END SkinHeight; PROCEDURE DrawRect*(Left, Top, Width, Height, Color: INTEGER); BEGIN K.sysfunc4(13, LSL(Left, 16) + Width, LSL(Top, 16) + Height, Color) END DrawRect; PROCEDURE NewThread*(eip: ENTRY; stack: ARRAY OF CHAR): INTEGER; VAR entry: INTEGER; BEGIN sys.GET(sys.ADR(eip), entry) RETURN K.sysfunc4(51, 1, entry, sys.ADR(stack[0]) + LEN(stack)) END NewThread; PROCEDURE Pause*(time: INTEGER); BEGIN K.sysfunc2(5, time) END Pause; PROCEDURE GetThreadSlot*(PID: INTEGER): INTEGER; RETURN K.sysfunc3(18, 21, PID) END GetThreadSlot; PROCEDURE TerminateThreadId*(PID: INTEGER); BEGIN K.sysfunc3(18, 18, PID) END TerminateThreadId; PROCEDURE IsTerminated*(PID: INTEGER): BOOLEAN; RETURN GetThreadSlot(PID) = 0 END IsTerminated; PROCEDURE FocusWindow*(Slot: INTEGER); BEGIN K.sysfunc3(18, 3, Slot) END FocusWindow; PROCEDURE CreateButton*(id, Left, Top, Width, Height, Color: INTEGER; Caption: ARRAY OF CHAR); VAR X, Y, len: INTEGER; BEGIN len := LENGTH(Caption); K.sysfunc5(8, LSL(Left, 16) + Width, LSL(Top, 16) + Height, id, btnColor); X := Left + (Width - FontW * len) DIV 2; Y := Top + (Height - FontH) DIV 2 + 1; OutText(X, Y, Caption, len, btnTextColor) END CreateButton; PROCEDURE DrawLine* (x1, y1, x2, y2: INTEGER; color: INTEGER); BEGIN K.sysfunc4(38, x1*65536 + x2, y1*65536 + y2, color) END DrawLine; PROCEDURE Box*(Left, Top, Width, Height, BrushColor, PenColor: INTEGER); BEGIN K.sysfunc4(13, LSL(Left, 16) + Width, LSL(Top, 16) + Height, BrushColor); DrawLine(Left, Top, Left + Width, Top, PenColor); DrawLine(Left + Width, Top, Left + Width, Top + Height, PenColor); DrawLine(Left + Width, Top + Height, Left, Top + Height, PenColor); DrawLine(Left, Top + Height, Left, Top, PenColor); END Box; PROCEDURE LoadCursor*(cursor: INTEGER): INTEGER; RETURN K.sysfunc4(37, 4, cursor, 1) END LoadCursor; PROCEDURE SetCursor*(handle: INTEGER); BEGIN K.sysfunc3(37, 5, handle) END SetCursor; PROCEDURE DelCursor*(handle: INTEGER); BEGIN K.sysfunc3(37, 6, handle) END DelCursor; PROCEDURE DrawImage* (data, sizeX, sizeY, x, y: INTEGER); BEGIN K.sysfunc4(7, data, sizeX*65536 + sizeY, x*65536 + y) END DrawImage; PROCEDURE DrawText69* (x, y, color: INTEGER; text: ARRAY OF CHAR); BEGIN K.sysfunc6(4, x*65536 + y, color + LSL(080H, 24), sys.ADR(text[0]), 0, 0) END DrawText69; PROCEDURE PutPixel* (x, y, color: INTEGER); BEGIN K.sysfunc5(1, x, y, color, 0) END PutPixel; PROCEDURE GetSystemColors*; VAR buf: ARRAY 10 OF INTEGER; BEGIN ASSERT(LEN(buf) >= 10); K.sysfunc4(48, 3, sys.ADR(buf[0]), 40); (*darkColor := buf[2];*) lightColor := buf[3]; winColor := buf[5]; textColor := buf[8]; btnColor := buf[6]; btnTextColor := buf[7]; borderColor := buf[9]; END GetSystemColors; PROCEDURE RolledUp* (): BOOLEAN; VAR buffer: ARRAY 1024 OF BYTE; BEGIN K.sysfunc3(9, sys.ADR(buffer[0]), -1) RETURN ODD(LSR(buffer[70], 2)) END RolledUp; END SysUtils.