
<<LabelsImpl.mesa >>
<<Edited by McGregor on October 28, 1982 11:17 am>>
<<Last Edited by: Maxwell, May 23, 1983 2:57 pm>>
<<Edited by Russ Atkinson, April 12, 1983 3:13 pm>>

DIRECTORY
Convert USING [IntFromRope, MapValue, ValueToRope],
Graphics USING [
black, Color, Context, DrawBox, DrawChar, DrawRope, SetColor, SetCP, SetStipple, white],
Labels USING [Label],
NumberLabels USING [],
Rope USING [ROPE],
VFonts USING [CharWidth, defaultFont, Font, FontHeight, GraphicsFont, StringWidth],
ViewerClasses USING [
GetProc, PaintProc, SetProc, Viewer, ViewerClass, ViewerClassRec, ViewerRec],
ViewerOps USING [CreateViewer, PaintViewer, RegisterViewerClass];

LabelsImpl: CEDAR PROGRAM

IMPORTS Convert, Graphics, 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.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;

LabelPaint: PaintProc = BEGIN OPEN Graphics;
<<borderFudge is so labels line up whether they have borders or not>>
data: LabelData _ NARROW[self.data];
myGrey: CARDINAL = 001010B;
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 => Graphics.SetColor[context, Graphics.black];
    blackOnGrey => Graphics.SetStipple[context, myGrey];
blackOnWhite => Graphics.SetColor[context, Graphics.white];
ENDCASE;
DrawBox[context, [1, 1, self.cw-1, self.ch-1]];
END;
IF self.name=NIL THEN RETURN;
SetColor[context, SELECT data.displayStyle FROM
whiteOnBlack    => white,
ENDCASE        => black];
SetCP[context, leftOffset+borderFudge, bottomOffset+borderFudge];
DrawRope[self: context, rope: self.name, font: VFonts.GraphicsFont[data.font]];
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 = {
<<borderFudge is so labels line up whether they have borders or not>>
data: NumberLabelData _ NARROW[self.data];
myGrey: CARDINAL = 001010B;
borderFudge: INTEGER = IF self.border THEN 0 ELSE 1;
draw1: PROC [c: CHAR] = {
Graphics.DrawChar[context, c, VFonts.GraphicsFont[data.font]];
};
IF data = NIL THEN RETURN;
IF ~clear OR data.displayStyle # blackOnWhite THEN BEGIN
SELECT data.displayStyle FROM
whiteOnBlack => Graphics.SetColor[context, Graphics.black];
    blackOnGrey => Graphics.SetStipple[context, myGrey];
blackOnWhite => Graphics.SetColor[context, Graphics.white];
ENDCASE;
Graphics.DrawBox[context, [1, 1, self.cw-1, self.ch-1]];
whatChanged _ NIL;
END;
IF whatChanged = $Update AND data.currentValue = data.lastDisplayed THEN RETURN;
data.lastDisplayed _ data.currentValue;
Graphics.SetColor[context, SELECT data.displayStyle FROM
whiteOnBlack => Graphics.white,
ENDCASE => Graphics.black];
Graphics.SetCP[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.