unit Functions;

{}

interface


	uses
		QuickDraw, Palettes, Picker, PrintTraps, globals, Utilities, Graphics, File1, File2, Analysis, Camera;


	procedure ApplyTable (var table: LookupTable);
	procedure ApplyLookupTable;
	procedure MakeBinary;
	procedure Filter (ftype: FilterType; pass: integer; var table: FateTable);
	procedure PhotoMode;
	function AllSameSize: boolean;
	procedure Animate;
	procedure EnhanceContrast;
	procedure EqualizeHistogram;
	procedure SortPalette (item: integer);
	procedure Convolve (name: str255; RefNum: integer);
	procedure Do3DPlot;
	procedure MakeSkeleton;
	procedure DoErosion;
	procedure DoDilation;
	procedure DoOpening;
	procedure DoClosing;
	procedure SetIterations;
	procedure ChangeValues (v1, v2, v3: integer);
	procedure DoPropagate (MenuItem: integer);
	procedure DoArithmetic (MenuItem: integer; constant: extended);


implementation

	const
		MaxW = 4000;

	type
		ktype = array[0..MaxW] of integer;

	var
		PixelsRemoved: LongInt;

	procedure ApplyTableToLine (data: ptr; var table: LookupTable; width: LongInt);
{$IFC false}
		type
			lptr = ^LineType;
		var
			line: lptr;
			i: integer;
	begin
		line := lptr(data);
		for i := 0 to width - 1 do
			Line^[i] := table[Line^[i]];
	end;
{$ENDC}

{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}


procedure PutLineUsingMask (h, v, count: integer; var line: LineType);
	var
		aLine, MaskLine: LineType;
		i: integer;
		SaveInfo: InfoPtr;
begin
	if count > MaxPixelsPerLine then
		count := MaxPixelsPerLine;
	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);
	StopDigitizing;
	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;
			WhatToUndo := UndoTransform;
			SetupUndoFromClip;
			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;


function DoApplyTableDialogBox: boolean;
	const
		Button1 = 3;
		Button2 = 4;
		Button3 = 5;
		Button4 = 6;
	var
		mylog: DialogPtr;
		item: integer;
		SaveA, SaveB: boolean;

	procedure SetButtons;
	begin
		SetDialogItem(mylog, Button1, ord(ThresholdToForeground));
		SetDialogItem(mylog, Button2, ord(not ThresholdToForeground));
		SetDialogItem(mylog, Button3, ord(NonThresholdToBackground));
		SetDialogItem(mylog, Button4, ord(not NonThresholdToBackground));
	end;

begin
	InitCursor;
	SaveA := ThresholdToForeground;
	SaveB := NonThresholdToBackground;
	mylog := GetNewDialog(40, nil, pointer(-1));
	SetButtons;
	OutlineButton(MyLog, ok, 16);
	repeat
		ModalDialog(nil, item);
		if (item = Button1) or (item = button2) then begin
				ThresholdToForeground := not ThresholdToForeground;
				SetButtons;
			end;
		if (item = Button3) or (item = button4) then begin
				NonThresholdToBackground := not NonThresholdToBackground;
				SetButtons;
			end;
	until (item = ok) or (item = cancel);
	DisposDialog(mylog);
	if item = cancel then begin
			ThresholdToForeground := SaveA;
			NonThresholdToBackground := SaveB;
			DoApplyTableDialogBox := false
		end
	else
		DoApplyTableDialogBox := true;
end;


procedure ApplyLookupTable;
	var
		table: LookupTable;
		ConvertingColorPic, GrayScaleImage: boolean;
begin
	with info^ do begin
			GrayScaleImage := (LUTMode = Grayscale) or (LUTMode = CustomGrayscale);
			ConvertingColorPic := not GrayScaleImage and not DensitySlicing;
			if ConvertingColorPic then
				KillRoi;
			if DensitySlicing and (not macro) then begin
					if not DoApplyTableDialogBox then
						exit(ApplyLookupTable);
				end;
			if thresholding then
				BinaryPic := true;
			GetLookupTable(table);
			if GrayscaleImage or ConvertingColorPic then
				ResetGrayMap;
			ApplyTable(table);
			if ConvertingColorPic then
				WhatToUndo := NothingToUndo;
		end; {with}
end;


procedure MakeBinary;
	var
		table: LookupTable;
		SaveBackground, SaveForeground: integer;
begin
	if not DensitySlicing and not Thresholding then
		PutMessage('Sorry, but you must be thresholding or density slicing to use Make Binary.')
	else begin
			ThresholdToForeground := true;
			NonThresholdToBackground := true;
			SaveBackground := BackgroundIndex;
			SaveForeground := ForegroundIndex;
			BackgroundIndex := WhiteIndex;
			ForegroundIndex := BlackIndex;
			GetLookupTable(table);
			ResetGrayMap;
			ApplyTable(table);
			BackgroundIndex := SaveBackground;
			ForegroundIndex := SaveForeground;
			info^.BinaryPic := true;
		end;
end;


procedure Filter (ftype: FilterType; pass: integer; var table: FateTable);
	const
		PixelsPerUpdate = 5000;
	var
		row, width, r1, r2, r3, c, value, error, sum, center: integer;
		tmp, mark, NewMark, LinesPerUpdate, LineCount: integer;
		t1, t2, t3, t4: integer;
		MaskRect, frame, trect: rect;
		L1, L2, L3, result: LineType;
		pt: point;
		a: SortArray;
		AutoSelectAll, UseMask: boolean;
		L, T, R, B, index: integer;
		StartTicks: LongInt;
