<> <> <> 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, RopeWidth, TextBoundingBox], Real USING [Round, RoundI], 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.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.RoundI[ext.ascent]; curTop: INTEGER _ dataHeight+rh; IF hist.subTitle # NIL THEN { <> ext _ ImagerFont.RopeBoundingBox[smallFont, hist.title]; wh _ wh + Real.RoundI[ext.ascent] + subTitlePad; }; IF hist.title # NIL THEN { <> ext _ ImagerFont.RopeBoundingBox[largeFont, hist.title]; wh _ wh + Real.RoundI[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.RoundI[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.RoundI[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.RopeWidth[hist.numberFont, tag].x]; 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) > 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.RoundI[MIN[sam, h]], 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.RoundI[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 { <