DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / bbcp.git / blob


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