begin
	if NotinBounds then
		exit(Filter);
	StopDigitizing;
	AutoSelectAll := not Info^.RoiShowing;
	if AutoSelectAll then
		with info^ do begin
				SelectAll(false);
				SetPort(wptr);
				PenNormal;
				PenPat(pat[PatIndex]);
				FrameRect(wrect);
			end;
	if TooWide then
		exit(Filter);
	ShowWatch;
	if info^.RoiType <> RectRoi then
		UseMask := SetupMask
	else
		UseMask := false;
	WhatToUndo := UndoFilter;
	if pass = 0 then begin
			SetupUndoFromClip;
			ShowMessage('Command-Period to cancel');
		end;
	frame := info^.RoiRect;
	StartTicks := TickCount;
	with frame, Info^ do begin
			changes := true;
			RoiShowing := false;
			if left > 0 then
				left := left - 1;
			if right < PicRect.right then
				right := right + 1;
			width := right - left;
			LinesPerUpdate := PixelsPerUpdate div width;
			if ftype = ReduceNoise then
				LinesPerUpdate := LinesPerUpdate div 3;
			GetLine(left, top, width, L2);
			GetLine(left, top + 1, width, L3);
			Mark := RoiRect.top;
			LineCount := 0;
			for row := top + 1 to bottom - 1 do begin
       {Move Convolution Window Down}
					BlockMove(@L2, @L1, width);
					BlockMove(@L3, @L2, width);
					GetLine(left, row + 1, width, L3);
       {Process One Row}
					case ftype of
						EdgeDetect: 
							for c := 1 to width - 2 do begin
									t1 := L1[c] + L1[c + 1] + L1[c + 2] - L3[c] - L3[c + 1] - L3[c + 2];
									t1 := abs(t1);
									t2 := L1[c + 2] + L2[c + 2] + L3[c + 2] - L1[c] - L2[c] - L3[c];
									t2 := abs(t2);
									if t1 > t2 then
										tmp := t1
									else
										tmp := t2;
									if OptionKeyWasDown then begin
											if tmp > 255 then
												tmp := 255;
											if tmp < 0 then
												tmp := 0;
										end
									else if tmp > 35 then
										tmp := 255
									else
										tmp := 0;
									result[c - 1] := tmp;
								end;
						ReduceNoise:  {Median Filter}
							for c := 1 to width - 2 do begin
									a[1] := L1[c];
									a[2] := L1[c + 1];
									a[3] := L1[c + 2];
									a[4] := L2[c];
									a[5] := L2[c + 1];
									a[6] := L2[c + 2];
									a[7] := L3[c];
									a[8] := L3[c + 1];
									a[9] := L3[c + 2];
									result[c - 1] := FindMedian(a);
								end;
						Dither:  {Floyd-Steinberg Algorithm}
							for c := 1 to width - 2 do begin
									value := L2[c + 1];
									if value < 128 then begin
											result[c - 1] := 0;
											error := -value;
										end
									else begin
											result[c - 1] := 255;
											error := 255 - value
										end;
									tmp := L2[c + 2];              {A}
									tmp := tmp - (7 * error) div 16;
									if tmp < 0 then
										tmp := 0;
									if tmp > 255 then
										tmp := 255;
									L2[c + 2] := tmp;
									tmp := L3[c + 2];              {B}
									tmp := tmp - error div 16;
									if tmp < 0 then
										tmp := 0;
									if tmp > 255 then
										tmp := 255;
									L3[c + 2] := tmp;
									tmp := L3[c + 1];              {C}
									tmp := tmp - (5 * error) div 16;
									if tmp < 0 then
										tmp := 0;
									if tmp > 255 then
										tmp := 255;
									L3[c + 1] := tmp;
									tmp := L3[c];                {D}
									tmp := tmp - (3 * error) div 16;
									if tmp < 0 then
										tmp := 0;
									if tmp > 255 then
										tmp := 255;
									L3[c] := tmp;
								end;
						UnweightedAvg: 
							for c := 1 to width - 2 do begin
									tmp := (L1[c] + L1[c + 1] + L1[c + 2] + L2[c] + L2[c + 1] + L2[c + 2] + L3[c] + L3[c + 1] + L3[c + 2]) div 9;
									if tmp > 255 then
										tmp := 255;
									if tmp < 0 then
										tmp := 0;
									result[c - 1] := tmp;
								end;
						WeightedAvg: 
							for c := 1 to width - 2 do begin
									tmp := (L1[c] + L1[c + 1] + L1[c + 2] + L2[c] + L2[c + 1] * 4 + L2[c + 2] + L3[c] + L3[c + 1] + L3[c + 2]) div 12;
									if tmp > 255 then
										tmp := 255;
									if tmp < 0 then
										tmp := 0;
									result[c - 1] := tmp;
								end;
						fsharpen: 
							for c := 1 to width - 2 do begin
									if OptionKeyWasDown then
										tmp := L2[c + 1] * 9 - L1[c] - L1[c + 1] - L1[c + 2] - L2[c] - L2[c + 2] - L3[c] - L3[c + 1] - L3[c + 2]
									else begin
											tmp := L2[c + 1] * 12 - L1[c] - L1[c + 1] - L1[c + 2] - L2[c] - L2[c + 2] - L3[c] - L3[c + 1] - L3[c + 2];
											tmp := tmp div 4;
										end;
									if tmp > 255 then
										tmp := 255;
									if tmp < 0 then
										tmp := 0;
									result[c - 1] := tmp;
								end;
						fshadow: 
							for c := 1 to width - 2 do begin
									tmp := L2[C + 1] + L2[C + 2] + L3[C + 1] + L3[C + 2] * 2 - L1[C] * 2 - L1[C + 1] - L2[C];
									if tmp > 255 then
										tmp := 255;
									if tmp < 0 then
										tmp := 0;
									result[c - 1] := tmp;
								end;
						Erosion: 
							for c := 1 to width - 2 do begin
									center := L2[c + 1];
									if center = BlackIndex then begin
											sum := L1[c] + L1[c + 1] + L1[c + 2] + L2[c] + L2[c + 2] + L3[c] + L3[c + 1] + L3[c + 2];
											if sum < 1275 then
												center := WhiteIndex;
										end;
									result[c - 1] := center;
								end;
						Dilation: 
							for c := 1 to width - 2 do begin
									center := L2[c + 1];
									if center = WhiteIndex then begin
											sum := L1[c] + L1[c + 1] + L1[c + 2] + L2[c] + L2[c + 2] + L3[c] + L3[c + 1] + L3[c + 2];
											if sum > 765 then
												center := BlackIndex;
										end;
									result[c - 1] := center;
								end;
						OutlineFilter: 
							for c := 1 to width - 2 do begin
									center := L2[c + 1];
									if center = BlackIndex then begin
											if (L2[c] = WhiteIndex) or (L1[c + 1] = WhiteIndex) or (L2[c + 2] = WhiteIndex) or (L3[c + 1] = WhiteIndex) then
												center := BlackIndex
											else
												center := WhiteIndex;
										end;
									result[c - 1] := center;
								end;

						Skeletonize: 
							for c := 1 to width - 2 do begin
									center := L2[c + 1];
									if center = BlackIndex then begin
											index := 0;
											if L1[c] = BlackIndex then
												index := bor(index, 1);
											if L1[c + 1] = BlackIndex then
												index := bor(index, 2);
											if L1[c + 2] = BlackIndex then
												index := bor(index, 4);
											if L2[c + 2] = BlackIndex then
												index := bor(index, 8);
											if L3[c + 2] = BlackIndex then
												index := bor(index, 16);
											if L3[c + 1] = BlackIndex then
												index := bor(index, 32);
											if L3[c] = BlackIndex then
												index := bor(index, 64);
											if L2[c] = BlackIndex then
												index := bor(index, 128);
											if odd(pass) then begin
													if table[index] = 2 then begin
															center := WhiteIndex;
															PixelsRemoved := PixelsRemoved + 1;
														end;
												end
											else begin
													if table[index] = 1 then begin
															center := WhiteIndex;
															PixelsRemoved := PixelsRemoved + 1;
														end;
												end;
										end; {if}
									result[c - 1] := center;
								end; {for}
					end; {case}
					if UseMask then
						PutLineUsingMask(left + 2, row, width - 3, result)
					else
						PutLine(left + 2, row, width - 3, result);
					LineCount := LineCount + 1;
					if LineCount = LinesPerUpdate then begin
							pt.h := RoiRect.left;
							pt.v := row + 1;
							NewMark := pt.v;
							with RoiRect do
								SetRect(MaskRect, left, mark, right, NewMark);
							UpdateScreen(MaskRect);
							LineCount := 0;
							Mark := NewMark;
							if magnification > 1.0 then
								Mark := Mark - 1;
							if CommandPeriod then begin
									UpdatePicWindow;
									beep;
									PixelsRemoved := 0;
									if AutoSelectAll then
										KillRoi;
									exit(filter)
								end;
						end;
				end; {for row:=...}
			trect := frame;
			InsetRect(trect, 1, 1);
			ShowTime(StartTicks, trect);
		end; {with}
	if LineCount > 0 then begin
			with frame do
				SetRect(MaskRect, left, mark, right, bottom);
			UpdateScreen(MaskRect)
		end;
	SetupRoiRect;
	if AutoSelectAll then
		KillRoi;
