PiecewiseLinearGraphImpl.mesa
Copyright Ó 1991, 1992 by Xerox Corporation. All rights reserved.
Spreitze, March 20, 1992 7:53 am PST
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.