UNIT PCMD1;

INTERFACE

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

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 - hold the current 
										calibration units}
					MyOSPort : GrafPtr;
	 			 END;
	 PCmdBlockPtr = ^PcmdBlock;
				 
  	UnsignedByte=0..255;
  	LineType=PACKED ARRAY[0..MaxPixelsperLine] OF UnsignedByte;
	SArray=Array[1..25] of integer;
	
				 
{ MAIN entry point}


PROCEDURE  DoPCommand (pData1:PCmdBlockptr);

IMPLEMENTATION

PROCEDURE DoPCommand (pData1:PCmdBlockptr);
VAR
	pData : PCMDBlock;
	
	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;

VAR
	i,j,k,B,t : integer;
	irect : rect;
	L1,L2,L3,L4,L5,L6,L7,L8,L9,L10,L11 : linetype;
	Result : linetype;
	Histo : array[0..255] of integer;
	ptr : array[0..11] of ^linetype;
	width,height : integer;
	
BEGIN {11 pixel diameter local equalization}
	pdata:=pdata1^;
	
	pdata.ReturnCode:=changed; {otherwise, :=No_Change}
	
	irect:=pdata.roirect; {bottom is not inclusive in process area}
	with irect,pdata DO
		BEGIN
			if top<5 then top:=5; {avoid top 5 lines}
			if left<5 then left:=5;
			if bottom>nlines-5 then bottom:=nlines-5;
			if right>PixelsperLine-5 then right:=PixelsPerLine-5;
			width:=right-left;
			height:=bottom-top;
		END;
		
	ptr[1]:=@L1;ptr[2]:=@L2;ptr[3]:=@L3;ptr[4]:=@L4;
	ptr[5]:=@L5;ptr[6]:=@L6;ptr[7]:=@L7;ptr[8]:=@L8;
	ptr[9]:=@L9;ptr[10]:=@L10;ptr[11]:=@L11;ptr[0]:=nil;
	
	For i:=1 to 10 DO {set up top 10 lines before entering loop}
		GetLine(irect.left-5,irect.top-6+i,width+10,ptr[i]^);
	
	FOR i:=irect.top to irect.bottom-1 DO
		BEGIN
			GetLine(irect.left-5,i+5,width+10,ptr[11]^);
			{initialize histogram for each line}
			For j:=0 to 255 do Histo[j]:=0;
			{j=horiz. posn; k=vertical line,
				read all except rightmost pixelin each line}
			For k:=1 to 11 DO
				case k of
					1,11:    For j:=4 to 5 do Histo[ptr[k]^[j]]:=Histo[ptr[k]^[j]]+1;
					2,10:    For j:=2 to 7 do Histo[ptr[k]^[j]]:=Histo[ptr[k]^[j]]+1;
					3,4,8,9: For j:=1 to 8 do Histo[ptr[k]^[j]]:=Histo[ptr[k]^[j]]+1;
					5,6,7:   For j:=0 to 9 do Histo[ptr[k]^[j]]:=Histo[ptr[k]^[j]]+1;
				end;
			{For j:=0 to 9 do
				For k:=1 to 11 DO
					Histo[ptr[k]^[j]]:=Histo[ptr[k]^[j]]+1;}
			
			For j:=0 to width-1 DO
				BEGIN
					For k:=1 to 11 DO {add in next column}
						case k of
							1,11:    Histo[ptr[k]^[j+ 6]]:=Histo[ptr[k]^[j+ 6]]+1;
							2,10:    Histo[ptr[k]^[j+ 8]]:=Histo[ptr[k]^[j+ 8]]+1;
							3,4,8,9: Histo[ptr[k]^[j+ 9]]:=Histo[ptr[k]^[j+ 9]]+1;
							5,6,7:   Histo[ptr[k]^[j+10]]:=Histo[ptr[k]^[j+10]]+1;
						end;

					B:=ptr[6]^[j+5];{center}
					t:=0;
					For k:=0 to B DO {count position - max=89}
						t:=t+Histo[k];
					Result[j]:=(255*t) DIV 89; {121 - 32 = 89 pixels in circle
							j=		0 1 2 3 4 5 6 7 8 9 10
							k=1		. . . . x x x . . . .
							 2		. . x x x x x x x . .
							 3		. x x x x x x x x x .
							 4		. x x x x x x x x x .
							 5		x x x x x x x x x x x
							 6		x x x x x ¥ x x x x x
							 7		x x x x x x x x x x x
							 8		. x x x x x x x x x .
							 9		. x x x x x x x x x .
							 10		. . x x x x x x x . .
							 11		. . . . x x x . . . .		}
					
					For k:=1 to 11 DO {remove old column}
						{Histo[ptr[k]^[j]]:=Histo[ptr[k]^[j]]-1;}
						case k of
							1,11:    Histo[ptr[k]^[j+4]]:=Histo[ptr[k]^[j+4]]-1;
							2,10:    Histo[ptr[k]^[j+2]]:=Histo[ptr[k]^[j+2]]-1;
							3,4,8,9: Histo[ptr[k]^[j+1]]:=Histo[ptr[k]^[j+1]]-1;
							5,6,7:   Histo[ptr[k]^[j  ]]:=Histo[ptr[k]^[j  ]]-1;
						end;
					
				END; {for j}
			if pdata.rectangular THEN
				PutLine(irect.left,i,width,result)
			ELSE
				PutLineUsingMask(irect.left,i,width,result);
			
			for k:=0 to 10 do {shuffle up each line}
				ptr[k]:=ptr[k+1];
			ptr[11]:=ptr[0];
			
			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}