kolibrios-fun/programs/develop/cedit/SRC/Graph.ob07

(*
    Copyright 2021-2023 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*, sizeY: 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
	canvas.mode := modeNOT;
	VLine(canvas, x, y1, y2);
	canvas.mode := modeCOPY
END notVLine;


PROCEDURE xorVLine* (canvas: tCanvas; x, y1, y2: INTEGER);
BEGIN
	canvas.mode := modeXOR;
	SetColor(canvas, 0FF0000H);
	VLine(canvas, x, y1, y2);
	canvas.mode := modeCOPY
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.sizeY - 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: INTEGER;
	font: tFont;
	c: WCHAR;
BEGIN
	font := canvas.font;
	IF (0 <= y) & (y <= canvas.sizeY - 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 - 1, 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
						c := WCHR(E.UNI[ORD(c), E.CP866])
					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.sizeY := 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.