unit Macros1;
{Contains the recursive descent parser/interpreter}
{for NIH Image's Pascal-like macro language.}

{References:}
{  "Pascal User Manual and Report", Kathleen Jensen and Niklaus Wirth, Springer-Verlag}
{  "Building Your Own C Interpreter", Dr. Dobb's Journal, August 1989}

interface

	uses
		QuickDraw, Palettes, Picker, PrintTraps, Globals, Utilities, Graphics, Edit, {}
		Analysis, Camera, File1, File2, Filters, Macros2, Stacks, Lut, Background, {}
		User, Serial, PlugIns, Text, projection, math, UMacroDef, UMacroRun;


	procedure RunMacro (nMacro: integer);
	procedure RunKeyMacro (ch: char; KeyCode: integer);
	procedure CloseSerialPorts;
	procedure RunMenuMacro (menuID, menuItem: integer);


implementation

	const
		EndExpected = '"end" or ";" expected';
		ThenExpected = '"then" expected';
		DivideByZero = 'Divide by zero';
		DoExpected = '"do" expected';
		UntilExpected = '"until" expected';
		RightParenExpected = '")" expected';
		NoImageOpen = 'No Image open';
		MaxArgs = 25;

	var
		ErrorPC, LineStartPC: LongInt;
		DoOption: boolean;
		SaveBackground, SavePicWidth, SavePicHeight: integer;
		SaveMethod: rsMethodType;
		SaveCreate, SaveInvertY, SaveScaleArithmetic, SaveScaleConvolutions: boolean;
		SaveAngle, SaveH, SaveV: real;
		MacroOpPending, StringsAllocated, InPhotoMode: boolean;
		RoutinesCalled: set of CommandType;
		LastChoosePicInfo: InfoPtr;



	function GetExpression: extended;
	forward;
	procedure DoStatement;
	forward;
	procedure SkipStatement;
	forward;
	procedure DoFor;
	forward;
	procedure MacroError (str: str255);
	forward;
	function GetString: str255;
	forward;
	function GetInteger: LongInt;
	forward;
	procedure SkipIf;
	forward;
	procedure SkipPartialStatement;
	forward;


{$S MacroUtil}
{Routines from here to the $S compiler directive go in the MacroUtil segment}


	procedure PutTokenBack;
	begin
		if token <> DoneT then begin
				pc := SavePC;
				token := SaveToken;
			end;
	end;


	procedure DeallocateStrings (first, last: integer);
		var
			i: integer;
	begin
		with MacrosP^ do begin
				for i := first to last do begin
						if Stack[i].StringH <> nil then begin
								DisposHandle(handle(Stack[i].StringH));
								Stack[i].StringH := nil;
							end;
					end;
			end;
	end;


	procedure TrimString (var str: str255);
	begin
		if length(str) > 0 then begin
				while (length(str) > 1) and (str[1] = ' ') do
					delete(str, 1, 1);
				while (length(str) > 1) and ((str[length(str)] = ' ') or (str[length(str)] = ';')) do
					delete(str, length(str), 1);
			end;
	end;


	procedure LookupVariable;
		var
			VarFound: boolean;
			i: integer;
	begin
		with MacrosP^ do begin
				VarFound := false;
				i := TopOfStack + 1;
				repeat
					i := i - 1;
					VarFound := SymbolTableLoc = Stack[i].SymbolTableIndex
				until VarFound or (i = 1);
				if VarFound then
					with stack[i] do begin
							TokenValue := value;
							if vType <> StringVar then
								token := Variable
							else begin
									token := StringVariable;
									if StringH <> nil then
										TokenStr := StringH^^
									else
										TokenStr := 'Deallocated String';
								end;
							TokenStackLoc := i;
						end;
			end; {with}
	end;


	function FetchInteger: integer;
		var
			temp: integer;
	begin
		temp := ord(pcp(Macros^ + pc)^.c);
		pc := pc + 1;
		FetchInteger := bor(bsl(temp, 8), ord(pcp(Macros^ + pc)^.c));
		pc := pc + 1;
	end;


	procedure LookupProcedure;
	begin
		with MacrosP^ do begin
				SymbolTableLoc := FetchInteger;
				with SymbolTable[SymbolTableLoc] do begin
						TokenLoc := loc;
						TokenSymbol := symbol;
					end;
			end;
	end;


	function FetchReal: real;
		var
			temp: LongInt;
	begin
		temp := ord(pcp(Macros^ + pc)^.c);
		pc := pc + 1;
		temp := bor(bsl(temp, 8), ord(pcp(Macros^ + pc)^.c));
		pc := pc + 1;
		temp := bor(bsl(temp, 8), ord(pcp(Macros^ + pc)^.c));
		pc := pc + 1;
		temp := bor(bsl(temp, 8), ord(pcp(Macros^ + pc)^.c));
		pc := pc + 1;
		FetchReal := real(temp);
	end;


	procedure GetToken;
	begin
		if token = DoneT then
			exit(GetToken);
		SavePC := PC;
		SaveToken := token;
		token := TokenType(pcp(Macros^ + pc)^.c);
		while token = NewLineT do begin
				MacroLineNumber := MacroLineNumber + 1;
				pc := pc + 1;
				LineStartPC := pc;
				if pc > EndMacros then begin
						Token := DoneT;
						exit(GetToken);
					end;
				SavePC := PC;
				SaveToken := token;
				token := TokenType(pcp(Macros^ + pc)^.c);
			end;
		pc := pc + 1;
		if pc > EndMacros then begin
				Token := DoneT;
				exit(GetToken);
			end;
		case token of
			CommandT, FunctionT, StringFunctionT, ArrayT, UserCommandT, UserFuncT, UserStrFuncT: 
				MacroCommand := CommandType(FetchInteger);
			Identifier:  begin
					SymbolTableLoc := FetchInteger;
					if TopOfStack > 0 then
						LookupVariable;
				end;
			ProcedureT: 
				LookupProcedure;
			NumericLiteral: 
				TokenValue := FetchReal;
			StringLiteral:  begin
					TokenStr := '';
					while pcp(Macros^ + pc)^.c <> chr(0) do begin
							TokenStr := concat(TokenStr, pcp(Macros^ + pc)^.c);
							pc := pc + 1;
						end;
					pc := pc + 1;
				end;
		end; {case}
	end;


	procedure GetMacroName;
		var
			i, len: integer;
	begin
		pc := PCStart;
		repeat
			pc := pc - 1;
			if pc < 0 then
				exit(GetMacroName);
		until pcp(Macros^ + pc)^.c = chr(ord(MacroT));
		GetToken; {MacroT}
		GetToken; {Macro name}
		if Token = StringLiteral then begin
				len := length(TokenStr);
				if len > SymbolSize then
					len := SymbolSize;
				for i := 1 to len do
					MacroOrProcName[i] := TokenStr[i];
			end;
	end;


	procedure ConvertTokenToString (t: TokenType; var str: str255);
		var
			i, j, len: integer;
	begin
		with MacrosP^ do
			case token of
				semicolon: 
					str := ';';
				comma: 
					str := ',';
				colon: 
					str := ':';
				LeftParen: 
					str := '(';
				RightParen: 
					str := ')';
				LeftBracket: 
					str := '[';
				RightBracket: 
					str := ']';
				PlusOp: 
					str := '+';
				MinusOp: 
					str := '-';
				MulOp: 
					str := '*';
				DivOp: 
					str := '/';
				eqOp: 
					str := '=';
				ltOp: 
					str := '<';
				gtOp: 
					str := '>';
				neOp: 
					str := '<>';
				leOp: 
					str := '<=';
				geOp: 
					str := '>=';
				orOp: 
					str := 'or';
				IntDivOp: 
					str := 'div';
				modOp: 
					str := 'mod';
				andOp: 
					str := 'and';
				NotOp: 
					str := 'not';
				AssignOp: 
					str := ':=';
				Identifier, Variable, StringVariable, ProcIdT:  begin
						for i := 1 to SymbolSize do
							str := concat(str, SymbolTable[SymbolTableLoc].symbol[i]);
						TrimString(str);
					end;
				NumericLiteral:  begin
						if trunc(TokenValue) = TokenValue then
							RealToString(TokenValue, 1, 0, str)
						else
							RealToString(TokenValue, 1, 1, str);
					end;
				StringLiteral: 
					str := concat('''', TokenStr, '''');
				CommandT, FunctionT, StringFunctionT, ArrayT, UserCommandT, UserFuncT, UserStrFuncT: 
					for i := 1 to nSymbols do begin
							with SymbolTable[i] do
								if (tType = token) and (MacroCommand = cType) then begin
										for j := 1 to SymbolSize do
											str := concat(str, symbol[j]);
										TrimString(str);
									end;
						end; {for}
				otherwise
					for i := 1 to nSymbols do begin
							with SymbolTable[i] do
								if tType = token then begin
										for j := 1 to SymbolSize do
											str := concat(str, symbol[j]);
										TrimString(str);
									end;
						end; {for}
			end; {case}
	end;


	procedure GetErrorLine (var ErrorLine: str255);
		var
			str: str255;
	begin
		pc := LineStartPC;
		ErrorLine := '';
		repeat
			str := '';
			if pcp(Macros^ + pc)^.c = chr(ord(NewLineT)) then
				leave;
			GetToken;
			ConvertTokenToString(token, str);
			if SavePC = ErrorPC then
				str := concat('Ç', str, 'È');
			ErrorLine := concat(ErrorLine, ' ', str);
		until token = DoneT;
	end;


	procedure GetLineNumber;
	begin
		pc := PCStart;
		MacroLineNumber := 1;
		while (pc <= errorpc) and (token <> DoneT) do
			GetToken;
	end;


	procedure MacroError (str: str255);
  {Report run-time errors}
		var
			name, ErrorLine: str255;
			i, count, ignore: integer;
	begin
		if token = DoneT then
			exit(MacroError);
		if TopOfStack > 0 then
			DeAllocateStrings(nGlobals + 1, TopOfStack);
		ErrorPC := SavePC;
		if MacroOrProcName = BlankSymbol then
			GetMacroName;
		if MacroOrProcName[SymbolSize] <> ' ' then
			MacroOrProcName[SymbolSize] := 'É';
		name := MacroOrProcName;
		TrimString(name);
		GetLineNumber;
		GetErrorLine(ErrorLine);
		InitCursor;
		ParamText(str, long2str(MacroLineNumber), Name, ErrorLine);
		Ignore := Alert(900, nil);
		Token := DoneT;
	end;


	procedure DoDeclaration;
		var
			SaveStackLoc, StackLoc: integer;
	begin
		SaveStackLoc := TopOfStack;
		while (token = Identifier) or (token = variable) or (token = comma) or (token = StringVariable) do begin
				if token = StringVariable then begin
						MacroError('Variable previously defined');
						exit(DoDeclaration);
					end;
				if TopOfStack >= MaxMacroStackSize then begin
						MacroError(StackOverflow);
						exit(DoDeclaration);
					end;
				TopOfStack := TopOfStack + 1;
				with MacrosP^.stack[TopOfStack] do begin
						SymbolTableIndex := SymbolTableLoc;
						value := 0.0;
						StringH := nil;
					end;
				GetToken;
				if token = comma then
					GetToken;
			end; {while}
		if (token = FunctionT) or (token = StringFunctionT) or (token = CommandT) or (token = ArrayT) then
			MacroError('Predefined identifier');
		if token <> colon then
			MacroError('":" expected');
		GetToken;
		if (token <> IntegerT) and (token <> RealT) and (token <> BooleanT) and (token <> StringT) then
			MacroError('"integer", "real", "boolean" or "string" expected');
		for StackLoc := SaveStackLoc + 1 to TopOfStack do
			with macrosP^.stack[StackLoc] do
				case token of
					IntegerT: 
						vType := IntVar;
					RealT: 
						vType := RealVar;
					BooleanT: 
						vType := BooleanVar;
					StringT:  begin
							StringsAllocated := true;
							vType := StringVar;
							StringH := str255H(NewHandle(SizeOf(str255)));
							if StringH = nil then begin
									MacroError('Out of memory');
									Token := DoneT
								end
							else
								StringH^^ := 'Local String';
						end;
					otherwise
				end;
		GetToken;
		if Token = SemiColon then
			GetToken;
	end;


	procedure GetLeftParen;
	begin
		GetToken;
		if token <> LeftParen then
			MacroError('"(" expected');
	end;


	procedure GetRightParen;
	begin
		GetToken;
		if token <> RightParen then
			MacroError(RightParenExpected);
	end;


	procedure GetComma;
	begin
		GetToken;
		if token <> comma then
			MacroError('"," expected');
	end;


	procedure GetArguments (var str: str255);
		var
			width, fwidth: integer;
			i: LongInt;
			isExpression, ZeroFill, noArgs: boolean;
			n: extended;
			str2: str255;
	begin
		if MacroCommand = WritelnC then begin {Check for Writeln with no arguments}
				GetToken;
				noArgs := token <> LeftParen;
				PutTokenBack;
				if NoArgs then begin
						str := '';
						exit(GetArguments);
					end;
			end;
		ZeroFill := not (MacroCommand in [DrawTextC, WriteC, WritelnC, PutMsgC, ShowMsgC, PutSerialC, ConcatC]);
		width := 4;
		fwidth := 0;
		str := '';
		GetLeftParen;
		GetToken;
		repeat
			isExpression := token in [Variable, NumericLiteral, FunctionT, UserFuncT, TrueT, FalseT, ArrayT, MinusOp, LeftParen];
			PutTokenBack;
			if isExpression then
				n := GetExpression
			else
				str2 := GetString;
			GetToken;
			if token = colon then begin
					width := GetInteger;
					if width < 0 then
						width := 0;
					if width > 100 then
						width := 100;
					GetToken;
					if token = colon then begin
							fwidth := GetInteger;
							if fwidth < 0 then
								width := 0;
							if fwidth > 12 then
								width := 12;
							GetToken;
						end;
				end;
			if token = comma then
				GetToken;
			if isExpression then begin
					RealToString(n, width, fwidth, str2);
					if ZeroFill and (n >= 0) then
						for i := 1 to width do
							if str2[i] = ' ' then
								str2[i] := '0';
				end;
			str := concat(str, str2);
		until (token = RightParen) or (token = DoneT);
	end;


	function GetVar: integer;
	forward;

	procedure DoUserToken;
		var
			uma: UserMacroArgs;
			i, j, PicN: integer;
			UserToken: TokenType;
			saveinfo: InfoPtr;
	begin
		with uma, MacrosP^ do begin
				UserToken := token;
				UserMacroCommand := UserCommandType(MacroCommand);
				nArgs := 0;
				ErrorOccurred := false;
				LookupUserMacro(uma);  {Get information about command arguments}
				if ErrorOccurred then
					MacroError(str);
				if token = DoneT then
					exit(DoUserToken);
       {scan the arguments}
				if nArgs > 0 then begin
						GetLeftParen;
						if token = DoneT then
							exit(DoUserToken);
						for i := 1 to nArgs do
							with arg[i] do begin
									if i <> 1 then
										GetComma;
									case atype of
										UMATinteger:  begin
												ival := GetInteger;
											end;
										UMATreal:  begin
												aval := GetExpression;
											end;
										UMATstring:  begin
												str := GetString;
											end;
										UMATpic:  begin
												PicN := GetInteger;
												j := 0;
												while (PicN < 0) and (j < nPics) do begin
														j := j + 1;
														if InfoPtr(WindowPeek(PicWindow[j])^.RefCon)^.pidNum = PicN then
															PicN := j;
													end;
												if (PicN < 1) or (PicN > nPics) then
													MacroError('Specified image does not exist')
												else begin
														infop := pointer(WindowPeek(PicWindow[picN])^.RefCon);
														ival := PicN;
														with infop^ do begin
																wasRoi := RoiShowing;
																if wasRoi then
																	with RoiRect do
																		if roiType <> RectRoi then
																			MacroError('This command requires a rectangular selection')
																		else if (left < 0) or (top < 0) or (right > PixelsPerLine) or (bottom > nlines) then
																			MacroError('This command requires the selection to be entirely within the image')
																		else begin
																				roi.Base := ptr(ord4(PicBaseAddr) + left + LongInt(top) * BytesPerRow);
																				roi.Width := right - left;
																				roi.Height := bottom - top;
																			end
																else begin
																		roi.Base := PicBaseAddr;
																		roi.Width := PixelsPerLine;
																		roi.Height := nLines;
																	end;
																roi.Skip := BytesPerRow - roi.Width;
															end;{with infop^}
													end;{image exists}
											end;{UMATpic:}
										UMATintvar:  begin
												j := GetVar;
												varIX := j;
												if j <> 0 then
													ival := round(stack[j].value);
											end;
										UMATrealvar:  begin
												j := GetVar;
												varIX := j;
												if j <> 0 then
													aval := stack[j].value;
											end;
										UMATstringvar:  begin
												GetToken;
												if token <> StringVariable then
													MacroError('String Variable expected')
												else begin
														varIX := TokenStackLoc;
														str := TokenStr;
													end;
											end;
									end; {case}
									if token = DoneT then
										exit(DoUserToken);
								end;{with arg[i]}
						GetRightParen;
					end;
				if token = DoneT then
					exit(DoUserToken);
				saveInfo := info;
				for i := 1 to nArgs do
					with arg[i] do
						if atype = UMATpic then
							if wasRoi then begin
									info := infop;
									KillRoi;
								end;
				info := saveInfo;
				FuncResult := 0.0;
				DoUserMacro(uma);  {Execute the user command / function/ string function}
				if ErrorOccurred then begin
						MacroError(str);
						exit(DoUserToken);
					end;
				for i := 1 to nArgs do
					with arg[i] do begin
							case atype of
								UMATintvar: 
									stack[varIX].value := ival;
								UMATrealvar: 
									stack[varIX].value := aval;
								UMATstringvar: 
									with stack[varIX] do
										if StringH <> nil then
											StringH^^ := str;
								UMATpic: 
									if wasRoi then
										with infop^ do begin {restore rectangular ROI}
												roiType := RectRoi;
												MakeRegion;
												SetupUndo;
												RoiShowing := true;
											end;
								otherwise
									;
							end;{case}
						end;{with arg[i]}
				if UserToken = UserFuncT then
					TokenValue := FuncResult
				else if UserToken = UserStrFuncT then
					TokenStr := str;
			end;{with}
	end;


	function DoGetString: str255; {(prompt,default:str255)}
		const
			StringID = 3;
		var
			prompt, default: str255;
			Canceled: boolean;
			mylog: DialogPtr;
			item: integer;
	begin
		GetLeftParen;
		prompt := GetString;
		GetToken;
		if token = Comma then
			default := GetString
		else begin
				default := '';
				PutTokenBack
			end;
		GetRightParen;
		if Token <> DoneT then begin
				InitCursor;
				ParamText(prompt, '', '', '');
				mylog := GetNewDialog(170, nil, pointer(-1));
				SetDString(MyLog, StringID, default);
				SelIText(MyLog, StringID, 0, 32767);
				OutlineButton(MyLog, ok, 16);
				repeat
					ModalDialog(nil, item);
				until (item = ok) or (item = cancel);
				if item = ok then
					DoGetString := GetDString(MyLog, StringID)
				else begin
						DoGetString := 'cancel';
						token := DoneT;
					end;
				DisposDialog(mylog);
			end;
	end;


	function GetSerial: str255;
		var
			count: LongInt;
			buffer: packed array[1..100] of char;
			err: OSErr;
	begin
		if SerialBufferP = nil then begin
				MacroError('Serial port not open');
				exit(GetSerial);
			end;
		Err := SerGetBuf(SerialIn, count);
		if count > 0 then begin
				count := 1;
				Err := FSRead(SerialIn, count, @buffer);
				GetSerial := buffer[1]
			end
		else
			GetSerial := '';
	end;


	procedure RangeCheck (i: LongInt);
	begin
		if (i < 0) or (i > 255) then
			MacroError('Argument is less than 0 or greater than 255');
	end;


	function DoChr: str255;
		var
			i: LongInt;
	begin
		GetLeftParen;
		i := GetInteger;
		GetRightParen;
		RangeCheck(i);
		if Token <> DoneT then
			DoChr := chr(i);
	end;


	function GetWindowTitle: str255;
		var
			wPeek: WindowPeek;
	begin
		wPeek := WindowPeek(FrontWindow);
		if wPeek = nil then begin
				GetWindowTitle := '';
				exit(GetWindowTitle);
			end;
		if wPeek^.WindowKind = PicKind then
			GetWindowTitle := Info^.title
		else
			GetWindowTitle := wPeek^.TitleHandle^^;
	end;


	function DoStringFunction: str255;
		var
			str: str255;
	begin
		case MacroCommand of
			GetStringC: 
				DoStringFunction := DoGetString;
			ChrC: 
				DoStringFunction := DoChr;
			GetSerialC: 
				DoStringFunction := GetSerial;
			ConcatC, ConcatZFC:  begin
					GetArguments(str);
					DoStringFunction := str;
				end;
			WindowTitleC: 
				DoStringFunction := GetWindowTitle;
			otherwise
				MacroError('"GetString ", "GetSerial" or "chr" expected');
		end;
	end;


	function GetString: str255;
	begin
		GetToken;
		if token = StringFunctionT then
			GetString := DoStringFunction
		else if token = UserStrFuncT then begin
				DoUserToken; {result in TokenStr}
				GetString := TokenStr;
			end
		else if (token = StringLiteral) or (token = StringVariable) then
			GetString := TokenStr
		else begin
				MacroError('String expected');
				GetString := '';
			end;
	end;


	function GetInteger: LongInt;
		var
			n: LongInt;
			r: extended;
	begin
		r := GetExpression;
		if token = DoneT then begin
				GetInteger := 0;
				exit(GetInteger);
			end;
		GetInteger := round(r);
	end;


	procedure CheckBoolean (b: extended);
	begin
		if (b <> ord(true)) and (b <> ord(false)) then
			MacroError('Boolean expression expected');
	end;


	function GetBoolean: boolean;
		var
			value: extended;
	begin
		value := GetExpression;
		CheckBoolean(value);
		GetBoolean := value = ord(true);
	end;


	function GetBooleanArg: boolean;
	begin
		GetLeftParen;
		GetBooleanArg := GetBoolean;
		GetRightParen;
	end;


	function GetStringArg: str255;
	begin
		GetLeftParen;
		GetStringArg := GetString;
		GetRightParen;
	end;


	procedure DoConvolve;
		var
			err: OSErr;
			f: integer;
			FileFound: boolean;
			fname: str255;
	begin
		fname := GetStringArg;
		if token <> DoneT then begin
				if (fname = '') and (CurrentWindow = TextKind) then begin
						ConvolveUsingText;
						exit(DoConvolve);
					end;
				err := fsopen(fname, KernelsRefNum, f);
				FileFound := err = NoErr;
				err := fsclose(f);
				if FileFound then
					convolve(fname, KernelsRefNum)
				else
					convolve('', 0);
			end;
	end;


	function GetNumber: extended; {(prompt:str255; default:extended)}
		var
			prompt: str255;
			default, n: extended;
			Canceled: boolean;
	begin
		GetLeftParen;
		prompt := GetString;
		GetComma;
		default := GetExpression;
		GetRightParen;
		n := 0.0;
		if Token <> DoneT then begin
				n := GetReal(prompt, default, Canceled);
				if Canceled then begin
						n := default;
						token := DoneT;
					end;
			end;
		GetNumber := n;
	end;


	function DoGetPixel: extended; {(hloc,vloc:integer)}
		var
			hloc, vloc: integer;
	begin
		GetLeftParen;
		hloc := GetInteger;
		GetComma;
		vloc := GetInteger;
		GetRightParen;
		if (Token <> DoneT) and (info <> NoInfo) then
			DoGetPixel := MyGetPixel(hloc, vloc)
		else
			DoGetPixel := 0.0;
	end;


	function DoFunction (c: CommandType): extended;
		var
			n: extended;
			SaveCommand: CommandType;
	begin
		SaveCommand := MacroCommand;
		GetLeftParen;
		n := GetExpression;
		GetRightParen;
		if Token <> DoneT then
			case SaveCommand of
				truncC: 
					DoFunction := trunc(n);
				roundC: 
					DoFunction := round(n);
				oddC: 
					if odd(trunc(n)) then
						DoFunction := ord(true)
					else
						DoFunction := ord(false);
				absC: 
					DoFunction := abs(n);
				sqrtC: 
					if n < 0.0 then
						MacroError('Sqrt Error')
					else
						DoFunction := sqrt(n);
				sqrC: 
					DoFunction := sqr(n);
				sinC: 
					DoFunction := sin(n);
				cosC: 
					DoFunction := cos(n);
				expC: 
					DoFunction := exp(n);
				lnC: 
					if n <= 0.0 then
						MacroError('Log Error')
					else
						DoFunction := ln(n);
				arctanC: 
					DoFunction := arctan(n);
			end
		else
			DoFunction := 0.0;
	end;


	function CalibrateValue: extended;
		var
			i: integer;
	begin
		GetLeftParen;
		i := GetInteger;
		GetRightParen;
		RangeCheck(i);
		if Token <> DoneT then begin
				CalibrateValue := cvalue[i];
			end;
	end;


	function DoOrd: extended;
		var
			str: str255;
	begin
		GetLeftParen;
		str := GetString;
		GetRightParen;
		if Token <> DoneT then begin
				if length(str) >= 1 then
					DoOrd := ord(str[1])
				else
					DoOrd := -1;
			end;
	end;


	function DoStringToNum: extended;
		var
			str: str255;
			n: extended;
	begin
		GetLeftParen;
		str := GetString;
		GetRightParen;
		if Token <> DoneT then begin
				n := StringToReal(str);
				if n = BadReal then
					DoStringToNum := 0.0
				else
					DoStringToNum := n;
			end;
	end;


	function DoLogicalFunction (c: CommandType): extended;
		var
			n1, n2: LongInt;
	begin
		GetLeftParen;
		n1 := GetInteger;
		GetComma;
		n2 := GetInteger;
		GetRightParen;
		if Token <> DoneT then begin
				if c = BitAndC then
					DoLogicalFunction := band(n1, n2)
				else
					DoLogicalFunction := bor(n1, n2)
			end;
	end;


	function PidExists: boolean; {(pid:integer)}
		var
			pid, i: integer;
	begin
		GetLeftParen;
		pid := GetInteger;
		GetRightParen;
		if Token <> DoneT then begin
				PidExists := false;
				if pid < 0 then begin
						for i := 1 to nPics do
							if InfoPtr(WindowPeek(PicWindow[i])^.RefCon)^.pidNum = pid then begin
									PidExists := true;
									leave;
								end;
					end
				else if (pid > 0) and (pid <= nPics) then
					PidExists := true;
			end;
	end;


	function DoPos: integer;
		var
			substr, str: str255;
	begin
		GetLeftParen;
		substr := GetString;
		GetComma;
		str := GetString;
		GetRightParen;
		if Token <> DoneT then
			DoPos := pos(substr, str);
	end;


	function DoLength: integer;
		var
			str: str255;
	begin
		GetLeftParen;
		str := GetString;
		GetRightParen;
		if Token <> DoneT then
			DoLength := length(str);
	end;


	function ExecuteFunction: extended;
	begin
		case MacroCommand of
			TruncC, RoundC, oddC, absC, sqrtC, sqrC, sinC, cosC, expC, lnC, arctanC: 
				ExecuteFunction := DoFunction(MacroCommand);
			GetNumC: 
				ExecuteFunction := GetNumber;
			RandomC: 
				ExecuteFunction := (random + 32767.0) / 65534.0;
			GetPixelC: 
				ExecuteFunction := DoGetPixel;
			ButtonC:  begin
					ExecuteFunction := ord(Button);
					FlushEvents(EveryEvent, 0);
				end;
			nPicsC: 
				ExecuteFunction := nPics;
			PicNumC: 
				ExecuteFunction := info^.PicNum;
			PidNumC: 
				ExecuteFunction := info^.PidNum;
			PidExistsC: 
				ExecuteFunction := ord(PidExists);
			SameSizeC: 
				ExecuteFunction := ord(AllSameSize);
			cValueC: 
				ExecuteFunction := CalibrateValue;
			CalibratedC: 
				ExecuteFunction := ord(info^.DensityCalibrated);
			rCountC: 
				ExecuteFunction := mCount;
			GetSliceC: 
				with info^ do
					if StackInfo = nil then
						ExecuteFunction := 0
					else
						ExecuteFunction := Info^.StackInfo^.CurrentSlice;
			nSlicesC: 
				with info^ do
					if StackInfo = nil then
						ExecuteFunction := 0
					else
						ExecuteFunction := Info^.StackInfo^.nSlices;
			GetSpacingC: 
				with info^ do
					if StackInfo = nil then
						MacroError('No stack')
					else
						ExecuteFunction := Info^.StackInfo^.SliceSpacing;
			nCoordinatesC: 
				ExecuteFunction := nCoordinates;
			OrdC: 
				ExecuteFunction := DoOrd;
			TickCountC: 
				ExecuteFunction := TickCount;
			StringToNumC: 
				ExecuteFunction := DoStringToNum;
			UndoSizeC: 
				ExecuteFunction := UndoBufSize;
			BitAndC, BitOrC: 
				ExecuteFunction := DoLogicalFunction(MacroCommand);
			PosC: 
				ExecuteFunction := DoPos;
			LengthC: 
				ExecuteFunction := DoLength;
		end; {case}
	end;


	procedure CheckIndex (index: LongInt; min, max: extended);
	begin
		if (index < min) or (index > max) then
			MacroError('Array index out of range');
	end;


	function GetArrayValue: extended;
		var
			SaveCommand: CommandType;
			Index: LongInt;
			xcoord, ycoord: integer;
	begin
		SaveCommand := MacroCommand;
		GetToken;
		if token <> LeftBracket then
			MacroError('"[" expected');
		Index := GetInteger;
		GetToken;
		if token <> RightBracket then
			MacroError('"]" expected');
		case SaveCommand of
			HistogramC:  begin
					CheckIndex(Index, 0, 255);
					GetArrayValue := histogram[Index];
				end;
			rAreaC:  begin
					CheckIndex(Index, 1, MaxMeasurements);
					GetArrayValue := mArea^[Index];
				end;
			rMeanC:  begin
					CheckIndex(Index, 1, MaxMeasurements);
					GetArrayValue := mean^[Index];
				end;
			rStdDevC:  begin
					CheckIndex(Index, 1, MaxMeasurements);
					GetArrayValue := sd^[Index];
				end;
			rXC:  begin
					CheckIndex(Index, 1, MaxMeasurements);
					GetArrayValue := xcenter^[Index];
				end;
			rYC:  begin
					CheckIndex(Index, 1, MaxMeasurements);
					GetArrayValue := ycenter^[Index];
				end;
			rLengthC:  begin
					CheckIndex(Index, 1, MaxMeasurements);
					GetArrayValue := pLength^[Index];
				end;
			rMinC:  begin
					CheckIndex(Index, 1, MaxMeasurements);
					GetArrayValue := mMin^[Index];
				end;
			rMaxC:  begin
					CheckIndex(Index, 1, MaxMeasurements);
					GetArrayValue := mMax^[Index];
				end;
			rMajorC:  begin
					CheckIndex(Index, 1, MaxMeasurements);
					GetArrayValue := MajorAxis^[Index];
				end;
			rMinorC:  begin
					CheckIndex(Index, 1, MaxMeasurements);
					GetArrayValue := MinorAxis^[Index];
				end;
			rAngleC:  begin
					CheckIndex(Index, 1, MaxMeasurements);
					GetArrayValue := orientation^[Index];
				end;
			rUser1C:  begin
					CheckIndex(Index, 1, MaxMeasurements);
					GetArrayValue := User1^[Index];
				end;
			rUser2C:  begin
					CheckIndex(Index, 1, MaxMeasurements);
					GetArrayValue := User2^[Index];
				end;
			RedLutC, GreenLutC, BlueLutC: 
				if OptionKeyDown then begin
						CheckIndex(Index, 0, 255);
						if Token <> DoneT then
							with cScreenPort^.portPixMap^^.pmTable^^.ctTable[index].rgb do
								case SaveCommand of
									RedLutC: 
										GetArrayValue := band(bsr(red, 8), 255);
									GreenLutC: 
										GetArrayValue := band(bsr(green, 8), 255);
									BlueLutC: 
										GetArrayValue := band(bsr(blue, 8), 255);
								end; {case}
					end
				else begin
						CheckIndex(Index, 0, 255);
						if Token <> DoneT then
							with osGDevice^^.gdPMap^^.pmTable^^.ctTable[index].rgb do
								case SaveCommand of
									RedLutC: 
										GetArrayValue := band(bsr(red, 8), 255);
									GreenLutC: 
										GetArrayValue := band(bsr(green, 8), 255);
									BlueLutC: 
										GetArrayValue := band(bsr(blue, 8), 255);
								end; {case}
					end;
			BufferC:  begin
					CheckIndex(Index, 0, MaxLine - 1);
					if Token <> DoneT then
						GetArrayValue := MacrosP^.aLine[index];
				end;
			PlotDataC:  begin
					CheckIndex(Index, 0, MaxLine - 1);
					if Token <> DoneT then
						GetArrayValue := PlotData^[index];
				end;
			xCoordinatesC:  begin
					CheckIndex(Index, 1, MaxCoordinates);
					if Token <> DoneT then
						with info^ do begin
								xcoord := xCoordinates^[index];
								if SpatiallyCalibrated then
									GetArrayValue := xcoord / xSpatialScale
								else
									GetArrayValue := xcoord
							end;
				end;
			yCoordinatesC:  begin
					CheckIndex(Index, 1, MaxCoordinates);
					if Token <> DoneT then
						with info^ do begin
								ycoord := yCoordinates^[index];
								if InvertYCoordinates and (Info <> NoInfo) then
									ycoord := Info^.PicRect.bottom - ycoord - 1;
								if SpatiallyCalibrated then
									GetArrayValue := ycoord / ySpatialScale
								else
									GetArrayValue := ycoord
							end;
				end;
			ScionC:  begin
					if framegrabber <> ScionLG3 then
						MacroError('No Scion LG-3');
					if Token <> DoneT then
						CheckIndex(Index, 1, 4);
					if Token <> DoneT then
						case index of
							1: 
								GetArrayValue := LG3DacA;
							2: 
								GetArrayValue := LG3DacB;
							3: 
								GetArrayValue := ControlReg^;
							4: 
								GetArrayValue := LG3DataOut;
						end;
				end;
		end; {case}
	end;


	function GetStringValue: extended;
 {Convert string to a base 102 number so we can do comparisons.}
		const
			base = 102;
		var
			i, j: integer;
			v, k: extended;
	begin
		MakeLowerCase(TokenStr);
		k := 1;
		v := 0.0;
		for i := 1 to length(TokenStr) do begin
				j := ord(TokenStr[i]);
				if j > 127 then
					j := 127;
				if j >= 91 then
					j := j - 26;
				v := v + j * k;
				k := k * base;
			end;
		GetStringValue := v;
	end;


	function GetValue: extended;
	begin
		case token of
			Variable, NumericLiteral: 
				GetValue := TokenValue;
			FunctionT: 
				GetValue := ExecuteFunction;
			StringFunctionT:  begin
					TokenStr := DoStringFunction;
					GetValue := GetStringValue;
				end;
			UserFuncT:  begin
					DoUserToken;{output in TokenValue}
					GetValue := TokenValue;
				end;
			UserStrFuncT:  begin
					DoUserToken; {output in TokenStr}
					GetValue := GetStringValue;
				end;
			TrueT: 
				GetValue := ord(true);
			FalseT: 
				GetValue := ord(false);
			ArrayT: 
				GetValue := GetArrayValue;
			StringVariable, StringLiteral: 
				GetValue := GetStringValue;
			otherwise begin
					MacroError('Number expected');
					GetValue := 0.0;
					exit(GetValue);
				end;
		end; {case}
	end;


	function GetFactor: extended;
		var
			fValue: extended;
			isUnaryMinus, isNot: boolean;
	begin
		GetToken;
		isUnaryMinus := token = MinusOp;
		isNot := token = NotOp;
		if isUnaryMinus or isNot then
			GetToken;
		case token of
			Variable, NumericLiteral, FunctionT, StringFunctionT, UserFuncT, {}
			UserStrFuncT, TrueT, FalseT, ArrayT, StringVariable, StringLiteral: 
				fValue := GetValue;
			LeftParen:  begin
					fValue := GetExpression;
					GetRightParen;
				end;
			otherwise begin
					macroError('Undefined identifier');
					fvalue := 0.0
				end;
		end;
		GetToken;
		if isUnaryMinus then
			fValue := -fValue;
		if isNot then
			if fValue = ord(true) then
				fValue := ord(false)
			else
				fValue := ord(true);
		GetFactor := fValue;
	end;


	function GetTerm: extended;
		var
			tValue, fValue: extended;
			op: TokenType;
	begin
		tValue := GetFactor;
		while token in [MulOp, IntDivOp, ModOp, DivOp, AndOp] do begin
				op := token;
				fValue := GetFactor;
				case op of
					MulOp: 
						tValue := tValue * fValue;
					IntDivOp: 
						if fValue <> 0.0 then
							tValue := trunc(tValue) div trunc(fValue)
						else
							MacroError(DivideByZero);
					ModOp: 
						if fValue <> 0.0 then
							tValue := trunc(tValue) mod trunc(fValue)
						else
							MacroError(DivideByZero);
					DivOp: 
						if fValue <> 0.0 then
							tValue := tValue / fValue
						else
							MacroError(DivideByZero);
					AndOp:  begin
							CheckBoolean(tValue);
							CheckBoolean(fValue);
							tValue := ord((tValue = ord(true)) and (fValue = ord(true)));
						end;
				end; {case}
			end; {while}
		GetTerm := tValue;
	end;


	function GetSimpleExpression: extended;
		var
			seValue, tValue: extended;
			op: TokenType;
	begin
		seValue := GetTerm;
		while token in [PlusOp, MinusOp, OrOp] do begin
				op := token;
				tValue := GetTerm;
				case op of
					PlusOp: 
						seValue := seValue + tValue;
					MinusOp: 
						seValue := seValue - tValue;
					orOp:  begin
							CheckBoolean(seValue);
							CheckBoolean(tValue);
							seValue := ord((seValue = ord(true)) or (tValue = ord(true)));
						end;
				end;
			end;
		GetSimpleExpression := seValue;
	end;


	function GetExpression: extended;
		var
			eValue, seValue: extended;
			op: TokenType;
	begin
		eValue := GetSimpleExpression;
		while token in [eqOp, ltOp, gtOp, neOp, leOp, geOp] do begin
				op := token;
				seValue := GetSimpleExpression;
				case op of
					eqOp: 
						eValue := ord(eValue = seValue);
					ltOp: 
						eValue := ord(eValue < seValue);
					gtOp: 
						eValue := ord(eValue > seValue);
					neOp: 
						eValue := ord(eValue <> seValue);
					leOp: 
						eValue := ord(eValue <= seValue);
					geOp: 
						eValue := ord(eValue >= seValue);
				end;
			end;
		GetExpression := eValue;
		PutTokenBack;
	end;


{$S}
{Routines from here to the end of the file go in the macro1 segment}

	procedure DoCapture;
	begin
		CaptureAndDisplayFrame;
		if ContinuousHistogram then
			ShowContinuousHistogram;
	end;


	procedure DoWait;
		var
			seconds: extended;
			SaveTicks: LongInt;
			str: str255;
	begin
		GetLeftParen;
		seconds := GetExpression;
		GetRightParen;
		if Token <> DoneT then begin
				SaveTicks := TickCount + round(seconds * 60.0);
				repeat
					if Digitizing then
						DoCapture;
				until (TickCount > SaveTicks) or CommandPeriod;
			end;
	end;


	procedure SetDensitySlice; {LowerLevel,UpperLevel:integer}
  {Disable density slicing if lower and upper=0 and enable it up lower and upper=255}
		var
			sStart, sEnd: integer;
	begin
		GetLeftParen;
		sStart := GetInteger;
		RangeCheck(sStart);
		GetComma;
		sEnd := GetInteger;
		RangeCheck(sEnd);
		GetRightParen;
		if Token <> DoneT then begin
				DisableDensitySlice;
				DisableThresholding;
				if (sEnd < sStart) or ((sStart = 0) and (sEnd = 0)) then
					exit(SetDensitySlice);
				if not ((sStart = 255) and (sEnd = 255)) then begin
						SliceStart := sStart;
						SliceEnd := sEnd;
						if SliceStart < 1 then
							SliceStart := 1;
						if SliceEnd > 254 then
							SliceEnd := 254;
					end;
				EnableDensitySlice;
			end;
	end;


	procedure SetColor;
		var
			index: integer;
			SaveCommand: CommandType;
	begin
		SaveCommand := MacroCommand;
		GetLeftParen;
		index := GetInteger;
		GetRightParen;
		RangeCheck(index);
		if Token <> DoneT then begin
				if SaveCommand = SetForeC then
					SetForegroundColor(index)
				else
					SetBackgroundColor(index);
			end;
	end;


	procedure DoConstantArithmetic;
		var
			constant: extended;
			SaveCommand: CommandType;
	begin
		SaveCommand := MacroCommand;
		GetLeftParen;
		constant := GetExpression;
		GetRightParen;
		if token <> DoneT then
			case SaveCommand of
				AddConstC: 
					DoArithmetic(AddItem, constant);
				MulConstC: 
					DoArithmetic(MultiplyItem, constant);
			end;
	end;


	procedure GetNextWindow;
		var
			n: integer;
	begin
		n := info^.PicNum + 1;
		if n > nPics then
			n := 1;
		StopDigitizing;
		SaveRoi;
		DisableDensitySlice;
		SelectWindow(PicWindow[n]);
		Info := pointer(WindowPeek(PicWindow[n])^.RefCon);
		ActivateWindow;
		GenerateValues;
		LoadLUT(info^.cTable);
		UpdatePicWindow;
	end;


	procedure DoRevert;
	begin
		if info^.revertable then begin
				RevertToSaved;
				UpdatePicWindow;
			end
		else
			MacroError('Unable to revert');
	end;


	procedure MakeRoi;
		var
			Left, Top, Width, Height: integer;
			SaveCommand: CommandType;
	begin
		SaveCommand := MacroCommand;
		GetLeftParen;
		left := GetInteger;
		GetComma;
		top := GetInteger;
		GetComma;
		width := GetInteger;
		if width < 1 then
			width := 1;
		GetComma;
		height := GetInteger;
		if height < 1 then
			height := 1;
		GetRightParen;
		KillRoi;
		if token <> DoneT then
			with Info^ do begin
					StopDigitizing;
					if SaveCommand = MakeOvalC then
						RoiType := OvalRoi
					else
						RoiType := RectRoi;
					SetRect(RoiRect, left, top, left + width, top + height);
					MakeRegion;
					SetupUndo;
					RoiShowing := true;
				end;
	end;


	procedure MoveRoi;
		var
			DeltaH, DeltaV: integer;
	begin
		GetLeftParen;
		DeltaH := GetInteger;
		GetComma;
		DeltaV := GetInteger;
		GetRightParen;
		with info^ do begin
				if not RoiShowing then begin
						MacroError('No Selection');
						exit(MoveRoi);
					end;
				OffsetRgn(roiRgn, DeltaH, DeltaV);
				RoiRect := roiRgn^^.rgnBBox;
				RoiUpdateTime := 0;
				MacroOpPending := true;
			end;
	end;


	procedure InsetRoi;
		var
			delta: integer;
	begin
		GetLeftParen;
		delta := GetInteger;
		GetRightParen;
		with info^ do begin
				if not RoiShowing then begin
						MacroError('No Selection');
						exit(InsetRoi);
					end;
				InsetRgn(roiRgn, delta, delta);
				RoiRect := roiRgn^^.rgnBBox;
				RoiUpdateTime := 0;
				MacroOpPending := true;
			end;
	end;


	procedure DoMoveTo; {(x,y:integer)}
	begin
		GetLeftParen;
		CurrentX := GetInteger;
		GetComma;
		CurrentY := GetInteger;
		GetRightParen;
		InsertionPoint.h := CurrentX;
		InsertionPoint.v := CurrentY + 4;
	end;


	procedure DoDrawtext (str: str255; EndOfLine: boolean);
	begin
		if info <> NoInfo then begin
				KillRoi;
				DrawTextString(str, InsertionPoint, TextJust);
				if EndOfLine then begin
						CurrentY := CurrentY + CurrentSize;
						InsertionPoint.h := CurrentX;
						InsertionPoint.v := CurrentY + 4;
					end;
			end;
	end;


	procedure DrawNumber;
		var
			n: extended;
			str: str255;
			fwidth: integer;
	begin
		GetLeftParen;
		n := GetExpression;
		GetRightParen;
		if token <> DoneT then begin
				if n = trunc(n) then
					fwidth := 0
				else
					fwidth := precision;
				RealToString(n, 1, fwidth, str);
				DoDrawText(str, true);
			end;
	end;


	procedure SetFont;
		var
			FontName: str255;
			id: integer;
	begin
		FontName := GetStringArg;
		if Token <> DoneT then begin
				GetFNum(FontName, id);
				if id = 0 then
					MacroError('Font not available')
				else
					CurrentFontID := id;
			end;
	end;


	procedure SetFontSize;
		var
			size: integer;
	begin
		GetLeftParen;
		Size := GetInteger;
		GetRightParen;
		if (size < 6) or (size > 720) then
			MacroError('Argument out of range');
		if Token <> DoneT then
			CurrentSize := size;
	end;


	procedure SetText;
		var
			Attributes: str255;
	begin
		Attributes := GetStringArg;
		if Token <> DoneT then begin
				MakeLowerCase(Attributes);
				if pos('with', Attributes) <> 0 then
					TextBack := WithBack;
				if pos('no', Attributes) <> 0 then
					TextBack := NoBack;
				if pos('left', Attributes) <> 0 then
					TextJust := teJustLeft;
				if pos('center', Attributes) <> 0 then
					TextJust := teJustCenter;
				if pos('right', Attributes) <> 0 then
					TextJust := teJustRight;
				CurrentStyle := [];
				if pos('bold', Attributes) <> 0 then
					CurrentStyle := CurrentStyle + [Bold];
				if pos('italic', Attributes) <> 0 then
					CurrentStyle := CurrentStyle + [Italic];
				if pos('underline', Attributes) <> 0 then
					CurrentStyle := CurrentStyle + [Underline];
				if pos('outline', Attributes) <> 0 then
					CurrentStyle := CurrentStyle + [Outline];
				if pos('shadow', Attributes) <> 0 then
					CurrentStyle := CurrentStyle + [Shadow];
			end;
	end;


	procedure DoPutMessage;
		var
			str: str255;
	begin
		GetArguments(str);
		if Token <> DoneT then
			PutMessage(str)
	end;


	function GetVar: integer;
	begin
		GetVar := 0;
		GetToken;
		if token <> Variable then
			MacroError('Variable expected')
		else
			GetVar := TokenStackLoc;
	end;


	procedure GetPicSize;  {(width,height)}
		var
			loc1, loc2: integer;
	begin
		GetLeftParen;
		loc1 := GetVar;
		GetComma;
		loc2 := GetVar;
		GetRightParen;
		if Token <> DoneT then
			with MacrosP^ do
				if info = NoInfo then begin
						stack[loc1].value := 0.0;
						stack[loc2].value := 0.0;
					end
				else
					with info^ do begin
							stack[loc1].value := PixelsPerLine;
							stack[loc2].value := nLines;
						end;
	end;


	procedure GetRoi;  {(hloc,vloc,width,height)}
		var
			loc1, loc2, loc3, loc4: integer;
	begin
		GetLeftParen;
		loc1 := GetVar;
		GetComma;
		loc2 := GetVar;
		GetComma;
		loc3 := GetVar;
		GetComma;
		loc4 := GetVar;
		GetRightParen;
		if Token <> DoneT then
			with MacrosP^, Info^ do
				if RoiShowing then
					with RoiRect do begin
							stack[loc1].value := left;
							stack[loc2].value := top;
							stack[loc3].value := right - left;
							stack[loc4].value := bottom - top;
						end
				else begin
						stack[loc1].value := 0.0;
						stack[loc2].value := 0.0;
						stack[loc3].value := 0.0;
						stack[loc4].value := 0.0;
					end;
	end;


	procedure CaptureOneFrame;
	begin
		if (FrameGrabber <> QuickCapture) and (FrameGrabber <> ScionLG3) then
			MacroError('Frame grabber not installed')
		else begin
				StartDigitizing;
				CaptureAndDisplayFrame;
				StopDigitizing;
			end;
	end;


	procedure DoMakeNewWindow; {(name:str255)}
		var
			name: str255;
	begin
		GetArguments(name);
		if token <> DoneT then
			if (LongInt(NewPicWidth) * NewPicHeight) > UndoBufSize then
				MacroError('New window larger than Undo buffer')
			else if not NewPicWindow(name, NewPicWidth, NewPicHeight) then
				MacroError('Out of memory');
	end;


	procedure DoSetPalette;
		var
			PaletteType: str255;
			ok: boolean;
	begin
		PaletteType := GetStringArg;
		if token <> DoneT then begin
				MakeLowerCase(PaletteType);
				if pos('gray', PaletteType) <> 0 then
					ResetGrayMap
				else if pos('pseudo', PaletteType) <> 0 then
					SwitchColorTables(Pseudo20Item, true)
				else if pos('system', PaletteType) <> 0 then
					SwitchColorTables(SystemPaletteItem, true)
				else if pos('rainbow', PaletteType) <> 0 then
					SwitchColorTables(RainbowItem, true)
				else if pos('spectrum', PaletteType) <> 0 then
					SwitchColorTables(SpectrumItem, true)
			end;
	end;


	procedure DoOpenImage;
		var
			err: OSErr;
			f: integer;
			FileFound, result: boolean;
			fname: str255;
			SaveCommand: CommandType;
	begin
		SaveCommand := MacroCommand;
		GetArguments(fname);
		if token <> DoneT then begin
				if fname = '' then
					fname := DefaultFileName;
				err := fsopen(fname, DefaultRefNum, f);
				FileFound := err = NoErr;
				err := fsclose(f);
				if FileFound then
					case SaveCommand of
						OpenC: 
							result := DoOpen(fname, DefaultRefNum);
						ImportC: 
							result := ImportFile(fname, DefaultRefNum);
					end
				else
					case SaveCommand of
						OpenC: 
							result := DoOpen('', 0);
						ImportC: 
							result := ImportFile('', 0);
					end;
				if result then
					UpdatePicWindow
				else
					token := DoneT;
			end;
	end;


	procedure SetImportAttributes;
		var
			Attributes: str255;
	begin
		Attributes := GetStringArg;
		if Token <> DoneT then begin
				MakeLowerCase(Attributes);
				WhatToImport := ImportTIFF;
				ImportCustomDepth := EightBits;
				ImportSwapBytes := false;
				ImportCalibrate := false;
				ImportAll := false;
				ImportAutoScale := true;
				ImportInvert := false;
				if pos('mcid', Attributes) <> 0 then
					WhatToImport := ImportMCID;
				if pos('look', Attributes) <> 0 then
					WhatToImport := ImportLUT;
				if pos('palette', Attributes) <> 0 then
					WhatToImport := ImportLUT;
				if pos('text', Attributes) <> 0 then
					WhatToImport := ImportText;
				if pos('custom', Attributes) <> 0 then
					WhatToImport := ImportCustom;
				if (pos('8', Attributes) <> 0) or (pos('eight', Attributes) <> 0) then begin
						ImportCustomDepth := EightBits;
						WhatToImport := ImportCustom;
					end;
				if (pos('signed', Attributes) <> 0) then begin
						ImportCustomDepth := SixteenBitsSigned;
						WhatToImport := ImportCustom;
					end;
				if (pos('unsigned', Attributes) <> 0) then begin
						ImportCustomDepth := SixteenBitsUnsigned;
						WhatToImport := ImportCustom;
					end;
				if (pos('swap', Attributes) <> 0) then
					ImportSwapBytes := true;
				if (pos('calibrate', Attributes) <> 0) then
					ImportCalibrate := true;
				if (pos('fixed', Attributes) <> 0) then
					ImportAutoScale := false;
				if (pos('all', Attributes) <> 0) then
					ImportAll := true;
				if (pos('invert', Attributes) <> 0) then
					ImportInvert := true;
			end;
	end;


	procedure SetImportMinMax; {(min,max:integer)}
		var
			TempMin, TempMax: extended;
	begin
		GetLeftParen;
		TempMin := GetExpression;
		GetComma;
		TempMax := GetExpression;
		GetRightParen;
		if Token <> DoneT then begin
				ImportAutoScale := false;
				ImportMin := TempMin;
				ImportMax := TempMax;
			end;
	end;


	procedure SetCustomImport; {(width,height,offset[,nslices]:integer)}
		var
			width, height, nSlices: integer;
			offset: LongInt;
	begin
		GetLeftParen;
		width := GetInteger;
		GetComma;
		height := GetInteger;
		GetComma;
		offset := GetInteger;
		GetToken;
		if token = comma then
			nSlices := GetInteger
		else begin
				PutTokenBack;
				nSlices := 1
			end;
		GetRightParen;
		if (width < 0) or (width > MaxPicSize) or (height < 0) or (offset < 0) or (nSlices < 1) then
			MacroError('Argument out of range');
		if Token <> DoneT then begin
				ImportCustomWidth := width;
				ImportCustomHeight := height;
				ImportCustomOffset := offset;
				ImportCustomSlices := nSlices;
				WhatToImport := ImportCustom;
			end;
	end;


	procedure SelectImage (id: integer);
	begin
		StopDigitizing;
		SaveRoi;
		DisableDensitySlice;
		SelectWindow(PicWindow[id]);
		Info := pointer(WindowPeek(PicWindow[id])^.RefCon);
		ActivateWindow;
		GenerateValues;
		LoadLUT(info^.cTable);
		UpdatePicWindow;
		LastChoosePicInfo := nil;
	end;


	procedure SelectPic; {(PicN:integer)}
		var
			PicN, i: integer;
			SaveCommand: CommandType;
	begin
		SaveCommand := MacroCommand;
		GetLeftParen;
		PicN := GetInteger;
		GetRightParen;
		i := 0;
		while (PicN < 0) and (i < nPics) do begin
				i := i + 1;
				if InfoPtr(WindowPeek(PicWindow[i])^.RefCon)^.pidNum = PicN then
					PicN := i;
			end;
		if (PicN < 1) or (PicN > nPics) then
			MacroError('Specified image does not exist');
		if Token <> DoneT then begin
				if SaveCommand = SelectPicC then
					SelectImage(PicN)
				else begin
						StopDigitizing;
						SaveRoi;
						DisableDensitySlice;
						Info := pointer(WindowPeek(PicWindow[PicN])^.RefCon);
						LastChoosePicInfo := Info;
					end
			end;
	end;


	procedure SetPicName;  {(name:string)}
		var
			n, i: LongInt;
			isInteger: boolean;
			name: str255;
	begin
		GetArguments(name);
		if Token <> DoneT then begin
				with info^ do begin
						title := name;
						if PictureType <> FrameGrabberType then
							PictureType := NewPicture;
						UpdateWindowsMenuItem(PixMapSize, title, PicNum);
						UpdateTitleBar;
					end;
			end;
	end;


	procedure SetNewSize; {(width,height:integer)}
		var
			TempWidth, TempHeight: integer;
	begin
		GetLeftParen;
		TempWidth := GetInteger;
		GetComma;
		TempHeight := GetInteger;
		GetRightParen;
		if Token <> DoneT then begin
				NewPicWidth := TempWidth;
				NewPicHeight := TempHeight;
				if odd(NewPicWidth) then
					NewPicWidth := NewPicWidth + 1;
				if NewPicWidth > MaxPicSize then
					NewPicWidth := MaxPicSize;
				if NewPicWidth < 8 then
					NewPicWidth := 8;
				if NewPicHeight < 8 then
					NewPicHeight := 8;
				if NewPicHeight > MaxPicSize then
					NewPicHeight := MaxPicSize;
			end;
	end;


	procedure DoSaveAs;
		var
			name: str255;
			RefNum: integer;
			HasArgs: boolean;
	begin
		name := info^.title;
		if (name = 'Untitled') or (name = 'Camera') then
			name := '';
		GetToken;
		HasArgs := token = LeftParen;
		PutTokenBack;
		if HasArgs then
			GetArguments(name);
		if token <> DoneT then begin
				StopDigitizing;
				if nSaves = 0 then
					RefNum := 0
				else
					RefNum := DefaultRefNum;
				case CurrentWindow of
					TextKind: 
						SaveTextAs;
					ResultsKind: 
						Export('', RefNum);
					otherwise begin
							if info <> NoInfo then
								SaveAs(name, RefNum)
							else
								MacroError(NoImageOpen);
						end;
				end;
				nSaves := nSaves + 1;
			end;
	end;


	procedure DoSave;
		var
			kind: integer;
	begin
		StopDigitizing;
		kind := CurrentWindow;
		if (kind = PicKind) or (kind = TextKind) or (Kind = ResultsKind) then
			SaveFile
		else
			MacroError('Nothing to save');
	end;


	procedure DoExport;
		var
			name: str255;
			RefNum: integer;
			HasArgs: boolean;
	begin
		StopDigitizing;
		name := info^.title;
		if (name = 'Untitled') or (name = 'Camera') then
			name := '';
		GetToken;
		HasArgs := token = LeftParen;
		PutTokenBack;
		if HasArgs then
			GetArguments(name);
		if nSaves = 0 then
			RefNum := 0
		else
			RefNum := DefaultRefNum;
		Export(name, RefNum);
		nSaves := nSaves + 1;
	end;


	procedure DoCopyResults;
		var
			IgnoreResult: boolean;
	begin
		if mCount < 1 then
			MacroError('Copy Results failed')
		else begin
				CopyResults;
				IgnoreResult := SystemEdit(3); {Fake Copy needed for MultiFinder}
			end;
	end;


	procedure DisposeAll;
		var
			i, ignore: integer;
	begin
		StopDigitizing;
		for i := nPics downto 1 do begin
				Info := pointer(WindowPeek(PicWindow[i])^.RefCon);
				ignore := CloseAWindow(info^.wptr);
			end;
	end;


	procedure DoDuplicate;
		var
			str: str255;
	begin
		GetArguments(str);
		if token <> DoneT then
			if not Duplicate(str, false) then
				token := DoneT
			else
				UpdatePicWindow;
	end;


	procedure DoLineTo; {(x,y:integer)}
		var
			x, y: integer;
			p1, p2: point;
	begin
		GetLeftParen;
		p2.h := GetInteger;
		GetComma;
		p2.v := GetInteger;
		GetRightParen;
		if token <> DoneT then begin
				KillRoi;
				p1.h := CurrentX;
				p1.v := CurrentY;
				CurrentX := p2.h;
				CurrentY := p2.v;
				OffscreenToScreen(p1);
				OffscreenToScreen(p2);
				DrawObject(LineObj, p1, p2);
			end;
	end;


	procedure DoGetLine;  {(var x1,y1,x2,y2:real; LineWidth:integer)}
		var
			loc1, loc2, loc3, loc4, loc5: integer;
			x1, y1, x2, y2: real;
	begin
		GetLeftParen;
		loc1 := GetVar;
		GetComma;
		loc2 := GetVar;
		GetComma;
		loc3 := GetVar;
		GetComma;
		loc4 := GetVar;
		GetComma;
		loc5 := GetVar;
		GetRightParen;
		if Token <> DoneT then
			with MacrosP^, info^ do begin
					GetLoi(x1, y1, x2, y2);
					if RoiShowing and (RoiType = LineRoi) then
						stack[loc1].value := x1
					else
						stack[loc1].value := -1;
					stack[loc2].value := y1;
					stack[loc3].value := x2;
					stack[loc4].value := y2;
					stack[loc5].value := LineWidth;
				end;
	end;


	procedure DoScaleAndRotate; {(hscale,vscale,angle:real)}
		var
			SaveCommand: CommandType;
	begin
		SaveCommand := MacroCommand;
		GetLeftParen;
		rsHScale := GetExpression;
		GetComma;
		rsVScale := GetExpression;
		if SaveCommand <> ScaleSelectionC then begin
				GetComma;
				rsAngle := GetExpression;
			end;
		GetRightParen;
		if token <> DoneT then begin
				if SaveCommand = ScaleSelectionC then begin
						rsMethod := NearestNeighbor;
						rsCreateNewWindow := false;
						rsAngle := 0.0;
					end;
				ScaleAndRotate;
			end;
	end;


	procedure SetPlotScale; {(min,max:integer)}
		var
			min, max: extended;
	begin
		GetLeftParen;
		min := GetExpression;
		GetComma;
		max := GetExpression;
		GetRightParen;
		if not info^.DensityCalibrated then begin
				RangeCheck(trunc(min));
				RangeCheck(trunc(max));
			end;
		if token <> DoneT then begin
				AutoScalePlots := (min = 0.0) and (max = 0.0);
				ProfilePlotMin := min;
				ProfilePlotMax := max;
			end;
	end;


	procedure SetPlotDimensions; {(width,height:integer)}
		var
			width, height: integer;
	begin
		GetLeftParen;
		width := GetInteger;
		GetComma;
		height := GetInteger;
		GetRightParen;
		if token <> DoneT then begin
				FixedSizePlot := not ((width = 0) and (height = 0));
				ProfilePlotWidth := width;
				ProfilePlotHeight := height;
			end;
	end;


	procedure GetResults;  {(var n,mean,mode,min,max:real)}
		var
			loc1, loc2, loc3, loc4, loc5: integer;
	begin
		GetLeftParen;
		loc1 := GetVar;
		GetComma;
		loc2 := GetVar;
		GetComma;
		loc3 := GetVar;
		GetComma;
		loc4 := GetVar;
		GetComma;
		loc5 := GetVar;
		GetRightParen;
		if mCount = 0 then
			MacroError('No results');
		if Token <> DoneT then
			with MacrosP^, results do begin
					stack[loc1].value := PixelCount^[mCount];
					stack[loc2].value := UncalibratedMean;
					stack[loc3].value := imode;
					stack[loc4].value := MinIndex;
					stack[loc5].value := MaxIndex;
				end;
	end;


	procedure DoPasteOperation;
	begin
		if not (OpPending and (CurrentOp = PasteOp)) then begin
				MacroError('Not pasting');
				exit(DoPasteOperation);
			end;
		if MacroCommand in [AddC, SubC, MulC, DivC] then begin
				case MacroCommand of
					AddC: 
						CurrentOp := AddOp;
					SubC: 
						CurrentOp := SubtractOp;
					MulC: 
						CurrentOp := MultiplyOp;
					DivC: 
						CurrentOp := DivideOp;
				end;
				DoPasteMath;
				exit(DoPasteOperation);
			end;
		case MacroCommand of
			CopyModeC: 
				SetPasteMode(CopyModeItem);
			AndC: 
				SetPasteMode(AndItem);
			OrC: 
				SetPasteMode(OrItem);
			XorC: 
				SetPasteMode(XorItem);
			ReplaceC: 
				SetPasteMode(ReplaceItem);
			BlendC: 
				SetPasteMode(BlendItem);
		end;
		if OptionKeyWasDown then begin
				if PasteControl <> nil then
					DrawPasteControl;
			end
		else
			KillRoi;
	end;


	procedure SetWidth; {(width:integer)}
		var
			width: integer;
	begin
		GetLeftParen;
		width := GetInteger;
		GetRightParen;
		if (Token <> DoneT) and (width > 0) then begin
				LineWidth := width;
				ShowLIneWidth;
			end;
	end;


	function GetMType (index: integer): MeasurementTypes;
	begin
		case index of
			0: 
				GetMType := AreaM;
			1: 
				GetMType := MeanM;
			2: 
				GetMType := StdDevM;
			3: 
				GetMType := xyLocM;
			4: 
				GetMType := ModeM;
			5: 
				GetMType := LengthM;
			6: 
				GetMType := MajorAxisM;
			7: 
				GetMType := MinorAxisM;
			8: 
				GetMType := AngleM;
			9: 
				GetMType := IntDenM;
			10: 
				GetMType := MinMaxM;
			11: 
				GetMType := User1M;
			12: 
				GetMType := User2M;
		end;
	end;


	procedure SetPrecision; {(DigitsRightofDecimalPoint[,FieldWidth]:integer)}
		var
			digits, width: LongInt;
	begin
		GetLeftParen;
		digits := GetInteger;
		GetToken;
		if token = comma then
			width := GetInteger
		else
			PutTokenBack;
		GetRightParen;
		if Token <> DoneT then begin
				if (digits >= 0) and (digits <= 12) then
					precision := digits;
				if (width >= 1) and (width <= 18) then
					FieldWidth := width;
			end;
	end;


	procedure SetParticleSize; {(min,max:LongInt)}
		var
			min, max: LongInt;
	begin
		GetLeftParen;
		min := GetInteger;
		GetComma;
		max := GetInteger;
		GetRightParen;
		if Token <> DoneT then begin
				MinParticleSize := min;
				MaxParticleSize := max;
			end;
	end;


	procedure SetThreshold; {(level:integer)}
		var
			level: LongInt;
	begin
		GetLeftParen;
		level := GetInteger;
		GetRightParen;
		if level = -1 then begin
				DisableThresholding;
				exit(SetThreshold);
			end;
		RangeCheck(level);
		if Token <> DoneT then
			EnableThresholding(level);
	end;


	procedure DoPutPixel; {(hloc,vloc, value:integer)}
		var
			hloc, vloc, value: integer;
			MaskRect: rect;
	begin
		GetLeftParen;
		hloc := GetInteger;
		GetComma;
		vloc := GetInteger;
		GetComma;
		value := GetInteger;
		GetRightParen;
		if (Token <> DoneT) and (info <> NoInfo) then begin
				KillRoi;
				PutPixel(hloc, vloc, value);
				SetRect(MaskRect, hloc, vloc, hloc + 1, vloc + 1);
				UpdateScreen(MaskRect);
			end;
	end;


	procedure CloseWindow;
		var
			OldPicNum, NewPicNum, ignore: integer;
	begin
		if CurrentWindow <> PicKind then begin
				ignore := CloseAWindow(CurrentWPtr);
				exit(CloseWindow);
			end;
		if info = NoInfo then begin
				MacroError(NoImageOpen);
				exit(CloseWindow);
			end;
		StopDigitizing;
		SaveRoi;
		with info^ do begin
				OldPicNum := PicNum;
				ignore := CloseAWindow(wptr);
			end;
		if nPics >= 1 then begin
				NewPicNum := OldPicNum - 1;
				if NewPicNum < 1 then
					NewPicNum := 1;
				SelectImage(NewPicNum);
			end;
	end;


	procedure SetScaling;
		var
			ScalingOptions: str255;
			ok: boolean;
	begin
		ScalingOptions := GetStringArg;
		if token <> DoneT then begin
				MakeLowerCase(ScalingOptions);
				rsInteractive := false;
				if pos('bilinear', ScalingOptions) <> 0 then
					rsMethod := Bilinear;
				if pos('nearest', ScalingOptions) <> 0 then
					rsMethod := NearestNeighbor;
				if pos('new', ScalingOptions) <> 0 then
					rsCreateNewWindow := true;
				if pos('same', ScalingOptions) <> 0 then
					rsCreateNewWindow := false;
				if pos('interactive', ScalingOptions) <> 0 then
					rsInteractive := true;
			end;
	end;


	procedure DoChangeValues; {(v1,v2,v3:integer)}
		var
			v1, v2, v3: integer;
	begin
		GetLeftParen;
		v1 := GetInteger;
		GetComma;
		v2 := GetInteger;
		GetComma;
		v3 := GetInteger;
		GetRightParen;
		RangeCheck(v1);
		RangeCheck(v2);
		RangeCheck(v3);
		if Token <> DoneT then
			ChangeValues(v1, v2, v3);
	end;


	procedure DoGetMouse;  {(var x,y:integer)}
		var
			loc1, loc2, sh, sv: integer;
			loc: point;
	begin
		GetLeftParen;
		loc1 := GetVar;
		GetComma;
		loc2 := GetVar;
		GetRightParen;
		if Token <> DoneT then
			with MacrosP^ do begin
					SetPort(info^.wptr);
					GetMouse(loc);
					with loc do begin
							sh := h;
							sv := v;
							ScreenToOffscreen(loc);
							if sh < 0 then
								h := sh;
							if sv < 0 then
								v := sv;
							stack[loc1].value := h;
							stack[loc2].value := v;
						end;
				end;
	end;


	procedure DoRotate (cmd: CommandType);
		var
			NoBoolean, NewWindow: boolean;
	begin
		GetToken;
		noBoolean := token <> LeftParen;
		PutTokenBack;
		if NoBoolean then
			NewWindow := false
		else
			NewWindow := GetBooleanArg;
		if NewWindow then begin
				case cmd of
					RotateRC: 
						RotateToNewWindow(RotateRight);
					RotateLC: 
						RotateToNewWindow(RotateLeft)
				end;
				if not macro then
					MacroError('Rotate failed')
			end
		else
			case cmd of
				RotateRC: 
					FlipOrRotate(RotateRight);
				RotateLC: 
					FlipOrRotate(RotateLeft)
			end;
	end;


	procedure DoSelectSlice; {(SliceNumber:integer)}
		var
			SliceNumber: LongInt;
			isRoi: boolean;
			SaveCommand: CommandType;
	begin
		SaveCommand := MacroCommand;
		GetLeftParen;
		SliceNumber := GetInteger;
		GetRightParen;
		with info^, info^.StackInfo^ do begin
				if (SliceNumber < 1) or (SliceNumber > nSlices) then
					MacroError('Illegal slice number');
				if Token <> DoneT then begin
						isRoi := RoiShowing;
						if isRoi then
							KillRoi;
						CurrentSlice := SliceNumber;
						SelectSlice(CurrentSlice);
						if SaveCommand = SelectSliceC then begin
								UpdatePicWindow;
								UpdateTitleBar;
							end;
						if isRoi then
							RestoreRoi;
					end;
			end;
	end;


	procedure MakeNewStack; {(name:str255)}
		var
			name: str255;
			aok: boolean;
	begin
		GetArguments(name);
		if token <> DoneT then
			if (LongInt(NewPicWidth) * NewPicHeight) > UndoBufSize then
				MacroError('Stack larger than Undo Buffer')
			else if NewPicWindow(name, NewPicWidth, NewPicHeight) then
				if not MakeStackFromWindow then
					MacroError('Out of memory');
	end;


	procedure MakeLineRoi; {(x1,y1,x2,y2:real)}
		var
			x1, y1, x2, y2: real;
	begin
		GetLeftParen;
		x1 := GetExpression;
		GetComma;
		y1 := GetExpression;
		GetComma;
		x2 := GetExpression;
		GetComma;
		y2 := GetExpression;
		GetRightParen;
		if token <> DoneT then
			with Info^ do begin
					KillRoi;
					StopDigitizing;
					LX1 := x1;
					LY1 := y1;
					LX2 := x2;
					LY2 := y2;
					RoiType := LineRoi;
					MakeRegion;
					SetupUndo;
					RoiShowing := true;
				end;
	end;


	procedure DoGetTime;
		var
			date: DateTimeRec;
			loc1, loc2, loc3, loc4, loc5, loc6, loc7: integer;
	begin
		GetLeftParen;
		loc1 := GetVar;
		GetComma;
		loc2 := GetVar;
		GetComma;
		loc3 := GetVar;
		GetComma;
		loc4 := GetVar;
		GetComma;
		loc5 := GetVar;
		GetComma;
		loc6 := GetVar;
		GetComma;
		loc7 := GetVar;
		GetRightParen;
		if Token <> DoneT then
			with MacrosP^, info^ do begin
					GetTime(date);
					with date do begin
							stack[loc1].value := year;
							stack[loc2].value := month;
							stack[loc3].value := day;
							stack[loc4].value := hour;
							stack[loc5].value := minute;
							stack[loc6].value := second;
							stack[loc7].value := DayOfWeek;
						end;
				end;
	end;


	procedure DoSetScale; {(scale:real; unit:string)}
		var
			id: integer;
			scale: extended;
			str: str255;
	begin
		GetLeftParen;
		scale := GetExpression;
		GetComma;
		str := GetString;
		GetRightParen;
		if token <> DoneT then
			with info^ do begin
					if str = '' then begin
							SetScale; {Display Set Scale dialog box}
							exit(DoSetScale);
						end;
					if scale < 0.0 then begin
							MacroError('Scale<0');
							exit(DoSetScale);
						end;
					MakeLowerCase(str);
					xUnit := str;
					xSpatialScale := scale;
					ySpatialScale := scale;
					PixelAspectRatio := 1.0;
					SpatiallyCalibrated := (xUnit <> '') and (xUnit <> 'pixel') and (xUnit <> 'pixels') and (xSpatialScale <> 0.0);
					UpdateTitleBar;
				end;
	end;


	procedure SaveState;
	begin
		SaveForeground := ForegroundIndex;
		SaveBackground := BackgroundIndex;
		SavePicWidth := NewPicWidth;
		SavePicHeight := NewPicHeight;
		SaveMethod := rsMethod;
		SaveCreate := rsCreateNewWindow;
		SaveAngle := rsAngle;
		SaveH := rsHScale;
		SaveV := rsVScale;
		SaveInvertY := InvertYCoordinates;
		SaveScaleArithmetic := ScaleArithmetic;
		SaveScaleConvolutions := ScaleConvolutions;
	end;


	procedure RestoreState;
	begin
		if SaveForeground = -1 then
			MacroError('State not saved')
		else begin
				SetForegroundColor(SaveForeground);
				SetBackgroundColor(SaveBackground);
				NewPicWidth := SavePicWidth;
				NewPicHeight := SavePicHeight;
				rsMethod := SaveMethod;
				rsCreateNewWindow := SaveCreate;
				rsAngle := SaveAngle;
				rsHScale := SaveH;
				rsVScale := SaveV;
				InvertYCoordinates := SaveInvertY;
				ScaleArithmetic := SaveScaleArithmetic;
				ScaleConvolutions := SaveScaleConvolutions;
			end;
	end;


	procedure DoPrint;
	begin
		FindWhatToPrint;
		if WhatToPrint <> NothingToPrint then
			Print(false)
		else
			MacroError('NothingToPrint');
	end;


	procedure SetCounter; {(n:integer)}
		var
			N, i: LongInt;
	begin
		GetLeftParen;
		N := GetInteger;
		GetRightParen;
		if (N < 0) or (N > MaxMeasurements) then
			MacroError('Argument out of range');
		if Token <> DoneT then begin
				if N = 0 then
					ResetCounter;
				for i := mCount + 1 to N do
					ClearResults(i);
				mCount := N;
				UpdateList;
				ShowInfo;
			end;
	end;


	procedure OutputText;
		var
			NewLine: boolean;
			str: str255;
			i: integer;
			SaveCommand: CommandType;
	begin
		NewLine := MacroCommand <> WriteC;
		SaveCommand := MacroCommand;
		GetArguments(str);
		if token <> DoneT then begin
				if SaveCommand = ShowMsgC then begin
						for i := 1 to length(str) do
							if str[i] = '\' then
								str[i] := cr;
						InfoMessage := str;
						ShowInfo;
					end
				else begin
						if CurrentWindow = TextKind then
							InsertText(str, NewLine)
						else
							DoDrawText(str, NewLine);
					end;
			end;
	end;


	procedure SetErosionDilationCount; {(n:integer)}
		var
			n: LongInt;
	begin
		GetLeftParen;
		n := GetInteger;
		GetRightParen;
		if (n < 1) or (n > 8) then
			MacroError('Argument out of range');
		if Token <> DoneT then begin
				BinaryCount := n;
				BinaryThreshold := BinaryCount * 255;
			end;
	end;


	procedure SetSliceSpacing; {(n:real)}
		var
			n: real; {pixels}
	begin
		GetLeftParen;
		n := GetExpression;
		GetRightParen;
		if (n <= 0.0) or (n > 100.0) then
			MacroError('Argument out of range');
		if info^.StackInfo = nil then
			MacroError('No stack');
		if Token <> DoneT then
			info^.StackInfo^.SliceSpacing := n;
	end;


	procedure GetOrPutLineOrColumn;  {(x,y,count:integer:integer)}
		var
			x, y, count, i: integer;
			MaskRect: rect;
			aLine2: LineType;
	begin
		GetLeftParen;
		x := GetInteger;
		GetComma;
		y := GetInteger;
		GetComma;
		count := GetInteger;
		GetRightParen;
		if (Token <> DoneT) and (count <= MaxLine) then
			with MacrosP^ do begin
					KillRoi;
					case MacroCommand of
						GetRowC: 
							GetLine(x, y, count, aLine);
						PutRowC:  begin
								PutLine(x, y, count, aLine);
								SetRect(MaskRect, x, y, x + count, y + 1);
								UpdateScreen(MaskRect);
								info^.changes := true;
							end;
						GetColumnC: 
							GetColumn(x, y, count, aLine);
						PutColumnC:  begin
								PutColumn(x, y, count, aLine);
								SetRect(MaskRect, x, y, x + 1, y + count);
								UpdateScreen(MaskRect);
								info^.changes := true;
							end;
					end; {case}
				end;
	end;


	procedure CheckVersion; {(RequiredVersion:real)}
		var
			RequiredVersion: real;
			str: str255;
	begin
		GetLeftParen;
		RequiredVersion := GetExpression;
		GetRightParen;
		if (Token <> DoneT) then
			if round(RequiredVersion * 100.0) > version then begin
					RealToString(RequiredVersion, 1, 2, str);
					PutMessage(concat('This macro requires version ', str, ' or later of NIH Image.'));
					Token := DoneT;
				end;
	end;


	procedure SetOptions; {(Options:string)}
		var
			options: str255;
			mtype: MeasurementTypes;
			i, LastOption: integer;
			SaveMeasurements: set of MeasurementTypes;
	begin
		GetLeftParen;
		Options := GetString;
		GetRightParen;
		if (Token <> DoneT) then begin
				SaveMeasurements := measurements;
				MakeLowerCase(options);
				Measurements := [];
				if pos('area', options) <> 0 then
					Measurements := Measurements + [AreaM];
				if pos('mean', options) <> 0 then
					Measurements := Measurements + [MeanM];
				if pos('st', options) <> 0 then
					Measurements := Measurements + [StdDevM];
				if pos('center', options) <> 0 then
					Measurements := Measurements + [xyLocM];
				if pos('mode', options) <> 0 then
					Measurements := Measurements + [ModeM];
				if (pos('per', options) <> 0) or (pos('length', options) <> 0) then
					Measurements := Measurements + [LengthM];
				if pos('major', options) <> 0 then
					Measurements := Measurements + [MajorAxisM];
				if pos('minor', options) <> 0 then
					Measurements := Measurements + [MinorAxisM];
				if pos('angle', options) <> 0 then
					Measurements := Measurements + [AngleM];
				if pos('int', options) <> 0 then
					Measurements := Measurements + [IntDenM];
				if pos('max', options) <> 0 then
					Measurements := Measurements + [MinMaxM];
				if pos('1', options) <> 0 then
					Measurements := Measurements + [User1M];
				if pos('2', options) <> 0 then
					Measurements := Measurements + [User2M];
				UpdateFitEllipse;
				if Measurements <> SaveMeasurements then
					UpdateList;
			end;
	end;


	procedure SetLabel;
		var
			SaveCommand: CommandType;
			str, SaveLabel: str255;
	begin
		SaveCommand := MacroCommand;
		GetArguments(str);
		case SaveCommand of
			SetMajorC:  begin
					SaveLabel := MajorLabel;
					MajorLabel := str;
					Measurements := Measurements + [MajorAxisM];
				end;
			SetMinorC:  begin
					SaveLabel := MinorLabel;
					MinorLabel := str;
					Measurements := Measurements + [MinorAxisM];
				end;
			SetUser1C:  begin
					SaveLabel := User1Label;
					User1Label := str;
					Measurements := Measurements + [User1M];
				end;
			SetUser2C:  begin
					SaveLabel := User2Label;
					User2Label := str;
					Measurements := Measurements + [User2M];
				end;
		end; {case}
		ShowInfo;
		if str <> SaveLabel then
			UpdateList;
	end;


	procedure DoUpdateLUT;
	begin
		with info^ do begin
				LoadLUT(ctable);
				IdentityFunction := false;
				if isGrayScaleLUT then
					LutMode := CustomGrayScale
				else begin
						SetupPseudocolor;
						LutMode := PseudoColor;
					end;
				UpdateMap;
			end;
	end;


	procedure SubtractBackground; {(Options:string; BallRadius:integer)}
		var
			options: str255;
			radius, item: integer;
	begin
		GetLeftParen;
		Options := GetString;
		GetComma;
		radius := GetInteger;
		GetRightParen;
		if (Token <> DoneT) then begin
				MakeLowerCase(options);
				FasterBackgroundSubtraction := pos('faster', options) <> 0;
				item := Sub2DItem;
				if pos('hor', options) <> 0 then
					item := HorizontalItem;
				if pos('ver', options) <> 0 then
					item := VerticalItem;
				if pos('roll', options) <> 0 then
					item := Sub2DItem;
				if pos('remove', options) <> 0 then
					item := RemoveStreaksItem;
			end;
		BallRadius := Radius;
		if Radius < 1 then
			BallRadius := 1;
		if Radius > 319 then
			BallRadius := 319;
		DoBackgroundMenuEvent(Item);
	end;


	procedure SetExportMode;
		var
			mode: str255;
	begin
		mode := GetStringArg;
		if Token <> DoneT then begin
				MakeLowerCase(mode);
				ExportAsWhat := AsRaw;
				if pos('mcid', mode) <> 0 then
					ExportAsWhat := asMCID;
				if pos('text', mode) <> 0 then
					ExportAsWhat := asText;
				if pos('lut', mode) <> 0 then
					ExportAsWhat := asLUT;
				if pos('meas', mode) <> 0 then
					ExportAsWhat := asMeasurements;
				if pos('plot', mode) <> 0 then
					ExportAsWhat := asPlotValues;
				if pos('hist', mode) <> 0 then
					ExportAsWhat := asHistogramValues;
				if pos('xy', mode) <> 0 then
					ExportAsWhat := asCoordinates;
			end;
	end;


	procedure MoveCurrentWindow;{(x,y:integer)}
		var
			x, y: integer;
			ignore: integer;
			fwptr: WindowPtr;
			kind: integer;
	begin
		GetLeftParen;
		x := GetInteger;
		GetComma;
		y := GetInteger;
		GetRightParen;
		fwptr := FrontWindow;
		if fwptr <> nil then begin
				kind := WindowPeek(fwptr)^.WindowKind;
				if (kind = PicKind) or (kind = ProfilePlotKind) or (kind = CalibrationPlotKind) or (kind = HistoKind) or (Kind = PasteControlKind) or (Kind = ResultsKind) or (Kind = TextKind) then
					MoveWindow(fwptr, x, y, true);
			end;
	end;


	procedure DoUserCode; {str:str255; Param1,Param2,Param3:real;}
  {Contributed by Mark Vivino}
		var
			WhichCode: integer;
			Param1, Param2, Param3: extended;
			str: str255;
			NewVersion: boolean;
	begin
		GetLeftParen;
		GetToken;
		NewVersion := (token = StringLiteral) or (token = StringVariable);
		PutTokenBack;
		WhichCode := 0;
		str := '';
		if NewVersion then
			str := GetString
		else
			WhichCode := GetInteger;
		GetComma;
		Param1 := GetExpression;
		GetComma;
		Param2 := GetExpression;
		GetComma;
		Param3 := GetExpression;
		GetRightParen;
		if Token <> DoneT then begin
				if NewVersion then
					UserMacroCode(str, Param1, Param2, Param3)
				else begin
						if (WhichCode < 1) or (WhichCode > 10) then
							MacroError('Range error . Allowable range is 1 to 10.');
						OldUserMacroCode(WhichCode, Param1, Param2, Param3);
					end;
			end;
	end;


	procedure CloseSerialPorts;
		var
			err: OSErr;
	begin
		if SerialBufferP <> nil then begin
				err := CloseDriver(SerialOut);
				err := CloseDriver(SerialIn);
				DisposePtr(SerialBufferP);
			end;
	end;


	procedure OpenSerial;
		const
			SerialBufferSize = 1024;
		var
			err: OSErr;
			baud, data, stop, parity: integer;
			config: integer;
			flags: SerShk;
			str: str255;
	begin
		CloseSerialPorts;
		baud := baud9600;
		data := data8;
		stop := stop10;
		parity := noParity;
		str := GetStringArg;
		if token = DoneT then
			exit(OpenSerial);
		MakeLowerCase(str);
		if pos('300', str) <> 0 then
			baud := baud300;
		if pos('1200', str) <> 0 then
			baud := baud1200;
		if pos('2400', str) <> 0 then
			baud := baud2400;
		if pos('19200', str) <> 0 then
			baud := baud19200;
		if pos('two', str) <> 0 then
			stop := stop20;
		if pos('odd', str) <> 0 then
			parity := oddParity;
		if pos('even', str) <> 0 then
			parity := evenParity;
		if pos('seven', str) <> 0 then
			data := data7;
		if (OpenDriver('.AOut', SerialOut) <> NoErr) or (OpenDriver('.AIn', SerialIn) <> NoErr) then begin
				MacroError('Error opening modem port');
				exit(OpenSerial);
			end;
		SerialBufferP := NewPtr(SerialBufferSize);
		if SerialBufferP = nil then begin
				MacroError('Out of Memory');
				exit(OpenSerial);
			end;
		with flags do begin
				fXOn := ord(false); {Disable xon/xoff output flow control}
				fCTS := ord(false); {Disable CTS (output) flow control}
				xOn := chr(17);
				xOff := chr(19);
				errs := 0;
				evts := 0;
				fInX := ord(true);  {Enable xon/xoff input flow control}
				fDTR := ord(true); {Enable DTR (input) flow control}
			end;
		Config := baud + data + stop + parity;
		Err := SerHShake(SerialOut, flags);
		Err := SerSetBuf(SerialIn, SerialBufferP, SerialBufferSize);
		Err := SerReset(SerialOut, Config);
	end;


	procedure PutSerial;
		var
			i: integer;
			Size: LongInt;
			OutputBuffer: packed array[1..256] of char;
			str: str255;
			err: OSErr;
	begin
		GetArguments(str);
		if token = DoneT then
			exit(PutSerial);
		if SerialBufferP = nil then begin
				MacroError('Serial port not open');
				exit(PutSerial);
			end;
		Size := 0;
		for i := 1 to length(str) do begin
				size := size + 1;
				OutputBuffer[size] := str[i];
			end;
		if size > 0 then
			err := fswrite(SerialOut, size, @OutputBuffer);
	end;


	procedure DoSetCursor; {str: string}
		var
			str: str255;
	begin
		str := GetStringArg;
		if Token <> DoneT then begin
				MakeLowerCase(str);
				if pos('watch', str) <> 0 then
					SetCursor(watch);
				if pos('cross', str) <> 0 then
					SetCursor(ToolCursor[SelectionTool]);
				if pos('arrow', str) <> 0 then
					InitCursor;
			end;
	end;


	procedure SetVideoOptions; {options: string}
		var
			options: str255;
			NewSyncMode: SyncModeType;

		procedure SetOption (id: integer; var option: boolean; enable: boolean);
    {Updates the modeless Video Control dialog box.}
		begin
			if option <> enable then
				DoVideoControl(id)
		end;

	begin
		options := GetStringArg;
		if Token <> DoneT then begin
				MakeLowerCase(options);
				SetOption(InvertID, InvertVideo, pos('invert', options) <> 0);
				SetOption(HighlightID, HighlightSaturatedPixels, pos('high', options) <> 0);
				SetOption(OscillatingID, OscillatingMovies, pos('osc', options) <> 0);
				SetOption(TriggerID, ExternalTrigger, pos('trig', options) <> 0);
				SetOption(BlindID, BlindMovieCapture, pos('blind', options) <> 0);
				if pos('sep', options) <> 0 then
					NewSyncMode := SeparateSync
				else
					NewSyncMode := NormalSync;
				if NewSyncMode <> SyncMode then
					DoVideoControl(SyncID)
			end;
	end;


	procedure SetChannel; {(channel:integer)}
		var
			channel: integer;
	begin
		GetLeftParen;
		channel := GetInteger;
		GetRightParen;
		if (channel < 1) or (channel > 4) then
			MacroError('Bad channel number')
		else
			DoVideoControl(FirstChannelID + channel - 1);
	end;


	procedure DoAcquire;
		var
			fname: str255;
	begin
		fname := GetStringArg;
		LoadAcqPlugIn(fname);
	end;


	procedure DoFilter;
		var
			fname: str255;
	begin
		fname := GetStringArg;
		LoadFilterPlugIn(fname);
	end;


	procedure DoPhotoMode;
		var
			erase: boolean;
	begin
		erase := GetBooleanArg;
		if Token <> DoneT then begin
				if erase then begin
						EraseScreen;
						UpdatePicWindow;
						InPhotoMode := true;
					end
				else if InPhotoMode then begin
						RestoreScreen;
						InitCursor;
					end;
			end;
	end;


	procedure RGBToIndexed; {options: string}
		var
			options: str255;
	begin
		options := GetStringArg;
		if Token <> DoneT then begin
				MakeLowerCase(options);
				RGBLut := CustomLUT;
				DitherColor := false;
				if pos('exist', options) <> 0 then
					RGBLut := ExistingLUT;
				if pos('system', options) <> 0 then
					RGBLut := SystemLUT;
				if pos('dither', options) <> 0 then
					DitherColor := true;
				ConvertRGBToEightBitColor(false);
			end;
	end;


	procedure DoAverageFrames; {[(Options:string; nFrames:integer)]}
		var
			options: str255;
			nFrames: integer;
			HasArguments: boolean;
	begin
		GetToken;
		HasArguments := token = LeftParen;
		PutTokenBack;
		if HasArguments then begin
				GetLeftParen;
				Options := GetString;
				GetComma;
				nFrames := GetInteger;
				if nFrames > 0 then
					FramesToAverage := nFrames;
				GetRightParen;
				if (Token <> DoneT) then begin
						MakeLowerCase(options);
						VideoRateAveraging := false;
						SumFrames := false;
						if (pos('int', options) <> 0) or (pos('sum', options) <> 0) then
							sumFrames := true;
						if pos('video', options) <> 0 then
							VideoRateAveraging := true;
					end;
			end; {has arguments}
		if token <> DoneT then
			AverageFrames;
	end;


	procedure DoSelectWindow;{('str')}
		var
			str, wTitle: str255;
			WPeek, NextWPeek: WindowPeek;
			id: integer;
			TempInfo: InfoPtr;
	begin
		GetArguments(str);
		MakeLowerCase(str);
		if Token <> DoneT then begin
				wPeek := WindowPeek(FrontWindow);
				while wPeek <> nil do begin
						NextWPeek := wPeek^.NextWindow;
						if wPeek^.WindowKind = PicKind then begin
								TempInfo := InfoPtr(wPeek^.RefCon);
								wTitle := TempInfo^.title;
							end
						else
							wTitle := wPeek^.TitleHandle^^;
						MakeLowerCase(wTitle);
						if str = wTitle then begin
								if wPeek^.WindowKind = PicKind then begin
										info := InfoPtr(wPeek^.RefCon);
										with info^ do
											if (PicNum >= 1) and (PicNum <= nPics) then
												SelectImage(PicNum);
									end
								else
									SelectWindow(WindowPtr(wPeek));
								leave;
							end;
						wpeek := NextWPeek;
					end;
				if wPeek = nil then
					MacroError('Window not found');
			end;
	end;


	procedure GetThreshold;  {(lower,upper)}
		var
			loc1, loc2: integer;
	begin
		GetLeftParen;
		loc1 := GetVar;
		GetComma;
		loc2 := GetVar;
		GetRightParen;
		if Token <> DoneT then
			with MacrosP^ do
				with info^ do begin
						if Thresholding then begin
								stack[loc1].value := ColorStart;
								stack[loc2].value := 255;
							end
						else if DensitySlicing then begin
								stack[loc1].value := SliceStart;
								stack[loc2].value := SliceEnd;
							end
						else begin
								stack[loc1].value := 0;
								stack[loc2].value := 0;
							end;
					end;
	end;


	procedure SortPalette;
		type
			MyHSVColor = record
					lHue, lSaturation, lValue: LongInt;
				end;
			HSVRec = record
					index: integer;
					hsv: MyHSVColor;
				end;
			HSVArrayType = array[0..255] of HSVRec;
		var
			TempTable: MyCSpecArray;
			i: integer;
			HSVArray: HSVArrayType;
			h, s, v: LongInt;
			fHue, fSaturation, fValue: fixed;
			TempHSV: HSVColor;
			table: LookupTable;

		procedure SortByHue;
    {Selection sorts from "Algorithms" by Robert Sedgewick.}
			var
				i, j, min: integer;
				t: HSVRec;
		begin
			for i := 1 to 254 do begin
					min := i;
					for j := i + 1 to 254 do
						if HSVArray[j].hsv.lHue < HSVArray[min].hsv.lHue then
							min := j;
					t := HSVArray[min];
					HSVArray[min] := HSVArray[i];
					HSVArray[i] := t;
				end;
		end;

	begin
		ShowWatch;
		DisableDensitySlice;
		with info^ do begin
				for i := 1 to 254 do begin
						HSVArray[i].index := i;
						rgb2hsv(cTable[i].rgb, TempHSV);
						with TempHSV do begin
								fHue := SmallFract2Fix(hue);
								fSaturation := SmallFract2Fix(saturation);
								fValue := SmallFract2Fix(value);
							end;
						with HSVArray[i].hsv do begin
								lHue := LongInt(band(fHue, $ffff));
								lSaturation := LongInt(band(fSaturation, $ffff));
								lValue := LongInt(band(fValue, $ffff));
							end;
					end;
				SortByHue;
				for i := 1 to 254 do
					TempTable[i].rgb := cTable[HSVArray[i].index].rgb;
				cTable := TempTable;
				LoadLUT(cTable);
				if info <> NoInfo then begin
						table[0] := 0;
						table[255] := 255;
						for i := 1 to 254 do
							table[HSVArray[i].index] := i;
						ApplyTable(table);
					end;
				WhatToUndo := NothingToUndo;
				SetupPseudocolor;
				ColorTable := CustomTable;
			end; {with}
	end;


	procedure DoProject;
	begin
		if not (ProjectC in RoutinesCalled) then begin
				if ShowProjectDialogBox then
					DoProjection
				else
					token := DoneT;
			end
		else
			DoProjection;
		RoutinesCalled := RoutinesCalled + [ProjectC];
	end;


	procedure DoNewTextWindow; {(name,width,height)}
		var
			str: str255;
			okay, OptionalArguments: boolean;
			width, height: LongInt;
	begin
		GetLeftParen;
		str := GetString;
		GetToken;
		OptionalArguments := token <> RightParen;
		PutTokenBack;
		width := 500;
		height := 400;
		if OptionalArguments then begin
				GetComma;
				width := GetInteger;
				if width < 8 then
					width := 8;
				GetComma;
				height := GetInteger;
				if height < 8 then
					height := 8;
			end;
		GetRightParen;
		if Token <> DoneT then
			okay := MakeNewTextWindow(str, width, height);
	end;


	procedure ImageMath; {('op',pic1,pic2,gain,offset,'result')}
		var
			op, result: str255;
			pic1, pic2, offset: LongInt;
			gain: real;
	begin
		GetLeftParen;
		op := GetString;
		GetComma;
		pic1 := GetInteger;
		GetComma;
		pic2 := GetInteger;
		GetComma;
		gain := GetExpression;
		GetComma;
		offset := GetInteger;
		GetComma;
		result := GetString;
		GetRightParen;
		if token <> DoneT then begin
				MakeLowerCase(op);
				if pos('add', op) <> 0 then
					CurrentMathOp := AddMath;
				if pos('sub', op) <> 0 then
					CurrentMathOp := SubMath;
				if pos('mul', op) <> 0 then
					CurrentMathOp := MulMath;
				if pos('div', op) <> 0 then
					CurrentMathOp := DivMath;
				if pos('and', op) <> 0 then
					CurrentMathOp := AndMath;
				if pos('or', op) <> 0 then
					CurrentMathOp := OrMath;
				if pos('xor', op) <> 0 then
					CurrentMathOp := XorMath;
				if pos('max', op) <> 0 then
					CurrentMathOp := MaxMath;
				if pos('min', op) <> 0 then
					CurrentMathOp := MinMath;
				if pos('copy', op) <> 0 then
					CurrentMathOp := CopyMath;
				MathGain := gain;
				MathOffset := offset;
				DoMath(pic1, pic2, result);
			end;
	end;


	procedure PasteLive;
	begin
		with info^ do begin
				if not RoiShowing or (RoiType <> RectRoi) then begin
						MacroError('No selection');
						exit(PasteLive);
					end;
				if PictureType = FrameGrabberType then begin
						MacroError('Can''t paste into Camera window');
						exit(PasteLive);
					end;
				if FrameGrabber = NoFrameGrabber then begin
						MacroError('No frame grabber');
						exit(PasteLive);
					end;
				if (RoiRect.right > fgwidth) or (RoiRect.bottom > fgheight) then begin
						MacroError('Selection out of range');
						exit(PasteLive);
					end;
				SetupUndo;
				WhatToUndo := UndoPaste;
				ClipBufInfo^.RoiRect := RoiRect;
				OpPending := true;
				CurrentOp := PasteOp;
				LivePasteMode := true;
				WhatsOnClip := LivePic;
			end;{with}
	end;


	procedure GetPlotData;  {(var nValues,PixelsPerValue, Min,Max:real)}
		var
			loc1, loc2, loc3, loc4: integer;
	begin
		GetLeftParen;
		loc1 := GetVar;
		GetComma;
		loc2 := GetVar;
		GetComma;
		loc3 := GetVar;
		GetComma;
		loc4 := GetVar;
		GetRightParen;
		if Token <> DoneT then
			with MacrosP^, results do begin
					ShowPlot := false;
					PlotDensityProfile;
					ShowPlot := true;
					stack[loc1].value := PlotCount;
					stack[loc2].value := PlotAvg;
					stack[loc3].value := ActualPlotMin;
					stack[loc4].value := ActualPlotMax;
				end;
	end;


	function GetStringVar: integer;
	begin
		GetStringVar := 0;
		GetToken;
		if token <> StringVariable then
			MacroError('String variable expected')
		else
			GetStringVar := TokenStackLoc;
	end;


	procedure DoDelete;  {(var dest; index, count:integer)}
		var
			StackLoc, index, count: integer;
			str: str255;
	begin
		GetLeftParen;
		StackLoc := GetStringVar;
		str := TokenStr;
		GetComma;
		index := GetInteger;
		GetComma;
		count := GetInteger;
		GetRightParen;
		if Token <> DoneT then
			with MacrosP^.stack[StackLoc] do begin
					delete(str, index, count);
					if StringH <> nil then
						StringH^^ := str;
				end;
	end;


	procedure GetScale;  {(var scale:real; unit:string)}
		var
			loc1, loc2, index, count: integer;
			str: str255;
	begin
		GetLeftParen;
		loc1 := GetVar;
		GetComma;
		loc2 := GetStringVar;
		GetRightParen;
		if Token <> DoneT then
			with info^, MacrosP^ do
				if SpatiallyCalibrated then begin
						stack[loc1].value := xSpatialScale;
						stack[loc2].StringH^^ := xUnit;
					end
				else begin
						stack[loc1].value := 1.0;
						stack[loc2].StringH^^ := 'pixel';
					end;
	end;


	procedure DoAutoOutline;  {(x,y:integer)}
		var
			x, y: integer;
			start: point;
	begin
		GetLeftParen;
		x := GetInteger;
		GetComma;
		y := GetInteger;
		GetRightParen;
		if Token <> DoneT then begin
				start.h := x;
				start.v := y;
				AutoOutline(start);
			end;
	end;


	procedure ExecuteCommand;
		var
			AutoSelectAll: boolean;
			t: FateTable;  {Needed for MakeSkeleton}
			okay: boolean;
			theEvent: EventRecord;
	begin
		if Info = NoInfo then
			if not (MacroCommand in LegalWithoutImage) then begin
					MacroError('No image window active');
					exit(ExecuteCommand);
				end;
		if DoOption then begin
				OptionKeyWasDown := true;
				DoOption := false;
			end;
		if OpPending then
			if not (MacroCommand in [CopyModeC, AndC, OrC, XorC, BlendC, ReplaceC, AddC, SubC, MulC, DivC, SetOptionC, PasteLiveC, GetRoiC, RequiresC]) then begin
					KillRoi; {Terminate any pending paste operation.}
					RestoreRoi;
				end;
		MacroOpPending := false;
		case MacroCommand of
			RotateRC, RotateLC: 
				DoRotate(MacroCommand);
			FlipVC: 
				FlipOrRotate(FlipVertical);
			FlipHC: 
				FlipOrRotate(FlipHorizontal);
			CopyC:  begin
					FindWhatToCopy;
					if WhatToCopy = NothingToCopy then
						MacroError('Copy failed')
					else
						DoCopy;
				end;
			SelectC: 
				if CurrentWindow = TextKind then
					DoTextSelectAll
				else begin
						StopDigitizing;
						SelectAll(true);
					end;
			PasteC: 
				DoPaste;
			ClearC, FillC, InvertC, FrameC: 
				if CurrentWindow = TextKind then
					case MacroCommand of
						ClearC: 
							DoTextClear;
						otherwise
					end
				else
					with info^ do begin
							AutoSelectAll := not RoiShowing;
							if AutoSelectAll then
								SelectAll(true);
							case MacroCommand of
								ClearC: 
									DoOperation(EraseOp);
								FillC: 
									DoOperation(PaintOp);
								InvertC: 
									DoOperation(InvertOp);
								FrameC: 
									DoOperation(FrameOp);
							end;
							UpdateScreen(RoiRect);
							if AutoSelectAll then
								KillRoi
							else
								MacroOpPending := true;
						end;
			KillC: 
				KillRoi;
			RestoreC: 
				if NoInfo^.RoiType <> NoRoi then
					RestoreRoi;
			AnalyzeC: 
				AnalyzeParticles;
			ConvolveC: 
				DoConvolve;
			NextC: 
				GetNextWindow;
			MarkC: 
				MarkSelection(mCount);
			MeasureC:  begin
					Measure;
					InitCursor;
				end;
			MakeBinC: 
				MakeBinary;
			DitherC: 
				Filter(Dither, 0, t);
			SmoothC: 
				if OptionKeyWasDown then
					Filter(UnweightedAvg, 0, t)
				else
					Filter(WeightedAvg, 0, t);
			SharpenC: 
				Filter(fsharpen, 0, t);
			ShadowC: 
				Filter(fshadow, 0, t);
			TraceC: 
				Filter(EdgeDetect, 0, t);
			ReduceC: 
				Filter(ReduceNoise, 0, t);
			RedirectC: 
				RedirectSampling := GetBooleanArg;
			ThresholdC: 
				SetThreshold;
			AutoThresholdC: 
				AutoThreshold;
			ResetgmC: 
				ResetGrayMap;
			WaitC: 
				DoWait;
			ResetmC: 
				ResetCounter;
			SetSliceC: 
				SetDensitySlice;
			UndoC: 
				DoUndo;
			SetForeC, SetBackC: 
				SetColor;
			HistoC:  begin
					DoHistogram;
					DrawHistogram;
				end;
			EnhanceC: 
				EnhanceContrast;
			EqualizeC: 
				EqualizeHistogram;
			ErodeC:  begin
					BinaryIterations := 1;
					DoErosion;
				end;
			DilateC:  begin
					BinaryIterations := 1;
					DoDilation;
				end;
			OutlineC: 
				filter(OutlineFilter, 0, t);
			ThinC: 
				MakeSkeleton;
			AddConstC, MulConstC: 
				DoConstantArithmetic;
			RevertC: 
				DoRevert;
			BeepC: 
				Beep;
			NopC: 
				;
			MakeC, MakeOvalC: 
				MakeRoi;
			MoveC: 
				MoveRoi;
			InsetC: 
				InsetRoi;
			MoveToC: 
				DoMoveTo;
			DrawTextC, WriteC, WritelnC, ShowMsgC: 
				OutputText;
			SetFontC: 
				SetFont;
			SetFontSizeC: 
				SetFontSize;
			SetTextC: 
				SetText;
			DrawNumC: 
				DrawNumber;
			ExitC: 
				token := DoneT;
			GetPicSizeC: 
				GetPicSize;
			PutMsgC: 
				DoPutMessage;
			GetRoiC: 
				GetRoi;
			MakeNewC: 
				DoMakeNewWindow;
			DrawScaleC: 
				if info^.RoiShowing then begin
						DrawScale;
						UpdatePicWindow
					end
				else
					MacroError('No Selection');
			SetPaletteC: 
				DoSetPalette;
			OpenC, ImportC: 
				DoOpenImage;
			SetImportC: 
				SetImportAttributes;
			SetMinMaxC: 
				SetImportMinMax;
			SetCustomC: 
				SetCustomImport;
			SelectPicC, ChoosePicC: 
				SelectPic;
			SetPicNameC: 
				SetPicName;
			ApplyLutC: 
				ApplyLookupTable;
			SetSizeC: 
				SetNewSize;
			SaveC: 
				DoSave;
			SaveAllC: 
				SaveAll;
			SaveAsC: 
				DoSaveAs;
			CopyResultsC: 
				DoCopyResults;
			CloseC, DisposeC: 
				CloseWindow;
			DisposeAllC: 
				DisposeAll;
			DupC: 
				DoDuplicate;
			GetInfoC: 
				GetInfo;
			PrintC: 
				DoPrint;
			LineToC: 
				DoLineTo;
			GetLineC: 
				DoGetLine;
			ShowPasteC: 
				if PasteControl = nil then
					ShowPasteControl
				else
					BringToFront(PasteControl);
			ChannelC: 
				SetChannel;
			ColumnC, PlotProfileC:  begin
					PlotDensityProfile;
					if PlotWindow <> nil then
						UpdatePlotWindow;
				end;
			ScaleC, ScaleSelectionC: 
				DoScaleAndRotate;
			SetOptionC: 
				DoOption := true;
			SetLabelsC: 
				DrawPlotLabels := GetBooleanArg;
			SetPlotScaleC: 
				SetPlotScale;
			SetDimC: 
				SetPlotDimensions;
			GetResultsC: 
				GetResults;
			CopyModeC, AndC, OrC, XorC, BlendC, ReplaceC, AddC, SubC, MulC, DivC: 
				DoPasteOperation;
			ScaleMathC: 
				ScaleArithmetic := GetBooleanArg;
			InvertYC: 
				InvertYCoordinates := GetBooleanArg;
			SetWidthC: 
				SetWidth;
			ShowResultsC:  begin
					ShowResults;
					UpdateList
				end;
			StartC: 
				StartDigitizing;
			StopC: 
				StopDigitizing;
			CaptureC: 
				CaptureOneFrame;
			GetRowC, PutRowC, GetColumnC, PutColumnC: 
				GetOrPutLineOrColumn;
			PlotXYZC: 
				PlotXYZ;
			IncludeC: 
				IncludeHoles := GetBooleanArg;
			AutoC: 
				WandAutoMeasure := GetBooleanArg;
			LabelC: 
				LabelParticles := GetBooleanArg;
			OutlineParticlesC: 
				OutlineParticles := GetBooleanArg;
			IgnoreC: 
				IgnoreParticlesTouchingEdge := GetBooleanArg;
			AdjustC: 
				WandAdjustAreas := GetBooleanArg;
			SetParticleSizeC: 
				SetParticleSize;
			SetPrecisionC: 
				SetPrecision;
			PutPixelC: 
				DoPutPixel;
			ScalingOptionsC: 
				SetScaling;
			SetExportC: 
				SetExportMode;
			ExportC: 
				DoExport;
			ChangeC: 
				DoChangeValues;
			UpdateResultsC:  begin
					ShowInfo;
					DeleteLines(mCount, mCount);
					AppendResults;
				end;
			CascadeC: 
				CascadeImages;
			SetMajorC, SetMinorC, SetUser1C, SetUser2C: 
				SetLabel;
			GetMouseC: 
				DoGetMouse;
			SelectSliceC, ChooseSliceC, AddSliceC, DeleteSliceC, ResliceC:  begin
					if info^.StackInfo = nil then
						MacroError('No stack');
					if token <> DoneT then
						case MacroCommand of
							SelectSliceC, ChooseSliceC: 
								DoSelectSlice;
							AddSliceC: 
								okay := AddSlice(true);
							DeleteSliceC: 
								DeleteSlice;
							ResliceC: 
								Reslice;
						end;
				end;
			MakeStackC: 
				MakeNewStack;
			AverageFramesC: 
				DoAverageFrames;
			TriggerC: 
				WaitForTrigger;
			MakeLineC: 
				MakeLineRoi;
			GetTimeC: 
				DoGetTime;
			SetScaleC: 
				DoSetScale;
			SaveStateC: 
				SaveState;
			RestoreStateC: 
				RestoreState;
			SetCounterC: 
				SetCounter;
			UpdateLutC: 
				DoUpdateLUT;
			SetCountC: 
				SetErosionDilationCount;
			PropagateLutC: 
				DoPropagate(1);
			PropagateSpatialC: 
				DoPropagate(2);
			PropagateDensityC: 
				DoPropagate(3);
			SetSpacingC: 
				SetSliceSpacing;
			RequiresC: 
				CheckVersion;
			SetOptionsC: 
				SetOptions;
			SubtractBackgroundC: 
				SubtractBackground;
			MoveWindowC: 
				MoveCurrentWindow;
			UserCodeC: 
				DoUserCode;
			InvertLutC:  begin
					InvertPalette;
					UpdateLUT;
				end;
			OpenSerialC: 
				OpenSerial;
			PutSerialC: 
				PutSerial;
			SetCursorC: 
				DoSetCursor;
			SetVideoC: 
				SetVideoOptions;
			AcquireC: 
				DoAcquire;
			FilterC: 
				DoFilter;
			PhotoModeC: 
				DoPhotoMode;
			RGBToIndexedC: 
				RGBToIndexed;
			SurfacePlotC: 
				PlotSurface;
			SelectWindowC: 
				DoSelectWindow;
			NewTextWindowC: 
				DoNewTextWindow;
			CaptureColorC: 
				CaptureColor;
			GetThresholdC: 
				GetThreshold;
			AverageSlicesC: 
				AverageSlices;
			SortPaletteC: 
				SortPalette;
			ProjectC: 
				DoProject;
			ScaleConvolutionsC: 
				ScaleConvolutions := GetBooleanArg;
			ImageMathC: 
				ImageMath;
			PasteLiveC: 
				PasteLive;
			GetPlotDataC: 
				GetPlotData;
			DeleteC: 
				DoDelete;
			GetScaleC: 
				GetScale;
			AutoOutlineC: 
				DoAutoOutline;
			LoadMacrosC:  begin
					Token := DoneT;
					MacroLoadRequest := true;
				end;
		end; {case}
		OptionKeyWasDown := false;
		if not macro then begin
				Token := DoneT;
				KillRoi;
			end;
		if TickCount > MacroTicks then begin
				MacroTicks := TickCount + 10;
				if EventAvail(everyEvent, theEvent) then
					; {Allows background tasks to run}
				if CommandPeriod then begin
						Token := DoneT;
						KillRoi;
					end;
			end;
	end;


	procedure DoCompoundStatement;
	begin
		if token <> BeginT then
			MacroError('"begin" expected');
		GetToken;
		while (token <> endT) and (token <> DoneT) do begin
				DoStatement;
				GetToken;
				if Token = SemiColon then
					GetToken
				else if token <> EndT then
					MacroError(EndExpected);
			end;
	end;


	procedure SkipCompoundStatement;
		var
			count: integer;
	begin
		count := 1;
		repeat
			GetToken;
			case token of
				beginT: 
					count := count + 1;
				endT: 
					count := count - 1;
				DoneT:  begin
						MacroError('"end" expected');
						exit(SkipCompoundStatement);
					end;
				otherwise
			end; {case}
		until count = 0;
	end;


	procedure DoDeclarations;
	begin
		if token = SemiColon then
			GetToken;
		if token = VarT then begin
				GetToken;
				while ((token = Identifier) or (token = variable) or (token = StringVariable)) and (Token <> DoneT) do
					DoDeclaration;
			end;
	end;


	procedure DoFor;
		var
			SavePC: LongInt;
			StackLoc: integer;
			StartValue, EndValue, i: LongInt;
	begin
		StackLoc := GetVar;
		GetToken;
		if token <> AssignOp then begin
				MacroError('":=" expected');
				exit(DoFor);
			end;
		StartValue := GetInteger;
		if token = DoneT then
			exit(DoFor);
		GetToken;
		if token <> ToT then begin
				MacroError('"to" expected');
				exit(DoFor);
			end;
		EndValue := GetInteger;
		if token = DoneT then
			exit(DoFor);
		GetToken;
		if token <> DoT then begin
				MacroError(DoExpected);
				exit(DoFor);
			end;
		SavePC := pc;
		if StartValue > EndValue then begin
				GetToken;
				SkipStatement
			end
		else
			for i := StartValue to EndValue do
				with MacrosP^ do begin
						Stack[StackLoc].value := i;
						pc := SavePC;
						GetToken;
						DoStatement;
						if CommandPeriod then
							token := DoneT;
						if Token = DoneT then
							leave;
						if Digitizing then
							DoCapture;
					end;
	end;


	procedure SkipFor;
	begin
		GetToken;
		SkipPartialStatement;
		GetToken;
		if token <> doT then
			MacroError(DoExpected);
		GetToken;
		SkipStatement
	end;


	procedure DoAssignment;
		var
			SaveStackLoc: integer;
	begin
		SaveStackLoc := TokenStackLoc;
		GetToken;
		if token <> AssignOp then begin
				MacroError('":=" expected');
				exit(DoAssignment);
			end;
		MacrosP^.stack[SaveStackLoc].value := GetExpression;
	end;


	procedure DoStringAssignment;
		var
			SaveStackLoc: integer;
			str: Str255;
	begin
		SaveStackLoc := TokenStackLoc;
		GetToken;
		if token <> AssignOp then begin
				MacroError('":=" expected');
				exit(DoStringAssignment);
			end;
		str := GetString;
		if token <> DoneT then
			with MacrosP^.stack[SaveStackLoc] do
				if StringH <> nil then
					StringH^^ := str;
	end;


	procedure SkipPartialStatement;
		var
			done: Boolean;
	begin
		done := token = DoneT;
		while not done do begin
				case token of
					ThenT, DoT, SemiColon, EndT, ElseT, UntilT:  begin
							PutTokenBack;
							done := true;
						end;
					DoneT, BeginT, ForT, IfT, WhileT, RepeatT:  begin
							MacroError('end of statement expected');
							done := true;
						end;
					otherwise
						GetToken;
				end;
			end;
	end;


	procedure DoIf;
		var
			isTrue: boolean;
	begin
		isTrue := GetBoolean;
		GetToken;
		if token <> ThenT then
			MacroError(ThenExpected);
		if isTrue then begin
				GetToken;
				DoStatement
			end
		else begin
				GetToken;
				SkipStatement;
			end;
		GetToken;
		if token = elseT then begin
				if isTrue then begin
						GetToken;
						SkipStatement
					end
				else begin
						GetToken;
						DoStatement;
					end;
			end
		else
			PutTokenBack;
	end;


	procedure SkipIf;
	begin
		GetToken;
		SkipPartialStatement;
		GetToken;
		if token <> thenT then
			MacroError(ThenExpected);
		GetToken;
		SkipStatement;
		GetToken;
		if token <> elseT then
			PutTokenBack
		else begin
				GetToken;
				SkipStatement
			end
	end;


	procedure DoWhile;
		var
			isTrue: boolean;
			SavePC: LongInt;
	begin
		SavePC := pc;
		repeat
			pc := SavePC;
			isTrue := GetBoolean;
			GetToken;
			if token <> doT then
				MacroError(DoExpected);
			if isTrue then begin
					GetToken;
					DoStatement
				end
			else begin
					GetToken;
					SkipStatement;
				end;
			if Digitizing then
				DoCapture;
			if CommandPeriod then
				token := DoneT;
		until not isTrue or (Token = DoneT);
	end;


	procedure SkipWhile;
	begin
		GetToken;
		SkipPartialStatement;
		GetToken;
		if token <> doT then
			MacroError(DoExpected);
		GetToken;
		SkipStatement
	end;


	procedure DoRepeat;
		var
			isTrue: boolean;
			SavePC: LongInt;
	begin
		SavePC := pc;
		isTrue := true;
		repeat
			pc := SavePC;
			GetToken;
			while (token <> untilT) and (token <> DoneT) do begin
					DoStatement;
					GetToken;
					if Token = SemiColon then
						GetToken;
					if CommandPeriod then
						token := DoneT;
				end;
			if token <> untilT then
				MacroError(UntilExpected);
			isTrue := GetBoolean;
			if Digitizing then
				DoCapture;
		until isTrue or (Token = DoneT);
	end;


	procedure SkipRepeat;
	begin
		GetToken;
		while (token <> untilT) and (token <> DoneT) do begin
				SkipStatement;
				GetToken;
				if token = SemiColon then
					GetToken
				else if token <> UntilT then
					MacroError(UntilExpected);
			end;
		GetToken;
		SkipPartialStatement;
	end;


	procedure DoArrayAssignment;
		var
			SaveCommand: CommandType;
			index, LutValue, PixelValue, RegisterValue: LongInt;
			SyncChannel: integer;
	begin
		SaveCommand := MacroCommand;
		GetToken;
		if token <> LeftBracket then
			MacroError('"[" expected');
		Index := GetInteger;
		GetToken;
		if token <> RightBracket then
			MacroError('"]" expected');
		GetToken;
		if token <> AssignOp then
			MacroError('":=" expected');

		if SaveCommand = BufferC then begin
				CheckIndex(index, 0, MaxLine - 1);
				PixelValue := GetInteger;
				RangeCheck(PixelValue);
				if token <> DoneT then
					MacrosP^.aLine[index] := PixelValue;
				exit(DoArrayAssignment);
			end;

		if SaveCommand in [RedLutC, BlueLutC, GreenLutC] then begin
				CheckIndex(index, 0, 255);
				LutValue := GetInteger;
				RangeCheck(LutValue);
				if token <> DoneT then
					with info^.cTable[index].rgb do
						case SaveCommand of
							RedLutC: 
								red := bsl(LutValue, 8);
							GreenLutC: 
								green := bsl(LutValue, 8);
							BlueLutC: 
								blue := bsl(LutValue, 8);
						end;
				exit(DoArrayAssignment);
			end;

		if SaveCommand = ScionC then begin
				if framegrabber <> ScionLG3 then
					MacroError('No Scion LG-3');
				if Token <> DoneT then
					CheckIndex(index, 1, 4);
				if Token = DoneT then
					exit(DoArrayAssignment);
				if index = 3 then
					MacroError('DataIn is read-only');
				RegisterValue := GetInteger;
				if token <> DoneT then begin
						if RegisterValue < 0 then
							RegisterValue := 0;
						if RegisterValue > 255 then
							RegisterValue := 255;
						case index of
							1:  begin
									LG3DacA := RegisterValue;
									DacAReg^ := LG3DacA
								end;
							2:  begin
									LG3DacB := RegisterValue;
									DacBReg^ := LG3DacB
								end;
							4:  begin
									LG3DataOut := band(RegisterValue, $f);
									if SyncMode = SeparateSync then
										SyncChannel := 3
									else
										SyncChannel := VideoChannel;
									ChannelReg^ := bor(LG3DataOut, bor(bsl(VideoChannel, 4), bsl(SyncChannel, 6)));
								end;
						end; {case}
					end;
				exit(DoArrayAssignment);
			end;

		if SaveCommand = PlotDataC then begin
				CheckIndex(index, 0, MaxLine - 1);
				PlotData^[index] := GetExpression;
				exit(DoArrayAssignment);
			end;

		CheckIndex(index, 1, MaxMeasurements);
		if token <> DoneT then
			case SaveCommand of
				rAreaC: 
					mArea^[Index] := GetExpression;
				rMeanC: 
					mean^[Index] := GetExpression;
				rStdDevC: 
					sd^[Index] := GetExpression;
				rXC: 
					xcenter^[Index] := GetExpression;
				rYC: 
					ycenter^[Index] := GetExpression;
				rLengthC: 
					plength^[Index] := GetExpression;
				rMinC: 
					mMin^[Index] := GetExpression;
				rMaxC: 
					mMax^[Index] := GetExpression;
				rMajorC: 
					MajorAxis^[Index] := GetExpression;
				rMinorC: 
					MinorAxis^[Index] := GetExpression;
				rAngleC: 
					orientation^[Index] := GetExpression;
				rUser1C: 
					User1^[Index] := GetExpression;
				rUser2C: 
					User2^[Index] := GetExpression;
				otherwise
					MacroError('Read-only array');
			end; {case}
	end;


	procedure PushArguments (var nArgs: integer);
		var
			arg: array[1..MaxArgs] of extended;
			StringArg: array[1..MaxArgs] of boolean;
			i, nStringArgs: integer;
			TempName: SymbolType;
	begin
		nArgs := 0;
		nStringArgs := 0;
		GetToken;
		while token in [Variable, StringVariable, StringLiteral, NumericLiteral, TrueT, FalseT, FunctionT, StringFunctionT, comma, MinusOp, LeftParen] do begin
				if token = comma then
					GetToken;
				if nArgs < MaxArgs then
					nArgs := nArgs + 1
				else
					MacroError('Too many arguments');
				if (token = StringVariable) or (token = StringLiteral) or (token = StringFunctionT) then begin
						nStringArgs := nStringArgs + 1;
						arg[nArgs] := 0.0;
						StringArg[nArgs] := true;
						if token = StringFunctionT then
							TokenStr := DoStringFunction;
					end
				else begin
						PutTokenBack;
						arg[nArgs] := GetExpression;
						StringArg[nArgs] := false;
					end;
				if nStringArgs > 1 then
					MacroError('No more than one string argument allowed');
				GetToken;
			end;
		if token <> RightParen then
			MacroError(RightParenExpected);
		for i := 1 to nArgs do begin
				if TopOfStack < MaxMacroStackSize then
					TopOfStack := TopOfStack + 1
				else
					MacroError(StackOverflow);
				with MacrosP^.stack[TopOfStack] do begin
						value := arg[i];
						StringH := nil;
						if StringArg[i] then begin
								vType := StringVar;
								StringsAllocated := true;
								StringH := str255H(NewHandle(SizeOf(str255)));
								if StringH = nil then begin
										MacroError('Out of memory');
										Token := DoneT
									end
								else
									StringH^^ := TokenStr;
							end
						else
							vType := RealVar;
						value := arg[i];
					end;
			end;
	end;


	procedure DoProcedure;
		var
			SavePC, SavePCStart, NewPCStart: LongInt;
			SaveStackLoc, nArgs, i: integer;
			SaveProcName, NewProcName: SymbolType;
			SaveStringsAllocated: boolean;
	begin
		NewPCStart := TokenLoc;
		NewProcName := TokenSymbol;
		SaveStackLoc := TopOfStack;
		SaveStringsAllocated := StringsAllocated;
		StringsAllocated := false;
		GetToken;
		if token = LeftParen then
			PushArguments(nArgs)
		else begin
				nArgs := 0;
				PutTokenBack;
			end;
		SavePCStart := PCStart;
		PCStart := NewPCStart;
		LineStartPC := NewPCStart;
		SaveProcName := MacroOrProcName;
		MacroOrProcName := NewProcName;
		SavePC := pc;
		pc := pcStart;
		if nArgs > 0 then begin
				GetLeftParen;
				i := 0;
				GetToken;
				while token in [Identifier, Variable, StringVariable, comma, colon, SemiColon, RealT, IntegerT, BooleanT, StringT] do begin
						if (token = Identifier) or (token = Variable) or (token = StringVariable) then begin
								if i < nArgs then
									i := i + 1
								else
									MacroError('Too many formal arguments');
								MacrosP^.stack[SaveStackLoc + i].SymbolTableIndex := SymbolTableloc;
							end;
						GetToken;
					end;
				if Token = VarT then
					MacroError('VAR parameters not supported');
				if i < nArgs then
					MacroError('Too few formal arguments');
				if token <> RightParen then
					MacroError(RightParenExpected);
			end;
		GetToken;
		if (token = LeftParen) and (nArgs = 0) then
			MacroError('Arguments not expected');
		DoDeclarations;
		DoCompoundStatement;
		pc := SavePC;
		if StringsAllocated then
			DeallocateStrings(SaveStackLoc + 1, TopOfStack);
		StringsAllocated := SaveStringsAllocated;
		TopOfStack := SaveStackLoc;
		pcStart := SavePCStart;
		MacroOrProcName := SaveProcName;
	end;


	procedure CannotBeginWithThis;
		var
			str: str255;
	begin
		str := '';
		ConvertTokenToString(token, str);
		MacroError(concat('Statement cannot begin with ', '"', str, '"'));
	end;


	procedure DoStatement;
	begin
		case token of
			BeginT: 
				DoCompoundStatement;
			CommandT: 
				ExecuteCommand;
			UserCommandT: 
				DoUserToken;
			ForT: 
				DoFor;
			IfT: 
				DoIf;
			WhileT: 
				DoWhile;
			RepeatT: 
				DoRepeat;
			Identifier: 
				MacroError('Undefined identifier');
			Variable: 
				DoAssignment;
			StringVariable: 
				DoStringAssignment;
			ArrayT: 
				DoArrayAssignment;
			ProcedureT: 
				DoProcedure;
			ElseT: 
				MacroError('Statement expected');
			FunctionT, StringFunctionT, UserFuncT, UserStrFuncT: 
				MacroError('Variable expected');
			SemiColon: 
				PutTokenBack; {Null statement}
			otherwise
				CannotBeginWithThis
		end;
	end;


	procedure SkipStatement;
	begin
		case token of
			BeginT: 
				SkipCompoundStatement;
			ForT: 
				SkipFor;
			IfT: 
				SkipIf;
			WhileT: 
				SkipWhile;
			RepeatT: 
				SkipRepeat;
			CommandT, UserCommandT, Variable, StringVariable, ArrayT, ProcedureT: 
				SkipPartialStatement;
			DoneT: 
				; {Aborting the macro}
			SemiColon, EndT, ElseT, UntilT: 
				PutTokenBack; {These tokens can follow a statement}
			otherwise
				CannotBeginWithThis
		end;
	end;



	procedure RunMacro (nMacro: integer);
		var
			count: integer;
			str: str255;
	begin
		MacroLoadHandle := nil;
		repeat
			MacroLoadRequest := false;
			DefaultFileName := '';
			str := '';
			nSaves := 0;
			DefaultRefNum := 0;
			count := 0;
			pcStart := MacroItems^^[nMacro].MacroStart;
			pc := pcStart;
			if (nMacro = 0) and (pc = 0) then
				exit(RunMacro); {no global variables initialization}
			SavePC := pcStart;
			LineStartPC := pcStart;
			token := NullT;
			macro := true;
			MacroOpPending := false;
			DoOption := false;
			LastChoosePicInfo := nil;
			TopOfStack := nGlobals;
			MacroOrProcName := BlankSymbol;
			StringsAllocated := false;
			InPhotoMode := false;
			RoutinesCalled := [];
			GetToken;
			DoDeclarations;
			DoCompoundStatement;
			if info = LastChoosePicInfo then begin
					SelectWindow(info^.wptr);
					ActivateWindow;
					GenerateValues;
					LoadLUT(info^.cTable);
					UpdatePicWindow;
				end;
			with info^, RoiRect do begin
					if ((right - left) <= 0) or ((bottom - top) <= 0) then
						KillRoi;
				end;
			if info^.RoiShowing then begin
					if MacroOpPending then begin
							KillRoi;
							RestoreRoi;
						end
					else
						UpdatePicWindow;
				end;
			macro := false;
			if StringsAllocated then
				DeallocateStrings(nGlobals + 1, TopOfStack);
			if InPhotoMode then
				RestoreScreen;
			if MacroLoadRequest then begin
					LoadMacros;
					UnloadSeg(@LoadMacros);
					nMacro := 0; {initialize globals if requested}
				end;
		until not MacroLoadRequest;
	end;


	procedure RunKeyMacro (ch: char; KeyCode: integer);
		const
			FunctionKey = 16;
		var
			i: integer;
	begin
		if (ord(ch) = 0) then
			exit(RunKeyMacro);
		if (ch >= 'A') and (ch <= 'Z') then
			ch := chr(ord(ch) + 32); {Convert to lower case}
		if ord(ch) = FunctionKey then
			case KeyCode of
				122: 
					ch := 'A';
				120: 
					ch := 'B';
				99: 
					ch := 'C';
				118: 
					ch := 'D';
				96: 
					ch := 'E';
				97: 
					ch := 'F';
				98: 
					ch := 'G';
				100: 
					ch := 'H';
				101: 
					ch := 'I';
				109: 
					ch := 'J';
				103: 
					ch := 'K';
				111: 
					ch := 'L';
				105: 
					ch := 'M';
				107: 
					ch := 'N';
				113: 
					ch := 'O';
				otherwise
			end;
		for i := 1 to nMacros do
			if ch = MacroItems^^[i].MacroKey then begin
					RunMacro(i);
					leave;
				end;
	end;

	procedure RunMenuMacro (menuID, menuItem: integer);
		var
			i: integer;
			nonHMenuID: integer; {menu ID of the non-hierarchal version}
			MHandle: MenuHandle;
	begin
		nonHMenuID := menuID;
		if menuID <> SpecialMenu then begin
				nonHMenuID := ((menuID - FirstMacroMenu) div 2) * 2 + FirstMacroMenu;
				if menuItem = 1 then begin
						MHandle := MacroMenusH[nonHMenuID];
						if MHandle <> nil then
							if menuID = nonHMenuID then begin
                     {hide this menu}
									DeleteMenu(nonHMenuID);
									DrawMenuBar;
								end
							else begin
                     {show this menu}
									InsertMenu(MHandle, 0);
									DrawMenuBar;
								end;
						exit(RunMenuMacro);
					end;
			end;
		for i := 1 to nMacros do
			with MacroItems^^[i] do begin
					if nonHMenuID = MMenuID then
						if menuItem = MMitem then begin
								RunMacro(i);
								exit(RunMenuMacro);
							end
				end;
		PutMessage('RunMenuMacro error');
	end;

end.