(* Copyright 2021 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, K := KOSAPI; CONST modeCOPY = 0; modeNOT = 1; modeXOR = 2; TYPE tFont* = POINTER TO RECORD handle*: INTEGER; height*: INTEGER; width*: INTEGER; size: 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; PROCEDURE DrawCanvas* (canvas: tCanvas; x, y: INTEGER); BEGIN K.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* (height: INTEGER; name: ARRAY OF WCHAR; attr: SET): tFont; VAR font: tFont; BEGIN NEW(font); font.size := MAX(MIN(height, 8), 1); font.width := font.size*8; font.height := font.size*16; DEC(font.size); 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 + y*canvas.width*4 + X1*4; 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 + Y1*canvas.width*4 + x*4; 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 color := canvas.color; ptr := canvas.bitmap + y*canvas.width*4 + x1*4; IF k = -1 THEN d := canvas.width*4 + 4 ELSIF k = 1 THEN d := 4 - canvas.width*4 END; WHILE x1 <= x2 DO SYSTEM.PUT32(ptr, color); INC(ptr, d); INC(x1) END END DLine; 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); CONST WCHAR_SIZE = 2; VAR color, i: INTEGER; BEGIN IF (0 <= y) & (y <= canvas.height - canvas.font.height - 1) THEN IF x < 0 THEN i := -(x DIV canvas.font.width); INC(x, i*canvas.font.width); DEC(n, i) ELSE i := 0 END; IF n > 0 THEN n := MAX(MIN(n, (canvas.width - x) DIV canvas.font.width), 0); color := canvas.color; canvas.color := canvas.backColor; FillRect(canvas, x, y, x + n*canvas.font.width, y + canvas.font.height); canvas.color := color; (* WHILE n > 0 DO K.sysfunc6(4, x*65536 + y, LSL(28H + canvas.font.size, 24) + canvas.textColor, text + i*WCHAR_SIZE, 1, canvas.bitmap - 8); INC(x, canvas.font.width); INC(i); DEC(n) END*) K.sysfunc6(4, x*65536 + y, LSL(28H + canvas.font.size, 24) + canvas.textColor, text + i*WCHAR_SIZE, n, canvas.bitmap - 8) 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) END TextOut2; PROCEDURE CreateCanvas* (width, height: INTEGER): tCanvas; VAR canvas: tCanvas; BEGIN NEW(canvas); canvas.bitmap := K.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 := K.free(canvas.bitmap); DISPOSE(canvas) END END destroy; END Graph.