unit UMCrest;

{Contributed by Jacques van Helden <jvanheld@dbm.ulb.ac.be>}

{User Macro "CrestPathway" package. }
{Macros which use these extensions should specify "requiresUser('CrestPathway',1)".}

{Code moved from User.p to UMCrest.p by Edward J. Huff huff@mcclb0.med.nyu.edu}
{The original was "User.p (Quantile+Crest)" last modified Mon, Aug 23, 1993, 11:20 AM.}

{These instructions apply if you have received only UMCrest.p and}
{a copy of UMacroDef.p and UMacroRun.p, and want to install the code}
{into your copy of NIH Image.}

{You need the Think Pascal compiler to use this source code. }

{Installation instructions.  At the moment, the UMacroDef.p and UMacroRun.p}
{have not been accepted for distribution with standard Image.  If they are, then}
{these instructions will apply.  Otherwise, you will have to obtain a copy of image}
{with UMacroDef.p etc. already installed.  This will typically be available in}
{the /pub/nih-image/contrib directory of zippy.nimh.nih.gov and the file}
{name will include "UMX".}

{If you have no other user macro extension packages installed,}
{then just replace the default UMacroDef.p and UMacroRun.p with the enclosed}
{versions.  Otherwise, you must merge the changes, which should be found only}
{at well marked places.  Generally, this means simply adding lines, although you }
{may also need to add a comma here and there.  Changes should be found at}
{one place in UMacroDef.p and seven places in UMacroRun.p.}

{You will also have to use the "Project/Add File..." menu item to tell Think Pascal }
{to compile this file, and use the "Windows/Image.proj" item to get the project window, }
{and drag this file from the bottom of the list to somewhere between UMacroDef.p and }
{UMacroRun.p.}

{Finally, recompile and rebuild:  Use "Run/Build" (command B) and }
{"Project/Build Application...".}

interface

	uses
		QuickDraw, Palettes, PrintTraps, Globals, Utilities, Graphics, UMacroDef;

	procedure UMCrestInit;
	procedure UMCrestFinal;
	procedure UMCrestAdd;
	procedure UMCrestLookup (var uma: UserMacroArgs);
	procedure UMCrestRun (var uma: UserMacroArgs);

implementation

	var
		Canceled: boolean;


{Called from procedure InitUserMacros in UMacroRun.p, }
{which is called from Image.p early in initialization.}
	procedure UMCrestInit;
	begin
	end;


{Called from procedure FinalUserMacros in UMacroRun,p.}
{This will eventually be guaranteed to run prior to any exit, and}
{is intended for things which MUST be done prior to exit, like removing}
{timers from the system timer list.}
	procedure UMCrestFinal;
	begin
	end;


{AddUMSym calls:}
{Add one call for each macro command, function, or string function}
{you wish to add to the macro language.}
{First argument is a string, case is ignored, truncated to SymbolSize characters.}
{Second argument must be one of UserCommandT, UserFuncT, or UserStrFuncT}
{Third argument is the UserCommandType item associated with the name.}


{Called from procedure AddUserMacros in UMacroRun.p.}
{This runs once each time macros are loaded from a file or a text window.}
	procedure UMCrestAdd;
	begin
		AddUMSym('CrestPathway', UserCommandT, CrestPathwayUC);
	end;

