ControlsOuterImpl.mesa
Copyright Ó 1985, 1992 by Xerox Corporation. All rights reserved.
Bloomenthal, July 2, 1992 6:25 pm PDT
DIRECTORY Atom, Buttons, CedarProcess, Commander, Containers, Controls, ControlsPrivate, Convert, FileNames, G2dBasic, Imager, IO, Labels, PopUpSelection, ProcessProps, Real, Rope, TiogaExtraOps, TiogaOps, TIPUser, TypeScript, VFonts, ViewerClasses, ViewerIO, ViewerOps, ViewerSpecs, ViewerTools;
ControlsOuterImpl: CEDAR MONITOR
IMPORTS Atom, Buttons, CedarProcess, Containers, Controls, ControlsPrivate, Convert, FileNames, Imager, IO, Labels, PopUpSelection, ProcessProps, Real, Rope, TiogaExtraOps, TiogaOps, TIPUser, TypeScript, VFonts, ViewerIO, ViewerOps, ViewerSpecs, ViewerTools
EXPORTS Controls
~ BEGIN
Types
Button:    TYPE ~ Controls.Button;
ButtonList:   TYPE ~ Controls.ButtonList;
ButtonRep:   TYPE ~ Controls.ButtonRep;
Choice:    TYPE ~ Controls.Choice;
ClickProc:   TYPE ~ Controls.ClickProc;
Column:    TYPE ~ Controls.Column;
Control:    TYPE ~ Controls.Control;
ControlList:   TYPE ~ Controls.ControlList;
ControlSizes:   TYPE ~ Controls.ControlSizes;
DestroyProc:   TYPE ~ Controls.DestroyProc;
DrawProc:   TYPE ~ Controls.DrawProc;
GraphicsData:  TYPE ~ Controls.GraphicsData;
GraphicsDataRep: TYPE ~ Controls.GraphicsDataRep;
IntegerPair:   TYPE ~ Controls.IntegerPair;
MouseButton:  TYPE ~ Controls.MouseButton;
MouseProc:   TYPE ~ Controls.MouseProc;
OuterData:   TYPE ~ Controls.OuterData;
OuterDataRep:  TYPE ~ Controls.OuterDataRep;
RealSequence:  TYPE ~ Controls.RealSequence;
RealSequenceRep: TYPE ~ Controls.RealSequenceRep;
RopeSequence:  TYPE ~ Controls.RopeSequence;
RopeSequenceRep: TYPE ~ Controls.RopeSequenceRep;
Request:    TYPE ~ Controls.Request;
Triple:    TYPE ~ Controls.Triple;
TSValue:    TYPE ~ Controls.TSValue;
Typescript:   TYPE ~ Controls.Typescript;
TypescriptRep:  TYPE ~ Controls.TypescriptRep;
Font:     TYPE ~ Imager.Font;
STREAM:    TYPE ~ IO.STREAM;
ROPE:     TYPE ~ Rope.ROPE;
IconFlavor:   TYPE ~ ViewerClasses.IconFlavor;
Viewer:    TYPE ~ ViewerClasses.Viewer;
Constants
maxNRows:   INTEGER ~ 10;
capHeight:   INTEGER ~ 14;
Errors
ControlError: PUBLIC ERROR [reason: ROPE] = CODE;
Outer Procedures
AvailableHeight: PROC [column: ViewerClasses.Column] RETURNS [ht: INTEGER] ~ {
nViewers: INTEGER ¬ 1;       -- count oneself too
EnumProc: ViewerOps.EnumProc ~ {
IF v.column = column AND NOT v.iconic THEN nViewers ¬ nViewers+1;
};
ViewerOps.EnumerateViewers[EnumProc];
ht ¬ ViewerSpecs.openTopY-ViewerSpecs.openBottomY-nViewers*ViewerSpecs.captionHeight;
};
PaintOuter: ViewerClasses.PaintProc ~ {
Action: PROC ~ {
o: OuterData ¬ NARROW[self.data];
Imager.MaskRectangleI[context, 0, self.wh-capHeight, self.ww, 1];
IF o.buttons # NIL THEN Imager.MaskRectangleI[context, 0, o.buttonsY, self.ww, 1];
IF o.typescript # NIL AND o.typescript.viewer # NIL
THEN Imager.MaskRectangleI[context, 0, o.tsY, self.ww, 1];
IF o.graphics # NIL THEN Imager.MaskRectangleI[context, 0, o.graphicsY-1, self.ww, 1];
};
IF whatChanged = NIL THEN Imager.DoWithBuffer[context, Action, 0, 0, self.ww, self.wh];
};
AdjustProc: ViewerClasses.AdjustProc ~ {AdjustOuter[NARROW[self.data], self.ww, self.wh]};
AdjustOuter: PROC [o: OuterData, w, h: INTEGER] ~ {
SetV: PROC[v: Viewer, x, y, w, h: INT] ~ {ViewerOps.EstablishViewerPosition[v,x,y,w,h]};
EstablishOuterChild: ViewerOps.EnumProc ~ {
Justify child with respect to top of parent viewer:
newY: INTEGER ¬ v.wy+h-o.outerH;
IF ViewerOps.FetchProp[v, $CreatedInOuterViewer] = NIL
THEN SetV[v, v.wx, v.wy ¬ newY, v.ww, v.wh];
};
oldGraphicsH: INT ¬ o.graphicsH;
o.graphicsH ¬ h-capHeight-o.controlsH-o.buttonsH-o.tsH;
SetYs[o];
IF o.typescript # NIL AND o.typescript.viewer # NIL
THEN SetV[o.typescript.viewer, 0, o.tsY+1, w, o.tsH-2];
IF o.buttons # NIL THEN FOR b: ButtonList ¬ o.buttons, b.rest WHILE b # NIL DO
SetV[b.first.viewer, b.first.x, o.buttonsY+b.first.y, b.first.w, b.first.h];
ENDLOOP;
IF o.parent # NIL THEN ViewerOps.EnumerateChildren[o.parent, EstablishOuterChild];
IF o.graphics # NIL AND NOT o.parent.iconic THEN {
refWidth: REF ANY ¬ ViewerOps.FetchProp[o.graphics, $Width];
refHeight: REF ANY ¬ ViewerOps.FetchProp[o.graphics, $Height];
SetV[o.graphics, 0, o.graphicsY, w, o.graphicsH];
IF refWidth # NIL AND refHeight # NIL THEN {
EstablishGraphicsChild: ViewerOps.EnumProc ~ {
I: PROC [r: REAL] RETURNS [i: INT] ~ {i ¬ Real.Round[r]};
SetV[v, I[sx*v.wx], I[sy*v.wy], I[sx*v.ww], I[sy*v.wh]];
};
sx: REAL ¬ REAL[w]/REAL[NARROW[refWidth, REF INTEGER]­];
sy: REAL ¬ REAL[o.graphicsH]/REAL[NARROW[refHeight, REF INTEGER]­];
ViewerOps.EnumerateChildren[o.graphics, EstablishGraphicsChild];
};
ViewerOps.AddProp[o.graphics, $Width, NEW[INTEGER ¬ w]];
ViewerOps.AddProp[o.graphics, $Height, NEW[INTEGER ¬ o.graphicsH]];
};
o.outerH ¬ h;
};
CopyControlList: PROC [controls: ControlList] RETURNS [ControlList] ~ {
new: ControlList ¬ NIL;
FOR c: ControlList ¬ controls, c.rest WHILE c # NIL DO
new ¬ Controls.Append[c.first, new];
ENDLOOP;
RETURN[new];
};
ChangeOuterViewer: PUBLIC PROC [outerData: OuterData, controls: ControlList] ~ {
NotInList: PROC [controls: ControlList, control: Control] RETURNS [BOOL] ~ {
FOR c: ControlList ¬ controls, c.rest WHILE c # NIL DO
IF c.first = control THEN RETURN[FALSE];
ENDLOOP;
RETURN[TRUE];
};
destroy: BOOL ¬ FALSE;
parent: Viewer ¬ outerData.parent;
oldControlHeight: INTEGER ¬ outerData.controlsH;
FOR c: ControlList ¬ outerData.controls, c.rest WHILE c # NIL DO   -- do this everytime
IF NotInList[controls, c.first] THEN {destroy ¬ TRUE; EXIT};
ENDLOOP;
FOR c: ControlList ¬ outerData.controls, c.rest WHILE c # NIL DO
ViewerOps.DestroyViewer[c.first.viewer, FALSE];
ViewerOps.DestroyViewer[c.first.title, FALSE];
ViewerOps.DestroyViewer[c.first.status, FALSE];
ENDLOOP;
outerData.controlsH ¬
Controls.ControlPositions[controls, outerData.controlSizes, ColumnWidth[outerData.column]];
IF outerData.controlsH # oldControlHeight THEN {
SetOuterHeight[outerData];
AdjustOuter[outerData, outerData.parent.ww, outerData.outerH];
ViewerOps.SetOpenHeight[parent, outerData.outerH-capHeight+1];
ViewerOps.ComputeColumn[outerData.column, TRUE];
};
outerData.controls ¬ CopyControlList[controls];
FOR c: ControlList ¬ controls, c.rest WHILE c # NIL DO
Controls.ControlViewer[parent, c.first, outerData.graphics, outerData];
ENDLOOP;
IF outerData.controlsH = oldControlHeight AND destroy
THEN ViewerOps.PaintViewer[parent, client, TRUE, NIL];
};
OuterViewer: PUBLIC PROC [
name: ROPE ¬ NIL,
column: Column ¬ left,
buttons: ButtonList ¬ NIL,
controls: ControlList ¬ NIL,
controlSizes: ControlSizes ¬ [25, 200, 60, 25, 60, 150, 150],
graphicsHeight: INTEGER ¬ 0,
mouseProc: MouseProc ¬ NIL,
drawProc: DrawProc ¬ NIL,
destroyProc: DestroyProc ¬ NIL,
typescriptHeight: INTEGER ¬ 0,
biScrollable: BOOL ¬ FALSE,
clientData: REF ANY ¬ NIL,
noOpen: BOOL ¬ FALSE,
icon: IconFlavor ¬ document]
RETURNS [outerData: OuterData]
~ {
viewer: Viewer;
IF column = color AND ColorDisplayManager.NextState[].type = NIL THEN column ← left;
outerData ¬ OuterDataInit[
NIL, column, buttons, controls, controlSizes,
graphicsHeight, mouseProc, drawProc,
destroyProc, typescriptHeight, clientData];
viewer ¬ outerData.parent ¬ ViewerOps.CreateViewer[
flavor: $Outer,
paint: FALSE,
info: [
name: name,
data: outerData,
openHeight: MIN[AvailableHeight[column], outerData.outerH],
scrollable: FALSE,
column: column,
iconic: TRUE]
];
IF icon # document THEN viewer.icon ¬ icon;
ViewerOps.AddProp[viewer, $WorkingDirectory, ProcessProps.GetProp[$WorkingDirectory]];
SetYs[outerData];
IF outerData.tsH # 0 THEN {
ts: Typescript ¬ outerData.typescript ¬ NEW[TypescriptRep];
v: Viewer ¬ ts.viewer ¬ TypescriptViewer[viewer, outerData.tsH];
[ts.in, ts.out] ¬ ViewerIO.CreateViewerStreams[NIL, v];
};
IF graphicsHeight # 0 THEN {
outerData.graphics ¬ GraphicsViewer[viewer, outerData.controlsH, graphicsHeight, mouseProc, drawProc, biScrollable, outerData.clientData];
ViewerOps.AddProp[outerData.graphics, $Width, NEW[INTEGER ¬ viewer.ww]];
ViewerOps.AddProp[outerData.graphics, $Height, NEW[INTEGER ¬ graphicsHeight]];
outerData.graphicsData ¬ GetGraphicsData[outerData.graphics];
};
FOR b: ButtonList ¬ outerData.buttons, b.rest WHILE b # NIL DO
v: Viewer ¬ b.first.viewer ¬ ButtonViewer[viewer, b.first];
IF b.first.type = click AND b.first.style # $BlackOnWhite
THEN Buttons.SetDisplayStyle[b.first.viewer, b.first.style];
ENDLOOP;
FOR c: ControlList ¬ outerData.controls, c.rest WHILE c # NIL DO
Controls.ControlViewer[viewer, c.first, outerData.graphics, outerData];
ENDLOOP;
IF NOT noOpen THEN ViewerOps.OpenIcon[viewer];
};
OuterDataInit: PROC [
outerData: OuterData ¬ NIL,       -- use if non-nil
column: Column ¬ left,
buttons: ButtonList ¬ NIL,
controls: ControlList ¬ NIL,
controlSizes: ControlSizes ¬ [25, 200, 60, 25, 60, 150, 150],
graphicsHeight: INTEGER ¬ 0,
mouseProc: MouseProc ¬ NIL,
drawProc: DrawProc ¬ NIL,
destroyProc: DestroyProc ¬ NIL,
typescriptHeight: INTEGER ¬ 0,
data: REF ANY ¬ NIL]
RETURNS [OuterData] ~ {
widthLim: NAT ¬ SELECT column FROM
left => ViewerSpecs.openLeftWidth,
right => ViewerSpecs.openRightWidth,
ENDCASE => ViewerSpecs.colorScreenWidth;
IF outerData = NIL THEN outerData ¬ NEW[OuterDataRep];
outerData.controls ¬ CopyControlList[controls];
outerData.buttons ¬ buttons;
outerData.clientData ¬ data;
outerData.destroyProc ¬ destroyProc;
outerData.controlSizes ¬ controlSizes;
outerData.directory ¬ FileNames.CurrentWorkingDirectory[];
outerData.cmdOut ¬ WITH ProcessProps.GetProp[$CommanderHandle] SELECT FROM
cmd: Commander.Handle => cmd.err,
ENDCASE => NIL;
outerData.controlsH ¬ Controls.ControlPositions[controls, controlSizes, ColumnWidth[column]];
outerData.graphicsH ¬ graphicsHeight;
outerData.tsH ¬ typescriptHeight;
outerData.buttonsH ¬ ButtonsPreparation[buttons, widthLim];
SetOuterHeight[outerData];
RETURN[outerData];
};
ColumnWidth: PROC [column: Column] RETURNS [INTEGER] ~ {
RETURN[SELECT column FROM
color => ViewerSpecs.colorScreenWidth,
left => ViewerSpecs.openLeftWidth,
right => ViewerSpecs.openRightWidth,
ENDCASE => 600];
};
SetYs: PROC [outerData: OuterData] ~ {
outerData.controlsY ¬ 0;
outerData.graphicsY ¬ outerData.controlsY+outerData.controlsH;
outerData.tsY ¬ outerData.graphicsY+outerData.graphicsH;
outerData.buttonsY ¬ outerData.tsY+outerData.tsH;
};
SetOuterHeight: PROC [outerData: OuterData] ~ {
outerData.outerH ¬ outerData.controlsH+outerData.graphicsH+outerData.tsH+outerData.buttonsH+capHeight;
};
Graphics Procedures
gGraphicsData: REF ANY;
gGraphicsInput: LIST OF REF ANY;
newGraphicsInputBoolean: BOOL;
newGraphicsInputCondition: CONDITION;
NotifyGraphics: ViewerClasses.NotifyProc ~ {
NewGraphicsInput[GetGraphicsData[self], input];
};
NewGraphicsInput: ENTRY PROC [data: REF ANY, input: LIST OF REF ANY] ~ {
gGraphicsData ¬ data;
gGraphicsInput ¬ input;
newGraphicsInputBoolean ¬ TRUE;
NOTIFY newGraphicsInputCondition;
};
GetGraphicsInput: ENTRY PROC RETURNS [graphics: GraphicsData] ~ {
IF NOT newGraphicsInputBoolean THEN WAIT newGraphicsInputCondition;
newGraphicsInputBoolean ¬ FALSE;
graphics ¬ NARROW[gGraphicsData];
IF gGraphicsInput # NIL
THEN graphics.mouse ¬ Controls.SetMouse[
atom: NARROW[gGraphicsInput.rest.first],
position: WITH gGraphicsInput.first SELECT FROM
p: TIPUser.TIPScreenCoords => [p.mouseX, p.mouseY],
p: BiScrollers.ClientCoords => [Real.InlineRoundI[p.x], Real.InlineRoundI[p.y]],
ENDCASE => ERROR];
};
WatchGraphics: CedarProcess.ForkableProc ~ {
DO
g: GraphicsData ¬ GetGraphicsInput[];
IF g.mouseProc # NIL THEN g.mouseProc[g.mouse, g.viewer, g.clientData];
ENDLOOP;
};
GetGraphicsData: PROC [viewer: Viewer] RETURNS [GraphicsData] ~ {
RETURN[IF BiScrollers.ViewerIsABiScroller[viewer]
THEN NARROW[BiScrollers.ClientDataOfViewer[viewer]]
ELSE NARROW[viewer.data]];
RETURN[NARROW[viewer.data]];
};
PaintGraphics: ViewerClasses.PaintProc ~ {
v: Viewer;
d: GraphicsData;
IF BiScrollers.ViewerIsABiScroller[self]
THEN {
d ← NARROW[BiScrollers.ClientDataOfViewer[self]];
v ← BiScrollers.QuaViewer[BiScrollers.QuaBiScroller[self], TRUE];
}
ELSE {
d ¬ NARROW[self.data];
v ¬ self;
};
IF d # NIL AND d.drawProc # NIL THEN d.drawProc[context, d.clientData, whatChanged, v];
};
GraphicsViewer: PUBLIC PROC [
parent: Viewer,
y, h: INTEGER ¬ 0,
mouseProc: MouseProc,
drawProc: DrawProc,
biScrollable: BOOL ¬ FALSE,
clientData: REF ANY]
RETURNS [viewer: Viewer]
~ {
graphicsData: GraphicsData ¬ NEW[GraphicsDataRep ¬ [
mouseProc: mouseProc, drawProc: drawProc, clientData: clientData, parent: parent]];
IF biScrollable
THEN {
bs: BiScrollers.BiScroller ← BiScrollers.GetStyle[].CreateBiScroller[
class: graphicsBiScrollerClass,
info: [
parent: parent,
wx: 0, wy: y,
ww: parent.ww,
wh: h,
data: graphicsData,
border: FALSE,
scrollable: FALSE],
paint: FALSE
];
viewer ← bs.QuaViewer[inner: FALSE];
}
-- ELSE -- viewer ¬ ViewerOps.CreateViewer[
flavor: $Graphics,
paint: FALSE,
info: [
data: graphicsData,
scrollable: FALSE,
ww: parent.ww,
wy: y,
wh: h,
border: FALSE,
parent: parent]];
graphicsData.viewer ¬ viewer;
ViewerOps.AddProp[viewer, $CreatedInOuterViewer, $True];
};
Button Procedures
ClickButton: PUBLIC PROC [
name: ROPE ¬ NIL,
proc: ClickProc ¬ NIL,
clientData: REF ANY ¬ NIL,
row, x, y, w, h: INTEGER ¬ 0,
fork: BOOL ¬ TRUE,
guarded: BOOL ¬ FALSE,
documentation: ROPE ¬ NIL,
font: Font ¬ NIL,
style: ATOM ¬ $BlackOnWhite]
RETURNS [Button] ~ {
RETURN[NEW[ButtonRep ¬ [click, name, row, x, y, w, h, fork, guarded, documentation, font, NIL, clientData, proc, style]]];
};
TextButton: PUBLIC PROC [
name: ROPE ¬ NIL,
text: ROPE ¬ NIL,
proc: ClickProc ¬ NIL,
clientData: REF ANY ¬ NIL,
row, x, y, w, h: INTEGER ¬ 0,
fork: BOOL ¬ TRUE,
documentation: ROPE ¬ NIL,
font: Font ¬ NIL]
RETURNS [b: Button]
~ {
b ¬ NEW[ButtonRep ¬ [text, name, row, x, y, w, h, fork,, documentation, font, NIL, clientData,,, text, proc]];
};
PopUpButton: PUBLIC PROC [
name: ROPE ← NIL,
proc: PopUpButtonProc ← NIL,
choices: ChoiceList ← NIL,
doc: ROPE ← NIL,
help: Help ← NIL,
clientData: REF ANY ← NIL,
row, x, y, w, h: INTEGER ← 0,
fork: BOOL ← TRUE,
guarded: BOOL ← FALSE,
documentation: ROPE ← NIL,
font: Font ← NIL]
RETURNS [Button] ~ {
RETURN[NEW[ButtonRep ← [popUp, name, row, x, y, w, h, fork, guarded, documentation, font,, clientData,,,,,, proc, choices, doc, help]]];
};
popUpButton: MouseButton ¬ none;
PopUpRequest: PUBLIC PROC [header: Request, requests: LIST OF Request] RETURNS [i: INT] ~ {
Reverse: PROC [in: LIST OF ROPE] RETURNS [out: LIST OF ROPE] ~ {
FOR r: LIST OF ROPE ¬ in, r.rest WHILE r # NIL DO out ¬ CONS[r.first, out]; ENDLOOP;
};
choices, docs: LIST OF ROPE ¬ NIL;
pos: REF ViewerClasses.MouseButton ¬ NEW[ViewerClasses.MouseButton];
FOR r: LIST OF Request ¬ requests, r.rest WHILE r # NIL DO
choices ¬ CONS[r.first.choice, choices];
docs ¬ CONS[r.first.doc, docs];
ENDLOOP;
i ¬ PopUpSelection.Request[header.choice, Reverse[choices], header.doc, Reverse[docs],,, pos];
popUpButton ¬ IF i > 0
THEN SELECT pos­ FROM
red  => left,
yellow => middle,
blue  => right,
ENDCASE => none
ELSE none;
};
BoolRequest: PUBLIC PROC [value: BOOL, title: ROPE] RETURNS [req: Request] ~ {
req.choice ¬ IO.PutFR["%g is %g", IO.rope[title], IO.rope[IF value THEN "On" ELSE "Off"]];
req.doc ¬ IO.PutFR["Turn %g %g", IO.rope[IF value THEN "Off" ELSE "On"], IO.rope[title]];
};
IntRequest: PUBLIC PROC [title, doc: ROPE, value: NAT] RETURNS [Request] ~ {
RETURN[[IO.PutFR["%g (now %g)", IO.rope[title], IO.int[value]], doc]];
};
RealRequest: PUBLIC PROC [title, doc: ROPE, value: REAL] RETURNS [Request] ~ {
RETURN[[IO.PutFR["%g (now %6.3f)", IO.rope[title], IO.real[value]], doc]];
};
RopeRequest: PUBLIC PROC [title, doc, value: ROPE] RETURNS [req: Request] ~ {
req ¬ IF value = NIL
THEN [IO.PutFR1["%g", IO.rope[title]], doc]
ELSE [IO.PutFR["%g (now %g)", IO.rope[title], IO.rope[value]], doc];
};
MultiRequest: PUBLIC PROC [header: ROPE, choices: LIST OF Choice] RETURNS [INT] ~ {
Reverse: PROC [in: LIST OF Request] RETURNS [out: LIST OF Request] ~ {
FOR r: LIST OF Request ¬ in, r.rest WHILE r # NIL DO out ¬ CONS[r.first, out]; ENDLOOP;
};
id, choice, count: NAT ¬ 0;
status: ROPE ¬ NIL;
requests: LIST OF Request ¬ NIL;
FOR l: LIST OF Choice ¬ choices, l.rest WHILE l # NIL DO
IF l.first.true
THEN status ¬ (IF status = NIL
THEN Rope.Concat[header, l.first.state]
ELSE Rope.Cat[status, ", ", l.first.state])
ELSE {
requests ¬ CONS[[Rope.Concat["Change to ", l.first.state]], requests];
l.first.privateId ¬ (id ¬ id+1);
};
ENDLOOP;
choice ¬ Controls.PopUpRequest[[status], Reverse[requests]];
FOR l: LIST OF Choice ¬ choices, l.rest WHILE l # NIL DO
count ¬ count+1;
IF l.first.privateId = choice THEN RETURN[count];
ENDLOOP;
RETURN[-1];
};
GetPopUpButton: PUBLIC PROC RETURNS [MouseButton] ~ {RETURN[popUpButton]};
GetTextButtonText: PUBLIC PROC [outerData: OuterData, name: ROPE] RETURNS [t: ROPE] ~ {
button: Button ¬ ButtonFind[outerData, name];
IF button = NIL
THEN ControlError["Can't find named button"]
ELSE t ¬ ViewerTools.GetContents[button.textViewer];
};
GetTextButtonValue: PUBLIC PROC [outerData: OuterData, name: ROPE] RETURNS [r: REAL] ~ {
r ¬ Convert.RealFromRope[GetTextButtonText[outerData, name]];
};
GetTextButtonsTexts: PUBLIC PROC [outerData: OuterData, name: ROPE]
RETURNS [ropes: RopeSequence]
~ {
IF outerData # NIL AND outerData.buttons # NIL THEN {
i: INT ¬ 0; FOR l: ButtonList ¬ outerData.buttons, l.rest WHILE l # NIL DO i¬i+1; ENDLOOP;
ropes ¬ NEW[RopeSequenceRep[i]];
i ¬ 0;
FOR l: ButtonList ¬ outerData.buttons, l.rest WHILE l # NIL DO
ropes[i] ¬ ViewerTools.GetContents[l.first.textViewer];
i ¬ i+1;
ENDLOOP;
};
};
GetTextButtonsValues: PUBLIC PROC [outerData: OuterData, name: ROPE]
RETURNS [reals: RealSequence]
~ {
IF outerData # NIL AND outerData.buttons # NIL THEN {
i: INT ¬ 0; FOR l: ButtonList ¬ outerData.buttons, l.rest WHILE l # NIL DO i¬i+1; ENDLOOP;
reals ¬ NEW[RealSequenceRep[i]];
i ¬ 0;
FOR l: ButtonList ¬ outerData.buttons, l.rest WHILE l # NIL DO
reals[i] ¬Convert.RealFromRope[ViewerTools.GetContents[l.first.textViewer]];
i ¬ i+1;
ENDLOOP;
};
};
ButtonRelabel: PUBLIC PROC [outerData: OuterData, oldName, newName: ROPE] ~ {
IF outerData # NIL THEN FOR b: ButtonList ¬ outerData.buttons, b.rest WHILE b # NIL DO
IF b.first.type = click AND Rope.Equal[b.first.viewer.name, oldName]
THEN Buttons.ReLabel[b.first.viewer, newName];
ENDLOOP;
};
ButtonToggle: PUBLIC PROC [outerData: OuterData, state: BOOL, trueName, falseName: ROPE]
~ {
IF state
THEN ButtonRelabel[outerData, falseName, trueName]
ELSE ButtonRelabel[outerData, trueName, falseName];
};
ButtonStyle: PUBLIC PROC [outerData: OuterData, name: ROPE, style: ATOM] ~ {
FOR b: ButtonList ¬ outerData.buttons, b.rest WHILE b # NIL DO
IF b.first.type = click AND Rope.Equal[b.first.viewer.name, name]
THEN Buttons.SetDisplayStyle[b.first.viewer, style];
ENDLOOP;
};
ButtonFind: PUBLIC PROC [outerData: OuterData, name: ROPE] RETURNS [Button] ~ {
FOR b: ButtonList ¬ outerData.buttons, b.rest WHILE b # NIL DO
IF Rope.Equal[b.first.name, name] THEN RETURN[b.first];
ENDLOOP;
RETURN[NIL];
};
ButtonTextProc: ClickProc ~ {
outerData: OuterData ¬ NARROW[clientData];
button: Button ¬ ButtonFind[outerData, parent.name];
IF button.type # text THEN RETURN;
ViewerTools.SetSelection[button.textViewer];
When mouse focus moved from textViewer, button.textProc called by Controls.KillInputFocus
};
ButtonDummyProc: ClickProc ~ {}; -- otherwise Buttons.ButtonPusher dies
ButtonViewer: PUBLIC PROC [parent: Viewer, button: Button] RETURNS [viewer: Viewer] ~ {
If button.proc is NIL, treat button as a non-bordered label.
SELECT button.type FROM
click =>
viewer ¬ IF button.clickProc # NIL
THEN
Buttons.Create[
info: [parent: parent, name: button.name, wx: button.x, wy: button.y],
proc: button.clickProc,
clientData: button.clientData,
fork: button.fork,
font: button.font,
documentation: button.documentation,
guarded: button.guarded
]
ELSE
Labels.Create[
info: [parent: parent, border: FALSE, wx: button.x, wy: button.y,
ww: VFonts.StringWidth[button.name, button.font]+8, wh: button.h,
scrollable: FALSE, name: button.name],
font: button.font
];
text => {
labelW: INTEGER ¬ VFonts.StringWidth[button.name, button.font]+8;
v: Viewer ¬ viewer ¬ Containers.Create[info: [parent: parent, name: button.name, wx: button.x, wy: button.y+1, ww: button.w, wh: button.h, scrollable: FALSE]];
v ¬ Buttons.Create[
info: [parent: viewer, name: button.name, border: FALSE, wx: 0, wy: -1, ww: labelW],
proc: ButtonTextProc,
clientData: parent.data,   -- should be outerData!!
fork: button.fork,
font: button.font,
documentation: IF button.guarded THEN button.text ELSE NIL,
guarded: button.guarded
];
button.textViewer ¬ ViewerTools.MakeNewTextViewer[
info: [parent: viewer, border: FALSE, wx: labelW, wy: 0, ww: button.w-labelW, wh: button.h, scrollable: FALSE, data: button.clientData]];
ViewerOps.AddProp[v, $CreatedInOuterViewer, $True];
ViewerOps.AddProp[button.textViewer, $CreatedInOuterViewer, $True];
ViewerOps.AddProp[button.textViewer, $ButtonText, button];
ViewerTools.SetContents[button.textViewer, button.text];
ControlsPrivate.ActivateViewer[button.textViewer];
};
popUp => {
class: PopUpButtons.Class ← PopUpButtons.MakeClass[[
classData: button.clientData,
proc: button.popUpProc,
choices: button.choices,
fork: button.fork,
guarded: button.guarded,
image: PopUpButtons.ImageForRope[button.name],
doc: button.doc,
help: button.help]];
viewer ← PopUpButtons.Instantiate[
class,
[parent: parent, name: button.name, border: button.popUpProc # NIL, wx: button.x, wy: button.y],
button.help];
};
ENDCASE;
ViewerOps.AddProp[viewer, $CreatedInOuterViewer, $True];
};
ButtonsPreparation: PROC [buttons: ButtonList, widthLimit: NAT]
RETURNS [buttonHeight: INTEGER]
~ {
margin: INTEGER ~ 4;
buttonRows: ARRAY [0..maxNRows) OF RECORD [x: INTEGER ¬ margin, y, h: INTEGER ¬ 0];
FOR b: ButtonList ¬ buttons, b.rest WHILE b # NIL DO
font: Font ¬ b.first.font ¬ VFonts.DefaultFont[b.first.font];
IF b.first.h = 0 THEN b.first.h ¬ VFonts.FontHeight[font]+3;
IF b.first.w = 0 THEN b.first.w ¬ VFonts.StringWidth[b.first.name, font]+8;
IF b.first.type = text THEN {
b.first.text ¬ Rope.Concat[b.first.text, " "]; -- MakeNewTextViewer needs padding
b.first.w ¬ b.first.w+VFonts.StringWidth[b.first.text, font]+8;
};
ENDLOOP;
FOR b: ButtonList ¬ buttons, b.rest WHILE b # NIL DO
b.first.row ¬ MAX[0, MIN[maxNRows-1, b.first.row]];
DO
IF MAX[b.first.x, buttonRows[b.first.row].x]+b.first.w < widthLimit THEN EXIT;
IF b.first.row >= maxNRows-2 THEN EXIT;
b.first.row ¬ b.first.row+1;
ENDLOOP;
IF b.first.x = 0
THEN b.first.x ¬ buttonRows[b.first.row].x
ELSE buttonRows[b.first.row].x ¬ b.first.x;
buttonRows[b.first.row].x ¬ b.first.x+b.first.w+margin-1;
buttonRows[b.first.row].h ¬ MAX[buttonRows[b.first.row].h, b.first.h];
ENDLOOP;
buttonRows[0].y ¬ margin+1;
buttonHeight ¬ buttonRows[0].y+buttonRows[0].h+margin;
FOR n: NAT IN [1..maxNRows) DO
IF buttonRows[n].h # 0 THEN buttonHeight ¬ buttonHeight+buttonRows[n].h+margin;
buttonRows[n].y ¬ buttonRows[n-1].y+buttonRows[n].h+margin;
ENDLOOP;
FOR b: ButtonList ¬ buttons, b.rest WHILE b # NIL DO
IF b.first.y = 0 THEN b.first.y ¬ buttonRows[b.first.row].y;
ENDLOOP;
IF buttons = NIL THEN buttonHeight ¬ 0;
};
Typescript Procedures
TypescriptViewer: PROC [parent: Viewer, tsHeight: INTEGER] RETURNS [ts: Viewer] ~ {
arg: ROPE ~ "0 pt restIndent";
ts ¬ TypeScript.Create[[parent: parent, wh: tsHeight, border: FALSE]];
ViewerOps.AddProp[ts, $CreatedInOuterViewer, $True];
TiogaExtraOps.PutProp[TiogaOps.LastWithin[TiogaOps.ViewerDoc[ts]], $Postfix, arg];
};
TypescriptClear: PUBLIC PROC [ts: Typescript] ~ {
IF ts.out # NIL AND NOT ts.clear THEN IO.PutRope[ts.out, "\n"];
ts.clear ¬ TRUE;
};
TypescriptWrite: PUBLIC PROC [ts: Typescript, rope: ROPE] ~ {
IF ts.out = NIL THEN RETURN;
IO.PutRope[ts.out, rope ! IO.Error => CONTINUE];
IO.Flush[ts.out ! IO.Error => CONTINUE];
ts.clear ¬ Rope.FindBackward[rope, "\n"] = Rope.Length[rope]-1;
};
TypescriptRead: PUBLIC PROC [ts: Typescript, prompt: ROPE ¬ NIL] RETURNS [reply: ROPE]
~ {
IF ts.in = NIL THEN RETURN[NIL];
IF ts.out # NIL AND prompt # NIL THEN {
IF NOT ts.clear THEN prompt ¬ Rope.Concat["\n", prompt];
TypescriptWrite[ts, prompt];
};
ViewerTools.SetSelection[ts.viewer];
reply ¬ IO.GetLineRope[ts.in ! IO.Rubout, IO.Error => CONTINUE];
IF reply = NIL THEN TypescriptWrite[ts, ". . . aborted.\n"];
ts.clear ¬ TRUE;
};
TypescriptReadFileName: PUBLIC PROC [ts: Typescript] RETURNS [reply: ROPE] ~ {
Inner: PROC ~ {reply ¬ FileNames.ResolveRelativePath[reply]};
workingDir: ROPE ~ NARROW[ViewerOps.FetchProp[ts.viewer.parent, $WorkingDirectory]];
reply ¬ TypescriptRead[ts, IO.PutFR1["Filename: (dir = %g) ", IO.rope[workingDir]]];
ProcessProps.AddPropList[Atom.PutPropOnList[NIL, $WorkingDirectory, workingDir], Inner];
The above doesn't always seem to work, so:
IF Rope.IsEmpty[reply] THEN RETURN[NIL];
IF Rope.Fetch[reply, 0] # '/ THEN reply ¬ Rope.Concat[workingDir, reply];
};
TypescriptReadValue: PUBLIC PROC [ts: Typescript, name: ROPE, currentValue: REAL]
RETURNS [newValue: REAL]
~ {
reply: ROPE ¬
TypescriptRead[ts, IO.PutFR["%g (now %g): ", IO.rope[name], IO.real[currentValue]]];
newValue ¬ currentValue;
IF reply # NIL THEN newValue ¬ Convert.RealFromRope[reply !
Convert.Error => {TypescriptWrite[ts, "Bad format.\n"]; CONTINUE}];
};
TypescriptReadValues: PUBLIC PROC [
ts: Typescript,
prompt: ROPE ¬ NIL,
tsValues: LIST OF TSValue]
RETURNS [reals: RealSequence]
~ {
ENABLE Convert.Error => GOTO BadFormat;
Test: PROC [tsv: TSValue] ~ {
commaV: IO.Value ¬ IO.rope[IF prompt # NIL THEN ", " ELSE NIL];
prompt ¬ SELECT TRUE FROM
named AND NOT once => IO.PutFLR["%g%g%g (now %g)",
LIST[IO.rope[prompt], commaV, IO.rope[tsv.name], IO.real[tsv.value]]],
named AND once => IO.PutFLR["%g%g%g (%g)",
LIST[IO.rope[prompt], commaV, IO.rope[tsv.name], IO.real[tsv.value]]],
ENDCASE => IO.PutFR["%g%g%g", IO.rope[prompt], commaV, IO.real[tsv.value]];
IF named AND NOT once THEN once ¬ TRUE;
};
NextRope: PROC RETURNS [ROPE] ~ {
IF (n0 ¬ Rope.SkipOver[reply, n1, ", \t"]) = Rope.Length[reply] THEN RETURN[NIL];
n1 ¬ Rope.SkipTo[reply, n0, ", \t"];
RETURN[Rope.Substr[reply, n0, n1-n0]];
};
once: BOOL ¬ FALSE;
n0, n1, count: NAT ¬ 0;
reply: ROPE ¬ NIL;
named: BOOL ¬ FALSE;
FOR l: LIST OF TSValue ¬ tsValues, l.rest WHILE l # NIL DO
count ¬ count+1;
IF l.first.name # NIL THEN named ¬ TRUE;
ENDLOOP;
IF NOT named THEN prompt ¬ Rope.Concat[prompt, "(now "];
FOR l: LIST OF TSValue ¬ tsValues, l.rest WHILE l # NIL DO Test[l.first]; ENDLOOP;
prompt ¬ Rope.Concat[prompt, IF named THEN "): " ELSE ": "];
IF (reply ¬ TypescriptRead[ts, prompt]) = NIL THEN RETURN;
reals ¬ NEW[RealSequenceRep[count]];
reals.length ¬ count;
count ¬ 0;
FOR l: LIST OF TSValue ¬ tsValues, l.rest WHILE l # NIL DO
rope: ROPE ¬ NextRope[];
real: REAL ¬ IF rope # NIL THEN Convert.RealFromRope[rope] ELSE l.first.value;
reals[count] ¬ real;
count ¬ count+1;
ENDLOOP;
EXITS BadFormat => TypescriptWrite[ts, "Bad Format"];
};
GetReal: PUBLIC PROC [ts: Typescript, prompt: ROPE, in: REAL] RETURNS [out: REAL] ~ {
reply: ROPE ¬ TypescriptRead[ts, IO.PutFR["%g (now %g): ", IO.rope[prompt], IO.real[in]]];
out ¬ in;
IF reply # NIL THEN out ¬ Convert.RealFromRope[reply !
Convert.Error => {TypescriptWrite[ts, ". . . bad format.\n"]; CONTINUE}];
};
GetNat: PUBLIC PROC [ts: Typescript, prompt: ROPE, in: NAT] RETURNS [out: NAT] ~ {
reply: ROPE ¬ TypescriptRead[ts, IO.PutFR["%g (now %g): ", IO.rope[prompt], IO.card[in]]];
out ¬ in;
IF reply # NIL THEN out ¬ Convert.CardFromRope[reply !
Convert.Error => {TypescriptWrite[ts, ". . . bad format.\n"]; CONTINUE}];
};
GetIntegerPair: PUBLIC PROC [ts: Typescript, prompt: ROPE, in: IntegerPair]
RETURNS [out: IntegerPair]
~ {
ENABLE IO.EndOfStream, IO.Error => GOTO Bad;
reply: ROPE ¬ TypescriptRead[ts, IO.PutFR["%g: (now %g, %g) ",
IO.rope[prompt], IO.int[in.x], IO.int[in.y]]];
out ¬ in;
IF reply # NIL THEN {
s: STREAM ¬ IO.RIS[reply];
out.x ¬ IO.GetInt[s];
out.y ¬ IO.GetInt[s];
};
EXITS Bad => TypescriptWrite[ts, ". . . bad format.\n"];
};
GetTriple: PUBLIC PROC [ts: Typescript, prompt: ROPE, in: Triple] RETURNS [out: Triple] ~ {
ENABLE IO.EndOfStream, IO.Error => GOTO Bad;
reply: ROPE ¬ TypescriptRead[ts, IO.PutFLR["%g: (now %g, %g, %g) ",
LIST[IO.rope[prompt], IO.real[in.x], IO.real[in.y], IO.real[in.z]]]];
out ¬ in;
IF reply # NIL THEN {
s: STREAM ¬ IO.RIS[reply];
out.x ¬ IO.GetReal[s];
out.y ¬ IO.GetReal[s];
out.z ¬ IO.GetReal[s];
};
EXITS Bad => TypescriptWrite[ts, ". . . bad format.\n"];
};
ClickProcs
Quit: PUBLIC ClickProc ~ {ViewerOps.DestroyViewer[NARROW[parent, Viewer].parent]};
DestroyOuter: ViewerClasses.DestroyProc ~ {
o: OuterData ¬ NARROW[self.data];
o.destroyed ¬ TRUE;
IF o.destroyProc # NIL THEN o.destroyProc[o.parent, $Unknown, o.clientData];
};
Restore: PUBLIC ClickProc ~ {
outerData: OuterData ¬ NARROW[clientData];
FOR c: ControlList ¬ outerData.controls, c.rest WHILE c # NIL DO
c.first.value ¬ c.first.init;
ViewerOps.PaintViewer[c.first.viewer, client, FALSE, c.first];
ENDLOOP;
};
Start Code
tipTable: TIPUser.TIPTable ¬ TIPUser.InstantiateNewTIPTable["Controls.tip"];
     
