<> <> <> <> <> <> DIRECTORY Basics USING [DIVMOD], Convert USING [IntFromRope, RopeFromInt], Imager, ImagerOps, Labels USING [Label], NumberLabels USING [], Rope USING [ROPE], VFonts USING [CharWidth, defaultFont, Font, FontHeight, StringWidth], ViewerClasses USING [ GetProc, PaintProc, SetProc, Viewer, ViewerClass, ViewerClassRec, ViewerRec], ViewerExtras USING [ImagerFont], ViewerOps USING [CreateViewer, PaintViewer, RegisterViewerClass]; LabelsImpl: CEDAR PROGRAM IMPORTS Basics, Convert, Imager, ImagerOps, VFonts, ViewerExtras, ViewerOps EXPORTS Labels, NumberLabels = BEGIN OPEN ViewerClasses; Label: TYPE ~ Labels.Label; ROPE: TYPE ~ Rope.ROPE; bottomOffset: INTEGER = 3; -- for painting leftOffset: INTEGER = 3; LabelData: TYPE = REF LabelDataRec; LabelDataRec: TYPE = RECORD [ font: Imager.FONT, displayStyle: DisplayStyle ]; DisplayStyle: TYPE = {blackOnWhite, whiteOnBlack, blackOnGrey} ; Create: PUBLIC PROC [info: ViewerRec _ [], font: VFonts.Font _ VFonts.defaultFont, paint: BOOL _ TRUE] RETURNS [label: Label] = BEGIN data: LabelData _ NEW[LabelDataRec _ [ViewerExtras.ImagerFont[font], blackOnWhite]]; IF info.parent=NIL THEN ERROR; IF info.ww=0 THEN info.ww _ VFonts.StringWidth[info.name, font]+leftOffset+leftOffset; IF info.wh=0 THEN info.wh _ VFonts.FontHeight[font]+bottomOffset; info.data _ data; label _ ViewerOps.CreateViewer[$Label, info, paint]; END; myGrey: Imager.Color ~ ImagerOps.ColorFromStipple[001010B]; LabelPaint: PaintProc = BEGIN <> <> data: LabelData _ NARROW[self.data]; imager: Imager.Context ~ ImagerOps.ImagerFromGraphics[context]; borderFudge: INTEGER = IF self.border THEN 0 ELSE 1; IF data = NIL THEN RETURN; IF ~clear OR data.displayStyle#blackOnWhite THEN BEGIN SELECT data.displayStyle FROM whiteOnBlack => Imager.SetColor[imager, Imager.black]; blackOnGrey => Imager.SetColor[imager, myGrey]; blackOnWhite => Imager.SetColor[imager, Imager.white]; ENDCASE; Imager.MaskRectangleI[imager, 1, 1, self.cw-2, self.ch-2]; END; IF self.name=NIL THEN RETURN; Imager.SetColor[imager, SELECT data.displayStyle FROM whiteOnBlack => Imager.white, ENDCASE => Imager.black]; Imager.SetXYI[imager, leftOffset+borderFudge, bottomOffset+borderFudge]; Imager.SetFont[imager, data.font]; Imager.ShowRope[imager, self.name]; END; LabelGet: GetProc = BEGIN RETURN[self.name]; END; LabelSet: SetProc = BEGIN IF op=NIL THEN self.name _ NARROW[data] ELSE BEGIN myData: LabelData _ NARROW[self.data]; IF myData = NIL THEN RETURN; SELECT data FROM $BlackOnWhite => myData.displayStyle _ blackOnWhite; $WhiteOnBlack => myData.displayStyle _ whiteOnBlack; $BlackOnGrey => myData.displayStyle _ blackOnGrey; ENDCASE; END; IF finalise THEN ViewerOps.PaintViewer[self, all]; END; NumberLabel: TYPE = ViewerClasses.Viewer; NumberLabelData: TYPE = REF NumberLabelDataRec; NumberLabelDataRec: TYPE = RECORD [ font: Imager.FONT, displayStyle: DisplayStyle, currentValue: INT _ 0, lastDisplayed: INT _ 0 ]; -- The following material is to support NumberLabels CreateNumber: PUBLIC PROC [info: ViewerClasses.ViewerRec _ [], chars: NAT _ 0, initialValue: INT _ 0, font: VFonts.Font _ VFonts.defaultFont, paint: BOOL _ TRUE] RETURNS [nl: NumberLabel _ NIL] = { data: NumberLabelData _ NEW [ NumberLabelDataRec _ [ViewerExtras.ImagerFont[font], blackOnWhite, initialValue, initialValue + 1]]; IF info.parent=NIL THEN ERROR; IF info.ww=0 THEN info.ww _ chars*VFonts.CharWidth['0, font]+leftOffset+leftOffset; IF info.wh=0 THEN info.wh _ VFonts.FontHeight[font]+bottomOffset; info.data _ data; nl _ ViewerOps.CreateViewer[$NumberLabel, info, paint]; }; NumberLabelPaint: ViewerClasses.PaintProc = { <> imager: Imager.Context ~ ImagerOps.ImagerFromGraphics[context]; data: NumberLabelData _ NARROW[self.data]; borderFudge: INTEGER = IF self.border THEN 0 ELSE 1; chars: ARRAY [0..11] OF CHAR; pos: NAT _ 0; card: LONG CARDINAL; scard: CARDINAL; font: Imager.FONT = data.font; IF data = NIL THEN RETURN; IF ~clear OR data.displayStyle # blackOnWhite THEN BEGIN SELECT data.displayStyle FROM whiteOnBlack => Imager.SetColor[imager, Imager.black]; blackOnGrey => Imager.SetColor[imager, myGrey]; blackOnWhite => Imager.SetColor[imager, Imager.white]; ENDCASE; Imager.MaskRectangleI[imager, 1, 1, self.cw-2, self.ch-2]; whatChanged _ NIL; END; IF whatChanged = $Update AND data.currentValue = data.lastDisplayed THEN RETURN; data.lastDisplayed _ data.currentValue; Imager.SetColor[imager, SELECT data.displayStyle FROM whiteOnBlack => Imager.white, ENDCASE => Imager.black]; Imager.SetXYI[imager, leftOffset+borderFudge, bottomOffset+borderFudge]; card _ LOOPHOLE[data.currentValue]; Imager.SetFont[imager, font]; IF data.currentValue < 0 THEN { Imager.ShowChar[imager, '-]; card _ - card; }; <<>> <> WHILE card > LAST[CARDINAL] DO chars[pos] _ '0 + (card MOD 10); card _ card / 10; pos _ pos + 1; ENDLOOP; <<>> <> scard _ card; WHILE scard > 9 DO mod: CARDINAL; [scard,mod] _ Basics.DIVMOD[scard, 10]; chars[pos] _ '0 + mod; pos _ pos + 1; ENDLOOP; <<>> <> Imager.ShowChar[imager, '0 + scard]; <<>> <> WHILE pos > 0 DO pos _ pos - 1; Imager.ShowChar[imager, chars[pos]]; ENDLOOP; }; NumberLabelGet: ViewerClasses.GetProc = { myData: NumberLabelData _ NARROW[self.data]; IF myData = NIL THEN RETURN [NIL]; IF op = NIL THEN RETURN[Convert.RopeFromInt[myData.currentValue]] ELSE RETURN [NEW[INT _ myData.currentValue]]; }; NumberLabelSet: ViewerClasses.SetProc = { myData: NumberLabelData _ NARROW[self.data]; IF myData = NIL THEN RETURN; WITH data SELECT FROM rope: ROPE => myData.currentValue _ Convert.IntFromRope[rope]; atom: ATOM => SELECT data FROM $BlackOnWhite => myData.displayStyle _ blackOnWhite; $WhiteOnBlack => myData.displayStyle _ whiteOnBlack; $BlackOnGrey => myData.displayStyle _ blackOnGrey; ENDCASE; refInt: REF INT => myData.currentValue _ refInt^; ENDCASE => RETURN; IF finalise THEN ViewerOps.PaintViewer[self, all]; }; NumberLabelUpdate: PUBLIC PROC [nl: NumberLabel, new: INT _ 0] = { myData: NumberLabelData _ NARROW[nl.data]; IF myData = NIL THEN RETURN; myData.currentValue _ new; IF new # myData.lastDisplayed THEN ViewerOps.PaintViewer[nl, all, FALSE, $Update]; }; NumberLabelQuery: PUBLIC PROC [nl: NumberLabel] RETURNS [current: INT _ 0] = { myData: NumberLabelData _ NARROW[nl.data]; IF myData = NIL THEN RETURN; RETURN [myData.currentValue]; }; labelClass: ViewerClasses.ViewerClass _ NEW[ViewerClasses.ViewerClassRec _ [ paint: LabelPaint, get: LabelGet, set: LabelSet ]]; numberLabelClass: ViewerClasses.ViewerClass _ NEW[ViewerClasses.ViewerClassRec _ [ paint: NumberLabelPaint, get: NumberLabelGet, set: NumberLabelSet ]]; ViewerOps.RegisterViewerClass[$Label, labelClass]; -- plug in to Viewers ViewerOps.RegisterViewerClass[$NumberLabel, numberLabelClass]; -- plug in to Viewers END.