[Indigo]<Cedar5.3>NewViewers>LabelsImpl.mesa!3

LabelsImpl.mesa

McGregor, October 28, 1982 11:17 am

Maxwell, May 23, 1983 2:57 pm

Russ Atkinson, September 27, 1983 1:14 pm

Doug Wyatt, September 4, 1984 10:22:58 am PDT

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

PROC [self: Viewer, context: Graphics.Context, whatChanged: REF ANY, clear: BOOL]

borderFudge is so labels line up whether they have borders or not

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 = {

borderFudge is so labels line up whether they have borders or not

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 we have to stay in 32 bits, do so

WHILE card > LAST[CARDINAL] DO

chars[pos] ← '0 + (card MOD 10);

card ← card / 10;

pos ← pos + 1;

ENDLOOP;

at this point, it is faster to do this in 16 bits

scard ← card;

WHILE scard > 9 DO

mod: CARDINAL;

[scard,mod] ← Basics.DIVMOD[scard, 10];

chars[pos] ← '0 + mod;

pos ← pos + 1;

ENDLOOP;

unconditionally output the leading character

Imager.ShowChar[imager, '0 + scard];

finally, output the remaining characters that we have stored

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.