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
		Memory, QuickDraw, Packages, Menus, Events, Fonts, Scrap, ToolUtils,Resources, Errors, Palettes, ColorPicker, Globals, Utilities, RealUtils, Graphics, Edit, {}
		Analysis, Camera, File1, File2, Filters, Macros2, Stacks, Lut, Background, {}
		User, Devices, Serial, PlugIns, Text, projection, math, fft; {,UMacroDef, UMacroRun}


	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;


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


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


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


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


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


	procedure GetArguments (var str: str255);
		var
			width, fwidth: integer;
			i: LongInt;
			isExpression, ZeroFill, noArgs, notFormatted: boolean;
			n: extended;
			str2: str255;
	begin
		if MacroCommand = WritelnC then begin {Check for Writeln with no arguments}
				GetToken;
				noArgs := token <> LeftParen;
				PutTokenBack;
				if NoArgs then begin
						str := '';
						exit(GetArguments);
					end;
			end;
		ZeroFill := not (MacroCommand in [DrawTextC, WriteC, WritelnC, PutMsgC, ShowMsgC, PutSerialC, ConcatC]);
		width := 4;
		fwidth := 0;
		str := '';
		GetLeftParen;
		GetToken;
		repeat
			isExpression := token in [Variable, NumericLiteral, FunctionT, UserFuncT, TrueT, FalseT, ArrayT, MinusOp, LeftParen];
			notFormatted := true;
			PutTokenBack;
			if isExpression then
				n := GetBooleanExpression
			else
				str2 := GetString;
			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;


	procedure DoUserToken;
	begin
		MacroError('UMX package not installed');
	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 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;
			otherwise
				MacroError('"GetString ", "GetSerial" or "chr" expected');
		end;
	end;


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


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


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


	function GetBoolean: boolean;
		var
			value: extended;
	begin
		value := 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; [precision:integer])}
		var
			prompt: str255;
			default, n: extended;
			Canceled, OptionalArgument: boolean;
	begin
		GetLeftParen;
		prompt := GetString;
		GetComma;
		default := GetExpression;
		GetToken;
		OptionalArgument := token <> RightParen;
		PutTokenBack;
		if OptionalArgument then begin
				GetComma;
				precision := GetInteger;
				if precision < 0 then
					precision := 0;
				if precision > 5 then
					precision := 5;
		end else
				precision := 2;
		GetRightParen;
		n := 0.0;
		if Token <> DoneT then begin
				n := GetReal(prompt, default, precision, 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: integer;
	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('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;
			UserFuncT:  begin
					DoUserToken;{output in TokenValue}
					GetValue := TokenValue;
				end;
			UserStrFuncT:  begin
					DoUserToken; {output in TokenStr}
					GetValue := GetStringValue;
				end;
			TrueT: 
				GetValue := ord(true);
			FalseT: 
				GetValue := ord(false);
			ArrayT: 
				GetValue := GetArrayValue;
			StringVariable, StringLiteral: 
				GetValue := GetStringValue;
			otherwise begin
					MacroError('Number expected');
					GetValue := 0.0;
					exit(GetValue);
				end;
		end; {case}
	end;


	function GetFactor: extended;
		var
			fValue: extended;
			isUnaryMinus, isNot: boolean;
	begin
		GetToken;
		isUnaryMinus := token = MinusOp;
		isNot := token = NotOp;
		if isUnaryMinus or isNot then
			GetToken;
		case token of
			Variable, NumericLiteral, FunctionT, StringFunctionT, UserFuncT, 
			UserStrFuncT, TrueT, FalseT, ArrayT, StringVariable, StringLiteral: 
				fValue := GetValue;
			LeftParen:  begin
					fValue := 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) 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: integer;
			SaveCommand: CommandType;
	begin
		SaveCommand := MacroCommand;
		GetLeftParen;
		PicN := GetInteger;
		GetRightParen;
		i := 0;
		while (PicN < 0) and (i < nPics) do begin
				i := i + 1;
				if InfoPtr(WindowPeek(PicWindow[i])^.RefCon)^.pidNum = PicN then
					PicN := i;
			end;
		if (PicN < 1) or (PicN > nPics) then
			MacroError('Specified image does not exist');
		if Token <> DoneT then begin
				if SaveCommand = SelectPicC then
					SelectImage(PicN)
				else begin
						StopDigitizing;
						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 < 8 then
					NewPicHeight := 8;
				if NewPicHeight > MaxPicSize then
					NewPicHeight := MaxPicSize;
			end;
	end;


	procedure DoSaveAs;
		var
			name: str255;
			RefNum: integer;
			HasArgs: boolean;
	begin
		name := info^.title;
		if (name = 'Untitled') or (name = 'Camera') then
			name := '';
		GetToken;
		HasArgs := token = LeftParen;
		PutTokenBack;
		if HasArgs then
			GetArguments(name);
		if token <> DoneT then begin
				StopDigitizing;
				if nSaves = 0 then
					RefNum := 0
				else
					RefNum := DefaultRefNum;
				case CurrentWindow of
					TextKind: 
						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 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);
				SetRect(MaskRect, hloc, vloc, hloc + 1, vloc + 1);
				UpdateScreen(MaskRect);
				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;
	begin
		GetLeftParen;
		x := GetInteger;
		GetComma;
		y := GetInteger;
		GetComma;
		count := GetInteger;
		GetRightParen;
		if (Token <> DoneT) and (count <= MaxLine) then
			with MacrosP^ do begin
					KillRoi;
					case MacroCommand of
						GetRowC: 
							GetLine(x, y, count, aLine);
						PutRowC:  begin
								PutLine(x, y, count, aLine);
								SetRect(MaskRect, x, y, x + count, y + 1);
								UpdateScreen(MaskRect);
								info^.changes := true;
							end;
						GetColumnC: 
							GetColumn(x, y, count, aLine);
						PutColumnC:  begin
								PutColumn(x, y, count, aLine);
								SetRect(MaskRect, x, y, x + 1, y + count);
								UpdateScreen(MaskRect);
								info^.changes := true;
							end;
					end; {case}
				end;
	end;


	procedure CheckVersion; {(RequiredVersion:real)}
		var
			RequiredVersion: 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);
{Begin Scion}
					{PutError(concat('This macro requires version ', str, ' or later of NIH Image.'));}
					PutError(concat('This macro requires version ', str, ' or later of Scion Image.'));
{End Scion}
					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
				LoadLUT(ctable);
				IdentityFunction := false;
				if isGrayScaleLUT then
					LutMode := CustomGrayScale
				else begin
						SetupPseudocolor;
						LutMode := PseudoColor;
					end;
				UpdateMap;
			if ScreenDepth<>8 then
			 	UpdatePicWindow;
			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('paint', mode) <> 0 then
					SaveAsWhat := asMacPaint;
				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 := chr(17);
				xOff := chr(19);
				errs := 0;
				evts := 0;
				fInX := ord(true);  {Enable xon/xoff input flow control}
				fDTR := ord(true); {Enable DTR (input) flow control}
			end;
		Config := baud + data + stop + parity;
		Err := SerHShake(SerialOut, flags);
		Err := SerSetBuf(SerialIn, SerialBufferP, SerialBufferSize);
		Err := SerReset(SerialOut, Config);
	end;


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


	procedure DoSetCursor; {str: string}
		var
			str: str255;
	begin
		str := GetStringArg;
		if Token <> DoneT then begin
				MakeLowerCase(str);
				if pos('watch', str) <> 0 then
					SetCursor(watch);
				if pos('cross', str) <> 0 then
					SetCursor(ToolCursor[SelectionTool]);
				if pos('arrow', str) <> 0 then
					InitCursor;
				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);
{Begin Scion}
				SetOption(VideoRateMathID, VideoRateMath, pos('math', options) <> 0);
				SetOption(VideoRateBlankID, VideoRateBlank, pos('blank', options) <> 0);
				SetOption(VideoPassID, VideoPass, pos('pass', options) <> 0);
{End Scion}
				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;


