(*
Copyright 2021, 2022 Anton Krotov
This file is part of CEdit.
CEdit 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.
CEdit 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 CEdit. If not, see <http://www.gnu.org/licenses/>.
*)
MODULE Graph;
IMPORT SYSTEM, KOSAPI, Lines, Languages, E := Encodings;
CONST
modeCOPY = 0;
modeNOT = 1;
modeXOR = 2;
triUp* = FALSE;
triDown* = TRUE;
triLeft* = FALSE;
triRight* = TRUE;
TYPE
tFont* = POINTER TO RECORD
handle*: INTEGER;
height*: INTEGER;
width*: INTEGER;
size: INTEGER;
flags: INTEGER;
name*: ARRAY 256 OF WCHAR
END;
tCanvas* = POINTER TO RECORD
bitmap: INTEGER;
width*, height*: INTEGER;
color, backColor, textColor: INTEGER;
font*: tFont;
mode: INTEGER
END;
VAR
fonts*: ARRAY 3 OF tFont;
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 DrawCanvas* (canvas: tCanvas; x, y: INTEGER);
BEGIN
KOSAPI.sysfunc7(65, canvas.bitmap, canvas.width*65536 + canvas.height, x*65536 + y, 32, 0, 0)
END DrawCanvas;
PROCEDURE SetColor* (canvas: tCanvas; color: INTEGER);
BEGIN
canvas.color := color
END SetColor;
PROCEDURE SetTextColor* (canvas: tCanvas; color: INTEGER);
BEGIN
canvas.textColor := color
END SetTextColor;
PROCEDURE SetBkColor* (canvas: tCanvas; color: INTEGER);
BEGIN
canvas.backColor := color
END SetBkColor;
PROCEDURE CreateFont (size: INTEGER; name: ARRAY OF WCHAR; attr: SET): tFont;
VAR
font: tFont;
BEGIN
ASSERT(size IN {0, 1, 2});
NEW(font);
font.size := size;
IF size = 0 THEN
font.width := 6;
font.height := 9;
font.flags := 08000000H
ELSE
font.width := size*8;
font.height := size*16;
IF size = 1 THEN
font.flags := 28000000H
ELSIF size = 2 THEN
font.flags := 29000000H
END
END;
font.name := name
RETURN font
END CreateFont;
PROCEDURE SetFont* (canvas: tCanvas; font: tFont);
BEGIN
canvas.font := font
END SetFont;
PROCEDURE HLine* (canvas: tCanvas; y, x1, x2: INTEGER);
VAR
X1, X2, i: INTEGER;
ptr: INTEGER;
color: INTEGER;
BEGIN
X1 := MAX(MIN(x1, x2), 0);
X2 := MIN(MAX(x1, x2), canvas.width - 1);
IF (0 <= y) & (y < canvas.height) THEN
color := canvas.color;
ptr := canvas.bitmap + 4*(y*canvas.width + X1);
FOR i := X1 TO X2 DO
SYSTEM.PUT32(ptr, color);
INC(ptr, 4)
END
END
END HLine;
PROCEDURE VLine* (canvas: tCanvas; x, y1, y2: INTEGER);
VAR
Y1, Y2, i: INTEGER;
ptr: INTEGER;
color: INTEGER;
BEGIN
Y1 := MAX(MIN(y1, y2), 0);
Y2 := MIN(MAX(y1, y2), canvas.height - 1);
IF (0 <= x) & (x < canvas.width) THEN
color := canvas.color;
ptr := canvas.bitmap + 4*(Y1*canvas.width + x);
FOR i := Y1 TO Y2 DO
IF canvas.mode = modeNOT THEN
SYSTEM.GET32(ptr, color);
color := ORD(-BITS(color)*{0..23})
ELSIF canvas.mode = modeXOR THEN
SYSTEM.GET32(ptr, color);
color := ORD((BITS(color)/BITS(canvas.color))*{0..23})
END;
SYSTEM.PUT32(ptr, color);
INC(ptr, canvas.width*4)
END
END
END VLine;
PROCEDURE notVLine* (canvas: tCanvas; x, y1, y2: INTEGER);
BEGIN
IF (0 <= y1) & (y1 < canvas.height) & (0 <= y2) & (y2 < canvas.height) THEN
canvas.mode := modeNOT;
VLine(canvas, x, y1, y2);
canvas.mode := modeCOPY
END
END notVLine;
PROCEDURE xorVLine* (canvas: tCanvas; x, y1, y2: INTEGER);
BEGIN
IF (0 <= y1) & (y1 < canvas.height) & (0 <= y2) & (y2 < canvas.height) THEN
canvas.mode := modeXOR;
SetColor(canvas, 0FF0000H);
VLine(canvas, x, y1, y2);
canvas.mode := modeCOPY
END
END xorVLine;
PROCEDURE DLine* (canvas: tCanvas; x1, x2, y: INTEGER; k: INTEGER);
VAR
ptr: INTEGER;
color: INTEGER;
d: INTEGER;
BEGIN
ASSERT(ABS(k) = 1);
color := canvas.color;
ptr := canvas.bitmap + 4*(y*canvas.width + x1);
d := 4*(1 - canvas.width*k);
WHILE x1 <= x2 DO
SYSTEM.PUT32(ptr, color);
INC(ptr, d);
INC(x1)
END
END DLine;
PROCEDURE Triangle* (canvas: tCanvas; x1, y1, x2, y2: INTEGER; orientation: BOOLEAN);
VAR
i, a, b, d: INTEGER;
line: PROCEDURE (canvas: tCanvas; c, c1, c2: INTEGER);
BEGIN
line := NIL;
d := ORD(orientation)*2 - 1;
IF y1 = y2 THEN
i := y1;
a := MIN(x1, x2);
b := MAX(x1, x2);
line := HLine
ELSIF x1 = x2 THEN
i := x1;
a := MIN(y1, y2);
b := MAX(y1, y2);
line := VLine
END;
IF line # NIL THEN
WHILE a <= b DO
line(canvas, i, a, b);
INC(i, d);
INC(a);
DEC(b)
END
END
END Triangle;
PROCEDURE FillRect* (canvas: tCanvas; left, top, right, bottom: INTEGER);
VAR
y: INTEGER;
BEGIN
FOR y := top TO bottom DO
HLine(canvas, y, left, right)
END
END FillRect;
PROCEDURE Rect* (canvas: tCanvas; left, top, right, bottom: INTEGER);
BEGIN
HLine(canvas, top, left, right);
HLine(canvas, bottom, left, right);
VLine(canvas, left, top, bottom);
VLine(canvas, right, top, bottom)
END Rect;
PROCEDURE clear* (canvas: tCanvas);
VAR
ptr, ptr2, w, i: INTEGER;
BEGIN
HLine(canvas, 0, 0, canvas.width - 1);
w := canvas.width*4;
ptr := canvas.bitmap;
ptr2 := ptr;
i := canvas.height - 1;
WHILE i > 0 DO
INC(ptr2, w);
SYSTEM.MOVE(ptr, ptr2, w);
DEC(i)
END
END clear;
PROCEDURE TextOut* (canvas: tCanvas; x, y: INTEGER; text: INTEGER; n: INTEGER; delimColor: INTEGER);
CONST
WCHAR_SIZE = 2;
VAR
color, i, ch: INTEGER;
font: tFont;
c: WCHAR;
BEGIN
font := canvas.font;
IF (0 <= y) & (y <= canvas.height - font.height - 1) THEN
IF x < 0 THEN
i := -(x DIV font.width);
INC(x, i*font.width);
DEC(n, i)
ELSE
i := 0
END;
IF n > 0 THEN
n := MAX(MIN(n, (canvas.width - x) DIV font.width), 0);
color := canvas.color;
canvas.color := canvas.backColor;
FillRect(canvas, x, y, x + n*font.width, y + font.height);
canvas.color := color;
WHILE n > 0 DO
SYSTEM.GET(text + i*WCHAR_SIZE, c);
IF ~Lines.isSpace(c) THEN
IF Languages.isDelim(c) THEN
color := delimColor
ELSE
color := canvas.textColor
END;
IF c = Lines.NUL THEN
c := 0X
END;
IF font = fonts[0] THEN
ch := E.UNI[ORD(c), E.CP866];
IF ch = E.UNDEF THEN
c := "?"
ELSE
c := WCHR(ch)
END
END;
KOSAPI.sysfunc6(4, x*65536 + y, font.flags + color, SYSTEM.ADR(c), 1, canvas.bitmap - 8)
END;
INC(x, font.width);
INC(i);
DEC(n)
END
END
END
END TextOut;
PROCEDURE TextOut2* (canvas: tCanvas; x, y: INTEGER; text: ARRAY OF WCHAR; n: INTEGER);
BEGIN
TextOut(canvas, x, y, SYSTEM.ADR(text[0]), n, canvas.textColor)
END TextOut2;
PROCEDURE CreateCanvas* (width, height: INTEGER): tCanvas;
VAR
canvas: tCanvas;
BEGIN
NEW(canvas);
canvas.bitmap := KOSAPI.malloc(width*height*4 + 8);
ASSERT(canvas.bitmap # 0);
SYSTEM.PUT32(canvas.bitmap, width);
SYSTEM.PUT32(canvas.bitmap + 4, height);
INC(canvas.bitmap, 8);
canvas.width := width;
canvas.height := height;
canvas.mode := modeCOPY
RETURN canvas
END CreateCanvas;
PROCEDURE destroy* (VAR canvas: tCanvas);
BEGIN
IF canvas # NIL THEN
canvas.bitmap := KOSAPI.free(canvas.bitmap - 8);
DISPOSE(canvas)
END
END destroy;
BEGIN
fonts[0] := CreateFont(0, "", {});
fonts[1] := CreateFont(1, "", {});
fonts[2] := CreateFont(2, "", {});
END Graph.