[Indigo]<Cedar5.3>Viewers>LabelsImpl.mesa!1

LabelsImpl.mesa

McGregor, October 28, 1982 11:17 am

Maxwell, May 23, 1983 2:57 pm

Russ Atkinson, September 27, 1983 1:14 pm

DIRECTORY

Basics USING [DIVMOD],

Convert USING [IntFromRope, RopeFromInt],

Graphics USING [

black, Color, Context, DrawBox, DrawChar, DrawRope, FontRef, 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 Basics, 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;

chars: ARRAY [0..11] OF CHAR;

pos: NAT ← 0;

card: LONG CARDINAL;

scard: CARDINAL;

font: Graphics.FontRef = 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];

card ← LOOPHOLE[data.currentValue];

IF data.currentValue < 0

THEN {

Graphics.DrawChar[context, '-, font];

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

Graphics.DrawChar[context, '0 + scard, font];

finally, output the remaining characters that we have stored

WHILE pos > 0 DO

pos ← pos - 1;

Graphics.DrawChar[context, chars[pos], font];

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.