[_CDCSL_93-16_]<1>Cedar>release>Viewers>LabelsImpl.mesa

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, April 15, 1985 5:46:15 pm PST

Pier, November 13, 1988 9:13:30 pm PST

Bier, January 4, 1989 8:37:24 pm PST

Christian Jacobi, October 25, 1991 1:19 pm PDT

Michael Plass, March 13, 1992 12:50 pm PST

DIRECTORY

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,

MessageWindowBackdoor;

LabelsImpl: CEDAR PROGRAM

IMPORTS Convert, Imager, ImagerBackdoor, VFonts, ViewerOps, MessageWindowBackdoor

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.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;

IF info.parent=NIL AND info.wx=0 AND info.wy=0 THEN {

[info.wx, info.wy, info.ww, info.wh] ¬ MessageWindowBackdoor.AllocateStaticArea[info.ww];

info.column ¬ static;

info.spare5 ¬ TRUE; -- mark as top row

};

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;

IF data = NIL THEN RETURN;

background ¬ BackgroundColor[data.displayStyle];

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

KAP for PCedar November 13, 1988

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: CARD32;

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 card > 9 DO

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

card ¬ card / 10;

pos ¬ pos + 1;

ENDLOOP;

unconditionally output the leading character

Imager.ShowChar[context, '0 + card];

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];

};

Initialization

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.