Subversion Repositories Kolibri OS

(*

    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 .

*)

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.