DIRECTORY
Trc, TrcViewers,
Allocator USING [bsiEscape, EHeaderP, ExtendedHeader, NHeaderP, NormalHeader],
AllocatorOps USING [bsiToSize, NewObject, REFToNHP],
Containers USING [Create],
Imager USING [DoSaveAll, MaskVector, Rectangle, Scale2T, SetStrokeEnd, SetStrokeJoint, SetStrokeWidth, TranslateT],
PrincOpsUtils USING [LongCopy],
Process USING [Detach],
Real USING [RoundC],
RefTab USING [Create, EachPairAction, Fetch, Pairs, Ref, Store],
RTTypesBasicPrivate USING [MapRefOffsets],
SafeStorage USING [GetReferentType],
TIPUser USING [TIPScreenCoords],
Vector2 USING [VEC],
ViewerClasses USING [DestroyProc, ModifyProc, NotifyProc, PaintProc, SaveProc, ViewerClass, ViewerClassRec],
ViewerOps USING [CreateViewer, PaintViewer, RegisterViewerClass],
VM USING [WordsForPages];


TrcImpl: CEDAR MONITOR
IMPORTS AllocatorOps, Containers, Imager, PrincOpsUtils, Process, Real, RefTab, RTTypesBasicPrivate, SafeStorage, Trc, ViewerOps, VM
EXPORTS Trc, TrcViewers
~ BEGIN
OPEN Trc;

classes: RefTab.Ref ~ RefTab.Create[];
RegisterClass: PUBLIC PROC [class: Class] ~ {
[] _ RefTab.Store[x: classes, key: class.flavor, val: class];
};
EnumerateRegisteredClasses: PUBLIC PROC [proc: ClassEnumProc] ~ {
EnumClasses: RefTab.EachPairAction = {
RETURN [proc[NARROW[val, Class]]];
};
[] _ RefTab.Pairs[x: classes, action: EnumClasses];
};
DefaultBlockFcn: PUBLIC BlockFcn ~ UNCHECKED {
FOR k: NAT IN [0..count) DO
to[k] _ trc.class.fcn[trc, from[k]];
ENDLOOP;
};
DefaultCopy: PUBLIC CopyProc = {
new _ NEW[TRCRep _ [class: trc.class, instance: NewRef[trc.instance], listener: NIL]];
};
DefaultPickle: PUBLIC PickleProc ~ {};
DefaultDepickle: PUBLIC DepickleProc ~ {};
DefaultNotify: PUBLIC NotifyProc ~ {};
DefaultBackground: PUBLIC BackgroundProc ~ {};
DefaultControl: PUBLIC BuildControlViewerProc = {
viewer _ Containers.Create[info: info];
viewer.openHeight _ 1;
};
NewRef: PROC [old: REF] RETURNS [new: REF] ~ TRUSTED {
UsableWords: UNSAFE PROC [ref: REF] RETURNS [size: INT] ~ UNCHECKED {
OPEN Allocator;
ExtendedBlockSize: UNSAFE PROC [ehp: EHeaderP] RETURNS [words: INT _ 0] = UNCHECKED INLINE {
SELECT ehp.sizeTag FROM
words =>  words _ ehp.extendedSize;
pages => words _ VM.WordsForPages[ehp.extendedSize];
ENDCASE => ERROR;
};
NHPToEHP: UNSAFE PROC [nhp: NHeaderP] RETURNS [EHeaderP] = INLINE {
RETURN [LOOPHOLE[nhp - (SIZE[ExtendedHeader] - SIZE[NormalHeader]), EHeaderP]];
};
nhp: NHeaderP ~ AllocatorOps.REFToNHP[ref];
IF nhp.blockSizeIndex # Allocator.bsiEscape
THEN RETURN [AllocatorOps.bsiToSize[nhp.blockSizeIndex] - SIZE[NormalHeader]]
ELSE RETURN [ExtendedBlockSize[NHPToEHP[nhp]] - SIZE[ExtendedHeader]];
};
EachContainedRef: UNSAFE PROC [offset: LONG CARDINAL] ~ {
newP: LONG POINTER = LOOPHOLE[new, LONG POINTER] + offset;
oldP: LONG POINTER TO REF = LOOPHOLE[old, LONG POINTER] + offset;
r: REF = oldP^;
LOOPHOLE[newP, LONG POINTER TO LONG POINTER]^ _ NIL;
LOOPHOLE[newP, REF REF ANY]^ _ r;
};
count: CARDINAL ~ UsableWords[old];
new _ AllocatorOps.NewObject[type: SafeStorage.GetReferentType[old], size: count];
PrincOpsUtils.LongCopy[from: LOOPHOLE[old], nwords: count, to: LOOPHOLE[new]];
RTTypesBasicPrivate.MapRefOffsets[ref: old, procLeaf: EachContainedRef];	--Copy the contained REFs by hand to maintain proper reference counts
};
ClassFromFlavor: PUBLIC PROC [flavor: ATOM] RETURNS [class: Class] ~ {
RETURN [NARROW[RefTab.Fetch[x: classes, key: flavor].val]];
};
Registration: TYPE ~ RECORD [trc: TRC, listener: Listener];
InstallListener: PUBLIC PROC [trc: TRC, listener: Listener] RETURNS [registration: REF] ~ {
trc.listener _ CONS[listener, trc.listener];
RETURN [NEW[Registration _ [trc, listener]]];
};
DeinstallListener: PUBLIC PROC [registration: REF] ~ {
reg: REF Registration ~ NARROW[registration];
new: LIST OF Listener _ NIL;
FOR each: LIST OF Listener _ reg.trc.listener, each.rest UNTIL each=NIL DO
IF each.first#reg.listener THEN new _ CONS[each.first, new];
ENDLOOP;
reg.trc.listener _ new;
};
NotifyListeners: PUBLIC PROC [trc: TRC, fork: BOOL _ FALSE] ~ {
FOR each: LIST OF Listener _ trc.listener, each.rest UNTIL each=NIL DO
IF fork THEN TRUSTED {
Process.Detach[FORK each.first.proc[trc: trc, listenerData: each.first.listenerData]];
}
ELSE {
each.first.proc[trc: trc, listenerData: each.first.listenerData];
};
ENDLOOP;
};
BuildTable: PUBLIC PROC [nElements: NAT, first, delta: REAL] RETURNS [table: Table] ~ {
table _ NEW[TableRep[nElements]];
FOR k: NAT IN [0..nElements) DO
table[k] _ first + delta*k;
ENDLOOP;
};
UnsafeTableFromTable: PUBLIC PROC [table: Table, start, count: NAT _ 0] RETURNS [unsafeTable: UnsafeTable] ~ TRUSTED {
IF count=0 THEN count _ table.n-start;
IF start+count > table.n THEN ERROR;
RETURN [LOOPHOLE[@table[start]]];
};

