Scrollers.txt 25 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853
  1. MODULE StdScrollers;
  2. (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Std/Mod/Scrollers.odc *)
  3. (* DO NOT EDIT *)
  4. IMPORT Dialog, Ports, Services, Stores, Models, Views, Properties, Controllers, StdCFrames;
  5. CONST
  6. (* properties & options *)
  7. horBar* = 0; verBar* = 1; horHide* = 2; verHide* = 3; width* = 4; height* = 5; showBorder* = 6; savePos* = 7;
  8. TYPE
  9. Prop* = POINTER TO RECORD (Properties.Property)
  10. horBar*, verBar*: BOOLEAN;
  11. horHide*, verHide*: BOOLEAN;
  12. width*, height*: INTEGER;
  13. showBorder*: BOOLEAN;
  14. savePos*: BOOLEAN
  15. END;
  16. ScrollBar = POINTER TO RECORD (Views.View)
  17. v: View;
  18. ver: BOOLEAN
  19. END;
  20. InnerView = POINTER TO RECORD (Views.View)
  21. v: View
  22. END;
  23. View = POINTER TO RECORD (Views.View);
  24. view: Views.View;
  25. sbW: INTEGER;
  26. orgX, orgY: INTEGER;
  27. w, h: INTEGER; (* = 0: adapt to container *)
  28. opts: SET;
  29. (* not persistent *)
  30. hor, ver: ScrollBar;
  31. inner: InnerView;
  32. rgap, bgap: INTEGER; (* = 0: no scrollbar *)
  33. border: INTEGER;
  34. update: Action
  35. END;
  36. Context = POINTER TO RECORD (Models.Context)
  37. v: View;
  38. type: INTEGER
  39. END;
  40. Action = POINTER TO RECORD (Services.Action)
  41. v: View
  42. END;
  43. Op = POINTER TO RECORD (Stores.Operation)
  44. v: View;
  45. p: Prop
  46. END;
  47. SOp = POINTER TO RECORD (Stores.Operation)
  48. v: View;
  49. x, y: INTEGER
  50. END;
  51. UpdateMsg = RECORD (Views.Message)
  52. changed: BOOLEAN
  53. END;
  54. VAR
  55. dialog*: RECORD
  56. horizontal*, vertical*: RECORD
  57. mode*: INTEGER;
  58. adapt*: BOOLEAN;
  59. size*: REAL
  60. END;
  61. showBorder*: BOOLEAN;
  62. savePos*: BOOLEAN;
  63. valid, readOnly: SET
  64. END;
  65. (* tools *)
  66. PROCEDURE CheckPos (v: View; VAR x, y: INTEGER);
  67. VAR w, h: INTEGER;
  68. BEGIN
  69. v.context.GetSize(w, h);
  70. DEC(w, v.rgap + 2 * v.border);
  71. DEC(h, v.bgap + 2 * v.border);
  72. IF x > v.w - w THEN x := v.w - w END;
  73. IF x < 0 THEN x := 0 END;
  74. IF y > v.h - h THEN y := v.h - h END;
  75. IF y < 0 THEN y := 0 END
  76. END CheckPos;
  77. PROCEDURE InnerFrame (v: View; f: Views.Frame): Views.Frame;
  78. VAR g, h: Views.Frame;
  79. BEGIN
  80. g := Views.ThisFrame(f, v.inner);
  81. IF g = NIL THEN
  82. Views.InstallFrame(f, v.inner, v.border, v.border, 0, TRUE);
  83. g := Views.ThisFrame(f, v.inner)
  84. END;
  85. IF g # NIL THEN
  86. h := Views.ThisFrame(g, v.view);
  87. IF h = NIL THEN
  88. Views.InstallFrame(g, v.view, -v.orgX, -v.orgY, 0, TRUE);
  89. h := Views.ThisFrame(g, v.view)
  90. END
  91. END;
  92. RETURN h
  93. END InnerFrame;
  94. PROCEDURE Scroll (v: View; dir: INTEGER; ver: BOOLEAN; p: INTEGER; OUT pos: INTEGER);
  95. VAR x, y: INTEGER; last: Stores.Operation; op: SOp;
  96. BEGIN
  97. x := v.orgX; y := v.orgY;
  98. IF ver THEN pos := y ELSE pos := x END;
  99. IF dir = StdCFrames.lineUp THEN
  100. DEC(pos, 10 * Ports.mm)
  101. ELSIF dir = StdCFrames.lineDown THEN
  102. INC(pos, 10 * Ports.mm)
  103. ELSIF dir = StdCFrames.pageUp THEN
  104. DEC(pos, 40 * Ports.mm)
  105. ELSIF dir = StdCFrames.pageDown THEN
  106. INC(pos, 40 * Ports.mm)
  107. ELSIF dir = Controllers.gotoPos THEN
  108. pos := p
  109. END;
  110. IF ver THEN CheckPos(v, x, pos); y := pos
  111. ELSE CheckPos(v, pos, y); x := pos
  112. END;
  113. IF (x # v.orgX) OR (y # v.orgY) THEN
  114. last := Views.LastOp(v);
  115. IF ~(savePos IN v.opts) OR (last # NIL) & (last IS SOp) THEN
  116. v.orgX := x; v.orgY := y;
  117. Views.Update(v.view, Views.keepFrames)
  118. ELSE
  119. NEW(op); op.v := v; op.x := x; op.y := y;
  120. Views.Do(v, "#System:Scrolling", op)
  121. END
  122. END
  123. END Scroll;
  124. PROCEDURE PollSection (v: View; ver: BOOLEAN; OUT size, sect, pos: INTEGER);
  125. VAR w, h: INTEGER;
  126. BEGIN
  127. v.context.GetSize(w, h);
  128. IF ver THEN size := v.h; sect := h - v.bgap - 2 * v.border; pos := v.orgY
  129. ELSE size := v.w; sect := w - v.rgap - 2 * v.border; pos := v.orgX
  130. END
  131. END PollSection;
  132. (* SOp *)
  133. PROCEDURE (op: SOp) Do;
  134. VAR x, y: INTEGER;
  135. BEGIN
  136. x := op.x; op.x := op.v.orgX; op.v.orgX := x;
  137. y := op.y; op.y := op.v.orgY; op.v.orgY := y;
  138. Views.Update(op.v.view, Views.keepFrames)
  139. END Do;
  140. (* properties *)
  141. PROCEDURE (p: Prop) IntersectWith* (q: Properties.Property; OUT equal: BOOLEAN);
  142. VAR valid: SET;
  143. BEGIN
  144. WITH q: Prop DO
  145. valid := p.valid * q.valid; equal := TRUE;
  146. IF p.horBar # q.horBar THEN EXCL(valid, horBar) END;
  147. IF p.verBar # q.verBar THEN EXCL(valid, verBar) END;
  148. IF p.horHide # q.horHide THEN EXCL(valid, horHide) END;
  149. IF p.verHide # q.verHide THEN EXCL(valid, verHide) END;
  150. IF p.width # q.width THEN EXCL(valid, width) END;
  151. IF p.height # q.height THEN EXCL(valid, height) END;
  152. IF p.showBorder # q.showBorder THEN EXCL(valid, showBorder) END;
  153. IF p.savePos # q.savePos THEN EXCL(valid, savePos) END;
  154. IF p.valid # valid THEN p.valid := valid; equal := FALSE END
  155. END
  156. END IntersectWith;
  157. PROCEDURE SetProp (v: View; p: Properties.Property);
  158. VAR op: Op;
  159. BEGIN
  160. WITH p: Prop DO
  161. NEW(op); op.v := v; op.p := p;
  162. Views.Do(v, "#System:SetProp", op)
  163. END
  164. END SetProp;
  165. PROCEDURE PollProp (v: View; OUT prop: Prop);
  166. VAR p: Prop;
  167. BEGIN
  168. NEW(p);
  169. p.valid := {horBar, verBar, horHide, verHide, width, height, showBorder, savePos};
  170. p.readOnly := {width, height} - v.opts;
  171. p.horBar := horBar IN v.opts;
  172. p.verBar := verBar IN v.opts;
  173. p.horHide := horHide IN v.opts;
  174. p.verHide := verHide IN v.opts;
  175. p.width := v.w;
  176. p.height := v.h;
  177. p.showBorder := showBorder IN v.opts;
  178. p.savePos := savePos IN v.opts;
  179. p.known := p.valid; prop := p
  180. END PollProp;
  181. (* Op *)
  182. PROCEDURE (op: Op) Do;
  183. VAR p: Prop; v: View; valid: SET;
  184. BEGIN
  185. v := op.v; p := op.p; PollProp(v, op.p); op.p.valid := p.valid;
  186. valid := p.valid * ({horBar, verBar, horHide, verHide, showBorder, savePos} + v.opts * {width, height});
  187. IF horBar IN valid THEN
  188. IF p.horBar THEN INCL(v.opts, horBar) ELSE EXCL(v.opts, horBar) END
  189. END;
  190. IF verBar IN valid THEN
  191. IF p.verBar THEN INCL(v.opts, verBar) ELSE EXCL(v.opts, verBar) END
  192. END;
  193. IF horHide IN valid THEN
  194. IF p.horHide THEN INCL(v.opts, horHide) ELSE EXCL(v.opts, horHide) END
  195. END;
  196. IF verHide IN valid THEN
  197. IF p.verHide THEN INCL(v.opts, verHide) ELSE EXCL(v.opts, verHide) END
  198. END;
  199. IF width IN valid THEN v.w := p.width END;
  200. IF height IN valid THEN v.h := p.height END;
  201. IF showBorder IN valid THEN
  202. IF p.showBorder THEN INCL(v.opts, showBorder); v.border := 2 * Ports.point
  203. ELSE EXCL(v.opts, showBorder); v.border := 0
  204. END
  205. END;
  206. IF savePos IN valid THEN
  207. IF p.savePos THEN INCL(v.opts, savePos) ELSE EXCL(v.opts, savePos) END
  208. END;
  209. Views.Update(v, Views.rebuildFrames)
  210. END Do;
  211. (* Action *)
  212. PROCEDURE (a: Action) Do;
  213. VAR msg: UpdateMsg;
  214. BEGIN
  215. msg.changed := FALSE;
  216. Views.Broadcast(a.v, msg);
  217. IF msg.changed THEN Views.Update(a.v, Views.keepFrames)
  218. ELSE
  219. Views.Broadcast(a.v.hor, msg);
  220. Views.Broadcast(a.v.ver, msg)
  221. END
  222. END Do;
  223. (* ScrollBars *)
  224. PROCEDURE TrackSB (f: StdCFrames.ScrollBar; dir: INTEGER; VAR pos: INTEGER);
  225. VAR s: ScrollBar; msg: Controllers.ScrollMsg; pmsg: Controllers.PollSectionMsg; host, inner: Views.Frame;
  226. BEGIN
  227. s := f.view(ScrollBar); host := Views.HostOf(f);
  228. msg.focus := FALSE; msg.vertical := s.ver;
  229. msg.op := dir; msg.done := FALSE;
  230. inner := InnerFrame(s.v, host);
  231. IF inner # NIL THEN Views.ForwardCtrlMsg(inner, msg) END;
  232. IF msg.done THEN
  233. pmsg.focus := FALSE; pmsg.vertical := s.ver;
  234. pmsg.valid := FALSE; pmsg.done := FALSE;
  235. inner := InnerFrame(s.v, host);
  236. IF inner # NIL THEN Views.ForwardCtrlMsg(inner, pmsg) END;
  237. IF pmsg.done THEN
  238. pos := pmsg.partPos
  239. END
  240. ELSE
  241. Scroll(s.v, dir, s.ver, 0, pos);
  242. Views.ValidateRoot(Views.RootOf(host))
  243. END
  244. END TrackSB;
  245. PROCEDURE SetSB (f: StdCFrames.ScrollBar; pos: INTEGER);
  246. VAR s: ScrollBar; msg: Controllers.ScrollMsg; p: INTEGER; host, inner: Views.Frame;
  247. BEGIN
  248. s := f.view(ScrollBar); host := Views.HostOf(f);
  249. msg.focus := FALSE; msg.vertical := s.ver;
  250. msg.op := Controllers.gotoPos; msg.pos := pos;
  251. msg.done := FALSE;
  252. inner := InnerFrame(s.v, host);
  253. IF inner # NIL THEN Views.ForwardCtrlMsg(inner, msg) END;
  254. IF ~msg.done THEN
  255. Scroll(s.v, Controllers.gotoPos, s.ver, pos, p);
  256. Views.ValidateRoot(Views.RootOf(host))
  257. END
  258. END SetSB;
  259. PROCEDURE GetSB (f: StdCFrames.ScrollBar; OUT size, sect, pos: INTEGER);
  260. VAR s: ScrollBar; msg: Controllers.PollSectionMsg; host, inner: Views.Frame;
  261. BEGIN
  262. s := f.view(ScrollBar); host := Views.HostOf(f);
  263. msg.focus := FALSE; msg.vertical := s.ver;
  264. msg.wholeSize := 1; msg.partSize := 0; msg.partPos := 0;
  265. msg.valid := FALSE; msg.done := FALSE;
  266. inner := InnerFrame(s.v, host);
  267. IF inner # NIL THEN Views.ForwardCtrlMsg(inner, msg) END;
  268. IF msg.done THEN
  269. IF msg.valid THEN
  270. size := msg.wholeSize; sect := msg.partSize; pos := msg.partPos
  271. ELSE
  272. size := 1; sect := 1; pos := 0
  273. END
  274. ELSE
  275. PollSection(s.v, s.ver, size, sect, pos)
  276. END
  277. END GetSB;
  278. PROCEDURE (s: ScrollBar) GetNewFrame (VAR frame: Views.Frame);
  279. VAR f: StdCFrames.ScrollBar;
  280. BEGIN
  281. f := StdCFrames.dir.NewScrollBar();
  282. f.disabled := FALSE; f.undef := FALSE; f.readOnly := FALSE;
  283. f.Track := TrackSB; f.Get := GetSB; f.Set := SetSB;
  284. frame := f
  285. END GetNewFrame;
  286. PROCEDURE (s: ScrollBar) Restore (f: Views.Frame; l, t, r, b: INTEGER);
  287. BEGIN
  288. WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
  289. END Restore;
  290. PROCEDURE (s: ScrollBar) HandleCtrlMsg (f: Views.Frame; VAR msg: Controllers.Message;
  291. VAR focus: Views.View);
  292. BEGIN
  293. WITH f: StdCFrames.Frame DO
  294. WITH msg: Controllers.PollCursorMsg DO
  295. f.GetCursor(msg.x, msg.y, msg.modifiers, msg.cursor)
  296. | msg: Controllers.TrackMsg DO
  297. f.MouseDown(msg.x, msg.y, msg.modifiers)
  298. ELSE
  299. END
  300. END
  301. END HandleCtrlMsg;
  302. PROCEDURE (s: ScrollBar) HandleViewMsg (f: Views.Frame; VAR msg: Views.Message);
  303. BEGIN
  304. WITH msg: UpdateMsg DO
  305. WITH f: StdCFrames.Frame DO f.Update() END
  306. ELSE
  307. END
  308. END HandleViewMsg;
  309. (* View *)
  310. PROCEDURE Update (v: View; f: Views.Frame);
  311. VAR msg: Controllers.PollSectionMsg; w, h: INTEGER; depends: BOOLEAN; inner: Views.Frame;
  312. BEGIN
  313. v.bgap := 0; v.rgap := 0; depends := FALSE;
  314. v.context.GetSize(w, h);
  315. DEC(w, 2 * v.border); DEC(h, 2 * v.border);
  316. IF horBar IN v.opts THEN
  317. IF horHide IN v.opts THEN
  318. msg.focus := FALSE; msg.vertical := FALSE;
  319. msg.wholeSize := 1; msg.partSize := 0; msg.partPos := 0;
  320. msg.valid := FALSE; msg.done := FALSE;
  321. inner := InnerFrame(v, f);
  322. IF inner # NIL THEN Views.ForwardCtrlMsg(inner, msg) END;
  323. IF msg.done THEN
  324. IF msg.valid THEN v.bgap := v.sbW END
  325. ELSIF v.w > 0 THEN
  326. IF w < v.w THEN v.bgap := v.sbW
  327. ELSIF w - v.sbW < v.w THEN depends := TRUE
  328. END
  329. END
  330. ELSE v.bgap := v.sbW
  331. END
  332. END;
  333. IF verBar IN v.opts THEN
  334. IF verHide IN v.opts THEN
  335. msg.focus := FALSE; msg.vertical := TRUE;
  336. msg.wholeSize := 1; msg.partSize := 0; msg.partPos := 0;
  337. msg.valid := FALSE; msg.done := FALSE;
  338. inner := InnerFrame(v, f);
  339. IF inner # NIL THEN Views.ForwardCtrlMsg(inner, msg) END;
  340. IF msg.done THEN
  341. IF msg.valid THEN v.rgap := v.sbW END
  342. ELSIF v.h > 0 THEN
  343. IF h - v.bgap < v.h THEN v.rgap := v.sbW END
  344. END
  345. ELSE v.rgap := v.sbW
  346. END
  347. END;
  348. IF depends & (v.rgap > 0) THEN v.bgap := v.sbW END;
  349. CheckPos(v, v.orgX, v.orgY)
  350. END Update;
  351. PROCEDURE Init (v: View; newView: BOOLEAN);
  352. CONST min = 2 * Ports.mm; max = MAX(INTEGER); default = 50 * Ports.mm;
  353. VAR c: Context; x: INTEGER; msg: Properties.ResizePref;
  354. BEGIN
  355. IF newView THEN
  356. v.opts := v.opts + {horBar, verBar, horHide, verHide};
  357. StdCFrames.dir.GetScrollBarSize(x, v.sbW);
  358. IF v.view.context # NIL THEN
  359. v.view.context.GetSize(v.w, v.h);
  360. v.view := Views.CopyOf(v.view, Views.shallow)
  361. ELSE
  362. v.w := Views.undefined; v.h := Views.undefined;
  363. Properties.PreferredSize(v.view, min, max, min, max, default, default, v.w, v.h)
  364. END;
  365. msg.fixed := FALSE;
  366. msg.horFitToWin := FALSE; msg.verFitToWin := FALSE;
  367. msg.horFitToPage := FALSE; msg.verFitToPage := FALSE;
  368. Views.HandlePropMsg(v.view, msg);
  369. IF ~msg.fixed THEN
  370. INCL(v.opts, width); INCL(v.opts, height);
  371. IF msg.horFitToWin OR msg.horFitToPage THEN v.w := 0 END;
  372. IF msg.verFitToWin OR msg.verFitToPage THEN v.h := 0 END
  373. END
  374. END;
  375. v.rgap := 0; v.bgap := 0;
  376. IF showBorder IN v.opts THEN v.border := 2 * Ports.point ELSE v.border := 0 END;
  377. NEW(v.inner); v.inner.v := v;
  378. NEW(c); c.v := v; c.type := 3; v.inner.InitContext(c);
  379. NEW(v.hor); v.hor.ver := FALSE; v.hor.v := v;
  380. NEW(c); c.v := v; c.type := 2; v.hor.InitContext(c);
  381. NEW(v.ver); v.ver.ver := TRUE; v.ver.v := v;
  382. NEW(c); c.v := v; c.type := 1; v.ver.InitContext(c);
  383. NEW(v.update); v.update.v := v;
  384. Stores.Join(v, v.view);
  385. Stores.Join(v, v.inner);
  386. Stores.Join(v, v.hor);
  387. Stores.Join(v, v.ver);
  388. Services.DoLater(v.update, Services.now)
  389. END Init;
  390. PROCEDURE (v: View) Internalize (VAR rd: Stores.Reader);
  391. VAR thisVersion: INTEGER;
  392. BEGIN
  393. v.Internalize^(rd);
  394. IF ~rd.cancelled THEN
  395. rd.ReadVersion(0, 0, thisVersion);
  396. IF ~rd.cancelled THEN
  397. Views.ReadView(rd, v.view);
  398. rd.ReadInt(v.sbW);
  399. rd.ReadInt(v.orgX);
  400. rd.ReadInt(v.orgY);
  401. rd.ReadInt(v.w);
  402. rd.ReadInt(v.h);
  403. rd.ReadSet(v.opts);
  404. Init(v, FALSE)
  405. END
  406. END
  407. END Internalize;
  408. PROCEDURE (v: View) Externalize (VAR wr: Stores.Writer);
  409. BEGIN
  410. v.Externalize^(wr);
  411. wr.WriteVersion(0);
  412. Views.WriteView(wr, v.view);
  413. wr.WriteInt(v.sbW);
  414. IF savePos IN v.opts THEN
  415. wr.WriteInt(v.orgX);
  416. wr.WriteInt(v.orgY)
  417. ELSE
  418. wr.WriteInt(0);
  419. wr.WriteInt(0)
  420. END;
  421. wr.WriteInt(v.w);
  422. wr.WriteInt(v.h);
  423. wr.WriteSet(v.opts);
  424. END Externalize;
  425. PROCEDURE (v: View) ThisModel(): Models.Model;
  426. BEGIN
  427. RETURN v.view.ThisModel()
  428. END ThisModel;
  429. PROCEDURE (v: View) CopyFromModelView (source: Views.View; model: Models.Model);
  430. BEGIN
  431. WITH source: View DO
  432. IF model = NIL THEN v.view := Views.CopyOf(source.view, Views.deep)
  433. ELSE v.view := Views.CopyWithNewModel(source.view, model)
  434. END;
  435. v.sbW := source.sbW;
  436. v.orgX := source.orgX;
  437. v.orgY := source.orgY;
  438. v.w := source.w;
  439. v.h := source.h;
  440. v.opts := source.opts;
  441. END;
  442. Init(v, FALSE)
  443. END CopyFromModelView;
  444. PROCEDURE (v: View) InitContext (context: Models.Context);
  445. VAR c: Context;
  446. BEGIN
  447. v.InitContext^(context);
  448. IF v.view.context = NIL THEN
  449. NEW(c); c.v := v; c.type := 0; v.view.InitContext(c)
  450. END
  451. END InitContext;
  452. PROCEDURE (v: View) Neutralize;
  453. BEGIN
  454. v.view.Neutralize
  455. END Neutralize;
  456. PROCEDURE (v: View) Restore (f: Views.Frame; l, t, r, b: INTEGER);
  457. VAR w, h: INTEGER;
  458. BEGIN
  459. v.context.GetSize(w, h);
  460. IF showBorder IN v.opts THEN
  461. v.border := 2 * f.dot;
  462. f.DrawRect(0, f.dot, w, v.border, Ports.fill, Ports.black);
  463. f.DrawRect(f.dot, 0, v.border, h, Ports.fill, Ports.black);
  464. f.DrawRect(0, h - v.border, w, h - f.dot, Ports.fill, Ports.grey25);
  465. f.DrawRect(w - v.border, 0, w - f.dot, h, Ports.fill, Ports.grey25);
  466. f.DrawRect(0, 0, w, f.dot, Ports.fill, Ports.grey50);
  467. f.DrawRect(0, 0, f.dot, h, Ports.fill, Ports.grey50);
  468. f.DrawRect(0, h - f.dot, w, h, Ports.fill, Ports.white);
  469. f.DrawRect(w - f.dot, 0, w, h, Ports.fill, Ports.white)
  470. END;
  471. Views.InstallFrame(f, v.inner, v.border, v.border, 0, TRUE);
  472. IF v.bgap > 0 THEN Views.InstallFrame(f, v.hor, v.border, h - v.border - v.bgap, 0, FALSE) END;
  473. IF v.rgap > 0 THEN Views.InstallFrame(f, v.ver, w - v.border - v.rgap, v.border, 0, FALSE) END
  474. END Restore;
  475. PROCEDURE (v: View) HandleCtrlMsg (f: Views.Frame; VAR msg: Controllers.Message; VAR focus: Views.View);
  476. VAR w, h, p, n: INTEGER;smsg: Controllers.ScrollMsg; inner: Views.Frame;
  477. BEGIN
  478. WITH msg: Controllers.WheelMsg DO
  479. smsg.focus := FALSE; smsg.op := msg.op; smsg.pos := 0; smsg.done := FALSE; n := msg.nofLines;
  480. IF (v.rgap > 0) OR (v.bgap > 0) THEN
  481. smsg.vertical := v.rgap > 0;
  482. REPEAT
  483. smsg.done := FALSE;
  484. inner := InnerFrame(v, f);
  485. IF inner # NIL THEN Views.ForwardCtrlMsg(inner, smsg) END;
  486. IF ~smsg.done THEN
  487. Scroll(v, smsg.op, smsg.vertical, 0, p);
  488. Views.ValidateRoot(Views.RootOf(f))
  489. END;
  490. DEC(n)
  491. UNTIL n <= 0;
  492. msg.done := TRUE
  493. ELSE
  494. focus := v.inner
  495. END
  496. | msg: Controllers.CursorMessage DO
  497. v.context.GetSize(w, h);
  498. IF msg.x > w - v.border - v.rgap THEN
  499. IF msg.y <= h - v.border - v.bgap THEN focus := v.ver END
  500. ELSIF msg.y > h - v.border - v.bgap THEN focus := v.hor
  501. ELSE focus := v.inner
  502. END
  503. | msg: Controllers.PollSectionMsg DO
  504. inner := InnerFrame(v, f);
  505. IF inner # NIL THEN Views.ForwardCtrlMsg(inner, msg) END;
  506. IF ~msg.done THEN
  507. PollSection(v, msg.vertical, msg.wholeSize, msg.partSize, msg.partPos);
  508. msg.valid := msg.partSize < msg.wholeSize;
  509. msg.done := TRUE
  510. END
  511. | msg: Controllers.ScrollMsg DO
  512. inner := InnerFrame(v, f);
  513. IF inner # NIL THEN Views.ForwardCtrlMsg(inner, msg) END;
  514. IF ~msg.done THEN
  515. Scroll(v, msg.op, msg.vertical, msg.pos, p);
  516. Views.ValidateRoot(Views.RootOf(f));
  517. msg.done := TRUE
  518. END
  519. ELSE focus := v.inner
  520. END;
  521. IF ~(msg IS Controllers.TickMsg) THEN
  522. Services.DoLater(v.update, Services.now)
  523. END
  524. END HandleCtrlMsg;
  525. PROCEDURE (v: View) HandleViewMsg (f: Views.Frame; VAR msg: Views.Message);
  526. VAR b, r: INTEGER;
  527. BEGIN
  528. WITH msg: UpdateMsg DO
  529. b := v.bgap; r := v.rgap;
  530. Update(v, f);
  531. IF (v.bgap # b) OR (v.rgap # r) THEN msg.changed := TRUE END
  532. ELSE
  533. END
  534. END HandleViewMsg;
  535. PROCEDURE (v: View) HandlePropMsg (VAR msg: Properties.Message);
  536. VAR w, h: INTEGER; p: Properties.Property; prop: Prop; fv: Views.View;
  537. BEGIN
  538. WITH msg: Properties.FocusPref DO
  539. v.context.GetSize(w, h);
  540. Views.HandlePropMsg(v.view, msg);
  541. IF msg.atLocation THEN
  542. IF (msg.x > w - v.border - v.rgap) & (msg.y > h - v.border - v.bgap) THEN
  543. msg.hotFocus := FALSE; msg.setFocus := FALSE
  544. ELSIF ((msg.x > w - v.border - v.rgap) OR (msg.y > h - v.border - v.bgap)) & ~msg.setFocus THEN
  545. msg.hotFocus := TRUE
  546. END
  547. END
  548. | msg: Properties.SizePref DO
  549. IF (v.w > 0) & (v.h > 0) THEN
  550. IF msg.w = Views.undefined THEN msg.w := 50 * Ports.mm END;
  551. IF msg.h = Views.undefined THEN msg.h := 50 * Ports.mm END
  552. ELSE
  553. IF msg.w > v.rgap THEN DEC(msg.w, v.rgap + 2 * v.border) END;
  554. IF msg.h > v.bgap THEN DEC(msg.h, v.bgap + 2 * v.border) END;
  555. Views.HandlePropMsg(v.view, msg);
  556. IF msg.w > 0 THEN INC(msg.w, v.rgap + 2 * v.border) END;
  557. IF msg.h > 0 THEN INC(msg.h, v.bgap + 2 * v.border) END
  558. END;
  559. IF msg.w < 3 * v.sbW THEN msg.w := 3 * v.sbW END;
  560. IF msg.h < 3 * v.sbW THEN msg.h := 3 * v.sbW END
  561. | msg: Properties.ResizePref DO
  562. Views.HandlePropMsg(v.view, msg);
  563. IF v.w > 0 THEN
  564. msg.fixed := FALSE;
  565. msg.horFitToWin := TRUE;
  566. msg.horFitToPage := FALSE
  567. END;
  568. IF v.h > 0 THEN
  569. msg.fixed := FALSE;
  570. msg.verFitToWin := TRUE;
  571. msg.verFitToPage := FALSE
  572. END
  573. | msg: Properties.BoundsPref DO
  574. Views.HandlePropMsg(v.view, msg);
  575. INC(msg.w, 2 * v.border);
  576. INC(msg.h, 2 * v.border);
  577. IF (horBar IN v.opts) & ~(horHide IN v.opts) THEN INC(msg.w, v.sbW) END;
  578. IF (verBar IN v.opts) & ~(verHide IN v.opts) THEN INC(msg.h, v.sbW) END
  579. | msg: Properties.PollMsg DO
  580. Views.HandlePropMsg(v.view, msg);
  581. PollProp(v, prop); Properties.Insert(msg.prop, prop)
  582. | msg: Properties.SetMsg DO
  583. p := msg.prop; WHILE (p # NIL) & ~(p IS Prop) DO p := p.next END;
  584. IF p # NIL THEN SetProp(v, p) END;
  585. Views.HandlePropMsg(v.view, msg);
  586. | msg: Properties.ControlPref DO
  587. fv := msg.focus;
  588. IF fv = v THEN msg.focus := v.view END;
  589. Views.HandlePropMsg(v.view, msg);
  590. msg.focus := fv
  591. ELSE
  592. Views.HandlePropMsg(v.view, msg);
  593. END;
  594. END HandlePropMsg;
  595. (* InnerView *)
  596. PROCEDURE (v: InnerView) GetBackground (VAR color: Ports.Color);
  597. BEGIN
  598. color := Ports.background
  599. END GetBackground;
  600. PROCEDURE (v: InnerView) Restore (f: Views.Frame; l, t, r, b: INTEGER);
  601. BEGIN
  602. Views.InstallFrame(f, v.v.view, -v.v.orgX, -v.v.orgY, 0, TRUE)
  603. END Restore;
  604. PROCEDURE (v: InnerView) HandleCtrlMsg (f: Views.Frame; VAR msg: Controllers.Message;
  605. VAR focus: Views.View);
  606. BEGIN
  607. focus := v.v.view
  608. END HandleCtrlMsg;
  609. (* Context *)
  610. PROCEDURE (c: Context) MakeVisible (l, t, r, b: INTEGER);
  611. VAR w, h, x, y: INTEGER;
  612. BEGIN
  613. IF ~(savePos IN c.v.opts) THEN
  614. c.v.context.GetSize(w, h);
  615. x := c.v.orgX; y := c.v.orgY;
  616. IF c.v.w > 0 THEN
  617. DEC(w, c.v.rgap + 2 * c.v.border);
  618. IF r > x + w - Ports.point THEN x := r - w + Ports.point END;
  619. IF l < x + Ports.point THEN x := l - Ports.point END;
  620. END;
  621. IF c.v.h > 0 THEN
  622. DEC(h, c.v.bgap + 2 * c.v.border);
  623. IF b > y + h - Ports.point THEN y := b - h + Ports.point END;
  624. IF t < y + Ports.point THEN y := t - Ports.point END;
  625. END;
  626. IF (x # c.v.orgX) OR (y # c.v.orgY) THEN
  627. CheckPos(c.v, x, y); c.v.orgX := x; c.v.orgY := y;
  628. Views.Update(c.v.view, Views.keepFrames)
  629. END;
  630. Services.DoLater(c.v.update, Services.now)
  631. END
  632. END MakeVisible;
  633. PROCEDURE (c: Context) Consider (VAR p: Models.Proposal);
  634. BEGIN
  635. c.v.context.Consider(p)
  636. END Consider;
  637. PROCEDURE (c: Context) Normalize (): BOOLEAN;
  638. BEGIN
  639. RETURN ~(savePos IN c.v.opts)
  640. END Normalize;
  641. PROCEDURE (c: Context) GetSize (OUT w, h: INTEGER);
  642. BEGIN
  643. c.v.context.GetSize(w, h);
  644. DEC(w, c.v.rgap + 2 * c.v.border);
  645. DEC(h, c.v.bgap + 2 * c.v.border);
  646. IF c.type = 0 THEN
  647. IF c.v.w > 0 THEN w := c.v.w END;
  648. IF c.v.h > 0 THEN h := c.v.h END
  649. ELSIF c.type = 1 THEN
  650. w := c.v.rgap
  651. ELSIF c.type = 2 THEN
  652. h := c.v.bgap
  653. END
  654. END GetSize;
  655. PROCEDURE (c: Context) SetSize (w, h: INTEGER);
  656. VAR w0, h0, w1, h1: INTEGER;
  657. BEGIN
  658. ASSERT(c.type = 0, 100);
  659. c.v.context.GetSize(w0, h0); w1 := w0; h1 := h0;
  660. IF c.v.w > 0 THEN c.v.w := w
  661. ELSE w1 := w + c.v.rgap + 2 * c.v.border
  662. END;
  663. IF c.v.h > 0 THEN c.v.h := h
  664. ELSE h1 := h + c.v.bgap + 2 * c.v.border
  665. END;
  666. IF (w1 # w0) OR (h1 # h0) THEN
  667. c.v.context.SetSize(w1, h1)
  668. END
  669. END SetSize;
  670. PROCEDURE (c: Context) ThisModel (): Models.Model;
  671. BEGIN
  672. RETURN NIL
  673. END ThisModel;
  674. (* dialog *)
  675. PROCEDURE InitDialog*;
  676. VAR p: Properties.Property; u: INTEGER;
  677. BEGIN
  678. Properties.CollectProp(p);
  679. WHILE (p # NIL) & ~(p IS Prop) DO p := p.next END;
  680. IF p # NIL THEN
  681. WITH p: Prop DO
  682. IF Dialog.metricSystem THEN u := Ports.mm DIV 10 ELSE u := Ports.inch DIV 100 END;
  683. dialog.valid := p.valid;
  684. dialog.readOnly := p.readOnly;
  685. IF ~p.horBar THEN dialog.horizontal.mode := 0
  686. ELSIF p.horHide THEN dialog.horizontal.mode := 1
  687. ELSE dialog.horizontal.mode := 2
  688. END;
  689. IF ~p.verBar THEN dialog.vertical.mode := 0
  690. ELSIF p.verHide THEN dialog.vertical.mode := 1
  691. ELSE dialog.vertical.mode := 2
  692. END;
  693. dialog.horizontal.size := p.width DIV u / 100;
  694. dialog.vertical.size := p.height DIV u / 100;
  695. dialog.horizontal.adapt := p.width = 0;
  696. dialog.vertical.adapt := p.height = 0;
  697. dialog.showBorder := p.showBorder;
  698. dialog.savePos := p.savePos
  699. END
  700. END
  701. END InitDialog;
  702. PROCEDURE Set*;
  703. VAR p: Prop; u: INTEGER;
  704. BEGIN
  705. IF Dialog.metricSystem THEN u := 10 * Ports.mm ELSE u := Ports.inch END;
  706. NEW(p); p.valid := dialog.valid;
  707. p.horBar := dialog.horizontal.mode # 0;
  708. p.verBar := dialog.vertical.mode # 0;
  709. p.horHide := dialog.horizontal.mode = 1;
  710. p.verHide := dialog.vertical.mode = 1;
  711. IF ~dialog.horizontal.adapt THEN p.width := SHORT(ENTIER(dialog.horizontal.size * u)) END;
  712. IF ~dialog.vertical.adapt THEN p.height := SHORT(ENTIER(dialog.vertical.size * u)) END;
  713. p.showBorder := dialog.showBorder;
  714. p.savePos := dialog.savePos;
  715. Properties.EmitProp(NIL, p)
  716. END Set;
  717. PROCEDURE DialogGuard* (VAR par: Dialog.Par);
  718. VAR p: Properties.Property;
  719. BEGIN
  720. Properties.CollectProp(p);
  721. WHILE (p # NIL) & ~(p IS Prop) DO p := p.next END;
  722. IF p = NIL THEN par.disabled := TRUE END
  723. END DialogGuard;
  724. PROCEDURE HorAdaptGuard* (VAR par: Dialog.Par);
  725. BEGIN
  726. IF width IN dialog.readOnly THEN par.readOnly := TRUE END
  727. END HorAdaptGuard;
  728. PROCEDURE VerAdaptGuard* (VAR par: Dialog.Par);
  729. BEGIN
  730. IF height IN dialog.readOnly THEN par.readOnly := TRUE END
  731. END VerAdaptGuard;
  732. PROCEDURE WidthGuard* (VAR par: Dialog.Par);
  733. BEGIN
  734. IF dialog.horizontal.adapt THEN par.disabled := TRUE
  735. ELSIF width IN dialog.readOnly THEN par.readOnly := TRUE
  736. END
  737. END WidthGuard;
  738. PROCEDURE HeightGuard* (VAR par: Dialog.Par);
  739. BEGIN
  740. IF dialog.vertical.adapt THEN par.disabled := TRUE
  741. ELSIF height IN dialog.readOnly THEN par.readOnly := TRUE
  742. END
  743. END HeightGuard;
  744. (* commands *)
  745. PROCEDURE AddScroller*;
  746. VAR poll: Controllers.PollOpsMsg; v: View; replace: Controllers.ReplaceViewMsg;
  747. BEGIN
  748. Controllers.PollOps(poll);
  749. IF (poll.singleton # NIL) & ~(poll.singleton IS View) THEN
  750. NEW(v); v.view := poll.singleton; Init(v, TRUE);
  751. replace.old := poll.singleton; replace.new := v;
  752. Controllers.Forward(replace)
  753. ELSE Dialog.Beep
  754. END
  755. END AddScroller;
  756. PROCEDURE RemoveScroller*;
  757. VAR poll: Controllers.PollOpsMsg; replace: Controllers.ReplaceViewMsg;
  758. BEGIN
  759. Controllers.PollOps(poll);
  760. IF (poll.singleton # NIL) & (poll.singleton IS View) THEN
  761. replace.old := poll.singleton;
  762. replace.new := Views.CopyOf(poll.singleton(View).view, Views.shallow);
  763. Controllers.Forward(replace)
  764. ELSE Dialog.Beep
  765. END
  766. END RemoveScroller;
  767. END StdScrollers.