
    <<ColorSchemeViewerImpl.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Maureen Stone, March 23, 1987 5:04:25 pm PST>>
        <<Pier, March 13, 1987 1:44:13 pm PST>>
    DIRECTORY
        ColorSchemeViewer,
        ViewerClasses USING [Viewer, ViewerClass, PaintProc, ViewerClassRec],
        ViewerOps USING [PaintViewer, CreateViewer, RegisterViewerClass, EstablishViewerPosition, PaintHint],
        VFonts USING [CharWidth, FontHeight, EstablishFont, StringWidth, Font],
        ViewerTools USING [MakeNewTextViewer, GetContents, SetContents],
        Real USING [Round],
        Convert USING [RealFromRope, RopeFromReal],
        MessageWindow USING [Append],
        ImagerFont USING [Font, Find, Extents, RopeEscapement, RopeBoundingBox],
        Buttons USING [ButtonProc, Create], 
        Sliders USING [SliderProc, Slider, Create, SetContents, GetContents, FilterProc],
        Rope USING [ROPE, Length],
        Imager;
        <<>>
    ColorSchemeViewerImpl: CEDAR PROGRAM
        IMPORTS ViewerOps, ImagerFont, Imager, Buttons, Sliders, Rope, VFonts, ViewerTools, Convert, MessageWindow, Real
        EXPORTS ColorSchemeViewer
    ~ BEGIN OPEN ColorSchemeViewer;

        ROPE: TYPE = Rope.ROPE;
        Context: TYPE = Imager.Context;
        Viewer: TYPE = ViewerClasses.Viewer;
        Data: TYPE = REF DataRec;
        DataRec: TYPE = RECORD [
            button: Viewer,
            title: Label,
            sliders: ARRAY [1..3] OF Sliders.Slider,
            text: ARRAY [1..3] OF Viewer,
            labels: ARRAY [1..3] OF Label,
            values: ARRAY [1..3] OF REAL,     -- same values as Sliders.GetContents
            notify: NotifyProc,    --called when values change
            clientData: REF
            ];
        Label: TYPE = REF LabelRec;
        LabelRec: TYPE = RECORD [
            rope: ROPE,
            lx,ly: REAL,    --for showing the rope
            font: Imager.Font,
            wx,wy: INT,    --lower left corner of the label
            ww,wh: INT    --overall size
            ];

        <<NotifyProc: TYPE = PROC [v1, v2, v3: REAL, client: REF]; >>
        <<>>
        Create: PUBLIC PROC [labels: ARRAY [1..3] OF ROPE, sw, sh: INT, notify: NotifyProc, title: ROPE _ NIL, clientData: REF _ NIL, 
        parent: Viewer _ NIL, wx, wy: INTEGER _ 0] RETURNS [Viewer] = {
            vgap: INT _ sh/3;    --gap between sliders
            hgap: INT _ sh;    --gap between sliders and text viewer
            lWidth: INT;
            xOrg: INT _ 0;
            yOrg: INT _ 0;
            data: Data _ NEW[DataRec];
            new: Viewer _ ViewerOps.CreateViewer[flavor: $ColorScheme,
                info: [parent: parent,
                wx: wx, wy: wy,
                border: parent=NIL,    --no border on nested viewers
                data: data], paint: FALSE];
            data.notify _ notify;
            data.clientData _ clientData;
            {
                <<Format the labels.  The labels are the same height as the sliders.  The width is based on the width of the longest rope.  Labels 
                are flush with the left edge of the viewer >>
                max: REAL _ 0;
                font: ImagerFont.Font _ SELECT TRUE FROM
                    sh < 14 => ImagerFont.Find["Xerox/TiogaFonts/Helvetica10B"],
                    sh IN [14..22] => ImagerFont.Find["Xerox/TiogaFonts/Helvetica12B"],
                    sh IN [22..28] => ImagerFont.Find["Xerox/TiogaFonts/Helvetica14B"],
                    sh > 28 => ImagerFont.Find["Xerox/TiogaFonts/Helvetica16B"],
                    ENDCASE => ImagerFont.Find["Xerox/TiogaFonts/Helvetica10"];
                x: INT _ xOrg;
                y: INT _ yOrg;
                FOR i: NAT IN [1..3] DO    --compute the width of the labels
                    max _ MAX[max, ImagerFont.RopeEscapement[font, labels[i],0, Rope.Length[labels[i]]].x];
                    ENDLOOP;
                lWidth _ MAX[Real.Round[1.2*max], Real.Round[max]+6];  --the label and its box
                FOR i: NAT DECREASING IN [1..3] DO    --format the labels
                data.labels[i] _ FormatLabel[labels[i], x, y, lWidth, sh, font];
                y _ y+sh+vgap;
                    ENDLOOP;
                };
            {
                <<Create the sliders.  The sliders are flush with the right edge of the labels>>
                x: INT _ xOrg+lWidth;
                y: INT _ yOrg;
                FOR i: NAT DECREASING IN [1..3] DO
                    data.sliders[i] _ Sliders.Create[info: [parent: new, wx: x, wy: y, ww: sw, wh: sh], 
                        sliderProc: SliderProc,
                        filterProc: FilterProc,
                        orientation: horizontal,
                        clientData: NEW[SliderData _ [i,data]],
                        paint: FALSE];
                y _ y+sh+vgap;
                    ENDLOOP;
                };
            {
                <<Create the text viewers.  They sit hgap to the right of the sliders>>
                w:  NAT _ 8 * VFonts.CharWidth['0];  -- 8 digits worth of width
                h: NAT _ VFonts.FontHeight[]+2;    --need space for the caret and selection
                x: INT _ xOrg+lWidth+sw+hgap;
                y: INT _ yOrg+(sh-h)/2;
                FOR i: NAT DECREASING IN [1..3] DO
                    data.text[i] _ ViewerTools.MakeNewTextViewer[info: [
                        parent: new,
                        wx: x, wy: y, ww: w, wh: h, 
                        data: "0.5",
                        scrollable: FALSE,
                        border: FALSE ], paint: FALSE];
                y _ y+sh+vgap;
                    ENDLOOP;
                {
                    <<Create the "Set" button.  This is used to make the viewer notice that the text viewers have been edited.  The button is 
                    positioned over the text viewers, bOffset above the top one.>>
                    bOffset: INT _ vgap/2;
                    vfont: VFonts.Font _ VFonts.EstablishFont["helvetica", 10, TRUE];
                    bw: INT _ VFonts.StringWidth["SET", vfont]+8;    --button width
                    bh: INT _ VFonts.FontHeight[vfont]+1;
                    by: INT _ yOrg+3*sh+2*vgap+bOffset;    --button y position
                    data.button _ Buttons.Create[
                        info: [
                            name: "SET",
                            wx: x,
                            wy: by,
                            wh: bh,
                            ww: bw,
                            parent: new,
                            border: TRUE ],
                        clientData: data,
                        font: vfont,
                        fork: TRUE,
                        documentation: "Sets the values in the text viewers", 
                        proc: ButtonProc,
                        paint: FALSE ];
                    <<Add the title.  It is flush left with the sliders and at the same height as the Set button>>
                    data.title _ NEW[LabelRec _ [
                        rope: title,
                        lx: 0,
                        ly: 2,    --to align with button text
                        font: vfont,
                        wx: xOrg,
                        wy: by,
                        ww: VFonts.StringWidth[title, vfont],    --last 4 not used unless I box the title
                        wh: bh
                        ]];
                    <<now we can set the total size of the viewer>>
                    new.ww _ xOrg+lWidth+sw+hgap+w+1;  --label+slider+gap+text+1
                    new.wh _ yOrg+3*sh+2*vgap+bOffset+bh+2; --3*sliders+2*gap+button+2
                    ViewerOps.EstablishViewerPosition[new, new.wx, new.wy, new.ww, new.wh];  --make viewers notice it
                    };
                };
            FOR i: NAT IN [1..3] DO
                data.values[i] _ .5;
                Sliders.SetContents[slider: data.sliders[i], contents: data.values[i]]
                ENDLOOP;
            RETURN[new];
            };
        ButtonProc: Buttons.ButtonProc = { ENABLE BadValue => CONTINUE;  --refuses to set bad values
            self: Viewer _ NARROW[parent];
            data: Data _ NARROW[clientData];
            values: ARRAY [1..3] OF REAL _ data.values;
            changes: Changes;
            FOR i: NAT IN [1..3] DO
                values[i] _ GetTextValue[data.text[i]];
                ENDLOOP;
            changes _ SetValues[self.parent, values];
            ViewerOps.PaintViewer[self.parent, client, FALSE, NEW[Changes _ changes]];
            data.notify[data.values, changes, data.clientData];
            };

        BadValue: SIGNAL = CODE;
        GetTextValue: PROCEDURE [v: ViewerClasses.Viewer] RETURNS [value: REAL] = {
            rope: Rope.ROPE ~ ViewerTools.GetContents[v];
            IF rope=NIL THEN RETURN[0];
            value _ Convert.RealFromRope[rope];
            IF value > 1.0 OR value < 0.0 THEN {
                MessageWindow.Append[message: "Invalid value ", clearFirst: TRUE];
                MessageWindow.Append[message: rope, clearFirst: FALSE];
            SIGNAL BadValue;
                };
            RETURN[value];
            };

        SliderData: TYPE = RECORD[v: NAT, data: Data];
        SliderProc: Sliders.SliderProc = {
            sd: REF SliderData _ NARROW[clientData];
            changes: Changes _ SELECT sd.v FROM 1 => v1, 2 => v2, 3 => v3, ENDCASE => ERROR;
            IF reason=move AND sd.data.values[sd.v] = value THEN RETURN;
            sd.data.values[sd.v] _ value;
            PutText[viewer: sd.data.text[sd.v], contents: value];
            sd.data.notify[sd.data.values, changes, sd.data.clientData];
            };
        FilterProc: Sliders.FilterProc = {RETURN[Real.Round[value*1000]/1000.0]};  --4 digits

        FormatLabel: PROC [rope: ROPE, x, y, w, h: INT, font: ImagerFont.Font] RETURNS[Label] = {
            extents: ImagerFont.Extents _ ImagerFont.RopeBoundingBox[font, rope, 0, Rope.Length[rope]];
            label: Label _ NEW[LabelRec _ [
                rope: rope,
                lx: (w-extents.rightExtent+extents.leftExtent)/2,
                ly: extents.descent+(h-(extents.descent+extents.ascent))/2,    
                font: font,
                wx: x,
                wy: y,
                ww: w,
                wh: h
                ]];
            RETURN[label];
            };
        PutText: PROC [viewer: Viewer, contents: REAL] = {
            rounded: REAL _ Real.Round[1000*contents]/1000.0;
            ViewerTools.SetContents[viewer: viewer, contents: Convert.RopeFromReal[rounded], paint: TRUE];
            };
        SetValues: PUBLIC PROC [viewer: Viewer, values: ARRAY [1..3] OF REAL, notify: BOOLEAN _ FALSE] RETURNS [Changes]= {
            changes: Changes;
            data: Data _ NARROW[viewer.data];
            v: NAT _ 0;
            update: PROC [i: NAT] = {
                PutText[viewer: data.text[i], contents: values[i]];
                Sliders.SetContents[slider: data.sliders[i], contents: values[i]];
                data.values[i] _ values[i];
                };
            IF data.values[1] # values[1] THEN {update[1]; v _ 1};
            IF data.values[2] # values[2] THEN {update[2]; v _ v+2};
            IF data.values[3] # values[3] THEN {update[3]; v _ v+4};
            changes _ SELECT v FROM 0 => none, 1 => v1, 2 => v2, 4 => v3, ENDCASE => allValues;
            IF notify THEN data.notify[data.values, changes, data.clientData];
            RETURN[changes];
            };

        GetValues: PUBLIC PROC[viewer: Viewer] RETURNS[v1, v2, v3: REAL] = {
            data: Data _ NARROW[viewer.data];
            RETURN[data.values[1], data.values[2], data.values[3]];
            };

        Paint: PUBLIC PROC [viewer: Viewer, context: Imager.Context, whatChanged: Changes] ~ {
        <<Changes: none, v1, v2, v3, allValues, paintViewer.  >>
            data: Data _ NARROW[viewer.data];
            doValue: PROC [v: NAT, paintHint: ViewerOps.PaintHint] = {
                ViewerOps.PaintViewer[data.sliders[v], paintHint, TRUE];
                ViewerOps.PaintViewer[data.text[v], paintHint, TRUE];
                };

            SELECT whatChanged FROM
                v1 => doValue[1, client];
                v2 => doValue[2, client];
                v3 => doValue[3, client];
                allValues => FOR i: NAT IN [1..3] DO doValue[i, client]; ENDLOOP;
                ENDCASE => {    --paintViewer
                    ViewerOps.PaintViewer[data.button, all, TRUE];
                    PaintLabel[data.title, context, FALSE];
                    FOR i: NAT IN [1..3] DO
                        doValue[i, all];
                        PaintLabel[label: data.labels[i], context: context, outline: TRUE]; 
                        ENDLOOP;
                    };
            };

        SetSliderColors: PUBLIC PROC [viewer: Viewer, colors: ARRAY [1..3] OF Imager.Color] = {
            <<For the red, green, blue colored sliders.>>
            data: Data _ NARROW[viewer.data];
            FOR i: NAT IN [1..3] DO
                old: Viewer _ data.sliders[i];
                data.sliders[i] _ Sliders.Create[info: [parent: viewer, wx: old.wx, wy: old.wy, ww: old.ww, wh: old.wh], 
                    sliderProc: SliderProc,
                    filterProc: FilterProc,
                    orientation: horizontal,
                    foreground: colors[i],
                    clientData: NEW[SliderData _ [i,data]],
                    paint: TRUE];
                Sliders.SetContents[data.sliders[i], Sliders.GetContents[old]];
                ENDLOOP;
            };

        PaintLabel: PROC[label: Label, context: Context, outline: BOOLEAN] = {
            action: PROC = {
                IF outline THEN OutlineBox[context, label.wx, label.wy, label.ww, label.wh];
                Imager.TranslateT[context, [label.wx, label.wy]];
                Imager.SetXY[context, [label.lx, label.ly]];
                Imager.SetFont[context, label.font];
                Imager.ShowRope[context, label.rope];
                };
            Imager.DoSave[context, action]
            };

        OutlineBox: PROC [context: Context, x, y, w, h: INT] = {
            Imager.SetColor[context, Imager.black];
            Imager.SetStrokeWidth[context, 1];
            Imager.SetStrokeEnd[context, square];
            x _ x; y _ y+1;    --match viewer conventions
            w _ w-1; h _ h-1;    --match viewer conventions
            Imager.MaskVectorI[context, x, y, x, y+h];
            Imager.MaskVectorI[context, x, y+h, x+w, y+h];
            Imager.MaskVectorI[context, x+w, y+h, x+w, y];
            Imager.MaskVectorI[context, x+w, y, x, y];
            };

        myClass: ViewerClasses.ViewerClass = NEW[ViewerClasses.ViewerClassRec _ [
            flavor:$ColorScheme,
            paint: PaintProc
            ]];
        PaintProc: ViewerClasses.PaintProc = {
            IF whatChanged = NIL THEN Paint[self, context, paintViewer]
            ELSE {
                changes: REF Changes _ NARROW[whatChanged];
                Paint[self, context, changes^];
                };
            RETURN[TRUE];
            };
        ViewerOps.RegisterViewerClass[$ColorScheme, myClass];
        END.