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
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;
borderFudge is so labels line up whether they have borders or not
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 =
{
borderFudge is so labels line up whether they have borders or not
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.