Info-Mac 1992 August/info-mac-1992.iso/Source/Pascal/Image/Color.p

Text File | 1991-09-16 | 24.7 KB | 1,092 lines | [TEXT/PJMM]

unit Color;

interface

    uses
        QuickDraw, Palettes, Picker, PrintTraps, globals, Utilities, Graphics;

    procedure DoMouseDownInLUT (event: EventRecord);
    procedure PasteColor;
    procedure ShowRGBValues (index: integer);
    procedure InvertPalette;
    procedure UpdateGrayMap;
    procedure ResetGraymap;
    procedure DrawGrayMap;
    procedure DoMouseDownInGrayMap;
    procedure EnableThresholding (level: integer);
    procedure DrawLUT;
    procedure UpdateColors;



implementation


    function GetColorIndex: integer;
 {*****This routine needs work***}
        var
            ColorWidth: integer;
            CLUTIndex: LongInt;
    begin
        ColorWidth := 1;
        CLUTIndex := 255 - ForegroundIndex;
        with info^ do
            if (CLUTIndex < ColorStart) or (CLUTIndex > (ColorStart + nColors * ColorWidth)) then begin
                    GetColorIndex := NoColor
                end
            else
                GetColorIndex := (CLUTIndex - ColorStart) div ColorWidth;
    end;


    procedure EditColor;
        var
            where: point;
            inRGBColor, OutRGBColor: RGBColor;
            index: integer;
    begin
        with info^ do begin
                index := GetColorIndex;
                if index = NoColor then
                    exit(EditColor);
                with inRGBColor do begin
                        red := RedLUT[index];
                        green := GreenLUT[index];
                        blue := BlueLUT[index];
                    end;
                outRGBColor := inRGBColor;
                where.h := 0;
                where.v := 0;
                InitCursor;
                if GetColor(where, 'Pick a color, any color...', inRGBColor, outRGBColor) then begin
                        with outRGBColor do begin
                                RedLUT[index] := red;
                                GreenLUT[index] := green;
                                BlueLUT[index] := blue;
                            end;
                        info^.changes := true;
                    end;
                UpdateColors;
            end; {with}
    end;

    procedure EditSliceColor;
        var
            where: point;
            inRGBColor, OutRGBColor: RGBColor;
    begin
        inRGBColor := SliceColor;
        outRGBColor := inRGBColor;
        where.h := 0;
        where.v := 0;
        InitCursor;
        if GetColor(where, 'Pick a new color...', inRGBColor, outRGBColor) then
            SliceColor := outRGBColor;
        DrawDensitySlice(false);
    end;


    procedure RotateColors;
        var
            vstart, i, j, delta: integer;
            loc: point;
            TempTable: MyCSpecArray;
    begin
        with info^ do begin
                SetPort(LUTWindow);
                GetMouse(loc);
                vstart := loc.v;
                repeat
                    GetMouse(loc);
                    delta := vstart - loc.v;
                    for i := 1 to 254 do begin {0 is resevred for white and 255 for black}
                            j := i + delta;
                            if j > 254 then
                                j := j - 254;
                            if j > 254 then
                                j := 254;
                            if j < 1 then
                                j := j + 254;
                            if j < 1 then
                                j := 1;
                            TempTable[i] := cTable[j]
                        end;
                    cTable := TempTable;
                    LoadLUT(cTable);
                    vstart := loc.v;
                until not button;
            end;
    end;


    procedure ShowLUTValues (tStart, tEnd: integer);
        var
            tPort: GrafPtr;
    begin
        with info^ do begin
                GetPort(tPort);
                SetPort(ResultsWindow);
                TextSize(9);
                TextFont(Monaco);
                TextMode(SrcCopy);
                MoveTo(xValueLoc, ValuesVStart);
                if DensityCalibrated then begin
                        DrawReal(cvalue[tStart], 5, 2);
                        DrawString(' (');
                        DrawReal(tStart, 3, 0);
                        DrawString(')');
                    end
                else
                    DrawReal(tStart, 3, 0);
                DrawString('    ');
                MoveTo(xValueLoc, ValuesVStart + 10);
                if DensityCalibrated then begin
                        DrawReal(cvalue[tEnd], 5, 2);
                        DrawString(' (');
                        DrawReal(tEnd, 3, 0);
                        DrawString(')');
                    end
                else
                    DrawReal(tEnd, 3, 0);
                DrawString('    ');
                SetPort(tPort);
            end;
    end;


    procedure DrawRGB (index: integer);
        var
            rStr, gStr, bStr: str255;
            TempRGB: rgbColor;
            i, entry: integer;

        procedure Convert (n: integer; var str: str255);
            var
                i: integer;
        begin
            RealToString(n, 3, 0, str);
            for i := 1 to 3 do
                if str[i] = ' ' then
                    str[i] := '0';
        end;

    begin
        TempRGB := cScreenPort^.portPixMap^^.pmTable^^.ctTable[index].rgb;
        with TempRGB do begin
                Convert(band(bsr(red, 8), 255), rStr);
                Convert(band(bsr(green, 8), 255), gStr);
                Convert(band(bsr(blue, 8), 255), bStr);
                DrawString(concat(rStr, ' ', gStr, ' ', bStr));
            end;
    end;


    procedure ShowRGBValues (index: integer);
        var
            tPort: GrafPtr;
            vloc: integer;
    begin
        with info^ do begin
                GetPort(tPort);
                SetPort(ResultsWindow);
                TextSize(9);
                TextFont(Monaco);
                TextMode(SrcCopy);
                vloc := ValuesVStart;
                MoveTo(xValueLoc, vloc);
                DrawLong(index);
                DrawString('    ');
                if Info^.DensityCalibrated then begin
                        vloc := vloc + 10;
                        MoveTo(xValueLoc, vloc);
                        DrawReal(cvalue[index], 1, precision);
                        DrawString('    ');
                    end;
                vloc := vloc + 10;
                MoveTo(xValueLoc, vloc);
                DrawRGB(index);
                DrawString('    ');
                SetPort(tPort);
            end;
    end;


    function GetVLoc: integer;
        var
            loc: point;
            vloc: integer;
    begin
        GetMouse(loc);
        vloc := loc.v;
        if vloc > 255 then
            vloc := 255;
        if vloc <= 0 then
            vloc := 0;
        GetVLoc := vloc;
    end;


    procedure UpdateThreshold;
        var
            level: integer;
    begin
        DrawLabels('Thresh:', '', '');
        SetPort(LUTWindow);
        with info^ do
            repeat
                level := GetVLoc;
                if level <= 255 then begin
                        p1x := level;
                        p2x := level;
                        UpdateGrayMap;
                        SetGrayScaleLUT;
                    end;
                Show1Value(p1x, NoValue);
            until not Button;
    end;


    procedure UpdateDensitySlice;
        var
            mloc, saveloc, width, delta: integer;
            adjust: (lower, upper, both);
    begin
        DrawLabels('Lower:', 'Upper:', '');
        SetPort(LUTWindow);
        mloc := getvloc;
        saveloc := mloc;
        width := SliceEnd - SliceStart + 1;
        adjust := lower;
        if mloc > (SliceStart + width div 3) then
            adjust := both;
        if mloc > (SliceEnd - width div 3) then
            adjust := upper;
        while button do begin
                width := SliceEnd - SliceStart + 1;
                mloc := getvloc;
                delta := mloc - saveloc;
                saveloc := mloc;
                case adjust of
                    lower:
                        begin
                            SliceStart := mloc;
                            if SliceStart < 1 then
                                SliceStart := 1;
                            if SliceStart > SliceEnd then
                                SliceStart := SliceEnd;
                        end;
                    upper:
                        begin
                            SliceEnd := mloc;
                            if SliceEnd > 254 then
                                SliceEnd := 254;
                            if SliceEnd < SliceStart then
                                SliceEnd := SliceStart;
                        end;
                    both:
                        begin
                            if mloc <= 1 then begin
                                    SliceStart := 1;
                                    SliceEnd := width;
                                end
                            else if mloc >= 254 then begin
                                    SliceEnd := 254;
                                    SliceStart := 254 - width + 1;
                                end
                            else if ((SliceStart + delta) >= 1) and ((SliceEnd + delta) <= 254) then begin
                                    SliceStart := SliceStart + delta;
                                    SliceEnd := SliceEnd + delta;
                                end;
                        end;
                end; {case}
                DrawDensitySlice(OptionKeyDown);
                ShowLUTValues(SliceStart, SliceEnd);
            end; {while}
        DrawDensitySlice(false)
    end;


    procedure EditExtraColors (entry: integer);
        var
            where: point;
            inRGBColor, OutRGBColor: RGBColor;
    begin
        if (entry <> WhiteIndex) and (entry <> BlackIndex) then begin
                inRGBColor := ExtraColors[entry];
                outRGBColor := inRGBColor;
                where.h := 0;
                where.v := 0;
                InitCursor;
                if GetColor(where, 'Pick a color, any color...', inRGBColor, outRGBColor) then
                    with info^ do begin
                            ExtraColors[entry] := OutRGBColor;
                            changes := true;
                            LoadLUT(cTable);
                        end
            end
        else
            PutMessage('Sorry, but you can not edit white or black.');
    end;


    function GetColorFromPalette (DoubleClick: boolean): integer;
        var
            mloc, color, i: integer;
            loc: point;
    begin
        SetPort(LUTWindow);
        GetMouse(loc);
        if loc.v > 255 then begin
                color := 0;
                for i := 1 to nExtraColors + 2 do
                    if PtInRect(loc, ExtraColorsRect[i]) then
                        Color := ExtraColorsEntry[i];
                if DoubleClick then
                    EditExtraColors(color);
                GetColorFromPalette := color;
            end
        else
            GetColorFromPalette := loc.v;
    end;


    procedure AdjustLUT;
        const
            MinWidth = 8;
        var
            mloc, saveloc, width, delta: integer;
            adjust: (lower, upper, both);
    begin
        with info^ do begin
                DrawLabels('Lower:', 'Upper:', '');
                SetPort(LUTWindow);
                mloc := getvloc;
                saveloc := mloc;
                width := ColorEnd - ColorStart + 1;
                adjust := lower;
                if mloc > (ColorStart + width div 3) then
                    adjust := both;
                if mloc > (ColorEnd - width div 3) then
                    adjust := upper;
                while button do begin
                        mloc := getvloc;
                        delta := mloc - saveloc;
                        saveloc := mloc;
                        case adjust of
                            lower:
                                begin
                                    ColorStart := mloc;
                                    if ColorStart > (ColorEnd - MinWidth) then
                                        ColorStart := ColorEnd - MinWidth;
                                end;
                            upper:
                                begin
                                    ColorEnd := mloc;
                                    if ColorEnd < (ColorStart + MinWidth) then
                                        ColorEnd := ColorStart + MinWidth;
                                end;
                            both:
                                begin
                                    width := ColorEnd - ColorStart + 1;
                                    if mloc <= 0 then begin
                                            ColorStart := 0;
                                            ColorEnd := width - 1;
                                        end
                                    else if mloc >= 255 then begin
                                            ColorEnd := 255;
                                            ColorStart := 255 - width + 1;
                                        end
                                    else if ((ColorStart + delta) >= 0) and ((ColorEnd + delta) <= 255) then begin
                                            ColorStart := ColorStart + delta;
                                            ColorEnd := ColorEnd + delta;
                                        end;
                                end;
                        end;
                        UpdateColors;
                        ShowLUTValues(ColorStart, ColorEnd);
                    end;
            end;
    end;


    procedure DoMouseDownInLUT (event: EventRecord);
        var
            color: integer;
            DoubleClick: boolean;
    begin
        with info^ do begin
                if CurrentTool = PickerTool then
                    DoubleClick := (TickCount - LutTime) < GetDblTime
                else
                    DoubleClick := false;
                LutTime := TickCount;
                if (CurrentTool <> LutTool) and (CurrentTool <> Wand) then begin
                        color := GetColorFromPalette(DoubleClick);
                        if (CurrentTool = eraser) or OptionKeyDown then
                            SetBackgroundColor(color)
                        else
                            SetForegroundColor(color);
                        if not DoubleClick then
                            exit(DoMouseDownInLUT);
                    end;
                if Thresholding then begin
                        UpdateThreshold;
                        exit(DoMouseDownInLUT)
                    end;
                if DoubleClick then begin
                        EditSliceColor;
                        exit(DoMouseDownInLUT)
                    end;
                if DensitySlicing then begin
                        if DoubleClick and (CurrentTool = PickerTool) then
                            EditSliceColor
                        else if (CurrentTool = LutTool) or (CurrentTool = Wand) then
                            UpdateDensitySlice;
                        exit(DoMouseDownInLUT)
                    end;
                if nColors = 0 then
                    exit(DoMouseDownInLUT);
                if (LUTMode <> PseudoColor) and not DoubleClick then begin
                        if pDeltaX <> 0 then
                            RotateColors;
                        exit(DoMouseDownInLUT)
                    end;
                if (CurrentTool = PickerTool) and DoubleClick then begin
                        if LUTMode <> PseudoColor then
                            exit(DoMouseDownInLUT);
                        EditColor;
                        exit(DoMouseDownInLUT)
                    end;
                AdjustLUT;
            end; {with}
    end;


    procedure PasteColor;
{*******Needs Work*****}
        var
            CurrentColorIndex, ClipColorIndex: integer;
    begin
        exit(PasteColor);
        with info^ do
            if (CurrentTool = PickerTool) and (LUTMode = PseudoColor) then begin
                    RedLUT[CurrentColorIndex] := RedLUT[ClipColorIndex];
                    GreenLUT[CurrentColorIndex] := GreenLUT[ClipColorIndex];
                    BlueLUT[CurrentColorIndex] := BlueLUT[ClipColorIndex];
                    UpdateColors;
                end
            else
                beep;
    end;


    procedure InvertPalette;
        var
            TempRed, TempGreen, TempBlue: LutArray;
            i, LastColor: integer;
            TempTable: MyCSpecArray;
    begin
        with info^ do begin
                if LutMode = PseudoColor then begin
                        TempRed := RedLUT;
                        TempGreen := GreenLUT;
                        TempBlue := BlueLUT;
                        LastColor := ncolors - 1;
                        for i := 0 to LastColor do begin
                                RedLUT[i] := TempRed[LastColor - i];
                                GreenLUT[i] := TempGreen[LastColor - i];
                                BlueLUT[i] := TempBlue[LastColor - i];
                            end;
                        UpdateColors;
                    end
                else begin
                        TempTable := cTable;
                        for i := 1 to 254 do
                            cTable[i] := TempTable[255 - i];
                        LoadLUT(cTable);
                    end;
            end; {with}
    end;



    procedure UpdateGrayMap;
        const
            gmRectArea = 4096.0; {64x64}
            max = 4177920;
        var
            tPort: GrafPtr;
            r: rect;
            x, y, i, h1, h2, h3, v1, v2, v3, dx, dy: integer;
            xcenter, ycenter, brightness, islope, thumb: integer;
            table: LookupTable;
            hrect: rect;
            slope: extended;
            area, value, sum: LongInt;
    begin
        GetPort(tPort);
        SetPort(GrayMapWindow);
        PenNormal;
        EraseRect(GrayMapRect2);
        FrameRect(GrayMapRect);
        with info^ do
            if LutMode = CustomGrayscale then begin
                    GetLookupTable(table);
                    MoveTo(gmRectLeft, gmRectBottom - 1);
                    for i := 0 to 63 do begin
                            x := gmRectLeft + i;
                            y := gmRectBottom - table[i * 4] div 4 - 1;
                            LineTo(x, y);
                        end;
                    EraseRect(gmSlide1i);
                    EraseRect(gmSlide2i);
                end
            else begin
                    h1 := gmRectLeft + p1x div 4;
                    v1 := gmRectBottom - 1 - (p1y div 4);
                    h2 := gmRectLeft + p2x div 4;
                    v2 := gmRectBottom - 1 - (p2y div 4);
                    MoveTo(gmRectLeft, gmRectBottom - 1);
                    LineTo(h1, v1);
                    LineTo(h2, v2);
                    LineTo(gmRectRight - 1, gmRectTop);
                    SetRect(hrect, h1 - 1, v1 - 1, h1 + 2, v1 + 2);
                    PaintRect(hrect); {First handle}
                    SetRect(hrect, h2 - 1, v2 - 1, h2 + 2, v2 + 2);
                    PaintRect(hrect); {Last handle}
                    dx := p2x - p1x;
                    dy := p2y - p1y;
                    xcenter := p1x + dx div 2;
                    ycenter := p1y + dy div 2;
                    h3 := gmRectLeft + xcenter div 4;
                    v3 := gmRectBottom - 1 - (ycenter div 4);
                    SetRect(hrect, h3 - 1, v3 - 1, h3 + 2, v3 + 2);
                    PaintRect(hrect); {Center handle}
                    thumb := gmSlideHeight - 2;
                    i := 0;
                    sum := 0;
                    repeat
                        value := ctable[i].rgb.red;
                        value := band(value, 65535);
                        sum := sum + value;
                        i := i + 4;
                    until i > 255;
                    brightness := trunc((sum / max) * (gmSlideWidth - thumb - 2.0));
                    gmSlide1Loc := brightness;
                    with gmSlide1 do
                        SetRect(hrect, left + brightness + 1, top + 1, left + brightness + thumb + 1, top + thumb + 1);
                    EraseRect(gmSlide1i);
                    PaintRect(hrect);  {Thumb for brightness control}
                    if dx <> 0 then
                        slope := dy / dx
                    else
                        slope := 1000.0;
                    if slope > 1.0 then begin
                            if dy <> 0 then
                                slope := 2.0 - dx / dy
                            else
                                slope := 2.0;
                        end;
                    islope := trunc(slope * 0.5 * (gmSlideWidth - thumb - 2.0));
                    with gmSlide2 do
                        SetRect(hrect, left + islope + 1, top + 1, left + islope + thumb + 1, top + thumb + 1);
                    EraseRect(gmSlide2i);
                    PaintRect(hrect);  {Thumb for contrast control}
                end;
        SetPort(tPort);
    end;


    procedure DrawGrayMap;
        var
            tPort: GrafPtr;
            x, y, i: integer;
            table: LookupTable;
    begin
        GetPort(tPort);
        SetPort(GrayMapWindow);
        PenNormal;
        TextFont(ApplFont);
        TextSize(9);
        with gmSlide1 do
            MoveTo(left - 6, bottom);
        DrawChar('B');
        with gmSlide2 do
            MoveTo(left - 6, bottom);
        DrawChar('C');
        FrameRect(gmSlide1);
        FrameRect(gmSlide2);
        FrameRect(gmIcon1);
        FrameRect(gmIcon2);
        with gmIcon1 do begin
                MoveTo(left, top + 10);
                LineTo(left + 5, top + 10);
                LineTo(left + 12, top + 3);
                LineTo(left + gmIconWidth - 1, top + 3);
            end;
        with gmIcon2 do begin
                MoveTo(left, top + 10);
                LineTo(left + gmIconWidth div 2, top + 10);
                LineTo(left + gmIconWidth div 2, top + 3);
                LineTo(left + gmIconWidth - 1, top + 3);
            end;
        UpdateGrayMap;
        GrayMapReady := true;
        SetPort(tPort);
    end;


    procedure ResetGrayMap;
    begin
        with info^ do begin
                DisableDensitySlice;
                p1x := 0;
                p1y := 0;
                p2x := 255;
                p2y := 255;
                pDeltaX := 256;
                pDeltaY := 256;
                SetGrayScaleLUT;
                LUTMode := Grayscale;
                if GrayMapReady then
                    UpdateGrayMap;
                IdentityFunction := true;
                Thresholding := false;
            end;
    end;


    procedure FindEndPoints (x, y: integer);
        var
            xintercept: integer;
    begin
        with info^ do begin
                if pDeltaX = 0 then begin
                        p1x := x;
                        p1y := 0;
                        p2x := x;
                        p2y := 255;
                        exit(FindEndPoints);
                    end;
                if pDeltaY = 0 then begin
                        p1x := 0;
                        p1y := y;
                        p2x := 255;
                        p2y := y;
                        exit(FindEndPoints);
                    end;
                p1x := x - y * LongInt(pDeltaX) div pDeltaY;
                xIntercept := p1x;
                p1y := 0;
                if p1x < 0 then begin
                        p1y := -(LongInt(pDeltaY) * p1x) div pDeltaX;
                        p1x := 0;
                    end;
                p2y := 255;
                p2x := 255 * LongInt(pDeltaX) div pDeltaY;
                if xIntercept < 0 then
                    p2x := p2x + xIntercept
                else
                    p2x := p2x + p1x;
                if p2x > 255 then begin
                        p2y := 255 - (p2x - 255) * LongInt(pDeltaY) div pDeltaX;
                        p2x := 255;
                    end;
                if p2x < 0 then
                    p2x := 0;
            end; {with}
    end;


    procedure ChangeBrightness;
        var
            loc, oldloc, max, HalfMax, thumb, xcenter, ycenter, delta: integer;
            hrect: rect;

        function FindLoc: integer;
            var
                p: point;
                loc: integer;
        begin
            GetMouse(p);
            loc := p.h - gmSlide1.left - 2;
            if loc < 0 then
                loc := 0;
            if loc > max + 5 then
                loc := max + 5;
            FindLoc := loc;
        end;

    begin
        with info^ do begin
                thumb := gmSlideHeight - 2;
                max := gmSlideWidth - thumb - 2;
                HalfMax := max div 2;
                OldLoc := FindLoc;
                repeat
                    xcenter := p1x + (p2x - p1x) div 2;
                    ycenter := p1y + (p2y - p1y) div 2;
                    loc := FindLoc;
                    delta := gmSlide1Loc + 1 - loc;
                    if pDeltaY <> 0 then begin
                            xcenter := xcenter - delta;
                            if xcenter < 0 then
                                xcenter := 0;
                            if xcenter > 255 then
                                xcenter := 255;
                        end;
                    if pDeltaX <> 0 then begin
                            ycenter := ycenter + delta;
                            if ycenter < 0 then
                                ycenter := 0;
                            if ycenter > 255 then
                                ycenter := 255;
                        end;
                    FindEndPoints(xcenter, ycenter);
                    UpdateGrayMap;
                    gmFixedSlope := true;
                    SetGrayScaleLUT;
                    gmFixedSlope := false;
                    OldLoc := loc;
                until not button;
                IdentityFunction := false;
            end; {with}
    end;


    procedure ChangeContrast;
        var
            p: point;
            loc, max, HalfMax, thumb, xcenter, ycenter: integer;
            hrect: rect;
            slope: extended;
            str: str255;
    begin
        with info^ do begin
                thumb := gmSlideHeight - 2;
                max := gmSlideWidth - thumb - 2;
                HalfMax := max div 2;
                xcenter := p1x + pDeltaX div 2;
                if xcenter > 255 then
                    xcenter := 255;
                ycenter := p1y + pDeltaY div 2;
                repeat
                    GetMouse(p);
                    loc := p.h - gmSlide2.left - 2;
                    if loc < 0 then
                        loc := 0;
                    if loc > max then
                        loc := max;
                    if loc <= HalfMax then
                        slope := loc / HalfMax
                    else if loc < max then
                        slope := HalfMax / (max - loc)
                    else
                        slope := 1000.0;
                    RealToString(slope, 1, 2, str);
{ShowMessage(concat(str, cr, long2str(xcenter), cr, long2str(ycenter), cr, long2str(pdeltax), cr, long2str(deltay)));}
                    if slope <= 1.0 then begin
                            pDeltaX := 255;
                            pDeltaY := round(slope * pDeltaX);
                        end
                    else begin
                            pDeltaY := 255;
                            pDeltaX := round(pDeltaY / slope);
                        end;
                    FindEndPoints(xcenter, ycenter);
                    UpdateGrayMap;
                    SetGrayScaleLUT;
                until not button;
                IdentityFunction := false;
            end; {with}
    end;


    procedure ConvertMouseToXY (p: point; var x, y: integer);
    begin
        x := (p.h - gmRectLeft) * 4;
        if x < 0 then
            x := 0;
        if x > 255 then
            x := 255;
        y := (gmRectBottom - p.v) * 4;
        if y < 0 then
            y := 0;
        if y > 255 then
            y := 255;
    end;


    procedure DoFreehandEditing;
        var
            p: point;
            x1, x2, y, i: integer;
            FirstTime, WasColor: boolean;
    begin
        with info^ do begin
                WasColor := (LUTMode = custom) or (LUTMode = PseudoColor) or (LUTMode = AppleDefault) or (LUTMode = Spectrum);
                LUTMode := CustomGrayscale;
                SetPort(GrayMapWindow);
                FirstTime := true;
                while button do begin
                        x1 := x2;
                        GetMouse(p);
                        ConvertMouseToXY(p, x2, y);
                        if x2 > 252 then
                            x2 := 252;
                        if FirstTime then begin
                                x1 := x2;
                                FirstTime := false;
                            end;
                        if x2 >= x1 then
                            for i := x1 to x2 + 3 do
                                with cTable[i].rgb do begin
                                        red := bsl(255 - y, 8);
                                        green := bsl(255 - y, 8);
                                        blue := bsl(255 - y, 8);
                                    end
                        else
                            for i := x1 + 3 downto x2 do
                                with cTable[i].rgb do begin
                                        red := bsl(255 - y, 8);
                                        green := bsl(255 - y, 8);
                                        blue := bsl(255 - y, 8);
                                    end;
                        DrawGrayMap;
                        LoadLUT(cTable);
                    end;
                if WasColor then
                    LUTMode := custom;
            end;
    end;


    procedure DoMouseDownInGrayMap;
        var
            r: rect;
            x, y, p1Dist, p2Dist, x1, y1: integer;
            mode: (StartPoint, EndPoint, Brightness);
            p: point;
            pressed: boolean;

        procedure DoFixup;
        begin
            with info^ do
                if ((p1x = 0) and (p2x = 0)) or ((p1x = 255) and (p2x = 255)) then begin
                        p1y := 0;
                        p2y := 255;
                    end;
        end;

    begin
        DisableDensitySlice;
        if OptionKeyDown then begin
                DoFreehandEditing;
                exit(DoMouseDownInGrayMap);
            end;
        if info^.LUTMode = CustomGrayscale then
            ResetGrayMap;
        SetPort(GrayMapWindow);
        GetMouse(p);
        if PtInRect(p, gmIcon1) then begin
                InvertRect(gmIcon1);
                pressed := true;
                while Button and pressed do begin
                        GetMouse(p);
                        if not PtInRect(p, gmIcon1) then begin
                                InvertRect(gmIcon1);
                                pressed := false;
                            end;
                    end;
                repeat
                until not button;
                if pressed then begin
                        InvertRect(gmIcon1);
                        ResetGrayMap;
                        exit(DoMouseDownInGrayMap)
                    end;
            end;
        if PtInRect(p, gmIcon2) then begin
                InvertRect(gmIcon2);
                pressed := true;
                while Button and pressed do begin
                        GetMouse(p);
                        if not PtInRect(p, gmIcon2) then begin
                                InvertRect(gmIcon2);
                                pressed := false;
                            end;
                    end;
                repeat
                until not button;
                if pressed then begin
                        InvertRect(gmIcon2);
                        EnableThresholding(128);
                        exit(DoMouseDownInGrayMap)
                    end;
            end;
        if PtInRect(p, gmSlide1) then
            ChangeBrightness;
        if PtInRect(p, gmSlide2) then
            ChangeContrast;
        if p.v > (gmRectBottom + 4) then begin
                Thresholding := info^.pDeltaX <= 1;
                exit(DoMouseDownInGrayMap);
            end;
        GetMouse(p);
        ConvertMouseToXY(p, x, y);
        if (x <= 24) or (y <= 32) then
            mode := StartPoint
        else if (x >= 224) or (y >= 232) then
            mode := EndPoint
        else
            mode := brightness;
        if (mode = brightness) and thresholding then
            DrawLabels('Thresh:', '', '')
        else
            DrawLabels('X:', 'Y:', '');
        repeat
            with info^ do
                case mode of
                    StartPoint:
                        begin
                            if x > y then
                                y := 0
                            else
                                x := 0;
                            p1x := x;
                            if p1x > p2x then
                                p2x := p1x;
                            p1y := y;
                            if p1y > p2y then
                                p2y := p1y;
                            DoFixUp;
                            Show2Values(p1x, p1y);
                        end;
                    EndPoint:
                        begin
                            if x > y then
                                x := 255
                            else
                                y := 255;
                            p2x := x;
                            if p2x < p1x then
                                p1x := p2x;
                            p2y := y;
                            if p2y < p1y then
                                p1y := p2y;
                            DoFixUp;
                            Show2Values(p2x, p2y);
                        end;
                    Brightness:
                        begin
                            FindEndPoints(x, y);
                            if thresholding then
                                Show1Value(p1x, NoValue);
                        end;
                end; {case}
            UpdateGrayMap;
            gmFixedSlope := mode = brightness;
            SetGrayScaleLUT;
            gmFixedSlope := false;
            GetMouse(p);
            ConvertMouseToXY(p, x, y);
        until not Button;
        IdentityFunction := false;
        Thresholding := info^.pDeltaX <= 1;
    end;


    procedure EnableThresholding (level: integer);
    begin
        with info^ do begin
                pDeltaX := 1;
                pDeltaY := 255;
                p1x := level;
                p1y := 0;
                p2x := level;
                p2y := 255;
                SetGrayScaleLUT;
                UpdateGrayMap;
                Thresholding := true;
                SelectLutTool;
            end;
    end;


    procedure DrawLUT;
        var
            tPort: GrafPtr;
            h, v, i: integer;
    begin
        GetPort(tPort);
        SetPort(LUTWindow);
        with LutWindow^ do begin
                for v := 0 to 255 do begin
                        pmForeColor(v);
                        MoveTo(0, v);
                        LineTo(cwidth, v)
                    end;
                for i := 1 to nExtraColors + 2 do begin
                        pmForeColor(ExtraColorsEntry[i]);
                        PaintRect(ExtraColorsRect[i]);
                    end;
                TextFont(ApplFont);
                TextSize(9);
                with ExtraColorsRect[1] do
                    MoveTo(left + 3, bottom - 1);
                pmForeColor(BlackIndex);
                DrawString('white');
                with ExtraColorsRect[2] do
                    MoveTo(left + 4, bottom - 1);
                InvertRect(ExtraColorsRect[2]);
                DrawString('black');
                InvertRect(ExtraColorsRect[2]);
            end;
        SetPort(tPort);
    end;


    procedure UpdateColors;
        var
            MaxStart, i, v, index: integer;
            OptionKey: boolean;
            inc, sIndex: LongInt;
    begin
        OptionKey := OptionKeyDown;
        DisableDensitySlice;
        Thresholding := false;
        with info^ do begin
                sIndex := 0;
                inc := LongInt(nColors) * 10000 div (ColorEnd - ColorStart);
                for i := 0 to 255 do
                    with cTable[i].rgb do begin
                            if (i < ColorStart) or (i > ColorEnd) then begin
                                    if OptionKey then begin
                                            v := bsl(i, 8);
                                            Red := v;
                                            Green := v;
                                            Blue := v;
                                        end
                                    else begin
                                            Red := 0;
                                            Green := 0;
                                            Blue := 0;
                                        end
                                end
                            else begin
                                    index := sIndex div 10000;
                                    Red := bsl(RedLUT[index], 8);
                                    Green := bsl(GreenLUT[index], 8);
                                    Blue := bsl(BlueLUT[index], 8);
                                    sIndex := sIndex + inc;
                                end;
                        end; {for}
                LoadLUT(cTable);
                LUTMode := PseudoColor;
            end;
        IdentityFunction := false;
    end;



end.