end;


procedure PhotoMode;
{Erases the screen to the background color and then redraws}
{the contents of the active image window . }
	var
		tPort: GrafPtr;
		event: EventRecord;
		WinRect: rect;
		SaveVisRgn: rgnHandle;
begin
	if info <> NoInfo then
		with info^ do begin
				KillRoi;
				if OptionKeyWasDown then begin {Move window up to top of screen.}
						GetWindowRect(wptr, WinRect);
						MoveWindow(wptr, WinRect.left, 0, false);
					end;
				with wptr^ do begin
						SaveVisRgn := visRgn;
						visRgn := NewRgn;
						RectRgn(visRgn, ScreenBits.Bounds);
					end;
				FlushEvents(EveryEvent, 0);
				GetPort(tPort);
				EraseScreen;
				UpdatePicWindow;
				repeat
				until WaitNextEvent(mDownMask + KeyDownMask, Event, 5, nil);
				with wptr^ do begin
						DisposeRgn(visRgn);
						visRgn := SaveVisRgn;
					end;
				RestoreScreen;
				SetPort(tPort);
				FlushEvents(EveryEvent, 0);
				if OptionKeyWasDown then begin
						MoveWindow(wptr, WinRect.left, WinRect.top, false);
					end;
			end
	else
		beep;
end;


function AllSameSize: boolean;
{Returns true if all currently open Images have the same dimensions.}
	var
		i: integer;
		SameSize: Boolean;
		TempInfo: InfoPtr;
begin
	if nPics = 0 then begin
			AllSameSize := false;
			exit(AllSameSize);
		end;
	SameSize := true;
	for i := 2 to nPics do begin
			TempInfo := pointer(WindowPeek(PicWindow[i])^.RefCon);
			SameSize := SameSize and EqualRect(Info^.PicRect, TempInfo^.PicRect);
		end;
	AllSameSize := SameSize;
end;


procedure Animate;
	var
		TempInfo: InfoPtr;
		n, SaveN, last, DelayTicks: integer;
		tPort: GrafPtr;
		Event: EventRecord;
		ch: char;
		b: boolean;
		SourceRect, DestRect: rect;
		SingleStep, GoForward, NewKeyDown, SameSize, UseWholeScreen: boolean;
		SaveLUTMode: LUTModeType;
		SaveVisRgn: RgnHandle;
		nFrames, StartTicks: LongInt;
