DIRECTORY
TrcEdit,
Containers USING [Create],
Convert USING [RealFromRope],
Imager USING [black, Color, MaskVector, SetColor, SetStrokeWidth, white],
ImagerBackdoor USING [GetReal],
IO USING [GetCedarTokenRope, GetReal, PutF, PutRope, TokenKind],
Real USING [CompareREAL],
RedBlackTree, --using lots...
Rope USING [Equal, ROPE],
TIPUser USING [InstantiateNewTIPTable, TIPScreenCoords],
Trc,
TrcViewers USING [VecFromTIPCoords],
Vector2 USING [InlineAdd, Length, Sub, VEC],
ViewerClasses USING [Viewer, ViewerRec],
ViewerOps USING [PaintViewer];
OPEN TrcEdit;
ROPE: TYPE ~ Rope.ROPE;
VEC: TYPE ~ Vector2.VEC;
EditInstance:
TYPE ~
REF EditInstanceRep;
EditInstanceRep:
TYPE ~
RECORD [
pins: RedBlackTree.Table ← RedBlackTree.Create[getKey: TrcEditGet, compare: TrcEditCompare],
toAdjust: VEC,
action: EditAction ← none
];
EditAction: TYPE ~ {none, abort, insert, delete};
Pin:
TYPE ~
REF PinRep;
PinRep:
TYPE ~
RECORD [
vec: Vector2.VEC
];
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 [RealToRef[NARROW[data, Pin].x]];
};
TrcEditCompare: RedBlackTree.Compare = {
[k: RedBlackTree.Key, data: RedBlackTree.UserData] RETURNS [Basics.Comparison]
RETURN [Real.CompareREAL[NARROW[data, Pin].x, RefToReal[k]]];
};
FindNearestPin:
PROC [pins: RedBlackTree.Table, loc:
VEC]
RETURNS [pin: Pin] ~ {
left, equal, right: REF;
[left, equal, right] ← RedBlackTree.Lookup3[self: pins, lookupKey: RealToRef[loc.x]];
IF equal=
NIL
THEN {
pin1: Pin ~ NARROW[left];
pin2: Pin ~ NARROW[right];
IF pin1=NIL THEN RETURN [pin2]; --Even if it's NIL
IF pin2=NIL THEN RETURN [pin1];
RETURN [IF pin1^.Sub[loc].Length[] < pin2^.Sub[loc].Length[] THEN pin1 ELSE pin2];
}
ELSE {
RETURN [NARROW[equal]]
};
};
EditFcn: Trc.Fcn = {
[trc: TRC, a: REAL] RETURNS [b: REAL]
instance: EditInstance ~ NARROW[trc.instance];
left, equal, right: REF;
[left, equal, right] ← RedBlackTree.Lookup3[self: instance.pins, lookupKey: RealToRef[a]];
IF equal=
NIL
THEN {
pin1: Pin ~ NARROW[left];
pin2: Pin ~ NARROW[right];
IF pin1=
NIL
THEN {
IF pin2=NIL THEN RETURN [a]; --I.e. deleting all the pins produces an identity
RETURN [pin2.y];
}
ELSE {
alpha: REAL;
IF pin2=NIL THEN RETURN [pin1.y];
alpha ← (a-pin1.x)/(pin2.x-pin1.x);
RETURN [alpha*(pin2.y) + (1.0-alpha)*(pin1.y)]
};
}
ELSE {
RETURN [NARROW[equal, Pin].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 => {
SELECT instance.action
FROM
delete => [] ← RedBlackTree.Delete[self: instance.pins, deleteKey: RealToRef[instance.toAdjust.x]];
insert => RedBlackTree.Insert[self: instance.pins, dataToInsert: NEW[PinRep ← [instance.toAdjust]], insertKey: RealToRef[instance.toAdjust.x]];
ENDCASE;
instance.action ← none;
Trc.NotifyListeners[trc: trc, fork: TRUE];
};
$Abort => instance.action ← abort;
$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.toAdjust ← vec;
markRequests ← LIST[[vec]];
instance.action ← insert;
};
$Delete => {
pin: Pin ~ FindNearestPin[pins: instance.pins, loc: vec];
IF pin#
NIL
THEN {
instance.action ← delete;
instance.toAdjust ← pin^;
markRequests ← LIST[[pin^, Imager.white]];
};
};
$Adjust =>
SELECT instance.action
FROM
delete => {
pin: Pin ~ FindNearestPin[pins: instance.pins, loc: vec];
IF pin=NIL THEN ERROR;
IF pin^#instance.toAdjust
THEN {
markRequests ← LIST[[instance.toAdjust], [pin^, Imager.white]];
instance.toAdjust ← pin^;
};
};
insert => {
IF RedBlackTree.Lookup[self: instance.pins, lookupKey: RealToRef[vec.x]]=
NIL
THEN {
--Otherwise ignore
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];
};
MarkRequest: TYPE ~ RECORD [vec: VEC, color: Imager.Color ← Imager.black];
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]]];
};
instance: EditInstance ~ NARROW[trc.instance];
w: REAL ~ ImagerBackdoor.GetReal[context: context, key: strokeWidth];
d: REAL ~ 3*w;
Imager.SetStrokeWidth[context: context, strokeWidth: w/2];
IF whatChanged=
NIL
THEN {
XMarksTheSpot: RedBlackTree.EachNode = {
[data: RedBlackTree.UserData] RETURNS [stop: BOOL ← FALSE]
pin: Pin ~ NARROW[data];
Mark[pin^];
};
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];
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]
pin: Pin ~ NARROW[data];
IO.PutF[stream: stream, format: "\n%g\t%g\t%g", v1: [rope[indentation]], v2: [real[pin.x]], v3: [real[pin.y]]];
};
IO.PutRope[self: stream, r: " {"];
RedBlackTree.EnumerateIncreasing[self: instance.pins, procToApply: WriteEachPin];
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;
IF ~IO.GetCedarTokenRope[stream: stream].token.Equal["{"] THEN ERROR;
[tokenKind: tokenKind, token: token] ← IO.GetCedarTokenRope[stream: stream];
WHILE tokenKind=tokenREAL
DO
vec: VEC ~ [x: Convert.RealFromRope[token], y: IO.GetReal[stream]];
RedBlackTree.Insert[self: instance.pins, dataToInsert: NEW[PinRep ← [vec]], insertKey: RealToRef[vec.x]];
ENDLOOP;
IF ~Rope.Equal[token, "}"] THEN ERROR;
};
EditControl: Trc.BuildControlViewerProc = {
[trc: TRC, info: ViewerClasses.ViewerRec, propList: Properties.PropList ← NIL] RETURNS [viewer: ViewerClasses.Viewer]
viewer ← Containers.Create[info: info];
IF trc.instance=
NIL
THEN {
trc.instance ← NEW[EditInstanceRep];
};
};
EditCopy: Trc.CopyProc = {
[trc: TRC] RETURNS [new: TRC]
CopyEachPin: RedBlackTree.EachNode = {
[data: RedBlackTree.UserData] RETURNS [stop: BOOL ← FALSE]
pin: Pin ~ NARROW[data];
RedBlackTree.Insert[self: newInstance.pins, dataToInsert: NEW[PinRep ← pin^], insertKey: RealToRef[pin.x]];
};
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];
};
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
]];
Trc.RegisterClass[editClass];