text:
Oberon/ETH Oberon/2.3.7/Display3.Mod

(* ETH Oberon, Copyright 1990-2003 Computer Systems Institute, ETH Zurich, CH-8092 Zurich. Refer to the license.txt file provided with this distribution. *) MODULE Display3;	(** portable *)	(** jm 17.1.95 / tk 7.12.95*) (** Module Display3 implements the clipped graphic primitives used by the Gadget system. It has a twin module called Printer3 that implements the same primitives for the printer. **) (* 	jm 11.2.93 - mask msg 	jm 15.4.93  fixed center string 	kr 2.6.93  fixed Poly with patterns 	jm 17.09.93 10:46:54 - fixed shift mask 	25.3.94 - fixed problem with Subtract (bug surfaces after 2 years only) 	29.3.94 - Added Pict and ReplPict 	15.11.94 - changed definition of String and CenterString 		- added selectpat (from Effects) 		- removed MakeMask 	12.12.94 - fixed clipping problem with lines (was a stupid mistake from Rege). 	6.1.95 - removed all the rubbish from rege 		- implemented brushes 			Lines (supports width, patterns) 			Poly (supports width, patterns, filled) 			Circle (supports width, patterns, filled) 			Ellipse (supports patterns /no fill & width) 	3.1.96 - fixed Open by setting clipping port to a maximum area 	29.8.96 - fixed Ellipse & Circle (thanks to eos) *) IMPORT Display, Objects, Fonts, Pictures, Oberon, Texts; CONST replace* = Display.replace; paint* = Display.paint; invert* = Display.invert;		(** Standard display modes. **) (** Display styles **) filled* = 1;		(** Filled *) maxcoord = 8192; add = 1; subtract = 2; TYPE Mask* = POINTER TO MaskDesc;	(** Clipping Mask. *) (** Informs a frame of a new mask. This message is always sent directly. **) OverlapMsg* = RECORD (Display.FrameMsg) M*: Mask;		(** Use NIL to indicate to a frame that its current mask is invalid. *) END; (** Message broadcast by a frame (identified by the F field) to indicate that it has an invalid mask and now requires 	its parent, to calculate a new mask for it and to inform it through the OverlapMsg. *) UpdateMaskMsg* = RECORD (Display.FrameMsg) END; Run = POINTER TO RunDesc; RunDesc = RECORD x, w, right: INTEGER; value: INTEGER; next, prev: Run; END; ScanLine = POINTER TO ScanLineDesc; ScanLineDesc = RECORD y, h, top: INTEGER; maymerge: BOOLEAN; run: Run; next,prev: ScanLine; END; MaskDesc* = RECORD	(** Clipping mask descriptor. *) x*, y*: INTEGER;		(** Relative mask origin or offset. *) X*, Y*, W*, H*: INTEGER;		(** Current clipping port in absolute coordinates. *) sX, sY, sW, sH: INTEGER; simple: BOOLEAN; scanline: ScanLine; END; (** Enumerate the set of rectangles in a mask. The clipping port is not enumerated. *) EnumProc* = PROCEDURE (X, Y, W, H: INTEGER); VAR selectpat*: Display.Pattern; (** Pattern used to draw gadgets when in a selected state. **) (** Colors *) FG*, BG*: INTEGER;		(** Foreground (black) and background (white) color indexes. *) red*, green*, blue*: INTEGER;	(** Primary color indexes. *) black*, white*: INTEGER;	(** True black and white. **) topC*: INTEGER;	(** Top shadow color. *) bottomC*: INTEGER;	(** Bottom shadow color. *) upC*: INTEGER;	(** Color of a button. *) downC*: INTEGER;	(** Color of the pushed button *) groupC*: INTEGER;	(** Color of containers, i.e. gadgets that have a grouping function like panels. *) invertC*: INTEGER;	(** Best color for doing inverts.. *) textC*: INTEGER;	(** Default text color. *) textbackC*: INTEGER;	(** Default text background. *) textmode*: INTEGER;	(** Best CopyPattern mode for this display card. *) typ: INTEGER; aM, bM: Mask; (* for enums *) (* tmp variables for picture enumerator *) tmpP: Pictures.Picture; tmpM, dX, dY: INTEGER; compactionflag: BOOLEAN; (* ========= Brush related ========= *) CONST BrushSize = 100; (* maximum width of the brush *) TYPE Brush = RECORD brul, brur: ARRAY BrushSize OF INTEGER; bufl, bufr: ARRAY BrushSize OF INTEGER; bufh, brushr: INTEGER; x, y, mode: INTEGER; col: Display.Color; M: Mask; pat: Display.Pattern END; VAR drawingPolygon: BOOLEAN; brush: Brush; (* global Bursh *) PROCEDURE Min(x, y: INTEGER): INTEGER; BEGIN IF x < y THEN RETURN x ELSE RETURN y END END Min; PROCEDURE Max(x, y: INTEGER): INTEGER; BEGIN IF x > y THEN RETURN x ELSE RETURN y END END Max; PROCEDURE ClipAgainst(VAR x, y, w, h: INTEGER; x1, y1, w1, h1: INTEGER); VAR r, t, r1, t1: INTEGER; BEGIN r := x + w - 1; r1 := x1 + w1 - 1; t := y + h - 1; t1 := y1 + h1 - 1; IF x < x1 THEN x := x1 END; IF y < y1 THEN y := y1 END; IF r > r1 THEN r := r1 END; IF t > t1 THEN t := t1 END; w := r - x + 1; h := t - y + 1; END ClipAgainst; PROCEDURE Clip(M: Mask; VAR x, y, w, h : INTEGER); VAR l, b, t, r, tmp : INTEGER; BEGIN l := x; b := y; r := x+w-1; t := y +h-1; IF (l < M.sX) THEN l := M.sX; END; tmp := M.sX + M.sW - 1; IF (r > tmp) THEN r := tmp; END; IF (b < M.sY) THEN b := M.sY; END; tmp := M.sY + M.sH - 1; IF (t > tmp) THEN t := tmp; END; x := l; y := b; w := r - l + 1; h := t - b + 1; END Clip; PROCEDURE Open0(M: Mask); VAR r: Run; s: ScanLine; BEGIN NEW(s); NEW(r); M.scanline := s; s.run := r; r.next := NIL; s.y := -maxcoord; s.h := 2 * maxcoord + 1; s.top := maxcoord; r.x := -maxcoord; r.w := 2 * maxcoord + 1; r.right := maxcoord; END Open0; (** Initialize the Mask to the empty region, i.e. everything will be clipped away. *) PROCEDURE Open*(M: Mask); BEGIN M.scanline := NIL; M.x := 0; M.y := 0; M.simple := TRUE; M.sX := 0; M.sY := 0; M.sW := 0; M.sH := 0; M.X := 0; M.Y := 0; M.W := maxcoord; M.H := maxcoord END Open; (** Enumerate all the visible areas of a mask. The clipping port is not enumerated. The mask translation vector is taken into account.**) PROCEDURE Enum*(M: Mask; enum: EnumProc); VAR s: ScanLine; r: Run; BEGIN IF M.simple THEN IF (M.sW > 0) & (M.sH > 0) THEN enum(M.x + M.sX, M.y + M.sY, M.sW, M.sH) END; ELSE s := M.scanline; WHILE s # NIL DO 			r := s.run; WHILE r # NIL DO 				IF r.value # 0 THEN enum(M.x + r.x, M.y + s.y, r.w, s.h) END; r := r.next END; s := s.next END END END Enum; (** Enumerate all the invisible areas of a mask. The clipping port is not enumerated. Note that you might obtain coordinates outside of the normal screen area, bounded by approximately -/+ 8192. The mask translation vector is taken into account.**) PROCEDURE EnumInvert*(M: Mask; enum: EnumProc); VAR s: ScanLine; r: Run; X, Y, W, H: INTEGER; BEGIN IF M.simple THEN X := M.x + M.sX; Y := M.y + M.sY; W := M.sW; H := M.sH; enum(-maxcoord, -maxcoord, 2*maxcoord + 1, Y + maxcoord); enum(-maxcoord, Y+H, 2*maxcoord + 1, maxcoord - (Y+H) + 1); enum(-maxcoord, Y, X + maxcoord, H); enum(X+W, Y, maxcoord - (X+W), H) 	ELSE s := M.scanline; WHILE s # NIL DO 			r := s.run; WHILE r # NIL DO 				IF r.value = 0 THEN enum(M.x + r.x, M.y + s.y, r.w, s.h) END; r := r.next END; s := s.next END END END EnumInvert; (** Enumerate all the visible areas in the given rectangular region. The clipping port is not taken into account. *) PROCEDURE EnumRect*(M: Mask; X, Y, W, H: INTEGER; enum: EnumProc); VAR hleft, wleft, nw, nh, x, y, X0: INTEGER; s: ScanLine; r: Run; BEGIN IF M.simple THEN ClipAgainst(X, Y, W, H, M.x + M.sX, M.y + M.sY, M.sW, M.sH); (* enum(M.x + M.sX, M.y + M.sY, M.sW, M.sH); *) IF (W > 0) & (H > 0) THEN enum(X, Y, W, H) END; ELSE x := M.x; y := M.y; 		hleft := H; 		r := NIL; s := M.scanline; WHILE s.top + y < Y DO s := s.next; END; X0 := X; 		WHILE hleft > 0 DO 			nh := Min(s.top + y - Y + 1, hleft); r := s.run; WHILE r.right + x < X DO r := r.next END; wleft := W; 			WHILE wleft > 0 DO 				nw := r.right + x - X + 1; IF wleft < nw THEN nw := wleft END; IF r.value > 0 THEN enum(X, Y, nw, nh) END; INC(X, nw); DEC(wleft, nw); r := r.next END; INC(Y, nh); DEC(hleft, nh); s := s.next; r := NIL; X := X0 		END END END EnumRect; PROCEDURE SplitScan(s: ScanLine; y: INTEGER); (* s.y < y < s.top *) VAR ns: ScanLine; nr, r, tmp: Run; BEGIN NEW(ns); ns.y := y; ns.top := s.top; ns.h := s.top - y + 1; r := s.run; (* NEWRun(nr); *) NEW(nr);ns.run := nr; WHILE r # NIL DO 		nr.x := r.x; nr.w := r.w; nr.right := r.right; nr.value := r.value; IF r.next # NIL THEN ( * NEWRun(tmp); *) NEW(tmp); nr.next := tmp; nr := tmp; ELSE nr.next := NIL; END; r := r.next; END; ns.next := s.next; s.next := ns; s.top := y - 1; s.h := s.top - s.y + 1; END SplitScan; PROCEDURE MergeScanLine(s : ScanLine); VAR r, rt: Run; noinc: BOOLEAN; BEGIN r := s.run; WHILE r # NIL DO (* Merge *) IF r.value > 0 THEN r.value := 1; END; rt := r.next; noinc := FALSE; IF (rt # NIL) THEN IF rt.value > 0 THEN rt.value := 1; END; IF (rt.value = r.value) & (r.right+1 = rt.x) THEN INC(r.w, rt.w); r.right := rt.right; r.next := rt.next; (* DisposeRun(rt); *) noinc := TRUE; END; END; IF ~noinc THEN r := r.next; END; END; END MergeScanLine; PROCEDURE Compact(M: Mask); VAR r, rt, thesinglerect: Run; bs, st, thesinglescanline: ScanLine; noofrects: INTEGER; merge, noinc: BOOLEAN; BEGIN IF ~compactionflag THEN RETURN END; bs := M.scanline; WHILE bs # NIL DO 		IF bs.maymerge THEN MergeScanLine(bs); END; bs := bs.next; END; bs := M.scanline; WHILE bs # NIL DO 		st := bs.next; noinc := FALSE; IF st # NIL THEN r := bs.run; rt := st.run; merge := TRUE; WHILE merge & (r # NIL) DO 				IF (r.value = rt.value) & (r.x = rt.x) & (r.w = rt.w) THEN ELSE merge := FALSE; END; r := r.next; rt := rt.next; END; IF merge THEN INC(bs.h, st.h); INC(bs.top, st.h); bs.next := st.next; noinc := TRUE; END; END; IF ~noinc THEN bs := bs.next; END; END; bs := M.scanline; noofrects := 0; WHILE (bs # NIL) & (noofrects <= 1) DO 		r := bs.run; WHILE (r # NIL) & (noofrects <= 1) DO 			IF (r.value > 0) THEN INC(noofrects); thesinglerect := r; thesinglescanline := bs; END; r := r.next; END; bs := bs.next; END; IF noofrects = 1 THEN (* super compact *) M.scanline := NIL; M.simple := TRUE; M.sX := thesinglerect.x; M.sY := thesinglescanline.y; 		M.sW := thesinglerect.w; M.sH := thesinglescanline.h; 	END END Compact; PROCEDURE DoLine(s: ScanLine; x, y, w, h: INTEGER); VAR splittop, splitbottom: BOOLEAN; r, rt: Run; wleft, nw: INTEGER; BEGIN splitbottom := (y > s.y); splittop := (y+h-1) < s.top; r := s.run; WHILE r.right < x DO r := r.next; END; wleft := w; 	WHILE (wleft > 0) & (r # NIL) DO 		nw := Min(wleft, r.right - x + 1); (* x, y, nw, h *) IF r.value = 1 THEN (* draw okay in this run *) ELSE IF splittop THEN SplitScan(s, y + h); splittop := FALSE; END; IF splitbottom THEN SplitScan(s, y); rt := s.next.run; WHILE rt.x # r.x DO rt := rt.next END; r := rt; s := s.next; splitbottom := FALSE END; IF x > r.x THEN	(* split left *) NEW(rt); rt.next := r.next; rt.x := x; rt.w := r.right - x + 1; rt.right := r.right; rt.value := 2; r.w := x - r.x; r.right := r.x + r.w - 1; r.value := 0; r.next := rt; nw:=0; s.maymerge := TRUE ELSIF x + wleft - 1 < r.right THEN 	(* split right *) NEW(rt); rt.next := r.next; rt.x := x + wleft ; rt.w := r.right - rt.x + 1; rt.right := r.right; rt.value := 0; r.w := nw; r.right := r.x + r.w - 1; r.value := 1; r.next := rt; s.maymerge := TRUE ELSE r.value := 1; s.maymerge := TRUE END END; INC(x, nw); DEC(wleft, nw); r := r.next END END DoLine; PROCEDURE ExclLine(s: ScanLine; x, y, w, h: INTEGER); VAR splittop, splitbottom: BOOLEAN; r, rt: Run; wleft, nw: INTEGER; BEGIN splitbottom := (y > s.y); splittop := (y+h-1) < s.top; r := s.run; WHILE r.right < x DO r := r.next END; wleft := w; 	WHILE (wleft > 0) & (r # NIL) DO 		nw := Min(wleft, r.right - x + 1); (* x, y, nw, h *) IF (r.value = 0) THEN ELSE IF splittop THEN SplitScan(s, y + h); splittop := FALSE END; IF splitbottom THEN SplitScan(s, y); rt := s.next.run; WHILE rt.x # r.x DO rt := rt.next; END; r := rt; s := s.next; splitbottom := FALSE END; IF x > r.x THEN	(* split left *) NEW(rt); rt.next := r.next; rt.x := x; rt.w := r.right - x + 1; rt.right := r.right; IF x + wleft - 1 < r.right THEN rt.value := 2; ELSE rt.value := 0; END; r.w := x - r.x; r.right := r.x + r.w - 1; r.value := 2; r.next := rt; nw:=0; s.maymerge := TRUE; ELSIF x + wleft - 1 < r.right THEN 	(* split right *) NEW(rt); rt.next := r.next; rt.x := x + wleft; rt.w := r.right - rt.x + 1; rt.right := r.right; rt.value := 1; r.w := nw; r.right := r.x + r.w - 1; r.value := 0; s.maymerge := TRUE; r.next := rt; ELSE r.value := 0; s.maymerge := TRUE; END; END; INC(x, nw); DEC(wleft, nw);r := r.next; END; END ExclLine; (** Make a copy of a mask. *) PROCEDURE Copy*(from: Mask; VAR to: Mask); VAR r, Tr, Nr: Run; s, Ns, Ts: ScanLine; BEGIN NEW(to); to^ := from^; IF from.scanline # NIL THEN s := from.scanline; NEW(Ns); to.scanline := Ns; WHILE s # NIL DO 			Ns^ := s^; Ns.prev := NIL; (* copy run *) r := s.run; NEW(Nr); Ns.run := Nr; WHILE r # NIL DO 				Nr^ := r^; Nr.prev := NIL; IF r.next # NIL THEN NEW(Tr); Nr.next := Tr; Nr := Tr; ELSE Nr.next := NIL; END; r := r.next; END; (* end copy run *) IF s.next # NIL THEN NEW(Ts); Ns.next := Ts; Ns := Ts; ELSE Ns.next := NIL; END; s := s.next; END END END Copy; (** Add the rectangle X, Y, W, H as a visible/drawable area to the mask. *) PROCEDURE Add * (M: Mask; X, Y, W, H: INTEGER); VAR hleft, nh: INTEGER; s: ScanLine; BEGIN X := X - M.x; Y := Y - M.y; (* adjust for offset *) IF M.simple THEN IF M.sW + M.sH = 0 THEN M.sX := X; M.sY := Y; M.sW := W; M.sH := H; 			RETURN; ELSE M.simple := FALSE; Open0(M); compactionflag := FALSE; Add(M, M.sX + M.x, M.sY + M.y, M.sW, M.sH); compactionflag := TRUE; END; END; hleft := H; 	s := M.scanline; WHILE s # NIL DO s.maymerge := FALSE; s := s.next; END; s := M.scanline; WHILE s.top < Y DO s := s.next; END; WHILE hleft > 0 DO 		nh := Min(s.top - Y + 1, hleft); DoLine(s, X, Y, W, nh); INC(Y, nh); DEC(hleft, nh); s := s.next; END; Compact(M); END Add; (** Clip the current clipping port of the mask to the rectangle X, Y, W, H. The result is an updated clipping port. *) PROCEDURE AdjustMask*(M: Mask; X, Y, W, H: INTEGER); BEGIN ClipAgainst(X, Y, W, H, M.X, M.Y, M.W, M.H); M.X := X; M.Y := Y; M.W := W; M.H := H END AdjustMask; (** Remove area X, Y, W, H from the mask i.e. make area undrawable. *) PROCEDURE Subtract * (M: Mask; X, Y, W, H: INTEGER); VAR hleft, nh: INTEGER;s: ScanLine; BEGIN IF M.simple THEN M.simple := FALSE; Open0(M); compactionflag := FALSE; Add(M, M.x + M.sX, M.y + M.sY, M.sW, M.sH); compactionflag := TRUE; END; X := X - M.x; Y := Y - M.y; 	hleft := H; 	s := M.scanline; WHILE s # NIL DO s.maymerge := FALSE; s := s.next; END; s := M.scanline; WHILE s.top < Y DO s := s.next; END; WHILE hleft > 0 DO 		nh := Min(s.top - Y + 1, hleft); ExclLine(s, X, Y, W, nh); INC(Y, nh); DEC(hleft, nh); s := s.next; END; Compact(M); END Subtract; (** Interset the mask with the rectangle X, Y, W, H. The visible areas are restricted to this rectangle. *) PROCEDURE Intersect*(M: Mask; X, Y, W, H: INTEGER); BEGIN IF M.simple THEN X := X - M.x; Y := Y - M.y; 		Clip(M, X, Y, W, H); M.sX := X; M.sY := Y; M.sW := W; M.sH := H 	ELSE Subtract(M, -maxcoord, -maxcoord, 2*maxcoord + 1, Y + maxcoord (* + 1 *)); Subtract(M, -maxcoord, Y+H, 2*maxcoord + 1, maxcoord - (Y+H) + 1); Subtract(M, -maxcoord, Y, X + maxcoord (* + 1 *), H); Subtract(M, X+W, Y, maxcoord - (X+W), H) 	END END Intersect; PROCEDURE *IntersectMasks1(x, y, w, h: INTEGER); BEGIN IF typ = add THEN Add(bM, x, y, w, h) ELSIF typ = subtract THEN Subtract(bM, x, y, w, h) END; END IntersectMasks1; PROCEDURE *IntersectMasks0(X, Y, W, H: INTEGER); BEGIN EnumRect(aM, X, Y, W, H, IntersectMasks1); END IntersectMasks0; (** Intersect the masks A and B resulting in R. *) PROCEDURE IntersectMasks*(A, B: Mask; VAR R: Mask);		(** R is an out parameter only *) BEGIN IF (A = NIL) OR (B = NIL) THEN R := NIL ELSE NEW(R); Open(R); R.x := A.x; R.y := A.y; 		aM := B; bM := R; typ := add; Enum(A, IntersectMasks0); aM := NIL; bM := NIL END; END IntersectMasks; (** Subtracts the visible areas of B from A to give mask R. *) PROCEDURE SubtractMasks*(A, B: Mask; VAR R: Mask); BEGIN IF (A = NIL) OR (B = NIL) THEN R := NIL ELSE Copy(A, R); aM := A; bM := R; typ := subtract; Enum(B, IntersectMasks0); aM := NIL; bM := NIL END; END SubtractMasks; (** Translate the mask so that the resulting origin/offset is 0, 0. This is done by "adding in" the translation vector. *) PROCEDURE Shift*(M: Mask); VAR s, first, last: ScanLine; r, f, l: Run; BEGIN IF M # NIL THEN IF M.simple THEN INC(M.sX, M.x); INC(M.sY, M.y); ELSIF (M.x # 0) OR (M.y # 0) THEN s := M.scanline; first := s; 			WHILE s # NIL DO 				INC(s.y, M.y); INC(s.top, M.y); r := s.run; f := r; 				WHILE r # NIL DO 					INC(r.x, M.x); INC(r.right, M.x); l := r; r := r.next END; f.x := -maxcoord; l.right := maxcoord; (* ! *) f.w := f.right - f.x + 1; l.w := l.right - l.x + 1; (* ! *) last := s; s := s.next; END; first.y := -maxcoord; last.top := maxcoord; (* ! *) first.h := first.top - first.y + 1; last.h := last.top - last.y + 1; (* ! *) END; M.x := 0; M.y := 0; END; END Shift; (** Returns TRUE if the visible areas of the mask form a single rectangle. The result, when TRUE, is returned. The clipping port is not taken into account. *) PROCEDURE Rectangular*(M: Mask; VAR X, Y, W, H: INTEGER): BOOLEAN; BEGIN X := M.x + M.sX; Y := M.y + M.sY; W := M.sW; H := M.sH; RETURN M.simple END Rectangular; (* - CopyMask *) (** Using Display.CopyBlock, copy the area M to position X, Y. The point M.x, M.y is copied to screen coordinates X, Y. *) PROCEDURE CopyMask*(M: Mask; X, Y: INTEGER; mode: INTEGER); VAR s, sp: ScanLine; r, rp: Run; rruns, rscans: BOOLEAN; BEGIN IF M.simple THEN Display.CopyBlock(M.x + M.sX, M.y + M.sY, M.sW, M.sH, X + M.sX, Y + M.sY, mode) ELSE rruns := X > M.x; rscans := Y > M.y; 		IF rscans THEN s := M.scanline; sp := NIL; WHILE s # NIL DO 				s.prev := sp; sp := s; s := s.next END; s := sp 		ELSE s := M.scanline END; WHILE s # NIL DO 			IF rruns THEN r := s.run; rp := NIL; WHILE r # NIL DO 					r.prev := rp; rp := r; r := r.next; END; r := rp; WHILE r # NIL DO 					IF r.value > 0 THEN Display.CopyBlock(M.x + r.x, M.y + s.y, r.w, s.h, X + r.x, Y + s.y, mode) END; r := r.prev; END; ELSE r := s.run; WHILE r # NIL DO 					IF r.value > 0 THEN Display.CopyBlock(M.x + r.x, M.y + s.y, r.w, s.h, X + r.x, Y + s.y, mode); END; r := r.next; END; END; IF ~rscans THEN s := s.next ELSE s := s.prev END; END END; END CopyMask; (** Display.ReplConst through a mask. *) PROCEDURE ReplConst* (M: Mask; col: Display.Color; X, Y, W, H, mode: INTEGER); VAR hleft, wleft, nw, nh, x, y, X0 : INTEGER; s : ScanLine; r : Run; BEGIN IF M = NIL THEN Display.ReplConst(col, X, Y, W, H, mode); ELSIF M.simple THEN ClipAgainst(X, Y, W, H, M.X, M.Y, M.W, M.H); ClipAgainst(X, Y, W, H, M.x + M.sX, M.y + M.sY, M.sW, M.sH); Display.ReplConst(col, X, Y, W, H, mode); ELSE ClipAgainst(X, Y, W, H, M.X, M.Y, M.W, M.H); x := M.x; y := M.y; 		hleft := H; 		s := M.scanline; WHILE s.top + y < Y DO s := s.next; END; X0 := X; 		WHILE hleft > 0 DO 			nh := Min(s.top + y - Y + 1, hleft); r := s.run; WHILE r.right + x < X DO r := r.next END; wleft := W; 			WHILE wleft > 0 DO 				nw := r.right + x - X + 1; IF wleft < nw THEN nw := wleft END; IF r.value > 0 THEN Display.ReplConst(col, X, Y, nw, nh, mode); END; INC(X, nw); DEC(wleft, nw); r := r.next; END; INC(Y, nh); DEC(hleft, nh); s := s.next; r := NIL; X := X0; END END END ReplConst; (** Is this rectangle completely visible? The clipping port is taken into acount. **) PROCEDURE Visible*(M: Mask; X, Y, W, H : INTEGER) : BOOLEAN; VAR x, y, X0, hleft, wleft, nh, nw: INTEGER; s: ScanLine; r: Run; BEGIN IF M = NIL THEN RETURN TRUE ELSIF (X < M.X) OR (Y < M.Y) OR (X + W > M.X + M.W) OR (Y + H >  M.Y + M.H ) THEN RETURN FALSE ELSIF M.simple THEN x := M.x; y := M.y; 		RETURN (X >= M.sX + x) & (Y >= M.sY + y) & (X + W <= M.sX + M.sW + x) & (Y + H <= M.sY + M.sH + y) 	ELSE (* jm mod *) DEC(X, M.x); DEC(Y, M.y); (* eos: shift rectangle into local mask coords *) s := M.scanline; WHILE s.top < Y DO s := s.next END; hleft := H; 		X0 := X; 		WHILE hleft > 0 DO 			nh := Min(s.top - Y + 1, hleft); r := s.run; WHILE r.right < X DO r := r.next END; wleft := W; 			WHILE wleft > 0 DO 				IF r.value = 0 THEN RETURN FALSE END; (*gs*) nw := r.right - X + 1; IF wleft < nw THEN nw := wleft END; INC(X, nw); DEC(wleft, nw); r := r.next END; INC(Y, nh); DEC(hleft, nh); s := s.next; X := X0 		END; RETURN TRUE END END Visible; (** Display.Dot through a clipping mask. *) PROCEDURE Dot*(M: Mask; col: Display.Color; X, Y, mode: INTEGER); VAR x, y: INTEGER; s: ScanLine; r: Run; BEGIN IF M = NIL THEN Display.Dot(col, X, Y, mode) ELSIF M.simple THEN x := M.x; y := M.y; 		IF (X >= M.X) & (Y >= M.Y ) & (X < M.X + M.W ) & (Y < M.Y + M.H) THEN IF (X >= M.sX + x) & (Y >= M.sY + y) & (X < M.sX + M.sW + x) & (Y < M.sY + M.sH + y) THEN Display.Dot(col, X, Y, mode) END END ELSE IF (X >= M.X) & (Y >= M.Y ) & (X < M.X + M.W ) & (Y < M.Y + M.H) THEN x := M.x; y := M.y; 			s := M.scanline; WHILE s.top + y < Y DO s := s.next; END; r := s.run; WHILE r.right + x < X DO r := r.next; END; IF r.value > 0 THEN Display.Dot(col, X, Y, mode) END END END END Dot; (** Display.FillPattern through a clipping mask. pX, pY is the pattern pin-point. *) PROCEDURE FillPattern * (M: Mask; col: Display.Color; pat: Display.Pattern; pX, pY, X, Y, W, H, mode: INTEGER); VAR hleft, nh, wleft, nw, x, y, X0 : INTEGER; s: ScanLine; r : Run; BEGIN IF pat = Display.solid THEN ReplConst(M, col, X, Y, W, H, mode); RETURN END; IF M = NIL THEN Display.FillPattern(col, pat, pX, pY, X, Y, W, H, mode) ELSIF M.simple THEN ClipAgainst(X, Y, W, H, M.X, M.Y, M.W, M.H); ClipAgainst(X, Y, W, H, M.x + M.sX, M.y + M.sY, M.sW, M.sH); Display.FillPattern(col, pat, pX, pY, X, Y, W, H, mode); ELSE ClipAgainst(X, Y, W, H, M.X, M.Y, M.W, M.H); x := M.x; y := M.y; 		s := M.scanline; WHILE s.top + y < Y DO s := s.next; END; hleft := H; X0 := X; 		WHILE hleft > 0 DO 			nh := s.top + M.y - Y + 1; IF hleft < nh THEN nh := hleft END; r := s.run; WHILE r.right + x < X DO r := r.next END; wleft := W; 			WHILE wleft > 0 DO 				nw := r.right + x - X + 1; IF wleft < nw THEN nw := wleft END; IF r.value > 0 THEN Display.FillPattern(col, pat, pX, pY, X,Y, nw, nh, mode); END; INC(X, nw); DEC(wleft, nw); r := r.next; END; INC(Y, nh); DEC(hleft, nh); s := s.next; r := NIL; X := X0; END; END; END FillPattern; (** Same as Display.CopyPattern, but through a clipping mask. *) PROCEDURE CopyPattern *(M: Mask; col: Display.Color; pat: Display.Pattern; X, Y, mode: INTEGER); VAR W, H, X0, hleft, wleft, nw, nh, ax, ay, cx, cy, cw, ch, x, y : INTEGER; s: ScanLine; r: Run; BEGIN Display.GetDim(pat,W,H); IF (M = NIL) OR Visible(M,X,Y,W,H) THEN Display.CopyPattern(col, pat, X, Y, mode) ELSIF (X >= M.X + M.W) OR (X + W <= M.X) OR (Y >= M.Y + M.H) OR (Y + H <= M.Y) THEN (* skip *) ELSIF M.simple THEN Display.SetClip(M.X, M.Y, M.W, M.H); Display.AdjustClip(M.sX+M.x, M.sY+M.y, M.sW, M.sH); Display.CopyPattern(col, pat, X, Y, mode); Display.ResetClip; ELSE ax := X; ay := Y; 		Display.SetClip(M.X, M.Y, M.W, M.H); Display.GetClip(cx, cy, cw, ch); x := M.x; y := M.y; 		s := M.scanline; WHILE s.top + y < Y DO s := s.next; END; hleft := H; X0 := X; 		WHILE hleft > 0 DO 			nh := Min(s.top + M.y - Y + 1, hleft); r := s.run; WHILE r.right + x < X DO r := r.next END; wleft := W; 			WHILE wleft > 0 DO 				nw := r.right + x - X + 1; IF wleft < nw THEN nw := wleft END; IF r.value > 0 THEN Display.AdjustClip(r.x+x, s.y+y, r.w, s.h); Display.CopyPattern(col, pat, ax, ay, mode); Display.SetClip(cx, cy, cw, ch) END; INC(X, nw); DEC(wleft, nw); r := r.next END; INC(Y, nh); DEC(hleft, nh); s := s.next; r := NIL; X := X0 		END; Display.ResetClip END END CopyPattern; (* -- Extra output primitives *) (** Draw rectangle outline in the specified size, line width and pattern. *) PROCEDURE Rect*(M: Mask; col: Display.Color; pat: Display.Pattern; X, Y, W, H, width, mode: INTEGER); VAR mX,mW : INTEGER; BEGIN width := Min(width, Min(H DIV 2, W DIV 2)); FillPattern(M, col, pat, X, Y, X, Y, width, H, mode); FillPattern(M, col, pat, X, Y, X + W - width, Y, width, H, mode); IF (X < Display.Width) & (X + W >= Display.Width) & (M # NIL) & (M.X < Display.Width) & (M.X + M.W >= Display.Width) THEN mX := M.X; mW := M.W; 		M.W := Display.Width - M.X; 		FillPattern(M, col, pat, X, Y, X + width, Y, W - 2 * width, width, mode); FillPattern(M, col, pat, X, Y, X + width, Y + H - width, W - 2 * width, width, mode); M.W := mW - M.W; M.X := Display.Width; FillPattern(M, col, pat, X, Y, X + width, Y, W - 2 * width, width, mode); FillPattern(M, col, pat, X, Y, X + width, Y + H - width, W - 2 * width, width, mode); M.X := mX; M.W := mW 	ELSE FillPattern(M, col, pat, X, Y, X + width, Y, W - 2 * width, width, mode); FillPattern(M, col, pat, X, Y, X + width, Y + H - width, W - 2 * width, width, mode) END END Rect; (** Draw rectangle outline in width using top and bottom shadow (3D effects ).*) PROCEDURE Rect3D*(M: Mask; topcol, botcol: Display.Color; X, Y, W, H, width, mode: INTEGER); BEGIN width := Min(width, Min(H DIV 2, W DIV 2)); WHILE width > 0 DO 		ReplConst(M, botcol, X, Y, W, 1,mode); ReplConst(M, topcol, X, Y + H - 1, W, 1, mode); ReplConst(M, topcol, X, Y, 1, H, mode); ReplConst(M, botcol, X + W - 1, Y, 1, H, mode); DEC(width); INC(X); INC(Y); DEC(W, 2); DEC(H, 2) END END Rect3D; (** Fill rectangle with 3D shadow effects. incol specifies the "inside" color. *) PROCEDURE FilledRect3D*(M: Mask; topcol, botcol, incol: Display.Color; X, Y, W, H, width, mode: INTEGER); BEGIN width := Min(width, Min(H DIV 2, W DIV 2)); WHILE width > 0 DO 		ReplConst(M, botcol, X, Y, W, 1,mode); ReplConst(M, topcol, X, Y + H - 1, W, 1, mode); ReplConst(M, topcol, X, Y, 1, H, mode); ReplConst(M, botcol, X + W - 1, Y, 1, H, mode); DEC(width); INC(X); INC(Y); DEC(W, 2); DEC(H, 2) END; ReplConst(M, incol, X, Y, W, H, mode) END FilledRect3D; (* BRUSHES *) PROCEDURE BrushJump(VAR b: Brush; x, y: INTEGER); VAR i: INTEGER; BEGIN IF (b.x # x) OR (b.y # y) THEN b.x := x; b.y := y; 		FOR i := 0 TO b.bufh - 1 DO b.bufl[i] := b.brul[i] + b.x; b.bufr[i] := b.brur[i] + b.x END END END BrushJump; PROCEDURE BrushWalk(VAR b: Brush; x, y: INTEGER); VAR i, dx, dy, t: INTEGER; BEGIN dx := x - b.x; dy := y - b.y; t := b.bufh - 1; IF dy = 0 THEN (* horizontal move *) IF dx < 0 THEN FOR i := 0 TO t DO b.bufl[i] := Min(b.bufl[i], b.brul[i] + x) END ELSIF dx > 0 THEN FOR i := 0 TO t DO b.bufr[i] := Max(b.bufr[i], b.brur[i] + x) END END ELSIF dy > 0 THEN (* up *) FillPattern(b.M, b.col, b.pat, 0, 0, b.bufl[0], b.y - b.brushr, b.bufr[0] - b.bufl[0] + 1, 1, b.mode); FOR i := 0 TO b.bufh - 2 DO 			b.bufl[i] := Min(b.bufl[i+1], b.brul[i] + x); b.bufr[i] := Max(b.bufr[i+1], b.brur[i] + x); END; b.bufl[t] := b.brul[t] + x; b.bufr[t] := b.brur[t] + x 	ELSE (* dy < 0 *) (* down *) FillPattern(b.M, b.col, b.pat, 0, 0, 			b.bufl[t], b.y - b.brushr + b.bufh-1, b.bufr[t] - b.bufl[t] + 1, 1, b.mode); FOR i := b.bufh - 1 TO 1 BY -1 DO 			b.bufl[i] := Min(b.bufl[i-1], b.brul[i] + x); b.bufr[i] := Max(b.bufr[i-1], b.brur[i] + x); END; b.bufl[0] := b.brul[0] + x; b.bufr[0] := b.brur[0] + x; 	END; b.x := x; b.y := y END BrushWalk; PROCEDURE BrushFlush(VAR b: Brush); VAR i: INTEGER; BEGIN FOR i := 0 TO b.bufh - 1 DO 		 FillPattern(b.M, b.col, b.pat, 0, 0, 			b.bufl[i], b.y + i - b.brushr, b.bufr[i] - b.bufl[i] + 1, 1, b.mode); END END BrushFlush; PROCEDURE InitBrush(VAR b: Brush; M: Mask; pat: Display.Pattern; col: Display.Color; w, mode: INTEGER); VAR r, x, y, d, dx, dy: INTEGER; PROCEDURE Set(x, y: INTEGER); BEGIN b.brul[y + r] := -x+1; b.brur[y + r] := x; b.brul[-y + r] := -x+1; b.brur[-y + r] := x; 		IF y + r > b.bufh THEN b.bufh := y + r END END Set; BEGIN b.bufh := 0; b.M := M; b.col := col; b.mode := mode; b.pat := pat; IF w >= BrushSize THEN w := BrushSize - 1 END; b.x := MIN(INTEGER); b.y := MIN(INTEGER); r := w DIV 2; (* radius *) IF r < 0 THEN r := 1 END; x := r; y := 0; d := 2 * r; dx := 4 * r; dy := 0; Set(x, y); WHILE y # r DO 		WHILE d <= 1 DO DEC(x); DEC(dx, 4); INC(d, dx) END; INC(y); Set(x, y); INC(dy, 4); DEC(d, dy); END; b.brushr := r; INC(b.bufh) END InitBrush; (* - Scan line based primitives - *) (** Draw a line in the specified pattern and width. Round brushes are used to draw thick lines. *) PROCEDURE Line*(M: Mask; col: Display.Color; pat: Display.Pattern; X, Y, X1, Y1, width, mode: INTEGER); VAR x, y, dx, dy, inx, iny, d, dy2, dx2: INTEGER; BEGIN dx := width DIV 2; dx2 := width + 1; IF Visible(M, Min(X, X1)-dx, Min(Y, Y1)-dx, ABS(X1-X)+dx2, ABS(Y1-Y)+dx2) THEN M := NIL END; x := X; y := Y; dx := X1 - X; dy := Y1 - Y; 	IF width > 1 THEN IF drawingPolygon THEN ELSE InitBrush(brush, M, pat, col, width, mode); BrushJump(brush, x, y) 		END; IF ABS(dy) > ABS(dx) THEN d := -ABS(dx); dy2 := 2 * ABS(dy); dx2 := 2 * ABS(dx); IF dx < 0 THEN inx := -1; ELSE inx := 1; END; IF dy < 0 THEN iny := -1; ELSE iny := 1; END; WHILE y # Y1 DO 				INC(y, iny); INC(d, dx2); IF d > 0 THEN INC(x, inx); DEC(d, dy2); END; BrushWalk(brush, x, y); END; ELSE d := -ABS(dx); dy2 := 2 * ABS(dy); dx2 := 2 * ABS(dx); IF dx < 0 THEN inx := -1; ELSE inx := 1; END; IF dy < 0 THEN iny := -1; ELSE iny := 1; END; WHILE x # X1 DO 				INC(x, inx); INC(d, dy2); IF d > 0 THEN INC(y, iny); DEC(d, dx2); END; BrushWalk(brush, x, y); END; END; IF ~drawingPolygon THEN BrushFlush(brush) END; ELSE IF ABS(dy) > ABS(dx) THEN d := -ABS(dx); dy2 := 2 * ABS(dy); dx2 := 2 * ABS(dx); IF dx < 0 THEN inx := -1; ELSE inx := 1; END; IF dy < 0 THEN iny := -1; ELSE iny := 1; END; WHILE y # Y1 DO 				INC(y, iny); INC(d, dx2); IF d > 0 THEN INC(x, inx); DEC(d, dy2); END; IF pat = Display.solid THEN Dot(M, col, x, y, mode) ELSE FillPattern(M, col, pat, 0, 0, x, y, 1, 1, mode) END END; ELSE d := -ABS(dx); dy2 := 2 * ABS(dy); dx2 := 2 * ABS(dx); IF dx < 0 THEN inx := -1; ELSE inx := 1; END; IF dy < 0 THEN iny := -1; ELSE iny := 1; END; WHILE x # X1 DO 				INC(x, inx); INC(d, dy2); IF d > 0 THEN INC(y, iny); DEC(d, dx2); END; IF pat = Display.solid THEN Dot(M, col, x, y, mode) ELSE FillPattern(M, col, pat, 0, 0, x, y, 1, 1, mode) END END END END END Line; PROCEDURE FilledPoly(M: Mask; col: Display.Color; pat: Display.Pattern; VAR X, Y: ARRAY OF INTEGER; n, mode: INTEGER); TYPE Run = POINTER TO RunDesc0; RunDesc0 = RECORD next: Run; x: INTEGER END; VAR scan: ARRAY 2000 OF Run; free, s: Run; i, miny, maxy, x0, x1: INTEGER; PROCEDURE New(VAR s: Run); BEGIN IF free = NIL THEN NEW(s) ELSE s := free; free := free.next; s.next := NIL END END New; PROCEDURE Free(VAR s: Run); VAR s0: Run; BEGIN IF s # NIL THEN s0 := s; WHILE s0.next # NIL DO s0 := s0.next END; s0.next := free; free := s; s := NIL END END Free; PROCEDURE Insert(VAR s: Run; x: INTEGER); VAR t, t0: Run; BEGIN IF s = NIL THEN New(s); s.x := x 		ELSE New(t); t.x := x; 			IF x < s.x THEN t.next := s; s := t 			ELSE t0 := s; 				WHILE (t0.next # NIL) & (t0.next.x < x) DO t0 := t0.next END; IF t0.next = NIL THEN t0.next := t 				ELSE t.next := t0.next; t0.next := t 				END END END END Insert; PROCEDURE line(x1, y1, x2, y2: INTEGER); (* standard bresenham *) VAR x, y, d, dx, dy, incx, incy: INTEGER; BEGIN (* Seg(x1,y1); *) x := x1; y := y1; dx := (x2 - x1) * 2; dy := (y2 - y1) * 2; incx := 0; IF dx < 0 THEN incx := -1; dx := -dx; ELSIF dx >0 THEN incx := 1 END; incy := 0; IF dy < 0 THEN incy := -1; dy := -dy ELSIF dy > 0 THEN incy := 1 END; d := incx * (x1 - x2); WHILE y # y2 DO 			INC(y, incy); INC(d, dx); WHILE d > 0 DO INC(x, incx); DEC(d, dy) END; IF incy > 0 THEN Insert(scan[y], x) ELSE Insert(scan[y+1], x) END END END line; BEGIN free := NIL; miny := MAX(INTEGER); maxy := MIN(INTEGER); i := 0; WHILE i < n DO IF Y[i] < miny THEN miny := Y[i] END; IF Y[i] > maxy THEN maxy := Y[i]; END; INC(i) END; i := 0; WHILE i <= maxy - miny DO scan[i] := NIL; INC(i) END; i := 1; WHILE i < n DO 		line(X[i - 1], Y[i - 1] - miny, X[i], Y[i] - miny); INC(i) END; line(X[n - 1], Y[n - 1] - miny, X[0], Y[0] - miny); i := 0; WHILE i <= maxy - miny DO 		s := scan[i]; WHILE s # NIL DO 			x0 := s.x; s := s.next; IF s = NIL THEN x1 := x0 ELSE x1 := s.x; s := s.next END; FillPattern(M, col, pat, 0, 0, x0, i + miny, x1 - x0 + 1, 1, mode) END; Free(scan[i]); INC(i) END END FilledPoly; (** Draw a polygon in pattern pat. n specifies the number of vertices listed in the arrays X and Y. Style may be {filled}. *) PROCEDURE Poly*(M: Mask; col: Display.Color; pat: Display.Pattern; VAR X, Y: ARRAY OF INTEGER; n, width: INTEGER; style: SET; mode: INTEGER); VAR i: INTEGER; BEGIN IF filled IN style THEN FilledPoly(M, col, pat, X, Y, n, mode) ELSE drawingPolygon := TRUE; IF width > 1 THEN InitBrush(brush, M, pat, col, width, mode); BrushJump(brush, X[0], Y[0]) END; i := 0; WHILE i < n - 1 DO 			Line(M, col, pat, X[i], Y[i], X[i+1], Y[i+1], width, mode); INC(i) END; drawingPolygon := FALSE; IF width > 1 THEN BrushFlush(brush) END END END Poly; (** Draw an ellipse. Implementation restriction: cannot fill an ellipse or draw an ellipse with line width > 1 *) PROCEDURE Ellipse*(M: Mask; col: Display.Color; pat: Display.Pattern; X, Y, a, b, width: INTEGER; style: SET; mode: INTEGER); VAR x1, y1: INTEGER; d, dx, dy, x2, y2, a1, a2, a8, b1, b2, b8: LONGINT; PROCEDURE Dot4(x1, x2, y1, y2: INTEGER); BEGIN IF pat = Display.solid THEN Dot(M, col, x1, y1, mode); Dot(M, col, x1, y2, mode); Dot(M, col, x2, y1, mode); Dot(M, col, x2, y2, mode) ELSE FillPattern(M, col, pat, 0, 0, x1, y1, 1, 1, mode); FillPattern(M, col, pat, 0, 0, x1, y2, 1, 1, mode); FillPattern(M, col, pat, 0, 0, x2, y1, 1, 1, mode); FillPattern(M, col, pat, 0, 0, x2, y2, 1, 1, mode) END END Dot4; BEGIN IF Visible(M, X - a, Y - b, 2 * a + 1, 2 * b + 1) THEN M := NIL END; IF (a < 600) & (b < 600) THEN a1 := a; a2 := a1*a1; a8 := 8*a2; b1 := b; b2 := b1*b1; b8 := 8*b2; x1 := a; y1 := 0; x2 := a1*b2; y2 := 0; dx := b8*(a1-1); dy := 4*a2; d := b2*(1- 4*a1); WHILE y2 < x2 DO 			Dot4(X-x1 (* -1 *), X+x1, Y-y1 (* -1 *) , Y+y1); INC(d, dy); INC(dy, a8); INC(y1); INC(y2, a2); IF d >= 0 THEN DEC(d, dx); DEC(dx, b8); DEC(x1); DEC(x2, b2) END END; INC(d, 4*(x2+y2)-b2+a2); WHILE x1 >= 0 DO 			Dot4(X-x1 (* -1 *), X+x1, Y-y1 (* -1 *) , Y+y1); DEC(d, dx); DEC(dx, b8); DEC(x1); IF d < 0 THEN INC(d, dy); INC(dy, a8); INC(y1) END END; END END Ellipse; (** Draw a circle in radius r using pattern pat at position X, Y. Thick line widths are allowed. *) PROCEDURE Circle*(M: Mask; col: Display.Color; pat: Display.Pattern; X, Y, r, width: INTEGER; style: SET; mode: INTEGER); VAR x, y, dx, dy, d, e: INTEGER; BEGIN IF filled IN style THEN IF Visible(M, X - r, Y - r, 2 * r + 1, 2 * r + 1 ) THEN M := NIL END; x := r; y := 0; e := 0; dx := 2; dy := 2; WHILE y <=x DO 			FillPattern(M, col, pat, X, Y, X - x, Y + y, 2 * x + 1, 1, mode); FillPattern(M, col, pat, X, Y, X - x, Y - y, 2 * x + 1, 1, mode); INC(y); INC(e, y * dy - 1); IF e > x THEN DEC(x); DEC(e, x * dx + 1); FillPattern(M, col, pat, X, Y, X - y, Y + x, 2* y + 1, 1, mode); FillPattern(M, col, pat, X, Y, X - y, Y - x, 2 * y + 1, 1, mode) END END ELSIF width > 1 THEN d := r + (width + 1) DIV 2; IF Visible(M, X - d, Y - d, 2*d + 1, 2*d + 1) THEN M := NIL END; x := X + r; y := Y; 		InitBrush(brush, M, pat, col, width, mode); BrushJump(brush, x, y); d := 2* r; dx := 4* r; dy := 0; WHILE y # Y + r DO 			WHILE d <= 1 DO DEC(x); BrushWalk(brush, x, y); DEC(dx,4); INC(d,dx) END; INC(y); BrushWalk(brush, x, y); INC(dy,4); DEC(d,dy); END; WHILE x # X DO DEC(x); BrushWalk(brush, x, y); DEC(dx,4); INC(d,dx) END; d := -d; WHILE x # X - r DO 			WHILE d <= 1 DO DEC(y); BrushWalk(brush,x,y); DEC(dy,4); INC(d,dy) END; DEC(x); BrushWalk(brush,x,y); INC(dx,4); DEC(d,dx); END; WHILE y # Y DO DEC(y); BrushWalk(brush,x,y); DEC(dy,4); INC(d,dy) END; d := -d; WHILE y # Y - r DO 			WHILE d <= 1 DO INC(x); BrushWalk(brush,x,y); DEC(dx,4); INC(d,dx) END; DEC(y); BrushWalk(brush,x,y); INC(dy,4); DEC(d,dy); END; WHILE x # X DO INC(x); BrushWalk(brush,x,y); DEC(dx,4); INC(d,dx) END; d := -d; WHILE x # X + r DO 			WHILE d <= 1 DO INC(y); BrushWalk(brush,x,y); DEC(dy,4); INC(d,dy) END; INC(x); BrushWalk(brush,x,y); INC(dx,4); DEC(d,dx); END; WHILE y # Y DO INC(y); BrushWalk(brush,x,y); DEC(dy,4); INC(d,dy) END; BrushFlush(brush) ELSE (* IF Visible(M, X - r, Y - r, 2 * r + 1, 2 * r + 1 ) THEN M := NIL END; *) Ellipse(M, col, pat, X, Y, r, r, width, style, mode) END END Circle; (* end of scanline primitives  *) (** Draw string s in font fnt and color col at position X, Y. *) PROCEDURE String*(M: Mask; col: Display.Color; X, Y: INTEGER; fnt: Fonts.Font; s: ARRAY OF CHAR; mode: INTEGER); VAR r: Objects.Object; p: INTEGER; BEGIN p := 0; WHILE s[p] # 0X DO 		fnt.GetObj(fnt,ORD(s[p]),r); WITH r: Fonts.Char DO   		CopyPattern(M, col, r.pat, X + r.x, Y + r.y, mode); INC(X, r.dx); INC(p) END END END String; (** Draw a string s in font fnt centered in the rectangle X, Y, W, H. Line breaks will be inserted as needed. *) PROCEDURE CenterString*(M: Mask; col: Display.Color; X, Y, W, H: INTEGER; fnt: Fonts.Font; s: ARRAY OF CHAR; mode: INTEGER); VAR len, p, h, lspc, i, y: INTEGER; r: Objects.Object; s0: ARRAY 64 OF CHAR; BEGIN len := 0; p := 0; WHILE (s[p] # 0X) DO 		fnt.GetObj(fnt, ORD(s[p]), r); INC(p); INC(len, r(Fonts.Char).dx) END; IF len < W - 4 THEN (* normal print *) String(M, col, (W - len) DIV 2 + X, Y + H DIV 2 - fnt.height DIV 2 + ABS(fnt.minY), fnt, s, mode) ELSE (* formatted print *) p := 0; len := 0; h := 0; lspc := -1; WHILE s[p] # 0X DO 			fnt.GetObj(fnt, ORD(s[p]), r); IF len + r(Fonts.Char).dx >= W THEN (* too long next line *) IF s[p] = " " THEN lspc := -1; s[p] := 1X; INC(h, fnt.height); len := 0 ELSIF lspc > 0 THEN (* space exists *) p := lspc; lspc := -1; s[p] := 1X; INC(h, fnt.height); len := 0 ELSE INC(len, r(Fonts.Char).dx) END ELSE INC(len, r(Fonts.Char).dx); IF s[p] = " " THEN lspc := p END END; INC(p) END; INC(h, fnt.height); (* print *) p := 0; i := 0; len := 0; y := Y + H DIV 2 + h DIV 2 + ABS(fnt.minY); WHILE s[p] # 0X DO 			fnt.GetObj(fnt, ORD(s[p]), r); IF s[p] = 1X THEN (* break *) s0[i] := 0X; i := 0; DEC(y, fnt.height); String(M, col, X + W DIV 2 - len DIV 2, y, fnt, s0, mode); len := 0 ELSE fnt.GetObj(fnt, ORD(s[p]), r); INC(len, r(Fonts.Char).dx); s0[i] := s[p]; INC(i) END; INC(p) END; DEC(y, fnt.height); IF i > 0 THEN s0[i] := 0X; String(M, col, X + W DIV 2 - len DIV 2, y, fnt, s0, mode) END END END CenterString; (** Return the size of a string in width w and height h. dsr returns the baseline offset as a positive value. *) PROCEDURE StringSize*(s: ARRAY OF CHAR; fnt: Fonts.Font; VAR w, h, dsr: INTEGER); VAR p: INTEGER; r: Objects.Object; BEGIN w := 0; h := fnt.height; dsr := ABS(fnt.minY); p := 0; WHILE s[p] # 0X DO 		fnt.GetObj(fnt, ORD(s[p]), r); INC(w, r(Fonts.Char).dx); INC(p) END END StringSize; PROCEDURE *EnumPict(X, Y, W, H: INTEGER); BEGIN Pictures.DisplayBlock(tmpP, X + dX, Y + dY, W, H, X, Y, tmpM); END EnumPict; (** Draw the area X, Y, W, H of picture P at position DX, DY on the display. *) PROCEDURE Pict*(M: Mask; P: Pictures.Picture; X, Y, W, H, DX, DY, mode: INTEGER); BEGIN dX := X - DX; dY :=Y - DY; ClipAgainst(DX, DY, W, H, M.X, M.Y, M.W, M.H); tmpP := P; tmpM := mode; EnumRect(M, DX, DY, W, H, EnumPict); tmpP := NIL; (* for GC *) END Pict; (** Replicate a picture filling area X, Y, W, H on the display. px, py is the picture pin-point. *) PROCEDURE ReplPict*(M: Mask; P: Pictures.Picture; px, py, X, Y, W, H, mode: INTEGER); VAR x, y, w, h, pw, ph, w0, x0: INTEGER; BEGIN pw := P.width; ph := P.height; w0 := W; x0 := X; 	WHILE H > 0 DO 		y := (Y - py) MOD ph; h := Min(H, ph - y); W := w0; X := x0; WHILE W > 0 DO 			x := (X - px) MOD pw; w := Min(W, pw - x); Pict(M, P, x, y, w, h, X, Y, mode); INC(X, w); DEC(W, w); END; INC(Y, h); DEC(H, h) 	END END ReplPict; PROCEDURE Init; VAR s: Texts.Scanner; BEGIN Oberon.OpenScanner(s, "Gadgets.Hardlook"); IF ((s.class = Texts.Name) OR (s.class = Texts.String)) & (CAP(s.s[0]) = "Y") THEN bottomC := Display.FG	(* hardlook *) ELSE bottomC := 12	(* softlook *) END END Init; BEGIN drawingPolygon := FALSE; selectpat := Display.grey1; FG := 15; BG := 0; red := 1; green := 2; blue := 3; black := Display.FG; white := Display.BG; IF Display.Depth(0) = 1 THEN topC := Display.FG; upC := Display.BG; downC := Display.BG; groupC := Display.BG; invertC := Display.FG; textC := Display.FG; textbackC := Display.BG; bottomC := Display.FG 	ELSE topC := Display.BG; upC := 13; downC := 12; groupC := 13; IF Display.TrueColor(0) THEN invertC := white ELSE invertC := 3 END; textC := Display.FG; textbackC := 14; Init END; textmode := Display.paint END Display3. (** Remarks: 1. Clipping Masks Built on top of the Display module, the Display3 module is the basis of the gadgets imaging model. It extends the Display module with more advanced clipped drawing primitives like lines, polygonal lines, ellipses, circles etc. A clipping mask indicates which areas on the display can be drawn in. You can imagine the mask to be a sheet of paper, possibly full of holes, and a display primitive being a spray can. The holes are all rectangular, and may overlap (i.e. only rectangular holes can be cut out of the paper). Just as you can move the piece of paper to spray an image at a new location, the mask can be translated by a translation vector (also refered to as the mask origin). By default, the holes of a mask are always defined relative to the origin (0, 0). The origin can be translated, efficiently moving the mask to a different position. In the MaskDesc, the fields x, y specify the mask origin/translation vector. It can be changed directly as needed. Internally masks are sets of non-overlapping rectangles, where each rectangle has a flag to indicate if drawing is allowed in that area or not. After each operation that changes the mask, the mask is checked to see if it might be optimal, i.e. if it is a single rectangular visible area. The latter case is handled separately, allowing more efficient drawing and masking operations. The construction of a mask is more heavyweight in comparison to drawing through a mask, mainly due to the latter checks. Masks should be generated once, and then left unchanged for as long as possible. 2. Clipping Ports Clipping ports are used to optimize masks operations. A clipping port is an absolutely positioned rectangular area through which all display operations are clipped (a clipping rectangle). The mask and clipping port form together the clipped region, where drawing primitives are first clipped to the mask, and then to the clipping port. This is an implementation of the following idea. Each gadget on the display can be overlapped by other visual objects, and potentially need to clip itself when displayed. Each gadget is thus allocated a static clipping mask. In some cases however, only parts of a gadget need to be redisplayed, for example when a gadget lying partially in front is removed. Rather than creating a new clipping mask just for this simple case, the clipping port can manipulated to indicate which "sub-area" of a gadget must be drawn. The key idea is thus to restrict the clipping mask of a gadget without actually changing the mask (a potentially expensive operation). The clipping port is set by the rectangle X, Y, W, H in the MaskDesc. These are absolute display coordinates. Programmers are allowed to manipulate the clipping port directly or use Display3.AdjustMask. 3. OverlapMsg and UpdateMaskMsg Each gadget has a (cached) display mask associated with it, even if it is completely visible. This mask is used when a gadget wants to draw on the display. Each parent visual gadget (container) has to manage the display masks of its children. The Display3 module provides messages for requesting a mask and for setting a mask. The OverlapMsg informs a gadget of its display mask. It is sent directly to a visual gadget by its parent. After some editing operations it may happen that a gadgets' mask has become invalid, in which case it is set to nothing (NIL). Should the gadget notice that it has no mask when it wants to draw itself, it may broadcast an UpdateMaskMsg to indicate that the parent must create a mask for it (the gadget itself is identified by the F field in the frame message). The latter should then calculate the mask, and inform the gadget using the OverlapMsg. In some cases, a parent can indicate to a child that its mask is not valid any more, by sending an OverlapMsg with no mask (M.M = NIL). *)

