<<>>
<<ControlsSketchmpl.mesa>>
<<Copyright Ó 1985, 1992 by Xerox Corporation.  All rights reserved.>>
<<Bloomenthal, July 2, 1992 6:20 pm PDT>>

DIRECTORY Controls, ControlsPrivate, Draw2d, Imager, ViewerClasses, ViewerOps;

ControlsSketchImpl: CEDAR PROGRAM
IMPORTS ControlsPrivate, Draw2d, Imager, ViewerOps
EXPORTS Controls, ControlsPrivate

~ BEGIN
<<Types>>
Context:                        TYPE ~ Imager.Context;
Control:                        TYPE ~ Controls.Control;
IntegerPair:                    TYPE ~ Controls.IntegerPair;
IntegerPairSequenceRep:    TYPE ~ Controls.IntegerPairSequenceRep;
IntegerPairSequence:        TYPE ~ Controls.IntegerPairSequence;
IntegerPairSequences:        TYPE ~ Controls.IntegerPairSequences;
IntegerPairSequencesRep:    TYPE ~ Controls.IntegerPairSequencesRep;
Mouse:                        TYPE ~ Controls.Mouse;
<<Sketch Type Definitions>>
Chain:                        TYPE ~ REF ChainRep;
ChainRep:                    TYPE ~ RECORD [
p0, p1:                                INTEGER Ź 0,        -- current vector to draw
firstRun:                                Run Ź NIL,
lastRun:                                Run Ź NIL,
pairs:                                    IntegerPairSequence Ź NIL    -- chain points
];

Run:                            TYPE ~ REF RunRep;
RunRep:                        TYPE ~ RECORD [
start, stop:                            INTEGER Ź 0,        -- inclusive indices into pairs
next:                                    Run Ź NIL
];
<<Sketch Initialization/Clearing>>
NewSketch: PUBLIC PROC [control: Control] ~ {
chain: Chain Ź NEW[ChainRep];
control.sketchRef Ź chain;
chain.pairs Ź NEW[IntegerPairSequenceRep[10000]];        -- should be large enough 
chain.firstRun Ź NEW[RunRep];
chain.lastRun Ź chain.firstRun;
};

LengthenChain: PROC [chain: Chain] ~ {
IF chain # NIL AND chain.pairs # NIL THEN {
old: IntegerPairSequence Ź chain.pairs;
new: IntegerPairSequence Ź NEW[IntegerPairSequenceRep[2*old.maxLength]];
FOR n: NAT IN [0..old.length) DO
new[n] Ź old[n];
ENDLOOP;
new.length Ź old.length;
chain.pairs Ź new;
};
};

ClearSketch: PUBLIC PROC [control: Control, repaint: BOOL Ź TRUE] ~ {
IF control.type = sketch THEN {
chain: Chain Ź NARROW[control.sketchRef];
chain.p0 Ź chain.p1 Ź 0;
chain.firstRun Ź chain.lastRun Ź NIL;
chain.pairs.length Ź 0;
IF repaint THEN RequestPaint[control, FALSE, NIL];
};
};

DeleteLastSketchStroke: PUBLIC PROC [control: Control, repaint: BOOL Ź TRUE] ~ {
IF control.type = sketch THEN {
chain: Chain Ź NARROW[control.sketchRef];
pairs: IntegerPairSequence Ź chain.pairs;
start: Run Ź chain.firstRun;
IF start = NIL THEN RETURN;
IF start.next = NIL
THEN {
chain.p0 Ź chain.p1 Ź 0;
chain.firstRun Ź chain.lastRun Ź NIL;
chain.pairs.length Ź 0;
}
ELSE
FOR run: Run Ź start, run.next DO
IF run.next.next = NIL THEN {
run.next Ź NIL;
chain.lastRun Ź run;
chain.pairs.length Ź run.stop+1;
EXIT;
};
ENDLOOP;
IF repaint THEN RequestPaint[control, FALSE, NIL];
};
};
<<Sketch Notification>>
AddIntegerPair: PROC [chain: Chain, pair: IntegerPair] ~ {
pairs: IntegerPairSequence Ź chain.pairs;
IF pairs.length = pairs.maxLength THEN LengthenChain[chain];
pairs[pairs.length] Ź pair;
pairs.length Ź pairs.length+1;
};

NotifySketch: PUBLIC PROC [control: Control, mouse: Mouse] ~ {
chain: Chain Ź NARROW[control.sketchRef];
control.mouse Ź mouse;
SELECT mouse.state FROM
down => {
chain.p0 Ź chain.p1 Ź chain.pairs.length;
IF chain.firstRun = NIL THEN {
chain.firstRun Ź NEW[RunRepŹ [start: chain.p0]];
chain.lastRun Ź chain.firstRun;
}
ELSE {
chain.lastRun.next Ź NEW[RunRep];
chain.lastRun Ź chain.lastRun.next;
chain.lastRun.start Ź chain.p0;
};
AddIntegerPair[chain, mouse.pos];
};
held => {
IF (chain.p1 Ź chain.pairs.length) # 0 THEN chain.p0 Ź chain.p1-1;
AddIntegerPair[chain, mouse.pos];
};
up =>
chain.lastRun.stop Ź chain.p1;
ENDCASE => RETURN;
RequestPaint[control, FALSE, control];
IF mouse.state = up THEN ControlsPrivate.MaybeForkControlProc[control];
};
<<Sketch Painting>>
LineIntegerPair: PROC [context: Context, p0, p1: IntegerPair] ~ {
Draw2d.Line[context, [p0.x, p0.y], [p1.x, p1.y]];
};

