<<>> <> <> <> <> DIRECTORY Buttons, CedarProcess, Controls, ControlsPrivate, Convert, Imager, Labels, MessageWindow, Rope, TiogaOps, TIPLinking, TIPUser, Vector2, VFonts, ViewerClasses, ViewerOps, ViewerTools; ControlsImpl: CEDAR MONITOR IMPORTS Buttons, CedarProcess, Controls, ControlsPrivate, Convert, Imager, Labels, MessageWindow, Rope, TiogaOps, TIPLinking, TIPUser, VFonts, ViewerOps, ViewerTools EXPORTS Controls, ControlsPrivate ~ BEGIN <> Button: TYPE ~ Controls.Button; Control: TYPE ~ Controls.Control; ControlList: TYPE ~ Controls.ControlList; ControlProc: TYPE ~ Controls.ControlProc; ControlRep: TYPE ~ Controls.ControlRep; ControlSizes: TYPE ~ Controls.ControlSizes; ControlType: TYPE ~ Controls.ControlType; Detent: TYPE ~ Controls.Detent; DetentList: TYPE ~ Controls.DetentList; IntegerPair: TYPE ~ Controls.IntegerPair; Mouse: TYPE ~ Controls.Mouse; OuterData: TYPE ~ Controls.OuterData; RealSequence: TYPE ~ Controls.RealSequence; SliderTaper: TYPE ~ Controls.SliderTaper; TextLocation: TYPE ~ Controls.TextLocation; RopeFromValueProc: TYPE ~ ControlsPrivate.RopeFromValueProc; SetValueFromRopeProc: TYPE ~ ControlsPrivate.SetValueFromRopeProc; Color: TYPE ~ Imager.Color; Font: TYPE ~ Imager.Font; ROPE: TYPE ~ Rope.ROPE; Viewer: TYPE ~ ViewerClasses.Viewer; <> NewControl: PUBLIC PROC [ name: ROPE ¬ NIL, type: ControlType ¬ vSlider, clientData: REF ANY ¬ NIL, min: REAL ¬ 0.0, max: REAL ¬ 1.0, init: REAL ¬ 0.5, proc: ControlProc ¬ NIL, report: BOOL ¬ TRUE, precision: NAT ¬ 0, row: INTEGER ¬ 0, x, y: INTEGER ¬ 0, w, h: INTEGER ¬ 0, textLocation: TextLocation ¬ [up, left], dummy: BOOL ¬ FALSE, detents: DetentList ¬ NIL, taper: SliderTaper ¬ lin, queue: BOOL ¬ FALSE, values: RealSequence ¬ NIL, color: Color ¬ Imager.black, font: Font ¬ NIL, clientUse: ATOM ¬ $None, flavor: ATOM ¬ $Nil] RETURNS [c: Control] ~ { c ¬ NEW[ControlRep]; IF type = dial THEN w ¬ h ¬ MIN[w, h]; c.name ¬ name; c.type ¬ type; c.proc ¬ proc; c.report ¬ report; c.precision ¬ precision; c.row ¬ row; c.x ¬ x; c.y ¬ y; c.w ¬ w; c.h ¬ h; c.textLocation ¬ textLocation; c.dummy ¬ dummy; c.flavor ¬ flavor; c.clientData ¬ clientData; c.min ¬ min; c.max ¬ max; c.init ¬ init; c.value ¬ init; c.values ¬ values; c.detents ¬ detents; c.taper ¬ taper; c.queue ¬ queue; c.color ¬ color; c.font ¬ font; c.clientUse ¬ clientUse; IF type = function AND w # 0 THEN ControlsPrivate.NewFunction[c]; }; Append: PUBLIC PROC [control: Control, controls: ControlList ¬ NIL] RETURNS [ControlList] ~ { tail: ControlList ¬ controls; List: TYPE ~ RECORD[first: Control, rest: REF List ¬ NIL]; IF tail = NIL THEN RETURN[LIST[control]]; WHILE tail.rest # NIL DO tail ¬ tail.rest; ENDLOOP; tail.rest ¬ LIST[control]; RETURN[controls]; }; ControlViewer: PUBLIC PROC [ parent: Viewer, control: Control, graphics: Viewer ¬ NIL, outerData: OuterData ¬ NIL] ~ { IF control = NIL THEN RETURN; IF NOT control.dummy THEN { viewer: Viewer; control.parent ¬ parent; <> control.outerData ¬ outerData; viewer ¬ ViewerOps.CreateViewer[ flavor: IF control.flavor # $Nil THEN control.flavor ELSE SELECT control.type FROM function => $ControlsFunction, contour => $ControlsContour, sketch => $ControlsSketch ENDCASE => $ControlsSliderDial, paint: TRUE, info: [ data: control, name: control.name, wx: control.x, wy: control.y, ww: control.w, wh: control.h, border: SELECT control.type FROM dial, vSlider, hSlider => FALSE, ENDCASE => TRUE, scrollable: FALSE, parent: parent]]; control.viewer ¬ viewer; ViewerOps.AddProp[viewer, $CreatedInOuterViewer, $True]; SELECT control.type FROM function, contour, sketch => ClearControl[control]; ENDCASE; IF NOT Rope.IsEmpty[control.name] THEN TitleControl[control]; IF control.report AND control.type # contour AND control.type # sketch THEN StatusControl[control]; }; SELECT control.type FROM vSlider, hSlider, dial => ControlsPrivate.NewSliderDial[control]; contour => ControlsPrivate.NewContour[control]; function => ControlsPrivate.NewFunction[control]; sketch => ControlsPrivate.NewSketch[control]; ENDCASE => NULL; }; SetControlColor: PUBLIC PROC [control: Control, color: Color] ~ { control.color ¬ color; }; <> statusWidth: INTEGER ~ 32; lineHeight: INTEGER ~ 8; lineMargin: INTEGER ~ 4; edgeMargin: INTEGER ~ 15; wordMargin: INTEGER ~ 10; functionMargin: INTEGER ~ 10; dialMargin: INTEGER ~ 12; sliderMargin: INTEGER ~ 17; ControlPositions: PUBLIC PROC [ controls: ControlList, sizes: ControlSizes, columnWidth: INTEGER] RETURNS [height: INTEGER] ~ { x, y: INTEGER ¬ edgeMargin; titleWidth, row, rowHeight, width: INTEGER ¬ 0; FOR cc: ControlList ¬ controls, cc.rest WHILE cc # NIL AND cc.first # NIL DO c: Control ¬ cc.first; controlMargin: INTEGER ¬ SELECT c.type FROM dial => dialMargin, function => functionMargin, ENDCASE => sliderMargin; IF c = NIL THEN LOOP; c.font ¬ VFonts.DefaultFont[c.font]; titleWidth ¬ VFonts.StringWidth[c.name, c.font]; SetControlSize[c, sizes]; SELECT c.row FROM 0, row => NULL; row+1 => {x ¬ edgeMargin; y ¬ y+rowHeight; row ¬ c.row; rowHeight ¬ 0}; ENDCASE => { x ¬ edgeMargin; y ¬ edgeMargin+row*rowHeight; row ¬ c.row; rowHeight ¬ 0}; width ¬ SELECT c.type FROM vSlider, hSlider, dial => MAX[titleWidth, statusWidth], ENDCASE => titleWidth+statusWidth+wordMargin; width ¬ SELECT c.textLocation.place FROM up, down => MAX[c.w+controlMargin, width], ENDCASE => c.w+controlMargin+width+wordMargin; IF c.x # 0 OR c.y # 0 THEN {x ¬ c.x; y ¬ c.y} -- pre-specified control location ELSE { -- computed control location IF x+width > columnWidth THEN {x ¬ edgeMargin; y ¬ y+rowHeight; row ¬ row+1; rowHeight ¬ 0}; SELECT c.textLocation.place FROM down => { c.x ¬ x; c.y ¬ SELECT c.type FROM function, contour => y+2*lineMargin+lineHeight, ENDCASE => y+3*lineMargin+2*lineHeight; }; left => { c.x ¬ x+wordMargin+(IF c.textLocation.side THEN titleWidth+statusWidth ELSE MAX[titleWidth, statusWidth]); c.y ¬ y; }; ENDCASE => {c.x ¬ x; c.y ¬ y}; }; height ¬ ControlHeight[c]; IF height > rowHeight THEN rowHeight ¬ height; c.row ¬ row; x ¬ x+width; ENDLOOP; height ¬ 0; FOR c: ControlList ¬ controls, c.rest WHILE c # NIL AND c.first # NIL DO temp: INTEGER ¬ ControlBaseY[c.first]+ControlHeight[c.first]; height ¬ MAX[height, temp]; ENDLOOP; }; ControlRow: PUBLIC PROC [control: Control, row: INTEGER] ~ { IF control # NIL THEN control.row ¬ row; }; ControlBaseY: PROC [control: Control] RETURNS [INTEGER] ~ { RETURN[IF control.textLocation.place = down THEN SELECT control.type FROM function, contour => control.y-2*lineMargin-lineHeight, ENDCASE => control.y-3*lineMargin-2*lineHeight ELSE control.y]; }; ControlHeight: PROC [control: Control] RETURNS [height: INTEGER] ~ { height ¬ sliderMargin+control.h; IF control.textLocation.place = up OR control.textLocation.place = down THEN { IF control.report THEN height ¬ height+lineMargin+lineHeight; IF NOT Rope.IsEmpty[control.name] THEN SELECT control.type FROM vSlider, hSlider, dial => IF control.textLocation.place = up THEN height ¬ height+lineMargin+lineHeight ELSE height ¬ height+2*lineMargin+lineHeight; ENDCASE; }; }; <> clearWidth: NAT ¬ 37; ClearControl: PROC [control: Control] ~ { SELECT control.textLocation.place FROM up, down => { x: INTEGER ¬ control.x+control.w-clearWidth; y: INTEGER ¬ IF control.textLocation.place = up THEN control.y+control.h+lineMargin ELSE control.y-2*lineMargin; v: Viewer ¬ Buttons.Create[ [parent: control.parent, name: "Clear", wx: x, wy: y], Clear, control,,,, TRUE]; ViewerOps.AddProp[v, $Control, control]; ViewerOps.AddProp[v, $CreatedInOuterViewer, $True]; }; ENDCASE; }; Clear: Buttons.ButtonProc ~ { c: Control ¬ NARROW[clientData]; SELECT c.type FROM function => ControlsPrivate.ResetFunction[c]; contour => ControlsPrivate.ClearContour[c]; sketch => ControlsPrivate.ClearSketch[c]; ENDCASE; }; TitleControl: PROC [control: Control] ~ { titleWidth: INTEGER ¬ VFonts.StringWidth[control.name, control.font]+10; x: INTEGER ¬ SELECT control.textLocation.place FROM up, down => SELECT control.textLocation.edge FROM center => MAX[control.x-3, (control.w-titleWidth)/2], right => control.x+control.w-titleWidth, ENDCASE -- left -- => control.x-3, left => SELECT control.type FROM vSlider, hSlider, dial => control.x-MAX[titleWidth, statusWidth]-wordMargin, ENDCASE => control.x-titleWidth-(IF control.report THEN statusWidth+wordMargin ELSE 0), inside => MAX[control.x-3, (control.w-titleWidth)/2], ENDCASE -- right -- => control.x+control.w+wordMargin; y: INTEGER ¬ SELECT control.textLocation.place FROM up => SELECT control.type FROM vSlider, hSlider, dial => control.y+control.h+2*lineMargin+lineHeight, ENDCASE => control.y+control.h+lineMargin, down => control.y-2*lineMargin-lineHeight, ENDCASE => SELECT control.textLocation.edge FROM center => control.y+control.h/2, up => control.y+control.h, ENDCASE -- down -- => control.y+lineHeight+2; IF control.textLocation.side THEN { titleWidth ¬ titleWidth-4; x ¬ control.x-statusWidth-titleWidth-8; y ¬ control.y-2; }; control.title ¬ LabelViewer[parent: control.parent, x: x, y: y, w: titleWidth, font: control.font]; ViewerOps.AddProp[control.title, $CreatedInOuterViewer, $True]; ViewerTools.SetContents[control.title, control.name]; }; StatusControl: PROC [control: Control] ~ { contents: ROPE; titleWidth: INTEGER ¬ VFonts.StringWidth[control.name, control.font]+10; x: INTEGER ¬ SELECT control.textLocation.place FROM up, down => SELECT control.type FROM vSlider, hSlider, dial => SELECT control.textLocation.edge FROM center => MAX[control.x-3, (control.w-titleWidth)/2], right => control.x+control.w-titleWidth, ENDCASE -- left -- => control.x, ENDCASE => control.x+titleWidth+wordMargin, left => control.x-MAX[titleWidth, statusWidth]-wordMargin+4, ENDCASE => SELECT control.type FROM vSlider, hSlider, dial => control.x+control.w+wordMargin, ENDCASE => control.x+control.w+2*wordMargin+titleWidth; y: INTEGER ¬ SELECT control.textLocation.place FROM up => control.y+control.h+lineMargin, down => control.y-2*lineMargin, ENDCASE => SELECT control.textLocation.edge FROM center => control.y+control.h/2, up => control.y+control.h, ENDCASE -- down -- => control.y; bigWidth: INTEGER ¬ statusWidth+5; IF control.textLocation.edge = left AND (control.textLocation.place = up OR control.textLocation.place = down) THEN bigWidth ¬ SELECT control.type FROM vSlider, hSlider, dial => MAX[control.w, bigWidth], ENDCASE => MAX[control.w-titleWidth-wordMargin-clearWidth, bigWidth]; IF control.textLocation.side THEN { x ¬ control.x-statusWidth-5; y ¬ control.y; }; control.status ¬ TextViewer[control, control.parent, x, y, bigWidth]; IF control.status = NIL THEN RETURN; ViewerOps.AddProp[control.status, $CreatedInOuterViewer, $True]; contents ¬ Convert.FtoRope[control.value, control.precision]; IF control.flavor # $ControlsContour AND control.flavor # $ControlsSketch THEN { ViewerOps.AddProp[control.status, $RopeFromControlValueProc, control.contourRef]; ViewerOps.AddProp[control.status, $SetControlValueFromRopeProc, control.sketchRef]; WITH control.contourRef SELECT FROM refProc: REF ControlsPrivate.RopeFromValueProc => contents ¬ refProc­[control].valueRope; ENDCASE; }; ViewerTools.SetContents[control.status, contents]; SELECT control.type FROM vSlider, hSlider, dial => ActivateViewer[control.status]; ENDCASE; }; Blink: PROC [message: ROPE] ~ { MessageWindow.Append[message, TRUE]; MessageWindow.Blink[]; }; LabelViewer: PROC [parent: Viewer, x, y, w: INTEGER, font: Font] RETURNS [v: Viewer] ~ { IF parent # NIL THEN v ¬ Labels.Create[ [parent: parent, wx: x, wy: y, ww: w, wh: 13, scrollable: FALSE, border: FALSE], font]; }; TextViewer: PROC [control: Control, parent: Viewer, x, y, w: INTEGER] RETURNS [v: Viewer] ~ { SELECT control.type FROM vSlider, hSlider, dial => IF parent # NIL THEN { v ¬ ViewerTools.MakeNewTextViewer[ [parent: parent, wx: x, wy: y, ww: w, wh: 13, scrollable: FALSE, border: FALSE]]; ViewerOps.AddProp[v, $Control, control]; }; ENDCASE => RETURN[LabelViewer[parent, x, y, w, control.font]]; }; SetControlSize: PROC [control: Control, controlSizes: ControlSizes] ~ { IF control.w = 0 THEN control.w ¬ SELECT control.type FROM hSlider => controlSizes.wHSlider, vSlider => controlSizes.wVSlider, function, contour, sketch => controlSizes.wSketch, dial => controlSizes.dDial, ENDCASE => controlSizes.dDial; IF control.h = 0 THEN control.h ¬ SELECT control.type FROM hSlider => controlSizes.hHSlider, vSlider => controlSizes.hVSlider, function, contour, sketch => controlSizes.hSketch, dial => controlSizes.dDial, ENDCASE => controlSizes.dDial; }; <> controlsActivateLinked: BOOL ¬ FALSE; controlsActivateTip: TIPUser.TIPTable ¬ TIPUser.InstantiateNewTIPTable["ControlsActivate.tip"]; ActivateViewer: PUBLIC PROC [viewer: Viewer] = { IF NOT controlsActivateLinked THEN { <> <> <> [] ¬ TIPLinking.Append[controlsActivateTip, viewer.tipTable]; controlsActivateLinked ¬ TRUE; }; viewer.tipTable ¬ controlsActivateTip; }; RegisterRopeFromValueProc: PUBLIC PROC [control: Control, proc: RopeFromValueProc] ~ { refProc: REF RopeFromValueProc ~ NEW[RopeFromValueProc ¬ proc]; IF control.status = NIL THEN RETURN; ViewerOps.AddProp[control.status, $RopeFromControlValueProc, refProc]; }; <<>> RegisterValueFromRopeProc: PUBLIC PROC [control: Control, proc: SetValueFromRopeProc] ~ { refProc: REF SetValueFromRopeProc ~ NEW[SetValueFromRopeProc ¬ proc]; IF control.status = NIL THEN RETURN; ViewerOps.AddProp[control.status, $SetControlValueFromRopeProc, refProc]; }; <<>> ActivateControl: PROC [viewer: Viewer, whatChanged: ATOM] RETURNS [ok: BOOL ¬ TRUE] ~ { refAny: REF ANY ¬ ViewerOps.FetchProp[viewer, $Control]; <> IF refAny # NIL THEN { control: Control ¬ NARROW[refAny]; text: ROPE ~ ViewerTools.GetContents[viewer: viewer]; refAnyToo: REF ANY ¬ ViewerOps.FetchProp[viewer, $SetControlValueFromRopeProc]; IF text # NIL THEN { WITH refAnyToo SELECT FROM refProc: REF ControlsPrivate.SetValueFromRopeProc => refProc­[control, text ! Convert.Error => {ok ¬ FALSE; CONTINUE}]; ENDCASE => Controls.SetSliderDialValue[control, Convert.RealFromRope[text ! Convert.Error => {ok ¬ FALSE; CONTINUE}]]; }; IF NOT ok THEN Blink[Rope.Concat["Bad value: ", text]] ELSE IF NOT ControlProcBusy[control] THEN { control.whatChanged ¬ whatChanged; ForkControlProc[control]; }; } ELSE IF (refAny ¬ ViewerOps.FetchProp[viewer, $ButtonText]) = NIL THEN ok ¬ FALSE ELSE [] ¬ CedarProcess.Fork[ForkTextButtonProc, refAny]; }; <> <> <> <> <> <> <> <> <> <> <> <> <<};>> <<>> ForkTextButtonProc: CedarProcess.ForkableProc ~ { b: Button ¬ NARROW[data]; IF b.textProc # NIL THEN b.textProc[b.textViewer, b.clientData, blue]; }; <> <> <> <<};>> <<>> Activator: TiogaOps.CommandProc ~ { RETURN[ActivateControl[viewer, $TypedIn], TRUE]; }; <> NotifyControl: PUBLIC ViewerClasses.NotifyProc ~ { c: Control ¬ NARROW[self.data]; IF c.queue OR c.proc = NIL OR CedarProcess.GetStatus[c.process] # busy THEN { m: Mouse ¬ c.mouse; IF input # NIL THEN WITH input.first SELECT FROM tipCoords: TIPUser.TIPScreenCoords => m ¬ SetMouse[NARROW[input.rest.first], [tipCoords.mouseX, tipCoords.mouseY]]; ENDCASE; IF c.outerData # NIL THEN c.outerData.lastControl ¬ c; IF c.mouse.state = up THEN lastControlMoused ¬ c; SELECT c.type FROM vSlider, hSlider, dial => ControlsPrivate.NotifySliderDial[c, m]; function => ControlsPrivate.NotifyFunction[c, m]; contour => ControlsPrivate.NotifyContour[c, m]; sketch => ControlsPrivate.NotifySketch[c, m]; ENDCASE; }; }; SetMouse: PUBLIC PROC [atom: ATOM, position: IntegerPair] RETURNS [mouse: Mouse] ~ { <> mouse ¬ SELECT atom FROM $upLeftShiftControl => [position, up, left, TRUE, TRUE], $upLeftShift => [position, up, left, FALSE, TRUE], $upLeftControl => [position, up, left, TRUE, FALSE], $upLeft => [position, up, left, FALSE, FALSE], $upMiddleShiftControl => [position, up, middle, TRUE, TRUE], $upMiddleShift => [position, up, middle, FALSE, TRUE], $upMiddleControl => [position, up, middle, TRUE, FALSE], $upMiddle => [position, up, middle, FALSE, FALSE], $upRightShiftControl => [position, up, right, TRUE, TRUE], $upRightShift => [position, up, right, FALSE, TRUE], $upRightControl => [position, up, right, TRUE, FALSE], $upRight => [position, up, right, FALSE, FALSE], $downLeftShiftControl => [position, down, left, TRUE, TRUE], $downLeftShift => [position, down, left, FALSE, TRUE], $downLeftControl => [position, down, left, TRUE, FALSE], $downLeft => [position, down, left, FALSE, FALSE], $downMiddleShiftControl => [position, down, middle, TRUE, TRUE], $downMiddleShift => [position, down, middle, FALSE, TRUE], $downMiddleControl => [position, down, middle, TRUE, FALSE], $downMiddle => [position, down, middle, FALSE, FALSE], $downRightShiftControl => [position, down, right, TRUE, TRUE], $downRightShift => [position, down, right, FALSE, TRUE], $downRightControl => [position, down, right, TRUE, FALSE], $downRight => [position, down, right, FALSE, FALSE], <> <<$downLeftDoubleShiftControl => [position, down, left, TRUE, TRUE, TRUE],>> <<$downLeftDoubleShift => [position, down, left, TRUE, FALSE, TRUE],>> <<$downLeftDoubleControl => [position, down, left, TRUE, TRUE, FALSE],>> <<$downLeftDouble => [position, down, left, TRUE, FALSE, FALSE],>> <<$downMiddleDoubleShiftControl => [position, down, middle, TRUE, TRUE, TRUE],>> <<$downMiddleDoubleShift => [position, down, middle, TRUE, FALSE, TRUE],>> <<$downMiddleDoubleControl => [position, down, middle, TRUE, TRUE, FALSE],>> <<$downMiddleDouble => [position, down, middle, TRUE, FALSE, FALSE],>> <<$downRightDoubleShiftControl => [position, down, right, TRUE, TRUE, TRUE],>> <<$downRightDoubleShift => [position, down, right, TRUE, FALSE, TRUE],>> <<$downRightDoubleControl => [position, down, right, TRUE, TRUE, FALSE],>> <<$downRightDouble => [position, down, right, TRUE, FALSE, FALSE],>> $heldLeftShiftControl => [position, held, left, TRUE, TRUE], $heldLeftShift => [position, held, left, FALSE, TRUE], $heldLeftControl => [position, held, left, TRUE, FALSE], $heldLeft => [position, held, left, FALSE, FALSE], $heldMiddleShiftControl => [position, held, middle, TRUE, TRUE], $heldMiddleShift => [position, held, middle, FALSE, TRUE], $heldMiddleControl => [position, held, middle, TRUE, FALSE], $heldMiddle => [position, held, middle, FALSE, FALSE], $heldRightShiftControl => [position, held, right, TRUE, TRUE], $heldRightShift => [position, held, right, FALSE, TRUE], $heldRightControl => [position, held, right, TRUE, FALSE], $heldRight => [position, held, right, FALSE, FALSE], ENDCASE => [position, held, left, FALSE, FALSE]; }; lastControlMoused: Control ¬ NIL; LastControlMoused: PUBLIC PROC RETURNS [Control] ~ {RETURN[lastControlMoused]}; SetLastControlMoused: PUBLIC PROC [control: Control] ~ {lastControlMoused ¬ control}; NotifyControlProcDone: ENTRY PROC [control: Control] ~ {NOTIFY control.procDone}; ControlProcForker: CedarProcess.ForkableProc ~ { c: Control ¬ NARROW[data]; c.proc[c, c.clientData]; NotifyControlProcDone[c]; }; MaybeForkControlProc: PUBLIC PROC [control: Control] ~ { IF control.proc # NIL AND NOT ControlProcBusy[control] THEN ForkControlProc[control]; }; ForkControlProc: PUBLIC PROC [control: Control] ~ { IF control.proc # NIL THEN control.process ¬ CedarProcess.Fork[ControlProcForker, control]; }; ControlProcBusy: PUBLIC PROC [control: Control] RETURNS [BOOL] ~ { RETURN[control.process # NIL AND CedarProcess.GetStatus[control.process] = busy]; }; <> GetClientDataFromControlViewer: PUBLIC PROC [viewer: Viewer] RETURNS [REF ANY] ~ { WITH viewer.data SELECT FROM control: Control => RETURN[control.clientData]; ENDCASE => RETURN[NIL]; }; <> Reset: PUBLIC PROC [c1, c2, c3, c4, c5, c6: Control ¬ NIL, repaint: BOOL ¬ TRUE] ~ { InnerReset: PROC [control: Control] ~ { IF control # NIL THEN SELECT control.type FROM vSlider, hSlider, dial => Controls.SetSliderDialValue[control, control.init, repaint]; function => ControlsPrivate.ResetFunction[control, repaint]; contour => ControlsPrivate.ClearContour[control, repaint]; sketch => ControlsPrivate.ClearSketch[control, repaint]; ENDCASE => NULL; }; InnerReset[c1]; InnerReset[c2]; InnerReset[c3]; InnerReset[c4]; InnerReset[c5]; InnerReset[c6]; }; <> WaitControlProcDone: PUBLIC ENTRY PROC [control: Control] ~ { WAIT control.procDone; }; FindControl: PUBLIC PROC [outerData: OuterData, controlName: ROPE] RETURNS [c: Control] ~ { FOR l: LIST OF Control ¬ outerData.controls, l.rest WHILE l # NIL DO IF Rope.Equal[l.first.name, controlName, FALSE] THEN RETURN[l.first]; ENDLOOP; }; <> Vernier: PUBLIC PROC [ vernier, control: Control, cwIncrease: BOOL ¬ TRUE, resolution: REAL ¬ 10.0] ~ { range, percent0, percent1, delta, newValue: REAL; IF vernier = NIL OR control = NIL OR vernier = control THEN RETURN; SELECT control.type FROM vSlider, hSlider, dial => NULL; ENDCASE => RETURN; IF vernier.min = vernier.max THEN {vernier.min ¬ 0.0; vernier.max ¬ 1.0}; range ¬ vernier.max-vernier.min; percent0 ¬ (vernier.valuePrev-vernier.min)/range; percent1 ¬ (vernier.value-vernier.min)/range; delta ¬ percent1-percent0; IF percent0 > 0.75 AND percent1 < 0.25 THEN delta ¬ delta+1.0; IF percent0 < 0.25 AND percent1 > 0.75 THEN delta ¬ delta-1.0; IF resolution # 0.0 THEN newValue ¬ IF cwIncrease THEN control.value+(control.max-control.min)*(delta/resolution) ELSE control.value-(control.max-control.min)*(delta/resolution); IF control.type # dial THEN newValue ¬ MIN[control.max, MAX[control.min, newValue]]; Controls.SetSliderDialValue[control, newValue]; }; <> tipTable: TIPUser.TIPTable ¬ TIPUser.InstantiateNewTIPTable["Controls.tip"]; <<[] _ CedarProcess.Fork[WatchControl];>> ViewerOps.RegisterViewerClass[$ControlsSliderDial, NEW[ViewerClasses.ViewerClassRec ¬ [ notify: NotifyControl, paint: ControlsPrivate.PaintSliderDial, tipTable: tipTable]]]; ViewerOps.RegisterViewerClass[$ControlsFunction, NEW[ViewerClasses.ViewerClassRec ¬ [ notify: NotifyControl, paint: ControlsPrivate.PaintFunction, tipTable: tipTable]]]; ViewerOps.RegisterViewerClass[$ControlsContour, NEW[ViewerClasses.ViewerClassRec ¬ [ notify: NotifyControl, paint: ControlsPrivate.PaintContour, tipTable: tipTable]]]; ViewerOps.RegisterViewerClass[$ControlsSketch, NEW[ViewerClasses.ViewerClassRec ¬ [ notify: NotifyControl, paint: ControlsPrivate.PaintSketch, tipTable: tipTable]]]; TiogaOps.RegisterCommand[$ControlsActivate, Activator, TRUE]; << We eliminate KillInputFocus so that ActivateControl is called ONLY if the user types a value followed by a CR into a control or text button. This is as advertised in Controls. Otherwise serious problems with the input focus can result; e.g., suppose the control proc called by ActivateControl changes the input focus, causing an endless propagation of KillInputFocus? One solution is to save the input focusand disable KillInputFocus restoring them when the control proc is done, but this would prevent the user from explicitly changing the input focus.>> <<[] _ ViewerEvents.RegisterEventProc[KillInputFocus, killInputFocus,, FALSE];>> END. .. <> <> <> <> <> <<>> <> <> <<};>> <<>> <> <> <> <> <> <<};>> <<>> <> <<-- IF NOT newControlInputBoolean THEN -- WAIT newControlInputCondition;>> <> <> <> <> <> <> <> <<};>> <<};>> <<>> <> <> <> <> <> <> <<};>> <> < ControlsPrivate.NotifySliderDial[control];>> < ControlsPrivate.NotifySliderDial[control];>> < ControlsPrivate.NotifySliderDial[control];>> < ControlsPrivate.NotifyFunction[control];>> < ControlsPrivate.NotifyContour[control];>> < ControlsPrivate.NotifySketch[control];>> < NULL;>> <> <<};>>