CDPanelImpl.mesa (part of ChipNDale)
Copyright © 1983, 1987 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, August 8, 1983 5:20 pm
Last Edited by: Christian Jacobi, March 18, 1987 12:37:04 pm PST
DIRECTORY
Buttons,
CD,
CDCellsBackdoor,
CDEnvironment,
CDEvents,
CDLayers,
CDOps,
CDPanel,
CDPrivate,
CDProperties,
CDSequencer,
CDValue,
CDViewer,
Containers,
Labels,
Menus,
PopUpSelection,
Rope,
TerminalIO,
UserProfile,
ViewerEvents,
ViewerClasses,
ViewerOps,
ViewerTools;
CDPanelImpl: CEDAR MONITOR
IMPORTS Buttons, CD, CDCellsBackdoor, CDEnvironment, CDEvents, CDLayers, CDOps, CDPrivate, CDProperties, CDSequencer, CDValue, CDViewer, Containers, Labels, PopUpSelection, Rope, TerminalIO, UserProfile, ViewerEvents, ViewerOps, ViewerTools
EXPORTS CDPanel
SHARES CDLayers, CDPrivate =
BEGIN
Terminology in procedure names
Build: build entry [instance] into a viewer
Define: define [register] behaviour for class
PutUp: reset picture on screen from CDValue
Called: proc is called by interactive action
ROPE: TYPE = Rope.ROPE;
Viewer: TYPE = ViewerClasses.Viewer;
Info: TYPE = CDPanel.Info;
LayerPanelRec: TYPE = RECORD [
container: Viewer ← NIL,
nextX: CARDINAL ← 0
];
layerOptionsCount: NAT = 3;
Panel: TYPE = REF PanelRec; -- defines the control panel; one per design
PanelRec: TYPE = RECORD [
container: Viewer ← NIL,
layerOption: NAT ← 0,
layers: ARRAY [0..layerOptionsCount) OF LayerPanelRec,
design: CD.Design,
class: Class ← NIL,
nextX: CARDINAL ← 0,
nextY: CARDINAL ← 0,
nexTopX: CARDINAL ← 0,
layerLabel: Labels.Label ← NIL,
layerWidths: LIST OF Actual ← NIL,
actuals: LIST OF Actual ← NIL
];
PanelList: TYPE = LIST OF Panel;
EntryClass: TYPE = REF EntryClassRec; --class of entry in viewer
EntryClassRec: TYPE = RECORD [
build: BuildProc,
toDisplay: ToDisplayProc ← NIL,
fromdisplay: FromDisplayProc ← NIL, --if defaulted uses cdvalue
classData: REF ← NIL
];
BuildProc: TYPE = PROC [panel: Panel, entry: EntryDef]; --builds an entry into a viewer
ToDisplayProc: TYPE = PROC [actual: Actual, value: REF];
FromDisplayProc: TYPE = PROC [actual: Actual] RETURNS [value: REF←NIL];
EntryDef: TYPE = REF EntryDefRec; --defines an entry
EntryDefRec: TYPE = RECORD [
entryClass: EntryClass,
button, val: Info,  --only val's cdValueKey is looked at ever
min, max, default, lambda: INT ← 1,
layer: CD.Layer ← CD.undefLayer, option: NAT ← 0,
topLine, editable: BOOL ← FALSE,
proc: CDSequencer.CommandProc ← NIL,
command: ATOM ← NIL,
queue: CDSequencer.QueueMethod ← useDefault,
data: REF ← NIL
];
EntryList: TYPE = LIST OF EntryDef;
Class: TYPE = REF EntryList; -- one per Technology
Actual: TYPE = REF ActualRec; --type used for clientData field of viewer stuff
ActualRec: TYPE = RECORD [
panel: Panel,
define: EntryDef,
feedback: Viewer ← NIL --might be a different viewer doing feedback for the caller
];
panelKey: REF ATOM ~ NEW[ATOM←$Panel]; -- used instead of atoms, to be really unique
classKey: REF ATOM ~ NEW[ATOM←$PanelClass];
globalClass: Class ~ NEW[EntryList←NIL];
panelList: PanelList ← NIL;
newLineClass: EntryClass ← RegisterEntryClass[[
build: BuildNewLine
]];
buttonClass: EntryClass ← RegisterEntryClass[[
build: BuildButton,
toDisplay: ToDisplayButton
]];
labelClass: EntryClass ← RegisterEntryClass[[
build: BuildLabel,
toDisplay: ToDisplayLabel
]];
textClass: EntryClass ← RegisterEntryClass[[
build: BuildText,
toDisplay: ToDisplayText,
fromdisplay: FromDisplayText
]];
layerClass: EntryClass ← RegisterEntryClass[[
build: BuildLayer
]];
intClass: EntryClass ← RegisterEntryClass[[
build: BuildInt,
toDisplay: ToDisplayNumber
]];
--Compensations
--the viewer package uses funny y positions; use this to compensate
butYCompensation: INTEGER ← 0;
labelYCompensation: INTEGER ← 1;
textYCompensation: INTEGER ← -2;
--the height sometimes are not enogh to reasonably display contents...
textHCompensation: INTEGER ← 2;
-- Viewer
topY: CARDINAL = 1;
entryHSpace: CARDINAL = 3;
entryHeight: CARDINAL = 12;
shorterEntryVSpace: CARDINAL = 1;
RegisterEntryClass: PROC [c: EntryClassRec] RETURNS [entryClass: EntryClass] = {
entryClass ←NEW[EntryClassRec𡤌]
};
GetPanel: PROC [design: CD.Design] RETURNS [Panel] = {
x: REF ← CDValue.Fetch[boundTo: design, key: panelKey, propagation: global];
IF x=NIL THEN {
panel: Panel = NEW[PanelRec←[
design: design,
class: GetClass[design.technology]
]];
[] ← CDValue.StoreConditional[design, panelKey, panel];
RETURN [GetPanel[design]]
};
RETURN [NARROW[x, Panel]];
};
GetClass: PROC [tech: CD.Technology] RETURNS [Class] = {
IF tech=NIL THEN RETURN [globalClass]
ELSE {
x: REF ← CDValue.Fetch[boundTo: tech, key: classKey, propagation: technology];
IF x=NIL THEN {
class: Class = NEW[EntryList←NIL];
IF CDValue.StoreConditional[tech, classKey, class] THEN
CDLayers.SetCurrentLayer[tech, CD.commentLayer];
RETURN [GetClass[tech]];
};
RETURN [NARROW[x, Class]];
}
};
Create: PUBLIC ENTRY PROC [design: CD.Design] RETURNS [Viewer] = {
ENABLE UNWIND => NULL;
panel: Panel ← GetPanel[design];
class: Class ← GetClass[design.technology];
IF panel.container#NIL AND NOT panel.container.destroyed THEN RETURN [panel.container];
panel.container ← NIL; panel.actuals ← NIL;
--supress creation of viewer if empty
IF class#NIL THEN CreatePanelViewer[panel];
CheckPanelList[panel];
IF panel.container#NIL THEN {
ViewerOps.PaintViewer[panel.container, all];
IF ~UserProfile.Boolean["ChipNDale.ControlViewerOpenIconic", FALSE] THEN
ViewerOps.OpenIcon[panel.container];
};
RETURN [panel.container]
};
CheckPanelList: INTERNAL PROC [p: Panel] = {
--Get rid of panels which are not used anymore
--No user visible action
copiedList: PanelList ← NIL;
FOR list: PanelList ← panelList, list.rest WHILE list#NIL DO
IF list.first.container#NIL AND ~list.first.container.destroyed AND list.first#p THEN
copiedList ← CONS[list.first, copiedList]
ENDLOOP;
IF p#NIL THEN copiedList ← CONS[p, copiedList];
panelList ← copiedList
};
BuildEntry: INTERNAL PROC[panel: Panel, entry: EntryDef] = {
IF panel.container.destroyed THEN RETURN;
entry.entryClass.build[panel, entry];
};
DefineEntry: INTERNAL PROC [tech: CD.Technology, entryRec: EntryDefRec] RETURNS [entry: EntryDef] = {
IncludeEntryInClass: INTERNAL PROC [class: Class, entry: EntryDef] = {
IF class^=NIL THEN class^ ← LIST[entry]
ELSE
FOR list: EntryList ← class^, list.rest DO
IF list.rest = NIL THEN {list.rest ← LIST[entry]; EXIT}
ENDLOOP;
};
CreateEntryInViewers: INTERNAL PROC [class: Class, entry: EntryDef] = {
FOR list: PanelList ← panelList, list.rest WHILE list#NIL DO
IF list.first.container#NIL AND ~list.first.container.destroyed THEN {
IF list.first.class=class OR class=globalClass THEN BuildEntry[list.first, entry];
}
ENDLOOP
};
class: Class = GetClass[tech];
entry ← NEW[EntryDefRec𡤎ntryRec];
entry.button.xpos ← MIN[2000, entry.button.xpos];
entry.button.width ← MIN[2000, entry.button.width];
entry.button.space ← MIN[2000, entry.button.space];
entry.val.xpos ← MIN[2000, entry.val.xpos];
entry.val.width ← MIN[2000, entry.val.width];
entry.val.space ← MIN[2000, entry.val.space];
IncludeEntryInClass[class, entry];
CreateEntryInViewers[class, entry];
};
-- Define's ===========================================================
Line: PUBLIC ENTRY PROC [tech: CD.Technology] = {
ENABLE UNWIND => NULL;
[] ← DefineEntry[tech, [entryClass: newLineClass]];
};
Button: PUBLIC ENTRY PROC [button: Info, proc: CDSequencer.CommandProc ← NIL, command: ATOM ← NIL, data: REF ← NIL, queue: CDSequencer.QueueMethod ← useDefault, topLine: BOOL ← FALSE, tech: CD.Technology ← NIL] = {
ENABLE UNWIND => NULL;
IF command=NIL AND queue=useDefault THEN queue ← doQueue;
[] ← DefineEntry[tech, [
entryClass: buttonClass,
button: button, val: button,
proc: proc, command: command,
queue: queue,
data: data,
topLine: topLine
]];
};
Label: PUBLIC ENTRY PROC [label: Info, tech: CD.Technology ← NIL] = {
ENABLE UNWIND => NULL;
[] ← DefineEntry[tech, [entryClass: labelClass, button: label, val: label]];
};
Layer: PUBLIC ENTRY PROC [layer: CD.Layer, text: Rope.ROPE, min, default: CD.Number ← 1, option: NAT ← 0, tech: CD.Technology ← NIL] = {
ENABLE UNWIND => NULL;
def: EntryDef ← DefineEntry[tech, [
entryClass: layerClass,
layer: layer, button: [text: text], min: min, default: default,
option: option MOD layerOptionsCount
]];
CDProperties.PutProp[CDPrivate.layers[layer].properties, GetClass[tech], def];
--we need to find names
CDLayers.SetLayerWidth[design: NIL --!!! it sets default--, layer: layer, width: default];
};
Number: PUBLIC ENTRY PROC [button: Info, number: Info, min: INT ← FIRST[INT], max: INT ← LAST[INT], default: INT ← 0, lambda: INT ← 1, tech: CD.Technology ← NIL] = {
ENABLE UNWIND => NULL;
CDValue.StoreInt[boundTo: tech, key: number.cdValueKey, value: default];
button.cdValueKey ← NIL;
number.text ← NIL;
IF number.width<=0 THEN number.width ← 72;
[] ← DefineEntry[tech, [
entryClass: intClass, button: button, val: number,
min: min, max: max, default: default, lambda: lambda
]];
};
Text: PUBLIC ENTRY PROC [button: Info, text: Info, editable: BOOL ← TRUE, tech: CD.Technology ← NIL] = {
ENABLE UNWIND => NULL;
button.cdValueKey ← NIL;
[] ← DefineEntry[tech, [entryClass: textClass, button: button, val: text, editable: editable]];
};
-- special treatment for layers ===========================================================
LayerName: PROC [panel: Panel, layer: CD.Layer] RETURNS [r: ROPE] = {
WITH CDProperties.GetListProp[CDPrivate.layers[layer].properties^, panel.class] SELECT FROM
entry: EntryDef => r ← entry.button.text;
ENDCASE => NULL;
IF Rope.IsEmpty[r] THEN {
r ← CDOps.LayerRope[layer];
IF Rope.IsEmpty[r] THEN r ← "not defined"
}
};
NotifyCurrentLayer: CDLayers.DesignNotifyProc = {
panel: Panel = GetPanel[design];
IF panel.layerLabel#NIL THEN {
l: CD.Layer ← CDLayers.CurrentLayer[design];
Labels.Set[panel.layerLabel, LayerName[panel, l]];
}
};
NotifyLayerWidth: CDLayers.LayerNotifyProc = {
panel: Panel = GetPanel[design];
IF panel.layerLabel#NIL THEN {
FOR list: LIST OF Actual ← panel.layerWidths, list.rest WHILE list#NIL DO
IF list.first.define.layer=layer THEN {
Labels.Set[list.first.feedback,
CDOps.LambdaRope[
n: CDLayers.LayerWidth[design, layer],
lambda: design.technology.lambda
]
];
EXIT; don't exit in case of multiple buttons...
};
ENDLOOP;
}
};
-- Viewer Stuff -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
Caption: PROC [panel: Panel] RETURNS [ROPE] = {
RETURN [Rope.Cat[
CD.DesignName[panel.design],
" ",
panel.design.technology.name,
" ",
CDCellsBackdoor.PushedCellName[panel.design]
]];
};
CreatePanelViewer: INTERNAL PROC [panel: Panel] = {
MakeClassEntries: INTERNAL PROC [class: Class] = {
--uses intermediate layer variables!
FOR l: EntryList ← class^, l.rest WHILE l#NIL DO
BuildEntry[panel, l.first];
ENDLOOP;
};
IF panel=NIL OR panel.design=NIL OR panel.design.technology=NIL THEN ERROR;
TerminalIO.PutRopes["create control panel for ", CD.DesignName[panel.design], "\n"];
panel.actuals ← NIL;
panel.layerWidths ← NIL;
panel.nextX ← 0;
panel.nextY ← topY;
panel.container ← Containers.Create[
info: [
name: Caption[panel],
openHeight: CDValue.FetchInt[panel.design, $PanelHeight, global, 120],
scrollable: TRUE,
iconic: TRUE, column: right, icon: CDEnvironment.GetPanelIcon[panel.design]
],
paint: FALSE
];
FOR i: NAT IN [0..layerOptionsCount) DO
panel.layers[i].nextX ← 0;
panel.layers[i].container ← Containers.Create[
info: [
wx: IF i=0 THEN 0 ELSE 1999,
wy: topY+entryHeight+entryHSpace+Containers.ScrollOffset[panel.container],
wh: entryHeight+shorterEntryVSpace+entryHeight+labelYCompensation,
parent: panel.container,
border: FALSE,
scrollable: FALSE
],
paint: FALSE
];
Containers.ChildXBound[container: panel.container, child: panel.layers[i].container];
ENDLOOP;
ViewerOps.AddProp[panel.container, $ChipNDaleDesign, panel.design];
ViewerOps.AddProp[panel.container, $CDPanelsPrivate, panel];
[] ← NextButton[panel: panel, label: "layer: ", proc: NotifyChangeLayerOption, clientData: panel];
panel.layerLabel ← NextLabel[panel: panel, name: LayerName[panel, CDLayers.CurrentLayer[panel.design]], width: 120];
panel.nextX ← 180;
[] ← NextLabel[panel, "| "];
panel.nexTopX ← panel.nextX;
panel.nextY ← 3*(entryHeight+entryHSpace);
panel.nextX ← 0;
MakeClassEntries[panel.class];
MakeClassEntries[globalClass];
};
NotifyChangeLayerOption: ENTRY Buttons.ButtonProc = {
ENABLE UNWIND => NULL;
panel: Panel ← NARROW[clientData];
this: NAT ← panel.layerOption;
next: NAT ← (this+1) MOD layerOptionsCount;
--special hack to make this outside accessible
IF control AND shift THEN
next ← CDValue.FetchInt[panel.design, $PanelLayerMode, global] MOD layerOptionsCount;
DO
IF next=this THEN RETURN;
IF panel.layers[next].nextX#0 THEN EXIT;
next ← (next+1) MOD layerOptionsCount;
ENDLOOP;
ViewerOps.MoveViewer[
viewer: panel.layers[this].container,
x: 1990, y: panel.layers[this].container.wy,
w: 0, h: panel.layers[this].container.wh,
paint: FALSE
];
panel.layerOption ← next;
ViewerOps.MoveViewer[
viewer: panel.layers[next].container,
x: 0, y: panel.layers[next].container.wy,
w: panel.container.ww, h: panel.layers[next].container.wh,
paint: TRUE
];
};
RepaintCaptions: CDEvents.EventProc = {
panel: Panel ← GetPanel[design];
IF panel.container#NIL THEN {
panel.container.name ← Caption[panel];
ViewerOps.PaintViewer[panel.container, caption];
};
};
NextIntButton: PROC [panel: Panel, label: ROPE, proc: Buttons.ButtonProc, border: BOOL ← FALSE, clientData: REF ANY ← NIL, width: INT ← -1, space: INT ← -1] = {
button: Buttons.Button = Buttons.Create[
info: [ name: label,
wx: panel.nextX,
ww: SmallDefault[width],
wy: panel.nextY+Containers.ScrollOffset[panel.container]+butYCompensation,
wh: entryHeight,
parent: panel.container,
border: border
],
clientData: clientData,
proc: proc
];
panel.nextX ← button.wx+button.ww+SpaceDefault[space];
};
NextButton: INTERNAL PROC [panel: Panel, label: ROPE, proc: Buttons.ButtonProc, clientData: REF ANY ← NIL, topLine: BOOL ← FALSE, border: BOOL ← FALSE, width: INT ← 0, space: INT𡤀] RETURNS [button: Buttons.Button] = {
yoff: INT = Containers.ScrollOffset[panel.container];
x: INT ← panel.nextX;
y: INT ← panel.nextY;
IF topLine THEN {x ← panel.nexTopX; y ← 0};
button ← Buttons.Create[
info: [ name: label,
wx: x,
ww: SmallDefault[width],
wy: y+yoff+butYCompensation,
wh: entryHeight,
parent: panel.container,
border: border
],
clientData: clientData,
proc: proc
];
IF topLine THEN panel.nexTopX ← button.wx+button.ww+SpaceDefault[space]
ELSE panel.nextX ← button.wx+button.ww+SpaceDefault[space]
};
NextLabel: PROC [panel: Panel, name: ROPE, border: BOOL ← FALSE, width: INT ← 0, space: INT ← 0] RETURNS [Labels.Label] = {
yoff: INT = Containers.ScrollOffset[panel.container];
label: Labels.Label;
IF name=NIL THEN name ← " ";
label ← Labels.Create[
info: [ name: name,
wx: panel.nextX,
ww: SmallDefault[width],
wy: panel.nextY+yoff+labelYCompensation,
wh: entryHeight,
parent: panel.container,
border: border
]
];
panel.nextX ← label.wx+label.ww+SpaceDefault[space];
RETURN [label]
};
BuildInt: BuildProc = {
initialValue: ROPE; width: INT;
actual: Actual ← NEW[ActualRec ← [panel: panel, define: entry]];
panel.nextX ← MAX[entry.button.xpos, panel.nextX];
width ← entry.button.width;
IF entry.button.maxx>0 THEN width ← entry.button.maxx-panel.nextX;
[] ← NextIntButton[panel: panel, label: entry.button.text, proc: IntCalled, clientData: actual, space: entry.button.space, width: width];
initialValue ← CDOps.LambdaRope[
n: CDValue.FetchInt[panel.design, entry.val.cdValueKey, technology, entry.default],
lambda: ActualLambda[actual]
];
panel.nextX ← MAX[entry.val.xpos, panel.nextX+8];
width ← entry.val.width;
IF entry.val.maxx>0 THEN width ← entry.val.maxx-panel.nextX;
actual.feedback ← NextLabel[panel: panel, name: initialValue, width: entry.val.width];
panel.actuals ← CONS[actual, panel.actuals];
};
ActualLambda: PROC [actual: Actual] RETURNS [lambda: INT] = {
lambda ← actual.define.lambda;
IF lambda<=0 THEN lambda ← actual.panel.design.technology.lambda
};
ToDisplayNumber: ToDisplayProc = {
n: INT;
lambda: INT ← ActualLambda[actual];
WITH value SELECT FROM
ri: REF INT => n ← ri^
ENDCASE => n ← actual.define.default;
Buttons.ReLabel[actual.feedback, CDOps.LambdaRope[n, lambda]];
};
BuildLabel: BuildProc = {
actual: Actual←NIL;
lab: Labels.Label;
width: INT ← entry.button.width;
panel.nextX ← MAX[entry.button.xpos, panel.nextX];
IF entry.button.maxx>0 THEN width ← entry.button.maxx-panel.nextX;
lab ← NextLabel[
panel: panel,
name: entry.button.text,
width: width,
space: entry.button.space,
border: entry.button.border
];
IF entry.val.cdValueKey#NIL THEN {
actual ← NEW[ActualRec ← [panel: panel,
define: entry,
feedback: lab
]];
panel.actuals ← CONS[actual, panel.actuals];
RedisplayVal[actual];
}
};
ToDisplayLabel: ToDisplayProc = {
Labels.Set[actual.feedback, CDOps.ToRope[value, "-?-"]];
};
FetchRopeWithList: PROC [from: REF, key: REF, start: ROPE←NIL] RETURNS [ROPE] = {
NextName: PROC [list: LIST OF ROPE, last: ROPE←NIL] RETURNS [next: ROPE ← NIL] = {
IF list=NIL THEN RETURN;
FOR l: LIST OF ROPE ← list, l.rest WHILE l#NIL DO
IF Rope.Equal[last, l.first, FALSE] THEN
RETURN [IF l.rest=NIL THEN list.first ELSE l.rest.first]
ENDLOOP;
RETURN [list.first]
};
WITH CDValue.Fetch[from, key, global] SELECT FROM
r: ROPE => RETURN [r];
rt: REF TEXT => RETURN [Rope.FromRefText[rt]];
lr: LIST OF ROPE => RETURN [NextName[lr, start]];
ENDCASE => RETURN [NIL];
};
TextButProc: Menus.ClickProc = {
--called from special buttons which have a Text as actual.feedback
actual: Actual ← NARROW[clientData];
selection: REF ViewerTools.SelPosRec ← NIL;
v: Viewer ← actual.feedback; --not the button; the text
SELECT TRUE FROM
mouseButton=blue => ViewerTools.SetContents[v, NIL];
ViewerTools.GetSelectedViewer[]=v => {--viewer previously selected; iterate through.
contents: ROPE ← FetchRopeWithList[actual.panel.design.technology, actual.define.val.cdValueKey, ViewerTools.GetContents[v]];
ViewerTools.SetContents[v, contents];
selection ← NEW[ViewerTools.SelPosRec ← [start: contents.Length[], length: 0]];
};
ENDCASE => NULL;
ViewerTools.SetSelection[v, selection];
--new contents is not stored to CDValue yet!! (It wont if edited either)
};
TextLabButProc: Menus.ClickProc = {
--called from special buttons which have a Label as actual.feedback
FetchSimpleRope: PROC [from: REF, key: REF] RETURNS [ROPE] = INLINE {
WITH CDValue.Fetch[from, key, global] SELECT FROM
r: ROPE => RETURN [r];
rt: REF TEXT => RETURN [Rope.FromRefText[rt]];
ENDCASE => RETURN [NIL];
};
contents, start: ROPE;
actual: Actual ← NARROW[clientData];
cdValueKey: REF ← actual.define.val.cdValueKey;
start ← FetchSimpleRope[actual.panel.design, cdValueKey];
contents ← FetchRopeWithList[actual.panel.design.technology, cdValueKey, start];
CDValue.Store[actual.panel.design, cdValueKey, contents];
Labels.Set[actual.feedback, contents];
};
SmallDefault: PROC [w: INT] RETURNS [INT] = {
--default width for buttons
RETURN [IF w<=0 THEN 0 ELSE MIN[2000, w]]
};
SpaceDefault: PROC [s: INT] RETURNS [INT] = {
--default spacing
RETURN [IF s<=0 THEN entryHSpace ELSE MIN[200, s]]
};
BuildText: BuildProc = {
v: Viewer; x, y: INT;
actual: Actual ← NEW[ActualRec ← [panel: panel, define: entry, feedback: NIL]];
width: INT;
height: INT ← entryHeight;
panel.nextX ← MAX[entry.button.xpos, panel.nextX];
y ← panel.nextY+Containers.ScrollOffset[panel.container];
x ← panel.nextX;
width ← SmallDefault[entry.button.width];
IF entry.button.maxx>0 THEN width ← entry.button.maxx-panel.nextX;
IF ~Rope.IsEmpty[entry.button.text] THEN {
button: Buttons.Button ← Buttons.Create[
info: [ name: entry.button.text,
wx: x, ww: width,
wy: y+butYCompensation, wh: height,
border: FALSE,
parent: panel.container
],
clientData: actual,
proc: IF entry.editable THEN TextButProc ELSE TextLabButProc
];
x ← button.wx+button.ww+SpaceDefault[entry.button.space];
};
x ← MAX[x, entry.val.xpos];
width ← IF entry.val.width<=0 THEN 2000 ELSE MIN[entry.val.width, 2000];
IF entry.val.maxx>0 THEN width ← entry.val.maxx-panel.nextX;
IF entry.editable THEN
v ← actual.feedback ← ViewerTools.MakeNewTextViewer[info: [
wx: x, wy: y+textYCompensation, ww: width, wh: height+textHCompensation,
parent: panel.container,
border: FALSE,
data: FetchRopeWithList[panel.design, entry.val.cdValueKey]
]]
ELSE
v ← actual.feedback ← Labels.Create[info: [
name: FetchRopeWithList[panel.design, entry.val.cdValueKey],
wx: x, ww: width,
wy: y+labelYCompensation, wh: height,
parent: panel.container,
border: FALSE
]];
panel.nextX ← v.wx+v.ww+SpaceDefault[entry.val.space];
IF entry.val.width<=0 AND entry.val.maxx<=0 THEN Containers.ChildXBound[panel.container, v];
panel.actuals ← CONS[actual, panel.actuals];
};
ToDisplayText: ToDisplayProc = {
entry: EntryDef ← actual.define;
design: CD.Design ← actual.panel.design;
rope: ROPE ← CDOps.ToRope[value, " "];
v: Viewer ← actual.feedback;
IF v.class.flavor=$Label THEN Labels.Set[v, rope]
ELSE ViewerTools.SetContents[v, rope];
};
FromDisplayText: FromDisplayProc = {
RETURN [ViewerTools.GetContents[NARROW[actual.feedback]]];
};
-- ================================================
RedisplayVal: PROC [actual: Actual] = {
IF actual.define.val.cdValueKey#NIL THEN
ToDisplay[actual, CDValue.Fetch[actual.panel.design, actual.define.val.cdValueKey, global]]
};
ToDisplay: PROC [actual: Actual, x: REF] = {
IF actual.define.entryClass.toDisplay#NIL THEN actual.define.entryClass.toDisplay[actual, x];
};
PutUpAll: PUBLIC PROC [design: CD.Design] = {
panel: Panel = GetPanel[design];
IF panel.container=NIL OR panel.container.destroyed THEN RETURN;
FOR list: LIST OF Actual ← panel.actuals, list.rest WHILE list#NIL DO
IF list.first.define.val.redisplay THEN RedisplayVal[list.first];
ENDLOOP;
};
BuildButton: INTERNAL PROC [panel: Panel, entry: EntryDef] = {
but: Buttons.Button;
width: INT ← SmallDefault[entry.button.width];
panel.nextX ← MAX[entry.button.xpos, panel.nextX];
IF entry.button.maxx>0 THEN width ← entry.button.maxx-panel.nextX;
but ← NextButton[
panel: panel,
label: entry.button.text,
proc: ButtonCalled,
border: entry.button.border,
topLine: entry.topLine,
width: width,
clientData: entry
];
IF entry.val.cdValueKey#NIL THEN {
actual: Actual ← NEW[ActualRec ← [panel: panel, define: entry, feedback: but]];
panel.actuals ← CONS[actual, panel.actuals];
RedisplayVal[actual];
}
};
ToDisplayButton: ToDisplayProc = {
Buttons.ReLabel[actual.feedback, CDOps.ToRope[value, "-?-"]];
};
ButtonCalled: Buttons.ButtonProc = {
butDef: EntryDef = NARROW[clientData];
comm: CDSequencer.Command = NEW[CDSequencer.CommandRec←[
data: butDef.data,
design: CDViewer.DesignOf[NARROW[parent]],
n: ORD[mouseButton],
b: shift OR control,
ref: $Panel
]];
IF butDef.proc#NIL THEN
CDSequencer.ExecuteProc[comm: comm, proc: butDef.proc, queue: butDef.queue]
ELSE IF butDef.command#NIL THEN
CDSequencer.ExecuteCommand[comm: comm, key: butDef.command, queue: butDef.queue];
};
GetAnInt: PROC [old, default: INT, label: ROPE, lambda: INT𡤁] RETURNS [new: INT] = {
ENABLE TerminalIO.UserAbort => GOTO aborted;
choice: LIST OF ROPE;
new ← old;
IF lambda=1 THEN
choice ← LIST["+1", "-1", "*2", "/2", "default", "type"]
ELSE
choice ← LIST["+1", "-1", "*2", "/2", "default", "type", Rope.Concat["type * ", CDOps.LambdaRope[1, lambda]], "trunc"];
SELECT PopUpSelection.Request[header: label, choice: choice] FROM
1 => new ← Inc[old, lambda];
2 => new ← Dec[old, lambda];
3 => new ← Double[old];
4 => new ← old/2;
5 => new ← default;
6 => new ← TerminalIO.RequestInt["type value > "]*lambda;
7 => new ← TerminalIO.RequestInt[Rope.Cat["type value ", CDOps.LambdaRope[1, lambda], " > "]];
8 => new ← old/lambda*lambda;
ENDCASE => TerminalIO.PutRope["Skipped\n"];
EXITS aborted => NULL;
};
IntCalled: Buttons.ButtonProc = {
design: CD.Design ← CDViewer.DesignOf[NARROW[parent]];
IF design=NIL THEN RETURN;
CDSequencer.ExecuteProc[
proc: SerializedIntCalled,
design: design,
queue: doQueue,
comm: NEW[CDSequencer.CommandRec ← [
data: clientData,
key: SELECT mouseButton FROM
red => $left, yellow => $middle, blue => $right,
ENDCASE => NIL,
n: IF control THEN 1 ELSE 0,
b: shift
]]
];
};
SerializedIntCalled: PROC [comm: CDSequencer.Command] = {
ENABLE UNWIND => NULL;
design: CD.Design ~ comm.design;
actual: Actual ~ NARROW[comm.data];
intDef: EntryDef ~ actual.define;
lambda: INT ← ActualLambda[actual];
i: INT ← CDValue.FetchInt[design, intDef.val.cdValueKey, global, intDef.default];
SELECT TRUE FROM
comm.b => {
IF comm.n=1 THEN i ← i/lambda*lambda
ELSE i ← GetAnInt[i, intDef.default, intDef.button.text, lambda]
};
comm.key=$right => {
IF comm.n=1 THEN i←i/2 ELSE i ← Dec[i, lambda]
};
comm.key=$left => {
IF comm.n=1 THEN i ← Double[i] ELSE i ← Inc[i, lambda]
};
ENDCASE => NULL;
i ← MAX[MIN[i, intDef.max], intDef.min];
CDValue.StoreInt[design, intDef.val.cdValueKey, i];
Labels.Set[actual.feedback, CDOps.LambdaRope[n: i, lambda: lambda]];
};
BuildNewLine: BuildProc = {
panel.nextY ← panel.nextY+entryHSpace+entryHeight;
panel.nextX ← 0;
};
BuildLayer: BuildProc = {
p: Actual ← NEW[ActualRec ← [define: entry, panel: panel]];
option: NAT ← entry.option;
button: Buttons.Button = Buttons.Create[
info: [ name: entry.button.text,
wx: panel.layers[option].nextX,
wy: butYCompensation,
wh: entryHeight,
parent: panel.layers[option].container,
border: FALSE
],
clientData: p,
proc: WireWidthCalled
];
p.feedback ← Labels.Create[
info: [
wx: panel.layers[option].nextX,
wy: shorterEntryVSpace+entryHeight+labelYCompensation,
wh: entryHeight,
ww: button.ww+4*entryHSpace, --2 spaces for real; 2 covering leading blank of next #
parent: panel.layers[option].container,
border: FALSE,
name: CDOps.LambdaRope[
n: CDLayers.LayerWidth[panel.design, entry.layer],
lambda: panel.design.technology.lambda
]
]
];
panel.layers[option].nextX ← button.wx+button.ww+2*entryHSpace;
panel.layerWidths ← CONS[p, panel.layerWidths];
};
WireWidthCalled: Buttons.ButtonProc = {
wireRef: Actual = NARROW[clientData];
CDSequencer.ExecuteProc[
proc: SerializedWireWidthCalled,
design: wireRef.panel.design,
queue: doQueue,
comm: NEW[CDSequencer.CommandRec ← [
data: clientData,
key: SELECT mouseButton FROM
red => $left,
yellow => $middle,
blue => $right,
ENDCASE => NIL,
n: IF control THEN 1 ELSE 0,
b: shift
]]
];
};
SerializedWireWidthCalled: PROC[comm: CDSequencer.Command] = {
wireRef: Actual = NARROW[comm.data];
layer: CD.Layer = wireRef.define.layer;
design: CD.Design ← wireRef.panel.design;
width: CD.Number ← CDLayers.LayerWidth[design, layer];
lambda: INT ← design.technology.lambda;
IF comm.b THEN {
IF comm.n=1 THEN width ← width/lambda*lambda
ELSE width ← GetAnInt[width, wireRef.define.default, wireRef.define.button.text, lambda]
}
ELSE IF comm.key=$right THEN {
IF comm.n=1 THEN width ← width/2 ELSE width ← Dec[width, lambda]
}
ELSE IF comm.key=$left THEN {
IF comm.n=1 THEN width ← Double[width] ELSE width ← Inc[width, lambda]
}
ELSE IF comm.key=$middle THEN {
CDLayers.SetCurrentLayer[design, layer];
RETURN
};
CDLayers.SetLayerWidth[design, layer, MAX[width, 0]];
};
DoFromDisplayVal: PROC [actual: Actual] RETURNS [x: REF] = {
RETURN [
IF actual.define.entryClass.fromdisplay=NIL
THEN CDValue.Fetch[actual.panel.design, actual.define.val.cdValueKey, global]
ELSE actual.define.entryClass.fromdisplay[actual]
]
};
FromDisplayNoStoreVal: PROC [design: CD.Design, cdValueKey: REF] RETURNS [REF←NIL] = {
panel: Panel = GetPanel[design];
FOR list: LIST OF Actual ← panel.actuals, list.rest WHILE list#NIL DO
IF list.first.define.val.cdValueKey=cdValueKey THEN
RETURN [DoFromDisplayVal[list.first]]
ENDLOOP;
};
TakeDown: PUBLIC PROC [design: CD.Design, cdValueKey: REF] RETURNS [x: REF] = {
x ← FromDisplayNoStoreVal[design, cdValueKey];
WITH x SELECT FROM
rt: REF TEXT => x ← Rope.FromRefText[rt];
ENDCASE => NULL;
CDValue.Store[design, cdValueKey, x];
};
TakeDownText: PUBLIC PROC [design: CD.Design, cdValueKey: REF] RETURNS [Rope.ROPE] = {
WITH TakeDown[design, cdValueKey] SELECT FROM
r: Rope.ROPE => RETURN [r];
ENDCASE => RETURN [NIL];
};
ToDisplayNoFetchVal: PROC [design: CD.Design, cdValueKey: REF, value: REF] = {
panel: Panel = GetPanel[design];
IF panel.container=NIL OR panel.container.destroyed THEN RETURN;
FOR list: LIST OF Actual ← panel.actuals, list.rest WHILE list#NIL DO
IF list.first.define.val.cdValueKey=cdValueKey THEN {
ToDisplay[list.first, value];
}
ENDLOOP;
};
PutUpText: PUBLIC PROC [design: CD.Design, cdValueKey: REF, rope: Rope.ROPE] = {
CDValue.Store[design, cdValueKey, rope];
ToDisplayNoFetchVal[design, cdValueKey, rope];
};
PutUp: PUBLIC PROC [design: CD.Design, cdValueKey: REF] RETURNS [REF←NIL] = {
value: REF;
--special hack to change layer mode
IF cdValueKey=$PanelLayerMode THEN {
panel: Panel ← GetPanel[design];
NotifyChangeLayerOption[panel.container, panel, red, TRUE, TRUE];
RETURN
};
value ← CDValue.Fetch[design, cdValueKey, global];
ToDisplayNoFetchVal[design, cdValueKey, value];
RETURN [value]
};
ContainerDeleted: ViewerEvents.EventProc = {
--break circularities
WITH ViewerOps.FetchProp[viewer, $CDPanelsPrivate] SELECT FROM
panel: Panel => {
ViewerOps.AddProp[viewer, $ChipNDaleDesign, NIL];
ViewerOps.AddProp[viewer, $CDPanelsPrivate, NIL];
IF panel.container=viewer AND panel.design#NIL THEN {
CDValue.Store[panel.design, panelKey, NIL];
panel.container ← NIL;
panel.design ← NIL;
panel.class ← NIL;
panel.layerLabel ← NIL;
panel.layerWidths ← NIL;
panel.actuals ← NIL;
};
};
ENDCASE => NULL;
};
EnumDesigns: PROC[p: CDPrivate.DesignEnumerator] RETURNS [quit: BOOL←FALSE] = {
FOR list: PanelList ← panelList, list.rest WHILE list#NIL AND ~quit DO
IF list.first.container#NIL AND ~list.first.container.destroyed THEN {
d: CD.Design ← list.first.design;
IF d#NIL THEN quit ← p[d];
}
ENDLOOP;
};
--vanilla utilities ================================
Double: PROC[i: INT] RETURNS [INT] = INLINE {
IF i<LAST[INT]/2 AND i>(FIRST[INT]/2) THEN i ← i+i;
RETURN [i]
};
Inc: PROC[i: INT, x: INT𡤁] RETURNS [INT] = INLINE {
IF i<=LAST[INT]-x THEN i ← i+x;
RETURN [i]
};
Dec: PROC[i: INT, x: INT𡤁] RETURNS [INT] = INLINE {
IF i>=FIRST[INT]+x THEN i ← i-x;
RETURN [i]
};
--module initialization ================================
[] ← CDValue.RegisterKey[panelKey, NIL];
[] ← CDValue.RegisterKey[classKey, NIL];
CDValue.RegisterKey[key: $PanelHeight];
CDEvents.RegisterEventProc[$RenameDesign, RepaintCaptions];
CDEvents.RegisterEventProc[$AfterPush, RepaintCaptions];
CDEvents.RegisterEventProc[$AfterPop, RepaintCaptions];
CDLayers.RegisterNotifiers[layer: NotifyCurrentLayer, width: NotifyLayerWidth];
[] ← ViewerEvents.RegisterEventProc[ContainerDeleted, destroy, $Container];
CDPrivate.InstallDesignEnumerator[EnumDesigns];
END.