MODULE Views; (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Views.odc *) (* DO NOT EDIT *) IMPORT SYSTEM, Kernel, Log, Dialog, Files, Services, Fonts, Stores, Converters, Ports, Sequencers, Models; CONST (** View.Background color **) transparent* = 0FF000000H; (** Views.CopyModel / Views.CopyOf shallow **) deep* = FALSE; shallow* = TRUE; (** Update, UpdateIn rebuild **) keepFrames* = FALSE; rebuildFrames* = TRUE; (** Deposit, QualifiedDeposit, Fetch w, h **) undefined* = 0; (** OldView, RegisterView ask **) dontAsk* = FALSE; ask* = TRUE; (* method numbers (UNSAFE!) *) (* copyFrom = 1; *) copyFromModelView = 7; copyFromSimpleView = 8; (* Frame.state *) new = 0; open = 1; closed = 2; maxN = 30; (* max number of rects used to approximate a region *) minVersion = 0; maxVersion = 0; (* actOp *) handler = 1; restore = 2; externalize = 3; markBorderSize = 2; clean* = Sequencers.clean; notUndoable* = Sequencers.notUndoable; invisible* = Sequencers.invisible; TYPE (** views **) View* = POINTER TO ABSTRACT RECORD (Stores.Store) context-: Models.Context; (** stable context # NIL **) era: INTEGER; guard: INTEGER; (* = TrapCount()+1 if view is addressee of ongoing broadcast *) bad: SET END; Alien* = POINTER TO LIMITED RECORD (View) store-: Stores.Alien END; Title* = ARRAY 64 OF CHAR; TrapAlien = POINTER TO RECORD (Stores.Store) END; (** frames **) Frame* = POINTER TO ABSTRACT RECORD (Ports.Frame) l-, t-, r-, b-: INTEGER; (** l < r, t < b **) view-: View; (** opened => view # NIL, view.context # NIL, view.seq # NIL **) front-, mark-: BOOLEAN; state: BYTE; x, y: INTEGER; (* origin in coordinates of environment *) gx0, gy0: INTEGER; (* global origin w/o local scrolling compensation *) sx, sy: INTEGER; (* cumulated local sub-pixel scrolling compensation *) next, down, up, focus: Frame; level: INTEGER (* used for partial z-ordering *) END; Message* = ABSTRACT RECORD view-: View (** view # NIL **) END; NotifyMsg* = EXTENSIBLE RECORD (Message) id0*, id1*: INTEGER; opts*: SET END; NotifyHook = POINTER TO RECORD (Dialog.NotifyHook) END; UpdateCachesMsg* = EXTENSIBLE RECORD (Message) END; ScrollClassMsg* = RECORD (Message) allowBitmapScrolling*: BOOLEAN (** OUT, preset to FALSE **) END; (** property messages **) PropMessage* = ABSTRACT RECORD END; (** controller messages **) CtrlMessage* = ABSTRACT RECORD END; CtrlMsgHandler* = PROCEDURE (op: INTEGER; f, g: Frame; VAR msg: CtrlMessage; VAR mark, front, req: BOOLEAN); UpdateMsg = RECORD (Message) scroll, rebuild, all: BOOLEAN; l, t, r, b, dx, dy: INTEGER END; Rect = RECORD v: View; rebuild: BOOLEAN; l, t, r, b: INTEGER END; Region = POINTER TO RECORD n: INTEGER; r: ARRAY maxN OF Rect END; RootFrame* = POINTER TO RECORD (Frame) flags-: SET; update: Region (* allocated lazily by SetRoot *) END; StdFrame = POINTER TO RECORD (Frame) END; (* view producer/consumer decoupling *) QueueElem = POINTER TO RECORD next: QueueElem; view: View END; GetSpecHook* = POINTER TO ABSTRACT RECORD (Kernel.Hook) END; ViewHook* = POINTER TO ABSTRACT RECORD (Kernel.Hook) END; MsgHook* = POINTER TO ABSTRACT RECORD (Kernel.Hook) END; VAR HandleCtrlMsg-: CtrlMsgHandler; domainGuard: INTEGER; (* = TrapCount()+1 if domain is addressee of ongoing domaincast *) actView: View; actFrame: RootFrame; actOp: INTEGER; copyModel: Models.Model; (* context for (View)CopyFrom; reset by TrapCleanup *) queue: RECORD len: INTEGER; head, tail: QueueElem END; getSpecHook: GetSpecHook; viewHook: ViewHook; msgHook: MsgHook; PROCEDURE Overwritten (v: View; mno: INTEGER): BOOLEAN; VAR base, actual: PROCEDURE; BEGIN SYSTEM.GET(SYSTEM.TYP(View) - 4 * (mno + 1), base); SYSTEM.GET(SYSTEM.TYP(v) - 4 * (mno + 1), actual); RETURN actual # base END Overwritten; (** Hooks **) PROCEDURE (h: GetSpecHook) GetExtSpec* (s: Stores.Store; VAR loc: Files.Locator; VAR name: Files.Name; VAR conv: Converters.Converter), NEW, ABSTRACT; PROCEDURE (h: GetSpecHook) GetIntSpec* (VAR loc: Files.Locator; VAR name: Files.Name; VAR conv: Converters.Converter), NEW, ABSTRACT; PROCEDURE SetGetSpecHook*(h: GetSpecHook); BEGIN getSpecHook := h END SetGetSpecHook; PROCEDURE (h: ViewHook) OldView* (loc: Files.Locator; name: Files.Name; VAR conv: Converters.Converter): View, NEW, ABSTRACT; PROCEDURE (h: ViewHook) Open* (s: View; title: ARRAY OF CHAR; loc: Files.Locator; name: Files.Name; conv: Converters.Converter; asTool, asAux, noResize, allowDuplicates, neverDirty: BOOLEAN), NEW, ABSTRACT; PROCEDURE (h: ViewHook) RegisterView* (s: View; loc: Files.Locator; name: Files.Name; conv: Converters.Converter), NEW, ABSTRACT; PROCEDURE SetViewHook*(h: ViewHook); BEGIN viewHook := h END SetViewHook; PROCEDURE (h: MsgHook) Omnicast* (VAR msg: ANYREC), NEW, ABSTRACT; PROCEDURE (h: MsgHook) RestoreDomain* (domain: Stores.Domain), NEW, ABSTRACT; PROCEDURE SetMsgHook*(h: MsgHook); BEGIN msgHook := h END SetMsgHook; (** Model protocol **) PROCEDURE (v: View) CopyFromSimpleView- (source: View), NEW, EMPTY; PROCEDURE (v: View) CopyFromModelView- (source: View; model: Models.Model), NEW, EMPTY; PROCEDURE (v: View) ThisModel* (): Models.Model, NEW, EXTENSIBLE; BEGIN RETURN NIL END ThisModel; (** Store protocol **) PROCEDURE (v: View) CopyFrom- (source: Stores.Store); VAR tm, fm: Models.Model; c: Models.Context; BEGIN tm := copyModel; copyModel := NIL; WITH source: View DO v.era := source.era; actView := NIL; IF tm = NIL THEN (* if copyModel wasn't preset then use deep copy as default *) fm := source.ThisModel(); IF fm # NIL THEN tm := Stores.CopyOf(fm)(Models.Model) END END; actView := v; IF Overwritten(v, copyFromModelView) THEN (* new View *) ASSERT(~Overwritten(v, copyFromSimpleView), 20); c := v.context; v.CopyFromModelView(source, tm); ASSERT(v.context = c, 60) ELSE (* old or simple View *) (* IF tm # NIL THEN v.InitModel(tm) END *) c := v.context; v.CopyFromSimpleView(source); ASSERT(v.context = c, 60) END END END CopyFrom; PROCEDURE (v: View) Internalize- (VAR rd: Stores.Reader), EXTENSIBLE; VAR thisVersion: INTEGER; BEGIN v.Internalize^(rd); IF rd.cancelled THEN RETURN END; rd.ReadVersion(minVersion, maxVersion, thisVersion) END Internalize; PROCEDURE (v: View) Externalize- (VAR wr: Stores.Writer), EXTENSIBLE; BEGIN v.Externalize^(wr); wr.WriteVersion(maxVersion) END Externalize; (** embedding protocol **) PROCEDURE (v: View) InitContext* (context: Models.Context), NEW, EXTENSIBLE; BEGIN ASSERT(context # NIL, 21); ASSERT((v.context = NIL) OR (v.context = context), 22); v.context := context END InitContext; PROCEDURE (v: View) GetBackground* (VAR color: Ports.Color), NEW, EMPTY; PROCEDURE (v: View) ConsiderFocusRequestBy- (view: View), NEW, EMPTY; PROCEDURE (v: View) Neutralize*, NEW, EMPTY; (** Frame protocol **) PROCEDURE (v: View) GetNewFrame* (VAR frame: Frame), NEW, EMPTY; PROCEDURE (v: View) Restore* (f: Frame; l, t, r, b: INTEGER), NEW, ABSTRACT; PROCEDURE (v: View) RestoreMarks* (f: Frame; l, t, r, b: INTEGER), NEW, EMPTY; (** handlers **) PROCEDURE (v: View) HandleModelMsg- (VAR msg: Models.Message), NEW, EMPTY; PROCEDURE (v: View) HandleViewMsg- (f: Frame; VAR msg: Message), NEW, EMPTY; PROCEDURE (v: View) HandleCtrlMsg* (f: Frame; VAR msg: CtrlMessage; VAR focus: View), NEW, EMPTY; PROCEDURE (v: View) HandlePropMsg- (VAR msg: PropMessage), NEW, EMPTY; (** Alien **) PROCEDURE (a: Alien) Externalize- (VAR wr: Stores.Writer); BEGIN HALT(100) END Externalize; PROCEDURE (a: Alien) Internalize- (VAR rd: Stores.Reader); BEGIN HALT(100) END Internalize; PROCEDURE (a: Alien) CopyFromSimpleView- (source: View); BEGIN a.store := Stores.CopyOf(source(Alien).store)(Stores.Alien); Stores.Join(a, a.store) END CopyFromSimpleView; PROCEDURE (a: Alien) Restore* (f: Frame; l, t, r, b: INTEGER); VAR u, w, h: INTEGER; BEGIN u := f.dot; a.context.GetSize(w, h); f.DrawRect(0, 0, w, h, Ports.fill, Ports.grey25); f.DrawRect(0, 0, w, h, 2 * u, Ports.grey75); f.DrawLine(0, 0, w - u, h - u, u, Ports.grey75); f.DrawLine(w - u, 0, 0, h - u, u, Ports.grey75) END Restore; (** TrapAlien **) PROCEDURE (v: TrapAlien) Internalize (VAR rd: Stores.Reader); BEGIN v.Internalize^(rd); rd.TurnIntoAlien(3) END Internalize; PROCEDURE (v: TrapAlien) Externalize (VAR rd: Stores.Writer); END Externalize; PROCEDURE (v: TrapAlien) CopyFrom (source: Stores.Store), EMPTY; (** Frame **) PROCEDURE (f: Frame) Close* (), NEW, EMPTY; (* Rect, Region *) PROCEDURE Union (VAR u: Rect; r: Rect); BEGIN IF r.v # u.v THEN u.v := NIL END; IF r.rebuild THEN u.rebuild := TRUE END; IF r.l < u.l THEN u.l := r.l END; IF r.t < u.t THEN u.t := r.t END; IF r.r > u.r THEN u.r := r.r END; IF r.b > u.b THEN u.b := r.b END END Union; PROCEDURE Add (rgn: Region; v: View; rebuild: BOOLEAN; gl, gt, gr, gb: INTEGER); (* does not perfectly maintain invariant of non-overlapping approx rects ... *) VAR q: Rect; i, j, n: INTEGER; x: ARRAY maxN OF BOOLEAN; BEGIN q.v := v; q.rebuild := rebuild; q.l := gl; q.t := gt; q.r := gr; q.b := gb; n := rgn.n + 1; i := 0; WHILE i < rgn.n DO x[i] := (gl < rgn.r[i].r) & (rgn.r[i].l < gr) & (gt < rgn.r[i].b) & (rgn.r[i].t < gb); IF x[i] THEN Union(q, rgn.r[i]); DEC(n) END; INC(i) END; IF n > maxN THEN (* n = maxN + 1 -> merge q with arbitrarily picked rect and Add *) Union(q, rgn.r[maxN - 1]); Add(rgn, v, q.rebuild, q.l, q.t, q.r, q.b) ELSE i := 0; WHILE (i < rgn.n) & ~x[i] DO INC(i) END; rgn.r[i] := q; INC(i); WHILE (i < rgn.n) & ~x[i] DO INC(i) END; j := i; WHILE (i < rgn.n) & x[i] DO INC(i) END; WHILE i < rgn.n DO (* ~x[i] *) rgn.r[j] := rgn.r[i]; INC(j); INC(i); WHILE (i < rgn.n) & x[i] DO INC(i) END END; rgn.n := n END END Add; PROCEDURE AddRect (root: RootFrame; f: Frame; l, t, r, b: INTEGER; rebuild: BOOLEAN); VAR rl, rt, rr, rb: INTEGER; i: INTEGER; BEGIN INC(l, f.gx); INC(t, f.gy); INC(r, f.gx); INC(b, f.gy); rl := root.l + root.gx; rt := root.t + root.gy; rr := root.r + root.gx; rb := root.b + root.gy; IF l < rl THEN l := rl END; IF t < rt THEN t := rt END; IF r > rr THEN r := rr END; IF b > rb THEN b := rb END; IF (l < r) & (t < b) THEN Add(root.update, f.view, rebuild, l, t, r, b); i := 0; WHILE (i < root.update.n) & (~root.update.r[i].rebuild OR (root.update.r[i].v # NIL)) DO INC(i) END; IF i < root.update.n THEN Add(root.update, root.view, TRUE, rl, rt, rr, rb) END END END AddRect; (** miscellaneous **) PROCEDURE RestoreDomain* (domain: Stores.Domain); BEGIN ASSERT(msgHook # NIL, 100); msgHook.RestoreDomain(domain) END RestoreDomain; PROCEDURE MarkBorder* (host: Ports.Frame; view: View; l, t, r, b: INTEGER); VAR s: INTEGER; BEGIN IF view # NIL THEN s := markBorderSize * host.dot; host.MarkRect(l - s, t - s, r + s, b + s, s, Ports.dim50, Ports.show) END END MarkBorder; (** views **) PROCEDURE SeqOf (v: View): Sequencers.Sequencer; VAR (*c: Models.Context;*) d: Stores.Domain; seq: Sequencers.Sequencer; any: ANYPTR; BEGIN d := v.Domain(); seq := NIL; IF d # NIL THEN any := d.GetSequencer(); IF (any # NIL) & (any IS Sequencers.Sequencer) THEN seq := any(Sequencers.Sequencer) END END; RETURN seq END SeqOf; PROCEDURE Era* (v: View): INTEGER; (** pre: v # NIL *) (** post: v.ThisModel() # NIL in-synch(v) iff Era(v) = Models.Era(v.ThisModel()) **) BEGIN ASSERT(v # NIL, 20); RETURN v.era END Era; PROCEDURE BeginScript* (v: View; name: Stores.OpName; OUT script: Stores.Operation); (** pre: v # NIL *) (** post: (script # NIL) iff (v.seq # NIL) **) VAR seq: Sequencers.Sequencer; BEGIN ASSERT(v # NIL, 20); seq := SeqOf(v); IF seq # NIL THEN seq.BeginScript(name, script) ELSE script := NIL END END BeginScript; PROCEDURE Do* (v: View; name: Stores.OpName; op: Stores.Operation); (** pre: v # NIL, op # NIL, ~op.inUse **) VAR seq: Sequencers.Sequencer; BEGIN ASSERT(v # NIL, 20); ASSERT(op # NIL, 21); (* ASSERT(~op.inUse, 22); *) seq := SeqOf(v); IF seq # NIL THEN seq.Do(v, name, op) ELSE op.Do END END Do; PROCEDURE LastOp* (v: View): Stores.Operation; (** pre: v # NIL **) VAR seq: Sequencers.Sequencer; BEGIN ASSERT(v # NIL, 20); seq := SeqOf(v); IF seq # NIL THEN RETURN seq.LastOp(v) ELSE RETURN NIL END END LastOp; PROCEDURE Bunch* (v: View); (** pre: v # NIL **) VAR seq: Sequencers.Sequencer; BEGIN ASSERT(v # NIL, 20); seq := SeqOf(v); ASSERT(seq # NIL, 21); seq.Bunch(v) END Bunch; PROCEDURE StopBunching* (v: View); (** pre: v # NIL **) VAR seq: Sequencers.Sequencer; BEGIN ASSERT(v # NIL, 20); seq := SeqOf(v); IF seq # NIL THEN seq.StopBunching END END StopBunching; PROCEDURE EndScript* (v: View; script: Stores.Operation); (** pre: (script # NIL) iff (v.seq # NIL) **) VAR seq: Sequencers.Sequencer; BEGIN ASSERT(v # NIL, 20); seq := SeqOf(v); IF seq # NIL THEN ASSERT(script # NIL, 21); seq.EndScript(script) ELSE ASSERT(script = NIL, 22) END END EndScript; PROCEDURE BeginModification* (type: INTEGER; v: View); VAR seq: Sequencers.Sequencer; BEGIN ASSERT(v # NIL, 20); seq := SeqOf(v); IF seq # NIL THEN seq.BeginModification(type, v) END END BeginModification; PROCEDURE EndModification* (type: INTEGER; v: View); VAR seq: Sequencers.Sequencer; BEGIN ASSERT(v # NIL, 20); seq := SeqOf(v); IF seq # NIL THEN seq.EndModification(type, v) END END EndModification; PROCEDURE SetDirty* (v: View); VAR seq: Sequencers.Sequencer; BEGIN ASSERT(v # NIL, 20); seq := SeqOf(v); IF seq # NIL THEN seq.SetDirty(TRUE) END END SetDirty; PROCEDURE Domaincast* (domain: Stores.Domain; VAR msg: Message); VAR g: INTEGER; seq: ANYPTR; BEGIN IF domain # NIL THEN seq := domain.GetSequencer(); IF seq # NIL THEN msg.view := NIL; g := Kernel.trapCount + 1; IF domainGuard > 0 THEN ASSERT(domainGuard # g, 20) END; domainGuard := g; seq(Sequencers.Sequencer).Handle(msg); domainGuard := 0 END END END Domaincast; PROCEDURE Broadcast* (v: View; VAR msg: Message); VAR seq: Sequencers.Sequencer; g: INTEGER; BEGIN ASSERT(v # NIL, 20); msg.view := v; seq := SeqOf(v); IF seq # NIL THEN g := Kernel.trapCount + 1; IF v.guard > 0 THEN ASSERT(v.guard # g, 21) END; v.guard := g; seq.Handle(msg); v.guard := 0 END END Broadcast; PROCEDURE Update* (v: View; rebuild: BOOLEAN); VAR upd: UpdateMsg; BEGIN ASSERT(v # NIL, 20); upd.scroll := FALSE; upd.rebuild := rebuild; upd.all := TRUE; Broadcast(v, upd) END Update; PROCEDURE UpdateIn* (v: View; l, t, r, b: INTEGER; rebuild: BOOLEAN); VAR upd: UpdateMsg; BEGIN ASSERT(v # NIL, 20); upd.scroll := FALSE; upd.rebuild := rebuild; upd.all := FALSE; upd.l := l; upd.t := t; upd.r := r; upd.b := b; Broadcast(v, upd) END UpdateIn; PROCEDURE Scroll* (v: View; dx, dy: INTEGER); VAR scroll: UpdateMsg; BEGIN ASSERT(v # NIL, 20); ASSERT(v.Domain() # NIL, 21); RestoreDomain(v.Domain()); scroll.scroll := TRUE; scroll.dx := dx; scroll.dy := dy; Broadcast(v, scroll) END Scroll; PROCEDURE CopyOf* (v: View; shallow: BOOLEAN): View; VAR w, a: View; op: INTEGER; b: Alien; BEGIN ASSERT(v # NIL, 20); IF ~(handler IN v.bad) THEN a := actView; op := actOp; actView := NIL; actOp := handler; IF shallow THEN copyModel := v.ThisModel() END; actView := v; w := Stores.CopyOf(v)(View); actView := a; actOp := op ELSE NEW(b); w := b; w.bad := {handler..externalize} END; IF shallow THEN Stores.Join(w, v) END; RETURN w END CopyOf; PROCEDURE CopyWithNewModel* (v: View; m: Models.Model): View; VAR w, a: View; op: INTEGER; b: Alien; fm: Models.Model; BEGIN ASSERT(v # NIL, 20); fm := v.ThisModel(); ASSERT(fm # NIL, 21); ASSERT(m # NIL, 22); ASSERT(Services.SameType(m, fm), 23); IF ~(handler IN v.bad) THEN a := actView; op := actOp; actView := v; actOp := handler; copyModel := m; w := Stores.CopyOf(v)(View); actView := a; actOp := op ELSE NEW(b); w := b; w.bad := {handler..externalize} END; RETURN w END CopyWithNewModel; PROCEDURE ReadView* (VAR rd: Stores.Reader; OUT v: View); VAR st: Stores.Store; a: Alien; BEGIN rd.ReadStore(st); IF st = NIL THEN v := NIL ELSIF st IS Stores.Alien THEN NEW(a); a.store := st(Stores.Alien); Stores.Join(a, a.store); v := a ELSE v := st(View) END END ReadView; PROCEDURE WriteView* (VAR wr: Stores.Writer; v: View); VAR a: TrapAlien; av: View; op: INTEGER; BEGIN IF v = NIL THEN wr.WriteStore(v) ELSIF externalize IN v.bad THEN NEW(a); wr.WriteStore(a) ELSIF v IS Alien THEN wr.WriteStore(v(Alien).store) ELSE av := actView; op := actOp; actView := v; actOp := externalize; wr.WriteStore(v); actView := av; actOp := op END END WriteView; (* frames *) PROCEDURE SetClip (f: Frame; l, t, r, b: INTEGER); VAR u: INTEGER; BEGIN ASSERT(f.rider # NIL, 20); ASSERT(l <= r, 21); ASSERT(t <= b, 22); u := f.unit; f.rider.SetRect((l + f.gx) DIV u, (t + f.gy) DIV u, (r + f.gx) DIV u, (b + f.gy) DIV u); f.l := l; f.t := t; f.r := r; f.b := b END SetClip; PROCEDURE Close (f: Frame); BEGIN f.Close; f.state := closed; f.up := NIL; f.down := NIL; f.next := NIL; f.view := NIL; f.ConnectTo(NIL) END Close; PROCEDURE AdaptFrameTo (f: Frame; orgX, orgY: INTEGER); VAR g, p, q: Frame; port: Ports.Port; w, h, pl, pt, pr, pb, gl, gt, gr, gb, gx, gy: INTEGER; BEGIN (* pre: environment (i.e. parent frame / port) has already been set up *) ASSERT(f.view # NIL, 20); ASSERT(f.view.context # NIL, 21); f.x := orgX; f.y := orgY; (* set new origin *) g := f.up; IF g # NIL THEN (* parent frame is environment *) f.gx0 := g.gx + orgX; f.gy0 := g.gy + orgY; f.SetOffset(f.gx0 - f.sx, f.gy0 - f.sy); pl := g.gx + g.l; pt := g.gy + g.t; pr := g.gx + g.r; pb := g.gy + g.b ELSE (* port is environment *) f.gx0 := orgX; f.gy0 := orgY; f.SetOffset(f.gx0 - f.sx, f.gy0 - f.sy); port := f.rider.Base(); port.GetSize(w, h); pl := 0; pt := 0; pr := w * f.unit; pb := h * f.unit END; (* (pl, pt, pr, pb) is parent clipping rectangle, in global coordinates, and in units *) gx := f.gx; gy := f.gy; f.view.context.GetSize(w, h); gl := gx; gt := gy; gr := gx + w; gb := gy + h; (* (gl, gt, gr, gb) is desired clipping rectangle, in global coordinates, and in units *) IF gl < pl THEN gl := pl END; IF gt < pt THEN gt := pt END; IF gr > pr THEN gr := pr END; IF gb > pb THEN gb := pb END; IF (gl >= gr) OR (gt >= gb) THEN gr := gl; gb := gt END; SetClip(f, gl - gx + f.sx, gt - gy + f.sy, gr - gx + f.sx, gb - gy + f.sy); (* (f.l, f.t, f.r, f.b) is final clipping rectangle, in local coordinates, and in units *) g := f.down; f.down := NIL; p := NIL; WHILE g # NIL DO (* adapt child frames *) q := g.next; g.next := NIL; AdaptFrameTo(g, g.x, g.y); IF g.l = g.r THEN (* empty child frame: remove *) Close(g) ELSE (* insert in new frame list *) IF p = NIL THEN f.down := g ELSE p.next := g END; p := g END; g := q END (* post: frame is set; child frames are set, nonempty, and clipped to frame *) END AdaptFrameTo; PROCEDURE SetRoot* (root: RootFrame; view: View; front: BOOLEAN; flags: SET); BEGIN ASSERT(root # NIL, 20); ASSERT(root.rider # NIL, 21); ASSERT(view # NIL, 22); ASSERT(view.context # NIL, 23); ASSERT(view.Domain() # NIL, 24); ASSERT(root.state IN {new, open}, 25); root.view := view; root.front := front; root.mark := TRUE; root.flags := flags; root.state := open; IF root.update = NIL THEN NEW(root.update); root.update.n := 0 END END SetRoot; PROCEDURE AdaptRoot* (root: RootFrame); BEGIN ASSERT(root # NIL, 20); ASSERT(root.state = open, 21); AdaptFrameTo(root, root.x, root.y) END AdaptRoot; PROCEDURE UpdateRoot* (root: RootFrame; l, t, r, b: INTEGER; rebuild: BOOLEAN); BEGIN ASSERT(root # NIL, 20); ASSERT(root.state = open, 21); AddRect(root, root, l, t, r, b, rebuild) END UpdateRoot; PROCEDURE RootOf* (f: Frame): RootFrame; BEGIN ASSERT(f # NIL, 20); ASSERT(f.state = open, 21); WHILE f.up # NIL DO f := f.up END; RETURN f(RootFrame) END RootOf; PROCEDURE HostOf* (f: Frame): Frame; BEGIN ASSERT(f # NIL, 20); RETURN f.up END HostOf; PROCEDURE IsPrinterFrame* (f: Frame): BOOLEAN; VAR p: Ports.Port; BEGIN ASSERT(f # NIL, 20); ASSERT(f.state = open, 21); p := f.rider.Base(); RETURN Ports.IsPrinterPort(p) END IsPrinterFrame; PROCEDURE InstallFrame* (host: Frame; view: View; x, y, level: INTEGER; focus: BOOLEAN); VAR e, f, g: Frame; w, h, l, t, r, b: INTEGER; m: Models.Model; std: StdFrame; msg: UpdateCachesMsg; a: View; op: INTEGER; BEGIN ASSERT(host # NIL, 20); ASSERT(host.state = open, 21); ASSERT(view # NIL, 22); ASSERT(view.context # NIL, 23); ASSERT(view.Domain() # NIL, 24); e := NIL; g := host.down; WHILE (g # NIL) & (g.view # view) DO e := g; g := g.next END; IF g = NIL THEN (* frame for view not yet in child frame list *) view.context.GetSize(w, h); IF w > MAX(INTEGER) DIV 2 THEN w := MAX(INTEGER) DIV 2 END; IF h > MAX(INTEGER) DIV 2 THEN h := MAX(INTEGER) DIV 2 END; l := x; t := y; r := x + w; b := y + h; (* (l, t, r, b) is child frame rectangle, in local coordinates, and in units *) IF (l < host.r) & (t < host.b) & (r > host.l) & (b > host.t) THEN (* visible *) g := NIL; view.GetNewFrame(g); IF g = NIL THEN NEW(std); g := std END; ASSERT(~(g IS RootFrame), 100); e := NIL; f := host.down; WHILE (f # NIL) & (f.level <= level) DO e := f; f := f.next END; IF e = NIL THEN g.next := host.down; host.down := g ELSE g.next := e.next; e.next := g END; g.down := NIL; g.up := host; g.level := level; g.view := view; g.ConnectTo(host.rider.Base()); g.state := open; AdaptFrameTo(g, x, y); IF ~(handler IN view.bad) THEN a := actView; op := actOp; actView := view; actOp := handler; view.HandleViewMsg(g, msg); actView := a; actOp := op END; m := view.ThisModel(); IF m # NIL THEN view.era := Models.Era(m) END; END ELSE IF g.level # level THEN (* adapt to modified z-order *) IF e = NIL THEN host.down := g.next ELSE e.next := g.next END; e := NIL; f := host.down; WHILE (f # NIL) & (f.level <= level) DO e := f; f := f.next END; IF e = NIL THEN g.next := host.down; host.down := g ELSE g.next := e.next; e.next := g END; g.level := level END; AdaptFrameTo(g, x, y) (* may close g, leaving g.state = closed *) (* possibly optimize: don't call Adapt if x=g.x, y=g.y, "host.era=g.era" *) END; IF (g # NIL) & (g.state = open) THEN IF focus THEN g.front := host.front; g.mark := host.mark ELSE g.front := FALSE; g.mark := FALSE END END END InstallFrame; PROCEDURE RemoveAll (f: Frame); VAR g, p: Frame; BEGIN g := f.down; WHILE g # NIL DO p := g.next; RemoveAll(g); Close(g); g := p END; f.down := NIL END RemoveAll; PROCEDURE RemoveFrame* (host, f: Frame); VAR g, h: Frame; BEGIN ASSERT(host # NIL, 20); ASSERT(host.state = open, 21); ASSERT(f # NIL, 22); ASSERT(f.up = host, 23); g := host.down; h := NIL; WHILE (g # NIL) & (g # f) DO h := g; g := g.next END; ASSERT(g = f, 24); IF h = NIL THEN host.down := f.next ELSE h.next := f.next END; RemoveAll(f); Close(f) END RemoveFrame; PROCEDURE RemoveFrames* (host: Frame; l, t, r, b: INTEGER); VAR f, g: Frame; gl, gt, gr, gb: INTEGER; BEGIN ASSERT(host # NIL, 20); ASSERT(host.state = open, 21); IF l < host.l THEN l := host.l END; IF t < host.t THEN t := host.t END; IF r > host.r THEN r := host.r END; IF b > host.b THEN b := host.b END; IF (l < r) & (t < b) THEN gl := l + host.gx; gt := t + host.gy; gr := r + host.gx; gb := b + host.gy; f := host.down; WHILE f # NIL DO g := f; f := f.next; IF (gl < g.r + g.gx) & (g.l + g.gx < gr) & (gt < g.b + g.gy) & (g.t + g.gy < gb) THEN RemoveFrame(host, g) END END END END RemoveFrames; PROCEDURE ThisFrame* (host: Frame; view: View): Frame; VAR g: Frame; BEGIN ASSERT(host # NIL, 20); ASSERT(host.state = open, 21); g := host.down; WHILE (g # NIL) & (g.view # view) DO g := g.next END; RETURN g END ThisFrame; PROCEDURE FrameAt* (host: Frame; x, y: INTEGER): Frame; (** return frontmost sub-frame of host that contains (x, y) **) VAR g, h: Frame; BEGIN ASSERT(host # NIL, 20); ASSERT(host.state = open, 21); g := host.down; h := NIL; INC(x, host.gx); INC(y, host.gy); WHILE g # NIL DO IF (g.gx + g.l <= x) & (x < g.gx + g.r) & (g.gy + g.t <= y) & (y < g.gy + g.b) THEN h := g END; g := g.next END; RETURN h END FrameAt; PROCEDURE ShiftFrames (f: Frame; dx, dy: INTEGER); VAR g, h: Frame; BEGIN g := f.down; WHILE g # NIL DO h := g; g := g.next; AdaptFrameTo(h, h.x + dx, h.y + dy); IF h.l = h.r THEN RemoveFrame(f, h) END END END ShiftFrames; PROCEDURE UpdateExposedArea (f: Frame; dx, dy: INTEGER); VAR root: RootFrame; BEGIN root := RootOf(f); IF dy > 0 THEN AddRect(root, f, f.l, f.t, f.r, f.t + dy, keepFrames); IF dx > 0 THEN AddRect(root, f, f.l, f.t + dy, f.l + dx, f.b, keepFrames) ELSE AddRect(root, f, f.r + dx, f.t + dy, f.r, f.b, keepFrames) END ELSE AddRect(root, f, f.l, f.b + dy, f.r, f.b, keepFrames); IF dx > 0 THEN AddRect(root, f, f.l, f.t, f.l + dx, f.b + dy, keepFrames) ELSE AddRect(root, f, f.r + dx, f.t, f.r, f.b + dy, keepFrames) END END END UpdateExposedArea; PROCEDURE ScrollFrame (f: Frame; dx, dy: INTEGER); VAR g: Frame; u, dx0, dy0: INTEGER; bitmapScrolling: BOOLEAN; msg: ScrollClassMsg; BEGIN g := f.up; bitmapScrolling := TRUE; IF (g # NIL) THEN WHILE bitmapScrolling & (g.up # NIL) DO msg.allowBitmapScrolling := FALSE; g.view.HandleViewMsg(g, msg); bitmapScrolling := bitmapScrolling & msg.allowBitmapScrolling; g := g.up END END; IF bitmapScrolling THEN u := f.unit; dx0 := dx; dy0 := dy; INC(dx, f.sx); INC(dy, f.sy); DEC(f.l, f.sx); DEC(f.t, f.sy); DEC(f.r, f.sx); DEC(f.b, f.sy); f.sx := dx MOD u; f.sy := dy MOD u; DEC(dx, f.sx); DEC(dy, f.sy); INC(f.l, f.sx); INC(f.t, f.sy); INC(f.r, f.sx); INC(f.b, f.sy); f.SetOffset(f.gx0 - f.sx, f.gy0 - f.sy); ShiftFrames(f, dx0, dy0); f.Scroll(dx, dy); UpdateExposedArea(f, dx, dy) ELSE AddRect(RootOf(f), f, f.l, f.t, f.r, f.b, rebuildFrames) END END ScrollFrame; PROCEDURE BroadcastModelMsg* (f: Frame; VAR msg: Models.Message); VAR v, a: View; send: BOOLEAN; op: INTEGER; BEGIN ASSERT(f # NIL, 20); ASSERT(f.state = open, 21); v := f.view; IF ~(handler IN v.bad) THEN a := actView; op := actOp; actView := v; actOp := handler; IF msg.model # NIL THEN IF (msg.model = v.ThisModel()) & (msg.era > v.era) THEN send := (msg.era - v.era = 1); v.era := msg.era; IF ~send THEN Log.synch := FALSE; HALT(100) END ELSE send := FALSE END ELSE send := TRUE END; IF send THEN WITH msg: Models.NeutralizeMsg DO v.Neutralize ELSE v.HandleModelMsg(msg) END END; actView := a; actOp := op END; f := f.down; WHILE f # NIL DO BroadcastModelMsg(f, msg); f := f.next END END BroadcastModelMsg; PROCEDURE HandleUpdateMsg (f: Frame; VAR msg: UpdateMsg); VAR root: RootFrame; g: Frame; l, t, r, b, dx, dy: INTEGER; BEGIN root := RootOf(f); IF msg.scroll THEN IF root.update.n = 0 THEN ScrollFrame(f, msg.dx, msg.dy) ELSE AddRect(root, f, f.l, f.t, f.r, f.b, msg.rebuild) END ELSE IF msg.all THEN IF f # root THEN g := f.up ELSE g := root END; dx := f.gx - g.gx; dy := f.gy - g.gy; AddRect(root, g, f.l + dx, f.t + dy, f.r + dx, f.b + dy, msg.rebuild) ELSE l := msg.l; t := msg.t; r := msg.r; b := msg.b; IF l < f.l THEN l := f.l END; IF t < f.t THEN t := f.t END; IF r > f.r THEN r := f.r END; IF b > f.b THEN b := f.b END; AddRect(root, f, l, t, r, b, msg.rebuild) END END END HandleUpdateMsg; PROCEDURE BroadcastViewMsg* (f: Frame; VAR msg: Message); VAR v, a: View; op: INTEGER; BEGIN ASSERT(f # NIL, 20); ASSERT(f.state = open, 21); v := f.view; IF (msg.view = v) OR (msg.view = NIL) THEN WITH msg: UpdateMsg DO HandleUpdateMsg(f, msg) ELSE IF ~(handler IN v.bad) THEN a := actView; op := actOp; actView := v; actOp := handler; v.HandleViewMsg(f, msg); actView := a; actOp := op END END END; IF msg.view # v THEN f := f.down; WHILE f # NIL DO BroadcastViewMsg(f, msg); f := f.next END END END BroadcastViewMsg; PROCEDURE ForwardCtrlMsg* (f: Frame; VAR msg: CtrlMessage); CONST pre = 0; translate = 1; backoff = 2; final = 3; VAR v, focus, a: View; g, h: Frame; op: INTEGER; req: BOOLEAN; BEGIN ASSERT(f # NIL, 20); ASSERT(f.state = open, 21); v := f.view; focus := NIL; g := f.up; req := FALSE; HandleCtrlMsg(pre, f, g, msg, f.mark, f.front, req); IF ~(handler IN v.bad) THEN a := actView; op := actOp; actView := v; actOp := handler; v.HandleCtrlMsg(f, msg, focus); actView := a; actOp := op END; IF focus # NIL THEN (* propagate msg to another view *) IF (f.focus # NIL) & (f.focus.view = focus) THEN (* cache hit *) h := f.focus ELSE (* cache miss *) h := f.down; WHILE (h # NIL) & (h.view # focus) DO h := h.next END END; IF h # NIL THEN HandleCtrlMsg(translate, f, h, msg, f.mark, f.front, req); f.focus := h; ForwardCtrlMsg(h, msg); HandleCtrlMsg(backoff, f, g, msg, f.mark, f.front, req) END ELSE HandleCtrlMsg(final, f, g, msg, f.mark, f.front, req) END; IF req & (g # NIL) THEN g.view.ConsiderFocusRequestBy(f.view) END END ForwardCtrlMsg; PROCEDURE RestoreFrame (f: Frame; l, t, r, b: INTEGER); VAR rd: Ports.Rider; g: Frame; v, a: View; op: INTEGER; u, w, h, cl, ct, cr, cb, dx, dy: INTEGER; col: Ports.Color; BEGIN IF l < f.l THEN l := f.l END; IF t < f.t THEN t := f.t END; IF r > f.r THEN r := f.r END; IF b > f.b THEN b := f.b END; IF (l < r) & (t < b) THEN (* non-empty rectangle to be restored *) v := f.view; rd := f.rider; u := f.unit; rd.GetRect(cl, ct, cr, cb); (* save clip rectangle *) rd.SetRect((f.gx + l) DIV u, (f.gy + t) DIV u, (f.gx + r) DIV u, (f.gy + b) DIV u); IF ~(restore IN v.bad) THEN a := actView; op := actOp; actView := v; actOp := restore; col := transparent; v.GetBackground(col); IF col # transparent THEN f.DrawRect(l, t, r, b, Ports.fill, col) END; v.Restore(f, l, t, r, b); g := f.down; WHILE g # NIL DO (* loop over all subframes to handle overlaps *) dx := f.gx - g.gx; dy := f.gy - g.gy; RestoreFrame(g, l + dx, t + dy, r + dx, b + dy); g := g.next END; v.RestoreMarks(f, l, t, r, b); actView := a; actOp := op END; IF v.bad # {} THEN IF externalize IN v.bad THEN u := f.dot; v.context.GetSize(w, h); f.DrawLine(0, 0, w - u, h - u, u, Ports.grey75); f.DrawLine(w - u, 0, 0, h - u, u, Ports.grey75) END; f.MarkRect(l, t, r, b, Ports.fill, Ports.dim25, Ports.show) END; rd.SetRect(cl, ct, cr, cb) (* restore current clip rectangle *) END END RestoreFrame; PROCEDURE RestoreRoot* (root: RootFrame; l, t, r, b: INTEGER); VAR port: Ports.Port; rd: Ports.Rider; u, gl, gt, gr, gb: INTEGER; col: Ports.Color; BEGIN ASSERT(root # NIL, 20); ASSERT(root.state = open, 21); ASSERT(root.update.n = 0, 22); IF l < root.l THEN l := root.l END; IF t < root.t THEN t := root.t END; IF r > root.r THEN r := root.r END; IF b > root.b THEN b := root.b END; IF (l < r) & (t < b) THEN u := root.unit; gl := l + root.gx; gt := t + root.gy; gr := r + root.gx; gb := b + root.gy; rd := root.rider; port := rd.Base(); actFrame := root; IF ~IsPrinterFrame(root) THEN port.OpenBuffer(gl DIV u, gt DIV u, gr DIV u, gb DIV u) END; col := transparent; root.view.GetBackground(col); ASSERT(col # transparent, 100); RestoreFrame(root, l, t, r, b); IF ~IsPrinterFrame(root) THEN port.CloseBuffer END; actFrame := NIL END END RestoreRoot; PROCEDURE ThisCand (f: Frame; v: View): Frame; (* find frame g with g.view = v *) VAR g: Frame; BEGIN WHILE (f # NIL) & (f.view # v) DO g := ThisCand(f.down, v); IF g # NIL THEN f := g ELSE f := f.next END END; RETURN f END ThisCand; PROCEDURE ValidateRoot* (root: RootFrame); VAR rgn: Region; f: Frame; v: View; i, n: INTEGER; BEGIN ASSERT(root # NIL, 20); ASSERT(root.state = open, 21); rgn := root.update; n := rgn.n; rgn.n := 0; i := 0; WHILE i < n DO IF rgn.r[i].rebuild THEN v := rgn.r[i].v; IF v # NIL THEN f := ThisCand(root, v) ELSE f := NIL END; IF f = NIL THEN f := root END; RemoveFrames(f, rgn.r[i].l - f.gx, rgn.r[i].t - f.gy, rgn.r[i].r - f.gx, rgn.r[i].b - f.gy) END; INC(i) END; i := 0; WHILE i < n DO RestoreRoot(root, rgn.r[i].l - root.gx, rgn.r[i].t - root.gy, rgn.r[i].r - root.gx, rgn.r[i].b - root.gy); INC(i) END END ValidateRoot; PROCEDURE MarkBordersIn (f: Frame); VAR g: Frame; w, h: INTEGER; BEGIN g := f.down; WHILE g # NIL DO g.view.context.GetSize(w, h); MarkBorder(f, g.view, g.x, g.y, g.x + w, g.y + h); MarkBordersIn(g); g := g.next END END MarkBordersIn; PROCEDURE MarkBorders* (root: RootFrame); BEGIN MarkBordersIn(root) END MarkBorders; PROCEDURE ReadFont* (VAR rd: Stores.Reader; OUT f: Fonts.Font); VAR version: INTEGER; fingerprint, size: INTEGER; typeface: Fonts.Typeface; style: SET; weight: INTEGER; BEGIN rd.ReadVersion(0, 0, version); rd.ReadInt(fingerprint); rd.ReadXString(typeface); rd.ReadInt(size); rd.ReadSet(style); rd.ReadXInt(weight); f := Fonts.dir.This(typeface, size, style, weight); ASSERT(f # NIL, 60); IF f.IsAlien() THEN Stores.Report("#System:AlienFont", typeface, "", "") END END ReadFont; PROCEDURE WriteFont* (VAR wr: Stores.Writer; f: Fonts.Font); BEGIN ASSERT(f # NIL, 20); wr.WriteVersion(0); wr.WriteInt(0); wr.WriteXString(f.typeface); wr.WriteInt(f.size); wr.WriteSet(f.style); wr.WriteXInt(f.weight) END WriteFont; (** view/file interaction **) PROCEDURE Old* (ask: BOOLEAN; VAR loc: Files.Locator; VAR name: Files.Name; VAR conv: Converters.Converter): View; VAR v: View; BEGIN ASSERT(ask OR (loc # NIL), 20); ASSERT(ask OR (name # ""), 21); IF ask THEN ASSERT(getSpecHook # NIL, 101); getSpecHook.GetIntSpec(loc, name, conv) END; IF (loc # NIL) & (name # "") THEN ASSERT(viewHook # NIL, 100); v := viewHook.OldView(loc, name, conv) ELSE v := NIL END; RETURN v END Old; PROCEDURE OldView* (loc: Files.Locator; name: Files.Name): View; VAR conv: Converters.Converter; BEGIN conv := NIL; RETURN Old(dontAsk, loc, name, conv) END OldView; PROCEDURE Register* (view: View; ask: BOOLEAN; VAR loc: Files.Locator; VAR name: Files.Name; VAR conv: Converters.Converter; OUT res: INTEGER); BEGIN ASSERT(viewHook # NIL, 100); ASSERT(getSpecHook # NIL, 101); ASSERT(view # NIL, 20); ASSERT(ask OR (loc # NIL), 22); ASSERT(ask OR (name # ""), 23); IF ask OR (loc = NIL) OR (name = "") OR (loc.res = 77) THEN getSpecHook.GetExtSpec(view, loc, name, conv) END; IF (loc # NIL) & (name # "") THEN viewHook.RegisterView(view, loc, name, conv); res := loc.res ELSE res := 7 END END Register; PROCEDURE RegisterView* (view: View; loc: Files.Locator; name: Files.Name); VAR res: INTEGER; conv: Converters.Converter; BEGIN conv := NIL; Register(view, dontAsk, loc, name, conv, res) END RegisterView; (** direct view opening **) PROCEDURE Open* (view: View; loc: Files.Locator; name: Files.Name; conv: Converters.Converter); BEGIN ASSERT(view # NIL, 20); ASSERT((loc = NIL) = (name = ""), 21); ASSERT(viewHook # NIL, 100); viewHook.Open(view, name, loc, name, conv, FALSE, FALSE, FALSE, FALSE, FALSE) END Open; PROCEDURE OpenView* (view: View); BEGIN ASSERT(view # NIL, 20); Open(view, NIL, "", NIL) END OpenView; PROCEDURE OpenAux* (view: View; title: Title); BEGIN ASSERT(view # NIL, 20); ASSERT(viewHook # NIL, 100); IF title = "" THEN title := "#System:untitled" END; viewHook.Open(view, title, NIL, "", NIL, FALSE, TRUE, FALSE, TRUE, TRUE) END OpenAux; (** view producer/consumer decoupling **) PROCEDURE Deposit* (view: View); VAR q: QueueElem; BEGIN ASSERT(view # NIL, 20); NEW(q); q.view := view; IF queue.head = NIL THEN queue.head := q ELSE queue.tail.next := q END; queue.tail := q; INC(queue.len) END Deposit; PROCEDURE Fetch* (OUT view: View); VAR q: QueueElem; BEGIN q := queue.head; ASSERT(q # NIL, 20); DEC(queue.len); queue.head := q.next; IF queue.head = NIL THEN queue.tail := NIL END; view := q.view END Fetch; PROCEDURE Available* (): INTEGER; BEGIN RETURN queue.len END Available; PROCEDURE ClearQueue*; BEGIN queue.len := 0; queue.head := NIL; queue.tail := NIL; actView := NIL (* HACK! prevents invalidation of view due to trap in Dialog.Call *) END ClearQueue; (** attach controller framework **) PROCEDURE InitCtrl* (p: CtrlMsgHandler); BEGIN ASSERT(HandleCtrlMsg = NIL, 20); HandleCtrlMsg := p END InitCtrl; PROCEDURE (h: NotifyHook) Notify (id0, id1: INTEGER; opts: SET); VAR msg: NotifyMsg; BEGIN ASSERT(msgHook # NIL, 100); msg.id0 := id0; msg.id1 := id1; msg.opts := opts; msgHook.Omnicast(msg) END Notify; PROCEDURE Omnicast* (VAR msg: ANYREC); BEGIN msgHook.Omnicast(msg) END Omnicast; PROCEDURE HandlePropMsg* (v: View; VAR msg: PropMessage); VAR a: View; op: INTEGER; BEGIN IF ~(handler IN v.bad) THEN a := actView; op := actOp; actView := v; actOp := handler; v.HandlePropMsg(msg); actView := a; actOp := op END END HandlePropMsg; (* view invalidation *) PROCEDURE IsInvalid* (v: View): BOOLEAN; BEGIN RETURN v.bad # {} END IsInvalid; PROCEDURE RevalidateView* (v: View); BEGIN v.bad := {}; Update(v, keepFrames) END RevalidateView; PROCEDURE TrapCleanup; BEGIN copyModel := NIL; IF actView # NIL THEN INCL(actView.bad, actOp); IF actFrame # NIL THEN UpdateRoot(actFrame, actFrame.l, actFrame.t, actFrame.r, actFrame.b, keepFrames); actFrame := NIL END; Update(actView, keepFrames); actView := NIL END END TrapCleanup; PROCEDURE Init; VAR h: NotifyHook; BEGIN NEW(h); Dialog.SetNotifyHook(h); domainGuard := 0; ClearQueue; Kernel.InstallTrapChecker(TrapCleanup) END Init; BEGIN Init END Views.