Views.txt 38 KB

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