unit Macros2; {Loads macro files into memory and converts them into a token stream} {that is interpreted by the routines in macros1.p.} interface uses Memory, QuickDraw, Packages, Menus, Events, Fonts, Scrap, ToolUtils,Resources, Errors, Palettes, Globals, Utilities, Graphics, File2;{} {,UMacroDef, UMacroRun;} procedure LoadMacrosFromFile (fname: str255; RefNum: integer); procedure LoadMacros; implementation type MacroBufType = packed array[0..MaxMacroFileSize] of char; MacroBufPtr = ^MacroBufType; var PC2, StartOfLine: integer; MacroBufP: MacroBufPtr; procedure InitSymbolTable; var i: integer; begin with MacrosP^ do begin for i := 1 to MaxSymbols do with SymbolTable[i] do begin tType := CommandT; cType := NullC; loc := 0; end; with SymbolTable[1] do begin symbol := 'begin '; tType := BeginT; end; with SymbolTable[2] do begin symbol := 'convolve '; cType := ConvolveC; end; with SymbolTable[3] do begin symbol := 'fill '; cType := FillC; end; with SymbolTable[4] do begin symbol := 'selectall '; cType := SelectC; end; with SymbolTable[5] do begin symbol := 'invert '; cType := InvertC; end; with SymbolTable[6] do begin symbol := 'killroi '; cType := KillC; end; with SymbolTable[7] do begin symbol := 'markselectio'; cType := MarkC; end; with SymbolTable[8] do begin symbol := 'drawboundary'; cType := FrameC; end; with SymbolTable[9] do begin symbol := 'measure '; cType := MeasureC; end; with SymbolTable[10] do begin symbol := 'fliphorizont'; cType := FliphC; end; with SymbolTable[11] do begin symbol := 'analyzeparti'; cType := AnalyzeC; end; with SymbolTable[12] do begin symbol := 'nextwindow '; cType := NextC; end; with SymbolTable[13] do begin symbol := 'paste '; cType := PasteC; end; with SymbolTAble[14] do begin symbol := 'clear '; cType := ClearC; end; with SymbolTable[15] do begin symbol := 'copy '; cType := CopyC; end; with SymbolTable[16] do begin symbol := 'restoreroi '; cType := RestoreC; end; with SymbolTable[17] do begin symbol := 'setthreshold'; cType := ThresholdC; end; with SymbolTable[18] do begin symbol := 'resetgraymap'; cType := ResetgmC; end; with SymbolTable[19] do begin symbol := 'makebinary '; cType := MakeBinC; end; with SymbolTable[20] do begin symbol := 'dither '; cType := DitherC; end; with SymbolTable[21] do begin symbol := 'smooth '; cType := SmoothC; end; with SymbolTable[22] do begin symbol := 'scalemath '; cType := ScaleMathC; end; with SymbolTable[23] do begin symbol := 'sharpen '; cType := SharpenC; end; with SymbolTable[24] do begin symbol := 'inverty '; cType := InvertYC; end; with SymbolTable[25] do begin symbol := 'calibrated '; tType := FunctionT; cType := CalibratedC; end; with SymbolTable[26] do begin symbol := 'divide '; cType := DivC; end; with SymbolTable[27] do begin symbol := 'redirect '; cType := RedirectC; end; with SymbolTable[28] do begin symbol := 'getresults '; cType := GetResultsC; end; with SymbolTable[29] do begin symbol := 'wait '; cType := WaitC; end; with SymbolTable[30] do begin symbol := 'resetcounter'; cType := ResetmC; end; with SymbolTable[31] do begin symbol := 'setdensitysl'; cType := SetSliceC; end; with SymbolTable[32] do begin symbol := 'undo '; cType := UndoC; end; with SymbolTable[33] do begin symbol := 'setforegroun'; cType := SetForeC; end; with SymbolTable[34] do begin symbol := 'setbackgroun'; cType := SetBackC; end; with SymbolTable[35] do begin symbol := 'scaleandrota'; cType := ScaleC; end; with SymbolTable[36] do begin symbol := 'rotateright '; cType := RotateRC; end; with SymbolTable[37] do begin symbol := 'rotateleft '; cType := RotateLC; end; with SymbolTable[38] do begin symbol := 'traceedges '; cType := TraceC; end; with SymbolTable[39] do begin symbol := 'multiply '; cType := MulC; end; with SymbolTable[40] do begin symbol := 'showhistogra'; cType := HistoC; end; with SymbolTable[41] do begin symbol := 'enhancecontr'; cType := EnhanceC; end; with SymbolTable[42] do begin symbol := 'equalizehist'; cType := EqualizeC; end; with SymbolTable[43] do begin symbol := 'erode '; cType := ErodeC; end; with SymbolTable[44] do begin symbol := 'dilate '; cType := DilateC; end; with SymbolTable[45] do begin symbol := 'outline '; cType := OutlineC; end; with SymbolTable[46] do begin symbol := 'skeletonize '; cType := ThinC; end; with SymbolTable[47] do begin symbol := 'addconstant '; cType := AddConstC; end; with SymbolTable[48] do begin symbol := 'reverttosave'; cType := RevertC; end; with SymbolTable[49] do begin symbol := 'shadow '; cType := ShadowC; end; with SymbolTable[50] do begin symbol := 'flipvertical'; cType := FlipvC; end; with SymbolTable[51] do begin symbol := 'end '; tType := EndT; end; with SymbolTable[52] do begin symbol := 'getline '; cType := GetLineC; end; with SymbolTable[53] do begin symbol := 'var '; tType := VarT; end; with SymbolTable[54] do begin symbol := 'for '; tType := ForT; end; with SymbolTable[55] do begin symbol := 'integer '; tType := IntegerT; end; with SymbolTable[56] do begin symbol := 'to '; tType := ToT; end; with SymbolTable[57] do begin symbol := 'do '; tType := DoT; end; with SymbolTable[58] do begin symbol := 'beep '; cType := BeepC; end; with SymbolTable[59] do begin symbol := 'capture '; cType := CaptureC; end; with SymbolTable[60] do begin symbol := 'makeroi '; cType := MakeC; end; with SymbolTable[61] do begin symbol := 'moveroi '; cType := MoveC; end; with SymbolTable[62] do begin symbol := 'insetroi '; cType := InsetC; end; with SymbolTable[63] do begin symbol := 'moveto '; cType := MoveToC; end; with SymbolTable[64] do begin symbol := 'drawtext '; cType := DrawTextC; end; with SymbolTable[65] do begin symbol := 'setfont '; cType := SetFontC; end; with SymbolTable[66] do begin symbol := 'setfontsize '; cType := SetFontSizeC; end; with SymbolTable[67] do begin symbol := 'settext '; cType := SetTextC; end; with SymbolTable[68] do begin symbol := 'drawnumber '; cType := DrawNumC; end; with SymbolTable[69] do begin symbol := 'or '; tType := orOp; end; with SymbolTable[70] do begin symbol := 'and '; tType := andOp; end; with SymbolTable[71] do begin symbol := 'div '; tType := IntDivOp; end; with SymbolTable[72] do begin symbol := 'mod '; tType := modOp; end; with SymbolTable[73] do begin symbol := 'getpicsize '; cType := GetPicSizeC; end; with SymbolTable[74] do begin symbol := 'putmessage '; cType := PutMsgC; end; with SymbolTable[75] do begin symbol := 'exit '; cType := ExitC; end; with SymbolTable[76] do begin symbol := 'if '; tType := ifT; end; with SymbolTable[77] do begin symbol := 'then '; tType := thenT; end; with SymbolTable[78] do begin symbol := 'else '; tType := elseT; end; with SymbolTable[79] do begin symbol := 'while '; tType := whileT; end; with SymbolTable[80] do begin symbol := 'repeat '; tType := repeatT; end; with SymbolTable[81] do begin symbol := 'until '; tType := untilT; end; with SymbolTable[82] do begin symbol := 'not '; tType := NotOp; end; with SymbolTable[83] do begin symbol := 'getroi '; cType := GetRoiC; end; with SymbolTable[84] do begin symbol := 'real '; tType := RealT; end; with SymbolTable[85] do begin symbol := 'trunc '; tType := FunctionT; cType := TruncC; end; with SymbolTable[86] do begin symbol := 'round '; tType := FunctionT; cType := RoundC; end; with SymbolTable[87] do begin symbol := 'getnumber '; tType := FunctionT; cType := GetNumC; end; with SymbolTable[88] do begin symbol := 'nop '; cType := NopC; end; with SymbolTable[89] do begin symbol := 'random '; tType := FunctionT; cType := RandomC; end; with SymbolTable[90] do begin symbol := 'makeovalroi '; cType := MakeOvalC; end; with SymbolTable[91] do begin symbol := 'drawscale '; cType := DrawScaleC; end; with SymbolTable[92] do begin symbol := 'setpalette '; cType := SetPaletteC; end; with SymbolTable[93] do begin symbol := 'makenewwindo'; cType := MakeNewC; end; with SymbolTable[94] do begin symbol := 'getpixel '; tType := FunctionT; cType := GetPixelC; end; with SymbolTable[95] do begin symbol := 'button '; tType := FunctionT; cType := ButtonC; end; with SymbolTable[96] do begin symbol := 'odd '; tType := FunctionT; cType := oddC; end; with SymbolTable[97] do begin symbol := 'abs '; tType := FunctionT; cType := absC; end; with SymbolTable[98] do begin symbol := 'sqrt '; tType := FunctionT; cType := sqrtC; end; with SymbolTable[99] do begin symbol := 'sin '; tType := FunctionT; cType := sinC; end; with SymbolTable[100] do begin symbol := 'cos '; tType := FunctionT; cType := cosC; end; with SymbolTable[101] do begin symbol := 'exp '; tType := FunctionT; cType := expC; end; with SymbolTable[102] do begin symbol := 'ln '; tType := FunctionT; cType := lnC; end; with SymbolTable[103] do begin symbol := 'arctan '; tType := FunctionT; cType := arctanC; end; with SymbolTable[104] do begin symbol := 'sqr '; tType := FunctionT; cType := sqrC; end; with SymbolTable[105] do begin symbol := 'macro '; tType := MacroT; end; with SymbolTable[106] do begin symbol := 'procedure '; tType := ProcIdT; end; with SymbolTable[107] do begin symbol := 'open '; cType := openC; end; with SymbolTable[108] do begin symbol := 'setimport '; cType := SetImportC; end; with SymbolTable[109] do begin symbol := 'import '; cType := ImportC; end; with SymbolTable[110] do begin symbol := 'setimportmin'; cType := SetMinMaxC; end; with SymbolTable[111] do begin symbol := 'setcustom '; cType := SetCustomC; end; with SymbolTable[112] do begin symbol := 'npics '; tType := FunctionT; cType := nPicsC; end; with SymbolTable[113] do begin symbol := 'selectpic '; cType := SelectPicC; end; with SymbolTable[114] do begin symbol := 'setpicname '; cType := SetPicNameC; end; with SymbolTable[115] do begin symbol := 'applylut '; cType := ApplyLutC; end; with SymbolTable[116] do begin symbol := 'multiplybyco'; cType := MulConstC; end; with SymbolTable[117] do begin symbol := 'setnewsize '; cType := SetSizeC; end; with SymbolTable[118] do begin symbol := 'save '; cType := SaveC; end; with SymbolTable[119] do begin symbol := 'saveall '; cType := SaveAllC; end; with SymbolTable[120] do begin symbol := 'saveas '; cType := SaveAsC; end; with SymbolTable[121] do begin symbol := 'copyresults '; cType := CopyResultsC; end; with SymbolTable[122] do begin symbol := 'boolean '; tType := BooleanT; end; with SymbolTable[123] do begin symbol := 'true '; tType := TrueT; end; with SymbolTable[124] do begin symbol := 'false '; tType := FalseT; end; with SymbolTable[125] do begin symbol := 'close '; cType := CloseC; end; with SymbolTable[126] do begin symbol := 'dispose '; cType := DisposeC; end; with SymbolTable[127] do begin symbol := 'disposeall '; cType := DisposeAllC; end; with SymbolTable[128] do begin symbol := 'duplicate '; cType := DupC; end; with SymbolTable[129] do begin symbol := 'getinfo '; cType := GetInfoC; end; with SymbolTable[130] do begin symbol := 'print '; cType := PrintC; end; with SymbolTable[131] do begin symbol := 'lineto '; cType := LineToC; end; with SymbolTable[132] do begin symbol := 'setplotlabel'; cType := SetLabelsC; end; with SymbolTable[133] do begin symbol := 'setplotscale'; cType := SetPlotScaleC; end; with SymbolTable[134] do begin symbol := 'setplotsize '; cType := SetDimC; end; with SymbolTable[135] do begin symbol := 'setscaling '; cType := ScalingOptionsC; end; with SymbolTable[136] do begin symbol := 'columnaverag'; cType := ColumnC; end; with SymbolTable[137] do begin symbol := 'setchannel '; cType := ChannelC; end; with SymbolTable[138] do begin symbol := 'showpastecon'; cType := ShowPasteC; end; with SymbolTable[139] do begin symbol := 'setoption '; cType := SetOptionC; end; with SymbolTable[140] do begin symbol := 'doand '; cType := AndC; end; with SymbolTable[141] do begin symbol := 'door '; cType := OrC; end; with SymbolTable[142] do begin symbol := 'doxor '; cType := XorC; end; with SymbolTable[143] do begin symbol := 'doblend '; cType := BlendC; end; with SymbolTable[144] do begin symbol := 'doreplace '; cType := ReplaceC; end; with SymbolTable[145] do begin symbol := 'add '; cType := AddC; end; with SymbolTable[146] do begin symbol := 'subtract '; cType := SubC; end; with SymbolTable[147] do begin symbol := 'setlinewidth'; cType := SetWidthC; end; with SymbolTable[148] do begin symbol := 'showresults '; cType := ShowResultsC; end; with SymbolTable[149] do begin symbol := 'startcapturi'; cType := StartC; end; with SymbolTable[150] do begin symbol := 'getrow '; cType := GetRowC; end; with SymbolTable[151] do begin symbol := 'putrow '; cType := PutRowC; end; with SymbolTable[152] do begin symbol := 'getcolumn '; cType := GetColumnC; end; with SymbolTable[153] do begin symbol := 'putcolumn '; cType := PutColumnC; end; with SymbolTable[154] do begin symbol := 'allsamesize '; tType := FunctionT; cType := SameSizeC; end; with SymbolTable[155] do begin symbol := 'cvalue '; tType := FunctionT; cType := cValueC; end; with SymbolTable[156] do begin symbol := 'plotxyz '; cType := PlotXYZC; end; with SymbolTable[157] do begin symbol := 'includeinter'; cType := IncludeC; end; with SymbolTable[158] do begin symbol := 'wandautomeas'; cType := AutoC; end; with SymbolTable[159] do begin symbol := 'labelparticl'; cType := LabelC; end; with SymbolTable[160] do begin symbol := 'outlineparti'; cType := OutlineParticlesC; end; with SymbolTable[161] do begin symbol := 'ignorepartic'; cType := IgnoreC; end; with SymbolTable[162] do begin symbol := 'adjustareas '; cType := AdjustC; end; with SymbolTable[163] do begin symbol := 'setparticles'; cType := SetParticleSizeC; end; with SymbolTable[164] do begin symbol := 'setprecision'; cType := SetPrecisionC; end; with SymbolTable[165] do begin symbol := 'imagemath '; cType := ImageMathC; end; with SymbolTable[166] do begin symbol := 'pastelive '; cType := PasteLiveC; end; with SymbolTable[167] do begin symbol := 'pidexists '; tType := FunctionT; cType := PidExistsC; end; with SymbolTable[168] do begin symbol := 'pos '; tType := FunctionT; cType := PosC; end; with SymbolTable[169] do begin symbol := 'delete '; cType := DeleteC; end; with SymbolTable[170] do begin symbol := 'length '; tType := FunctionT; cType := LengthC; end; with SymbolTable[171] do begin symbol := 'getscale '; cType := GetScaleC; end; with SymbolTable[172] do begin symbol := 'autooutline '; cType := AutoOutlineC; end; with SymbolTable[173] do begin symbol := 'filter '; cType := FilterC; end; with SymbolTable[174] do begin symbol := 'setsaveas '; cType := SetSaveAsC; end; with SymbolTable[175] do begin symbol := 'putpixel '; cType := PutPixelC; end; with SymbolTable[176] do begin symbol := 'choosepic '; cType := ChoosePicC; end; with SymbolTable[177] do begin symbol := 'write '; cType := WriteC; end; with SymbolTable[178] do begin symbol := 'writeln '; cType := WritelnC; end; with SymbolTable[179] do begin symbol := 'scaleselecti'; cType := ScaleSelectionC; end; with SymbolTable[180] do begin symbol := 'picnumber '; tType := FunctionT; cType := PicNumC; end; with SymbolTable[181] do begin symbol := 'export '; cType := ExportC; end; with SymbolTable[182] do begin symbol := 'reducenoise '; cType := ReduceC; end; with SymbolTable[183] do begin symbol := 'changevalues'; cType := ChangeC; end; with SymbolTable[184] do begin symbol := 'histogram '; tType := ArrayT; cType := CommandType(HistogramA); end; with SymbolTable[185] do begin symbol := 'scaleconvolu'; cType := ScaleConvolutionsC; end; with SymbolTable[186] do begin symbol := 'rarea '; tType := ArrayT; cType := CommandTYpe(rAreaA); end; with SymbolTable[187] do begin symbol := 'rmean '; tType := ArrayT; cType := CommandType(rMeanA); end; with SymbolTable[188] do begin symbol := 'rx '; tType := ArrayT; cType := CommandType(rXA); end; with SymbolTable[189] do begin symbol := 'ry '; tType := ArrayT; cType := CommandType(rYA); end; with SymbolTable[190] do begin symbol := 'rmin '; tType := ArrayT; cType := CommandTYpe(rMinA); end; with SymbolTable[191] do begin symbol := 'rmax '; tType := ArrayT; cType := CommandType(rMaxA); end; with SymbolTable[192] do begin symbol := 'rcount '; tType := FunctionT; cType := rCountC; end; with SymbolTable[193] do begin symbol := 'updateresult'; cType := UpdateResultsC; end; with SymbolTable[194] do begin symbol := 'stopcapturin'; cType := StopC; end; with SymbolTable[195] do begin symbol := 'tilewindows '; cType := TileC; end; with SymbolTable[196] do begin symbol := 'rlength '; tType := ArrayT; cType := CommandType(rLengthA); end; with SymbolTable[197] do begin symbol := 'rmajor '; tType := ArrayT; cType := CommandType(rMajorA); end; with SymbolTable[198] do begin symbol := 'rminor '; tType := ArrayT; cType := CommandType(rMinorA); end; with SymbolTable[199] do begin symbol := 'rangle '; tType := ArrayT; cType := CommandType(rAngleA); end; with SymbolTable[200] do begin symbol := 'setmajorlabe'; cType := SetMajorC; end; with SymbolTable[201] do begin symbol := 'setminorlabe'; cType := SetMinorC; end; with SymbolTable[202] do begin symbol := 'getmouse '; cType := GetMouseC; end; with SymbolTable[203] do begin symbol := 'slicenumber '; tType := FunctionT; cType := GetSliceC; end; with SymbolTable[204] do begin symbol := 'nslices '; tType := FunctionT; cType := nSlicesC; end; with SymbolTable[205] do begin symbol := 'selectslice '; cType := SelectSliceC; end; with SymbolTable[206] do begin symbol := 'addslice '; cType := AddSliceC; end; with SymbolTable[207] do begin symbol := 'deleteslice '; cType := DeleteSliceC; end; with SymbolTable[208] do begin symbol := 'makenewstack'; cType := MakeStackC; end; with SymbolTable[209] do begin symbol := 'averageframe'; cType := AverageFramesC; end; with SymbolTable[210] do begin symbol := 'waitfortrigg'; cType := TriggerC; end; with SymbolTable[211] do begin symbol := 'docopy '; cType := CopyModeC; end; with SymbolTable[212] do begin symbol := 'reslice '; cType := ResliceC; end; with SymbolTable[213] do begin symbol := 'makelineroi '; cType := MakeLineC; end; with SymbolTable[214] do begin symbol := 'plotprofile '; cType := PlotProfileC; end; with SymbolTable[215] do begin symbol := 'gettime '; cType := GetTimeC; end; with SymbolTable[216] do begin symbol := 'setscale '; cType := SetScaleC; end; with SymbolTable[217] do begin symbol := 'savestate '; cType := SaveStateC; end; with SymbolTable[218] do begin symbol := 'restorestate'; cType := RestoreStateC; end; with SymbolTable[219] do begin symbol := 'setcounter '; cType := SetCounterC; end; with SymbolTable[220] do begin symbol := 'redlut '; tType := ArrayT; cType := CommandType(RedLutA); end; with SymbolTable[221] do begin symbol := 'greenlut '; tType := ArrayT; cType := CommandType(GreenLutA); end; with SymbolTable[222] do begin symbol := 'bluelut '; tType := ArrayT; cType := CommandType(BlueLutA); end; with SymbolTable[223] do begin symbol := 'updatelut '; cType := UpdateLutC; end; with SymbolTable[224] do begin symbol := 'showmessage '; cType := ShowMsgC; end; with SymbolTable[225] do begin symbol := 'setbinarycou'; cType := SetCountC; end; with SymbolTable[226] do begin symbol := 'rstddev '; tType := ArrayT; cType := CommandType(rStdDevA); end; with SymbolTable[227] do begin symbol := 'propagatelut'; cType := PropagateLutC; end; with SymbolTable[228] do begin symbol := 'chooseslice '; cType := ChooseSliceC; end; with SymbolTable[229] do begin symbol := 'setslicespac'; cType := SetSpacingC; end; with SymbolTable[230] do begin symbol := 'getslicespac'; tType := FunctionT; cType := GetSpacingC; end; with SymbolTable[231] do begin symbol := 'linebuffer '; tType := ArrayT; cType := CommandType(BufferA); end; with SymbolTable[232] do begin symbol := 'ruser1 '; tType := ArrayT; cType := CommandType(rUser1A); end; with SymbolTable[233] do begin symbol := 'ruser2 '; tType := ArrayT; cType := CommandType(rUser2A); end; with SymbolTable[234] do begin symbol := 'propagateden'; cType := PropagateDensityC; end; with SymbolTable[235] do begin symbol := 'propagatespa'; cType := PropagateSpatialC; end; with SymbolTable[236] do begin symbol := 'setoptions '; cType := SetOptionsC; end; with SymbolTable[237] do begin symbol := 'requiresvers'; cType := RequiresC; end; with SymbolTable[238] do begin symbol := 'getplotdata '; cType := GetPlotDataC; end; with SymbolTable[239] do begin symbol := 'plotdata '; tType := ArrayT; cType := CommandType(PlotDataA); end; with SymbolTable[240] do begin symbol := 'setuser1labe'; cType := SetUser1C; end; with SymbolTable[241] do begin symbol := 'setuser2labe'; cType := SetUser2C; end; with SymbolTable[242] do begin symbol := 'subtractback'; cType := SubtractBackgroundC; end; with SymbolTable[243] do begin symbol := 'autothreshol'; cType := AutoThresholdC; end; with SymbolTable[244] do begin symbol := 'setexport '; cType := SetExportC; end; with SymbolTable[245] do begin symbol := 'movewindow '; cType := MoveWindowC; end; with SymbolTable[246] do begin symbol := 'usercode '; cType := UserCodeC; end; with SymbolTable[247] do begin symbol := 'invertlut '; cType := InvertLutC; end; with SymbolTable[248] do begin symbol := 'xcoordinates'; tType := ArrayT; cType := CommandType(xCoordinatesA); end; with SymbolTable[249] do begin symbol := 'ycoordinates'; tType := ArrayT; cType := CommandType(yCoordinatesA); end; with SymbolTable[250] do begin symbol := 'ncoordinates'; tType := FunctionT; cType := nCoordinatesC; end; with SymbolTable[251] do begin symbol := 'string '; tType := StringT; end; with SymbolTable[252] do begin symbol := 'getstring '; tType := StringFunctionT; cType := GetStringC; end; with SymbolTable[253] do begin symbol := 'openserial '; cType := OpenSerialC; end; with SymbolTable[254] do begin symbol := 'getserial '; tType := StringFunctionT; cType := GetSerialC; end; with SymbolTable[255] do begin symbol := 'putserial '; cType := PutSerialC; end; with SymbolTable[256] do begin symbol := 'chr '; tType := StringFunctionT; cType := ChrC; end; with SymbolTable[257] do begin symbol := 'ord '; tType := FunctionT; cType := OrdC; end; with SymbolTable[258] do begin symbol := 'setcursor '; cType := SetCursorC; end; with SymbolTable[259] do begin symbol := 'tickcount '; tType := FunctionT; cType := TickCountC; end; with SymbolTable[260] do begin symbol := 'concat '; tType := StringFunctionT; cType := ConcatC; end; with SymbolTable[261] do begin symbol := 'setvideo '; cType := SetVideoC; end; with SymbolTable[262] do begin symbol := 'stringtonum '; tType := FunctionT; cType := StringToNumC; end; with SymbolTable[263] do begin symbol := 'acquire '; cType := AcquireC; end; with SymbolTable[264] do begin symbol := 'undobuffersi'; tType := FunctionT; cType := UndoSizeC; end; with SymbolTable[265] do begin symbol := 'scion '; tType := ArrayT; cType := CommandType(ScionA); end; with SymbolTable[266] do begin symbol := 'callfilter '; cType := CallFilterC; end; with SymbolTable[267] do begin symbol := 'photomode '; cType := PhotoModeC; end; with SymbolTable[268] do begin symbol := 'rgbtoindexed'; cType := RGBToIndexedC; end; with SymbolTable[269] do begin symbol := 'surfaceplot '; cType := SurfacePlotC; end; with SymbolTable[270] do begin symbol := 'selectwindow'; cType := SelectWindowC; end; with SymbolTable[271] do begin symbol := 'newtextwindo'; cType := NewTextWindowC; end; with SymbolTable[272] do begin symbol := 'capturecolor'; cType := CaptureColorC; end; with SymbolTable[273] do begin symbol := 'getthreshold'; cType := GetThresholdC; end; with SymbolTable[274] do begin symbol := 'averageslice'; cType := AverageSlicesC; end; with SymbolTable[275] do begin symbol := 'bitand '; tType := FunctionT; cType := BitAndC; end; with SymbolTable[276] do begin symbol := 'bitor '; tType := FunctionT; cType := BitOrC; end; with SymbolTable[277] do begin symbol := 'sortpalette '; cType := SortPaletteC; end; with SymbolTable[278] do begin symbol := 'pidnumber '; tType := FunctionT; cType := PidNumC; end; with SymbolTable[279] do begin symbol := 'project '; cType := ProjectC; end; with SymbolTable[280] do begin symbol := 'windowtitle '; tType := StringFunctionT; cType := WindowTitleC; end; with SymbolTable[281] do begin symbol := 'calibrate '; cType := CalibrateC; end; with SymbolTable[282] do begin symbol := 'callexport '; cType := CallExportC; end; with SymbolTable[283] do begin symbol := 'keydown '; tType := FunctionT; cType := KeyDownC; end; with SymbolTable[284] do begin symbol := 'indexedtorgb'; cType := IndexedToRgbC; end; with SymbolTable[285] do begin symbol := 'makemovie '; cType := MakeMovieC; end; with SymbolTable[286] do begin symbol := 'setprojectio'; cType := SetProjectionC; end; with SymbolTable[287] do begin symbol := 'gethistogram'; cType := GetHistogramC; end; with SymbolTable[288] do begin symbol := 'get '; tType := FunctionT; cType := GetC; end; end; {with} nSymbols := 288; {Must be subscript of last predefined symbol} end; procedure DeallocateStrings2 (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; function CurrentLine: str255; var cLine: str255; i, count: integer; begin i := StartOfLine; if (i < 0) or (i > EndMacros) then begin CurrentLine := ''; exit(CurrentLine); end; cLine := ''; count := 0; repeat i := i + 1; count := count + 1; if not (MacroBufP^[i] = cr) or (MacroBufP^[i] = '|') then cLine := concat(cLine, MacroBufP^[i]); until (i >= EndMacros) or (MacroBufP^[i] = cr) or (MacroBufP^[i] = '|') or (count > 60); while (length(cLine) > 1) and (cLine[1] = ' ') do delete(cLine, 1, 1); CurrentLine := concat(crStr, '<<', cLine, '>>'); end; procedure LTMacroError (str: str255); {Report load-time errors} var str2: str255; i, count: integer; begin if token = DoneT then exit(LTMacroError); if TopOfStack > 0 then DeallocateStrings2(1, TopOfStack); PutError(concat(str, ' in line ', long2str(MacroLineNumber), ' of macro file.', CurrentLine)); Token := DoneT; end; procedure LookupIdentifier; var i: integer; begin with MacrosP^ do for i := 1 to nSymbols do begin if TokenSymbol = SymbolTable[i].symbol then with SymbolTable[i] do begin token := tType; MacroCommand := cType; TokenLoc := loc; SymbolTableLoc := i; exit(LookupIdentifier); end; end; {for} token := UnknownIdentifier; end; procedure GetToken; var c: char; SymbolLength: integer; begin if token = DoneT then exit(GetToken); SavePC := PC; SaveToken := token; while not (MacroBufP^[pc] in ['a'..'z', '0'..'9', '(', ')', ',', '''', '+', '-', '*', '/', ':', ';', '=', '.', '>', '<', '[', ']', '|']) do begin {skip white space} if MacroBufP^[pc] = cr then MacroBufP^[pc] := '|' else pc := pc + 1; if pc > EndMacros then begin Token := DoneT; exit(GetToken); end; end; c := MacroBufP^[pc]; case c of 'a'..'z': begin TokenSymbol := BlankSymbol; SymbolLength := 0; while MacroBufP^[pc] in ['a'..'z', '0'..'9'] do begin SymbolLength := SymbolLength + 1; if SymbolLength <= SymbolSize then TokenSymbol[SymbolLength] := MacroBufP^[pc]; pc := pc + 1; if pc > EndMacros then begin Token := DoneT; exit(GetToken); end; end; Token := identifier; LookupIdentifier; exit(GetToken); end; '0'..'9', '.': begin TokenStr := ''; while MacroBufP^[pc] in ['0'..'9', '.'] do begin TokenStr := Concat(TokenStr, c); pc := pc + 1; c := MacroBufP^[pc]; if pc > EndMacros then begin Token := DoneT; exit(GetToken); end; end; Token := NumericLiteral; if MacroBufP^[pc] in ['a'..'z'] then LTMacroError('Operator or delimiter expected'); exit(GetToken); end; '(': begin Token := LeftParen; pc := pc + 1; end; ')': begin Token := RightParen; pc := pc + 1; end; '[': begin Token := LeftBracket; pc := pc + 1; end; ']': begin Token := RightBracket; pc := pc + 1; end; ',': begin Token := comma; pc := pc + 1; end; ':': if MacroBufP^[pc + 1] = '=' then begin Token := AssignOp; pc := pc + 2; end else begin Token := colon; pc := pc + 1; end; ';': begin Token := SemiColon; pc := pc + 1; end; '+': begin Token := PlusOp; pc := pc + 1; end; '-': begin Token := MinusOp; pc := pc + 1; end; '*': begin Token := MulOp; pc := pc + 1; end; '/': begin Token := DivOp; pc := pc + 1; end; '''': begin TokenStr := ''; pc := pc + 1; while MacroBufP^[pc] <> '''' do begin TokenStr := Concat(TokenStr, MacroBufP^[pc]); pc := pc + 1; if pc > EndMacros then begin Token := DoneT; exit(GetToken); end; end; pc := pc + 1; Token := StringLiteral; end; '=': begin Token := eqOp; pc := pc + 1; end; '<': begin pc := pc + 1; if MacroBufP^[pc] = '>' then begin token := neOp; pc := pc + 1; end else if MacroBufP^[pc] = '=' then begin token := leOp; pc := pc + 1; end else token := ltOp; end; '>': begin pc := pc + 1; if MacroBufP^[pc] = '=' then begin token := geOp; pc := pc + 1; end else token := gtOp; end; '|': begin Token := NewLineT; MacroLineNumber := MacroLineNumber + 1; StartOfLine := pc; pc := pc + 1; end; otherwise begin token := NullT; beep; end; end; {case} end; procedure AddProcedure; begin GetToken; if token <> UnknownIdentifier then begin LTMacroError('Procedure name missing or previously defined'); exit(AddProcedure); end; if nSymbols >= MaxSymbols then begin LTMacroError('Symbol table overflow'); exit(AddProcedure); end; nSymbols := nSymbols + 1; nProcedures := nProcedures + 1; with MacrosP^, MacrosP^.SymbolTable[nSymbols] do begin symbol := TokenSymbol; tType := procedureT; cType := NullC; if MacroBufP^[pc] = ';' then pc := pc + 1; loc := pc2 + 1; end; end; procedure AddIdentifier; begin if nSymbols >= MaxSymbols then begin LTMacroError('Symbol table overflow'); exit(AddIdentifier); end; nSymbols := nSymbols + 1; with MacrosP^, MacrosP^.SymbolTable[nSymbols] do begin symbol := TokenSymbol; tType := Identifier; cType := NullC; loc := pc2; end; end; procedure GetGDToken; begin GetToken; while token = NewLineT do GetToken; end; procedure DoGlobalDeclaration; var SaveStackLoc, StackLoc: integer; begin SaveStackLoc := TopOfStack; while (token = UnknownIdentifier) or (token = Identifier) do begin if Token = UnknownIdentifier then begin AddIdentifier; SymbolTableLoc := nSymbols; token := identifier; end; if TopOfStack >= MaxMacroStackSize then begin LTMacroError(StackOverflow); exit(DoGlobalDeclaration); end; TopOfStack := TopOfStack + 1; nGlobals := nGlobals + 1; with MacrosP^.stack[TopOfStack] do begin SymbolTableIndex := SymbolTableLoc; value := 0.0; StringH := nil; end; GetGDToken; if token = comma then GetGDToken; if (token = FunctionT) or (token = StringFunctionT) or (token = CommandT) or (token = ArrayT) then begin LTMacroError('Predefined identifier'); exit(DoGlobalDeclaration); end; end; {while} if token <> colon then LTMacroError('":" expected'); GetGDToken; if (token <> IntegerT) and (token <> RealT) and (token <> BooleanT) and (token <> StringT) then LTMacroError('"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 vType := StringVar; StringH := str255H(NewHandle(SizeOf(str255))); if StringH = nil then begin LTMacroError('Out of memory'); Token := DoneT end else StringH^^ := 'Global String'; end; otherwise end; GetGDToken; if Token = SemiColon then GetGDToken; end; procedure PutTokenBack2; begin if token <> DoneT then begin pc := SavePC; token := SaveToken; end; end; procedure DoGlobalDeclarations; begin GetGDToken; if (token = FunctionT) or (token = StringFunctionT) or (token = CommandT) or (token = ArrayT) then begin LTMacroError('Predefined identifier'); exit(DoGlobalDeclarations); end; while ((token = UnknownIdentifier) or (token = Identifier)) and (Token <> DoneT) do DoGlobalDeclaration; PutTokenBack2; end; function PreScan1: boolean; {Converts the macro file to lowercase and removes comments.} var inString, inComment: boolean; c: char; i, StartComment: integer; function LineNumber: integer; var i, n: integer; begin n := 1; for i := 0 to pc do if MacroBufP^[i] = cr then begin StartOfLine := i; n := n + 1; end; LineNumber := n; end; begin PreScan1 := false; inString := false; inComment := false; for i := 0 to EndMacros do begin c := MacroBufP^[i]; if inString and (c = cr) then begin pc := i - 1; PutError(concat('The quoted string in line ', long2str(LineNumber), ' of the macro file is not terminated.', CurrentLine)); exit(PreScan1); end; if (not InString) and (c = '{') then begin InComment := true; StartComment := i; end; if inComment then begin if (c = '{') and (i <> StartComment) then begin PutError(concat('Comments cannot be nested.', CurrentLine)); exit(PreScan1); end; if c = '}' then inComment := false; if c <> cr then MacroBufP^[i] := ' '; end else begin if (c = 'Ô') or (c = '`') then begin pc := i; PutError(concat('Bad quote("Ô" or "`") in line ', long2str(LineNumber), ' of macro file.', CurrentLine)); exit(PreScan1); end; if c = '''' then inString := not inString; if (c >= 'A') and (c <= 'Z') and not inString then MacroBufP^[i] := chr(ord(c) + 32); end; end; if inComment then begin pc := StartComment; PutError(concat('The comment starting in line ', long2str(LineNumber), ' of the macro file is not terminated.', CurrentLine)) end else PreScan1 := true; end; procedure StoreInteger (i: integer); begin with macrosP^ do begin pc2 := pc2 + 1; macros[pc2] := chr(band(bsr(i, 8), $ff)); pc2 := pc2 + 1; macros[pc2] := chr(band(i, $ff)); end; end; procedure StoreReal (r: real); type bytes=packed array[1..4] of char; var vrec:record case integer of 1: (rv: real); 2: (b: bytes) end; begin {b := bytes(r);} {ppc-bug} vrec.rv:=r; with macrosP^,vrec do begin pc2 := pc2 + 1; macros[pc2] :=b[1]; pc2 := pc2 + 1; macros[pc2] :=b[2]; pc2 := pc2 + 1; macros[pc2] :=b[3]; pc2 := pc2 + 1; macros[pc2] := b[4]; end; end; procedure StoreString; var i: integer; begin with macrosP^ do begin for i := 1 to length(TokenStr) do begin pc2 := pc2 + 1; macros[pc2] := TokenStr[i]; end; pc2 := pc2 + 1; macros[pc2] := chr(0); end; end; procedure AddMenuItem; var i, fkey: integer; c, key: char; begin with MacrosP^ do begin GetToken; pc2 := pc2 + 1; macros[pc2] := chr(ord(token)); if token <> StringLiteral then begin LTMacroError('Macro command name not found'); exit(AddMenuItem); end; StoreString; if nMacros < MaxMacros then begin AppendMenu(SpecialMenuH, TokenStr); nMacros := nMacros + 1 end else PutError('Too many macros.'); if macros[pc] = ';' then pc := pc + 1; MacroStart[nMacros] := pc2 + 1; i := pos('[', TokenStr); if i > 0 then begin {Assign a key to macro?} i := i + 1; key := TokenStr[i]; if (key >= 'A') and (key <= 'Z') then key := chr(ord(key) + 32); MacroKey[nMacros] := key; if (key = 'f') and (TokenStr[i + 1] in ['1'..'9']) then begin {Function Key?} fkey := ord(TokenStr[i + 1]) - ord('0'); if TokenStr[i + 2] in ['0'..'5'] then fkey := fkey * 10 + ord(TokenStr[i + 2]) - ord('0'); if (fkey >= 1) and (fkey <= 15) then MacroKey[nMacros] := chr(ord('A') + fkey - 1); end; {Function key?} end; end; {with} end; procedure PreScan2; {Converts the macro file to a token stream. Some tokens are followed by an argument.} { is followd by a null terminated string, by a real(4 byte) number,} { and by a symbol table location (2 byte integer), and} {, , , and by a 1 byte ID.} {UserCommandT, UserFuncT, UserStrFuncT are also followed by a 1 byte ID.} var i: integer; begin with MacrosP^ do begin if nMacros > 0 then for i := 1 to nMacros do begin DeleteMenuItem(SpecialMenuH, FirstMacroItem); MacroKey[i] := chr(0); end; nMacros := 0; nProcedures := 0; nGlobals := 0; if TopOfStack > 0 then DeallocateStrings2(1, TopOfStack); TopOfStack := 0; MacroOrProcName := BlankSymbol; pc := 0; pc2 := 0; token := NullT; SymbolTableLoc := 0; MacroLineNumber := 1; repeat GetToken; macros[pc2] := chr(ord(token)); case token of StringLiteral: StoreString; NumericLiteral: StoreReal(StringToReal(TokenStr)); MacroT: begin AddMenuItem; if token = DoneT then exit(PreScan2); end; Identifier, ProcedureT: StoreInteger(SymbolTableLoc); UnknownIdentifier: begin AddIdentifier; if token = DoneT then exit(PreScan2); macros[pc2] := chr(ord(Identifier)); StoreInteger(nSymbols); end; ProcIDT: begin AddProcedure; if token = DoneT then exit(PreScan2); end; VarT: if (nMacros = 0) and (nProcedures = 0) then begin DoGlobalDeclarations; if token = DoneT then exit(PreScan2); end; CommandT, FunctionT, StringFunctionT, ArrayT, UserCommandT, UserFuncT, UserStrFuncT: begin pc2 := pc2 + 1; macros[pc2] := chr(ord(MacroCommand)); end; otherwise ; end; {case} pc2 := pc2 + 1; if pc2 > (MaxMacroSize - 256) then begin if nMacros > 0 then DeleteMenuItem(SpecialMenuH, FirstMacroItem + nMacros - 1); PutError('Unable to load all the macros because file is too large.'); exit(PreScan2); end; until token = DoneT; EndMacros := pc2 - 1; end; if nMacros = 0 then PutError('No macros found.'); end; procedure LoadMacros2; var size1, size2: LongInt; begin ShowWatch; size1 := endMacros; if not PreScan1 then begin DisposePtr(ptr(MacroBufP)); exit(LoadMacros2); end; InitSymbolTable; PreScan2; size2 := endMacros; DisposePtr(ptr(MacroBufP)); CurrentX := 20; CurrentY := 20; SaveForeground := -1; StartOfLine := 0; ShowMessage(StringOf('Macro size:', cr, ' file: ',size1:1, ' (', (size1 / MaxMacroFileSize) * 100.0:1:0, '%)', cr, ' tokenized: ', size2:1, ' (', (size2 / MaxMacroSize) * 100.0:1:0, '%)')); end; procedure LoadMacrosFromFile (fname: str255; RefNum: integer); var err: OSErr; FileSize: LongInt; f: integer; begin err := FSOpen(fname, RefNum, f); err := GetEOF(f, FileSize); if FileSize > MaxMacroFileSize then begin err := fsclose(f); PutError('Macro file is too large.'); exit(LoadMacrosFromFile); end; MacroBufP := MacroBufPtr(NewPtr(FileSize)); if MacroBufP = nil then begin err := fsclose(f); PutError('Not enough memory to load macro file.'); exit(LoadMacrosFromFile); end; err := SetFPos(f, fsFromStart, 0); err := fsRead(f, FileSize, ptr(MacroBufP)); EndMacros := FileSize - 1; err := fsclose(f); LoadMacros2; end; procedure LoadMacrosFromWindow; var ByteCount: LongInt; begin if TextInfo <> nil then with TextInfo^ do begin ByteCount := TextTE^^.TELength; if ByteCount <= 0 then begin PutError('Text window is empty.'); exit(LoadMacrosFromWindow); end; EndMacros := ByteCount - 1; MacroBufP := MacroBufPtr(NewPtr(ByteCount)); if MacroBufP = nil then begin PutError('Not enough memory to load macros.'); exit(LoadMacrosFromWindow); end; BlockMove(TextTE^^.hText^, ptr(MacroBufP), ByteCount); LoadMacros2; end; end; procedure LoadMacros; var name: str255; begin if CurrentWindow = TextKind then LoadMacrosFromWindow else if GetTextFile(name, MacrosRefNum) then LoadMacrosFromFile(name, MacrosRefNum); end; end.