Celestin Apprentice 2/Apprentice-Release2.iso/Source Code/Pascal/Applications/NIH Image 1.55/Source/Lut.p

Text File | 1994-04-20 | 51.7 KB | 1,860 lines | [TEXT/PJMM]

unit Lut;
{This file contains routines that deal with the video Look-Up Table(LUT).}

interface

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

    function GetPseudoColorIndex: integer;
    function isGrayScaleLUT: boolean;
    procedure DoMouseDownInLUT (event: EventRecord);
    procedure DoCopyColor;
    procedure PasteColor;
    procedure ShowRGBValues (index: integer);
    procedure InvertPalette;
    procedure FindPoints (var x1, y1, x2, y2: integer);
    procedure UpdateMap;
    procedure ResetGraymap;
    procedure DrawMap;
    procedure DoMouseDownInMap;
    procedure EnableThresholding (level: integer);
    procedure DisableThresholding;
    procedure DrawLUT;
    procedure UpdateLUT;
    procedure LoadColorTable (theColorTable: CTabHandle);
    function LoadCLUTResource (id: integer): boolean;
    procedure GetLookupTable (var table: LookupTable);
    procedure RedrawLUTWindow;
    procedure DrawDensitySlice (OptionKey: boolean);
    procedure SelectLutTool;
    procedure EnableDensitySlice;
    procedure SetupPseudocolor;
    procedure DoImportLut (fname: str255; vnum: integer);
    procedure OpenOldPalette (fname: str255; RefNum: integer);
    procedure OpenNewPalette (fname: str255; RefNum: integer);
    procedure OpenColorTable (fname: str255; RefNum: integer);
    procedure ImportPalette (FileType: OSType; fname: str255; vnum: integer);
    procedure GetColorTable (id: integer);
    procedure GetLutResource (id: integer);
    procedure DrawScale;
    procedure MakeSpectrum;
    function GetColorTableItem (ctab: ColorTableType): integer;
    procedure SwitchColorTables (item: integer; update: boolean);
    procedure InitPaletteHeader (var hdr: PaletteHeader);
    procedure ResetMap;
    procedure DoLutOptions;
    function SetupMask: boolean;
    procedure PutLineUsingMask (h, v, count: integer; var line: LineType);
    procedure ApplyTable (var table: LookupTable);
    procedure FixColors;