{Called from procedure LookupUserMacro in UMMacroRun.p}
{This runs every time the macro is executed, just prior to}
{parsing the arguments.}
	procedure UMCrestLookup (var uma: UserMacroArgs);
	begin
		with uma do
			case UserMacroCommand of
				CrestPathwayUC:  begin
						nArgs := 3;
						arg[1].atype := UMATinteger;
						arg[2].atype := UMATinteger;
						arg[3].atype := UMATinteger;
					end;
				otherwise begin
						ErrorOccurred := true;
						str := 'UMCrest.p LookupUserMacro';
					end;
			end;
	end;

	procedure CrestPathway (AveragingDist, MaxAngle, MaxCount: integer);
		const
			MaxAveragingDist = 10;
			DefAveragingDist = 3;
			MaxMaxAngle = 3;
			DefMaxAngle = 1;
			DeltaSignif = 0.001;
			DefMaxCount = 0;
		var
			dx, dy: array[0..7] of integer;
			ExAequos, i, dir, InitialDir, OptimalDir, counter, dist, x, y: integer;
			FirstPointInLoop, SaveBackGround, ImgH, ImgW: integer;
			MaxCountReached, OnABorder, Cycled, AddRoi: boolean;
			avg, max: real;
			pt: point;
			Oldinfo, Newinfo: InfoPtr;
			TempRgn: RgnHandle;
	begin
		if OptionKeyDown then
			AddRoi := true;
		if info^.PictureType = NullPicture then
			exit(CrestPathway);
		Oldinfo := Info;
		ImgH := Info^.nlines;
		ImgW := Info^.PixelsPerLine;

		SaveBackground := BackgroundIndex;
		BackgroundIndex := WhiteIndex;
		MaxCountReached := false;
		OnABorder := false;
		Cycled := false;
		counter := 1;
		InitialDir := 2;
		dx[0] := -1;
		dy[0] := 0;
		dx[1] := -1;
		dy[1] := -1;
		dx[2] := 0;
		dy[2] := -1;
		dx[3] := 1;
		dy[3] := -1;
		dx[4] := 1;
		dy[4] := 0;
		dx[5] := 1;
		dy[5] := 1;
		dx[6] := 0;
		dy[6] := 1;
		dx[7] := -1;
		dy[7] := 1;




		if (AveragingDist < 1) or (AveragingDist > MaxAveragingDist) then begin
				AveragingDist := GetInt(concat('Averaging Distance (1-', Long2str(MaxAveragingDist), ')'), DefAveragingDist, Canceled);
				if Canceled or (AveragingDist > MaxAveragingDist) or (AveragingDist < 1) then begin
						BackgroundIndex := SaveBackground;
						exit(CrestPathway);
					end;
			end;

		if (MaxAngle < 1) or (MaxAngle > MaxMaxAngle) then begin
				MaxAngle := GetInt(concat('MaxAngle (1-', Long2str(MaxMaxAngle), ')'), DefMaxAngle, Canceled);
				if Canceled or (MaxAngle > MaxMaxAngle) or (MaxAngle < 1) then begin
						BackgroundIndex := SaveBackground;
						exit(CrestPathway);
					end;
			end;

		if (MaxCount < 0) or (MaxCount > MaxCoordinates) then begin
				MaxCount := GetInt(concat('Maximal Path Lenght (0-', Long2str(MaxCoordinates), ')'), DefMaxCount, Canceled);
				if Canceled or (MaxCount > MaxCoordinates) or (MaxCount < 0) then begin
						BackgroundIndex := SaveBackground;
						exit(CrestPathway);
					end;
			end;

		Info := OldInfo;
		with OldInfo^ do begin
{get the initial position}
				SetPort(wptr);
				ShowMessage('Click on starting position');
				SetCursor(ToolCursor[SelectionTool]);
				UpdatePicWindow;
				repeat
				until button;
				GetMouse(pt);
				x := pt.h;
				y := pt.v;
				if (x < 0) or (y < 0) or (x > ImgW - 1) or (y > ImgH - 1) then {point outside the image}
					begin
						Putmessage(concat('Click on starting porition inside ', title, ' image'));
						UpdatePicWindow;
						repeat
						until button;
						GetMouse(pt);
						x := pt.h;
						y := pt.v;
						if (x < 0) or (y < 0) or (x > ImgW - 1) or (y > ImgH - 1) then {point outside the image}
							exit(CrestPathway);
					end;
				xCoordinates^[counter] := x;
				yCoordinates^[counter] := y;
				nCoordinates := counter;

				if not NewPicWindow('Crest pathway', ImgW, ImgH) then begin
						PutMessage('Not enough memory to open destination image');
						BackgroundIndex := SaveBackground;
						exit(CrestPathway);
					end;
				NewInfo := Info;