{Begin Scion}
	procedure VideoMath; {('op',pic1,gain,offset)}
		const
			AG5LutOffset = $80000;
		var
			op: str255;
			pic1, offset: LongInt;
			gain: extended;
			SrcInfo: InfoPtr;
	begin
    if FrameGrabber <> ScionAG5 then begin
        MacroError('Live Video Math requires a Scion AG-5.');
        exit(VideoMath);
      end;
		GetLeftParen;
		op := GetString;
		GetComma;
		pic1 := GetInteger;
		GetComma;
		gain := GetExpression;
		GetComma;
		offset := GetInteger;
		GetRightParen;
		if token <> DoneT then begin
				MakeLowerCase(op);
				if pos('add', op) <> 0 then
					CurrentVideoMathOp := AddVideoMath;
				if pos('sub', op) <> 0 then
					CurrentVideoMathOp := SubVideoMath;
				if pos('mul', op) <> 0 then
					CurrentVideoMathOp := MulVideoMath;
				if pos('div', op) <> 0 then
					CurrentVideoMathOp := DivVideoMath;
				if pos('and', op) <> 0 then
					CurrentVideoMathOp := AndVideoMath;
				if pos('or', op) <> 0 then
					CurrentVideoMathOp := OrVideoMath;
				if pos('xor', op) <> 0 then
					CurrentVideoMathOp := XorVideoMath;
				if pos('max', op) <> 0 then
					CurrentVideoMathOp := MaxVideoMath;
				if pos('min', op) <> 0 then
					CurrentVideoMathOp := MinVideoMath;
				VideoMathGain := gain;
				VideoMathOffset := offset;
				VideoMathSrc := pic1;
				
				if not VideoRateBlankValid or not VideoRateBlank then begin
						SrcInfo := GetInfoPtr(VideoMathSrc);
						with SrcInfo^ do begin
								if (PicRect.right - PicRect.left <> fgWidth) or (PicRect.bottom - PicRect.top <> fgHeight) then begin
										if fgwidth = 640 then
									    MacroError('Source image must be 640 x 480 pixels.')
										else
											MacroError('Source image must be 768 x 512 pixels.');
										exit(VideoMath);
									end;
							end;
						DoVideoMath(false);
					end;
			end;  {end token <> DoneT}
	end;   {end VideoMath}
{End Scion}



  	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: 
				token := DoneT;
			GetPicSizeC: 
				GetPicSize;
			PutMsgC: 
				DoPutMessage;
			GetRoiC: 
				GetRoi;
			MakeNewC: 
				DoMakeNewWindow;
			DrawScaleC: 
				if info^.RoiShowing then begin
						DrawScale;
						UpdatePicWindow
					end
				else
					MacroError('No Selection');
			SetPaletteC: 
				DoSetPalette;
			OpenC, ImportC: 
				DoOpenImage;
			SetImportC: 
				SetImportAttributes;
			SetMinMaxC: 
				SetImportMinMax;
			SetCustomC: 
				SetCustomImport;
			SelectPicC, ChoosePicC: 
				SelectPic;
			SetPicNameC: 
				SetPicName;
			ApplyLutC: 
				ApplyLookupTable;
			SetSizeC: 
				SetNewSize;
			SaveC: 
				DoSave;
			SaveAllC: 
				SaveAll;
			SaveAsC: 
				DoSaveAs;
			CopyResultsC: 
				DoCopyResults;
			CloseC, DisposeC: 
				CloseWindow;
			DisposeAllC: 
				DisposeAll;
			DupC: 
				DoDuplicate;
			GetInfoC: 
				GetInfo;
			PrintC: 
				DoPrint;
			LineToC: 
				DoLineTo;
			GetLineC: 
				DoGetLine;
			ShowPasteC: 
				if PasteControl = nil then
					ShowPasteControl
				else
					BringToFront(PasteControl);
			ChannelC: 
				SetChannel;
			ColumnC, PlotProfileC:  begin
					PlotDensityProfile;
					if PlotWindow <> nil then
						UpdatePlotWindow;
				end;
			ScaleC, ScaleSelectionC: 
				DoScaleAndRotate;
			SetOptionC: 
				DoOption := true;
			SetLabelsC: 
				DrawPlotLabels := GetBooleanArg;
			SetPlotScaleC: 
				SetPlotScale;
			SetDimC: 
				SetPlotDimensions;
			GetResultsC: 
				GetResults;
			CopyModeC, AndC, OrC, XorC, BlendC, ReplaceC, AddC, SubC, MulC, DivC: 
				DoPasteOperation;
			ScaleMathC: 
				ScaleArithmetic := GetBooleanArg;
			InvertYC: 
				InvertYCoordinates := GetBooleanArg;
			SetWidthC: 
				SetWidth;
			ShowResultsC:  begin
					ShowResults;
					UpdateList
				end;
			StartC: 
				StartDigitizing;
			StopC: 
				StopDigitizing;
			CaptureC: 
				CaptureOneFrame;
			GetRowC, PutRowC, GetColumnC, PutColumnC: 
				GetOrPutLineOrColumn;
			PlotXYZC: 
				PlotXYZ;
			IncludeC: 
				IncludeHoles := GetBooleanArg;
			AutoC: 
				WandAutoMeasure := GetBooleanArg;
			LabelC: 
				LabelParticles := GetBooleanArg;
			OutlineParticlesC: 
				OutlineParticles := GetBooleanArg;
			IgnoreC: 
				IgnoreParticlesTouchingEdge := GetBooleanArg;
			AdjustC: 
				WandAdjustAreas := GetBooleanArg;
			SetParticleSizeC: 
				SetParticleSize;
			SetPrecisionC: 
				SetPrecision;
			PutPixelC: 
				DoPutPixel;
			ScalingOptionsC: 
				SetScaling;
			SetExportC: 
				SetExportMode;
			ExportC: 
				DoExport;
			ChangeC: 
				DoChangeValues;
			UpdateResultsC:  begin
					ShowInfo;
					DeleteLines(mCount, mCount);
					AppendResults;
				end;
			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: 
				AverageSlices;
			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;
{Begin Scion}
			PrintVideoC: 
				PrintVideo;
			VideoMathC: 
				VideoMath;
{End Scion}
		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, 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 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;
		SaveProcName := MacroOrProcName;
		MacroOrProcName := NewProcName;
		SavePC := pc;
		pc := pcStart;
		if nArgs > 0 then begin
				GetLeftParen;
				i := 0;
				GetToken;
				while token in [Identifier, Variable, StringVariable, comma, colon, SemiColon, RealT, IntegerT, BooleanT, StringT] do begin
						if (token = Identifier) or (token = Variable) or (token = StringVariable) then begin
								if i < nArgs then
									i := i + 1
								else
									MacroError('Too many formal arguments');
								MacrosP^.stack[SaveStackLoc + i].SymbolTableIndex := SymbolTableloc;
							end;
						GetToken;
					end;
				if Token = VarT then
					MacroError('VAR parameters not supported');
				if i < nArgs then
					MacroError('Too few formal arguments');
				if token <> RightParen then
					MacroError(RightParenExpected);
			end;
		GetToken;
		if (token = LeftParen) and (nArgs = 0) then
			MacroError('Arguments not expected');
		DoDeclarations;
		DoCompoundStatement;
		pc := SavePC;
		if StringsAllocated then
			DeallocateStrings(SaveStackLoc + 1, TopOfStack);
		StringsAllocated := SaveStringsAllocated;
		TopOfStack := SaveStackLoc;
		pcStart := SavePCStart;
		MacroOrProcName := SaveProcName;
	end;


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


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


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



	procedure RunMacro (nMacro: integer);
		var
			count: integer;
			str: str255;
			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.