<> <> <> DIRECTORY Buttons, CedarProcess, Commander, Controls, EditedStream, FileNames, Imager, ImagerOps, IO, ProcessProps, Rope, TiogaExtraOps, TiogaOps, TIPUser, TypeScript, VFonts, ViewerClasses, ViewerIO, ViewerOps, ViewerSpecs, ViewerTools; ControlsOuterImpl: CEDAR MONITOR IMPORTS Buttons, CedarProcess, Controls, EditedStream, FileNames, Imager, ImagerOps, IO, ProcessProps, Rope, TiogaExtraOps, TiogaOps, TIPUser, TypeScript, VFonts, ViewerIO, ViewerOps, ViewerSpecs, ViewerTools EXPORTS Controls ~ BEGIN OPEN Controls; <> maxNRows: INTEGER ~ 10; capHeight: INTEGER ~ 14; <> AvailableHeight: PROC [column: ViewerClasses.Column] RETURNS [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]; RETURN[ViewerSpecs.openTopY-ViewerSpecs.openBottomY-nViewers*ViewerSpecs.captionHeight]; }; PaintOuter: ViewerClasses.PaintProc ~ { Action: PROC ~ { IF whatChanged = NIL THEN { 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 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]; }; }; ImagerOps.DoWithBuffer[context, Action, 0, 0, self.ww, self.wh]; }; AdjustProc: ViewerClasses.AdjustProc ~ { AdjustOuter[NARROW[self.data], self.ww, self.wh]; }; AdjustOuter: PROC [outerData: OuterData, w, h: INTEGER] ~ { outerData.outerH _ h; outerData.graphicsH _ h-capHeight-outerData.controlsH-outerData.buttonsH-outerData.tsH; SetYs[outerData]; IF outerData.graphics # NIL THEN ViewerOps.EstablishViewerPosition[ outerData.graphics, 0, outerData.graphicsY, w, outerData.graphicsH]; IF outerData.typeScript # NIL THEN ViewerOps.EstablishViewerPosition[ outerData.typeScript, 0, outerData.tsY+1, w, outerData.tsH-2]; IF outerData.buttons # NIL THEN FOR b: ButtonList _ outerData.buttons, b.rest WHILE b # NIL DO ViewerOps.EstablishViewerPosition[ b.first.viewer, b.first.x, outerData.buttonsY+b.first.y, b.first.w, b.first.h]; ENDLOOP; }; 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, outerData.graphics, c.first, 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 _ defSizes, graphicsHeight: INTEGER _ 0, graphicsProc: GraphicsProc _ NIL, graphicsShow: GraphicsShow _ NIL, destroyProc: DestroyProc _ NIL, typeScriptHeight: INTEGER _ 0, data: REF ANY _ NIL, noOpen: BOOL _ FALSE] RETURNS [viewer: Viewer] ~ { outerData: OuterData _ OuterDataInit[ NIL, column, buttons, controls, controlSizes, graphicsHeight, graphicsProc, graphicsShow, destroyProc, typeScriptHeight, data]; viewer _ ViewerOps.CreateViewer[ flavor: $Outer, paint: FALSE, info: [ name: name, data: outerData, openHeight: MIN[AvailableHeight[column], outerData.outerH], scrollable: FALSE, column: column, iconic: TRUE] ]; outerData.parent _ viewer; SetYs[outerData]; IF outerData.tsH # 0 THEN { arg: ROPE ~ "0 pt restIndent"; ts: Viewer _ TypeScript.Create[[parent: viewer, wh: typeScriptHeight, border: FALSE]]; outerData.typeScript _ ts; TiogaExtraOps.PutProp[TiogaOps.LastWithin[TiogaOps.ViewerDoc[ts]], $Postfix, arg]; [outerData.tSin, outerData.tSout] _ ViewerIO.CreateViewerStreams[NIL, ts]; }; IF graphicsHeight # 0 THEN { outerData.graphics _ GraphicsViewer[outerData.parent, outerData.controlsH, graphicsHeight, graphicsProc, graphicsShow, outerData.data]; outerData.graphicsData _ NARROW[outerData.graphics.data]; }; FOR b: ButtonList _ outerData.buttons, b.rest WHILE b # NIL DO b.first.viewer _ ButtonViewer[outerData.parent, b.first, outerData]; IF 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[outerData.parent, outerData.graphics, c.first, 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 _ defSizes, graphicsHeight: INTEGER _ 0, graphicsProc: GraphicsProc _ NIL, graphicsShow: GraphicsShow _ NIL, destroyProc: DestroyProc _ NIL, typeScriptHeight: INTEGER _ 0, data: REF ANY _ NIL] RETURNS [OuterData] ~ { IF outerData = NIL THEN outerData _ NEW[OuterDataRep]; outerData.controls _ CopyControlList[controls]; outerData.buttons _ buttons; outerData.data _ 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 _ ButtonsPosition[buttons]; 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[self.data, 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[NARROW[gGraphicsInput.rest.first], NARROW[gGraphicsInput.first]]; }; WatchGraphics: CedarProcess.ForkableProc ~ { DO g: GraphicsData _ GetGraphicsInput[]; IF g.proc # NIL THEN g.proc[g]; ENDLOOP; }; PaintGraphics: ViewerClasses.PaintProc ~ { d: GraphicsData _ NARROW[self.data]; IF d # NIL AND d.show # NIL THEN d.show[context, d.viewer.ww, d.viewer.wh, d.data, whatChanged, d.viewer]; }; GraphicsViewer: PUBLIC PROC [ parent: Viewer, y, h: INTEGER _ 0, proc: GraphicsProc, show: GraphicsShow, data: REF ANY] RETURNS [viewer: Viewer] ~ { graphicsData: GraphicsData _ NEW[GraphicsDataRep _ [ proc: proc, show: show, data: data, parent: parent]]; 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; }; <> ButtonReLabel: PUBLIC PROC [outerData: OuterData, oldName, newName: ROPE] ~ { FOR b: ButtonList _ outerData.buttons, b.rest WHILE b # NIL DO IF 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 Rope.Equal[b.first.viewer.name, name] THEN Buttons.SetDisplayStyle[b.first.viewer, style]; ENDLOOP; }; NilProc: ClickProc ~ {}; ButtonViewer: PUBLIC PROC [parent: Viewer, button: Button, outerData: OuterData] RETURNS [Viewer] ~ { <> RETURN[Buttons.Create[ info: [ parent: parent, name: button.name, border: button.proc # NIL, wx: button.x, wy: button.y], proc: IF button.proc = NIL THEN NilProc ELSE button.proc, clientData: outerData, fork: button.fork, font: button.font, documentation: button.documentation, guarded: button.guarded, paint: button.paint ]]; }; ButtonsPosition: PROC [buttons: ButtonList] 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: Imager.Font _ VFonts.DefaultFont[b.first.font]; IF b.first.w = 0 THEN b.first.w _ VFonts.StringWidth[b.first.name, font]+8; IF b.first.h = 0 THEN b.first.h _ VFonts.FontHeight[font]+3; 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 < 600 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 b.first.y _ buttonRows[b.first.row].y; ENDLOOP; IF buttons = NIL THEN buttonHeight _ 0; }; <> TypeScriptClear: PUBLIC PROC [outerData: OuterData] ~ { IF outerData.tSout = NIL OR outerData.tSclear THEN RETURN; IO.PutRope[outerData.tSout, "\n"]; outerData.tSclear _ TRUE; }; TypeScriptWrite: PUBLIC PROC [outerData: OuterData, rope: ROPE] ~ { IF outerData.tSout = NIL THEN RETURN; IO.PutRope[outerData.tSout, rope ! IO.Error => CONTINUE]; IO.Flush[outerData.tSout ! IO.Error => CONTINUE]; outerData.tSclear _ FALSE; }; TypeScriptRead: PUBLIC PROC [outerData: OuterData, prompt: ROPE _ NIL] RETURNS [ROPE] ~ { rope: ROPE _ NIL; IF outerData.tSin = NIL THEN RETURN[NIL]; IF outerData.tSout # NIL AND prompt # NIL THEN TypeScriptWrite[outerData, prompt]; ViewerTools.SetSelection[outerData.typeScript]; rope _ IO.GetLineRope[outerData.tSin ! EditedStream.Rubout => CONTINUE]; RETURN[rope]; }; TypeScriptReadFileName: PUBLIC PROC [outerData: OuterData] RETURNS [ROPE] ~ { reply: ROPE; TypeScriptWrite[outerData, "\nFilename: "]; reply _ TypeScriptRead[outerData]; IF reply = NIL THEN { TypeScriptWrite[outerData, ". . . aborted.\n"]; RETURN[NIL]; }; RETURN[IF Rope.Find[reply, "/"] # -1 THEN reply ELSE Rope.Concat[outerData.directory, reply]]; }; <> Quit: PUBLIC ClickProc ~ {EndViewer[NARROW[parent, Viewer].parent]}; EndViewer: PUBLIC PROC [viewer: REF ANY] ~ { ViewerOps.DestroyViewer[NARROW[viewer]]; }; DestroyOuter: ViewerClasses.DestroyProc ~ { outerData: OuterData _ NARROW[self.data]; outerData.destroyed _ TRUE; IF outerData.destroyProc # NIL THEN outerData.destroyProc[outerData]; }; 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; }; <> [] _ 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: TIPUser.InstantiateNewTIPTable["Controls.TIP"]]]]; END.