{find pathway}
				repeat
					Info := OldInfo;
					counter := counter + 1;
					max := -1;
					for i := (InitialDir - MaxAngle) to (InitialDir + MaxAngle) do begin
							dir := (i + 8) mod 8;
							avg := 0;
							for dist := 1 to AveragingDist do
								avg := avg + myGetPixel(x + dist * dx[dir], y + dist * dy[dir]);
							avg := avg / AveragingDist;
							if (avg > max) or (abs(avg - max) <= DeltaSignif * avg) then begin
									if (abs(avg - max) <= DeltaSignif * avg) then
										ExAequos := ExAequos + 1
									else
										ExAequos := 0;
									max := avg;
									OptimalDir := dir;
								end;
						end;	{for i := (InitialDir - MaxAngle) to (InitialDir + MaxAngle)}

					if ExAequos > 1 then
						OptimalDir := (OptimalDir - (ExAequos div 2) + 8) mod 8;

					Info := NewInfo;
					putpixel(x, y, 255);
					UpdatePicWindow;
					x := x + dx[OptimalDir];
					y := y + dy[OptimalDir];
					xCoordinates^[counter] := x;
					yCoordinates^[counter] := y;
					nCoordinates := counter;
					InitialDir := OptimalDir;

					if (x < 1) or (y < 1) or (x > ImgW - 2) or (y > ImgH - 2) then
						OnABorder := true;
					if (myGetPixel(x, y) <> 0) and (counter > 4) then
						Cycled := true;
					if (MaxCount > 0) and (counter >= MaxCount) then
						MaxCountReached := true;

				until MaxCountReached or Cycled or OnABorder;
			end; {with Info^}

		FirstPointInLoop := 0;
		if Cycled and (MaxCount = 0) then {removing points outside of the loop}
			begin
{finding first point in the loop}
				Info := NewInfo;
				repeat
					FirstPointInLoop := FirstPointInLoop + 1;
				until ((xCoordinates^[FirstPointInLoop] = x) and (yCoordinates^[FirstPointInLoop] = y)) or (FirstPointInLoop > counter);

{blanks all points outside the loop}
				if (FirstPointInLoop <> Counter) and (FirstPointInLoop <> 1) then
					for i := 1 to FirstPointInLoop - 1 do
						PutPixel(xCoordinates^[i], yCoordinates^[i], 0);

{Selecting ROI along pathway}
				Info := OldInfo;
				with info^ do begin
						TempRgn := NewRgn;
						PenNormal;
						OpenRgn;
						MoveTo(xCoordinates^[FirstPointInLoop], yCoordinates^[FirstPointInLoop]);
						for i := FirstPointInLoop + 1 to Counter do
							LineTo(xCoordinates^[i], yCoordinates^[i]);
						CloseRgn(TempRgn);
						if not AddRoi then begin
								RoiRgn := TempRgn;
								FrameRgn(RoiRgn);
							end
						else if RgnNotTooBig(roiRgn, TempRgn) then
							UnionRgn(roiRgn, TempRgn, roiRgn);
						RoiShowing := true;
						roiType := FreehandRoi;
						RoiRect := roiRgn^^.rgnBBox;
						UpdatePicWindow;
					end;
			end;

		if Cycled then
			if MaxCount = 0 then
				ShowMessage(concat('Cycle of ', Long2str(Counter - FirstPointInLoop), ' steps'))
			else
				ShowMessage(concat('Cycled after ', Long2str(Counter), ' steps'))
		else if OnABorder then
			ShowMessage(concat('Reached a border after ', Long2str(Counter), ' steps'))
		else if MaxCountReached then
			ShowMessage(concat('Maximum number of steps (', Long2str(Counter), ') reached'));

		BackgroundIndex := SaveBackground;
	end;			{CrestPathway}



{Called from procedure DoUserMacro in UMacroRun.p .}
{Do not change uma.nArgs or uma.arg[i].argt here.}
{This runs once each time the macro is used, after parsing the arguments.}
	procedure UMCrestRun (var uma: UserMacroArgs);
	begin
		with uma do
			case UserMacroCommand of
				CrestPathwayUC: 
					CrestPathway(arg[1].ival, arg[2].ival, arg[3].ival);
				otherwise begin
						ErrorOccurred := true;
						str := 'UMCrest.p DoUserMacro';
					end;
			end;
	end;


end.