0,0 → 1,280 |
(* |
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 <http://www.gnu.org/licenses/>. |
*) |
|
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. |