TrcEditImpl.mesa
Copyright © 1986 by Xerox Corporation. All rights reserved.
Eric Nickell, January 14, 1987 8:29:36 am PST
DIRECTORY
TrcEdit,
Convert USING [RealFromRope],
Draw2d USING [Line],
Imager USING [black, Color, --MaskVector,-- SetColor, SetStrokeWidth, white],
ImagerBackdoor USING [GetReal],
IO USING [GetCedarTokenRope, PutF, PutRope, TokenKind],
Real USING [CompareREAL],
RedBlackTree, --using lots...
Rope USING [Equal, Fetch, ROPE],
TIPUser USING [InstantiateNewTIPTable, TIPScreenCoords],
Trc,
TrcTool USING [NewSelectableTrc, SelectNewTrc],
TrcViewers USING [VecFromTIPCoords],
Vector2 USING [InlineAdd, Length, Sub, VEC],
ViewerClasses USING [Viewer, ViewerRec],
ViewerOps USING [PaintViewer];
TrcEditImpl: CEDAR PROGRAM
IMPORTS Convert, Draw2d, Imager, ImagerBackdoor, IO, Real, RedBlackTree, Rope, TIPUser, Trc, TrcTool, TrcViewers, Vector2, ViewerOps
EXPORTS TrcEdit
~ BEGIN
OPEN TrcEdit;
ROPE: TYPE ~ Rope.ROPE;
VEC: TYPE ~ Vector2.VEC;
margin: NAT ~ 10;
EditInstance: TYPE ~ REF EditInstanceRep;
EditInstanceRep: TYPE ~ RECORD [
trc: Trc.TRC ← TrcTool.NewSelectableTrc[],
listener: REF ← NIL,
pins: RedBlackTree.Table ← RedBlackTree.Create[getKey: TrcEditGet, compare: TrcEditCompare],
joinPin: BOOL ← FALSE,
selected: REAL, --When action~select, this contains x-value of selected pin
toAdjust: VEC,
action: EditAction ← none
];
EditAction: TYPE ~ {none, abort, insert, delete, select};
MarkRequest: TYPE ~ RECORD [vec: VEC, color: Imager.Color ← Imager.black];
Pin: TYPE ~ REF PinRep;
PinRep: TYPE ~ RECORD [
vec: Vector2.VEC
];
EditControlData: TYPE ~ REF EditControlDataRep;
EditControlDataRep: TYPE ~ RECORD [
container, childControl: ViewerClasses.Viewer ← NIL,
trc: Trc.TRC ← NIL,
y: INTEGER
];
NewEditTrc: PUBLIC PROC [underlying: Trc.TRC] RETURNS [trc: Trc.TRC] ~ {
instance: EditInstance ← NEW[EditInstanceRep];
trc ← NEW[Trc.TRCRep ← [class: editClass, instance: instance]];
instance.listener ← Trc.InstallListener[trc: instance.trc, listener: [EditListener, trc]];
};
NewUnderlyingTrc: PUBLIC PROC [edit, new: Trc.TRC, notify: BOOL ← TRUE] ~ {
instance: EditInstance ~ NARROW[edit.instance];
Trc.DeinstallListener[registration: instance.listener];
instance.trc ← new;
instance.listener ← Trc.InstallListener[trc: new, listener: [EditListener, edit]];
IF notify THEN Trc.NotifyListeners[trc: edit];
};
GetUnderlyingTrc: PUBLIC PROC [edit: Trc.TRC] RETURNS [underlying: Trc.TRC] ~ {
instance: EditInstance ~ NARROW[edit.instance];
RETURN [instance.trc];
};
EditFcn: Trc.Fcn = {
[trc: TRC, a: REAL] RETURNS [b: REAL]
VecFromRef: PROC [ref: REF] RETURNS [vec: VEC] ~ {
WITH ref SELECT FROM
p: Pin => RETURN [p^];  --This will return NIL as well
real: REF REAL => RETURN [[x: real^, y: Trc.ApplyFcn[instance.trc, real^]]];
ENDCASE => ERROR;
};
Join: PROC [ref: REF] RETURNS [join: BOOL] ~ INLINE {
RETURN [ref=NIL OR ISTYPE[ref, REF REAL]]
};
instance: EditInstance ~ NARROW[trc.instance];
left, equal, right: REF;
[left, equal, right] ← RedBlackTree.Lookup3[self: instance.pins, lookupKey: RealToRef[a]];
SELECT TRUE FROM
equal#NIL => RETURN [VecFromRef[equal].y];
Join[left] AND Join[right] => RETURN [Trc.ApplyFcn[instance.trc, a]]; --This covers the case that we're between two join pins, or that we're outside the extreme pin and it's a join pin, or that there are no pins at all.
left=NIL => RETURN [NARROW[right, Pin].y]; --Note that left=NIL => ~Join[right] (see previous check) => right#NIL AND ~ISTYPE[right, REF REAL] => ISTYPE[right, Pin]
Englishly, we're to the left of all the pins, the leftmost of which is a fixed Pin.
right=NIL => RETURN [NARROW[left, Pin].y] --Note that right=NIL => ~Join[left] (see previous check) => left#NIL AND ~ISTYPE[left, REF REAL] => ISTYPE[left, Pin]
Englishly, we're to the right of all the pins, the rightmost of which is a fixed Pin.
ENDCASE => { --We're between two pins, at least one of which is a fixed Pin.
vLeft: VEC ~ VecFromRef[left];
vRight: VEC ~ VecFromRef[right];
alpha: REAL ~ (a-vLeft.x)/(vRight.x-vLeft.x);
RETURN [alpha*(vRight.y) + (1.0-alpha)*(vLeft.y)]
};
};
EditNotify: Trc.NotifyProc = {
[viewer: ViewerClasses.Viewer, trc: TRC, input: LIST OF REF ANY]
instance: EditInstance ~ NARROW[trc.instance];
vec: Vector2.VEC;
markRequests: LIST OF MarkRequest ← NIL;
FOR each: LIST OF REF ANY ← input, each.rest UNTIL each=NIL DO
WITH each.first SELECT FROM
coords: TIPUser.TIPScreenCoords => {
vec ← TrcViewers.VecFromTIPCoords[viewer: viewer, coords: coords];
};
token: ATOM => SELECT token FROM
$Commit => {
IF instance.action=select THEN [] ← RedBlackTree.Delete[self: instance.pins, deleteKey: RealToRef[instance.selected]]; --select same as insert except for this...
SELECT instance.action FROM
delete => [] ← RedBlackTree.Delete[self: instance.pins, deleteKey: RealToRef[instance.toAdjust.x]];
insert, select => RedBlackTree.Insert[self: instance.pins, dataToInsert: IF instance.joinPin THEN NEW[REAL ← instance.toAdjust.x] ELSE NEW[PinRep ← [instance.toAdjust]], insertKey: RealToRef[instance.toAdjust.x]];
ENDCASE;
instance.action ← none;
instance.joinPin ← FALSE;
Trc.NotifyListeners[trc: trc, fork: TRUE];
};
$Abort => instance.action ← abort;
$JoinPin => instance.joinPin ← TRUE;
$Insert => {
UNTIL RedBlackTree.Lookup[self: instance.pins, lookupKey: RealToRef[vec.x]]=NIL DO
This is an extreme kludge to get slightly off the pin, but to be as close as can be to it.
vec.x ← LOOPHOLE[SUCC[LOOPHOLE[vec.x, INT]], REAL];
ENDLOOP;
instance.action ← insert;
IF instance.joinPin THEN vec.y ← Trc.ApplyFcn[instance.trc, vec.x]; --If a joinPin, then set y-value to match underlying trc
instance.toAdjust ← vec;
markRequests ← LIST[[vec]];
};
$Select => {
[instance.toAdjust, instance.joinPin] ← FindNearestPin[pins: instance.pins, loc: vec, trc: instance.trc ! NoPins => GOTO Abort];
instance.selected ← instance.toAdjust.x;
instance.action ← select;
markRequests ← LIST[[instance.toAdjust, Imager.white]];
EXITS Abort => instance.action ← abort;
};
$Delete => {
[instance.toAdjust, instance.joinPin] ← FindNearestPin[pins: instance.pins, loc: vec, trc: instance.trc ! NoPins => GOTO Abort];
instance.action ← delete;
markRequests ← LIST[[instance.toAdjust, Imager.white]];
EXITS Abort => instance.action ← abort;
};
$Adjust => SELECT instance.action FROM
delete => {
markRequests ← LIST[[instance.toAdjust]];
ViewerOps.PaintViewer[viewer: viewer, hint: client, clearClient: FALSE, whatChanged: NARROW[LIST[[instance.toAdjust]], LIST OF MarkRequest]]; --This clearing operation has to be specifically done, as we don't know that the repaint will be of the same shape, as the value of instance.joinPin may change
[instance.toAdjust, instance.joinPin] ← FindNearestPin[pins: instance.pins, loc: vec, trc: instance.trc];
markRequests ← LIST[[instance.toAdjust, Imager.white]];
};
select => {
XFromRef: PROC [ref: REF] RETURNS [x: REAL] ~ {
WITH ref SELECT FROM
p: Pin => RETURN [p^.x];  --This will return NIL as well
real: REF REAL => RETURN [real^];
ENDCASE => ERROR;
};
ref: REF ~ RedBlackTree.Lookup[self: instance.pins, lookupKey: RealToRef[vec.x]];
IF ref=NIL OR XFromRef[ref]=instance.selected THEN { --We'll pretend we didn't see it iff he's exactly vertically aligned with a different pin
IF instance.joinPin THEN vec.y ← Trc.ApplyFcn[instance.trc, vec.x];
markRequests ← LIST[[instance.toAdjust, Imager.white], [vec]];
instance.toAdjust ← vec;
};
};
insert => {
IF RedBlackTree.Lookup[self: instance.pins, lookupKey: RealToRef[vec.x]]=NIL THEN { --Otherwise ignore
IF instance.joinPin THEN vec.y ← Trc.ApplyFcn[instance.trc, vec.x];
markRequests ← LIST[[instance.toAdjust, Imager.white], [vec]];
instance.toAdjust ← vec;
};
};
ENDCASE;
ENDCASE;
ENDCASE;
ENDLOOP;
IF markRequests#NIL THEN ViewerOps.PaintViewer[viewer: viewer, hint: client, clearClient: FALSE, whatChanged: markRequests];
};
EditBackground: Trc.BackgroundProc = {
[trc: TRC, context: Imager.Context, rectangle: ImagerTransformation.Rectangle, whatChanged: REF ← NIL]
Mark: PROC [vec: VEC] ~ INLINE {
Imager.MaskVector[context: context, p1: vec.InlineAdd[[-d,-d]], p2: vec.InlineAdd[[d,d]]];
Imager.MaskVector[context: context, p1: vec.InlineAdd[[d,-d]], p2: vec.InlineAdd[[-d,d]]];
Draw2d.Line[context: context, vec0: vec.InlineAdd[[-d,-d]], vec1: vec.InlineAdd[[d,d]]];
Draw2d.Line[context: context, vec0: vec.InlineAdd[[d,-d]], vec1: vec.InlineAdd[[-d,d]]];
};
MarkPlus: PROC [vec: VEC] ~ INLINE {
Imager.MaskVector[context: context, p1: vec.InlineAdd[[-d,0]], p2: vec.InlineAdd[[d,0]]];
Imager.MaskVector[context: context, p1: vec.InlineAdd[[0,-d]], p2: vec.InlineAdd[[0,d]]];
Draw2d.Line[context: context, vec0: vec.InlineAdd[[-d,0]], vec1: vec.InlineAdd[[d,0]]];
Draw2d.Line[context: context, vec0: vec.InlineAdd[[0,-d]], vec1: vec.InlineAdd[[0,d]]];
};
instance: EditInstance ~ NARROW[trc.instance];
w: REAL ~ ImagerBackdoor.GetReal[context: context, key: strokeWidth];
d: REAL ~ 3*w;
Imager.SetStrokeWidth[context: context, strokeWidth: 0.0];
IF whatChanged=NIL THEN {
XMarksTheSpot: RedBlackTree.EachNode = {
[data: RedBlackTree.UserData] RETURNS [stop: BOOL ← FALSE]
WITH data SELECT FROM
pin: Pin => Mark[pin^];
real: REF REAL => MarkPlus[[x: real^, y: Trc.ApplyFcn[instance.trc, real^]]];
ENDCASE => ERROR;
};
RedBlackTree.EnumerateIncreasing[self: instance.pins, procToApply: XMarksTheSpot];
}
ELSE {
WITH whatChanged SELECT FROM
atom: ATOM => NULL;  --Somebody has us layered
markRequest: LIST OF MarkRequest => {
FOR each: LIST OF MarkRequest ← markRequest, each.rest UNTIL each=NIL DO
Imager.SetColor[context: context, color: each.first.color];
IF instance.joinPin THEN MarkPlus[each.first.vec] ELSE Mark[each.first.vec];
ENDLOOP;
};
ENDCASE => ERROR;
};
};
EditPickle: Trc.PickleProc = {
[trc: TRC, stream: STREAM, indentation: ROPE ← NIL]
instance: EditInstance ~ NARROW[trc.instance];
WriteEachPin: RedBlackTree.EachNode = {
[data: RedBlackTree.UserData] RETURNS [stop: BOOL ← FALSE]
WITH data SELECT FROM
pin: Pin => IO.PutF[stream: stream, format: "\n%g\t%g\t%g", v1: [rope[indentation]], v2: [real[pin.x]], v3: [real[pin.y]]];
real: REF REAL => IO.PutF[stream: stream, format: "\n%g\t%g\t*", v1: [rope[indentation]], v2: [real[real^]]]
ENDCASE => ERROR;
};
under: Trc.TRC ~ instance.trc;
IO.PutRope[self: stream, r: " {"];
RedBlackTree.EnumerateIncreasing[self: instance.pins, procToApply: WriteEachPin];
Trc.PickleArbitraryTrc[trc: under, stream: stream, indentation: indentation];
IO.PutF[stream: stream, format: "\n%g| %g", v1: [rope[indentation]], v2: [atom[under.class.flavor]]];
Trc.Pickle[trc: under, stream: stream, indentation: Rope.Concat[indentation, "\t"]];
IO.PutF[stream: stream, format: "\n%g}", v1: [rope[indentation]]];
};
EditDepickle: Trc.DepickleProc = {
[class: Trc.Class, stream: STREAM] RETURNS [trc: TRC]
instance: EditInstance ~ NEW[EditInstanceRep];
token: ROPE;
tokenKind: IO.TokenKind;
trc ← NEW[Trc.TRCRep ← [class: class, instance: instance, listener: NIL]];
IF ~IO.GetCedarTokenRope[stream: stream].token.Equal["{"] THEN ERROR;
[tokenKind: tokenKind, token: token] ← IO.GetCedarTokenRope[stream: stream];
WHILE tokenKind=tokenREAL DO
x: REAL ~ Convert.RealFromRope[token];
[tokenKind: tokenKind, token: token] ← IO.GetCedarTokenRope[stream: stream];
SELECT tokenKind FROM
tokenSINGLE => IF Rope.Fetch[token]='* THEN RedBlackTree.Insert[self: instance.pins, dataToInsert: NEW[REAL ← x], insertKey: RealToRef[x]];
tokenREAL => RedBlackTree.Insert[self: instance.pins, dataToInsert: NEW[PinRep ← [[x: x, y: Convert.RealFromRope[token]]]], insertKey: RealToRef[x]];
ENDCASE => ERROR;
[tokenKind: tokenKind, token: token] ← IO.GetCedarTokenRope[stream: stream];
ENDLOOP;
instance.trc ← Trc.DepickleArbitraryTrc[stream: stream];
IF instance.trc.class.flavor#$Selectable THEN {
temp: Trc.TRC ~ instance.trc;
instance.trc ← TrcTool.NewSelectableTrc[];
TrcTool.SelectNewTrc[trc: instance.trc, under: temp, paint: FALSE, notify: FALSE];
};
instance.listener ← Trc.InstallListener[trc: instance.trc, listener: [EditListener, trc]];
IF ~Rope.Equal[token, "|"] THEN ERROR;
{ --Depickle the underlying trc
flavor: ATOM ~ IO.GetAtom[stream: stream];
class: Trc.Class ~ Trc.ClassFromFlavor[flavor: flavor];
instance.trc ← TrcTool.NewSelectableTrc[];
TrcTool.SelectNewTrc[trc: instance.trc, under: Trc.Depickle[class, stream], paint: FALSE, notify: FALSE];
instance.listener ← Trc.InstallListener[trc: instance.trc, listener: [EditListener, trc]];
};
[tokenKind: tokenKind, token: token] ← IO.GetCedarTokenRope[stream: stream];
IF ~Rope.Equal[token, "}"] THEN ERROR;
};
EditControl: Trc.BuildControlViewerProc = {
[trc: TRC, info: ViewerClasses.ViewerRec, propList: Properties.PropList ← NIL] RETURNS [viewer: ViewerClasses.Viewer]
instance: EditInstance;
IF trc.instance=NIL THEN { --Need to instantiate viewer
trc.instance ← instance ← NEW[EditInstanceRep];
instance.listener ← Trc.InstallListener[trc: instance.trc, listener: [EditListener, trc]]
}
ELSE instance ← NARROW[trc.instance];
viewer ← Trc.BuildControlViewer[trc: instance.trc, info: info, paint: paint];
instance.listener ← Trc.InstallListener[trc: instance.trc, listener: [EditListener, trc]];
};
EditCopy: Trc.CopyProc = {
[trc: TRC] RETURNS [new: TRC]
CopyEachPin: RedBlackTree.EachNode = {
[data: RedBlackTree.UserData] RETURNS [stop: BOOL ← FALSE]
RedBlackTree.Insert[self: newInstance.pins, dataToInsert: data, insertKey: data];
};
instance: EditInstance ~ NARROW[trc.instance];
newInstance: EditInstance ~ NEW[EditInstanceRep];
new ← NEW[Trc.TRCRep ← [class: trc.class, instance: newInstance, listener: NIL]];
RedBlackTree.EnumerateIncreasing[self: instance.pins, procToApply: CopyEachPin];
newInstance.trc ← Trc.Copy[instance.trc];
newInstance.listener ← Trc.InstallListener[trc: newInstance.trc, listener: [EditListener, new]];
};
EditListener: Trc.ListenerProc = {
[trc: TRC, listenerData: REF ANY]
Trc.NotifyListeners[trc: NARROW[listenerData]];
};
editClass: Trc.Class ~ NEW[Trc.ClassRep ← [
flavor: $Edit,
fcn: EditFcn,
blockFcn: Trc.DefaultBlockFcn,
copy: EditCopy,
pickle: EditPickle,
depickle: EditDepickle,
notify: EditNotify,
tipTable: TIPUser.InstantiateNewTIPTable[file: "TrcEdit.tip"],
background: EditBackground,
control: EditControl,
classData: NIL
]];
RealToRef: PROC [real: REAL] RETURNS [ref: REF] ~ INLINE {
RETURN [NEW[REAL ← real]];
};
RefToReal: PROC [ref: REF] RETURNS [real: REAL] ~ INLINE {
WITH ref SELECT FROM
refReal: REF REAL => RETURN [refReal^];
pin: Pin => RETURN [pin.x]
ENDCASE => ERROR;
};
TrcEditGet: RedBlackTree.GetKey = {
[data: RedBlackTree.UserData] RETURNS [RedBlackTree.Key]
RETURN [data];
};
TrcEditCompare: RedBlackTree.Compare = {
[k: RedBlackTree.Key, data: RedBlackTree.UserData] RETURNS [Basics.Comparison]
RETURN [Real.CompareREAL[RefToReal[data], RefToReal[k]]];
};
NoPins: SIGNAL ~ CODE;
FindNearestPin: PROC [pins: RedBlackTree.Table, loc: VEC, trc: Trc.TRC] RETURNS [closest: VEC, joinPin: BOOL] ~ {
PinFromRef: PROC [ref: REF] RETURNS [pin: Pin] ~ {
IF ref=NIL THEN RETURN [NIL];
WITH ref SELECT FROM
p: Pin => RETURN [p];  --This will return NIL as well
real: REF REAL => RETURN [NEW[PinRep ← [[x: real^, y: Trc.ApplyFcn[trc, real^]]]]];
ENDCASE => ERROR;
};
left, equal, right: REF;
[left, equal, right] ← RedBlackTree.Lookup3[self: pins, lookupKey: RealToRef[loc.x]];
IF equal=NIL THEN {
pin1: Pin ~ PinFromRef[left];
pin2: Pin ~ PinFromRef[right];
pickLeft: BOOL ~ SELECT TRUE FROM
pin1=NIL AND pin2=NIL => ERROR NoPins[],
pin1=NIL => FALSE,
pin2=NIL => TRUE,
ENDCASE => pin1^.Sub[loc].Length[] < pin2^.Sub[loc].Length[];
IF pickLeft THEN RETURN [pin1^, ISTYPE[left, REF REAL]] ELSE RETURN [pin2^, ISTYPE[right, REF REAL]];
}
ELSE {
pin1: Pin ~ PinFromRef[equal];
RETURN [pin1^, ISTYPE[equal, REF REAL]];
};
};
Trc.RegisterClass[editClass];
END.