implementation


    function GetPseudoColorIndex: integer;
        var
            index: integer;
    begin
        with info^ do begin
                index := trunc((nColors) * (ForegroundIndex - ColorStart) / (ColorEnd - ColorStart + 1));
                if index < 0 then
                    index := 0;
                if index > (nColors - 1) then
                    index := nColors - 1;
                GetPseudoColorIndex := index;
            end;
    end;


    procedure UpdateLUT;
        var
            MaxStart, i, v, index, last: integer;
            inc, sIndex: LongInt;
    begin
        with info^ do begin
                sIndex := 0;
                if ColorEnd > ColorStart then
                    inc := LongInt(nColors) * 10000 div (ColorEnd - ColorStart)
                else
                    inc := 2560000;
                if ColorStart < 0 then
                    sIndex := -ColorStart * Inc
                else
                    sIndex := 0;
                last := nColors - 1;
                for i := 0 to 255 do
                    with cTable[i].rgb do begin
                            if (i < ColorStart) or (i > ColorEnd) then begin
                                    if i < ColorStart then
                                        cTable[i].rgb := FillColor1
                                    else
                                        cTable[i].rgb := FillColor2;
                                end
                            else begin
                                    index := sIndex div 10000;
                                    if index > last then
                                        index := last;
                                    Red := bsl(RedLUT[index], 8);
                                    Green := bsl(GreenLUT[index], 8);
                                    Blue := bsl(BlueLUT[index], 8);
                                    sIndex := sIndex + inc;
                                end;
                        end; {for}
                if ColorStart = ColorEnd then
                    cTable[ColorStart].rgb := FillColor2
                else
                    Thresholding := false;
                LoadLUT(cTable);
                IdentityFunction := false;
            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 GetNewColor (var color: RGBColor);
        var
            where: point;
            inRGBColor, OutRGBColor: RGBColor;
    begin
        inRGBColor := color;
        outRGBColor := color;
        where.h := 0;
        where.v := 0;
        InitCursor;
        if GetColor(where, 'Pick a new color...', inRGBColor, outRGBColor) then
            color := outRGBColor;
    end;


    procedure EditPseudoColors;
        var
            where: point;
            inRGBColor, OutRGBColor: RGBColor;
            index, mloc: integer;
    begin
        SetupLUTUndo;
        with info^ do begin
                SetPort(LUTWindow);
                mloc := getvloc;
                if mloc < ColorStart then begin
                        GetNewColor(FillColor1);
                        UpdateLUT;
                        exit(EditPseudoColors);
                    end;
                if mloc > ColorEnd then begin
                        GetNewColor(FillColor2);
                        UpdateLUT;
                        exit(EditPseudoColors);
                    end;
                index := GetPseudoColorIndex;
                with inRGBColor do begin
                        red := bsl(RedLUT[index], 8);
                        green := bsl(GreenLUT[index], 8);
                        blue := bsl(BlueLUT[index], 8);
                    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] := bsr(red, 8);
                                GreenLUT[index] := bsr(green, 8);
                                BlueLUT[index] := bsr(blue, 8);
                            end;
                        changes := true;
                    end;
                ColorTable := CustomTable;
                LutMode := PseudoColor;
                UpdateLUT;
            end; {with}
    end;


    function EditSliceColor: boolean;
        var
            where: point;
            inRGBColor, OutRGBColor: RGBColor;
            vloc: integer;
    begin
        SetPort(LUTWindow);
        vloc := getvloc;
        if (vloc >= SliceStart) and (vloc <= SliceEnd) then begin
                GetNewColor(SliceColor);
                DrawDensitySlice(false);
                EditSliceColor := true
            end
        else
            EditSliceColor := false;
    end;


    procedure ShowLUTValues (tStart, tEnd: integer);
        var
            tPort: GrafPtr;
            value: extended;
            range, NewMin, NewMax: LongInt;
    begin
        with info^ do begin
                GetPort(tPort);
                SetPort(InfoWindow);
                TextSize(9);
                TextFont(Monaco);
                TextMode(SrcCopy);
                MoveTo(xValueLoc, InfoVStart);
                if DataType <> EightBits then begin
                        range := CurrentMax - CurrentMin;
                        if tEnd < 255 then
                            NewMin := CurrentMin + round(((255 - tEnd) / 255) * range)
                        else
                            NewMin := CurrentMin;
                        DrawLong(NewMin);
                        DrawString('    ');
                        MoveTo(xValueLoc, InfoVStart + 10);
                        if tStart > 0 then
                            NewMax := CurrentMax - round((tStart / 255) * range)
                        else
                            NewMax := CurrentMax;
                        DrawLong(NewMax);
                        DrawString('    ');
                        SetPort(tPort);
                        exit(ShowLUTValues);
                    end;
                if DensityCalibrated then begin
                        if tStart >= 0 then
                            value := cvalue[tStart]
                        else
                            value := cvalue[0];
                        DrawReal(value, 5, 2);
                        DrawString(' (');
                        DrawReal(tStart, 3, 0);
                        DrawString(')');
                    end
                else
                    DrawReal(tStart, 3, 0);
                DrawString('    ');
                MoveTo(xValueLoc, InfoVStart + 10);
                if DensityCalibrated then begin
                        if tEnd <= 255 then
                            value := cvalue[tEnd]
                        else
                            value := cvalue[255];
                        DrawReal(value, 5, 2);
                        DrawString(' (');
                        DrawReal(tEnd, 3, 0);
                        DrawString(')');
                    end
                else
                    DrawReal(tEnd, 3, 0);
                DrawString('    ');
                SetPort(tPort);
            end;
    end;


    procedure ShowRGBValues (index: integer);
        var
            tPort: GrafPtr;
            vloc: integer;
    begin
        with info^ do begin
                GetPort(tPort);
                SetPort(InfoWindow);
                TextSize(9);
                TextFont(Monaco);
                TextMode(SrcCopy);
                vloc := InfoVStart;
                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;


    procedure FindPoints (var x1, y1, x2, y2: integer);
    begin
        with info^ do begin
                if ColorStart >= 0 then begin
                        x1 := ColorStart;
                        y1 := 0;
                    end
                else begin
                        x1 := 0;
                        if ColorEnd > ColorStart then
                            y1 := -ColorStart * 255 div (ColorEnd - ColorStart)
                        else
                            y1 := 0;
                    end;
                if ColorEnd <= 255 then begin
                        x2 := ColorEnd;
                        y2 := 255;
                    end
                else begin
                        x2 := 255;
                        if ColorEnd > ColorStart then
                            y2 := 255 * (255 - ColorStart) div (ColorEnd - ColorStart)
                        else
                            y2 := 255;
                    end;
            end;
    end;


    procedure UpdateMap;
        var
            r: rect;
            x, y, i, h1, h2, h3, v1, v2, v3, dx, dy: integer;
            xcenter, ycenter, brightness, islope, thumb: integer;
            width, max: integer;
            table: LookupTable;
            hrect: rect;
            slope: extended;
            area, value, sum: LongInt;
            p1x, p1y, p2x, p2y: integer;
    begin
        with info^ do begin
                FindPoints(p1x, p1y, p2x, p2y);
                SetPort(MapWindow);
                PenNormal;
                EraseRect(MapRect2);
                FrameRect(MapRect1);
                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);
                        exit(UpdateMap);
                    end;
                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;
                max := gmSlideWidth - thumb - 2;
                width := ColorEnd - ColorStart;
                brightness := trunc(max * ((ColorStart + width) / (width + 255)));
                with gmSlide1 do
                    SetRect(hrect, left + brightness + 1, top + 1, left + brightness + thumb + 1, top + thumb + 1);
                EraseRect(gmSlide1i);
                PaintRect(hrect);  {Thumb for contrast 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}
                if ScreenDepth <> 8 then begin
                        if ScreenDepth > 2 then
                            DrawLut;
                        UpdatePicWindow;
                    end;
            end;
    end;


    procedure UpdateThreshold;
        var
            level: integer;
    begin
        DrawLabels('Thresh:', '', '');
        ShowMessage('');
        with info^ do
            repeat
                SetPort(LUTWindow);
                level := GetVLoc;
                if level <= 255 then begin
                        ColorStart := level;
                        ColorEnd := level;
                        UpdateLUT;
                        UpdateMap;
                    end;
                Show1Value(level, 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 4) then
            adjust := both;
        if mloc > (SliceEnd - width div 4) then
            adjust := upper;
        if (SliceStart = SliceEnd) and (abs(mloc - SliceStart) <= 2) and (SliceStart > 1) and (SliceEnd < 254) then
            adjust := both;
        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 GetColorFromLUT (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);
                GetColorFromLUT := color;
            end
        else
            GetColorFromLUT := loc.v;
    end;


    function isGrayScaleLUT: boolean;
        var
            i: integer;
            GrayScaleLUT: boolean;
    begin
        with info^ do begin
                GrayscaleLUT := true;
                i := 0;
                repeat
                    with cTable[i].rgb do
                        GrayscaleLUT := GrayscaleLUT and (red = green) and (green = blue);
                    i := i + 1;
                until (i = 256) or not GrayscaleLUT;
                isGrayScaleLUT := GrayScaleLUT;
            end;
    end;


    procedure SetupPseudocolor;
        var
            i: integer;
    begin
        with info^ do begin
                DisableDensitySlice;
                Thresholding := false;
                for i := 1 to 254 do
                    with cTable[i].rgb do begin
                            RedLUT[i] := band(bsr(red, 8), 255);
                            GreenLUT[i] := band(bsr(green, 8), 255);
                            BlueLUT[i] := band(bsr(blue, 8), 255);
                        end;
                RedLUT[0] := RedLUT[1];
                GreenLUT[0] := GreenLUT[1];
                BlueLUT[0] := BlueLUT[1];
                RedLUT[255] := RedLUT[254];
                GreenLUT[255] := GreenLUT[254];
                BlueLUT[255] := BlueLUT[254];
                nColors := 256;
                ColorStart := 0;
                ColorEnd := 255;
                FillColor1 := ctable[1].rgb;
                FillColor2 := ctable[254].rgb;
                InvertedColorTable := false;
            end;
    end;


    procedure ShowLabels;
    begin
        with info^ do
            if DataType <> EightBits then
                DrawLabels('Min:', 'Max:', '')
            else
                DrawLabels('Lower:', 'Upper:', '');
    end;


    procedure AdjustLUT;
        const
            MinWidth = 8;
        var
            mloc, saveloc, width, delta, cstart, cend: integer;
            adjust: (lower, upper, both);
            loc: point;
    begin
        with info^ do begin
                SetPort(LUTWindow);
                SetupLutUndo;
                ShowLabels;
                mloc := getvloc;
                saveloc := mloc;
                cstart := ColorStart;
                if cstart < 0 then
                    cstart := 0;
                cend := ColorEnd;
                if cend > 255 then
                    cend := 255;
                width := cend - cstart + 1;
                adjust := lower;
                if mloc > (cstart + width div 4) then
                    adjust := both;
                if mloc > (cend - width div 4) then
                    adjust := upper;
                while button do begin
                        SetPort(LUTWindow);
                        GetMouse(loc);
                        mloc := loc.v;
                        delta := mloc - saveloc;
                        saveloc := mloc;
                        case adjust of
                            lower:  begin
                                    ColorStart := mloc;
                                    cend := ColorEnd;
                                    if cend > 255 then
                                        cend := 255;
                                    if ColorStart > (cend - MinWidth) then
                                        ColorStart := cend - MinWidth;
                                end;
                            upper:  begin
                                    ColorEnd := mloc;
                                    cstart := ColorStart;
                                    if cstart < 0 then
                                        cstart := 0;
                                    if ColorEnd < (cstart + MinWidth) then
                                        ColorEnd := cstart + MinWidth;
                                end;
                            both:
                                if (mloc >= 0) and (mloc <= 255) then begin
                                        ColorStart := ColorStart + delta;
                                        ColorEnd := ColorEnd + delta;
                                    end;
                        end;
                        UpdateLUT;
                        UpdateMap;
                        ShowLUTValues(ColorStart, ColorEnd);
                    end;
            end; {with info}
    end;


    procedure RotateLUT;
        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;
                SetupPseudocolor;
                ColorTable := CustomTable;
            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 := GetColorFromLUT(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
                        if DensitySlicing and (CurrentTool = PickerTool) then begin
                                if EditSliceColor then
                                    exit(DoMouseDownInLUT);
                            end;
                        if CurrentTool = PickerTool then begin
                                EditPseudoColors;
                                exit(DoMouseDownInLUT)
                            end;
                    end; {if DoubleClick}
                if ((CurrentTool = LutTool) or (CurrentTool = Wand)) and DensitySlicing then begin
                        UpdateDensitySlice;
                        exit(DoMouseDownInLUT);
                    end;
                if OptionKeyDown then
                    RotateLUT
                else
                    AdjustLUT;
            end; {with}
    end;


    procedure DoCopyColor;
    begin
        with info^ do begin
                if ForegroundIndex = WhiteIndex then begin
                        ClipboardColor := WhiteRGB;
                        exit(DoCopyColor);
                    end;
                if ForegroundIndex = BlackIndex then begin
                        ClipboardColor := BlackRGB;
                        exit(DoCopyColor);
                    end;
                with cTable[ForegroundIndex].rgb do begin
                        ClipboardColor.red := red;
                        ClipboardColor.green := green;
                        ClipboardColor.blue := blue;
                    end;
                WhatsOnClip := AColor;
                ClipTextInBuffer := false;
            end;
    end;


    procedure PasteColor;
        var
            CurrentColorIndex: integer;
    begin
        with info^ do begin
                if CurrentTool = PickerTool then begin
                        if ForegroundIndex < ColorStart then begin
                                FillColor1 := ClipboardColor;
                                UpdateLUT;
                                exit(PasteColor);
                            end;
                        if ForegroundIndex > ColorEnd then begin
                                FillColor2 := ClipboardColor;
                                UpdateLUT;
                                exit(PasteColor);
                            end;
                        CurrentColorIndex := GetPseudoColorIndex;
                        with ClipboardColor do begin
                                RedLUT[CurrentColorIndex] := bsr(red, 8);
                                GreenLUT[CurrentColorIndex] := bsr(green, 8);
                                BlueLUT[CurrentColorIndex] := bsr(blue, 8);
                            end;
                        ColorTable := CustomTable;
                        UpdateLUT;
                    end
                else
                    beep;
            end;
    end;


    procedure InvertPalette;
        var
            TempRed, TempGreen, TempBlue: LutArray;
            i, LastColor: integer;
            TempTable: MyCSpecArray;
            TempFill: rgbColor;
    begin
        DisableDensitySlice;
        DisableThresholding;
        with info^ do 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;
                TempFill := FillColor1;
                FillColor1 := FillColor2;
                FillColor2 := TempFill;
                InvertedColorTable := not InvertedColorTable;
                IdentityFunction := false;
            end;
    end;


    procedure DrawMap;
        var
            x, y, i: integer;
            table: LookupTable;
    begin
        SetPort(MapWindow);
        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;
        UpdateMap;
        GrayMapReady := true;
    end;


    procedure ResetGrayMap;
        var
            i: integer;
    begin
        with info^ do begin
                DisableDensitySlice;
                for i := 0 to 255 do begin
                        RedLut[i] := 255 - i;
                        GreenLut[i] := 255 - i;
                        BlueLut[i] := 255 - i;
                    end;
                FillColor1 := WhiteRGB;
                FillColor2 := BlackRGB;
                ColorStart := 0;
                ColorEnd := 255;
                nColors := 256;
                ColorTable := CustomTable;
                LUTMode := Grayscale;
                UpdateLUT;
                if GrayMapReady then
                    UpdateMap;
                IdentityFunction := true;
                InvertedColorTable := false;
            end;
    end;


    procedure AdjustBrightness;
        var
            loc, max, thumb, xcenter, ycenter, width: integer;
            p: point;
    begin
        with info^ do begin
                thumb := gmSlideHeight - 2;
                max := gmSlideWidth - thumb - 2;
                width := ColorEnd - ColorStart;
                ShowLabels;
                repeat
                    GetMouse(p);
                    loc := p.h - gmSlide1.left - 2;
                    if loc < 0 then
                        loc := 0;
                    if loc > max then
                        loc := max;
                    ColorStart := -width + round((width + 255) * (loc / max));
                    ColorEnd := ColorStart + width;
                    UpdateLUT;
                    UpdateMap;
                    ShowLUTValues(ColorStart, ColorEnd);
                until not button;
                IdentityFunction := false;
            end; {with}
    end;


    procedure AdjustContrast;
        var
            p: point;
            loc, max, HalfMax, thumb: integer;
            slope, center: extended;
    begin
        with info^ do begin
                thumb := gmSlideHeight - 2;
                max := gmSlideWidth - thumb - 2;
                HalfMax := max div 2;
                center := ColorStart + (ColorEnd - ColorStart) / 2.0;
                ShowLabels;
                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;
                    if slope > 0.0 then begin
                            ColorStart := round(center - 127.5 / slope);
                            ColorEnd := round(center + 127.5 / slope);
                        end
                    else begin
                            ColorStart := round(center - MaxColor);
                            ColorEnd := round(center + MaxColor);
                        end;
                    if ColorEnd < 0 then
                        ColorEnd := 0;
                    if ColorStart > 255 then
                        ColorStart := 255;
                    UpdateLUT;
                    UpdateMap;
                    ShowLUTValues(ColorStart, ColorEnd);
                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: boolean;
    begin
        with info^ do begin
                LUTMode := CustomGrayscale;
                SetPort(MapWindow);
                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;
                        DrawMap;
                        LoadLUT(cTable);
                    end;
                if not isGrayscaleLut then
                    LutMode := ColorLut;
            end;
    end;


    procedure DisableThresholding;
    begin
        with info^ do
            if thresholding then begin
                    ColorStart := SaveColorStart;
                    ColorEnd := SaveColorEnd;
                    FillColor1 := SaveFill1;
                    FillColor2 := SaveFill2;
                    UpdateLut;
                    UpdateMap;
                    Thresholding := false;
                end;
    end;


    procedure EnableThresholding (level: integer);
    begin
        with info^ do begin
                if thresholding then
                    DisableThresholding;
                SaveColorStart := ColorStart;
                SaveColorEnd := ColorEnd;
                ColorStart := level;
                ColorEnd := level;
                SaveFill1 := FillColor1;
                SaveFill2 := FillColor2;
                FillColor1 := WhiteRGB;
                FillColor2 := BlackRGB;
                UpdateLut;
                UpdateMap;
                Thresholding := true;
                if not macro then
                    SelectLutTool;
            end;
    end;


    procedure ResetMap;
    begin
        with info^ do begin
                ColorStart := 0;
                ColorEnd := 255;
                if Thresholding then begin
                        FillColor1 := SaveFill1;
                        FillColor2 := SaveFill2;
                    end;
                IdentityFunction := LutMode = Grayscale;
                UpdateLUT;
                UpdateMap;
            end;
    end;


    procedure DoMouseDownInMap;
        var
            r: rect;
            x, y, p1Dist, p2Dist: integer;
            mode: (StartPoint, EndPoint, Brightness, AdjustThreshold);
            p: point;
            pressed: boolean;
            x1, y1, x2, y2: integer;
            xintercept: integer;
            deltax, deltay: LongInt;

        procedure DoFixup;
        begin
            with info^ do
                if ((x1 = 0) and (x2 = 0)) or ((x1 = 255) and (x2 = 255)) then begin
                        y1 := 0;
                        y2 := 255;
                    end;
        end;

    begin
        with info^ do begin
                DisableDensitySlice;
                if OptionKeyDown then begin
                        DoFreehandEditing;
                        exit(DoMouseDownInMap);
                    end;
                if LUTMode = CustomGrayscale then
                    ResetGrayMap;
                FindPoints(x1, y1, x2, y2);
                SetPort(MapWindow);
                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);
                                ResetMap;
                                exit(DoMouseDownInMap)
                            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);
                                if Thresholding then
                                    DisableThresholding
                                else
                                    EnableThresholding(128);
                                exit(DoMouseDownInMap)
                            end;
                    end;
                if PtInRect(p, gmSlide1) then
                    AdjustBrightness;
                if PtInRect(p, gmSlide2) then
                    AdjustContrast;
                if p.v > (gmRectBottom + 4) then begin
                        if not thresholding and ((x2 - x1) <= 1) then begin
                                thresholding := true;
                                SaveFill1 := FillColor1;
                                SaveFill2 := FillColor2;
                            end;
                        exit(DoMouseDownInMap);
                    end;
                if LutMode = CustomGrayscale then
                    LutMode := Grayscale;
                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 if thresholding then
                    mode := AdjustThreshold
                else
                    mode := brightness;
                if mode = AdjustThreshold then
                    DrawLabels('Thresh:', '', '')
                else
                    ShowLabels;
                repeat
                    case mode of
                        StartPoint:  begin
                                if thresholding then begin
                                        FillColor1 := SaveFill1;
                                        FillColor2 := SaveFill2;
                                    end;
                                if x > y then
                                    y := 0
                                else
                                    x := 0;
                                x1 := x;
                                if x1 > x2 then
                                    x2 := x1;
                                y1 := y;
                                if y1 > y2 then
                                    y2 := y1;
                                DoFixUp;
                            end;
                        EndPoint:  begin
                                if thresholding then begin
                                        FillColor1 := SaveFill1;
                                        FillColor2 := SaveFill2;
                                    end;
                                if x > y then
                                    x := 255
                                else
                                    y := 255;
                                x2 := x;
                                if x2 < x1 then
                                    x1 := x2;
                                y2 := y;
                                if y2 < y1 then
                                    y1 := y2;
                                DoFixUp;
                            end;
                        Brightness:  begin
                                deltax := x2 - x1;
                                deltay := y2 - y1;
                                if deltax = 0 then begin
                                        x1 := x;
                                        y1 := 0;
                                        x2 := x;
                                        y2 := 255;
                                    end
                                else if deltay = 0 then begin
                                        x1 := 0;
                                        y1 := y;
                                        x2 := 255;
                                        y2 := y;
                                    end
                                else begin
                                        x1 := x - y * deltax div deltay;
                                        xIntercept := x1;
                                        y1 := 0;
                                        if x1 < 0 then begin
                                                y1 := -deltay * x1 div deltaX;
                                                x1 := 0;
                                            end;
                                        y2 := 255;
                                        x2 := 255 * deltax div deltay;
                                        if xIntercept < 0 then
                                            x2 := x2 + xIntercept
                                        else
                                            x2 := x2 + x1;
                                        if x2 > 255 then begin
                                                y2 := 255 - (x2 - 255) * deltay div deltax;
                                                x2 := 255;
                                            end;
                                    end;
                                if x2 < 1 then
                                    x2 := 1;
                                if y2 < 1 then
                                    y2 := 1;
                                if x1 > 254 then
                                    x1 := 254;
                                if y1 > 254 then
                                    y1 := 254;
                            end;
                        AdjustThreshold:  begin
                                x1 := x;
                                y1 := 0;
                                x2 := x;
                                y2 := 255;
                            end;
                    end; {case}
{showmessage(concat(long2str(x1), '  ', long2str(y1), '  ', long2str(x2), '  ', long2str(y2), cr, long2str(ColorStart), '  ', long2str(ColorEnd)));}
                    if y1 = 0 then
                        ColorStart := x1
                    else begin
                            if (y2 > y1) then
                                ColorStart := -LongInt(x2 - x1) * y1 div (y2 - y1)
                            else
                                ColorStart := -MaxColor;
                        end;
                    if y2 = 255 then
                        ColorEnd := x2
                    else begin
                            if (y2 > y1) then
                                ColorEnd := 255 + LongInt(x2 - x1) * (255 - y2) div ((y2 - y1))
                            else
                                ColorEnd := MaxColor;
                        end;
                    UpdateLUT;
                    UpdateMap;
                    if thresholding then
                        Show1Value(ColorStart, NoValue)
                    else
                        ShowLUTValues(ColorStart, ColorEnd);
                    GetMouse(p);
                    ConvertMouseToXY(p, x, y);
                until not Button;
                IdentityFunction := false;
                if not thresholding and ((x2 - x1) <= 1) then begin
                        thresholding := true;
                        SaveFill1 := FillColor1;
                        SaveFill2 := FillColor2;
                    end;
            end; {with info}
    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
                        SetFColor(v);
                        MoveTo(0, v);
                        LineTo(cwidth, v)
                    end;
                for i := 1 to nExtraColors + 2 do begin
                        SetFColor(ExtraColorsEntry[i]);
                        PaintRect(ExtraColorsRect[i]);
                    end;
                TextFont(ApplFont);
                TextSize(9);
                with ExtraColorsRect[1] do
                    MoveTo(left + 3, bottom - 1);
                SetFColor(BlackIndex);
                DrawString('white');
                with ExtraColorsRect[2] do
                    MoveTo(left + 4, bottom - 1);
                InvertRect(ExtraColorsRect[2]);
                DrawString('black');
                InvertRect(ExtraColorsRect[2]);
            end;
        SetPort(tPort);
    end;


    function LoadPP2Palette: boolean;
{Loads COLR resource from PixelPaint 2.0 palette file.}
        var
            i: integer;
            size: LongInt;
            h: Handle;
            PPColorTable: record
                    ctSize: INTEGER;
                    table: array[0..255] of RGBColor;
                end;
    begin
        h := GetResource('COLR', 999);
        size := GetHandleSize(handle(h));
        if (ResError = NoErr) and (size = 1538) then
            with info^ do begin
                    BlockMove(handle(h)^, @PPColorTable, SizeOf(PPColorTable));
                    with PPColorTable do begin
                            for i := 0 to 255 do
                                cTable[i].rgb := table[i];
                        end;
                    LoadLUT(cTable);
                    LutMode := ColorLut;
                    SetupPseudocolor;
                    IdentityFunction := false;
                    LoadPP2Palette := true;
                end
        else
            LoadPP2Palette := false;
        if h <> nil then
            DisposHandle(h);
    end;


    procedure LoadColorTable (theColorTable: CTabHandle);
        const
            ExpectedSize = 2056;
        var
            size: LongInt;
            MyColorTable: record
                    ctSeed: LONGINT;
                    transIndex: INTEGER;
                    ctSize: INTEGER;
                    ctTable: MyCSpecArray;
                end;
    begin
        size := GetHandleSize(handle(theColorTable));
        if size < ExpectedSize then
            exit(LoadColorTable);
        if size > ExpectedSize then
            Size := ExpectedSize;
        BlockMove(handle(theColorTable)^, @MyColorTable, size);
        LoadLUT(MyColorTable.ctTable);
        with info^ do begin
                cTable := MyColorTable.ctTable;
                LutMode := ColorLut;
                IdentityFunction := false;
            end;
        SetupPseudocolor;
    end;


    function LoadCLUTResource;{(id:integer):boolean}
        const
            ExpectedSize = 2056;
        var
            Size: LongInt;
            h: cTabHandle;
    begin
        DisableDensitySlice;
        h := GetCTable(id);
        size := GetHandleSize(handle(h));
        if (ResError <> NoErr) or (size < ExpectedSize) then begin
                LoadCLUTResource := false;
                if id = PixelpaintID then begin
                        if LoadPP2Palette then
                            LoadCLUTResource := true;
                    end;
                if h <> nil then
                    DisposCTable(h);
                exit(LoadCLUTResource)
            end;
        LoadColorTable(h);
        DisposCTable(h);
        LoadCLUTResource := true;
    end;


    procedure GetLookupTable;{(VAR table:LookupTable)}
        var
            i, r, g, b: integer;
            GrayscaleImage: boolean;
    begin
        with info^ do begin
                if DensitySlicing then begin
                        for i := 0 to 255 do
                            if (i >= SliceStart) and (i <= SliceEnd) then begin
                                    if ThresholdToForeground then
                                        table[i] := ForegroundIndex
                                    else
                                        table[i] := i
                                end
                            else begin
                                    if NonThresholdToBackground then
                                        table[i] := BackgroundIndex
                                    else
                                        table[i] := i
                                end;
                        DisableDensitySlice;
                        exit(GetLookupTable);
                    end;
                if (LutMode = GrayScale) or (LutMode = CustomGrayscale) then
                    for i := 0 to 255 do
                        table[i] := 255 - BSR(cTable[i].RGB.red, 8)
                else begin
                        table[0] := 0;
                        for i := 1 to 254 do
                            with cTable[i].RGB do
                                table[i] := 255 - trunc(band(bsr(red, 8), 255) * 0.3 + band(bsr(green, 8), 255) * 0.59 + band(bsr(blue, 8), 255) * 0.11);
                        table[255] := 255;
                    end;
            end; {with}
    end;


    procedure RedrawLUTWindow;
    begin
        LoadLUT(info^.cTable);
        cheight := 256 + (2 + nExtraColors) * ExtraColorsHeight;
        SizeWindow(LUTWindow, cwidth, cheight, true);
    end;


    procedure DrawDensitySlice (OptionKey: boolean);
        var
            i, tRed: integer;
    begin
        with info^ do begin
                if OptionKey then begin
                        UndoLutChange;
                        exit(DrawDensitySlice);
                    end
                else
                    for i := 0 to 255 do
                        if (i >= SliceStart) and (i <= SliceEnd) then
                            cTable[i].rgb := SliceColor
                        else
                            ctable[i].rgb := UndoInfo^.cTable[i].rgb;
                LoadLUT(cTable);
                if ScreenDepth <> 8 then begin
                        if ScreenDepth > 2 then
                            DrawLut;
                        UpdatePicWindow;
                    end;
            end;
    end;


    procedure SelectLutTool;
        var
            tPort: GrafPtr;
    begin
        if (CurrentTool <> LutTool) and (CurrentTool <> Wand) then begin
                GetPort(tPort);
                SetPort(ToolWindow);
                InvalRect(ToolRect[CurrentTool]);
                InvalRect(ToolRect[LutTool]);
                CurrentTool := LutTool;
                isSelectionTool := false;
                SetPort(tPort);
            end;
    end;


    procedure EnableDensitySlice;
    begin
        if not DensitySlicing then begin
                SetupLutUndo;
                DrawDensitySlice(false);
                DensitySlicing := true;
                SelectLUTTool;
            end;
    end;


    procedure DoImportLut (fname: str255; vnum: integer);
        var
            err: OSErr;
            f, i: integer;
            ByteCount: LongInt;
            ImportedLUT: array[1..3] of packed array[0..255] of byte;
    begin
        DisableDensitySlice;
        err := fsopen(fname, vNum, f);
        ByteCount := 768;
        err := fsRead(f, ByteCount, @ImportedLUT);
        if err = NoErr then
            with info^ do begin
                    for i := 0 to 255 do
                        with cTable[i], cTable[i].rgb do begin
                                value := 0;
                                red := bsl(ImportedLUT[1, i], 8);
                                green := bsl(ImportedLUT[2, i], 8);
                                blue := bsl(ImportedLUT[3, i], 8);
                            end;
                    LoadLUT(cTable);
                    SetupPseudocolor;
                    LutMode := PseudoColor;
                    IdentityFunction := false;
                    if isGrayScaleLUT then
                        info^.LutMode := CustomGrayScale;
                    UpdateMap;
                end
        else
            beep;
        err := fsClose(f);
    end;


    procedure OpenOldPalette (fname: str255; RefNum: integer);
{Opens palette files created by versions NIH Image earlier than 1.42.}
        var
            PaletteHeader: ColorArray;
            err, f, ColorWidth: integer;
            size: LongInt;
    begin
        DisableDensitySlice;
        err := fsopen(fname, RefNum, f);
        with info^ do begin
                size := SizeOf(ColorArray);
                err := fsread(f, size, @PaletteHeader);
                nColors := PaletteHeader[0];
                if nColors > MaxPseudocolors then
                    nColors := MaxPseudoColors;
                ColorEnd := 255 - PaletteHeader[1];
                ColorWidth := PaletteHeader[2];
                ColorStart := ColorEnd - nColors * ColorWidth + 1;
                if ColorStart < 0 then
                    ColorStart := 0;
                FillColor1 := BlackRGB;
                FillColor2 := BlackRGB;
                err := fsread(f, size, @RedLut);
                err := fsread(f, size, @GreenLut);
                err := fsread(f, size, @BlueLut);
                LutMode := PseudoColor;
                InvertedColorTable := false;
            end;
        err := fsclose(f);
        UpdateLUT;
    end;


    procedure OpenNewPalette (fname: str255; RefNum: integer);
{Opens palette files created by versions of NIH Image later than 1.41.}
        var
            err, f: integer;
            count: LongInt;
            hdr: PaletteHeader;
    begin
        DisableDensitySlice;
        err := fsopen(fname, RefNum, f);
        with info^ do begin
                count := SizeOf(PaletteHeader);
                err := fsread(f, count, @hdr);
                with hdr do begin
                        nColors := pnColors;
                        if nColors > 256 then
                            nColors := 256;
                        ColorStart := pColorStart;
                        ColorEnd := pColorEnd;
                        FillColor1 := pFill1;
                        FillColor2 := pFill2;
                        InvertedColorTable := false;
                    end;
                count := nColors;
                err := fsread(f, count, @RedLut);
                count := nColors;
                err := fsread(f, count, @GreenLut);
                count := nColors;
                err := fsread(f, count, @BlueLut);
                LutMode := PseudoColor;
            end;
        err := fsclose(f);
        UpdateLUT;
    end;


    procedure OpenColorTable (fname: str255; RefNum: integer);
        var
            err: OSErr;
            f: integer;
            FileSize, count: LongInt;
            id: packed array[1..4] of char;
    begin
        err := fsopen(fname, RefNum, f);
        err := GetEOF(f, FileSize);
        count := SizeOf(id);
        err := fsread(f, count, @id);
        err := fsclose(f);
        if FileSize = 768 then
            DoImportLut(fname, RefNum)
        else if id = 'ICOL' then
            OpenNewPalette(fname, RefNum)
        else
            OpenOldPalette(fname, RefNum);
    end;


    procedure ImportPalette (FileType: OSType; fname: str255; vnum: integer);
        var
            RefNum: integer;
            ok: boolean;
            err: OSErr;
    begin
        err := SetVol(nil, vnum);
        refNum := OpenResFile(fname);
        if RefNum <> -1 then begin
                if FileType = 'CLUT' then
                    ok := LoadClutResource(KlutzID)
                else
                    ok := LoadClutResource(PixelPaintID); {Load PixelPaint or Canvas palette}
                CloseResFile(RefNum);
                if isGrayScaleLUT then begin
                        info^.LutMode := CustomGrayScale;
                        DrawMap;
                    end;
            end;
    end;


    procedure InitPaletteHeader (var hdr: PaletteHeader);
        var
            i: integer;
    begin
        with hdr, info^ do begin
                pID := 'ICOL';
                pVersion := version;
                pnColors := nColors;
                pColorStart := ColorStart;
                pColorEnd := ColorEnd;
                pFill1 := FillColor1;
                pFill2 := FillColor2;
                for i := 1 to 4 do
                    pUnused[i] := 0;
            end;
    end;


    procedure SaveLutResource;
{Saves the current color table as  a CPAL resource}
        var
            id: integer;
            canceled: boolean;
            PalH: handle;
            hdr: PaletteHeader;
            p: ptr;
    begin
        with info^ do begin
                id := GetInt('Resource ID', 1000, canceled);
                if canceled then
                    exit(SaveLutResource);
                PalH := GetResource('CPAL', id);
                if GetHandleSize(PalH) > 0 then begin
                        RmveResource(PalH);
                        DisposHandle(PalH);
                    end;
                InitPaletteHeader(hdr);
                PalH := NewHandle(SizeOF(PaletteHeader) + nColors * 3);
                p := PalH^;
                BlockMove(@hdr, p, SizeOf(PaletteHeader));
                p := ptr(ord4(p) + SizeOf(PaletteHeader));
                BlockMove(@RedLut, p, nColors);
                p := ptr(ord4(p) + nColors);
                BlockMove(@GreenLut, p, nColors);
                p := ptr(ord4(p) + nColors);
                BlockMove(@BlueLut, p, nColors);
                AddResource(PalH, 'CPAL', id, '');
                WriteResource(PalH);
                if ResError <> NoErr then
                    SysBeep(1);
                DisposHandle(PalH);
            end;
    end;


    procedure GetLutResource (id: integer);
        var
            LutH: handle;
            hdr: PaletteHEader;
            p: ptr;
    begin
        with info^ do begin
                LutH := GetResource('CPAL', id);
                if (ResError <> noErr) or (LutH = nil) then begin
                        beep;
                        if LutH <> nil then
                            ReleaseResource(LutH);
                        exit(GetLutResource)
                    end;
                p := LutH^;
                BlockMove(p, @hdr, SizeOf(PaletteHeader));
                with hdr do begin
                        if pID <> 'ICOL' then begin
                                beep;
                                ReleaseResource(LutH);
                                exit(GetLutResource);
    $0004, {  move.l 4(a6),d0}
    $5380,       {  subq.l #1,d0}
    $4281,       {  clr.l d1}
    $1210,       {L move.b (a0),d1}
    $10F1, $1000, {  move.b 0(a1,d1.w),(a0)+}
    $51C8, $FFF8, {  dbra d0,L}
    $4CDF, $0303, {  movem.l (sp)+,a0-a1/d0-d1}
    $4E5E,       {  unlk a6}
    $DEFC, $000C; {  add.w #12,sp}


procedure PutLineUsingMask (h, v, count: integer; var line: LineType);
    var
        aLine, MaskLine: LineType;
        i: integer;
        SaveInfo: InfoPtr;
begin
    if count > MaxLine then
        count := MaxLine;
    GetLine(h, v, count, aline);
    SaveInfo := Info;
    Info := UndoInfo;
    GetLine(h, v, count, MaskLine);
    for i := 0 to count - 1 do
        if MaskLine[i] = BlackIndex then
            aLine[i] := line[i];
    info := SaveInfo;
    PutLine(h, v, count, aLine);
end;


procedure ApplyTable; {(var table: LookupTable)}
    var
        width, NumberOfLines, i, hloc, vloc: integer;
        offset: LongInt;
        p: ptr;
        UseMask: boolean;
        TempLine: LineType;
        AutoSelectAll: boolean;
begin
    if NotInBounds then
        exit(ApplyTable);
    AutoSelectAll := not Info^.RoiShowing;
    if AutoSelectAll then
        SelectAll(false);
    if TooWide then
        exit(ApplyTable);
    ShowWatch;
    with info^.RoiRect, info^ do begin
            if RoiType <> RectRoi then
                UseMask := SetupMask
            else
                UseMask := false;
            SetupUndoFromClip;
            WhatToUndo := UndoTransform;
            offset := LongInt(top) * BytesPerRow + left;
            if UseMask then
                p := @TempLine
            else
                p := ptr(ord4(PicBaseAddr) + offset);
            width := right - left;
            NumberOfLines := bottom - top;
            hloc := left;
            vloc := top;
        end;
    if width > 0 then
        for i := 1 to NumberOfLines do
            if UseMask then begin
                    GetLine(hloc, vloc, width, TempLine);
                    ApplyTableToLine(p, table, width);
                    PutLineUsingMask(hloc, vloc, width, TempLine);
                    vloc := vloc + 1
                end
            else begin
                    ApplyTableToLine(p, table, width);
                    p := ptr(ord4(p) + info^.BytesPerRow);
                end;
    with info^ do begin
            UpdateScreen(RoiRect);
            Info^.changes := true;
        end;
    SetupRoiRect;
    if AutoSelectAll then
        KillRoi;
end;


procedure FixColors;
    {Because NIH Image always sets LUT entries 0 and 255 to white and black respectively we need to map}
    {pixels with values of 0 or 255 to the nearest matching color in the other 254  LUT entries.}
    var
        i, index2, match0, match255: integer;
        table: LookupTable;

    procedure BestMatch (index1: integer; var match: integer);
        var
            i: integer;
            rdiff, gdiff, bdiff: LongInt;
            diff, mindiff: extended;
    begin
        match := index1;
        mindiff := 10e10;
        if index1 = 0 then
            index2 := 1
        else
            index2 := 254;
        with info^ do
            for i := 1 to 254 do begin
                    rdiff := bsr(cTable[index1].rgb.red, 8) - bsr(cTable[index2].rgb.red, 8);
                    gdiff := bsr(cTable[index1].rgb.green, 8) - bsr(cTable[index2].rgb.green, 8);
                    bdiff := bsr(cTable[index1].rgb.blue, 8) - bsr(cTable[index2].rgb.blue, 8);
                    diff := sqrt(sqr(rdiff) + sqr(gdiff) + sqr(bdiff));
                    if diff < mindiff then begin
                            match := index2;
                            mindiff := diff;
                        end;
                    if index1 = 0 then
                        index2 := index2 + 1
                    else
                        index2 := index2 - 1;
                end;
    end;

begin
    BestMatch(0, match0);
    BestMatch(255, match255);
    table[0] := match0;
    for i := 1 to 254 do
        table[i] := i;
    table[255] := match255;
    ApplyTable(table);
end;


end.