<<>>
    <<LabelsImpl.mesa >>
        <<Copyright Ó 1985, 1986, 1988, 1991 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>>
        <<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.