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.