ControlsOuterImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Bloomenthal, February 24, 1987 5:36:40 pm PST
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;
Constants
maxNRows:   INTEGER ~ 10;
capHeight:   INTEGER ~ 14;
Outer Procedures
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;
};
Graphics Procedures
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;
};
Button Procedures
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] ~ {
If button.proc is NIL, then treat button as a non-bordered label.
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;
};
TypeScript Procedures
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]];
};
Miscellaneous Procedures
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;
};
Start Code
[] ← 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.