<> <> DIRECTORY BiScrollers, Geom2D, GList, Histograms, HistogramsPrivate, Icons, Imager, ImagerBackdoor, ImagerBox, ImagerColor, ImagerFont, ImagerTransformation, IO, MessageWindow, MJSContainers, PopUpButtons, Process, Real, RealFns, Rope, Rules, TIPUser, VFonts, ViewerClasses, ViewerForkers, ViewerOps, ViewerSpecs; HistogramsImpl: CEDAR MONITOR LOCKS h USING h: Histogram IMPORTS BiScrollers, Geom2D, GList, Icons, Imager, ImagerBackdoor, ImagerBox, ImagerColor, ImagerFont, ImagerTransformation, IO, MessageWindow, MJSContainers, PopUpButtons, Process, Real, RealFns, Rope, Rules, TIPUser, VFonts, ViewerForkers, ViewerOps, ViewerSpecs EXPORTS Histograms = BEGIN OPEN BS:BiScrollers, IT:ImagerTransformation, PUB:PopUpButtons, VF:VFonts, VFk:ViewerForkers, VO:ViewerOps, HistogramsPrivate; Error: PUBLIC ERROR [msg: ROPE] = CODE; Histogram: TYPE = REF HistogramRep; HistogramRep: PUBLIC TYPE = HistogramsPrivate.HistogramRep; containerFlavor: ATOM = $VanillaMJSContainer; bsStyle: BS.BiScrollerStyle _ BS.GetStyle[]; histogramViewer: BS.BiScrollerClass; icon: Icons.IconFlavor _ Icons.NewIconFromFile["Histograms.icons", 0]; ts: REAL _ 1; tl: REAL _ 5; ls: REAL _ 2; adx, ady, awx, awy: REAL _ -1; fontHeight, ySpacing: INTEGER; dHeightInitial: REAL _ 1; vFreqInitial: INTEGER _ 15; leftFudge: REAL _ VF.CharWidth['x]; --because the highest label is not necessarily the widest (but it's gonna be close) Create1D: PUBLIC PROC [ factor: REAL _ 1.0, --x = I*factor + offset offset: REAL _ -0.5] RETURNS [h: Histogram] = BEGIN d: DataRef _ NEW[Data[0]]; h _ NEW [HistogramRep _ [ dimensionality: 1, data: d, iFactor: factor, iOffset: offset, jFactor: 1, jOffset: 0 ]]; END; Create2D: PUBLIC PROC [ --sorry, no labelling yet iMin, iMax, jMin, jMax: INT, iFactor, jFactor: REAL _ 1, --x = I*iFactor + iOffset iOffset, jOffset: REAL _ 0] --y = J*jFactor + jOffset RETURNS [h: Histogram] = BEGIN IF iMax < iMin OR jMax < jMin THEN ERROR Error["reversed bounds"]; h _ NEW [HistogramRep _ [ dimensionality: 2, data: NIL, iMin: iMin, iMax: iMax, jMin: jMin, jMax: jMax, nI: iMax + 1 - iMin, nJ: jMax + 1 - jMin, iFactor: iFactor, iOffset: iOffset, jFactor: jFactor, jOffset: jOffset ]]; h.data _ NEW [Data[h.nI * h.nJ]]; FOR k: NAT IN [0 .. h.data.length) DO h.data[k] _ 0 ENDLOOP; END; Ensure: PROC [old: DataRef, n: INT] RETURNS [new: DataRef] = { oldLen: NAT = IF old # NIL THEN old.length ELSE 0; new _ NEW[Data[MIN[n+n/2+1, NAT.LAST]]]; FOR i: NAT _ 0, i+1 WHILE i NULL; IF h.dimensionality # 1 THEN RETURN WITH ERROR Error["This is a 1-D proc, stupid"]; {errMsg: ROPE = ChangeInt[h, who, howMuch]; IF errMsg # NIL THEN RETURN WITH ERROR Error[errMsg]; }}; ChangeInt: INTERNAL PROC [h: Histogram, who: NAT, howMuch: INTEGER] RETURNS [errMsg: ROPE _ NIL] = { IF who < h.data.length THEN NULL ELSE IF who >= NAT.LAST THEN RETURN["too much data"] ELSE h.data _ Ensure[h.data, who]; IF (IF howMuch < 0 THEN h.data.counts[who] < Count[-howMuch] ELSE h.data.counts[who] > Count.LAST-Count[howMuch]) THEN RETURN["counter tried to go out of bounds"]; h.data.counts[who] _ h.data.counts[who] + howMuch; IF h.maxValid THEN SELECT howMuch FROM < 0 => h.maxValid _ FALSE; >= 0 => h.maxCount _ MAX[h.maxCount, h.data.counts[who]]; ENDCASE => ERROR; BroadcastChange[h, [[who, who], [0, 0]]]; }; Change2: INTERNAL PROC [h: Histogram, i, j: INT, delta: INTEGER] RETURNS [errMsg: ROPE _ NIL] = BEGIN index: NAT = (i - h.iMin)*h.nJ + (j - h.jMin); IF (IF delta < 0 THEN h.data.counts[index] < Count[-delta] ELSE h.data.counts[index] > Count.LAST-Count[delta]) THEN RETURN["counter tried to go out of bounds"]; h.data.counts[index] _ h.data.counts[index] + delta; IF h.maxValid THEN SELECT delta FROM < 0 => h.maxValid _ FALSE; >= 0 => h.maxCount _ MAX[h.maxCount, h.data.counts[index]]; ENDCASE => ERROR; BroadcastChange[h, [[i, i], [j, j]]]; END; IncrementTransformed: PUBLIC ENTRY PROC [h: Histogram, xmin, xmax, x: REAL] = { ENABLE UNWIND => NULL; n: NAT = Real.Fix[(MIN[xmax, MAX[xmin, x]] - h.iOffset)/h.iFactor]; errMsg: ROPE = ChangeInt[h, n, 1]; IF errMsg # NIL THEN RETURN WITH ERROR Error[errMsg]; }; ChangeTransformed: PUBLIC ENTRY PROC [h: Histogram, x: REAL, y: REAL _ 0, delta: INTEGER _ 1] = { ENABLE UNWIND => NULL; i: INT = Real.Fix[(x - h.iOffset)/h.iFactor]; j: INT = Real.Fix[(y - h.jOffset)/h.jFactor]; IF h.dimensionality=2 AND NOT (i IN [h.iMin .. h.iMax] AND j IN [h.jMin .. h.jMax]) THEN RETURN WITH ERROR Error["sample point out of range"]; {errMsg: ROPE = SELECT h.dimensionality FROM 1 => ChangeInt[h, i, delta], 2 => Change2[h, MAX[h.iMin, MIN[h.iMax, i]], MAX[h.jMin, MIN[h.jMax, j]], delta], ENDCASE => ERROR; IF errMsg # NIL THEN RETURN WITH ERROR Error[errMsg]; }}; ClearAll: PUBLIC ENTRY PROC [h: Histogram] = { ENABLE UNWIND => NULL; FOR i: NAT IN [0 .. h.data.length) DO h.data[i] _ 0 ENDLOOP; h.maxCount _ 0; h.maxValid _ TRUE; SELECT h.dimensionality FROM 1 => BroadcastChange[h, [[0, h.data.length-1], [0, 0]]]; 2 => BroadcastChange[h, [[h.iMin, h.iMax], [h.jMin, h.jMax]]]; ENDCASE => ERROR; }; BroadcastChange: INTERNAL PROC [h: Histogram, dr: Range2] = { FOR hvl: HistogramViewList _ h.views, hvl.rest WHILE hvl # NIL DO hv: HistogramView = hvl.first; FOR d: Dim IN Dim DO hv.bad[d].min _ MIN[hv.bad[d].min, dr[d].min]; hv.bad[d].max _ MAX[hv.bad[d].max, dr[d].max]; ENDLOOP; IF hvl.first.updatePeriod = 0.0 THEN VFk.ForkPaint[viewer: hv.bsOuter, hint: client, clearClient: FALSE, tryShortCuts: TRUE]; ENDLOOP; }; WriteTo: PUBLIC ENTRY PROC [h: Histogram, to: IO.STREAM] = { ENABLE UNWIND => NULL; d: DataRef _ h.data; others: BOOL _ FALSE; <> <> to.PutRope["["]; SELECT h.dimensionality FROM 1 => { <> FOR i:NAT _ 0, i+1 WHILE i0 THEN BEGIN <> IF others THEN to.PutRope[", "] ELSE others _ TRUE; to.PutF["%g of %g", IO.card[d.counts[i]], IO.real[i*h.iFactor + h.iOffset]]; <> END; ENDLOOP; }; 2 => { index: NAT _ 0; someI: BOOL _ FALSE; FOR i: INT IN [h.iMin .. h.iMax] DO someJ: BOOL _ FALSE; EnsureJ: PROC = {IF someJ THEN {to.PutRope[", "]; RETURN}; someJ _ TRUE; IF someI THEN to.PutRope[", "]; someI _ TRUE; to.PutF["%g: [", IO.real[i*h.iFactor + h.iOffset]]}; FOR j: INT IN [h.jMin .. h.jMax] DO IF h.data[index] # 0 THEN { EnsureJ[]; to.PutF["%g: %g", IO.real[j*h.jFactor + h.jOffset], IO.int[h.data[index]]]}; index _ index + 1; ENDLOOP; IF someJ THEN to.PutF["]"]; ENDLOOP; }; ENDCASE => ERROR; to.PutRope["]"]; }; Show: PUBLIC PROC [ h: Histogram, viewerInit: ViewerClasses.ViewerRec _ [], format: ROPE _ NIL, --NIL means "%d" width: NAT _ 0, --max number of chars produced when formatting updatePeriod: REAL _ -1.0, --If > 0, every updatePeriod seconds the viewer is repainted if it's out of date. If updatePeriod=0, the viewer is painted every time something changes. If updatePeriod<0, the viewer is never automatically repainted. paint: BOOL _ TRUE] RETURNS [v: Viewer] = { hv: HistogramView; x, yTop, yBot: INTEGER _ 0; w, cw: INTEGER; Place: PROC [iv: Viewer] = { IF iv.wx+iv.ww <= w THEN NULL ELSE IF iv.wx = 0 THEN NULL ELSE VO.MoveViewer[iv, x _ 0, yTop _ yBot+vSep, iv.ww, iv.wh, FALSE]; x _ iv.wx + iv.ww + hSep; yBot _ MAX[yBot, iv.wy + iv.wh]; }; AddView: ENTRY PROC [h: Histogram] = { ENABLE UNWIND => NULL; h.views _ CONS[hv, h.views]; }; hv _ NEW [HistogramViewRep _ [ h: h, iFormat: IF format.Length[] = 0 THEN "%d" ELSE format, iChars: IF width = 0 THEN 5 ELSE width, vFreq: vFreqInitial, dHeight: dHeightInitial, dWidth: 5, updatePeriod: updatePeriod ]]; viewerInit.scrollable _ FALSE; IF viewerInit.icon = unInit THEN viewerInit.icon _ icon; hv.ctr _ v _ MJSContainers.Create[viewerFlavor: containerFlavor, info: viewerInit, paint: paint]; w _ IF v.parent # NIL THEN MAX[v.cw, 100] ELSE (ViewerSpecs.openRightWidth - 2*ViewerSpecs.windowBorderSize); cw _ w - ViewerSpecs.scrollBarW; <> hv.minHLabSep _ Real.Round[hv.iChars * VF.CharWidth['8] * 1.2]; hv.iFreq _ MAX[CeilDiv[MAX[hv.minHLabSep, cw/6], hv.dWidth], 1]; hv.cWidth _ 0.8 * hv.dWidth; hv.bs _ bsStyle.CreateBiScroller[class: histogramViewer, info: [parent: hv.ctr, wx: 0, wy: 0, ww: w, wh: v.ch, data: hv, border: FALSE], paint: FALSE]; Place[stats.Instantiate[[parent: hv.ctr, wx: x, wy: yTop, border: FALSE, name: "Stats"], hv, NIL, FALSE]]; IF h.dimensionality = 1 THEN { Place[vScale.Instantiate[[parent: hv.ctr, wx: x, wy: yTop, border: FALSE, name: "V-Scale"], hv, NIL, FALSE]]; Place[hScale.Instantiate[[parent: hv.ctr, wx: x, wy: yTop, border: FALSE, name: "H-Scale"], hv, NIL, FALSE]]; }; Place[BS.CreateEdge[[parent: hv.ctr, wx: x, wy: yTop, border: FALSE], hv.bs]]; Place[BS.CreateReset[[parent: hv.ctr, wx: x, wy: yTop, border: FALSE], hv.bs]]; Place[BS.CreatePrev[[parent: hv.ctr, wx: x, wy: yTop, border: FALSE], hv.bs]]; Place[BS.CreateScale[[parent: hv.ctr, wx: x, wy: yTop, border: FALSE], hv.bs]]; Place[BS.CreateFit[[parent: hv.ctr, wx: x, wy: yTop, border: FALSE], hv.bs]]; Place[Rules.Create[[parent: hv.ctr, wx: 1, wy: yTop, ww: ViewerSpecs.bwScreenWidth, wh: 1], NIL, FALSE]]; VO.MoveViewer[hv.bsOuter _ hv.bs.QuaViewer[], 0, yBot, w, hv.ctr.ch-yBot, FALSE]; MJSContainers.ChildXBound[hv.ctr, hv.bsOuter]; MJSContainers.ChildYBound[hv.ctr, hv.bsOuter]; AddView[h]; IF paint THEN VO.PaintViewer[v, client]; IF updatePeriod > 0 THEN hv.tracker _ FORK Track[hv, Process.MsecToTicks[ MAX[Real.Fix[MIN[updatePeriod, LAST[CARDINAL]/1000]*1000 + 0.999], 1]]]; }; hSep: INTEGER _ 2; vSep: INTEGER _ 2; Track: PROC [hv: HistogramView, ticks: Process.Ticks] = { DO Process.Pause[ticks]; IF hv.ctr.destroyed THEN EXIT; IF hv.bad[X].max >= hv.bad[X].min AND hv.bad[Y].max >= hv.bad[Y].min AND NOT hv.ctr.iconic THEN VO.PaintViewer[hv.bsOuter, client, FALSE]; ENDLOOP; }; stats: PUB.Class _ PUB.MakeClass[[proc: GiveStats, doc: "Print statistics in MessageWindow"]]; GiveStats: PROC [viewer: Viewer, instanceData, classData, key: REF ANY] --PUB.PopUpButtonProc-- = { hv: HistogramView = NARROW[instanceData]; Stats1: ENTRY PROC [h: Histogram] = { ENABLE UNWIND => NULL; count: INT; sum1, sum2, avg, stdDev, xmin, xmax: REAL; [count, sum1, sum2, avg, stdDev, xmin, xmax] _ Stats1DInt[h]; MessageWindow.Append[ message: IO.PutFR[ "count=%g; sum=%g; sum of squares=%g", [integer[count]], [real[sum1]], [real[sum2]] ], clearFirst: TRUE]; IF count > 0 THEN MessageWindow.Append[ message: IO.PutFR[ "; avg=%g", [real[avg]] ], clearFirst: FALSE]; IF count > 1 THEN MessageWindow.Append[ message: IO.PutFR[ "; std. dev.=%g", [real[stdDev]] ], clearFirst: FALSE]; IF xmax >= xmin THEN MessageWindow.Append[ message: IO.PutFR[ "; x bounds=[%g..%g]", [real[xmin]], [real[xmax]] ], clearFirst: FALSE]; }; Stats2: ENTRY PROC [h: Histogram] = { ENABLE UNWIND => NULL; count: INT; sumX, sumY: REAL; [count, sumX, sumY] _ Stats2DInt[h]; MessageWindow.Append[ message: IO.PutFR[ "count = %g; sumX = %g; sumY = %g", IO.int[count], IO.real[sumX], IO.real[sumY]], clearFirst: TRUE]; IF count > 0 THEN MessageWindow.Append[ message: IO.PutFR[ "; average X = %g; average Y = %g", IO.real[sumX/count], IO.real[sumY/count]], clearFirst: FALSE]; }; SELECT hv.h.dimensionality FROM 1 => Stats1[hv.h]; 2 => Stats2[hv.h]; ENDCASE => ERROR; }; vScale: PUB.Class _ PUB.MakeClass[[proc: TweakVScale, choices: LIST[[$DoubleResolution], [$Fit], [$HalveResolution], [NIL], [$Reset], [NIL]] ]]; TweakVScale: PROC [viewer: Viewer, instanceData, classData, key: REF ANY] --PUB.PopUpButtonProc-- = { hv: HistogramView = NARROW[instanceData]; WithLock: ENTRY PROC [h: Histogram] = { ENABLE UNWIND => NULL; SELECT key FROM $DoubleResolution => IF hv.vFreq > 1 THEN { hv.dHeight _ hv.dHeight * 2; hv.vFreq _ (hv.vFreq + 1) / 2; VFk.ForkPaint[viewer: hv.bsOuter, hint: client, clearClient: TRUE]; }; $HalveResolution => IF hv.vFreq < 16384 THEN { hv.dHeight _ hv.dHeight / 2; hv.vFreq _ hv.vFreq * 2; VFk.ForkPaint[viewer: hv.bsOuter, hint: client, clearClient: TRUE]; }; $Fit => { IF NOT h.maxValid THEN ComputeMax[h]; IF h.maxCount >= 1 THEN { vMin, vMax: BS.Vec; dHeightNew, yf: REAL; [vMin, vMax] _ hv.bs.ViewportExtrema[[0, 1]]; dHeightNew _ 0.95 * (vMax.y - (vMin.y + ySpacing * 2)) / hv.h.maxCount; IF dHeightNew > 0 AND ySpacing < 32000*dHeightNew THEN { yf _ ySpacing / dHeightNew; hv.dHeight _ dHeightNew; hv.vFreq _ MAX[Real.RoundLI[yf + 0.5], 1]; VFk.ForkPaint[viewer: hv.bsOuter, hint: client, clearClient: TRUE]; }; }; }; $Reset => { hv.dHeight _ dHeightInitial; hv.vFreq _ vFreqInitial; VFk.ForkPaint[viewer: hv.bsOuter, hint: client, clearClient: TRUE]; }; ENDCASE => ERROR; }; WithLock[hv.h]; }; hScale: PUB.Class _ PUB.MakeClass[[proc: TweakHScale, choices: LIST[[$DoubleResolution], [$Fit], [$HalveResolution], [NIL], [$Reset], [NIL]] ]]; TweakHScale: PROC [viewer: Viewer, instanceData, classData, key: REF ANY] --PUB.PopUpButtonProc-- = { hv: HistogramView = NARROW[instanceData]; cw: NAT = hv.bs.QuaViewer[TRUE].cw; WithLock: ENTRY PROC [h: Histogram] = { ENABLE UNWIND => NULL; SELECT key FROM $DoubleResolution => IF hv.dWidth < 16384 THEN hv.dWidth _ hv.dWidth * 2 ELSE RETURN; $HalveResolution => IF hv.dWidth > 1 THEN hv.dWidth _ hv.dWidth / 2 ELSE RETURN; $Fit => { vMin, vMax: BS.Vec; [vMin, vMax] _ hv.bs.ViewportExtrema[[1, 0]]; hv.dWidth _ MAX[Real.Round[0.95 * (vMax.x - (vMin.x + hv.minHLabSep)) / MAX[h.data.length, 5]], 1]; }; $Reset => IF hv.dWidth # 5 THEN hv.dWidth _ 5 ELSE RETURN; ENDCASE => ERROR; hv.cWidth _ IF hv.dWidth IN [2 .. 5] THEN hv.dWidth-1 ELSE (0.8*hv.dWidth); hv.iFreq _ MAX[CeilDiv[MAX[hv.minHLabSep, cw/6], hv.dWidth], 1]; VFk.ForkPaint[viewer: hv.bsOuter, hint: client, clearClient: TRUE]; }; WithLock[hv.h]; }; Paint: PROC [self: Viewer, context: Imager.Context, whatChanged: REF ANY, clear: BOOL] RETURNS [quit: BOOL _ FALSE] --ViewerClasses.PaintProc-- = BEGIN asBS: BiScroller = BS.QuaBiScroller[self]; hv: HistogramView = NARROW[asBS.ClientDataOf[]]; SELECT hv.h.dimensionality FROM 1 => Paint1D[self, asBS, hv.h, hv, context, whatChanged, clear]; 2 => Paint2D[self, asBS, hv.h, hv, context, whatChanged, clear]; ENDCASE => ERROR; END; Paint1D: ENTRY PROC [self: Viewer, asBS: BiScroller, h: Histogram, hv: HistogramView, context: Imager.Context, whatChanged: REF ANY, clear: BOOL] = { ENABLE UNWIND => NULL; dwr: REAL = hv.dWidth; i, iMin, iMax, iMinS, iMaxS, jMin, jMax: INT; xMin, xMax, yMin, yMax: BS.Vec; IF NOT h.maxValid THEN ComputeMax[h]; {incremental: BOOL = NOT clear; [xMin, xMax] _ asBS.ViewportExtrema[[1, 0]]; iMin _ MAX[Real.RoundLI[(xMin.x - hv.cWidth/2)/hv.dWidth]-1, 0]; iMax _ MIN[Real.RoundLI[(xMax.x - hv.cWidth/2)/hv.dWidth]+1, INTEGER[h.data.length]-1]; IF incremental THEN { iMin _ MAX[hv.bad[X].min, iMin]; iMax _ MIN[hv.bad[X].max, iMax]; }; IF hv.shown # NIL AND iMax < hv.shown.length THEN NULL ELSE hv.shown _ Ensure[hv.shown, iMax]; iMinS _ FloorDiv[iMin, hv.iFreq] * hv.iFreq; iMaxS _ CeilDiv[iMax, hv.iFreq] * hv.iFreq; IF NOT incremental THEN { showns: DataRef = hv.shown; actuals: DataRef = h.data; [yMin, yMax] _ asBS.ViewportExtrema[[0, 1]]; IF NOT clear THEN { context.SetColor[Imager.white]; context.MaskBox[[xMin.x, yMin.y, xMax.x, yMax.y]]; context.SetColor[Imager.black]; }; context.MaskBox[[adx+awx, ady+awy, adx, hv.dHeight*h.maxCount]]; context.MaskBox[[adx+awx, ady+awy, dwr*h.data.length, ady]]; Imager.SetFont[context, VF.defaultFont]; FOR i _ iMinS, i+hv.iFreq WHILE i <= iMaxS DO r: ROPE = IO.PutFR[hv.iFormat, IO.real[(i+0.5)*h.iFactor + h.iOffset]]; xmin, xmax, ymin, ymax, cx: REAL; cx _ dwr*i + hv.cWidth/2; context.MaskRectangle[[cx-ts, ady-tl, ts*2, tl]]; [[xmin, ymin, xmax, ymax]] _ ImagerBox.BoxFromExtents[VF.defaultFont.RopeBoundingBox[r]]; context.SetXY[[cx - (xmin+xmax)/2, ady-tl-ls-ymax]]; context.ShowRope[r]; ENDLOOP; jMin _ MAX[Real.RoundLI[yMin.y/(hv.dHeight*hv.vFreq)]-1, 0] * hv.vFreq; jMax _ MIN[Real.RoundLI[yMax.y/(hv.dHeight*hv.vFreq)]+1, CeilDiv[h.maxCount, hv.vFreq]] * hv.vFreq; FOR i _ jMin, i+hv.vFreq WHILE i <= jMax DO r: ROPE = IO.PutFR["%g", IO.card[i]]; xmin, ymin, xmax, ymax, cy: REAL; cy _ hv.dHeight*i; context.MaskRectangle[[adx-tl, cy-ts, tl, ts*2]]; [[xmin, ymin, xmax, ymax]] _ ImagerBox.BoxFromExtents[VF.defaultFont.RopeBoundingBox[r]]; context.SetXY[[adx-tl-ls-xmax, cy - (ymin+ymax)/2]]; context.ShowRope[r]; ENDLOOP; FOR i _ iMin, i+1 WHILE i <= iMax DO IF actuals[i]>0 THEN context.MaskRectangle[[i*dwr, 0, hv.cWidth, actuals[i]*hv.dHeight]]; showns[i] _ actuals[i]; ENDLOOP; } ELSE { showns: DataRef = hv.shown; actuals: DataRef = h.data; context.SetColor[ImagerBackdoor.invert]; FOR i _ iMin, i+1 WHILE i <= iMax DO shown: Count = showns[i]; actual: Count = actuals[i]; SELECT <0 => context.MaskRectangle[[i*dwr, actual*hv.dHeight, hv.cWidth, - =0 => NULL; >0 => context.MaskRectangle[[i*dwr, shown*hv.dHeight, hv.cWidth, ENDCASE => ERROR; showns[i] _ actuals[i]; ENDLOOP; }; hv.bad _ nullRange2; }}; Paint2D: ENTRY PROC [self: Viewer, asBS: BiScroller, h: Histogram, hv: HistogramView, context: Imager.Context, whatChanged: REF ANY, clear: BOOL] = { ENABLE UNWIND => NULL; iMin, iMax, jMin, jMax: INTEGER; xMin, xMax, yMin, yMax: BS.Vec; IF NOT h.maxValid THEN {ComputeMax[h]; hv.bad _ fullRange2}; {maxCount: Count = h.maxCount; maxCountR: REAL = maxCount; incremental: BOOL = maxCount = hv.shownMax AND NOT clear; [xMin, xMax] _ asBS.ViewportExtrema[[1, 0]]; [yMin, yMax] _ asBS.ViewportExtrema[[0, 1]]; iMin _ MAX[Real.RoundLI[(xMin.x - h.iOffset)/h.iFactor]-1, h.iMin]; iMax _ MIN[Real.RoundLI[(xMax.x - h.iOffset)/h.iFactor]+1, h.iMax]; jMin _ MAX[Real.RoundLI[(yMin.y - h.jOffset)/h.jFactor]-1, h.jMin]; jMax _ MIN[Real.RoundLI[(yMax.y - h.jOffset)/h.jFactor]+1, h.jMax]; IF incremental THEN { iMin _ MAX[hv.bad[X].min, iMin]; iMax _ MIN[hv.bad[X].max, iMax]; jMin _ MAX[hv.bad[Y].min, jMin]; jMax _ MIN[hv.bad[Y].max, jMax]; }; IF maxCountR > 0 THEN FOR i: INT IN [iMin .. iMax] DO FOR j: INT IN [jMin .. jMax] DO context.SetColor[ImagerColor.ColorFromGray[MAX[0.0, MIN[1.0, h.data[(i - h.iMin)*h.nJ + (j - h.jMin)]/maxCountR]]]]; context.MaskRectangle[[ x: i+0.05, y: j+0.05, w: 0.90, h: 0.90]]; ENDLOOP; ENDLOOP ELSE IF NOT clear THEN { context.SetColor[ImagerColor.ColorFromGray[0]]; context.MaskBox[[iMin, jMin, iMax+1, jMax+1]]; }; hv.shownMax _ maxCount; hv.bad _ nullRange2; }}; Extrema: BS.ExtremaProc = BEGIN hv: HistogramView = NARROW[clientData]; WithLock: ENTRY PROC [h: Histogram] = { ENABLE UNWIND => NULL; nb, ny: INTEGER; SELECT hv.h.dimensionality FROM 1 => { IF NOT h.maxValid THEN ComputeMax[h]; IF h.maxCount # hv.maxCountForR OR hv.vFreqForR # hv.vFreq THEN ComputeR[hv]; nb _ CeilDiv[h.data.length-1, hv.iFreq]; ny _ CeilDiv[h.maxCount, hv.vFreq]; [min, max] _ Geom2D.ExtremaOfRect[ ImagerBox.RectFromBox[[ adx - tl - ls - hv.rxmax + hv.rxmin - leftFudge, ady-tl-ls-fontHeight, hv.dWidth*(nb+0.5)*hv.iFreq, hv.dHeight*(ny+0.5)*hv.vFreq]], direction]; }; 2 => [min, max] _ Geom2D.ExtremaOfRect[ [h.iMin, h.jMin, h.iMax - h.iMin, h.jMax - h.jMin], direction]; ENDCASE => ERROR; }; WithLock[hv.h]; END; ComputeR: INTERNAL PROC [hv: HistogramView] = { topJ: INT = CeilDiv[hv.h.maxCount, hv.vFreq] * hv.vFreq; r: ROPE = IO.PutFR["%g", [integer[topJ]]]; [[hv.rxmin, , hv.rxmax, ]] _ ImagerBox.BoxFromExtents[VF.defaultFont.RopeBoundingBox[r]]; hv.vFreqForR _ hv.vFreq; hv.maxCountForR _ hv.h.maxCount; }; Vanilla: PROC [bs: BS.BiScroller] RETURNS [t: BS.Transform] --BS.TransformGenerator-- = { hv: HistogramView = NARROW[bs.ClientDataOf[]]; WithLock: ENTRY PROC [h: Histogram] = { ENABLE UNWIND => NULL; IF NOT h.maxValid THEN ComputeMax[h]; IF h.maxCount # hv.maxCountForR OR hv.vFreqForR # hv.vFreq THEN ComputeR[hv]; t _ IT.Translate[[-adx + tl + ls + hv.rxmax - hv.rxmin + leftFudge, -ady+tl+ls+fontHeight]]; }; WithLock[hv.h]; }; Find1D: INTERNAL PROC [hv: HistogramView, wo: BS.ClientCoords] RETURNS [index: NAT, valid: BOOL] = BEGIN i: INT; IF wo.x < -hv.dWidth OR wo.x > hv.dWidth * (INT[hv.h.data.length] + 1) THEN RETURN [0, FALSE]; i _ Real.RoundLI[(wo.x - hv.cWidth/2.0) / hv.dWidth]; IF i < 0 OR i >= hv.h.data.length THEN RETURN [0, FALSE]; RETURN [i, TRUE]; END; Find2D: INTERNAL PROC [hv: HistogramView, wo: BS.ClientCoords] RETURNS [i, j: INT, valid: BOOL] = BEGIN i _ Real.RoundLI[wo.x]; j _ Real.RoundLI[wo.y]; valid _ i IN [hv.h.iMin .. hv.h.iMax] AND j IN [hv.h.jMin .. hv.h.jMax]; END; Notify: PROC [self: Viewer, input: LIST OF REF ANY] --ViewerClasses.NotifyProc-- = BEGIN asBS: BiScroller _ BS.QuaBiScroller[self]; hv: HistogramView _ NARROW[asBS.ClientDataOf[]]; SELECT hv.h.dimensionality FROM 1 => Notify1D[self, asBS, hv.h, hv, input]; 2 => Notify2D[self, asBS, hv.h, hv, input]; ENDCASE => ERROR; END; Notify1D: ENTRY PROC [self: Viewer, asBS: BiScroller, h: Histogram, hv: HistogramView, input: LIST OF REF ANY] = { ENABLE UNWIND => NULL; WHILE input # NIL DO SELECT input.first FROM $StartFind => BEGIN index: NAT; valid: BOOL; coords: BS.ClientCoords _ NARROW[input.rest.first]; [index, valid] _ Find1D[hv, coords]; IF hv.finding _ valid THEN {hv.findFirstI _ index; FollowFind1D[hv, index]}; input _ input.rest.rest; END; $FollowFind => BEGIN index: NAT; valid: BOOL; coords: BS.ClientCoords _ NARROW[input.rest.first]; [index, valid] _ Find1D[hv, coords]; IF valid THEN FollowFind1D[hv, index]; input _ input.rest.rest; END; $FinishFind => BEGIN index: NAT; valid: BOOL; coords: BS.ClientCoords _ NARROW[input.rest.first]; [index, valid] _ Find1D[hv, coords]; IF valid THEN FollowFind1D[hv, index]; hv.finding _ FALSE; input _ input.rest.rest; END; ENDCASE => ERROR; ENDLOOP; }; Notify2D: ENTRY PROC [self: Viewer, asBS: BiScroller, h: Histogram, hv: HistogramView, input: LIST OF REF ANY] = { ENABLE UNWIND => NULL; WHILE input # NIL DO SELECT input.first FROM $StartFind => BEGIN i, j: INT; valid: BOOL; coords: BS.ClientCoords _ NARROW[input.rest.first]; [i, j, valid] _ Find2D[hv, coords]; IF hv.finding _ valid THEN {hv.findFirstI _ i; hv.findFirstJ _ j; FollowFind2D[hv, i, j]}; input _ input.rest.rest; END; $FollowFind => BEGIN i, j: INT; valid: BOOL; coords: BS.ClientCoords _ NARROW[input.rest.first]; [i, j, valid] _ Find2D[hv, coords]; IF valid THEN FollowFind2D[hv, i, j]; input _ input.rest.rest; END; $FinishFind => BEGIN i, j: INT; valid: BOOL; coords: BS.ClientCoords _ NARROW[input.rest.first]; [i, j, valid] _ Find2D[hv, coords]; IF valid THEN FollowFind2D[hv, i, j]; hv.finding _ FALSE; input _ input.rest.rest; END; ENDCASE => ERROR; ENDLOOP; }; FollowFind1D: INTERNAL PROC [hv: HistogramView, current: NAT] = { data: DataRef = hv.h.data; lowest, highest: NAT; count: INT _ 0; IF NOT hv.finding THEN {hv.finding _ TRUE; hv.findFirstI _ current}; [lowest, highest] _ Sort2[hv.findFirstI, current]; FOR i: NAT IN [lowest .. highest] DO count _ count + data[i]; ENDLOOP; MessageWindow.Append[ message: IO.PutFR[ "%g in %g thru %g", IO.int[count], IO.real[(lowest-0.0) * hv.h.iFactor + hv.h.iOffset], IO.real[(highest+1.0) * hv.h.iFactor + hv.h.iOffset]], clearFirst: TRUE]; }; Sort2: PROC [i1, i2: INT] RETURNS [min, max: INT] = { SELECT i2 - i1 FROM >0 => {min _ i1; max _ i2}; =0 => min _ max _ i1; <0 => {min _ i2; max _ i1}; ENDCASE => ERROR; }; FollowFind2D: INTERNAL PROC [hv: HistogramView, i, j: INT] = BEGIN data: DataRef = hv.h.data; iMin, iMax, jMin, jMax: INT; count: INT _ 0; IF NOT hv.finding THEN {hv.finding _ TRUE; hv.findFirstI _ i; hv.findFirstJ _ j}; [iMin, iMax] _ Sort2[hv.findFirstI, i]; [jMin, jMax] _ Sort2[hv.findFirstJ, j]; FOR i: INT IN [iMin .. iMax] DO index: NAT _ (i - hv.h.iMin) * hv.h.nJ + jMin - hv.h.jMin; FOR j: INT IN [jMin .. jMax] DO count _ count + data[index]; index _ index + 1; ENDLOOP; ENDLOOP; MessageWindow.Append[ message: IO.PutFR[ "%g in <%g, %g> thru <%g, %g>", IO.int[count], IO.real[(iMin-0.0) * hv.h.iFactor + hv.h.iOffset], IO.real[(jMin-0.0) * hv.h.jFactor + hv.h.jOffset], IO.real[(iMax+1.0) * hv.h.iFactor + hv.h.iOffset], IO.real[(jMax+1.0) * hv.h.jFactor + hv.h.jOffset] ], clearFirst: TRUE]; END; Destroy: PROC [self: Viewer] --ViewerClasses.DestroyProc-- = { asBS: BiScroller = BS.QuaBiScroller[self]; hv: HistogramView = NARROW[asBS.ClientDataOf[]]; RemoveView: ENTRY PROC [h: Histogram] = { ENABLE UNWIND => NULL; h.views _ NARROW[GList.Remove[hv, h.views]]; }; RemoveView[hv.h]; }; Stats1D: PUBLIC ENTRY PROC [h: Histogram] RETURNS [sum0: INT, sum1, sum2, avg, stdDev, xmin, xmax: REAL] = { ENABLE UNWIND => NULL; [sum0, sum1, sum2, avg, stdDev, xmin, xmax] _ Stats1DInt[h]}; Stats1DInt: INTERNAL PROC [h: Histogram] RETURNS [sum0: INT, sum1, sum2, avg, stdDev, xmin, xmax: REAL] = { data: DataRef = h.data; needMin: BOOL _ TRUE; x: REAL _ h.iOffset + h.iFactor/2; sum0 _ 0; sum1 _ sum2 _ 0; FOR i: NAT IN [0..data.length) DO n: Count = data[i]; IF n # 0 THEN { sum0 _ sum0 + n; sum1 _ sum1 + x * n; sum2 _ sum2 + x * x * n; xmax _ x; IF needMin THEN {xmin _ x; needMin _ FALSE}; }; x _ x + h.iFactor; ENDLOOP; avg _ IF sum0 > 0 THEN sum1/sum0 ELSE Real.TrappingNaN; stdDev _ IF sum0 > 1 THEN RealFns.SqRt[(sum2 - sum0*avg*avg) / (sum0 - 1)] ELSE Real.TrappingNaN; IF needMin THEN xmax _ -(xmin _ Real.LargestNumber) ELSE { xmin _ xmin - h.iFactor/2; xmax _ xmax + h.iFactor/2 }; }; Stats2D: PUBLIC ENTRY PROC [h: Histogram] RETURNS [sum0: INT, sumx, sumy: REAL] = { ENABLE UNWIND => NULL; [sum0, sumx, sumy] _ Stats2DInt[h]}; Stats2DInt: INTERNAL PROC [h: Histogram] RETURNS [sum0: INT, sumx, sumy: REAL] = { sum0 _ 0; sumx _ sumy _ 0; FOR i: INT IN [h.iMin .. h.iMax] DO x: REAL _ i*h.iFactor + h.iOffset; FOR j: INT IN [h.jMin .. h.jMax] DO y: REAL _ j*h.jFactor + h.jOffset; index: NAT _ (i - h.iMin) * h.nJ + (j - h.jMin); sum0 _ sum0 + h.data.counts[index]; sumx _ sumx + x * h.data.counts[index]; sumy _ sumy + y * h.data.counts[index]; ENDLOOP; ENDLOOP; }; ComputeMax: INTERNAL PROC [h: Histogram] = BEGIN h.maxCount _ 0; FOR i: NAT _ 0, i+1 WHILE i < h.data.length DO h.maxCount _ MAX[h.maxCount, h.data.counts[i]]; ENDLOOP; h.maxValid _ TRUE; END; CeilDiv: PROC [num, den: INT] RETURNS [quot: INT] = { IF den < 0 THEN {den _ -den; num _ -num}; quot _ IF num < 0 THEN (num/den) ELSE ((num + den-1)/den); }; FloorDiv: PROC [num, den: INT] RETURNS [quot: INT] = { IF den < 0 THEN {den _ -den; num _ -num}; quot _ IF num >= 0 THEN (num/den) ELSE ((num - den+1)/den); }; Round: PROC [r: REAL] RETURNS [i: INT] = {i _ Real.Round[r]}; Setup: PROC = BEGIN ySpacing _ (fontHeight _ VF.FontHeight[]) + 1; histogramViewer _ bsStyle.NewBiScrollerClass[[flavor: $Histogram, extrema: Extrema, notify: Notify, paint: Paint, destroy: Destroy, tipTable: TIPUser.InstantiateNewTIPTable["Histograms.TIP"], mayStretch: FALSE, vanilla: Vanilla, preserve: [0.0, 0.0] ]]; END; Setup[]; END.