DIRECTORY BiAxialMenu, BiAxials, BiScrollers, Complex, FFTSingle, FS, Geom2D, Imager, ImagerBackdoor, ImagerBox, IO, Menus, MessageWindow, PiecewiseLinearGraph, Rope, SimpleFeedback, TIPUser, Vector2, ViewerClasses, ViewerOps, ViewerTools;

PiecewiseLinearGraphImpl: CEDAR PROGRAM
IMPORTS BiAxialMenu, BiAxials, BiScrollers, Complex, FFTSingle, FS, Geom2D, Imager, ImagerBackdoor, ImagerBox, IO, Menus, MessageWindow, Rope, SimpleFeedback, TIPUser, ViewerOps, ViewerTools
EXPORTS PiecewiseLinearGraph
= BEGIN OPEN PiecewiseLinearGraph, BA:BiAxials, BS:BiScrollers, Fft:FFTSingle;

ROPE: TYPE ~ Rope.ROPE;

FV: TYPE ~ REF FvRec;
FvRec: TYPE ~ RECORD [
fn: Function,
const: BOOL,
bounds: Box,
cursLoc, scursLoc: VEC ¬ [0, 0],
cursing, scursing: BOOL ¬ FALSE
];

bsStyle: BS.BiScrollerStyle ~ BS.GetStyle[];

plgMenu: PUBLIC Menus.Menu ¬ Menus.CopyMenu[BiAxialMenu.baMenu];

fvClass: BA.Class ~ BA.CreateClass[bsStyle, [
flavor: $PiecewiseLinearGraph,
extrema: Extrema,
notify: Notify,
paint: Paint,
menu: plgMenu,
tipTable: TIPUser.InstantiateNewTIPTable["PiecewiseLinearGraph.tip"]
]];

View: PUBLIC PROC [fn: Function, viewerInit: ViewerClasses.ViewerRec, paint: BOOL ¬ TRUE] RETURNS [Viewer] ~ {
fv: FV ~ NEW [FvRec ¬ [fn, NOT fn.class.Mutable[fn], [0, 0, 0, 0] ]];
bs: BS.BiScroller;
lpx: BA.LabelPolicy ~ BA.CreateLinearLabelPolicy[X, "%g", 11, [FALSE, 0.0, 1.0]];
lpy: BA.LabelPolicy ~ BA.CreateLinearLabelPolicy[Y, "%g", 11, [FALSE, 0.0, 1.0]];
IF fv.const THEN fv.bounds ¬ fn.class.Bounds[fn];
viewerInit.data ¬ fv;
bs ¬ BA.Create[fvClass, [lpx, lpy], viewerInit, paint];
RETURN bs.QuaViewer[FALSE]};

Extrema: PROC [clientData: REF ANY, direction: VEC] RETURNS [min, max: VEC] ~ {
fv: FV ~ NARROW[clientData];
IF NOT fv.const THEN fv.bounds ¬ fv.fn.class.Bounds[fv.fn];
RETURN Geom2D.ExtremaOfRect[fv.bounds.RectangleFromBox, direction]};

Notify: PROC [self: Viewer, input: LIST OF REF ANY, device, user, display: REF ANY] ~ {
ba: BA.BiAxial ~ BS.QuaBiScroller[self];
fv: FV ~ NARROW[BA.ClientDataOf[ba]];
WHILE input#NIL DO
SELECT input.first FROM
$Eval => {
where: BS.ClientCoords ~ NARROW[input.rest.first];
IF fv.scursing AND where.x = fv.scursLoc.x THEN NULL
ELSE {
y: REAL ~ fv.fn.class.Eval[fv.fn, where.x];
fv.cursLoc ¬ [where.x, y];
fv.cursing ¬ TRUE;
MessageWindow.Append[IO.PutFR["f(%g)=%g", [real[where.x]], [real[y]] ], TRUE];
ViewerOps.PaintViewer[self, client, FALSE, $Cursing];
};
input ¬ input.rest.rest};
$DontEval => {
fv.cursing ¬ FALSE;
IF fv.cursing # fv.scursing THEN ViewerOps.PaintViewer[self, client, FALSE, $Cursing];
input ¬ input.rest};
ENDCASE => ERROR;
ENDLOOP;
RETURN};

