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). *)