[] ¬ CedarProcess.Fork[WatchGraphics];
ViewerOps.RegisterViewerClass[$Outer, NEW[ViewerClasses.ViewerClassRec ¬ [
paint: PaintOuter,
adjust: AdjustProc,
destroy: DestroyOuter]]];
ViewerOps.RegisterViewerClass[$Graphics, NEW[ViewerClasses.ViewerClassRec ¬ [
notify: NotifyGraphics,
paint: PaintGraphics,
tipTable: tipTable]]];
END.
..
ButtonNewChoice: PUBLIC PROC [
viewer: Viewer, oldAtom, newAtom: REF ANY, newDoc: ROPE]
~ {
instanceSpec: PopUpButtons.InstanceSpec ¬ PopUpButtons.GetInstanceSpec[viewer];
spec: PopUpButtons.ClassSpec ¬ PopUpButtons.GetSpec[instanceSpec.class];
FOR c: PopUpButtons.ChoiceList ¬ spec.choices, c.rest WHILE c # NIL DO
IF c.first.key = oldAtom THEN {c.first.key ¬ newAtom; c.first.doc ¬ newDoc; EXIT};
ENDLOOP;
PopUpButtons.AmbushClass[instanceSpec.class, spec];
};
Extrema: BiScrollers.ExtremaProc ~ {
g: GraphicsData ¬ NARROW[clientData];
[min,max] ¬ Geom2D.ExtremaOfRect[[0, 0, g.viewer.cw, g.viewer.ch], direction];
};
graphicsBiScrollerClass: BiScrollers.BiScrollerClass ¬ BiScrollers.GetStyle[].NewBiScrollerClass[[
flavor: $GraphicsBiScroller,
extrema: Extrema,
notify: NotifyGraphics,
paint: PaintGraphics,
tipTable: tipTable,
mayStretch: FALSE,
offsetsMustBeIntegers: TRUE,
preferIntegerCoefficients: FALSE,
preserve: [X: 0.0, Y: 0.0]
]];