unit File4;

{Routines used by Image for loading Wright-camera files.}

interface


	uses
		QuickDraw, Palettes, PrintTraps, globals, Utilities, Graphics;

	function OpenNCCDFile (fname: str255; vnum: integer): boolean;



implementation

	function CloseAWindow (WhichWindow: WindowPtr): integer;
	external;
	procedure DoBusyBox (n, a: integer);
	external;
	procedure OpenBusyBox (text: str255);
	external;
	procedure CloseBusyBox;
	external;
	procedure Swap2Bytes (var i: integer);
	external;
	procedure Swap4Bytes (var i: LongInt);
	external;


	type
		AFMDataArray = array[0..262144] of integer;
		AFMDataArrayPtr = ^AFMDataArray;
		AFMDataArrayHandle = ^AFMDataArrayPtr;

	var
		LowerCutOff, UpperCutOff: real;
		To0, To255: longint;
		InputOptionsSet, SubtrBackgrnd, ShowOriginal: boolean;
		NCCDScaling: integer;

	procedure HiLiteDialogItem (TheDialog: DialogPtr; item, hiliteState: integer);
		var
			ItemType: integer;
			ItemBox: rect;
			ItemHdl: handle;
	begin
		GetDItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
		HiLiteControl(ControlHandle(ItemHdl), hiliteState)
	end;


	function OpenNCCDFile (fname: str255; vnum: integer): boolean;
		const
			NCCDinpOptDLOG = 2401;
			Ok = 1;
			Cancel = 2;
			FixedScale = 3;
			To0ID = 4;
			To255ID = 5;
			GaussScale = 6;
			LowCutOff = 7;
			UpCutOff = 8;
			MinToMaxScale = 9;
			SubtrBackgrndID = 10;
			ShowOriginalID = 11;
			NCCDHeaderSize = 2880;
			Imagtop = 0;
			Imagleft = 4;
			Imagbottom = 1;
			Imagright = 0;
		var
			AFMMDataArrayH, BackGrndArrayH: AFMDataArrayHandle;
			AFMMDataArrayP, BackGrndArrayP: AFMDataArrayPtr;
			aLine: LineType;
			value_range: integer;
			min, max: integer;
			k, kmin, kmax: integer;
			aNumber, ticks, Count, imax, jmax, jmin, j1, j2, LineOffset: LongInt;
			Mean, StdDev: extended;
			nPixels: longint;
			err: OSErr;
			f: integer;
			line, pixel, IntValue: integer;
			r2, r3: rect;
			p: ptr;
			value: byte;
			iptr: ptr;
			name: str255;
			NCCD_Header: packed array[0..2880] of Byte;
			InfoWindow, SaveInfo: InfoPtr;
			ScaleFactor: extended;
			widthNCCD, heightNCCD: integer;

		procedure GetNCCDInputOptions; {(var LowerCutOff, UpperCutOff: real; var SubtrBackgrnd: boolean)}
			var
				mylog: DialogPtr;
				item, i: integer;
		begin
			mylog := GetNewDialog(NCCDinpOptDLog, nil, pointer(-1));
			OutlineButton(mylog, OK, 16);
			SetDReal(mylog, LowCutOff, LowerCutOff, 3);
			SetDreal(mylog, UpCutOff, UpperCutOff, 3);
			SetDReal(mylog, To0ID, To0, 0);
			SetDreal(mylog, To255ID, To255, 0);
			SetDialogItem(mylog, SubtrBackgrndID, integer(SubtrBackgrnd));
			SetDialogItem(mylog, ShowOriginalID, integer(ShowOriginal));
			if not SubtrBackGrnd then begin
					HiLiteDialogItem(myLog, ShowOriginalID, 255);
				end;
			SetDialogItem(mylog, FixedScale, 0);
			SetDialogItem(mylog, GaussScale, 0);
			SetDialogItem(mylog, MinToMaxScale, 0);
			SetDialogItem(mylog, NCCDScaling, 1);
			if NCCDScaling <> MinToMaxScale then
				SelIText(mylog, NCCDScaling + 1, 0, 32767);
			repeat
				ModalDialog(nil, item);
				case item of
					FixedScale, GaussScale, MinToMaxScale: 
						begin
							SetDialogItem(mylog, FixedScale, 0);
							SetDialogItem(mylog, GaussScale, 0);
							SetDialogItem(mylog, MinToMaxScale, 0);
							SetDialogItem(mylog, Item, 1);
							if item <> MinToMaxScale then
								SelIText(mylog, Item + 1, 0, 32767);
							NCCDScaling := Item;
						end;
					SubtrBackgrndID: 
						begin
							SubtrBackgrnd := not SubtrBackgrnd;
							SetDialogItem(mylog, SubtrBackgrndID, integer(SubtrBackgrnd));
							if not SubtrBackGrnd then begin
									ShowOriginal := true;
									SetDialogItem(mylog, ShowOriginalID, integer(ShowOriginal));
									HiLiteDialogItem(myLog, ShowOriginalID, 255);
								end
							else begin
									HiLiteDialogItem(myLog, ShowOriginalID, 0);
								end;
						end;
					ShowOriginalID: 
						if SubtrBackGrnd then begin
								ShowOriginal := not ShowOriginal;
								SetDialogItem(mylog, ShowOriginalID, integer(ShowOriginal));
							end;
				end;
			until (item = Ok) or (item = Cancel);
			if item = Ok then begin
					LowerCutOff := GetDReal(mylog, LowCutOff);
					UpperCutOff := GetDReal(mylog, UpCutOff);
					To0 := Round(GetDReal(mylog, To0ID));
					To255 := Round(GetDReal(mylog, To255ID));
				end;
			DisposDialog(mylog);
		end;

		procedure BackGround;
			const
				NSmooth = 63;
			var
				i, j, k: integer;
		begin
			BackGrndArrayH := AFMDataArrayHandle(NewHandle(sizeof(AFMDataArray)));
			if BackGrndArrayH = nil then begin
					DisposHandle(Handle(BackGrndArrayH));
					PutMessage('Couldn ''t allocate array for   background ');
					exit(BackGround)
				end;
			HLock(Handle(BackGrndArrayH));
			BackGrndArrayP := BackGrndArrayH^;
			name := concat(copy(name, 1, 8), '-BkGnd');
			if NewPicWindow(name, widthNCCD, heightNCCD) then begin
					with Info^ do begin
							ScaleToFitWindow := true;
							LUTMode := GrayScale;
							ScaleToFitWindow := true;
							LUTMode := GrayScale;
							Count := SizeOf(integer) * ImageSize;
							BlockMove(Ptr(AFMMDataArrayP), Ptr(BackGrndArrayP), Size(Count));
							min := 32000;
							OpenBusyBox('      Calculating Background');
							LineOffset := 0;
							imax := nlines - imagBottom - 1;
							jmin := imagLeft;
							j1 := nSmooth div 2 + 1 + imagLeft;
							j2 := PixelsPerLine - imagRight - (nSmooth div 2 + 1);
							jmax := PixelsPerLine - 1 - imagRight;
							LineOffset := imagTop * PixelsPerLine;
							for i := imagTop to imax do begin
									for j := imagLeft to j1 do begin
											aNumber := 0;
											kmax := j - imagLeft;
											kmin := -kmax;
											for k := kmin to kmax do begin
													aNumber := aNumber + AFMMDataArrayP^[LineOffset + j + k];
												end;
											aNumber := round(aNumber / (kmax - kmin + 1));
											BackgrndArrayP^[LineOffset + j] := aNumber;
{aLine[j] := BAnd($FF, round(aNumber * ScaleFactor));}
										end;
									for j := j1 to j2 do begin
											aNumber := 0;
											kmax := nSmooth div 2;
											kmin := -kmax;
											for k := kmin to kmax do begin
													aNumber := aNumber + AFMMDataArrayP^[LineOffset + j + k];
												end;
											aNumber := round(aNumber / (kmax - kmin + 1));
											BackgrndArrayP^[LineOffset + j] := aNumber;
{aLine[j] := BAnd($FF, round(aNumber * ScaleFactor));}
										end;
									for j := j2 to jmax do begin
											aNumber := 0;
											kmax := jmax - j;
											kmin := -kmax;
											for k := kmin to kmax do begin
													aNumber := aNumber + AFMMDataArrayP^[LineOffset + j + k];
												end;
											aNumber := round(aNumber / (kmax - kmin + 1));
											BackgrndArrayP^[LineOffset + j] := aNumber;
{aLine[j] := BAnd($FF, round(aNumber * ScaleFactor));}
										end;
									LineOffset := LineOffset + PixelsPerLine;
{PutLine(0, i, PixelsPerLine, aLine);}
									DoBusyBox(i, imax);
									if CommandPeriod then begin
											HUnLock(Handle(BackGrndArrayH));
											DisposHandle(Handle(BackGrndArrayH));
											CloseBusyBox;
											beep;
											exit(Background)
										end;
								end; {i}
							CloseBusyBox;
{InvertPic;}
{UpdatePicWindow;}
							Min := 32000;
							Max := -32000;
							LineOffset := imagTop * PixelsPerLine;
							for i := imagTop to imax do begin
									for j := imagLeft to jmax do begin
											aNumber := AFMMDataArrayP^[LineOffset + j] - BackgrndArrayP^[LineOffset + j];
											BackgrndArrayP^[LineOffset + j] := aNumber;
											if aNumber < Min then
												Min := aNumber;
											if aNumber > Max then
												Max := aNumber;
										end;
									LineOffset := LineOffset + PixelsPerLine;
								end;
							ScaleFactor := 256 / (Max - min);
							LineOffset := 0;
							imax := nlines - 1;
							jmax := PixelsPerLine - 1;
							for i := 0 to imax do begin
									for j := 0 to jmax do begin
											aNumber := round((BackgrndArrayP^[LineOffset + j] - min) * ScaleFactor);
											aLine[j] := aNumber;
											if aNumber < 0 then
												aLine[j] := 0
											else if aNumber > 255 then
												aLine[j] := 255;
										end;
									LineOffset := LineOffset + PixelsPerLine;
									PutLine(0, i, PixelsPerLine, aLine);
								end;
							if ImageSize > UndoBufSize then
								PutWarning;
						end;
					SetupUndo;
					InvertPic;
					UpdatePicWindow;
					HUnLock(Handle(BackGrndArrayH));
					DisposHandle(Handle(BackGrndArrayH));
				end;
		end;


		var
			i, j: integer;
	begin
		OpenNCCDFile := false;
		AFMMDataArrayH := AFMDataArrayHandle(NewHandle(sizeof(AFMDataArray)));
		if AFMMDataArrayH = nil then begin
				DisposHandle(Handle(AFMMDataArrayH));
				PutMessage('Sorry, couldn'' t allocate DataArray ');
				exit(OpenNCCDFile)
			end;
		if not InputOptionsSet then begin
				InputOptionsSet := TRUE;
				To0 := 0;
				To255 := 16384;
				LowerCutOff := 1.5;
				UpperCutOff := 1.5;
				SubtrBackgrnd := false;
				ShowOriginal := true;
{NCCDScaling := MinToMaxScale;}
				NCCDScaling := GaussScale;
			end;
		if OptionKeyDown or OptionKeyWasDown then
			GetNCCDInputOptions;{(LowerCutOff, UpperCutOff, SubtrBackgrnd)}
		ShowWatch;
		err := fsopen(fname, vNum, f);
		if err <> 0 then begin
				PutMessage('Sorry, error opening file');
				exit(OpenNCCDFile);
			end;
		count := NCCDHeaderSize;
		err := FSRead(f, count, @NCCD_Header);
		p := ptr(longint(@NCCD_Header) + $100);
		p^ := 255;
		ReadString(stringPtr(p)^, widthNCCD);
		p := ptr(longint(@NCCD_Header) + $150);
		p^ := 255;
		ReadString(stringPtr(p)^, heightNCCD);
		heightNCCD := Round(heightNCCD);
		Count := NCCDHeaderSize;
		err := SetFPos(f, fsFromStart, Count);
		Count := SizeOf(integer) * Longint(widthNCCD) * heightNCCD;
		err := fsread(f, Count, ptr(AFMMDataArrayH^));
		if err <> NoErr then begin
				PutMessage('Error while reading data , Unexpected end of data');
				err := fsclose(f);
				DisposHandle(Handle(AFMMDataArrayH));
				err := CloseAWindow(FrontWindow);
				exit(OpenNCCDFile);
			end;
		err := fsclose(f);
		SaveInfo := Info;
		ResetGrayMap;
		name := Copy(fname, 1, 8);
		if NewPicWindow(name, widthNCCD, heightNCCD) then begin
				with Info^ do begin
						ScaleToFitWindow := true;
						LUTMode := GrayScale;
						Hlock(handle(AFMMDataArrayH));
						AFMMDataArrayP := AFMMDataArrayH^;
						LineOffset := imagTop * PixelsPerLine;
						imax := nLines - imagBottom - 1;
						jmax := PixelsPerLine - imagRight - 1;
						if ShowOriginal then begin
								case NCCDScaling of
									FixedScale: 
										begin
											OpenBusyBox('rescaling image');
											for i := imagTop to imax do begin
													for j := imagLeft to jmax do begin
															IntValue := AFMMDataArrayP^[LineOffset + j];
															swap2bytes(IntValue);
															AFMMDataArrayP^[LineOffset + j] := IntValue;
														end;
													LineOffset := LineOffset + PixelsPerLine;
													DoBusyBox(i, nlines);
												end;
											Min := To0;
											Max := To255;
											CloseBusyBox;
										end;
									GaussScale: 
										begin
											OpenBusyBox('rescaling image');
											mean := 0;
											nPixels := 0;
											LineOffset := imagTop * PixelsPerLine;
											for i := imagTop to imax do begin
													for j := imagLeft to jmax do begin
															IntValue := AFMMDataArrayP^[LineOffset + j];
															swap2bytes(IntValue);
															AFMMDataArrayP^[LineOffset + j] := IntValue;
															Mean := Mean + IntValue;
															nPixels := nPixels + 1;
														end;
													LineOffset := LineOffset + PixelsPerLine;
													DoBusyBox(i, 2 * nlines);
												end;
											mean := mean / nPixels;
											StdDev := 0;
											LineOffset := imagTop * PixelsPerLine;
											for i := imagTop to imax do begin
													for j := imagLeft to jmax do begin
															StdDev := StdDev + sqr(AFMMDataArrayP^[LineOffset + j] - mean);
														end;
													LineOffset := LineOffset + PixelsPerLine;
													DoBusyBox(i + nLines, 2 * nlines);
												end;
											StdDev := sqrt(StdDev / npixels);
											Min := round(mean - LowerCutOff * StdDev);
											Max := round(mean + UpperCutOff * StdDev);
											CloseBusyBox;
										end;
									MinToMaxScale: 
										begin
											Min := 30000;
											Max := -30000;
											for i := imagTop to imax do begin
													for j := imagLeft to jmax do begin
															IntValue := AFMMDataArrayP^[LineOffset + j];
															swap2bytes(IntValue);
															AFMMDataArrayP^[LineOffset + j] := IntValue;
															if IntValue < Min then
																Min := IntValue;
															if IntValue > Max then
																Max := IntValue;
														end;
													LineOffset := LineOffset + PixelsPerLine;
												end;
										end;
								end;{case}
								ScaleFactor := 256 / (Max - Min);
								LineOffset := 0;
								imax := nlines - 1;
								jmax := PixelsPerLine - 1;
								for i := 0 to imax do begin
										for j := 0 to jmax do begin
												aNumber := round((AFMMDataArrayP^[LineOffset + j] - min) * ScaleFactor);
												aLine[j] := aNumber;
												if aNumber < 0 then
													aLine[j] := 0
												else if aNumber > 255 then
													aLine[j] := 255;
											end;
										LineOffset := LineOffset + PixelsPerLine;
										PutLine(0, i, PixelsPerLine, aLine);
									end;
								if ImageSize > UndoBufSize then
									PutWarning;
{Calibrate image}
								if ImportCalibrate then begin
										fit := StraightLine;
										nCoefficients := 2;
										coefficient[1] := max;
										coefficient[2] := (min - max) / 255;
										calibrated := true;
									end;
								SetupUndo;
								InvertPic;
{UpdatePicWindow;}
							end {if ShowOriginal}
						else begin
								LineOffset := imagTop * PixelsPerLine;
								for i := imagTop to imax do begin
										for j := imagLeft to jmax do begin
												IntValue := AFMMDataArrayP^[LineOffset + j];
												swap2bytes(IntValue);
												AFMMDataArrayP^[LineOffset + j] := IntValue;
											end;
										LineOffset := LineOffset + PixelsPerLine;
									end;
								err := CloseAWindow(frontWindow);
							end;{if ShowOriginal}
					end;{with Info^}
			end;{if NewPicWindow}
		if SubtrBackgrnd then
			BackGround;
		HUnlock(handle(AFMMDataArrayH));
		OpenNCCDFile := true;
		DisposHandle(Handle(AFMMDataArrayH));
	end;


end.