[Indigo]<Chipndale>5.2>cd18>CDPanelImpl.mesa!8

CDPanelImpl.mesa (part of Chipndale)

by Christian Jacobi August 8, 1983 5:20 pm

last edited by Christian Jacobi November 6, 1984 12:59:46 pm PST

DIRECTORY

Atom,

Buttons,

CD USING [combined, Design, DesignNumber, lambda, Level, levelNumber, Technology],

CDEvents,

CDExtras,

CDPanel,

CDDefaults,

CDTipEtc,

CDValue,

CDViewer,

Containers,

IO,

Labels,

Menus,

MBQueue,

NumberLabels,

Rope USING [Concat, ROPE],

TerminalIO,

UserProfile,

ViewerClasses,

ViewerOps;

CDPanelImpl: CEDAR MONITOR

IMPORTS Atom, CDEvents, CDExtras, CDDefaults, CDTipEtc, CDValue, CDViewer, Containers, IO, Labels, MBQueue, NumberLabels, Rope, TerminalIO, UserProfile, ViewerOps

EXPORTS CDPanel

SHARES CDDefaults =

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,

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;

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]];

CDDefaults.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];

CDDefaults.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

CDDefaults.SetLevelWidth[design: design, level: lev, width: width]

END;

FetchWidth: PUBLIC PROC [design: CD.Design, level: CD.Level] RETURNS [CD.DesignNumber] =

BEGIN

RETURN [CDDefaults.LevelWidth[design, level]]

END;

FetchDefaultLevel: PUBLIC PROC [design: CD.Design] RETURNS [CD.Level] =

BEGIN

RETURN [CDDefaults.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

← (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;

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[[

openHeight: CDValue.FetchInt[boundTo: panel.design, key: $PanelHeight, propagation: global, ifNotFound: 120],

scrollable: TRUE,

iconic: UserProfile.Boolean["Chipndale.ControlViewerOpenIconic", FALSE],

icon: CDTipEtc.GetPanelIcon[panel.design],

column: right,

data: panel]

];

[] ← NextLabel[panel, "current layer:"];

panel.layerLabel ← NextLabel[mySheet: panel,

extraSpaces: 2,

extraWidth: 8

];

[] ← NextLabel[panel, " | "];

NextButton[panel, "split viewer", SplitViewer,,, panel.design];

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

CDDefaults.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;

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] RETURNS [INT] = INLINE {

IF i<LAST[INT] THEN i ← i+1;

RETURN [i]

};

Dec: PROC[i: INT] RETURNS [INT] = INLINE {

IF i>FIRST[INT] THEN i ← i-1;

RETURN [i]

};

GetAnInt: PROC [old, default: INT, label: Rope.ROPE] RETURNS [new: INT] =

BEGIN

ENABLE TerminalIO.UserAbort => GOTO aborted;

new ← old;

SELECT TerminalIO.RequestSelection[label: label,

choice: LIST["+1", "-1", "*2", "/2", IO.PutFR["←%0g", IO.int[default]], "type"]

] FROM

1 => new ← Inc[old];

2 => new ← Dec[old];

3 => {new ← Double[old]};

4 => {new ← old/2};

5 => {new ← default};

6 => {new ← TerminalIO.RequestInt["type value > "]};

ENDCASE => TerminalIO.WriteRope["Skipped\n"];

EXITS aborted => NULL;

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 THEN i ← GetAnInt[i, intRef.intDef.default, intRef.intDef.text]

ELSE IF mouseButton=Menus.MouseButton[blue] THEN

{IF control THEN i←i/2 ELSE i ← Dec[i]}

ELSE IF mouseButton=Menus.MouseButton[red] THEN

{IF control THEN i ← Double[i] ELSE i ← Inc[i]};

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

ENABLE UNWIND => NULL;

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 THEN width ← GetAnInt[width, wireRef.levelDefine.default/CD.lambda, wireRef.levelDefine.text]

ELSE IF mouseButton=Menus.MouseButton[blue] THEN

{IF control THEN width ← width/2 ELSE width ← Dec[width]}

ELSE IF mouseButton=Menus.MouseButton[red] THEN

{IF control THEN width ← Double[width] ELSE width ← Inc[width]}

ELSE IF mouseButton=Menus.MouseButton[yellow] THEN {

StoreDefaultLevel[design, lev];

RETURN

};

width ← MAX[width, 0];

StoreWidth[design, lev, width*CD.lambda];

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];

def^ ← IntDefineRec[hookedOn: cdValueKey, text: text, min: min, max: max, default: default];

AppendEntry[class, def];

CDValue.StoreInt[boundTo: tech, key: cdValueKey, value: default];

END;

SplitViewer: Buttons.ButtonProc =

--clientData: REF ANY

BEGIN

design: CD.Design = NARROW[clientData];

[] ← CDViewer.CreateViewer[design]

END;

Init: PROC [] =

BEGIN

FOR l: Level IN [0..CD.levelNumber) DO

levelDefinitions[l] ← NEW[LevelDefineRec]

ENDLOOP;

[] ← CDValue.EnregisterKey[panelKey, NIL];

[] ← CDValue.EnregisterKey[panelClassKey, NIL];

CDValue.EnregisterKey[key: $PanelHeight];

CDEvents.RegisterEventProc[$RenameDesign, RepaintCaptions];

CDEvents.RegisterEventProc[$AfterPush, RepaintCaptions];

CDEvents.RegisterEventProc[$AfterPop, RepaintCaptions];

END;

Init[]

END.