unit Stacks;

interface

	uses
		Memory, QuickDraw, Packages, Menus, Events, Fonts, Scrap, ToolUtils,Resources, Errors, Palettes, QDOffscreen, PictUtils, Timer, globals, Utilities, Graphics, Analysis, Camera, file1, file2, filters, sound, lut;

	procedure MakeStack;
	procedure MakeWindowsFromStack;
	function AddSlice (update: boolean): boolean;
	procedure DeleteSlice;
	procedure ShowNextSlice (item: integer);
	procedure ShowFirstOrLastSlice (ich: integer);
	procedure DoStackInfo;
	procedure Reslice;
	procedure Animate;
	procedure MakeMovie(ShowDialog: boolean);
	procedure CaptureFrames;
	procedure MakeMontage;
	procedure ConvertRGBToEightBitColor (Capturing: boolean);
	procedure ConvertEightBitColorToRGB;
	procedure CaptureColor;
	procedure AverageSlices;
	procedure ConvertRGBToHSV;


implementation


	procedure MakeStack;
		var
			ok, isStack: boolean;
			i, result: integer;
			TempInfo, SaveInfo: InfoPtr;
			str: str255;
	begin
		if not AllSameSize then begin
				PutError('All currently open images must be the same size to make a stack.');
				exit(MakeStack);
			end;
		isStack := false;
		for i := 1 to nPics do begin
				TempInfo := pointer(WindowPeek(PicWindow[i])^.RefCon);
				isStack := isStack or (TempInfo^.StackInfo <> nil);
			end;
		if isStack then begin
				PutError('All stacks must be closed before making a new stack.');
				exit(MakeStack);
			end;
		if nPics > MaxSlices then begin
				NumToString(MaxSlices, str);
				PutError(concat('Maximun stack size is ', str, ' slices.'));
				exit(MakeStack);
			end;
		StopDigitizing;
		DisableDensitySlice;
		SelectWindow(PicWindow[1]);
		Info := pointer(WindowPeek(PicWindow[1])^.RefCon);
		ActivateWindow;
		KillRoi;
		UnZoom;
		if not MakeStackFromWindow then
			exit(MakeStack);
		with info^ do begin
				StackInfo^.nSlices := nPics;
				title := 'Stack';
				UpdateTitleBar;
				Revertable := false;
			end;
		SaveInfo := Info;
		MakingStack := true;
		ShowWatch;
		for i := 2 to nPics do begin
				TempInfo := pointer(WindowPeek(PicWindow[2])^.RefCon);
				with TempInfo^ do begin
						hunlock(PicBaseHandle);
						info^.StackInfo^.PicBaseH[i] := PicBaseHandle;
					end;
				result := CloseAWindow(PicWindow[2]);
				Info := SaveInfo;
			end;
		UpdateWindowsMenuItem;
		MakingStack := false;
	end;


	procedure DeleteSlice;
		var
			SliceToDelete, NextSlice, i: integer;
			isRoi: boolean;
	begin
		with info^, info^.StackInfo^ do begin
				if nSlices = 1 then begin
						WhatToUndo := NothingToUndo;
						exit(DeleteSlice);
					end;
				isRoi := RoiShowing;
				if isRoi then
					KillRoi;
				SetupUndo;
				WhatToUndo := UndoSliceDelete;
				SliceToDelete := CurrentSlice;
				if CurrentSlice = 1 then begin
						NextSlice := 2;
						WhatToUndo := UndoFirstSliceDelete;
					end
				else
					NextSlice := CurrentSlice - 1;
				SelectSlice(NextSlice);
				UpdatePicWindow;
				DisposeHandle(PicBaseH[SliceToDelete]);
				for i := SliceToDelete to nSlices - 1 do
					PicBaseH[i] := PicBaseH[i + 1];
				nSlices := nSlices - 1;
				if CurrentSlice <> 1 then
					CurrentSlice := CurrentSlice - 1;
				if (StackType = rgbStack) and (nSlices <> 3) then
					StackType := VolumeStack;
				UpdateTitleBar;
				if isRoi then
					RestoreRoi;
				changes := true;
				UpdateWindowsMenuItem;
			end;
	end;


	procedure MakeWindowsFromStack;
		var
			i, ignore: integer;
			N: LongInt;
			SaveInfo: InfoPtr;
			tmp: longint;

		function MakeName (i: integer): str255;
			var
				str: str255;
		begin
			RealToString(i, 3, 0, str);
			if str[1] = ' ' then
				str[1] := '0';
			if str[2] = ' ' then
				str[2] := '0';
			MakeName := str;
		end;

	begin
		N := info^.StackInfo^.nSlices;
		tmp := SizeOf(PicInfo);
		if MaxBlock < (MinFree + info^.ImageSize + (SizeOf(PicInfo) + 2000) * N) then begin
				PutError('There is not enough memory available to convert this stack to windows.');
				exit(MakeWindowsFromStack);
			end;
		SaveInfo := Info;
		KillRoi;
		for i := 1 to N - 1 do begin
				SelectSlice(1);
				info^.StackInfo^.CurrentSlice := 1;
				if not Duplicate(MakeName(i), false) then
					exit(MakeWindowsFromStack);
				info := SaveInfo;
				DeleteSlice;
			end;
		if Duplicate(MakeName(N), false) then begin
				info := SaveInfo;
				info^.changes := false;
				ignore := CloseAWindow(info^.wptr);
			end;
	end;


	procedure ShowNextSlice (item: integer);
		var
			isRoi: boolean;
	begin
		with info^, info^.StackInfo^ do begin
				if item = NextSliceItem then begin
						CurrentSlice := CurrentSlice + 1;
						if CurrentSlice > nSlices then
							CurrentSlice := nSlices;
					end
				else begin
						CurrentSlice := CurrentSlice - 1;
						if CurrentSlice < 1 then
							CurrentSlice := 1;
					end;
				isRoi := RoiShowing;
				if isRoi then
					KillRoi;
				SelectSlice(CurrentSlice);
				UpdatePicWindow;
				UpdateTitleBar;
				WhatToUndo := NothingToUndo;
				isInsertionPoint:=false;
				if isRoi then
					RestoreRoi;
			end;
	end;


	procedure ShowFirstOrLastSlice (ich: integer);
		var
			isRoi: boolean;
	begin
		with info^, info^.StackInfo^ do begin
				if ich = EndKey then
					CurrentSlice := nSlices
				else
					CurrentSlice := 1;
				isRoi := RoiShowing;
				if isRoi then
					KillRoi;
				SelectSlice(CurrentSlice);
				UpdatePicWindow;
				UpdateTitleBar;
				WhatToUndo := NothingToUndo;
				isInsertionPoint:=false;
				if isRoi then
					RestoreRoi;
			end;
	end;


	procedure GetSlice (xstart, ystart, start: extended; angle: extended; count: integer; var line: LineType);
		var
			i: integer;
			x, y, xinc, yinc: extended;
			IntegerStart: boolean;
	begin
		IntegerStart := (xstart = trunc(xstart)) and (ystart = trunc(ystart));
		if IntegerStart and (angle = 0.0) then begin
				GetLine(trunc(xstart), trunc(ystart), count, line);
				exit(GetSlice);
			end;
		if IntegerStart and (angle = 270.0) then begin
				GetColumn(trunc(xstart), trunc(ystart), count, line);
				exit(GetSlice);
			end;
		angle := (angle / 180.0) * pi;
		xinc := cos(angle);
		yinc := -sin(angle);
		x := xstart + start * xinc;
		y := ystart + start * yinc;
		for i := 0 to count - 1 do begin
				line[i] := round(GetInterpolatedPixel(x, y));
				x := x + xinc;
				y := y + yinc;
			end;
	end;


	function DoResliceOptions: boolean;
	var
		default, tmp: extended;
		Canceled: boolean;
		prompt, str: str255;
	begin
		with info^.StackInfo^, info^ do begin
			if SpatiallyCalibrated then begin
				default := SliceSpacing / xScale;
				str := xUnit;
			end else begin
				default := SliceSpacing;
				str := 'pixels';
			end;
			if SliceSpacing = 0.0 then
				default := 1.0;
			tmp := GetReal(concat('Slice Spacing (', str, '):'), default, 2, Canceled);
			if not Canceled and (tmp > 0.0) then begin
					if SpatiallyCalibrated then
						SliceSpacing := tmp * xScale
					else
						SliceSpacing := tmp;
				end;
		end; {with}
		DoResliceOptions := not canceled;
	end;


	procedure Reslice;
		var
			DstWidth, DstHeight, nSlices: integer;
			dstLeft, dstTop, y, i, j, LineLength: integer;
			SaveWindowFlag, SaveMacro, HorizontalMode: boolean;
			SaveHScale, SaveVScale, UncalibratedLineLength, CalibratedLineLength, angle: extended;
			Stack, Reconstruction: InfoPtr;
			aLine: LineType;
			name, str1, str2: str255;
			MaskRect: rect;
			x1, y1, x2, y2, ulength, clength: extended;

		procedure MakeRoi (Left, Top, Width, Height: integer);
		begin
			with info^ do begin
					RoiType := RectRoi;
					SetRect(RoiRect, left, top, left + width, top + height);
					MakeRegion;
					SetupUndo;
					RoiShowing := true;
				end;
		end;

	begin
		with info^, info^.StackInfo^ do begin
				if nSlices < 2 then begin
						PutError('Reslicing requires at least 2 slices.');
						AbortMacro;
						exit(Reslice);
					end;
				if not (RoiShowing and (RoiType = LineRoi)) then begin
						PutError('Please make a straight line selection first.');
						AbortMacro;
						exit(Reslice);
					end;
				Stack := info;
				GetLengthOrPerimeter(ulength, clength);
				LineLength := round(ulength);
				if LineLength = 0 then begin
						PutError('Line length cannot be zero.');
						AbortMacro;
						exit(Reslice);
					end;
				if SliceSpacing = 0.0 then
					if not DoResliceOptions then
						exit(reslice);;
				GetLoi(x1, y1, x2, y2);
				if (LAngle = 0.0) or (LAngle = 270.0) then
					if NotInBounds then
						exit(Reslice);
				HorizontalMode := not OptionKeyWasDown;
				if HorizontalMode then begin
						DstWidth := LineLength;
						DstHeight := round(nSlices * SliceSpacing);
						if DstHeight < nSlices then
							DstHeight := nSlices;
						dstLeft := 0;
						dstTop := round((dstHeight - nSlices) / 2.0);
					end
				else begin
						DstWidth := round(nSlices * SliceSpacing);
						if DstWidth < nSlices then
							DstWidth := nSlices;
						DstHeight := LineLength;
						dstLeft := round((dstWidth - nSlices) / 2.0);
						dstTop := 0;
					end;
				RealToString(y1, 3, 0, str1);
				RealToString(LAngle, 1, 2, str2);
				name := concat(str1, '-', str2);
				if not NewPicWindow(name, DstWidth, DstHeight) then
					exit(Reslice);
				Reconstruction := info;
				SaveWindowFlag := rsCreateNewWindow;
				SaveHScale := rsHScale;
				SaveVScale := rsVScale;
				rsCreateNewWindow := false;
				rsMethod := bilinear;
				for i := 1 to nSlices do begin
						Info := Stack;
						SelectSlice(i);
						GetSlice(x1, y1, 0.0, LAngle, LineLength, aLine);
						info := Reconstruction;
						if HorizontalMode then begin
								PutLine(dstLeft, dstTop + nSlices - i, LineLength, aLine);
								if i = 1 then {Draw extra line needed to get scaling to work right.}
									PutLine(dstLeft, dstTop + nSlices, LineLength, aLine);
								SetRect(MaskRect, dstLeft, dstTop + nSlices - i, dstLeft + LineLength, dstTop + nSlices - i + 1);
							end
						else begin
								PutColumn(dstLeft + nSlices - i, dstTop, LineLength, aLine);
								if i = 1 then {Draw extra line needed to get scaling to work right.}
									PutLine(dstLeft + nSlices, dstTop, LineLength, aLine);
								SetRect(MaskRect, dstLeft + nSlices - i, dstTop, dstLeft + nSlices - i + 1, dstTop + LineLength);
							end;
						UpdateScreen(MaskRect);
					end;
				if HorizontalMode then begin
						MakeRoi(dstLeft, dstTop, LineLength, nSlices);
						rsHScale := 1.0;
						rsVScale := SliceSpacing;
					end
				else begin
						MakeRoi(dstLeft, dstTop, nSlices, LineLength);
						rsHScale := SliceSpacing;
						rsVScale := 1.0;
					end;
				rsAngle := 0;
				SaveMacro := macro;
				macro := true;
				ScaleAndRotate;
				macro := SaveMacro;
				Info := Stack;
				SelectSlice(CurrentSlice);
				Info := Reconstruction;
				rsCreateNewWindow := SaveWindowFlag;
				rsHScale := SaveHScale;
				rsVScale := SaveVScale;
				KillRoi;
			end;
	end;


	procedure Animate;
		var
			n, SaveN, fpsInterval, DelayCount: integer;
			Event: EventRecord;
			ch: char;
			b: boolean;
			SingleStep, GoForward, NewKeyDown, PhotoMode: boolean;
			nFrames, StartTicks, NextTicks, SaveTicks, ticks: LongInt;
			fps, seconds: extended;

		procedure ShowFPS (fps: extended);
			var
				hstart, vstart, ivalue: integer;
				key: str255;
		begin
			if PhotoMode then
				exit(ShowFPS);
			hstart := InfoHStart;
			vstart := InfoVStart;
			SetPort(InfoWindow);
			MoveTo(xValueLoc, vstart);
			case DelayTicks of
				0: 
					key := '9 ';
				2: 
					key := '8 ';
				3: 
					key := '7 ';
				4: 
					key := '6 ';
				6: 
					key := '5 ';
				8: 
					key := '4 ';
				12: 
					key := '3 ';
				30: 
					key := '2 ';
				60: 
					key := '1 ';
			end;
			if SingleStep then begin
					if GoForward then
						key := '->'
					else
						key := '<-';
				end;
			DrawString(key);
			MoveTo(yValueLoc, vstart + 10);
			DrawReal(fps, 1, 2);
			DrawChar(' ');
		end;

	begin
		if info^.StackInfo = nil then begin
				PutError('Animation requires a stack.');
				exit(Animate);
			end;
		with info^, info^.StackInfo^ do begin
				if nSlices < 2 then begin
						PutError('Animation requires at least two "slices".');
						exit(Animate);
					end;
				KillRoi;
				PhotoMode := OptionKeyDown or OptionKeyWasDown;
				if PhotoMode then
					EraseScreen
				else begin
						ShowWatch;
						ShowMessage(concat('Use 1...9 keys to control speed', crStr, 'Use arrow keys to single step', crStr, 'Press mouse button to stop'));
					end;
				FlushEvents(EveryEvent, 0);
				fpsInterval := 10;
				SaveN := -1;
				n := 1;
				GoForward := true;
				SingleStep := false;
				nFrames := 0;
				StartTicks := TickCount;
				NextTicks := StartTicks;
				SaveTicks := StartTicks;
				if not PhotoMode then begin
						DrawLabels('key:', 'fps:', '');
						SetPort(InfoWindow);
						TextSize(9);
						TextFont(Monaco);
						TextMode(SrcCopy);
					end;
				repeat
					b := WaitNextEvent(EveryEvent, Event, 0, nil);
					NewKeyDown := (event.what = KeyDown) or (event.what = AutoKey);
					if NewKeyDown then begin
							Ch := chr(BitAnd(Event.message, 127));
							SingleStep := false;
							case ord(ch) of
								28, 44, 60, PageUp: {<-, <}
									begin
										SingleStep := true;
										GoForward := false;
										n := n - 1;
										if n < 1 then
											n := 1;
										DelayTicks := 0
									end; {left}
								29, 46, 62, PageDown:  {->, >}
									begin
										SingleStep := true;
										GoForward := true;
										n := n + 1;
										if n > nSlices then
											n := nSlices;
										DelayTicks := 0
									end;  {right}
								57: 
									DelayTicks := 0;  {'9'-max speed}
								56: 
									DelayTicks := 2;  {'8'-30 fps}
								55: 
									DelayTicks := 3;  {'7'-20 fps}
								54: 
									DelayTicks := 4;  {'6'-15 fps}
								53: 
									DelayTicks := 6;  {'5'-10 fps}
								52: 
									DelayTicks := 8; {'4'-7.5 fps}
								51: 
									DelayTicks := 12; {'3'-5 fps}
								50: 
									DelayTicks := 30; {'2'-2 fps}
								49: 
									DelayTicks := 60; {'1'-1 fps}
								otherwise
							end; {case}
							if DelayTicks > 12 then
								fpsInterval := 2
							else if DelayTicks > 3 then
								fpsInterval := 5
							else
								fpsInterval := 10;
						end; {if NewKeyDown}
					if GoForward then begin
							if not SingleStep then
								n := n + 1;
							if n > nSlices then begin
									if OscillatingMovies then begin
											n := nSlices - 1;
											GoForward := false;
										end
									else
										n := 1;
								end;
						end
					else begin
							if not SingleStep then
								n := n - 1;
							if n < 1 then begin
									if OscillatingMovies then begin
											n := 2;
											Goforward := true;
										end
									else
										n := nSlices;
								end;
						end;
					CurrentSlice := n;
					SelectSlice(CurrentSlice);
					UpdatePicWindow;
					nFrames := nFrames + 1;
					if SingleStep then begin
							if (not OptionKeyWasDown) and (n <> SaveN) then begin
									UpdateTitleBar;
									SaveN := n;
								end;
							ShowFPS(0.0);
						end
					else if (nFrames mod fpsInterval) = 0 then begin
							ticks := TickCount;
							seconds := (ticks - SaveTicks) / 60.0;
							if seconds <> 0.0 then
								fps := fpsInterval / seconds
							else
								fps := 0.0;
							ShowFPS(fps);
							SaveTicks := ticks;
						end;
					DelayCount := 0;
					if DelayTicks > 0 then begin
							repeat
								ticks := TickCount;
							until ticks >= NextTicks;
							NextTicks := ticks + DelayTicks;
						end;
				until (event.what = MouseDown) or (event.what = osEvt);
				if PhotoMode then
					RestoreScreen;
				FlushEvents(EveryEvent, 0);
				UpdateTitleBar
			end; {with}
	end;


	function Activate (name: str255): boolean;
  {Activates the window with the specified name.}
		var
			i: integer;
			TempInfo: InfoPtr;
	begin
		Activate := false;
		for i := 1 to nPics do begin
				TempInfo := pointer(WindowPeek(PicWindow[i])^.RefCon);
				if TempInfo^.title = name then begin
						if PicWindow[i] <> nil then begin
								SelectWindow(PicWindow[i]);
								Info := TempInfo;
								ActivateWindow;
								Activate := true;
							end; {if}
						leave;
					end; {if}
			end; {for}
	end;


	function DoMakeMovieOptions: boolean;
	const
		FramesID = 3;
		IntervalID = 5;
		rateID = 7;
		BlindID = 9;
		LG3BufferID = 10;
		StampID = 11;
        UseExistingStackID = 12;
		TriggerID = 13;
        TriggerFirstID = 14;
        TriggerEachID = 15;
	var
		mylog: DialogPtr;
		item, i: integer;
		FramesPerSecond: extended;
		
		procedure ShowFrameRate;
		begin
			if SecondsPerFrame = 0.0 then begin
				if fgWidth = 640 then
					FramesPerSecond := 30.0
				else FramesPerSecond := 25.0
			end else
				FramesPerSecond := 1.0 / SecondsPerFrame;
			if FramesPerSecond = trunc(FramesPerSecond) then
				SetDReal(MyLog, rateID, FramesPerSecond, 0)
			else
				SetDReal(MyLog, rateID, FramesPerSecond, 4);
		end;
		
		procedure ShowInterval;
		begin
			if SecondsPerFrame < 1.0 then
				SetDReal(MyLog, IntervalID, SecondsPerFrame, 4)
			else if SecondsPerFrame < 99.0 then
				SetDReal(MyLog, IntervalID, SecondsPerFrame, 2)
			else
				SetDReal(MyLog, IntervalID, SecondsPerFrame, 0);
		end;
		
		procedure ShowTriggerMode;
		begin
			SetDlogItem(mylog, TriggerID, ord(ExternalTrigger));
			SetDlogItem(mylog, TriggerFirstID, ord(TriggerFirstFrameOnly));
			SetDlogItem(mylog, TriggerEachID, ord(not TriggerFirstFrameOnly));
		end;
		
	begin
		InitCursor;
		mylog := GetNewDialog(230, nil, pointer(-1));
		SetDNum(MyLog, FramesID, FramesWanted);
		ShowFrameRate;
		ShowInterval;
		SetDlogItem(mylog, BlindID, ord(BlindMovieCapture));
		SetDlogItem(mylog, LG3BufferID, ord(LG3BufferCapture));
		SetDlogItem(mylog, StampID, ord(TimeStamp));
		ShowTriggerMode;
		SetDlogItem(mylog, UseExistingStackID, ord(UseExistingStack));
		SelectDialogItemText(MyLog, FramesID, 0, 32767);
		OutlineButton(MyLog, ok, 16);
		repeat
			ModalDialog(nil, item);
			if item = FramesID then
				FramesWanted := GetDNum(MyLog, FramesID);
			if item = IntervalID then begin
				SecondsPerFrame := GetDReal(MyLog, IntervalID);
				ShowFrameRate;
			end;
			if item = rateID then begin
				FramesPerSecond := GetDReal(MyLog, rateID);
				if FramesPerSecond <> 0.0 then
				  SecondsPerFrame := 1.0 / FramesPerSecond;
				ShowInterval;
			end;
			if item = BlindID then begin
					BlindMovieCapture := not BlindMovieCapture;
					SetDlogItem(mylog, BlindID, ord(BlindMovieCapture));
				end;
			if item = LG3BufferID then begin
					LG3BufferCapture := not LG3BufferCapture;
					if LG3BufferCapture then
						BlindMovieCapture := true;
					SetDlogItem(mylog, LG3BufferID, ord(LG3BufferCapture));
					SetDlogItem(mylog, BlindID, ord(BlindMovieCapture));
				end;
			if item = StampID then begin
					TimeStamp := not TimeStamp;
					SetDlogItem(mylog, StampID, ord(TimeStamp));
				end;
			if item = TriggerID then begin
			    ExternalTrigger := not ExternalTrigger;
			    SetDlogItem (mylog, TriggerID, ord (ExternalTrigger));
			  end;
			if (item = TriggerFirstID) or (item = TriggerEachID) then begin
			    TriggerFirstFrameOnly := not TriggerFirstFrameOnly;
			    ExternalTrigger := true;
			    ShowTriggerMode;
			  end;
			if item = UseExistingStackID then begin
					UseExistingStack := not UseExistingStack;
					SetDlogItem(mylog, UseExistingStackID, ord(UseExistingStack));
				end;
		until (item = ok) or (item = cancel);
		DisposeDialog(mylog);
		if FramesWanted < 1 then
			FramesWanted := 1;
		if FramesWanted > MaxSlices then
			FramesWanted := MaxSlices;
		if SecondsPerFrame < 0.0 then
			SecondsPerFrame := 0.0;
		if LG3BufferCapture and (item <> cancel) then begin
			if FrameGrabber <> ScionLG3 then begin
				LG3BufferCapture := false;
				PutError('Capturing to an on-board frame buffer requires a Scion LG-3.');
				DoMakeMovieOptions := false;
				exit(DoMakeMovieOptions);
			end;
			if FramesWanted > MaxLG3Frames then begin
				FramesWanted := MaxLG3Frames;
				PutError(concat('This ', long2str(MaxLG3Frames div 2), 'MB LG-3 can capture a maximum of ', long2str(MaxLG3Frames), ' frames to its on-board buffer.'));
				DoMakeMovieOptions := false;
				exit(DoMakeMovieOptions);
			end;
		end;
		DoMakeMovieOptions := item <> cancel;
	end;


	procedure CaptureFramesUsingTicks(SecondsPerFrame:extended; nFrames:integer; frect:rect);
	var
		StartTicks, NextTicks, LastTicks, interval, ticks: LongInt;
		SourcePixMap: PixMapHandle;
		str: str255;
		frame, i: integer;
		ElapsedTime, avgFrameInterval: extended;
	begin
		interval := round(60.0 * SecondsPerFrame);
		ShowWatch;
		SourcePixMap := fgPort^.portPixMap;
		ResetFrameGrabber;
		ShowTriggerMessage;
		with info^, info^.StackInfo^ do begin
				if Interval >= 30 then
					ShowMessage(CmdPeriodToStop)
				else
					DrawLabels('Frame:', 'Total:', '');
				if TimeStamp then begin
					SetPort(GrafPtr(osPort));
					TextFont(Monaco);
					TextSize(9);
				end;
				for frame := 1 to nFrames do begin
						CurrentSlice := frame;
						SelectSlice(CurrentSlice);
						if Interval >= 30 then
							UpdateTitleBar
						else
							Show2Values(CurrentSlice, nSlices);
						GetFrame;
						ticks:=TickCount;
						if (frame = 1) then begin
						    StartTicks := ticks;
						    NextTicks := StartTicks+interval - 3;
							if TriggerFirstFrameOnly then
							    ExternalTrigger := false;
						end else
							NextTicks := NextTicks + interval;
						if frame = nFrames then
							LastTicks := ticks;
						CopyOffscreen(SourcePixMap, osPort^.portPixMap, frect, PicRect);
						if TimeStamp then begin
							ElapsedTime:=(ticks-StartTicks) / 60.0;
							RealToString(ElapsedTime, 9, 3, str);
							for i:=1 to 5 do
								if str[i]=' ' then str[i]:='0';
							MoveTo(2,10);
							DrawString(str);
							PlotData^[frame]:=ElapsedTime;
						end;
						if not BlindMovieCapture then
							UpdatePicWindow;
						while TickCount < NextTicks do
							if CommandPeriod then begin
									beep;
									wait(60);
									exit(CaptureFramesUsingTicks);
								end;
					end; {for}
				ElapsedTime := (LastTicks - StartTicks) / 60.0;
				avgFrameInterval := ElapsedTime / (nFrames - 1);
				FrameInterval := avgFrameInterval;
			end; {with}
	end;



	function uTickCount:extended;
	var
		count:UnsignedWide;
		d:extended;
	begin
		microseconds(count);
		d:=count.lo;
		if d<0 then d:=band(count.lo,$7fffffff)+2147483648.0;
		uTickCount:=d+count.hi*4294967296.0;
	end;


	procedure CaptureFramesUsingMicroTicks(SecondsPerFrame:extended; nFrames:integer; frect:rect);
	var
		uStartTicks, uNextTicks, uLastTicks, uInterval, uTicks: Extended;
		SourcePixMap: PixMapHandle;
		str: str255;
		frame, i: integer;
		ElapsedTime: extended;
		uTicksToCaptureOneFrame, avgFrameInterval:extended;
		ShowProgress: boolean;
	begin
		ShowWatch;
		uInterval := 1000000.0 * SecondsPerFrame;
		SourcePixMap := fgPort^.portPixMap;
		ResetFrameGrabber;
		ShowTriggerMessage;
        if fgWidth = 768 then  {if PAL board}
            uTicksToCaptureOneFrame := 40000.0  {PAL captures 25 fps}
        else
            uTicksToCaptureOneFrame := 33333.0;  {non-PAL captures 33 fps}
        ShowProgress := (not LG3BufferCapture) or (uInterval > (2 * uTicksToCaptureOneFrame));
		with info^, info^.StackInfo^ do begin
				if ShowProgress and (uInterval < 500000.0) then
					DrawLabels('Frame:', 'Total:', '')
				else if not ExternalTrigger then
					ShowMessage(CmdPeriodToStop);
				if TimeStamp then begin
					SetPort(GrafPtr(osPort));
					TextFont(Monaco);
					TextSize(9);
				end;
				for frame := 1 to nFrames do begin
					CurrentSlice := frame;
					SelectSlice(CurrentSlice);
					if showProgress then begin
						if uInterval >= 500000.0 then
							UpdateTitleBar
						else
							Show2Values(CurrentSlice, nSlices);
					end;
					if LG3BufferCapture then begin
						BufferReg^ := frame - 1;
						GetFrame;
						uTicks := uTickCount;
					end else begin
						GetFrame;
						uTicks := uTickCount;
						CopyOffscreen(SourcePixMap, osPort^.portPixMap, frect, PicRect);
					end;
					if frame = 1 then begin
		    			uStartTicks := uTicks;
						uNextTicks := uStartTicks + uInterval - 1.5 * uTicksToCaptureOneFrame;
						if TriggerFirstFrameOnly then
							ExternalTrigger := false;
					end else
						uNextTicks :=uNextTicks + uInterval;
					if frame = nFrames then
						uLastTicks := uTicks;
					if TimeStamp then begin
						ElapsedTime:=(uTicks-uStartTicks) / 1000000.0;
						PlotData^[frame]:=ElapsedTime;
						if not LG3BufferCapture then begin
							RealToString(ElapsedTime, 9, 3, str);
							for i:=1 to 5 do
								if str[i]=' ' then str[i]:='0';
							MoveTo(2,10);
							DrawString(str);
						end;
					end;
					if not BlindMovieCapture then
						UpdatePicWindow;
					if uTicks < uNextTicks then
						while uTickCount < uNextTicks do
							if CommandPeriod then begin
									beep;
									wait(60);
									exit(CaptureFramesUsingMicroTicks);
								end;
					end; {for}
				ElapsedTime := (uLastTicks - uStartTicks) / 1000000.0;
				avgFrameInterval := ElapsedTime / (nFrames - 1);
				FrameInterval := avgFrameInterval;
			end; {with}
		if LG3BufferCapture then begin
			{Copy captured frames from LG-3 to stack.}
			with info^, info^.StackInfo^ do begin
				for frame := 1 to nFrames do begin
					ShowAnimatedWatch;
					CurrentSlice := frame;
					SelectSlice(CurrentSlice);
					BufferReg^ := frame - 1;
					CopyOffscreen(SourcePixMap, osPort^.portPixMap, frect, PicRect);
					if TimeStamp then begin
						RealToString(PlotData^[frame], 9, 3, str);
						for i:=1 to 5 do
							if str[i]=' ' then str[i]:='0';
						MoveTo(2,10);
						DrawString(str);
					end; {if TimeStamp}
				end; {for}
			end; {with}
			BufferReg^ := 0;
		end; {if LG3BufferCapture}
	end;

	
	
	procedure MakeMovie(ShowDialog: boolean);
		var
			nFrames, wleft, wtop, width, height: integer;
			ignore, SaveFW: integer;
			OutOfMemory: boolean;
			seconds: extended;
			frect: rect;
			Canceled: boolean;
			avgFrameInterval: extended;
	begin
		SelectCameraWindow;
		with info^ do begin
			if PictureType <> FrameGrabberType then begin
					PutError('You must be capturing to make a movie.');
					exit(MakeMovie);
				end;
			StopDigitizing;
			if not (RoiShowing and (RoiType = RectRoi)) then begin
					PutError('Please make a rectangular selection first.');
					exit(MakeMovie);
				end;
			if NotInBounds then
				exit(MakeMovie);
			if ShowDialog then
				if not DoMakeMovieOptions then begin
					AbortMacro;
					exit(MakeMovie);
				end;
			if (FrameGrabber <> ScionLG3) then
				LG3BufferCapture := false;
			if LG3BufferCapture and (FramesWanted > MaxLG3Frames) then
				FramesWanted := MaxLG3Frames;
			if LG3BufferCapture then
				BlindMovieCapture := true;
			with RoiRect do begin
					left := band(left + 1, $fffc);   {Word align}
					right := band(right + 2, $fffc);
					if right > PicRect.right then
						right := PicRect.right;
					MakeRegion;
					wleft := left;
					wtop := top;
					width := right - left;
					height := bottom - top;
				end;
			end; {with info^}
		with frect do begin
				left := wleft;
				top := wtop;
				right := left + width;
				bottom := top + height;
			end;
		if UseExistingStack then begin
			if not Activate('Movie') then begin
				PutError('Can''t find a stack named "Movie".');
				UseExistingStack := false;
				AbortMacro;
				exit(MakeMovie);
			end;
			with info^ do begin
				if (PixelsPerLine <> width) or (nLines <> height) then begin
					PutError('The dimensions of the stack "Movie" are not the same as the selection.');
					exit(MakeMovie);
				end;
				nFrames := StackInfo^.nSlices;
				if nFrames > FramesWanted then
					nFrames := FramesWanted;
			end {with info}
		end else begin
			if not NewPicWindow('Movie', width, height) then
				exit(MakeMovie);
			if not MakeStackFromWindow then
				exit(MakeMovie);
			nFrames := 1;
			OutOfMemory := false;
			while (nFrames < FramesWanted) and (not OutOfMemory) do begin
					OutOfMemory := not AddSlice(false);
					if not OutOfMemory then
						nFrames := nFrames + 1;
				end;
		end;
		if ExternalTrigger and not TriggerFirstFrameOnly then
			SecondsPerFrame := 0.0;
		If (FramesWanted < 1) then
			FramesWanted := 1;
		if SecondsPerFrame < 0.0 then
			SecondsPerFrame := 0.0;
		with info^.StackInfo^ do begin
			FrameInterval := 0.0;
			StackType := movieStack;
		end;
		if OptionKeyWasDown then
			CaptureFramesUsingTicks(SecondsPerFrame, nFrames, frect)
		else
			CaptureFramesUsingMicroTicks(SecondsPerFrame, nFrames, frect);
		ShowFirstOrLastSlice(HomeKey);
		avgFrameInterval := info^.StackInfo^.FrameInterval;
		if AvgFrameInterval <> 0.0 then
			ShowMessage(StringOf(nFrames:1, ' frames', cr,
				AvgFrameInterval * nFrames:1:2, ' seconds', cr,
				AvgFrameInterval:1:3, ' seconds/frame', cr,
				1 / AvgFrameInterval:1:2, ' frames/second'));
		if TimeStamp then begin
			PlotData^[0] := nFrames;
			PlotData^[nFrames + 1] := SecondsPerFrame;
			PlotCount := 0;
		end;
	end;


	procedure CaptureFrames;
		var
			nFrames, wleft, wtop, width, height, i: integer;
			ignore, SaveFW: integer;
			OutOfMemory, AdvanceFrame, b: boolean;
			frect: rect;
			MainDevice: GDHandle;
			SourcePixMap: PixMapHandle;
			Event: EventRecord;
			ShutterSound: SndListHandle;
			err: OSErr;

		procedure CheckButton;
		begin
			if Button and not AdvanceFrame then
				with Info^.StackInfo^ do begin
						AdvanceFrame := true;
						ShutterSound := SndListHandle(GetResource('snd ', 100));
						if ShutterSound <> nil then
							err := SndPlay(nil, ShutterSound, false);
						if CurrentSlice < nSlices then begin
								CurrentSlice := CurrentSlice + 1;
								UpdateTitleBar;
								CurrentSlice := CurrentSlice - 1;
							end;
					end;
		end;

	begin
		with info^ do begin
				if PictureType <> FrameGrabberType then begin
						PutError('You must be capturing to capture frames.');
						exit(CaptureFrames);
					end;
				StopDigitizing;
				if not (RoiShowing and (RoiType = RectRoi)) then begin
						PutError('Please make a rectangular selection first.');
						exit(CaptureFrames);
					end;
				if NotInBounds then
					exit(CaptureFrames);
				SaveFW := FramesWanted;
				ShutterSound := nil;
				with RoiRect do begin
						left := band(left + 1, $fffc);   {Word align}
						right := band(right + 2, $fffc);
						if right > PicRect.right then
							right := PicRect.right;
						MakeRegion;
						wleft := left;
						wtop := top;
						width := right - left;
						height := bottom - top;
					end;
			end; {with info^}
		with frect do begin
				left := wleft;
				top := wtop;
				right := left + width;
				bottom := top + height;
			end;
		if not NewPicWindow('Frames', width, height) then
			exit(CaptureFrames);
		if not MakeStackFromWindow then
			exit(CaptureFrames);
		UpdateTitleBar;
		ShowWatch;
		SourcePixMap := fgPort^.portPixMap;
		ResetFrameGrabber;
		FlushEvents(EveryEvent, 0);
		ExternalTrigger := false;
		UpdateVideoControl;
		with info^, info^.StackInfo^ do begin
				ShowMessage(CmdPeriodToStop);
				OutOfMemory := false;
				AdvanceFrame := false;
				while (not OutOfMemory) and (CurrentSlice <= MaxSlices) do begin
						if AdvanceFrame then begin
								OutOfMemory := not AddSlice(false);
								AdvanceFrame := false;
							end;
						GetFrame;
						CheckButton;
						CopyOffscreen(SourcePixMap, osPort^.portPixMap, frect, PicRect);
						CheckButton;
						UpdatePicWindow;
						CheckButton;
						b := WaitNextEvent(EveryEvent, Event, 0, nil);
						if event.what = KeyDown then
							leave;
					end; {while}
			end; {with}
		if ShutterSound <> nil then
			ReleaseResource(handle(ShutterSound));
	end;



	procedure CopyPics (sPort, dPort: cGrafPtr; sRect, dRect: rect);
	begin
		pmForeColor(BlackIndex);
		pmBackColor(WhiteIndex);
		CopyBits(BitMapHandle(sPort^.portPixMap)^^, BitMapHandle(dPort^.PortPixMap)^^, sRect, dRect, SrcCopy, nil);
		pmForeColor(ForegroundIndex);
		pmBackColor(BackgroundIndex);
	end;


	procedure MakeMontage;
  {Opens a new window and creates a composite image}
  {from the slices in the current stack.}
	const
		ColumnsID = 3;
		RowsID = 4;
		ScaleID = 5;
		FirstID = 6;
		LastID = 7;
		IncrementID = 8;
		NumberID = 9;
		BordersID=16;
	var
		mylog: DialogPtr;
		item, i, nRows, nColumns, Inc, slices: integer;
		StackWidth, StackHeight, mWidth, mHeight, Background: integer;
		dWidth, dHeight, dLeft, dTop, dRight, dBottom, MaxWidth, MaxHeight: integer;
		FirstSlice, LastSlice, TotalSlices: integer;
		scale, SaveScale: extended;
		sPort, dPort: cGrafPtr;
		StackInfo, MontageInfo: InfoPtr;
		sRect, dRect: rect;
		IncrementSet: boolean;
		str: str255;
		loc: point;
		SaveGDevice: GDHandle;
		
	procedure Estimate (var scale:extended{ppc-bug}; adjustinc: boolean);
		var
			tmp, xxScale, yyScale: extended;
			n: integer;
	begin
		slices := LastSlice - FirstSlice + 1;
		if adjustinc then
			inc := 0;
		repeat
			if adjustinc then
				inc := inc + 1;
			n := trunc(slices / inc);
			tmp := sqrt(n);
			if trunc(tmp) <> tmp then
				tmp := trunc(tmp) + 1.0;
			nColumns := trunc(tmp);
			nRows := nColumns;
			if (nColumns * (nRows - 1)) >= n then
				nRows := nRows - 1;
			xxScale := (MaxWidth / nColumns) / StackWidth;
			yyScale := (MaxHeight / nRows) / StackHeight;
			if xxScale < yyScale then
				scale := xxScale
			else
				scale := yyScale;
			if scale > 1.0 then
				scale := 1.0;
			SaveScale := scale;
		until (scale >= 0.5) or (inc >= 3) or not adjustinc;
	end;

	begin
		InitCursor;
		with info^ do begin
				StackWidth := PixelsPerLine;
				StackHeight := nLines;
				FirstSlice := 1;
				TotalSlices := StackInfo^.nSlices;
				LastSlice := TotalSlices;
			end;
		MaxWidth := ScreenWidth - 85;
		MaxHeight := ScreenHeight - 45;
		Estimate(scale, true);
		IncrementSet := false;
		mylog := GetNewDialog(150, nil, pointer(-1));
		SetDNum(MyLog, RowsID, nRows);
		SetDNum(MyLog, ColumnsID, nColumns);
		SetDReal(MyLog, ScaleID, scale, 2);
		SetDNum(MyLog, FirstID, FirstSlice);
		SetDNum(MyLog, LastID, LastSlice);
		SetDNum(MyLog, IncrementID, inc);
		SetDlogItem(MyLog, NumberID, ord(gNumberSlices));
		SetDlogItem(MyLog, BordersID, ord(gBorders));
		OutlineButton(MyLog, ok, 16);
		repeat
			ModalDialog(nil, item);
			if item = ColumnsID then begin
					nColumns := GetDNum(MyLog, ColumnsID);
					if nColumns < 0 then begin
							nColumns := 0;
							SetDNum(MyLog, ColumnsID, nRows);
						end;
				end;
			if item = RowsID then begin
					nRows := GetDNum(MyLog, RowsID);
					if nRows < 0 then begin
							nRows := 0;
							SetDNum(MyLog, RowsID, nRows);
						end;
				end;
			if item = ScaleID then
				scale := GetDReal(MyLog, ScaleID);
			if item = FirstID then begin
					FirstSlice := GetDNum(MyLog, FirstID);
					if (FirstSlice < 1) or (FirstSlice > LastSlice) then
						FirstSlice := 1;
					if IncrementSet then
						Estimate(scale, false)
					else
						Estimate(scale, true);
					SetDNum(MyLog, RowsID, nRows);
					SetDNum(MyLog, ColumnsID, nColumns);
					SetDReal(MyLog, ScaleID, scale, 2);
				end;
			if item = LastID then begin
					LastSlice := GetDNum(MyLog, LastID);
					if (LastSlice < FirstSlice) or (LastSlice > TotalSlices) then
						LastSlice := TotalSlices;
					if IncrementSet then
						Estimate(scale, false)
					else
						Estimate(scale, true);
					SetDNum(MyLog, RowsID, nRows);
					SetDNum(MyLog, ColumnsID, nColumns);
					SetDReal(MyLog, ScaleID, scale, 2);
				end;
			if item = IncrementID then begin
					inc := GetDNum(MyLog, IncrementID);
					IncrementSet := true;
					if (inc < 1) or (inc > (slices div 2)) then begin
							inc := 1;
							SetDNum(MyLog, IncrementID, inc);
						end;
					Estimate(scale, false);
					SetDNum(MyLog, RowsID, nRows);
					SetDNum(MyLog, ColumnsID, nColumns);
					SetDReal(MyLog, ScaleID, scale, 2);
				end;
			if item = NumberID then begin
					gNumberSlices := not gNumberSlices;
					SetDlogItem(MyLog, NumberID, ord(gNumberSlices));
				end;
			if item = BordersID then begin
					gBorders := not gBorders;
					SetDlogItem(MyLog, BordersID, ord(gBorders));
				end;
		until (item = ok) or (item = cancel);
		DisposeDialog(mylog);
		if item = cancel then
			exit(MakeMontage);
		if (scale <= 0.05) or (scale > 5) then
			scale := SaveScale;
		dWidth := round(StackWidth * scale);
		dHeight := round(StackHeight * scale);
		mWidth := nColumns * dWidth;
		mHeight := nRows * dHeight;
		StackInfo := info;
		Background := MyGetPixel(0, 0);
		SetBackgroundColor(Background);
		if Background = WhiteIndex then
			SetForegroundColor(BlackIndex)
		else
			SetForegroundColor(WhiteIndex);
		if not NewPicWindow('Montage', mWidth, mHeight) then
			exit(MakeMontage);
		MontageInfo := info;
		SaveGDevice := GetGDevice;
		SetGDevice(osGDevice);
		SetPort(GrafPtr(info^.osPort));
		pmForeColor(ForegroundIndex);
		dPort := info^.osPort;
		dLeft := 0;
		dTop := 0;
		sPort := StackInfo^.osPort;
		sRect := StackInfo^.PicRect;
		i := FirstSlice;
		while i <= LastSlice do begin
				Info := StackInfo;
				SelectSlice(i);
				SetRect(dRect, dLeft, dTop, dLeft + dWidth, dTop + DHeight);
				CopyPics(sPort, dPort, sRect, dRect);
				info := MontageInfo;
				if gNumberSlices then begin
						MoveTo(dLeft + (dWidth div 2) - 3, dTop + dHeight - 9);
						NumToString(i, str);
						loc.h := dLeft + (dWidth div 2) - 3;
						loc.v := dTop + dHeight - 5;
						DrawTextString(str, loc, TeJustCenter);
					end;
				if gBorders then with dRect do begin
					PenSize(LineWidth, LineWidth);
					MoveTo(left,bottom);
					LineTo(left,top);
					LineTo(right,top);
					LineTo(right,bottom);
					LineTo(left,bottom);
				end;
				UpdateScreen(dRect);
				dLeft := dLeft + dWidth;
				if (dLeft + dWidth) > mWidth then begin
						dLeft := 0;
						dTop := dTop + dHeight;
					end;
				i := i + inc;
			end;
		FrameRect(info^.PicRect);
		SetGDevice(SaveGDevice);
		info := StackInfo;
		SelectSlice(info^.StackInfo^.CurrentSlice);
		info := MontageInfo;
		if info^.PixMapSize > UndoBufSize then
			PutWarning;
	end;


	procedure CopyRGBToPixMap (pmap: PixMapHandle);
		type
			LongPtr = ^LongInt;
		var
			row, i, width, WatchRate: integer;
			RedLine, GreenLine, BlueLine: LineType;
			Pixel, RowOffset: LongInt;
			pmapPtr: ptr;
			LPtr, RowStart: LongPtr;
	begin
		with info^ do begin
				pmapPtr := GetPixBaseAddr(pmap);
				if pmapPtr = nil then
					exit(CopyRGBToPixMap);
				LPtr := LongPtr(pmapPtr);
				RowStart := LPtr;
				RowOffset := band(pmap^^.RowBytes, $3FFF);
				width := PicRect.right;
				WatchRate := 40000 div PixelsPerLine;
				for row := 0 to nLines - 1 do begin
						if (row mod WatchRate) = 0 then
							ShowAnimatedWatch;
						SelectSlice(1);
						GetLine(0, row, width, RedLine);
						SelectSlice(2);
						GetLine(0, row, width, GreenLine);
						SelectSlice(3);
						GetLine(0, row, width, BlueLine);
						LPtr := RowStart;
						for i := 0 to PixelsPerLine - 1 do begin
								pixel := -1;
								pixel := RedLine[i];
								pixel := bor(bsl(pixel, 8), GreenLine[i]);
								pixel := bor(bsl(pixel, 8), blueLine[i]);
								LPtr^ := BitNot(pixel);
								LPtr := LongPtr(ord4(LPtr) + 4);
							end;
						RowStart := LongPtr(ord4(RowStart) + RowOffset);
					end;
				SelectSlice(StackInfo^.CurrentSlice);
			end; {with}
	end;


	function DoColorOptions: boolean;
		const
			ExistingID = 4;
			SystemID = 5;
			CustomID = 6;
			DitherID = 7;
		var
			mylog: DialogPtr;
			item: integer;

		procedure UpdateButtons;
		begin
			SetDlogItem(mylog, ExistingID, ord(RGBLut = ExistingLUT));
			SetDlogItem(mylog, SystemID, ord(RGBLut = SystemLUT));
			SetDlogItem(mylog, CustomID, ord(RGBLut = CustomLUT));
		end;

	begin
		InitCursor;
		mylog := GetNewDialog(160, nil, pointer(-1));
		SetDlogItem(mylog, DitherID, ord(DitherColor));
		UpdateButtons;
		OutlineButton(MyLog, ok, 16);
		repeat
			ModalDialog(nil, item);
			if item = DitherID then begin
					DitherColor := not DitherColor;
					SetDlogItem(mylog, DitherID, ord(DitherColor));
				end;
			if item = ExistingID then begin
					RGBLut := ExistingLUT;
					UpdateButtons
				end;
			if item = SystemID then begin
					RGBLut := SystemLUT;
					UpdateButtons;
					DitherColor := true;
					SetDlogItem(mylog, DitherID, ord(DitherColor));
				end;
			if item = CustomID then begin
					RGBLut := CustomLUT;
					UpdateButtons
				end;
		until (item = ok) or (item = cancel);
		DisposeDialog(mylog);
		DoColorOptions := item <> cancel;
	end;



	procedure ConvertRGBToEightBitColor (Capturing: boolean);
		var
			err: QDErr;
			err2: OSErr;
			osGWorld: GWorldPtr;
			flags: GWorldFlags;
			pmap: PixMapHandle;
			pRect: rect;
			thePictInfo: PictInfo;
			CopyMode, SamplingMethod: integer;
			UpdateNeeded: boolean;
			SaveGDevice: GDHandle;
	begin
		if not System7 then begin
				PutError('You must be running System 7 to do 24 to 8-bit color conversions.');
				exit(ConvertRGBToEightBitColor);
			end;
		with info^ do begin
				if StackInfo^.nSlices <> 3 then begin
						PutError('24 to 8-bit color conversion requires a three slice (red, green and blue) stack as input.');
						exit(ConvertRGBToEightBitColor);
					end;
				if StackInfo^.StackType <> rgbStack then begin;
					StackInfo^.StackType := rgbStack;
					UpdateTitleBar;
				end;
				if Capturing then begin
						DitherColor := true;
						RGBLut := CustomLUT;
					end
				else if not macro then begin
						if not DoColorOptions then
							exit(ConvertRGBToEightBitColor);
					end;
				flags := 0; {ppc-bug}
				SaveGDevice := GetGDevice;
				SetGDevice(osGDevice);
				err := NewGWorld(osGWorld, 32, PicRect, nil, nil, flags);
				SetGDevice(SaveGDevice);
				if err <> NoErr then begin
						PutMemoryAlert;
						exit(ConvertRGBToEightBitColor);
					end;
				pmap := GetGWorldPixMap(osGWorld);
				if not LockPixels(pmap) then
					begin
						DisposeGWorld(osGWorld);
						exit(ConvertRGBToEightBitColor);
					end;
				CopyRGBToPixMap(pmap);
				pRect := PicRect;
			end; {with}
		UpdateNeeded := true;
		if Activate('Indexed Color') then begin
				if (info^.PixelsPerLine <> pRect.right) or (info^.nLines <> pRect.bottom) then begin
						if not NewPicWindow('Indexed Color', pRect.right, pRect.bottom) then
							begin
								DisposeGWorld(osGWorld);
								exit(ConvertRGBToEightBitColor);
							end;
						UpdateNeeded := false;
					end
			end
		else begin
				if not NewPicWindow('Indexed Color', pRect.right, pRect.bottom) then
					begin
						DisposeGWorld(osGWorld);
						exit(ConvertRGBToEightBitColor);
					end;
				UpdateNeeded := false;
			end;
		if RGBLut = SystemLUT then
			SwitchColorTables(SystemPaletteItem, false)
		else if RGBLut = CustomLut then begin
				if OptionKeyWasDown then
					SamplingMethod := PopularMethod
				else
					SamplingMethod := SystemMethod;
				err2 := GetPixMapInfo(pmap, thePictInfo, ReturnColorTable, 256, SamplingMethod, 0);
				LoadColorTable(thePictInfo.theColorTable);
			end;
		SetForegroundColor(BlackIndex);
		SetBackgroundColor(WhiteIndex);
		if DitherColor then
			CopyMode := DitherCopy
		else
			CopyMode := SrcCopy;
		SetGDevice(osGDevice);
		SetPort(GrafPtr(Info^.osPort));
		CopyBits(BitMapHandle(pmap)^^, BitMapHandle(info^.osPort^.PortPixMap)^^, pRect, pRect, CopyMode, nil);
		DisposeGWorld(osGWorld);
		SetGDevice(SaveGDevice);
		if UpdateNeeded then
			UpdatePicWindow;
	end;


	function MakeRGBStack (name: str255): boolean;
		var
			ignore: integer;
	begin
		MakeRGBStack := false;
		if not Duplicate(name, false) then
			exit(MakeRGBStack);
		if not MakeStackFromWindow then
			exit(MakeRGBStack);
		if not AddSlice(false) then begin
				info^.changes := false;
				ignore := CloseAWindow(info^.wptr);
				exit(MakeRGBStack);
			end;
		if not AddSlice(false) then begin
				info^.changes := false;
				ignore := CloseAWindow(info^.wptr);
				exit(MakeRGBStack);
			end;
		MakeRGBStack := true;
	end;


	procedure ConvertEightBitColorToRGB;
		var
			width, height, i, row: integer;
			srcLine, rLine, gLine, bLine: LineType;
			rLut, gLUT, bLUT: packed array[0..255] of byte;
			value: byte;
	begin
		if isGrayscaleLUT then begin
				PutError('8-bit color to RGB conversion requires a color image.');
				exit(ConvertEightBitColorToRGB);
			end;
		KillRoi;
		if not MakeRGBStack(concat(info^.title, ' (RGB)')) then
			exit(ConvertEightBitColorToRGB);
		LoadLUT(Info^.cTable);
		for i := 0 to 255 do
			with cScreenPort^.portPixMap^^.pmTable^^.ctTable[i].rgb do begin
					rLUT[i] := BitNot(band(bsr(red, 8), 255));
					gLUT[i] := BitNot(band(bsr(green, 8), 255));
					bLUT[i] := BitNot(band(bsr(blue, 8), 255));
				end;
		width := info^.PixelsPerLine;
		height := info^.nLines;
		for row := 0 to height - 1 do begin
				SelectSlice(1);
				GetLine(0, row, width, srcLine);
				for i := 0 to width - 1 do begin
						value := srcLine[i];
						rLine[i] := rLUT[value];
						gLine[i] := gLUT[value];
						bLine[i] := bLUT[value];
					end;
				PutLine(0, row, width, rLine);
				SelectSlice(2);
				PutLine(0, row, width, gLine);
				SelectSlice(3);
				PutLine(0, row, width, bLine);
			end;
		with Info^.StackInfo^ do begin
				CurrentSlice := 1;
				SelectSlice(CurrentSlice);
				StackType := rgbStack;
				UpdateTitleBar;
			end;
		ResetGrayMap;
	end;


	procedure CaptureColor;
		var
			MainDevice: GDHandle;
			SourcePixMap: PixMapHandle;
			frame, width, height, SaveChannel: integer;
			frect: rect;
	begin
		with info^ do
			if PictureType <> FrameGrabberType then begin
					PutError('You must be capturing to capture color.');
					AbortMacro;
					exit(CaptureColor);
				end;
		StopDigitizing;
		with info^.PicRect do begin
				width := right - left;
				height := bottom - top;
			end;
		if Activate('RGB') then
			with info^.PicRect do begin
					if ((right - left) <> width) or ((bottom - top) <> height) then
						if not MakeRGBStack('RGB') then
							exit(CaptureColor);
				end
		else if not MakeRGBStack('RGB') then
			exit(CaptureColor);
		ShowWatch;
		SourcePixMap := fgPort^.portPixMap;
		ResetFrameGrabber;
		with frect do begin
				left := 0;
				top := 0;
				right := left + width;
				bottom := top + height;
			end;
		ShowTriggerMessage;
		SaveChannel := VideoChannel;
		with info^, info^.StackInfo^ do begin
				for frame := 1 to 3 do begin
						if FrameGrabber = QuickCapture then begin
								case frame of
									1: 
										VideoChannel := 1; {Green}
									2: 
										VideoChannel := 0;  {Red}
									3: 
										VideoChannel := 2;  {Blue}
								end;
								ResetFrameGrabber;
								repeat
								until band(ControlReg^, $8) = 0; {mux channel not busy}
							end
						else begin
								VideoChannel := frame - 1;
								ResetFrameGrabber;
							end;
						if VideoControl <> nil then
							ShowChannel;
						CurrentSlice := frame;
						SelectSlice(CurrentSlice);
						GetFrame;
						CopyOffscreen(SourcePixMap, osPort^.portPixMap, frect, PicRect);
					end; {for}
				CurrentSlice := 1;
				SelectSlice(CurrentSlice);
				UpdateTitleBar;
			end; {with}
		VideoChannel := SaveChannel;
		if VideoControl <> nil then
			ShowChannel;
		ConvertRGBToEightBitColor(true);
	end;


	procedure AverageSlices;
		const
			MaxWidth = 2048;
		var
			slices, sRow, aRow, slice, i, SaveSlice: integer;
			width, height, hstart, vStart: integer;
			OldInfo, NewInfo: InfoPtr;
			aLine: LineType;
			mask: rect;
			sum: array[0..MaxWidth] of LongInt;
			AutoSelectAll: boolean;
			SlicesDiv2:LongInt;
	begin
		OldInfo := Info;
		with info^ do begin
				if StackInfo = nil then begin
						PutError('Average Slices requires a stack.');
						AbortMacro;
						exit(AverageSlices);
					end;
				AutoSelectAll := not Info^.RoiShowing;
				if AutoSelectAll then
					SelectAll(true);
				with RoiRect do begin
						hStart := left;
						vStart := top;
						width := right - left;
						height := bottom - top;
					end;
				if width > MaxWidth then begin
						PutError(concat('NIH Image can''t average selections wider than ', Long2str(MaxWidth), ' pixels.'));
						AbortMacro;
						exit(AverageSlices);
					end;
				with StackInfo^ do begin
						slices := StackInfo^.nSlices;
						SaveSlice := CurrentSlice;
					end;
				if not NewPicWindow('Average', width, height) then begin
						AbortMacro;
						exit(AverageSlices);
					end;
			end;
		info^.changes := true;
		NewInfo := Info;
		aRow := 0;
		SlicesDiv2:=slices div 2; {Needed for rounding}
		for sRow := vStart to vStart + height - 1 do begin
				info := OldInfo;
				for i := 0 to width - 1 do
					sum[i] := 0;
				for slice := 1 to slices do begin
						SelectSlice(slice);
						GetLine(hStart, sRow, width, aLine);
						for i := 0 to width - 1 do
							sum[i] := sum[i] + aLine[i];
					end;
				for i := 0 to width - 1 do
					aLine[i] := (sum[i]+SlicesDiv2) div slices;
				info := NewInfo;
				PutLine(0, aRow, width, aLine);
				SetRect(mask, 0, aRow, width, aRow + 1);
				aRow := aRow + 1;
				UpdateScreen(mask);
				if CommandPeriod then
					leave;
			end;
		info := OldInfo;
		SelectSlice(SaveSlice);
		if AutoSelectAll then
			KillRoi;
		info:=NewInfo;
	end;


	procedure ConvertRGBToHSV;
		const
			MaxSaturation = 255;
			MaxValue = 255;
		var
			width, height, i, row, mark: integer;
			rLine, gLine, bLine, hLine, sLine, vLine: LineType;
			delta, min, max, R, G, B, H, S, V: integer;
			tmp: longint;
			UpdateR: rect;

		function Max3 (a, b, c: integer): integer;
			var
				TempMax: integer;
		begin
			if (a > b) then
				TempMax := a
			else
				TempMax := b;
			if (TempMax > c) then
				Max3 := TempMax
			else
				Max3 := c;
		end;

		function Min3 (a, b, c: integer): integer;
			var
				TempMin: integer;
		begin
			if (a < b) then
				TempMin := a
			else
				TempMin := b;
			if (TempMin < c) then
				Min3 := TempMin
			else
				Min3 := c;
		end;

	begin
		with info^ do begin
				if StackInfo^.nSlices <> 3 then begin
						PutError('RGB to HSV color conversion requires a three slice(red, green and blue) stack as input.');
						exit(ConvertRGBToHSV);
					end;
				if Changes then begin
						if PutMessageWithCancel('RGB to HSV color conversion is undoable.') = cancel then
							exit(ConvertRGBToHSV);
					end;
				KillRoi;
				with StackInfo^ do begin
						CurrentSlice := 1;
						SelectSlice(CurrentSlice);
						UpdatePicWindow;
					end;
				SwitchColorTables(SpectrumItem, true);
				title := 'HSV';
				UpdateTitleBar;
				width := PixelsPerLine;
				height := nLines;
				mark := 0;
				ShowWatch;
				for row := 0 to height - 1 do begin
						SelectSlice(1);
						GetLine(0, row, width, rLine);
						SelectSlice(2);
						GetLine(0, row, width, gLine);
						SelectSlice(3);
						GetLine(0, row, width, bLine);
						for i := 0 to width - 1 do begin
								R := 255 - rLine[i];
								G := 255 - gLine[i];
								B := 255 - bLine[i];
								max := Max3(R, G, B);
								min := Min3(R, G, B);
								V := max;
								if max <> 0 then begin
										tmp := 255 * (max - min);
										S := (tmp + (tmp mod max)) div max;  {adding '(tmp mod max)' simulate rounding}
									end
								else
									S := 0;
								if S = 0 then
									H := 0  {undefined but, but select red }
								else begin
										delta := max - min;
										if R = max then begin
												tmp := 85 * (G - B);
												H := tmp div delta;
											end
										else if G = max then begin
												tmp := 85 * (B - R);
												H := 170 + tmp div delta;
											end
										else if B = max then begin
												tmp := 85 * (R - G);
												H := 340 + tmp div delta;
											end;
										H := H div 2;
										if H < 0 then
											H := H + 255
									end;
								if H = 0 then
									hLine[i] := 1
								else
									hLine[i] := H;
								sLine[i] := S;
								vLine[i] := 255 - V;
							end;
						SelectSlice(1);
						PutLine(0, row, width, hLine);
						if (row mod 10) = 0 then begin
								setrect(UpdateR, 0, mark, width - 1, row);
								mark := row;
								UpdateScreen(UpdateR);
							end;
						SelectSlice(2);
						PutLine(0, row, width, sLine);
						SelectSlice(3);
						PutLine(0, row, width, vLine);
					end;
				SelectSlice(1);
				StackInfo^.StackType := hsvStack;
				UpdateTitleBar;
			end; {with}
		WhatToUndo := NothingToUndo;
	end;


	procedure DoStackInfo;
	const
		VolumeID = 5;
		MovieID = 6;
		RGBID = 7;
		HSVID = 8;
		SpacingID = 11;
		IntervalID = 12;
	var
		mylog: DialogPtr;
		item: integer;
		spacing, SaveSpacing, SaveInterval: extended;
		SaveType: StackTypeType;
		str: str255;
		
		procedure ShowStackType;
		begin
			With info^.StackInfo^ do begin
				SetDlogItem(MyLog, VolumeID, ord(StackType = VolumeStack));
				SetDlogItem(MyLog, MovieID, ord(StackType = MovieStack));
				SetDlogItem(MyLog, RGBID, ord(StackType = rgbStack));
				SetDlogItem(MyLog, HSVID, ord(StackType = hsvStack));
			end;
		end;
		
	begin
		With info^, info^.StackInfo^ do begin
			InitCursor;
			mylog := GetNewDialog(280, nil, pointer(-1));
			SaveType := StackType;
			SaveSpacing := SliceSpacing;
			SaveInterval := Frameinterval;
			ShowStackType;
			if SpatiallyCalibrated then begin
				spacing := SliceSpacing / xScale;
				str := xunit;
			end else begin
				spacing := SliceSpacing;
				str := 'pixels'
			end;
			SetDReal(MyLog, SpacingID, spacing, 3);
			ParamText(str, '', '', '');
			if Frameinterval < 99.0 then
				SetDReal(MyLog, IntervalID, Frameinterval, 3)
			else
				SetDReal(MyLog, IntervalID, Frameinterval, 0);
			SelectDialogItemText(MyLog, SpacingID, 0, 32767);
			OutlineButton(MyLog, ok, 16);
			repeat
				ModalDialog(nil, item);
				if (item >= VolumeID) and (item <= HSVID) then begin
					case item of
						VolumeID: StackType := VolumeStack;
						MovieID: StackType := MovieStack;
						rgbID: StackType := rgbStack;
						hsvID: StackType := hsvStack;
					end;
				    ShowStackType;
				  end;
				if item = SpacingID then begin
					spacing := GetDReal(MyLog, SpacingID);
					if SpatiallyCalibrated then
						SliceSpacing := spacing * xScale
					else
						SliceSpacing := spacing;
				end;
				if item = IntervalID then
					Frameinterval := GetDReal(MyLog, IntervalID);
			until (item = ok) or (item = cancel);
			DisposeDialog(mylog);
			if item = cancel then begin
				StackType := SaveType;
				SliceSpacing := SaveSpacing;
				Frameinterval := SaveInterval;
			end else
				if ((StackType = rgbStack) or (StackType = hsvStack)) and (nSlices <> 3) then begin
					PutError('RGB and HSV stacks must have three slices.');
					StackType := SaveType;
				end;
		end; {with}
		UpdateTitleBar;
	end;


end.