<<>> <> <> <> <> <> DIRECTORY Containers USING [ChildXBound, Create], Convert USING [AppendF, AppendInt, AppendRope, RopeFromInt], Histograph USING [], Imager USING [black, Context, MaskRectangle, SetColor, SetFont, SetXYI, ShowRope, ShowText, TranslateT, white], ImagerFont USING [Extents, Find, Font, Scale, RopeBoundingBox, TextBoundingBox], Real USING [Round], RealFns USING [Log], RefText USING [ObtainScratch, ReleaseScratch], Rope USING [Concat, ROPE], ViewerClasses USING [PaintProc, Viewer, ViewerClass, ViewerClassRec], ViewerForkers USING [ForkPaint], ViewerOps USING [CreateViewer, OpenIcon, PaintViewer, RegisterViewerClass, SetOpenHeight], ViewerSpecs USING [captionHeight]; HistographImpl: CEDAR MONITOR LOCKS hist USING hist: HistographData IMPORTS Convert, Containers, Imager, ImagerFont, Real, RealFns, RefText, Rope, ViewerForkers, ViewerOps, ViewerSpecs EXPORTS Histograph = BEGIN <> Context: TYPE = Imager.Context; Extents: TYPE = ImagerFont.Extents; Font: TYPE = ImagerFont.Font; ROPE: TYPE = Rope.ROPE; Viewer: TYPE = ViewerClasses.Viewer; HistographData: TYPE = REF HistographDataRep; HistographDataRep: TYPE = MONITORED RECORD [ height: NAT ¬ 64, -- height of max entry (in viewer units) width: NAT ¬ 120, -- display width of graph (<= sampleMax) lastViewerWidth: NAT ¬ 0, -- last known viewer width (v.ww) flexible: BOOL ¬ FALSE, -- TRUE iff inherits right edge from parent historical: BOOL ¬ FALSE, -- TRUE iff inherits right edge from parent nextPlotIndex: NAT ¬ 0, -- next index (in sampleData) to plot nextDataIndex: NAT ¬ 0, -- next index (in sampleData) to plot firstSampleX: NAT ¬ 64, -- the X position of the first sample firstSampleY: NAT ¬ 8, -- the Y position of the first sample tickX: NAT ¬ 60, -- frequency of ticks in the X direction tickY: NAT ¬ 20, -- frequency of ticks in the Y direction vertiLog: NAT ¬ 1, -- log base to use on vertical axis scale: REAL ¬ 1.0, -- scaling factor to use in plotting samples numberW: INTEGER ¬ 32, -- width to allow for numbers numberH: INTEGER ¬ 10, -- height to allow for numbers numberY: INTEGER ¬ -2, lastSample: REAL ¬ 0, -- the most recent plotted sample lastSampleAvg: REAL ¬ 0, -- the most recent plotted sample avg averageFactor: REAL ¬ 0.9, maxSample: REAL ¬ 100, -- largest permitted sample numberFont: Font ¬ NIL, smallFont: Font ¬ NIL, largeFont: Font ¬ NIL, title: ROPE ¬ NIL, subTitle: ROPE ¬ NIL, sampleData: SEQUENCE sampleMax: NAT OF REAL ]; numberYInit: INTEGER = -2; -- pixels of bottom offset for first line numberPad: NAT = 4; -- pixels of top leading for numbers subTitlePad: NAT = 2; -- pixels of top leading for sub-title subTitleIndent: NAT = 6; -- pixels for sub-title indent titlePad: NAT = 6; -- pixels of top leading for title titleIndent: NAT = 2; -- pixels for title indent clearAhead: NAT = 8; -- # of pixels to keep clear ahead of cursor fontPrefix: ROPE ¬ "Xerox/TiogaFonts/Helvetica"; fontPostfix: NAT ¬ 8; fontScale: NAT ¬ 0; <> NewHistograph: PUBLIC PROC [ dataWidth: NAT ¬ 480, -- # of samples buffered for display dataHeight: NAT ¬ 100, -- # of vertical units for samples maxSample: INT ¬ 100, -- sample corresponding to the height averageFactor: REAL ¬ 0.9, -- used to compute declining average vertiLog: NAT ¬ 0, -- log base to use on Y-axis (0, 1 => linear) title: ROPE ¬ NIL, -- graph title subTitle: ROPE ¬ NIL, -- graph sub-title firstSampleX: NAT ¬ 64, -- x position of first sample numberW: INTEGER ¬ 32, -- # of units for displaying numbers name: ROPE ¬ NIL, -- name to use if top-level viewer parent: Viewer ¬ NIL, -- parent viewer wx: INTEGER ¬ 0, -- x position in parent wy: INTEGER ¬ 0, -- y position in parent historical: BOOL ¬ TRUE, -- => strip chart style, else random access border: BOOL ¬ FALSE, -- => give returned viewer a border childXbound: BOOL ¬ FALSE, -- => make right bound match parent tickX: NAT ¬ 60, -- # of units to use between horizontal ticks tickY: NAT ¬ 25, -- # of units to use between vertical ticks numberFont: Font ¬ NIL, -- font for numbers (default: Helvetica8) smallFont: Font ¬ NIL, -- font for subTitle (default: Helvetica8) largeFont: Font ¬ NIL] -- font for title (default: Helvetica10) RETURNS [Viewer] = { viewer: Viewer ¬ NIL; hist: HistographData ¬ NIL; flexible: BOOL ¬ FALSE; hPlus, hPlusCaption: NAT; IF historical AND childXbound AND parent # NIL AND parent.class.flavor = $Container THEN flexible ¬ TRUE; IF numberFont = NIL THEN numberFont ¬ DefaultFont[0]; IF smallFont = NIL THEN smallFont ¬ DefaultFont[0]; IF largeFont = NIL THEN largeFont ¬ DefaultFont[2]; SELECT tickX FROM < 8 => tickX ¬ 8; > 1024 => tickX ¬ 1024; ENDCASE; SELECT tickY FROM < 8 => tickY ¬ 8; > 1024 => tickY ¬ 1024; ENDCASE; SELECT dataWidth FROM < tickX => dataWidth ¬ tickX; > 4096 => dataWidth ¬ 4096; ENDCASE; SELECT dataHeight FROM < 8 => dataHeight ¬ 8; > 1024 => dataWidth ¬ 1024; ENDCASE; SELECT numberW FROM < 8 => numberW ¬ 8; > 128 => numberW ¬ 128; ENDCASE; SELECT firstSampleX FROM < numberW*2 => firstSampleX ¬ numberW*2; > numberW*4 => firstSampleX ¬ numberW*4; ENDCASE; SELECT averageFactor FROM < 0.0 => averageFactor ¬ 0.0; > 1.0 => averageFactor ¬ 1.0; ENDCASE; hist ¬ NEW[HistographDataRep[dataWidth]]; hist.height ¬ dataHeight; hist.width ¬ dataWidth; hist.flexible ¬ flexible; hist.historical ¬ historical; hist.firstSampleX ¬ firstSampleX; hist.tickX ¬ tickX; hist.tickY ¬ tickY; hist.vertiLog ¬ vertiLog; hist.averageFactor ¬ averageFactor; hist.numberW ¬ numberW; hist.maxSample ¬ IF maxSample <= 0.0 THEN 1.0 ELSE REAL[maxSample]; hist.scale ¬ dataHeight/ (IF vertiLog > 2 THEN RealFns.Log[vertiLog, maxSample] ELSE REAL[maxSample]); hist.title ¬ title; hist.subTitle ¬ subTitle; hist.numberFont ¬ numberFont; hist.smallFont ¬ smallFont; hist.largeFont ¬ largeFont; { wh: INTEGER ¬ numberYInit; ext: ImagerFont.Extents ¬ ImagerFont.RopeBoundingBox[numberFont, "0123456789"]; rh: INTEGER ¬ hist.numberH ¬ Real.Round[ext.ascent]; curTop: INTEGER ¬ dataHeight+rh; IF hist.subTitle # NIL THEN { <> ext ¬ ImagerFont.RopeBoundingBox[smallFont, hist.title]; wh ¬ wh + Real.Round[ext.ascent] + subTitlePad; }; IF hist.title # NIL THEN { <> ext ¬ ImagerFont.RopeBoundingBox[largeFont, hist.title]; wh ¬ wh + Real.Round[ext.ascent] + titlePad; }; wh ¬ wh + (rh + 4)*2; <> IF wh < curTop THEN wh ¬ curTop; hPlus ¬ wh+hist.firstSampleY; hPlusCaption ¬ hPlus+ViewerSpecs.captionHeight; }; viewer ¬ ViewerOps.CreateViewer[ flavor: $Histograph, info: [name: name, data: hist, openHeight: IF parent#NIL THEN hPlus ELSE hPlusCaption, parent: parent, wx: wx, wy: wy, border: border, ww: dataWidth+firstSampleX+numberW+2, wh: IF parent#NIL THEN hPlus ELSE hPlusCaption], paint: FALSE]; IF flexible THEN Containers.ChildXBound[parent, viewer]; RETURN [viewer]; }; Error: PUBLIC ERROR [code: ATOM, message: ROPE] = CODE; AddSample: PUBLIC PROC [viewer: Viewer, sample: REAL, paint: BOOL ¬ TRUE] = { WITH viewer.data SELECT FROM hist: HistographData => IF hist.historical THEN AddSampleEntry[viewer, hist, sample, paint] ELSE ERROR Error[$notHistorical, "operation requires historical"]; ENDCASE => IF NOT viewer.destroyed THEN ERROR Error[$notHistograph, "illegal viewer kind"]; }; StoreSample: PUBLIC PROC [viewer: Viewer, index: NAT, sample: REAL, paint: BOOL ¬ TRUE] = { WITH viewer.data SELECT FROM hist: HistographData => SELECT TRUE FROM hist.historical => ERROR Error[$historical, "operation requires not historical"]; index >= hist.sampleMax => ERROR Error[$invalidIndex, "Invalid index"]; ENDCASE => StoreSampleEntry[viewer, hist, index, sample, paint]; ENDCASE => IF NOT viewer.destroyed THEN ERROR Error[$notHistograph, "illegal viewer kind"]; }; ModifySample: PUBLIC PROC [viewer: Viewer, index: NAT, sample: REAL, paint: BOOL ¬ TRUE] = { WITH viewer.data SELECT FROM hist: HistographData => SELECT TRUE FROM hist.historical => ERROR Error[$historical, "operation requires not historical"]; index >= hist.sampleMax => ERROR Error[$index, "Invalid index"]; ENDCASE => ModifySampleEntry[viewer, hist, index, sample, paint]; ENDCASE => IF NOT viewer.destroyed THEN ERROR Error[$notHistograph, "illegal viewer kind"]; }; FetchSample: PUBLIC PROC [viewer: Viewer, index: NAT] RETURNS [REAL ¬ 0.0] = { WITH viewer.data SELECT FROM hist: HistographData => SELECT TRUE FROM index >= hist.sampleMax => ERROR Error[$invalidIndex, "Invalid index"]; ENDCASE => RETURN [hist[index]]; ENDCASE => IF NOT viewer.destroyed THEN ERROR Error[$notHistograph, "illegal viewer kind"]; }; Reset: PUBLIC PROC [viewer: Viewer, paint: BOOL ¬ TRUE] = { WITH viewer.data SELECT FROM hist: HistographData => ResetEntry[viewer, hist, paint]; ENDCASE => IF NOT viewer.destroyed THEN ERROR Error[$notHistograph, "illegal viewer kind"]; }; <> AddSampleEntry: ENTRY PROC [viewer: Viewer, hist: HistographData, sample: REAL, paint: BOOL ¬ TRUE] = { comp: REAL ¬ 1.0-hist.averageFactor; next: NAT ¬ hist.nextDataIndex; hist[next] ¬ sample; next ¬ next + 1; IF next = hist.sampleMax THEN next ¬ 0; hist.nextDataIndex ¬ next; hist.lastSample ¬ sample; hist.lastSampleAvg ¬ sample + hist.averageFactor * (hist.lastSampleAvg - sample); IF paint THEN ViewerForkers.ForkPaint[viewer, client, FALSE, $Update, TRUE]; }; StoreSampleEntry: ENTRY PROC [viewer: Viewer, hist: HistographData, index: NAT, sample: REAL, paint: BOOL] = { hist.lastSampleAvg ¬ (hist.lastSampleAvg + sample) - hist[index]; hist.lastSample ¬ hist[index] ¬ sample; IF hist.nextDataIndex < hist.nextPlotIndex THEN { IF index < hist.nextDataIndex THEN hist.nextDataIndex ¬ index; IF index >= hist.nextPlotIndex THEN hist.nextPlotIndex ¬ index+1; } ELSE { hist.nextDataIndex ¬ index; hist.nextPlotIndex ¬ index+1; }; IF paint THEN ViewerForkers.ForkPaint[viewer, client, FALSE, $Update, TRUE]; }; ModifySampleEntry: ENTRY PROC [viewer: Viewer, hist: HistographData, index: NAT, sample: REAL, paint: BOOL] = { hist.lastSampleAvg ¬ hist.lastSampleAvg + sample; hist.lastSample ¬ hist[index] ¬ hist[index] + sample; IF hist.nextDataIndex < hist.nextPlotIndex THEN { IF index < hist.nextDataIndex THEN hist.nextDataIndex ¬ index; IF index >= hist.nextPlotIndex THEN hist.nextPlotIndex ¬ index+1; } ELSE { hist.nextDataIndex ¬ index; hist.nextPlotIndex ¬ index+1; }; IF paint THEN ViewerForkers.ForkPaint[viewer, client, FALSE, $Update, TRUE]; }; ResetEntry: ENTRY PROC [viewer: Viewer, hist: HistographData, paint: BOOL ¬ TRUE] = { FOR index: NAT IN [0..hist.sampleMax) DO hist[index] ¬ 0.0; ENDLOOP; hist.nextDataIndex ¬ 0; hist.nextPlotIndex ¬ 0; hist.lastSampleAvg ¬ 0.0; IF paint THEN ViewerForkers.ForkPaint[viewer, client, FALSE, NIL, TRUE]; }; GetDirtyRange: ENTRY PROC [hist: HistographData] RETURNS [start, limit: NAT] = { <> start ¬ hist.nextDataIndex; limit ¬ hist.nextPlotIndex; hist.nextDataIndex ¬ hist.nextPlotIndex ¬ hist.sampleMax; }; <> HistographPaint: ViewerClasses.PaintProc = { <<[self: ViewerClasses.Viewer, context: Imager.Context, whatChanged: REF ANY, clear: BOOL] RETURNS [quit: BOOL _ FALSE]>> WITH self.data SELECT FROM hist: HistographData => { update: BOOL ¬ whatChanged = $Update; print: BOOL ¬ whatChanged = $Print; historical: BOOL ¬ hist.historical; index: INTEGER ¬ hist.nextPlotIndex; limit: NAT ¬ hist.nextDataIndex; blackSet: BOOL ¬ FALSE; baseX: INTEGER ¬ hist.firstSampleX; baseY: INTEGER ¬ hist.firstSampleY; max: INTEGER ¬ hist.sampleMax; w: INTEGER ¬ hist.width; h: INTEGER ¬ hist.height; rightBound: INTEGER ¬ self.ww; IF clear THEN update ¬ FALSE; Imager.TranslateT[context, [baseX, baseY]]; IF hist.flexible AND rightBound # hist.lastViewerWidth THEN { <> update ¬ FALSE; w ¬ (hist.lastViewerWidth ¬ rightBound) - hist.firstSampleX - hist.numberW; <> SELECT w FROM < hist.tickX => w ¬ hist.tickX; <> > max => w ¬ max; <> ENDCASE; hist.width ¬ w; }; IF NOT update THEN { <> IF NOT print THEN { <> Imager.SetColor[context, Imager.white]; Imager.MaskRectangle[context, [x: self.wx, y: self.wy, w: rightBound, h: self.wh]]; }; <> hist.numberY ¬ numberYInit; Imager.SetColor[context, Imager.black]; IF hist.subTitle # NIL THEN { ext: ImagerFont.Extents ¬ ImagerFont.RopeBoundingBox[hist.smallFont, hist.subTitle]; Imager.SetFont[context, hist.smallFont]; Imager.SetXYI[context, -hist.firstSampleX+subTitleIndent, hist.numberY]; Imager.ShowRope[context, hist.subTitle]; hist.numberY ¬ hist.numberY + Real.Round[ext.ascent] + subTitlePad; }; IF hist.title # NIL THEN { ext: ImagerFont.Extents ¬ ImagerFont.RopeBoundingBox[hist.largeFont, hist.title]; Imager.SetFont[context, hist.largeFont]; Imager.SetXYI[context, -hist.firstSampleX+titleIndent, hist.numberY]; Imager.ShowRope[context, hist.title]; hist.numberY ¬ hist.numberY + Real.Round[ext.ascent] + titlePad; }; Imager.SetFont[context, hist.numberFont]; <> Imager.SetColor[context, Imager.black]; blackSet ¬ TRUE; Imager.MaskRectangle[context, [x: -1, y: -2, w: w+2, h: 2]]; Imager.MaskRectangle[context, [x: -1, y: -2, w: 1.0, h: h+2]]; Imager.MaskRectangle[context, [x: w, y: -2, w: 1.0, h: h+2]]; FOR i: NAT ¬ 0, i + hist.tickX UNTIL i > w DO Imager.MaskRectangle[context, [x: i, y: -5, w: 1, h: 5]]; ENDLOOP; { <> delta: NAT = 2; wx: INTEGER = w+delta*2; eachTime: REAL = REAL[hist.tickY]/hist.height; fract: REAL ¬ 1.0; value: REAL ¬ hist.maxSample; FOR i: INTEGER ¬ h, i - hist.tickY UNTIL i < 0 DO tag: ROPE = Convert.RopeFromInt[Real.Round[value]]; ropeWidth: INT = Real.Round[ImagerFont.RopeBoundingBox[hist.numberFont, tag].rightExtent]; Imager.SetXYI[context, 0-ropeWidth-delta*2, i-delta]; IF i # 0 THEN Imager.ShowRope[context, tag]; Imager.MaskRectangle[context, [x: -1, y: i, w: -delta, h: -1.0]]; Imager.MaskRectangle[context, [x: w+1, y: i, w: +delta, h: -1.0]]; Imager.SetXYI[context, wx, i-delta]; Imager.ShowRope[context, tag]; SELECT TRUE FROM hist.vertiLog <= 1 => { fract ¬ fract - eachTime; value ¬ hist.maxSample*fract; }; ENDCASE => value ¬ value / hist.vertiLog; ENDLOOP; }; }; IF historical THEN { IF NOT update THEN { <> index ¬ limit - (w - clearAhead); IF index < 0 THEN index ¬ index + max; }; } ELSE { <> [index, limit] ¬ GetDirtyRange[hist]; IF NOT update THEN {index ¬ 0; limit ¬ max}; IF index >= limit THEN RETURN; }; IF index # limit THEN { scale: REAL = hist.scale; pos: INTEGER; avg: REAL ¬ hist.lastSampleAvg; comp: REAL ¬ 1.0-hist.averageFactor; count: NAT ¬ 0; IF historical THEN { <> elems: INTEGER ¬ IF limit >= index THEN limit-index ELSE limit+max-index; pos ¬ limit - elems; DO SELECT pos FROM < 0 => pos ¬ pos + w; >= w => pos ¬ pos - w; ENDCASE => EXIT; ENDLOOP; } ELSE { pos ¬ index; <> avg ¬ avg / max; <> }; DO sample: REAL ¬ hist[index]; IF update OR (historical AND count+(clearAhead+2) > NAT[w]) THEN { IF NOT print THEN { <> Imager.SetColor[context, Imager.white]; blackSet ¬ FALSE; Imager.MaskRectangle[context, [x: pos, y: 0, w: 1.0, h: h]]; IF historical THEN { <> farPos: NAT ¬ pos+clearAhead; IF farPos >= w THEN farPos ¬ farPos - w; Imager.MaskRectangle[context, [x: farPos, y: 0, w: 1.0, h: h]]; }; }; }; IF sample > 0.0 THEN { <> sam: REAL ¬ 0.0; SELECT TRUE FROM hist.vertiLog <= 1 => sam ¬ sample * scale; sample > 0.0 => sam ¬ h + RealFns.Log[hist.vertiLog, sample/hist.maxSample]*hist.tickY; ENDCASE; IF NOT blackSet THEN {Imager.SetColor[context, Imager.black]; blackSet ¬ TRUE}; Imager.MaskRectangle[context, [x: pos, y: 0, w: 1.0, h: MAX[Real.Round[MIN[sam, h]], INT[1]] ]]; }; count ¬ count + 1; pos ¬ pos + 1; IF pos = w THEN pos ¬ 0; IF (index ¬ index + 1) = max AND historical THEN index ¬ 0; IF index = limit THEN { <> Imager.SetColor[context, Imager.black]; IF historical THEN { <> quarter: NAT ¬ h/4; half: NAT ¬ quarter+quarter; Imager.MaskRectangle[context, [x: pos, y: quarter-2, w: 1.0, h: 4]]; Imager.MaskRectangle[context, [x: pos, y: half-2, w: 1.0, h: 4]]; Imager.MaskRectangle[context, [x: pos, y: quarter+half-2, w: 1.0, h: 4]]; hist.nextPlotIndex ¬ index; }; ShowNumber[hist, context, hist.lastSample, avg, update]; <> EXIT; }; ENDLOOP; }; }; ENDCASE; }; <> ShowNumber: PROC [hist: HistographData, context: Context, sample: REAL, avg: REAL, needClear: BOOL] = { text: REF TEXT ¬ RefText.ObtainScratch[16]; SELECT TRUE FROM avg < 0.005 => text ¬ Convert.AppendRope[text, "0", FALSE]; avg < 0.05 => text ¬ Convert.AppendRope[text, "< 0.1", FALSE]; avg < 9.95 => text ¬ Convert.AppendF[text, avg, 1]; ENDCASE => text ¬ Convert.AppendInt[text, Real.Round[avg]]; ShowNumberText[hist, context, hist.numberFont, 0, text, needClear]; text.length ¬ 0; SELECT TRUE FROM sample = 0 => text ¬ Convert.AppendRope[text, "0", FALSE]; sample < 0.05 => text ¬ Convert.AppendRope[text, "< 0.1", FALSE]; sample < 9.95 => text ¬ Convert.AppendF[text, sample, 1]; ENDCASE => text ¬ Convert.AppendInt[text, Real.Round[sample]]; ShowNumberText[hist, context, hist.numberFont, 1, text, needClear]; RefText.ReleaseScratch[text]; }; ShowNumberText: PROC [hist: HistographData, context: Context, font: ImagerFont.Font, hd: INTEGER, text: REF TEXT, needClear: BOOL] = { w: INTEGER ¬ Real.Round[ImagerFont.TextBoundingBox[font, text].rightExtent]; h: INTEGER ¬ hist.numberH; <> hd ¬ hist.numberY+(hd*(h+numberPad)); IF needClear THEN { <> Imager.SetColor[context, Imager.white]; Imager.MaskRectangle[context, [x: -hist.firstSampleX, y: hd-1, w: hist.numberW, h: h+2]]; }; <> Imager.SetColor[context, Imager.black]; Imager.SetXYI[context, -hist.firstSampleX+hist.numberW-w, hd]; Imager.SetFont[context, font]; Imager.ShowText[context, text]; }; DefaultFont: PROC [delta: NAT] RETURNS [font: Font] = { name: ROPE ¬ fontPrefix; IF fontPostfix # 0 THEN name ¬ Rope.Concat[name, Convert.RopeFromInt[fontPostfix+delta]]; font ¬ ImagerFont.Find[name]; IF fontScale # 0 THEN font ¬ ImagerFont.Scale[font, fontScale+delta]; }; SetDefaultFont: PROC [which: ATOM, size: NAT] = { SELECT which FROM $tioga, $Tioga => { fontPrefix ¬ "Xerox/TiogaFonts/Helvetica"; fontPostfix ¬ size; fontScale ¬ 0; }; $press, $Press => { fontPrefix ¬ "Xerox/PressFonts/Helvetica-mrr"; fontPostfix ¬ 0; fontScale ¬ size; }; ENDCASE; }; <> Test: PROC [sample: REAL, times: NAT ¬ 1, height: NAT ¬ 64, vLog: NAT ¬ 1, container, flexible, historical: BOOL ¬ TRUE] ~ { hist: HistographData ¬ NIL; IF topViewer = NIL OR topViewer.destroyed THEN { <