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

interface

	uses
		Memory, QuickDraw, Packages, Menus, Events, Fonts, Scrap, ToolUtils, {}
		Resources, Palettes, Printing, ColorPicker, {}
		VDigitizerDefs, VDigitizerM, 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 := 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(band(RedLUT[index],255), 8);
									Green := bsl(band(GreenLUT[index],255), 8);
									Blue := bsl(band(BlueLUT[index],255), 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.0) * range)
						else
							NewMin := CurrentMin;
						DrawLong(NewMin);
						DrawString('    ');
						MoveTo(xValueLoc, InfoVStart + 10);
						if tStart > 0 then
							NewMax := CurrentMax - round((tStart / 255.0) * range)
						else
							NewMax := CurrentMax;
						DrawLong(NewMax);
						DrawString('    ');
						SetPort(tPort);
						exit(ShowLUTValues);
					end;
				if fit <> uncalibrated 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 fit <> uncalibrated 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^.fit <> uncalibrated 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
			PutError('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(Geneva);
		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);
						if ScreenDepth <> 8 then UpdatePicWindow;
					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 not thresholding then begin
				SaveColorStart := ColorStart;
				SaveColorEnd := ColorEnd;
				SaveFill1 := FillColor1;
				SaveFill2 := FillColor2;
			end;
			ColorStart := level;
			ColorEnd := level;
			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, width: 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), crStr, long2str(ColorStart), '  ', long2str(ColorEnd)));}
					width := x2 - x1;
					if y1 = 0 then
						ColorStart := x1
					else begin
							if (y2 > y1) then
								ColorStart := -width * y1 div (y2 - y1)
							else
								ColorStart := -MaxColor;
						end;
					if y2 = 255 then
						ColorEnd := x2
					else begin
							if (y2 > y1) then
								ColorEnd := 255 + width * (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(Geneva);
				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
			DisposeHandle(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
					DisposeCTable(h);
				exit(LoadCLUTResource)
			end;
		LoadColorTable(h);
		DisposeCTable(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,j,tRed: 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(band(ImportedLUT[1, i],255), 8);
								green := bsl(band(ImportedLUT[2, i],255), 8);
								blue := bsl(band(ImportedLUT[3, i],255), 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
						RemoveResource(PalH);
						DisposeHandle(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);
				DisposeHandle(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);
							end;
						nColors := pnColors;
						if nColors > 256 then
							nColors := 256;
						ColorStart := pColorStart;
						ColorEnd := pColorEnd;
						FillColor1 := pFill1;
						FillColor2 := pFill2;
						InvertedColorTable := false;
					end;
				p := ptr(ord4(p) + SizeOf(PaletteHeader));
				BlockMove(p, @RedLut, nColors);
				p := ptr(ord4(p) + nColors);
				BlockMove(p, @GreenLut, nColors);
				p := ptr(ord4(p) + nColors);
				BlockMove(p, @BlueLut, nColors);
				ReleaseResource(LutH);
			end;
	end;


	procedure DrawScale;
		var
			hloc, vloc, width, height, SaveForeground, LUTStart, LutEnd, LUTWidth: integer;
			SaveGDevice: GDHandle;
	begin
		if NoSelection or NotRectangular then
			exit(DrawScale);
		ShowWatch;
		with info^.RoiRect, info^ do begin
				width := right - left;
				height := bottom - top;
				if (width = 0) or (height = 0) then
					exit(DrawScale);
				SaveGDevice := GetGDevice;
				SetGDevice(osGDevice);
				SetPort(GrafPtr(osPort));
				PenNormal;
				SetupUndoFromClip;
				SetupUndo;
				WhatToUndo := UndoEdit;
				SaveForeground := ForegroundIndex;
				LUTStart := ColorStart;
				if LutStart <= 0 then
					LutStart := 1;
				LutEnd := ColorEnd;
				if LutEnd >= 255 then
					LutEnd := 254;
				LUTWidth := LutEnd - LutStart + 1;
				if width >= height then
					for hloc := left to right - 1 do begin
							SetForegroundColor(trunc(((hloc - left) / width) * LUTWidth) + LUTStart);
							MoveTo(hloc, top);
							LineTo(hloc, Bottom - 1);
						end
				else
					for vloc := top to bottom - 1 do begin
							SetForegroundColor(trunc(((vloc - top) / height) * LUTWidth) + LUTStart);
							MoveTo(left, vloc);
							LineTo(right - 1, vloc);
						end;
				SetForegroundColor(SaveForeground);
				changes := true;
			end;
		SetupRoiRect;
		SetGDevice(SaveGDevice);
	end;


	procedure MakeSpectrum;
  {Generates the "Spectrum" color table.}
		const
			Sat = -1;
			Val = -1;
		var
			i: integer;
			color: HSVColor;
	begin
		with info^ do begin
				for i := 0 to 255 do begin
						color.hue := i * 256;
						color.saturation := sat;
						color.value := val;
						HSV2RGB(color, ctable[i].rgb);
					end;
				LutMode := ColorLut;
				IdentityFunction := false;
				SetupPseudocolor;
			end;
	end;


	function GetColorTableItem (ctab: ColorTableType): integer;
	begin
		case ctab of
			AppleDefault: 
				GetColorTableItem := SystemPaletteItem;
			Pseudo20: 
				GetColorTableItem := Pseudo20Item;
			Pseudo32: 
				GetColorTableItem := Pseudo32Item;
			Rainbow: 
				GetColorTableItem := RainbowItem;
			Fire1: 
				GetColorTableItem := Fire1Item;
			Fire2: 
				GetColorTableItem := Fire2Item;
			Ice: 
				GetColorTableItem := IceItem;
			Grays: 
				GetColorTableItem := GraysItem;
			Spectrum: 
				GetColorTableItem := SpectrumItem;
			otherwise
				GetColorTableItem := Pseudo20Item;
		end;
	end;


	procedure SwitchColorTables (item: integer; update: boolean);
		var
			ok: boolean;
	begin
		DisableDensitySlice;
		if update then
			SetupLutUndo;
		with info^ do begin
				case item of
					SystemPaletteItem:  begin
							ok := LoadCLUTResource(AppleDefaultCLUT);
							ColorTable := AppleDefault;
						end;
					Pseudo20Item:  begin
							GetLutResource(Pseudo20ID);
							ColorTable := Pseudo20;
						end;
					Pseudo32Item:  begin
							GetLutResource(Pseudo32ID);
							ColorTable := Pseudo32;
						end;
					RainbowItem:  begin
							GetLutResource(RainbowID);
							ColorTable := Rainbow;
						end;
					Fire1Item:  begin
							GetLutResource(Fire1ID);
							ColorTable := Fire1;
						end;
					Fire2Item:  begin
							GetLutResource(Fire2ID);
							ColorTable := Fire2;
						end;
					IceItem:  begin
							GetLutResource(IceID);
							ColorTable := Ice;
						end;
					GraysItem:  begin
							GetLutResource(GraysID);
							ColorTable := Grays;
						end;
					SpectrumItem: 
						if ControlKeyDown and OptionKeyDown and ShiftKeyDown then
							SaveLutResource
						else begin
								MakeSpectrum;
								ColorTable := Spectrum;
							end;
				end; {case}
				LutMode := Pseudocolor;
				if update then begin
						UpdateLUT;
						UpdateMap;
					end;
			end;
	end;


	procedure SetNumberOfColors (n: integer);
		var
			i, r, g, b, index: integer;
			eIndex, inc, fraction: extended;
			SaveRed, SaveGreen, SaveBlue: LutArray;
	begin
		with info^ do begin
				SaveRed := RedLUT;
				SaveGreen := GreenLUT;
				SaveBlue := BlueLUT;
				eIndex := 0.0;
				inc := (nColors - 1) / (n - 1);
				for i := 0 to n - 1 do begin
						index := trunc(eIndex);
						if index >= (nColors - 1) then begin
								RedLUT[i] := SaveRed[index];
								GreenLUT[i] := SaveGreen[index];
								BlueLUT[i] := SaveBlue[index]
							end
						else begin
								fraction := eIndex - index;
								RedLUT[i] := round(SaveRed[index] * (1.0 - fraction) + SaveRed[index + 1] * fraction);
								GreenLUT[i] := round(SaveGreen[index] * (1.0 - fraction) + SaveGreen[index + 1] * fraction);
								BlueLUT[i] := round(SaveBlue[index] * (1.0 - fraction) + SaveBlue[index + 1] * fraction);
							end;
						eIndex := eIndex + inc;
					end;
				nColors := n;
				LutMode := PseudoColor;
				ColorTable := CustomTable;
				UpdateLUT;
				UpdateMap;
			end;
	end;


	procedure SetNumberOfExtraColors;
		var
			n: integer;
			Canceled: boolean;
	begin
		n := GetInt('Number of Extra Colors(0..6):', nExtraColors, Canceled);
		if (n <= 6) and (n >= 0) and not Canceled then begin
				nExtraColors := n;
				RedrawLUTWindow;
				SelectWindow(LUTWindow);
				if info <> NoInfo then
					SelectWindow(info^.wptr);
			end
		else if not Canceled then
			beep;
	end;


	procedure DoLutOptions;
		const
			nColorsID = 7;
			nExtraColorsID = 8;
			InvertID = 9;
		var
			mylog: DialogPtr;
			item, i, n, nExtra: integer;
			InvertLut: boolean;
	begin
		with info^ do begin
				InitCursor;
				mylog := GetNewDialog(210, nil, pointer(-1));
				n := nColors;
				SetDNum(MyLog, nColorsID, n);
				nExtra := nExtraColors;
				SetDNum(MyLog, nExtraColorsID, nExtra);
				InvertLut := false;
				SetDlogItem(mylog, InvertID, ord(InvertLut));
				repeat
					ModalDialog(nil, item);
					if item = nColorsID then
						n := GetDNum(MyLog, nColorsID);
					if item = nExtraColorsID then
						nExtra := GetDNum(MyLog, nExtraColorsID);
					if item = InvertID then begin
							InvertLut := not InvertLut;
							SetDlogItem(mylog, InvertID, ord(InvertLut));
						end;
				until (item = ok) or (item = cancel);
				DisposeDialog(mylog);
				if item = cancel then
					exit(DoLutOptions);
				DisableDensitySlice;
				SetupLutUndo;
				if n < 1 then
					n := 1;
				if n > 256 then
					n := 256;
				if n <> nColors then
					SetNumberOfColors(n);
				if (nExtra <> nExtraColors) and (nExtra >= 0) and (nExtra <= 6) then begin
						nExtraColors := nExtra;
						RedrawLUTWindow;
						SelectWindow(LUTWindow);
						if info <> NoInfo then
							SelectWindow(info^.wptr);
					end;
				if InvertLut then begin
						InvertPalette;
						UpdateLut;
					end;
			end; {with info}
	end;


	function SetupMask: boolean;
{Creates a mask in the undo buffer for operating}
{on non-rectangular selections .}
		var
			tPort: GrafPtr;
			SaveInfo: InfoPtr;
			SaveGDevice: GDHandle;
	begin
		if NoUndo then begin
				SetupMask := false;
				exit(SetupMask)
			end;
		SetupUndoInfoRec;
		SaveInfo := Info;
		Info := UndoInfo;
		SaveGDevice := GetGDevice;
		SetGDevice(osGDevice);
		GetPort(tPort);
		with Info^ do begin
				SetPort(GrafPtr(osPort));
				pmForeColor(BlackIndex);
				pmBackColor(WhiteIndex);
				PenNormal;
				EraseRect(RoiRect);
				PaintRgn(roiRgn);
			end;
		SetPort(tPort);
		SetGDevice(SaveGDevice);
		Info := SaveInfo;
		SetupMask := true;
	end;

	procedure ApplyTableToLine (data: ptr; var table: LookupTable; width: LongInt);
{$IFC PowerPC}
	var
		line: LinePtr;
		i: integer;
	begin
		line := LinePtr(data);
		for i := 0 to width - 1 do
			Line^[i] := table[band(Line^[i],255)];
	end;
{$ELSEC}

{a0 = data}
{a1 = lookup table}
{d0 = width }
{d1 = pixel value}
inline
	$4E56, $0000, {  link a6,#0}
	$48E7, $C0C0, {  movem.l a0-a1/d0-d1,-(sp)}
	$206E, $000C, {  move.l 12(a6),a0}
	$226E, $0008, {  move.l 8(a6),a1}
	$202E, $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}
{$ENDC}


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 := 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, match0, match255: integer;
		table: LookupTable;

	procedure BestMatch (index1: integer; var match: integer);
		var
			i, index2: integer;
			rdiff, gdiff, bdiff, r1, g1, b1: LongInt;
			diff, mindiff: extended;
	begin
		match := index1;
		mindiff := 10e10;
		if index1 = 0 then
			index2 := 1
		else
			index2 := 254;
		with info^ do begin
			r1:=band(bsr(cTable[index1].rgb.red, 8),255);
			g1:=band(bsr(cTable[index1].rgb.green, 8),255);
			b1:=band(bsr(cTable[index1].rgb.blue, 8),255);
			for i := 1 to 254 do begin
					rdiff := r1 - band(bsr(cTable[index2].rgb.red, 8),255);
					gdiff := g1 - band(bsr(cTable[index2].rgb.green, 8),255);
					bdiff := b1 - band(bsr(cTable[index2].rgb.blue, 8),255);
					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; {for}
		end; {with}
	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.