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

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


interface

	uses
		QuickDraw, Palettes, PrintTraps, globals, Utilities, Graphics, edit, Analysis, Camera, file1, file2, functions, macros2;


	procedure LoadMacros (fname: str255; RefNum: integer);
	procedure RunMacro (nMacro: integer);
	procedure RunKeyMacro (ch: char; KeyCode: integer);


implementation


	const
		DivideByZero = 'Divide by zero';
		DoExpected = '"do" expected';
		StackOverflow = 'Stack overflow';
		RightParenExpected = '")" expected';
		MaxArgs = 25;
		BlankSymbol = '            ';

	var
		EndMacros, pcStart, TopOfStack, CurrentX, CurrentY, nSaves: integer;
		nProcedures, TokenLoc, TokenStackLoc, SavePC, nGlobals: integer;
		MacroStart: array[1..MaxMacros] of integer;
		MacroKey: packed array[1..MaxMacros] of char;
		pc: integer; {"program counter" used by macro interpreter}
		Token, SaveToken: TokenType;
		TokenStr: string[100];
		TokenSymbol, ProcName: SymbolType;
		TokenValue: extended;
		DoOption: boolean;


	function GetExpression: extended;
	forward;
	procedure DoStatement;
	forward;
	procedure DoFor;
	forward;


	function LineNumber: integer;
		var
			i, n: integer;
	begin
		n := 1;
		with MacrosP^ do
			for i := pcStart to pc do
				if macros[i] = cr then
					n := n + 1;
		LineNumber := n;
	end;

