<<>>
    <<ColorToolImpl.mesa>>
        <<Copyright Ó 1985, 1989, 1990, 1992 by Xerox Corporation.  All rights reserved.>>
        <<Maureen Stone June 10, 1986 0:26:23 am PDT>>
        <<Maureen Stone, October 1, 1987 11:05:04 am PDT>>
        <<Pier, December 7, 1988 4:56:56 pm PST>>
        <<Giordano:PARC:Xerox (8*923-4484),  June 25, 1990 4:54 pm PDT>>
        <<Doug Wyatt, April 10, 1992 6:32 pm PDT>>
        <<Ken Fishkin, September 14, 1992 2:43 pm PDT>>

    DIRECTORY
        Buttons, CNSColor, ColorFns, ColorPatch, ColorSchemeViewer, ColorTool, ColorTypes, Commander, Containers, Convert, ImagerColor, 
        ImagerDither, NamedColors, Rope, SymTab, VFonts, ViewerClasses, ViewerOps, ViewerTools;

    ColorToolImpl: CEDAR PROGRAM
    IMPORTS Buttons, CNSColor, ColorFns, ColorPatch, ColorSchemeViewer, Commander, Containers, Convert, ImagerColor, NamedColors, Rope, 
    SymTab, VFonts, ViewerOps, ViewerTools
    EXPORTS ColorTool 
    ~ BEGIN

    RGB: TYPE = ImagerColor.RGB;
    HSL: TYPE = ColorTypes.HSL;
    HSV: TYPE = ColorTypes.HSV;
    CMY: TYPE = ColorTypes.CMY;
