TrcToolImpl.mesa
Copyright c 1986 by Xerox Corporation. All rights reserved.
Eric Nickell, April 10, 1986 9:52:15 am PST
DIRECTORY
Buttons USING [ButtonProc],
ChoiceButtons USING [BuildEnumTypeSelection, ButtonList, SelectionNotifierProc],
Containers USING [Create, ChildXBound],
Convert USING [AtomFromRope, RopeFromAtom],
Rope USING [ROPE],
Trc USING [BuildControlViewer, ClassEnumProc, ClassFromFlavor, Copy, EnumerateRegisteredClasses, NotifyListeners, TRC, TRCRep],
TrcButtons USING [AttachNewTrcToButton, Create, TrcFromButton],
TrcStandardClasses USING [EnumerateRegisteredParametricClasses, NewChainTrc, NewIdentityTrc, ReplaceNthTrcInChain],
TrcViewers USING [CreateTRCViewer, InfoFromTRCViewer, NewTrc],
ViewerClasses USING [Viewer, ViewerRec],
ViewerOps USING [DestroyViewer, EstablishViewerPosition, PaintViewer, SetOpenHeight];
TrcToolImpl: CEDAR PROGRAM
IMPORTS ChoiceButtons, Containers, Convert, Trc, TrcButtons, TrcStandardClasses, TrcViewers, ViewerOps
EXPORTS ExportsList
~ BEGIN
OPEN Interface;
ROPE: TYPE ~ Rope.ROPE;
width: NAT ~ 100;
cWidth: NAT ~ 250;
margin: NAT ~ 10;
sq: NAT ~ 15;
Data: TYPE ~ REF DataRep;
DataRep: TYPE ~ RECORD [
novice: BOOL,
chainTrc: Trc.TRC,   --the parent chain trc
trcV, controlV, viewer, sibling: ViewerClasses.Viewer ← NIL
trcV is the trc viewer
controlV is the controlling viewer
viewer is the enclosing container
sibling, if non-NIL, is the container below viewer
];
BuildNewControlViewer: PROC [data: Data, trc: Trc.TRC, paint: BOOLTRUE] ~ {
IF data.controlV#NIL THEN ViewerOps.DestroyViewer[viewer: data.controlV, paint: FALSE];
data.controlV ← Trc.BuildControlViewer[trc: trc, info: [parent: data.viewer, wx: 0, wy: sq*15, ww: 17*sq, wh: sq*3, border: FALSE, scrollable: FALSE]]; --This should init trc.instance
ViewerOps.EstablishViewerPosition[viewer: data.controlV, x: data.controlV.wx, y: data.controlV.wy, w: 1000, h: IF data.controlV.openHeight=0 THEN data.controlV.wh ELSE data.controlV.openHeight];
ViewerOps.EstablishViewerPosition[viewer: data.viewer, x: data.viewer.wx, y: data.viewer.wy, w: data.viewer.ww, h: data.controlV.wy + data.controlV.wh];
IF data.sibling#NIL THEN ViewerOps.EstablishViewerPosition[viewer: data.sibling, x: data.sibling.wx, y: data.viewer.wh + sq, w: data.sibling.ww, h: data.sibling.wh];
IF paint THEN {
ViewerOps.PaintViewer[viewer: data.controlV, hint: client];
IF data.sibling#NIL THEN ViewerOps.PaintViewer[viewer: data.sibling, hint: client];
};
};
NotifyEnumButtons: ChoiceButtons.SelectionNotifierProc = {
data: Data ~ NARROW[clientdata];
trc: Trc.TRC ~ NEW[Trc.TRCRep ← [class: Trc.ClassFromFlavor[Convert.AtomFromRope[name]], instance: NIL]];
NewTrcInMainViewer[data, trc, FALSE];
ViewerOps.PaintViewer[viewer: data.viewer.parent, hint: client];
};
MakeTrcTool: PUBLIC PROC [info: ViewerClasses.ViewerRec ← []] RETURNS [v: ViewerClasses.Viewer] ~ {
FillContainer: PROC [v, sibling: ViewerClasses.Viewer, novice: BOOL] ~ {
iden: Trc.TRC ~ TrcStandardClasses.NewIdentityTrc[];
GetButtonList: PROC [preferredDefault: ATOM] RETURNS [list: ChoiceButtons.ButtonList ← NIL, default: ROPENIL] ~ {
EnumProc: Trc.ClassEnumProc = {
[class: Trc.Class] RETURNS [quit: BOOL ← FALSE]
rope: ROPE ~ Convert.RopeFromAtom[from: class.flavor, quote: FALSE];
IF class.flavor=preferredDefault THEN default ← rope;
IF class.control#NIL THEN list ← CONS[rope, list];
};
(IF novice THEN TrcStandardClasses.EnumerateRegisteredParametricClasses ELSE Trc.EnumerateRegisteredClasses)[EnumProc];
IF default=NIL THEN default ← list.first;
};
data: Data ~ NEW[DataRep ← [novice: novice, viewer: v, sibling: sibling, chainTrc: chain]];
buttonList: ChoiceButtons.ButtonList;
defaultButton: ROPE;
[list: buttonList, default: defaultButton] ← GetButtonList[IF novice THEN $Linear ELSE $Edit];
[] ← ChoiceButtons.BuildEnumTypeSelection[viewer: v, x: 0, y: 0, buttonNames: buttonList, default: defaultButton, borderOnButtons: FALSE, notifyClientProc: NotifyEnumButtons, clientdata: data, style: menuSelection, allInOneRow: FALSE, maxWidth: 17*sq];
data.trcV ← TrcViewers.CreateTRCViewer[trc: TrcStandardClasses.NewIdentityTrc[], rectangle: [0,0,1,1], dx: 0.05, info: IF data.novice THEN [parent: data.viewer, wx: 12*sq, wy: 3*sq, ww: 5*sq, wh: 5*sq, scrollable: FALSE] ELSE [parent: data.viewer, wx: 0, wy: 3*sq, ww: 11*sq, wh: 11*sq, scrollable: FALSE], paint: FALSE];
NotifyEnumButtons[name: defaultButton, clientdata: data];
FOR column: NAT IN [0..2) DO
wx: INTEGER ~ sq*(12+3*column);
FOR row: NAT IN [(IF novice THEN 2 ELSE 0) .. 4) DO
wy: INTEGER ~ sq*(3+3*row);
[] ← TrcButtons.Create[trc: iden, rectangle: [0,0,1,1], dx: 0.1, info: [parent: v, wx: wx, wy: wy, ww: 2*sq, wh: 2*sq, scrollable: FALSE], proc: BugTrcButton, clientData: data, paint: FALSE];
ENDLOOP;
ENDLOOP;
};
chain: Trc.TRC ← TrcStandardClasses.NewChainTrc[LIST[TrcStandardClasses.NewIdentityTrc[], TrcStandardClasses.NewIdentityTrc[]]]; --The NIL's act as placeholders
top, bottom: ViewerClasses.Viewer;
IF info.name = NIL THEN info.name ← "Trc Tool";
v ← Containers.Create[info: info, paint: FALSE];
top ← Containers.Create[info: [border: FALSE, scrollable: FALSE, ww: v.ww, wh: v.wh, parent: v], paint: FALSE];
Containers.ChildXBound[container: v, child: top];
bottom ← Containers.Create[info: [border: FALSE, scrollable: FALSE, ww: v.ww, wh: v.wh, parent: v], paint: FALSE];
Containers.ChildXBound[container: v, child: bottom];
FillContainer[v: top, sibling: bottom, novice: TRUE];
FillContainer[v: bottom, sibling: NIL, novice: FALSE];
[] ← TrcViewers.CreateTRCViewer[trc: chain, rectangle: [0,0,1,1], dx: 0.05, info: [parent: top, wx: 0, wy: 3*sq, ww: 11*sq, wh: 11*sq, scrollable: FALSE]];
ViewerOps.SetOpenHeight[viewer: v, clientHeight: top.wy + top.wh + sq];
ViewerOps.PaintViewer[viewer: v, hint: all];
};
NewTrcInMainViewer: PROC [data: Data, trc: Trc.TRC, paint: BOOLTRUE] ~ {
TrcViewers.NewTrc[data.trcV, trc, paint];
BuildNewControlViewer[data, trc];
TrcStandardClasses.ReplaceNthTrcInChain[chain: data.chainTrc, new: trc, n: IF data.novice THEN 1 ELSE 0];
Trc.NotifyListeners[trc: trc, fork: TRUE];
};
BugTrcButton: Buttons.ButtonProc = {
[parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE]
button: ViewerClasses.Viewer ~ NARROW[parent];
data: Data ~ NARROW[clientData];
SELECT mouseButton FROM
red => { --Copy from button to main viewer
copy: Trc.TRC ~ Trc.Copy[TrcButtons.TrcFromButton[button]];
NewTrcInMainViewer[data, copy];
};
yellow => {
big: Trc.TRC ~ TrcViewers.InfoFromTRCViewer[data.trcV].trc;
little: Trc.TRC ~ TrcButtons.TrcFromButton[button];
TrcButtons.AttachNewTrcToButton[button: button, trc: big];
NewTrcInMainViewer[data, little];
};
blue => {
copy: Trc.TRC ~ Trc.Copy[TrcViewers.InfoFromTRCViewer[data.trcV].trc];
TrcButtons.AttachNewTrcToButton[button: button, trc: copy];
};
ENDCASE => ERROR;
};
END.