<<>> <> <> <> 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] ~ { 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.Cat["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.Cat["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, 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* XyToIy: PROC [v: VEC] RETURNS [w: VEC] ~ {w _ [i* [] _ 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.PutF[$PiecewiseLinearGraph, oneLiner, $Error, "Only %g points >= %g", [integer[i]], [real[xstart]] ]; GOTO Dun}; buf.length _ N; SimpleFeedback.PutF[$PiecewiseLinearGraph, oneLiner, $FYI, "xmin=%g, xmax=%g, 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 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.