Display: TYPE ~ REF DisplayRep;
DisplayRep: TYPE ~ RECORD [
trc: TRC,
rectangle: Imager.Rectangle,
dx: REAL,
listenerRegistration: REF,
clientData: REF
];
CreateTRCViewer: PUBLIC PROC [trc: TRC, rectangle: Rectangle, dx: REAL, info: ViewerRec, paint: BOOL _ TRUE] RETURNS [viewer: Viewer] ~ {
display: Display ~ NEW[DisplayRep _ [
trc: trc,
rectangle: rectangle,
dx: dx,
clientData: info.data
]];
info.data _ display;
info.scrollable _ info.hscrollable _ FALSE;
IF info.tipTable=NIL THEN info.tipTable _ trc.class.tipTable;
viewer _ ViewerOps.CreateViewer[flavor: $Trc, info: info, paint: paint];
IF trc.class.tipTable#NIL THEN viewer.tipTable _ trc.class.tipTable;
display.listenerRegistration _ InstallListener[trc: trc, listener: [proc: TrcViewerListener, listenerData: viewer]];
IF paint THEN ViewerOps.PaintViewer[viewer: viewer, hint: all];
};
NewTrc: PUBLIC PROC [viewer: Viewer, trc: TRC, paint: BOOL _ TRUE] ~ {
display: Display ~ NARROW[viewer.data];
Trc.DeinstallListener[display.listenerRegistration];
display.trc _ trc;
display.listenerRegistration _ InstallListener[trc: trc, listener: [proc: TrcViewerListener, listenerData: viewer]];
IF paint THEN ViewerOps.PaintViewer[viewer: viewer, hint: all];
viewer.tipTable _ trc.class.tipTable;
};
InfoFromTRCViewer: PUBLIC PROC [viewer: Viewer] RETURNS [trc: TRC, rectangle: Rectangle, dx: REAL, clientData: REF] ~ {
display: Display ~ NARROW[viewer.data];
RETURN [trc: display.trc, rectangle: display.rectangle, dx: display.dx, clientData: display.clientData]
};
ResetTRCViewer: PUBLIC PROC [viewer: Viewer, rectangle: Rectangle, dx: REAL, clientData: REF] ~ {
display: Display ~ NARROW[viewer.data];
display^ _ [trc: display.trc, rectangle: rectangle, dx: dx, clientData: clientData];
};
VecFromTIPCoords: PUBLIC PROC [viewer: Viewer, coords: TIPUser.TIPScreenCoords] RETURNS [vec: Vector2.VEC] ~ {
display: Display ~ NARROW[viewer.data];
RETURN [ Vector2.VEC [x: display.rectangle.x+display.rectangle.w*coords.mouseX/viewer.cw, y: display.rectangle.y+display.rectangle.h*coords.mouseY/viewer.ch]];
};
TrcViewerListener: ListenerProc = {
ViewerOps.PaintViewer[viewer: NARROW[listenerData, Viewer], hint: client];
};
TrcNotify: ViewerClasses.NotifyProc = {
display: Display ~ NARROW[self.data];
display.trc.class.notify[viewer: self, trc: display.trc, input: input];
};
TrcPaint: ViewerClasses.PaintProc = {
PaintBackground: PROC ~ {
Trc.PaintBackground[trc: display.trc, context: context, rectangle: display.rectangle, whatChanged: whatChanged];
};
display: Display ~ NARROW[self.data];
Imager.Scale2T[context: context, s: [x: self.cw/display.rectangle.w, y: self.ch/display.rectangle.h]];
Imager.TranslateT[context: context, t: [x: display.rectangle.x, y: display.rectangle.y]];
Imager.SetStrokeEnd[context: context, strokeEnd: butt];
Imager.SetStrokeJoint[context: context, strokeJoint: mitered];
Imager.SetStrokeWidth[context: context, strokeWidth: 2*display.rectangle.w/self.cw];
Imager.DoSaveAll[context: context, action: PaintBackground];

IF whatChanged=NIL THEN TRUSTED {	--Actually paint the trc itself...
nElements: NAT ~ 1+MIN[self.cw, Real.RoundC[display.rectangle.w/display.dx]];
delta: REAL ~ display.rectangle.w/nElements;
from: Table ~ BuildTable[nElements: nElements, first: display.rectangle.x, delta: delta];
to: Table ~ NEW[TableRep[nElements]];
last, this: VEC;

from[nElements-1] _ display.rectangle.x + display.rectangle.w;
ApplyBlockFcn[trc: display.trc, from: UnsafeTableFromTable[from], to: UnsafeTableFromTable[to], count: nElements];
last _ [x: from[0], y: to[0]];
FOR k: NAT IN [1..nElements) DO
Imager.MaskVector[context: context, p1: last, p2: this _ [x: from[k], y: to[k]]];
last _ this;
ENDLOOP;

};
};
TrcModify: ViewerClasses.ModifyProc = {
};
TrcDestroy: ViewerClasses.DestroyProc = {
display: Display ~ NARROW[self.data];
DeinstallListener[registration: display.listenerRegistration];
display.trc _ NIL
};
TrcSave: ViewerClasses.SaveProc = {
};
trcViewerClass: ViewerClasses.ViewerClass ~ NEW[ViewerClasses.ViewerClassRec _ [
flavor: $Trc,
notify: TrcNotify,
paint: TrcPaint,
modify: TrcModify,
destroy: TrcDestroy,
save: TrcSave,
cursor: crossHairsCircle,
icon: private
]];

