DIRECTORY Basics USING [DivMod], Convert USING [IntFromRope, RopeFromInt], Imager USING [black, Color, Font, MaskRectangleI, SetColor, SetFont, SetXYI, ShowChar, ShowRope, white], ImagerBackdoor USING [MakeStipple], Labels USING [Label], NumberLabels USING [], Rope USING [ROPE], VFonts USING [CharWidth, DefaultFont, Font, FontHeight, StringWidth], ViewerClasses USING [GetProc, PaintProc, SetProc, Viewer, ViewerClass, ViewerClassRec, ViewerRec], ViewerOps USING [CreateViewer, DestroyViewer, PaintViewer, RegisterViewerClass]; LabelsImpl: CEDAR PROGRAM IMPORTS Basics, Convert, Imager, ImagerBackdoor, VFonts, ViewerOps EXPORTS Labels, NumberLabels = BEGIN OPEN ViewerClasses, Labels, Rope; bottomOffset: INTEGER = 3; -- for painting sideMargin: INTEGER = 3; LabelData: TYPE = REF LabelDataRec; LabelDataRec: TYPE = RECORD [ font: Imager.Font _ NIL, displayStyle: DisplayStyle _ blackOnWhite ]; DisplayStyle: TYPE = {blackOnWhite, whiteOnBlack, blackOnGrey}; Create: PUBLIC PROC [info: ViewerRec _ [], font: Imager.Font _ NIL, paint: BOOL _ TRUE] RETURNS [label: Label] = { data: LabelData ~ NEW[LabelDataRec _ [font: VFonts.DefaultFont[font]]]; IF info.parent=NIL THEN ERROR; IF info.ww=0 THEN info.ww _ VFonts.StringWidth[info.name, data.font]+sideMargin*2; IF info.wh=0 THEN info.wh _ VFonts.FontHeight[data.font]+bottomOffset; info.data _ data; label _ ViewerOps.CreateViewer[$Label, info, paint]; }; Destroy: PUBLIC PROC [label: Label] = {ViewerOps.DestroyViewer[label]}; Set: PUBLIC PROC [label: Label, value: Rope.ROPE, paint: BOOL _ TRUE] = {label.class.set[label, value, paint]}; SetDisplayStyle: PUBLIC PROC [label: Label, style: ATOM, paint: BOOL _ TRUE] = {label.class.set[label, style, paint, $DisplayStyle]}; white: Imager.Color ~ Imager.white; black: Imager.Color ~ Imager.black; myGrey: Imager.Color ~ ImagerBackdoor.MakeStipple[001010B]; BackgroundColor: PROC [displayStyle: DisplayStyle] RETURNS [Imager.Color] ~ { SELECT displayStyle FROM blackOnWhite => RETURN[white]; whiteOnBlack => RETURN[black]; blackOnGrey => RETURN[myGrey]; ENDCASE; RETURN[white]; }; LabelColor: PROC [displayStyle: DisplayStyle] RETURNS [Imager.Color] ~ { SELECT displayStyle FROM blackOnWhite => RETURN[black]; whiteOnBlack => RETURN[white]; blackOnGrey => RETURN[black]; ENDCASE; RETURN[black]; }; LabelPaint: PaintProc = { data: LabelData _ NARROW[self.data]; borderFudge: INTEGER = IF self.border THEN 0 ELSE 1; background: Imager.Color ~ BackgroundColor[data.displayStyle]; IF data = NIL THEN RETURN; IF clear AND background=white THEN NULL ELSE { Imager.SetColor[context, background]; Imager.MaskRectangleI[context, 1, 1, self.cw-2, self.ch-2]; }; IF self.name=NIL THEN RETURN; Imager.SetColor[context, LabelColor[data.displayStyle]]; Imager.SetXYI[context, sideMargin+borderFudge, bottomOffset+borderFudge]; Imager.SetFont[context, data.font]; Imager.ShowRope[context, self.name]; }; LabelGet: GetProc = { RETURN[self.name]; }; LabelSet: SetProc = { IF op=NIL THEN self.name _ NARROW[data] ELSE { 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; }; IF finalise THEN ViewerOps.PaintViewer[self, all]; }; NumberLabel: TYPE = ViewerClasses.Viewer; NumberLabelData: TYPE = REF NumberLabelDataRec; NumberLabelDataRec: TYPE = RECORD [ font: VFonts.Font, displayStyle: DisplayStyle _ blackOnWhite, currentValue: INT _ 0, lastDisplayed: INT _ 0 ]; CreateNumber: PUBLIC PROC [info: ViewerClasses.ViewerRec _ [], chars: NAT _ 0, initialValue: INT _ 0, font: Imager.Font _ NIL, paint: BOOL _ TRUE] RETURNS [nl: NumberLabel _ NIL] = { data: NumberLabelData _ NEW [NumberLabelDataRec _ [font: VFonts.DefaultFont[font], currentValue: initialValue, lastDisplayed: initialValue + 1]]; IF info.parent=NIL THEN ERROR; IF info.ww=0 THEN info.ww _ chars*VFonts.CharWidth['0, data.font]+sideMargin+sideMargin; IF info.wh=0 THEN info.wh _ VFonts.FontHeight[data.font]+bottomOffset; info.data _ data; nl _ ViewerOps.CreateViewer[$NumberLabel, info, paint]; }; NumberLabelPaint: ViewerClasses.PaintProc = { 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; background: Imager.Color ~ BackgroundColor[data.displayStyle]; IF data = NIL THEN RETURN; IF clear AND background=white THEN NULL ELSE { Imager.SetColor[context, background]; Imager.MaskRectangleI[context, 1, 1, self.cw-2, self.ch-2]; whatChanged _ NIL; }; IF whatChanged = $Update AND data.currentValue = data.lastDisplayed THEN RETURN; data.lastDisplayed _ data.currentValue; Imager.SetColor[context, LabelColor[data.displayStyle]]; Imager.SetXYI[context, sideMargin+borderFudge, bottomOffset+borderFudge]; Imager.SetFont[context, data.font]; card _ LOOPHOLE[data.currentValue]; IF data.currentValue < 0 THEN { Imager.ShowChar[context, '-]; 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[context, '0 + scard]; WHILE pos > 0 DO pos _ pos - 1; Imager.ShowChar[context, 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. jLabelsImpl.mesa Copyright c 1985 by Xerox Corporation. All rights reserved. McGregor, October 28, 1982 11:17 am Maxwell, May 23, 1983 2:57 pm Russ Atkinson, September 27, 1983 1:14 pm Doug Wyatt, April 15, 1985 5:46:15 pm PST borderFudge is so labels line up whether they have borders or not The following material is to support NumberLabels borderFudge is so labels line up whether they have borders or not while we have to stay in 32 bits, do so at this point, it is faster to do this in 16 bits unconditionally output the leading character finally, output the remaining characters that we have stored Κ – "Mesa" style˜codešœ™Kšœ Οmœ1™˜>Kšžœžœžœžœ˜Kšžœžœžœž˜'šžœ˜Kšœ%˜%K˜;K˜—Kšžœ žœžœžœ˜Kšœ8˜8K˜IK˜#K˜$Kšœ˜K˜—š‘œ ˜Kšžœ ˜Kšœ˜K˜—š‘œ ˜Kšžœžœžœ žœ˜'šžœ˜Kšœžœ ˜&Kšžœ žœžœžœ˜šžœž˜K˜4K˜4K˜2Kšžœ˜—Kšœ˜—Kšžœ žœ"˜2Kšœ˜K˜—Kšœ žœ˜)K˜Kšœžœžœ˜/šœžœžœ˜#K˜Kšœ*˜*Kšœžœ˜Kšœžœ˜K˜K˜—Kšœ2™2š‘ œžœžœ.žœžœžœ žœžœžœžœ˜ΈKšœžœw˜’Kšžœ žœžœžœ˜Kšžœ žœG˜XKšžœ žœ5˜FK˜Kšœ7˜7Kšœ˜K˜—š‘œ˜-KšœA™AKšœžœ ˜*Kš œ žœžœ žœžœ˜4Kšœžœ žœžœ˜Kšœžœ˜ Kšœžœžœ˜Kšœžœ˜K˜>Kšžœžœžœžœ˜K˜Kšžœžœžœž˜'šžœ˜K˜%Kšœ;˜;Kšœžœ˜K˜—Kšžœžœ(žœžœ˜PKšœ'˜'Kšœ8˜8KšœI˜IKšœ#˜#Kšœžœ˜#Kšžœžœ1˜NK™Kšœ'™'šžœžœžœž˜Kšœžœ˜ K˜K˜Kšžœ˜—K™Kšœ1™1K˜ šžœ ž˜Kšœžœ˜Kšœ'˜'Kšœ˜K˜Kšžœ˜—K™Kšœ,™,Kšœ%˜%K™Kšœ<™<šžœ ž˜K˜Kšœ%˜%Kšžœ˜—Kšœ˜K˜—š‘œ˜)Kšœžœ ˜,Kš žœ žœžœžœžœ˜"šžœž˜ Kšžœžœ*˜5Kšžœžœžœžœ˜-—Kšœ˜K˜—š‘œ˜)Kšœžœ ˜,Kšžœ žœžœžœ˜šžœžœž˜šœžœ˜ Kšœ0˜0—šœžœ˜šžœž˜K˜4K˜4K˜2Kšžœ˜——šœžœžœ˜Kšœ˜—Kšžœžœ˜—Kšžœ žœ"˜2Kšœ˜K˜—š‘œžœžœžœ ˜BKšœžœ ˜*Kšžœ žœžœžœ˜Kšœ˜Kšžœžœ žœ ˜RKšœ˜K˜—š ‘œžœžœžœ žœ ˜NKšœžœ ˜*Kšžœ žœžœžœ˜Kšžœ˜Kšœ˜K˜—šœ(žœ!˜LK˜K˜K˜ K˜K˜—šœ.žœ!˜RK˜K˜K˜K˜K˜—Kšœ3 ˜HKšœ? ˜TK˜Kšžœ˜—…—–'