{$PUSH}
{$D-}

	function PreScan: boolean;
   {Convert to lowercase and remove comments to speed up parsing.}
		var
			inString, inComment: boolean;
			c: char;
			i, StartComment: integer;
	begin
		with MacrosP^ do begin
				PreScan := false;
				inString := false;
				inComment := false;
				pcStart := 0;
				for i := 0 to EndMacros do begin
						c := macros[i];
						if inString and (c = cr) then begin
								pc := i;
								PutMessage(concat('The quoted string in line ', long2str(LineNumber), ' is not terminated.'));
								exit(PreScan);
							end;
						if (not InString) and (c = '{') then begin
								InComment := true;
								StartComment := i;
							end;
						if inComment then begin
								if (c = '{') and (i <> StartComment) then begin
										PutMessage('Comments cannot be nested.');
										exit(PreScan);
									end;
								if c = '}' then
									inComment := false;
								macros[i] := ' ';
							end
						else begin
								if c = '''' then
									inString := not inString;
								if (c >= 'A') and (c <= 'Z') and not inString then
									macros[i] := chr(ord(c) + 32);
							end;
					end;
				if inComment then begin
						pc := StartComment;
						PutMessage(concat('The comment starting in line ', long2str(LineNumber), ' is not terminated.'))
					end
				else
					PreScan := true;
			end; {with}
	end;


	function match (str: str255): boolean;
		var
			i, loc: integer;
	begin
		loc := pc - 1;
		match := false;
		with MacrosP^ do
			for i := 1 to length(str) do
				if macros[loc + i] <> str[i] then
					exit(match);
		match := true;
	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 MacroError (str: str255);
		var
			cLine, str2: str255;
			i, count: integer;
	begin
		with MacrosP^ do begin
				if token = DoneT then
					exit(MacroError);
				i := pc - 1;
				while (i > 0) and (macros[i] <> cr) do {Find start of line}
					i := i - 1;
				count := 0;
				cLine := '';
				repeat
					i := i + 1;
					count := count + 1;
					if macros[i] <> cr then
						cLine := concat(cLine, macros[i]);
				until (i >= EndMacros) or (macros[i] = cr) or (count > 60);
				TrimString(cLine);
				if ProcName <> BlankSymbol then begin {Are we in a procedure?}
						str2 := ProcName;
						TrimString(str2);
						str2 := concat(' of procedure ', str2)
					end
				else
					str2 := ' of macro';
				PutMessage(concat(str, ' in line ', long2str(LineNumber), str2, '.', cr, cr, '"', cLine, '"'));
				Token := DoneT;
			end; {with}
	end;


	procedure LookupIdentifier;
  {Binary search routine from "Data Structures with Abstract}
  {Data Types and Pascal" by Stubbs and Webre.}
		var
			low, high, mid: integer;
	begin
		with MacrosP^ do begin
				low := 1;
				high := nSymbols;
				while low < high do begin
						mid := (low + high + 1) div 2;
						if TokenSymbol < SymbolTable[mid].symbol then
							high := mid - 1
						else
							low := mid;
					end;
				with SymbolTable[high] do
					if (high <> 0) and (TokenSymbol = symbol) then begin
							token := tType;
							MacroCommand := cType;
							TokenLoc := loc;
						end
					else
						token := UnknownIdentifier;
			end;
	end;


	procedure LookupVariable;
		var
			VarFound: boolean;
			i: integer;
	begin
		with MacrosP^ do begin
				VarFound := false;
				i := TopOfStack + 1;
				repeat
					i := i - 1;
					VarFound := TokenSymbol = Stack[i].symbol
				until VarFound or (i = 1);
				if VarFound then
					with stack[i] do begin
							token := Variable;
							TokenValue := value;
							TokenStackLoc := i;
						end;
			end; {with}
	end;


	procedure GetToken;
		var
			c: char;
			SymbolLength: integer;
	begin
		with MacrosP^ do begin
				if token = DoneT then
					exit(GetToken);
				SavePC := PC;
				SaveToken := token;
				while not (macros[pc] in ['a'..'z', '0'..'9', '(', ')', ',', '''', '+', '-', '*', '/', ':', ';', '=', '.', '>', '<', '[', ']']) do begin  {skip white space}
						pc := pc + 1;
						if pc > EndMacros then begin
								Token := DoneT;
								exit(GetToken);
							end;
					end;
				c := macros[pc];
				case c of
					'a'..'z': 
						begin
							TokenSymbol := BlankSymbol;
							SymbolLength := 0;
							while macros[pc] in ['a'..'z', '0'..'9'] do begin
									SymbolLength := SymbolLength + 1;
									if SymbolLength <= SymbolSize then
										TokenSymbol[SymbolLength] := macros[pc];
									pc := pc + 1;
									if pc > EndMacros then begin
											Token := DoneT;
											exit(GetToken);
										end;
								end;
							Token := identifier;
							LookupIdentifier;
							if (token = UnknownIdentifier) and (TopOfStack > 0) then
								LookupVariable;
							exit(GetToken);
						end;
					'0'..'9', '.': 
						begin
							TokenStr := '';
							while macros[pc] in ['0'..'9', '.'] do begin
									TokenStr := concat(TokenStr, c);
									pc := pc + 1;
									c := macros[pc];
									if pc > EndMacros then begin
											Token := DoneT;
											exit(GetToken);
										end;
								end;
							Token := NumericLiteral;
							if macros[pc] in ['a'..'z'] then
								MacroError('Operator expected');
							exit(GetToken);
						end;
					'(': 
						begin
							Token := LeftParen;
							pc := pc + 1;
						end;
					')': 
						begin
							Token := RightParen;
							pc := pc + 1;
						end;
					'[': 
						begin
							Token := LeftBracket;
							pc := pc + 1;
						end;
					']': 
						begin
							Token := RightBracket;
							pc := pc + 1;
						end;
					',': 
						begin
							Token := comma;
							pc := pc + 1;
						end;
					':': 
						if macros[pc + 1] = '=' then begin
								Token := AssignOp;
								pc := pc + 2;
							end
						else begin
								Token := colon;
								pc := pc + 1;
							end;
					';': 
						begin
							Token := SemiColon;
							pc := pc + 1;
						end;
					'+': 
						begin
							Token := PlusOp;
							pc := pc + 1;
						end;
					'-': 
						begin
							Token := MinusOp;
							pc := pc + 1;
						end;
					'*': 
						begin
							Token := MulOp;
							pc := pc + 1;
						end;
					'/': 
						begin
							Token := DivOp;
							pc := pc + 1;
						end;
					'''': 
						begin
							TokenStr := '';
							pc := pc + 1;
							while macros[pc] <> '''' do begin
									TokenStr := concat(TokenStr, macros[pc]);
									pc := pc + 1;
									if pc > EndMacros then begin
											Token := DoneT;
											exit(GetToken);
										end;
								end;
							pc := pc + 1;
							Token := stringT;
						end;
					'=': 
						begin
							Token := eqOp;
							pc := pc + 1;
						end;
					'<': 
						begin
							pc := pc + 1;
							if macros[pc] = '>' then begin
									token := neOp;
									pc := pc + 1;
								end
							else if macros[pc] = '=' then begin
									token := leOp;
									pc := pc + 1;
								end
							else
								token := ltOp;
						end;
					'>': 
						begin
							pc := pc + 1;
							if macros[pc] = '=' then begin
									token := geOp;
									pc := pc + 1;
								end
							else
								token := gtOp;
						end;
					otherwise
						begin
							token := NullT;
							beep;
						end;
				end; {case}
			end; {with}
	end;


	procedure AddMenuItem;
		var
			i, fkey: integer;
			str: str255;
			c, key: char;
	begin
		with MacrosP^ do begin
				if pc > 1 then
					if macros[pc - 1] in ['a'..'z', '0'..'9'] then
						exit(AddMenuItem);
				if macros[pc + 5] in ['a'..'z', '0'..'9'] then
					exit(AddMenuItem);
				pc := pc + 4;
				repeat
					pc := pc + 1;
					c := macros[pc];
				until (c = '''') or (c = cr) or (pc = EndMacros);
				if (c = cr) or (pc = EndMacros) then begin
						MacroError('Menu entry for macro not found.');
						exit(AddMenuItem);
					end;
				pc := pc + 1;
				str := '';
				repeat
					str := concat(str, macros[pc]);
					pc := pc + 1;
				until (macros[pc] = '''') or (pc = EndMacros);
				if pc = EndMacros then
					PutMessage('Ending quote('') missing.')
				else
					pc := pc + 1;
				AppendMenu(SpecialMenuH, str);
				if nMacros < MaxMacros then
					nMacros := nMacros + 1
				else
					beep;
				if macros[pc] = ';' then
					pc := pc + 1;
				MacroStart[nMacros] := pc;
				i := pos('[', str);
				if i > 0 then begin {Assign a key to macro?}
						i := i + 1;
						key := str[i];
						if (key >= 'A') and (key <= 'Z') then
							key := chr(ord(key) + 32);
						MacroKey[nMacros] := key;
						if (key = 'f') and (str[i + 1] in ['1'..'9']) then begin {Function Key?}
								fkey := ord(str[i + 1]) - ord('0');
								if str[i + 2] in ['0'..'5'] then
									fkey := fkey * 10 + ord(str[i + 2]) - ord('0');
								if (fkey >= 1) and (fkey <= 15) then
									MacroKey[nMacros] := chr(ord('A') + fkey - 1);
							end; {Function key?}
					end;
			end; {with}
	end;


	procedure AddProcedure;
	begin
		pc := pc + 9;
		GetToken;
		if token <> UnknownIdentifier then begin
				MacroError('Procedure name missing or previously defined');
				exit(AddProcedure);
			end;
		if nSymBols >= MaxSymbols then begin
				MacroError('Too many procedures');
				exit(AddProcedure);
			end;
		nSymbols := nSymbols + 1;
		nProcedures := nProcedures + 1;
		with MacrosP^, MacrosP^.SymbolTable[nSymbols] do begin
				symbol := TokenSymbol;
				tType := procedureT;
				cType := NullC;
				if macros[pc] = ';' then
					pc := pc + 1;
				loc := pc;
			end;
	end;


	procedure CheckForReservedWord;
		var
			str: str255;
	begin
		if token in [CommandT, FunctionT, endT, VarT, ForT, ToT, DoT, IfT, ThenT, whileT, repeatT, untilT, IntDivOp, modOp, andOp, NotOp, ProcedureT, MacroT, ArrayT] then begin
				str := TokenSymbol;
				TrimString(str);
				MacroError(concat('"', str, '" is a reserved identifier'));
			end;
	end;


	procedure DoDeclaration (global: boolean);
		var
			SaveStackLoc, StackLoc: integer;
	begin
		SaveStackLoc := TopOfStack;
		while (token = UnknownIdentifier) or (token = Variable) or (token = comma) do begin
				TopOfStack := TopOfStack + 1;
				if global then
					nGlobals := nGlobals + 1;
				if TopOfStack > MaxStackSize then begin
						MacroError(StackOverflow);
						exit(DoDeclaration);
					end;
				with MacrosP^.stack[TopOfStack] do begin
						Symbol := TokenSymbol;
						value := 0.0;
					end;
				GetToken;
				if token = comma then
					GetToken;
			end; {while}
		CheckForReservedWord;
		if token <> colon then
			MacroError('":" expected');
		GetToken;
		if (token <> IntegerT) and (token <> RealT) and (token <> BooleanT) then
			MacroError('"integer", "real", or "boolean" 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;
					otherwise
				end;
		GetToken;
		if Token = SemiColon then
			GetToken;
	end;


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


	procedure DoGlobalDeclarations;
	begin
		pc := pc + 3;
		GetToken;
		CheckForReservedWord;
		while (token = UnknownIdentifier) and (Token <> DoneT) do
			DoDeclaration(true);
		PutTokenBack;
	end;


	procedure PreScan2;
		var
			i: integer;
			inString: boolean;
			c: char;
	begin
		Token := NullT;
		with MacrosP^ do begin
				if nMacros > 0 then
					for i := 1 to nMacros do begin
							DelMenuItem(SpecialMenuH, FirstMacroItem);
							MacroKey[i] := chr(0);
						end;
				nMacros := 0;
				nProcedures := 0;
				nGlobals := 0;
				TopOfStack := 0;
				ProcName := BlankSymbol;
				pc := 0;
				inString := false;
				while pc <= (EndMacros - 10) do begin
						c := macros[pc];
						if c = '''' then
							inString := not inString;
						if not InString then
							case c of
								'm': 
									if match('macro') then begin
											AddMenuItem;
											if token = DoneT then
												exit(PreScan2);
										end;
								'p': 
									if match('procedure') then begin
											AddProcedure;
											if token = DoneT then
												exit(PreScan2);
										end;
								'v': 
									if (nMacros = 0) and (nProcedures = 0) then
										if match('var') then begin
												DoGlobalDeclarations;
												if token = DoneT then
													exit(PreScan2);
											end;
								otherwise
							end;
						pc := pc + 1;
					end; {while}
				if nMacros = 0 then
					PutMessage('No macros found in this file.');
			end; {with}
	end;


	procedure SortSymbolTable;
  {Selection sort routine from "Algorithms" by Robert Sedgewick.}
		var
			i, j, min: integer;
			t: SymTabRec;
	begin
		with MacrosP^ do
			for i := 1 to nSymbols do begin
					min := i;
					for j := i + 1 to nSymbols do
						if SymbolTable[j].symbol < SymbolTable[min].symbol then
							min := j;
					t := SymbolTable[min];
					SymbolTable[min] := SymbolTable[i];
					SymbolTable[i] := t;
				end;
	end;


	procedure LoadMacros (fname: str255; RefNum: integer);
		var
			err: OSErr;
			FileSize: LongInt;
			f: integer;
	begin
		err := FSOpen(fname, RefNum, f);
		err := GetEOF(f, FileSize);
		if FileSize > MaxMacroSize then begin
				PutMessage('Macro file is too large.');
				exit(LoadMacros);
			end;
		err := SetFPos(f, fsFromStart, 0);
		err := fsRead(f, FileSize, @MacrosP^.macros);
		EndMacros := FileSize - 1;
		err := fsclose(f);
		ShowWatch;
		if not PreScan then
			exit(LoadMacros);
		InitSymbolTable;
		UnloadSeg(@InitSymbolTable);
		SortSymbolTable;
		PreScan2;
		if nProcedures > 0 then
			SortSymbolTable;
		CurrentX := 20;
		CurrentY := 20;
	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;


	function GetString: str255;
	begin
		GetToken;
		if token = stringT then
			GetString := TokenStr
		else begin
				MacroError('String expected');
				GetString := '';
			end;
	end;


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


	procedure GetArguments (var str: str255);
		var
			width, fwidth: integer;
			i: LongInt;
			isExpression, ZeroFill, noArgs: boolean;
			n: real;
			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]);
		width := 4;
		fwidth := 0;
		str := '';
		GetLeftParen;
		GetToken;
		repeat
			isExpression := token in [Variable, NumericLiteral, FunctionT, TrueT, FalseT, ArrayT];
			PutTokenBack;
			if isExpression then
				n := GetExpression
			else
				str2 := GetString;
			GetToken;
			if token = colon then begin
					width := GetInteger;
					if width < 0 then
						width := 0;
					if width > 100 then
						width := 100;
					GetToken;
					if token = colon then begin
							fwidth := GetInteger;
							if fwidth < 0 then
								width := 0;
							if fwidth > 12 then
								width := 12;
							GetToken;
						end;
				end;
			if token = comma then
				GetToken;
			if isExpression then begin
					RealToString(n, width, fwidth, str2);
					if ZeroFill 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;


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


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


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


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


	procedure DoConvolve;
		var
			err: OSErr;
			f: integer;
			FileFound: boolean;
			fname: str255;
	begin
		fname := GetStringArg;
		err := fsopen(fname, KernelsRefNum, f);
		FileFound := err = NoErr;
		err := fsclose(f);
		if FileFound then
			convolve(fname, KernelsRefNum)
		else
			convolve('', 0);
	end;


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


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

{$POP}

	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;


	procedure RangeCheck (i: LongInt);
	begin
		if (i < 0) or (i > 255) then
			MacroError('Argument is less than 0 or greater than 255');
	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 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;
			SameSizeC: 
				ExecuteFunction := ord(AllSameSize);
			cValueC: 
				ExecuteFunction := CalibrateValue;
			CalibratedC: 
				ExecuteFunction := ord(info^.calibrated);
			rCountC: 
				ExecuteFunction := mCount;
		end; {case}
	end;


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


	function GetArrayValue: extended;
		var
			SaveCommand: CommandType;
			Index: LongInt;
	begin
		SaveCommand := MacroCommand;
		GetToken;
		if token <> LeftBracket then
			MacroError('"[" expected');
		Index := GetInteger;
		GetToken;
		if token <> RightBracket then
			MacroError('"]" expected');
		case SaveCommand of
			HistogramC: 
				begin
					CheckIndex(Index, 0, 255);
					GetArrayValue := histogram[Index];
				end;
			rAreaC: 
				begin
					CheckIndex(Index, 1, MaxRegions);
					GetArrayValue := mArea^[Index];
				end;
			rMeanC: 
				begin
					CheckIndex(Index, 1, MaxRegions);
					GetArrayValue := mean^[Index];
				end;
			rXC: 
				begin
					CheckIndex(Index, 1, MaxRegions);
					GetArrayValue := xcenter^[Index];
				end;
			rYC: 
				begin
					CheckIndex(Index, 1, MaxRegions);
					GetArrayValue := ycenter^[Index];
				end;
			rLengthC: 
				begin
					CheckIndex(Index, 1, MaxRegions);
					GetArrayValue := pLength^[Index];
				end;
			rMinC: 
				begin
					CheckIndex(Index, 1, MaxRegions);
					GetArrayValue := mMin^[Index];
				end;
			rMaxC: 
				begin
					CheckIndex(Index, 1, MaxRegions);
					GetArrayValue := mMax^[Index];
				end;
			rMajorC: 
				begin
					CheckIndex(Index, 1, MaxRegions);
					GetArrayValue := MajorAxis^[Index];
				end;
			rMinorC: 
				begin
					CheckIndex(Index, 1, MaxRegions);
					GetArrayValue := MinorAxis^[Index];
				end;
			rAngleC: 
				begin
					CheckIndex(Index, 1, MaxRegions);
					GetArrayValue := orientation^[Index];
				end;
		end; {case}
	end;


	function GetValue: extended;
	begin
		case token of
			Variable: 
				GetValue := TokenValue;
			NumericLiteral: 
				GetValue := StringToReal(TokenStr);
			FunctionT: 
				GetValue := ExecuteFunction;
			TrueT: 
				GetValue := ord(true);
			FalseT: 
				GetValue := ord(false);
			ArrayT: 
				GetValue := GetArrayValue;
			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, TrueT, FalseT, ArrayT: 
				fValue := GetValue;
			LeftParen: 
				begin
					fValue := GetExpression;
					GetRightParen;
				end;
			otherwise
				begin
					macroError('Undefined identifier');
					fvalue := 0.0
				end;
		end;
		GetToken;
		if isUnaryMinus then
			fValue := -fValue;
		if isNot then
			if fValue = ord(true) then
				fValue := ord(false)
			else
				fValue := ord(true);
		GetFactor := fValue;
	end;


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


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


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


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


	procedure SetDensitySlice; {LowerLevel,UpperLevel:integer}
		var
			sStart, sEnd: integer;
	begin
		GetLeftParen;
		sStart := GetInteger;
		RangeCheck(sStart);
		GetComma;
		sEnd := GetInteger;
		RangeCheck(sEnd);
		if Token <> DoneT then begin
				DisableDensitySlice;
				SliceStart := sStart;
				SliceEnd := sEnd;
				if thresholding then
					ResetGrayMap;
				EnableDensitySlice;
			end;
		GetRightParen;
	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;
		KillRoi;
		Info := pointer(WindowPeek(PicWindow[n])^.RefCon);
		SetPort(info^.wptr);
		IsInsertionPoint := false;
		WhatToUndo := NothingToUndo;
		UndoFromClip := false;
	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;
		GetComma;
		height := GetInteger;
		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;
					WhatToUndo := NothingToUndo;
					RoiShowing := true;
				end;
	end;


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


	procedure InsetRoi;
		var
			delta: integer;
	begin
		GetLeftParen;
		delta := GetInteger;
		GetRightParen;
		with info^ do begin
				if not RoiShowing then begin
						MacroError('No Selection');
						exit(InsetRoi);
					end;
				InsetRgn(roiRgn, delta, delta);
				RoiRect := roiRgn^^.rgnBBox;
				RoiUpdateTime := 0;
			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
		KillRoi;
		DrawText(str, InsertionPoint, TextJust);
		if EndOfLine then begin
				CurrentY := CurrentY + CurrentSize;
				InsertionPoint.h := CurrentX;
				InsertionPoint.v := CurrentY + 4;
			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 MakeLowerCase (var str: str255);
		var
			i: integer;
			c: char;
	begin
		for i := 1 to length(str) do begin
				c := str[i];
				if (c >= 'A') and (c <= 'Z') then
					str[i] := chr(ord(c) + 32);
			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;
				UpdateTextMenu
			end;
	end;


	procedure SetFontSize;
		var
			size: integer;
	begin
		GetLeftParen;
		Size := GetInteger;
		GetRightParen;
		if Token <> DoneT then begin
				CurrentSize := size;
				UpdateTextMenu
			end;
	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];
				UpdateTextMenu
			end;
	end;


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


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


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


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


	procedure CaptureOneFrame;
	begin
		if FrameGrabber <> QuickCapture then
			MacroError('DT2255 frame grabber not installed')
		else begin
				StartDigitizing;
				CaptureAndDisplayQCFrame;
				StopDigitizing;
			end;
	end;


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


	procedure DoSetPalette;
		var
			PaletteType: str255;
			ok: boolean;
	begin
		PaletteType := GetStringArg;
		if token <> DoneT then begin
				MakeLowerCase(PaletteType);
				if pos('gray', PaletteType) <> 0 then
					ResetGrayMap
				else if pos('pseudo', PaletteType) <> 0 then
					UpdateColors
				else if pos('system', PaletteType) <> 0 then
					ok := LoadCLUTResource(AppleDefaultCLUT)
				else if pos('spectrum', PaletteType) <> 0 then
					Load256ColorCLUT;
			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 not result then
					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;
				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;
			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:integer)}
		var
			width, height: integer;
			offset: LongInt;
	begin
		GetLeftParen;
		width := GetInteger;
		GetComma;
		height := GetInteger;
		GetComma;
		offset := GetInteger;
		GetRightParen;
		if (width < 0) or (width > MaxPicSize) or (height < 0) or (offset < 0) then
			MacroError('Argument out of range');
		if Token <> DoneT then begin
				ImportCustomWidth := width;
				ImportCustomHeight := height;
				ImportCustomOffset := offset;
				WhatToImport := ImportCustom;
			end;
	end;


	procedure SelectPic; {(WindowID:integer)}
		var
			WindowID: integer;
			SaveCommand: CommandType;
	begin
		SaveCommand := MacroCommand;
		GetLeftParen;
		WindowID := GetInteger;
		if (WindowID < 1) or (WindowID > nPICS) then
			MacroError('Invalid window ID');
		GetRightParen;
		if Token <> DoneT then begin
				if SaveCommand = SelectPicC then begin
						StopDigitizing;
						SaveRoi;
						DisableDensitySlice;
						SelectWindow(PicWindow[WindowID]);
						Info := pointer(WindowPeek(PicWindow[WindowID])^.RefCon);
						ActivateWindow;
					end
				else
					Info := pointer(WindowPeek(PicWindow[WindowID])^.RefCon);
			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 <> QuickCaptureType then
							PictureType := NewPicture;
						UpdateWindowsMenuItem(ImageSize, title, PicNum);
					end;
				ShowMagnification;
			end;
	end;


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


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


	procedure DoExport;
		var
			name: str255;
			RefNum: integer;
	begin
		StopDigitizing;
		name := info^.title;
		if (name = 'Untitled') or (name = 'Camera') then
			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
				p1.h := CurrentX;
				p1.v := CurrentY;
				CurrentX := p2.h;
				CurrentY := p2.v;
				OffscreenToScreen(p1);
				OffscreenToScreen(p2);
				DrawObject(LineObj, p1, p2);
				x1 := -1;
				y1 := -1;
				x2 := -1;
				y2 := -1;
			end;
	end;


	procedure DoGetLine;  {(var x1,y1,x2,y2,LineWidth:integer)}
		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 Token <> DoneT then
			with MacrosP^ do begin
					stack[loc1].value := x1;
					stack[loc2].value := y1;
					stack[loc3].value := x2;
					stack[loc4].value := y2;
					stack[loc5].value := LineWidth;
				end;
	end;


	procedure SetChannel; {(channel:integer)}
		var
			channel: integer;
	begin
		GetLeftParen;
		channel := GetInteger;
		GetRightParen;
		if (channel < 0) or (channel > 3) then
			MacroError('Bad channel number')
		else
			VideoChannel := channel;
	end;


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


	procedure SetPlotScale; {(min,max:integer)}
		var
			min, max: extended;
	begin
		GetLeftParen;
		min := GetExpression;
		GetComma;
		max := GetExpression;
		GetRightParen;
		if not info^.calibrated 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 := mean^[mCount];
					stack[loc3].value := mode^[mCount];
					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;
				DoMath;
				exit(DoPasteOperation);
			end;
		case MacroCommand of
			AndC: 
				SetPasteMode(AndItem);
			OrC: 
				SetPasteMode(OrItem);
			XorC: 
				SetPasteMode(XorItem);
			ReplaceC: 
				SetPasteMode(ReplaceItem);
			BlendC: 
				SetPasteMode(BlendItem);
		end;
		KillRoi;
	end;


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


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


	procedure SetMeasurements;
		var
			index: integer;
			mtype: MeasurementTypes;
	begin
		index := ord(MacroCommand) - ord(AreaC);
		case index of
			0: 
				mtype := AreaM;
			1: 
				mtype := MeanM;
			2: 
				mtype := StdDevM;
			3: 
				mtype := xyLocM;
			4: 
				mtype := ModeM;
			5: 
				mtype := LengthM;
			6: 
				mtype := MajorAxisM;
			7: 
				mtype := MinorAxisM;
			8: 
				mtype := AngleM;
			9: 
				mtype := IntDenM;
			10: 
				mtype := MinMaxM;
		end;
		if GetBooleanArg then
			measurements := measurements + [mtype]
		else
			measurements := measurements - [mtype];
		UpdateFitEllipse;
	end;


	procedure SetPrecision; {(DigitsRightofDecimalPoint:integer)}
		var
			digits: LongInt;
	begin
		GetLeftParen;
		digits := GetInteger;
		GetRightParen;
		if (Token <> DoneT) and (digits >= 0) and (digits <= 12) then
			precision := digits;
	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;
		RangeCheck(level);
		if Token <> DoneT then
			EnableThresholding(level);
	end;


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


	procedure ClosePicWindow;
		var
			OldPicNum, NewPicNum, ignore: integer;
	begin
		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;
				Info := pointer(WindowPeek(PicWindow[NewPicNum])^.RefCon);
			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: integer;
			loc: point;
	begin
		GetLeftParen;
		loc1 := GetVar;
		GetComma;
		loc2 := GetVar;
		GetRightParen;
		if Token <> DoneT then
			with MacrosP^ do begin
					SetPort(info^.wptr);
					GetMouse(loc);
					stack[loc1].value := loc.h;
					stack[loc2].value := loc.v;
				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 ExecuteCommand;
		var
			AutoSelectAll, NewLine: boolean;
			t: FateTable;  {Needed for MakeSkeleton}
			str: str255;
	begin
		if (Info = NoInfo) and not (MacroCommand in [StartC, ShowResultsC, GetPicSizeC, PutMsgC, ExitC, CaptureC, MoveToC, BeepC, MakeNewC, SetPaletteC, SetBackC, GetRoiC, OpenC, ImportC, SetImportC, SetMinMaxC, SetCustomC, nPicsC, WaitC, SetSizeC, AreaC, DensityC, StdC, XyC, ModeC, PerimeterC, MajorC, MinorC, AngleC, IntDensityC]) 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 [AndC, OrC, XorC, BlendC, ReplaceC, AddC, SubC, MulC, DivC]) then
				KillRoi; {Terminate any pending paste operation.}
		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: 
				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: 
				AnalyzeParticles;
			ConvolveC: 
				DoConvolve;
			NextC: 
				GetNextWindow;
			MarkC: 
				MarkSelection(mCount);
			MeasureC: 
				Measure;
			MakeBinC: 
				MakeBinary;
			DitherC: 
				Filter(Dither, 0, t);
			SmoothC: 
				if OptionKeyWasDown then
					Filter(UnweightedAvg, 0, t)
				else
					Filter(WeightedAvg, 0, t);
			SharpenC: 
				Filter(fsharpen, 0, t);
			ShadowC: 
				Filter(fshadow, 0, t);
			TraceC: 
				Filter(EdgeDetect, 0, t);
			ReduceC: 
				Filter(ReduceNoise, 0, t);
			RedirectC: 
				RedirectSampling := GetBooleanArg;
			ThresholdC: 
				SetThreshold;
			ResetgmC: 
				ResetGrayMap;
			WaitC: 
				DoWait;
			ResetmC: 
				ResetCounter;
			SetSliceC: 
				SetDensitySlice;
			UndoC: 
				DoUndo;
			SetForeC, SetBackC: 
				SetColor;
			HistoC: 
				begin
					DoHistogram;
					DrawHistogram;
				end;
			EnhanceC: 
				EnhanceContrast;
			EqualizeC: 
				EqualizeHistogram;
			ErodeC: 
				DoErosion;
			DilateC: 
				DoDilation;
			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: 
				begin
					NewLine := MacroCommand <> WriteC;
					GetArguments(str);
					if token <> DoneT then
						DoDrawText(str, NewLine);
				end;
			SetFontC: 
				SetFont;
			SetFontSizeC: 
				SetFontSize;
			SetTextC: 
				SetText;
			DrawNumC: 
				DrawNumber;
			ExitC: 
				token := DoneT;
			GetPicSizeC: 
				GetPicSize;
			PutMsgC: 
				DoPutMessage;
			GetRoiC: 
				GetRoi;
			MakeNewC: 
				DoMakeNewWindow;
			DrawScaleC: 
				if info^.RoiShowing then begin
						DrawScale;
						UpdatePicWindow
					end
				else
					MacroError('No Selection');
			SetPaletteC: 
				DoSetPalette;
			OpenC, ImportC: 
				DoOpenImage;
			SetImportC: 
				SetImportAttributes;
			SetMinMaxC: 
				SetImportMinMax;
			SetCustomC: 
				SetCustomImport;
			SelectPicC, ChoosePicC: 
				SelectPic;
			SetPicNameC: 
				SetPicName;
			ApplyLutC: 
				ApplyLookupTable;
			SetSizeC: 
				SetNewSize;
			SaveC: 
				begin
					StopDigitizing;
					SaveFile;
				end;
			SaveAllC: 
				SaveAll;
			SaveAsC: 
				DoSaveAs;
			CopyResultsC: 
				DoCopyResults;
			CloseC, DisposeC: 
				ClosePicWindow;
			DisposeAllC: 
				DisposeAll;
			DupC: 
				DoDuplicate;
			GetInfoC: 
				GetInfo;
			PrintC: 
				Print(false);
			LineToC: 
				DoLineTo;
			GetLineC: 
				DoGetLine;
			ShowPasteC: 
				if PasteControl = nil then
					ShowPasteControl
				else
					BringToFront(PasteControl);
			ChannelC: 
				SetChannel;
			ColumnC: 
				ColumnAveragePlot;
			ScaleC, ScaleSelectionC: 
				DoScaleAndRotate;
			SetOptionC: 
				DoOption := true;
			SetLabelsC: 
				DrawPlotLabels := GetBooleanArg;
			SetScaleC: 
				SetPlotScale;
			SetDimC: 
				SetPlotDimensions;
			GetResultsC: 
				GetResults;
			AndC, OrC, XorC, BlendC, ReplaceC, AddC, SubC, MulC, DivC: 
				DoPasteOperation;
			ScaleMathC: 
				ScaleArithmetic := GetBooleanArg;
			InvertYC: 
				InvertYCoordinates := GetBooleanArg;
			SetWidthC: 
				SetLineWidth;
			ShowResultsC: 
				begin
					ShowMeasurements;
					UpdateList
				end;
			StartC: 
				StartDigitizing;
			StopC: 
				StopDigitizing;
			CaptureC: 
				CaptureOneFrame;
			GetRowC, PutRowC, GetColumnC, PutColumnC: 
				GetOrPutLineOrColumn;
			PlotXYZC: 
				PlotXYZ;
			IncludeC: 
				IncludeHoles := GetBooleanArg;
			AutoC: 
				WandAutoMeasure := GetBooleanArg;
			AreaC, DensityC, StdC, XyC, ModeC, PerimeterC, MajorC, MinorC, AngleC, IntDensityC, MinMaxC: 
				SetMeasurements;
			LabelC: 
				LabelParticles := GetBooleanArg;
			OutlineParticlesC: 
				OutlineParticles := GetBooleanArg;
			IgnoreC: 
				IgnoreParticlesTouchingEdge := GetBooleanArg;
			AdjustC: 
				WandAdjustAreas := GetBooleanArg;
			SetParticleSizeC: 
				SetParticleSize;
			SetPrecisionC: 
				SetPrecision;
			PutPixelC: 
				DoPutPixel;
			ScalingOptionsC: 
				SetScaling;
			ExportC: 
				DoExport;
			ChangeC: 
				DoChangeValues;
			UpdateResultsC: 
				begin
					ShowResults;
					DeleteLines(mCount, mCount);
					AppendResults;
				end;
			TileC: 
				TileWindows;
			SetMajorC: 
				begin
					GetArguments(str);
					MajorLabel := str;
					Measurements := Measurements + [MajorAxisM];
					ShowResults;
				end;
			SetMinorC: 
				begin
					GetArguments(str);
					MinorLabel := str;
					Measurements := Measurements + [MinorAxisM];
					ShowResults;
				end;
			GetMouseC: 
				DoGetMouse;
		end; {case}
		OptionKeyWasDown := false;
	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;
			end;
	end;


	procedure DoDeclarations;
	begin
		if token = SemiColon then
			GetToken;
		if token = VarT then begin
				GetToken;
				while ((token = UnknownIdentifier) or (token = Variable)) and (Token <> DoneT) do
					DoDeclaration(false);
				CheckForReservedWord;
			end;
	end;


	procedure SkipStatement (Statement: TokenType);
		var
			count: integer;
	begin
		GetToken;
		if token = beginT then begin
				count := 1;
				repeat
					GetToken;
					case token of
						beginT: 
							count := count + 1;
						endT: 
							count := count - 1;
						DoneT: 
							begin
								MacroError('"end" expected');
								exit(SkipStatement);
							end;
						otherwise
					end; {case}
				until count = 0;
			end
		else begin
				while (token <> SemiColon) and (token <> endT) and not ((Statement = IfT) and (token = ElseT)) do begin
						GetToken;
						if token = DoneT then begin
								MacroError('";"  or "end" expected');
								exit(SkipStatement);
							end;
					end; {while}
				PutTokenBack;
			end;
	end;


	procedure DoCapture;
	begin
		CaptureAndDisplayQCFrame;
		if ContinuousHistogram then
			ShowContinuousHistogram;
	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
			SkipStatement(ForT)
		else
			for i := StartValue to EndValue do
				with MacrosP^ do begin
						Stack[StackLoc].value := i;
						pc := SavePC;
						GetToken;
						DoStatement;
						if Token = DoneT then
							leave;
						if Digitizing then
							DoCapture;
					end;
	end;


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


	procedure DoIf;
		var
			isTrue: boolean;
	begin
		isTrue := GetBoolean;
		GetToken;
		if token <> ThenT then
			MacroError('"then" expected');
		if isTrue then begin
				GetToken;
				DoStatement
			end
		else
			SkipStatement(IfT);
		GetToken;
		if token = elseT then begin
				if isTrue then
					SkipStatement(NullT)
				else begin
						GetToken;
						DoStatement;
					end;
			end
		else
			PutTokenBack;
	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
				SkipStatement(WhileT);
			if Digitizing then
				DoCapture;
		until not isTrue or (Token = DoneT);
	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;
				end;
			if token <> untilT then
				MacroError('"until" expected');
			isTrue := GetBoolean;
			if Digitizing then
				DoCapture;
		until isTrue or (Token = DoneT);
	end;


	procedure PushArguments (var nArgs: integer);
		var
			arg: array[1..MaxArgs] of extended;
			i: integer;
			TempName: SymbolType;
	begin
		nArgs := 1;
		Arg[nArgs] := GetExpression;
		GetToken;
		while token = comma do begin
				if nArgs < MaxArgs then
					nArgs := nArgs + 1
				else
					MacroError('Too many arguments');
				arg[nArgs] := GetExpression;
				GetToken;
			end;
		if token <> RightParen then
			MacroError(RightParenExpected);
		for i := 1 to nArgs do begin
				if TopOfStack < MaxStackSize then
					TopOfStack := TopOfStack + 1
				else
					MacroError(StackOverflow);
				with MacrosP^.stack[TopOfStack] do begin
						vType := RealVar;
						value := arg[i];
					end;
			end;
	end;


	procedure DoProcedure;
		var
			SavePC, SavePCStart, SaveStackLoc, nArgs, i: integer;
			SaveProcName: SymbolType;
	begin
		SavePCStart := PCStart;
		PCStart := TokenLoc;
		SaveProcName := ProcName;
		ProcName := TokenSymbol;
		SaveStackLoc := TopOfStack;
		GetToken;
		if token = LeftParen then
			PushArguments(nArgs)
		else begin
				nArgs := 0;
				PutTokenBack;
			end;
		SavePC := pc;
		pc := pcStart;
		if nArgs > 0 then begin
				GetLeftParen;
				i := 0;
				GetToken;
				while token in [UnknownIdentifier, Variable, comma, colon, SemiColon, RealT, IntegerT] do begin
						if (token = UnknownIdentifier) or (token = Variable) then begin
								if i < nArgs then
									i := i + 1
								else
									MacroError('Too many arguments');
								MacrosP^.stack[SaveStackLoc + i].symbol := TokenSymbol;
							end;
						GetToken;
					end;
				if Token = VarT then
					MacroError('VAR parameters not supported');
				if i < nArgs then
					MacroError('Too few arguments');
				if token <> RightParen then
					MacroError(RightParenExpected);
			end;
		GetToken;
		if (token = LeftParen) and (nArgs = 0) then
			MacroError('Arguments not expected');
		DoDeclarations;
		DoCompoundStatement;
		pc := SavePC;
		TopOfStack := SaveStackLoc;
		pcStart := SavePCStart;
		ProcName := SaveProcName;
	end;


	procedure DoArrayAssignment;
		var
			SaveCommand: CommandType;
			index: LongInt;
	begin
		SaveCommand := MacroCommand;
		GetToken;
		if token <> LeftBracket then
			MacroError('"[" expected');
		Index := GetInteger;
		GetToken;
		if token <> RightBracket then
			MacroError('"]" expected');
		GetToken;
		if token <> AssignOp then
			MacroError('":=" expected');
		CheckIndex(index, 1, MaxRegions);
		if token <> DoneT then
			case SaveCommand of
				rAreaC: 
					mArea^[Index] := GetInteger;
				rMeanC: 
					mean^[Index] := GetExpression;
				rXC: 
					xcenter^[Index] := GetExpression;
				rYC: 
					ycenter^[Index] := GetExpression;
				rLengthC: 
					plength^[Index] := GetExpression;
				rMinC: 
					mMin^[Index] := GetExpression;
				rMaxC: 
					mMax^[Index] := GetExpression;
				rMajorC: 
					MajorAxis^[Index] := GetExpression;
				rMinorC: 
					MinorAxis^[Index] := GetExpression;
				rAngleC: 
					orientation^[Index] := GetExpression;
				otherwise
					MacroError('Read-only array');
			end; {case}
	end;


	procedure DoStatement;
	begin
		case token of
			BeginT: 
				DoCompoundStatement;
			CommandT: 
				ExecuteCommand;
			ForT: 
				DoFor;
			IfT: 
				DoIf;
			WhileT: 
				DoWhile;
			RepeatT: 
				DoRepeat;
			UnknownIdentifier: 
				MacroError('Undefined identifier');
			Variable: 
				DoAssignment;
			ArrayT: 
				DoArrayAssignment;
			ProcedureT: 
				DoProcedure;
			ElseT: 
				MacroError('Statement expected');
			otherwise
		end;
		if CommandPeriod or not macro then begin
				Token := DoneT;
				KillRoi;
				if macro then
					beep;
			end;
	end;


	procedure RunMacro (nMacro: integer);
		var
			count: integer;
			str: str255;
			SaveInfo: InfoPtr;
	begin
		if nPics > 0 then
			with info^ do {Activate image window so Copy won't fail.}
				if FrontWindow <> wptr then
					if wptr <> nil then
						SelectWindow(wptr);
		DefaultFileName := '';
		str := '';
		nSaves := 0;
		count := 0;
		pcStart := MacroStart[nMacro];
		pc := pcStart;
		SavePC := pcStart;
		token := NullT;
		macro := true;
		DoOption := false;
		SaveInfo := info;
		TopOfStack := nGlobals;
		ProcName := BlankSymbol;
		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
			UpdatePicWindow;
		macro := false;
	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.