Here's instalment 5 of building an interpreter for a simple BASIC like language. To recap: BYH-BASIC allows 26 Variables (A-Z only] and these instructions (so far): LET PRINT INPUT COLOR BEEP It seems pretty simple, eh? <--- touch of a Canuck accent here. ;-) But it takes a lot to make it work. Careful study is needed not to be confused. More instructions like IF and REPEAT are planned for version 6; maybe - if I find time. Previous posts, starting in August '05, of this series developed the user interface (editor window and output window), allowed entering instructions, parsed an instruction into an array 'tokens' which are separate words, variables, operators etc. and interpreted the instructions. A recursive routine was developed to evaluate expressions in the LET and PRINT instructions (and others later on maybe). Version 5 now adds instructions to SAVE the program in a file, OPEN a program from a file, start a NEW file, and PRINT the instructions. Data files are set to type TEXT for simplicity which aids in transferring BYH-BASIC instruction files to other text editors, word processors, or even Excel. Note - In hindsight, these routines should have been added much earlier so that testing program instructions would be much easier. Programming Notes & Methodology: 1. A global variable gFileName is always set to the current file. It starts off as 'Untitled' like many other applications, and changes whenever a file is saved or opened. The file's name is displayed in the editor window's title bar. 2. Another global variable, gIsFileDirty, keeps track of whether the user has made any changes to the files. If so, the the SAVE item is enabled in the FILE menu; if not, it is disabled. (So you can't use SAVE until you've typed something.) SAVE AS... is always active though. 3. The PRINT function displays a title line and line numbers in front of each instruction. For now, it doesn't check to see if printing has reached the bottom of a page; try that yourself maybe. 4. The data files for BYH-BASIC programs contain 2 'header' lines so that the program can identify whether the TEXt file being opened is actually a BYH-BASIC program. They are unseen by the user of BYH-BASIC unless the data file is opened in another application. It's starting to get long so future versions will refer to my web site where it can be found. Here's the complete program below, with more comments than before (Search for V5 for newly added parts). Watch out for any line breaks by your mail application. ========================================== '~'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 - Nov 2005} */ /* Version 5 of the Simple BYH-BASIC interpreter .... {Stu-11/21/05} Now we add routines to save the BASIC instructions to a disk file and to open a file with instructions. For simplicity, the file will be type TEXT and is read and written a line at a time. This allows you to inspect the file with any text editor or word processor. The first line of the file will be treated as a 'header' with info about this program as its creator (just for reference). Some global variables are used to keep track of the file's name and location and whether any changes have been made to it. */ BEGIN GLOBALS DIM AS DOUBLE gVar(27) ' for values of 26 variables DIM 27 gAlphabet$' for names of 26 variables and π DIM gCurrentInstruction$' copy of current instruction DIM gKeyword$' first word in an instruction ' DIM gFileName$' name of currently opened file DIM gVolRefNum ' voume reference # of active file DIM gIsFileDirty' flag 0=no; 1=true (file has changed) _maxTokenNum = 100 DIM 31 gToken$(_maxTokenNum) ' tokens use 32 bytes each (instead of 256) to save memory DIM gTokenType(_maxTokenNum) ' types: 1=text; 2=number, 3=message in quotes, 4=operator, 5=end of line DIM AS SHORT gNumTokens DIM AS LONG gLineNumber ' Line # of instruction being interpreted DIM gProgramIsRunning ' User has started a BYH-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. 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 _AboutBYHBasicItem = 1 END ENUM #define FMFontFamily AS SInt16 TOOLBOX FN FMGetFontFamilyFromName(Str255 iName) = FMFontFamily '~'1 LOCAL FN formatWithLeadingZeros$( N ) ' added in V5: {Stu-11/22/05} DIM result$ result$ = USING "#### "; N' convert # to text; 2 trailing blanks IF N < 1000 THEN result$[1] = _"0" ' and put in leading zeros IF N < 100 THEN result$[2] = _"0" ' " IF N < 10 THEN result$[3] = _"0" ' " END FN = result$ '~'1 LOCAL FN ShowError( errorMessage$ ) ' revised in v4B {SNC, Sept. 9,'05) ' This routine displays the given error message and ' the corresponding line # and instruction when the error occurred. DIM as OSStatus ignore ignore = FN StandardAlert( _kAlertNoteAlert, ErrorMessage$, ¬ "Line #" +str$(gLineNumber) + ": " + gCurrentInstruction, ¬ 0, #0 ) END FN '~'1 '~File SAVE and OPEN routines; also PRINT routine - V5 {Stu-11/21/05} ' The following routines were added as part of V5 {Stu-11/21/05} LOCAL FN SaveProgramInFile DIM header$' 1st line in the program DIM AS LONG lineNum DIM AS HANDLE efH ' handle to an edit field's text DIM AS STR255 lineStr ' text on one line DIM lastLineNumber DIM tempFileName$ DIM tempVolRefNum ' display standard 'open for save' dialog tempFileName$ = FILES$( _fSave, "Save program instructions as ...", ¬ gFileName$, tempVolRefNum ) ' Check whether user clicked on the Cancel button ( file name will be a null string ) ' Since a temporay file name is used above, the real file name is not changed when cancel is clicked. IF LEN( tempFileName ) = 0 THEN EXIT FN ' OK - user has selected a file: store its name, reset the window's title, etc. gFileName$ = tempFileName$ gVolRefNum = tempVolRefNum WINDOW _editorWnd, gFileName$ ' Actually open the file and print 2 'header' lines with id info first DEF OPEN "TEXT" ' set the file type OPEN "O", 1, gFileName$, , gVolRefNum PRINT #1, "'Made by BYH-BASIC V5.0 on "; DATE$; " at "; TIME$' header$ PRINT #1, "'=====================================================" ' Now output each line of the program... WINDOW OUTPUT _EditorWnd efH = TEhandle( _instructionsEF )' get handle to edit field lastLineNumber = efH..TEnLines%' get # of lines it has FOR lineNum = 1 TO lastLineNumber lineStr = EDIT$( _instructionsEF, lineNum ) ' get a line of text (one instr.) PRINT #1, lineStr' and send it to the file NEXT lineNum ' All done with the file CLOSE #1 gIsFileDirty = _false END FN '~'1 LOCAL FN ReadProgramFromFile DIM header1$, header2$ DIM tempFileName$ DIM tempVolRefNum DIM instructionLine$ ' Show standard 'Open file for input' dialog tempFileName$ = FILES$( _fOpen, "TEXT", "Open a BYH-BASIC file...", tempVolRefNum ) ' Did user click on CANCEL button? (filename is null then) IF LEN( tempFileName ) = 0 THEN EXIT FN ' Make connection to the actual file OPEN "I", 2, tempFileName$, , tempVolRefNum ' Check the first line to ensure the selected file was made by this interpreter. LINE INPUT #2, header1$ LONG IF LEFT$(header1$,18) <> "'Made by BYH-BASIC" BEEP FN ShowError( "This is not a BYH-BASIC file." ) EXIT FN XELSE ' 2nd line should be a row of = signs; read it and then ignore it LINE INPUT #2, header2$ END IF ' Now read rest of the file into the edit field for instructions, line by line. WINDOW _editorWnd EDIT$( _InstructionsEF ) = ""' clear any old instructions WHILE NOT EOF( 2 ) ' continue until end of file... LINE INPUT #2, instructionLine$ ' get next line from file and EDIT$( _InstructionsEF, _maxInt, _maxInt ) = instructionLine$ ' append it to text in edit field EDIT$( _InstructionsEF, _maxInt, _maxInt ) = chr$(13) ' put a 'return' after each instr WEND SetSelect _maxInt, _maxInt ' put cursor at end of the edit field ' All done: close file and Update window's title, etc. CLOSE #2 gFileName$ = tempFileName$ gVolRefNum = tempVolRefNum WINDOW _editorWnd, gFileName$ gIsFileDirty = _false END FN '~'1 LOCAL FN PrintTheProgram ' Sends the program to the printer 'Added in V5: {Stu-11/21/05} ' Note: Quick way would be to use DEF PrintEditField routine in FB ' but it just prints the EF and can't get extras like title and line #s, etc DIM indent DIM lineNum, lastLineNumber DIM Instruction$ DIM vertPos DIM ln$ DIM AS HANDLE efH indent = 36 ' 36 points = 1/2 inch ' Show std PRINT dialog (varies depending on selected printer) DEF LPRINT IF PrCancel THEN EXIT FN WINDOW _editorWnd efH = TEhandle( _instructionsEF )' get handle to edit field lastLineNumber = efH..TEnLines%' get # of lines it has ' Print the program title first... ROUTE _toPrinter TEXT _Courier, 10, 0 PRINT %( indent, 24 ) "BYH-BASIC V5: File = «"; TEXT _Courier, 12, 1 PRINT gFileName$; TEXT _Courier, 10, 0 PRINT "» Printed on "; DATE$; " at "; TIME$ PLOT 0,30 TO 8*72,30 vertPos = 48' vert position for 1st line ' Now print the program, line by line; just like saving it... ' Leaving out instructions to test for end of the page, etc (later maybe) FOR lineNum = 1 TO lastLineNumber vertPos += 16' adjust vert position ' This is where we need to check for bottom of page (in a later version maybe..) ln$ = FN FormatWithLeadingZeros$( lineNum )' format line # ROUTE _toScreen' needed to refer to edit field instruction$ = EDIT$( _instructionsEF, lineNum ) ' get one instr. ROUTE _toPrinter PRINT %(indent,vertPos) ln$; instruction$;' print both items NEXT lineNum ' Tell printer that's all... ROUTE _toScreen CLOSE LPRINT 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) 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 ) 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 ) 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... ' ' 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: Brackets, Mult & Divide, Add & Subtract (last) ' If an error should occur in the expression being evaluated, ' then global variable gExpressionErrorFlag will be _true. ' Exponent operator (^) not used. ' gExpressionErrorFlag = _false END FN = FN EvalExpr# '~'1 '~ Filters for typing instructions & INPUT LOCAL FN CapsOnlyFilter ' added in v3, snc DIM 15 key$' value of current key press ' Ensures all typed data in the editor field is converted to capital letters (for this simple interpretter) ' This is used with the instructions edit field 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... ' Must check if ? is at start of a line too TEKEY$ = key$ ' replace value for typed key gIsFileDirty = _True ' added in V5; {Stu-11/21/05} END FN '~'1 LOCAL FN NumberOnlyFilter ' added in 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 field 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$ ) ' added in 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 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, gFileName$, @r, _kDocumentWindowClass, wa // changed in V5: {Stu-11/21/05} 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, 360, 677) filterFN = @fn capsOnlyFilter EDIT FIELD _InstructionsEF, "", @r, _framed, _leftJust, filterFN ' Added a scroll bar in V5 {SNC-11/21/05} SetRect(r, 364, 57, 384, 677) SCROLL BUTTON -_InstructionsEF, 0,0,0,0, @r, _scrollOther 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"'allow digits 0-9 num$ += key$ print key$; CASE else ' ignore all other characters END SELECT until endOfNum = _true numValue# = val( num$ ) END FN = numValue# '~'1 LOCAL FN cmdINPUT ' Added in V4 - SNC ' Legal syntax: INPUT X <--- where X is a variable A-Z; only this simple 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 simple BYH-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 ' handle to an edit field's text DIM AS STR255 lineStr ' text on one line 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 NEXT x gVar#(27) = PI ' value of π (can be used like a variable) 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 '~ Usual event handlers & set up routines ... LOCAL FN DoMenuCommand// {SNC 8/22/05} DIM menuID, itemID menuID = MENU(0) itemID = MENU(1) SELECT menuID CASE _AppleMenu SELECT itemId CASE _AboutBYHBasicItem : BEEP END SELECT CASE _FileMenu SELECT itemID CASE _FileNewItem :' added V5: {Stu-11/21/05} LONG IF gIsFileDirty = _true FN SaveProgramInFile END IF gFileName$ = "Untitled" WINDOW _editorWnd, gFileName$ EDIT$( _instructionsEF ) = "" gIsFileDirty = _false CASE _FileOpenItem : FN ReadProgramFromFile ' added V5: {Stu-11/21/05} CASE _FileSaveItem : FN SaveProgramInFile ' added V5: {Stu-11/21/05} CASE _FileSaveAsItem : FN SaveProgramInFile ' added V5: {Stu-11/21/05} CASE _FilePrintItem : FN PrintTheProgram ' added V5: {Stu-11/21/05} CASE _FileQuitItem : ' revised in V5: {Stu-11/21/05} LONG IF gIsFileDirty = _true FN SaveProgramInFile END IF gFBquit = _true END SELECT CASE _CommandMenu SELECT itemID CASE _CommandRunItem : FN DoRunCommand// {Version 2 - 8/22/05} END SELECT END SELECT MENU' restore menu bar END FN '~'1 LOCAL FN BuildMenus// v1 {SNC 8/22/05} APPLE MENU "About BYH-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 ' Set inital value for key global variables... gAlphabet$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"// {V2 - snc} gProgramIsRunning = _false // {4B - snc} gFileName$ = "Untitled" // Added in V5: {Stu-11/21/05} gVolRefNum = SYSTEM( _aplVol ) // for the same folder as BYH-BASIC; Added in V5: {Stu-11/21/05} FN BuildMenus// v1 - {SNC} FN BuildRuntimeWnd FN BuildEditorWnd 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 CASE _wndClose CASE _wndRefresh CASE _wndResized CASE _wndActivate CASE _btnClick CASE _preview SELECT id CASE _preMenuClick LONG IF gIsFileDirty ' added in V5: {Stu-11/21/05} MENU _fileMenu, _fileSaveItem, _enable XELSE MENU _fileMenu, _fileSaveItem, _disable END IF 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 DO HandleEvents UNTIL gFBQuit