Views.cp

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

**)

	IMPORT Dialog, Ports, Stores, Models, Views, Controllers, Properties, Containers, FormModels;

	CONST
		(** minimal border between form view and any embedded view: **)
		minBorder* = 4 * Ports.point; maxBorder* = 100 * Ports.mm;
		maxSize = 600 * Ports.mm;
		(* range of currently supported versions *)
		minVersion = 0; maxBaseVersion = 2; maxStdVersion = 1;

	TYPE
		View* = POINTER TO ABSTRACT RECORD (Containers.View) END;

		Directory* = POINTER TO ABSTRACT RECORD END;


		StdView = POINTER TO RECORD (View)
			border: INTEGER;
			grid: INTEGER;	(* grid > 0 *)
			gridFactor: INTEGER;	(* gridFactor > 0 *)
			background: Ports.Color;
			cache: FormModels.Reader	(* reuse form reader *)
		END;

		StdDirectory = POINTER TO RECORD (Directory) END;


		ViewOp = POINTER TO RECORD (Stores.Operation)
			view: StdView;	(* view # NIL *)
			border: INTEGER;	(* border >= minBorder *)
			grid: INTEGER;	(* grid > 0 *)
			gridFactor: INTEGER;	(* gridFactor > 0 *)
			background: Ports.Color
		END;


	VAR
		dir-, stdDir-: Directory;
		ctrldir-: Containers.Directory;


	(** View **)

	PROCEDURE (v: View) Internalize2- (VAR rd: Stores.Reader), EXTENSIBLE;
		VAR thisVersion: INTEGER;
	BEGIN
		IF ~rd.cancelled THEN
			rd.ReadVersion(minVersion, maxBaseVersion, thisVersion);
			IF~ rd.cancelled THEN
				IF thisVersion IN {0, 1} THEN
					WITH v: StdView DO	(* backward compatibility with Rel. 1.3 *)
						rd.ReadInt(v.border);
						rd.ReadInt(v.grid);
						rd.ReadXInt(v.gridFactor);
						IF thisVersion = 1 THEN
							rd.ReadInt(v.background)
						ELSE
							v.background := Ports.defaultColor
						END
					END
				END
			END
		END
	END Internalize2;

	PROCEDURE (v: View) Externalize2- (VAR wr: Stores.Writer), EXTENSIBLE;
	BEGIN
		wr.WriteVersion(maxBaseVersion)
	END Externalize2;

	PROCEDURE (v: View) ThisModel* (): FormModels.Model, EXTENSIBLE;
		VAR m: Containers.Model;
	BEGIN
		m := v.ThisModel^();
		IF m = NIL THEN RETURN NIL ELSE RETURN m(FormModels.Model) END
	END ThisModel;

	PROCEDURE (v: View) SetBorder* (border: INTEGER), NEW, ABSTRACT;
	(** border >= 0	20 **)

	PROCEDURE (v: View) Border* (): INTEGER, NEW, ABSTRACT;

	PROCEDURE (v: View) SetGrid* (grid, gridFactor: INTEGER), NEW, ABSTRACT;
	(**
		grid > 0	20
		gridFactor > 0	21
	**)

	PROCEDURE (v: View) Grid* (): INTEGER, NEW, ABSTRACT;

	PROCEDURE (v: View) GridFactor* (): INTEGER, NEW, ABSTRACT;

	PROCEDURE (v: View) SetBackground* (background: Ports.Color), NEW, ABSTRACT;


	(** Directory **)

	PROCEDURE (d: Directory) New* (f: FormModels.Model): View, NEW, ABSTRACT;
	(**
		f # NIL	20
		f.init	21
	**)


	(* ViewOp *)

	PROCEDURE (op: ViewOp) Do;
		VAR border, grid, gridFactor: INTEGER; background: Ports.Color;
	BEGIN
		(* save old state of view *)
		border := op.view.border; grid := op.view.grid; gridFactor := op.view.gridFactor;
		background := op.view.background;
		(* set new state of view *)
		op.view.border := op.border; op.view.grid := op.grid; op.view.gridFactor := op.gridFactor;
		op.view.background := op.background;
		Views.Update(op.view, Views.keepFrames);
		(* old state is new undo state *)
		op.border := border; op.grid := grid; op.gridFactor := gridFactor;
		op.background := background
	END Do;


	(* StdView *)

	PROCEDURE (v: StdView) Internalize2 (VAR rd: Stores.Reader);
		VAR thisVersion: INTEGER;
	BEGIN
		v.Internalize2^(rd);
		IF ~rd.cancelled THEN
			rd.ReadVersion(minVersion, maxStdVersion, thisVersion);
			IF thisVersion # 0 THEN
				rd.ReadInt(v.border);
				rd.ReadInt(v.grid);
				rd.ReadInt(v.gridFactor);
				rd.ReadInt(v.background)
			END
		END
	END Internalize2;

	PROCEDURE (v: StdView) Externalize2 (VAR wr: Stores.Writer);
	BEGIN
		v.Externalize2^(wr);
		wr.WriteVersion(maxStdVersion);
		wr.WriteInt(v.border);
		wr.WriteInt(v.grid);
		wr.WriteInt(v.gridFactor);
		wr.WriteInt(v.background)
	END Externalize2;

	PROCEDURE (v: StdView) CopyFromModelView2 (source: Views.View; model: Models.Model);
	BEGIN
		WITH source: StdView DO
			v.border := source.border;
			v.grid := source.grid;
			v.gridFactor := source.gridFactor;
			v.background := source.background
		END
	END CopyFromModelView2;

	PROCEDURE (d: StdView) AcceptableModel (m: Containers.Model): BOOLEAN;
	BEGIN
		RETURN m IS FormModels.Model
	END AcceptableModel;
	
	PROCEDURE (v: StdView) InitModel2 (m: Containers.Model);
	BEGIN
		ASSERT(m IS FormModels.Model, 23)
	END InitModel2;

	PROCEDURE (v: StdView) GetRect (f: Views.Frame; view: Views.View; OUT l, t, r, b: INTEGER);
	BEGIN
		view.context(FormModels.Context).GetRect(l, t, r, b)
	END GetRect;

	PROCEDURE (v: StdView) SetBorder (border: INTEGER);
		VAR op: ViewOp;
	BEGIN
		ASSERT(border >= 0, 20);
		IF border < minBorder THEN
			border := minBorder
		ELSIF border > maxBorder THEN
			border := maxBorder
		END;
		NEW(op); op.view := v; op.border := border;
		op.grid := v.grid; op.gridFactor := v.gridFactor;
		op.background := v.background;
		Views.Do(v, "#Form:BorderChange", op)
	END SetBorder;

	PROCEDURE (v: StdView) Border (): INTEGER;
	BEGIN
		RETURN v.border
	END Border;

	PROCEDURE (v: StdView) SetGrid (grid, gridFactor: INTEGER);
		VAR op: ViewOp;
	BEGIN
		ASSERT(grid > 0, 20); ASSERT(gridFactor > 0, 21);
		NEW(op); op.view := v; op.border := v.border;
		op.grid := grid; op.gridFactor := gridFactor;
		op.background := v.background;
		Views.Do(v, "#Form:GridChange", op)
	END SetGrid;

	PROCEDURE (v: StdView) Grid (): INTEGER;
	BEGIN
		RETURN v.grid
	END Grid;

	PROCEDURE (v: StdView) GridFactor (): INTEGER;
	BEGIN
		RETURN v.gridFactor
	END GridFactor;

	PROCEDURE (v: StdView) SetBackground (background: Ports.Color);
		VAR op: ViewOp;
	BEGIN
		NEW(op); op.view := v; op.border := v.border;
		op.grid := v.grid; op.gridFactor := v.gridFactor;
		op.background := background;
		Views.Do(v, "#Form:BackgroundChange", op)
	END SetBackground;

	PROCEDURE (v: StdView) GetBackground (VAR color: Ports.Color);
	BEGIN
		IF v.background = Ports.defaultColor THEN
			color := Ports.dialogBackground
		ELSE
			color := v.background
		END
	END GetBackground;

	PROCEDURE (v: StdView) Restore (f: Views.Frame; l, t, r, b: INTEGER);
		VAR form: FormModels.Model; ctrl: Containers.Controller;
			focus, q: Views.View; k, w, h, x, y: INTEGER; s: FormModels.Reader;
	BEGIN
		form := v.ThisModel();
		IF form # NIL THEN
			ctrl := v.ThisController();
			IF ctrl # NIL THEN focus := ctrl.ThisFocus() ELSE focus := NIL END;
			s := form.NewReader(v.cache); v.cache := s;
			s.Set(NIL); s.ReadView(q); k := 0;
			WHILE q # NIL DO
				IF (s.r >= l) & (s.b >= t) & (s.l < r) & (s.t < b) THEN
					Views.InstallFrame(f, q, s.l, s.t, k, q = focus)
				END;
				s.ReadView(q); INC(k)
			END
		ELSE
			f.DrawRect(l, t, r, b, Ports.fill, Ports.grey12)
		END;
		IF (ctrl # NIL) & ~(Containers.noCaret IN ctrl.opts) THEN
			k := v.grid * v.gridFactor; ASSERT(k > 0, 100);
			v.context.GetSize(w, h);
			IF w > maxSize THEN w := maxSize END;
			IF h > maxSize THEN h := maxSize END;
			x := l - l MOD k;
			WHILE x <= w DO
				f.MarkRect(x, 0, x + f.unit, h, Ports.fill, Ports.dim50, Ports.show);
				INC(x, k)
			END;
			y := t - t MOD k;
			WHILE y <= h DO
				f.MarkRect(0, y, w, y + f.unit, Ports.fill, Ports.dim50, Ports.show);
				INC(y, k)
			END
		END
	END Restore;

	PROCEDURE (v: StdView) HandleModelMsg2 (VAR msg: Models.Message);
	BEGIN
		WITH msg: Models.UpdateMsg DO
			WITH msg: FormModels.UpdateMsg DO
				Views.UpdateIn(v, msg.l, msg.t, msg.r, msg.b, Views.rebuildFrames)
			ELSE
				Views.Update(v, Views.rebuildFrames)	(* catch all update messages *)
			END
		ELSE
		END
	END HandleModelMsg2;

	PROCEDURE GetBounds (v: StdView; VAR w, h: INTEGER);
		VAR form: FormModels.Model; r, b: INTEGER; p: FormModels.Reader; q: Views.View;
	BEGIN
		form := v.ThisModel();
		IF form # NIL THEN
			p := form.NewReader(v.cache); v.cache := p;
			p.Set(NIL);	(* set reader to bottom of view list *)
			p.ReadView(q);	(* read bottom-most view *)
			IF q # NIL THEN
				r := 0; b := 0;
				WHILE q # NIL DO
					IF p.r > r THEN r := p.r END;
					IF p.b > b THEN b := p.b END;
					p.ReadView(q)
				END;
				w := r + v.border; h := b + v.border
			ELSE
				w := 0; h := 0
			END
		ELSE
			w := 0; h := 0
		END
	END GetBounds;

	PROCEDURE AssertRange (border: INTEGER; VAR w, h: INTEGER);
		VAR min: INTEGER;
	BEGIN	(* prevent illegal values *)
		min := 2 * border + FormModels.minViewSize;
		IF w = Views.undefined THEN w := 100 * Ports.mm
		ELSIF w < min THEN w := min
		ELSIF w > maxSize THEN w := maxSize
		END;
		IF h = Views.undefined THEN h := 70 * Ports.mm
		ELSIF h < min THEN h := min
		ELSIF h > maxSize THEN h := maxSize
		END
	END AssertRange;

	PROCEDURE (v: StdView) HandlePropMsg2 (VAR p: Properties.Message);
		VAR sp: Properties.StdProp; q: Properties.Property;
	BEGIN
		WITH p: Properties.BoundsPref DO
			GetBounds(v, p.w, p.h)
		| p: Properties.SizePref DO
			AssertRange(v.border, p.w, p.h)
		| p: Properties.PollMsg DO
			NEW(sp); sp.valid := {Properties.color}; sp.known := sp.valid;
			sp.color.val := v.background; p.prop := sp
		| p: Properties.SetMsg DO
			q := p.prop;
			WHILE q # NIL DO
				WITH q: Properties.StdProp DO
					IF (Properties.color IN q.valid) & (q.color.val # v.background) THEN
						v.SetBackground(q.color.val)
					END;
				ELSE
				END;
				q :=q.next
			END
		| p: Containers.DropPref DO
			p.okToDrop := TRUE
		ELSE
		END
	END HandlePropMsg2;


	(* StdDirectory *)

	PROCEDURE (d: StdDirectory) New (f: FormModels.Model): View;
		VAR v: StdView; grid, gridFactor: INTEGER;
	BEGIN
		ASSERT(f # NIL, 20);
		NEW(v); v.InitModel(f);
		IF ctrldir # NIL THEN v.SetController(ctrldir.New()) END;
		v.SetBorder(minBorder);
		IF Dialog.metricSystem THEN
			grid := 2 * Ports.mm; gridFactor := 5	(* place at 2 mm resolution *)
		ELSE
			grid := Ports.inch DIV 16; gridFactor := 8	(* place at 1/16 inch resolution *)
		END;
		v.SetGrid(grid, gridFactor);
		v.background := Ports.defaultColor;
		RETURN v
	END New;


	(** miscellaneous **)

	PROCEDURE Focus* (): View;
		VAR v: Views.View;
	BEGIN
		v := Controllers.FocusView();
		IF (v # NIL) & (v IS View) THEN RETURN v(View) ELSE RETURN NIL END
	END Focus;

	PROCEDURE FocusModel* (): FormModels.Model;
		VAR v: View;
	BEGIN
		v := Focus();
		IF v # NIL THEN RETURN v.ThisModel() ELSE RETURN NIL END
	END FocusModel;

	PROCEDURE RoundToGrid* (v: View; VAR x, y: INTEGER);
		VAR grid: INTEGER;
	BEGIN
		grid := v.Grid();
		x := x + grid DIV 2;
		y := y + grid DIV 2;
		x := x - x MOD grid;
		y := y - y MOD grid
	END RoundToGrid;

	PROCEDURE New* (): View;
	BEGIN
		RETURN dir.New(FormModels.dir.New())
	END New;

	PROCEDURE Deposit*;
	BEGIN
		Views.Deposit(New())
	END Deposit;

	PROCEDURE SetDir* (d: Directory);
	BEGIN
		ASSERT(d # NIL, 20); dir := d
	END SetDir;

	PROCEDURE SetCtrlDir* (d: Containers.Directory);
	BEGIN
		ASSERT(d # NIL, 20); ctrldir := d
	END SetCtrlDir;

	PROCEDURE Init;
		VAR d: StdDirectory; res: INTEGER;
	BEGIN
		Dialog.Call("FormControllers.Install", "#Form:CntrlInstallFailed", res);
		NEW(d); dir := d; stdDir := d
	END Init;

BEGIN
	Init
END FormViews.