
<<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_1] =
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_Caption[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_0] 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.