begin
	if nPics < 2 then begin
			PutMessage('There must be at least two image windows open in order to do animation.');
			exit(Animate)
		end;
	KillRoi;
	SameSize := AllSameSize;
	SaveLutMode := info^.LutMode;
	last := nPics;
	SaveN := -1;
	getPort(tPort);
	UseWholeScreen := OptionkeyWasDown or not SameSize;
	if UseWholeScreen then
		EraseScreen
	else begin
			ShowWatch;
			ShowMessage(concat('Use 1...9 keys to control speed', cr, 'Use arrow keys to single step', cr, 'Press mouse button to stop'));
		end;
	FlushEvents(EveryEvent, 0);
	DelayTicks := 0;
	n := 1;
	GoForward := true;
	SingleStep := false;
	if UseWholeScreen then
		with info^ do begin
				SetPort(wptr);
				with wptr^ do begin
						SaveVisRgn := visRgn;
						visRgn := NewRgn;
						RectRgn(visRgn, ScreenBits.Bounds);
					end;
			end;
	nFrames := 0;
	StartTicks := TickCount;
	repeat
		b := WaitNextEvent(EveryEvent, Event, 0, nil);
		NewKeyDown := (event.what = KeyDown) or (event.what = AutoKey);
		if NewKeyDown then begin
				Ch := chr(BitAnd(Event.message, 127));
				SingleStep := false;
				case ord(ch) of
					28: 
						begin
							SingleStep := true;
							GoForward := false;
							n := n - 1;
							if n < 1 then
								n := 1;
							DelayTicks := 0
						end; {left}
					29: 
						begin
							SingleStep := true;
							GoForward := true;
							n := n + 1;
							if n > last then
								n := last;
							DelayTicks := 0
						end;  {right}
					57: 
						DelayTicks := 0;  {9}
					56: 
						DelayTicks := 1;  {8}
					55: 
						DelayTicks := 3;  {7}
					54: 
						DelayTicks := 5;  {6}
					53: 
						DelayTicks := 8;  {5}
					52: 
						DelayTicks := 12; {4}
					51: 
						DelayTicks := 18; {3}
					50: 
						DelayTicks := 30; {2}
					49: 
						DelayTicks := 60; {1}
					otherwise
						;
				end;
			end;
		if DelayTicks <> 0 then
			delay(DelayTicks, ticks);
		if GoForward then begin
				if not SingleStep then
					n := n + 1;
				if n > last then begin
						if ShowReversingMovies then begin
								n := last - 1;
								GoForward := false;
							end
						else
							n := 1;
					end;
			end
		else begin
				if not SingleStep then
					n := n - 1;
				if n < 1 then begin
						if ShowReversingMovies then begin
								n := 2;
								Goforward := true;
							end
						else
							n := last;
					end;
			end;
		TempInfo := pointer(WindowPeek(PicWindow[n])^.RefCon);
		with TempInfo^ do begin
				if not SameSize then
					if (LutMode <> SaveLutMode) or (LutMode = Custom) or (LutMode = CustomGrayscale) or SingleStep then
						LoadLut(cTable);
				SaveLutMode := LutMode;
				with TempInfo^ do begin
						if UseWholeScreen then begin
								SourceRect := SrcRect;
								DestRect := wrect;
							end
						else
							with Info^ do begin
									SourceRect := SrcRect;
									DestRect := wrect;
								end;
						hlock(handle(osPort^.portPixMap));
						hlock(handle(CGrafPort(wptr^).PortPixMap));
						CopyBits(BitMapHandle(osPort^.portPixMap)^^, BitMapHandle(CGrafPort(info^.wptr^).PortPixMap)^^, SourceRect, DestRect, SrcCopy, nil);
						hunlock(handle(osPort^.portPixMap));
						hunlock(handle(CGrafPort(wptr^).PortPixMap));
						nFrames := nFrames + 1;
					end;
				if SingleStep then
					if (not UseWholeScreen) and (n <> SaveN) then begin
							SetWTitle(info^.wptr, title);
							SaveN := n;
						end;
			end; {with}
	until event.what = MouseDown;
{SelectWindow(PicWindow[n]);}
	if UseWholeScreen then begin
			RestoreScreen;
			with info^.wptr^ do begin
					DisposeRgn(visRgn);
					visRgn := SaveVisRgn;
				end;
		end;
	SetPort(tPort);
	ShowFrameRate('', StartTicks, nFrames);
	UpdatePicWindow;
	ShowCursor;
	FlushEvents(EveryEvent, 0);
	if not UseWholeScreen then
		ShowMagnification;
end;


procedure EnhanceContrast;
	var
		AutoSelectAll: boolean;
		min, max, i, threshold: integer;
		found: boolean;
		sum: LongInt;
begin
	with info^ do
		if (LUTMode <> GrayScale) and (LUTMode <> CustomGrayscale) then begin
				PutMessage('Sorry, but you can only contrast enhance grayscale images.');
				exit(EnhanceContrast)
			end;
	if NotInBounds or (ClipBuf = nil) then
		exit(EnhanceContrast);
	StopDigitizing;
	AutoSelectAll := not Info^.RoiShowing;
	if AutoSelectAll then
		SelectAll(false);
	if info^.RoiType = RectRoi then
		GetRectHistogram
	else
		GetNonRectHistogram;
	sum := 0;
	for i := 0 to 255 do
		sum := sum + histogram[i];
	threshold := sum div 5000;
	i := -1;
	repeat
		i := i + 1;
		found := histogram[i] > threshold;
	until found or (i = 255);
	min := i;
	i := 256;
	repeat
		i := i - 1;
		found := histogram[i] > threshold;
	until found or (i = 0);
	max := i;
	if max > min then
		with info^ do begin
				p1x := 255 - max;
				p1y := 0;
				p2x := 255 - min;
				p2y := 255;
				SetGrayScaleLUT;
				DrawGrayMap;
				WhatToUndo := UndoContrastEnhancement;
			end;
	info^.changes := true;
	IdentityFunction := false;
	if AutoSelectAll then
		KillRoi;
end;


procedure EqualizeHistogram;
	var
		AutoSelectAll: boolean;
		i, sum, v: integer;
		isum: LongInt;
		ScaleFactor: extended;