ViewerOps.RegisterViewerClass[flavor: $Trc, class: trcViewerClass];

END.
:TrcImpl.mesa
Copyright c 1986 by Xerox Corporation.  All rights reserved.
Eric Nickell, April 10, 1986 1:33:19 am PST

[key: RefTab.Key, val: RefTab.Val] RETURNS [quit: BOOLEAN]
[trc: TRC] RETURNS [new: TRC]
[trc: TRC, info: ViewerClasses.ViewerRec] RETURNS [viewer: ViewerClasses.Viewer]
this ref will be in both newP^ and oldP^
NIL the destination to force the following AssignRef to increment the ref
force AssignRef by faking out the compiler
Blechh!!!
[trc: TRC, listenerData: REF ANY]
[self: ViewerClasses.Viewer, input: LIST OF REF ANY]
[self: ViewerClasses.Viewer, context: Imager.Context, whatChanged: REF ANY, clear: BOOL] RETURNS [quit: BOOL _ FALSE]
[self: ViewerClasses.Viewer, change: ViewerClasses.ModifyAction]

Body
[self: ViewerClasses.Viewer]
[self: ViewerClasses.Viewer, force: BOOL _ FALSE]

Body
Κ˜™Icodešœ
Οm
œ1™<K™+K™—š
Οk	˜	K˜Kšœ
žœ?˜NKšœ
žœ"˜4Kšœžœ
˜Kšœžœg˜sKšœžœ˜Kšœžœ
˜Kšœžœ
˜Kšœžœ4˜@Kšœžœ˜*Kšœžœ˜$Kšœžœ˜ Kšœžœžœ˜KšœžœY˜lKšœ
žœ2˜AKšžœ
žœ˜K˜—K˜KšΠlnœž
˜Kšžœ{ž˜„
Kšžœ˜Kšœž˜šžœ˜	K˜Icode2•StartOfExpansion#[mod: 
RefTab.SeqIndex _ 21B (17)]˜&šΟn
œžœ˜-K–7[x: 
RefTab.Ref, key: 
RefTab.Key, val: 
RefTab.Val]˜=K˜—š œžœ˜A–> -- [key: RefTab.Key, val: RefTab.Val] RETURNS [quit: BOOLEAN]š
œ&˜&Kš
Πck:™:Kšžœžœ˜"K˜—K˜3K˜—šœžœž	œ˜.šžœžœ
žœž˜K˜$Kšžœ
˜—Kš
œ˜—–! -- [trc: TRC] RETURNS [new: TRC]šœ
žœ
˜ Kš
‘™KšœžœGžœ˜VK˜—Kšœžœ˜&Kšœžœ˜*Kšœžœ˜&Kšœžœ˜.–T -- [trc: TRC, info: ViewerClasses.ViewerRec] RETURNS [viewer: ViewerClasses.Viewer]šœžœ˜1Kš
‘P™PK–™[info: 
ViewerClasses.ViewerRec _ [class: NIL, wx: 0, wy: 0, ww: 0, wh: 0, cx: 0, cy: 0, cw: 0, ch: 0, lock: [process: PROCESS#0B, count: 0B (0)], tipTable: NIL, name: NIL, file: NIL, label: NIL, menu: NIL, icon: 177777B?, column: left, caption: FALSE, scrollable: TRUE, hscrollable: FALSE, iconic: TRUE, border: TRUE, newVersion: FALSE, newFile: FALSE, visible: TRUE, offDeskTop: FALSE, destroyed: FALSE, init: FALSE, saveInProgress: FALSE, inhibitDestroy: FALSE, guardDestroy: FALSE, paintingWedged: FALSE, ...], paint: 
BOOL _ TRUE]˜'K˜K˜—š œžœžœžœžœžœ˜6š œžœ
žœžœžœžœž	œ˜EKšžœ˜š œžœ
žœžœ	žœž	œ
žœ˜\šžœ
ž˜Kš
œ#˜#Kšœžœ!˜4Kšžœžœ
˜—Kš
œ˜—š
 œžœ
žœžœžœ˜CKšžœžœžœžœ˜OK˜—K˜+šžœ)˜+Kšžœ
žœ/žœ˜MKšžœ
žœ%žœ˜F—K˜—š
 œžœ
žœ
žœ
žœ˜9Kšœžœ
žœžœžœ
žœ˜:Kšœžœ
žœ
žœ
žœžœžœ
žœ˜Ašœžœ	˜K™(—šžœžœ
žœ
žœ
žœ
žœžœ
˜4K™I—šžœžœ
žœ
žœ˜!K™*—K˜—Kšœžœ˜#K–[ref: 
REF ANY]˜RKšœžœžœ˜NK–([ref: 
REF ANY, procLeaf: 
PROC [...]]šœIΟcE˜Ž
K˜—š œžœ
žœžœ˜FK–$[x: 
RefTab.Ref, key: 
RefTab.Key]šžœžœ-˜;K˜—Lšœžœžœžœ˜;š
 œžœžœžœžœ˜[Kšœžœ˜,Kšžœžœ"˜-K˜—š œžœžœ˜6K™	Kšœžœžœ˜-Kšœžœ
žœžœ
˜šžœžœ
žœ(žœžœ
ž˜JKšžœžœžœ˜<Kšžœ
˜—K˜K˜—š
 œžœžœžœžœ˜?šžœžœ
žœ$žœžœ
ž˜Fšžœžœ
žœ˜K–	[PROCESS]šœžœC˜VKš
œ
˜
—šžœ˜Kš
œA˜AKš
œ˜—Kšžœ
˜—K˜—š
 
œžœ
žœžœžœ˜WKšœžœ˜!šžœžœ
žœž˜K˜Kšžœ
˜—K˜—š œžœ
žœžœžœžœ˜vKšžœ	žœ˜&Kšžœžœ
žœ
˜$Kšžœžœ˜!K˜—K˜šœ	žœžœ˜šœžœžœ˜Kšœžœ
˜	K˜Kšœžœ
˜	Kšœžœ
˜Kšœž˜Kš
œ˜——š œžœžœžœžœžœžœ˜‰
šœžœ˜%K˜	K˜K˜K˜K˜—K˜Kšœ%žœ
˜+Kšžœžœ
žœ$˜=K–Ώ[flavor: 
ViewerClasses.ViewerFlavor, info: 
ViewerClasses.ViewerRec _ [class: NIL, wx: 0, wy: 0, ww: 0, wh: 0, cx: 0, cy: 0, cw: 0, ch: 0, lock: [process: PROCESS#0B, count: 0B (0)], tipTable: NIL, name: NIL, file: NIL, label: NIL, menu: NIL, icon: 177777B?, column: left, caption: FALSE, scrollable: TRUE, hscrollable: FALSE, iconic: TRUE, border: TRUE, newVersion: FALSE, newFile: FALSE, visible: TRUE, offDeskTop: FALSE, destroyed: FALSE, init: FALSE, saveInProgress: FALSE, inhibitDestroy: FALSE, guardDestroy: FALSE, paintingWedged: FALSE, ...], paint: 
BOOL _ TRUE]š
œH˜HKšžœžœ
žœ&˜DK–&[trc: 
TRC, listener: 
Trc.Listener]š
œt˜tK–w[viewer: 
ViewerClasses.Viewer, hint: 
ViewerOps.PaintHint, clearClient: 
BOOL _ TRUE, whatChanged: 
REF ANY _ NIL]šžœžœ2˜?K˜—š
 œžœžœ	žœžœ˜FKšœžœ˜'Kš
œ4˜4K˜Kš
œt˜tK–w[viewer: 
ViewerClasses.Viewer, hint: 
ViewerOps.PaintHint, clearClient: 
BOOL _ TRUE, whatChanged: 
REF ANY _ NIL]šžœžœ2˜?K˜%K˜—–% -- [trc: TRC, listenerData: REF ANY]š œžœ
žœžœžœžœžœ˜wKšœžœ˜'Kšžœa˜gK˜—š
 œžœ
žœ,žœžœ˜aKšœžœ˜'Kš
œT˜TK˜—š œžœ3žœžœ˜nKšœžœ˜'Kšžœžœ‹
˜Ÿ
K˜—š
œ#˜#Lš
‘!™!L–w[viewer: 
ViewerClasses.Viewer, hint: 
ViewerOps.PaintHint, clearClient: 
BOOL _ TRUE, whatChanged: 
REF ANY _ NIL]šœžœ&˜JL˜—˜'Kš
‘4™4Kšœžœ˜%K˜GK˜—–y -- [self: ViewerClasses.Viewer, context: Imager.Context, whatChanged: REF ANY, clear: BOOL] RETURNS [quit: BOOL _ FALSE]˜%Kš
‘u™u–%[context: 
Imager.Context, s: 
VEC]š œžœ˜K˜pK˜—Kšœžœ˜%Kš
œf˜fK–%[context: 
Imager.Context, t: 
VEC]š
œY˜YK–:[context: 
Imager.Context, strokeEnd: 
Imager.StrokeEnd]˜7K–>[context: 
Imager.Context, strokeJoint: 
Imager.StrokeJoint]˜>K–0[context: 
Imager.Context, strokeWidth: 
REAL]˜TK–+[context: 
Imager.Context, action: 
PROC]˜<K˜š	žœ
žœ
žœ
žœ’"˜DKšœžœžœ7˜MKšœžœ!˜,K–0[nElements: 
NAT, first: 
REAL, delta: 
REAL]š
œY˜YKšœžœ˜%Kšœžœ
˜K˜K˜>K˜rK˜šžœžœ
žœž˜K–1[context: 
Imager.Context, p1: 
VEC, p2: 
VEC]š
œQ˜QK˜Kšžœ
˜—K˜Kš
œ˜—K˜—–D -- [self: ViewerClasses.Viewer, change: ViewerClasses.ModifyAction]˜'Kš
‘@™@K™K˜—–  -- [self: ViewerClasses.Viewer]˜)Kš
‘™Kšœžœ˜%K–[registration: 
REF ANY]š
œ>˜>Kšœž˜K˜—–5 -- [self: ViewerClasses.Viewer, force: BOOL _ FALSE]˜#Kš
‘1™1K™K˜—šœ,žœ!˜PK˜
K˜K˜K˜K˜K˜K˜K˜
K˜—K˜K–J[flavor: 
ViewerClasses.ViewerFlavor, class: 
ViewerClasses.ViewerClass]˜C—K˜Kšžœ
˜—…—"π:D