
DIRECTORY
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,
MessageWindowBackdoor;

LabelsImpl: CEDAR PROGRAM
IMPORTS Convert, Imager, ImagerBackdoor, VFonts, ViewerOps, MessageWindowBackdoor
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.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;
IF info.parent=NIL AND info.wx=0 AND info.wy=0 THEN {
[info.wx, info.wy, info.ww, info.wh] м MessageWindowBackdoor.AllocateStaticArea[info.ww];
info.column м static;
info.spare5 м TRUE; -- mark as top row
};
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;
IF data = NIL THEN RETURN;
background м BackgroundColor[data.displayStyle];
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: CARD32;
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 > 9 DO
chars[pos] м '0 + (card MOD 10);
card м card / 10;
pos м pos + 1;
ENDLOOP;
Imager.ShowChar[context, '0 + card];
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.
   °  
LabelsImpl.mesa 
Copyright ╙ 1985, 1986, 1988, 1991 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
Pier, November 13, 1988 9:13:30 pm PST
Bier, January 4, 1989 8:37:24 pm PST
Christian Jacobi, October 25, 1991 1:19 pm PDT
Michael Plass, March 13, 1992 12:50 pm PST
borderFudge is so labels line up whether they have borders or not
The following material is to support NumberLabels

KAP for PCedar November 13, 1988
borderFudge is so labels line up whether they have borders or not


unconditionally output the leading character

finally, output the remaining characters that we have stored
Initialization

Э╩√  Ц(cedarcode) styleХNewlineDelimiter
Щ codeЪЬЩKЪЬ
╧eЬCЩNKЪЬ#Щ#KЪЬЩKЪЬ)Щ)KЩ)KЩ&KЩ$KЩ.KЩ*ЧKШ Ъ╧k	Ш	KЪЬЮЬШ)KЪЬЮЬ\ШhKЪЬЮЬШ#KЪЬЮЬ	ШKЪЬЮЬШKЪЬЮЬЮЬШKЪЬЮЬ9ШEKЪЬЮЬOШbKЪЬ
Ш
KШЧKШ KЪ╨bl
ЬЮЬЮШKЪЮЬJШQKЪЮЬШKЪЬЮЬЮЬШ)KШ KЪЬЮЬ╧cШ*KЪЬЮЬШKШ KЪЬЮЬЮЬШ#ЪЬЮЬЮЬШKЪЬЮЬШKЪЬ)Ш)KШKШ ЧKЪЬЮЬ-Ш?KШ Ъ╧nЬЮЬЮЬ,ЮЬШCKЪЬЮЬЮЬЮЬШ.KЪЬЮЬ2ШGKЪЮЬЮЬAШRKЪЮЬЮЬ5ШFЪ
ЮЬЮЬЮЬЮЬЮЬШ5KШYKШKЪЬЮЬаШ&KЪЬШЧKШKШ4KЪЬШKШ ЧЪбЬЮЬЮЬШ#KЪЬ#Ш#ЧKШ ЪбЬЮЬЮЬЮЬ	ЮЬЮЬШEKЪЬ)Ш)ЧKШ ЪбЬЮЬЮЬЮЬ	ЮЬЮЬШLKЪЬ8Ш8KШ ЧKЪЬ#Ш#KЪЬ#Ш#KЪЬ;Ш;KШ ЪбЬЮЬЮЬШMЪЮЬЮШKЪЬЮЬШKЪЬЮЬШKЪЬЮЬ	ШKЪЮЬШЧKЪЮЬШKШKШ ЧЪб
ЬЮЬЮЬШHЪЮЬЮШKЪЬЮЬШKЪЬЮЬШKЪЬЮЬШKЪЮЬШЧKЪЮЬШKШKШ ЧЪб
ЬШKЪЬAЩAKЪЬЮЬШ$KЪ	ЬЮЬЮЬЮЬЮЬШ4KЪЬШKЪЮЬЮЬЮЬЮЬШKЪЬ0Ш0KЪЮЬЮЬЮЬЮШ'ЪЮЬШ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ЪЬ Щ KЪЬAЩAKЪЬЮЬШ*KЪ	ЬЮЬЮЬЮЬЮЬШ4KЪЬЮЬ	ЮЬЮЬШ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ЪЬ$Ш$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Ш KЪЬЩKЩ ЪЬ(ЮЬ!ШLKШKШKШKШKШ ЧЪЬ.ЮЬ!ШRKШKШKШKШKШ ЧKЪЬ3аШHKЪЬ?аШTKШ KЪЮЬШЧ ЕЧ    n  'a  