RequestPaint: PROC [control: Control, clearClient: BOOL, whatChanged: REF ANY] ~ {
ViewerOps.PaintViewer[control.viewer, client, clearClient, whatChanged];
};

PaintSketch: PUBLIC ViewerClasses.PaintProc ~ {
control: Control Ź NARROW[self.data];
chain: Chain Ź NARROW[control.sketchRef];
IF chain = NIL THEN RETURN;
IF whatChanged = NIL
THEN {
Draw2d.Clear[context];
SketchReDraw[context, chain];
}
ELSE {
pairs: IntegerPairSequence Ź chain.pairs;
LineIntegerPair[context, pairs[chain.p0], pairs[chain.p1]];
};
};

SketchReDraw: PROC [context: Context, chain: Chain] ~ {
pairs: IntegerPairSequence Ź chain.pairs;
start: Run Ź chain.firstRun;
FOR run: Run Ź start, run.next WHILE run # NIL DO
FOR n: NAT IN [run.start..run.stop) DO
LineIntegerPair[context, pairs[n], pairs[n+1]];
ENDLOOP;
ENDLOOP;
};
<<Sketch Processing>>
GetSketch: PUBLIC PROC [control: Control] RETURNS [sketch: IntegerPairSequences] ~ {
nSketch: NAT Ź 0;
chain: Chain Ź NARROW[control.sketchRef];
chainIntegerPairs: IntegerPairSequence Ź chain.pairs;
start: Run Ź chain.firstRun;
FOR run: Run Ź start, run.next WHILE run # NIL DO nSketch Ź nSketch+1; ENDLOOP;
sketch Ź NEW[IntegerPairSequencesRep[nSketch]];
FOR run: Run Ź start, run.next WHILE run # NIL DO
n: INTEGER Ź 0;
sketchIntegerPairs: IntegerPairSequence Ź
NEW[IntegerPairSequenceRep[run.stop-run.start+1]];
sketchIntegerPairs.length Ź sketchIntegerPairs.maxLength;
sketch[sketch.length] Ź sketchIntegerPairs;
sketch.length Ź sketch.length+1;
FOR r: NAT IN [run.start..run.stop] DO
sketchIntegerPairs[n] Ź chainIntegerPairs[r];
n Ź n+1;
ENDLOOP;
ENDLOOP;
};

SetSketch: PUBLIC PROC [control: Control, sketch: IntegerPairSequences, repaint: BOOL Ź TRUE] ~ {
run: Run Ź NIL;
iIntegerPair, nIntegerPairs: CARDINAL Ź 0;
chain: Chain Ź NARROW[control.sketchRef];
FOR n: INT IN [0..sketch.length) DO nIntegerPairs Ź nIntegerPairs+sketch[n].length; ENDLOOP;
IF nIntegerPairs > chain.pairs.maxLength THEN chain.pairs Ź NEW[IntegerPairSequenceRep[nIntegerPairs]];
FOR n: INT IN [0..sketch.length) DO
pairs: IntegerPairSequence Ź sketch[n];
FOR i: INT IN [0..pairs.length) DO chain.pairs[i+iIntegerPair] Ź pairs[i]; ENDLOOP;
IF run # NIL
THEN {run.next Ź NEW[RunRep]; run Ź run.next}
ELSE chain.firstRun Ź run Ź NEW[RunRep];
run.start Ź iIntegerPair;
iIntegerPair Ź iIntegerPair+pairs.length;
run.stop Ź iIntegerPair-1; 
ENDLOOP;
IF repaint THEN RequestPaint[control, FALSE, NIL];
};

NLinesInSketch: PUBLIC PROC [control: Control] RETURNS [INTEGER] ~ {
IF control.sketchRef = NIL
THEN RETURN[0]
ELSE {
chain: Chain Ź NARROW[control.sketchRef];
nLines: INTEGER Ź 0;
FOR r: Run Ź chain.firstRun, r.next WHILE r # NIL DO nLines Ź nLines+1; ENDLOOP;
RETURN[nLines];
};
};

NPointsInSketch: PUBLIC PROC [control: Control] RETURNS [INTEGER] ~ {
IF control.sketchRef = NIL
THEN RETURN[0]
ELSE {
chain: Chain Ź NARROW[control.sketchRef];
nIntegerPairs: INTEGER Ź 0;
FOR run: Run Ź chain.firstRun, run.next WHILE run # NIL DO
nIntegerPairs Ź nIntegerPairs+run.stop-run.start+1;
ENDLOOP;
RETURN[nIntegerPairs];
};
};

END.