title: Oberon/ETH Oberon/2.3.7/Display3.Mod


text:
Oberon/ETH Oberon/2.3.7/Displays.Colors.Mod

(* ETH Oberon, Copyright 1990-2003 Computer Systems Institute, ETH Zurich, CH-8092 Zurich. Refer to the license.txt file provided with this distribution. *) MODULE Colors; (** portable **)	(* eos 06.09.21 07.01.29 *) (** 		Color conversions and abstract color objects 	**) IMPORT Files, Objects, Displays, Display, Strings; CONST undefined* = -1; red* = 0; yellow* = 1/6; green* = 2/6; cyan* = 3/6; blue* = 4/6; magenta* = 5/6;	(** hues **) TYPE (** color objects **) Color* = POINTER TO ColorDesc; ColorDesc* = RECORD (Objects.ObjDesc) r, g, b: REAL;	(* internal representation is RGB *) END; (** inverse color lookup table **) Index* = RECORD bits: INTEGER;	(* number of bits per component in color cube *) cube: POINTER TO ARRAY OF CHAR;	(* maps RGB triples to palette indices, size is (2^bits)^3 *) END; VAR DisplayIndex*: Index;	(** inverse color lookup table for display palette **) DisplayBits*: INTEGER;	(** number of bits used for DisplayIndex **) Red*, Green*, Blue*: ARRAY 256 OF INTEGER;	(** copy of display palette (faster lookup) **) (**--- Inverse Color Lookup ---**) (** return index of best match in inverse color lookup table **) PROCEDURE Match* (index: Index; bits, red, green, blue: INTEGER): INTEGER; VAR shift: INTEGER; BEGIN IF bits > 6 THEN bits := 6 END; shift := bits-8; RETURN ORD(index.cube[ASH(ASH(red, shift), 2*bits) + ASH(ASH(green, shift), bits) + ASH(blue, shift)]) END Match; (** initialize inverse color lookup table **) PROCEDURE MakeIndex* (VAR index: Index; bits, colors: INTEGER; VAR red, green, blue: ARRAY OF INTEGER); VAR nbits, x, colormax, cur, rcol, gcol, bcol: INTEGER; xsqr, txsqr, rstride, gstride, size, i, rdist, gdist, bdist, cdist: LONGINT; dbuf: POINTER TO ARRAY OF LONGINT; rcenter, gcenter, bcenter, ghere, bhere, gmin, bmin, gmax, bmax: INTEGER; incr, incg, incb, p, rp, gp: LONGINT; ginc, binc: LONGINT; PROCEDURE blueloop: BOOLEAN; VAR detect: BOOLEAN; blue: INTEGER; bp, bdist, bxx: LONGINT; BEGIN detect := FALSE; blue := bhere; bp := gp; bdist := gdist; bxx := binc; WHILE (blue < bmax) & (dbuf[bp] <= bdist) DO 				INC(blue); INC(bp); INC(bdist, bxx); INC(bxx, txsqr) END; IF blue < bmax THEN	(* found applicable cell *) IF blue > bhere THEN bhere := blue; gp := bp; gdist := bdist; binc := bxx END; detect := TRUE; WHILE (blue < bmax) & (dbuf[bp] > bdist) DO 					dbuf[bp] := bdist; index.cube[bp] := CHR(cur); INC(blue); INC(bp); INC(bdist, bxx); INC(bxx, txsqr) END END; blue := bhere-1; bp := gp-1; bxx := binc - txsqr; bdist := gdist - bxx; IF ~detect THEN WHILE (blue >= bmin) & (dbuf[bp] <= bdist) DO 					DEC(blue); DEC(bp); DEC(bxx, txsqr); DEC(bdist, bxx) END; IF blue >= bmin THEN bhere := blue; gp := bp; gdist := bdist; binc := bxx; detect := TRUE END END; WHILE (blue >= bmin) & (dbuf[bp] > bdist) DO 				dbuf[bp] := bdist; index.cube[bp] := CHR(cur); DEC(blue); DEC(bp); DEC(bxx, txsqr); DEC(bdist, bxx) END; RETURN detect END blueloop; PROCEDURE greenloop: BOOLEAN; VAR detect: BOOLEAN; green: INTEGER; ggp, ggdist, gxx: LONGINT; BEGIN detect := FALSE; bhere := bcenter; bmin := 0; bmax := colormax; binc := incb;	(* restart blueloop *) green := ghere; gp := rp; ggp := gp; gdist := rdist; ggdist := gdist; gxx := ginc; WHILE green < gmax DO 				IF blueloop THEN IF ~detect THEN IF green > ghere THEN ghere := green; rp := ggp; rdist := ggdist; ginc := gxx END; detect := TRUE END; INC(green); INC(gp, gstride); INC(ggp, gstride); INC(gdist, gxx); INC(ggdist, gxx); INC(gxx, txsqr) ELSIF ~detect THEN green := gmax ELSE INC(green); INC(gp, gstride); INC(ggp, gstride); INC(gdist, gxx); INC(ggdist, gxx); INC(gxx, txsqr) END END; bhere := bcenter; bmin := 0; bmax := colormax; binc := incb;	(* restart blueloop *) green := ghere-1; gp := rp - gstride; ggp := gp; gxx := ginc - txsqr; gdist := rdist - gxx; ggdist := gdist; WHILE green >= gmin DO 				IF blueloop THEN IF ~detect THEN ghere := green; rp := ggp; rdist := ggdist; ginc := gxx; detect := TRUE END; DEC(green); DEC(gp, gstride); DEC(ggp, gstride); DEC(gxx, txsqr); DEC(gdist, gxx); DEC(ggdist, gxx) ELSIF ~detect THEN green := gmin-1 ELSE DEC(green); DEC(gp, gstride); DEC(ggp, gstride); DEC(gxx, txsqr); DEC(gdist, gxx); DEC(ggdist, gxx) END END; RETURN detect END greenloop; PROCEDURE redloop; VAR detect: BOOLEAN; red: INTEGER; rxx: LONGINT; BEGIN (* red up loop *) detect := FALSE; ghere := gcenter; gmin := 0; gmax := colormax; ginc := incg;	(* restart greenloop *) red := rcenter; rp := p; rdist := cdist; rxx := incr; WHILE red < colormax DO 				IF greenloop THEN detect := TRUE; INC(red); INC(rp, rstride); INC(rdist, rxx); INC(rxx, txsqr) ELSIF detect THEN red := colormax	(* leave loop *) ELSE INC(red); INC(rp, rstride); INC(rdist, rxx); INC(rxx, txsqr) END END; (* red down loop *) ghere := gcenter; gmin := 0; gmax := colormax; ginc := incg;	(* restart greenloop *) red := rcenter-1; rp := p - rstride; rxx := incr - txsqr; rdist := cdist - rxx; WHILE red >= 0 DO 				IF greenloop THEN detect := TRUE; DEC(red); DEC(rp, rstride); DEC(rxx, txsqr); DEC(rdist, rxx) ELSIF detect THEN red := -1	(* leave loop *) ELSE DEC(red); DEC(rp, rstride); DEC(rxx, txsqr); DEC(rdist, rxx) END END END redloop; BEGIN (* uses Spencer W. Thomas' algorithm from Graphics Gems II (ugly as it is) *) ASSERT(colors <= 256, 100); IF bits > 6 THEN bits := 6 END;	(* (2^6)^3 = 262144! *) nbits := 8-bits; x := SHORT(ASH(1, nbits)); xsqr := ASH(1, 2*nbits); txsqr := 2*xsqr; colormax := SHORT(ASH(1, bits)); rstride := ASH(1, 2*bits); gstride := colormax; (* fill buffer with maximal distance *) size := ASH(1, 3*bits); NEW(dbuf, size); i := 0; WHILE i < size DO dbuf[i] := MAX(LONGINT); INC(i) END; IF (index.cube = NIL) OR (LEN(index.cube^) < size) THEN NEW(index.cube, size) END; index.bits := bits; cur := 0; WHILE cur < colors DO 			rcol := red[cur]; rcenter := SHORT(ASH(rcol, -nbits)); rdist := rcol - (rcenter * x + x DIV 2); gcol := green[cur]; gcenter := SHORT(ASH(gcol, -nbits)); gdist := gcol - (gcenter * x + x DIV 2); bcol := blue[cur]; bcenter := SHORT(ASH(bcol, -nbits)); bdist := bcol - (bcenter * x + x DIV 2); cdist := rdist * rdist + gdist * gdist + bdist * bdist; incr := 2*((rcenter+1) * xsqr - rcol * x); incg := 2*((gcenter+1) * xsqr - gcol * x); incb := 2*((bcenter+1) * xsqr - bcol * x); p := rcenter * rstride + gcenter * gstride + bcenter; redloop; INC(cur) END END MakeIndex; (** update the inverse color lookup table for the display palette **) PROCEDURE Update*; VAR colors, n: INTEGER; d: Displays.Display; col: LONGINT; BEGIN d := Displays.main; IF (d # NIL) & (d.format = Displays.index8) THEN	(* use real palette *) IF d.IndexToColor(0) = d.IndexToColor(16) THEN colors := 16 ELSE colors := 256 END; FOR n := 0 TO colors-1 DO 				col := d.IndexToColor(n); Red[n] := SHORT(ASH(col, -16) MOD 100H); Green[n] := SHORT(ASH(col, -8) MOD 100H); Blue[n] := SHORT(col MOD 100H) END; MakeIndex(DisplayIndex, DisplayBits, colors, Red, Green, Blue) ELSE colors := SHORT(ASH(1, Display.Depth(Display.ColLeft))); IF colors > 256 THEN colors := 256 END; FOR n := 0 TO colors-1 DO 				Display.GetColor(n, Red[n], Green[n], Blue[n]) END; MakeIndex(DisplayIndex, DisplayBits, colors, Red, Green, Blue) END END Update; (**--- Conversion Routines ---**) (** Oberon display model **) PROCEDURE DisplayToRGB* (dcol: Display.Color; VAR r, g, b: REAL); VAR dr, dg, db: INTEGER; BEGIN IF dcol < 0 THEN Display.GetColor(dcol, dr, dg, db) ELSE dr := Red[dcol]; dg := Green[dcol]; db := Blue[dcol] END; r := (1/255)*dr; g := (1/255)*dg; b := (1/255)*db END DisplayToRGB; PROCEDURE RGBToDisplay* (r, g, b: REAL; VAR dcol: Display.Color); VAR dr, dg, db: LONGINT; BEGIN dr := ENTIER(255*r); dg := ENTIER(255*g); db := ENTIER(255*b); IF Display.TrueColor(Display.ColLeft) THEN dcol := Display.RGB(dr, dg, db) ELSE dcol := Match(DisplayIndex, DisplayBits, SHORT(dr), SHORT(dg), SHORT(db)) END END RGBToDisplay; (** HSV (Hue Saturation Value) model **) PROCEDURE RGBToHSV* (r, g, b: REAL; VAR h, s, v: REAL); VAR min, d: REAL; BEGIN (* conversion algorithm: Foley et al. fig 13.33 *) IF r < g THEN IF g < b THEN min := r; v := b 			ELSIF b < r THEN min := b; v := g 			ELSE min := r; v := g 			END ELSE IF b > r THEN min := g; v := b 			ELSIF g > b THEN min := b; v := r 			ELSE min := g; v := r 			END END; d := v - min; IF v = 0 THEN s := 0	(* black is a special case with saturation 0 *) ELSE s := d/v END; IF s = 0 THEN	(* achromatic case *) h := undefined ELSE IF r = v THEN h := (g - b)/d	(* hue between yellow and magenta *) ELSIF g = v THEN h := 2 + (b - r)/d	(* hue between cyan and yellow *) ELSE h := 4 + (r - g)/d	(* hue between magenta and cyan *) END; h := (1/6)*h; IF h < 0 THEN h := h+1 ELSIF h >= 1 THEN h := h-1 END END END RGBToHSV; PROCEDURE HSVToRGB* (h, s, v: REAL; VAR r, g, b: REAL); VAR i: LONGINT; f, p, q, t: REAL; BEGIN (* conversion algorithm: Foley et al. fig 13.34 *) IF s = 0 THEN	(* achromatic case *) r := v; g := v; b := v 		ELSE h := 6*h; i := ENTIER(h); f := h - i; 			p := v * (1-s); q := v * (1 - s*f); t := v * (1 - s*(1-f)); CASE i MOD 6 OF 			| 0: r := v; g := t; b := p 			| 1: r := q; g := v; b := p 			| 2: r := p; g := v; b := t 			| 3: r := p; g := q; b := v 			| 4: r := t; g := p; b := v 			| 5: r := v; g := p; b := q 			END END END HSVToRGB; (** CMY (Cyan Magenta Yellow) model **) PROCEDURE RGBToCMY* (r, g, b: REAL; VAR c, m, y: REAL); BEGIN c := 1 - r; m := 1 - g; y := 1 - b 	END RGBToCMY; PROCEDURE CMYToRGB* (c, m, y: REAL; VAR r, g, b: REAL); BEGIN r := 1 - c; g := 1 - m; b := 1 - y 	END CMYToRGB; (** CMYK (Cyan Magenta Yellow blacK) model **) PROCEDURE RGBToCMYK* (r, g, b: REAL; VAR c, m, y, k: REAL); BEGIN c := 1 - r; m := 1 - g; y := 1 - b; 		IF r < g THEN IF b < r THEN k := b 			ELSE k := r 			END ELSE IF b < g THEN k := b 			ELSE k := g 			END END; c := c - k; m := m - k; y := y - k 	END RGBToCMYK; PROCEDURE CMYKToRGB* (c, m, y, k: REAL; VAR r, g, b: REAL); BEGIN r := 1 - (k + c); g := 1 - (k + m); b := 1 - (k + y) 	END CMYKToRGB; (**--- Colors ---**) (** copy color contents **) PROCEDURE Copy* (VAR msg: Objects.CopyMsg; from, to: Color); BEGIN to.handle := from.handle; to.r := from.r; to.g := from.g; to.b := from.b 	END Copy; (** message handler **) PROCEDURE Handle* (obj: Objects.Object; VAR msg: Objects.ObjMsg); VAR col, copy: Color; x, y, z, w: REAL; lib: Objects.Library; ref: INTEGER; ver: LONGINT; BEGIN col := obj(Color); IF msg IS Objects.AttrMsg THEN WITH msg: Objects.AttrMsg DO 				IF msg.id = Objects.enum THEN msg.Enum("RedGB"); msg.Enum("RGreenB"); msg.Enum("RGBlue"); msg.Enum("Color"); msg.Enum("HueSV"); msg.Enum("HSaturationV"); msg.Enum("HSValue"); msg.Enum("CyanMY"); msg.Enum("CMagentaY"); msg.Enum("CMYellow"); msg.Enum("CyanMYK"); msg.Enum("CMagentaYK"); msg.Enum("CMYellowK"); msg.Enum("CMYblacK") ELSIF msg.id = Objects.get THEN IF msg.name = "Gen" THEN msg.class := Objects.String; msg.s := "Colors.New"; msg.res := 0 ELSIF msg.name = "RedGB" THEN msg.class := Objects.Real; msg.x := col.r; msg.res := 0 ELSIF msg.name = "RGreenB" THEN msg.class := Objects.Real; msg.x := col.g; msg.res := 0 ELSIF msg.name = "RGBlue" THEN msg.class := Objects.Real; msg.x := col.b; msg.res := 0 ELSIF msg.name = "Color" THEN msg.class := Objects.Int; RGBToDisplay(col.r, col.g, col.b, msg.i); msg.res := 0 ELSIF msg.name = "HueSV" THEN msg.class := Objects.Real; RGBToHSV(col.r, col.g, col.b, msg.x, x, y); msg.res := 0 ELSIF msg.name = "HSaturationV" THEN msg.class := Objects.Real; RGBToHSV(col.r, col.g, col.b, x, msg.x, y); msg.res := 0 ELSIF msg.name = "HSValue" THEN msg.class := Objects.Real; RGBToHSV(col.r, col.g, col.b, x, y, msg.x); msg.res := 0 ELSIF msg.name = "CyanMY" THEN msg.class := Objects.Real; RGBToCMY(col.r, col.g, col.b, msg.x, x, y); msg.res := 0 ELSIF msg.name = "CMagentaY" THEN msg.class := Objects.Real; RGBToCMY(col.r, col.g, col.b, x, msg.x, y); msg.res := 0 ELSIF msg.name = "CMYellow" THEN msg.class := Objects.Real; RGBToCMY(col.r, col.g, col.b, x, y, msg.x); msg.res := 0 ELSIF msg.name = "CyanMYK" THEN msg.class := Objects.Real; RGBToCMYK(col.r, col.g, col.b, msg.x, x, y, z); msg.res := 0 ELSIF msg.name = "CMagentaYK" THEN msg.class := Objects.Real; RGBToCMYK(col.r, col.g, col.b, x, msg.x, y, z); msg.res := 0 ELSIF msg.name = "CMYellowK" THEN msg.class := Objects.Real; RGBToCMYK(col.r, col.g, col.b, x, y, msg.x, z); msg.res := 0 ELSIF msg.name = "CMYblacK" THEN msg.class := Objects.Real; RGBToCMYK(col.r, col.g, col.b, x, y, z, msg.x); msg.res := 0 ELSIF msg.name = "Red255" THEN msg.class := Objects.Int; msg.i := ENTIER(255*col.r); msg.res := 0 ELSIF msg.name = "Green255" THEN msg.class := Objects.Int; msg.i := ENTIER(255*col.g); msg.res := 0 ELSIF msg.name = "Blue255" THEN msg.class := Objects.Int; msg.i := ENTIER(255*col.b); msg.res := 0 ELSIF msg.name = "Hue360" THEN RGBToHSV(col.r, col.g, col.b, x, y, z); IF x < 0 THEN msg.class := Objects.String; msg.s := ""; msg.res := 0 ELSE msg.class := Objects.Int; msg.i := ENTIER(360*x); msg.res := 0 END ELSIF msg.name = "Saturation100" THEN msg.class := Objects.Int; RGBToHSV(col.r, col.g, col.b, x, y, z); msg.i := ENTIER(100*y); msg.res := 0 ELSIF msg.name = "Value100" THEN msg.class := Objects.Int; RGBToHSV(col.r, col.g, col.b, x, y, z); msg.i := ENTIER(100*z); msg.res := 0 END ELSIF msg.id = Objects.set THEN IF msg.class = Objects.Int THEN msg.x := msg.i 					ELSIF msg.class = Objects.LongReal THEN msg.x := SHORT(msg.y); msg.i := ENTIER(msg.x) 					ELSIF msg.class = Objects.String THEN Strings.StrToReal(msg.s, msg.y); msg.x := SHORT(msg.y); Strings.StrToInt(msg.s, msg.i) 					ELSIF msg.class = Objects.Real THEN msg.i := ENTIER(msg.x) 					ELSE RETURN END; IF (msg.name = "RedGB") & (0 <= msg.x) & (msg.x <= 1) THEN col.r := msg.x; msg.res := 0 ELSIF (msg.name = "RGreenB") & (0 <= msg.x) & (msg.x <= 1) THEN col.g := msg.x; msg.res := 0 ELSIF (msg.name = "RGBlue") & (0 <= msg.x) & (msg.x <= 1) THEN col.b := msg.x; msg.res := 0 ELSIF (msg.name = "Color") & (msg.i < 256) THEN DisplayToRGB(msg.i, col.r, col.g, col.b); msg.res := 0 ELSIF (msg.name = "HueSV") & (0 <= msg.x) & (msg.x <= 1) THEN RGBToHSV(col.r, col.g, col.b, x, y, z); HSVToRGB(msg.x, y, z, col.r, col.g, col.b); msg.res := 0 ELSIF (msg.name = "HSaturationV") & (0 <= msg.x) & (msg.x <= 1) THEN RGBToHSV(col.r, col.g, col.b, x, y, z); HSVToRGB(x, msg.x, z, col.r, col.g, col.b); msg.res := 0 ELSIF (msg.name = "HSValue") & (0 <= msg.x) & (msg.x <= 1) THEN RGBToHSV(col.r, col.g, col.b, x, y, z); HSVToRGB(x, y, msg.x, col.r, col.g, col.b); msg.res := 0 ELSIF (msg.name = "CyanMY") & (0 <= msg.x) & (msg.x <= 1) THEN RGBToCMY(col.r, col.g, col.b, x, y, z); CMYToRGB(msg.x, y, z, col.r, col.g, col.b); msg.res := 0 ELSIF (msg.name = "CMagentaY") & (0 <= msg.x) & (msg.x <= 1) THEN RGBToCMY(col.r, col.g, col.b, x, y, z); CMYToRGB(x, msg.x, z, col.r, col.g, col.b); msg.res := 0 ELSIF (msg.name = "CMYellow") & (0 <= msg.x) & (msg.x <= 1) THEN RGBToCMY(col.r, col.g, col.b, x, y, z); CMYToRGB(x, y, msg.x, col.r, col.g, col.b); msg.res := 0 ELSIF (msg.name = "CyanMYK") & (0 <= msg.x) & (msg.x <= 1) THEN RGBToCMYK(col.r, col.g, col.b, x, y, z, w); CMYKToRGB(msg.x, y, z, w, col.r, col.g, col.b); msg.res := 0 ELSIF (msg.name = "CMagentaYK") & (0 <= msg.x) & (msg.x <= 1) THEN RGBToCMYK(col.r, col.g, col.b, x, y, z, w); CMYKToRGB(x, msg.x, z, w, col.r, col.g, col.b); msg.res := 0 ELSIF (msg.name = "CMYellowK") & (0 <= msg.x) & (msg.x <= 1) THEN RGBToCMYK(col.r, col.g, col.b, x, y, z, w); CMYKToRGB(x, y, msg.x, w, col.r, col.g, col.b); msg.res := 0 ELSIF (msg.name = "CMYblacK") & (0 <= msg.x) & (msg.x <= 1) THEN RGBToCMYK(col.r, col.g, col.b, x, y, z, w); CMYKToRGB(x, y, z, msg.x, col.r, col.g, col.b); msg.res := 0 ELSIF (msg.name = "Red255") & (0 <= msg.i) & (msg.i < 256) THEN col.r := msg.i/255; msg.res := 0 ELSIF (msg.name = "Green255") & (0 <= msg.i) & (msg.i < 256) THEN col.g := msg.i/255; msg.res := 0 ELSIF (msg.name = "Blue255") & (0 <= msg.i) & (msg.i < 256) THEN col.b := msg.i/255; msg.res := 0 ELSIF (msg.name = "Hue360") & (0 <= msg.i) & (msg.i < 360) THEN RGBToHSV(col.r, col.g, col.b, x, y, z); IF (msg.class = Objects.String) & (msg.s = "") THEN HSVToRGB(-1, 0, z, col.r, col.g, col.b); msg.res := 0 ELSE HSVToRGB(msg.i/360, y, z, col.r, col.g, col.b); msg.res := 0 END ELSIF (msg.name = "Saturation100") & (0 <= msg.i) & (msg.i <= 100) THEN RGBToHSV(col.r, col.g, col.b, x, y, z); HSVToRGB(x, msg.i/100, z, col.r, col.g, col.b); msg.res := 0 ELSIF (msg.name = "Value100") & (0 <= msg.i) & (msg.i <= 100) THEN RGBToHSV(col.r, col.g, col.b, x, y, z); HSVToRGB(x, y, msg.i/100, col.r, col.g, col.b); msg.res := 0 END END END ELSIF msg IS Objects.CopyMsg THEN WITH msg: Objects.CopyMsg DO 				IF msg.stamp # col.stamp THEN NEW(copy); col.dlink := copy; col.stamp := msg.stamp; Copy(msg, col, copy) END; msg.obj := col.dlink END ELSIF msg IS Objects.BindMsg THEN lib := msg(Objects.BindMsg).lib; IF (lib # NIL) & ((col.lib = NIL) OR (col.lib.name[0] = 0X) & (col.lib # lib)) THEN lib.GenRef(lib, ref); IF ref >= 0 THEN lib.PutObj(lib, ref, col) END END ELSIF msg IS Objects.FileMsg THEN WITH msg: Objects.FileMsg DO 				IF msg.id = Objects.store THEN Files.WriteNum(msg.R, 1); Files.WriteReal(msg.R, col.r); Files.WriteReal(msg.R, col.g); Files.WriteReal(msg.R, col.b) 				ELSIF msg.id = Objects.load THEN Files.ReadNum(msg.R, ver); Files.ReadReal(msg.R, col.r); Files.ReadReal(msg.R, col.g); Files.ReadReal(msg.R, col.b) 				END END END END Handle; (** generator command **) PROCEDURE New*; VAR col: Color; BEGIN NEW(col); col.handle := Handle; Objects.NewObj := col END New; (** initialization **) PROCEDURE InitRGB* (col: Color; r, g, b: REAL); BEGIN col.handle := Handle; col.r := r; col.g := g; col.b := b 	END InitRGB; PROCEDURE InitDisplay* (col: Color; dcol: Display.Color); BEGIN col.handle := Handle; DisplayToRGB(dcol, col.r, col.g, col.b) 	END InitDisplay; PROCEDURE InitHSV* (col: Color; h, s, v: REAL); BEGIN col.handle := Handle; HSVToRGB(h, s, v, col.r, col.g, col.b) 	END InitHSV; PROCEDURE InitCMY* (col: Color; c, m, y: REAL); BEGIN col.handle := Handle; CMYToRGB(c, m, y, col.r, col.g, col.b) 	END InitCMY; PROCEDURE InitCMYK* (col: Color; c, m, y, k: REAL); BEGIN col.handle := Handle; CMYKToRGB(c, m, y, k, col.r, col.g, col.b) 	END InitCMYK; (** get color values **) PROCEDURE GetRGB* (col: Color; VAR r, g, b: REAL); BEGIN r := col.r; g := col.g; b := col.b 	END GetRGB; PROCEDURE GetDisplay* (col: Color; VAR dcol: Display.Color); BEGIN RGBToDisplay(col.r, col.g, col.b, dcol) END GetDisplay; PROCEDURE GetHSV* (col: Color; VAR h, s, v: REAL); BEGIN RGBToHSV(col.r, col.g, col.b, h, s, v) 	END GetHSV; PROCEDURE GetCMY* (col: Color; VAR c, m, y: REAL); BEGIN RGBToCMY(col.r, col.b, col.b, c, m, y) 	END GetCMY; PROCEDURE GetCMYK* (col: Color; VAR c, m, y, k: REAL); BEGIN RGBToCMYK(col.r, col.g, col.b, c, m, y, k) 	END GetCMYK; (** set color values **) PROCEDURE SetRGB* (col: Color; r, g, b: REAL); BEGIN col.r := r; col.g := g; col.b := b 	END SetRGB; PROCEDURE SetDisplay* (col: Color; dcol: Display.Color); BEGIN DisplayToRGB(dcol, col.r, col.g, col.b) 	END SetDisplay; PROCEDURE SetHSV* (col: Color; h, s, v: REAL); BEGIN HSVToRGB(h, s, v, col.r, col.g, col.b) 	END SetHSV; PROCEDURE SetCMY* (col: Color; c, m, y: REAL); BEGIN CMYToRGB(c, m, y, col.r, col.b, col.b) 	END SetCMY; PROCEDURE SetCMYK* (col: Color; c, m, y, k: REAL); BEGIN CMYKToRGB(c, m, y, k, col.r, col.b, col.b) 	END SetCMYK; BEGIN DisplayBits := 4; Update END Colors. (** Notes 1. Color Conversions In order to support RGB, HSV, CMY(K) and the Oberon display color model, several procedures convert from RGB to another model or vice versa. The range of all components is usually [0..1], except for display colors which are integers ranging from 0 to 255 (palette color) or from MIN(LONGINT) to -1 (true color). 2. Color Objects Color objects are extensions of Objects.Object and can thus be used as models for visual gadgets which deal with color. Their internal representation is kept private, but components for all color models are accessible as object attributes. 3. Inverse Color Lookup To speed up the conversion from an RGB triple to a palette index, an inverse color mapping can be computed with MakeIndex. The more bits are used for the index structure, the more memory is consumed. A reasonable value for bits is 4, allocating 4096 bytes on the heap. 4. Display Colors The colors in the Oberon default palette are mirrored in global variables Red, Green and Blue. An inverse color lookup table using DisplayBits is available in DisplayIndex. When the display palette is modified, Update should be called to adapt all of these to the new palette. **)

license: Creative Commons - Attribution Share-Alike - https://creativecommons.org/licenses/by-sa/4.0/


text:
Oberon/ETH Oberon/2.3.7/DisplayBackdrop.Mod

(* ETH Oberon, Copyright 1990-2003 Computer Systems Institute, ETH Zurich, CH-8092 Zurich. Refer to the license.txt file provided with this distribution. *) MODULE DisplayBackdrop;	(* pjm *) (* Display a backdrop in the user track filler *) IMPORT Modules, Objects, Display, Viewers, Texts, Oberon, Effects, Display3, Colors, Images, ImageGadgets, ColorModels; VAR oldhandle: Objects.Handler; fill: Display.Frame; f: ImageGadgets.Frame; color: Display.Color; PROCEDURE Restore(x, y, w, h: INTEGER); VAR fx, fy: INTEGER; m: Display3.Mask; BEGIN IF f.W >= fill.W THEN fx := 0 ELSE fx := (fill.W-f.W) DIV 2 END; IF f.H >= Display.Height THEN fy := 0 ELSE fy := (Display.Height-f.H) DIV 2 END; NEW(f.mask); Display3.Open(f.mask); Display3.Add(f.mask, x, y, w, h); Display3.Copy(f.mask, m); Display3.Subtract(m, fx, fy, f.W, f.H); Oberon.RemoveMarks(x, y, w, h); Display3.ReplConst(m, color, x, y, w, h, Display.replace); ImageGadgets.Restore(f, 0, 0, f.W, f.H, fx, fy, f.mask) END Restore; PROCEDURE Handler(v: Objects.Object; VAR m: Objects.ObjMsg); BEGIN WITH v: Viewers.Viewer DO 		IF m IS Display.DisplayMsg THEN WITH m: Display.DisplayMsg DO 				IF (m.device = Display.screen) & ((m.F = v) OR (m.F = NIL)) THEN Restore(v.X, v.Y, v.W, v.H) 				ELSE oldhandle(v, m) 				END END ELSIF m IS Display.ControlMsg THEN WITH m: Display.ControlMsg DO 				IF (m.id = Display.restore) & (v.W > 0) & (v.H > 0) THEN Restore(v.X, v.Y, v.W, v.H) 				ELSE oldhandle(v, m) 				END END ELSIF m IS Display.ModifyMsg THEN WITH m: Display.ModifyMsg DO 				IF (m.F = v) & (m.id = Display.extend) THEN Restore(v.X, m.Y, v.W, v.Y - m.Y) 				ELSE oldhandle(v, m) 				END END ELSIF m IS Oberon.InputMsg THEN WITH m: Oberon.InputMsg DO 				IF m.id = Oberon.track THEN Oberon.DrawCursor(Oberon.Mouse, Effects.Arrow, m.X, m.Y) 				ELSE oldhandle(v, m) 				END END ELSE oldhandle(v, m) 		END END END Handler; PROCEDURE Close*; VAR ctrl: Display.ControlMsg; BEGIN IF fill # NIL THEN fill.handle := oldhandle; IF (fill.W > 0) & (fill.H > 0) THEN ctrl.id := Display.restore; ctrl.F := NIL;  ctrl.x := 0;  ctrl.y := 0;  ctrl.res := -1; fill.handle(fill, ctrl) END; fill := NIL; f := NIL END END Close; PROCEDURE Open*;	(* name [color] *) VAR bot, alt, max: Display.Frame; done: BOOLEAN;  name: ARRAY 32 OF CHAR; m: Images.Image; s: Texts.Scanner;  r, g, b: REAL;  ok: BOOLEAN; BEGIN Texts.OpenScanner(s, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(s); IF s.class = Texts.Name THEN COPY(s.s, name); color := 12; Texts.Scan(s); IF s.class = Texts.Int THEN color := s.i 		ELSIF s.class = Texts.Name THEN ColorModels.StrToRGB(s.s, r, g, b, ok); IF ok THEN IF Display.TrueColor(0) THEN color := Display.RGB(ENTIER(r*255), ENTIER(g*255), ENTIER(b*255)) ELSE color := Colors.Match(Colors.DisplayIndex, Colors.DisplayBits, SHORT(ENTIER(r*255)), SHORT(ENTIER(g*255)), SHORT(ENTIER(b*255))) END END ELSE (* skip *) END; NEW(m); Images.Load(m, name, done); IF done THEN IF fill # NIL THEN Close END; NEW(f); ImageGadgets.Init(f, m); Viewers.Locate(0, 0, fill, bot, alt, max); oldhandle := fill.handle; fill.handle := Handler; IF (fill.W > 0) & (fill.H > 0) THEN Restore(fill.X, fill.Y, fill.W, fill.H) END END END END Open; BEGIN fill := NIL; Modules.InstallTermHandler(Close) END DisplayBackdrop. DisplayBackdrop.Open chagall1.jpg Black DisplayBackdrop.Open chapmanspeak.bmp RoyalBlue DisplayBackdrop.Open tafelbird.bmp DeepSkyBlue DisplayBackdrop.Open ArlesCloitre5.jpg DarkGoldenRod DisplayBackdrop.Open sunflowers.bmp DarkGoldenRod DisplayBackdrop.Close System.Free DisplayBackdrop ~


text:
Oberon/ETH Oberon/2.3.7/GfxDisplay.Mod

(* ETH Oberon, Copyright 1990-2003 Computer Systems Institute, ETH Zurich, CH-8092 Zurich. Refer to the license.txt file provided with this distribution. *) MODULE GfxDisplay; (** portable *)	(* eos 05.01.03 20:13:30 *) (** 		Raster contexts on Oberon display 	**) (* 		10.12.98 - first release; derived from former GfxDev 		16.4.99 - bugfix in CopyIndex and BlendIndex: used wrong offset into bitmap 		19.4.99 - uses Display transfer and truecolor functionality 		[26.5.99 - use 300 dpi metrics in Show (removed 14.7.99)] 		25.8.99 - replaced GfxMaps with Images/GfxImages 		10.8.99 - scratched SetPoint, added Close method 		17.11.1999 - added Colors 		13.02.2000 - new get/set clip methods 	*) IMPORT Display, Fonts, Colors, Images, GfxMatrix, GfxImages, GfxRegions, GfxFonts, Gfx, GfxRaster; CONST red = Images.r; green = Images.g; blue = Images.b; alpha = Images.a; 		MaxRun = 256; TYPE Context* = POINTER TO ContextDesc; ContextDesc* = RECORD (GfxRaster.ContextDesc) orgX*, orgY*: REAL;	(** origin of default coordinate system **) scale*: REAL;	(** scale factor of default coordinate system **) defClip*: GfxRegions.Region;	(** default clipping region **) bg*: Gfx.Color;	(** background color for erasing **) bgCol: Display.Color;	(* display color corresponding to background color *) bgPix: Images.Pixel;	(* pixel value corresponding to background color *) dcol: Display.Color;	(* current display color *) srcOverDst: Images.Mode;	(* srcOverDst mode with current color *) END; RegData = RECORD (GfxRegions.EnumData) dc: Context; dx, dy: INTEGER; pat: Display.Pattern; img: Images.Image; col: Display.Color; END; BlendDotProc = PROCEDURE (dc: Context; img: Images.Image; mx, my: INTEGER; x, y: LONGINT); CopyRunProc = PROCEDURE (img: Images.Image; mx, my, len: INTEGER; x, y: LONGINT); BlendRunProc = PROCEDURE (dc: Context; img: Images.Image; mx, my, len: INTEGER; x, y: LONGINT); WarpProc = PROCEDURE (dc: Context; img: Images.Image; dx, dy, x0, y0, x1, y1: INTEGER; VAR m: GfxMatrix.Matrix; VAR f: GfxImages.Filter); CopyImageProc = PROCEDURE (dc: Context; img: Images.Image; dx, dy: INTEGER; VAR filter: GfxImages.Filter); VAR TrueColor, TransferBlock: BOOLEAN;	(* set if corresponding Display features are available *) Methods: Gfx.Methods; BlendDot: BlendDotProc;	(* copies dot from pattern to display *) CopyRun: CopyRunProc;	(* copies run from image to display *) BlendRun: BlendRunProc;	(* blends buffer run with display *) TileRect: GfxRegions.Enumerator;	(* fills rectangular area with pattern *) Warp: WarpProc;	(* applies matrix to image and stores result in buffer *) BlendImageRect: GfxRegions.Enumerator;	(* blends image rectangle *) CopyImage: CopyImageProc;	(* copies visible parts of image to display *) Buffer: Images.Image;	(* shadow map *) PROCEDURE CreateBuffer (w, h: INTEGER); BEGIN (* 			Display.TransferBlock on Windows Oberon requires that the size of the supplied memory block is a 			multiple of 4 bytes. We therefore ensure that one row occupies at least 4 bytes and allocate one 			row more than requested. 		*) IF w * Images.DisplayFormat.bpp < 32 THEN w := 32 DIV Images.DisplayFormat.bpp END; Images.Create(Buffer, w, h+1, Images.DisplayFormat) END CreateBuffer; (*--- Blend Dot Into Display ---*) PROCEDURE BlendDotBlk (dc: Context; img: Images.Image; mx, my: INTEGER; x, y: LONGINT); VAR buf: ARRAY 4 OF CHAR; BEGIN IF Images.alpha IN img.fmt.components THEN	(* get original color from display *) Display.TransferBlock(buf, 0, 0, x, y, 1, 1, Display.get) END; Images.GetPixels(img, mx, my, 1, Images.DisplayFormat, buf, dc.srcOverDst); Display.TransferBlock(buf, 0, 0, x, y, 1, 1, Display.set) END BlendDotBlk; PROCEDURE BlendDotRGB (dc: Context; img: Images.Image; mx, my: INTEGER; x, y: LONGINT); VAR pix: Images.Pixel; BEGIN IF Images.alpha IN img.fmt.components THEN pix := dc.bgPix END; Images.GetPixels(img, mx, my, 1, Images.PixelFormat, pix, dc.srcOverDst); Display.Dot(Display.RGB(ORD(pix[red]), ORD(pix[green]), ORD(pix[blue])), x, y, Display.replace) END BlendDotRGB; PROCEDURE BlendDotIdx (dc: Context; img: Images.Image; mx, my: INTEGER; x, y: LONGINT); VAR buf: ARRAY 1 OF CHAR; BEGIN IF Images.alpha IN img.fmt.components THEN buf[0] := CHR(dc.bgCol) END; Images.GetPixels(img, mx, my, 1, Images.D8, buf, dc.srcOverDst); Display.Dot(ORD(buf[0]), x, y, Display.replace) END BlendDotIdx; PROCEDURE Dot (rc: GfxRaster.Context; x, y: LONGINT); VAR dc: Context; img: Images.Image; mw, mh, mx, my: INTEGER; BEGIN IF (rc.clipState = GfxRaster.In) OR 			(rc.clipState = GfxRaster.InOut) & GfxRegions.RectInside(SHORT(x), SHORT(y), SHORT(x+1), SHORT(y+1), rc.clipReg) THEN IF rc.pat = NIL THEN Display.Dot(rc(Context).dcol, x, y, Display.replace) ELSE dc := rc(Context); img := dc.pat.img; mw := img.width; mh := img.height; mx := SHORT(x - ENTIER(dc.orgX + dc.pat.px + 0.5)) MOD mw; my := SHORT(y - ENTIER(dc.orgY + dc.pat.py + 0.5)) MOD mh; BlendDot(dc, img, mx, my, x, y) 			END END END Dot; (*--- Draw Run ---*) PROCEDURE DrawRunRGB (VAR buf: ARRAY OF CHAR; len, x, y: LONGINT); VAR i, l: LONGINT; r, g, b: CHAR; BEGIN i := 0; WHILE len > 0 DO 			r := buf[i + red]; g := buf[i + green]; b := buf[i + blue]; INC(i, 3); l := 1; WHILE (l < len) & (buf[i + red] = r) & (buf[i + green] = g) & (buf[i + blue] = b) DO 				INC(i, 3); INC(l) END; Display.ReplConst(Display.RGB(ORD(r), ORD(g), ORD(b)), x, y, l, 1, Display.replace); INC(x, l); DEC(len, l) 		END END DrawRunRGB; PROCEDURE DrawRunIdx (VAR buf: ARRAY OF CHAR; len, x, y: LONGINT); VAR i, l: LONGINT; idx: CHAR; BEGIN i := 0; WHILE len > 0 DO 			idx := buf[i]; INC(i); l := 1; WHILE (l < len) & (buf[i] = idx) DO INC(i); INC(l) END; Display.ReplConst(ORD(idx), x, y, l, 1, Display.replace); INC(x, l); DEC(len, l) 		END END DrawRunIdx; (*--- Copy Image Run ---*) PROCEDURE CopyRunRGB (img: Images.Image; mx, my, len: INTEGER; x, y: LONGINT); VAR buf: ARRAY 3*MaxRun OF CHAR; BEGIN Images.GetPixels(img, mx, my, len, Images.BGR888, buf, Images.SrcCopy); DrawRunRGB(buf, len, x, y) 	END CopyRunRGB; PROCEDURE CopyRunIdx (img: Images.Image; mx, my, len: INTEGER; x, y: LONGINT); VAR buf: ARRAY MaxRun OF CHAR; BEGIN Images.GetPixels(img, mx, my, len, Images.D8, buf, Images.SrcCopy); DrawRunIdx(buf, len, x, y) 	END CopyRunIdx; (*--- Blend Image Run ---*) PROCEDURE BlendRunRGB (dc: Context; img: Images.Image; mx, my, len: INTEGER; x, y: LONGINT); VAR i, j, l: LONGINT; buf: ARRAY 3*MaxRun OF CHAR; alpha: ARRAY MaxRun OF CHAR; a, r, g, b: CHAR; BEGIN i := 0; j := 0; WHILE i < len DO 			buf[j + blue] := dc.bgPix[blue]; buf[j + green] := dc.bgPix[green]; buf[j + red] := dc.bgPix[red]; INC(i); INC(j, 3) END; Images.GetPixels(img, mx, my, len, Images.BGR888, buf, dc.srcOverDst); Images.GetPixels(img, mx, my, len, Images.A8, alpha, Images.SrcCopy); i := 0; j := 0; WHILE len > 0 DO 			a := alpha[i]; INC(i); IF a = 0X THEN INC(j, 3); INC(x); DEC(len) ELSE r := buf[j + red]; g := buf[j + green]; b := buf[j + blue]; INC(j, 3); l := 1; WHILE (l < len) & (alpha[i] # 0X) & (buf[j + red] = r) & (buf[j + green] = g) & (buf[j + blue] = b) DO 					INC(i); INC(j, 3); INC(l) END; Display.ReplConst(Display.RGB(ORD(r), ORD(g), ORD(b)), x, y, l, 1, Display.replace); INC(x, l); DEC(len, SHORT(l)) END END END BlendRunRGB; PROCEDURE BlendRunIdx (dc: Context; img: Images.Image; mx, my, len: INTEGER; x, y: LONGINT); VAR i, l: LONGINT; buf, alpha: ARRAY MaxRun OF CHAR; idx: CHAR; BEGIN i := 0; WHILE i < len DO buf[i] := CHR(dc.bgCol); INC(i) END; Images.GetPixels(img, mx, my, len, Images.D8, buf, dc.srcOverDst); Images.GetPixels(img, mx, my, len, Images.A8, alpha, Images.SrcCopy); i := 0; WHILE len > 0 DO 			IF alpha[i] = 0X THEN INC(i); INC(x); DEC(len) ELSE idx := buf[i]; INC(i); l := 1; WHILE (l < len) & (alpha[i] # 0X) & (buf[i] = idx) DO INC(i); INC(l) END; Display.ReplConst(ORD(idx), x, y, l, 1, Display.replace); INC(x, l); DEC(len, SHORT(l)) END END END BlendRunIdx; (*--- Draw Rectangle ---*) PROCEDURE DrawRect (llx, lly, urx, ury: INTEGER; VAR data: GfxRegions.EnumData); BEGIN Display.ReplConst(data(RegData).col, llx, lly, urx - llx, ury - lly, Display.replace) END DrawRect; PROCEDURE TileRectBlk (llx, lly, urx, ury: INTEGER; VAR data: GfxRegions.EnumData); VAR w, h: INTEGER; BEGIN WITH data: RegData DO 			w := urx - llx; h := ury - lly; CreateBuffer(w, h); IF Images.alpha IN data.img.fmt.components THEN Display.TransferBlock(Buffer.mem^, 0, Buffer.bpr, llx, lly, w, h, Display.get) END; Images.FillPattern(data.img, Buffer, 0, 0, w, h, data.dx - llx, data.dy - lly, data.dc.srcOverDst); Display.TransferBlock(Buffer.mem^, 0, Buffer.bpr, llx, lly, w, h, Display.set) END END TileRectBlk; PROCEDURE TileRectPix (llx, lly, urx, ury: INTEGER; VAR data: GfxRegions.EnumData); VAR mw, mh, y, my, x, mx, len: INTEGER; BEGIN WITH data: RegData DO 			mw := data.img.width; mh := data.img.height; y := lly; my := (lly - data.dy) MOD mh; WHILE y < ury DO 				x := llx; mx := (llx - data.dx) MOD mw; WHILE x < urx DO 					len := urx - x; 					IF mx + len > mw THEN len := mw - mx END; IF len > MaxRun THEN len := MaxRun END; IF Images.alpha IN data.img.fmt.components THEN BlendRun(data.dc, data.img, mx, my, len, x, y) 					ELSE CopyRun(data.img, mx, my, len, x, y) 					END; INC(x, len); INC(mx, len); IF mx = mw THEN mx := 0 END END; INC(y); INC(my); IF my = mh THEN my := 0 END END END END TileRectPix; PROCEDURE Rect (rc: GfxRaster.Context; llx, lly, urx, ury: LONGINT); VAR data: RegData; dc: Context; BEGIN IF rc.clipState # GfxRaster.Out THEN IF rc.pat = NIL THEN IF rc.clipState = GfxRaster.In THEN Display.ReplConst(rc(Context).dcol, llx, lly, urx - llx, ury - lly, Display.replace) ELSE data.col := rc(Context).dcol; GfxRegions.Enumerate(rc.clipReg, SHORT(llx), SHORT(lly), SHORT(urx), SHORT(ury), DrawRect, data) END ELSE dc := rc(Context); data.dx := SHORT(ENTIER(dc.orgX + dc.pat.px + 0.5)); data.dy := SHORT(ENTIER(dc.orgY + dc.pat.py + 0.5)); data.dc := dc; data.img := dc.pat.img; GfxRegions.Enumerate(dc.clipReg, SHORT(llx), SHORT(lly), SHORT(urx), SHORT(ury), TileRect, data) END END END Rect; (*--- Set Color/Pattern for Raster Context ---*) PROCEDURE SetColPatRGB (rc: GfxRaster.Context; col: Gfx.Color; pat: Gfx.Pattern); VAR dc: Context; BEGIN dc := rc(Context); dc.col := col; dc.pat := pat; dc.dcol := Display.RGB(col.r, col.g, col.b); Images.SetModeColor(dc.srcOverDst, col.r, col.g, col.b) 	END SetColPatRGB; PROCEDURE SetColPatIdx (rc: GfxRaster.Context; col: Gfx.Color; pat: Gfx.Pattern); VAR dc: Context; BEGIN dc := rc(Context); dc.col := col; dc.pat := pat; dc.dcol := Colors.Match(Colors.DisplayIndex, Colors.DisplayBits, col.r, col.g, col.b); Images.SetModeColor(dc.srcOverDst, col.r, col.g, col.b) 	END SetColPatIdx; (*--- Draw String ---*) PROCEDURE CopyPattern (llx, lly, urx, ury: INTEGER; VAR data: GfxRegions.EnumData); BEGIN WITH data: RegData DO 			Display.SetClip(llx, lly, urx - llx, ury - lly); Display.CopyPattern(data.col, data.pat, data.dx, data.dy, Display.paint); Display.ResetClip END END CopyPattern; PROCEDURE Show (ctxt: Gfx.Context; x, y: REAL; VAR str: ARRAY OF CHAR); VAR mat: GfxMatrix.Matrix; font: GfxFonts.Font; dc: Context; u, v: REAL; px, py, i, aw, dx, bx, by, w, h: INTEGER; pat: Display.Pattern; data: RegData; BEGIN GfxMatrix.Concat(ctxt.font.mat, ctxt.ctm, mat); font := GfxFonts.Open(ctxt.font.name, ctxt.font.ptsize, mat); IF font = NIL THEN font := GfxFonts.Default END; IF (font.rfont # NIL) & (ctxt.mode * {Gfx.Record..Gfx.EvenOdd} = {Gfx.Fill}) & (ctxt.fillPat = NIL) THEN dc := ctxt(Context); dc.setColPat(dc, dc.fillCol, NIL); GfxMatrix.Apply(dc.ctm, x, y, u, v); px := SHORT(ENTIER(u + 0.5)); py := SHORT(ENTIER(v + 0.5)); i := 0; aw := 0; WHILE str[i] # 0X DO 				Fonts.GetChar(font.rfont, str[i], dx, bx, by, w, h, pat); INC(aw, dx); INC(i) END; IF GfxRegions.RectInside(px, py + font.rfont.minY, px + aw, py + font.rfont.maxY, dc.clipReg) THEN i := 0; WHILE str[i] # 0X DO 					Fonts.GetChar(font.rfont, str[i], dx, bx, by, w, h, pat); IF w * h # 0 THEN Display.CopyPattern(dc.dcol, pat, px + bx, py + by, Display.paint) END; INC(px, dx); INC(i) END ELSE data.col := dc.dcol; i := 0; WHILE str[i] # 0X DO 					Fonts.GetChar(font.rfont, str[i], dx, bx, by, w, h, pat); IF (w * h # 0) & GfxRegions.RectOverlaps(px + bx, py + by, px + bx + w, py + by + h, dc.clipReg) THEN data.dx := px + bx; data.dy := py + by; data.pat := pat; GfxRegions.Enumerate(dc.clipReg, data.dx, data.dy, data.dx + w, data.dy + h, CopyPattern, data) END; INC(px, dx); INC(i) END END; dc.cpx := x + aw; dc.cpy := y	(* font coordinates are same as world coordinates *) ELSE GfxRaster.Show(ctxt, x, y, str) END END Show; (*--- Transform To Temporary Bitmap ---*) PROCEDURE WarpBlk (dc: Context; img: Images.Image; dx, dy, x0, y0, x1, y1: INTEGER; VAR m: GfxMatrix.Matrix; VAR f: GfxImages.Filter); VAR col: Images.Pixel; BEGIN CreateBuffer(x1 - x0, y1 - y0); Display.TransferBlock(Buffer.mem^, 0, Buffer.bpr, dx + x0, dy + y0, x1 - x0, y1 - y0, Display.get); m[2, 0] := m[2, 0] - x0; m[2, 1] := m[2, 1] - y0;	(* make transform local to Buffer origin *) col := f.col; Images.SetModeColor(f, dc.fillCol.r, dc.fillCol.g, dc.fillCol.b); GfxImages.Transform(img, Buffer, m, f); Images.SetModeColor(f, ORD(col[red]), ORD(col[green]), ORD(col[blue])) END WarpBlk; PROCEDURE WarpPix (dc: Context; img: Images.Image; dx, dy, x0, y0, x1, y1: INTEGER; VAR m: GfxMatrix.Matrix; VAR f: GfxImages.Filter); VAR op: INTEGER; col: Images.Pixel; BEGIN Images.Create(Buffer, x1 - x0, y1 - y0, Images.BGRA8888); m[2, 0] := m[2, 0] - x0; m[2, 1] := m[2, 1] - y0;	(* make transform local to Buffer origin *) op := f.op; col := f.col; Images.InitModeColor(f, Images.srcCopy, dc.fillCol.r, dc.fillCol.g, dc.fillCol.b); GfxImages.Transform(img, Buffer, m, f); Images.InitModeColor(f, op, ORD(col[red]), ORD(col[green]), ORD(col[blue])) END WarpPix; (*--- Draw/Blend Image Rectangle ---*) PROCEDURE DrawImageRectBlk (llx, lly, urx, ury: INTEGER; VAR data: GfxRegions.EnumData); VAR off: LONGINT; BEGIN WITH data: RegData DO 			off := (lly - data.dy) * data.img.bpr + LONG(llx - data.dx) * (data.img.fmt.bpp DIV 8); Display.TransferBlock(data.img.mem^, off, data.img.bpr, llx, lly, urx - llx, ury - lly, Display.set) END END DrawImageRectBlk; PROCEDURE DrawImageRectPix (llx, lly, urx, ury: INTEGER; VAR data: GfxRegions.EnumData); VAR y, x, len: INTEGER; BEGIN WITH data: RegData DO 			y := lly; WHILE y < ury DO 				x := llx; WHILE x < urx DO 					len := MaxRun; IF x + MaxRun > urx THEN len := urx - x END; CopyRun(data.img, x - data.dx, y - data.dy, len, x, y); INC(x, len) END; INC(y) END END END DrawImageRectPix; PROCEDURE BlendImageRectPix (llx, lly, urx, ury: INTEGER; VAR data: GfxRegions.EnumData); VAR y, x, len: INTEGER; BEGIN WITH data: RegData DO 			y := lly; WHILE y < ury DO 				x := llx; WHILE x < urx DO 					len := MaxRun; IF x + MaxRun > urx THEN len := urx - x END; BlendRun(data.dc, data.img, x - data.dx, y - data.dy, len, x, y); INC(x, len) END; INC(y) END END END BlendImageRectPix; (*--- Copy Image To Display ---*) PROCEDURE CopyImageBlk (dc: Context; img: Images.Image; dx, dy: INTEGER; VAR filter: GfxImages.Filter); VAR data: RegData; llx, lly, urx, ury: INTEGER; col: Images.Pixel; BEGIN IF Images.Same(img.fmt, Images.DisplayFormat) & (img.mem # NIL) & ((filter.op IN {Images.srcCopy, Images.srcInDst}) OR 			 (filter.op IN {Images.srcOverDst, Images.srcAtopDst}) & ~(Images.alpha IN img.fmt.components)) THEN	(* copy directly from image *) data.img := img; data.dx := dx; data.dy := dy; GfxRegions.Enumerate(dc.clipReg, dx, dy, dx + img.width, dy + img.height, DrawImageRectBlk, data) ELSE	(* blend into temporary map first *) llx := dx; lly := dy; urx := llx + img.width; ury := lly + img.height; GfxRegions.ClipRect(llx, lly, urx, ury, dc.clipReg.llx, dc.clipReg.lly, dc.clipReg.urx, dc.clipReg.ury); IF ~GfxRegions.RectEmpty(llx, lly, urx, ury) THEN CreateBuffer(urx - llx, ury - lly); IF ~(filter.op IN {Images.srcCopy, Images.srcInDst}) & ~((filter.op IN {Images.srcOverDst, Images.srcAtopDst}) & ~(Images.alpha IN img.fmt.components)) THEN Display.TransferBlock(Buffer.mem^, 0, Buffer.bpr, llx, lly, urx - llx, ury - lly, Display.get) END; col := filter.col; Images.SetModeColor(filter, dc.fillCol.r, dc.fillCol.g, dc.fillCol.b); Images.Copy(img, Buffer, llx - dx, lly - dy, urx - dx, ury - dy, 0, 0, filter); Images.SetModeColor(filter, ORD(col[red]), ORD(col[green]), ORD(col[blue])); data.img := Buffer; data.dx := llx; data.dy := lly; GfxRegions.Enumerate(dc.clipReg, llx, lly, urx, ury, DrawImageRectBlk, data) END END END CopyImageBlk; PROCEDURE CopyImagePix (dc: Context; img: Images.Image; dx, dy: INTEGER; VAR filter: GfxImages.Filter); VAR data: RegData; llx, lly, urx, ury: INTEGER; buf: Images.Image; col: Images.Pixel; mode: Images.Mode; BEGIN IF (filter.op IN {Images.srcCopy, Images.srcInDst}) & ~(Images.alpha IN img.fmt.components) THEN data.img := img; data.dx := dx; data.dy := dy; GfxRegions.Enumerate(dc.clipReg, dx, dy, dx + img.width, dy + img.height, DrawImageRectPix, data) ELSIF filter.op IN {Images.srcOverDst, Images.srcAtopDst} THEN dc.setColPat(dc, dc.fillCol, NIL); data.dc := dc; data.img := img; data.dx := dx; data.dy := dy; GfxRegions.Enumerate(dc.clipReg, dx, dy, dx + img.width, dy + img.height, BlendImageRectPix, data) ELSE llx := dx; lly := dy; urx := llx + img.width; ury := lly + img.height; GfxRegions.ClipRect(llx, lly, urx, ury, dc.clipReg.llx, dc.clipReg.lly, dc.clipReg.urx, dc.clipReg.ury); IF ~GfxRegions.RectEmpty(llx, lly, urx, ury) THEN NEW(buf); Images.Create(buf, urx - llx, ury - lly, Images.PixelFormat); Images.Fill(buf, 0, 0, urx - llx, ury - lly, dc.bgPix, Images.SrcCopy); col := filter.col; Images.SetModeColor(filter, dc.fillCol.r, dc.fillCol.g, dc.fillCol.b); Images.Copy(img, buf, llx - dx, lly - dy, urx - dx, ury - dy, 0, 0, filter); Images.SetModeColor(filter, ORD(col[red]), ORD(col[green]), ORD(col[blue])); Images.InitMode(mode, Images.dstInSrc); Images.Copy(img, buf, llx - dx, lly - dy, urx - dx, ury - dy, 0, 0, mode);	(* reduce buf to opaque parts of img *) data.img := buf; data.dx := llx; data.dy := lly; GfxRegions.Enumerate(dc.clipReg, llx, lly, urx, ury, BlendImageRectPix, data) END END END CopyImagePix; (*--- Draw Bitmap ---*) PROCEDURE Image (ctxt: Gfx.Context; x, y: REAL; img: Images.Image; VAR filter: GfxImages.Filter); VAR dc: Context; m: GfxMatrix.Matrix; dx, dy, llx, lly, urx, ury: INTEGER; x0, y0, x1, y1: REAL; data: RegData; BEGIN dc := ctxt(Context); GfxMatrix.Translate(dc.ctm, x, y, m); dx := SHORT(ENTIER(m[2, 0])); m[2, 0] := m[2, 0] - dx; dy := SHORT(ENTIER(m[2, 1])); m[2, 1] := m[2, 1] - dy; IF (filter.hshift # GfxImages.NoFilter.hshift) & (0.1 < m[2, 0]) & (m[2, 0] < 0.9) OR 			(filter.vshift # GfxImages.NoFilter.vshift) & (0.1 < m[2, 1]) & (m[2, 1] < 0.9) OR 			GfxMatrix.Scaled(m) OR 			GfxMatrix.Rotated(m) THEN	(* transform into temporary image and copy from there *) GfxMatrix.ApplyToRect(m, 0, 0, img.width, img.height, x0, y0, x1, y1); llx := SHORT(ENTIER(x0)); lly := SHORT(ENTIER(y0)); urx := -SHORT(ENTIER(-x1)); ury := -SHORT(ENTIER(-y1)); GfxRegions.ClipRect(llx, lly, urx, ury, dc.clipReg.llx - dx, dc.clipReg.lly - dy, dc.clipReg.urx - dx, dc.clipReg.ury - dy); IF ~GfxRegions.RectEmpty(llx, lly, urx, ury) THEN Warp(dc, img, dx, dy, llx, lly, urx, ury, m, filter); data.dc := dc; data.img := Buffer; data.dx := dx + llx; data.dy := dy + lly; GfxRegions.Enumerate(dc.clipReg, data.dx, data.dy, dx + urx, dy + ury, BlendImageRect, data) END ELSE CopyImage(dc, img, dx, dy, filter) END END Image; (*--- Gfx Context Methods ---*) PROCEDURE ResetCTM (ctxt: Gfx.Context); VAR dc: Context; BEGIN dc := ctxt(Context); GfxMatrix.Translate(GfxMatrix.Identity, dc.orgX, dc.orgY, dc.ctm); GfxMatrix.Scale(dc.ctm, dc.scale, dc.scale, dc.ctm) END ResetCTM; PROCEDURE ResetClip (ctxt: Gfx.Context); VAR dc: Context; BEGIN dc := ctxt(Context); GfxRaster.ResetClip(dc); GfxRegions.Copy(dc.defClip, dc.clipReg) END ResetClip; PROCEDURE InitMethods; VAR do: Gfx.Methods; BEGIN NEW(do); Methods := do; do.reset := Gfx.DefResetContext; do.resetCTM := ResetCTM; do.setCTM := Gfx.DefSetCTM; do.translate := Gfx.DefTranslate; do.scale := Gfx.DefScale; do.rotate := Gfx.DefRotate; do.concat := Gfx.DefConcat; do.resetClip := ResetClip; do.getClipRect := GfxRaster.GetClipRect; do.getClip := GfxRaster.GetClip; do.setClip := GfxRaster.SetClip; do.setStrokeColor := Gfx.DefSetStrokeColor; do.setStrokePattern := Gfx.DefSetStrokePattern; do.setFillColor := Gfx.DefSetFillColor; do.setFillPattern := Gfx.DefSetFillPattern; do.setLineWidth := Gfx.DefSetLineWidth; do.setDashPattern := Gfx.DefSetDashPattern; do.setCapStyle := Gfx.DefSetCapStyle; do.setJoinStyle := Gfx.DefSetJoinStyle; do.setStyleLimit := Gfx.DefSetStyleLimit; do.setFlatness := Gfx.DefSetFlatness; do.setFont := Gfx.DefSetFont; do.getWidth := Gfx.DefGetStringWidth; do.begin := GfxRaster.Begin; do.end := GfxRaster.End; do.enter := GfxRaster.Enter; do.exit := GfxRaster.Exit; do.close := GfxRaster.Close; do.line := GfxRaster.Line; do.arc := GfxRaster.Arc; do.bezier := GfxRaster.Bezier; do.show := Show; do.flatten := Gfx.DefFlatten; do.outline := Gfx.DefOutline; do.render := GfxRaster.Render; do.rect := GfxRaster.Rect; do.ellipse := GfxRaster.Ellipse; do.image := Image; do.newPattern := Gfx.DefNewPattern; IF TransferBlock THEN BlendDot := BlendDotBlk; TileRect := TileRectBlk; BlendImageRect := DrawImageRectBlk; Warp := WarpBlk; CopyImage := CopyImageBlk ELSIF TrueColor THEN BlendDot := BlendDotRGB; TileRect := TileRectPix; CopyRun := CopyRunRGB; BlendRun := BlendRunRGB; BlendImageRect := BlendImageRectPix; Warp := WarpPix; CopyImage := CopyImagePix ELSE BlendDot := BlendDotIdx; TileRect := TileRectPix; CopyRun := CopyRunIdx; BlendRun := BlendRunIdx; BlendImageRect := BlendImageRectPix; Warp := WarpPix; CopyImage := CopyImagePix END END InitMethods; (*--- Exported Interface ---*) (** set default clip region to rectangle **) PROCEDURE SetClipRect* (dc: Context; llx, lly, urx, ury: INTEGER); BEGIN GfxRegions.SetToRect(dc.defClip, llx, lly, urx, ury) END SetClipRect; (** copy given region to default clip region **) PROCEDURE SetClipRegion* (dc: Context; reg: GfxRegions.Region); BEGIN GfxRegions.Copy(reg, dc.defClip) END SetClipRegion; (** set default coordinate origin and scale factor **) PROCEDURE SetCoordinates* (dc: Context; x, y, scale: REAL); BEGIN dc.orgX := x; dc.orgY := y; dc.scale := scale END SetCoordinates; (** set background color for display context **) PROCEDURE SetBGColor* (dc: Context; col: Gfx.Color); BEGIN dc.bg := col; Images.SetRGB(dc.bgPix, col.r, col.g, col.b); IF TrueColor THEN dc.bgCol := Display.RGB(col.r, col.g, col.b) 		ELSE dc.bgCol := Colors.Match(Colors.DisplayIndex, Colors.DisplayBits, col.r, col.g, col.b) 		END END SetBGColor; (** initialize display context to rectangle **) PROCEDURE Init* (dc: Context; llx, lly, urx, ury: INTEGER); BEGIN GfxRaster.InitContext(dc); dc.do := Methods; dc.dot := Dot; dc.rect := Rect; IF TrueColor THEN dc.setColPat := SetColPatRGB ELSE dc.setColPat := SetColPatIdx END; Images.InitMode(dc.srcOverDst, Images.srcOverDst); NEW(dc.defClip); GfxRegions.Init(dc.defClip, GfxRegions.Winding); SetClipRect(dc, llx, lly, urx, ury); SetCoordinates(dc, llx, lly, 1); SetBGColor(dc, Gfx.White); Gfx.DefResetContext(dc) END Init; BEGIN TrueColor := Display.TrueColor(Display.ColLeft); TransferBlock := Display.TransferFormat(Display.ColLeft) # Display.unknown; NEW(Buffer); InitMethods END GfxDisplay.

title: Oberon/ETH Oberon/2.3.7/GfxDisplay.Mod