CSL: TYPE ~ CNSColor.CSL;
    ROPE: TYPE = Rope.ROPE;
    Viewer: TYPE = ViewerClasses.Viewer;

    Handle: TYPE = REF HandleRec Ź NIL;
    HandleRec: TYPE = RECORD[self, rgb, cmy, hsl, hsv, patch, name, setName, registered, setRegistered: Viewer, lastValue: RGB, 
    specialColor: ImagerColor.ConstantColor, notify: SymTab.Ref];
    ColorScheme: TYPE = {rgb, cmy, hsl, hsv, name};
    fast: BOOLEAN Ź FALSE;
    <<Set and read the current value of the ColorTool>>

    NoColorToolViewer: PUBLIC SIGNAL = CODE;  --Raised when one of the following procedures is called and there is no ColorTool viewer 
    available

    SetRGBValue: PUBLIC PROC[rgb: RGB, viewer: Viewer Ź NIL] = {
        handle: Handle Ź GetHandle[viewer];
        Update[[rgb.R, rgb.G, rgb.B], handle, $rgb];
        };

    GetRGBValue: PUBLIC PROC[viewer: Viewer Ź NIL] RETURNS [RGB] = {
        handle: Handle Ź GetHandle[viewer];
        RETURN[handle.lastValue];
        };

    SetCSLValue: PUBLIC PROC [csl: CSL, viewer: Viewer Ź NIL] = {
        handle: Handle Ź GetHandle[viewer];
        hsl: HSL ~ CNSColor.HSLFromCSL[csl];
        Update[[hsl.H, hsl.S, hsl.L], handle, $hsl];
        };

    GetCSLValue: PUBLIC PROC[viewer: Viewer Ź NIL] RETURNS [CSL] = {
        handle: Handle Ź GetHandle[viewer];
        hsl: HSL ~ ColorFns.HSLFromRGB[handle.lastValue];
        RETURN[CNSColor.CSLFromHSL[hsl]];
        };

    GetColor: PUBLIC PROC [viewer: Viewer Ź NIL] RETURNS [ImagerColor.ConstantColor] = {
        handle: Handle Ź GetHandle[viewer];
        IF handle.specialColor#NIL THEN RETURN[handle.specialColor]
        ELSE RETURN[ImagerColor.ColorFromRGB[handle.lastValue]];
        };
        <<>>
    SetColor: PUBLIC PROC [color: ImagerColor.Color, viewer: Viewer Ź NIL] = {
        handle: Handle Ź GetHandle[viewer];
        WITH color SELECT FROM
            constant: ImagerColor.ConstantColor => {
                rgb: RGB Ź RGBFromColor[constant];
                Update[[rgb.R, rgb.G, rgb.B], handle, rgb];
                WITH constant SELECT FROM
                    special: ImagerColor.SpecialColor => {    
                        UpdateSpecial[special, special.name, handle];
                        };
                    ENDCASE => NULL;
                };
            ENDCASE => NULL;    --sampled colors do nothing
        };
        <<>>
    RGBFromColor: PROC [color: ImagerColor.ConstantColor] RETURNS [RGB] ~ {
        RETURN[ImagerColor.RGBFromColor[ImagerColor.NarrowToOpConstantColor[color]]];
        };
        <<>>
    <<>>
    <<This mechanism allows a client of the ColorTool to request being called whenever the color changes.  The ColorTool will keep a 
    SymTab of procedures to support multiple clients.  If there are multiple colortools, only one will get the registery.>>
    NotifyProc: TYPE = ColorTool.NotifyProc;
    Notifier: TYPE = REF NotifierRep;
    NotifierRep: TYPE = RECORD [
        notifyProc: NotifyProc,
        notifyData: REF
        ];

    RegisterNotifyProc: PUBLIC PROC[id: ATOM, notifyProc: NotifyProc, data: REF, viewer: Viewer Ź NIL] = {
        handle: Handle Ź GetHandle[viewer];
        idRope: ROPE Ź Convert.RopeFromAtom[id, FALSE];
        IF handle.notify=NIL THEN handle.notify Ź SymTab.Create[];
        [] Ź SymTab.Store[x: handle.notify, key: idRope, val: NEW[NotifierRep Ź [notifyProc: notifyProc, notifyData: data]]];
        notifyProc[handle.lastValue, data];
        };

    RemoveProc: PUBLIC PROC[id: ATOM, viewer: Viewer Ź NIL] = {
        handle: Handle Ź GetHandle[viewer];
        idRope: ROPE Ź Convert.RopeFromAtom[id, FALSE];
        [] Ź SymTab.Delete[x: handle.notify, key: idRope];
        };

    GetHandle: PROC[viewer: Viewer Ź NIL] RETURNS[Handle] = {
        IF viewer=NIL THEN viewer Ź ViewerOps.FindViewer["ColorTool"];
        IF viewer=NIL THEN ERROR NoColorToolViewer
        ELSE RETURN[NARROW[ViewerOps.FetchProp[viewer, $ColorTool]]];
        };

    Create: PUBLIC PROC RETURNS[Viewer] = {
        column: ViewerClasses.Column Ź left;
        outer: Viewer Ź Containers.Create[info: [
            name: "ColorTool",
            iconic: TRUE,
            column: column,
            scrollable: TRUE ],
            paint: FALSE ];
        handle: Handle Ź NEW[HandleRec];
        sw: INT  Ź 128;    --slider width
        sh: INT  Ź 18;    --slider height
        xOrg: INT Ź 10;
        x,y: INT Ź 0;
        hSpace: INT Ź 10;
        vSpace: INT Ź 15;
        fudge: INT Ź 6;
        y Ź 10;
        x Ź xOrg;
        handle.rgb Ź ColorSchemeViewer.Create[
            labels: ["R","G","B"],
            sw: sw, sh: sh,
            notify: UpdateRGB,
            title: "Red, Green, Blue",
            clientData: handle,
            parent: outer,
            wx: x, wy: y
            ];
        ColorSchemeViewer.SetSliderColors[handle.rgb, [
            ImagerColor.ColorFromRGB[[1,0,0]],
            ImagerColor.ColorFromRGB[[0,1,0]],
            ImagerColor.ColorFromRGB[[0,0,1]]
            ]];
        <<211 by 85 for sw=128, sh=18>>
        x Ź x+handle.rgb.ww+1;
        handle.patch Ź ColorPatch.MakeColorPatch[
            [wx: x, wy: y, ww: 150, wh: 85, parent: outer], [mapIndex: 128, red: 127, green: 127, blue: 127]];
        x Ź x+handle.patch.ww+hSpace+fudge;
        handle.hsl Ź ColorSchemeViewer.Create[
            labels: ["H","S","L"],
            sw: sw, sh: sh,
            notify: UpdateHSL,
            title: "Hue, Saturation, Lightness",
            clientData: handle,
            parent: outer,
            wx: x, wy: y
            ];
        x Ź xOrg;
        y Ź y+handle.rgb.wh+vSpace;
        handle.cmy Ź ColorSchemeViewer.Create[
            labels: ["C","M","Y"],
            sw: sw, sh: sh,
            notify: UpdateCMY,
            title: "Cyan, Magenta, Yellow",
            clientData: handle,
            parent: outer,
            wx: x, wy: y
            ];
        ColorSchemeViewer.SetSliderColors[handle.cmy, [
            ImagerColor.ColorFromRGB[ColorFns.RGBFromCMY[[1,0,0]]],
            ImagerColor.ColorFromRGB[ColorFns.RGBFromCMY[[0,1,0]]],
            ImagerColor.ColorFromRGB[ColorFns.RGBFromCMY[[0,0,1]]]
            ]];
        x Ź x+handle.rgb.ww+1;
        {
            vfont: VFonts.Font Ź VFonts.EstablishFont["helvetica", 10, TRUE];
            bw: INT Ź VFonts.StringWidth["SET FROM NAME", vfont]+8;    --button width
            bh: INT Ź VFonts.FontHeight[vfont]+1;
            localY: INT Ź y;
            makeText:  PROC[data: ROPE] RETURNS[Viewer] = {
                []Ź  VFonts.EstablishFont["tioga", 10, TRUE];
                RETURN[ViewerTools.MakeNewTextViewer[info: [
                    parent: outer,
                    wx: x, wy: localY,
                    ww: handle.patch.ww, wh: 2*VFonts.FontHeight[]+12,
                    data: data,
                    scrollable: TRUE,
                    border: TRUE ], paint: FALSE]];
                };
            handle.setName Ź Buttons.Create[
                info: [
                    name: "SET FROM NAME",
                    wx: x,
                    wy: localY,
                    wh: bh,
                    ww: bw,
                    parent: outer,
                    border: TRUE ],
                clientData: handle,
                font: vfont,
                fork: FALSE,
                documentation: "Sets the color from the name", 
                proc: SetNamedColor,
                paint: FALSE ];
            localY Ź localY+handle.setName.wh;
            handle.name Ź makeText["Gray"];

            localY Ź localY+handle.name.wh;
            bw Ź VFonts.StringWidth["SET REGISTERED COLOR", vfont]+8;
            handle.setRegistered Ź Buttons.Create[
                info: [
                    name: "SET REGISTERED COLOR",
                    wx: x,
                    wy: localY,
                    wh: bh,
                    ww: bw,
                    parent: outer,
                    border: TRUE ],
                clientData: handle,
                font: vfont,
                fork: FALSE,
                documentation: "Sets a registered color from the hierarchical name", 
                proc: SetRegisteredColor,
                paint: FALSE ];
            localY Ź localY+handle.setRegistered.wh;
            handle.registered Ź makeText[""];
            };
        x Ź x+handle.name.ww+hSpace+fudge;
        handle.hsv Ź ColorSchemeViewer.Create[
            labels: ["H","S","V"],
            sw: sw, sh: sh,
            notify: UpdateHSV,
            title: "Hue, Saturation, Value",
            clientData: handle,
            parent: outer,
            wx: x, wy: y
            ];
        handle.self Ź outer;
        ViewerOps.AddProp[outer, $ColorTool, handle];
        ViewerOps.SetOpenHeight[outer, y+handle.hsl.wh+vSpace];
        Update[[0.5, 0.5, 0.5], handle, rgb];
        ViewerOps.OpenIcon[outer];
        RETURN[outer];
        };

    Changes: TYPE = ColorSchemeViewer.Changes;

    UpdateRGB: ColorSchemeViewer.NotifyProc = {Update[values, NARROW[client], rgb]};
    UpdateCMY: ColorSchemeViewer.NotifyProc = {Update[values, NARROW[client], cmy]};
    UpdateHSV: ColorSchemeViewer.NotifyProc = {Update[values, NARROW[client], hsv]};
    UpdateHSL: ColorSchemeViewer.NotifyProc = {Update[values, NARROW[client], hsl]};
    SetRegisteredColor: Buttons.ButtonProc = { 
        self: Viewer Ź NARROW[parent];
        data: Handle Ź NARROW[clientData];
        rope: ROPE Ź ViewerTools.GetContents[data.registered];
        color: ImagerColor.ConstantColor Ź ImagerColor.Find[rope];
        IF color=NIL THEN color Ź ImagerColor.Find[Rope.Concat["Xerox/Research/", rope]]; -- retry
        IF color=NIL THEN ViewerTools.SetContents[data.registered, 
        Rope.Concat[rope, " is not a registered color"]]
        ELSE {
            <<found a registered color.  May not have sensible rgb value, but set it anyway>>
            rgb: RGB ~ RGBFromColor[color];
            Update[[rgb.R, rgb.G, rgb.B], data, $rgb];
            UpdateSpecial[color, rope, data];
            };
        };
    UpdateSpecial: PROC[color: ImagerColor.ConstantColor, name: ROPE, handle: Handle] = {
        IF Rope.Match["*ChipNDale*", name, FALSE] THEN {
            initial: ImagerColor.ConstantColor Ź ImagerColor.Find["Xerox/Research/ChipNDale/CD/InitialColor"]; 
            ColorPatch.PaintSpecial[handle.patch, initial]; 
            };
        ColorPatch.PaintSpecial[handle.patch, color];
        ViewerTools.SetContents[handle.registered, name];
        handle.specialColor Ź color;
        };
    SetNamedColor: Buttons.ButtonProc = { 
        self: Viewer Ź NARROW[parent];
        data: Handle Ź NARROW[clientData];
        rope: ROPE Ź ViewerTools.GetContents[data.name];
        {ENABLE NamedColors.UndefinedName, NamedColors.BadGrammar => {
              ViewerTools.SetContents[data.name, Rope.Concat[rope, " is an invalid color name"]];
               CONTINUE};
            hsl: HSL Ź NamedColors.RopeToHSL[rope];
            Update[[hsl.H, hsl.S, hsl.L], data, name]
            };
        };

    Update: PROC [values: ARRAY [1..3] OF REAL, handle: Handle, who: ColorScheme] = {
        cmy: CMY;
        hsl: HSL;
        hsv: HSV;
        colorName: Rope.ROPE;

        doNotify: SymTab.EachPairAction = {
            notifier: Notifier Ź NARROW[val];
            IF notifier.notifyProc#NIL THEN notifier.notifyProc[handle.lastValue, notifier.notifyData];
            };
        rgbColor: RGB;
        rgbColor Ź SELECT who FROM
            rgb => [values[1], values[2], values[3]],
            cmy => ColorFns.RGBFromCMY[[values[1], values[2], values[3]]],
            hsl, name => ColorFns.RGBFromHSL[[values[1], values[2], values[3]]],
            hsv => ColorFns.RGBFromHSV[[values[1], values[2], values[3]]],
            ENDCASE => ERROR;
        IF rgbColor=handle.lastValue THEN RETURN
        ELSE handle.lastValue Ź rgbColor;
        cmy Ź ColorFns.CMYFromRGB[rgbColor];
        hsl Ź ColorFns.HSLFromRGB[rgbColor];
        hsv Ź ColorFns.HSVFromRGB[rgbColor];
        colorName Ź NamedColors.HSLToRope[hsl];
        [] Ź ColorSchemeViewer.SetValues[handle.rgb, [rgbColor.R, rgbColor.G, rgbColor.B]];
        [] Ź ColorSchemeViewer.SetValues[handle.cmy, [cmy.C, cmy.M, cmy.Y]];
        [] Ź ColorSchemeViewer.SetValues[handle.hsl, [hsl.H, hsl.S, hsl.L]];
        [] Ź ColorSchemeViewer.SetValues[handle.hsv, [hsv.H, hsv.S, hsv.V]];
        ColorPatch.PaintColorPatch[handle.patch, rgbColor];
        ViewerTools.SetContents[handle.name, colorName];
        IF handle.notify#NIL THEN [] Ź SymTab.Pairs[handle.notify, doNotify];
        handle.specialColor Ź NIL;
        };

    Init: Commander.CommandProc = {
        WITH cmd.procData.clientData SELECT FROM
            a: ATOM => IF (a = $ces) THEN {msg Ź "This command has been retracted"; RETURN};
            ENDCASE => NULL;
        [] Ź Create[]
        };
    Commander.Register[key: "ColorTool", proc: Init, doc: "Create a color tool", clientData: $original];
    Commander.Register[key: "CesColorTool", proc: Init, doc: "This command has been retracted", clientData: $ces];

    END.