CDPanelImpl.mesa (part of ChipNDale)
Copyright © 1983, 1985, 1986 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, August 8, 1983 5:20 pm
Last Edited by: Christian Jacobi, December 18, 1986 12:21:09 pm PST
DIRECTORY
Buttons,
CD,
CDCellsBackdoor,
CDEnvironment,
CDEvents,
CDLayers,
CDOps,
CDPanel,
CDPrivate,
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, 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
ToDisplay: reset picture on screen from CDValue
Called: proc is called by interactive action
ROPE: TYPE = Rope.ROPE;
Viewer: TYPE = ViewerClasses.Viewer;
Panel: TYPE = REF PanelRec; -- defines the control panel; one per design
PanelRec: TYPE = RECORD [
container: Viewer ← NIL,
design: CD.Design,
class: Class ← NIL,
nextLayerX: CARDINAL ← 0,
nextLayerY: CARDINAL ← 0,
nextX: CARDINAL ← 0,
nextY: CARDINAL ← 0,
nextSpecialX: 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,
text: ROPE ← NIL,
redisplay: BOOL ← TRUE,
cdValueKey: REF ← NIL,
min, max, default, lambda: INT ← 1,
width: INT ← -1, --viewer units
layer: CD.Layer ← CD.undefLayer,
proc: CDSequencer.CommandProc ← NIL,
command: ATOM ← NIL,
queue: CDSequencer.QueueMethod ← useDefault,
topLine: BOOL ← FALSE,
border: BOOL ← FALSE,
editable: BOOL ← FALSE,
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;
layerDefs: REF ARRAY [0..CD.layerNum) OF EntryDef ~
NEW[ARRAY [0..CD.layerNum) OF EntryDef ← ALL[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: ToDisplayInt
]];
--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]];
}
};
CreatePanel: PUBLIC ENTRY PROC [design: CD.Design] RETURNS [Viewer] = {
--only one panel-viewer per design is created
--panel may or may not be updated if definitions occur after first creation
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];
IncludeEntryInClass[class, entry];
CreateEntryInViewers[class, entry];
};
-- Define's ===========================================================
DefineNewLine: PUBLIC ENTRY PROC [tech: CD.Technology] = {
ENABLE UNWIND => NULL;
[] ← DefineEntry[tech, [entryClass: newLineClass]];
};
DefineButton: PUBLIC ENTRY PROC [tech: CD.Technology←NIL, name: ROPE, proc: CDSequencer.CommandProc ← NIL, command: ATOM ← NIL, queue: CDSequencer.QueueMethod ← useDefault, topLine: BOOL ← FALSE, border: BOOL ← FALSE, data: REF ← NIL, cdValueKey: REF ← NIL, redisplay: BOOL] = {
ENABLE UNWIND => NULL;
IF command=NIL AND queue=useDefault THEN queue ← doQueue;
[] ← DefineEntry[tech, [
entryClass: buttonClass,
text: name, proc: proc, command: command,
queue: queue,
data: data, border: border, topLine: topLine, cdValueKey: cdValueKey
]];
};
DefineLabel: PUBLIC ENTRY PROC [tech: CD.Technology←NIL, name: ROPE, border: BOOL ← FALSE, cdValueKey: REF ← NIL, redisplay: BOOL ← TRUE] = {
ENABLE UNWIND => NULL;
[] ← DefineEntry[tech, [
entryClass: labelClass,
text: name, border: border, cdValueKey: cdValueKey
]];
};
DefineLayerEntry: PUBLIC ENTRY PROC [tech: CD.Technology, layer: CD.Layer, text: ROPE, min, default: CD.Number𡤁] = {
ENABLE UNWIND => NULL;
IF layer=CD.undefLayer THEN RETURN WITH ERROR CD.Error[callingError];
IF layerDefs[layer]#NIL THEN
RETURN WITH ERROR CD.Error[doubleRegistration, "re-registers layer"];
layerDefs[layer] ← DefineEntry[tech, [
entryClass: layerClass, layer: layer, text: text, min: min, default: default
]];
CDLayers.SetLayerWidth[design: NIL --!!! it sets default--, layer: layer, width: default];
};
DefineIntEntry: PUBLIC ENTRY PROC [tech: CD.Technology, cdValueKey: REF, text: ROPE, min: INT, max: INT, default: INT, lambda: INT, redisplay: BOOL] = {
ENABLE UNWIND => NULL;
CDValue.StoreInt[boundTo: tech, key: cdValueKey, value: default];
[] ← DefineEntry[tech, [
entryClass: intClass,
cdValueKey: cdValueKey, text: text, min: min, max: max,
default: default, lambda: lambda
]];
};
DefineRopeEntry: PUBLIC ENTRY PROC [tech: CD.Technology ← NIL, cdValueKey: REF, button: Rope.ROPE, width: INT, editable: BOOL, redisplay: BOOL] = {
ENABLE UNWIND => NULL;
[] ← DefineEntry[tech, [
entryClass: textClass,
cdValueKey: cdValueKey, width: width, border: FALSE,
text: button, editable: editable
]];
};
-- special treatment for layers ===========================================================
LayerName: PROC [layer: CD.Layer] RETURNS [r: ROPE] = {
IF layerDefs[layer]#NIL THEN RETURN[layerDefs[layer].text]
ELSE {
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[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;
};
ENDLOOP;
}
};
-- Viewer Stuff -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
DesignName: PROC [d: CD.Design] RETURNS [Rope.ROPE] = {
RETURN [IF d.name#NIL THEN d.name ELSE "no name" ];
};
Caption: PROC [panel: Panel] RETURNS [ROPE] = {
RETURN [Rope.Cat[
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 ", DesignName[panel.design], "\n"];
panel.actuals ← NIL;
panel.layerWidths ← NIL;
panel.nextLayerX ← panel.nextX ← 0;
panel.nextY ← topY;
panel.nextLayerY ← topY+entryHeight+entryHSpace;
panel.container ← Containers.Create[[
name: Caption[panel],
openHeight: CDValue.FetchInt[panel.design, $PanelHeight, global, 120],
scrollable: TRUE,
iconic: TRUE, column: right, icon: CDEnvironment.GetPanelIcon[panel.design]
]];
ViewerOps.AddProp[panel.container, $ChipNDaleDesign, panel.design];
ViewerOps.AddProp[panel.container, $CDPanelPrivate, panel];
[] ← NextLabel[panel, "current layer:"];
panel.layerLabel ← NextLabel[panel: panel,
extraSpaces: 2,
name: LayerName[CDLayers.CurrentLayer[panel.design]],
extraWidth: 2
];
[] ← NextLabel[panel, "| "];
panel.nextSpecialX ← panel.nextX;
panel.nextY ← 3*(entryHeight+entryHSpace);
panel.nextX ← 0;
MakeClassEntries[panel.class];
MakeClassEntries[globalClass];
};
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] = {
yoff: INT = Containers.ScrollOffset[panel.container];
button: Buttons.Button = Buttons.Create[
info: [ name: label,
wx: panel.nextX,
wy: panel.nextY+yoff+butYCompensation,
wh: entryHeight,
parent: panel.container,
border: border
],
clientData: clientData,
proc: proc
];
panel.nextX ← button.wx+button.ww+entryHSpace;
};
NextButton: INTERNAL PROC [panel: Panel, label: ROPE, proc: Buttons.ButtonProc, clientData: REF ANY ← NIL, topLine: BOOL ← FALSE, border: BOOL ← FALSE] RETURNS [button: Buttons.Button] = {
yoff: INT = Containers.ScrollOffset[panel.container];
x: INT ← panel.nextX;
y: INT ← panel.nextY;
IF topLine THEN {x ← panel.nextSpecialX; y ← 0};
button ← Buttons.Create[
info: [ name: label,
wx: x,
wy: y+yoff+butYCompensation,
wh: entryHeight,
parent: panel.container,
border: border
],
clientData: clientData,
proc: proc
];
IF topLine THEN panel.nextSpecialX ← button.wx+button.ww+entryHSpace
ELSE panel.nextX ← button.wx+button.ww+entryHSpace
};
NextLabel: PROC [panel: Panel, name: ROPE, border: BOOL ← FALSE, extraSpaces: CARDINAL ← 0, extraWidth: CARDINAL ← 0] RETURNS [Labels.Label] = {
yoff: INT = Containers.ScrollOffset[panel.container];
label: Labels.Label;
IF name=NIL THEN name ← " ";
WHILE extraWidth>0 DO
name ← Rope.Concat[base: name, rest: " "];
extraWidth ← extraWidth-1;
ENDLOOP;
label ← Labels.Create[
info: [ name: name,
wx: panel.nextX+extraSpaces*entryHSpace,
wy: panel.nextY+yoff+labelYCompensation,
wh: entryHeight,
parent: panel.container,
border: border
]
];
panel.nextX ← label.wx+label.ww+entryHSpace;
RETURN [label]
};
BuildInt: BuildProc = {
initialValue: ROPE;
actual: Actual ← NEW[ActualRec ← [panel: panel, define: entry]];
[] ← NextIntButton[panel: panel, label: entry.text, proc: IntCalled, clientData: actual];
initialValue ← CDOps.LambdaRope[
n: CDValue.FetchInt[panel.design, entry.cdValueKey, technology, entry.default],
lambda: ActualLambda[actual]
];
actual.feedback ← NextLabel[panel: panel, name: initialValue, extraWidth: 8];
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
};
ToDisplayInt: 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 ← NextLabel[
panel: panel,
name: entry.text,
border: entry.border
];
IF entry.cdValueKey#NIL THEN {
actual ← NEW[ActualRec ← [panel: panel,
define: entry,
feedback: lab
]];
panel.actuals ← CONS[actual, panel.actuals];
RedisplayEntry[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.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.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];
};
BuildText: BuildProc = {
actual: Actual←NEW[ActualRec ← [panel: panel, define: entry, feedback: NIL]];
yoff: INT = Containers.ScrollOffset[panel.container];
w: INT ← IF entry.width<=0 THEN 2000 ELSE MIN[entry.width, 2000];
h: INT ← entryHeight;
y: INT ← panel.nextY+yoff;
x: INT ← panel.nextX;
v: Viewer;
IF ~Rope.IsEmpty[entry.text] THEN {
button: Buttons.Button ← Buttons.Create[
info: [ name: entry.text,
wx: x, wy: y+butYCompensation, wh: h,
border: FALSE,
parent: panel.container
],
clientData: actual,
proc: IF entry.editable THEN TextButProc ELSE TextLabButProc
];
x ← button.wx+button.ww+entryHSpace;
};
IF entry.editable THEN
v ← actual.feedback ← ViewerTools.MakeNewTextViewer[info: [
wx: x, wy: y+textYCompensation, ww: w, wh: h+textHCompensation,
parent: panel.container,
border: FALSE,
data: FetchRopeWithList[panel.design, entry.cdValueKey]
]]
ELSE
v ← actual.feedback ← Labels.Create[info: [
name: FetchRopeWithList[panel.design, entry.cdValueKey],
wx: x, wy: y+labelYCompensation, ww: w, wh: h,
parent: panel.container,
border: FALSE
]];
panel.nextX ← v.wx+w+entryHSpace;
IF entry.width<=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]]];
};
-- ================================================
RedisplayEntry: PROC [actual: Actual] = {
IF actual.define.cdValueKey#NIL THEN
DoToDisplay[actual, CDValue.Fetch[actual.panel.design, actual.define.cdValueKey, global]]
};
DoToDisplay: PROC [actual: Actual, x: REF] = {
IF actual.define.entryClass.toDisplay#NIL THEN actual.define.entryClass.toDisplay[actual, x];
};
Redisplay: 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.redisplay THEN RedisplayEntry[list.first];
ENDLOOP;
};
BuildButton: INTERNAL PROC [panel: Panel, entry: EntryDef] = {
but: Buttons.Button = NextButton[
panel: panel,
label: entry.text,
proc: ButtonCalled,
border: entry.border,
topLine: entry.topLine,
clientData: entry
];
IF entry.cdValueKey#NIL THEN {
actual: Actual ← NEW[ActualRec ← [panel: panel, define: entry, feedback: but]];
panel.actuals ← CONS[actual, panel.actuals];
RedisplayEntry[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]]
]];
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.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.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.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 = {
yoff: INT = Containers.ScrollOffset[panel.container];
p: Actual ← NEW[ActualRec ← [define: entry, panel: panel]];
button: Buttons.Button = Buttons.Create[
info: [ name: entry.text,
wx: panel.nextLayerX,
wy: panel.nextLayerY+yoff+butYCompensation,
wh: entryHeight,
parent: panel.container,
border: FALSE
],
clientData: p,
proc: WireWidthCalled
];
p.feedback ← Labels.Create[
info: [
wx: panel.nextLayerX,
wy: panel.nextLayerY+shorterEntryVSpace+entryHeight+yoff+labelYCompensation,
wh: entryHeight,
ww: button.ww+4*entryHSpace, --2 spaces for real; 2 covering leading blank of next #
parent: panel.container,
border: FALSE,
name: CDOps.LambdaRope[
n: CDLayers.LayerWidth[panel.design, entry.layer],
lambda: panel.design.technology.lambda
]
]
];
panel.nextLayerX ← 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.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]];
};
DoFromDisplay: PROC [actual: Actual] RETURNS [x: REF] = {
RETURN [
IF actual.define.entryClass.fromdisplay=NIL
THEN CDValue.Fetch[actual.panel.design, actual.define.cdValueKey, global]
ELSE actual.define.entryClass.fromdisplay[actual]
]
};
FromDisplayNoStore: 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.cdValueKey=cdValueKey THEN
RETURN [DoFromDisplay[list.first]]
ENDLOOP;
};
FromDisplay: PUBLIC PROC [design: CD.Design, cdValueKey: REF] RETURNS [x: REF] = {
x ← FromDisplayNoStore[design, cdValueKey];
CDValue.Store[design, cdValueKey, x];
};
FromDisplayRope: PUBLIC PROC [design: CD.Design, cdValueKey: REF] RETURNS [Rope.ROPE] = {
WITH FromDisplay[design, cdValueKey] SELECT FROM
r: Rope.ROPE => RETURN [r];
ENDCASE => RETURN [NIL];
};
ToDisplayNoFetch: 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.cdValueKey=cdValueKey THEN {
DoToDisplay[list.first, value];
}
ENDLOOP;
};
ToDisplayRope: PUBLIC PROC [design: CD.Design, cdValueKey: REF, rope: Rope.ROPE] = {
CDValue.Store[design, cdValueKey, rope];
ToDisplayNoFetch[design, cdValueKey, rope];
};
ToDisplay: PUBLIC PROC [design: CD.Design, cdValueKey: REF] RETURNS [REF←NIL] = {
value: REF ← CDValue.Fetch[design, cdValueKey, global];
ToDisplayNoFetch[design, cdValueKey, value];
RETURN [value]
};
ContainerDeleted: ViewerEvents.EventProc = {
--break circularities
WITH ViewerOps.FetchProp[viewer, $CDPanelPrivate] SELECT FROM
panel: Panel => {
ViewerOps.AddProp[viewer, $ChipNDaleDesign, NIL];
ViewerOps.AddProp[viewer, $CDPanelPrivate, 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.