f3a229407257ccc738a662bbd42024770a106e9e
1 MODULE Views;
3 (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Views.odc *)
4 (* DO NOT EDIT *)
6 IMPORT SYSTEM,
7 Kernel, Log, Dialog, Files, Services, Fonts, Stores, Converters, Ports, Sequencers, Models;
9 CONST
10 (** View.Background color **)
11 transparent* = 0FF000000H;
13 (** Views.CopyModel / Views.CopyOf shallow **)
14 deep* = FALSE; shallow* = TRUE;
16 (** Update, UpdateIn rebuild **)
17 keepFrames* = FALSE; rebuildFrames* = TRUE;
19 (** Deposit, QualifiedDeposit, Fetch w, h **)
20 undefined* = 0;
22 (** OldView, RegisterView ask **)
23 dontAsk* = FALSE; ask* = TRUE;
25 (* method numbers (UNSAFE!) *)
26 (* copyFrom = 1; *)
27 copyFromModelView = 7; copyFromSimpleView = 8;
29 (* Frame.state *)
30 new = 0; open = 1; closed = 2;
32 maxN = 30; (* max number of rects used to approximate a region *)
34 minVersion = 0; maxVersion = 0;
36 (* actOp *)
37 handler = 1; restore = 2; externalize = 3;
39 markBorderSize = 2;
41 clean* = Sequencers.clean;
42 notUndoable* = Sequencers.notUndoable;
43 invisible* = Sequencers.invisible;
46 TYPE
48 (** views **)
50 View* = POINTER TO ABSTRACT RECORD (Stores.Store)
51 context-: Models.Context; (** stable context # NIL **)
52 era: INTEGER;
53 guard: INTEGER; (* = TrapCount()+1 if view is addressee of ongoing broadcast *)
54 bad: SET
55 END;
57 Alien* = POINTER TO LIMITED RECORD (View)
58 store-: Stores.Alien
59 END;
61 Title* = ARRAY 64 OF CHAR;
63 TrapAlien = POINTER TO RECORD (Stores.Store) END;
66 (** frames **)
68 Frame* = POINTER TO ABSTRACT RECORD (Ports.Frame)
69 l-, t-, r-, b-: INTEGER; (** l < r, t < b **)
70 view-: View; (** opened => view # NIL, view.context # NIL, view.seq # NIL **)
71 front-, mark-: BOOLEAN;
72 state: BYTE;
73 x, y: INTEGER; (* origin in coordinates of environment *)
74 gx0, gy0: INTEGER; (* global origin w/o local scrolling compensation *)
75 sx, sy: INTEGER; (* cumulated local sub-pixel scrolling compensation *)
76 next, down, up, focus: Frame;
77 level: INTEGER (* used for partial z-ordering *)
78 END;
81 Message* = ABSTRACT RECORD
82 view-: View (** view # NIL **)
83 END;
85 NotifyMsg* = EXTENSIBLE RECORD (Message)
86 id0*, id1*: INTEGER;
87 opts*: SET
88 END;
90 NotifyHook = POINTER TO RECORD (Dialog.NotifyHook) END;
92 UpdateCachesMsg* = EXTENSIBLE RECORD (Message) END;
94 ScrollClassMsg* = RECORD (Message)
95 allowBitmapScrolling*: BOOLEAN (** OUT, preset to FALSE **)
96 END;
99 (** property messages **)
101 PropMessage* = ABSTRACT RECORD END;
104 (** controller messages **)
106 CtrlMessage* = ABSTRACT RECORD END;
108 CtrlMsgHandler* = PROCEDURE (op: INTEGER; f, g: Frame; VAR msg: CtrlMessage; VAR mark, front, req: BOOLEAN);
110 UpdateMsg = RECORD (Message)
111 scroll, rebuild, all: BOOLEAN;
112 l, t, r, b, dx, dy: INTEGER
113 END;
116 Rect = RECORD
117 v: View;
118 rebuild: BOOLEAN;
119 l, t, r, b: INTEGER
120 END;
122 Region = POINTER TO RECORD
123 n: INTEGER;
124 r: ARRAY maxN OF Rect
125 END;
127 RootFrame* = POINTER TO RECORD (Frame)
128 flags-: SET;
129 update: Region (* allocated lazily by SetRoot *)
130 END;
132 StdFrame = POINTER TO RECORD (Frame) END;
135 (* view producer/consumer decoupling *)
137 QueueElem = POINTER TO RECORD
138 next: QueueElem;
139 view: View
140 END;
142 GetSpecHook* = POINTER TO ABSTRACT RECORD (Kernel.Hook) END;
143 ViewHook* = POINTER TO ABSTRACT RECORD (Kernel.Hook) END;
144 MsgHook* = POINTER TO ABSTRACT RECORD (Kernel.Hook) END;
148 VAR
149 HandleCtrlMsg-: CtrlMsgHandler;
151 domainGuard: INTEGER; (* = TrapCount()+1 if domain is addressee of ongoing domaincast *)
153 actView: View;
154 actFrame: RootFrame;
155 actOp: INTEGER;
157 copyModel: Models.Model; (* context for (View)CopyFrom; reset by TrapCleanup *)
159 queue: RECORD
160 len: INTEGER;
161 head, tail: QueueElem
162 END;
164 getSpecHook: GetSpecHook;
165 viewHook: ViewHook;
166 msgHook: MsgHook;
169 PROCEDURE Overwritten (v: View; mno: INTEGER): BOOLEAN;
170 VAR base, actual: PROCEDURE;
171 BEGIN
172 SYSTEM.GET(SYSTEM.TYP(View) - 4 * (mno + 1), base);
173 SYSTEM.GET(SYSTEM.TYP(v) - 4 * (mno + 1), actual);
174 RETURN actual # base
175 END Overwritten;
177 (** Hooks **)
179 PROCEDURE (h: GetSpecHook) GetExtSpec* (s: Stores.Store; VAR loc: Files.Locator;
180 VAR name: Files.Name; VAR conv: Converters.Converter), NEW, ABSTRACT;
181 PROCEDURE (h: GetSpecHook) GetIntSpec* (VAR loc: Files.Locator; VAR name: Files.Name;
182 VAR conv: Converters.Converter), NEW, ABSTRACT;
184 PROCEDURE SetGetSpecHook*(h: GetSpecHook);
185 BEGIN
186 getSpecHook := h
187 END SetGetSpecHook;
189 PROCEDURE (h: ViewHook) OldView* (loc: Files.Locator; name: Files.Name;
190 VAR conv: Converters.Converter): View, NEW, ABSTRACT;
191 PROCEDURE (h: ViewHook) Open* (s: View; title: ARRAY OF CHAR;
192 loc: Files.Locator; name: Files.Name; conv: Converters.Converter;
193 asTool, asAux, noResize, allowDuplicates, neverDirty: BOOLEAN), NEW, ABSTRACT;
194 PROCEDURE (h: ViewHook) RegisterView* (s: View; loc: Files.Locator;
195 name: Files.Name; conv: Converters.Converter), NEW, ABSTRACT;
197 PROCEDURE SetViewHook*(h: ViewHook);
198 BEGIN
199 viewHook := h
200 END SetViewHook;
202 PROCEDURE (h: MsgHook) Omnicast* (VAR msg: ANYREC), NEW, ABSTRACT;
203 PROCEDURE (h: MsgHook) RestoreDomain* (domain: Stores.Domain), NEW, ABSTRACT;
205 PROCEDURE SetMsgHook*(h: MsgHook);
206 BEGIN
207 msgHook := h
208 END SetMsgHook;
211 (** Model protocol **)
213 PROCEDURE (v: View) CopyFromSimpleView- (source: View), NEW, EMPTY;
214 PROCEDURE (v: View) CopyFromModelView- (source: View; model: Models.Model), NEW, EMPTY;
216 PROCEDURE (v: View) ThisModel* (): Models.Model, NEW, EXTENSIBLE;
217 BEGIN
218 RETURN NIL
219 END ThisModel;
222 (** Store protocol **)
224 PROCEDURE (v: View) CopyFrom- (source: Stores.Store);
225 VAR tm, fm: Models.Model; c: Models.Context;
226 BEGIN
227 tm := copyModel; copyModel := NIL;
228 WITH source: View DO
229 v.era := source.era;
230 actView := NIL;
231 IF tm = NIL THEN (* if copyModel wasn't preset then use deep copy as default *)
232 fm := source.ThisModel();
233 IF fm # NIL THEN tm := Stores.CopyOf(fm)(Models.Model) END
234 END;
235 actView := v;
236 IF Overwritten(v, copyFromModelView) THEN (* new View *)
237 ASSERT(~Overwritten(v, copyFromSimpleView), 20);
238 c := v.context;
239 v.CopyFromModelView(source, tm);
240 ASSERT(v.context = c, 60)
241 ELSE (* old or simple View *)
242 (* IF tm # NIL THEN v.InitModel(tm) END *)
243 c := v.context;
244 v.CopyFromSimpleView(source);
245 ASSERT(v.context = c, 60)
246 END
247 END
248 END CopyFrom;
250 PROCEDURE (v: View) Internalize- (VAR rd: Stores.Reader), EXTENSIBLE;
251 VAR thisVersion: INTEGER;
252 BEGIN
253 v.Internalize^(rd);
254 IF rd.cancelled THEN RETURN END;
255 rd.ReadVersion(minVersion, maxVersion, thisVersion)
256 END Internalize;
258 PROCEDURE (v: View) Externalize- (VAR wr: Stores.Writer), EXTENSIBLE;
259 BEGIN
260 v.Externalize^(wr);
261 wr.WriteVersion(maxVersion)
262 END Externalize;
265 (** embedding protocol **)
267 PROCEDURE (v: View) InitContext* (context: Models.Context), NEW, EXTENSIBLE;
268 BEGIN
269 ASSERT(context # NIL, 21);
270 ASSERT((v.context = NIL) OR (v.context = context), 22);
271 v.context := context
272 END InitContext;
274 PROCEDURE (v: View) GetBackground* (VAR color: Ports.Color), NEW, EMPTY;
275 PROCEDURE (v: View) ConsiderFocusRequestBy- (view: View), NEW, EMPTY;
276 PROCEDURE (v: View) Neutralize*, NEW, EMPTY;
279 (** Frame protocol **)
281 PROCEDURE (v: View) GetNewFrame* (VAR frame: Frame), NEW, EMPTY;
282 PROCEDURE (v: View) Restore* (f: Frame; l, t, r, b: INTEGER), NEW, ABSTRACT;
283 PROCEDURE (v: View) RestoreMarks* (f: Frame; l, t, r, b: INTEGER), NEW, EMPTY;
286 (** handlers **)
288 PROCEDURE (v: View) HandleModelMsg- (VAR msg: Models.Message), NEW, EMPTY;
289 PROCEDURE (v: View) HandleViewMsg- (f: Frame; VAR msg: Message), NEW, EMPTY;
290 PROCEDURE (v: View) HandleCtrlMsg* (f: Frame; VAR msg: CtrlMessage; VAR focus: View), NEW, EMPTY;
291 PROCEDURE (v: View) HandlePropMsg- (VAR msg: PropMessage), NEW, EMPTY;
294 (** Alien **)
296 PROCEDURE (a: Alien) Externalize- (VAR wr: Stores.Writer);
297 BEGIN
298 HALT(100)
299 END Externalize;
301 PROCEDURE (a: Alien) Internalize- (VAR rd: Stores.Reader);
302 BEGIN
303 HALT(100)
304 END Internalize;
306 PROCEDURE (a: Alien) CopyFromSimpleView- (source: View);
307 BEGIN
308 a.store := Stores.CopyOf(source(Alien).store)(Stores.Alien); Stores.Join(a, a.store)
309 END CopyFromSimpleView;
311 PROCEDURE (a: Alien) Restore* (f: Frame; l, t, r, b: INTEGER);
312 VAR u, w, h: INTEGER;
313 BEGIN
314 u := f.dot; a.context.GetSize(w, h);
315 f.DrawRect(0, 0, w, h, Ports.fill, Ports.grey25);
316 f.DrawRect(0, 0, w, h, 2 * u, Ports.grey75);
317 f.DrawLine(0, 0, w - u, h - u, u, Ports.grey75);
318 f.DrawLine(w - u, 0, 0, h - u, u, Ports.grey75)
319 END Restore;
322 (** TrapAlien **)
324 PROCEDURE (v: TrapAlien) Internalize (VAR rd: Stores.Reader);
325 BEGIN
326 v.Internalize^(rd);
327 rd.TurnIntoAlien(3)
328 END Internalize;
330 PROCEDURE (v: TrapAlien) Externalize (VAR rd: Stores.Writer);
331 END Externalize;
333 PROCEDURE (v: TrapAlien) CopyFrom (source: Stores.Store), EMPTY;
336 (** Frame **)
338 PROCEDURE (f: Frame) Close* (), NEW, EMPTY;
341 (* Rect, Region *)
343 PROCEDURE Union (VAR u: Rect; r: Rect);
344 BEGIN
345 IF r.v # u.v THEN u.v := NIL END;
346 IF r.rebuild THEN u.rebuild := TRUE END;
347 IF r.l < u.l THEN u.l := r.l END;
348 IF r.t < u.t THEN u.t := r.t END;
349 IF r.r > u.r THEN u.r := r.r END;
350 IF r.b > u.b THEN u.b := r.b END
351 END Union;
353 PROCEDURE Add (rgn: Region; v: View; rebuild: BOOLEAN; gl, gt, gr, gb: INTEGER);
354 (* does not perfectly maintain invariant of non-overlapping approx rects ... *)
355 VAR q: Rect; i, j, n: INTEGER; x: ARRAY maxN OF BOOLEAN;
356 BEGIN
357 q.v := v; q.rebuild := rebuild; q.l := gl; q.t := gt; q.r := gr; q.b := gb;
358 n := rgn.n + 1;
359 i := 0;
360 WHILE i < rgn.n DO
361 x[i] := (gl < rgn.r[i].r) & (rgn.r[i].l < gr) & (gt < rgn.r[i].b) & (rgn.r[i].t < gb);
362 IF x[i] THEN Union(q, rgn.r[i]); DEC(n) END;
363 INC(i)
364 END;
365 IF n > maxN THEN
366 (* n = maxN + 1 -> merge q with arbitrarily picked rect and Add *)
367 Union(q, rgn.r[maxN - 1]); Add(rgn, v, q.rebuild, q.l, q.t, q.r, q.b)
368 ELSE
369 i := 0; WHILE (i < rgn.n) & ~x[i] DO INC(i) END;
370 rgn.r[i] := q; INC(i); WHILE (i < rgn.n) & ~x[i] DO INC(i) END;
371 j := i; WHILE (i < rgn.n) & x[i] DO INC(i) END;
372 WHILE i < rgn.n DO (* ~x[i] *)
373 rgn.r[j] := rgn.r[i]; INC(j); INC(i);
374 WHILE (i < rgn.n) & x[i] DO INC(i) END
375 END;
376 rgn.n := n
377 END
378 END Add;
380 PROCEDURE AddRect (root: RootFrame; f: Frame; l, t, r, b: INTEGER; rebuild: BOOLEAN);
381 VAR rl, rt, rr, rb: INTEGER; i: INTEGER;
382 BEGIN
383 INC(l, f.gx); INC(t, f.gy); INC(r, f.gx); INC(b, f.gy);
384 rl := root.l + root.gx; rt := root.t + root.gy; rr := root.r + root.gx; rb := root.b + root.gy;
385 IF l < rl THEN l := rl END;
386 IF t < rt THEN t := rt END;
387 IF r > rr THEN r := rr END;
388 IF b > rb THEN b := rb END;
389 IF (l < r) & (t < b) THEN
390 Add(root.update, f.view, rebuild, l, t, r, b);
391 i := 0;
392 WHILE (i < root.update.n)
393 & (~root.update.r[i].rebuild OR (root.update.r[i].v # NIL)) DO INC(i) END;
394 IF i < root.update.n THEN Add(root.update, root.view, TRUE, rl, rt, rr, rb) END
395 END
396 END AddRect;
399 (** miscellaneous **)
401 PROCEDURE RestoreDomain* (domain: Stores.Domain);
402 BEGIN
403 ASSERT(msgHook # NIL, 100);
404 msgHook.RestoreDomain(domain)
405 END RestoreDomain;
407 PROCEDURE MarkBorder* (host: Ports.Frame; view: View; l, t, r, b: INTEGER);
408 VAR s: INTEGER;
409 BEGIN
410 IF view # NIL THEN
411 s := markBorderSize * host.dot;
412 host.MarkRect(l - s, t - s, r + s, b + s, s, Ports.dim50, Ports.show)
413 END
414 END MarkBorder;
418 (** views **)
420 PROCEDURE SeqOf (v: View): Sequencers.Sequencer;
421 VAR (*c: Models.Context;*) d: Stores.Domain; seq: Sequencers.Sequencer; any: ANYPTR;
422 BEGIN
423 d := v.Domain(); seq := NIL;
424 IF d # NIL THEN
425 any := d.GetSequencer();
426 IF (any # NIL) & (any IS Sequencers.Sequencer) THEN
427 seq := any(Sequencers.Sequencer)
428 END
429 END;
430 RETURN seq
431 END SeqOf;
434 PROCEDURE Era* (v: View): INTEGER;
435 (** pre: v # NIL *)
436 (** post:
437 v.ThisModel() # NIL
438 in-synch(v) iff Era(v) = Models.Era(v.ThisModel())
439 **)
440 BEGIN
441 ASSERT(v # NIL, 20);
442 RETURN v.era
443 END Era;
445 PROCEDURE BeginScript* (v: View; name: Stores.OpName; OUT script: Stores.Operation);
446 (** pre: v # NIL *)
447 (** post: (script # NIL) iff (v.seq # NIL) **)
448 VAR seq: Sequencers.Sequencer;
449 BEGIN
450 ASSERT(v # NIL, 20);
451 seq := SeqOf(v);
452 IF seq # NIL THEN seq.BeginScript(name, script)
453 ELSE script := NIL
454 END
455 END BeginScript;
457 PROCEDURE Do* (v: View; name: Stores.OpName; op: Stores.Operation);
458 (** pre: v # NIL, op # NIL, ~op.inUse **)
459 VAR seq: Sequencers.Sequencer;
460 BEGIN
461 ASSERT(v # NIL, 20); ASSERT(op # NIL, 21); (* ASSERT(~op.inUse, 22); *)
462 seq := SeqOf(v);
463 IF seq # NIL THEN seq.Do(v, name, op) ELSE op.Do END
464 END Do;
466 PROCEDURE LastOp* (v: View): Stores.Operation;
467 (** pre: v # NIL **)
468 VAR seq: Sequencers.Sequencer;
469 BEGIN
470 ASSERT(v # NIL, 20);
471 seq := SeqOf(v);
472 IF seq # NIL THEN RETURN seq.LastOp(v) ELSE RETURN NIL END
473 END LastOp;
475 PROCEDURE Bunch* (v: View);
476 (** pre: v # NIL **)
477 VAR seq: Sequencers.Sequencer;
478 BEGIN
479 ASSERT(v # NIL, 20);
480 seq := SeqOf(v); ASSERT(seq # NIL, 21);
481 seq.Bunch(v)
482 END Bunch;
484 PROCEDURE StopBunching* (v: View);
485 (** pre: v # NIL **)
486 VAR seq: Sequencers.Sequencer;
487 BEGIN
488 ASSERT(v # NIL, 20);
489 seq := SeqOf(v);
490 IF seq # NIL THEN seq.StopBunching END
491 END StopBunching;
493 PROCEDURE EndScript* (v: View; script: Stores.Operation);
494 (** pre: (script # NIL) iff (v.seq # NIL) **)
495 VAR seq: Sequencers.Sequencer;
496 BEGIN
497 ASSERT(v # NIL, 20);
498 seq := SeqOf(v);
499 IF seq # NIL THEN ASSERT(script # NIL, 21); seq.EndScript(script)
500 ELSE ASSERT(script = NIL, 22)
501 END
502 END EndScript;
505 PROCEDURE BeginModification* (type: INTEGER; v: View);
506 VAR seq: Sequencers.Sequencer;
507 BEGIN
508 ASSERT(v # NIL, 20);
509 seq := SeqOf(v);
510 IF seq # NIL THEN seq.BeginModification(type, v) END
511 END BeginModification;
513 PROCEDURE EndModification* (type: INTEGER; v: View);
514 VAR seq: Sequencers.Sequencer;
515 BEGIN
516 ASSERT(v # NIL, 20);
517 seq := SeqOf(v);
518 IF seq # NIL THEN seq.EndModification(type, v) END
519 END EndModification;
521 PROCEDURE SetDirty* (v: View);
522 VAR seq: Sequencers.Sequencer;
523 BEGIN
524 ASSERT(v # NIL, 20);
525 seq := SeqOf(v);
526 IF seq # NIL THEN seq.SetDirty(TRUE) END
527 END SetDirty;
530 PROCEDURE Domaincast* (domain: Stores.Domain; VAR msg: Message);
531 VAR g: INTEGER; seq: ANYPTR;
532 BEGIN
533 IF domain # NIL THEN
534 seq := domain.GetSequencer();
535 IF seq # NIL THEN
536 msg.view := NIL;
537 g := Kernel.trapCount + 1;
538 IF domainGuard > 0 THEN ASSERT(domainGuard # g, 20) END;
539 domainGuard := g;
540 seq(Sequencers.Sequencer).Handle(msg);
541 domainGuard := 0
542 END
543 END
544 END Domaincast;
546 PROCEDURE Broadcast* (v: View; VAR msg: Message);
547 VAR seq: Sequencers.Sequencer; g: INTEGER;
548 BEGIN
549 ASSERT(v # NIL, 20);
550 msg.view := v;
551 seq := SeqOf(v);
552 IF seq # NIL THEN
553 g := Kernel.trapCount + 1;
554 IF v.guard > 0 THEN ASSERT(v.guard # g, 21) END;
555 v.guard := g;
556 seq.Handle(msg);
557 v.guard := 0
558 END
559 END Broadcast;
562 PROCEDURE Update* (v: View; rebuild: BOOLEAN);
563 VAR upd: UpdateMsg;
564 BEGIN
565 ASSERT(v # NIL, 20);
566 upd.scroll := FALSE; upd.rebuild := rebuild; upd.all := TRUE;
567 Broadcast(v, upd)
568 END Update;
570 PROCEDURE UpdateIn* (v: View; l, t, r, b: INTEGER; rebuild: BOOLEAN);
571 VAR upd: UpdateMsg;
572 BEGIN
573 ASSERT(v # NIL, 20);
574 upd.scroll := FALSE; upd.rebuild := rebuild; upd.all := FALSE;
575 upd.l := l; upd.t := t; upd.r := r; upd.b := b;
576 Broadcast(v, upd)
577 END UpdateIn;
579 PROCEDURE Scroll* (v: View; dx, dy: INTEGER);
580 VAR scroll: UpdateMsg;
581 BEGIN
582 ASSERT(v # NIL, 20); ASSERT(v.Domain() # NIL, 21);
583 RestoreDomain(v.Domain());
584 scroll.scroll := TRUE; scroll.dx := dx; scroll.dy := dy;
585 Broadcast(v, scroll)
586 END Scroll;
588 PROCEDURE CopyOf* (v: View; shallow: BOOLEAN): View;
589 VAR w, a: View; op: INTEGER; b: Alien;
590 BEGIN
591 ASSERT(v # NIL, 20);
592 IF ~(handler IN v.bad) THEN
593 a := actView; op := actOp; actView := NIL; actOp := handler;
594 IF shallow THEN copyModel := v.ThisModel() END;
595 actView := v;
596 w := Stores.CopyOf(v)(View);
597 actView := a; actOp := op
598 ELSE
599 NEW(b); w := b; w.bad := {handler..externalize}
600 END;
601 IF shallow THEN Stores.Join(w, v) END;
602 RETURN w
603 END CopyOf;
605 PROCEDURE CopyWithNewModel* (v: View; m: Models.Model): View;
606 VAR w, a: View; op: INTEGER; b: Alien; fm: Models.Model;
607 BEGIN
608 ASSERT(v # NIL, 20);
609 fm := v.ThisModel(); ASSERT(fm # NIL, 21);
610 ASSERT(m # NIL, 22);
611 ASSERT(Services.SameType(m, fm), 23);
612 IF ~(handler IN v.bad) THEN
613 a := actView; op := actOp; actView := v; actOp := handler;
614 copyModel := m;
615 w := Stores.CopyOf(v)(View);
616 actView := a; actOp := op
617 ELSE
618 NEW(b); w := b; w.bad := {handler..externalize}
619 END;
620 RETURN w
621 END CopyWithNewModel;
623 PROCEDURE ReadView* (VAR rd: Stores.Reader; OUT v: View);
624 VAR st: Stores.Store; a: Alien;
625 BEGIN
626 rd.ReadStore(st);
627 IF st = NIL THEN
628 v := NIL
629 ELSIF st IS Stores.Alien THEN
630 NEW(a);
631 a.store := st(Stores.Alien); Stores.Join(a, a.store);
632 v := a
633 ELSE
634 v := st(View)
635 END
636 END ReadView;
638 PROCEDURE WriteView* (VAR wr: Stores.Writer; v: View);
639 VAR a: TrapAlien; av: View; op: INTEGER;
640 BEGIN
641 IF v = NIL THEN wr.WriteStore(v)
642 ELSIF externalize IN v.bad THEN NEW(a); wr.WriteStore(a)
643 ELSIF v IS Alien THEN wr.WriteStore(v(Alien).store)
644 ELSE
645 av := actView; op := actOp; actView := v; actOp := externalize;
646 wr.WriteStore(v);
647 actView := av; actOp := op
648 END
649 END WriteView;
652 (* frames *)
654 PROCEDURE SetClip (f: Frame; l, t, r, b: INTEGER);
655 VAR u: INTEGER;
656 BEGIN
657 ASSERT(f.rider # NIL, 20); ASSERT(l <= r, 21); ASSERT(t <= b, 22);
658 u := f.unit;
659 f.rider.SetRect((l + f.gx) DIV u, (t + f.gy) DIV u, (r + f.gx) DIV u, (b + f.gy) DIV u);
660 f.l := l; f.t := t; f.r := r; f.b := b
661 END SetClip;
663 PROCEDURE Close (f: Frame);
664 BEGIN
665 f.Close;
666 f.state := closed;
667 f.up := NIL; f.down := NIL; f.next := NIL; f.view := NIL;
668 f.ConnectTo(NIL)
669 END Close;
671 PROCEDURE AdaptFrameTo (f: Frame; orgX, orgY: INTEGER);
672 VAR g, p, q: Frame; port: Ports.Port;
673 w, h, pl, pt, pr, pb, gl, gt, gr, gb, gx, gy: INTEGER;
674 BEGIN
675 (* pre: environment (i.e. parent frame / port) has already been set up *)
676 ASSERT(f.view # NIL, 20); ASSERT(f.view.context # NIL, 21);
677 f.x := orgX; f.y := orgY; (* set new origin *)
678 g := f.up;
679 IF g # NIL THEN (* parent frame is environment *)
680 f.gx0 := g.gx + orgX; f.gy0 := g.gy + orgY;
681 f.SetOffset(f.gx0 - f.sx, f.gy0 - f.sy);
682 pl := g.gx + g.l; pt := g.gy + g.t; pr := g.gx + g.r; pb := g.gy + g.b
683 ELSE (* port is environment *)
684 f.gx0 := orgX; f.gy0 := orgY;
685 f.SetOffset(f.gx0 - f.sx, f.gy0 - f.sy);
686 port := f.rider.Base();
687 port.GetSize(w, h);
688 pl := 0; pt := 0; pr := w * f.unit; pb := h * f.unit
689 END;
690 (* (pl, pt, pr, pb) is parent clipping rectangle, in global coordinates, and in units *)
691 gx := f.gx; gy := f.gy; f.view.context.GetSize(w, h);
692 gl := gx; gt := gy; gr := gx + w; gb := gy + h;
693 (* (gl, gt, gr, gb) is desired clipping rectangle, in global coordinates, and in units *)
694 IF gl < pl THEN gl := pl END;
695 IF gt < pt THEN gt := pt END;
696 IF gr > pr THEN gr := pr END;
697 IF gb > pb THEN gb := pb END;
698 IF (gl >= gr) OR (gt >= gb) THEN gr := gl; gb := gt END;
699 SetClip(f, gl - gx + f.sx, gt - gy + f.sy, gr - gx + f.sx, gb - gy + f.sy);
700 (* (f.l, f.t, f.r, f.b) is final clipping rectangle, in local coordinates, and in units *)
701 g := f.down; f.down := NIL; p := NIL;
702 WHILE g # NIL DO (* adapt child frames *)
703 q := g.next; g.next := NIL;
704 AdaptFrameTo(g, g.x, g.y);
705 IF g.l = g.r THEN (* empty child frame: remove *)
706 Close(g)
707 ELSE (* insert in new frame list *)
708 IF p = NIL THEN f.down := g ELSE p.next := g END;
709 p := g
710 END;
711 g := q
712 END
713 (* post: frame is set; child frames are set, nonempty, and clipped to frame *)
714 END AdaptFrameTo;
716 PROCEDURE SetRoot* (root: RootFrame; view: View; front: BOOLEAN; flags: SET);
717 BEGIN
718 ASSERT(root # NIL, 20); ASSERT(root.rider # NIL, 21);
719 ASSERT(view # NIL, 22); ASSERT(view.context # NIL, 23);
720 ASSERT(view.Domain() # NIL, 24);
721 ASSERT(root.state IN {new, open}, 25);
722 root.view := view;
723 root.front := front; root.mark := TRUE; root.flags := flags;
724 root.state := open;
725 IF root.update = NIL THEN NEW(root.update); root.update.n := 0 END
726 END SetRoot;
728 PROCEDURE AdaptRoot* (root: RootFrame);
729 BEGIN
730 ASSERT(root # NIL, 20); ASSERT(root.state = open, 21);
731 AdaptFrameTo(root, root.x, root.y)
732 END AdaptRoot;
734 PROCEDURE UpdateRoot* (root: RootFrame; l, t, r, b: INTEGER; rebuild: BOOLEAN);
735 BEGIN
736 ASSERT(root # NIL, 20); ASSERT(root.state = open, 21);
737 AddRect(root, root, l, t, r, b, rebuild)
738 END UpdateRoot;
740 PROCEDURE RootOf* (f: Frame): RootFrame;
741 BEGIN
742 ASSERT(f # NIL, 20); ASSERT(f.state = open, 21);
743 WHILE f.up # NIL DO f := f.up END;
744 RETURN f(RootFrame)
745 END RootOf;
747 PROCEDURE HostOf* (f: Frame): Frame;
748 BEGIN
749 ASSERT(f # NIL, 20);
750 RETURN f.up
751 END HostOf;
753 PROCEDURE IsPrinterFrame* (f: Frame): BOOLEAN;
754 VAR p: Ports.Port;
755 BEGIN
756 ASSERT(f # NIL, 20); ASSERT(f.state = open, 21);
757 p := f.rider.Base();
758 RETURN Ports.IsPrinterPort(p)
759 END IsPrinterFrame;
761 PROCEDURE InstallFrame* (host: Frame; view: View; x, y, level: INTEGER; focus: BOOLEAN);
762 VAR e, f, g: Frame; w, h, l, t, r, b: INTEGER; m: Models.Model; std: StdFrame;
763 msg: UpdateCachesMsg; a: View; op: INTEGER;
764 BEGIN
765 ASSERT(host # NIL, 20); ASSERT(host.state = open, 21);
766 ASSERT(view # NIL, 22); ASSERT(view.context # NIL, 23);
767 ASSERT(view.Domain() # NIL, 24);
768 e := NIL; g := host.down; WHILE (g # NIL) & (g.view # view) DO e := g; g := g.next END;
769 IF g = NIL THEN (* frame for view not yet in child frame list *)
770 view.context.GetSize(w, h);
771 IF w > MAX(INTEGER) DIV 2 THEN w := MAX(INTEGER) DIV 2 END;
772 IF h > MAX(INTEGER) DIV 2 THEN h := MAX(INTEGER) DIV 2 END;
773 l := x; t := y; r := x + w; b := y + h;
774 (* (l, t, r, b) is child frame rectangle, in local coordinates, and in units *)
775 IF (l < host.r) & (t < host.b) & (r > host.l) & (b > host.t) THEN (* visible *)
776 g := NIL; view.GetNewFrame(g);
777 IF g = NIL THEN NEW(std); g := std END;
778 ASSERT(~(g IS RootFrame), 100);
779 e := NIL; f := host.down; WHILE (f # NIL) & (f.level <= level) DO e := f; f := f.next END;
780 IF e = NIL THEN g.next := host.down; host.down := g ELSE g.next := e.next; e.next := g END;
781 g.down := NIL; g.up := host; g.level := level;
782 g.view := view;
783 g.ConnectTo(host.rider.Base());
784 g.state := open;
785 AdaptFrameTo(g, x, y);
786 IF ~(handler IN view.bad) THEN
787 a := actView; op := actOp; actView := view; actOp := handler;
788 view.HandleViewMsg(g, msg);
789 actView := a; actOp := op
790 END;
791 m := view.ThisModel();
792 IF m # NIL THEN view.era := Models.Era(m) END;
793 END
794 ELSE
795 IF g.level # level THEN (* adapt to modified z-order *)
796 IF e = NIL THEN host.down := g.next ELSE e.next := g.next END;
797 e := NIL; f := host.down; WHILE (f # NIL) & (f.level <= level) DO e := f; f := f.next END;
798 IF e = NIL THEN g.next := host.down; host.down := g ELSE g.next := e.next; e.next := g END;
799 g.level := level
800 END;
801 AdaptFrameTo(g, x, y) (* may close g, leaving g.state = closed *)
802 (* possibly optimize: don't call Adapt if x=g.x, y=g.y, "host.era=g.era" *)
803 END;
804 IF (g # NIL) & (g.state = open) THEN
805 IF focus THEN
806 g.front := host.front; g.mark := host.mark
807 ELSE
808 g.front := FALSE; g.mark := FALSE
809 END
810 END
811 END InstallFrame;
813 PROCEDURE RemoveAll (f: Frame);
814 VAR g, p: Frame;
815 BEGIN
816 g := f.down; WHILE g # NIL DO p := g.next; RemoveAll(g); Close(g); g := p END;
817 f.down := NIL
818 END RemoveAll;
820 PROCEDURE RemoveFrame* (host, f: Frame);
821 VAR g, h: Frame;
822 BEGIN
823 ASSERT(host # NIL, 20); ASSERT(host.state = open, 21);
824 ASSERT(f # NIL, 22); ASSERT(f.up = host, 23);
825 g := host.down; h := NIL;
826 WHILE (g # NIL) & (g # f) DO h := g; g := g.next END;
827 ASSERT(g = f, 24);
828 IF h = NIL THEN host.down := f.next ELSE h.next := f.next END;
829 RemoveAll(f); Close(f)
830 END RemoveFrame;
832 PROCEDURE RemoveFrames* (host: Frame; l, t, r, b: INTEGER);
833 VAR f, g: Frame; gl, gt, gr, gb: INTEGER;
834 BEGIN
835 ASSERT(host # NIL, 20); ASSERT(host.state = open, 21);
836 IF l < host.l THEN l := host.l END;
837 IF t < host.t THEN t := host.t END;
838 IF r > host.r THEN r := host.r END;
839 IF b > host.b THEN b := host.b END;
840 IF (l < r) & (t < b) THEN
841 gl := l + host.gx; gt := t + host.gy; gr := r + host.gx; gb := b + host.gy;
842 f := host.down;
843 WHILE f # NIL DO
844 g := f; f := f.next;
845 IF (gl < g.r + g.gx) & (g.l + g.gx < gr) & (gt < g.b + g.gy) & (g.t + g.gy < gb) THEN
846 RemoveFrame(host, g)
847 END
848 END
849 END
850 END RemoveFrames;
852 PROCEDURE ThisFrame* (host: Frame; view: View): Frame;
853 VAR g: Frame;
854 BEGIN
855 ASSERT(host # NIL, 20); ASSERT(host.state = open, 21);
856 g := host.down; WHILE (g # NIL) & (g.view # view) DO g := g.next END;
857 RETURN g
858 END ThisFrame;
860 PROCEDURE FrameAt* (host: Frame; x, y: INTEGER): Frame;
861 (** return frontmost sub-frame of host that contains (x, y) **)
862 VAR g, h: Frame;
863 BEGIN
864 ASSERT(host # NIL, 20); ASSERT(host.state = open, 21);
865 g := host.down; h := NIL; INC(x, host.gx); INC(y, host.gy);
866 WHILE g # NIL DO
867 IF (g.gx + g.l <= x) & (x < g.gx + g.r) & (g.gy + g.t <= y) & (y < g.gy + g.b) THEN
868 h := g
869 END;
870 g := g.next
871 END;
872 RETURN h
873 END FrameAt;
875 PROCEDURE ShiftFrames (f: Frame; dx, dy: INTEGER);
876 VAR g, h: Frame;
877 BEGIN
878 g := f.down;
879 WHILE g # NIL DO
880 h := g; g := g.next;
881 AdaptFrameTo(h, h.x + dx, h.y + dy);
882 IF h.l = h.r THEN RemoveFrame(f, h) END
883 END
884 END ShiftFrames;
886 PROCEDURE UpdateExposedArea (f: Frame; dx, dy: INTEGER);
887 VAR root: RootFrame;
888 BEGIN
889 root := RootOf(f);
890 IF dy > 0 THEN
891 AddRect(root, f, f.l, f.t, f.r, f.t + dy, keepFrames);
892 IF dx > 0 THEN
893 AddRect(root, f, f.l, f.t + dy, f.l + dx, f.b, keepFrames)
894 ELSE
895 AddRect(root, f, f.r + dx, f.t + dy, f.r, f.b, keepFrames)
896 END
897 ELSE
898 AddRect(root, f, f.l, f.b + dy, f.r, f.b, keepFrames);
899 IF dx > 0 THEN
900 AddRect(root, f, f.l, f.t, f.l + dx, f.b + dy, keepFrames)
901 ELSE
902 AddRect(root, f, f.r + dx, f.t, f.r, f.b + dy, keepFrames)
903 END
904 END
905 END UpdateExposedArea;
907 PROCEDURE ScrollFrame (f: Frame; dx, dy: INTEGER);
908 VAR g: Frame; u, dx0, dy0: INTEGER; bitmapScrolling: BOOLEAN; msg: ScrollClassMsg;
909 BEGIN
910 g := f.up;
911 bitmapScrolling := TRUE;
912 IF (g # NIL) THEN
913 WHILE bitmapScrolling & (g.up # NIL) DO
914 msg.allowBitmapScrolling := FALSE; g.view.HandleViewMsg(g, msg);
915 bitmapScrolling := bitmapScrolling & msg.allowBitmapScrolling;
916 g := g.up
917 END
918 END;
919 IF bitmapScrolling THEN
920 u := f.unit; dx0 := dx; dy0 := dy;
921 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);
922 f.sx := dx MOD u; f.sy := dy MOD u;
923 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);
924 f.SetOffset(f.gx0 - f.sx, f.gy0 - f.sy);
925 ShiftFrames(f, dx0, dy0);
926 f.Scroll(dx, dy);
927 UpdateExposedArea(f, dx, dy)
928 ELSE AddRect(RootOf(f), f, f.l, f.t, f.r, f.b, rebuildFrames)
929 END
930 END ScrollFrame;
932 PROCEDURE BroadcastModelMsg* (f: Frame; VAR msg: Models.Message);
933 VAR v, a: View; send: BOOLEAN; op: INTEGER;
934 BEGIN
935 ASSERT(f # NIL, 20); ASSERT(f.state = open, 21);
936 v := f.view;
937 IF ~(handler IN v.bad) THEN
938 a := actView; op := actOp; actView := v; actOp := handler;
939 IF msg.model # NIL THEN
940 IF (msg.model = v.ThisModel()) & (msg.era > v.era) THEN
941 send := (msg.era - v.era = 1);
942 v.era := msg.era;
943 IF ~send THEN
944 Log.synch := FALSE;
945 HALT(100)
946 END
947 ELSE send := FALSE
948 END
949 ELSE send := TRUE
950 END;
951 IF send THEN
952 WITH msg: Models.NeutralizeMsg DO
953 v.Neutralize
954 ELSE
955 v.HandleModelMsg(msg)
956 END
957 END;
958 actView := a; actOp := op
959 END;
960 f := f.down; WHILE f # NIL DO BroadcastModelMsg(f, msg); f := f.next END
961 END BroadcastModelMsg;
963 PROCEDURE HandleUpdateMsg (f: Frame; VAR msg: UpdateMsg);
964 VAR root: RootFrame; g: Frame; l, t, r, b, dx, dy: INTEGER;
965 BEGIN
966 root := RootOf(f);
967 IF msg.scroll THEN
968 IF root.update.n = 0 THEN
969 ScrollFrame(f, msg.dx, msg.dy)
970 ELSE
971 AddRect(root, f, f.l, f.t, f.r, f.b, msg.rebuild)
972 END
973 ELSE
974 IF msg.all THEN
975 IF f # root THEN g := f.up ELSE g := root END;
976 dx := f.gx - g.gx; dy := f.gy - g.gy;
977 AddRect(root, g, f.l + dx, f.t + dy, f.r + dx, f.b + dy, msg.rebuild)
978 ELSE
979 l := msg.l; t := msg.t; r := msg.r; b := msg.b;
980 IF l < f.l THEN l := f.l END;
981 IF t < f.t THEN t := f.t END;
982 IF r > f.r THEN r := f.r END;
983 IF b > f.b THEN b := f.b END;
984 AddRect(root, f, l, t, r, b, msg.rebuild)
985 END
986 END
987 END HandleUpdateMsg;
989 PROCEDURE BroadcastViewMsg* (f: Frame; VAR msg: Message);
990 VAR v, a: View; op: INTEGER;
991 BEGIN
992 ASSERT(f # NIL, 20); ASSERT(f.state = open, 21);
993 v := f.view;
994 IF (msg.view = v) OR (msg.view = NIL) THEN
995 WITH msg: UpdateMsg DO
996 HandleUpdateMsg(f, msg)
997 ELSE
998 IF ~(handler IN v.bad) THEN
999 a := actView; op := actOp; actView := v; actOp := handler;
1000 v.HandleViewMsg(f, msg);
1001 actView := a; actOp := op
1002 END
1003 END
1004 END;
1005 IF msg.view # v THEN
1006 f := f.down; WHILE f # NIL DO BroadcastViewMsg(f, msg); f := f.next END
1007 END
1008 END BroadcastViewMsg;
1010 PROCEDURE ForwardCtrlMsg* (f: Frame; VAR msg: CtrlMessage);
1011 CONST pre = 0; translate = 1; backoff = 2; final = 3;
1012 VAR v, focus, a: View; g, h: Frame; op: INTEGER; req: BOOLEAN;
1013 BEGIN
1014 ASSERT(f # NIL, 20); ASSERT(f.state = open, 21);
1015 v := f.view;
1016 focus := NIL; g := f.up; req := FALSE;
1017 HandleCtrlMsg(pre, f, g, msg, f.mark, f.front, req);
1018 IF ~(handler IN v.bad) THEN
1019 a := actView; op := actOp; actView := v; actOp := handler;
1020 v.HandleCtrlMsg(f, msg, focus);
1021 actView := a; actOp := op
1022 END;
1023 IF focus # NIL THEN (* propagate msg to another view *)
1024 IF (f.focus # NIL) & (f.focus.view = focus) THEN (* cache hit *)
1025 h := f.focus
1026 ELSE (* cache miss *)
1027 h := f.down; WHILE (h # NIL) & (h.view # focus) DO h := h.next END
1028 END;
1029 IF h # NIL THEN
1030 HandleCtrlMsg(translate, f, h, msg, f.mark, f.front, req);
1031 f.focus := h; ForwardCtrlMsg(h, msg);
1032 HandleCtrlMsg(backoff, f, g, msg, f.mark, f.front, req)
1033 END
1034 ELSE
1035 HandleCtrlMsg(final, f, g, msg, f.mark, f.front, req)
1036 END;
1037 IF req & (g # NIL) THEN g.view.ConsiderFocusRequestBy(f.view) END
1038 END ForwardCtrlMsg;
1041 PROCEDURE RestoreFrame (f: Frame; l, t, r, b: INTEGER);
1042 VAR rd: Ports.Rider; g: Frame; v, a: View; op: INTEGER;
1043 u, w, h, cl, ct, cr, cb, dx, dy: INTEGER; col: Ports.Color;
1044 BEGIN
1045 IF l < f.l THEN l := f.l END;
1046 IF t < f.t THEN t := f.t END;
1047 IF r > f.r THEN r := f.r END;
1048 IF b > f.b THEN b := f.b END;
1049 IF (l < r) & (t < b) THEN (* non-empty rectangle to be restored *)
1050 v := f.view; rd := f.rider; u := f.unit;
1051 rd.GetRect(cl, ct, cr, cb); (* save clip rectangle *)
1052 rd.SetRect((f.gx + l) DIV u, (f.gy + t) DIV u, (f.gx + r) DIV u, (f.gy + b) DIV u);
1053 IF ~(restore IN v.bad) THEN
1054 a := actView; op := actOp; actView := v; actOp := restore;
1055 col := transparent; v.GetBackground(col);
1056 IF col # transparent THEN f.DrawRect(l, t, r, b, Ports.fill, col) END;
1057 v.Restore(f, l, t, r, b);
1058 g := f.down;
1059 WHILE g # NIL DO (* loop over all subframes to handle overlaps *)
1060 dx := f.gx - g.gx; dy := f.gy - g.gy;
1061 RestoreFrame(g, l + dx, t + dy, r + dx, b + dy);
1062 g := g.next
1063 END;
1064 v.RestoreMarks(f, l, t, r, b);
1065 actView := a; actOp := op
1066 END;
1067 IF v.bad # {} THEN
1068 IF externalize IN v.bad THEN
1069 u := f.dot; v.context.GetSize(w, h);
1070 f.DrawLine(0, 0, w - u, h - u, u, Ports.grey75);
1071 f.DrawLine(w - u, 0, 0, h - u, u, Ports.grey75)
1072 END;
1073 f.MarkRect(l, t, r, b, Ports.fill, Ports.dim25, Ports.show)
1074 END;
1075 rd.SetRect(cl, ct, cr, cb) (* restore current clip rectangle *)
1076 END
1077 END RestoreFrame;
1079 PROCEDURE RestoreRoot* (root: RootFrame; l, t, r, b: INTEGER);
1080 VAR port: Ports.Port; rd: Ports.Rider;
1081 u, gl, gt, gr, gb: INTEGER; col: Ports.Color;
1082 BEGIN
1083 ASSERT(root # NIL, 20); ASSERT(root.state = open, 21);
1084 ASSERT(root.update.n = 0, 22);
1085 IF l < root.l THEN l := root.l END;
1086 IF t < root.t THEN t := root.t END;
1087 IF r > root.r THEN r := root.r END;
1088 IF b > root.b THEN b := root.b END;
1089 IF (l < r) & (t < b) THEN
1090 u := root.unit;
1091 gl := l + root.gx; gt := t + root.gy; gr := r + root.gx; gb := b + root.gy;
1092 rd := root.rider; port := rd.Base();
1093 actFrame := root;
1094 IF ~IsPrinterFrame(root) THEN port.OpenBuffer(gl DIV u, gt DIV u, gr DIV u, gb DIV u) END;
1095 col := transparent; root.view.GetBackground(col);
1096 ASSERT(col # transparent, 100);
1097 RestoreFrame(root, l, t, r, b);
1098 IF ~IsPrinterFrame(root) THEN port.CloseBuffer END;
1099 actFrame := NIL
1100 END
1101 END RestoreRoot;
1103 PROCEDURE ThisCand (f: Frame; v: View): Frame;
1104 (* find frame g with g.view = v *)
1105 VAR g: Frame;
1106 BEGIN
1107 WHILE (f # NIL) & (f.view # v) DO
1108 g := ThisCand(f.down, v);
1109 IF g # NIL THEN f := g ELSE f := f.next END
1110 END;
1111 RETURN f
1112 END ThisCand;
1114 PROCEDURE ValidateRoot* (root: RootFrame);
1115 VAR rgn: Region; f: Frame; v: View; i, n: INTEGER;
1116 BEGIN
1117 ASSERT(root # NIL, 20); ASSERT(root.state = open, 21);
1118 rgn := root.update; n := rgn.n; rgn.n := 0; i := 0;
1119 WHILE i < n DO
1120 IF rgn.r[i].rebuild THEN
1121 v := rgn.r[i].v;
1122 IF v # NIL THEN f := ThisCand(root, v) ELSE f := NIL END;
1123 IF f = NIL THEN f := root END;
1124 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)
1125 END;
1126 INC(i)
1127 END;
1128 i := 0;
1129 WHILE i < n DO
1130 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);
1131 INC(i)
1132 END
1133 END ValidateRoot;
1135 PROCEDURE MarkBordersIn (f: Frame);
1136 VAR g: Frame; w, h: INTEGER;
1137 BEGIN
1138 g := f.down;
1139 WHILE g # NIL DO
1140 g.view.context.GetSize(w, h);
1141 MarkBorder(f, g.view, g.x, g.y, g.x + w, g.y + h);
1142 MarkBordersIn(g);
1143 g := g.next
1144 END
1145 END MarkBordersIn;
1147 PROCEDURE MarkBorders* (root: RootFrame);
1148 BEGIN
1149 MarkBordersIn(root)
1150 END MarkBorders;
1152 PROCEDURE ReadFont* (VAR rd: Stores.Reader; OUT f: Fonts.Font);
1153 VAR version: INTEGER;
1154 fingerprint, size: INTEGER; typeface: Fonts.Typeface; style: SET; weight: INTEGER;
1155 BEGIN
1156 rd.ReadVersion(0, 0, version);
1157 rd.ReadInt(fingerprint);
1158 rd.ReadXString(typeface); rd.ReadInt(size); rd.ReadSet(style); rd.ReadXInt(weight);
1159 f := Fonts.dir.This(typeface, size, style, weight); ASSERT(f # NIL, 60);
1160 IF f.IsAlien() THEN
1161 Stores.Report("#System:AlienFont", typeface, "", "")
1162 END
1163 END ReadFont;
1165 PROCEDURE WriteFont* (VAR wr: Stores.Writer; f: Fonts.Font);
1166 BEGIN
1167 ASSERT(f # NIL, 20);
1168 wr.WriteVersion(0);
1169 wr.WriteInt(0);
1170 wr.WriteXString(f.typeface); wr.WriteInt(f.size); wr.WriteSet(f.style); wr.WriteXInt(f.weight)
1171 END WriteFont;
1174 (** view/file interaction **)
1176 PROCEDURE Old* (ask: BOOLEAN;
1177 VAR loc: Files.Locator; VAR name: Files.Name; VAR conv: Converters.Converter): View;
1178 VAR v: View;
1179 BEGIN
1180 ASSERT(ask OR (loc # NIL), 20);
1181 ASSERT(ask OR (name # ""), 21);
1182 IF ask THEN
1183 ASSERT(getSpecHook # NIL, 101);
1184 getSpecHook.GetIntSpec(loc, name, conv)
1185 END;
1186 IF (loc # NIL) & (name # "") THEN
1187 ASSERT(viewHook # NIL, 100);
1188 v := viewHook.OldView(loc, name, conv)
1189 ELSE v := NIL
1190 END;
1191 RETURN v
1192 END Old;
1194 PROCEDURE OldView* (loc: Files.Locator; name: Files.Name): View;
1195 VAR conv: Converters.Converter;
1196 BEGIN
1197 conv := NIL;
1198 RETURN Old(dontAsk, loc, name, conv)
1199 END OldView;
1201 PROCEDURE Register* (view: View; ask: BOOLEAN;
1202 VAR loc: Files.Locator; VAR name: Files.Name; VAR conv: Converters.Converter; OUT res: INTEGER);
1203 BEGIN
1204 ASSERT(viewHook # NIL, 100);
1205 ASSERT(getSpecHook # NIL, 101);
1206 ASSERT(view # NIL, 20);
1207 ASSERT(ask OR (loc # NIL), 22); ASSERT(ask OR (name # ""), 23);
1208 IF ask OR (loc = NIL) OR (name = "") OR (loc.res = 77) THEN
1209 getSpecHook.GetExtSpec(view, loc, name, conv)
1210 END;
1211 IF (loc # NIL) & (name # "") THEN
1212 viewHook.RegisterView(view, loc, name, conv); res := loc.res
1213 ELSE res := 7
1214 END
1215 END Register;
1217 PROCEDURE RegisterView* (view: View; loc: Files.Locator; name: Files.Name);
1218 VAR res: INTEGER; conv: Converters.Converter;
1219 BEGIN
1220 conv := NIL;
1221 Register(view, dontAsk, loc, name, conv, res)
1222 END RegisterView;
1224 (** direct view opening **)
1226 PROCEDURE Open* (view: View; loc: Files.Locator; name: Files.Name; conv: Converters.Converter);
1227 BEGIN
1228 ASSERT(view # NIL, 20); ASSERT((loc = NIL) = (name = ""), 21);
1229 ASSERT(viewHook # NIL, 100);
1230 viewHook.Open(view, name, loc, name, conv, FALSE, FALSE, FALSE, FALSE, FALSE)
1231 END Open;
1233 PROCEDURE OpenView* (view: View);
1234 BEGIN
1235 ASSERT(view # NIL, 20);
1236 Open(view, NIL, "", NIL)
1237 END OpenView;
1239 PROCEDURE OpenAux* (view: View; title: Title);
1240 BEGIN
1241 ASSERT(view # NIL, 20); ASSERT(viewHook # NIL, 100);
1242 IF title = "" THEN title := "#System:untitled" END;
1243 viewHook.Open(view, title, NIL, "", NIL, FALSE, TRUE, FALSE, TRUE, TRUE)
1244 END OpenAux;
1247 (** view producer/consumer decoupling **)
1249 PROCEDURE Deposit* (view: View);
1250 VAR q: QueueElem;
1251 BEGIN
1252 ASSERT(view # NIL, 20);
1253 NEW(q); q.view := view;
1254 IF queue.head = NIL THEN queue.head := q ELSE queue.tail.next := q END;
1255 queue.tail := q; INC(queue.len)
1256 END Deposit;
1258 PROCEDURE Fetch* (OUT view: View);
1259 VAR q: QueueElem;
1260 BEGIN
1261 q := queue.head; ASSERT(q # NIL, 20);
1262 DEC(queue.len); queue.head := q.next;
1263 IF queue.head = NIL THEN queue.tail := NIL END;
1264 view := q.view
1265 END Fetch;
1267 PROCEDURE Available* (): INTEGER;
1268 BEGIN
1269 RETURN queue.len
1270 END Available;
1272 PROCEDURE ClearQueue*;
1273 BEGIN
1274 queue.len := 0; queue.head := NIL; queue.tail := NIL;
1275 actView := NIL (* HACK! prevents invalidation of view due to trap in Dialog.Call *)
1276 END ClearQueue;
1279 (** attach controller framework **)
1281 PROCEDURE InitCtrl* (p: CtrlMsgHandler);
1282 BEGIN
1283 ASSERT(HandleCtrlMsg = NIL, 20); HandleCtrlMsg := p
1284 END InitCtrl;
1286 PROCEDURE (h: NotifyHook) Notify (id0, id1: INTEGER; opts: SET);
1287 VAR msg: NotifyMsg;
1288 BEGIN
1289 ASSERT(msgHook # NIL, 100);
1290 msg.id0 := id0; msg.id1 := id1; msg.opts := opts;
1291 msgHook.Omnicast(msg)
1292 END Notify;
1294 PROCEDURE Omnicast* (VAR msg: ANYREC);
1295 BEGIN
1296 msgHook.Omnicast(msg)
1297 END Omnicast;
1299 PROCEDURE HandlePropMsg* (v: View; VAR msg: PropMessage);
1300 VAR a: View; op: INTEGER;
1301 BEGIN
1302 IF ~(handler IN v.bad) THEN
1303 a := actView; op := actOp; actView := v; actOp := handler;
1304 v.HandlePropMsg(msg);
1305 actView := a; actOp := op
1306 END
1307 END HandlePropMsg;
1310 (* view invalidation *)
1312 PROCEDURE IsInvalid* (v: View): BOOLEAN;
1313 BEGIN
1314 RETURN v.bad # {}
1315 END IsInvalid;
1317 PROCEDURE RevalidateView* (v: View);
1318 BEGIN
1319 v.bad := {};
1320 Update(v, keepFrames)
1321 END RevalidateView;
1323 PROCEDURE TrapCleanup;
1324 BEGIN
1325 copyModel := NIL;
1326 IF actView # NIL THEN
1327 INCL(actView.bad, actOp);
1328 IF actFrame # NIL THEN
1329 UpdateRoot(actFrame, actFrame.l, actFrame.t, actFrame.r, actFrame.b, keepFrames);
1330 actFrame := NIL
1331 END;
1332 Update(actView, keepFrames);
1333 actView := NIL
1334 END
1335 END TrapCleanup;
1337 PROCEDURE Init;
1338 VAR h: NotifyHook;
1339 BEGIN
1340 NEW(h); Dialog.SetNotifyHook(h);
1341 domainGuard := 0; ClearQueue;
1342 Kernel.InstallTrapChecker(TrapCleanup)
1343 END Init;
1345 BEGIN
1346 Init
1347 END Views.