<<>> <> <> <> DIRECTORY CedarProcess, ChoiceButtons, Draw2d, G2dBasic, Imager, IO, List, Menus, Rope, TIPUser, Vector2, ViewerClasses; Controls: CEDAR DEFINITIONS IMPORTS Imager ~ BEGIN <> ROPE: TYPE ~ IO.ROPE; STREAM: TYPE ~ IO.STREAM; VEC: TYPE ~ Imager.VEC; Process: TYPE ~ CedarProcess.Process; DrawProc: TYPE ~ Draw2d.DrawProc; Triple: TYPE ~ G2dBasic.Triple; Context: TYPE ~ Imager.Context; Color: TYPE ~ Imager.Color; Font: TYPE ~ Imager.Font; Column: TYPE ~ ViewerClasses.Column; Viewer: TYPE ~ ViewerClasses.Viewer; -- buttons, controls, graphics IconFlavor: TYPE ~ ViewerClasses.IconFlavor; IntegerPair: TYPE ~ G2dBasic.IntegerPair; IntegerPairSequence: TYPE ~ G2dBasic.IntegerPairSequence; IntegerPairSequenceRep: TYPE ~ G2dBasic.IntegerPairSequenceRep; IntegerSequence: TYPE ~ G2dBasic.IntegerSequence; IntegerSequenceRep: TYPE ~ G2dBasic.IntegerSequenceRep; RealSequence: TYPE ~ G2dBasic.RealSequence; RealSequenceRep: TYPE ~ G2dBasic.RealSequenceRep; <> RopeSequence: TYPE ~ REF RopeSequenceRep; RopeSequenceRep: TYPE ~ RECORD [ length: CARDINAL ¬ 0, element: SEQUENCE maxLength: CARDINAL OF ROPE ]; IntegerPairSequences: TYPE ~ REF IntegerPairSequencesRep; IntegerPairSequencesRep: TYPE ~ RECORD [ length: CARDINAL ¬ 0, element: SEQUENCE maxLength: CARDINAL OF IntegerPairSequence ]; MouseButton: TYPE ~ {none, left, middle, right}; -- which mouse button MouseState: TYPE ~ {none, down, held, up}; -- state of pressed button Mouse: TYPE ~ RECORD [ -- mouse information pos: IntegerPair ¬ [], -- screen coordinates state: MouseState ¬ none, -- up, down or held button: MouseButton ¬ none, -- left, middle or right controlKey: BOOL ¬ FALSE, -- if control key held shiftKey: BOOL ¬ FALSE -- if shift key held ]; MouseProc: TYPE ~ PROC [mouse: Mouse, viewer: Viewer, clientData: REF ANY]; << Called if graphics viewer mouse action>> <> Control: TYPE ~ REF ControlRep; <> <<>> ControlRep: TYPE ~ RECORD [ -- complete control information <> name: ROPE ¬ NIL, -- name of control type: ControlType ¬ vSlider, -- slider, dial, functioner, contourer proc: ControlProc ¬ NIL, -- proc to call if control adjusted process: Process ¬ NIL, -- fork new process if old not busy report: BOOL ¬ TRUE, -- if true, report control value precision: NAT ¬ 3, -- number decimal places for value row: INTEGER ¬ 0, -- row of control (0 is lowest) x, y, w, h: INTEGER ¬ 0, -- control sizes (usu. automatic set) textLocation: TextLocation ¬ [up, left], -- where to place text font: Font ¬ NIL, -- font type (default is Tioga10) dummy: BOOL ¬ FALSE, -- if true, don't paint this control queue: BOOL ¬ FALSE, -- if true, queue mous events clientUse: ATOM ¬ NIL, -- for client use indication clientData: REF ANY ¬ NIL, -- client supplied data <> min, max, init: REAL ¬ 0.0, -- range and inital value of control detents: DetentList ¬ NIL, -- for sliders or dials grainSize: REAL ¬ 0.02, -- grain size for detents color: Color, -- control color (border and slider) taper: SliderTaper ¬ lin, -- for sliders value: REAL ¬ 0.0, -- (readonly) slider or dial value valuePrev: REAL ¬ 0.0, -- (readonly) previous slider value values: RealSequence ¬ NIL, -- function values <> sliderDialRef: REF ANY ¬ NIL, -- (private) details in impl functionRef: REF ANY ¬ NIL, -- (private) details in impl contourRef: REF ANY ¬ NIL, -- (private) details in impl sketchRef: REF ANY ¬ NIL, -- (private) details in impl <> procDone: CONDITION, -- for notification of proc done mouse: Mouse ¬ [], -- (readonly) mouse in control outerData: OuterData ¬ NIL, -- (readonly) parent viewer data viewer: Viewer ¬ NIL, -- (readonly) control viewer whatChanged: ATOM ¬ NIL, -- can be $Moused, $TypedIn, etc. flavor: ATOM ¬ NIL, -- (readonly) permit some wizardry title: Viewer ¬ NIL, -- (private) viewer to display name status: Viewer ¬ NIL, -- (private) viewer to display value parent: Viewer ¬ NIL -- (private) outer viewer ]; ControlList: TYPE ~ LIST OF Control; ControlProc: TYPE ~ PROC [control: Control, clientData: REF ANY]; <> <> ControlType: TYPE ~ { vSlider, -- vertical slider; bar is horizontal hSlider, -- horizontal slider; bar is vertical dial, -- circular dial function, -- rectangular viewer for function contour, -- rectangular viewer for contour sketch -- rectangular viewer for sketch }; ControlSizes: TYPE ~ RECORD [ wVSlider: INTEGER ¬ 25, -- width of vertical slider wHSlider: INTEGER ¬ 200, -- width of horizontal control hVSlider: INTEGER ¬ 60, -- height of vertical slider hHSlider: INTEGER ¬ 25, -- height of horizontal slider dDial: INTEGER ¬ 60, -- diameter of dial wSketch: INTEGER ¬ 150, -- width of sketcher hSketch: INTEGER ¬ 150 -- height of sketcher ]; Detent: TYPE ~ RECORD [ -- detent positions within a control value: REAL, -- for client use t: REAL ¬ 0.5 -- private ]; DetentList: TYPE ~ LIST OF Detent; TextLocation: TYPE ~ RECORD [ place: {up, down, left, right, inside}, -- which edge? edge: {up, down, left, right, center}, -- where along edge? side: BOOL ¬ FALSE -- title, status: side by side? ]; SliderTaper: TYPE ~ {log, lin, exp}; -- logarithmic, linear, or exponential <> ControlError: ERROR [reason: ROPE]; <> <> <<>> Typescript: TYPE ~ REF TypescriptRep; TypescriptRep: TYPE ~ RECORD [ viewer: Viewer ¬ NIL, -- typescript viewer in: STREAM ¬ NIL, -- input typescript stream out: STREAM ¬ NIL, -- output typescript stream clear: BOOL ¬ TRUE]; -- typescript display clear? OuterData: TYPE ~ REF OuterDataRep; OuterDataRep: TYPE ~ RECORD [ -- complete outer data name: ROPE ¬ NIL, -- name of viewer column: Column ¬ left, -- column of viewer clientData: REF ANY ¬ NIL, -- client supplied data parent: Viewer ¬ NIL, -- (private) main outer viewer typescript: Typescript ¬ NIL, -- (private) typescript viewer, streams graphics: Viewer ¬ NIL, -- (private) graphics viewer graphicsData: GraphicsData ¬ NIL, -- (private) graphics viewer data controls: ControlList ¬ NIL, -- controls for parent viewer controlSizes: ControlSizes, -- default sizes for controls lastControl: Control ¬ NIL, -- (readonly) last control moused buttons: ButtonList ¬ NIL, -- buttons for outer viewer destroyProc: DestroyProc ¬ NIL, -- call if outer viewer destroyed destroyed: BOOL ¬ FALSE, -- (readonly) if viewer destroyed directory: ROPE ¬ NIL, -- (readonly) commander directory cmdOut: STREAM ¬ NIL, -- (readonly) commander output controlsY: INTEGER ¬ 0, -- (private) base of controls controlsH: INTEGER ¬ 0, -- (private) height of controls graphicsY: INTEGER ¬ 0, -- (private) base of graphics graphicsH: INTEGER ¬ 0, -- (private) graphics viewer height tsY: INTEGER ¬ 0, -- (private) base of typescript tsH: INTEGER ¬ 0, -- (private) typescript height buttonsY: INTEGER ¬ 0, -- (private) base of buttons buttonsH: INTEGER ¬ 0, -- (private) height of buttons outerH: INTEGER ¬ 0 -- (private) height of outer viewer ]; DestroyProc: TYPE ~ PROC [viewer: Viewer, reason: ATOM, clientData: REF ANY]; <> OuterViewer: 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]; << Create a top level viewer whose data field is of type OuterData. The viewer may contain an arbitrary number of controls and buttons, a single typescript, and a single graphics viewer. The buttons are placed at the top of the viewer. Below the buttons is the optional, scrollable typescript (usually a height of 18 is good for one line); the software may print or prompt to the typescript, and the user may type a reply. Below the typescript is an optional sub-viewer for display of graphical material. The controls are placed below the graphics viewer. If noOpen then the viewer will not be opened (iconic or otherwise), permitting a program to manipulate the viewer (for example, installing an icon from a file) before displaying it.>> <<>> ChangeOuterViewer: PROC [outerData: OuterData, controls: ControlList]; <> <> <> <<>> GraphicsData: TYPE ~ REF GraphicsDataRep; <> <<>> GraphicsDataRep: TYPE ~ RECORD [ -- complete graphics viewer specs mouseProc: MouseProc ¬ NIL, -- called if graphics mouse action drawProc: DrawProc ¬ NIL, -- proc called to display graphics clientData: REF ANY ¬ NIL, -- client supplied data mouse: Mouse, -- (readonly) graphics viewer mouse viewer: Viewer ¬ NIL, -- (private) graphics viewer parent: Viewer ¬ NIL -- (private) parent viewer ]; GraphicsViewer: PROC [ parent: Viewer, y, h: INTEGER ¬ 0, mouseProc: MouseProc, drawProc: DrawProc, biScrollable: BOOL ¬ FALSE, clientData: REF ANY] RETURNS [Viewer]; <> <> NewControl: PROC [ name: ROPE ¬ NIL, -- control label type: ControlType ¬ vSlider, -- vSlider, hSlider, dial, function, contour, sketch clientData: REF ANY ¬ NIL, -- client data min: REAL ¬ 0.0, -- lower bounds of control max: REAL ¬ 1.0, -- upper bounds of control init: REAL ¬ 0.5, -- initial control setting proc: ControlProc ¬ NIL, -- client callback whenever control is adjusted report: BOOL ¬ TRUE, -- display numeric value of control precision: NAT ¬ 3, -- number of decimal places for control value row: INTEGER ¬ 0, -- see below x, y: INTEGER ¬ 0, -- position wrt parent viewer (y is control bottom) w, h: INTEGER ¬ 0 , -- dimension of control textLocation: TextLocation ¬ [up, left], -- position of control name and value labels dummy: BOOL ¬ FALSE, -- iff dummy, invisible and inactive detents: DetentList ¬ NIL, -- see Detent, above taper: SliderTaper ¬ lin, -- log, lin, or exp control taper queue: BOOL ¬ FALSE, values: RealSequence ¬ NIL, -- intial values if control is of type function color: Color ¬ Imager.black, -- color of control font: Font ¬ NIL, -- if other than default font (Tioga10) clientUse: ATOM ¬ $None, -- for subsequent client reference flavor: ATOM ¬ $Nil] -- wizards only RETURNS [Control]; << Return a control but do not allocate its viewer; viewer allocation is done by ControlViewer.>> << The controls are normally ordered by OuterViewer, from right to left, beginning new rows as needed; if row is non-zero, however, the control will appear in the specified row and all subsequent controls will follow it; 0 is the lowest row. If y is non-zero, however, the control will appear at the specified y value, regardless of the value of row.>> << If there are any detents, the taper is constrained to be linear.>> << If queue, then queue all down, up, and most recent held mouse events; otherewise, discard mouse events that occur during control.proc.>> << control.proc is called on mouse event within the control, or whenever a value is typed into the text display of the control, followed by a carriage-return. Clients should read the value of the control before executing a function, to ensure consistency with values shown in the text display that may have been typed by the user without a carriage-return.>> <<>> Append: PROC [control: Control, controls: ControlList ¬ NIL] RETURNS [ControlList]; <> <<>> ControlViewer: PROC [ parent: Viewer, control: Control, graphics: Viewer ¬ NIL, outerData: OuterData ¬ NIL]; <> <> <> <<>> SetControlColor: PROC [control: Control, color: Color]; <> <> NotifyControl: PUBLIC ViewerClasses.NotifyProc; <> <<>> SetMouse: PUBLIC PROC [atom: ATOM, position: IntegerPair] RETURNS [Mouse]; <> <<>> LastControlMoused: PUBLIC PROC RETURNS [Control]; <> <<>> SetLastControlMoused: PUBLIC PROC [control: Control]; <> <<>> CalledFromQueue: PROC [control: Control] RETURNS [BOOL]; <> <> SetDetentGrainSize: PROC [control: Control, grainSize: REAL]; <> <<>> GetDetentGrainSize: PROC [control: Control] RETURNS [REAL]; <> <> ControlPositions: PROC [controls: ControlList, sizes: ControlSizes, columnWidth: INTEGER] RETURNS [height: INTEGER]; <> <<>> ControlRow: PROC [control: Control, row: INTEGER]; <> <<0 is the lowest row.>> <> GetClientDataFromControlViewer: PROC [viewer: Viewer] RETURNS [REF ANY]; <> <<>> GetSliderDialValue: PROC [control: Control] RETURNS [REAL]; <> <<>> GetSliderDialDeltaValue: PROC [control: Control] RETURNS [REAL]; <> <<>> GetFunctionValues: PROC [control: Control] RETURNS [RealSequence]; <> <<>> GetSketch: PROC [control: Control] RETURNS [IntegerPairSequences]; <> <<>> GetContour: PROC [control: Control] RETURNS [IntegerPairSequence]; <> <> Reset: PROC [c1, c2, c3, c4, c5, c6: Control ¬ NIL, repaint: BOOL ¬ TRUE]; <> <<>> SetSliderDialValue: PROC [control: Control, value: REAL, repaint: BOOL ¬ TRUE]; <> <<>> SetFunctionValues: PROC [control: Control, values: RealSequence, repaint: BOOL ¬ TRUE]; <> <<>> SetSketch: PROC [control: Control, sketch: IntegerPairSequences, repaint: BOOL ¬ TRUE]; <> <<>> SetContour: PROC [ control: Control, pairs: IntegerPairSequence, closed: BOOL ¬ FALSE, repaint: BOOL ¬ TRUE]; <> <<>> CloseContour: PUBLIC PROC [control: Control, repaint: BOOL ¬ TRUE]; <> <> WaitControlProcDone: PROC [control: Control]; <> <<>> FindControl: PROC [outerData: OuterData, controlName: ROPE] RETURNS [Control]; <> <> <> <<>> ClickProc: TYPE ~ ViewerClasses.ClickProc; -- if click button pressed PromptProc: TYPE ~ ChoiceButtons.SelectionNotifierProc; -- if prompt button pressed Request: TYPE ~ RECORD [ choice: ROPE ¬ NIL, -- name of button choice doc: ROPE ¬ NIL -- associated documentation ]; Choice: TYPE ~ RECORD [state: ROPE, true: BOOL, privateId: NAT ¬ 0]; ButtonType: TYPE ~ {click, text --, popUp --}; ButtonList: TYPE ~ LIST OF Button; Button: TYPE ~ REF ButtonRep; ButtonRep: TYPE ~ RECORD [ -- specifications for a menu button <> type: ButtonType ¬ click, -- type of button name: ROPE ¬ NIL, -- name of button row: INTEGER ¬ 0, -- vert. pos'n of button (0 is lowest) x, y, w, h: INTEGER ¬ 0, -- dimensions (usu. defaulted) fork: BOOL ¬ TRUE, -- if true, fork proc on button guarded: BOOL ¬ FALSE, -- require double click iff true documentation: ROPE ¬ NIL, -- message window if button guarded font: Font ¬ NIL, -- font type (usu. defaulted) viewer: Viewer ¬ NIL, -- (private) viewer for this button clientData: REF ANY ¬ NIL, -- client supplied data <> clickProc: ClickProc ¬ NIL, -- to call upon click button press style: ATOM ¬ $BlackOnWhite, -- as in Buttons.mesa <> text: ROPE ¬ NIL, -- default text to be displayed textProc: ClickProc, -- as in ChoiceButtons.mesa textViewer: Viewer ¬ NIL -- (private) viewer for associated text <> <> <> <> <> ]; ClickButton: 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]; <> <<>> TextButton: 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 [Button]; <> <> <<>> PopUpRequest: PROC [header: Request, requests: LIST OF Request] RETURNS [INT]; <> <<1 is returned for first choice, 2 for second, etc; 0 if selected outside menu; -1 if timed out.>> <<>> BoolRequest: PROC [value: BOOL, title: ROPE] RETURNS [Request]; <> <<>> IntRequest: PROC [title, doc: ROPE, value: NAT] RETURNS [Request]; <> <<>> RealRequest: PROC [title, doc: ROPE, value: REAL] RETURNS [Request]; <> <<>> RopeRequest: PROC [title, doc, value: ROPE] RETURNS [req: Request]; <> MultiRequest: PROC [header: ROPE, choices: LIST OF Choice] RETURNS [INT]; <> <<>> GetPopUpButton: PROC RETURNS [MouseButton]; <> <> <<>> GetTextButtonText: PROC [outerData: OuterData, name: ROPE] RETURNS [ROPE]; <> <<>> GetTextButtonValue: PROC [outerData: OuterData, name: ROPE] RETURNS [REAL]; <> <<>> GetTextButtonsTexts: PROC [outerData: OuterData, name: ROPE] RETURNS [RopeSequence]; <> GetTextButtonsValues: PROC [outerData: OuterData, name: ROPE] RETURNS [RealSequence]; <> ButtonRelabel: PROC [outerData: OuterData, oldName, newName: ROPE]; <> <> <<>> ButtonToggle: PROC [outerData: OuterData, state: BOOL, trueName, falseName: ROPE]; <> <> <<>> ButtonStyle: PROC [outerData: OuterData, name: ROPE, style: ATOM]; <> <<$BlackOnWhite - black letters on white background (default)>> <<$WhiteOnBlack - white letters on black background>> <<$BlackOnGrey - black letters on grey background>> <<>> ButtonFind: PROC [outerData: OuterData, name: ROPE] RETURNS [Button]; <> <<>> ButtonViewer: PROC [parent: Viewer, button: Button] RETURNS [Viewer]; <> <> <> <<>> TSValue: TYPE ~ RECORD [name: ROPE ¬ NIL, value: REAL ¬ 0.0]; TypescriptClear: PROC [ts: Typescript]; <> <<>> TypescriptWrite: PROC [ts: Typescript, rope: ROPE]; <> <<>> TypescriptRead: PROC [ts: Typescript, prompt: ROPE ¬ NIL] RETURNS [ROPE]; <> <<>> TypescriptReadFileName: PROC [ts: Typescript] RETURNS [ROPE]; <> <<>> TypescriptReadValue: PROC [ts: Typescript, name: ROPE, currentValue: REAL] RETURNS [newValue: REAL]; <> < (now ): .>> <> <> TypescriptReadValues: PROC [ ts: Typescript, prompt: ROPE ¬ NIL, tsValues: LIST OF TSValue] RETURNS [RealSequence]; <> < (now ): .>> <> <> <<>> GetReal: PROC [ts: Typescript, prompt: ROPE, in: REAL] RETURNS [newValue: REAL]; <> GetNat: PROC [ts: Typescript, prompt: ROPE, in: NAT] RETURNS [NAT]; <> GetIntegerPair: PROC [ts: Typescript, prompt: ROPE, in: IntegerPair] RETURNS [IntegerPair]; <> GetTriple: PROC [ts: Typescript, prompt: ROPE, in: Triple] RETURNS [out: Triple]; <> <> Vernier: PROC [vernier, control: Control, cwIncrease: BOOL ¬ TRUE, resolution: REAL ¬ 10.0]; <> <> <> <> <> IsContourClosed: PROC [control: Control] RETURNS [BOOL]; <> <> <<>> NPointsInContour: PROC [control: Control] RETURNS [INTEGER]; <> <> <<>> NPointsInSketch: PROC [control: Control] RETURNS [INTEGER]; <> <> <<>> NLinesInSketch: PROC [control: Control] RETURNS [INTEGER]; <> <> <> Quit: ClickProc; <> <<>> Restore: ClickProc; <> END. .. ChoiceList: TYPE ~ PopUpButtons.ChoiceList; -- popUp choices Help: TYPE ~ PopUpButtons.Help; PopUpButtonProc: TYPE ~ PopUpButtons.PopUpButtonProc; -- if popUp button pressed PopUpButton: PROC [ name: ROPE, proc: PopUpButtonProc, 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]; <> <<>> ButtonNewChoice: PROC [viewer: Viewer, oldAtom, newAtom: REF ANY, newDoc: ROPE]; <> <> <> <<>>