Obx/Mod/Scroll.odc

MODULE ObxScroll;
(**
	project	= "BlackBox"
	organization	= "www.oberon.ch"
	contributors	= "Oberon microsystems"
	version	= "System/Rsrc/About"
	copyright	= "System/Rsrc/About"
	license	= "Docu/BB-License"
	changes	= "
	- YYYYMMDD, nn, ...
	"
	issues	= "
	- ...
	"

**)

	IMPORT Stores, Fonts, Ports, Views, Controllers, Properties;

	CONST
		minVersion = 0; maxVersion = 0;
		cellSize = 7 * Ports.mm;
		boardSize = 10;

	TYPE
		View = POINTER TO RECORD (Views.View)
			x, y: INTEGER
		END;

	PROCEDURE (v: View) Externalize (VAR wr: Stores.Writer);
	BEGIN
		wr.WriteVersion(maxVersion);
		wr.WriteInt(v.x); wr.WriteInt(v.y)
	END Externalize;

	PROCEDURE (v: View) Internalize (VAR rd: Stores.Reader);
		VAR version: INTEGER;
	BEGIN
		rd.ReadVersion(minVersion, maxVersion, version);
		IF ~rd.cancelled THEN
			rd.ReadInt(v.x); rd.ReadInt(v.y)
		END
	END Internalize;

	PROCEDURE (v: View) CopyFromSimpleView (source: Views.View);
	BEGIN
		WITH source: View DO
			v.x := source.x; v.y := source.y
		END
	END CopyFromSimpleView;

	PROCEDURE (v: View) Restore (f: Views.Frame; l, t, r, b: INTEGER);
		VAR x, y, asc, dsc, w: INTEGER; color: Ports.Color; str: ARRAY 3 OF CHAR; font: Fonts.Font;
	BEGIN
		str := "00"; font := Fonts.dir.Default();
		x := l DIV cellSize;
		IF Views.IsPrinterFrame(f) THEN r := r - r MOD cellSize END;
		WHILE (x * cellSize < r) & (v.x + x < boardSize) DO
			y := t DIV cellSize;
			IF Views.IsPrinterFrame(f) THEN b := b - b MOD cellSize END;
			WHILE (y * cellSize < b) & (v.y + y < boardSize) DO
				IF ODD(x + y + v.x + v.y) THEN color := Ports.black ELSE color := Ports.white END;
				f.DrawRect(x * cellSize, y * cellSize, (x + 1) * cellSize, (y + 1) * cellSize, Ports.fill, color);
				str[0] := CHR(ORD("0") + x + v.x); str[1] := CHR(ORD("0") + y + v.y);
				font.GetBounds(asc, dsc, w);
				f.DrawString(
					(x * cellSize + cellSize DIV 2) - font.StringWidth(str) DIV 2,
					(y * cellSize + cellSize DIV 2) + asc DIV 2, Ports.red, str, font);
				INC(y)
			END;
			INC(x)
		END
	END Restore;

	PROCEDURE (v: View) HandleCtrlMsg (f: Views.Frame; VAR msg: Views.CtrlMessage; VAR focus: Views.View);
		VAR val, vis, w, h: INTEGER; changed: BOOLEAN;
	BEGIN
		WITH msg: Controllers.PollSectionMsg DO
			v.context.GetSize(w, h);
			msg.focus := FALSE;	(* v is not a container *)
			IF msg.vertical THEN
				msg.partSize := h DIV cellSize;
				msg.wholeSize := boardSize + MAX(0, msg.partSize +  v.y - boardSize);
				msg.partPos := v.y
			ELSE
				msg.partSize := w DIV cellSize;
				msg.wholeSize := boardSize + MAX(0, msg.partSize + v.x - boardSize);
				msg.partPos := v.x
			END;
			msg.valid := (msg.partSize < msg.wholeSize);
			msg.done := TRUE
		| msg: Controllers.ScrollMsg DO
			v.context.GetSize(w, h); changed := FALSE;
			msg.focus := FALSE;	(* v is not a container *)
			IF msg.vertical THEN
				val := v.y; vis := h DIV cellSize
			ELSE
				val := v.x; vis := w DIV cellSize
			END;
			CASE msg.op OF
			Controllers.decLine:
				IF val > 0 THEN DEC(val); changed := TRUE END
			| Controllers.incLine:
				IF val < boardSize - vis THEN INC(val); changed := TRUE END
			| Controllers.decPage:
				DEC(val, vis); changed := TRUE;
				IF val < 0THEN val := 0 END
			| Controllers.incPage:
				INC(val, vis); changed := TRUE;
				IF val > boardSize - vis THEN val := boardSize - vis END
			| Controllers.gotoPos:
				val := msg.pos; changed := TRUE
			END;
			IF msg.vertical THEN v.y := val ELSE v.x := val END;
			msg.done := TRUE;
			IF changed THEN Views.Update(v, Views.keepFrames) END
		| msg: Controllers.PageMsg DO
			v.context.GetSize(w, h);
			IF msg.op IN {Controllers.nextPageY, Controllers.gotoPageY} THEN
				vis := h DIV cellSize
			ELSE
				vis := w DIV cellSize
			END;
			CASE msg.op OF
			Controllers.nextPageX:
				INC(v.x, vis)
			| Controllers.nextPageY:
				INC(v.y, vis)
			| Controllers.gotoPageX:
				v.x := msg.pageX * vis
			| Controllers.gotoPageY:
				v.y := msg.pageY * vis
			END;
			msg.done := TRUE;
			msg.eox := v.x >= boardSize;
			msg.eoy := v.y >= boardSize
		ELSE
		END
	END HandleCtrlMsg;

	PROCEDURE (v: View) HandlePropMsg (VAR p: Properties.Message);
	BEGIN
		WITH p: Properties.SizePref DO
			IF p.w = Views.undefined THEN p.w := (boardSize - v.x) * cellSize END;
			IF p.h = Views.undefined THEN p.h := (boardSize - v.y) * cellSize END
		| p: Properties.ResizePref DO
			p.horFitToWin := TRUE;
			p.verFitToWin := TRUE
		| p: Properties.FocusPref DO
			p.setFocus := TRUE
		ELSE	(* ignore other messages *)
		END
	END HandlePropMsg;

	PROCEDURE Deposit*;
		VAR v: View;
	BEGIN
		NEW(v); v.x := 0; v.y := 0; Views.Deposit(v)
	END Deposit;

	PROCEDURE DepositAt* (x, y: INTEGER);
		VAR v: View;
	BEGIN
		NEW(v); v.x := 0; v.y := 0;
		IF (x > 0) & (x < boardSize) THEN v.x := x END;
		IF (y > 0) & (y < boardSize) THEN v.y := y END;
		Views.Deposit(v)
	END DepositAt;

END ObxScroll.