123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853 |
- MODULE StdScrollers;
- (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Std/Mod/Scrollers.odc *)
- (* DO NOT EDIT *)
- IMPORT Dialog, Ports, Services, Stores, Models, Views, Properties, Controllers, StdCFrames;
-
-
- CONST
- (* properties & options *)
- horBar* = 0; verBar* = 1; horHide* = 2; verHide* = 3; width* = 4; height* = 5; showBorder* = 6; savePos* = 7;
-
- TYPE
- Prop* = POINTER TO RECORD (Properties.Property)
- horBar*, verBar*: BOOLEAN;
- horHide*, verHide*: BOOLEAN;
- width*, height*: INTEGER;
- showBorder*: BOOLEAN;
- savePos*: BOOLEAN
- END;
-
- ScrollBar = POINTER TO RECORD (Views.View)
- v: View;
- ver: BOOLEAN
- END;
-
- InnerView = POINTER TO RECORD (Views.View)
- v: View
- END;
-
- View = POINTER TO RECORD (Views.View);
- view: Views.View;
- sbW: INTEGER;
- orgX, orgY: INTEGER;
- w, h: INTEGER; (* = 0: adapt to container *)
- opts: SET;
- (* not persistent *)
- hor, ver: ScrollBar;
- inner: InnerView;
- rgap, bgap: INTEGER; (* = 0: no scrollbar *)
- border: INTEGER;
- update: Action
- END;
-
- Context = POINTER TO RECORD (Models.Context)
- v: View;
- type: INTEGER
- END;
-
- Action = POINTER TO RECORD (Services.Action)
- v: View
- END;
-
- Op = POINTER TO RECORD (Stores.Operation)
- v: View;
- p: Prop
- END;
-
- SOp = POINTER TO RECORD (Stores.Operation)
- v: View;
- x, y: INTEGER
- END;
-
- UpdateMsg = RECORD (Views.Message)
- changed: BOOLEAN
- END;
-
- VAR
- dialog*: RECORD
- horizontal*, vertical*: RECORD
- mode*: INTEGER;
- adapt*: BOOLEAN;
- size*: REAL
- END;
- showBorder*: BOOLEAN;
- savePos*: BOOLEAN;
- valid, readOnly: SET
- END;
-
- (* tools *)
-
- PROCEDURE CheckPos (v: View; VAR x, y: INTEGER);
- VAR w, h: INTEGER;
- BEGIN
- v.context.GetSize(w, h);
- DEC(w, v.rgap + 2 * v.border);
- DEC(h, v.bgap + 2 * v.border);
- IF x > v.w - w THEN x := v.w - w END;
- IF x < 0 THEN x := 0 END;
- IF y > v.h - h THEN y := v.h - h END;
- IF y < 0 THEN y := 0 END
- END CheckPos;
-
- PROCEDURE InnerFrame (v: View; f: Views.Frame): Views.Frame;
- VAR g, h: Views.Frame;
- BEGIN
- g := Views.ThisFrame(f, v.inner);
- IF g = NIL THEN
- Views.InstallFrame(f, v.inner, v.border, v.border, 0, TRUE);
- g := Views.ThisFrame(f, v.inner)
- END;
- IF g # NIL THEN
- h := Views.ThisFrame(g, v.view);
- IF h = NIL THEN
- Views.InstallFrame(g, v.view, -v.orgX, -v.orgY, 0, TRUE);
- h := Views.ThisFrame(g, v.view)
- END
- END;
- RETURN h
- END InnerFrame;
- PROCEDURE Scroll (v: View; dir: INTEGER; ver: BOOLEAN; p: INTEGER; OUT pos: INTEGER);
- VAR x, y: INTEGER; last: Stores.Operation; op: SOp;
- BEGIN
- x := v.orgX; y := v.orgY;
- IF ver THEN pos := y ELSE pos := x END;
- IF dir = StdCFrames.lineUp THEN
- DEC(pos, 10 * Ports.mm)
- ELSIF dir = StdCFrames.lineDown THEN
- INC(pos, 10 * Ports.mm)
- ELSIF dir = StdCFrames.pageUp THEN
- DEC(pos, 40 * Ports.mm)
- ELSIF dir = StdCFrames.pageDown THEN
- INC(pos, 40 * Ports.mm)
- ELSIF dir = Controllers.gotoPos THEN
- pos := p
- END;
- IF ver THEN CheckPos(v, x, pos); y := pos
- ELSE CheckPos(v, pos, y); x := pos
- END;
- IF (x # v.orgX) OR (y # v.orgY) THEN
- last := Views.LastOp(v);
- IF ~(savePos IN v.opts) OR (last # NIL) & (last IS SOp) THEN
- v.orgX := x; v.orgY := y;
- Views.Update(v.view, Views.keepFrames)
- ELSE
- NEW(op); op.v := v; op.x := x; op.y := y;
- Views.Do(v, "#System:Scrolling", op)
- END
- END
- END Scroll;
-
- PROCEDURE PollSection (v: View; ver: BOOLEAN; OUT size, sect, pos: INTEGER);
- VAR w, h: INTEGER;
- BEGIN
- v.context.GetSize(w, h);
- IF ver THEN size := v.h; sect := h - v.bgap - 2 * v.border; pos := v.orgY
- ELSE size := v.w; sect := w - v.rgap - 2 * v.border; pos := v.orgX
- END
- END PollSection;
-
-
- (* SOp *)
-
- PROCEDURE (op: SOp) Do;
- VAR x, y: INTEGER;
- BEGIN
- x := op.x; op.x := op.v.orgX; op.v.orgX := x;
- y := op.y; op.y := op.v.orgY; op.v.orgY := y;
- Views.Update(op.v.view, Views.keepFrames)
- END Do;
-
- (* properties *)
-
- PROCEDURE (p: Prop) IntersectWith* (q: Properties.Property; OUT equal: BOOLEAN);
- VAR valid: SET;
- BEGIN
- WITH q: Prop DO
- valid := p.valid * q.valid; equal := TRUE;
- IF p.horBar # q.horBar THEN EXCL(valid, horBar) END;
- IF p.verBar # q.verBar THEN EXCL(valid, verBar) END;
- IF p.horHide # q.horHide THEN EXCL(valid, horHide) END;
- IF p.verHide # q.verHide THEN EXCL(valid, verHide) END;
- IF p.width # q.width THEN EXCL(valid, width) END;
- IF p.height # q.height THEN EXCL(valid, height) END;
- IF p.showBorder # q.showBorder THEN EXCL(valid, showBorder) END;
- IF p.savePos # q.savePos THEN EXCL(valid, savePos) END;
- IF p.valid # valid THEN p.valid := valid; equal := FALSE END
- END
- END IntersectWith;
-
- PROCEDURE SetProp (v: View; p: Properties.Property);
- VAR op: Op;
- BEGIN
- WITH p: Prop DO
- NEW(op); op.v := v; op.p := p;
- Views.Do(v, "#System:SetProp", op)
- END
- END SetProp;
-
- PROCEDURE PollProp (v: View; OUT prop: Prop);
- VAR p: Prop;
- BEGIN
- NEW(p);
- p.valid := {horBar, verBar, horHide, verHide, width, height, showBorder, savePos};
- p.readOnly := {width, height} - v.opts;
- p.horBar := horBar IN v.opts;
- p.verBar := verBar IN v.opts;
- p.horHide := horHide IN v.opts;
- p.verHide := verHide IN v.opts;
- p.width := v.w;
- p.height := v.h;
- p.showBorder := showBorder IN v.opts;
- p.savePos := savePos IN v.opts;
- p.known := p.valid; prop := p
- END PollProp;
-
-
- (* Op *)
-
- PROCEDURE (op: Op) Do;
- VAR p: Prop; v: View; valid: SET;
- BEGIN
- v := op.v; p := op.p; PollProp(v, op.p); op.p.valid := p.valid;
- valid := p.valid * ({horBar, verBar, horHide, verHide, showBorder, savePos} + v.opts * {width, height});
- IF horBar IN valid THEN
- IF p.horBar THEN INCL(v.opts, horBar) ELSE EXCL(v.opts, horBar) END
- END;
- IF verBar IN valid THEN
- IF p.verBar THEN INCL(v.opts, verBar) ELSE EXCL(v.opts, verBar) END
- END;
- IF horHide IN valid THEN
- IF p.horHide THEN INCL(v.opts, horHide) ELSE EXCL(v.opts, horHide) END
- END;
- IF verHide IN valid THEN
- IF p.verHide THEN INCL(v.opts, verHide) ELSE EXCL(v.opts, verHide) END
- END;
- IF width IN valid THEN v.w := p.width END;
- IF height IN valid THEN v.h := p.height END;
- IF showBorder IN valid THEN
- IF p.showBorder THEN INCL(v.opts, showBorder); v.border := 2 * Ports.point
- ELSE EXCL(v.opts, showBorder); v.border := 0
- END
- END;
- IF savePos IN valid THEN
- IF p.savePos THEN INCL(v.opts, savePos) ELSE EXCL(v.opts, savePos) END
- END;
- Views.Update(v, Views.rebuildFrames)
- END Do;
-
-
- (* Action *)
-
- PROCEDURE (a: Action) Do;
- VAR msg: UpdateMsg;
- BEGIN
- msg.changed := FALSE;
- Views.Broadcast(a.v, msg);
- IF msg.changed THEN Views.Update(a.v, Views.keepFrames)
- ELSE
- Views.Broadcast(a.v.hor, msg);
- Views.Broadcast(a.v.ver, msg)
- END
- END Do;
-
-
- (* ScrollBars *)
-
- PROCEDURE TrackSB (f: StdCFrames.ScrollBar; dir: INTEGER; VAR pos: INTEGER);
- VAR s: ScrollBar; msg: Controllers.ScrollMsg; pmsg: Controllers.PollSectionMsg; host, inner: Views.Frame;
- BEGIN
- s := f.view(ScrollBar); host := Views.HostOf(f);
- msg.focus := FALSE; msg.vertical := s.ver;
- msg.op := dir; msg.done := FALSE;
- inner := InnerFrame(s.v, host);
- IF inner # NIL THEN Views.ForwardCtrlMsg(inner, msg) END;
- IF msg.done THEN
- pmsg.focus := FALSE; pmsg.vertical := s.ver;
- pmsg.valid := FALSE; pmsg.done := FALSE;
- inner := InnerFrame(s.v, host);
- IF inner # NIL THEN Views.ForwardCtrlMsg(inner, pmsg) END;
- IF pmsg.done THEN
- pos := pmsg.partPos
- END
- ELSE
- Scroll(s.v, dir, s.ver, 0, pos);
- Views.ValidateRoot(Views.RootOf(host))
- END
- END TrackSB;
- PROCEDURE SetSB (f: StdCFrames.ScrollBar; pos: INTEGER);
- VAR s: ScrollBar; msg: Controllers.ScrollMsg; p: INTEGER; host, inner: Views.Frame;
- BEGIN
- s := f.view(ScrollBar); host := Views.HostOf(f);
- msg.focus := FALSE; msg.vertical := s.ver;
- msg.op := Controllers.gotoPos; msg.pos := pos;
- msg.done := FALSE;
- inner := InnerFrame(s.v, host);
- IF inner # NIL THEN Views.ForwardCtrlMsg(inner, msg) END;
- IF ~msg.done THEN
- Scroll(s.v, Controllers.gotoPos, s.ver, pos, p);
- Views.ValidateRoot(Views.RootOf(host))
- END
- END SetSB;
- PROCEDURE GetSB (f: StdCFrames.ScrollBar; OUT size, sect, pos: INTEGER);
- VAR s: ScrollBar; msg: Controllers.PollSectionMsg; host, inner: Views.Frame;
- BEGIN
- s := f.view(ScrollBar); host := Views.HostOf(f);
- msg.focus := FALSE; msg.vertical := s.ver;
- msg.wholeSize := 1; msg.partSize := 0; msg.partPos := 0;
- msg.valid := FALSE; msg.done := FALSE;
- inner := InnerFrame(s.v, host);
- IF inner # NIL THEN Views.ForwardCtrlMsg(inner, msg) END;
- IF msg.done THEN
- IF msg.valid THEN
- size := msg.wholeSize; sect := msg.partSize; pos := msg.partPos
- ELSE
- size := 1; sect := 1; pos := 0
- END
- ELSE
- PollSection(s.v, s.ver, size, sect, pos)
- END
- END GetSB;
- PROCEDURE (s: ScrollBar) GetNewFrame (VAR frame: Views.Frame);
- VAR f: StdCFrames.ScrollBar;
- BEGIN
- f := StdCFrames.dir.NewScrollBar();
- f.disabled := FALSE; f.undef := FALSE; f.readOnly := FALSE;
- f.Track := TrackSB; f.Get := GetSB; f.Set := SetSB;
- frame := f
- END GetNewFrame;
- PROCEDURE (s: ScrollBar) Restore (f: Views.Frame; l, t, r, b: INTEGER);
- BEGIN
- WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
- END Restore;
-
- PROCEDURE (s: ScrollBar) HandleCtrlMsg (f: Views.Frame; VAR msg: Controllers.Message;
- VAR focus: Views.View);
- BEGIN
- WITH f: StdCFrames.Frame DO
- WITH msg: Controllers.PollCursorMsg DO
- f.GetCursor(msg.x, msg.y, msg.modifiers, msg.cursor)
- | msg: Controllers.TrackMsg DO
- f.MouseDown(msg.x, msg.y, msg.modifiers)
- ELSE
- END
- END
- END HandleCtrlMsg;
-
- PROCEDURE (s: ScrollBar) HandleViewMsg (f: Views.Frame; VAR msg: Views.Message);
- BEGIN
- WITH msg: UpdateMsg DO
- WITH f: StdCFrames.Frame DO f.Update() END
- ELSE
- END
- END HandleViewMsg;
-
- (* View *)
-
- PROCEDURE Update (v: View; f: Views.Frame);
- VAR msg: Controllers.PollSectionMsg; w, h: INTEGER; depends: BOOLEAN; inner: Views.Frame;
- BEGIN
- v.bgap := 0; v.rgap := 0; depends := FALSE;
- v.context.GetSize(w, h);
- DEC(w, 2 * v.border); DEC(h, 2 * v.border);
- IF horBar IN v.opts THEN
- IF horHide IN v.opts THEN
- msg.focus := FALSE; msg.vertical := FALSE;
- msg.wholeSize := 1; msg.partSize := 0; msg.partPos := 0;
- msg.valid := FALSE; msg.done := FALSE;
- inner := InnerFrame(v, f);
- IF inner # NIL THEN Views.ForwardCtrlMsg(inner, msg) END;
- IF msg.done THEN
- IF msg.valid THEN v.bgap := v.sbW END
- ELSIF v.w > 0 THEN
- IF w < v.w THEN v.bgap := v.sbW
- ELSIF w - v.sbW < v.w THEN depends := TRUE
- END
- END
- ELSE v.bgap := v.sbW
- END
- END;
- IF verBar IN v.opts THEN
- IF verHide IN v.opts THEN
- msg.focus := FALSE; msg.vertical := TRUE;
- msg.wholeSize := 1; msg.partSize := 0; msg.partPos := 0;
- msg.valid := FALSE; msg.done := FALSE;
- inner := InnerFrame(v, f);
- IF inner # NIL THEN Views.ForwardCtrlMsg(inner, msg) END;
- IF msg.done THEN
- IF msg.valid THEN v.rgap := v.sbW END
- ELSIF v.h > 0 THEN
- IF h - v.bgap < v.h THEN v.rgap := v.sbW END
- END
- ELSE v.rgap := v.sbW
- END
- END;
- IF depends & (v.rgap > 0) THEN v.bgap := v.sbW END;
- CheckPos(v, v.orgX, v.orgY)
- END Update;
-
- PROCEDURE Init (v: View; newView: BOOLEAN);
- CONST min = 2 * Ports.mm; max = MAX(INTEGER); default = 50 * Ports.mm;
- VAR c: Context; x: INTEGER; msg: Properties.ResizePref;
- BEGIN
- IF newView THEN
- v.opts := v.opts + {horBar, verBar, horHide, verHide};
- StdCFrames.dir.GetScrollBarSize(x, v.sbW);
- IF v.view.context # NIL THEN
- v.view.context.GetSize(v.w, v.h);
- v.view := Views.CopyOf(v.view, Views.shallow)
- ELSE
- v.w := Views.undefined; v.h := Views.undefined;
- Properties.PreferredSize(v.view, min, max, min, max, default, default, v.w, v.h)
- END;
- msg.fixed := FALSE;
- msg.horFitToWin := FALSE; msg.verFitToWin := FALSE;
- msg.horFitToPage := FALSE; msg.verFitToPage := FALSE;
- Views.HandlePropMsg(v.view, msg);
- IF ~msg.fixed THEN
- INCL(v.opts, width); INCL(v.opts, height);
- IF msg.horFitToWin OR msg.horFitToPage THEN v.w := 0 END;
- IF msg.verFitToWin OR msg.verFitToPage THEN v.h := 0 END
- END
- END;
- v.rgap := 0; v.bgap := 0;
- IF showBorder IN v.opts THEN v.border := 2 * Ports.point ELSE v.border := 0 END;
- NEW(v.inner); v.inner.v := v;
- NEW(c); c.v := v; c.type := 3; v.inner.InitContext(c);
- NEW(v.hor); v.hor.ver := FALSE; v.hor.v := v;
- NEW(c); c.v := v; c.type := 2; v.hor.InitContext(c);
- NEW(v.ver); v.ver.ver := TRUE; v.ver.v := v;
- NEW(c); c.v := v; c.type := 1; v.ver.InitContext(c);
- NEW(v.update); v.update.v := v;
- Stores.Join(v, v.view);
- Stores.Join(v, v.inner);
- Stores.Join(v, v.hor);
- Stores.Join(v, v.ver);
- Services.DoLater(v.update, Services.now)
- END Init;
-
- PROCEDURE (v: View) Internalize (VAR rd: Stores.Reader);
- VAR thisVersion: INTEGER;
- BEGIN
- v.Internalize^(rd);
- IF ~rd.cancelled THEN
- rd.ReadVersion(0, 0, thisVersion);
- IF ~rd.cancelled THEN
- Views.ReadView(rd, v.view);
- rd.ReadInt(v.sbW);
- rd.ReadInt(v.orgX);
- rd.ReadInt(v.orgY);
- rd.ReadInt(v.w);
- rd.ReadInt(v.h);
- rd.ReadSet(v.opts);
- Init(v, FALSE)
- END
- END
- END Internalize;
- PROCEDURE (v: View) Externalize (VAR wr: Stores.Writer);
- BEGIN
- v.Externalize^(wr);
- wr.WriteVersion(0);
- Views.WriteView(wr, v.view);
- wr.WriteInt(v.sbW);
- IF savePos IN v.opts THEN
- wr.WriteInt(v.orgX);
- wr.WriteInt(v.orgY)
- ELSE
- wr.WriteInt(0);
- wr.WriteInt(0)
- END;
- wr.WriteInt(v.w);
- wr.WriteInt(v.h);
- wr.WriteSet(v.opts);
- END Externalize;
- PROCEDURE (v: View) ThisModel(): Models.Model;
- BEGIN
- RETURN v.view.ThisModel()
- END ThisModel;
-
- PROCEDURE (v: View) CopyFromModelView (source: Views.View; model: Models.Model);
- BEGIN
- WITH source: View DO
- IF model = NIL THEN v.view := Views.CopyOf(source.view, Views.deep)
- ELSE v.view := Views.CopyWithNewModel(source.view, model)
- END;
- v.sbW := source.sbW;
- v.orgX := source.orgX;
- v.orgY := source.orgY;
- v.w := source.w;
- v.h := source.h;
- v.opts := source.opts;
- END;
- Init(v, FALSE)
- END CopyFromModelView;
-
- PROCEDURE (v: View) InitContext (context: Models.Context);
- VAR c: Context;
- BEGIN
- v.InitContext^(context);
- IF v.view.context = NIL THEN
- NEW(c); c.v := v; c.type := 0; v.view.InitContext(c)
- END
- END InitContext;
- PROCEDURE (v: View) Neutralize;
- BEGIN
- v.view.Neutralize
- END Neutralize;
- PROCEDURE (v: View) Restore (f: Views.Frame; l, t, r, b: INTEGER);
- VAR w, h: INTEGER;
- BEGIN
- v.context.GetSize(w, h);
- IF showBorder IN v.opts THEN
- v.border := 2 * f.dot;
- f.DrawRect(0, f.dot, w, v.border, Ports.fill, Ports.black);
- f.DrawRect(f.dot, 0, v.border, h, Ports.fill, Ports.black);
- f.DrawRect(0, h - v.border, w, h - f.dot, Ports.fill, Ports.grey25);
- f.DrawRect(w - v.border, 0, w - f.dot, h, Ports.fill, Ports.grey25);
- f.DrawRect(0, 0, w, f.dot, Ports.fill, Ports.grey50);
- f.DrawRect(0, 0, f.dot, h, Ports.fill, Ports.grey50);
- f.DrawRect(0, h - f.dot, w, h, Ports.fill, Ports.white);
- f.DrawRect(w - f.dot, 0, w, h, Ports.fill, Ports.white)
- END;
- Views.InstallFrame(f, v.inner, v.border, v.border, 0, TRUE);
- IF v.bgap > 0 THEN Views.InstallFrame(f, v.hor, v.border, h - v.border - v.bgap, 0, FALSE) END;
- IF v.rgap > 0 THEN Views.InstallFrame(f, v.ver, w - v.border - v.rgap, v.border, 0, FALSE) END
- END Restore;
-
- PROCEDURE (v: View) HandleCtrlMsg (f: Views.Frame; VAR msg: Controllers.Message; VAR focus: Views.View);
- VAR w, h, p, n: INTEGER;smsg: Controllers.ScrollMsg; inner: Views.Frame;
- BEGIN
- WITH msg: Controllers.WheelMsg DO
- smsg.focus := FALSE; smsg.op := msg.op; smsg.pos := 0; smsg.done := FALSE; n := msg.nofLines;
- IF (v.rgap > 0) OR (v.bgap > 0) THEN
- smsg.vertical := v.rgap > 0;
- REPEAT
- smsg.done := FALSE;
- inner := InnerFrame(v, f);
- IF inner # NIL THEN Views.ForwardCtrlMsg(inner, smsg) END;
- IF ~smsg.done THEN
- Scroll(v, smsg.op, smsg.vertical, 0, p);
- Views.ValidateRoot(Views.RootOf(f))
- END;
- DEC(n)
- UNTIL n <= 0;
- msg.done := TRUE
- ELSE
- focus := v.inner
- END
- | msg: Controllers.CursorMessage DO
- v.context.GetSize(w, h);
- IF msg.x > w - v.border - v.rgap THEN
- IF msg.y <= h - v.border - v.bgap THEN focus := v.ver END
- ELSIF msg.y > h - v.border - v.bgap THEN focus := v.hor
- ELSE focus := v.inner
- END
- | msg: Controllers.PollSectionMsg DO
- inner := InnerFrame(v, f);
- IF inner # NIL THEN Views.ForwardCtrlMsg(inner, msg) END;
- IF ~msg.done THEN
- PollSection(v, msg.vertical, msg.wholeSize, msg.partSize, msg.partPos);
- msg.valid := msg.partSize < msg.wholeSize;
- msg.done := TRUE
- END
- | msg: Controllers.ScrollMsg DO
- inner := InnerFrame(v, f);
- IF inner # NIL THEN Views.ForwardCtrlMsg(inner, msg) END;
- IF ~msg.done THEN
- Scroll(v, msg.op, msg.vertical, msg.pos, p);
- Views.ValidateRoot(Views.RootOf(f));
- msg.done := TRUE
- END
- ELSE focus := v.inner
- END;
- IF ~(msg IS Controllers.TickMsg) THEN
- Services.DoLater(v.update, Services.now)
- END
- END HandleCtrlMsg;
- PROCEDURE (v: View) HandleViewMsg (f: Views.Frame; VAR msg: Views.Message);
- VAR b, r: INTEGER;
- BEGIN
- WITH msg: UpdateMsg DO
- b := v.bgap; r := v.rgap;
- Update(v, f);
- IF (v.bgap # b) OR (v.rgap # r) THEN msg.changed := TRUE END
- ELSE
- END
- END HandleViewMsg;
- PROCEDURE (v: View) HandlePropMsg (VAR msg: Properties.Message);
- VAR w, h: INTEGER; p: Properties.Property; prop: Prop; fv: Views.View;
- BEGIN
- WITH msg: Properties.FocusPref DO
- v.context.GetSize(w, h);
- Views.HandlePropMsg(v.view, msg);
- IF msg.atLocation THEN
- IF (msg.x > w - v.border - v.rgap) & (msg.y > h - v.border - v.bgap) THEN
- msg.hotFocus := FALSE; msg.setFocus := FALSE
- ELSIF ((msg.x > w - v.border - v.rgap) OR (msg.y > h - v.border - v.bgap)) & ~msg.setFocus THEN
- msg.hotFocus := TRUE
- END
- END
- | msg: Properties.SizePref DO
- IF (v.w > 0) & (v.h > 0) THEN
- IF msg.w = Views.undefined THEN msg.w := 50 * Ports.mm END;
- IF msg.h = Views.undefined THEN msg.h := 50 * Ports.mm END
- ELSE
- IF msg.w > v.rgap THEN DEC(msg.w, v.rgap + 2 * v.border) END;
- IF msg.h > v.bgap THEN DEC(msg.h, v.bgap + 2 * v.border) END;
- Views.HandlePropMsg(v.view, msg);
- IF msg.w > 0 THEN INC(msg.w, v.rgap + 2 * v.border) END;
- IF msg.h > 0 THEN INC(msg.h, v.bgap + 2 * v.border) END
- END;
- IF msg.w < 3 * v.sbW THEN msg.w := 3 * v.sbW END;
- IF msg.h < 3 * v.sbW THEN msg.h := 3 * v.sbW END
- | msg: Properties.ResizePref DO
- Views.HandlePropMsg(v.view, msg);
- IF v.w > 0 THEN
- msg.fixed := FALSE;
- msg.horFitToWin := TRUE;
- msg.horFitToPage := FALSE
- END;
- IF v.h > 0 THEN
- msg.fixed := FALSE;
- msg.verFitToWin := TRUE;
- msg.verFitToPage := FALSE
- END
- | msg: Properties.BoundsPref DO
- Views.HandlePropMsg(v.view, msg);
- INC(msg.w, 2 * v.border);
- INC(msg.h, 2 * v.border);
- IF (horBar IN v.opts) & ~(horHide IN v.opts) THEN INC(msg.w, v.sbW) END;
- IF (verBar IN v.opts) & ~(verHide IN v.opts) THEN INC(msg.h, v.sbW) END
- | msg: Properties.PollMsg DO
- Views.HandlePropMsg(v.view, msg);
- PollProp(v, prop); Properties.Insert(msg.prop, prop)
- | msg: Properties.SetMsg DO
- p := msg.prop; WHILE (p # NIL) & ~(p IS Prop) DO p := p.next END;
- IF p # NIL THEN SetProp(v, p) END;
- Views.HandlePropMsg(v.view, msg);
- | msg: Properties.ControlPref DO
- fv := msg.focus;
- IF fv = v THEN msg.focus := v.view END;
- Views.HandlePropMsg(v.view, msg);
- msg.focus := fv
- ELSE
- Views.HandlePropMsg(v.view, msg);
- END;
- END HandlePropMsg;
-
-
- (* InnerView *)
-
- PROCEDURE (v: InnerView) GetBackground (VAR color: Ports.Color);
- BEGIN
- color := Ports.background
- END GetBackground;
- PROCEDURE (v: InnerView) Restore (f: Views.Frame; l, t, r, b: INTEGER);
- BEGIN
- Views.InstallFrame(f, v.v.view, -v.v.orgX, -v.v.orgY, 0, TRUE)
- END Restore;
-
- PROCEDURE (v: InnerView) HandleCtrlMsg (f: Views.Frame; VAR msg: Controllers.Message;
- VAR focus: Views.View);
- BEGIN
- focus := v.v.view
- END HandleCtrlMsg;
- (* Context *)
-
- PROCEDURE (c: Context) MakeVisible (l, t, r, b: INTEGER);
- VAR w, h, x, y: INTEGER;
- BEGIN
- IF ~(savePos IN c.v.opts) THEN
- c.v.context.GetSize(w, h);
- x := c.v.orgX; y := c.v.orgY;
- IF c.v.w > 0 THEN
- DEC(w, c.v.rgap + 2 * c.v.border);
- IF r > x + w - Ports.point THEN x := r - w + Ports.point END;
- IF l < x + Ports.point THEN x := l - Ports.point END;
- END;
- IF c.v.h > 0 THEN
- DEC(h, c.v.bgap + 2 * c.v.border);
- IF b > y + h - Ports.point THEN y := b - h + Ports.point END;
- IF t < y + Ports.point THEN y := t - Ports.point END;
- END;
- IF (x # c.v.orgX) OR (y # c.v.orgY) THEN
- CheckPos(c.v, x, y); c.v.orgX := x; c.v.orgY := y;
- Views.Update(c.v.view, Views.keepFrames)
- END;
- Services.DoLater(c.v.update, Services.now)
- END
- END MakeVisible;
-
- PROCEDURE (c: Context) Consider (VAR p: Models.Proposal);
- BEGIN
- c.v.context.Consider(p)
- END Consider;
-
- PROCEDURE (c: Context) Normalize (): BOOLEAN;
- BEGIN
- RETURN ~(savePos IN c.v.opts)
- END Normalize;
-
- PROCEDURE (c: Context) GetSize (OUT w, h: INTEGER);
- BEGIN
- c.v.context.GetSize(w, h);
- DEC(w, c.v.rgap + 2 * c.v.border);
- DEC(h, c.v.bgap + 2 * c.v.border);
- IF c.type = 0 THEN
- IF c.v.w > 0 THEN w := c.v.w END;
- IF c.v.h > 0 THEN h := c.v.h END
- ELSIF c.type = 1 THEN
- w := c.v.rgap
- ELSIF c.type = 2 THEN
- h := c.v.bgap
- END
- END GetSize;
-
- PROCEDURE (c: Context) SetSize (w, h: INTEGER);
- VAR w0, h0, w1, h1: INTEGER;
- BEGIN
- ASSERT(c.type = 0, 100);
- c.v.context.GetSize(w0, h0); w1 := w0; h1 := h0;
- IF c.v.w > 0 THEN c.v.w := w
- ELSE w1 := w + c.v.rgap + 2 * c.v.border
- END;
- IF c.v.h > 0 THEN c.v.h := h
- ELSE h1 := h + c.v.bgap + 2 * c.v.border
- END;
- IF (w1 # w0) OR (h1 # h0) THEN
- c.v.context.SetSize(w1, h1)
- END
- END SetSize;
-
- PROCEDURE (c: Context) ThisModel (): Models.Model;
- BEGIN
- RETURN NIL
- END ThisModel;
-
-
- (* dialog *)
-
- PROCEDURE InitDialog*;
- VAR p: Properties.Property; u: INTEGER;
- BEGIN
- Properties.CollectProp(p);
- WHILE (p # NIL) & ~(p IS Prop) DO p := p.next END;
- IF p # NIL THEN
- WITH p: Prop DO
- IF Dialog.metricSystem THEN u := Ports.mm DIV 10 ELSE u := Ports.inch DIV 100 END;
- dialog.valid := p.valid;
- dialog.readOnly := p.readOnly;
- IF ~p.horBar THEN dialog.horizontal.mode := 0
- ELSIF p.horHide THEN dialog.horizontal.mode := 1
- ELSE dialog.horizontal.mode := 2
- END;
- IF ~p.verBar THEN dialog.vertical.mode := 0
- ELSIF p.verHide THEN dialog.vertical.mode := 1
- ELSE dialog.vertical.mode := 2
- END;
- dialog.horizontal.size := p.width DIV u / 100;
- dialog.vertical.size := p.height DIV u / 100;
- dialog.horizontal.adapt := p.width = 0;
- dialog.vertical.adapt := p.height = 0;
- dialog.showBorder := p.showBorder;
- dialog.savePos := p.savePos
- END
- END
- END InitDialog;
-
- PROCEDURE Set*;
- VAR p: Prop; u: INTEGER;
- BEGIN
- IF Dialog.metricSystem THEN u := 10 * Ports.mm ELSE u := Ports.inch END;
- NEW(p); p.valid := dialog.valid;
- p.horBar := dialog.horizontal.mode # 0;
- p.verBar := dialog.vertical.mode # 0;
- p.horHide := dialog.horizontal.mode = 1;
- p.verHide := dialog.vertical.mode = 1;
- IF ~dialog.horizontal.adapt THEN p.width := SHORT(ENTIER(dialog.horizontal.size * u)) END;
- IF ~dialog.vertical.adapt THEN p.height := SHORT(ENTIER(dialog.vertical.size * u)) END;
- p.showBorder := dialog.showBorder;
- p.savePos := dialog.savePos;
- Properties.EmitProp(NIL, p)
- END Set;
-
- PROCEDURE DialogGuard* (VAR par: Dialog.Par);
- VAR p: Properties.Property;
- BEGIN
- Properties.CollectProp(p);
- WHILE (p # NIL) & ~(p IS Prop) DO p := p.next END;
- IF p = NIL THEN par.disabled := TRUE END
- END DialogGuard;
-
- PROCEDURE HorAdaptGuard* (VAR par: Dialog.Par);
- BEGIN
- IF width IN dialog.readOnly THEN par.readOnly := TRUE END
- END HorAdaptGuard;
-
- PROCEDURE VerAdaptGuard* (VAR par: Dialog.Par);
- BEGIN
- IF height IN dialog.readOnly THEN par.readOnly := TRUE END
- END VerAdaptGuard;
-
- PROCEDURE WidthGuard* (VAR par: Dialog.Par);
- BEGIN
- IF dialog.horizontal.adapt THEN par.disabled := TRUE
- ELSIF width IN dialog.readOnly THEN par.readOnly := TRUE
- END
- END WidthGuard;
-
- PROCEDURE HeightGuard* (VAR par: Dialog.Par);
- BEGIN
- IF dialog.vertical.adapt THEN par.disabled := TRUE
- ELSIF height IN dialog.readOnly THEN par.readOnly := TRUE
- END
- END HeightGuard;
-
-
- (* commands *)
-
- PROCEDURE AddScroller*;
- VAR poll: Controllers.PollOpsMsg; v: View; replace: Controllers.ReplaceViewMsg;
- BEGIN
- Controllers.PollOps(poll);
- IF (poll.singleton # NIL) & ~(poll.singleton IS View) THEN
- NEW(v); v.view := poll.singleton; Init(v, TRUE);
- replace.old := poll.singleton; replace.new := v;
- Controllers.Forward(replace)
- ELSE Dialog.Beep
- END
- END AddScroller;
- PROCEDURE RemoveScroller*;
- VAR poll: Controllers.PollOpsMsg; replace: Controllers.ReplaceViewMsg;
- BEGIN
- Controllers.PollOps(poll);
- IF (poll.singleton # NIL) & (poll.singleton IS View) THEN
- replace.old := poll.singleton;
- replace.new := Views.CopyOf(poll.singleton(View).view, Views.shallow);
- Controllers.Forward(replace)
- ELSE Dialog.Beep
- END
- END RemoveScroller;
- END StdScrollers.
|