unit User;

{This module is the place to put user additions to Image. You will need }
{to uncomment the call to InitUser in Image.p.}


interface

	uses
		QuickDraw, Palettes, PrintTraps, globals, Utilities, Graphics, File3, File1, FFT, ThreeDPlot, Correlation, CShade;


	procedure InitUser;
	procedure DoUserMenuEvent (MenuItem: integer);


implementation


	const
		DoFFTItem = 1;
		HorizontalFFTItem = 6;
		PhasesItem = 7;
		FilterItem = 3;
		Restore_Item = 4;
		DoBackFFTItem = 2;
		DoCorrelationItem = 9;
		SubOffItem = 14;
		DoPlot3DItem = 11;
		ShadeItem = 12;
		BlowUpItem = 15;
		AddScaleItem = 16;
		BlackPhotoModeItem = 17;


		LineFilter = 1;
		LineFit = 2;
		PlaneFilter = 3;
		PlaneFit = 4;
		ColumnFilter = 5;
		ColumnFit = 6;
		ParabolicFit = 99;

		NegButton = 6;

		ScaleDLOG = 2300;
		ScaleOk = 1;
		ScaleCancel = 2;
		ScaleText = 5;

		ShadeDLOG = 29180;
		ShadeStepMNU = 31559;
		Viewer = 5;
		Light = 6;
		RView = 9;
		RLight = 10;
		HFactor = 1;
		ShadeStep = 2;
		Ok = 13;
		Cancel = 14;
		PositionDLOG = 2900;
		PositionOk = 1;
		PositionCancel = 2;

		SubtractDLOG = 2800;
		SubOk = 1;
		SubCancel = 2;
		LineO = 3;
		LineF = 4;
		ColumnO = 5;
		ColumnF = 6;
		PlaneF = 7;
		ParabolicF = 8;
		UseMask = 9;
		IgnoreSel = 11;
		IgnoreNonSel = 10;

	type
		TNvector = array[1..5] of double;
		TNmatrix = array[1..5] of TNvector;
		glindx = array[1..5] of integer;
		glnarray = array[1..5] of double;
		glnpbynp = array[1..5, 1..5] of double;

	var
		x_viewer, y_viewer, z_viewer: longint;
		x_light, y_light, z_light: longint;
		ThetaV, ThetaL, PhiV, PhiL, HeightFactor: real;
		Step, RadiusV, RadiusL, Choice: integer;
		NegPos, Select, Mask: boolean;

	procedure InitUser;
		var
			PhiV1, PhiL1: real;

	begin
		FFTArrayH := FFTArrayHandle(NewHandle(sizeof(FFTArray)));
		ReFFTArrayH := FFTArrayHandle(NewHandle(sizeof(FFTArray)));
		SavedPictH := SavedPictHandle(NewHandle(sizeof(SavedPict)));
		if ((FFTArrayH = nil) or (ReFFTArrayH = nil) or (SavedPictH = nil)) then
			PutMessage('There is not enough Memory  to allocate the buffers needed  for FFT');
		if FFTArrayH = nil then
			DisposHandle(Handle(FFTArrayH));
		if ReFFTArrayH = nil then
			DisposHandle(Handle(ReFFTArrayH));
		if SavedPictH = nil then
			DisposHandle(Handle(SavedPictH));
		with FFTInfo do
			FFT_Done := false;
		UserMenuH := GetMenu(UserMenu);
		InsertMenu(UserMenuH, 0);
		DrawMenuBar;
		FFTFilterComponents := 2;
		FFTFilterNoise := 75;
		ThreeDHeightFactor := 1;
		NegPos := true;
		step := 2;
		RadiusV := 5000;
		RadiusL := 5000;
		HeightFactor := 50;
		ThetaV := 0;
		PhiV := 0;
		ThetaL := 0;
		PhiL := 0;
		PhiV1 := PhiV - 1.570796;
		PhiL1 := PhiL - 1.570796;
		z_viewer := trunc(RadiusV * cos(ThetaV) * sin(PhiV1));
		x_viewer := trunc(RadiusV * cos(ThetaV) * cos(PhiV1));
		y_viewer := trunc(RadiusV * sin(ThetaV));
		z_light := trunc(RadiusL * cos(ThetaL) * sin(PhiL1));
		x_light := trunc(RadiusL * cos(ThetaL) * cos(PhiL1));
		y_light := trunc(RadiusL * sin(ThetaL));
		HeightFactor := 1;
		Choice := LineFilter;
		Select := true;
		Mask := false;
		Transform := SubtractOffset;
		Scaling := Auto;
		Filt := Gauss5;
	end;

	procedure SetReadWriteInfo (var ReadInfo, WriteInfo: Infoptr);

		var
			searchname: string[30];
			i: integer;
			TempInfo: InfoPtr;
	begin
		WriteInfo := Info;
		ReadInfo := Info;
		searchname := info^.title;
		searchname := concat('Copy of ', searchname);
		for i := 1 to nPics do begin
				TempInfo := pointer(WindowPeek(PicWindow[i])^.RefCon);
				if TempInfo^.Title = searchname then
					ReadInfo := TempInfo;
			end;
	end;



	procedure TransFormLine (Operation: integer);
		var
			S: double;
			S_x: double;
			S_xx: double;
			S_xy: double;
			S_y: double;
			S_yy: double;
			S_z: double;
			S_zx: double;
			S_zy: double;
			S_zz: double;
			delta_S: double;
			N_x: longint;
			N_y: longint;
			delta_x: longint;
			delta_y: longint;
			aNumber: longint;
			mean: longint;
			i, j: longint;
			Line, Line2: Linetype;
			a, b, c: double;
			ReadInfo, WriteInfo: Infoptr;
			dummy: integer;

	begin
		if nPics < 1 then
			PutMessage('You need a Picture  to run this Option')
		else begin
				if mask then begin
						SetReadWriteInfo(ReadInfo, WriteInfo);
						if (ReadInfo = WriteInfo) then begin
								putmessage('Copy cannot be found');
								exit(TransformLine);
							end
					end
				else begin
						WriteInfo := Info;
						with info^ do
							BlockMove(PicBaseAddr, UndoBuf, PixMapSize);
						setport(Grafptr(info^.osport));
						if WriteInfo^.RoiShowing then begin
								eraserect(info^.RoiRect);
							end;
						with info^ do
							BlockMove(PicBaseAddr, ClipBuf, PixMapSize);
						ClipBufInfo^ := Info^;
						ClipBufInfo^.PicBaseAddr := Clipbuf;
						with info^ do
							BlockMove(UndoBuf, PicBaseAddr, PixMapSize);
						readinfo := clipbufinfo;
						info := WriteInfo;
						killroi;
						setport(Grafptr(writeinfo^.osport));
					end;
				SetupUndo;
				WhatToUndo := UndoFilter;
				UndoInfoRec := Writeinfo^;
				UndoInfo := @UndoInfoRec;
				Info := ReadInfo;
				case Operation of

					LineFilter: 
						begin
							case select of
								true: 
									begin
										with info^ do begin
												ShowWatch;
												for i := 0 to (nlines - 1) do begin
														Info := readinfo;
														GetLine(0, i, PixelsPerLine, Line);
														aNumber := 0;
														S := 0;
														for j := 0 to (PixelsPerLine - 1) do begin
																if (Line[j]) <> 0 then begin
																		aNumber := aNumber + Line[j];
																		S := S + 1;
																	end;
															end;

														if s = 0 then
															s := 1;
														mean := 127 - trunc(aNumber / S);
														Info := Writeinfo;
														GetLine(0, i, PixelsPerLine, Line);
														for j := 0 to (PixelsPerLine - 1) do begin
																aNumber := Line[j] + mean;
																if aNumber < 0 then
																	aNumber := 0;
																if aNumber > 255 then
																	aNumber := 255;
																Line[j] := trunc(aNumber)
															end;
														PutLine(0, i, PixelsPerLine, Line);
													end;
												UpdatePicWindow;
											end;
									end;
								false: 
									begin
										with info^ do begin
												ShowWatch;
												for i := 0 to (nlines - 1) do begin
														Info := readinfo;
														GetLine(0, i, PixelsPerLine, Line);
														Info := Writeinfo;
														GetLine(0, i, PixelsPerLine, Line2);
														aNumber := 0;
														S := 0;
														for j := 0 to (PixelsPerLine - 1) do begin
																if (Line[j]) = 0 then begin
																		aNumber := aNumber + Line2[j];
																		S := S + 1;
																	end;
															end;

														if s = 0 then
															s := 1;
														mean := 127 - trunc(aNumber / S);
														Info := Writeinfo;
														GetLine(0, i, PixelsPerLine, Line);
														for j := 0 to (PixelsPerLine - 1) do begin
																aNumber := Line[j] + mean;
																if aNumber < 0 then
																	aNumber := 0;
																if aNumber > 255 then
																	aNumber := 255;
																Line[j] := trunc(aNumber)
															end;
														PutLine(0, i, PixelsPerLine, Line);
													end;
												UpdatePicWindow;
											end;
									end;
							end;
						end;

					LineFit: 
						begin
							case select of
								true: 
									begin
										with info^ do begin
												ShowWatch;
												for i := 0 to (nlines - 1) do begin
														Info := ReadInfo;
														GetLine(0, i, PixelsPerLine, Line);
														S_xy := 0;
														S_y := 0;
														S := 0;
														S_x := 0;
														S_xx := 0;
														for j := 0 to (PixelsPerLine - 1) do begin
																aNumber := Line[j];
																if aNumber <> 0 then begin
																		S := S + 1;
																		S_x := S_x + j;
																		S_xx := S_xx + j * j;
																		S_y := S_y + aNumber;
																		S_xy := S_xy + j * aNumber;
																	end;
															end;
														delta_S := (S * S_xx - S_x * S_x);
														if delta_S = 0 then
															delta_S := 1;
														b := (S * S_xy - S_x * S_y) / delta_S;
														a := (S_xx * S_y - S_x * S_xy) / delta_S;
														Info := WriteInfo;
														GetLine(0, i, PixelsPerLine, Line);
														for j := 0 to (PixelsPerLine - 1) do begin
																aNumber := round(Line[j] - a - b * j) + 127;
																if aNumber < 0 then
																	aNumber := 0;
																if aNumber > 255 then
																	aNumber := 255;
																Line[j] := trunc(aNumber);
															end;
														PutLine(0, i, PixelsPerLine, Line);
													end;
												UpdatePicWindow;
											end;
									end;

								false: 
									begin
										with info^ do begin
												ShowWatch;
												for i := 0 to (nlines - 1) do begin
														Info := ReadInfo;
														GetLine(0, i, PixelsPerLine, Line);
														Info := WriteInfo;
														GetLine(0, i, PixelsPerLine, Line2);
														S_xy := 0;
														S_y := 0;
														S := 0;
														S_x := 0;
														S_xx := 0;
														for j := 0 to (PixelsPerLine - 1) do begin
																aNumber := Line[j];
																if aNumber = 0 then begin
																		aNumber := Line2[j];
																		S := S + 1;
																		S_x := S_x + j;
																		S_xx := S_xx + j * j;
																		S_y := S_y + aNumber;
																		S_xy := S_xy + j * aNumber;
																	end;
															end;
														delta_S := (S * S_xx - S_x * S_x);
														if delta_S = 0 then
															delta_S := 1;
														b := (S * S_xy - S_x * S_y) / delta_S;
														a := (S_xx * S_y - S_x * S_xy) / delta_S;
														Info := WriteInfo;
														GetLine(0, i, PixelsPerLine, Line);
														for j := 0 to (PixelsPerLine - 1) do begin
																aNumber := round(Line[j] - a - b * j) + 127;
																if aNumber < 0 then
																	aNumber := 0;
																if aNumber > 255 then
																	aNumber := 255;
																Line[j] := trunc(aNumber);
															end;
														PutLine(0, i, PixelsPerLine, Line);
													end;
												UpdatePicWindow;
											end;
									end;
							end;
						end;


					PlaneFilter: 
						begin
							with info^ do begin
									aNumber := 0;
									S := 0;
									ShowWatch;
									Info := ReadInfo;
									for i := 0 to (nlines - 1) do begin
											GetLine(0, i, PixelsPerLine, Line);
											for j := 0 to (PixelsPerLine - 1) do begin
													if Line[j] <> 0 then begin
															aNumber := aNumber + Line[j];
															s := s + 1;
														end;
												end;
										end;
									if s = 0 then
										s := 1;
									mean := trunc(127 - aNumber / (S));
									Info := WriteInfo;
									for i := 0 to (nlines - 1) do begin
											GetLine(0, i, PixelsPerLine, Line);
											for j := 0 to (PixelsPerLine - 1) do begin
													aNumber := Line[j] + mean;
													if aNumber < 0 then
														aNumber := 0;
													if aNumber > 255 then
														aNumber := 255;
													Line[j] := trunc(aNumber)
												end;
											PutLine(0, i, PixelsPerLine, Line);
										end;
								end;
							UpdatePicWindow;
						end;

					PlaneFit: 
						begin
							with info^ do begin
									N_x := PixelsPerLine;
									N_y := nlines;
									S_z := 0.0;
									S_zx := 0.0;
									S_zy := 0.0;
									S := 0;
									S_x := 0;
									S_xx := 0;
									S_xy := 0;
									S_y := 0;
									S_yy := 0;

									ShowWatch;
									case select of
										true: 
											begin
												Info := ReadInfo;
												for i := 0 to (N_y - 1) do begin
														GetLine(0, i, N_x, Line);
														for j := 0 to (N_x - 1) do begin
																aNumber := Line[j];
																if aNumber <> 0 then begin
																		S_z := S_z + aNumber;
																		S_zx := S_zx + (j) * aNumber;
																		S_zy := S_zy + (i) * aNumber;
																		s := s + 1;
																		s_x := s_x + j;
																		s_xx := s_xx + j * j;
																		s_xy := s_xy + i * j;
																		s_y := s_y + i;
																		s_yy := s_yy + i * i;
																	end;
															end;
													end;
											end;
										false: 
											begin
												for i := 0 to (N_y - 1) do begin
														Info := ReadInfo;
														GetLine(0, i, N_x, Line);
														Info := WriteInfo;
														GetLine(0, i, N_x, Line2);
														for j := 0 to (N_x - 1) do begin
																aNumber := Line[j];
																if aNumber = 0 then begin
																		aNumber := Line2[j];
																		S_z := S_z + aNumber;
																		S_zx := S_zx + (j) * aNumber;
																		S_zy := S_zy + (i) * aNumber;
																		s := s + 1;
																		s_x := s_x + j;
																		s_xx := s_xx + j * j;
																		s_xy := s_xy + i * j;
																		s_y := s_y + i;
																		s_yy := s_yy + i * i;
																	end;
															end;
													end;
											end;
									end;
									c := ((S_z * S_x - S * S_zx) * (S_x * S_y - S * S_xy) - (S_z * S_y - S * S_zy) * (S_x * S_x - S * S_xx)) / ((S_x * S_y - S * S_xy) * (S_x * S_y - S * S_xy) - (S_y * S_y - S * S_yy) * (S_x * S_x - S * S_xx));
									b := ((S_z * S_x - S * S_zx) - c * (S_x * S_y - S_xy * S)) / (S_x * S_x - S * S_xx);
									a := (S_z / S) - b * (S_x / S) - c * (S_y / S);
									Info := WriteInfo;
									for i := 0 to (N_y - 1) do begin
											GetLine(0, i, N_x, Line);
											for j := 0 to (N_x - 1) do begin
													aNumber := round((Line[j] + 127 - a - b * (j + 1) - c * (i + 1)));
													if aNumber < 0 then
														aNumber := 0;
													if aNumber > 255 then
														aNumber := 255;
													Line[j] := trunc(aNumber)
												end;
											PutLine(0, i, N_x, Line);
										end;
									UpdatePicWindow;
								end;
						end;

					ColumnFilter: 
						begin
							case select of
								true: 
									begin
										with info^ do begin
												ShowWatch;
												for i := 0 to (PixelsPerLine - 1) do begin
														Info := ReadInfo;
														GetColumn(i, 0, nlines, Line);
														aNumber := 0;
														S := 0;
														for j := 0 to (nlines - 1) do begin
																if Line[j] <> 0 then begin
																		aNumber := aNumber + Line[j];
																		S := S + 1;
																	end;
															end;
														if S = 0 then
															S := 1;
														mean := 127 - trunc(aNumber / S);
														Info := WriteInfo;
														GetColumn(i, 0, nlines, Line);
														for j := 0 to (nlines - 1) do begin
																aNumber := Line[j] + mean;
																if aNumber < 0 then
																	aNumber := 0;
																if aNumber > 255 then
																	aNumber := 255;
																Line[j] := trunc(aNumber)
															end;
														PutColumn(i, 0, nlines, Line);
													end;
												UpdatePicWindow;
											end;
									end;
								false: 
									begin
										with info^ do begin
												ShowWatch;
												for i := 0 to (PixelsPerLine - 1) do begin
														Info := ReadInfo;
														GetColumn(i, 0, nlines, Line);
														Info := WriteInfo;
														GetColumn(i, 0, nlines, Line2);
														aNumber := 0;
														S := 0;
														for j := 0 to (nlines - 1) do begin
																if Line[j] = 0 then begin
																		aNumber := aNumber + Line2[j];
																		S := S + 1;
																	end;
															end;
														if S = 0 then
															S := 1;
														mean := 127 - trunc(aNumber / S);
														Info := WriteInfo;
														GetColumn(i, 0, nlines, Line);
														for j := 0 to (nlines - 1) do begin
																aNumber := Line[j] + mean;
																if aNumber < 0 then
																	aNumber := 0;
																if aNumber > 255 then
																	aNumber := 255;
																Line[j] := trunc(aNumber)
															end;
														PutColumn(i, 0, nlines, Line);
													end;
												UpdatePicWindow;
											end;
									end;
							end;
						end;


					ColumnFit: 
						begin
							case select of
								true: 
									begin
										with info^ do begin
												ShowWatch;
												for i := 0 to (PixelsPerLine - 1) do begin
														Info := ReadInfo;
														GetColumn(i, 0, nlines, Line);
														S_xy := 0;
														S_x := 0;
														S := 0;
														S_y := 0;
														S_yy := 0;

														for j := 0 to (nlines - 1) do begin
																aNumber := Line[j];
																if aNumber <> 0 then begin
																		S_x := S_x + aNumber;
																		S_xy := S_xy + j * aNumber;
																		S := S + 1;
																		S_y := S_y + j;
																		S_yy := s_yy + j * j;
																	end;
															end;
														delta_S := (S * S_yy - S_y * S_y);
														if delta_S = 0 then
															delta_S := 1;
														b := (S * S_xy - S_y * S_x) / delta_S;
														a := (S_yy * S_x - S_y * S_xy) / delta_S;
														Info := WriteInfo;
														GetColumn(i, 0, nlines, Line);
														for j := 0 to (nlines - 1) do begin
																aNumber := round(Line[j] - a - b * j) + 127;
																if aNumber < 0 then
																	aNumber := 0;
																if aNumber > 255 then
																	aNumber := 255;
																Line[j] := trunc(aNumber);
															end;
														PutColumn(i, 0, nlines, Line);
													end;
												UpdatePicWindow;
											end;
									end;
								false: 
									begin
										with info^ do begin
												ShowWatch;
												for i := 0 to (PixelsPerLine - 1) do begin
														Info := ReadInfo;
														GetColumn(i, 0, nlines, Line);
														Info := WriteInfo;
														GetColumn(i, 0, nlines, Line2);
														S_xy := 0;
														S_x := 0;
														S := 0;
														S_y := 0;
														S_yy := 0;

														for j := 0 to (nlines - 1) do begin
																aNumber := Line[j];
																if aNumber = 0 then begin
																		aNumber := Line2[j];
																		S_x := S_x + aNumber;
																		S_xy := S_xy + j * aNumber;
																		S := S + 1;
																		S_y := S_y + j;
																		S_yy := s_yy + j * j;
																	end;
															end;
														delta_S := (S * S_yy - S_y * S_y);
														if delta_S = 0 then
															delta_S := 1;
														b := (S * S_xy - S_y * S_x) / delta_S;
														a := (S_yy * S_x - S_y * S_xy) / delta_S;
														Info := WriteInfo;
														GetColumn(i, 0, nlines, Line);
														for j := 0 to (nlines - 1) do begin
																aNumber := round(Line[j] - a - b * j) + 127;
																if aNumber < 0 then
																	aNumber := 0;
																if aNumber > 255 then
																	aNumber := 255;
																Line[j] := trunc(aNumber);
															end;
														PutColumn(i, 0, nlines, Line);
													end;
												UpdatePicWindow;
											end;
									end;
							end;
						end;
				end;
			end;
	end;



	procedure Get3Doptions (var item: integer);
		var
			mylog: DialogPtr;
			OldNegPos: boolean;
			i: integer;
	begin
		mylog := GetNewDialog(ScaleDLOG, nil, pointer(-1));
		OldNegPos := NegPos;
		OutlineButton(mylog, ScaleOK, 16);
		SetDReal(mylog, ScaleText, ThreeDHeightFactor, 2);
		if not (NegPos) then
			SetDialogItem(mylog, Negbutton, 1);

		repeat
			ModalDialog(nil, item);
			if item = Negbutton then begin
					SetDialogItem(mylog, Negbutton, 0);
					NegPos := not (NegPos);
					if not (NegPos) then
						SetDialogItem(mylog, Negbutton, 1);
				end;

		until (item = ScaleOk) or (item = ScaleCancel);

		if item = ScaleOk then begin
				ThreeDHeightFactor := GetDReal(mylog, ScaleText);
			end
		else
			NegPos := OldNegPos;
		DisposDialog(mylog);
	end;


	procedure ShowButtons (mylog: Dialogptr; item: integer);

	begin
		SetDialogItem(mylog, LineO, 0);
		SetDialogItem(mylog, LineF, 0);
		SetDialogItem(mylog, ColumnO, 0);
		SetDialogItem(mylog, ColumnF, 0);
		SetDialogItem(mylog, PlaneF, 0);
		SetDialogItem(mylog, ParabolicF, 0);
		SetDialogItem(mylog, item, 1);
	end;


	procedure ShowSelandMask (mylog: Dialogptr);

	begin
		if mask then
			SetDialogItem(mylog, usemask, 1)
		else
			SetDialogItem(mylog, usemask, 0);
		if select then begin
				SetDialogItem(mylog, IgnoreSel, 1);
				SetDialogItem(mylog, IgnoreNonSel, 0);
			end
		else begin
				SetDialogItem(mylog, IgnoreSel, 0);
				SetDialogItem(mylog, IgnoreNonSel, 1);
			end
	end;



	procedure GetSubtractOpts (var item: integer);
		var
			mylog: DialogPtr;
			Oldchoice: integer;
			oldmask, oldselect: boolean;
			i: integer;
	begin
		mylog := GetNewDialog(SubtractDLOG, nil, pointer(-1));
		OutlineButton(mylog, SubOK, 16);
		oldchoice := choice;
		oldmask := mask;
		oldselect := select;
		case Choice of
			LineFilter: 
				item := LineO;
			LineFit: 
				item := LineF;
			ColumnFilter: 
				item := ColumnO;
			ColumnFit: 
				item := ColumnF;
			PlaneFit: 
				item := PlaneF;
			ParabolicFit: 
				item := ParabolicF;
		end;
		ShowButtons(mylog, item);
		ShowSelandMask(mylog);
		repeat
			ModalDialog(nil, item);
			case item of
				LineO: 
					begin
						Choice := LineFilter;
						ShowButtons(mylog, item);
					end;
				LineF: 
					begin
						Choice := LineFit;
						ShowButtons(mylog, item);
					end;
				ColumnO: 
					begin
						Choice := columnFilter;
						ShowButtons(mylog, item);
					end;
				ColumnF: 
					begin
						Choice := ColumnFit;
						ShowButtons(mylog, item);
					end;
				PlaneF: 
					begin
						Choice := PlaneFit;
						ShowButtons(mylog, item);
					end;
				ParabolicF: 
					begin
						Choice := ParabolicFit;
						ShowButtons(mylog, item);
					end;
				UseMask: 
					begin
						mask := not (mask);
						ShowSelandMask(mylog);
					end;
				IgnoreSel: 
					begin
						Select := true;
						ShowSelandMask(mylog);
					end;
				IgnoreNonSel: 
					begin
						Select := false;
						ShowSelandMask(mylog);
					end;
			end;

		until (item = SubOk) or (item = SubCancel);

		if item = SubCancel then begin
				Choice := OldChoice;
				Select := Oldselect;
				mask := Oldmask;
			end;
		DisposDialog(mylog);
	end;

	procedure ShowShadeStep (dlog: DialogPtr; number: integer);
		var
			Itemtype, Temp: integer;
			BoxRect: rect;
			ItemH: handle;
			text: str255;
	begin
		GetDItem(dlog, ShadeStep, ItemType, ItemH, BoxRect);
		EraseRect(BoxRect);
		FrameRect(BoxRect);
		with Boxrect do begin
				MoveTo(left + 5, bottom);
				LineTo(right, bottom);
				LineTo(right, top + 5);
				MoveTo(left + 5, bottom - 5);
				NumToString(number, text);
				DrawString(text);
			end;
	end;

	procedure ShowCircle (mylog: DialogPtr; Box: integer; Theta, Phi: real);
		var
			TInfo: InfoPtr;
			Itemtype, midx, midy, n, i: integer;
			ItemHandle: handle;
			tport: GrafPtr;
			trect, irect: Rect;
			r, dh, dv, CapR, Ralt, Rneu, alpha: real;
			p: Point;

	begin
		GetPort(tPort);
		SetPort(mylog);
		GetDitem(myLog, Box, ItemType, itemHandle, trect);
		irect := trect;
		InsetRect(irect, -3, -3);
		EraseRect(irect);
		FrameOval(trect);
		with trect do begin
				midx := trunc((right + left) / 2);
				midy := trunc((bottom + top) / 2);
				CapR := (right - left) / 2;
				irect := trect;
				alpha := 10 * 3.1416 / 180;
				n := trunc(3.1416 / (2 * alpha));
				Ralt := CapR;
				for i := 1 to n do begin
						Rneu := CapR * cos(i * alpha);
						InsetRect(irect, trunc(Ralt - Rneu), trunc(Ralt - Rneu));
						FrameOval(irect);
						Ralt := Rneu;
					end;
				for i := 1 to 12 do begin
						moveto(midx, midy);
						Line(trunc(CapR * sin(30 * i * 3.1416 / 180)), trunc(CapR * cos(30 * i * 3.1416 / 180)));
					end;
				r := Cos(Theta) * CapR;
				dh := r * sin(Phi);
				dv := r * cos(Phi);
				p.h := midx + trunc(dh);
				p.v := midy + trunc(dv);
				if ptinrect(p, trect) then begin
					end;
				SetRect(irect, p.h - 3, p.v - 3, p.h + 3, p.v + 3);
				FillOval(irect, black);
			end;
		Setport(tport);
	end;

	function HandleCircles (mylog: DialogPtr; var Event: EventRecord; var item: integer): boolean;
		var
			Itemtype, aux, Position, Control: integer;
			ItemHandle: handle;
			trect: Rect;
			auxDLOG: DialogPtr;
			auxItem: integer;
			thePoint: Point;
			tport: GrafPtr;
			CapR, midx, midy, r, dx, dy, px, py: real;
			charcode: longint;

	begin
		HandleCircles := false;

		if IsDialogEvent(event) then
			if DialogSelect(event, auxDLOG, auxItem) then begin
					GetPort(tPort);
					SetPort(auxDLOG);
					thePoint := Event.where;
					GlobalToLocal(thePoint);
					case auxitem of
						Viewer: 
							begin
								GetDitem(mylog, Viewer, ItemType, itemHandle, trect);
								with trect do begin
										midx := trunc((right + left) / 2);
										midy := trunc((bottom + top) / 2);
										px := thePoint.h;
										py := thePoint.v;
										dx := px - midx;
										dy := py - midy;
										if (dx = 0) and (dy = 0) then begin
												dy := 0.1;
												dx := 0.1
											end;
										PhiV := arctan(dx / dy);
										if dy < 0 then
											PhiV := 3.141592654 + PhiV;
										r := sqrt(dx * dx + dy * dy);
										CapR := (right - left) / 2;
										if abs(r) > (right - left) / 2 then
											r := (right - left) / 2 * (r / abs(r));
										ThetaV := arctan(sqrt(CapR * CapR - r * r) / r);
										ShowCircle(mylog, Viewer, ThetaV, PhiV);
									end;
							end;
						Light: 
							begin
								GetDitem(mylog, Light, ItemType, itemHandle, trect);
								with trect do begin
										midx := trunc((right + left) / 2);
										midy := trunc((bottom + top) / 2);
										px := thePoint.h;
										py := thePoint.v;
										dx := px - midx;
										dy := py - midy;
										if (dx = 0) and (dy = 0) then begin
												dy := 0.1;
												dx := 0.1
											end;
										PhiL := arctan(dx / dy);
										if dy < 0 then
											PhiL := 3.141592654 + PhiL;
										r := sqrt(dx * dx + dy * dy);
										CapR := (right - left) / 2;
										if abs(r) > (right - left) / 2 then
											r := (right - left) / 2 * (r / abs(r));
										ThetaL := arctan(sqrt(CapR * CapR - r * r) / r);
										ShowCircle(mylog, Light, ThetaL, PhiL);
									end;
							end;
						otherwise
							begin
								item := auxItem;
								HandleCircles := true;
							end;
					end;
					SetPort(tPort);
				end;
		if event.what = keydown then begin
				charcode := BitAnd(event.message, charCodemask);
				if charcode = $0d then begin
						Item := Ok;
						HandleCircles := true
					end;
			end;
	end;

	function HandleShadeStep (dlog: DialogPtr; Step: Integer): integer;
		var
			Itemtype, Result, number2: integer;
			BoxRect: rect;
			PopUpMenuH: MenuHandle;
			ItemH: handle;
			pt: Point;

	begin
		GetDItem(dlog, ShadeStep, ItemType, ItemH, BoxRect);
		PopUpMenuH := GetMenu(ShadeStepMNU);
		InsertMenu(PopUpMenuH, -1);
		pt := BoxRect.topleft;
		LocalToGlobal(pt);
		case Step of
			1, 2, 3: 
				number2 := Step;
			5: 
				number2 := 4;
			10, 20: 
				number2 := trunc(step / 10) + 4;
		end;
		Result := PopUpMenuSelect(PopUpMenuH, pt.v, pt.h, number2);
		if Result > 0 then begin
				case Result of
					1, 2, 3: 
						HandleShadeStep := Result;
					4: 
						HandleShadeStep := 5;
					5, 6: 
						HandleShadeStep := (Result - 4) * 10;
				end;
			end
		else
			HandleShadeStep := Step;
		DeleteMenu(ShadeStepMnu);
	end;

	procedure getshadeopts (var item: integer);
		var
			mylog: DialogPtr;
			i: integer;
			PhiV1, PhiL1: real;
			tport: GrafPtr;

	begin
		mylog := GetNewDialog(ShadeDLOG, nil, pointer(-1));
		Getport(tport);
		Setport(mylog);
		OutlineButton(mylog, OK, 16);
		SetDNum(mylog, Rview, RadiusV);
		SetDNum(mylog, RLight, RadiusL);
		SetDReal(mylog, HFactor, HeightFactor, 1);
		ShowShadeStep(mylog, Step);
		ShowCircle(mylog, Viewer, ThetaV, PhiV);
		ShowCircle(mylog, Light, ThetaL, PhiL);
		repeat
			ModalDialog(@HandleCircles, item);
			case item of
				ShadeStep: 
					begin
						Step := HandleShadeStep(mylog, Step);
						ShowShadeStep(mylog, Step);
					end;
			end;
		until (item = Ok) or (item = Cancel);
		if item = Ok then begin
				HeightFactor := GetDReal(mylog, HFactor);
				RadiusL := GetDNum(mylog, RLight);
				RadiusV := GetDNum(mylog, RView);
				if RadiusV > 10000 then
					RadiusV := 10000;
				if RadiusV < 100 then
					RadiusV := 100;
				if RadiusL > 10000 then
					RadiusL := 10000;
				if RadiusL < 100 then
					RadiusL := 100;
				PhiV1 := PhiV - 1.570796;
				PhiL1 := PhiL - 1.570796;
				z_viewer := trunc(RadiusV * cos(ThetaV) * sin(PhiV1));
				x_viewer := trunc(RadiusV * cos(ThetaV) * cos(PhiV1));
				y_viewer := trunc(RadiusV * sin(ThetaV));
				z_light := trunc(RadiusL * cos(ThetaL) * sin(PhiL1));
				x_light := trunc(RadiusL * cos(ThetaL) * cos(PhiL1));
				y_light := trunc(RadiusL * sin(ThetaL));
			end;
		setport(tport);
		DisposDialog(mylog);
	end;


	procedure Determinant (Dimen: integer; Data: TNmatrix; var Det: double; var Error: byte);

		const
			TNNearlyZero = 1E-015;


		procedure Initial (Dimen: integer; var Data: TNmatrix; var Det: double; var Error: byte);
		begin
			Error := 0;
			if Dimen < 1 then
				Error := 1
			else if Dimen = 1 then
				Det := Data[1, 1];
		end;



		procedure EROswitch (var Row1: TNvector; var Row2: TNvector);
			var
				DummyRow: TNvector;
		begin
			DummyRow := Row1;
			Row1 := Row2;
			Row2 := DummyRow;
		end;


		procedure EROmultAdd (Multiplier: double; Dimen: integer; var ReferenceRow: TNvector; var ChangingRow: TNvector);
			var
				Term: integer;
		begin
			for Term := 1 to Dimen do
				ChangingRow[Term] := ChangingRow[Term] + Multiplier * ReferenceRow[Term];
		end;

		function Deter (Dimen: integer; var Data: TNmatrix): double;
			var
				PartialDeter, Multiplier: double;
				Row, ReferenceRow: integer;
				DetEqualsZero: boolean;

			procedure Pivot (Dimen: integer; ReferenceRow: integer; var Data: TNmatrix; var PartialDeter: double; var DetEqualsZero: boolean);
				var
					NewRow: integer;
			begin
				DetEqualsZero := true;
				NewRow := ReferenceRow;
				while DetEqualsZero and (NewRow < Dimen) do begin
						NewRow := Succ(NewRow);
						if ABS(Data[NewRow, ReferenceRow]) > TNNearlyZero then begin
								EROswitch(Data[NewRow], Data[ReferenceRow]);
								DetEqualsZero := false;
								PartialDeter := -PartialDeter;
							end;
					end;
			end;

		begin
			DetEqualsZero := false;
			PartialDeter := 1;
			ReferenceRow := 0;
			while not (DetEqualsZero) and (ReferenceRow < Dimen - 1) do begin
					ReferenceRow := Succ(ReferenceRow);
					if ABS(Data[ReferenceRow, ReferenceRow]) < TNNearlyZero then
						Pivot(Dimen, ReferenceRow, Data, PartialDeter, DetEqualsZero);
					if not (DetEqualsZero) then
						for Row := ReferenceRow + 1 to Dimen do
							if ABS(Data[Row, ReferenceRow]) > TNNearlyZero then begin
									Multiplier := -Data[Row, ReferenceRow] / Data[ReferenceRow, ReferenceRow];
									EROmultAdd(Multiplier, Dimen, Data[ReferenceRow], Data[Row]);
								end;
					PartialDeter := PartialDeter * Data[ReferenceRow, ReferenceRow];
				end;
			if DetEqualsZero then
				Deter := 0
			else
				Deter := PartialDeter * Data[Dimen, Dimen];
		end;

	begin
		Initial(Dimen, Data, Det, Error);
		if Dimen > 1 then
			Det := Deter(Dimen, Data);
	end;



	procedure Quad_Fit;
		var
			S: double;
			S_x: double;
			S_xx: double;
			S_xxx: double;
			S_xxxx: double;
			S_xy: double;
			S_xxy: double;
			S_xyy: double;
			S_xxyy: double;
			S_y: double;
			S_yy: double;
			S_yyy: double;
			S_yyyy: double;
			S_z: double;
			S_zx: double;
			S_zxx: double;
			S_zy: double;
			S_zyy: double;
			delta_S: double;
			N_x: longint;
			N_y: longint;
			delta_x: longint;
			delta_y: longint;
			aNumber: double;
			i, j: longint;
			Line, Line2: Linetype;
			a, b, c, d, e: double;
			det: double;
			det1: double;
			det2: double;
			det3: double;
			det4: double;
			det5: double;
			matrix: TNmatrix;
			error: byte;
			ReadInfo, WriteInfo: Infoptr;
			dummy: integer;
	begin
		if nPics < 1 then
			PutMessage('You need a Picture  to run this Option')
		else begin
				if mask then begin
						SetReadWriteInfo(ReadInfo, WriteInfo);
						if (ReadInfo = WriteInfo) then begin
								putmessage('Copy cannot be found');
								exit(Quad_Fit);
							end
					end
				else begin
						WriteInfo := Info;
						with info^ do
							BlockMove(PicBaseAddr, UndoBuf, PixMapSize);
						setport(Grafptr(info^.osport));
						if WriteInfo^.RoiShowing then begin
								eraserect(info^.RoiRect);
							end;
						with info^ do
							BlockMove(PicBaseAddr, ClipBuf, PixMapSize);
						ClipBufInfo^ := Info^;
						ClipBufInfo^.PicBaseAddr := Clipbuf;
						with info^ do
							BlockMove(UndoBuf, PicBaseAddr, PixMapSize);
						readinfo := clipbufinfo;
						info := WriteInfo;
						killroi;
						setport(Grafptr(writeinfo^.osport));
					end;
				SetupUndo;
				WhatToUndo := UndoFilter;
				UndoInfoRec := Writeinfo^;
				UndoInfo := @UndoInfoRec;
				Info := ReadInfo;
				with info^ do begin
						N_x := PixelsPerLine;
						N_y := nlines;
						S_z := 0.0;
						S_zx := 0.0;
						S_zxx := 0.0;
						S_zy := 0.0;
						S_zyy := 0.0;
						S := 0;
						S_x := 0;
						S_xx := 0;
						S_xxx := 0;
						S_xxxx := 0;
						S_xy := 0;
						S_xxy := 0;
						S_xyy := 0;
						S_xxyy := 0;
						S_y := 0;
						S_yy := 0;
						S_yyy := 0;
						S_yyyy := 0;

						ShowWatch;
						case Select of
							true: 
								begin
									Info := ReadInfo;
									for i := 0 to (N_y - 1) do begin
											GetLine(0, i, N_x, Line);
											for j := 0 to (N_x - 1) do begin
													aNumber := Line[j];
													if aNumber <> 0 then begin
															S_z := S_z + aNumber;
															S_zx := S_zx + (j) * aNumber;
															S_zxx := S_zxx + (j) * (j) * aNumber;
															S_zy := S_zy + (i) * aNumber;
															S_zyy := S_zyy + (i) * (i) * aNumber;
															S := S + 1;
															S_x := S_x + j;
															S_xx := S_xx + j * j;
															S_xxx := S_xxx + j * j * j;
															S_xxxx := s_xxxx + j * j * j * j;
															S_xy := S_xy + i * j;
															S_xxy := S_xxy + i * j * j;
															S_xyy := S_xyy + j * i * i;
															S_xxyy := S_xxyy + j * j * i * i;
															S_y := s_y + i;
															S_yy := s_yy + i * i;
															S_yyy := S_yyy + i * i * i;
															S_yyyy := S_yyyy + i * i * i * i;
														end;
												end;
										end;
								end;
							false: 
								begin
									for i := 0 to (N_y - 1) do begin
											Info := ReadInfo;
											GetLine(0, i, N_x, Line);
											Info := WriteInfo;
											GetLine(0, i, N_x, Line2);

											for j := 0 to (N_x - 1) do begin
													aNumber := Line[j];
													if aNumber = 0 then begin
															aNumber := Line2[j];
															S_z := S_z + aNumber;
															S_zx := S_zx + (j) * aNumber;
															S_zxx := S_zxx + (j) * (j) * aNumber;
															S_zy := S_zy + (i) * aNumber;
															S_zyy := S_zyy + (i) * (i) * aNumber;
															S := S + 1;
															S_x := S_x + j;
															S_xx := S_xx + j * j;
															S_xxx := S_xxx + j * j * j;
															S_xxxx := s_xxxx + j * j * j * j;
															S_xy := S_xy + i * j;
															S_xxy := S_xxy + i * j * j;
															S_xyy := S_xyy + j * i * i;
															S_xxyy := S_xxyy + j * j * i * i;
															S_y := s_y + i;
															S_yy := s_yy + i * i;
															S_yyy := S_yyy + i * i * i;
															S_yyyy := S_yyyy + i * i * i * i;
														end;
												end;
										end;
								end;
						end;
					end;



				matrix[1, 1] := S_xx;
				matrix[2, 1] := S_xxx;
				matrix[3, 1] := S_xy;
				matrix[4, 1] := S_xyy;
				matrix[5, 1] := S_x;

				matrix[1, 2] := S_xxx;
				matrix[2, 2] := S_xxxx;
				matrix[3, 2] := S_xxy;
				matrix[4, 2] := S_xxyy;
				matrix[5, 2] := S_xx;

				matrix[1, 3] := S_xy;
				matrix[2, 3] := S_xxy;
				matrix[3, 3] := S_yy;
				matrix[4, 3] := S_yyy;
				matrix[5, 3] := S_y;

				matrix[1, 4] := S_xyy;
				matrix[2, 4] := S_xxyy;
				matrix[3, 4] := S_yyy;
				matrix[4, 4] := S_yyyy;
				matrix[5, 4] := S_yy;

				matrix[1, 5] := S_x;
				matrix[2, 5] := S_xx;
				matrix[3, 5] := S_y;
				matrix[4, 5] := S_yy;
				matrix[5, 5] := S;

				Determinant(5, matrix, det, error);


				matrix[1, 1] := S_zx;
				matrix[2, 1] := S_zxx;
				matrix[3, 1] := S_zy;
				matrix[4, 1] := S_zyy;
				matrix[5, 1] := S_z;

				matrix[1, 2] := S_xxx;
				matrix[2, 2] := S_xxxx;
				matrix[3, 2] := S_xxy;
				matrix[4, 2] := S_xxyy;
				matrix[5, 2] := S_xx;

				matrix[1, 3] := S_xy;
				matrix[2, 3] := S_xxy;
				matrix[3, 3] := S_yy;
				matrix[4, 3] := S_yyy;
				matrix[5, 3] := S_y;

				matrix[1, 4] := S_xyy;
				matrix[2, 4] := S_xxyy;
				matrix[3, 4] := S_yyy;
				matrix[4, 4] := S_yyyy;
				matrix[5, 4] := S_yy;

				matrix[1, 5] := S_x;
				matrix[2, 5] := S_xx;
				matrix[3, 5] := S_y;
				matrix[4, 5] := S_yy;
				matrix[5, 5] := S;


				Determinant(5, matrix, det1, error);


				matrix[1, 1] := S_xx;
				matrix[2, 1] := S_xxx;
				matrix[3, 1] := S_xy;
				matrix[4, 1] := S_xyy;
				matrix[5, 1] := S_x;

				matrix[1, 2] := S_zx;
				matrix[2, 2] := S_zxx;
				matrix[3, 2] := S_zy;
				matrix[4, 2] := S_zyy;
				matrix[5, 2] := S_z;

				matrix[1, 3] := S_xy;
				matrix[2, 3] := S_xxy;
				matrix[3, 3] := S_yy;
				matrix[4, 3] := S_yyy;
				matrix[5, 3] := S_y;

				matrix[1, 4] := S_xyy;
				matrix[2, 4] := S_xxyy;
				matrix[3, 4] := S_yyy;
				matrix[4, 4] := S_yyyy;
				matrix[5, 4] := S_yy;

				matrix[1, 5] := S_x;
				matrix[2, 5] := S_xx;
				matrix[3, 5] := S_y;
				matrix[4, 5] := S_yy;
				matrix[5, 5] := S;

				Determinant(5, matrix, det2, error);


				matrix[1, 1] := S_xx;
				matrix[2, 1] := S_xxx;
				matrix[3, 1] := S_xy;
				matrix[4, 1] := S_xyy;
				matrix[5, 1] := S_x;

				matrix[1, 2] := S_xxx;
				matrix[2, 2] := S_xxxx;
				matrix[3, 2] := S_xxy;
				matrix[4, 2] := S_xxyy;
				matrix[5, 2] := S_xx;

				matrix[1, 3] := S_zx;
				matrix[2, 3] := S_zxx;
				matrix[3, 3] := S_zy;
				matrix[4, 3] := S_zyy;
				matrix[5, 3] := S_z;

				matrix[1, 4] := S_xyy;
				matrix[2, 4] := S_xxyy;
				matrix[3, 4] := S_yyy;
				matrix[4, 4] := S_yyyy;
				matrix[5, 4] := S_yy;

				matrix[1, 5] := S_x;
				matrix[2, 5] := S_xx;
				matrix[3, 5] := S_y;
				matrix[4, 5] := S_yy;
				matrix[5, 5] := S;


				Determinant(5, matrix, det3, error);

				matrix[1, 1] := S_xx;
				matrix[2, 1] := S_xxx;
				matrix[3, 1] := S_xy;
				matrix[4, 1] := S_xyy;
				matrix[5, 1] := S_x;

				matrix[1, 2] := S_xxx;
				matrix[2, 2] := S_xxxx;
				matrix[3, 2] := S_xxy;
				matrix[4, 2] := S_xxyy;
				matrix[5, 2] := S_xx;


				matrix[1, 3] := S_xy;
				matrix[2, 3] := S_xxy;
				matrix[3, 3] := S_yy;
				matrix[4, 3] := S_yyy;
				matrix[5, 3] := S_y;

				matrix[1, 4] := S_zx;
				matrix[2, 4] := S_zxx;
				matrix[3, 4] := S_zy;
				matrix[4, 4] := S_zyy;
				matrix[5, 4] := S_z;

				matrix[1, 5] := S_x;
				matrix[2, 5] := S_xx;
				matrix[3, 5] := S_y;
				matrix[4, 5] := S_yy;
				matrix[5, 5] := S;


				Determinant(5, matrix, det4, error);

				matrix[1, 1] := S_xx;
				matrix[2, 1] := S_xxx;
				matrix[3, 1] := S_xy;
				matrix[4, 1] := S_xyy;
				matrix[5, 1] := S_x;

				matrix[1, 2] := S_xxx;
				matrix[2, 2] := S_xxxx;
				matrix[3, 2] := S_xxy;
				matrix[4, 2] := S_xxyy;
				matrix[5, 2] := S_xx;

				matrix[1, 3] := S_xy;
				matrix[2, 3] := S_xxy;
				matrix[3, 3] := S_yy;
				matrix[4, 3] := S_yyy;
				matrix[5, 3] := S_y;

				matrix[1, 4] := S_xyy;
				matrix[2, 4] := S_xxyy;
				matrix[3, 4] := S_yyy;
				matrix[4, 4] := S_yyyy;
				matrix[5, 4] := S_yy;

				matrix[1, 5] := S_zx;
				matrix[2, 5] := S_zxx;
				matrix[3, 5] := S_zy;
				matrix[4, 5] := S_zyy;
				matrix[5, 5] := S_z;

				Determinant(5, matrix, det5, error);


				a := det1 / det;
				b := det2 / det;
				c := det3 / det;
				d := det4 / det;
				e := det5 / det;
				Info := WriteInfo;
				for i := 0 to (N_y - 1) do begin
						GetLine(0, i, N_x, Line);
						for j := 0 to (N_x - 1) do begin
								aNumber := (Line[j] + 127 - a * (j + 1) - b * (j + 1) * (j + 1) - c * (i + 1) - d * (i + 1) * (i + 1) - e);
								if aNumber < 0 then
									aNumber := 0;
								if aNumber > 255 then
									aNumber := 255;
								Line[j] := trunc(aNumber)
							end;
						PutLine(0, i, N_x, Line);
					end;
				UpdatePicWindow;
			end;
	end;



	procedure ludcmp (var a: glnpbynp; n, np: integer; var det: double);
		const
			tiny = 1.0e-20;
		var
			k, j, imax, i: integer;
			sum, dum, big: double;
			vv: glnarray;
			indx: glindx;
			d: double;
	begin
		d := 1.0;
		for i := 1 to n do begin
				big := 0.0;
				for j := 1 to n do
					if (abs(a[i, j]) > big) then
						big := abs(a[i, j]);
				if (big = 0.0) then begin
						writeln('pause in LUDCMP - singular matrix');
						readln
					end;
				vv[i] := 1.0 / big
			end;
		for j := 1 to n do begin
				if (j > 1) then begin
						for i := 1 to j - 1 do begin
								sum := a[i, j];
								if (i > 1) then begin
										for k := 1 to i - 1 do begin
												sum := sum - a[i, k] * a[k, j]
											end;
										a[i, j] := sum
									end
							end
					end;
				big := 0.0;
				for i := j to n do begin
						sum := a[i, j];
						if (j > 1) then begin
								for k := 1 to j - 1 do begin
										sum := sum - a[i, k] * a[k, j]
									end;
								a[i, j] := sum
							end;
						dum := vv[i] * abs(sum);
						if (dum > big) then begin
								big := dum;
								imax := i
							end
					end;
				if (j <> imax) then begin
						for k := 1 to n do begin
								dum := a[imax, k];
								a[imax, k] := a[j, k];
								a[j, k] := dum
							end;
						d := -d;
						vv[imax] := vv[j]
					end;
				indx[j] := imax;
				if (j <> n) then begin
						if (a[j, j] = 0.0) then
							a[j, j] := tiny;
						dum := 1.0 / a[j, j];
						for i := j + 1 to n do begin
								a[i, j] := a[i, j] * dum
							end
					end
			end;
		if (a[n, n] = 0.0) then
			a[n, n] := tiny;
		for i := 1 to 5 do
			det := det * a[i, i];
	end;


	procedure BlackPhotoMode;
{Erases the screen to the background color and then redraws}
{the contents of the active picture window . }
		var
			tPort: GrafPtr;
			event: EventRecord;
			WinRect: rect;
			SaveVisRgn: rgnHandle;
			SaveBkColor: RGBColor;
	begin
		if info <> NoInfo then
			with info^ do begin
					KillRoi;
					if OptionKeyDown then begin {Move window up to top of screen.}
							GetWindowRect(wptr, WinRect);
							MoveWindow(wptr, WinRect.left, 0, false);
						end;
					with wptr^ do begin
							SaveVisRgn := visRgn;
							visRgn := NewRgn;
							RectRgn(visRgn, ScreenBits.Bounds);
						end;
					FlushEvents(EveryEvent, 0);
					GetPort(tPort);
					SetPort(GrafPtr(CScreenPort));
					with CScreenPort^ do begin
							HideCursor;
							GetBackColor(SaveBkColor);
							RGBBackColor(BlackRGB);
							EraseRect(portPixMap^^.Bounds);
							RGBBackColor(SaveBkColor);
						end;

					UpdatePicWindow;
					repeat
					until GetNextEvent(mDownMask + KeyDownMask, Event);
					with wptr^ do begin
							DisposeRgn(visRgn);
							visRgn := SaveVisRgn;
						end;
					RestoreScreen;
					SetPort(tPort);
					FlushEvents(EveryEvent, 0);
				end
		else
			beep;
	end;


	procedure DoUserMenuEvent (MenuItem: integer);
		var
			item: integer;
	begin
		case MenuItem of
			DoFFTItem: 
				begin
					if ((FFTArrayH = nil) or (SavedPictH = nil)) then
						PutMessage('There is not enough Memory  to allocate the buffers needed  for FFT')
					else begin
							if nPics < 1 then
								PutMessage('There is no Picture  for FFT')
							else
								Do2DFFT;
						end;
				end;
			HorizontalFFTItem: 
				begin
					if ((FFTArrayH = nil) or (SavedPictH = nil)) then
						PutMessage('There is not enough Memory  to allocate the buffers needed  for FFT')
					else begin
							if nPics < 1 then
								PutMessage('There is no Picture  for FFT')
							else
								DoHorizontalFFT;
						end;
				end;
			PhasesItem: 
				begin
					if FFTInfo.FFT_Done = true then
						ShowFFTPhases
					else
						PutMessage('You must run FFT  to use this Option ');
				end;

			FilterItem: 
				begin
					if FFTInfo.FFT_Done = true then
						DoFFTFilter(FFTInfo.FFTPict_info^.PixelsperLine)
					else
						PutMessage('You must run FFT  to use this Option ');
				end;
			Restore_Item: 
				begin
					if FFTInfo.FFT_Done = true then
						Restore
					else
						PutMessage('You must run FFT  to use this Option ');
				end;
			DoBackFFTItem: 
				begin
					if (ReFFTArrayH = nil) then
						PutMessage('There is not enough Memory  to allocate the buffers needed  for FFT')
					else if FFTInfo.FFT_Done = true then
						Do2DBackFFT;
				end;
			DoCorrelationItem: 
				DoCorrelation;
			SubOffItem: 
				begin
					GetSubtractOpts(item);
					if item = SubOk then
						if Choice <> ParabolicFit then
							TransformLine(Choice)
						else
							quad_Fit;
				end;
			DoPlot3DItem: 
				begin
					if OptionKeyDown or OptionKeyWasDown then
						Get3DOptions(item)
					else
						item := ScaleOk;
					if item = ScaleOk then
						DoPlot(NegPos);
				end;
			ShadeItem: 
				begin
					if OptionKeyDown or OptionKeyWasDown then
						GetShadeOpts(item)
					else
						item := Ok;
					if item = Ok then
						DoCShade(x_viewer, y_viewer, z_viewer, x_light, y_light, z_light, HeightFactor, Step);
				end;
			BlowUpItem: 
				DoBlowUp;
			AddScaleItem: 
				DoAddScales;
			BlackPhotoModeItem: 
				BlackPhotoMode;
		end;
	end;

end.