MODULE FormModels;
(**
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 Ports, Stores, Models, Views, Properties, Containers;
CONST
minViewSize* = 4 * Ports.point; (** size of smallest embedded view **)
maxViewSize* = 1000 * Ports.mm; (** size of largest embedded view **)
(* range of currently supported versions *)
minVersion = 0; maxBaseVersion = 0; maxStdVersion = 0;
TYPE
(* interface types *)
Model* = POINTER TO ABSTRACT RECORD (Containers.Model) END;
Directory* = POINTER TO ABSTRACT RECORD END;
Context* = POINTER TO ABSTRACT RECORD (Models.Context) END;
Reader* = POINTER TO ABSTRACT RECORD
view*: Views.View; (** most recently read view **)
l*, t*, r*, b*: INTEGER (** bounding box of most recently read view **)
END;
Writer* = POINTER TO ABSTRACT RECORD END;
UpdateMsg* = RECORD (Models.UpdateMsg)
(** the receiver of this message must not switch on any marks **)
l*, t*, r*, b*: INTEGER (** (l < r) & (b < t) **)
END;
(* concrete types *)
StdDirectory = POINTER TO RECORD (Directory) END;
StdModel = POINTER TO RECORD (Model)
contexts: StdContext (* list of views in form, ordered from bottom to top *)
END;
StdContext = POINTER TO RECORD (Context)
next: StdContext; (* next upper view *)
form: StdModel; (* form # NIL *)
view: Views.View; (* view # NIL *)
l, t, r, b: INTEGER (* (r - l >= minViewSize) & (b - t >= minViewSize) *)
END;
StdReader = POINTER TO RECORD (Reader)
form: StdModel; (* form # NIL *)
pos: StdContext (* next ReadView: read view above pos *)
END;
StdWriter = POINTER TO RECORD (Writer)
form: StdModel; (* form # NIL *)
pos: StdContext (* next WriteView: insert view above pos *)
END;
FormOp = POINTER TO RECORD (Stores.Operation)
del, ins: StdContext; (* ((del = NIL) # (ins = NIL)) OR (del = ins) *)
pos: StdContext (* ins # NIL => next Do: insert ins above pos *)
END;
ResizeOp = POINTER TO RECORD (Stores.Operation)
context: StdContext; (* context # NIL *)
l, t, r, b: INTEGER (* (r - l >= minViewSize) & (b - t >= minViewSize) *)
END;
ReplaceViewOp = POINTER TO RECORD (Stores.Operation)
context: StdContext; (* context # NIL *)
view: Views.View (* view # NIL *)
END;
VAR dir-, stdDir-: Directory; (** (dir # NIL) & (stdDir # NIL) **)
(** Model **)
PROCEDURE (f: Model) GetEmbeddingLimits* (OUT minW, maxW,
minH, maxH: INTEGER), EXTENSIBLE;
BEGIN
minH := minViewSize; minW := minViewSize;
maxH := maxViewSize; maxW := maxViewSize
END GetEmbeddingLimits;
PROCEDURE (f: Model) Insert* (v: Views.View; l, t, r, b: INTEGER), NEW, ABSTRACT;
(**
v # NIL 20
v.init 21
v.context = NIL 22
l <= r 23
t <= b 24
**)
PROCEDURE (f: Model) Delete* (v: Views.View), NEW, ABSTRACT;
(** v in f 20 **)
PROCEDURE (f: Model) Resize* (v: Views.View; l, t, r, b: INTEGER), NEW, ABSTRACT;
(**
v in f 20
l <= r 21
t <= b 22
**)
PROCEDURE (f: Model) Top* (): Views.View, NEW, ABSTRACT;
PROCEDURE (f: Model) PutAbove* (v, pos: Views.View), NEW, ABSTRACT;
(**
v in f 20
(pos = NIL) OR (pos in f) 21
**)
PROCEDURE (f: Model) Move* (v: Views.View; dx, dy: INTEGER), NEW, ABSTRACT;
(** v in f 20 **)
PROCEDURE (f: Model) Copy* (VAR v: Views.View; dx, dy: INTEGER), NEW, ABSTRACT;
(** v in f 20 **)
PROCEDURE (f: Model) NewReader* (old: Reader): Reader, NEW, ABSTRACT;
PROCEDURE (f: Model) NewWriter* (old: Writer): Writer, NEW, ABSTRACT;
PROCEDURE (f: Model) ViewAt* (x, y: INTEGER): Views.View, NEW, ABSTRACT;
PROCEDURE (f: Model) NofViews* (): INTEGER, NEW, ABSTRACT;
(** Directory **)
PROCEDURE (d: Directory) New* (): Model, NEW, ABSTRACT;
(** Context **)
PROCEDURE (c: Context) ThisModel* (): Model, ABSTRACT;
PROCEDURE (c: Context) GetRect* (OUT l, t, r, b: INTEGER), NEW, ABSTRACT;
(** Reader **)
PROCEDURE (rd: Reader) Set* (pos: Views.View), NEW, ABSTRACT;
(** (pos = NIL) OR (pos in r's form) 20 **)
PROCEDURE (rd: Reader) ReadView* (OUT v: Views.View), NEW, ABSTRACT;
(** Writer **)
PROCEDURE (wr: Writer) Set* (pos: Views.View), NEW, ABSTRACT;
(** (pos = NIL) OR (pos in w's form) 20 **)
PROCEDURE (wr: Writer) WriteView* (v: Views.View; l, t, r, b: INTEGER), NEW, ABSTRACT;
(**
v # NIL 20
v.init 21
v.context = NIL 22
l <= r 23
t <= b 24
**)
(* StdModel *)
PROCEDURE ThisContext (f: StdModel; view: Views.View): StdContext;
VAR c: StdContext;
BEGIN
c := f.contexts; WHILE (c # NIL) & (c.view # view) DO c := c.next END;
RETURN c
END ThisContext;
PROCEDURE NewContext (form: StdModel; view: Views.View; l, t, r, b: INTEGER): StdContext;
VAR c: StdContext;
BEGIN
ASSERT(form # NIL, 100); ASSERT(view.context = NIL, 101);
IF r - l < minViewSize THEN r := l + minViewSize END;
IF b - t < minViewSize THEN b := t + minViewSize END;
NEW(c); c.form := form; c.view := view; c.l := l; c.t := t; c.r := r; c.b := b;
Stores.Join(form, view);
view.InitContext(c);
RETURN c
END NewContext;
PROCEDURE InsertAbove (c, pos: StdContext);
BEGIN
IF pos = NIL THEN
c.next := NIL; c.form.contexts := c
ELSE
c.next := pos.next; pos.next := c
END
END InsertAbove;
PROCEDURE (f: StdModel) Internalize (VAR rd: Stores.Reader);
VAR thisVersion, l, t, r, b, x: INTEGER; top, h: StdContext; v: Views.View;
BEGIN
rd.ReadVersion(minVersion, maxStdVersion, thisVersion);
IF ~rd.cancelled THEN
rd.ReadVersion(0, 0, thisVersion); rd.ReadInt(x); (* backward compatibility with Rel. 1.3 *)
Views.ReadView(rd, v); top := NIL;
WHILE v # NIL DO
rd.ReadInt(l); rd.ReadInt(t); rd.ReadInt(r); rd.ReadInt(b);
h := NewContext(f, v, l, t, r, b);
InsertAbove(h, top); top := h;
Views.ReadView(rd, v)
END
END
END Internalize;
PROCEDURE (f: StdModel) Externalize (VAR wr: Stores.Writer);
VAR c: StdContext;
BEGIN
wr.WriteVersion(maxStdVersion);
wr.WriteVersion(0); wr.WriteInt(0); (* backward compatibility with Rel. 1.3 *)
c := f.contexts;
WHILE c # NIL DO
IF Stores.ExternalizeProxy(c.view) # NIL THEN
Views.WriteView(wr, c.view);
wr.WriteInt(c.l); wr.WriteInt(c.t);
wr.WriteInt(c.r); wr.WriteInt(c.b)
END;
c := c.next
END;
wr.WriteStore(NIL)
END Externalize;
PROCEDURE (f: StdModel) CopyFrom (source: Stores.Store);
VAR c, top, h: StdContext;
BEGIN
WITH source: StdModel DO
c := source.contexts; top := NIL;
WHILE c # NIL DO
h := NewContext(f, Views.CopyOf(c.view, Views.deep), c.l, c.t, c.r, c.b);
InsertAbove(h, top); top := h;
c := c.next
END
END
END CopyFrom;
PROCEDURE (f: StdModel) InitFrom (source: Containers.Model);
BEGIN
f.contexts := NIL
END InitFrom;
PROCEDURE (f: StdModel) ReplaceView (old, new: Views.View);
VAR op: ReplaceViewOp; c: StdContext;
BEGIN
c := ThisContext(f, old); ASSERT(c # NIL, 20);
ASSERT(new # NIL, 21); ASSERT((new.context = NIL) OR (new.context = c), 23);
IF old # new THEN
(* Stores.InitDomain(new, f.domain); *) Stores.Join(f, new);
new.InitContext(c); (* both views share same context *)
NEW(op); op.context := c; op.view := new;
Models.Do(f, "#System:ReplaceView", op)
END
END ReplaceView;
PROCEDURE (f: StdModel) Insert (v: Views.View; l, t, r, b: INTEGER);
VAR op: FormOp; c, h, top: StdContext;
BEGIN
ASSERT(v # NIL, 20); ASSERT(v.context = NIL, 22);
ASSERT(l <= r, 23); ASSERT(t <= b, 24);
h := f.contexts; top := NIL; WHILE h # NIL DO top := h; h := h.next END;
c := NewContext(f, v, l, t, r, b);
NEW(op); op.del := NIL; op.ins := c; op.pos := top;
Models.Do(f, "#System:Insertion", op)
END Insert;
PROCEDURE (f: StdModel) Delete (v: Views.View);
VAR op: FormOp; c: StdContext;
BEGIN
c := ThisContext(f, v); ASSERT(c # NIL, 20);
NEW(op); op.del := c; op.ins := NIL; op.pos := NIL;
Models.Do(f, "#System:Deletion", op)
END Delete;
PROCEDURE (f: StdModel) Resize (v: Views.View; l, t, r, b: INTEGER);
VAR op: ResizeOp; c: StdContext;
BEGIN
c := ThisContext(f, v); ASSERT(c # NIL, 20);
ASSERT(r >= l, 21); ASSERT(b >= t, 22);
IF r - l < minViewSize THEN r := l + minViewSize END;
IF b - t < minViewSize THEN b := t + minViewSize END;
NEW(op); op.context := c; op.l := l; op.t := t; op.r := r; op.b := b;
Models.Do(f, "#System:Resizing", op)
END Resize;
PROCEDURE (f: StdModel) Top (): Views.View;
VAR h, top: StdContext;
BEGIN
top := NIL; h := f.contexts;
WHILE h # NIL DO top := h; h := h.next END;
IF top # NIL THEN RETURN top.view ELSE RETURN NIL END
END Top;
PROCEDURE (f: StdModel) PutAbove (v, pos: Views.View);
VAR op: FormOp; c, d: StdContext;
BEGIN
c := ThisContext(f, v); ASSERT(c # NIL, 20);
d := ThisContext(f, pos); ASSERT((pos = NIL) OR (d # NIL), 21);
IF v # pos THEN
NEW(op); op.del := c; op.ins := c; op.pos := d;
Models.Do(f, "#Form:ChangeZOrder", op)
END
END PutAbove;
PROCEDURE (f: StdModel) Move (v: Views.View; dx, dy: INTEGER);
VAR op: ResizeOp; c: StdContext;
BEGIN
c := ThisContext(f, v); ASSERT(c # NIL, 20);
IF (dx # 0) OR (dy # 0) THEN
NEW(op); op.context := c;
op.l := c.l + dx; op.t := c.t + dy; op.r := c.r + dx; op.b := c.b + dy;
Models.Do(f, "#System:Moving", op)
END
END Move;
PROCEDURE (f: StdModel) Copy (VAR v: Views.View; dx, dy: INTEGER);
VAR op: FormOp; c, h, top: StdContext;
BEGIN
c := ThisContext(f, v); ASSERT(c # NIL, 20);
h := f.contexts; top := NIL; WHILE h # NIL DO top := h; h := h.next END;
h := NewContext(f, Views.CopyOf(v, Views.deep), c.l + dx, c.t + dy, c.r + dx, c.b + dy);
NEW(op); op.del := NIL; op.ins := h; op.pos := top;
Models.Do(f, "#System:Copying", op);
v := h.view
END Copy;
PROCEDURE (f: StdModel) NewReader (old: Reader): Reader;
VAR r: StdReader;
BEGIN
IF (old = NIL) OR ~(old IS StdReader) THEN NEW(r) ELSE r := old(StdReader) END;
r.view := NIL; r.l := 0; r.t := 0; r.r := 0; r.b := 0;
r.form := f; r.pos := NIL;
RETURN r
END NewReader;
PROCEDURE (f: StdModel) NewWriter (old: Writer): Writer;
VAR w: StdWriter;
BEGIN
IF (old = NIL) OR ~(old IS StdWriter) THEN NEW(w) ELSE w := old(StdWriter) END;
w.form := f; w.pos := NIL;
RETURN w
END NewWriter;
PROCEDURE (f: StdModel) ViewAt (x, y: INTEGER): Views.View;
VAR c, top: StdContext;
BEGIN
c := f.contexts; top := NIL;
WHILE c # NIL DO
IF (x >= c.l) & (y >= c.t) & (x < c.r) & (y < c.b) THEN top := c END;
c := c.next
END;
IF top = NIL THEN RETURN NIL ELSE RETURN top.view END
END ViewAt;
PROCEDURE (f: StdModel) NofViews (): INTEGER;
VAR c: StdContext; n: INTEGER;
BEGIN
n := 0; c := f.contexts; WHILE c # NIL DO INC(n); c := c.next END;
RETURN n
END NofViews;
(* StdContext *)
PROCEDURE (c: StdContext) ThisModel (): Model;
BEGIN
RETURN c.form
END ThisModel;
PROCEDURE (c: StdContext) GetSize (OUT w, h: INTEGER);
BEGIN
w := c.r - c.l; h := c.b - c.t
END GetSize;
PROCEDURE (c: StdContext) SetSize (w, h: INTEGER);
VAR w0, h0: INTEGER;
BEGIN
w0 := c.r - c.l; h0 := c.b - c.t; ASSERT(w0 > 0, 100); ASSERT(h0 > 0, 101);
Properties.PreferredSize(
c.view, minViewSize, maxViewSize, minViewSize, maxViewSize, w0, h0, w, h);
IF (w # w0) OR (h # h0) THEN
c.form.Resize(c.view, c.l, c.t, c.l + w, c.t + h)
END
END SetSize;
PROCEDURE (c: StdContext) Normalize (): BOOLEAN;
BEGIN
RETURN FALSE
END Normalize;
PROCEDURE (c: StdContext) GetRect (OUT l, t, r, b: INTEGER);
BEGIN
l := c.l; t := c.t; r := c.r; b := c.b
END GetRect;
(* StdDirectory *)
PROCEDURE (d: StdDirectory) New (): Model;
VAR f: StdModel;
BEGIN
NEW(f); RETURN f
END New;
(* StdReader *)
PROCEDURE (rd: StdReader) Set (pos: Views.View);
VAR c: StdContext;
BEGIN
IF pos = NIL THEN c := NIL ELSE c := ThisContext(rd.form, pos); ASSERT(c # NIL, 20) END;
rd.view := NIL; rd.l := 0; rd.t := 0; rd.r := 0; rd.b := 0;
rd.pos := c
END Set;
PROCEDURE (rd: StdReader) ReadView (OUT v: Views.View);
VAR c: StdContext;
BEGIN
c := rd.pos;
IF c = NIL THEN c := rd.form.contexts ELSE c := c.next END;
IF c # NIL THEN
rd.view := c.view; rd.l := c.l; rd.t := c.t; rd.r := c.r; rd.b := c.b;
rd.pos := c
ELSE
rd.view := NIL; rd.l := 0; rd.t := 0; rd.r := 0; rd.b := 0
END;
v := rd.view
END ReadView;
(* StdWriter *)
PROCEDURE (wr: StdWriter) Set (pos: Views.View);
VAR c: StdContext;
BEGIN
IF pos = NIL THEN c := NIL ELSE c := ThisContext(wr.form, pos); ASSERT(c # NIL, 20) END;
wr.pos := c
END Set;
PROCEDURE (wr: StdWriter) WriteView (v: Views.View; l, t, r, b: INTEGER);
VAR op: FormOp; c: StdContext;
BEGIN
ASSERT(v # NIL, 20); ASSERT(v.context = NIL, 22);
ASSERT(l <= r, 23); ASSERT(t <= b, 24);
c := NewContext(wr.form, v, l, t, r, b);
NEW(op); op.del := NIL; op.ins := c; op.pos := wr.pos;
wr.pos := c;
Models.Do(wr.form, "#System:Insertion", op)
END WriteView;
(* operations *)
PROCEDURE Update (c: StdContext);
VAR msg: UpdateMsg;
BEGIN
msg.l := c.l; msg.t := c.t; msg.r := c.r; msg.b := c.b; Models.Broadcast(c.form, msg)
END Update;
PROCEDURE (op: FormOp) Do;
VAR f: StdModel; c, p, pos: StdContext;
BEGIN
(* delete *)
pos := NIL;
c := op.del;
IF c # NIL THEN
f := c.form; ASSERT(f # NIL, 100);
p := f.contexts; ASSERT(p # NIL, 101);
IF p = c THEN
f.contexts := c.next
ELSE
WHILE p.next # c DO p := p.next; ASSERT(p # NIL, 102) END;
pos := p; p.next := c.next
END;
c.next := NIL;
Update(c)
END;
(* insert *)
c := op.ins;
IF c # NIL THEN
f := c.form; ASSERT(f # NIL, 103);
p := f.contexts;
IF op.pos = NIL THEN
c.next := f.contexts; f.contexts := c
ELSE
c.next := op.pos.next; op.pos.next := c
END;
Update(c)
END;
(* swap ins and del for undo *)
p := op.del; op.del := op.ins; op.ins := p; op.pos := pos
END Do;
PROCEDURE (op: ResizeOp) Do;
VAR c: StdContext; l, t, r, b: INTEGER;
BEGIN
c := op.context;
(* save old state of context *)
l := c.l; t := c.t; r := c.r; b := c.b;
Update(c);
(* set new state of context *)
c.l := op.l; c.t := op.t; c.r := op.r; c.b := op.b;
Update(c);
(* old state is new undo state *)
op.l := l; op.t := t; op.r := r; op.b := b
END Do;
PROCEDURE (op: ReplaceViewOp) Do;
VAR c: StdContext; view: Views.View;
BEGIN
c := op.context;
(* save old state of context *)
view := c.view;
(* set new state of context *)
c.view := op.view;
Update(c);
(* old state is new undo state *)
op.view := view
END Do;
(** miscellaneous **)
PROCEDURE New* (): Model;
BEGIN
RETURN dir.New()
END New;
PROCEDURE CloneOf* (source: Model): Model;
BEGIN
ASSERT(source # NIL, 20);
RETURN Containers.CloneOf(source)(Model)
END CloneOf;
PROCEDURE Copy* (source: Model): Model;
BEGIN
ASSERT(source # NIL, 20);
RETURN Stores.CopyOf(source)(Model)
END Copy;
PROCEDURE SetDir* (d: Directory);
(** d # NIL 20 **)
BEGIN
ASSERT(d # NIL, 20); dir := d
END SetDir;
PROCEDURE Init;
VAR d: StdDirectory;
BEGIN
NEW(d); dir := d; stdDir := d
END Init;
BEGIN
Init
END FormModels.