invCursColor: Imager.Color ~ ImagerBackdoor.MakeStipple[5A5AH, TRUE];

Paint: PROC [self: Viewer, context: Imager.Context, bounds: Box, dest: BA.ImageDestination, whatChanged: REF ANY, clear: BOOL] RETURNS [quit: BOOL ¬ FALSE] ~ {
ba: BA.BiAxial ~ BS.QuaBiScroller[self];
fv: FV ~ NARROW[BA.ClientDataOf[ba]];
first: BOOL ¬ TRUE;
p: VEC ¬ [0, 0];
PaintPoint: PROC [v: VEC] RETURNS [BOOL] ~ {
IF first THEN first ¬ FALSE ELSE context.MaskVector[p, v];
p ¬ v;
RETURN [FALSE]};
context.SetStrokeEnd[round];
context.SetStrokeJoint[bevel];
IF fv.fn.class.Scan[fv.fn, bounds.xmin, bounds.xmax, FALSE, PaintPoint].stopped THEN ERROR;
IF fv.cursing # (fv.scursing AND NOT clear) OR (fv.cursing AND fv.scursLoc # fv.cursLoc) THEN {
IF NOT fv.const THEN fv.bounds ¬ fv.fn.class.Bounds[fv.fn];
context.SetColor[invCursColor];
SELECT TRUE FROM
clear => {
context.MaskVector[[fv.cursLoc.x, fv.bounds.ymin], [fv.cursLoc.x, fv.bounds.ymax]];
context.MaskVector[[fv.bounds.xmin, fv.cursLoc.y], [fv.bounds.xmax, fv.cursLoc.y]];
};
fv.cursing AND NOT fv.scursing => {
context.MaskVector[[fv.cursLoc.x, fv.bounds.ymin], [fv.cursLoc.x, fv.bounds.ymax]];
context.MaskVector[[fv.bounds.xmin, fv.cursLoc.y], [fv.bounds.xmax, fv.cursLoc.y]];
};
fv.scursing AND NOT fv.cursing => {
context.MaskVector[[fv.scursLoc.x, fv.bounds.ymin], [fv.scursLoc.x, fv.bounds.ymax]];
context.MaskVector[[fv.bounds.xmin, fv.scursLoc.y], [fv.bounds.xmax, fv.scursLoc.y]];
};
ENDCASE => {
IF fv.scursLoc # fv.cursLoc THEN {
context.MaskVector[[fv.scursLoc.x, fv.bounds.ymin], [fv.scursLoc.x, fv.bounds.ymax]];
context.MaskVector[[fv.cursLoc.x, fv.bounds.ymin], [fv.cursLoc.x, fv.bounds.ymax]]};
IF fv.scursLoc.y # fv.cursLoc.y THEN {
context.MaskVector[[fv.bounds.xmin, fv.scursLoc.y], [fv.bounds.xmax, fv.scursLoc.y]];
context.MaskVector[[fv.bounds.xmin, fv.cursLoc.y], [fv.bounds.xmax, fv.cursLoc.y]]};
};
fv.scursLoc ¬ fv.cursLoc;
fv.scursing ¬ fv.cursing;
}
ELSE fv.scursing ¬ fv.scursing AND NOT clear;
RETURN};

CtlButt: PROC [parent: Viewer, clientData: REF ANY ¬ NIL, mouseButton: ViewerClasses.MouseButton ¬ red, shift, control: BOOL ¬ FALSE] ~ {
ba: BA.BiAxial ~ BS.QuaBiScroller[parent];
Ctl[parent, ba, NIL, SELECT mouseButton FROM
red => $ToFile,
yellow => $FFT,
blue => $FromFile,
ENDCASE => ERROR];
RETURN};

