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
		Types, Memory, QuickDraw, QuickDrawText, Packages, Menus, Events, Fonts, 
		Scrap, ToolUtils, Resources, Errors, Palettes, StandardFile, Windows, OSUtils,
		Controls, TextEdit, Files, Dialogs, TextUtils, Finder, MixedMode, Processes,
		Folders, ColorPicker,
		Globals, Utilities, RealUtils, Graphics, Edit, Dialogs, Files, Windows,
		Analysis, Camera, File1, File2, Filters, Macros2, Stacks, Lut, Background,
		User, Devices, Serial, PlugIns, Text, projection, math, fft, Edm;


	procedure RunMacro (nMacro: integer);
	procedure RunKeyMacro (ch: char; KeyCode: integer);
	procedure CloseSerialPorts;


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;
		MaxLoopCount = 20;
		
	var
		nSaves, ErrorPC, LineStartPC: integer;
		SaveBackground: integer;
		SavePicWidth, SavePicHeight: LongInt;
		SaveMethod: rsMethodType;
		SaveCreate, SaveInvertY, SaveScaleArithmetic, SaveScaleConvolutions: boolean;
		SaveCurrentFontID, SaveCurrentSize, SaveTextJust: integer;
		SaveCurrentStyle: Style;
		SaveTextBack: TextBackType;
		SaveAngle, SaveH, SaveV: extended;
		DoOption, MacroOpPending, StringsAllocated, InPhotoMode: boolean;
		RoutinesCalled: set of CommandType;
		MacroTicks: LongInt;
		LoopCounter: LongInt;
	


	procedure test;
	var
	  op:TokenTypeX;
	begin
		op:=token;
	end;


	function GetExpression: extended;
	forward;
	function GetBooleanExpression: 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;
	procedure DoUserFunction;
	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
								DisposeHandle(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
		with macrosP^ do begin
				temp := ord(macros[pc]);
				pc := pc + 1;
				FetchInteger := bor(bsl(temp, 8),  ord(macros[pc]));
				pc := pc + 1;
			end;
	end;


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


function FetchReal: real;
		type
			bytes=packed array[1..4] of char;
		var
			vrec:record
				case integer of
					1: (rv: real);
					2: (b: bytes)
				end;
	begin
		with macrosP^,vrec do begin
			b[1] := macros[pc];
			pc := pc + 1;
			b[2] := macros[pc];
			pc := pc + 1;
			b[3] := macros[pc];
			pc := pc + 1;
			b[4] := macros[pc];
			pc := pc + 1;
			FetchReal:=rv;
		end;
	end;


	procedure GetToken;
	begin
		with MacrosP^ do begin
				if token = DoneT then
					exit(GetToken);
				SavePC := PC;
				SaveToken := token;
				token := TokenTypeX(ord(macros[pc]));
				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 := TokenTypeX(band(ord(macros[pc]),255));
					end;
				pc := pc + 1;
				if pc > EndMacros then begin
						Token := DoneT;
						exit(GetToken);
					end;
				case token of
					CommandT, FunctionT, StringFunctionT, ArrayT:
						begin
							MacroCommand := CommandType(ord(macros[pc]));
							pc := pc + 1;
						end;
					Identifier:  begin
							SymbolTableLoc := FetchInteger;
							if TopOfStack > 0 then
								LookupVariable;
						end;
					ProcedureT, UserFunctionT: 
						LookupProcedureOrFunction;
					NumericLiteral: 
						TokenValue := FetchReal;
					StringLiteral:  begin
							TokenStr := '';
							while ord(macros[pc]) <> 0 do begin
									TokenStr := Concat(TokenStr, macros[pc]);
									pc := pc + 1;
								end;
							pc := pc + 1;
						end;
				end; {case}
			end; {with}
	end;


	procedure GetMacroName;
		var
			i, len: integer;
	begin
		with MacrosP^ do begin
				pc := PCStart;
				repeat
					pc := pc - 1;
					if pc < 0 then
						exit(GetMacroName);
				until macros[pc] = 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;
	end;


	procedure ConvertTokenToString (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, UserFuncIdT:  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, UserFunctionT: 
					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
		with MacrosP^ do begin
				pc := LineStartPC;
				ErrorLine := '';
				repeat
					str := '';
					if ord(macros[pc]) = ord(NewLineT) then {ppc-bug}
						leave;
					GetToken;
					ConvertTokenToString(str);
					if SavePC = ErrorPC then
						str := concat('Ç', str, 'È');
					ErrorLine := concat(ErrorLine, ' ', str);
				until token = DoneT;
			end;
	end;


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


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

	procedure MacroError (str: str255);
  {Report run-time errors}
		var
			name, ErrorLine, Line: str255;
			i, count, ignore: integer;
	begin
		with MacrosP^ do 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:='123456789012';
				for i:=1 to 12 do name[i]:=MacroOrProcName[i];
				TrimString(name);
				GetLocalLineNumber;
				Line := StringOf(MacroLineNumber:1);
				GetErrorLine(ErrorLine);
				InitCursor;
				GetGlobalLineNumber;
				Line:=StringOf(Line,' (',MacroLineNumber:1,')');
				ParamText(str, Line, Name, ErrorLine);
				Ignore := Alert(900, nil);
				Token := DoneT;
			end; {with}
	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 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, notFormatted: boolean;
			isUserFunction: 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
			notFormatted := true;
			if token = UserFunctionT then begin
					DoUserFunction;
					isExpression := TokenStr = 'No return string';
					if isExpression then
						n := TokenValue
					else
						str2 := TokenStr;
			end else begin
					isExpression := token in [Variable, NumericLiteral, FunctionT, TrueT, FalseT, ArrayT, MinusOp, LeftParen];
					PutTokenBack;
					if isExpression then
						n := GetBooleanExpression
					else
						str2 := GetString;
			end;
			GetToken;
			if token = colon then begin
					notFormatted := false;
					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
					if notFormatted then
						if (trunc(n) <> n) and (not ZeroFill) then begin
								width := 1;
								fwidth := 4;
							end;
					str2:=StringOf(n:width:fwidth);
					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 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);
				SelectdialogItemText(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;
				DisposeDialog(mylog);
			end;
	end;


	function GetSerial: str255;
		var
			count: LongInt;
			buffer: packed array[1..100] of char;
			err: OSErr;
			c:char;
	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);
			c:=buffer[1]; {ppc-bug}
			GetSerial :=c;
			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 begin
			DoChr := chr(i);
		end;
	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 GetPath (vRefnum: Integer; DirID: LongInt): Str255;
	{ from 'Inside Macintosh: Files' }
	var
	  myPB:     CInfoPBRec;
	  dirName:  Str255;
	  fullPath: Str255;
	  myErr:    OSErr;
	begin
	  fullPath := '';
	  myPB.ioNamePtr := @dirName;
	  myPB.ioVRefNum := vRefNum;
	  myPB.ioDrParID := DirId;
	  myPB.ioFDirIndex := -1;
	  repeat
	    myPB.ioDrDirID := myPB.ioDrParID;
	    myErr := PBGetCatInfoSync(@myPB);
	    dirName := concat(dirName, ':');
	    fullPath := concat(dirName, fullPath);
	  until myPB.ioDrDirID = fsRtDirID;
	  GetPath := fullPath;
	end;


	function DoGetPath: str255;
	var
		err: OSErr;
		PrefsVRef: integer;
		PrefsDirID: LongInt;
		PathType: str255;
	begin
		GetLeftParen;
		PathType := GetString;
		GetRightParen;
		if Token <> DoneT then begin
			DoGetPath := '';
			MakeLowerCase(PathType);
			if pos('window', PathType) <> 0 then begin
				if (CurrentWindow = textKind) and (TextInfo <> nil) then begin
					if TextInfo^.TextRefNum <> 0 then
						DoGetPath := GetPath(TextInfo^.TextRefNum, 0)
				end else if (CurrentWindow = PicKind) and (info^.vRef <> 0) then
					DoGetPath := GetPath(info^.vRef, 0)
			end else if pos('start', PathType) <> 0 then
				DoGetPath := GetPath(StartupSpec.vRefNum, StartupSpec.parID)
			else if pos('pref', PathType) <> 0 then begin
				err:=FindFolder(kOnSystemDisk, kPreferencesFolderType,
					false, PrefsVRef, PrefsDirID);
				if err = noErr then
					DoGetPath := GetPath(PrefsVRef, PrefsDirID)
			end else
				MacroError('Unrecognized argument');
		end;
	end;
	
	
	function DoStringFunction: str255;
		var
			str: str255;
	begin
		case MacroCommand of
			GetStringC: 
				DoStringFunction := DoGetString;
			ChrC: 
				DoStringFunction := DoChr;
			GetSerialC: 
				DoStringFunction := GetSerial;
			ConcatC:  begin
					GetArguments(str);
					DoStringFunction := str;
				end;
			WindowTitleC: 
				DoStringFunction := GetWindowTitle;
			GetPathC:
				DoStringFunction := DoGetPath;
			otherwise
				MacroError('"GetString ", "GetSerial" or "chr" expected');
		end;
	end;


	function GetString: str255;
	begin
		GetToken;
		if token = StringFunctionT then
			GetString := DoStringFunction
		else if (token = StringLiteral) or (token = StringVariable) then
			GetString := TokenStr
		else if token = UserFunctionT then begin
			DoUserFunction;
			GetString := TokenStr
		end 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 := GetBooleanExpression;
		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; [DefaultDigits:integer])}
		var
			prompt: str255;
			default, n: extended;
			Canceled, OptionalArgument: boolean;
			DefaultDigits: LongInt;
	begin
		GetLeftParen;
		prompt := GetString;
		GetComma;
		default := GetExpression;
		GetToken;
		OptionalArgument := token <> RightParen;
		PutTokenBack;
		if OptionalArgument then begin
				GetComma;
				DefaultDigits := GetInteger;
				if DefaultDigits < 0 then
					DefaultDigits := 0;
				if DefaultDigits > 5 then
					DefaultDigits := 5;
		end else
				DefaultDigits := 2;
		GetRightParen;
		n := 0.0;
		if Token <> DoneT then begin
				n := GetReal(prompt, default, DefaultDigits, Canceled);
				if Canceled then begin
						n := default;
						token := DoneT;
					end;
			end;
		GetNumber := n;
	end;


	function DoGetPixel: extended; {(hloc,vloc:integer)}
		var
			hloc, vloc: LongInt;
	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: LongInt;
	begin
		GetLeftParen;
		pid := GetInteger;
		GetRightParen;
		if Token <> DoneT then begin
				PidExists := false;
				for i := 1 to nPics do
					if InfoPtr(WindowPeek(PicWindow[i])^.RefCon)^.pidNum = pid then begin
							PidExists := true;
							leave;
						end;
			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 isKeyDown:boolean; {(key:string)}
		var
			key: str255;
	begin
		GetLeftParen;
		key := GetString;
		GetRightParen;
		if token <> DoneT then begin
			MakeLowerCase(key);
			isKeydown:=false;
			if (pos('option', key) <> 0) and OptionKeyDown then
				isKeyDown:=true
			else if (pos('shift', key) <> 0) and ShiftKeyDown then
				isKeyDown:=true
			else if (pos('control', key) <> 0) and ControlKeyDown then
				isKeyDown:=true;
		end;
	end;


	function GetParameter:LongInt; {parameter:string}
		var
			param: str255;
	begin
		GetLeftParen;
		param := GetString;
		GetRightParen;
		if token <> DoneT then begin
			MakeLowerCase(param);
			if pos('maxmeasure', param) <> 0 then
				GetParameter := MaxMeasurements
			else if pos('undo', param) <> 0 then
				GetParameter := UndoBufSize
			else if pos('freemem', param) <> 0 then
				GetParameter := FreeMem
			else if pos('maxblock', param) <> 0 then
				GetParameter := MaxBlock
			else if pos('offset', param) <> 0 then
				GetParameter := DacLow
			else if pos('gain', param) <> 0 then
				GetParameter := 255 - (DacHigh - DacLow)
			else if pos('width', param) <> 0 then
				GetParameter := ScreenWidth
			else if pos('height', param) <> 0 then
				GetParameter := ScreenHeight
			else if pos('roitype', param) <> 0 then begin
				if info = nil then
					GetParameter := 0
				else case Info^.RoiType of
					noRoi: GetParameter := 0;
					RectRoi: GetParameter := 1;
					OvalRoi: GetParameter := 2;
					PolygonRoi: GetParameter := 3;
					FreehandRoi: GetParameter := 4;
					TracedRoi: GetParameter := 5;
					LineRoi: GetParameter := 6;
					FreeLineRoi: GetParameter := 7;
					SegLineRoi: GetParameter := 8;
				end
			end else begin
				MacroError('Invalid argument');
				GetParameter := 0;
			end;
		end;
	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^.fit <> uncalibrated);
			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 with Info^.StackInfo^ do begin
						if StackType = MovieStack then
							ExecuteFunction := Info^.StackInfo^.FrameInterval
						else
							ExecuteFunction := Info^.StackInfo^.SliceSpacing;
					end;
			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;
			KeyDownC:
				ExecuteFunction := ord(isKeyDown);
			GetC:
				ExecuteFunction := GetParameter;
		end; {case}
	end;


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


	function GetArrayValue: extended;
		var
			SaveArrayType: ArrayType;
			Index: LongInt;
			xcoord, ycoord: integer;
	begin
		SaveArrayType := ArrayType(MacroCommand);
		GetToken;
		if token <> LeftBracket then
			MacroError('"[" expected');
		Index := GetInteger;
		GetToken;
		if token <> RightBracket then
			MacroError('"]" expected');
		case SaveArrayType of
			HistogramA:  begin
					RangeCheck(Index);
					GetArrayValue := histogram[Index];
				end;
			rAreaA:  begin
					CheckIndex(Index, 1, MaxMeasurements);
					GetArrayValue := mArea^[Index];
				end;
			rMeanA:  begin
					CheckIndex(Index, 1, MaxMeasurements);
					GetArrayValue := mean^[Index];
				end;
			rStdDevA:  begin
					CheckIndex(Index, 1, MaxMeasurements);
					GetArrayValue := sd^[Index];
				end;
			rXA:  begin
					CheckIndex(Index, 1, MaxMeasurements);
					GetArrayValue := xcenter^[Index];
				end;
			rYA:  begin
					CheckIndex(Index, 1, MaxMeasurements);
					GetArrayValue := ycenter^[Index];
				end;
			rLengthA:  begin
					CheckIndex(Index, 1, MaxMeasurements);
					GetArrayValue := pLength^[Index];
				end;
			rMinA:  begin
					CheckIndex(Index, 1, MaxMeasurements);
					GetArrayValue := mMin^[Index];
				end;
			rMaxA:  begin
					CheckIndex(Index, 1, MaxMeasurements);
					GetArrayValue := mMax^[Index];
				end;
			rMajorA:  begin
					CheckIndex(Index, 1, MaxMeasurements);
					GetArrayValue := MajorAxis^[Index];
				end;
			rMinorA:  begin
					CheckIndex(Index, 1, MaxMeasurements);
					GetArrayValue := MinorAxis^[Index];
				end;
			rAngleA:  begin
					CheckIndex(Index, 1, MaxMeasurements);
					GetArrayValue := orientation^[Index];
				end;
			rUser1A:  begin
					CheckIndex(Index, 1, MaxMeasurements);
					GetArrayValue := User1^[Index];
				end;
			rUser2A:  begin
					CheckIndex(Index, 1, MaxMeasurements);
					GetArrayValue := User2^[Index];
				end;
			RedLutA, GreenLutA, BlueLutA: 
				if OptionKeyDown then begin
						RangeCheck(Index);
						if Token <> DoneT then
							with cScreenPort^.portPixMap^^.pmTable^^.ctTable[index].rgb do
								case SaveArrayType of
									RedLutA: 
										GetArrayValue := band(bsr(red, 8), 255);
									GreenLutA: 
										GetArrayValue := band(bsr(green, 8), 255);
									BlueLutA: 
										GetArrayValue := band(bsr(blue, 8), 255);
								end; {case}
					end
				else begin
						RangeCheck(Index);
						if Token <> DoneT then
							with osGDevice^^.gdPMap^^.pmTable^^.ctTable[index].rgb do
								case SaveArrayType of
									RedLutA: 
										GetArrayValue := band(bsr(red, 8), 255);
									GreenLutA: 
										GetArrayValue := band(bsr(green, 8), 255);
									BlueLutA: 
										GetArrayValue := band(bsr(blue, 8), 255);
								end; {case}
					end;
			BufferA:  begin
					CheckIndex(Index, 0, MaxLine - 1);
					if Token <> DoneT then
						GetArrayValue := MacrosP^.aLine[index];
				end;
			PlotDataA:  begin
					CheckIndex(Index, 0, MaxLine - 1);
					if Token <> DoneT then
						GetArrayValue := PlotData^[index];
				end;
			xCoordinatesA:  begin
					CheckIndex(Index, 1, MaxCoordinates);
					if Token <> DoneT then
						with info^ do begin
								xcoord := xCoordinates^[index];
								if SpatiallyCalibrated then
									GetArrayValue := xcoord / xScale
								else
									GetArrayValue := xcoord
							end;
				end;
			yCoordinatesA:  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 / yScale
								else
									GetArrayValue := ycoord
							end;
				end;
			ScionA:  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;
			UserFunctionT:  begin
					DoUserFunction;
					GetValue := TokenValue;
				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, UserFunctionT, StringFunctionT, 
			TrueT, FalseT, ArrayT, StringVariable, StringLiteral: 
				fValue := GetValue;
			LeftParen:  begin
					fValue := GetBooleanExpression;
					GetRightParen;
				end;
			otherwise begin
					macroError('Undefined identifier');
					fvalue := 0.0
				end;
		end;
		if isUnaryMinus then
			fValue := -fValue;
		if isNot then
			if fValue = ord(true) then
				fValue := ord(false)
			else
				fValue := ord(true);
		GetFactor := fValue;
		GetToken;
	end;


	function GetTerm: extended;
		var
			tValue, fValue: extended;
			op: TokenTypeX;
	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: TokenTypeX;
	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
			seValue, tValue: extended;
			op: TokenTypeX;
	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;
		GetExpression := seValue;
		PutTokenBack;
	end;


	function GetBooleanExpression: extended;
		var
			eValue, seValue: extended;
			op: TokenTypeX;
	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;
		GetBooleanExpression := 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;
			theEvent: EventRecord;
	begin
		GetLeftParen;
		seconds := GetExpression;
		GetRightParen;
		if Token <> DoneT then begin
				SaveTicks := TickCount + round(seconds * 60.0);
				repeat
					if Digitizing then
						DoCapture;
					if EventAvail(everyEvent, theEvent) then
						; {Allows background tasks to run}
				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;
			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;
			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 = noFrameGrabber 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 (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, OptionalArgument: boolean;
			nExtra: LongInt;
	begin
		GetLeftParen;
		PaletteType := GetString;
		GetToken;
		OptionalArgument := token <> RightParen;
		PutTokenBack;
		if OptionalArgument then begin
				GetComma;
				nExtra := GetInteger;
				if nExtra < 0 then
					nExtra := 0;
				if nExtra > 6 then
					nExtra := 6;
		end;
		GetRightParen;
		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);
				if OptionalArgument then begin
					nExtraColors := nExtra;
					RedrawLUTWindow;
				end;
			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('dicom', Attributes) <> 0 then
					WhatToImport := ImportDICOM;
				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) or (nSlices > MaxSlices) 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;
	end;


	procedure SelectPic; {(PicN:integer)}
		var
			PicN, i: LongInt;
			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;
						DisableDensitySlice;
						Info := pointer(WindowPeek(PicWindow[PicN])^.RefCon);
					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;
						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 NewPicWidth > MaxPicSize then
					NewPicWidth := MaxPicSize;
				if NewPicWidth < 8 then
					NewPicWidth := 8;
				if NewPicHeight < 1 then
					NewPicHeight := 1;
				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: 
						if pos(':', name) <> 0 then
							SaveTextUsingPath(name)
						else
							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: extended;
	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 info^.fit = uncalibrated 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;
		SetForegroundColor(BlackIndex);
		SetBackGroundColor(WhiteIndex);
		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 DrawPixel (h, v, value: integer);
  {Draws a pixel on the screen in the current foreground color.}
	begin
		SetPort(info^.wptr);
		PenNormal;
		SetFColor(value);
		PenSize(1, 1);
		MoveTo(h, v);
		LineTo(h, v);
	end;


	procedure DoPutPixel; {(hloc,vloc, value:integer)}
		var
			hloc, vloc: LongInt;
			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);
				if info^.magnification = 1.0 then
					DrawPixel(hloc, vloc, value)
				else begin
					SetRect(MaskRect, hloc, vloc, hloc + 1, vloc + 1);
					UpdateScreen(MaskRect);
				end;
				info^.changes := true;
			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 (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: extended;
	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;


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


	procedure DoSetScale; {(scale:real; unit:string; [AspectRatio: real])}
		var
			id: integer;
			scale, AspectRatio: extended;
			str: str255;
	begin
		AspectRatio:=0.0;
		GetLeftParen;
		scale := GetExpression;
		GetComma;
		str := GetString;
		GetToken;
		if token=comma
			then AspectRatio:=GetExpression
			else PutTokenBack;
		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);
					TruncateString(str, maxUnit);
					xUnit := str;
					xScale := scale;
					yScale := scale;
					if AspectRatio>0.0 then begin
						PixelAspectRatio:=AspectRatio;
						yScale := xScale / PixelAspectRatio;
					end else
						PixelAspectRatio := 1.0;
					SpatiallyCalibrated := (xUnit <> '') and (xUnit <> 'pixel') and (xUnit <> 'pixels') and (xScale <> 0.0);
					UpdateTitleBar;
				end;
	end;


	procedure GetScale;  {(var scale:real; unit:string; [AspectRatio:real])}
		var
			loc1, loc2, loc3, index, count: integer;
			str: str255;
	begin
		GetLeftParen;
		loc1 := GetVar;
		GetComma;
		loc2 := GetStringVar;
		loc3:=0;
		GetToken;
		if token=comma
		 then loc3 := GetVar
		 else PutTokenBack;
		GetRightParen;
		if Token <> DoneT then
			with info^, MacrosP^ do
				if SpatiallyCalibrated then begin
						stack[loc1].value := xScale;
						stack[loc2].StringH^^ := xUnit;
						if loc3>0 then stack[loc3].value := PixelAspectRatio;
					end
				else begin
						stack[loc1].value := 1.0;
						stack[loc2].StringH^^ := 'pixel';
						if loc3>0 then stack[loc3].value := 1.0;
					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;
		SaveCurrentFontID:=CurrentFontID;
		SaveCurrentSize:=CurrentSize;
		SaveCurrentStyle:=CurrentStyle;
		SaveTextJust:=TextJust;
		SaveTextBack:=TextBack;
	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;
				CurrentFontID:=SaveCurrentFontID;
				CurrentSize:=SaveCurrentSize;
				CurrentStyle:=SaveCurrentStyle;
				TextJust:=SaveTextJust;
				TextBack:=SaveTextBack;
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 begin
							InsertText(str, NewLine);
							if not macro then MacroError('32K text limit exceeded')
						end 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: extended; {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;
			SaveCommand: CommandType;
	begin
		SaveCommand := MacroCommand;
		GetLeftParen;
		x := GetInteger;
		GetComma;
		y := GetInteger;
		GetComma;
		count := GetInteger;
		GetRightParen;
		if (Token <> DoneT) and (count <= MaxLine) then
			with MacrosP^ do begin
					KillRoi;
					case SaveCommand 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: extended;
			str: str255;
	begin
		GetLeftParen;
		RequiredVersion := GetExpression;
		GetRightParen;
		if (Token <> DoneT) then
			if round(RequiredVersion * 100.0) > version then begin
					RealToString(RequiredVersion, 1, 2, str);
					PutError(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: SetOfMeasurements;
	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);
		TruncateString(str, maxLabelLength);
		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
			SetupPseudocolor;
			LutMode := PseudoColor;
			IdentityFunction := false;
			if isGrayScaleLUT then
				info^.LutMode := CustomGrayScale;
			UpdateLut;
			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 SetSaveAsMode;
		var
			mode: str255;
	begin
		mode := GetStringArg;
		if Token <> DoneT then begin
				MakeLowerCase(mode);
				SaveAsWhat := asTiff;
				if pos('tiff', mode) <> 0 then
					SaveAsWhat := asTiff;
				if pos('pict', mode) <> 0 then
					SaveAsWhat := asPict;
				if pos('quick', mode) <> 0 then
					SaveAsWhat := asQuickTime;
				if pos('pics', mode) <> 0 then
					SaveAsWhat := asPICS;
				if pos('lut', mode) <> 0 then
					SaveAsWhat := AsPalette;
				if pos('outline', mode) <> 0 then
					SaveAsWhat := AsOutline;
				if pos('rgb', mode) <> 0 then with info^ do begin
					if StackInfo = nil then begin
						MacroError('Stack required');
						exit(SetSaveAsMode);
					end;
					if StackInfo^.nSlices <> 3 then begin
						MacroError('Stack must have 3 slices');
						exit(SetSaveAsMode);
					end;
					StackInfo^.StackType := rgbStack;
					UpdateTitleBar;
				end;
			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, i: 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('seven', str) <> 0 then
			data := data7;
		i:=pos('even', str);
		if (i <> 0) and (str[i-1]<>'s') then
			parity := evenParity;
		if pos('odd', str) <> 0 then
			parity := oddParity;
		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 := UInt8(chr(17));
				xOff := UInt8(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;
				if pos('finger', str) <> 0 then
					SetCursor(FingerCursor);
			end;
	end;


	procedure SetVideoOptions; {options: string[, gain:integer, offset:integer]}
		var
			options: str255;
			NewSyncMode: SyncModeType;
      gain, offset: integer;

		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
		GetLeftParen;
		options := GetString;
		GetToken;
		if token = comma then begin
			gain := GetInteger;
			GetComma;
			offset := GetInteger
		end
		else begin
			PutTokenBack;
			gain := 255 - (DacHigh - DacLow);
			offset := DacLow;
		end;
		GetRightParen;
		if Token <> DoneT then begin
				MakeLowerCase(options);
				SetOption(InvertID, InvertVideo, pos('invert', options) <> 0);
				SetOption(HighlightID, HighlightSaturatedPixels, pos('high', options) <> 0);
				SetOption(TriggerID, ExternalTrigger, pos('trig', options) <> 0);
				if pos('sep', options) <> 0 then
					NewSyncMode := SeparateSync
				else
					NewSyncMode := NormalSync;
				if NewSyncMode <> SyncMode then
					DoVideoControl(SyncID);
				SetOffset(offset, gain);
				SetGain(offset, gain);
				if VideoControl <> nil then begin
					gain := 255 - (DacHigh - DacLow);
					ShowOffsetAndGain(DacLow, gain);
				end;
				OscillatingMovies := pos('osc', options) <> 0;
				BlindMovieCapture := pos('blind', options) <>0;
				if (FrameGrabber = ScionLG3) or (FrameGrabber=ScionAG5) or (FrameGrabber=ScionVG5f) then begin
						DacLowReg^ := DacLow;
						DacHighReg^ := DacHigh;
					end;
			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 CallExportPlugin;
		var
			fname: str255;
	begin
		fname := GetStringArg;
		LoadExportPlugIn(fname);
	end;


	procedure CallFilterPlugin;
		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
						RestoreScreen;
			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: LongInt;
   HasArguments,ShowDialog,okay: boolean;
 begin
  GetToken;
  HasArguments := token = LeftParen;
  PutTokenBack;
  ShowDialog:=false;
  if HasArguments then begin
    GetLeftParen;
    Options := GetString;
    GetComma;
    nFrames := GetInteger;
    ShowDialog:= nFrames <= 0;
    if not ShowDialog then
    	FramesToAverage := nFrames;
    GetRightParen;
    if (Token <> DoneT) then begin
      MakeLowerCase(options);
      VideoRateAveraging := false;
      SumFrames := false;
      IntegrateOnChip := false;
      if (pos('int', options) <> 0) or (pos('sum', options) <> 0) then
       sumFrames := true;
      if pos('video', options) <> 0 then
       VideoRateAveraging := true;
      if (pos('camera', options) <> 0) or (pos('chip', options) <> 0) then begin
       if  (FrameGrabber<>ScionLG3) and (FrameGrabber<>ScionAG5) and (FrameGrabber<>ScionVG5f) then begin
         MacroError('On-chip integration requires a Scion frame grabber.');
         exit(DoAverageFrames)
       end;
       VideoRateAveraging := false;
       SumFrames := false;
       IntegrateOnChip := true;
       end;
     end;
   end; {has arguments}
  if token <> DoneT then begin
   if ShowDialog
    then okay:=DoAveragingOptions
    else okay:=true;
   if okay then AverageFrames;
  end;
 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 := ord4(band(fHue, $ffff));
								lSaturation := ord4(band(fSaturation, $ffff));
								lValue := ord4(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 info^.StackInfo = nil then begin
			MacroError('Stack required');
			exit(DoProject);
		end;
		if not ((ProjectC in RoutinesCalled) or (SetProjectionC in RoutinesCalled)) then begin
				if ShowProjectDialogBox then
					DoProjection
				else
					token := DoneT;
			end
		else with info^.StackInfo^ do begin
			if SliceSpacing <= 0.0 then
				SliceSpacing := 1.0;
			if DensitySlicing then
				with info^ do begin
						TransparencyLower := SliceStart;
						TransparencyUpper := SliceEnd;
					end;
			DoProjection;
		end;
		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, DstPidNum: LongInt;
			gain, offset: extended;
			roi:rect;
			DstInfo:InfoPtr;
			isPidNum:boolean;
	begin
		GetLeftParen;
		op := GetString;
		GetComma;
		pic1 := GetInteger;
		GetComma;
		pic2 := GetInteger;
		GetComma;
		gain := GetExpression;
		GetComma;
		offset := GetExpression;
		GetComma;
		GetToken;
		isPidNum:=token=variable;
		PutTokenBack;
		if isPidNum
			then DstPidNum:=GetInteger
			else result := GetString;
		GetRightParen;
		if token <> DoneT then begin
				MakeLowerCase(op);
				RealImageMath:=false;
				if pos('calibrate', op) <> 0 then
					RealImageMath := true;
				if pos('real', op) <> 0 then
					RealImageMath := true;
				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('cmul', op) <> 0) or (pos('conjugate', op) <> 0) then begin
					CurrentMathOp := cMulMath;
					RealImageMath := true;
				end;
				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;
				if not GetMathRoi(pic1, pic2, roi) then
					exit(ImageMath);
				if isPidNum then begin
					DstInfo := GetInfoPtr(DstPidNum);
					if DstInfo=nil then begin
						MacroError('Bad pid number');
						exit(ImageMath);
					end;
					if RealImageMath and (DstInfo^.dataH = nil) then begin
						MacroError('Real output image required');
						exit(ImageMath);
					end;
					SelectWindow(DstInfo^.wptr);
					Info := DstInfo;
					ActivateWindow;
					LoadLUT(info^.cTable);
					UpdatePicWindow;
					KillRoi;
				end else begin
					with roi do
						if RealImageMath then begin
							if not NewRealWindow(result, right-left, bottom-top) then
								exit(ImageMath)
						end else begin
							if not NewPicWindow(result, right-left, bottom-top) then
								exit(ImageMath)
						end;
					DstInfo := Info;
				end;
				DoMath(pic1, pic2, DstInfo, roi);
			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;


	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 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 DoFilter; {(fType:string)}
		var
			fType: str255;
			doMore:boolean;
			t:FateTable;
	begin
		GetLeftParen;
		fType := GetString;
		GetRightParen;
		if token <> DoneT then begin
				MakeLowerCase(fType);
				doMore:=pos('more', fType) <> 0;
				if pos('smooth', fType) <> 0 then begin
					if doMore then
						Filter(UnweightedAvg, 0, t)
					else
						Filter(WeightedAvg, 0, t);
					exit(DoFilter);
				end;
				if pos('sharpen', fType) <> 0 then begin
					if doMore then
						Filter(SharpenMore, 0, t)
					else
						Filter(fsharpen, 0, t);
					exit(DoFilter);
				end;
				if pos('median', fType) <> 0 then begin
					RankFilter := MedianRank;
					DoRankFilter;
					exit(DoFilter);
				end;
				if (pos('edges', fType) <> 0) or (pos('sobel', fType)<>0) then begin
					Filter(FindEdges, 0, t);
					exit(DoFilter);
				end;
				if pos('dither', fType) <> 0 then begin
					Filter(Dither, 0, t);
					exit(DoFilter);
				end;
				if pos('min', fType) <> 0 then begin
					RankFilter := MinRank;
					DoRankFilter;
					exit(DoFilter);
				end;
				if pos('max', fType) <> 0 then begin
					RankFilter := MaxRank;
					DoRankFilter;
					exit(DoFilter);
				end;
				MacroError('Undefined filter');
			end;
	end;


	procedure DoShadow; {[(Direction:string)]}
		var
			direction: str255;
			t: FateTable;
	begin
		GetToken;
		if token =LeftParen then begin
			direction := GetString;
			MakeLowerCase(direction);
			GetRightParen;
		end else begin
			PutTokenBack;
			direction:='se';
		end;
		if Token <> DoneT then
		if direction='n' then Filter(ShadowN, 0, t)
		else if direction='ne' then Filter(ShadowNE, 0, t)
		else if direction='e'  then Filter(ShadowE, 0, t)
		else if direction='se' then Filter(ShadowSE, 0, t)
		else if direction='s'  then Filter(ShadowS, 0, t)
		else if direction='sw' then Filter(ShadowSW, 0, t)
		else if direction='w'  then Filter(ShadowW, 0, t)
		else if direction='nw' then Filter(ShadowNW, 0, t)
		else MacroError('Invalid direction');
		end;


	procedure DoCalibrate; {(fit,unit:string,m1,k1,m2,k2,...)}
		var
			sFit, sUnit: str255;
			Measured, Known:StandardsArray;
			nPairs, i:integer;
	begin
		GetLeftParen;
		sFit := GetString;
		if token <> DoneT then with info^ do begin
				MakeLowerCase(sFit);
				if pos('straight', sFit) <> 0 then fit:=StraightLine
				else if pos('rodbard', sFit) <> 0 then fit:=RodbardFit
				else if pos('od', sFit) <> 0 then fit:=UncalibratedOD
				else if pos('uncal', sFit) <> 0 then fit:=Uncalibrated
				else if pos('exp', sFit) <> 0 then fit:=ExpoFit
				else if pos('log', sFit) <> 0 then fit:=LogFit
				else if pos('pow', sFit) <> 0 then fit:=PowerFit
				else if pos('poly2', sFit) <> 0 then fit:=Poly2
				else if pos('poly3', sFit) <> 0 then fit:=Poly3
				else if pos('poly4', sFit) <> 0 then fit:=Poly4
				else if pos('poly5', sFit) <> 0 then fit:=Poly5
				else begin
					MacroError('Unknown fit');
					exit(DoCalibrate);
				end;
				if (fit=Uncalibrated) or (fit=UncalibratedOD) then begin
					GetRightParen;
					Calibrate;
					exit(DoCalibrate);
				end;
		end;
		GetComma;
		sUnit := GetString;
		GetComma;
		nPairs:=0;
		GetToken;
		while (token<>RightParen) and (token<>DoneT) do begin
			PutTokenBack;
			if nPairs<MaxStandards then
				nPairs:=nPairs+1;
			Measured[nPairs]:=GetExpression;
			GetComma;
			Known[nPairs]:=GetExpression;
			GetToken;
			if token=comma then
				GetToken;
		end;
		if token <> DoneT then with info^ do begin
				if nPairs<2 then begin
					MacroError('More arguments expected');
					exit(DoCalibrate);
				end;
				TruncateString(sUnit, maxUM);
				UnitOfMeasure:=sUnit;
				nStandards:=nPairs;
				nKnownValues:=nPairs;
				for i:=1 to nStandards do begin
					ClearResults(i);
					uMean[i]:=Measured[i];
					Mean^[i]:=Measured[i];
					StandardValues[i]:=Known[i];
				end;
				mCount := nStandards;
				UpdateList;
				Calibrate;
			end;
	end;


	procedure DoMakeMovie; {(Options:string; nFrames:integer; delay:extended)}
		var
			options: str255;
			nFrames: integer;
			delay: extended;
			ShowDialog: boolean;
	begin
			GetLeftParen;
			Options := GetString;
			GetComma;
			nFrames := GetInteger;
			GetComma;
			delay := GetExpression;
			GetRightParen;
			if (Token <> DoneT) then begin
					ShowDialog := pos('dialog', options) <> 0;
					if ShowDialog and (length(options) = 6) then begin
						MakeMovie(true);
						exit(DoMakeMovie);
					end;
					if nFrames > 0 then
						FramesWanted := nFrames;
					if delay >= 0.0 then
						SecondsPerFrame := delay;
					MakeLowerCase(options);
					BlindMovieCapture := false;
					LG3BufferCapture := false;
					TriggerFirstFrameOnly := true;
					TimeStamp := false;
					UseExistingStack := false;
					if pos('blind', options) <> 0 then
						BlindMovieCapture := true;
					if (pos('buffer', options) <> 0) then
						LG3BufferCapture := true;
					if (pos('stamp', options) <> 0) then
							TimeStamp := true;
					if (pos('trigger', options) <> 0) and (pos('first', options) <> 0) then begin
						ExternalTrigger := true;
						TriggerFirstFrameOnly := true;
					  end;
					if (pos('trigger', options) <> 0) and (pos('each', options) <> 0) then begin
						ExternalTrigger := true;
						TriggerFirstFrameOnly := false;
					  end;
					if (pos('existing', options) <> 0) then
							UseExistingStack := true;
					MakeMovie(ShowDialog);
				end;
	end;


	procedure DoAnalyzeParticles; {[(Options:string)]}
		var
			options: str255;
			hasOptions, okay: boolean;
	begin
		GetToken;
		hasOptions := token = LeftParen;
		PutTokenBack;
		if hasOptions then begin
			GetArguments(options);
			MakeLowerCase(options);
			if pos('dialog', options) <> 0 then begin
				okay := DoAPDialog;
				if okay then
					AnalyzeParticles;
				exit(DoAnalyzeParticles);
			end;
			LabelParticles := false;
			OutlineParticles := false;
			IgnoreParticlesTouchingEdge := false;
			IncludeHoles := false;
			APReset := false;
			if pos('label', options) <> 0 then
				LabelParticles := true;
			if pos('outline', options) <> 0 then
				OutlineParticles := true;
			if pos('ignore', options) <> 0 then
				IgnoreParticlesTouchingEdge := true;
			if pos('include', options) <> 0 then
				IncludeHoles := true;
			if pos('reset', options) <> 0 then
				APReset := true;
		end;
		AnalyzeParticles;
	end;


  procedure SetProjection;
    var
      v: extended;
      s: str255;
  begin
    GetLeftParen;
    s := GetString;
		MakeLowerCase(s);
    if pos('x-axis', s) <> 0 then
      AxisOfRotation := XAxis
    else if pos('y-axis', s) <> 0 then
      AxisOfRotation := YAxis
    else if pos('z-axis', s) <> 0 then
      AxisOfRotation := ZAxis
    else if pos('nearest', s) <> 0 then
      ProjectionMethod := NearestPoint
    else if pos('brightest', s) <> 0 then
      ProjectionMethod := BrightestPoint
    else if pos('mean', s) <> 0 then
      ProjectionMethod := MeanValue
    else begin
        GetComma;
        if pos('save', s) <> 0 then
          SaveProjections := GetBoolean
        else if pos('minimize', s) <> 0 then
          MinProjSize := GetBoolean
        else begin
            v := GetExpression;
            if pos('initial', s) <> 0 then
              InitAngle := round(v)
            else if pos('total', s) <> 0 then
              TotalAngle := round(v)
            else if pos('increment', s) <> 0 then
              AngleInc := round(v)
            else if pos('opacity', s) <> 0 then
              Opacity := round(v)
            else if pos('surface', s) <> 0 then
              DepthCueSurf := 100 - round(v)
            else if pos('interior', s) <> 0 then
              DepthCueInt := 100 - round(v)
            else
              MacroError('String not recognized:');
          end;
      end;
    GetRightParen;
		RoutinesCalled := RoutinesCalled + [SetProjectionC];
  end;
  
  
	procedure DoGetHistogram;
		var
			Left, Top, Width, Height: integer;
			SaveRoiRect: rect;
	begin
		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;
		if token <> DoneT then
			with Info^ do begin
					SaveRoiRect := RoiRect;
					SetRect(RoiRect, left, top, left + width, top + height);
					GetRectHistogram;
					RoiRect := SaveRoiRect;
				end;
	end;


	procedure doFFTMacro; {(Options:string)}
		var
			options: str255;
	begin
		GetLeftParen;
		Options := GetString;
		GetRightParen;
		if (Token <> DoneT) then begin
				MakeLowerCase(options);
				if pos('foreward', options) <> 0 then
					doFFT(ForewardFFT)
				else if pos('inverse', options) <> 0 then begin
					if pos('without', options) <> 0 then
						doFFT(InverseFFT)
					else if pos('filter', options) <> 0 then
						doFFT(InverseFFTWithFilter)
					else doFFT(InverseFFTWithMask)
				end else if pos('display', options) <> 0 then
					RedisplayPowerSpectrum
				else if pos('swap', options) <> 0 then
					doSwapQuadrants
				else
					MacroError('Unrecognized argument');
			end;
	end;


	procedure GetFileInfo; {(path: string, var type:string; var size: integer)}
	type
		CharArray = packed array[1..4] of char;
	var
		err: OSErr;
		path: str255;
		FinderInfo: FInfo;
		ftype: CharArray;
		loc1, loc2, f: integer;
		FileSize : LongInt;
	begin
		GetLeftParen;
		path := GetString;
		GetComma;
		loc1 := GetStringVar;
		GetComma;
		loc2 := GetVar;
		GetRightParen;
		if Token <> DoneT then with MacrosP^ do begin
			err := GetFInfo(path, 0, FinderInfo);
			if err = noErr then begin
				err := fsopen(path, 0, f);
				err := GetEOF(f, FileSize);
				if err = noErr then
					stack[loc2].value := FileSize
				else
					stack[loc2].value := -1;
				err := fsclose(f);
				fType := CharArray(FinderInfo.fdType);
				stack[loc1].StringH^^ := concat(ftype[1], ftype[2], ftype[3], ftype[4]);
			end else begin
				stack[loc1].StringH^^ := '';
				stack[loc2].value := -1;
			end;
		end;
	end;


	procedure DoSelectTool;
	var
		tType: str255;
	begin
		GetLeftParen;
		tType := GetString;
		GetRightParen;
		if token = DoneT then
			exit(DoSelectTool);
		MakeLowerCase(tType);
		PreviousTool := CurrentTool;
			{left side tools}
		if pos('magn', tType) <> 0 then
			CurrentTool := MagnifyingGlass
		else if pos('grabber', tType) <> 0 then
			CurrentTool := Grabber
		else if pos('pencil', tType) <> 0 then
			CurrentTool := Pencil
		else if pos('eraser', tType) <> 0 then
			CurrentTool := Eraser
		else if pos('brush', tType) <> 0 then
			CurrentTool := Brush
		else if pos('drawline', tType) <> 0 then
			CurrentTool := ruler
		else if pos('paint', tType) <> 0 then
			CurrentTool := PaintBucket
		else if pos('profile', tType) <> 0 then
			CurrentTool := PlotTool
		else if pos('wand', tType) <> 0 then
			CurrentTool := Wand
		else if pos('angletool', tType) <> 0 then
			CurrentTool := AngleTool
			{right side tools}
		else if pos('rect', tType) <> 0 then
			CurrentTool := SelectionTool
		else if pos('oval', tType) <> 0 then
			CurrentTool := OvalSelectionTool
		else if pos('poly', tType) <> 0 then
			CurrentTool := PolygonTool
		else if pos('freehand', tType) <> 0 then
			CurrentTool := FreehandTool
		else if pos('straight', tType) <> 0 then begin
			CurrentTool := LineTool;
			LOIType := Straight;
		end
		else if pos('freeline', tType) <> 0 then begin
			CurrentTool := LineTool;
			LOIType := Freehand;
		end
		else if pos('segment', tType) <> 0 then begin
			CurrentTool := LineTool;
			LOIType := Segmented;
		end
		else if pos('lut', tType) <> 0 then
			CurrentTool := LUTTool
		else if pos('text', tType) <> 0 then
			CurrentTool := TextTool
		else if pos('spray', tType) <> 0 then
			CurrentTool := SprayCanTool
		else if pos('picker', tType) <> 0 then
			CurrentTool := PickerTool
		else if pos('cross', tType) <> 0 then
			CurrentTool := CrossHairTool
		else begin
			MacroError('Unrecognized tool name');
			exit(DoSelectTool);
		end;
		isSelectionTool := (CurrentTool = SelectionTool) or (CurrentTool = OvalSelectionTool)
			or (CurrentTool = PolygonTool) or (CurrentTool = FreehandTool) or (CurrentTool = LineTool);
		DrawTools;
		if (not isSelectionTool) and (CurrentTool <> MagnifyingGlass) and
			(CurrentTool <> Grabber) and (CurrentTool <> Wand) then
				KillRoi;
		with info^ do if RoiShowing then
			if EqualRect(RoiRect, PicRect) and not isSelectionTool then {if Select All}
				KillRoi;
		if (CurrentTool = SelectionTool) or (CurrentTool = CrossHairTool) then begin
			InfoMessage := '';
			if mCount > 0 then
				ShowInfo;
		end;
		RoiMode := MoveMode;
		if CurrentTool = LineTool then
			if (LoiType = Straight) and (LineWidth <> 1) then begin
				LineWidth := 1;
				UpdateRoiLineWidth;
				ShowLineWidth;
		end;
	end;


	procedure DoExit;
	var
		reason: str255;
	begin
		GetToken;
		if token = LeftParen then begin
			reason := GetString;
			GetRightParen;
			beep;
			PutMessage(reason);
		end else
		  PutTokenBack;
		token := DoneT;
	end;


	procedure DoBinary; {(op:string)}
		var
			op: str255;
	begin
		GetLeftParen;
		op := GetString;
		GetRightParen;
		if token <> DoneT then begin
				MakeLowerCase(op);
				if (pos('edm', op) <> 0) or (pos('map', op) <> 0) then begin
					MakeEDM(EDMItem);
					exit(DoBinary);
				end;
				if pos('ultimate', op) <> 0 then begin
					MakeEDM(UltimateItem);
					exit(DoBinary);
				end;
				if pos('watershed', op) <> 0 then begin
					MakeEDM(WatershedItem);
					exit(DoBinary);
				end;
				MacroError('Undefined binary operation');
			end;
	end;


  	procedure DoAverageSlices;
	var
	   FirstSlice, nSlices: LongInt;
		HasArguments: boolean;
	begin
		GetToken;
		HasArguments := token = LeftParen;
		PutTokenBack;
		FirstSlice := 0;
		nSlices := 0;
		if HasArguments then begin
			GetLeftParen;
			FirstSlice := GetInteger;
			GetComma;
			nSlices := GetInteger;
			GetRightParen;
		end;
		if (Token <> DoneT) then
			AverageSlices(FirstSlice, nSlices);
  	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, UndoC]) then begin
					KillRoi; {Terminate any pending paste operation.}
					RestoreRoi;
				end;
		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
					SelectAllText
				else begin
					StopDigitizing;
					SelectAll(true);
				end;
			PasteC: 
				DoPaste;
			ClearC, FillC, InvertC, FrameC: 
				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;
					end;
			KillC: 
				KillRoi;
			RestoreC: 
				if NoInfo^.RoiType <> NoRoi then
					RestoreRoi;
			AnalyzeC: 
				DoAnalyzeParticles;
			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: 
				DoShadow;
			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:
				DoExit; 
			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;
			TileC: 
				TileImages;
			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;
			CallFilterC: 
				CallFilterPlugin;
			PhotoModeC: 
				DoPhotoMode;
			RGBToIndexedC: 
				RGBToIndexed;
			SurfacePlotC: 
				PlotSurface;
			SelectWindowC: 
				DoSelectWindow;
			NewTextWindowC: 
				DoNewTextWindow;
			CaptureColorC: 
				CaptureColor;
			GetThresholdC: 
				GetThreshold;
			AverageSlicesC: 
				DoAverageSlices;
			SortPaletteC: 
				SortPalette;
			ProjectC: 
				DoProject;
			ScaleConvolutionsC: 
				ScaleConvolutions := GetBooleanArg;
			ImageMathC: 
				ImageMath;
			PasteLiveC: 
				PasteLive;
			GetPlotDataC: 
				GetPlotData;
			DeleteC: 
				DoDelete;
			GetScaleC: 
				GetScale;
			AutoOutlineC: 
				DoAutoOutline;
			FilterC: 
				DoFilter;
			SetSaveAsC:
				SetSaveAsMode;
			CalibrateC:
				DoCalibrate;
			CallExportC:
				CallExportPlugin;
			IndexedToRGBC:
				ConvertEightBitColorToRGB;
			MakeMovieC:
				DoMakeMovie;
	   SetProjectionC:
	      SetProjection;
	   GetHistogramC:
	  		DoGetHistogram;
	  	fftC:
	  		doFFTMacro;
	  	GetFileInfoC:
	  		GetFileInfo;
	  	SelectToolC:
	  		DoSelectTool;
	  	BinaryC:
	  		DoBinary;
		end; {case}
		OptionKeyWasDown := false;
		if not macro then begin
				Token := DoneT;
				KillRoi;
			end;
		if TickCount > MacroTicks then begin
				if EventAvail(everyEvent, theEvent) then; {Allows background tasks to run}
				if CommandPeriod then begin
						Token := DoneT;
						KillRoi;
					end;
				MacroTicks := TickCount + 15;
			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, 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;
						LoopCounter := LoopCounter + 1;
						if LoopCounter >= MaxLoopCount then begin
							if CommandPeriod then
								token := DoneT;
							LoopCounter := 0;
						end;
						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 := GetBooleanExpression;
	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: integer;
	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;
			LoopCounter := LoopCounter + 1;
			if LoopCounter >= MaxLoopCount then begin
				if CommandPeriod then
					token := DoneT;
				LoopCounter := 0;
			end;
		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: integer;
	begin
		SavePC := pc;
		isTrue := true;
		repeat
			pc := SavePC;
			GetToken;
			while (token <> untilT) and (token <> DoneT) do begin
					DoStatement;
					GetToken;
					if Token = SemiColon then
						GetToken;
					LoopCounter := LoopCounter + 1;
					if LoopCounter >= MaxLoopCount then begin
						if CommandPeriod then
							token := DoneT;
						LoopCounter := 0;
					end;
				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
			SaveArrayType: ArrayType;
			index, LutValue, PixelValue, RegisterValue: LongInt;
			SyncChannel: integer;
	begin
		SaveArrayType := ArrayType(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 SaveArrayType = BufferA then begin
				CheckIndex(index, 0, MaxLine - 1);
				PixelValue := GetInteger;
				RangeCheck(PixelValue);
				if token <> DoneT then
					MacrosP^.aLine[index] := PixelValue;
				exit(DoArrayAssignment);
			end;

		if SaveArrayType in [RedLutA, BlueLutA, GreenLutA] then begin
				RangeCheck(index);
				LutValue := GetInteger;
				RangeCheck(LutValue);
				if token <> DoneT then
					with info^.cTable[index].rgb do
						case SaveArrayType of
							RedLutA: 
								red := bsl(LutValue, 8);
							GreenLutA: 
								green := bsl(LutValue, 8);
							BlueLutA: 
								blue := bsl(LutValue, 8);
						end;
				exit(DoArrayAssignment);
			end;

		if SaveArrayType = ScionA 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 SaveArrayType = PlotDataA then begin
				CheckIndex(index, 0, MaxLine - 1);
				PlotData^[index] := GetExpression;
				exit(DoArrayAssignment);
			end;

		CheckIndex(index, 1, MaxMeasurements);
		if token <> DoneT then
			case SaveArrayType of
				rAreaA: 
					mArea^[Index] := GetExpression;
				rMeanA: 
					mean^[Index] := GetExpression;
				rStdDevA: 
					sd^[Index] := GetExpression;
				rXA: 
					xcenter^[Index] := GetExpression;
				rYA: 
					ycenter^[Index] := GetExpression;
				rLengthA: 
					plength^[Index] := GetExpression;
				rMinA: 
					mMin^[Index] := GetExpression;
				rMaxA: 
					mMax^[Index] := GetExpression;
				rMajorA: 
					MajorAxis^[Index] := GetExpression;
				rMinorA: 
					MinorAxis^[Index] := GetExpression;
				rAngleA: 
					orientation^[Index] := GetExpression;
				rUser1A: 
					User1^[Index] := GetExpression;
				rUser2A: 
					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, UserFunctionT, StringFunctionT, ArrayT, 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] := GetBooleanExpression;
						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 PushFunctionResult(SymbolLoc: integer; var ReturnValueLoc: integer);
		var
			StackLoc: integer;
	begin
		if TopOfStack >= MaxMacroStackSize then begin
				MacroError(StackOverflow);
				exit(PushFunctionResult);
			end;
		TopOfStack := TopOfStack + 1;
		ReturnValueLoc := TopOfStack;
		with MacrosP^.stack[TopOfStack] do begin
				SymbolTableIndex := SymbolLoc;
				value := 0.0;
				StringH := nil;
			end;
		with macrosP^.stack[TopOfStack] do
			case token of
				IntegerT: 
					vType := IntVar;
				RealT: 
					vType := RealVar;
				BooleanT: 
					vType := BooleanVar;
				StringT:  begin
						vType := StringVar;
						StringH := str255H(NewHandle(SizeOf(str255)));
						StringsAllocated := true;
						if StringH = nil then begin
								MacroError('Out of memory');
								Token := DoneT
							end
						else
							StringH^^ := '';
					end;
				otherwise
			end;
	end;


	procedure DoUserFunction;
		var
			SavePC, SavePCStart, NewPCStart, SaveStackLoc, nArgs, i: integer;
			SaveSymbolTableLoc, ReturnValueLoc: integer;
			SaveName, NewFuncName: SymbolType;
			SaveStringsAllocated: boolean;
	begin
		NewPCStart := TokenLoc;
		NewFuncName := TokenSymbol;
		SaveStackLoc := TopOfStack;
		SaveSymbolTableLoc := SymbolTableLoc;
		SaveStringsAllocated := StringsAllocated;
		StringsAllocated := false;
		GetToken;
		if token = LeftParen then
			PushArguments(nArgs)
		else begin
				nArgs := 0;
				PutTokenBack;
			end;
		SavePCStart := PCStart;
		PCStart := NewPCStart;
		LineStartPC := NewPCStart - 1;
		SaveName := MacroOrProcName;
		MacroOrProcName := NewFuncName;
		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 <> 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');
		PushFunctionResult(SaveSymbolTableLoc, ReturnValueLoc);
		GetToken;
		if (token = LeftParen) and (nArgs = 0) then
			MacroError('Arguments not expected');
		DoDeclarations;
		DoCompoundStatement;
		pc := SavePC;
		with MacrosP^.stack[ReturnValueLoc] do begin
      {Get return value from stack}
			if (vType = StringVar) and (StringH <> nil) then begin
				TokenStr := StringH^^;
				TokenValue := 0.0;
			end else begin
				TokenValue := value;
				TokenStr := 'No return string';
			end;
		end;
		if StringsAllocated then
			DeallocateStrings(SaveStackLoc + 1, TopOfStack);
		StringsAllocated := SaveStringsAllocated;
		TopOfStack := SaveStackLoc;
		pcStart := SavePCStart;
		MacroOrProcName := SaveName;
	end; {DoUserFunction}


	procedure DoProcedure;
		var
			SavePC, SavePCStart, NewPCStart, 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 - 1;
		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(str);
		MacroError(concat('Statement cannot begin with ', '"', str, '"'));
	end;
	
	
	procedure DoFunctionAssignment;
		var
			SaveStackLoc: integer;
			value: extended;
	begin
		LookupVariable;
		SaveStackLoc := TokenStackLoc;
		GetToken;
		if token <> AssignOp then begin
				MacroError('":=" expected');
				exit(DoFunctionAssignment);
			end;
		with MacrosP^.stack[SaveStackLoc] do begin
			if (vType =StringVar) and (StringH <> nil) then
				StringH^^ := GetString
			else
				value := GetBooleanExpression;
		end;
	end;


	procedure DoStatement;
	begin
		case token of
			BeginT: 
				DoCompoundStatement;
			CommandT: 
				ExecuteCommand;
			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: 
				MacroError('Variable expected');
			UserFunctionT:
				DoFunctionAssignment;
			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, Variable, StringVariable, ArrayT, ProcedureT, UserFunctionT: 
				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;
			SaveInfo: InfoPtr;
	begin
		DefaultFileName := '';
		str := '';
		nSaves := 0;
		DefaultRefNum := 0;
		count := 0;
		pcStart := MacroStart[nMacro];
		pc := pcStart;
		SavePC := pcStart;
		LineStartPC := pcStart;
		token := NullT;
		macro := true;
		DoOption := false;
		SaveInfo := info;
		TopOfStack := nGlobals;
		MacroOrProcName := BlankSymbol;
		StringsAllocated := false;
		InPhotoMode := false;
		RoutinesCalled := [];
		MacroTicks := TickCount + 15;
		LoopCounter := 0;
		GetToken;
		DoDeclarations;
		DoCompoundStatement;
		if (info <> SaveInfo) and (info <> NoInfo) then
			SelectWindow(info^.wptr);
		with info^, RoiRect do begin
				if ((right - left) <= 0) or ((bottom - top) <= 0) then
					KillRoi;
			end;
		if info^.RoiShowing then
			if not (OpPending and (CurrentOp = PasteOp)) then begin
			  KIllRoi;
			  RestoreRoi;
			end;
		macro := false;
		if StringsAllocated then
			DeallocateStrings(nGlobals + 1, TopOfStack);
		if InPhotoMode then
			RestoreScreen;
	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 = MacroKey[i] then begin
					RunMacro(i);
					leave;
				end;
	end;



end.