begin
	with info^ do
		if (LUTMode <> GrayScale) and (LutMode <> CustomGrayscale) then begin
				PutMessage('Sorry, but you can only do histogram equalization on grayscale images.');
				exit(EqualizeHistogram)
			end;
	if NotInBounds or (ClipBuf = nil) then
		exit(EqualizeHistogram);
	StopDigitizing;
	AutoSelectAll := not Info^.RoiShowing;
	if AutoSelectAll then
		SelectAll(false);
	if info^.RoiType = RectRoi then
		GetRectHistogram
	else
		GetNonRectHistogram;
	FindThresholdingMode;
	ComputeResults;
	isum := 0;
	for i := 0 to 255 do
		isum := isum + histogram[i];
	ScaleFactor := 255.0 / isum;
	sum := 0;
	with info^ do begin
			for i := 255 downto 0 do
				with cTable[i].rgb do begin
						sum := round(sum + histogram[i] * ScaleFactor);
						if sum > 255 then
							sum := 255;
						v := sum * 256;
						red := v;
						green := v;
						blue := v;
					end;
			LoadLUT(cTable);
			LUTMode := CustomGrayscale;
			changes := true;
		end;
	DrawGrayMap;
	WhatToUndo := UndoEqualization;
	IdentityFunction := false;
	if AutoSelectAll then
		KillRoi;
end;


procedure SortPalette (item: integer);
	type
		MyHSVColor = record
				lHue, lSaturation, lValue: LongInt;
			end;
		HSVRec = record
				index: integer;
				hsv: MyHSVColor;
			end;
		HSVArrayType = array[0..255] of HSVRec;
	var
		TempTable: MyCSpecArray;
		i: integer;
		HSVArray: HSVArrayType;
		h, s, v: LongInt;
		fHue, fSaturation, fValue: fixed;
		TempHSV: HSVColor;
		table: LookupTable;

	procedure SortByHue;
     {Selection sort routine from "Algorithms" by Robert Sedgewick.}
		var
			i, j, min: integer;
			t: HSVRec;
	begin
		for i := 2 to 254 do begin
				min := i;
				for j := i + 1 to 245 do
					if HSVArray[j].hsv.lHue < HSVArray[min].hsv.lHue then
						min := j;
				t := HSVArray[min];
				HSVArray[min] := HSVArray[i];
				HSVArray[i] := t;
			end;
	end;

	procedure SortBySaturation;
		var
			i, j, min: integer;
			t: HSVRec;
	begin
		for i := 2 to 254 do begin
				min := i;
				for j := i + 1 to 245 do
					if HSVArray[j].hsv.lSaturation < HSVArray[min].hsv.lSaturation then
						min := j;
				t := HSVArray[min];
				HSVArray[min] := HSVArray[i];
				HSVArray[i] := t;
			end;
	end;

	procedure SortByValue;
		var
			i, j, min: integer;
			t: HSVRec;
	begin
		for i := 2 to 254 do begin
				min := i;
				for j := i + 1 to 245 do
					if HSVArray[j].hsv.lValue < HSVArray[min].hsv.lValue then
						min := j;
				t := HSVArray[min];
				HSVArray[min] := HSVArray[i];
				HSVArray[i] := t;
			end;
	end;

begin
	ShowWatch;
	DisableDensitySlice;
	with info^ do begin
			for i := 1 to 254 do begin
					HSVArray[i].index := i;
					rgb2hsv(cTable[i].rgb, TempHSV);
					with TempHSV do begin
							fHue := SmallFract2Fix(hue);
							fSaturation := SmallFract2Fix(saturation);
							fValue := SmallFract2Fix(value);
						end;
					with HSVArray[i].hsv do begin
							lHue := LongInt(band(fHue, $ffff));
							lSaturation := LongInt(band(fSaturation, $ffff));
							lValue := LongInt(band(fValue, $ffff));
						end;
				end;
			case item of
				byHueItem: 
					SortByHue;
				bySaturationItem: 
					SortBySaturation;
				byBrightnessItem: 
					SortByValue;
			end;
			for i := 1 to 254 do begin
					with HSVArray[i].hsv do begin
							TempHSV.hue := Fix2SmallFract(fixed(lHue));
							TempHSV.saturation := Fix2SmallFract(fixed(lSaturation));
							TempHSV.value := Fix2SmallFract(fixed(lValue));
						end;
					hsv2rgb(TempHSV, cTable[i].rgb);
				end;
			LoadLUT(cTable);
			if info <> NoInfo then begin
					table[0] := 0;
					table[255] := 255;
					for i := 1 to 254 do
						table[HSVArray[i].index] := i;
					ApplyTable(table);
				end;
			WhatToUndo := NothingToUndo;
			if LutMode = AppleDefault then
				LutMode := custom;
		end; {with}
end;


procedure GetKernel (var kernel: ktype; var n: integer; var name: str255; RefNum: integer);
	var
		rLine: rLineType;
		i, count, nValues, nRows: integer;
begin
	count := 0;
	nRows := 0;
	InitTextInput(name, RefNum);
	while not TextEof and (nRows <= 63) do begin
			GetLineFromText(rLine, nValues);
			if count <> 0 then
				nRows := nRows + 1;
			if nRows = 1 then
				n := nValues;
			for i := 1 to nValues do begin
					count := count + 1;
					kernel[count - 1] := round(rLine[i]);
				end;
		end;
	if count <> (n * n) then
		n := 0;
end;


procedure DoOnePixel (nLess1, BytesPerLine: integer; corner: LongInt; var sum: LongInt; var kernel: ktype);
{$IFC false}
	var
		row, column, k: integer;
		pp: ptr;
begin
	k := 0;
	sum := 0;
	for row := 0 to nless1 do begin
			corner := corner + BytesPerLine;
			pp := ptr(corner);
			for column := 0 to nless1 do begin
					sum := sum + band(pp^, 255) * kernel[k];
					k := k + 1;
					pp := ptr(ord(pp) + 1);
				end;
		end;
end;
{$ENDC}

{a0=^corner/^sum}
{a1=^kernel}
{a2=^pixels}

{d0=n-1}
{d1=BytesPerLine}
{d2=sum}
{d3=n-1(outer loop)}
{d4=n-1(inner loop)}
{d5=temp}

