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;
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] = {
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
]]
];
};
Serial
izedWireWidthCalled:
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 ← 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.