Ctl: PROC [view, instanceData, classData, key: REF ANY] --PUB.PopUpButtonProc-- = {
viewer: Viewer ~ NARROW[view];
ba: BA.BiAxial ~ NARROW[instanceData];
fv: FV ~ NARROW[BA.ClientDataOf[ba]];
{SELECT key FROM
$ToFile => {
fileName: ROPE ~ ViewerTools.GetSelectionContents[];
out: IO.STREAM ¬ NIL;
of: FS.OpenFile;
fullName: ROPE;
WritePt: PROC [v: VEC] RETURNS [BOOL] ~ {
out.PutF["%g %g\n", [real[v.x]], [real[v.y]] ];
RETURN [FALSE]};
out ¬ FS.StreamOpen[fileName, create !FS.Error => {
SimpleFeedback.Append[$PiecewiseLinearGraph, oneLiner, $Error, Rope.Concat["File create error: ", error.explanation]];
GOTO Dun}];
of ¬ FS.OpenFileFromStream[out];
fullName ¬ FS.GetName[of].fullFName;
IF NOT fv.const THEN fv.bounds ¬ fv.fn.class.Bounds[fv.fn];
IF fv.fn.class.Scan[fv.fn, fv.bounds.xmin, fv.bounds.xmax, TRUE, WritePt].stopped THEN ERROR;
out.Close[];
SimpleFeedback.PutF[$PiecewiseLinearGraph, oneLiner, $FYI, "%g written", [rope[fullName]] ]};
$FromFile => {
fileName: ROPE ~ ViewerTools.GetSelectionContents[];
in: IO.STREAM ¬ NIL;
buf: Fft.ComplexSeq ¬ Fft.NewComplexSeq[32];
x, y: REAL;
in ¬ FS.StreamOpen[fileName !FS.Error => {
SimpleFeedback.Append[$PiecewiseLinearGraph, oneLiner, $Error, Rope.Concat["File create error: ", error.explanation]];
GOTO Dun}];
DO
[] ¬ in.SkipWhitespace[];
IF in.EndOf[] THEN EXIT;
x ¬ in.GetReal[];
y ¬ in.GetReal[];
buf ¬ buf.CsAppend[[x, y]];
ENDLOOP;
in.Close[];
[] ¬ View[[buf, cbClass], [name: fileName]];
key ¬ key};
$FFT => {
spec: ROPE ~ ViewerTools.GetSelectionContents[];
in: IO.STREAM ¬ IO.RIS[spec];
xmin, xmax, xstart, ts, tp, np: REAL ¬ 0.0;
N: INT ¬ 0;
i: INT ¬ 0;
buf, ansM, ansA: Fft.ComplexSeq ¬ NIL;
CountPt: PROC [v: VEC] RETURNS [BOOL] ~ {
N ¬ N.SUCC;
RETURN [FALSE]};
CapturePt: PROC [v: VEC] RETURNS [BOOL] ~ {
IF v.x >= xstart THEN {
buf[i] ¬ [v.y, 0.0];
IF i=0 THEN xmin ¬ v.x;
i ¬ i.SUCC;
IF i=N THEN xmax ¬ v.x}
ELSE buf[i] ¬ [0, 0];
RETURN [i >= N]};
XyToIx: PROC [v: VEC] RETURNS [w: VEC]
~ {w ¬ [i*np, v.x]; i ¬ i.SUCC; RETURN};
XyToIy: PROC [v: VEC] RETURNS [w: VEC]
~ {w ¬ [i*np, v.y]; i ¬ i.SUCC; RETURN};
[] ¬ Extrema[fv, [1.0, 0.0]];
IF spec.Length <= 1 THEN {
IF fv.fn.class.Scan[fv.fn, fv.bounds.xmin, fv.bounds.xmax, TRUE, CountPt].stopped THEN ERROR;
xstart ¬ fv.bounds.xmin}
ELSE {
N ¬ in.GetInt[];
xstart ¬ in.GetReal[]};
buf ¬ Fft.NewComplexSeq[N];
[] ¬ fv.fn.class.Scan[fv.fn, xstart, fv.bounds.xmax, TRUE, CapturePt];
IF i # N THEN {
SimpleFeedback.PutFL[$PiecewiseLinearGraph, oneLiner, $Error, "Only %g points >= %g", LIST[[integer[i]], [real[xstart]] ]];
GOTO Dun};
buf.length ¬ N;
ts ¬ (xmax - xmin) / (N-1);
tp ¬ xmax - xmin + ts;
np ¬ 1.0 / tp;
SimpleFeedback.PutFL[$PiecewiseLinearGraph, oneLiner, $FYI, "xmin=%g, xmax=%g, np=%g", LIST[[real[xmin]], [real[xmax]], [real[np]] ]];
ansM ¬ buf.DestructiveFft[FALSE];
ansM.DestructiveMap[RectangularToPolar];
ansA ¬ ansM.CsCopy[0, N];
i ¬ 0;
ansM.DestructiveMap[XyToIx];
i ¬ 0;
ansA.DestructiveMap[XyToIy];
[] ¬ View[[ansM, cbClass], [name: IO.PutFR["%g DFT(%g, %g) mag", [rope[viewer.name]], [integer[N]], [real[xstart]] ]]];
[] ¬ View[[ansA, cbClass], [name: IO.PutFR["%g DFT(%g, %g) ang", [rope[viewer.name]], [integer[N]], [real[xstart]] ]]];
key ¬ key};
ENDCASE => ERROR;
EXITS Dun => key ¬ key};
RETURN};

