unit User;

{This module is a good place to put user additions to NIH Image. You will need }
{to uncomment the call to InitUser in Image.p.}


interface

	uses
		Memory, QuickDraw, Packages, Menus, Events, Fonts, Scrap, ToolUtils,Resources, Errors, Palettes, globals, Utilities, Graphics, Filters, Analysis;


	procedure InitUser;
	procedure DoUserCommand1;
	procedure DoUserCommand2;
	procedure DoUserMenuEvent (MenuItem: integer);
	procedure OldUserMacroCode (CodeNumber: integer; Param1, Param2, Param3: extended);
	procedure UserMacroCode (str: str255; Param1, Param2, Param3: extended);


implementation

{User global variables go here.}
	var
		color, MinSpacing: integer;
		SaveInfo: InfoPtr;
		PeakRadius, Peakedness: extended;


	procedure InitUser;
	begin
		UserMenuH := GetMenu(UserMenu);
		InsertMenu(UserMenuH, 0);
		DrawMenuBar;
{Additional user initialization code goes here.}
	end;


	procedure DrawDot (row, column, RowOffset, ColumnOffset: integer; big: boolean);
		var
			h, v: integer;
	begin
		if big then begin
				for h := -1 to 1 do
					for v := -1 to 1 do
						PutPixel(column * 16 + ColumnOffset * 4 + h + 16, row * 16 + RowOffset * 4 + v + 16, color)
			end
		else
			PutPixel(column * 16 + ColumnOffset * 4 + 16, row * 16 + RowOffset * 4 + 16, color);
	end;

	procedure DrawNeighborhood (i, row, column: integer);

	begin
		DrawDot(row, column, 0, 0, BitAnd(i, 1) = 1);
		DrawDot(row, column, 0, 1, BitAnd(i, 2) = 2);
		DrawDot(row, column, 0, 2, BitAnd(i, 4) = 4);
		DrawDot(row, column, 1, 2, BitAnd(i, 8) = 8);
		DrawDot(row, column, 2, 2, BitAnd(i, 16) = 16);
		DrawDot(row, column, 2, 1, BitAnd(i, 32) = 32);
		DrawDot(row, column, 2, 0, BitAnd(i, 64) = 64);
		DrawDot(row, column, 1, 0, BitAnd(i, 128) = 128);
		DrawDot(row, column, 1, 1, true);
	end;


	procedure SetColor (i: integer);
{Color neighborhoods to show which ones would be removed on the first pass(150), second pass(100),}
{or either pass(200) when using the Zhang and Suen thinning algorithm(CACM, Mar. 1984,236-239).}
		var
			p2, p3, p4, p5, p6, p7, p8, p9, A, B: integer;
	begin
		p2 := bsr(band(i, 2), 1);
		p3 := bsr(band(i, 4), 2);
		p4 := bsr(band(i, 8), 3);
		p5 := bsr(band(i, 16), 4);
		p6 := bsr(band(i, 32), 5);
		p7 := bsr(band(i, 64), 6);
		p8 := bsr(band(i, 128), 7);
		p9 := band(i, 1);
		A := 0;
		if (p2 = 0) and (p3 = 1) then
			A := A + 1;
		if (p3 = 0) and (p4 = 1) then
			A := A + 1;
		if (p4 = 0) and (p5 = 1) then
			A := A + 1;
		if (p5 = 0) and (p6 = 1) then
			A := A + 1;
		if (p6 = 0) and (p7 = 1) then
			A := A + 1;
		if (p7 = 0) and (p8 = 1) then
			A := A + 1;
		if (p8 = 0) and (p9 = 1) then
			A := A + 1;
		if (p9 = 0) and (p2 = 1) then
			A := A + 1;
		B := p2 + p3 + p4 + p5 + p6 + p7 + p8 + p9;
		color := 255;
		if A = 1 then
			if (B >= 2) and (B <= 6) then begin
					if ((p2 * p4 * p6 = 0) and (p4 * p6 * p8 = 0)) and ((p2 * p4 * p8 = 0) and (p2 * p6 * p8 = 0)) then
						color := 200
					else if (p2 * p4 * p6 = 0) and (p4 * p6 * p8 = 0) then
						color := 150
					else if (p2 * p4 * p8 = 0) and (p2 * p6 * p8 = 0) then
						color := 100;
				end;
	end;


	procedure DoUserCommand1;
{Generates a table showing all possible 3x3 neighborhoods. This table is used}
{ for making up the "fate table" used by the Skeletonize command and the Wand tool.}
		var
			row, column, index: integer;
	begin
		row := 0;
		column := 0;
		if NewPicWindow('Fate Table', 600, 200) then
			for index := 0 to 255 do begin
					SetColor(index);
					DrawNeighborhood(index, row, column);
					column := column + 1;
					if column = 32 then begin
							row := row + 1;
							column := 0;
						end;
				end;
	end;


	function isPeak (x, y, minValue: LongInt): boolean;
		var
			delta, angle, dx, dy: extended;
			v, i, v2, maxv2, x2, y2, v2count, nSamples: integer;
			sample: LineType;
			minlower, count, nLower, maxCount: integer;
			PeakFound: boolean;
			mask: rect;
	begin
		isPeak := false;
		v := MyGetPixel(x, y);
		if v < minValue then
			exit(isPeak);
		if v <= MyGetPixel(x + 1, y) then
			exit(isPeak);
		if v <= MyGetPixel(x + 1, y + 1) then
			exit(isPeak);
		if v <= MyGetPixel(x, y + 1) then
			exit(isPeak);
		if v <= MyGetPixel(x - 1, y + 1) then
			exit(isPeak);
		if v < MyGetPixel(x - 1, y) then
			exit(isPeak);
		if (v < MyGetPixel(x - 1, y - 1)) then
			exit(isPeak);
		if v < MyGetPixel(x, y - 1) then
			exit(isPeak);
		if v < MyGetPixel(x + 1, y - 1) then
			exit(isPeak);
		nSamples := round(4 * PeakRadius);
		delta := 2.0 * pi / nsamples;
		angle := 0.0;
		maxv2 := round((1.0 - Peakedness) * v);
		for i := 1 to nSamples do begin
				dx := PeakRadius * cos(angle);
				dy := PeakRadius * sin(angle);
				sample[i] := round(GetInterpolatedPixel(x + dx, y + dy));
				angle := angle + delta;
			end;
		minLower := round(0.677 * nsamples);
		PeakFound := false;
		count := 0;
		i := 1;
		nLower := 0;
		maxCount := nSamples + minLower;
		repeat
			if sample[i] <= maxv2 then
				nLower := nLower + 1
			else
				nLower := 0;
			PeakFound := nLower >= minLower;
			i := i + 1;
			if i > nSamples then
				i := 1;
			count := count + 1;
		until PeakFound or (count = maxCount);
		if PeakFound then begin
				info := SaveInfo;
				with info^ do begin
						SetRect(RoiRect, x - MinSpacing + 1, y - MinSpacing + 1, x + MinSpacing, y + MinSpacing);
						with RoiRect do begin
								if left < 0 then
									left := 0;
								if top < 0 then
									top := 0;
								if right > PicRect.right then
									right := PicRect.right;
								if bottom > PicRect.bottom then
									bottom := PicRect.bottom;
							end;
						GetRectHistogram;
						PeakFound := histogram[0] = 0;
					end; {with}
				Info := UndoInfo;
			end;
		isPeak := PeakFound;
	end;


	procedure FindPeaks (minValue, PeakRadiusP, PeakednessP: extended);
		var
			x, y, i, iMinValue: integer;
			AutoSelectAll: boolean;
			srect, mask: rect;
			count: LongInt;
			t: FateTable;
	begin
		if NotRectangular or NotInBounds or NoUndo then
			exit(FindPeaks);
		iMinValue := round(minValue);
		if iMinValue < 10 then
			iMinValue := 10;
		if iMinValue > 150 then
			iMinValue := 150;
		PeakRadius := PeakRadiusP;
		if PeakRadius = 0.0 then
			PeakRadius := 6.0;
		if PeakRadius < 1.0 then
			PeakRadius := 1.0;
		if PeakRadius > 50.0 then
			PeakRadius := 50.0;
		MinSpacing := round(PeakRadius) - 1;
		if MinSpacing < 1 then
			MinSpacing := 1;
		if MinSpacing > 4 then
			MinSpacing := 4;
		Peakedness := PeakednessP;
		if Peakedness = 0.0 then
			Peakedness := 0.2;
		if Peakedness < 0.05 then
			Peakedness := 0.05;
		if Peakedness > 0.95 then
			Peakedness := 0.95;
		AutoSelectAll := not Info^.RoiShowing;
		if AutoSelectAll then
			SelectAll(true);
		ShowWatch;
		SetupUndo;
		WhatToUndo := UndoEdit;
		SetupUndoInfoRec;
		SaveInfo := Info;
		srect := info^.roiRect;
		KillRoi;
		ChangeValues(0, 0, 1);
		info := UndoInfo;
		count := 0;
		with srect do
			for y := top to bottom - 1 do begin
					if CommandPeriod then begin
							beep;
							Info := SaveInfo;
							leave;
						end;
					for x := left to right - 1 do
						if isPeak(x, y, iMinValue) then begin
								count := count + 1;
								Info := SaveInfo;
								PutPixel(x, y, 0);
{PutPixel(x - 1, y, 0);}
{PutPixel(x - 1, y - 1, 0);}
{PutPixel(x, y - 1, 0);}
								SetRect(mask, x - 1, y - 1, x + 1, y + 1);
								UpdateScreen(mask);
								Info := UndoInfo;
								if count < MaxMeasurements then begin
										User1^[count] := x;
										User2^[count] := y;
									end;
								if (y mod 50) = 0 then ShowMessage(concat(long2str(y), '  ', long2str(count)));
							end;
				end;
		Info := SaveInfo;
		if count < MaxMeasurements then begin
				UnsavedResults := false;
				ResetCounter;
				for i := 1 to count do begin
						ClearResults(i);
						xcenter^[i] := User1^[i];
						ycenter^[i] := User2^[i];
					end;
				mCount := count;
				UpdateList;
				ShowInfo;
			end
		else
			PutError('"Max Measurements" is too small.');
		ShowMessage(concat('Count=', long2str(count), crStr, 'Threshold=', long2str(iMinValue)));
	end;



	procedure ComputeBirefringence (scale, offset: extended);
{This an example of how to do image math using a UserCode macro routine.}
{It executes the following formula}

      {SQRT ( ( I1 - I2 ) ^ 2 + ( I3 - I4 ) ^ 2 ) / ( I1 + I2 - I3 + I4 ) ,}

