Sorry for the 5-6 week absence in this series.... Here is the next instalment of the simple BHY-BASIC interpreter demo program to show some basic programming ideas including using Select/Case, arrays, recursion, etc. This time, we introduce a method for evaluating expressions which can be used in both the LET and PRINT instructions. Background - during this past summer, a new programmer was asking many questions about making an interpreter for his own version of BASIC. Many replied and made suggestions and gave examples for the parts he asked about but somehow his program didn't seem to gel. Perhaps he was not familiar enough with some programming concepts like arrays or using string functions. It seemed as if he had rushed into the problem without considering how to do it or even what the details of the problem were. And unfortunately, much of the advice seemed to be ignored as the same questions were repeatedly asked. However, the problem of developing an interpreter for a simple version of a BASIC like language was intriguing, especially as it could be a case study for beginning programmers like BH to see and study some programming concepts. This version of BYH-BASIC allows for only 5 instructions so far - LET, PRINT, COLOR, BEEP, and INPUT. Maybe a later instalment will implement IF to make decisions and also so type of looping command like DO or FOR. Variable in BYH-BASIC can be any of the 26 letters (A-Z) and can represent only numbers. Then it will be much more powerful. But first things first. Earlier instalments showed the start of the project with an 'editor' window for typing instructions and a 'run time' window where results can be shown. When the user selects the run command, each statement is parsed or divided into a series of tokens in an array; each token might be a number, a variable, a text message in quotes, a number, or an operator in an expression. The first item in the parsed array must be one of the instructions of the language. Routines to handle some of the instructions (INPUT, LET and BEEP) have already been presented in the earlier parts of this series. Two more (PRINT and LET) are added now. As mentioned above, evaluating an expression has now been added to the interpreter and is used with both the LET and PRINT instructions. Three recursive functions are used to do this. An expression is one or more terms added or subtracted together; a term is one or more values multiplied or divided; and an item is a single number, variable or another expression in brackets. Recursion - a routine which calls itself or which calls another routine that in turn calls the first routine - is obvious here in order to evaluate sub-expressions in brackets to get a value that is used in the main expression. Those 3 functions are shown in the program below and they are used in the PRINT and LET handler routines. There also is some rudimentary error checking to make sure that the proper syntax is being used. Yet to come ... Part 5: Routines to save the instructions in a file and to open files with BYH-BASIC programs. Part 6: Additional instructions - maybe IF and DO loops ------------------------------------------ First - here is a sample program to try in BYH-BASIC to see some of the commands. It can be copied from here, pasted into the editor window, and then executed (run). BEEP TWICE PRINT "WELCOME TO BYH-BASIC" LET X = 5 LET Y = X + X*X - X/X COLOR BLUE PRINT X, Y PRINT 10+2*(30-9)/13 LET A = 305 LET B = 25 LET C = (A-5)/(2*B-10) COLOR ORANGE PRINT A; B; C BEEP 3 COLOR BLACK PRINT "ALL DONE" ------------------------------------------ Second - Here is part 4B of the BYH-BASIC interpreter. Study it at your own risk or leisure if interested. Feedback and questions are welcome. '~'A ' Runtime : Rntm Appearance.Incl ' CPU : Carbon ' CALL Req'd : Off '~'B /* FB code generated by TWM <http://homepage.ntlworld.com/bernie.w/twm.htm> for window layout ' Rest of code for the simple interpreter by SNC / OGGS {Aug - Oct 2005} */ /* Part 4B - BYH-BASIC - A Simple Interpreter - An evolving project {SNC - Sept 14, '05} New / Revised Features added in this verion 4B.... 1. Version 4A added FN ShowError to display the offending instruction, its line number, and an error message in a similar way. This uses OS system routine FM StandardAlert( ) to display the message. 2. Version 4A added FN ChangeInstructionIntoTokens. That created arrays of items in the instruction and another array telling what type of item each one is (text, message in quotes, number, operator, or end-of-instruction). Now the fuctions that process each instruction are changed to work with the tokens and, in some case, do more. PRINT now can display several items not just one LET works to store result of an expression COLOR has been changed to allows more colors BEEP has been simnplified INPUT variable 3. A new subprogram, FN evaluateExpression, is added to the interpretter for use with the LET instruction and with other instructions later on. It uses a recursive technique to call itself to evaluate sub-expressions in brackets. 4. Code for an INPUT command has been added. ex. INPUT X Since this demo uses only numeric variables, only numbers are allowed for input values. 5. Code for CMD-Period has been added to let the user interupt a running program. It just creates a special error mesage; no sense developing something new to do the same thing. 6. Earlier versions initialized the variables (A-Z) to 1000, 2000, 3000, 4000, ... 260000 to help test the PRINT and LET commands. Now the values are initialized to zero every time a program is run. 7. ? ==> PRINT The text filter routine for instructions changed everything into capital letters (part of syntax for this simple interpretter) Now it also changes a question mark into PRINT followed by a space when used at the start of a line as a shortcut. */ BEGIN GLOBALS// {Version 2 - 8/22/05} DIM as DOUBLE gVar(26) ' for values of 26 variables DIM gAlphabet$' for names of 26 variables DIM gCurrentInstruction$' copy of current instruction DIM gKeyword$' _maxTokenNum = 100 dim 31 gToken$(_maxTokenNum)' use 32 bytes each (instead of 256) to save memory dim gTokenType(_maxTokenNum)'1=text; 2=number, 3=message in quotes, 4=operator dim as short gNumTokens dim as long gLineNumber' # of instruction being interpreted 'DM gErrorWndVisible' true when error window shown; (not needed V4B) ' program activity suspeneded until window closed dim gProgramIsRunning ' user has started an H-BAsic program ' This affects how cmd-period (BREAK) works DIM gExpressionErrorFlag ' logical flag set by FN EvaluateExpression dim gNumToken ' subscript number of current token in FN Eval Expr. DIM gDebug END GLOBALS '~'1 begin enum 1' constants for token types _myNumberType _myTextType _myQuotedMessageType _myOperatorType _myEndOfInstructionType end enum '~'1 ' begin enum 1' window #s _EditorWnd _RuntimeWnd end enum begin enum 1' fields in Editor Window _InstructionsEF _InstructionsLabel end enum BEGIN ENUM'' menu and item #s {SNC 8/22/05} _FileMenu = 1 _FileNewItem = 1 _FileOpenItem = 2 _FileSaveItem = 3 _FileSaveAsItem = 4 _FilePrintItem = 6 _FileQuitItem = 8 _CommandMenu = 3 _CommandRunItem =1 _AboutHBasicItem = 1 END ENUM #define FMFontFamily as SInt16 toolbox fn FMGetFontFamilyFromName(Str255 iName) = FMFontFamily '~'1 local fn ShowError( errorMessage$ ) ' v4B {SNC, Sept. 9,'05) DIM as OSStatus ignore ignore = fn StandardAlert( _kAlertNoteAlert, ErrorMessage$,¬ "Line #" +str$(gLineNumber) + ": " + gCurrentInstruction, 0, #0 ) end fn '~'1 '~Evaluate Expressions-->Terms-->Items DEF FN EvalItem# DEF FN EvalTerm# DEF FN EvalExpr# LOCAL FN EvalItem# ' gets the value of a number or a variable ' sets error code if neither DIM itemValue# dim ssVar' subscript of variable DIM txt$ txt$ = gToken$( gNumToken ) ' VARIABLE type (single letter) if gDebug Then print "••••••EvalITEM: token#="gNumToken; " txt$="; txt$ SELECT gTokenType(gNumToken) case _myNumberType' NUMBER type itemValue# = VAL( gToken$(gNumToken) ) case _myTextType long if len(txt$) != 1 ' is token just 1 letter for a variable? FN ShowError( "Variable A-Z expected; found "+txt$) gExpressionErrorFlag = _true itemValue# = 0 EXIT FN END IF ssVar = INSTR( 1, gAlphabet$, txt$ ) itemValue# = gVar(ssVar) case _myOperatorType long if txt$="(" gNumToken ++ itemValue# = FN EvalExpr# end if CASE ELSE FN ShowError( "Variable or number expected; found: " + txt$ ) gExpressionErrorFlag = _true itemValue# = 0 END SELECT gNumToken ++ end FN = itemValue# '~'1 LOCAL FN EvalTerm# dim termValue# DIM txt$ termValue# = FN EvalItem# txt$ = gToken$( gNumToken ) if gDebug Then print "••••Eval TERM: token#="gNumToken; " txt$="; txt$ SELECT gTokenType( gNumToken ) CASE _myOperatorType SELECT txt$ CASE "*" : gNumToken ++ termValue# = termValue# * FN EvalTerm# CASE "/" : gNumToken ++ termValue# = termValue# / FN EvalTerm# CASE ",", ";" 'gNumToken ++ Case "+", "-" case ")" 'gNumToken ++ END SELECT CASE _myEndOfInstructionType ' Case ELSE FN ShowError( "Operator expected; found " + txt$ ) gExpressionErrorFlag = _true termValue# = 0 END SELECT END FN = termValue# '~'1 LOCAL FN EvalExpr# dim exprValue# DIM txt$ exprValue# = FN EvalTerm# txt$ = gToken$( gNumToken ) if gDebug Then print "••Eval EXPR: token#="gNumToken; " txt$="; txt$ SELECT gTokenType( gNumToken ) CASE _myOperatorType SELECT txt$ CASE "+" : gNumToken ++ exprValue# = exprValue# + FN EvalExpr# CASE "-" : gNumToken ++ exprValue# = exprValue# - FN EvalExpr# CASE ",", ";" 'gNumToken ++ case ")" 'gNumToken ++ END SELECT CASE _myEndOfInstructionType ' Case ELSE FN ShowError( "Operator expected; found: " + txt$ ) gExpressionErrorFlag = _true exprValue# = 0 end select END fn = exprValue# '~'1 '~'1 LOCAL FN EvaluateExpression#' added in V4B ' This is a recursive routine to evaluate expressions in the simple BYH-BASIC language interpreter. ' Parameters... ' exprEnd$ is value of terminating expression; usually null "" meaning the end of line or , or ; in PRINT ' but sometimes ")" for subexpressions in ( ) or "THEN" for an IF command ( in a later version). ' Note: gNumToken is a global to indicate which token is being examined. ' Set its value before calling this routine. ' This routine will incr. it as needed until the end of an expression is reached ' The end is any of the following: ) , ; or end of the instruction. ' ' A legal expression for this interpreter is any of the following... ' number <--- ex. 13, -4 56.125 ' or variable <--- ex A B C ... Z (only single capital letters are allowed ' term <--- ex a #, a variable, or term times or divided by a term ' or expressions: term + term term — term ' ex. 3+X A + 2*B – 6.6/D ' or (expression) ' 'Order or evaluation: BEDMAS: Bracketrs, (no exponents), Mult & Divide, Add & Subtract (last) ' If an error should occur in the expression being evaluated, then global variable gExpressionErrorFlag will be _true. ' gExpressionErrorFlag = _false END FN = FN EvalExpr# '~'1 '~ Filters for typing instructions & INPUT local fn CapsOnlyFilter ' v3, snc dim 15 key$' value of current key press ' Ensures all typed data in the edit field is converted to capital letters (for this simple interpretter) ' This is used with the instructions edit fireld in the editor window ' Note - it dows not affect text that is pasted into the field or text typed in other fields. key$ = ucase$( TEKEY$ )' get typed key and convert to capital letter if key$ = "?" then key$ = "PRINT "' make shortcut for PRINT command (V4B) ' ----> More to add here... ' Check if ? is at start of a line too tekey$ = key$ ' replace value for typed key end fn '~'1 local fn NumberOnlyFilter ' v3, snc ' Allows only numeric digits (0-9) to be entered in an edit field ' This was to be used with the INPUT command and an edit firld but edit field not used now. ' It also allows one decimal point and optionally a leading minus sign (-). dim 1 key$' value of current key press DIM numChars' # chars in current edit field Dim txt$' text currently in edit field key$ = TEKEY$' get the key that has been typed LONG IF instr(1, "1234567890-.", key$ ) = 0 key$ = ""' change invalid chars to nulls xElse txt$ = EDIT$( window(_efNum) )' get text from currently active edit field ' check if decimal point ok IF insTR(1,txt$,".") != 0 AND key$="." THEN key$="" ' check for leading minus sign ok IF insTR(1,txt$,"-") != 0 AND (key$="-" and WINDOW(_selStart)=0) THEN key$="" end IF tekey$ = key$ ' replace value for typed key end fn '~'1 local fn Trim$( message$ ) ' v3 snc ' Deletes all leading and trailing spaces; may end up with a null string ' See 'The Rosetta Stone' on FB disk for a faster executing method and related routines. dim result$ dim x result$ = message$ def truncate( result$ ) ' remove trailing spaces. while result$[1] = _" " and len(result$) >= 1' remove leading spaces result$ = MID$( result$, 2 ) WEND END Fn = result$ '~'1 '~Other Routines... local fn BuildEditorWnd dim as Str255 s dim as ControlFontStyleRec tfs dim as WindowAttributes wa dim as Rect r DIM AS Pointer @ filterFN wa = _kWindowCloseBoxAttribute_kWindowCollapseBoxAttribute SetRect(r, 0, 48, 400, 748)// w: 400 h: 700 appearance window -_EditorWnd, "BYH-BASIC Editor", @r, _kDocumentWindowClass, wa def SetWindowBackground(_kThemeActiveDialogBackgroundBrush, _zTrue) TEXT fn FMGetFontFamilyFromName("Lucida Grande"), 13, 0 SetRect(r, 15, 28, 315, 44) s = "Type BYH-BASIC instructions here..." edit field _InstructionsLabel, s, @r, _statNoFramed, _leftJust TEXT _Courier, 18, 0 SetRect(r, 18, 57, 377, 677) filterFN = @fn capsOnlyFilter edit field _InstructionsEF, "", @r, _framed, _leftJust, filterFN appearance window _EditorWnd end fn '~'1 local fn BuildRuntimeWnd dim as WindowAttributes wa dim as Rect r wa = _kWindowCloseBoxAttribute¬ _kWindowCollapseBoxAttribute¬ _kWindowFullZoomAttribute SetRect(r, 410, 48, 1010, 748)// w: 600 h: 700 appearance window -_RuntimeWnd, "BYH-BASIC Runtime Output", @r, _kDocumentWindowClass, wa def SetWindowBackground(_kThemeDocumentWindowBackgroundBrush, _zTrue) appearance window _RuntimeWnd end fn '~'1 LOCAL FN cmdPeriod ' Come here when the user presses cmd-period, (a BREAK evenk) ' Just create an error message to allow user to quit or continue if the BYH-BASIC program is running; otherwize, quit long if gProgramIsRunning FN ShowError( "BYH-BASIC Program interuption (cmd-.) ..." ) ' BREAK in H-BASIC run XELSE STOP "USER-BREAK (Cmd-Period)"' regular STOP while in Editor. END iF END FN '~'1 '~ INPUT handler local FN inputNumber# 'this uses INKEY$ to enter a decimal number. ' Only digits 0-9 are allwed as well as a leading negative sign and 1 decimal point. ' Note extra code needed to hangle the delete key ' Using an edit field without borders might be a better solution. dim num$ DIM numValue# dim 1 key$, returnKey$, enterKey$, minusKey$, periodKey$ dim endOfNum num = "" numValue# = VAL( num$ ) returnKey$ = chr$(13) enterKey$ = chr$(3) minusKey$ = "-" periodKey$ = "." endOfNum = _False Do do' wait for any key to be pressed key$ = INKEY$ until len( key$ ) = 1 SELECT key$ case returnKey$, enterKey$ ' return or enter mark end of the number endOfNum = _true print case minusKey$ ' allow a leading negative sign LONG IF len(num$) = 0 num$ = key$ print key$; END IF Case periodKey$' allow a single decimal point long If INSTR(1,num$,periodKey$) = 0 num$ += key$ print key$; END IF CASE "0","1","2","3","4","5","6","7","8","9"'alloe digits 0-9 num$ += key$ print key$; CASE else ' ignore all other caharacters END SELECT until endOfNum = _true numValue# = val( num$ ) END FN = numValue# '~'1 LOCAL FN cmdINPUT ' Legal syntax: INPUT X <--- where X is a variable A-Z; only format allowed ' To get effect of FB's INPUT "message"; X Use PRINT "message"; first, then INPUT X DIM result# DIM c$ dim ssVar long if gNumTokens > 3 FN ShowError( "Only 1 Variable Allowed." ) exit fn end if c$ = gToken$(2) ssVar = INSTR( 1, gAlphabet$, left$( c$, 1 ) ) long if gTokenType(2) != _myTextType or ssVar = 0 or LEN( c$ ) > 1 FN ShowError( "Use A Variable (A-Z)" ) exit fn end if window output _RuntimeWnd 'input "? "; result# ' simple way but no auto check for legal numbers PRINT "? "; ' show a prompt beep ' and audible cue for input too, eh result# = fn inputNumber# gVar( ssVar ) = result# END FN '~'1 '~ PRINT handler LOCAL FN cmdPRINT ' This function handles various forms of a PRINT command in this H-Basic language dim startNewLineFlag DIM txt$ startNewLineFlag = _true gNumToken = 1 Do gNumToken ++ select gTokenType(gNumToken) case _myQuotedMessageType print gToken$(gNumToken) ; startNewLineFlag = _true case _myTextType, _myNumberType Print FN EvaluateExpression# ; " " ; gNumToken -- case _myOperatorType select gToken$(gNumToken) CASE ";" , "," : startNewLineFlag = _false' do nothing for ; or , Case "(" Print FN EvaluateExpression# ; " " ; gNumToken -- /* print FN EvaluateExpression#( ")" ) ; gNumToken -- startNewLineFlag = _true */ case else : FN ShowError( "Unexpected Separator In List" ) end select case _myEndOfInstructionType 'print "•"; : beep : delay 500 ' Show bullet char as deguging flag delay 100 'IF startNewLineFlag = _true THEN PRINT select gToken$(gNumToken-1)' check previous token at end CASE ";" , "," : ' do nothing for ; or , case else : print' advance to new line. end select case else' here for numbers and/or expressions Print FN EvaluateExpression# ; gNumToken -- startNewLineFlag = _true end select UNTIL gNumToken >= gNumTokens END FN '~'1 '~ LET handler LOCAL FN cmdLET ' Legal Syntax: LET variable = expression ' added in V4B {SNC} ' An expression ... ' number ' or variable ' or expression OP expression <--- where OP is an operator: + = * / or ^ ' or (expression) ' or expression expression <.--- Multiplication will be assumed: ex. 5A or (X+3)(2Y-1) or 3AB ' A recursive function is called to evaluate the expression after the = sign ' If an error should occur in the expression being evaluated, then global variable gExpressionErrorFlag will be _true. ' dim 1 resultVar$ DIM as double exprResult DIM 1 c$ dim ssVar ' Step 1: Look for a variable name after LET for the result resultVar$ = gToken$( 2 ) ' should be a letter for variable ssVar = instr( 1, gAlphabet$, resultVar$ ) ' subscript to array of values for variables. long if ssVar = 0 or LEN( resultVar$ ) > 1 ' need to check length too above because user might type LET STU = 5 and ssVar would turn out to be 19. FN ShowError( "Missing or invalid variable after LET" ) exit fn end if ' Step 2: Look for an equal sign after the variable c$ = gToken$(3) LONG IF c$ != "=" FN ShowError( "Missing equals sign (=) after the variable." ) exit fn END IF ' Step 3: Store value of the expression after = in the value array for the variable before = gNumToken = 4 exprResult = FN evaluateExpression# if gExpressionErrorFlag = _false THEN gVar(ssVar) = exprResult END FN '~'1 '~ BEEP handler LOCAL FN cmdBEEP ' Legal Syntax: BEEP n where n is 1, 2, 3, ONCE, TWICE or blank for once DIM n$ n$ = gToken$( 2 ) Select n$ case "", " ", "1", "ONCE" : BEEP case "2", "TWICE" : BEEP : delay 100 : BEEP : delay 100 case "3" : BEEP : delay 100 : BEEP : delay 100 : BEEP : delay 100 CASE ELSE : FN ShowError( "Invalid BEEP Option" ) end select long if gNumTokens > 3 fn showError( "Invalid extra options for BEEP" ) exit fn end if END FN '~'1 '~ COLOR handler LOCAL FN cmdCOLOR ' Legal Syntax: COLOR colorName DIm colorName$ colorName$ = gToken$(2) window output _RuntimeWnd SELECT colorName$ ' Convert it to FB's LONG COLOR blue#, green#, red# (each #: 0-65535) CASE "BLUE" : Long color 65535,0,0 CASE "GREEN" : Long color 0,65535,0 CASE "RED" : Long color 0,0,65535 CASE "PURPLE" : Long color 65535,0,65535 CASE "BROWN" : long color 0,16383,49151 CASE "ORANGE" : long color 0,32767,65535 CASE "BLACK" : long color 0,0,0 CASE "GREY" : long color 32767,32767,32767 CASE "SILVER" : long color 49151,49151,49151 CASE "CHARCOAL" : long color 16383,16383,16383 ' add other colors here... Maybe even show color selection dialog???? CASE ELSE : fn showError( "Invalid color name" ) color _zBlack exit fn END SELECT ' PRINT "Debug: Testing COLOR "; colorName$ long if gNumTokens > 3 fn showError( "Invalid or extra data after color name." ) exit fn end if ' NOTE TO MYSELF: Maybe allow this syntax: COLOR RED 50% or COLOR BLACK 33% ' and interpreter would convert above values: 65535 -((65535-n)*percent) END FN '~'1 '~Create Array of Tokens for an Instruction local fn ChangeInstructionIntoTokens DIM p' loop counter for position with instruction dim 1 c$ ' a character at position p in the instruction dim temp$' temporary item built char by char DIM inMessage, inText, inNumber' logocal flags for what object is being built dim isLetter, isDigit, isOperator' logical flags for class of character DIM isDoubleQuote, isSpace, isReturn' logical flag for special delimeter characters DIM x ' misc loop counter ' Clear the array of tokens first for x = 1 to _maxTokenNum gToken$(x) = "" next x ' ' get a copy of the current line to be executed window output _editorWnd' needed before getting instruction edit field info gCurrentInstruction$ = FN Trim$( EDIT$( _instructionsEF, gLineNumber ) ) window output _RuntimeWnd gCurrentInstruction$ += CHR$(13)' append return char for end of instr code gNumTokens = 0 inMessage = _false inText = _false inNumber = _false temp$ = "" FOR p = 1 TO LEN( gCurrentInstruction$ ) c$ = mid$( gCurrentInstruction$, p, 1 ) isLetter = instr(1, gAlphabet, c$ ) isDigit = instr(1, "1234567890.", c$ ) isOperator = instr(1, "+-*/^()=,;", c$ ) isDoubleQuote = ( c$ = chr$(34) ) isReturn = ( c$ = CHR$(13) ) isSpace = ( c$ = " " ) select case inMessage long if isDoubleQuote ' here at end or a quoted message; store the message as a token gNumTokens ++ gToken$(gNumTokens) = temp$ gTokenType(gNumTokens) = _myQuotedMessageType temp$ = "" inMessage = _false inText = _false inNumber = _false XELSE ' here for any char between quotation marks; append each char onto the message temp$ += c$ inMessage = _true inText = _false inNumber = _false END IF case isDoubleQuote ' here for the start of a message between quotes long if inNumber or inText gNumTokens ++ gToken$(gNumTokens) = temp$ if inNumber then gTokenType(gNumTokens) = _myNumberType if inText then gTokenType(gNumTokens) = _myTextType end if temp$ = "" inMessage = _true inText = _false inNumber = _false case isOperator long if inNumber or inText gNumTokens ++ gToken$(gNumTokens) = temp$ if inNumber then gTokenType(gNumTokens) = _myNumberType if inText then gTokenType(gNumTokens) = _myTextType temp$ = "" end if gNumTokens ++ gToken$(gNumTokens) = c$ gTokenType(gNumTokens) = _myOperatorType inMessage = _false inText = _false inNumber = _false case isSpace or isReturn long if inNumber or inText or inMessage gNumTokens ++ gToken$(gNumTokens) = temp$ if inNumber then gTokenType(gNumTokens) = _myNumberType if inText then gTokenType(gNumTokens) = _myTextType temp$ = "" end if inMessage = _false inText = _false inNumber = _false CASE isDigit long if inText gNumTokens ++ gToken$(gNumTokens) = temp$ gTokenType(gNumTokens) = _myTextType temp$ = "" end if temp$ += c$ inMessage = _false inText = _false inNumber = _true Case isLetter long if inNumber gNumTokens ++ gToken$(gNumTokens) = temp$ gTokenType(gNumTokens) = _myNumberType end if temp$ += c$ inMessage = _false inText = _true inNumber = _false end select NEXT p ' set special token type for the end of the line (better than special char or message) gNumTokens ++ gToken$(gNumTokens) = "" gTokenType(gNumTokens) = _myEndOfInstructionType /* ' dump the array of tokens - part of debugging. window output _RuntimeWnd cls print gCurrentInstruction$ for x = 1 to gNumTokens print using "### "; x ; using "### "; gTokenType(x); gToken$(x) next x ' pause */ end fn '~'1 '~RUN COMMAND - DECODE INSTRUCTIONS LOCAL FN DoRunCommand// {Version 2 - 8/22/05} DIM as long x, p dim as handle efH dim as str255 lineStr dim @ lineLength DIM @ programLength dim @ lastLineNumber WINDOW OUTPUT _EditorWnd efH = tehandle( _instructionsEF ) lastLineNumber = efH..TEnLines% WINDOW OUTPUT _RuntimeWnd COLOR _zBlack ' reset font TEXT _Courier, 18, 1 for x = 1 to 26' reset variables to zero gVar(x) = 0.0 ' test values for early versions 'gVar(x) = x*1000.0 next x CLS' clear window gLineNumber = 0 gProgramIsRunning = _True while (gLineNumber <= lastLineNumber) AND (gProgramIsRunning = _true) if gProgramIsRunning = _false then exit fn gLineNumber ++ fn ChangeInstructionIntoTokens gKeyword$ = gToken$(1) SELECT gKeyword$ CASE "PRINT" : FN cmdPrint CASE "INPUT" : FN cmdInput CASE "LET" : FN cmdLet CASE "BEEP" : FN cmdBeep CASE "COLOR" : FN cmdColor CASE "", " "' blank line <--- do nothing CASE "'" ' comment line <--- do nothing CASE ELSE : FN ShowError( "Invalid Keyword At Start of Instruction") END SELECT delay 100' to slow down program while testing handleEvents WEND WINDOW OUTPUT _EditorWnd END FN '~'1 '~ Traditional event handlers ... LOCAL FN DoMenuCommand// {SNC 8/22/05} DIM menuID, itemID menuID = MENU(0) itemID = MENU(1) SELECT menuID CASE _AppleMenu SELECT itemId CASE _AboutHBasicItem : BEEP END SELECT case _FileMenu SELECT itemID CASE _FileNewItem : CASE _FileOpenItem : CASE _FileSaveItem : CASE _FileSaveAsItem : CASE _FilePrintItem : CASE _FileQuitItem : gFBquit = _true END SELECT CASE _CommandMenu SELECT itemID CASE _CommandRunItem : FN DoRunCommand// {Version 2 - 8/22/05} END SELECT END SELECT MENU END FN '~'1 LOCAL FN BuildMenus// v1 {SNC 8/22/05} APPLE MENU "About H-BASIC…" MENU _FileMenu,0,_enable, "File" MENU _FileMenu,_FileNewItem, _enable, "New/N" MENU _FileMenu,_FileOpenItem, _enable, "Open/O" MENU _FileMenu,_FileSaveItem, _enable, "Save/S" MENU _FileMenu,_FileSaveAsItem,_enable, "Save As…;-" MENU _FileMenu,_FilePrintItem, _enable, "Print…/P;-" MENU _FileMenu,_FileQuitItem, _enable, "Quit/Q" EDIT MENU 2 MENU _CommandMenu,0,_enable,"Command" MENU _CommandMenu,_CommandRunItem,_enable,"Run/R<B" END FN '~'1 LOCAL FN Init FN BuildMenus// v1 - {SNC} fn BuildRuntimeWnd fn BuildEditorWnd 'Def SetButtonFocus ( _instructionsEF ) gAlphabet$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"// {Version 2 - snc} gProgramIsRunning = _false // v 4B END FN '~'1 local fn DoDialog dim as Rect r dim as long ev, id ev = dialog(0) id = dialog(ev) select ev case _wndClick 'window id' v4 - prevent making output wnd active case _wndClose case _wndRefresh case _wndResized case _wndActivate case _btnClick ' v4A {SNC, Aug 25,'05) select window(_outputWnd)' V4B - check if program is running now too (for Break) case 666' is it the error window while H-BASIC program is being run? /* ' Note needed - use Fn StandardAlert() instead - v4B ' (Note to myself... Should have used constants!) select id ' check which button of error window was clicked case 666-1 ' CONTINUE button gProgramIsRunning = _True CASE 666-2 ' QUIT button gProgramIsRunning = _False end select window close 666' close the error window and continue the interpreter gErrorWndVisible = _False */ end select case _preview select id case _preMenuClick case _preWndGrow end select end select end fn '~'1 '~MAIN PROGRAM FN Init ON DIALOG FN DoDialog ON MENU FN DoMenuCommand ON BREAk FN cmdPeriod ' gDebug = _true ' used to show stages of decoding expressions gDebug = _false ' DO HandleEvents UNTIL gFBQuit ------------------------------------------