CDPanelImpl.mesa (part of Chipndale)
by Christian Jacobi August 8, 1983 5:20 pm
last edited by Christian Jacobi February 8, 1984 10:52 am
DIRECTORY
Atom,
Buttons, Menus, MBQueue, Labels,
CD USING [combined, Design, DesignNumber, lambda, Level, levelNumber, Technology],
CDEvents,
CDExtras,
CDPanel,
CDTechnology,
CDValue,
Containers,
Icons,
NumberLabels,
Rope USING [Concat, ROPE],
TerminalIO,
UserProfile,
ViewerClasses,
ViewerOps;
CDPanelImpl: CEDAR MONITOR
IMPORTS Atom, CDEvents, CDExtras, CDTechnology, CDValue, Containers, Icons, Labels, MBQueue, NumberLabels, Rope, TerminalIO, UserProfile, ViewerOps
EXPORTS CDPanel =
BEGIN
Design: TYPE = CD.Design;
Technology: TYPE = CD.Technology;
Level: TYPE = CD.Level;
DesignNumber: TYPE = CD.DesignNumber;
Error: ERROR = CODE;
panelKey: REF INT = NEW[INT]; -- used instead of atoms, to be really unique
panelClassKey: REF INT = NEW[INT];
Panel: TYPE = REF PanelRecord; -- one per design
PanelRecord: TYPE = RECORD [
container: ViewerClasses.Viewer←NIL,
design: Design,
class: PanelClass←NIL,
nextLevelX: CARDINAL,
nextLevelY: CARDINAL,
nextX: CARDINAL,
nextY: CARDINAL,
layerLabel: Labels.Label,
dontGarbageCollect: LIST OF REF
];
GetPanel: INTERNAL PROC [design: Design] RETURNS [Panel] =
BEGIN
x: REF ANY ← CDValue.Fetch[boundTo: design, key: panelKey, propagation: design];
IF x=NIL THEN {
panel: Panel = NEW[PanelRecord];
panel.class ← GetPanelClass[design.technology];
panel.design ← design;
CDValue.Store[design, panelKey, panel];
RETURN [panel]
};
RETURN [NARROW[x, Panel]];
END;
GetPanelClass: INTERNAL PROC [tech: Technology] RETURNS [PanelClass] =
BEGIN
x: REF ANY ← CDValue.Fetch[boundTo: tech, key: panelClassKey, propagation: technology];
IF x=NIL THEN {
panelClass: PanelClass = NEW[PanelEntryList←NIL];
CDValue.Store[boundTo: tech, key: panelClassKey, value: panelClass];
RETURN [panelClass]
};
RETURN [NARROW[x, PanelClass]];
END;
CreatePanel: PUBLIC ENTRY PROC [design: CD.Design] RETURNS [ViewerClasses.Viewer] =
--only one panel-viewer per design is created
--panel may or may not be updated if definitions occur after first creation
BEGIN
ENABLE UNWIND => NULL;
panel: Panel ← GetPanel[design];
panelClass: PanelClass ← GetPanelClass[design.technology];
IF panel.container#NIL AND NOT panel.container.destroyed THEN RETURN [panel.container];
panel.container ← NIL;
--supress creation of viewer if empty
IF panelClass#NIL AND panelClass^#NIL THEN CreateViewer[panel];
RETURN [panel.container]
END;
AppendEntry: INTERNAL PROC [class: PanelClass, el: REF ANY] =
BEGIN
IF class=NIL THEN ERROR;
IF class^=NIL THEN class^ ← LIST[el]
ELSE
FOR l: PanelEntryList ← class^, l.rest DO
IF l.rest = NIL THEN {l.rest ← LIST[el]; EXIT}
ENDLOOP;
END;
DefineNewLine: PUBLIC ENTRY PROC [tech: Technology] =
BEGIN
ENABLE UNWIND => NULL;
class: PanelClass ← GetPanelClass[tech];
ln: LnDefine ← NEW[LnDefineRec ← [tech: tech]];
AppendEntry[class, ln];
END;
levelDefinitions: REF ARRAY [0..CD.levelNumber) OF LevelDefine =
NEW[ARRAY [0..CD.levelNumber) OF LevelDefine];
LevelDefine: TYPE = REF LevelDefineRec;
LevelDefineRec: TYPE = RECORD [
tech: Technology ← NIL,
level: Level ← CD.combined,
text: Rope.ROPE ← NIL,
min, default: DesignNumber ← 0,
init: BOOL ← FALSE
];
IntDefine: TYPE = REF IntDefineRec;
IntDefineRec: TYPE = RECORD [
hookedOn: REF,
text: Rope.ROPE,
min, max, default: INT
];
LnDefine: TYPE = REF LnDefineRec; -- Ln means Line End
LnDefineRec: TYPE = RECORD [tech: Technology];
PanelEntryList: TYPE = LIST OF REF ANY; -- one per Technology
PanelClass: TYPE = REF PanelEntryList;
DefineLevelEntry: PUBLIC ENTRY PROC [tech: Technology, lev: Level, text: Rope.ROPE, min, default: DesignNumber𡤁] =
BEGIN
ENABLE UNWIND => NULL;
panelClass: PanelClass ← GetPanelClass[tech];
IF lev=CD.combined THEN ERROR;
IF levelDefinitions[lev].init THEN ERROR;
levelDefinitions[lev]^ ← LevelDefineRec[init: TRUE,
tech: tech, level: lev, text: text, min: min, default: default
];
AppendEntry[panelClass, levelDefinitions[lev]];
CDTechnology.SetLevelWidth[design: tech --!!! it sets default--, level: lev, width: default];
END;
StoreDefaultLevel: PUBLIC ENTRY PROC [design: Design, lev: Level] =
BEGIN
ENABLE UNWIND => NULL;
p: Panel ← GetPanel[design];
CDTechnology.SetCurrentLevel[design, lev];
IF p.layerLabel#NIL THEN Labels.Set[p.layerLabel, levelDefinitions[lev].text];
END;
StoreWidth: PUBLIC PROC [design: Design, lev: Level, width: DesignNumber] =
BEGIN
CDTechnology.SetLevelWidth[design: design, level: lev, width: width]
END;
FetchWidth: PUBLIC PROC [design: CD.Design, level: CD.Level] RETURNS [CD.DesignNumber] =
BEGIN
RETURN [CDTechnology.LevelWidth[design, level]]
END;
FetchDefaultLevel: PUBLIC PROC [design: CD.Design] RETURNS [CD.Level] =
BEGIN
RETURN [CDTechnology.CurrentLevel[design]]
END;
-- Viewer Stuff -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
entryHSpace: CARDINAL = 3;
entryHeight: CARDINAL = 12;
shorterEntryVSpace: CARDINAL = 1;
TechnologyName: PROC [t: CD.Technology] RETURNS [Rope.ROPE] =
{RETURN [IF t.name#NIL THEN t.name ELSE Atom.GetPName[t.key]]};
Caption: PROC [panel: Panel] RETURNS [Rope.ROPE] =
BEGIN
name: Rope.ROPE
← (IF panel.design.name#NIL THEN panel.design.name ELSE "no name");
name ← Rope.Concat[name, " "];
name ← Rope.Concat[name, TechnologyName[panel.design.technology]];
name ← Rope.Concat[name, " "];
name ← Rope.Concat[name, CDExtras.PushedCellName[panel.design]];
RETURN [name]
END;
PanelIconForDesign: PROC [design: CD.Design] RETURNS [Icons.IconFlavor] =
BEGIN
x: REF = CDValue.Fetch[boundTo: design, key: $PanelIcon, propagation: global];
WITH x SELECT FROM
ip: REF Icons.IconFlavor => RETURN [ip^];
ENDCASE => RETURN [Icons.IconFlavor[unInit]]
END;
CreateViewer: INTERNAL PROC [panel: Panel] =
BEGIN
firstLevel: LevelDefine←NIL;
TerminalIO.WriteRope["Create a control panel\n"];
IF panel=NIL OR panel.design=NIL OR panel.design.technology=NIL THEN
{TerminalIO.WriteRope["not registered properly\n"]; ERROR};
panel.nextLevelX ← panel.nextX ← panel.nextY ← 0;
panel.nextLevelY ← entryHeight+entryHSpace;
panel.dontGarbageCollect ← NIL;
panel.container ← Containers.Create[[
name: Caption[panel],
openHeight: CDValue.FetchInt[boundTo: panel.design, key: $PanelHeight, propagation: global, ifNotFound: 120],
scrollable: TRUE,
iconic: UserProfile.Boolean["Chipndale.ControlViewerOpenIconic", FALSE],
icon: PanelIconForDesign[panel.design],
column: right,
data: panel]
];
[] ← NextLabel[panel, "current layer:"];
panel.layerLabel ← NextLabel[mySheet: panel,
name: levelDefinitions[FetchDefaultLevel[panel.design]].text,
extraSpaces: 2,
extraWidth: 5
];
panel.nextY ← 3*(entryHeight+entryHSpace);
panel.nextX ← 0;
FOR l: PanelEntryList ← panel.class^, l.rest WHILE l#NIL DO
WITH l.first SELECT FROM
levelDefine: LevelDefine => {
IF firstLevel=NIL THEN firstLevel←levelDefine;
CreateLevelEntry[panel, levelDefine];
};
intDef: IntDefine => CreateIntEntry[panel, intDef];
lnDef: LnDefine => CreateLnEntry[panel, lnDef];
ENDCASE => TerminalIO.WriteRope["unknown case\n"];
ENDLOOP;
IF firstLevel#NIL THEN {
--does not work: deadlock: StoreDefaultLevel[panel.design, firstLevel.level];
--so do the work inline
CDTechnology.SetCurrentLevel[panel.design, firstLevel.level];
Labels.Set[panel.layerLabel, levelDefinitions[firstLevel.level].text]
};
END;
RepaintCaptions: ENTRY CDEvents.EventProc =
BEGIN
panel: Panel ← GetPanel[design];
panel.container.name�ption[panel];
ViewerOps.PaintViewer[panel.container, caption]
END;
WidthValueRec: TYPE = RECORD [
levelDefine: LevelDefine,
panel: Panel,
numbLab: NumberLabels.NumberLabel←NIL
];
WidthValueRef: TYPE = REF WidthValueRec;
NextButton: INTERNAL PROC [panel: Panel,
label: Rope.ROPE, proc: Buttons.ButtonProc, border: BOOL ← FALSE, extraSpaces: CARDINAL ← 1, clientData: REF ANY ← NIL] =
BEGIN
button: Buttons.Button = MBQueue.CreateButton[q: panel.design.queue,
info: [ name: label,
wx: panel.nextX+extraSpaces*entryHSpace,
wy: panel.nextY,
wh: entryHeight,
parent: panel.container,
border: border
],
clientData: clientData,
proc: proc
];
panel.nextX ← button.wx+button.ww+entryHSpace;
panel.dontGarbageCollect ← CONS[button, panel.dontGarbageCollect]
END;
NextNumberLabel: INTERNAL PROC [panel: Panel, value: INT, extraSpaces: CARDINAL𡤀] RETURNS
[NumberLabels.NumberLabel] =
BEGIN
nl: NumberLabels.NumberLabel ← NumberLabels.CreateNumber[
info: [
wx: panel.nextX+extraSpaces*entryHSpace,
wy: panel.nextY,
wh: entryHeight,
parent: panel.container,
border: FALSE],
chars: 4,
initialValue: value
];
panel.nextX ← nl.wx+nl.ww+entryHSpace;
panel.dontGarbageCollect ← CONS[nl, panel.dontGarbageCollect];
RETURN [nl]
END;
NextLabel: INTERNAL PROC [mySheet: Panel,
name: Rope.ROPE, border: BOOL ← FALSE, extraSpaces: CARDINAL ← 1, extraWidth: CARDINAL ← 0] RETURNS [Labels.Label] =
BEGIN
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: mySheet.nextX+extraSpaces*entryHSpace,
wy: mySheet.nextY,
wh: entryHeight,
parent: mySheet.container,
border: border
]
];
mySheet.nextX ← label.wx+label.ww+entryHSpace;
mySheet.dontGarbageCollect ← CONS[label, mySheet.dontGarbageCollect];
RETURN [label]
END;
IntValueRec: TYPE = RECORD [
panel: Panel,
intDef: IntDefine,
numbLab: NumberLabels.NumberLabel←NIL
];
IntValueRef: TYPE = REF IntValueRec;
CreateIntEntry: INTERNAL PROC [panel: Panel, intDef: IntDefine] =
BEGIN
intRef: IntValueRef ← NEW[IntValueRec ← [panel, intDef]];
[] ← NextButton[panel: panel, label: intDef.text, proc: IntModify, clientData: intRef];
[intRef.numbLab] ← NextNumberLabel[panel: panel,
value: CDValue.FetchInt[
boundTo: panel.design,
key: intDef.hookedOn,
propagation: technology,
ifNotFound: intDef.default
]
];
END;
IntModify: ENTRY Buttons.ButtonProc =
--clientData: REF ANY, mouseButton: { red, yellow, blue }
BEGIN
ENABLE UNWIND => NULL;
i: INT;
intRef: IntValueRef = NARROW[clientData];
i ← CDValue.FetchInt[
boundTo: intRef.panel.design,
key: intRef.intDef.hookedOn,
propagation: technology,
ifNotFound: intRef.intDef.default
];
IF shift AND control THEN i←TerminalIO.RequestInt["type value > "]
ELSE IF shift THEN i←intRef.intDef.default
ELSE IF mouseButton=Menus.MouseButton[blue] THEN {
IF control THEN i ← i/2 ELSE i ← i-1;
}
ELSE IF mouseButton=Menus.MouseButton[red] THEN {
IF control THEN i ← i*2 ELSE i ← i+1;
};
i ← MIN[i, intRef.intDef.max];
i ← MAX[i, intRef.intDef.min];
CDValue.StoreInt[
boundTo: intRef.panel.design,
key: intRef.intDef.hookedOn,
value: i
];
NumberLabels.NumberLabelUpdate[intRef.numbLab, i]
END;
CreateLnEntry: INTERNAL PROC [panel: Panel, lnDef: LnDefine] =
BEGIN
panel.nextY ← panel.nextY+entryHSpace+entryHeight;
panel.nextX ← 0;
END;
CreateLevelEntry: INTERNAL PROC [panel: Panel, levelDefine: LevelDefine] =
BEGIN
extraSpaces: CARDINAL = 1;
p: WidthValueRef ← NEW[WidthValueRec ← WidthValueRec[levelDefine: levelDefine, panel: panel]];
button: Buttons.Button = MBQueue.CreateButton[q: panel.design.queue,
info: [ name: levelDefine.text,
wx: panel.nextLevelX+extraSpaces*entryHSpace,
wy: panel.nextLevelY,
wh: entryHeight,
parent: panel.container,
border: FALSE
],
clientData: p,
proc: WireWidthModify
];
p.numbLab ← NumberLabels.CreateNumber[
info: [
wx: panel.nextLevelX+extraSpaces*entryHSpace,
wy: panel.nextLevelY+shorterEntryVSpace+entryHeight,
wh: entryHeight,
parent: panel.container,
border: FALSE],
chars: 3,
initialValue: FetchWidth[panel.design, levelDefine.level]/CD.lambda
];
panel.nextLevelX ← button.wx+button.ww+entryHSpace;
panel.dontGarbageCollect ← CONS[p.numbLab, panel.dontGarbageCollect];
panel.dontGarbageCollect ← CONS[button, panel.dontGarbageCollect];
END;
WireWidthModify: Buttons.ButtonProc =
--clientData: REF ANY, mouseButton: { red, yellow, blue }
BEGIN
wireRef: WidthValueRef = NARROW[clientData];
lev: CD.Level = wireRef.levelDefine.level;
design: Design ← wireRef.panel.design;
width: CD.DesignNumber ← FetchWidth[design, lev]/CD.lambda;
IF shift AND control THEN {
width ← MAX[0, TerminalIO.RequestInt["type width > "]];
StoreWidth[design, lev, width*CD.lambda]
}
ELSE IF shift THEN {
width ← wireRef.levelDefine.default/CD.lambda;
StoreWidth[design, lev, width*CD.lambda]
}
ELSE
IF mouseButton=Menus.MouseButton[blue] THEN {
IF control THEN width←width/2 ELSE width←MAX[width-1, 0];
StoreWidth[design, lev, width*CD.lambda]
}
ELSE IF mouseButton=Menus.MouseButton[red] THEN {
IF control THEN width←width*2 ELSE width←width+1;
StoreWidth[design, lev, width*CD.lambda]
}
ELSE IF mouseButton=Menus.MouseButton[yellow] THEN StoreDefaultLevel[design, lev];
NumberLabels.NumberLabelUpdate[wireRef.numbLab, width]
END;
DefineIntEntry: PUBLIC ENTRY PROC [cdValueKey: REF, tech: CD.Technology,
text: Rope.ROPE←NIL,
min: INT ← FIRST[INT], max: INT ← LAST[INT], default: INT ← 1] =
--cdValueKey must have been correctly registered with CDValue! CDPanel does NOT itself.
--(needed to allow hooking entries onto already used keys)
--Restriction: displayed value does not follow changes of CDValue.StoreInt
BEGIN
ENABLE UNWIND => NULL;
def: IntDefine ← NEW[IntDefineRec];
class: PanelClass ← GetPanelClass[tech];
def^ ← IntDefineRec[hookedOn: cdValueKey, text: text, min: min, max: max, default: default];
AppendEntry[class, def];
CDValue.StoreInt[boundTo: tech, key: cdValueKey, value: default];
END;
Init: PROC [] =
BEGIN
chipndaleControlIcon: REF Icons.IconFlavor ← NEW[Icons.IconFlavor];
FOR l: Level IN [0..CD.levelNumber) DO
levelDefinitions[l] ← NEW[LevelDefineRec]
ENDLOOP;
[] ← CDValue.EnregisterKey[panelKey, NIL];
[] ← CDValue.EnregisterKey[panelClassKey, NIL];
chipndaleControlIcon^ ← Icons.NewIconFromFile["Chipndale.icons", 1
! ANY => {chipndaleControlIcon^←Icons.IconFlavor[unInit]; CONTINUE}];
CDValue.EnregisterKey[key: $PanelIcon];
CDValue.Store[boundTo: NIL, key: $PanelIcon, value: chipndaleControlIcon];
CDValue.EnregisterKey[key: $PanelHeight];
CDEvents.RegisterEventProc[$RenameDesign, RepaintCaptions];
CDEvents.RegisterEventProc[$AfterPush, RepaintCaptions];
CDEvents.RegisterEventProc[$AfterPop, RepaintCaptions];
END;
Init[]
END.