implements Histograms
Mike Spreitzer January 14, 1987 5:16:15 pm PST
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<oldLen
DO
new.counts[i] ← old.counts[i];
ENDLOOP;
FOR i:
NAT ← oldLen, i+1
WHILE i<new.length
DO
new.counts[i] ← 0;
ENDLOOP;
};
Change:
PUBLIC
ENTRY
PROC [h: Histogram, who:
NAT, howMuch:
INTEGER] = {
ENABLE UNWIND => 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;
I wonder why this check was here?
IF h.dimensionality # 1 THEN ERROR;
to.PutRope["["];
SELECT h.dimensionality
FROM
1 => {
count: NAT ← 0;
FOR i:
NAT ← 0, i+1
WHILE i<d.length
DO
IF d.counts[i]>0
THEN
BEGIN
IF others THEN to.PutRope[IF (count MOD 5)=0 THEN "\n" ELSE ", "];
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]];
count ← count + 1;
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;
need that iChars * charwidth * 1.2 < dwidth * iFreq
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];
d: INT = INT[actual] - shown;
SELECT
d
FROM
<0 => context.MaskRectangle[[i*dwr, actual*hv.dHeight, hv.cWidth, -d*hv.dHeight]];
=0 => NULL;
>0 => context.MaskRectangle[[i*dwr, shown*hv.dHeight, hv.cWidth, d*hv.dHeight]];
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.