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,P_CellList;



	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);

	
	
procedure P_DoObject (event: EventRecord);
procedure ShowPreviousImage;


implementation


function ScreenToPixmapH (hloc: integer): extended;
	begin
		with info^ do
			ScreenToPixmapH := SrcRect.left + hloc / magnification;
	end;

	function ScreenToPixmapV (vloc: integer): extended;
	begin
		with info^ do
			ScreenToPixmapV := SrcRect.top + vloc / magnification;
	end;




{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 Think Pascal routine. ');
	end;


	procedure DoUserCommand2;
	begin
		ShowNoCodeMessage
	end;


	
		procedure DoUserMenuEvent (MenuItem: integer);
	begin
		case MenuItem of
			1: 
				begin
					Createstructures;
					P_CircleMode := true;
					CurrentTool := P_SelectTool;
					P_Mode := P_CreateNewCircle;
				end;
			2: 
				DoUserCommand2;
			{ Code added by PR}

			3: 
				P_SaveNewFile;


			4: 
				begin
					DisposeList;
					ResetInfoHandles;
					P_LoadFromfile;
					P_CircleMode := True;
					CurrentTool := P_SelectTool;
					UpdatePicWindow;
				end;


			6: 
				if P_circleMode then
					begin
						CurrentTool := P_SelectTool;
						P_Mode := P_CreateNewCircle;
						UpdatePicWindow;
					end
				else
					PutMessage('Use New Structures or Load command first');

			7: 
				RatioDialog;
			8: 
				begin
					DeValid;
					UpdatePicWindow;
				end;
			9: 
				if P_CircleMode then
					DuplicatetoNextWindow
				else
					PutMessage('Circle mode off, use New structures or Load command');
			10: 
				UpdatePicWindow;
			11: 
				ComputeAllResults;


			13: 
				begin
					DisposeList;
					ResetInfoHandles;
					P_CircleMode := false;
					CurrentTool := SelectionTool;
				end;

			15: 
				DeleteOneCircle;
			16: 
				DeleteAllInWindow;
			18: 
				EnablePrinting;
			19:
			ShowPreviousImage;	

		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;

	procedure P_DoObject ( event: EventRecord);
		var
			Start, Finish, ScreenStart, ScreenFinish, osStart, osFinish: point;
			r: rect;
			DeltaX, DeltaY, switch: integer;
			Constrain: boolean;
			StartH, StartV, FinishH, FinishV, HelpR: integer;
			SavedFColor: integer;
			isSelected, aFirst: boolean;
	begin
		SetPort(info^.wptr);
		SavedFColor := ForegroundIndex;
		SetColor(SavedFColor);
		DrawLabels('Width:', 'Height:', '');
		start := event.where;
		StartH := round(ScreenToPixmapH(start.h));
		StartV := round(ScreenToPixmapV(start.v));
		osStart := start;
		ScreenToOffscreen(osStart);
		finish := start;
		osFinish := finish;
		ScreenToOffscreen(osFinish);
		Select;
		P_Mode := P_MoveCircle;
		isSelected := ReturnCircle(start);
		if OptionKeyDown then
			P_Mode := P_CreateNewCircle;
		case P_Mode of
			P_CreateNewCircle: 
				begin
					while button do
						begin
							GetMouse(finish);
							with finish, Info^ do
								begin
									if h > wrect.right then
										h := wrect.right;
									if v > wrect.bottom then
										v := wrect.bottom;
									if h < 0 then
										h := 0;
									if v < 0 then
										v := 0;
								end;

							DeltaX := finish.h - start.h;
							DeltaY := finish.v - start.v;

							if ((DeltaX > 0) and (DeltaY < 0)) or ((DeltaX < 0) and (DeltaY > 0)) then
								switch := -1
							else
								switch := 1;
							if abs(DeltaX) > abs(DeltaY) then
								finish.h := start.h + switch * DeltaY
							else
								finish.v := start.v + switch * DeltaX;
							osFinish := finish;
{ScreenToOffscreen(osfinish);}
							PenNormal;
							PenMode(PatXor);
							PenSize(1, 1);
							Pt2Rect(start, finish, r);
							FrameOval(r);
							Show3Values(osfinish.h - osstart.h, osfinish.v - osstart.v, -1);
							Pt2Rect(start, finish, r);

							FrameOval(r);

{FinishH := round(ScreenToPixmapH(finish.h));}
{FinishV := round(ScreenToPixmapV(finish.v));}

{SetRect(P_Rect, StartH, StartV, FinishH, FinishV);}
						end;  {while button}
{FrameOval(P_rect);}

					AppendToList(r);
					select;
				end;
			P_MoveCircle: 
				if isSelected then
					begin
						aFirst := true;
						DrawDescription;
						while button do
							begin
								GetMouse(finish);
{if aFirst then}

{Draw}
{    else}

								DrawCircle;
								aFirst := false;
								with finish, Info^ do
									begin
										if h > wrect.right then
											h := wrect.right;
										if v > wrect.bottom then
											v := wrect.bottom;
										if h < 0 then
											h := 0;
										if v < 0 then
											v := 0;
									end;
								DeltaX := finish.h - start.h;
								DeltaY := finish.v - start.v;

								SetNewLocation(DeltaX, DeltaY);
								DrawCircle;
								start := finish;
							end; {while}
{    DrawDescription;}
						UpdatePicWindow;
					end;

			P_ResizeCircle: 
				begin
					if isSelected then
						begin
							aFirst := true;
							DrawDescription;
							while button do
								begin
									GetMouse(finish);
									DrawCircle;
									aFirst := false;
									with finish, Info^ do
										begin
											if h > wrect.right then
												h := wrect.right;
											if v > wrect.bottom then
												v := wrect.bottom;
											if h < 0 then
												h := 0;
											if v < 0 then
												v := 0;
										end;

									DeltaX := finish.h - start.h;
									DeltaY := finish.v - start.v;

									if ((DeltaX > 0) and (DeltaY < 0)) or ((DeltaX < 0) and (DeltaY > 0)) then
										switch := -1
									else
										switch := 1;
									if abs(DeltaX) > abs(DeltaY) then
										DeltaX := switch * DeltaY
									else
										DeltaY := switch * DeltaX;

									resizeCircle(DeltaX, DeltaY);
									DrawCircle;
									start := finish;

								end;  {while button}
							ResizeCircle(DeltaX, DeltaY);
{DrawCircle;}
{DrawDescription;}
							UpdatePicWindow;
						end;
				end;
		end;{case}

		SetColor(SavedFColor);

	end;
	

procedure ShowPreviousImage;
		var
			n: integer;
	begin
		n := info^.PicNum - 1;
		if n < 1 then
			n := 1;
		SelectWindow(PicWindow[n]);
	end;


end.