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];
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 = {
[key: RefTab.Key, val: RefTab.Val] RETURNS [quit: BOOLEAN]
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 = {
[trc: TRC] RETURNS [new: TRC]
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 = {
[trc: TRC, info: ViewerClasses.ViewerRec] RETURNS [viewer: ViewerClasses.Viewer]
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^;
this ref will be in both newP^ and oldP^
LOOPHOLE[newP,
LONG
POINTER
TO
LONG
POINTER]^ ←
NIL;
NIL the destination to force the following AssignRef to increment the ref
LOOPHOLE[newP,
REF
REF
ANY]^ ← r;
force AssignRef by faking out the compiler
};
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] ~ {
Blechh!!!
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 = {
[trc: TRC, listenerData: REF ANY]
ViewerOps.PaintViewer[viewer: NARROW[listenerData, Viewer], hint: client];
};
TrcNotify: ViewerClasses.NotifyProc = {
[self: ViewerClasses.Viewer, input: LIST OF REF ANY]
display: Display ~ NARROW[self.data];
display.trc.class.notify[viewer: self, trc: display.trc, input: input];
};
TrcPaint: ViewerClasses.PaintProc = {
[self: ViewerClasses.Viewer, context: Imager.Context, whatChanged: REF ANY, clear: BOOL] RETURNS [quit: BOOL ← FALSE]
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 = {
[self: ViewerClasses.Viewer, change: ViewerClasses.ModifyAction]
Body
};
TrcDestroy: ViewerClasses.DestroyProc = {
[self: ViewerClasses.Viewer]
display: Display ~ NARROW[self.data];
DeinstallListener[registration: display.listenerRegistration];
display.trc ← NIL
};
TrcSave: ViewerClasses.SaveProc = {
[self: ViewerClasses.Viewer, force: BOOL ← FALSE]
Body
};
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];