RectangularToPolar: PROC [r: VEC] RETURNS [p: VEC] ~ {
p.x ¬ Complex.Abs[r];
p.y ¬ Complex.Arg[r];
RETURN};

cbClass: FunctionClass ~ NEW [FunctionClassPrivate ¬ [
Mutable: NotMutable,
Bounds: CbBounds,
Scan: CbScan,
Eval: Interpolate]];

NotMutable: PROC [Function] RETURNS [BOOL] ~ {RETURN [FALSE]};

CbBounds: PROC [fn: Function] RETURNS [bds: Box] ~ {
cb: Fft.ComplexSeq ~ NARROW[fn.data];
bds ¬ [cb[0].x, cb[0].y, cb[0].x, cb[0].y];
FOR i: NAT IN (0..cb.length) DO
bds.xmin ¬ MIN[bds.xmin, cb[i].x];
bds.xmax ¬ MAX[bds.xmax, cb[i].x];
bds.ymin ¬ MIN[bds.ymin, cb[i].y];
bds.ymax ¬ MAX[bds.ymax, cb[i].y];
ENDLOOP;
RETURN};

CbScan: PROC [
fn: Function,
xmin, xmax: REAL,
exact: BOOL, --FALSE => only accurate enough for drawing
Consume: PROC [VEC] RETURNS [BOOL] --return TRUE to stop the Scan
] RETURNS [stopped: BOOL, at: VEC]
~ {
cb: Fft.ComplexSeq ~ NARROW[fn.data];
i: NAT ¬ 0;
IF cb[i].x < xmin THEN FOR i ¬ i, i+1 WHILE i+1<cb.length AND cb[i+1].x < xmin DO NULL ENDLOOP;
FOR i ¬ i, i+1 WHILE i<cb.length AND cb[i].x <= xmax DO
IF Consume[cb[i]] THEN RETURN [TRUE, cb[i]];
ENDLOOP;
IF i<cb.length AND Consume[cb[i]] THEN RETURN [TRUE, cb[i]];
RETURN [FALSE, [0, 0]]};

Interpolate: PUBLIC PROC [fn: Function, x: REAL] RETURNS [REAL] ~ {
lo, hi: VEC ¬ [0, 0];
needLo, needHi: BOOL ¬ TRUE;
Seek: PROC [v: VEC] RETURNS [BOOL] ~ {
SELECT TRUE FROM
v.x < x => IF needLo OR v.x > lo.x THEN {lo ¬ v; needLo ¬ FALSE};
v.x = x => {lo ¬ hi ¬ v; needLo ¬ needHi ¬ FALSE; RETURN [TRUE]};
v.x > x => IF needHi OR v.x < hi.x THEN {hi ¬ v; needHi ¬ FALSE};
ENDCASE => ERROR;
RETURN [FALSE]};
IF fn.class.Scan[fn, x, x, TRUE, Seek].stopped THEN RETURN [lo.y];
IF needLo OR needHi THEN RETURN [0.0];
RETURN [( hi.y * (x - lo.x) + lo.y * (hi.x - x) ) / ( hi.x - lo.x )]};

