WebSVN – Kolibri OS – Diff – /programs/develop/cedit/SRC/Graph.ob07


﻿(*
    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, Lines, Languages;
 
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;
        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 Triangle* (canvas: tCanvas; x1, y1, x2, y2: INTEGER; orientation: BOOLEAN);
VAR
	i, a, b, d: INTEGER;
BEGIN
	d := ORD(orientation)*2 - 1;
	IF y1 = y2 THEN
		i := y1;
		a := MIN(x1, x2);
		b := MAX(x1, x2);
		WHILE a <= b DO
			HLine(canvas, i, a, b);
			INC(i, d);
			INC(a);
			DEC(b)
		END
	ELSIF x1 = x2 THEN
		i := x1;
		a := MIN(y1, y2);
		b := MAX(y1, y2);
		WHILE a <= b DO
			VLine(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, ecx: INTEGER;
    c: WCHAR;
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
                SYSTEM.GET(text + i*WCHAR_SIZE, c);
                IF ~Lines.isSpace(c) THEN
                	IF Languages.isDelim(c) THEN
                		ecx := LSL(28H + canvas.font.size, 24) + delimColor
                	ELSE
                		ecx := LSL(28H + canvas.font.size, 24) + canvas.textColor
                	END;
                    K.sysfunc6(4, x*65536 + y, ecx, SYSTEM.ADR(c), 1, canvas.bitmap - 8)
                END;
                INC(x, canvas.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 := 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.

Rev 9174	Rev 9193
1	(*	1	(*
2	Copyright 2021 Anton Krotov	2	Copyright 2021 Anton Krotov
3		3
4	This file is part of CEdit.	4	This file is part of CEdit.
5		5
6	CEdit is free software: you can redistribute it and/or modify	6	CEdit is free software: you can redistribute it and/or modify
7	it under the terms of the GNU General Public License as published by	7	it under the terms of the GNU General Public License as published by
8	the Free Software Foundation, either version 3 of the License, or	8	the Free Software Foundation, either version 3 of the License, or
9	(at your option) any later version.	9	(at your option) any later version.
10		10
11	CEdit is distributed in the hope that it will be useful,	11	CEdit is distributed in the hope that it will be useful,
12	but WITHOUT ANY WARRANTY; without even the implied warranty of	12	but WITHOUT ANY WARRANTY; without even the implied warranty of
13	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the	13	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14	GNU General Public License for more details.	14	GNU General Public License for more details.
15		15
16	You should have received a copy of the GNU General Public License	16	You should have received a copy of the GNU General Public License
17	along with CEdit. If not, see .	17	along with CEdit. If not, see .
18	*)	18	*)
19		19
20	MODULE Graph;	20	MODULE Graph;
21		21
22	IMPORT SYSTEM, K := KOSAPI, Lines;	22	IMPORT SYSTEM, K := KOSAPI, Lines, Languages;
23		23
24	CONST	24	CONST
25		25
26	modeCOPY = 0;	26	modeCOPY = 0;
27	modeNOT = 1;	27	modeNOT = 1;
28	modeXOR = 2;	28	modeXOR = 2;
29		29
30	triUp* = FALSE;	30	triUp* = FALSE;
31	triDown* = TRUE;	31	triDown* = TRUE;
32	triLeft* = FALSE;	32	triLeft* = FALSE;
33	triRight* = TRUE;	33	triRight* = TRUE;
34		34
35	TYPE	35	TYPE
36		36
37	tFont* = POINTER TO RECORD	37	tFont* = POINTER TO RECORD
38	handle*: INTEGER;	38	handle*: INTEGER;
39	height*: INTEGER;	39	height*: INTEGER;
40	width*: INTEGER;	40	width*: INTEGER;
41	size: INTEGER;	41	size: INTEGER;
42	name*: ARRAY 256 OF WCHAR	42	name*: ARRAY 256 OF WCHAR
43	END;	43	END;
44		44
45	tCanvas* = POINTER TO RECORD	45	tCanvas* = POINTER TO RECORD
46	bitmap: INTEGER;	46	bitmap: INTEGER;
47	width, height: INTEGER;	47	width, height: INTEGER;
48	color, backColor, textColor: INTEGER;	48	color, backColor, textColor: INTEGER;
49	font*: tFont;	49	font*: tFont;
50	mode: INTEGER	50	mode: INTEGER
51	END;	51	END;
52		52
53		53
54	PROCEDURE DrawCanvas* (canvas: tCanvas; x, y: INTEGER);	54	PROCEDURE DrawCanvas* (canvas: tCanvas; x, y: INTEGER);
55	BEGIN	55	BEGIN
56	K.sysfunc7(65, canvas.bitmap, canvas.width65536 + canvas.height, x65536 + y, 32, 0, 0);	56	K.sysfunc7(65, canvas.bitmap, canvas.width65536 + canvas.height, x65536 + y, 32, 0, 0);
57	END DrawCanvas;	57	END DrawCanvas;
58		58
59		59
60	PROCEDURE SetColor* (canvas: tCanvas; color: INTEGER);	60	PROCEDURE SetColor* (canvas: tCanvas; color: INTEGER);
61	BEGIN	61	BEGIN
62	canvas.color := color	62	canvas.color := color
63	END SetColor;	63	END SetColor;
64		64
65		65
66	PROCEDURE SetTextColor* (canvas: tCanvas; color: INTEGER);	66	PROCEDURE SetTextColor* (canvas: tCanvas; color: INTEGER);
67	BEGIN	67	BEGIN
68	canvas.textColor := color	68	canvas.textColor := color
69	END SetTextColor;	69	END SetTextColor;
70		70
71		71
72	PROCEDURE SetBkColor* (canvas: tCanvas; color: INTEGER);	72	PROCEDURE SetBkColor* (canvas: tCanvas; color: INTEGER);
73	BEGIN	73	BEGIN
74	canvas.backColor := color	74	canvas.backColor := color
75	END SetBkColor;	75	END SetBkColor;
76		76
77		77
78	PROCEDURE CreateFont* (height: INTEGER; name: ARRAY OF WCHAR; attr: SET): tFont;	78	PROCEDURE CreateFont* (height: INTEGER; name: ARRAY OF WCHAR; attr: SET): tFont;
79	VAR	79	VAR
80	font: tFont;	80	font: tFont;
81	BEGIN	81	BEGIN
82	NEW(font);	82	NEW(font);
83	font.size := MAX(MIN(height, 8), 1);	83	font.size := MAX(MIN(height, 8), 1);
84	font.width := font.size*8;	84	font.width := font.size*8;
85	font.height := font.size*16;	85	font.height := font.size*16;
86	DEC(font.size);	86	DEC(font.size);
87	font.name := name	87	font.name := name
88	RETURN font	88	RETURN font
89	END CreateFont;	89	END CreateFont;
90		90
91		91
92	PROCEDURE SetFont* (canvas: tCanvas; font: tFont);	92	PROCEDURE SetFont* (canvas: tCanvas; font: tFont);
93	BEGIN	93	BEGIN
94	canvas.font := font	94	canvas.font := font
95	END SetFont;	95	END SetFont;
96		96
97		97
98	PROCEDURE HLine* (canvas: tCanvas; y, x1, x2: INTEGER);	98	PROCEDURE HLine* (canvas: tCanvas; y, x1, x2: INTEGER);
99	VAR	99	VAR
100	X1, X2, i: INTEGER;	100	X1, X2, i: INTEGER;
101	ptr: INTEGER;	101	ptr: INTEGER;
102	color: INTEGER;	102	color: INTEGER;
103	BEGIN	103	BEGIN
104	X1 := MAX(MIN(x1, x2), 0);	104	X1 := MAX(MIN(x1, x2), 0);
105	X2 := MIN(MAX(x1, x2), canvas.width - 1);	105	X2 := MIN(MAX(x1, x2), canvas.width - 1);
106	IF (0 <= y) & (y < canvas.height) THEN	106	IF (0 <= y) & (y < canvas.height) THEN
107	color := canvas.color;	107	color := canvas.color;
108	ptr := canvas.bitmap + ycanvas.width4 + X1*4;	108	ptr := canvas.bitmap + ycanvas.width4 + X1*4;
109	FOR i := X1 TO X2 DO	109	FOR i := X1 TO X2 DO
110	SYSTEM.PUT32(ptr, color);	110	SYSTEM.PUT32(ptr, color);
111	INC(ptr, 4)	111	INC(ptr, 4)
112	END	112	END
113	END	113	END
114	END HLine;	114	END HLine;
115		115
116		116
117	PROCEDURE VLine* (canvas: tCanvas; x, y1, y2: INTEGER);	117	PROCEDURE VLine* (canvas: tCanvas; x, y1, y2: INTEGER);
118	VAR	118	VAR
119	Y1, Y2, i: INTEGER;	119	Y1, Y2, i: INTEGER;
120	ptr: INTEGER;	120	ptr: INTEGER;
121	color: INTEGER;	121	color: INTEGER;
122	BEGIN	122	BEGIN
123	Y1 := MAX(MIN(y1, y2), 0);	123	Y1 := MAX(MIN(y1, y2), 0);
124	Y2 := MIN(MAX(y1, y2), canvas.height - 1);	124	Y2 := MIN(MAX(y1, y2), canvas.height - 1);
125	IF (0 <= x) & (x < canvas.width) THEN	125	IF (0 <= x) & (x < canvas.width) THEN
126	color := canvas.color;	126	color := canvas.color;
127	ptr := canvas.bitmap + Y1canvas.width4 + x*4;	127	ptr := canvas.bitmap + Y1canvas.width4 + x*4;
128	FOR i := Y1 TO Y2 DO	128	FOR i := Y1 TO Y2 DO
129	IF canvas.mode = modeNOT THEN	129	IF canvas.mode = modeNOT THEN
130	SYSTEM.GET32(ptr, color);	130	SYSTEM.GET32(ptr, color);
131	color := ORD(-BITS(color)*{0..23})	131	color := ORD(-BITS(color)*{0..23})
132	ELSIF canvas.mode = modeXOR THEN	132	ELSIF canvas.mode = modeXOR THEN
133	SYSTEM.GET32(ptr, color);	133	SYSTEM.GET32(ptr, color);
134	color := ORD((BITS(color)/BITS(canvas.color))*{0..23})	134	color := ORD((BITS(color)/BITS(canvas.color))*{0..23})
135	END;	135	END;
136	SYSTEM.PUT32(ptr, color);	136	SYSTEM.PUT32(ptr, color);
137	INC(ptr, canvas.width*4)	137	INC(ptr, canvas.width*4)
138	END	138	END
139	END	139	END
140	END VLine;	140	END VLine;
141		141
142		142
143	PROCEDURE notVLine* (canvas: tCanvas; x, y1, y2: INTEGER);	143	PROCEDURE notVLine* (canvas: tCanvas; x, y1, y2: INTEGER);
144	BEGIN	144	BEGIN
145	IF (0 <= y1) & (y1 < canvas.height) & (0 <= y2) & (y2 < canvas.height) THEN	145	IF (0 <= y1) & (y1 < canvas.height) & (0 <= y2) & (y2 < canvas.height) THEN
146	canvas.mode := modeNOT;	146	canvas.mode := modeNOT;
147	VLine(canvas, x, y1, y2);	147	VLine(canvas, x, y1, y2);
148	canvas.mode := modeCOPY	148	canvas.mode := modeCOPY
149	END	149	END
150	END notVLine;	150	END notVLine;
151		151
152		152
153	PROCEDURE xorVLine* (canvas: tCanvas; x, y1, y2: INTEGER);	153	PROCEDURE xorVLine* (canvas: tCanvas; x, y1, y2: INTEGER);
154	BEGIN	154	BEGIN
155	IF (0 <= y1) & (y1 < canvas.height) & (0 <= y2) & (y2 < canvas.height) THEN	155	IF (0 <= y1) & (y1 < canvas.height) & (0 <= y2) & (y2 < canvas.height) THEN
156	canvas.mode := modeXOR;	156	canvas.mode := modeXOR;
157	SetColor(canvas, 0FF0000H);	157	SetColor(canvas, 0FF0000H);
158	VLine(canvas, x, y1, y2);	158	VLine(canvas, x, y1, y2);
159	canvas.mode := modeCOPY	159	canvas.mode := modeCOPY
160	END	160	END
161	END xorVLine;	161	END xorVLine;
162		162
163		163
164	PROCEDURE DLine* (canvas: tCanvas; x1, x2, y: INTEGER; k: INTEGER);	164	PROCEDURE DLine* (canvas: tCanvas; x1, x2, y: INTEGER; k: INTEGER);
165	VAR	165	VAR
166	ptr: INTEGER;	166	ptr: INTEGER;
167	color: INTEGER;	167	color: INTEGER;
168	d: INTEGER;	168	d: INTEGER;
169	BEGIN	169	BEGIN
170	color := canvas.color;	170	color := canvas.color;
171	ptr := canvas.bitmap + ycanvas.width4 + x1*4;	171	ptr := canvas.bitmap + ycanvas.width4 + x1*4;
172	IF k = -1 THEN	172	IF k = -1 THEN
173	d := canvas.width*4 + 4	173	d := canvas.width*4 + 4
174	ELSIF k = 1 THEN	174	ELSIF k = 1 THEN
175	d := 4 - canvas.width*4	175	d := 4 - canvas.width*4
176	END;	176	END;
177	WHILE x1 <= x2 DO	177	WHILE x1 <= x2 DO
178	SYSTEM.PUT32(ptr, color);	178	SYSTEM.PUT32(ptr, color);
179	INC(ptr, d);	179	INC(ptr, d);
180	INC(x1)	180	INC(x1)
181	END	181	END
182	END DLine;	182	END DLine;
183		183
184		184
185	PROCEDURE Triangle* (canvas: tCanvas; x1, y1, x2, y2: INTEGER; orientation: BOOLEAN);	185	PROCEDURE Triangle* (canvas: tCanvas; x1, y1, x2, y2: INTEGER; orientation: BOOLEAN);
186	VAR	186	VAR
187	i, a, b, d: INTEGER;	187	i, a, b, d: INTEGER;
188	BEGIN	188	BEGIN
189	d := ORD(orientation)*2 - 1;	189	d := ORD(orientation)*2 - 1;
190	IF y1 = y2 THEN	190	IF y1 = y2 THEN
191	i := y1;	191	i := y1;
192	a := MIN(x1, x2);	192	a := MIN(x1, x2);
193	b := MAX(x1, x2);	193	b := MAX(x1, x2);
194	WHILE a <= b DO	194	WHILE a <= b DO
195	HLine(canvas, i, a, b);	195	HLine(canvas, i, a, b);
196	INC(i, d);	196	INC(i, d);
197	INC(a);	197	INC(a);
198	DEC(b)	198	DEC(b)
199	END	199	END
200	ELSIF x1 = x2 THEN	200	ELSIF x1 = x2 THEN
201	i := x1;	201	i := x1;
202	a := MIN(y1, y2);	202	a := MIN(y1, y2);
203	b := MAX(y1, y2);	203	b := MAX(y1, y2);
204	WHILE a <= b DO	204	WHILE a <= b DO
205	VLine(canvas, i, a, b);	205	VLine(canvas, i, a, b);
206	INC(i, d);	206	INC(i, d);
207	INC(a);	207	INC(a);
208	DEC(b)	208	DEC(b)
209	END	209	END
210	END	210	END
211	END Triangle;	211	END Triangle;
212		212
213		213
214	PROCEDURE FillRect* (canvas: tCanvas; left, top, right, bottom: INTEGER);	214	PROCEDURE FillRect* (canvas: tCanvas; left, top, right, bottom: INTEGER);
215	VAR	215	VAR
216	y: INTEGER;	216	y: INTEGER;
217	BEGIN	217	BEGIN
218	FOR y := top TO bottom DO	218	FOR y := top TO bottom DO
219	HLine(canvas, y, left, right)	219	HLine(canvas, y, left, right)
220	END	220	END
221	END FillRect;	221	END FillRect;
222		222
223		223
224	PROCEDURE Rect* (canvas: tCanvas; left, top, right, bottom: INTEGER);	224	PROCEDURE Rect* (canvas: tCanvas; left, top, right, bottom: INTEGER);
225	BEGIN	225	BEGIN
226	HLine(canvas, top, left, right);	226	HLine(canvas, top, left, right);
227	HLine(canvas, bottom, left, right);	227	HLine(canvas, bottom, left, right);
228	VLine(canvas, left, top, bottom);	228	VLine(canvas, left, top, bottom);
229	VLine(canvas, right, top, bottom)	229	VLine(canvas, right, top, bottom)
230	END Rect;	230	END Rect;
231		231
232		232
233	PROCEDURE clear* (canvas: tCanvas);	233	PROCEDURE clear* (canvas: tCanvas);
234	VAR	234	VAR
235	ptr, ptr2, w, i: INTEGER;	235	ptr, ptr2, w, i: INTEGER;
236	BEGIN	236	BEGIN
237	HLine(canvas, 0, 0, canvas.width - 1);	237	HLine(canvas, 0, 0, canvas.width - 1);
238	w := canvas.width*4;	238	w := canvas.width*4;
239	ptr := canvas.bitmap;	239	ptr := canvas.bitmap;
240	ptr2 := ptr;	240	ptr2 := ptr;
241	i := canvas.height - 1;	241	i := canvas.height - 1;
242	WHILE i > 0 DO	242	WHILE i > 0 DO
243	INC(ptr2, w);	243	INC(ptr2, w);
244	SYSTEM.MOVE(ptr, ptr2, w);	244	SYSTEM.MOVE(ptr, ptr2, w);
245	DEC(i)	245	DEC(i)
246	END	246	END
247	END clear;	247	END clear;
248		248
249		249
250	PROCEDURE TextOut* (canvas: tCanvas; x, y: INTEGER; text: INTEGER; n: INTEGER);	250	PROCEDURE TextOut* (canvas: tCanvas; x, y: INTEGER; text: INTEGER; n: INTEGER; delimColor: INTEGER);
251	CONST	251	CONST
252	WCHAR_SIZE = 2;	252	WCHAR_SIZE = 2;
253	VAR	253	VAR
254	color, i: INTEGER;	254	color, i, ecx: INTEGER;
255	c: WCHAR;	255	c: WCHAR;
256	BEGIN	256	BEGIN
257	IF (0 <= y) & (y <= canvas.height - canvas.font.height - 1) THEN	257	IF (0 <= y) & (y <= canvas.height - canvas.font.height - 1) THEN
258	IF x < 0 THEN	258	IF x < 0 THEN
259	i := -(x DIV canvas.font.width);	259	i := -(x DIV canvas.font.width);
260	INC(x, i*canvas.font.width);	260	INC(x, i*canvas.font.width);
261	DEC(n, i)	261	DEC(n, i)
262	ELSE	262	ELSE
263	i := 0	263	i := 0
264	END;	264	END;
265	IF n > 0 THEN	265	IF n > 0 THEN
266	n := MAX(MIN(n, (canvas.width - x) DIV canvas.font.width), 0);	266	n := MAX(MIN(n, (canvas.width - x) DIV canvas.font.width), 0);
267	color := canvas.color;	267	color := canvas.color;
268	canvas.color := canvas.backColor;	268	canvas.color := canvas.backColor;
269	FillRect(canvas, x, y, x + n*canvas.font.width, y + canvas.font.height);	269	FillRect(canvas, x, y, x + n*canvas.font.width, y + canvas.font.height);
270	canvas.color := color;	270	canvas.color := color;
271	WHILE n > 0 DO	271	WHILE n > 0 DO
272	SYSTEM.GET(text + i*WCHAR_SIZE, c);	272	SYSTEM.GET(text + i*WCHAR_SIZE, c);
273	IF ~Lines.isSpace(c) THEN	273	IF ~Lines.isSpace(c) THEN
-		274	IF Languages.isDelim(c) THEN
-		275	ecx := LSL(28H + canvas.font.size, 24) + delimColor
-		276	ELSE
-		277	ecx := LSL(28H + canvas.font.size, 24) + canvas.textColor
-		278	END;
274	K.sysfunc6(4, x*65536 + y, LSL(28H + canvas.font.size, 24) + canvas.textColor, SYSTEM.ADR(c), 1, canvas.bitmap - 8)	279	K.sysfunc6(4, x*65536 + y, ecx, SYSTEM.ADR(c), 1, canvas.bitmap - 8)
275	END;	280	END;
276	INC(x, canvas.font.width);	281	INC(x, canvas.font.width);
277	INC(i);	282	INC(i);
278	DEC(n)	283	DEC(n)
279	END	284	END
280	(K.sysfunc6(4, x65536 + y, LSL(28H + canvas.font.size, 24) + canvas.textColor, text + iWCHAR_SIZE, n, canvas.bitmap - 8))	-
281	END	285	END
282	END	286	END
283	END TextOut;	287	END TextOut;
284		288
285		289
286	PROCEDURE TextOut2* (canvas: tCanvas; x, y: INTEGER; text: ARRAY OF WCHAR; n: INTEGER);	290	PROCEDURE TextOut2* (canvas: tCanvas; x, y: INTEGER; text: ARRAY OF WCHAR; n: INTEGER);
287	BEGIN	291	BEGIN
288	TextOut(canvas, x, y, SYSTEM.ADR(text[0]), n)	292	TextOut(canvas, x, y, SYSTEM.ADR(text[0]), n, canvas.textColor)
289	END TextOut2;	293	END TextOut2;
290		294
291		295
292	PROCEDURE CreateCanvas* (width, height: INTEGER): tCanvas;	296	PROCEDURE CreateCanvas* (width, height: INTEGER): tCanvas;
293	VAR	297	VAR
294	canvas: tCanvas;	298	canvas: tCanvas;
295	BEGIN	299	BEGIN
296	NEW(canvas);	300	NEW(canvas);
297	canvas.bitmap := K.malloc(widthheight4 + 8);	301	canvas.bitmap := K.malloc(widthheight4 + 8);
298	ASSERT(canvas.bitmap # 0);	302	ASSERT(canvas.bitmap # 0);
299	SYSTEM.PUT32(canvas.bitmap, width);	303	SYSTEM.PUT32(canvas.bitmap, width);
300	SYSTEM.PUT32(canvas.bitmap + 4, height);	304	SYSTEM.PUT32(canvas.bitmap + 4, height);
301	INC(canvas.bitmap, 8);	305	INC(canvas.bitmap, 8);
302	canvas.width := width;	306	canvas.width := width;
303	canvas.height := height;	307	canvas.height := height;
304	canvas.mode := modeCOPY	308	canvas.mode := modeCOPY
305	RETURN canvas	309	RETURN canvas
306	END CreateCanvas;	310	END CreateCanvas;
307		311
308		312
309	PROCEDURE destroy* (VAR canvas: tCanvas);	313	PROCEDURE destroy* (VAR canvas: tCanvas);
310	BEGIN	314	BEGIN
311	IF canvas # NIL THEN	315	IF canvas # NIL THEN
312	canvas.bitmap := K.free(canvas.bitmap);	316	canvas.bitmap := K.free(canvas.bitmap);
313	DISPOSE(canvas)	317	DISPOSE(canvas)
314	END	318	END
315	END destroy;	319	END destroy;
316		320
317		321
318	END Graph.	322	END Graph.

Subversion Repositories Kolibri OS

(root)/programs/develop/cedit/SRC/Graph.ob07 – Rev 9174 → 9193