{where I1 , I2 , I3 , I4  are the first four slices of the current stack.}
{The result in the fifth slice of the stack.}

		var
			i1, i2, i3, i4, i5: LineType;
			i, slice, row: integer;
			mask: rect;
			v, min, max: extended;
			minstr, maxstr: str255;
	begin
		with info^ do begin
				if StackInfo = nil then
					exit(ComputeBirefringence);
				if StackInfo^.nSlices <> 5 then
					exit(ComputeBirefringence);
				min := 1.0e12;
				max := -1.0e12;
				for row := 0 to nLines - 1 do begin
						SelectSlice(1);
						GetLine(0, row, PixelsPerLine, i1);
						SelectSlice(2);
						GetLine(0, row, PixelsPerLine, i2);
						SelectSlice(3);
						GetLine(0, row, PixelsPerLine, i3);
						SelectSlice(4);
						GetLine(0, row, PixelsPerLine, i4);
						for i := 0 to PixelsPerLine - 1 do begin
								v := sqrt(sqr(I1[i] - I2[i]) + sqr(I3[i] - I4[i])) / (I1[i] + I2[i] - I3[i] + I4[i]);
								if v < min then
									min := v;
								if v > max then
									max := v;
								if v > 255 then
									v := 255;
								if v < 0 then
									v := 0;
								v := v * scale + offset;
								i5[i] := round(v);
							end;
						SelectSlice(5);
						PutLine(0, row, PixelsPerLine, i5);
						SetRect(mask, 0, row, PixelsPerLine, row + 1);
						UpdateScreen(mask);
						if CommandPeriod then
							leave;
					end;
			end;
		RealToString(min, 1, 4, minstr);
		RealToString(max, 1, 4, maxstr);
		ShowMessage(concat('min=', minstr, crStr, 'max=', maxstr));
	end;


	procedure ShowNoCodeMessage;
	begin
		PutError('Requires user written Pascal routine. ');
	end;


	procedure DoUserCommand2;
	begin
		ShowNoCodeMessage
	end;


	procedure DoUserMenuEvent (MenuItem: integer);
	begin
		case MenuItem of
			1: 
				DoUserCommand1;
			2: 
				DoUserCommand2;
		end;
	end;


	procedure OldUserMacroCode (CodeNumber: integer; Param1, Param2, Param3: extended);
  {Obsolete version kept for backward compatibilty.}
	begin
		case CodeNumber of
			1: 
				ShowNoCodeMessage;
			2: 
				ShowNoCodeMessage;
			3: 
				ShowNoCodeMessage;
			4: 
				ShowNoCodeMessage;
			5: 
				FindPeaks(param1, param2, param3);
			otherwise
				ShowNoCodeMessage;
		end;
	end;


	procedure UserMacroCode (str: str255; Param1, Param2, Param3: extended);
	begin
		MakeLowerCase(str);
		if pos('peaks', str) <> 0 then begin
				FindPeaks(param1, param2, param3);
				exit(UserMacroCode);
			end;
		if pos('birefringence', str) <> 0 then begin
				ComputeBirefringence(param1, param2);
				exit(UserMacroCode);
			end;
		ShowNoCodeMessage;
	end;


end.