Syntax10.Scn.Fnt
Syntax10i.Scn.Fnt
StampElems
Alloc
30 Dec 95
Syntax10b.Scn.Fnt
FoldElems
MODULE GraphicUtils;
	(** Markus Knasm
ller 9 Aug 94 - 
	IMPORT Display, Display1, Fonts, Input, Oberon, Printer, TextFrames, TextPrinter, Texts;
	CONST 
		grey1* = 12; grey2* = 13; grey3* = 14; black* = 15; white* = 0;
		CR = 0DX; MR = 0; MM = 1; ML = 2; cancel = {ML, MM, MR};
		left* = 0; center* = 1; right* = 2; (** alignment *)
		ehm = 4; evm = 3;	(* element: horizontal margin, vertical margin*)
		mhm = 5; mvm = 2; 
		delay = 150;  (* for scrolling *)
	VAR dUnit*, pUnit*: LONGINT;  (** for device independent coordinates *)
	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 ReplConstC (f: Display.Frame; col, x, y, w, h, mode: INTEGER);
	BEGIN
		IF f # NIL THEN
			Display.ReplConstC (f, col, x, y, w, h, mode)
		ELSE
			Display.ReplConst (col, x, y, w, h, mode)
		END
	END ReplConstC;
	PROCEDURE CopyPatternC (f: Display.Frame; col: INTEGER; pat: LONGINT; x, y, mode: INTEGER);
	BEGIN
		IF f # NIL THEN
			Display.CopyPatternC (f, col, pat, x, y, mode)
		ELSE
			Display.CopyPattern (col, pat, x, y, mode)
		END
	END CopyPatternC;
	PROCEDURE CheckString (s: ARRAY OF CHAR; x, y, w: INTEGER; fnt: Fonts.Font; VAR ret, let: INTEGER);
		VAR i, cx, cy, cw, ch, dx, x0: INTEGER; pat: LONGINT; cond: BOOLEAN; 
	BEGIN
		i := 0; x0 := x; cond := TRUE;		
		WHILE (s[i] # 0X) & (cond) DO
			Display.GetChar (fnt.raster, s[i], dx, cx, cy, cw, ch, pat);
			IF x + dx < x0 + w THEN INC (x, dx); INC (i) ELSE cond := FALSE END
		END;
		ret := (w - (x - x0)); let := i
	END CheckString;
	PROCEDURE DrawString* (f: Display.Frame; s: ARRAY OF CHAR; x, y, w: INTEGER; fnt: Fonts.Font; mode: INTEGER; 
			align: INTEGER; VAR ret: INTEGER);
		VAR i, let, cx, cy, cw, ch, dx: INTEGER; cond: BOOLEAN; pat: LONGINT;
	BEGIN 
		IF f # NIL THEN Oberon.RemoveMarks(f.X, f.Y, f.W, f.H) END;
		CheckString (s, x, y, w, fnt, cx, let);  ret := cx DIV 2;
		IF align = left THEN cx := 0
		ELSIF align = center THEN cx := cx DIV 2;
		END;
		INC (x, cx); 
		FOR i := 0 TO let - 1 DO
			Display.GetChar (fnt.raster, s[i], dx, cx, cy, cw, ch, pat);
			Display.CopyPatternC (f, black, pat, x + cx, y + cy, mode);
			INC (x, dx)
		END
	END DrawString;
	PROCEDURE GetStringLength* (s: ARRAY OF CHAR; fnt: Fonts.Font): INTEGER;
		VAR i, x, dx, cx, cy, cw, ch: INTEGER; pat: LONGINT;
	BEGIN
		i := 0; x := 0;
		WHILE (s[i] # 0X) DO
			Display.GetChar (fnt.raster, s[i], dx, cx, cy, cw, ch, pat);
			INC (x, dx); INC (i)
		END;
		RETURN x
	END GetStringLength;
	PROCEDURE CheckPString (s: ARRAY OF CHAR; x, y, w: INTEGER; fnt: Fonts.Font; VAR ret, let: INTEGER);
		VAR fno: SHORTINT; i, cx, cy, cw, ch, dx, x0: INTEGER; pat, pdx: LONGINT; cond: BOOLEAN; 
	BEGIN
		fno := TextPrinter.FontNo (fnt);
		i := 0; x0 := x; cond := TRUE;		
		WHILE (s[i] # 0X) & (cond) DO
			TextPrinter.GetChar (fno, pUnit, s[i], pdx, dx, cx, cy, cw, ch, pat);
			IF x + dx < x0 + w THEN INC (x, dx); INC (i) ELSE cond := FALSE END
		END;
		ret := (w - (x - x0)); let := i
	END CheckPString;
	PROCEDURE PrintString* (s: ARRAY OF CHAR; x, y, w: INTEGER; fnt: Fonts.Font; align: INTEGER; VAR ret: INTEGER);
		VAR i, let, cx: INTEGER; mystr: ARRAY 62 OF CHAR; 
	BEGIN
		CheckPString (s, x, y, w, fnt, cx, let); ret := cx DIV 2;	
		IF align = left THEN cx := 0
		ELSIF align = center THEN cx := cx DIV 2;
		END;
		INC (x, cx); 
		FOR i := 0 TO let - 1 DO mystr[i] := s[i] END;
		mystr[let] := 0X;
		Printer.String (x, y, mystr, fnt.name);
	END PrintString;
	PROCEDURE DrawBox* (f: Display.Frame; pressed: BOOLEAN; x, y, w, h: INTEGER; mode: INTEGER);
	BEGIN
		IF f # NIL THEN Oberon.RemoveMarks(f.X, f.Y, f.W, f.H) END;
		IF (w <= 4) OR (h <= 4) THEN
			Display.ReplConstC (f, grey3, x, y, w, Min (h, 2), mode)
		ELSE 
			IF pressed THEN
				Display.ReplConstC (f, grey1, x, y, w, h, mode);
				Display.ReplConstC (f, grey3, x, y + 2, w - 2, h - 2, mode);
				Display.ReplConstC (f, grey2, x + 2, y + 2, w - 4, h - 4, mode);
				Display.DotC (f, grey3, x, y + 1, mode);
				Display.DotC (f, grey3, x + w - 2, y + h - 1, mode);
			ELSE
				Display.ReplConstC (f, grey3, x, y, w, h, mode);
				Display.ReplConstC (f, grey1, x, y + 2, w - 2, h - 2, mode);
				Display.ReplConstC (f, grey2, x + 2, y + 2, w - 4, h - 4, mode);
				Display.DotC (f, grey1, x, y + 1, mode);
				Display.DotC (f, grey1, x + w - 2, y + h - 1, mode);
			END
		END
	END DrawBox;
	PROCEDURE PrintBox* (x, y, w, h: INTEGER);
	BEGIN
		Printer.ReplConst (x, y, w, 2);
		Printer.ReplConst (x + w - 2, y + 2, 2, h - 2);
		Printer.ReplConst (x, y + 2, 2, h - 2);
		Printer.ReplConst (x + 2, y + h - 2, w -  4, 2);
		Printer.Circle (x, y + 1, 0);
		Printer.Circle (x + w - 2, y + h - 1, 0)
	END PrintBox;
	PROCEDURE DrawPatternBox* (f: Display.Frame; pressed: BOOLEAN; pat: Display.Pattern; x, y, w, h, pX, pY, mode: INTEGER);
		lowerCol, upperCol : INTEGER;
	BEGIN
		IF f # NIL THEN Oberon.RemoveMarks(f.X, f.Y, f.W, f.H) END;
		IF pressed THEN
			lowerCol := grey1; upperCol := grey3; INC(pX); DEC(pY)
		ELSE
			lowerCol := grey3; upperCol := grey1
		END;
		Display.ReplConstC (f, lowerCol, x, y, w, 2, mode);
		Display.ReplConstC (f, lowerCol, x + w - 2, y + 2, 2, h - 2, mode);
		Display.ReplConstC (f, upperCol, x, y + 2, 2, h - 2, mode);
		Display.ReplConstC (f, upperCol, x + 2, y + h - 2, w - 4, 2, mode);
		Display.DotC (f, upperCol, x, y + 1, mode);
		Display.DotC (f, upperCol, x + w - 2, y + h -1, mode);
		Display.ReplConstC (f, grey2, x + 2, y + 2, w - 4, h - 4, mode);
		IF pat # 0 THEN
			Display.CopyPatternC (f, black, pat, x + pX, y + pY, mode)
		END
	END DrawPatternBox;
	PROCEDURE PrintPatternBox* (pat: Display.Pattern; x, y, w, h, pX, pY: INTEGER);
	(** not yet implemented *)
	BEGIN
		PrintBox (x, y, w, h)
	END PrintPatternBox;
	PROCEDURE Set* (VAR r: Texts.Reader; t: Texts.Text; l: INTEGER);	
	(* sets the reader r in the text t to line l *)
		VAR i: INTEGER; ch: CHAR;
	BEGIN
		Texts.OpenReader (r, t, 0);
		FOR i := 0 TO l - 1 DO
			REPEAT Texts.Read (r, ch) UNTIL ch = CR
		END
	END Set;
	PROCEDURE DrawLine (VAR r: Texts.Reader; f: Display.Frame; x, y, w: INTEGER);	
		VAR e: Texts.Elem; ch: CHAR; dx, x0, y0, w0, h: INTEGER; pat: Display.Pattern; m: TextFrames.DisplayMsg;
	BEGIN
		Texts.Read (r, ch);
		WHILE (w > 0) & ~r.eot & (ch # CR) DO
			IF r.elem # NIL THEN
				e := r.elem;
				m.prepare := TRUE; m.fnt := r.fnt; m.col := r.col; m.pos := Texts.Pos (r) - 1; 
				e.handle (e, m); DEC (w, SHORT (e.W DIV TextFrames.Unit));
				IF w > evm THEN
					m.prepare := FALSE; m.fnt := r.fnt; m.col := r.col; m.pos := Texts.Pos (r) - 1;
					m.frame := f; m.X0 := x; m.Y0 := y; m.elemFrame := NIL;
					e.handle (e, m); INC (x, SHORT (e.W DIV TextFrames.Unit))
				END
			ELSE
				Display.GetChar (r.fnt.raster, ch, dx, x0, y0, w0, h, pat); DEC (w, dx);
				IF w > evm THEN 
					CopyPatternC (f, r.col, pat, x + x0, y + y0, Display.paint); INC (x, dx)
				END
			END;
			Texts.Read (r,ch)
		END
	END DrawLine;
	PROCEDURE Flip (f: Display.Frame; menu: Texts.Text; lsp, dsc, x, y, w, h: INTEGER; in: BOOLEAN; sc, cmd: INTEGER);
		VAR r: Texts.Reader; itemH, x1, y1 : INTEGER;
	BEGIN
		IF (cmd >= 0) & (cmd >= sc) THEN
			y1:= y + h - (lsp * (cmd - sc + 1)) - dsc - mvm; y := y1 + dsc - 1; x1 := x + mhm; 
			itemH := lsp + 1; DEC (w, 4); INC (x, 2);
			Oberon.RemoveMarks(x,y,w,h);
			IF in THEN
				ReplConstC (f, black, x, y, w, 1, Display.replace);
				ReplConstC (f, black, x + w - 1, y, 1, itemH - 1, Display.replace);
				ReplConstC (f, white, x, y + 1, 1, itemH - 1, Display.replace);
				ReplConstC (f, white, x, y + itemH -1, w, 1, Display.replace);
				ReplConstC (f, grey1, x + 1, y + 1, w - 2, itemH - 2, Display.replace)
			ELSE
				ReplConstC (f, grey2, x, y, w, itemH, Display.replace)
			END;
			Set (r, menu, cmd); DrawLine (r, f, x1, y1, w)
		END
	END Flip;
	PROCEDURE DrawMenu* (f: Display.Frame; menu: Texts.Text; sc, cmd, x, y, w, h, mode: INTEGER; VAR n, lsp, dsc: INTEGER);
	(** draws the menu with the coordinates x, y, and the dimensions w, h in frame f if f # NIL ; otherwise it is drawn to the screen; 
		computes number of lines, line space & descender of item lines *)
		VAR def, wid, x0, y0, i: INTEGER; r: Texts.Reader;
		PROCEDURE MeasureMenu;
			(* compute number of items, default item, with, line space descender of item lines *)
			VAR r: Texts.Reader; ch, oldCh: CHAR; wid0, dx, x, y, w, h: INTEGER; p: LONGINT;
		BEGIN
			wid := 0; n := 1; lsp := 0; dsc := 0; wid0 := 0; oldCh := 0X; def := -1;
			Texts.OpenReader (r, menu, 0); Texts.Read (r, ch);
			WHILE ~ r.eot DO
				IF ch = CR THEN wid := Max (wid, wid0); wid0 := 0; INC (n)
				ELSIF r.elem # NIL THEN
					lsp := Max (lsp, SHORT (r.elem.H DIV TextFrames.Unit)); 
					INC (wid, SHORT (r.elem.W DIV TextFrames.Unit))
				ELSE
					lsp := Max (lsp, r.fnt.height); dsc := Min (dsc, r.fnt.minY);
					Display.GetChar (r.fnt.raster, ch, dx, x, y, w, h, p); INC (wid, dx)
				END;
				oldCh := ch; Texts.Read (r, ch)
			END;
			IF oldCh = CR THEN DEC (n) END;
			wid := Max (wid, wid0); INC (lsp);
		END MeasureMenu;
	BEGIN
		IF f # NIL THEN Oberon.RemoveMarks (f.X, f.Y, f.W, f.H) END;
		MeasureMenu; y0 := y; x0 := x; 
		ReplConstC (f, black, x0, y0, w, h, mode);
		ReplConstC (f, grey2, x0 + 1, y0 + 1, w - 2, h - 2, Display.replace);
		Set (r, menu, sc); y := y + h - mvm - lsp - dsc; x := x + mhm;
		WHILE (y + dsc >= y0 + mvm + 1) & (~ r.eot) DO
			DrawLine (r, f, x, y, w); DEC (y, lsp); INC (i)
		END;  
		Flip (f, menu, lsp, dsc, x0, y0, w, h, TRUE, sc, cmd) 
	END DrawMenu;
	PROCEDURE TrackMenu* (f: Display.Frame; menu: Texts.Text; x, y, w, h, n, lsp, dsc: INTEGER; VAR sc, cmd: INTEGER);
	(** handles a mouse click into the menu; sc is the first command which is shown in the menu; cmd the selected command *)
		VAR bot, top, dif, newCmd, mx, my: INTEGER; keys, keysum: SET; i: LONGINT;
	BEGIN
		bot := y + mvm; top := y + h - mvm; sc := Max (sc, 0); 
		dif := (h - 2 * mvm - 1) DIV lsp;
		Input.Mouse (keys, mx, my); keysum := {};
		cmd := Max (0, cmd);
		WHILE keys  # {} DO
			keysum := keysum + keys; 
			Oberon.DrawCursor (Oberon.Mouse, Oberon.Arrow, mx, my);
			newCmd := (top - my) DIV lsp + sc;
			IF (keysum = cancel) OR (cmd = -1) THEN 
				Flip (f, menu, lsp, dsc, x, y, w, h, FALSE, sc, cmd);
				cmd := -1
			ELSIF (mx >= x) & (mx <= x + w) & (newCmd >= sc) & (newCmd <= sc + dif - 1) THEN
				IF (newCmd # cmd) & (newCmd < n)  THEN
					Flip (f, menu, lsp, dsc, x, y, w, h, FALSE, sc, cmd); 
					Flip (f, menu, lsp, dsc, x, y, w, h, TRUE, sc, newCmd); 
					cmd := newCmd;   
				END
			ELSIF (mx >= x) & (mx <= x + w) & (my > top) & (sc > 0) THEN
				DEC (sc); DEC (cmd); DrawMenu (f, menu, sc, cmd, x, y, w, h, Display.replace, n, lsp, dsc); 
				i := Oberon.Time (); WHILE Oberon.Time () - i < delay DO END;
			ELSIF (mx >= x) & (mx <= x + w) & (my < top - dif ) & (cmd < n - 1) THEN
				INC (sc); INC (cmd); DrawMenu (f, menu, sc, cmd, x, y, w, h, Display.replace, n, lsp, dsc); 
				i := Oberon.Time (); WHILE Oberon.Time () - i < delay DO END; 
			END;
			Input.Mouse (keys, mx, my); 
		END;
	END TrackMenu;
BEGIN
	dUnit := Display.Unit; pUnit := TextPrinter.Unit;	
	Display.SetColor (11, 230, 230, 230); Display.SetColor (12, 210, 210, 210);
	Display.SetColor (13, 150, 150, 150); Display.SetColor (14, 100, 100, 100);
END GraphicUtils.