UNIT PCMD1;  {reduce grey scale and lateral resolution}

INTERFACE

{$R-}   { range checking off}
{$SC+}  { short circuit AND & OR statements in IF's}
USES memtypes, OSIntf, ToolIntf, 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;
	
	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;

	PROCEDURE SetDialogItem(TheDialog:DialogPtr; item,value:integer);
	VAR
		ItemType:integer;
		ItemBox:rect;
		ItemHdl:handle;
	BEGIN
		GetDItem (TheDialog,item,ItemType,ItemHdl,ItemBox);
		SetCtlValue(ControlHandle(ItemHdl),value)
	END;{SetDialogItem}

	PROCEDURE ShowWatch;
	VAR
		watch:CursHandle;
	BEGIN
		watch := GetCursor(WatchCursor);
		SetCursor(watch^^);
	END;

	PROCEDURE OutlineButton(theDialog: DialogPtr; itemNo, CornerRad: integer);
	{ Draws a border around a button. 16 is the normal
	  cornerRad for small buttons }
	VAR
		itemType: Integer;
		itemBox: Rect;
		itemHdl: Handle;
		tempPort: GrafPtr;
	BEGIN
		GetPort(tempPort);
		SetPort(theDialog);
		GetDItem(theDialog, itemNo, itemType, itemHdl, itemBox);
		PenSize(3, 3);
		InSetRect(itemBox, -4, -4);
		FrameRoundRect(itemBox, cornerRad, cornerRad);
		PenSize(1,1);
		SetPort(tempPort);
	END;{OutlineButton}

	FUNCTION GetDNum(TheDialog:DialogPtr; item:integer):LongInt;
	VAR
	  ItemType:integer;
	  ItemBox:rect;
	  ItemHdl:handle;
	  str:str255;
	  n:LongInt;
	BEGIN
	  GetDItem (TheDialog,item,ItemType,ItemHdl,ItemBox);
	  GetIText(ItemHdl,str);
	  {look for '.' and use everything before that character...}
	  StringToNum(str,n);
	  GetDNum:=n;
	END;

	PROCEDURE SetDNum(TheDialog:DialogPtr; item:integer; n:LongInt);
	VAR
	  ItemType:integer;
	  ItemBox:rect;
	  ItemHdl:handle;
	  str:str255;
	BEGIN
	  GetDItem (TheDialog,item,ItemType,ItemHdl,ItemBox);
	  NumToString(n,str);
	  SetIText(ItemHdl,str)
	END;{SetDNum}

VAR
	irect : rect;
	L1: linetype;
	Result : linetype;         {result from processing}
	ptr1: ^linetype;
	row,width,height,b,c,g,h,i,j,k,nstrips,nblocks,posn,temp : integer;
    Sum:Array[0..1023] of integer;
	mylog : dialogptr;
	Okay : Boolean;
	
BEGIN {Reduce grey scale and resolution}
	pdata:=pdata1^;
	pdata.ReturnCode:=changed; {if the image is going to change}
	
	irect:=pdata.roirect; {bottom is not inclusive in process area}
	with irect,pdata DO
		BEGIN
			width:=right-left;
			height:=bottom-top;
		END;
	ptr1:=@L1;
	
	{get number of pixels to average and number of grey bits}
	initcursor;
	Mylog:=GetNewDialog(2001,nil,pointer(-1));
	OutlineButton(MyLog,OK,16);
	j:=4;{number of bits};
	c:=2;{blocksize};
	Okay:=true;
	SetDNum(Mylog,3,j);
	SetDNum(MyLog,4,c);
	SelIText(MyLog,3,0,32767);
	Repeat
		ModalDialog(nil,i);
		IF i=3 THEN BEGIN
			temp:=GetDNum(Mylog,3);
			IF (temp>=1) and (temp<=8)
				then j:=temp
				else begin
					SetDNum(MyLog,3,j);
					SelIText(MyLog,3,0,32767);
					end;;
			END;
		IF i=4 then begin
			temp:=GetDNum(MyLog,4);
			if (temp>=1) and (temp<=16)
				then c:=temp
				else begin
					SetDNum(MyLog,4,c);
					SelIText(MyLog,4,0,32767);
				end;
			END;
		if (i=5) or (i=6) then
			if ((i=5) AND (j<8)) OR ((i=6) AND (j>1)) then begin
				if (i=5) THEN j:=j+1 else j:=j-1;
				SetDNum(MyLog,3,j);
				SelIText(MyLog,3,0,32767);
				end;
		if (i=7) or (i=8) then
			if ((i=7) AND (c<16)) OR ((i=8) AND (c>1)) then begin
				if (i=7) THEN c:=c+1 else c:=c-1;
				SetDNum(MyLog,4,c);
				SelIText(MyLog,4,0,32767);
				end;
		Okay:=(c>=1) AND (c<=16) AND (j>=1) and (j<=8);
	Until ((i=ok) AND Okay) or (i=cancel);
	DisposDialog(MyLog);
	
	IF (i=cancel) THEN
		BEGIN
			pdata.ReturnCode:=pdata.ReturnCode+CMDperiod;
			pdata1^:=pdata;
			Exit(DoPCommand);
		END;

	showwatch;
	Case j OF
		 1:g:=128;
		 2:g:=192;
		 3:g:=224;
		 4:g:=240;
		 5:g:=248;
		 6:g:=252;
		 7:g:=254;
		 8:g:=255;
        END;
		 {1,2,3,4,5,6,7,8 bits}

	i:=width MOD c;
	width:=width-i;
	nblocks:=width DIV c;
	i:=height MOD c;
	height:=height-i;
	nstrips:=height DIV c;
	FOR j:=1 TO nstrips DO
		BEGIN
			for k:=0 to width DO Sum[k]:=0;
			for i:=1 to c DO 
				BEGIN
					row:=irect.top+(j-1)*c+(i-1);
					GetLine(irect.left,row,width,ptr1^);
					IF i=1 THEN FOR k:=0 to width DO Sum[k]:=L1[k]
						   ELSE For k:=0 to width DO Sum[k]:=Sum[k]+L1[k];
				END;
			For i:=1 to nblocks DO
				BEGIN
					h:=0;
					For k:=1 to c DO
						BEGIN
							posn:=irect.left+(i-1)*c+(k-1);
							h:=h+Sum[posn];
						END;
					h:=h DIV c;
					For k:=1 to c DO
						BEGIN
							posn:=irect.left+(i-1)*c+(k-1);
							Sum[posn]:=h;
						END;
				END;
			FOR k:=0 to width DO
				BEGIN
					L1[k]:=Sum[k] DIV c;
					L1[k]:=BAND(L1[k],g);
				END;
			For i:=1 to c DO
				BEGIN
					row:=irect.top+(j-1)*c+(i-1);
					if pdata.rectangular
						THEN PutLine(irect.left,row,width,ptr1^)
						ELSE PutLineUsingMask(irect.left,row,width,ptr1^);
				END;
			IF commandperiod then
				BEGIN
					sysbeep(1);
					pdata.ReturnCode:=pdata.ReturnCode+CMDperiod;
					pdata1^:=pdata;
					Exit(DoPCommand);
				END;
		END; {for j:=...}
		
		pData1^:=pdata;
	
END; {DoPCommand}



END. {UNIT}