UNIT PCMD1;  {Frei & Chen}

INTERFACE

{$R-}   { range checking off}
{$SC+}  { short circuit AND & OR statements in IF's}
USES memtypes, OSIntf, ToolIntf, SANE;

CONST
	MaxPixelsPerLine = 2048;
	WhiteC = 0;
	BlackC = 255;
	{returnCodes}
	No_Change			  = 	 0;
	CMDperiod			  = -10000;
	Changed				  = -20000;
	CMDperiod_and_changed = -30000;
	
TYPE
	 PCmdBlock = RECORD
	 				Primary : ptr; {all changes are made to primary}
					Secondary : ptr; {NIL if it couldn't load, or didn't exist}
					OptionKeyDownCall : boolean;
					ShiftKeyDownCall : boolean;
					NLines : integer;
					PixelsPerLine : integer;
					BytesPerRow : integer;
					sPixelsPerLine : integer;
					sBytesPerRow : integer;
					sNLines : integer;
					RoiRect : rect;
					Rectangular : boolean; {T/F}
					mask : ptr;
					ReturnCode : OSErr; {0=okay, <0 = changed,CommandPeriod, or both}
					FgColor : integer;
					iScale:extended;   {extended - # of pixels per unit}
					iunits:string[2];  {2 characters - calibration units}
					MyOSPort : GrafPtr;
	 			 END;
	 PCmdBlockPtr = ^PcmdBlock;
				 
  	UnsignedByte=0..255;
  	LineType=PACKED ARRAY[0..MaxPixelsperLine] OF UnsignedByte;
	
				 
				 
{ MAIN entry point}


PROCEDURE  DoPCommand (pData1:PCmdBlockptr);

IMPLEMENTATION

PROCEDURE DoPCommand (pData1:PCmdBlockptr);
VAR
	pData : PCMDBlock;
	
	PROCEDURE dumbBeep;
	BEGIN
		sysbeep(1);
	END;
	
	FUNCTION blankLine : linetype;
	VAR i:integer;
		jl : linetype;
	BEGIN
		for i:=0 to MaxPixelsPerLine-1 do
			jl[i]:=whiteC;
		blankline:=jl;
	END; {blankline}
	
	PROCEDURE GetLine(h,v,count:integer; VAR line:LineType);
	VAR
		offset:LongInt;
		p:ptr;
	BEGIN
		IF pdata.primary=NIL then
			BEGIN
				line:=BlankLine;
				exit(GetLine);
			END;			
		IF (h<0) OR (v<0) OR
		   ((h+count)>pdata.PixelsPerLine)
		   OR (v>=pdata.nlines) THEN
			BEGIN
				line:=BlankLine;
				exit(GetLine);
			END;
		offset:=LongInt(v)*pdata.BytesPerRow+h;
		p:=ptr(ord4(pdata.Primary)+offset);
		BlocKMove(p,@line,count);
	END; {getline}

	PROCEDURE GetBGLine(h,v,count:integer; VAR line:LineType);
	VAR
		offset:LongInt;
		p:ptr;
	BEGIN
		IF pdata.secondary=NIL then
			BEGIN
				line:=BlankLine;
				exit(GetBGLine);
			END;			
		IF (h<0) OR (v<0) OR
		   ((h+count)>pdata.sPixelsPerLine)
		   OR (v>=pdata.snlines) THEN
			BEGIN
				line:=BlankLine;
				exit(GetBGLine);
			END;
		offset:=LongInt(v)*pdata.sBytesPerRow+h;
		p:=ptr(ord4(pdata.secondary)+offset);
		BlocKMove(p,@line,count);
	END; {getBGline}

	PROCEDURE GetMaskLine(h,v,count:integer; VAR line:LineType);
	VAR
		offset:LongInt;
		p:ptr;
	BEGIN
		IF pdata.mask=NIL then
			BEGIN
				line:=BlankLine;
				exit(GetMaskLine);
			END;			
		IF (h<0) OR (v<0) OR
		   ((h+count)>pdata.PixelsPerLine)
		   OR (v>=pdata.nlines) THEN
			BEGIN
				line:=BlankLine;
				exit(GetMaskLine);
			END;
		offset:=LongInt(v)*pdata.BytesPerRow+h;
		p:=ptr(ord4(pdata.mask)+offset);
		BlocKMove(p,@line,count);
	END; {getMaskline}
	
	PROCEDURE PutLine(h,v,count:integer; VAR line:LineType);
	VAR
		offset:LongInt;
		p:ptr;
	BEGIN
		if pdata.primary=NIL then exit(putLine);
		IF (h<0) OR (v<0) OR (v>=pdata.nlines) THEN exit(PutLine);
		IF (h+count)>pdata.PixelsPerLine THEN count:=pdata.PixelsPerLine-h;
		offset:=LongInt(v)*pdata.BytesPerRow+h;
		p:=ptr(ord4(pdata.primary)+offset);
		BlocKMove(@line,p,count);
	END;{PutLine}

	PROCEDURE GetLineUsingMask(h,v,count:integer; var line:linetype;  padcolor:integer);
	VAR {only needed when eroding/dilating & the boundaries are 
	     assumed to be a special color}
		line2 : linetype;
		i: integer;
	BEGIN
		getline (h,v,count,line);
		getline(h,v,count,line2);
		FOR i:=0 to count-1 DO
			if line2[i]<>pdata.fgcolor THEN line[i]:=padcolor;
	END;{GetLineUsingMask}
	
	PROCEDURE PutLineUsingMask(h,v,count:integer; VAR line:LineType);
	VAR
		aLine,MaskLine:LineType;
		i:integer;
	BEGIN
		GetLine(h,v,count,aline);
		GetMaskLine(h,v,count,MaskLine);
		FOR i:=0 TO count-1 DO
		IF MaskLine[i]=pdata.fgcolor THEN aLine[i]:=line[i];
		PutLine(h,v,count,aLine);
	END;

	FUNCTION CommandPeriod:boolean;
	TYPE
		KeyPtrType=^KeyMap;
	VAR
		KeyPtr:KeyPtrType;
		keys:ARRAY[0..3] OF LongInt;
		event : eventrecord;
	BEGIN
	  systemtask;
	  KeyPtr:=KeyPtrType(@keys);
	  GetKeys(KeyPtr^);
	  CommandPeriod:=(BAND(keys[1],$808000))=$808000;
	END;

CONST
    numer=58; {58      7    3}
    denom=41; {41      5    2}
	denomsquared = 1681;

VAR
	i,j : integer; {for scanning entire area}
	irect : rect;
	L1,L2,L3 : linetype; {space for 3 incoming lines}
	Result : linetype;         {result from processing}
	ptr1,ptr2,ptr3, shuffle : ^linetype;  {pointing at all 3 lines}
	width,height : integer;
	
	E,S,temp : extended;
	t1,troot2 : array[0..255] of longint;
	basis : longint;
	a11,a12,a13,
	a21,a22,a23,
	a31,a32,a33 : integer;
	scalevalue : extended;
	
BEGIN {DoMedian5x5}
	pdata:=pdata1^;
	
	for i:=0 to 255 do
		BEGIN
			t1[i]:=denom*i;
			troot2[i]:=numer*i; 
			 {for basis functions 1..4, divide by denom afterwards}
		END;
	{1 - assume that UNDO is completely handled by the calling program}
	{2 - cannot do screen updates while doing processing, so speed is
	     of the essence}
	{3 - if there is a nonrectangular region within the roirect, then
		 we should use putlineusingmask, otherwise use putline}
		 
	scalevalue:=sqrt(2)*255/arccos(0);
		 
	{pdata.ReturnCode:=No_Change;}
	pdata.ReturnCode:=changed; {the image is going to change}
	
	irect:=pdata.roirect; {bottom is not inclusive in process area}
	with irect,pdata DO
		BEGIN
			if top<1 then top:=1; {avoid top line}
			if left<1 then left:=1;
			if bottom>nlines-1 then bottom:=nlines-1;
			if right>PixelsperLine-1 then right:=PixelsPerLine-1;
			width:=right-left;
			height:=bottom-top;
		END;
	
	{set up top 2 lines before entering loop}
	
	ptr1:=@L1;ptr2:=@L2;ptr3:=@L3; shuffle:=NIL;
	
			GetLine(irect.left-1,irect.top-1,width+2,ptr1^);
			GetLine(irect.left-1,irect.top-0,width+2,ptr2^);
		
	{ top of the loop}
	
	FOR i:=irect.top to irect.bottom-1 DO
		BEGIN
			GetLine(irect.left-1,i+1,width+2,ptr3^);
			
			for j:=1 to width DO
				BEGIN { *** process each point, w/ Result[] ***}
					{Compute Frei & Chen edge detector}
					
					{Frei, W. and C. C. Chen. "Fast boundary detection: 
					 a generalization and a new algorithm." _IEEE Trans.
					 Computers 26_, 2, October 1977, 988-998.}
					 
					a11:=ptr1^[j-1];
					a12:=ptr1^[j  ];
					a13:=ptr1^[j+1];
					a21:=ptr2^[j-1];
					a22:=ptr2^[j  ];
					a23:=ptr2^[j+1];
					a31:=ptr3^[j-1];
					a32:=ptr3^[j  ];
					a33:=ptr3^[j+1];


					{ compute E first}
					basis{1}:=-t1	 [a11]
							  -troot2[a12]
							  -t1    [a13]
							  +t1	 [a31]
							  +troot2[a32]
							  +t1    [a33];
					E:=basis*basis/denomsquared;
					
					basis{2}:=-t1	 [a11]
							  -troot2[a21]
							  -t1    [a31]
							  +t1	 [a13]
							  +troot2[a23]
							  +t1    [a33];
					E:=E+basis*basis/denomsquared;
					
					{ compute S next}
					S:=E; {start out with functions 1 & 2}
					
					basis{3}:=-t1	 [a12]
							  +troot2[a13]
							  -t1    [a23]
							  +t1	 [a21]
							  -troot2[a31]
							  +t1    [a32];
					S:=S+basis*basis/denomsquared;
					
					basis{4}:=-t1	 [a12]
							  +troot2[a11]
							  -t1    [a21]
							  +t1	 [a23]
							  -troot2[a33]
							  +t1    [a32];
					S:=S+basis*basis/denomsquared;
					
					basis{0}:=a11+a12+a13+a21+a22+a23+a31+a32+a33;
					S:=S+basis*basis;
					
					basis{5}:=a12-a21+a23-a32;
					S:=S+basis*basis;
					
					basis{6}:=a13-a11+a31-a33;
					S:=S+basis*basis;
					
					basis{7}:=a11-a12-a12+a13
							 -a21-a21+4*a22-a23-a23
							 +a31-a32-a32+a33;
					S:=S+basis*basis;

					basis{8}:=-a11-a11+a12-a13-a13
							  +a21+4*a22+a23
							  -a31-a31+a32-a33-a33;
					S:=S+basis*basis;

					
					temp:=arccos(1-sqrt(E/S))*scalevalue;
					if temp<0 then Result[j-1]:=0  {shouldn't be possible}
					else if temp>255 then Result[j-1]:=255
					else Result[j-1]:=trunc(temp);
													
				END; {for j}
				
			if pdata.rectangular THEN
				PutLine(irect.left,i,width,result)
			ELSE
				PutLineUsingMask(irect.left,i,width,result);
			
			shuffle:=ptr1;
			ptr1:=ptr2;
			ptr2:=ptr3;
			ptr3:=shuffle;
			
			IF commandperiod then
				BEGIN
					sysbeep(1);
					pdata.ReturnCode:=pdata.ReturnCode+CMDperiod;
					pdata1^:=pdata;
					Exit(DoPCommand);
				END;
		END; {for i}
		
		
		pData1^:=pdata;
	
END; {DoPCommand}



END. {UNIT}