DIRECTORYConvert USING [IntFromRope, MapValue, ValueToRope],Imager USING [black, Color, Context, MaskIntRectangle, MaskChar, MaskCharacters, SetColor, SetIntCP, white],Labels USING [Label],NumberLabels USING [],Rope USING [ROPE],VFonts USING [CharWidth, defaultFont, Font, FontHeight, RopeWidth],ViewerClasses USING [GetProc, PaintProc, SetProc, Viewer, ViewerClass, ViewerClassRec, ViewerRec],ViewerOps USING [CreateViewer, PaintViewer, RegisterViewerClass];LabelsImpl: CEDAR PROGRAMIMPORTS Convert, Imager, VFonts, ViewerOpsEXPORTS Labels, NumberLabels =BEGIN OPEN ViewerClasses, Labels, Rope;bottomOffset: INTEGER = 3;	-- for paintingleftOffset: INTEGER = 3;LabelData: TYPE = REF LabelDataRec;LabelDataRec: TYPE = RECORD [font: VFonts.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 _ [font, blackOnWhite]];IF info.parent=NIL THEN ERROR;IF info.ww=0 THEN info.ww _ VFonts.RopeWidth[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: REF CARDINAL = NEW[CARDINAL _ 001010B];LabelPaint: PaintProc = BEGIN OPEN Imager;data: LabelData _ NARROW[self.data];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[context, Imager.black];	blackOnGrey => Imager.SetColor[context, myGrey];blackOnWhite => Imager.SetColor[context, Imager.white];ENDCASE;MaskIntRectangle[context, [1, 1, self.cw-2, self.ch-2]];END;IF self.name=NIL THEN RETURN;SetColor[context, SELECT data.displayStyle FROMwhiteOnBlack	=> white,ENDCASE		=> black];SetIntCP[context, [leftOffset+borderFudge, bottomOffset+borderFudge]];MaskCharacters[context, data.font, 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: VFonts.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 _ [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 = {data: NumberLabelData _ NARROW[self.data];borderFudge: INTEGER = IF self.border THEN 0 ELSE 1;draw1: PROC [c: CHAR] = {Imager.MaskChar[context, data.font, c]};IF data = NIL THEN RETURN;IF ~clear OR data.displayStyle # blackOnWhite THEN BEGINSELECT data.displayStyle FROMwhiteOnBlack => Imager.SetColor[context, Imager.black];	blackOnGrey => Imager.SetColor[context, myGrey];blackOnWhite => Imager.SetColor[context, Imager.white];ENDCASE;Imager.MaskIntRectangle[context, [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[context, SELECT data.displayStyle FROMwhiteOnBlack => Imager.white,ENDCASE => Imager.black];Imager.SetIntCP[context, [leftOffset+borderFudge, bottomOffset+borderFudge]];Convert.MapValue[put: draw1, value: [signed[data.currentValue]]];};NumberLabelGet: ViewerClasses.GetProc = {myData: NumberLabelData _ NARROW[self.data];IF myData = NIL THEN RETURN [NIL];IF op = NILTHEN RETURN[Convert.ValueToRope[[signed[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; written by S. McGregorEdited by McGregor on August 4, 1983 11:21 amLast Edited by: Maxwell, May 23, 1983 2:57 pmEdited by Russ Atkinson, April 12, 1983 3:13 pmborderFudge is so labels line up whether they have borders or notborderFudge is so labels line up whether they have borders or notЭ╩C  Ц"cedar" styleШ JЪ╧c'Щ'JЪЬ-Щ-JЪЬ-Щ-JЪЬ/Щ/JШ Ъ╧k	Ш	JЪЬЮЬ&Ш3JЪЬЮЬ`ШlJЪЬЮЬ	ШJЪЬЮЬШJЪЬЮЬЮЬШJЪЬЮЬ7ШCЪЬЮЬШJШMЧJЪЬ
ЮЬ2ШAЧJШ JЪ╧b
ЬЮЬЮШJШ JЪЮЬ#Ш*JЪЮЬШJШ JЪЮЬЮЬШ'JШ JЪЬЮЬЭШ*JЪЬЮЬШJШ JЪЬЮЬЮЬШ#ЪЬЮЬЮЬШJШJШJШJШ ЧJЪЬЮЬ.Ш@JШ Ъ╧nЬЮЬЮЬ?ШRJЪЬЮЬЮЬЮЬЮШ2JЪЬЮЬ&Ш;JЪЮЬЮЬЮЬЮЬШJЪЮЬЮЬCШTJЪЮЬЮЬ0ШAJШJШ4JЪЮЬШJШ ЧJЪ	ЬЮЬЮЬЮЬЮЬШ/JШ ЪЬЮЬЮЬШ*JЪЭAЩAJЪЬЮЬШ$JЪ	ЬЮЬЮЬЮЬЮЬШ4JЪЮЬЮЬЮЬЮЬШЪЮЬЮЬ ЮЬЮШ6ЪЮЬЮШJЪЬ7Ш7ЧЪЬ1Ш1JЪЬ7Ш7JЪЮЬШЧJШ8JЪЮЬШЧJЪЮЬЮЬЮЬЮЬШЪЬЮЬЮШ/JШJЪЮЬШЧJШFJШ.JЪЮЬШJШ ЧЪЬЮШJЪЮЬШJЪЮЬШJШ ЧЪЬЮШJЪЮЬЮЬЮЬЮЬШ'ЪЮЬЮШ
JЪЬЮЬШ&JЪЮЬ
ЮЬЮЬЮЬШЪЮЬЮШJШ4JШ4JШ2JЪЮЬШЧJЪЮЬШЧJЪЮЬ
ЮЬ"Ш2JЪЮЬШJШ ЧJЪЬЮЬШ)JШ JЪЬЮЬЮЬШ/ЪЬЮЬЮЬШ#JШJШJЪЬЮЬШJЪЬЮЬШJШJШ ЧJЪЭ5Ш5ЪаЬЮЬЮШJЪЬ,ЮЬЮЬ5ЮЬЮЬЮЬЮЬШлЪЬЮЬШJЪЬKШKЧJЪЮЬЮЬЮЬЮЬШJЪЮЬЮЬBШSJЪЮЬЮЬ0ШAJШJЪЬ7Ш7JЪЬШJШ ЧЪЬ,ЮШ-JЪЭAЩAJЪЬЮЬШ*JЪ	ЬЮЬЮЬЮЬЮЬШ4JЪЬЮЬЮЬ-ШAJЪЮЬЮЬЮЬЮЬШЪЮЬЮЬ"ЮЬЮШ8ЪЮЬЮШJЪЬ7Ш7ЧЪЬ1Ш1JЪЬ7Ш7JЪЮЬШЧJЪЬ?Ш?JЪЬЮЬШJЪЮЬШЧJЪЮЬЮЬ(ЮЬЮЬШPJЪЬ'Ш'ЪЬЮЬЮШ6JШJЪЮЬШЧJШMJЪЬAШAJЪЮЬШJШ ЧЪЬ(ЮШ)JЪЬЮЬШ,JЪ
ЮЬ
ЮЬЮЬЮЬЮЬШ"ЪЮЬЮШJЪЮЬЮЬ4Ш?JЪЮЬЮЬЮЬЮЬШ-ЧJЪЮЬШJШ ЧЪЬ)Ш)JЪЬЮЬШ,JЪЮЬ
ЮЬЮЬЮЬШЪЮЬЮЬЮШЪЬЮЬШJЪЬ0Ш0ЧЪЬЮЬШЪЮЬЮШJШ4JШ4JШ2JЪЮЬШЧЧЪЬЮЬЮЬШJЪЬШЧJЪЮЬЮЬШЧJЪЮЬ
ЮЬ"Ш2JЪЬШJШ ЧЪаЬЮЬЮЬЮЬ	ШBJЪЬЮЬ
Ш*JЪЮЬ
ЮЬЮЬЮЬШJЪЬШJЪЮЬЮЬ ЮЬШRJЪЬШJШ ЧЪ
аЬЮЬЮЬЮЬЮЬ	ШNJЪЬЮЬ
Ш*JЪЮЬ
ЮЬЮЬЮЬШJЪЮЬШJЪЬШJШ ЧЪЬ(ЮЬ!ШLJШJШJШJШJШ ЧЪЬ.ЮЬ!ШRJШJШJШJШJШ ЧJЪЬ3ЭШHJЪЬ?ЭШTJШ JЪЮЬШJШ JШ Ч ЕЧ    j  ы  