<<>> <> <> <> 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 <> 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; <> maxNRows: INTEGER ~ 10; capHeight: INTEGER ~ 14; <> ControlError: PUBLIC ERROR [reason: ROPE] = CODE; <> 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 ~ { <> 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; <> 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; }; <> 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], < [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[NARROW[viewer.data]]; }; PaintGraphics: ViewerClasses.PaintProc ~ { v: Viewer; d: GraphicsData; <> <> <> <> <<}>> <> 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]]; <> <> <> <> <> <> <> <> <> <> <> <> <> <<];>> <> <<}>> -- 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]; }; <> 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: 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]; <> }; ButtonDummyProc: ClickProc ~ {}; -- otherwise Buttons.ButtonPusher dies ButtonViewer: PUBLIC PROC [parent: Viewer, button: Button] RETURNS [viewer: Viewer] ~ { <> 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]; }; < {>> <> <> <> <> <> <> <> <> <> <> <> <<[parent: parent, name: button.name, border: button.popUpProc # NIL, wx: button.x, wy: button.y],>> <> <<};>> 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; }; <> 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]; <> 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"]; }; <> 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; }; <> 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] ]];