FloorToPowerOfTwo: PROC [n: CARD] RETURNS [NAT] ~ {
IF n <= 2 THEN RETURN [n];
RETURN [FloorToPowerOfTwo[n/2]*2]};

Start: PROC ~ {
Menus.AppendMenuEntry[plgMenu, Menus.CreateEntry["Ctl", CtlButt], 0];
RETURN};

Start[];

END.
Ž
PiecewiseLinearGraphImpl.mesa
Copyright Σ 1991, 1992 by Xerox Corporation.  All rights reserved.
Spreitze, March 20, 1992 7:53 am PST
ΚΨ•NewlineDelimiter

–
(cedarcode) style™
codeš
œ™Kšœ
Οe
œ7™BK™$—K˜KšΟk	œ9žœ-žœ|˜ο
K˜šΟnœžœ
ž˜'Kšžœ9žœ-žœM˜Ύ
Kšžœ˜—Kšœžœ
žœžœžœŸœ˜NK˜Kšžœžœžœ
˜K˜Kšžœžœžœ˜šœžœžœ˜K˜
Kšœžœ
˜K˜Kšœžœ
˜ Kšœžœž˜K˜—K˜Kšœ	žœžœ˜,K˜Kšœ	žœ1˜@K˜šœ	žœ	žœ˜-Kš
œ˜K˜K˜K˜
K˜Kš
œD˜DK˜—K˜šŸœžœ
žœ<žœžœžœ
˜nKšœžœžœžœ'˜EKšœžœ˜Kšœžœžœ'žœ
˜QKšœžœžœ'žœ
˜QKšžœ
žœ!˜1K˜Kšœžœ0˜7Kšžœžœ˜—K˜šŸœžœžœ
žœ
žœžœžœ˜OKšœžœžœ
˜Kšžœ
žœ
žœ'˜;Kšžœ>˜D—K˜šŸœžœžœ
žœ
žœ
žœžœ
žœ˜WKšœžœžœ˜(Kšœžœžœ
žœ˜%šžœžœ
ž˜šžœ
ž˜˜
Kšœžœžœ˜2Kšžœ
žœžœ
ž˜4šžœ˜Kšœžœ$˜+K˜Kšœ
žœ
˜Kšœžœ1žœ˜NKšœ$žœ˜5K˜—K˜—˜Kšœ
žœ
˜Kšžœžœ%žœ˜VK˜—Kšžœžœ
˜—Kšžœ
˜—Kšžœ˜—K˜Kšœ?žœ˜EK˜šŸœžœ<žœ žœ
žœ	žœžœžœžœ˜Ÿ
Kšœžœžœ˜(Kšœžœžœ
žœ˜%Kšœžœžœ
˜Kšœžœ
˜š
Ÿ
œžœžœžœžœ˜,Kšžœžœ	žœ
žœ˜:K˜Kšžœžœ˜—Kš
œ˜Kš
œ˜Kšžœ3žœžœ
žœ
˜[šžœžœ
žœžœ
žœžœ˜_Kšžœ
žœ
žœ'˜;K˜šžœ
žœ
ž˜˜
K˜SK˜SK˜—šœžœ
žœ˜#K˜SK˜SK˜—šœžœ
žœ˜#K˜UK˜UK˜—šžœ˜šžœžœ˜"K˜UK˜T—šžœžœ˜&K˜UK˜T—K˜——K˜K˜K˜
—Kšžœžœ
žœ˜-Kšžœ˜—K˜šŸœžœžœ
žœžœ@žœžœ˜‰
Kšœžœžœ˜*šœžœžœ
ž˜,Kš
œ˜K˜K˜Kšžœžœ˜—Kšžœ˜—K˜š
Ÿœžœ&žœ
žœΟcœ˜SKšœžœ˜Kšœžœžœ˜&Kšœžœžœ
žœ˜%šœ
žœž˜š
œ˜Kšœ
žœ&˜4Kšœžœ
žœžœ
˜Kšœžœ
˜Kšœ
žœ
˜š
Ÿœžœžœžœžœ˜)K˜/Kšžœžœ˜—šœžœžœ˜3K˜vKšžœ˜—Kšœžœ˜ Kšœžœ˜$Kšžœ
žœ
žœ'˜;Kšžœ9žœžœ
žœ
˜]K˜Kš
œ]˜]—š
œ˜Kšœ
žœ&˜4Kšœžœ
žœžœ
˜K˜,Kšœžœ
˜šœžœžœ˜*K˜vKšžœ˜—š
ž˜K˜Kšžœžœ
žœ
˜K˜K˜K˜Kšžœ
˜—K˜K˜,K˜—š
œ	˜	Kšœžœ&˜0Kš	œžœ
žœžœ
žœ˜KšœΟg
Οd
œ‘
’
œ‘
’
œžœ˜+KšŸ
œžœ˜Kšœžœ˜Kšœ"žœ
˜&š
Ÿœžœžœžœžœ˜)Kšœžœ
˜Kšžœžœ˜—š
Ÿ	œžœžœžœžœ˜+šžœžœ˜K˜Kšžœžœ˜Kšœžœ
˜Kšžœžœ˜—Kšžœ˜Kšžœ˜—š
Ÿœžœžœžœžœ
˜&Kšœ
‘
’
œžœžœ˜(—š
Ÿœžœžœžœžœ
˜&Kšœ
‘
’
œžœžœ˜(—K˜šžœžœ˜Kšžœ9žœžœ
žœ
˜]K˜—šžœ˜K˜K˜—K˜Kšœ5žœ
˜Fšžœžœ˜KšœVžœ!˜{Kšžœ˜
—K˜Kš‘
’
œ˜Kš‘
’
œ‘
’
œ
˜Kš‘
’
œ	‘
’
œ
˜Kš	œO‘
’
œžœ#‘
’
œ˜†
Kšœžœ˜!Kš
œ(˜(K˜K˜Kš
œ˜K˜Kš
œ˜Kšœ"žœS˜wKšœ"žœS˜wK˜—Kšžœžœ
˜—Kšžœ˜Kšžœ˜—K˜š
Ÿœžœžœžœžœ˜6K˜K˜Kšžœ˜—K˜šœžœ˜6KšŸœ
˜KšŸœ˜KšŸœ	˜
KšŸœ˜—K˜KšŸ
œžœžœžœžœžœ˜>K˜šŸœžœžœ˜4Kšœžœ
˜%K˜+šžœžœ
žœž˜Kšœžœ˜"Kšœžœ˜"Kšœžœ˜"Kšœžœ˜"Kšžœ
˜—Kšžœ˜—K˜šŸœžœ˜Kš
œ
˜
Kšœžœ
˜Kšœžœ +˜8KšŸœžœžœžœžœ ˜AKšœžœžœžœ
˜"K˜Kšœžœ
˜%Kšœžœ˜Kšžœžœ
žœžœžœžœ
žœ
žœ
˜_šžœžœ
žœž˜7Kšžœžœ
žœžœ	˜,Kšžœ
˜—Kš
žœ
žœžœ
žœžœ	˜<Kšžœžœ˜—K˜šŸœžœ
žœžœžœžœ˜CKšœžœ
˜Kšœžœžœ
˜š
Ÿœžœžœžœžœ˜&šžœ
žœ
ž˜Kš	œžœžœžœžœ˜AKšœ+žœžœžœ˜AKš	œžœžœžœžœ˜AKšžœžœ
˜—Kšžœžœ˜—Kšžœžœžœ
žœ˜BKšžœžœžœ
žœ˜&Kšžœ@˜F—K˜š
Ÿœžœžœžœžœ˜3Kšžœžœ
žœ˜Kšžœ˜#—K˜šŸœžœ˜Kš
œE˜EKšžœ˜—K˜K˜K˜Kšžœ
˜—…—'š5