(*
Copyright 2016-2020, 2022, 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 <http://www.gnu.org/licenses/>.
*)
MODULE Graph;
IMPORT K := KOSAPI, sys := SYSTEM, SU := SysUtils;
TYPE
tBuffer* = POINTER TO RECORD Width*, Height*, bitmap*, Color: INTEGER END;
VAR
Buffer*, BackImg*: tBuffer;
Width0, Height0: INTEGER;
PROCEDURE [stdcall-, "rasterworks.obj", ""] drawText (canvas, x, y, string, charQuantity, fontColor, params: INTEGER): INTEGER; END;
PROCEDURE Destroy*(VAR Buffer: tBuffer);
BEGIN
IF Buffer # NIL THEN
IF Buffer.bitmap # 0 THEN
DEC(Buffer.bitmap, 8);
Buffer.bitmap := K.free(Buffer.bitmap)
END;
DISPOSE(Buffer)
END
END Destroy;
PROCEDURE Create*(Width, Height: INTEGER): tBuffer;
VAR res: tBuffer;
BEGIN
NEW(res);
res.bitmap := K.malloc(Width * Height * 4 + 8);
sys.PUT(res.bitmap, Width);
sys.PUT(res.bitmap + 4, Height);
res.Width := Width;
res.Height := Height;
INC(res.bitmap, 8);
RETURN res
END Create;
PROCEDURE getRGB* (color: INTEGER; VAR r, g, b: BYTE);
BEGIN
b := color MOD 256;
g := color DIV 256 MOD 256;
r := color DIV 65536 MOD 256
END getRGB;
PROCEDURE Fill* (Buffer: tBuffer; Color: INTEGER);
VAR p, n, i: INTEGER;
BEGIN
p := Buffer.bitmap;
n := Buffer.Width * Buffer.Height;
FOR i := 1 TO n DO
sys.PUT(p, Color);
INC(p, 4)
END
END Fill;
PROCEDURE HLine*(X1, X2, Y: INTEGER);
VAR
p1, p2, i, color: INTEGER;
BEGIN
IF X1 <= X2 THEN
SU.MinMax(Y, 0, Buffer.Height - 1);
color := Buffer.Color;
p1 := Buffer.bitmap + 4 * (Y * Buffer.Width + X1);
p2 := p1 + (X2 - X1) * 4;
FOR i := p1 TO p2 BY 4 DO
sys.PUT(i, color)
END
END
END HLine;
PROCEDURE HLineNotXOR (X1, X2, Y, color: INTEGER);
VAR
p1, p2, i: INTEGER;
pix: SET;
BEGIN
IF X1 <= X2 THEN
SU.MinMax(Y, 0, Buffer.Height - 1);
p1 := Buffer.bitmap + 4 * (Y * Buffer.Width + X1);
p2 := p1 + (X2 - X1) * 4;
FOR i := p1 TO p2 BY 4 DO
sys.GET(i, pix);
pix := (-pix) / BITS(color) - {24..31};
sys.PUT(i, pix)
END
END
END HLineNotXOR;
PROCEDURE VLine*(X, Y1, Y2: INTEGER);
VAR p1, p2, line_size, color: INTEGER;
BEGIN
ASSERT(Y1 <= Y2);
SU.MinMax(Y1, 0, Buffer.Height - 1);
SU.MinMax(Y2, 0, Buffer.Height - 1);
color := Buffer.Color;
line_size := Buffer.Width * 4;
p1 := Buffer.bitmap + line_size * Y1 + 4 * X;
p2 := p1 + (Y2 - Y1) * line_size;
WHILE p1 <= p2 DO
sys.PUT(p1, color);
p1 := p1 + line_size
END
END VLine;
PROCEDURE Box(X1, Y1, X2, Y2: INTEGER);
VAR y: INTEGER;
BEGIN
FOR y := Y1 TO Y2 DO
HLine(X1, X2, y)
END
END Box;
PROCEDURE BoxNotXOR* (X1, Y1, X2, Y2, color: INTEGER);
VAR y: INTEGER;
BEGIN
FOR y := Y1 TO Y2 DO
HLineNotXOR(X1, X2, y, color)
END
END BoxNotXOR;
PROCEDURE SetColor*(color: INTEGER);
BEGIN
Buffer.Color := color
END SetColor;
PROCEDURE GetColor*(): INTEGER;
RETURN Buffer.Color
END GetColor;
PROCEDURE TextOut*(X, Y: INTEGER; Text: INTEGER; length: INTEGER; size, params: INTEGER);
BEGIN
drawText(Buffer.bitmap - 8, X, Y, Text, length, 0FF000000H + Buffer.Color, params)
END TextOut;
PROCEDURE InitSize* (Width, Height: INTEGER);
BEGIN
Width0 := Width;
Height0 := Height;
END InitSize;
PROCEDURE Image* (X, Y, sizeX, sizeY, ptr, Ymin, Ymax: INTEGER);
VAR
y: INTEGER;
BEGIN
ASSERT(sizeX <= Buffer.Width);
FOR y := 0 TO sizeY - 1 DO
IF (Ymin <= Y) & (Y < Ymax) THEN
sys.MOVE(ptr + sizeX*4*y, Buffer.bitmap + (Buffer.Width*Y + X)*4, sizeX*4)
END;
INC(Y)
END
END Image;
PROCEDURE Image2(Buffer: tBuffer; X, Y, sizeX, sizeY, ptr: INTEGER);
VAR x, y, pix, left: INTEGER;
BEGIN
left := X;
FOR y := 0 TO sizeY - 1 DO
X := left;
FOR x := 0 TO sizeX - 1 DO
sys.GET32(ptr + (y*sizeX + x)*4, pix);
IF (X < Buffer.Width) & (Y < Buffer.Height) THEN
sys.PUT32(Buffer.bitmap + (Buffer.Width*Y + X)*4, pix)
END;
INC(X)
END;
INC(Y)
END
END Image2;
PROCEDURE BackImage*(sizeX, sizeY, ptr: INTEGER);
VAR x, y: INTEGER;
BEGIN
IF ptr # 0 THEN
y := 0;
WHILE y < BackImg.Height DO
x := 0;
WHILE x < BackImg.Width DO
Image2(BackImg, x, y, sizeX, sizeY, ptr);
INC(x, sizeX)
END;
INC(y, sizeY)
END
END
END BackImage;
PROCEDURE Copy*(src, dst: tBuffer; y_src, lines, y_dst: INTEGER);
BEGIN
sys.MOVE(src.bitmap + y_src * src.Width * 4, dst.bitmap + y_dst * dst.Width * 4, lines * dst.Width * 4)
END Copy;
PROCEDURE Draw*(X, Y: INTEGER);
BEGIN
K.sysfunc7(65, Buffer.bitmap, Buffer.Width * 65536 + Buffer.Height, X * 65536 + Y, 32, 0, 0)
END Draw;
PROCEDURE Rect*(X1, Y1, X2, Y2: INTEGER);
BEGIN
VLine(X1, Y1, Y2);
VLine(X2, Y1, Y2);
HLine(X1, X2, Y1);
HLine(X1, X2, Y2)
END Rect;
PROCEDURE Progress*(value: REAL);
VAR W4, W2, H2: INTEGER;
BEGIN
W2 := Width0 DIV 2;
W4 := W2 DIV 2;
H2 := Height0 DIV 2;
Fill(Buffer, 0FFFFFFH);
SetColor(0);
Rect(W4, H2 - 50, 3 * W4, H2 + 30);
TextOut(W2 - 10 * 8 DIV 2, H2 - 50 + 15, sys.SADR("Loading..."), 10, 1, 16 + 0 + LSL(3, 16) + LSL(128, 24));
SetColor(000000FFH);
Box(W4 + 10, H2, W4 + 10 + FLOOR( FLT(W2 - 20) * value ), H2 + 15);
END Progress;
PROCEDURE _resize (Buffer: tBuffer; Width, Height: INTEGER);
BEGIN
IF Buffer.bitmap # 0 THEN
DEC(Buffer.bitmap, 8)
END;
Buffer.bitmap := K.realloc(Buffer.bitmap, Width * Height * 4 + 8);
SU.MemError(Buffer.bitmap = 0);
sys.PUT(Buffer.bitmap, Width);
sys.PUT(Buffer.bitmap + 4, Height);
INC(Buffer.bitmap, 8);
Buffer.Width := Width;
Buffer.Height := Height
END _resize;
PROCEDURE Resize*(Width, Height: INTEGER);
BEGIN
_resize(Buffer, Width, Height);
IF BackImg # NIL THEN
_resize(BackImg, Width, Height)
END
END Resize;
PROCEDURE Init;
VAR Width, Height: INTEGER;
BEGIN
BackImg := NIL;
NEW(Buffer);
SU.GetScreenSize(Width, Height);
Resize(Width, Height)
END Init;
PROCEDURE CreateBackImg*;
BEGIN
IF BackImg = NIL THEN
BackImg := Create(Buffer.Width, Buffer.Height)
END
END CreateBackImg;
PROCEDURE DestroyBackImg*;
BEGIN
Destroy(BackImg)
END DestroyBackImg;
BEGIN
Init
END Graph.