inline
	$4E56, $0000, {  link	a6,#0}
	$48E7, $FCE0,  {  movem.l	a0-a2/d0-d5,-(sp)}
	$4280,              {  clr.l	d0}
	$302E, $0012, {  move.w	18(a6),d0}
	$4281,              {  clr.l	d1}
	$322E, $0010, {  move.w	16(a6),d1}
	$206E, $000C, {  movea.l	12(a6),a0}
	$226E, $0004, {  movea.l	4(a6),a1}

	$4282,             {  clr.l	d2}
	$2600,             {  move.l	d0,d3}

	$D1C1,             {A adda.l	d1,a0}
	$2448,            {  move.l	a0,a2}
	$2800,            {  move.l	d0,d4}
	$4285,            {B clr.l	d5                   (2)}
	$1A1A,             {  move.b	(a2)+,d5    (6) }
	$CBD9,             {  muls	(a1)+,d5     (29!)}
	$D485,             {  add.l	d5,d2          (2)}
	$51CC, $FFF6, {  dbra	d4,B                (6)}
	$51CB, $FFEC, {  dbra	d3,A}

	$206E, $0008, {  move.l	8(a6),a0}
	$2082,              {  move.l	d2,(a0)}
	$4CDF, $073F, {  movem.l	(sp)+,a0-a2/d0-d5}
	$4E5E,              {  unlk	a6}
	$DEFC, $0010; {  add.w	#16,sp}



procedure DoConvolution (var kernel: ktype; n: integer);
	var
		row, width, column, value, error: integer;
		margin, i, nless1: integer;
		frame, MaskRect, tRect: rect;
		AutoSelectAll: boolean;
		SrcCenter, DstCenter, sum, max, offset, wsum, cscale, StartTicks: LongInt;
		p: ptr;
		str, str2: str255;
begin
	if NotinBounds or NotRectangular then
		exit(DoConvolution);
	StopDigitizing;
	AutoSelectAll := not Info^.RoiShowing;
	if AutoSelectAll then
		SelectAll(false);
	SetupUndoFromClip;
	WhatToUndo := UndoFilter;
	frame := info^.RoiRect;
	with frame, Info^ do begin
			if ((LutMode = GrayScale) or (LutMode = CustomGrayscale)) and (not IdentityFunction) then
				ApplyLookupTable;
			changes := true;
			margin := n div 2;
			if left < margin then
				left := left + margin;
			if right > (PicRect.right - margin) then
				right := right - margin;
			if top < margin then
				top := top + margin;
			if bottom > (PicRect.bottom - margin) then
				bottom := bottom - margin;
			SetPort(wptr);
			PenNormal;
			PenPat(pat[PatIndex]);
			tRect := frame;
			OffscreenToScreenRect(tRect);
			FrameRect(tRect);
			width := right - left;
			max := n * n - 1;
			wsum := 0;
			for i := 0 to max do
				wsum := wsum + kernel[i];
			NumToString(n, str);
			NumToString(wsum, str2);
			ResultsMessage := Concat(str, ' x ', str, ' kernel', cr, 'sum = ', str2, cr, cr, 'Command-Period to cancel');
			ShowResults;
			if wsum <> 0 then
				cscale := wsum
			else
				cscale := 1;
			offset := -(n div 2) * BytesPerRow - BytesPerRow - n div 2;
			nless1 := n - 1;
			StartTicks := TickCount;
			for row := top to bottom - 1 do begin
					SrcCenter := ord4(ClipBufInfo^.PicBaseAddr) + LongInt(row) * BytesPerRow + left;
					DstCenter := ord4(PicBaseAddr) + LongInt(row) * BytesPerRow + left;
					for column := left to left + width - 1 do begin
							DoOnePixel(nless1, BytesPerRow, SrcCenter + offset, sum, kernel);
							value := sum div cscale;
							if value > 255 then
								value := 255;
							if value < 0 then
								value := 0;
							p := ptr(DstCenter);
							p^ := BAND(value, 255);
							SrcCenter := SrcCenter + 1;
							DstCenter := DstCenter + 1;
						end; {for column:=}
					SetRect(MaskRect, left, row, right, row + 1);
					UpdateScreen(MaskRect);
					if CommandPeriod then begin
							UpdatePicWindow;
							beep;
							exit(DoConvolution)
						end;
				end; {for row:=...}
			ShowTime(StartTicks, frame);
		end; {with}
	UpdatePicWindow;
	SetupRoiRect;
	if AutoSelectAll then
		KillRoi;
end;


procedure Convolve (name: str255; RefNum: integer);
	var
		kernel: ktype;
		n, count: integer;
begin
	if name = '' then begin
			if not OpenTextFile(name, RefNum) then
				exit(convolve)
			else
				KernelsRefNum := RefNum;
		end;
	GetKernel(kernel, n, name, RefNum);
	count := n * n;
	UpdatePicWindow;
	if (n >= 3) and (n <= 63) then
		DoConvolution(kernel, n)
	else
		PutMessage('Kernels must be n x n square matrices with 3 <= n <= 63.');
end;


procedure Do3DPlot;
	var
		hend, vend, h, v, DataWidth, DataHeight, i: integer;
		htemp, vtemp, ivalue: integer;
		skip, DataLeft, DataRight, DataTop, DataBottom: integer;
		hLoc, vLoc, hMin, hMax, vMin, vMax, MinIValue, MaxIValue: integer;
		hstart, vstart, dh, dv, hbase, vbase, vscale, nPlotLines, CalValue: extended;
		peak, MaxPeak, hinc, vinc, nLines, MinCValue, MaxCValue: extended;
		tPort: GrafPtr;
		poly: PolyHandle;
		SaveInfo, PlotInfo: InfoPtr;
		aLine: LineType;
		MaskRect: rect;
		AutoSelectAll, ApplyLUT: boolean;
		table: LookupTable;
		StartTicks: LongInt;

	procedure FindVinc;
	begin
		with PlotInfo^.PicRect do begin
				vstart := 5.0 + MaxPeak - dv * DataWidth;
				skip := round(DataHeight / ((bottom - vstart - 5.0) / vinc));
				if skip = 0 then
					skip := 1;
				nPlotLines := DataHeight / skip;
				vinc := (bottom - vstart - 5.0) / nPlotLines;
				vinc := vinc / 0.95;
				repeat
					vinc := vinc * 0.95;
					hinc := vinc / 2.0;
				until (5.0 + hinc * nPlotLines + dh * DataWidth) < right;
			end;
	end;

begin
	if NotRectangular or NotInBounds then
		exit(Do3DPlot);
	StopDigitizing;
	DisableDensitySlice;
	SetForegroundColor(BlackIndex);
	SetBackgroundColor(WhiteIndex);
	SaveInfo := Info;
	if not NewPicWindow('3D Plot', NewPicWidth, NewPicHeight) then begin
			KillRoi;
			exit(Do3DPlot)
		end;
	PlotInfo := info;
	info := SaveInfo;
	AutoSelectAll := not Info^.RoiShowing;
	ShowWatch;
	if AutoSelectAll then
		SelectAll(true);
	if TooWide then
		exit(Do3DPlot);
	with info^ do
		ApplyLUT := ((LutMode = GrayScale) or (LutMode = CustomGrayscale)) and (not IdentityFunction);
	if ApplyLUT then
		GetLookupTable(table);
	Measure;
	UndoLastMeasurement(true);
	with results do begin
			MinIValue := MinIndex;
			MaxIValue := MaxIndex;
		end;
	if ApplyLut then begin
			MinIvalue := table[MinIValue];
			MaxIvalue := table[MaxIValue];
		end;
	MinCValue := 10e100;
	MaxCValue := -10e100;
	for i := MinIValue to MaxIValue do begin
			ivalue := i;
			if ApplyLUT then
				ivalue := table[ivalue];
			calValue := cvalue[i];
			if calValue < minCValue then
				minCValue := calValue;
			if calValue > maxCValue then
				maxCValue := calValue;
		end;
	WhatToUndo := NothingToUndo;
	with results do
		if (MaxValue - MinValue) <> 0.0 then
			vscale := (255.0 / (MaxValue - MinValue)) * 0.5
		else
			vscale := 0.5;
	with info^.RoiRect do begin
			DataLeft := left;
			DataRight := right;
			DataTop := top;
			DataBottom := bottom;
			DataWidth := DataRight - DataLeft;
			DataHeight := DataBottom - DataTop;
		end;
	dh := (0.65 * PlotInfo^.PicRect.right) / DataWidth;
	dv := -0.4 * dh;
	hstart := 5.0;
	vinc := 2.0;
	MaxPeak := (MaxCValue - MinCValue) * vscale * 0.5;
	FindVinc; {First estimate}
	MaxPeak := MaxPeak * 2.0;
	hmin := DataRight + round(MaxPeak / dv);
	if hmin < 0 then
		hmin := 0;
	vmax := DataTop + round(MaxPeak / vinc);
	if vmax > DataBottom then
		vmax := DataBottom;
	MaxPeak := 0.0;
	vloc := DataTop;
	skip := 3;
	repeat
		repeat
			ivalue := MyGetPixel(hloc, vloc);
			if ApplyLUT then
				ivalue := table[ivalue];
			calValue := cvalue[ivalue];
			peak := (calValue - MinCValue) * vscale + (DataRight - hloc) * dv - (vloc - DataTop) * vinc;
			if peak > MaxPeak then
				MaxPeak := peak;
			hloc := hloc + skip;
		until hloc > DataRight;
		vloc := vloc + skip;
	until vloc > vmax;
	FindVinc;
	v := DataTop;
	StartTicks := TickCount;
	GetPort(tPort);
	SetPort(GrafPtr(PlotInfo^.osPort));
	PenNormal;
	repeat
		hmax := 0;
		vmin := 9999;
		poly := OpenPoly;
		hbase := hstart;
		vbase := vstart;
		Info := SaveInfo;
		GetLine(DataLeft, v, DataWidth, aLine);
		info := PlotInfo;
		if ApplyLUT then
			ApplyTableToLine(@aLine, table, DataWidth);
		MoveTo(round(hbase), round(vbase - vscale * (cvalue[aLine[0]] - MinCValue)));
		for i := 0 to DataWidth - 1 do begin
				hbase := hbase + dh;
				vbase := vbase + dv;
				hLoc := round(hbase);
				vLoc := round(vbase - vscale * (cvalue[aLine[i]] - MinCValue));
				LineTo(hloc, vloc);
				if hloc > hmax then
					hmax := hloc;
				if vloc < vmin then
					vmin := vloc;
			end;
		LineTo(round(hbase), round(vbase));
		LineTo(round(hstart), round(vstart));
		LineTo(round(hstart), round(vstart - vscale * (cvalue[aLine[0]] - MinCValue)));
		hmin := round(hstart);
		vmax := round(vstart);
		ClosePoly;
		ErasePoly(poly);
		FramePoly(poly);
		KillPoly(poly);
		SetRect(MaskRect, hmin, vmin, hmax, vmax);
		UpdateScreen(MaskRect);
		hstart := hstart + hinc;
		vstart := vstart + vinc;
		v := v + skip;
	until (v >= DataBottom) or CommandPeriod;
	ShowTime(StartTicks, SaveInfo^.RoiRect);
	if CommandPeriod then
		beep;
	info^.changes := true;
	SetPort(tPort);
end;


procedure MakeSkeleton;
	const
		s999 = '01234567890123456789012345678901';
		s000 = '00020012000020220000000010001011';
		s032 = '00000000000010002000000010001011';
		s064 = '00000000000000000000000000000000';
		s096 = '10000000100010001000000010001010';
		s128 = '02020002000000020000000000000002';
		s160 = '02000000000000001100000000000000';
		s192 = '12220002000000020000000000000000';
		s224 = '1202002210001000120200001100100';
	var
		table: FateTable;
		s: str255;
		i, pass: integer;
begin
	s := concat(s000, s032, s064, s096, s128, s160, s192, s224);
	for i := 0 to 254 do
		table[i] := ord(s[i + 1]) - ord('0');
	table[255] := 0;
	pass := 0;
	repeat
		PixelsRemoved := 0;
		filter(skeletonize, pass, table);
		pass := pass + 1;
		if not CommandPeriod then
			filter(skeletonize, pass, table);
		pass := pass + 1;
	until (PixelsRemoved = 0) or CommandPeriod;
end;

procedure DoErosion;
	var
		i: integer;
		t: FateTable;
begin
	for i := 0 to BinaryIterations - 1 do begin
			filter(Erosion, i, t);
			if CommandPeriod then
				leave;
		end;
end;


procedure DoDilation;
	var
		i: integer;
		t: FateTable;
begin
	for i := 0 to BinaryIterations - 1 do begin
			filter(Dilation, i, t);
			if CommandPeriod then
				leave;
		end;
end;


procedure DoOpening;
	var
		i: integer;
		t: FateTable;
begin
	for i := 0 to BinaryIterations - 1 do begin
			filter(Erosion, i, t);
			if CommandPeriod then
				exit(DoOpening);
		end;
	for i := 0 to BinaryIterations - 1 do begin
			filter(Dilation, i + BinaryIterations, t);
			if CommandPeriod then
				exit(DoOpening);
		end;
end;

procedure DoClosing;
	var
		i: integer;
		t: FateTable;
begin
	for i := 0 to BinaryIterations - 1 do begin
			filter(Dilation, i, t);
			if CommandPeriod then
				exit(DoClosing);
		end;
	for i := 0 to BinaryIterations - 1 do begin
			filter(Erosion, i + BinaryIterations, t);
			if CommandPeriod then
				exit(DoClosing);
		end;
end;

procedure SetIterations;
	var
		TempIterations: integer;
begin
	TempIterations := GetInt('Number of Iterations:', BinaryIterations);
	if (TempIterations >= 1) and (TempIterations < 100) then
		BinaryIterations := TempIterations
	else
		beep;
end;

procedure ChangeValues (v1, v2, v3: integer);
  {Changes all pixels in the current selection with a value in the range v1 to v2 to a value of v3.}
	var
		id, i, value: integer;
		table: LookupTable;
begin
	if macro then
		id := ok
	else begin
			ParamText(long2str(v1), long2str(v3), '', '');
			id := alert(700, nil);
		end;
	if id = ok then begin
			for i := 0 to 255 do begin
					value := i;
					if (value >= v1) and (value <= v2) then
						value := v3;
					table[i] := value;
				end;
			ApplyTable(table);
		end;
end;

procedure DoPropagate (MenuItem: integer);
      {Copies the current Look-Up Table to all open windows.}
	var
		TempInfo: InfoPtr;
		i: integer;

	procedure CopyLUTInfo;
	begin
		with info^ do begin
				TempInfo^.RedX := RedX;
				TempInfo^.GreenX := GreenX;
				TempInfo^.BlueX := BlueX;
				TempInfo^.ColorStart := ColorStart;
				TempInfo^.ColorWidth := ColorWidth;
				TempInfo^.nColors := nColors;
				TempInfo^.LutMode := LUTMode;
				TempInfo^.cTable := cTable;
				TempInfo^.p1x := p1x;
				TempInfo^.p1y := p1y;
				TempInfo^.p2x := p2x;
				TempInfo^.p2y := p2y;
				TempInfo^.DeltaX := DeltaX;
				TempInfo^.DeltaY := DeltaY;
			end;
	end;

	procedure CopySpatialCalibration;
	begin
		with info^ do begin
				TempInfo^.SpatialScale := SpatialScale;
				TempInfo^.RawspatialScale := RawspatialScale;
				TempInfo^.ScaleMagnification := ScaleMagnification;
				TempInfo^.Units := Units;
				TempInfo^.UnitsID := UnitsID;
				TempInfo^.FullUnits := FullUnits;
				TempInfo^.changes := true;
			end;
	end;

	procedure CopyDensityCalibration;
	begin
		with info^ do begin
				TempInfo^.calibrated := calibrated;
				TempInfo^.fit := fit;
				TempInfo^.nCoefficients := nCoefficients;
				TempInfo^.Coefficient := Coefficient;
				TempInfo^.UnitOfMeasure := UnitOfMeasure;
				TempInfo^.calibrated := true;
				TempInfo^.changes := true;
			end;
	end;

begin
	for i := 1 to nPics do begin
			TempInfo := pointer(WindowPeek(PicWindow[i])^.RefCon);
			case MenuItem of
				1: 
					CopyLUTInfo;
				2: 
					CopySpatialCalibration;
				3: 
					CopyDensityCalibration;
			end; {case}
		end;
	WhatToUndo := NothingToUndo;
end;

procedure DoArithmetic (MenuItem: integer; constant: extended);
	var
		table: LookupTable;
		i, tmp: integer;
		LogScale: extended;
begin
	if not macro then
		case menuItem of
			AddItem: 
				constant := GetReal('Constant to add:', 25);
			SubtractItem: 
				constant := GetReal('Constant to subtract:', 25);
			MultiplyItem: 
				begin
					constant := GetReal('Constant to multiply by:', 1.25);
					if constant < 0.0 then begin
							PutMessage('Constant must be positive.');
							exit(DoArithmetic);
						end;
				end;
			DivideItem: 
				begin
					constant := GetReal('Constant to divide by:', 1.25);
					if constant <= 0.0 then begin
							PutMessage('Constant must be nonzero and positive.');
							exit(DoArithmetic);
						end;
				end;
			LogItem: 
				begin
					constant := 0.0;
					LogScale := 255.0 / ln(255.0);
				end;
		end; {case}
	if constant = BadReal then
		exit(DoArithmetic); {cancel}
	for i := 0 to 255 do begin
			case MenuItem of
				AddItem: 
					tmp := round(i + constant);
				SubtractItem: 
					tmp := round(i - constant);
				MultiplyItem: 
					tmp := round(i * constant);
				DivideItem: 
					tmp := round(i / constant);
				LogItem: 
					if i = 0 then
						tmp := 0
					else
						tmp := round(ln(i) * LogScale);
			end;
			if tmp < 0 then
				tmp := 0;
			if tmp > 255 then
				tmp := 255;
			table[i] := tmp;
		end;
	ApplyTable(table);
end;


end.