LabelsImpl.mesa
Copyright © 1985 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
DIRECTORY
Basics USING [DivMod],
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 USING [CreateViewer, DestroyViewer, PaintViewer, RegisterViewerClass];
LabelsImpl: CEDAR PROGRAM
IMPORTS Basics, Convert, Imager, ImagerBackdoor, VFonts, ViewerOps
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.parent=NIL THEN ERROR;
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;
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 = {
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;
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];
};
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
];
The following material is to support NumberLabels
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 = {
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;
chars: ARRAY [0..11] OF CHAR;
pos: NAT ← 0;
card: LONG CARDINAL;
scard: CARDINAL;
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 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[context, '0 + scard];
finally, output the remaining characters that we have stored
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.