Forum - Socoder

-=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- (c) WidthPadding Industries 1987 0\|714\|0 -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=-
Socoder -> Blitz -> TinyBasic (TinyBBasic)
Thu, 12 Apr 2018, 10:58
Dan	TinyBasic (TinyBBasic) Here is the Sourcecode for the TinyBasic, which can be found on: TinyBasic in Runbasic in Webbrowser converted to run in BlitzBasic (3d). The code, so far is run-able (haven't tested if it is 100% bug free). This interpreter understands only numeric variables, which can be placed between a to z chars. I have added a small delay each 2 seconds, to avoid 100% cpu usage. Following line can be commented out: If ((MilliSecs()-timer)/1000) Mod 2 = 1 Then Delay 5 ; small delay to release the cpu usage, while running programs --v To break a running program, press Ctrl + D. Auto Loading/Running of an program is also supported, if you save it as 0 (save 0). p.s.: The Windows api calls are made only By the Functions, which are not really needed for this interpreter. The needed decls addition are in or before the functions, in the code. You can safely remove all the Functions and their calls by commenting/removing the Include line, and uncommenting the 2 graphic calls. p.p.s: ini functions require the Program to be compiled. If you run in in the Ide, the settings and the programs will be made in the blitzbasic bin folder. p.p.p.s. The Graphic calls are intentionally left as ,2 and ,3 (instead of ,6 ,7) because the time call functions need a runable code, if the window looses the focus. ;TinyBasic.bas ; tinyBasic v1.0 - A very small and simple BASIC interpreter written in ; Run BASIC. WARNING: For uber geeks only. :-p ; Copyleft 2005 by Laurent DUVEAU ; www.aldweb.com ; an iziBasic sample program ; Ported to Run BASIC by Carl Gundel and Scott McLaughlin ; www.libertybasic.com ; Ported to Blitzbasic (b3d) by Dan ; A1 temp ; B temp ; C character index in line ; E line number for error msg ; I temp (loops) ; L number of lines ; N number ; S expression stack index ; T temp ; V variable index ; ATMP$ temp ; B00$ temp ; C00$ character ; D$ single statement ; E00$ error message ; G$ string code (") ; H$ HALT code (Line Feed) ; I$-R$ Help ; Z$=A00$(26) statement input ;tmsec contains Milliseconds, tsec contains milliseconds()/1000, reseted to 0 at every start of the interpteter, using the timer=Millisec FntName$="Fixedsys" FntSize=9 Include "ScreenIni.bb" ;If you comment this line, uncomment the next 2 graphic calls ;Graphics 640,480,32,2 ;Graphics 640,480,32,3 AppTitle "Tiny (Blitz)Basic" SetBuffer BackBuffer() SeedRnd MilliSecs() ;Font=LoadFont("MyPC_Dos_Font",12,False,False,False) ;Font=LoadFont("My Cpc Font",6,False,False,False) ;Font=LoadFont("MyAmigaFont",6,False,False,False) Font=LoadFont(Fntname$,FntSize,False,False,False) ;Font=LoadFont("Topaz",11,False,False,False) SetFont Font cmdline$=Lower$(CommandLine$()) If cmdline$<>"" If cmdline$="white" Then cmdline$="" Else If iCol$="white" Then iCol$="" cmdline$=iCol$ iCol$="" EndIf Select cmdline$ Case "black" ClsColor $0,0,0 Color $ff,$Ff,$FF Case "green" ClsColor $0,$40,0 Color $0,$ff,$0 Case "red" ClsColor $40,0,0 Color $ff,$0,$0 Case "blue" ClsColor 0,0,$50 Color $80,$80,$ff Case "orange" ClsColor $0,0,0 Color $ff,$a5,0 Case "yellow" ClsColor $FF,$FF,$0 Color 0,$0,$0 Case "gold" ClsColor $A3,$9F,$34 Color 255,255,23 Case "" ClsColor $ff,$ff,$ff Color 0,0,0 Default ClsColor $FF,$ff,$FF Color $0,$0,$ff End Select Cls Dim A00$(125) ; [27-125] = 99 program lines Dim A(82) ; [27-52] = 26 variables ; [53-82] = 30 items math stack A00$(9)="BYE, CLEAR, CLS, END, HELP, MEM, NEW, RUN, GOTO" A00$(10)="LOAD <number> \| SAVE <number> [0 for autoload] \| INPUT <var>" A00$(11)="IF <exp> THEN <statement> \| REM <any> " A00$(12)="[LET] <var>=<exp> \| LIST [<exp>\|PAUSE]" A00$(13)="PRINT <exp\|str>[,<exp\|str>][;]" A00$(14)="ticks,tickspersec \| tmsec,tsec" A00$(15)="a-z vars/numeric only" A00$(16)="" A00$(17)="" .BEGIN timer=MilliSecs() G$=Chr$(34) : H$=Chr$(10) B=FileType("tinyBas0") If B=1 Then Z$="load 0:run" A00$(26)=Z$ Goto AutoRun End If Print "Tiny (Blitz)BASIC v1.0 from Run BASIC's Source code" Print "Type HELP for commands. Use Ctrl+D to stop." Print "" .Ready If E00$<>"" Then If E>0 Then E00$="#Err in "+Str$(E)+": "+E00$ Else E00$="#Err: "+E00$ End If Print E00$ : E00$="" End If Print "Ready." .IabInput z$=Input$(">") A00$(26)=Z$ .AutoRun L=26 : C=1 : Gosub GetNumber : E=N If N=0 Then DebugLog ">"+c00$ If C00$="" Then Goto Ready Goto NextStatement Else Gosub EnterLine If E00$<>"" Then Goto Ready Goto IabInput End If .Exec If ((MilliSecs()-timer)/1000) Mod 2 = 1 Then Delay 5 ; small delay to release the cpu usage, while running programs Gosub GetNumber : E=N .NextStatement ;ATMP2=GetKey() If KeyDown(29) And KeyDown(32) ;Ctrl+D stops the running program ATMP$="Break in "+Str$(E) Print ATMP$ : Goto Ready End If Gosub GetLabel If E00$<>"" Then Goto Ready Select D$ Case "if" Gosub GetExpression If E00$<>"" Then Goto Ready If N<1 Then B00$=A00$(L) : C=Len(B00$)+1 Goto FinishStatement End If Gosub GetLabel If E00$<>"" Then Goto Ready If D$<>"then" Then E00$="'THEN' expected" Goto Ready End If Goto NextStatement Case "rem" B00$=A00$(L) : C=Len(B00$)+1 Goto FinishStatement Case "input" Gosub GetVar If E00$<>"" Then Goto Ready n=Input() : A(V)=N Goto FinishStatement Case "print" .LAB_PRINT Gosub SkipSpace Gosub GetChar If C00$=G$ Then B00$="" .NextChar C = C + 1 : C00$=Mid$(ATMP$,C,1) If C00$="" Then E00$="Unterminated string" Goto Ready Else If C00$<>G$ Then B00$=B00$+C00$ Goto NextChar End If End If C = C + 1 : C00$=Mid$(ATMP$,C,1) If C00$=G$ Then B00$=B00$+C00$ Goto NextChar End If Write B00$ Else Gosub GetExpression If E00$<>"" Then Goto Ready B=N1 If B=N Then Write N+"" Else Write N End If End If Gosub SkipSpace Gosub GetChar If C00$="," Then C = C + 1 : Goto LAB_PRINT Gosub SkipSpace Gosub GetChar If C00$<>";" Then Print Else C = C + 1 End If Goto FinishStatement Case "clear" For I=27 To 52 : A(I)=0 : Next Goto FinishStatement Case "run" For I=27 To 52 : A(I)=0 : Next L=27 : C=1 Goto FinishStatement2 Case "goto" Gosub GetExpression If E00$<>"" Then Goto Ready If E>=N Then L=27 C=1 : T=N .NextGoto If L=126 Then E00$="Line not found" Goto Ready End If Gosub GetNumber If N=T Then E=N : Goto NextStatement L = L + 1 : C=1 Goto NextGoto Case "new" For I=27 To 125 : A00$(I)="" : Next For I=27 To 52 : A(I)=0 : Next If E=0 Then Goto FinishStatement Goto Ready Case "cls" Cls : Locate 0,0 :Goto FinishStatement Case "help" For I=9 To 18 B00$=A00$(I) : Print B00$ Next Goto FinishStatement Case "mem" B=126 For I=27 To 125 diffI = 152 - I B00$=A00$(diffI) : If B00$="" Then B=diffI ;Find the first emtpy line, backwards Next B=126-B : Print B+""+" lines free" Goto FinishStatement Case "end" Goto Ready Case "bye" Goto ExitTinyBas Case "list" Gosub GetNumber : T=N : A1=L : I=C If T=0 Then Gosub GetLabel If E00$="" And D$="pause" Then I=C E00$="" End If For L=27 To 125 C=1 : Gosub GetNumber B=(T=0) Or (N=T) If B=True Then If ATMP$<>"" Then Print ATMP$ If D$="pause" Then B = (L-26) Mod 10 If B=0 Then Print "Pause..." : AAA$=Input$ (">") End If End If End If Next L=A1 : C=I Goto FinishStatement Case "save" Print "SAVE, # (use 0 for autostart)" Print "Path: "+CurrentDir() Gosub GetExpression If E00$<>"" Then Goto Ready ATMP$="tinyBas"+Str$(N) : A1=False atmp1$="y" If FileType(atmp$)>0 Then ATMp1$=AskInput$("File exists, overwrite?",0) EndIf If atmp1$="y" filetmp=WriteFile(ATMP$) If filetmp<>0 For I=27 To 125 B00$=A00$(I) If B00$<>"" Then WriteLine(filetmp,B00$) : A1=True Next Else Print "Error, unable to write to '"+atmp$+"'" Print "Path: "+CurrentDir$() EndIf CloseFile filetmp ;If A1=False Then DeleteFile(ATMP$) Else Print "Not saved." EndIf Goto FinishStatement Case "load" Write "LOADING: " Gosub GetExpression If E00$<>"" Then Goto Ready ATMP$="tinyBas"+Str$(N) B=FileType(ATMP$) If B=0 Then E00$="File "+ATMP$+" not found" Goto Ready End If If B=1 filetmp=ReadFile(ATMP$) B=False : I=27 While B=False B00$=ReadLine(filetmp): A00$(I)=B00$ : I=I+1 B=Eof(filetmp) Wend CloseFile filetmp While I<=125 A00$(I)="" : I=I+1 Wend EndIf If E=0 Then Goto FinishStatement Goto Ready Case "let" Gosub GetLabel If E00$<>"" Then Goto Ready End Select Gosub ReturnVar If E00$<>"" Then Goto Ready Gosub SkipSpace Gosub GetChar If C00$<>"=" Then E00$="'=' expected" Goto Ready End If C = C + 1 : T=V Gosub GetExpression If E00$<>"" Then Goto Ready A(T)=N .FinishStatement Gosub SkipSpace Gosub GetChar If C00$=":" Then C = C + 1 : Goto NextStatement Else If C00$<>"" Then E00$="End of statement expected" Goto Ready End If End If If L=26 Then Goto Ready L = L + 1 : C=1 If L=126 Then E00$="Program Overflow" Goto Ready End If .FinishStatement2 B00$=A00$(L) If B00$="" Then Goto Ready Goto Exec .ExitTinyBas Print "Thanks for using Tiny BASIC." Print atmp1$=AskInput$("Really quit ?",1) If atmp1$="n" Then Goto Ready End .EnterLine L=27 : C=1 : T=N .NextLine Gosub GetNumber B=(N<T) And (N<>0) And (L<126) If B=True Then L = L + 1 : C=1 : Goto NextLine End If If L=126 Then E00$="Program Overflow" Goto EndEnterLine End If If T<>N Then For I=L To 125 diffI = (125+L)-I B=diffI-1 : A00$(diffI)=A00$(B) Next End If A00$(L)=Z$ Gosub SkipSpace If C00$="" Then For I=L To 124 B=I+1 : A00$(I)=A00$(B) Next End If .EndEnterLine Return .GetExpression A(53)=0 : S=53 Gosub BoolExpression N=A(S) : Goto EndExpression .BoolExpression Gosub AddExpression Gosub SkipSpace Gosub GetChar .NextBool Select C00$ Case "=" C = C + 1 : Gosub AddExpression B=S-1 : A(B)=A(B)=A(S) : S = S - 1 Case ">" C = C + 1 : Gosub GetChar If C00$="=" Then C = C + 1 : Gosub AddExpression B=S-1 : A(B)=A(B)>=A(S) : S = S - 1 Else Gosub AddExpression B=S-1 : A(B)=A(B)>A(S) : S = S - 1 End If Case "<" C = C + 1 : Gosub GetChar Select C00$ Case "=" C = C + 1 : Gosub AddExpression B=S-1 : A(B)=A(B)<=A(S) : S = S - 1 Case ">" C = C + 1 : Gosub AddExpression B=S-1 : A(B)=A(B)<>A(S) : S = S - 1 Default Gosub AddExpression B=S-1 : A(B)=A(B)<A(S) : S = S - 1 End Select End Select Gosub SkipSpace Gosub GetChar B=Asc(C00$) : B=(B>=60) And (B<=62) If B=True Then Goto NextBool Goto EndExpression .AddExpression Gosub MulExpression Gosub SkipSpace Gosub GetChar .NextAdd Select C00$ Case "+" C = C + 1 : Gosub MulExpression B=S-1 : A(B)=A(B)+A(S) : S = S - 1 Case "-" C = C + 1 : Gosub MulExpression B=S-1 : A(B)=A(B)-A(S) : S = S - 1 End Select Gosub SkipSpace Gosub GetChar B=Asc(C00$) : B=(B=43) Or (B=45) If B=True Then Goto NextAdd Goto EndExpression .MulExpression Gosub GroupExpression Gosub SkipSpace Gosub GetChar .NextMul Select C00$ Case "" C = C + 1 : Gosub GroupExpression B=S-1 : A(B)=A(B)A(S) : S = S - 1 Case "/" C = C + 1 : Gosub GroupExpression B=A(S) If B=0 Then If E00$="" Then E00$="Division by zero" S = S - 1 : Goto EndExpression Else B=S-1 : A(B)=A(B)/A(S) : S = S - 1 End If Case " " C = C + 1 : Gosub GroupExpression B=A(S) If B=0 Then If E00$="" Then E00$="Division by zero" S = S - 1 : Goto EndExpression Else B=S-1 : A(B)=A(B) Mod A(S) : S = S - 1 End If End Select Gosub SkipSpace Gosub GetChar B=Asc(C00$) B=(B=42) Or (B=47) Or (B=92) If B=True Then Goto NextMul Goto EndExpression .GroupExpression Gosub SkipSpace Gosub GetChar Select C00$ Case "(" C = C + 1 : Gosub BoolExpression Gosub SkipSpace Gosub GetChar If C00$<>")" Then If E00$="" Then E00$="Missing ')'" Goto EndExpression End If C = C + 1 Case "" If E00$="" Then E00$="Invalid Factor" Default B=Asc(C00$) : B=(B<48) Or (B>57) If B=False Then Gosub GetNumber S = S + 1 : A(S)=N Else Gosub GetLabel If E00$<>"" Then Goto EndExpression B=Len(D$) If B=1 Then Gosub ReturnVar S = S + 1 : A(S)=A(V) Else Select D$ Case "tmsec" S = S + 1 : A(S)=(MilliSecs()-timer) ;MilliSeconds Case "tsec" S = S + 1 : A(S)=(MilliSecs()-timer)/1000 ;Seconds Case "ticks" S = S + 1 : A(S)=MilliSecs() ;TICKS Case "tickspersec" S = S + 1 : A(S)=1000 ;TICKSPERSEC Default If E00$="" Then E00$="Function expected" End Select End If End If End Select .EndExpression Return .GetNumber Gosub SkipSpace B00$="" .NextNumber Gosub GetChar If C00$="" Then Goto GetNumberExit B=Asc(C00$) B=((B<48) Or (B>57)) And (B<>46) If B=True Then Goto GetNumberExit B00$=B00$+C00$ : C = C + 1 : Goto NextNumber .GetNumberExit N=B00$ Return .GetVar Gosub GetLabel If E00$<>"" Then Goto GetVarExit .ReturnVar B=Asc(D$) : A1=Len(D$) A1=(A1<>1) Or (B<97) Or (B>122) If A1=False Then V=B-70 Else If E00$="" Then E00$="Variable expected" End If .GetVarExit Return .GetLabel Gosub SkipSpace Gosub GetChar D$="" If C00$="" Then Goto GetLabelError B=Asc(C00$) : B=(B<97) Or (B>122) If B=True Then Goto GetLabelError .GetNextLabel D$=D$+C00$ : C = C + 1 Gosub GetChar If C00$="" Then Goto GetLabelExit B=Asc(C00$) : B=(B>=97) And (B<=122) If B=True Then Goto GetNextLabel Goto GetLabelExit .GetLabelError If E00$="" Then E00$="Invalid label" .GetLabelExit Return .SkipSpace Gosub GetChar If C00$=" " Then C = C + 1 : Goto SkipSpace Return .GetChar ATMP$=A00$(L) C00$=Mid$(ATMP$,C,1) : C00$=Lower$(C00$) Return Function AskInput$(txt$,def=0) If def=1 Then atmp2$="y" If def=2 Then atmp2$="n" If def>0 Then atmp3$=" [def="+atmp2$+"]" Repeat ATMp1$=Lower$(Input$(txt$+" (Yes/No"+atmp3$+") >")) If Len (atmp1$)>1 Then atmp1$=Left$(atmp1$,1) If atmp1$="" If def>0 Then atmp1$=atmp2$ EndIf Until ATMP1$="y" Or atmp1$="n" Return atmp1$ End Function --v and the include file ScreenIni.bb : ;ChangeDir(SystemProperty ("appdir")) ;Global appdir$=SystemProperty ("appdir") Global appdir$=CurrentDir$() Global inifile$=appdir$+"settings.ini" initmp=FileType(inifile$) If initmp=1 ;File exists ScrW=ReadIni(inifile$,"settings","ScreenWidth",640) ScrH=ReadIni(inifile$,"settings","ScreenHeight",480) FntName$=ReadIni(inifile$,"settings","fontname","Fixedsys") FntSize=ReadIni(inifile$,"settings","fontsize",9) iCol$=Lower$(ReadIni(inifile$,"settings","startuptheme","white")) ElseIf initmp=0 ;File does not exists ScrW=640 ScrH=480 FntName$="Fixedsys" FntSize=9 iCol$="white" WriteIni (inifile$,"settings","ScreenWidth",ScrW) WriteIni (inifile$,"settings","ScreenHeight",ScrH) WriteIni (inifile$,"settings","rem","ScreenWidth/ScreenHeight up/downscale the 640x480 output") WriteIni (inifile$,"settings","startuptheme",iCol$) WriteIni(inifile$,"settings","fontname",FntName$) WriteIni(inifile$,"settings","fontsize",FntSize) WriteIni (inifile$,"settings","themenames","black green red blue orange yellow gold white") EndIf ;Screen (640,480,1) ;for the first screen function Screen (640,480,ScrW,ScrH) ;for the second screen function ;Function Screen(x,y,full=0) ;; User32.decls ;;;.lib "user32.dll" ;;api_GetSystemMetrics% (nIndex%) : "GetSystemMetrics" ;;api_GetActiveWindow%():"GetActiveWindow" ;;api_GetDC% (hwnd%) : "GetDC" ;;api_GetDesktopWindow% () : "GetDesktopWindow" ;;api_MoveWindow% (hwnd%, x%, y%, nWidth%, nHeight%, bRepaint%) : "MoveWindow" ;; ;; GDI32.decls ;;.lib "gdi32.dll" ;;api_GetDeviceCaps% (hdc%, nIndex%) : "GetDeviceCaps" ;;fill <0 = Fulldesktop, borderless window ;;full =0 = Fulldesktop ;;full =1 = original x,y ;;full >1-5 = xfull,yfull size ;;full >5 = 0 ; DeskX=api_GetSystemMetrics(0) ; DeskY=api_GetSystemMetrics(1) ; If x>DeskX Then x=DeskX ; If x<64 Then x=64 ; If y>DeskY Then y=DeskY ; If y<64 Then y=64 ; bits=api_GetDeviceCaps(api_GetDC( api_GetDesktopWindow()),12) ; Graphics x,y,bits,2 ; Graphics x,y,bits,3 ; If full<=0 Or full>5 ; If full<0 Then api_SetWindowLong(api_GetActiveWindow(), -16, $10000000) ; api_MoveWindow(api_GetActiveWindow(),0,0,DeskX,DeskY,True) ; EndIf ; If full>1 And full<=5 Then api_MoveWindow(api_GetActiveWindow(),0,0,xfull,yfull,True) ;End Function Function Screen(defaultx=320,defaulty=240,Stretchx=640,Stretchy=480) ; User32.decls ;.lib "user32.dll" ;api_GetDesktopWindow% () : "GetDesktopWindow" ; GDI32.decls ;.lib "gdi32.dll" ;api_GetDeviceCaps% (hdc%, nIndex%) : "GetDeviceCaps" bits=api_GetDeviceCaps(api_GetDC( api_GetDesktopWindow()),12) Graphics Stretchx,Stretchy,bits,2 Graphics defaultx,defaulty,bits,3 End Function ;From Giulio - Blitzbasic.com - B3D tutorials ; Userlibs kernel32.decls ;.lib "kernel32.dll" ;GetPrivateProfileString%(lpApplicationName$,lpKeyName$,lpDefault$,lpReturnedString*,nSize%,lpFileName$):"GetPrivateProfileStringA" ;WritePrivateProfileString%(lpApplicationName$,lpKeyName$,lpString$,lpFileName$):"WritePrivateProfileStringA" Function WriteIni%(FileINI$, Section$, Key$, Value$) ; FileINI = file (must include path, for current dir use .\) to write into (eg: ".\myinifile.ini") ; Section$ = section that will include your key and value (eg: "GeneralSetup") ; Key$ = Key's name for the value (eg: "BackColor") ; Value$ = Value to write in Key (eg: "ff00ff") ; If the function succedeed it return True otherwhise False ; result in myinifile.ini: ; [GeneralSetup] ; BackColor=ff00ff Ret%=WritePrivateProfileString(Section$, Key$, Value$, FileINI$) If Ret% <> 1 Then Return False Else Return True End If End Function Function ReadIni$(FileINI$,Section$,Key$,DefaultValue$) ; FileINI = file (must include path, for current dir use .\) to read (eg: "c:\windows\myinifile.ini") ; Section$ = section where search your key (eg: "GeneralSetup") ; Key$ = Key's name to search (eg: "BackColor") ; DefaultValue$ = Value to return if key or file or section is not found (eg: "ff00ff") ; Function return value retrieved from searched Key or the user's default value myString$="" myBank=CreateBank(255) LenString%=GetPrivateProfileString(Section$, Key$, DefaultValue$, myBank, 255, FileINI$) For x=1 To LenString% myString$=myString$+Chr(PeekByte(myBank,x-1)) Next FreeBank myBank Return myString$ End Function --v
Thu, 12 Apr 2018, 13:16
Dabz	Pretty cool that! Dabz
Sat, 28 Apr 2018, 09:35
Dan	Thanks, here is a version 1.1 which someone has updated. (credits are in the comments) This version is basically the same as the previous with added functionality. If you want, you can use the include file from the previous post. ;TinyBasic.bas ;a@oO0 A4 2Zz 5S$s 8B 9g 6G mnnm %X# t+ :.;, [{( )}] 1lLiI\| ;Font testing - Similar chars. ; tinyBasic v1.0 - A very small and simple BASIC interpreter written in ; Run BASIC. WARNING: For uber geeks only. :-p ; Copyleft 2005 by Laurent DUVEAU ; www.aldweb.com ; an iziBasic sample program ; Ported to Run BASIC by Carl Gundel and Scott McLaughlin ; www.libertybasic.com ; ' http://www.runbasic.com ; ; 'Version 1.1 (Will run on Liberty BASIC 4.03 and Run BASIC build 2.27) ; 'by David den Haring (8/15/2007) ; 'The purpose of this release is to add enough features to Tiny Basic in order to run the Sieve benchmark. ; 'Added a fixed array accessible from the interpreter (i.e. a() ) ; ; Ported to Blitzbasic (b3d) by Dan ; A1 temp ; B temp ; C character index in line ; E line number for error msg ; I temp (loops) ; L number of lines ; N number ; S expression stack index ; T temp ; V variable index ; ATMP$ temp ; B00$ temp ; C00$ character ; D$ single statement ; E00$ error message ; G$ string code (") ; H$ HALT code (Line Feed) ; I$-R$ Help ; Z$=A00$(26) statement input ;tmsec contains Milliseconds, tsec contains milliseconds()/1000, reseted to 0 at every start of the interpteter, using the timer=Millisec FntName$="Blitz" FntSize=10 Include "ScreenIni.bb" ;If you comment this line, uncomment the next 2 graphic calls ;Graphics 640,480,32,2 ;Graphics 640,480,32,3 Const BasicFile$="tbas_" ;Used to determine the filename of the TinyBasic programs (save/load/delete/dir) AppTitle "Tiny (Blitz)Basic" SetBuffer BackBuffer() SeedRnd MilliSecs() Font=LoadFont(Fntname$,FntSize,False,False,False) ;Font=LoadFont("Blitz",10,False,False,False) ;Font=LoadFont("MyPC_Dos_Font",12,False,False,False) ;Font=LoadFont("My Cpc Font",6,False,False,False) ;Font=LoadFont("MyAmigaFont",6,False,False,False) ;Font=LoadFont("Topaz",11,False,False,False) SetFont Font cmdline$=Lower$(CommandLine$()) If cmdline$<>"" If cmdline$="white" Then cmdline$="" Else If iCol$="white" Then iCol$="" cmdline$=iCol$ iCol$="" EndIf Select cmdline$ Case "black" ClsColor $0,0,0 Color $ff,$Ff,$FF Case "green" ClsColor $0,$40,0 Color $0,$ff,$0 Case "red" ClsColor $40,0,0 Color $ff,$0,$0 Case "blue" ClsColor 0,0,$50 Color $80,$80,$ff Case "orange" ClsColor $0,0,0 Color $ff,$a5,0 Case "yellow" ClsColor $FF,$FF,$0 Color 0,$0,$0 Case "gold" ClsColor $A3,$9F,$34 Color 255,255,23 Case "" ClsColor $ff,$ff,$ff Color 0,0,0 Default ClsColor $FF,$ff,$FF Color $0,$0,$ff End Select Cls Dim A00$(125) ; [27-125] = 99 program lines Dim A(82) ; [27-52] = 26 variables ; [53-82] = 30 items math stack Const ArraySize = 7001 ; Size of user Array Dim Array(ArraySize) A00$(9)="BYE, CLEAR, CLS, END, HELP, MEM, NEW, RUN, GOTO" A00$(10)="LOAD <number> \| SAVE <number> [0 for autoload] \| Delete <number> " A00$(11)="INPUT <var> \| Files \| Dir \| waitkey" A00$(12)="IF <exp> THEN <statement> \| REM <any> " A00$(13)="[LET] <var>=<exp> \| LIST [<exp>\|PAUSE]" A00$(14)="PRINT <exp\|str>[,<exp\|str>][;]" A00$(15)="Numeric variables available from 'a' to 'z'" A00$(16)="One array variable available -- a[1] to a["+Str$(ArraySize)+ "]" A00$(17)="Functions available: ticks=milliseconds,tickspersec=1000" A00$(18)="tmsec,tsec - Mili/Seconds since the start of TBasic" A00$(19)="day, month, year (as numbers)" A00$(20)="GOSUB workaround: Set a variable to the line number and use Goto to 'return'" A00$(21)="GetKey - returns some key values" .BEGIN timer=MilliSecs() G$=Chr$(34) : H$=Chr$(10) B=FileType(BasicFile$+"0") If B=1 Then Z$="load 0:run" A00$(26)=Z$ Goto AutoRun End If Print "Tiny (Blitz)BASIC v1.1 from Run BASIC's Source code" Print "Type HELP for commands. Use Ctrl+D to stop." Print "" .Ready simpleFlag = False arrayFlag = False If E00$<>"" Then If E>0 Then E00$="#Err at line "+Str$(E)+": "+E00$ Else E00$="#Err: "+E00$ End If Print E00$ : E00$="" End If Print "Ready." .IabInput z$=Input$(">") A00$(26)=Z$ .AutoRun L=26 : C=1 : Gosub GetNumber : E=N If N=0 Then ;No line number If C00$="" Then Goto Ready ;User just hit the return key Goto NextStatement ;Get the next token Else ;Line number Gosub EnterLine ;enter line of code into program If E00$<>"" Then Goto Ready ;branch and display error Goto IabInput ;Get User input End If .Exec ;get the next number If ((MilliSecs()-timer)/1000) Mod 2 = 1 Then Delay 5 ; small delay to release the cpu usage, while running programs Gosub GetNumber : E=N .NextStatement ;ATMP2=GetKey() If KeyDown(29) And KeyDown(32) ;Ctrl+D stops the running program ATMP$="Break in "+Str$(E) Print ATMP$ : Goto Ready End If Gosub GetLabel If E00$<>"" Then Goto Ready Select D$ Case "waitkey" quit=0 Repeat Delay 1 If GetKey()<>0 Then quit=1 Until quit=1 quit=0 Goto FinishStatement Case "if" Gosub GetExpression If E00$<>"" Then Goto Ready If N<1 Then B00$=A00$(L) : C=Len(B00$)+1 Goto FinishStatement End If Gosub GetLabel If E00$<>"" Then Goto Ready If D$<>"then" Then E00$="'THEN' expected" Goto Ready End If Goto NextStatement Case "rem" B00$=A00$(L) : C=Len(B00$)+1 Goto FinishStatement Case "input" Gosub GetVar If E00$<>"" Then Goto Ready N=Input() If arrayFlag Then Array(V)=N Else A(V)=N EndIf Goto FinishStatement Case "print" .LAB_PRINT Gosub SkipSpace Gosub GetChar If C00$=G$ Then ;Print Quoted string B00$="" .NextChar C = C + 1 : C00$=Mid$(ATMP$,C,1) If C00$="" Then E00$="Unterminated string" Goto Ready Else If C00$<>G$ Then ;Anything else than " B00$=B00$+C00$ Goto NextChar End If End If C = C + 1 : C00$=Mid$(ATMP$,C,1) If C00$=G$ Then ;If " is found B00$=B00$+C00$ Goto NextChar End If Write B00$ Else ;Print Expression Gosub GetExpression If E00$<>"" Then Goto Ready B=0 If B=N Then ;if variable is 0, then print a trailing "" Write N+"" Else Write N End If End If Gosub SkipSpace Gosub GetChar If C00$="," Then C = C + 1 : Goto LAB_PRINT Gosub SkipSpace Gosub GetChar If C00$<>";" Then Print Else C = C + 1 End If Goto FinishStatement Case "clear" For I=27 To 52 : A(I)=0 : Next ;clear variables a -- z Dim Array(ArraySize) ; clear the Array Goto FinishStatement Case "run" For I=27 To 52 : A(I)=0 : Next Dim Array(ArraySize) L=27 : C=1 Goto FinishStatement2 Case "goto" Gosub GetExpression If E00$<>"" Then Goto Ready If E>=N Then L=27 C=1 : T=N .NextGoto If L=126 Then E00$="Line not found" Goto Ready End If Gosub GetNumber If N=T Then E=N : Goto NextStatement L = L + 1 : C=1 Goto NextGoto Case "new" For I=27 To 125 : A00$(I)="" : Next For I=27 To 52 : A(I)=0 : Next Dim Array(ArraySize) If E=0 Then Goto FinishStatement Goto Ready Case "cls" Cls : Locate 0,0 :Goto FinishStatement Case "help" For I=9 To 21 B00$=A00$(I) : Print B00$ Next Goto FinishStatement Case "mem" B=126 For I=27 To 125 diffI = 152 - I B00$=A00$(diffI) : If B00$="" Then B=diffI ;Find the first emtpy line, backwards Next B=126-B : Print B+"* lines free" Goto FinishStatement Case "end" Goto Ready Case "bye" Goto ExitTinyBas Case "list" Gosub GetNumber : T=N : A1=L : I=C If T=0 Then Gosub GetLabel If E00$="" And D$="pause" Then I=C E00$="" End If For L=27 To 125 C=1 : Gosub GetNumber B=(T=0) Or (N=T) If B=True Then If ATMP$<>"" Then Print ATMP$ If D$="pause" Then B = (L-26) Mod 10 If B=0 Then Write "Pause..." : AAA$=Input$ ("") End If End If End If Next L=A1 : C=I Goto FinishStatement Case "save" Print "SAVE, # (use 0 for autostart)" Print "Path: "+CurrentDir() Gosub GetExpression If E00$<>"" Then Goto Ready ATMP$=BasicFile$+Str$(N) : A1=False atmp1$="y" If FileType(atmp$)>0 Then ATMp1$=AskInput$("File exists, overwrite?",0) EndIf If atmp1$="y" filetmp=WriteFile(ATMP$) If filetmp<>0 For I=27 To 125 B00$=A00$(I) If B00$<>"" Then WriteLine(filetmp,B00$) : A1=True Next Else Print "Error, unable to write to '"+atmp$+"'" Print "Path: "+CurrentDir$() EndIf CloseFile filetmp ;If A1=False Then DeleteFile(ATMP$) Else Print atmp$+" is not saved." EndIf Goto FinishStatement Case "load" Write "LOADING: " Gosub GetExpression If E00$<>"" Then Goto Ready ATMP$=BasicFile$+Str$(N) B=FileType(ATMP$) If B=0 Then E00$="File "+ATMP$+" not found" Goto Ready End If If B=1 filetmp=ReadFile(ATMP$) B=False : I=27 While B=False B00$=ReadLine(filetmp): A00$(I)=B00$ : I=I+1 B=Eof(filetmp) Wend CloseFile filetmp While I<=125 A00$(I)="" : I=I+1 Wend EndIf If E=0 Then Print "ok" : Goto FinishStatement Goto Ready Case "delete" ;delete a program Gosub GetExpression If E00$<>"" Then Goto Ready ATMP$=BasicFile$+Str$(N) If FileType(atmp$)=1 ATMP1$="Delete "+ATMP$+" forever ?" If AskInput$(atmp1$,2)="y" DeleteFile Atmp$ If FileType(ATMP$)=0 Print "Done" Else Print "unable to delete ?!!" EndIf Else Print "Not done." EndIf Else Print "File "+atmp$+" does not exists." EndIf Goto FinishStatement Case "dir" folder$=CurrentDir() Print "Displaying files in "+Folder$ myDir=ReadDir(folder$) dispdir=0 Write "[" Repeat fileDir$=NextFile$(myDir) If fileDir$="" Then Exit If FileType(folder$+"\"+fileDir$) = 1 Then If dispdir<1 Write LSet(FileDir$,39) dispdir=dispdir+1 Else dispdir=0 Print LSet(" "+FileDir$,39)+"]" Write "[" EndIf EndIf Forever Print "]" CloseDir myDir Goto FinishStatement Case "files" ;list all program files folder$=CurrentDir() Print "Displaying load'able files in "+Folder$ myDir=ReadDir(folder$) DispDir=0 Write "[" Repeat fileDir$=NextFile$(myDir) If fileDir$="" Then Exit If FileType(folder$+"\"+fileDir$) = 1 Then If Left$(Lower$(fileDir$),Len(BasicFile$))=BasicFile$ If dispdir<4 Write LSet(" "+FileDir$,10) dispdir=dispdir+1 Else dispdir=0 Print LSet(" "+FileDir$,10)+" ]" Write "[" EndIf End If EndIf Forever Print "]" CloseDir myDir Goto FinishStatement Case "let" Gosub GetLabel If E00$<>"" Then Goto Ready End Select ;it must be an expression Gosub ReturnVar If E00$<>"" Then Goto Ready Gosub SkipSpace Gosub GetChar If C00$<>"=" Then E00$="'=' expected" Goto Ready End If C = C + 1 : T=V If Not(arrayFlag) Then simpleFlag = True ;Left side is A simple variable Gosub GetExpression If E00$<>"" Then Goto Ready If simpleFlag Then A(T)=N ;set the value of simple variable Else Array(T)=N ;set the value of the Array End If arrayFlag = False : simpleFlag = False .FinishStatement Gosub SkipSpace Gosub GetChar If C00$=":" Then C = C + 1 : Goto NextStatement Else If C00$<>"" Then E00$="End of statement expected" Goto Ready End If End If If L=26 Then Goto Ready L = L + 1 : C=1 If L=126 Then E00$="Program Overflow" Goto Ready End If .FinishStatement2 B00$=A00$(L) If B00$="" Then Goto Ready Goto Exec .ExitTinyBas Print "Thanks for using Tiny BASIC." Print atmp1$=AskInput$("Really quit ?",1) If atmp1$="n" Then Goto Ready End .EnterLine L=27 : C=1 : T=N .NextLine Gosub GetNumber B=(N<T) And (N<>0) And (L<126) If B=True Then L = L + 1 : C=1 : Goto NextLine End If If L=126 Then E00$="Program Overflow" Goto EndEnterLine End If If T<>N Then For I=L To 125 diffI = (125+L)-I B=diffI-1 : A00$(diffI)=A00$(B) Next End If A00$(L)=Z$ Gosub SkipSpace If C00$="" Then For I=L To 124 B=I+1 : A00$(I)=A00$(B) Next End If .EndEnterLine Return .GetExpression ;numeric expressions only A(53)=0 : S=53 Gosub BoolExpression N=A(S) : Goto EndExpression .BoolExpression Gosub AddExpression Gosub SkipSpace Gosub GetChar .NextBool Select C00$ Case "=" C = C + 1 : Gosub AddExpression B=S-1 : A(B)=A(B)=A(S) : S = S - 1 Case ">" C = C + 1 : Gosub GetChar If C00$="=" Then C = C + 1 : Gosub AddExpression B=S-1 : A(B)=A(B)>=A(S) : S = S - 1 Else Gosub AddExpression B=S-1 : A(B)=A(B)>A(S) : S = S - 1 End If Case "<" C = C + 1 : Gosub GetChar Select C00$ Case "=" C = C + 1 : Gosub AddExpression B=S-1 : A(B)=A(B)<=A(S) : S = S - 1 Case ">" C = C + 1 : Gosub AddExpression B=S-1 : A(B)=A(B)<>A(S) : S = S - 1 Default Gosub AddExpression B=S-1 : A(B)=A(B)<A(S) : S = S - 1 End Select End Select Gosub SkipSpace Gosub GetChar B=Asc(C00$) : B=(B>=60) And (B<=62) If B=True Then Goto NextBool Goto EndExpression .AddExpression Gosub MulExpression Gosub SkipSpace Gosub GetChar .NextAdd Select C00$ Case "+" C = C + 1 : Gosub MulExpression B=S-1 : A(B)=A(B)+A(S) : S = S - 1 Case "-" C = C + 1 : Gosub MulExpression B=S-1 : A(B)=A(B)-A(S) : S = S - 1 End Select Gosub SkipSpace Gosub GetChar B=Asc(C00$) : B=(B=43) Or (B=45) If B=True Then Goto NextAdd Goto EndExpression .MulExpression Gosub GroupExpression Gosub SkipSpace Gosub GetChar .NextMul Select C00$ Case "" C = C + 1 : Gosub GroupExpression B=S-1 : A(B)=A(B)A(S) : S = S - 1 Case "/" C = C + 1 : Gosub GroupExpression B=A(S) If B=0 Then If E00$="" Then E00$="Division by zero" S = S - 1 : Goto EndExpression Else B=S-1 : A(B)=A(B)/A(S) : S = S - 1 End If Case " " C = C + 1 : Gosub GroupExpression B=A(S) If B=0 Then If E00$="" Then E00$="Division by zero" S = S - 1 : Goto EndExpression Else B=S-1 : A(B)=A(B) Mod A(S) : S = S - 1 End If End Select Gosub SkipSpace Gosub GetChar B=Asc(C00$) B=(B=42) Or (B=47) Or (B=92) If B=True Then Goto NextMul Goto EndExpression .GroupExpression Gosub SkipSpace Gosub GetChar Select C00$ Case "(" C = C + 1 : Gosub BoolExpression Gosub SkipSpace Gosub GetChar If C00$<>")" Then If E00$="" Then E00$="Missing ')'" Goto EndExpression End If C = C + 1 Case "" If E00$="" Then E00$="Invalid Factor" Default B=Asc(C00$) : B=(B<48) Or (B>57) If B=False Then Gosub GetNumber S = S + 1 : A(S)=N Else Gosub GetLabel If E00$<>"" Then Goto EndExpression B=Len(D$) If B=1 Or (Left$(D$, 2) = "a[" And Right$(D$,1) = "]")Then Gosub ReturnVar S = S + 1 If arrayFlag Then A(S)=Array(V) Else A(S)=A(V) End If Else Select D$ Case "getkey" S = S + 1 : A(S)=GetKey() Case "day" S = S + 1 : A(S)=Left$(CurrentDate$(),2) Case "month" ;DebugLog Mid$(CurrentDate$(),4,3) S = S + 1 : A(S)=Month2Num (Mid$(CurrentDate$(),4,3)) Case "year" S = S + 1 : A(S)=Right$(CurrentDate$(),4) Case "tmsec" S = S + 1 : A(S)=(MilliSecs()-timer) ;MilliSeconds Case "tsec" S = S + 1 : A(S)=(MilliSecs()-timer)/1000 ;Seconds Case "ticks" S = S + 1 : A(S)=MilliSecs() ;TICKS Case "tickspersec" S = S + 1 : A(S)=1000 ;TICKSPERSEC Default If E00$="" Then E00$="Function expected" End Select End If End If End Select .EndExpression Return .GetNumber Gosub SkipSpace B00$="" .NextNumber Gosub GetChar If C00$="" Then Goto GetNumberExit B=Asc(C00$) B=((B<48) Or (B>57)) And (B<>46) If B=True Then Goto GetNumberExit B00$=B00$+C00$ : C = C + 1 : Goto NextNumber .GetNumberExit N=B00$ Return .GetVar Gosub GetLabel If E00$<>"" Then Goto GetVarExit .ReturnVar arrayFlag = False If Left$(D$,2) = "a[" And Right$(D$,1) = "]" Then ;possible Array variable (i.e. A() ) Gosub ExtractArrayIndex Else ;simple variable (i.e. A-z) B=Asc(D$) : A1=Len(D$) A1=(A1<>1) Or (B<97) Or (B>122) If A1=False Then V=B-70 Else If E00$="" Then E00$="Variable expected" End If End If .GetVarExit Return .GetLabel Gosub SkipSpace Gosub GetChar D$="" If C00$="" Then Goto GetLabelError B=Asc(C00$) : B=((B>=97) And (B<=122)) Or (B=91) Or (B=93) Or ((B>=48) And (B<=57)) ;letters, parentheses And digits are OK If B=False Then Goto GetLabelError .GetNextLabel D$=D$+C00$ : C = C + 1 Gosub GetChar If C00$="" Then Goto GetLabelExit B=Asc(C00$) : B=((B>=97) And (B<=122)) Or (B=91) Or (B=93) Or ((B>=48) And (B<=57)) ;letters, parentheses And digits are OK If B=True Then Goto GetNextLabel Goto GetLabelExit .GetLabelError If E00$="" Then E00$="Invalid label" .GetLabelExit Return .SkipSpace Gosub GetChar If C00$=" " Then C = C + 1 : Goto SkipSpace Return .GetChar ;get the next character and change it to lowercase ATMP$=A00$(L) ;efficient? This assignment is made before retrieving each character. C00$=Mid$(ATMP$,C,1) : C00$=Lower$(C00$) Return .ExtractArrayIndex ;get the Array index ;the index can be A number Or A simple variable Atmp$=Mid$(D$,3,(Len(D$)-3)) A1 = Atmp$ If A1 = 0 Then ;'index is 0 Or it's A variable B = Asc(Lower$(Atmp$)) If (B >= 97) And (B <= 122) Then ;'it's A variable arrayFlag = True V = A(B-70) ;'get the index value If V = 0 Then If E00$="" Then E00$="Array index should be between 1 and "+Str$(ArraySize) End If Else If E00$="" Then E00$="Array index should be between 1 and "+Str$(ArraySize) End If Else If A1 > ArraySize Then If E00$="" Then E00$="Array index should be between 1 and "+ Str$(ArraySize) Else arrayFlag = True V = A1 ;must use Array flag to determine where to use the V index End If End If Return Function AskInput$(txt$,def=0) If def=1 Then atmp2$="y" If def=2 Then atmp2$="n" If def>0 Then atmp3$=" [def="+atmp2$+"]" Repeat ATMp1$=Lower$(Input$(txt$+" (Yes/No"+atmp3$+") >")) If Len (atmp1$)>1 Then atmp1$=Left$(atmp1$,1) If atmp1$="" If def>0 Then atmp1$=atmp2$ EndIf Until ATMP1$="y" Or atmp1$="n" Return atmp1$ End Function Function Month2Num(mon$) For x=1 To 12 ;Print Mid$("janfebmaraprmaijunjulaugsepoktnovdec",(x3)-2,3) If Lower$(mon$)=Mid$("janfebmaraprmayjunjulaugsepoctnovdec",(x3)-2,3) Exit EndIf Next Return x End Function --v The only untested thing is the Month2Num function, as i'm not sure if it will work on every PC (language-wise) as it is. Edit (4/May/2018) bugfixed version:The older code contained a bug where some functions calls after parentheses would cause an error. Now the array has the [ ] Brackets instead of normal ( ) ones.
Sat, 28 Apr 2018, 11:08
Pakz	I noticed a free book a time ago called eloquent javascript and it had a chapter(s?) on creating your own programming language. Yesterday I was thinking I might have a go at figuring out how to add a programming language into my voxel world. But creating a programming language or script language even might be to difficult for me still. The code here might be useful for me for reference later
Fri, 11 May 2018, 03:47
Dan	How complicated a scripting/programming language can get, depends on what your script shall do. I'v found a simple command-executing thing, over on german's blitzbasic forum : commandline interpreter and replaced the IF statements with Select/Case: Graphics 800,600,32,2 Graphics 800,600,32,3 ChangeDir("c:\") Pfad$=CurrentDir$() Local CMDLINE$,CMDLINE1$,d=1,CMD$,CMDPAR$ Repeat CMDLINE$=Input$(Pfad$+">") CMDLINE1$=Lower$(CMDLINE$) i=Instr(CMDLINE$," ") ;check if the input string contains spaces, as delimiter If i Then ;Does the input contain parameters ? yes: CMD$=Left(CMDLINE1$,i-1) ;get the first command CMDPAR$=Right(CMDLINE$,Len(CMDLINE$)-i) ;and set the parameters in CMDPAR$ Else ;no? then it is only a sigle command CMD$=CMDLINE$ CMDPAR$="" End If Select CMD$ Case "quit" End Case "cls" Cls Locate 0,0 Case "dir" Verz=ReadDir(pfad$) Repeat Datei$=NextFile$(Verz) If Datei$="" Then Exit If FileType(pfad$+Datei$) = 2 Then Print ">>" + Datei$ + "<<" Else Print Datei$ End If Forever CloseDir Verz Print Case "help" Print "OpenSource BlitzBasic UserInterface" Print "" Print "Dir - Directory of "+pfad$ Print "Cls - Clear screen" Print "Print <text> - Display text" Print "echo - turn on/off the error message" Print "Quit - End" Case "echo" d=-d If d=1 Then Print "On" If d<>1 Then Print "Off" Case "print" Print CMDPAR$ Default If d=1 Then Print "Syntax error." End Select Until KeyDown(1) End --v Its nice for a start. The next steps would be to parse the arguments, add variables (if needed), read the script out of the array instead of the input line ...
Fri, 11 May 2018, 16:53
Dabz	I did this... https://sourceforge.net/p/bamboobasic/wiki/Home/ But bare in mind, I'm a plasterer, so the code may seem a mess... But... It worked! I also recommend if your interested in languages for just a peek, then take a look at the Linux Vala source... Vala is lovely! Dabz -=-=- Intel Core i5 6400 2.7GHz, NVIDIA GeForce GTX 1070 (8GB), 8Gig DDR4 RAM, 256GB SSD, 1TB HDD, Windows 10 64bit
Sun, 27 May 2018, 03:05
Dan	Here is another version of TinyBbasic (v1.2). Some of the Variables have been renamed, the limit of 99 lines per script has been changed to 1000 (can be increased/decreased in this source). 1x 2d and 1x 3d array access and some graphic functions have been added. (type HELP for all commands) Blitzbasic commands can be easilly wrapped for use with TBB. Loading and Saving programs work with filename instead of numbers, and reloading the last saved/loaded filename is possible, in case you want to edit the program with Notepad/CrimsonED etc. ;TinyBasic.bas ; ;a@oO0 A4 2Zz 5S$s 8B 9g 6G mnnm %X# t+ :.;, [{( )}] 1lLiI\| ;Font testing - Similar chars. ; ; tinyBasic v1.0 - A very small and simple BASIC interpreter written in ; Run BASIC. WARNING: For uber geeks only. :-p ; Copyleft 2005 by Laurent DUVEAU ; www.aldweb.com ; an iziBasic sample program ; Ported to Run BASIC by Carl Gundel and Scott McLaughlin ; www.libertybasic.com ; ' http://www.runbasic.com ; ; 'Version 1.1 (Will run on Liberty BASIC 4.03 and Run BASIC build 2.27) ; 'by David den Haring (8/15/2007) ; 'The purpose of this release is to add enough features to Tiny Basic in order to run the Sieve benchmark. ; 'Added a fixed array accessible from the interpreter (i.e. a() ) ; ; Ported to Blitzbasic (b3d) by Dan - now V1.2 ; A1 temp ; B temp ; C character index in line ; E line number for error msg ; I temp (loops) ; L number of lines ; N number ; S expression stack index ; T temp ; V variable index ; ATMP$ temp ; B00$ temp ; char$ character ; D$ single statement ; Err$ error message ; G$ string code (") ; H$ HALT code (Line Feed) ; I$-R$ Help ; Z$=PROG$(0) statement input ;tmsec contains Milliseconds, tsec contains milliseconds()/1000, reseted to 0 at every start of the interpteter, using the timer=Millisec FntName$="Blitz" FntSize=10 Include "ScreenIni.bb" ;If you comment this line, uncomment the next 2 graphic calls ;Graphics 640,480,32,2 ;Graphics 640,480,32,3 Const BasicFile$=".bas" ;Used to determine the filename of the TinyBasic programs (save/load/delete/dir) AppTitle "Tiny (Blitz)Basic" ;SetBuffer BackBuffer() ;SeedRnd MilliSecs() Font=LoadFont(Fntname$,FntSize,False,False,False) ;Font=LoadFont("Blitz",10,False,False,False) ;Font=LoadFont("MyPC_Dos_Font",12,False,False,False) ;Font=LoadFont("My Cpc Font",6,False,False,False) ;Font=LoadFont("MyAmigaFont",6,False,False,False) ;Font=LoadFont("Topaz",11,False,False,False) SetFont Font cmdline$=Lower$(CommandLine$()) If cmdline$<>"" If cmdline$="white" Then cmdline$="" Else If iCol$="white" Then iCol$="" cmdline$=iCol$ iCol$="" EndIf Select cmdline$ Case "black" ClsColor $0,0,0 Color $ff,$Ff,$FF Case "green" ClsColor $0,$40,0 Color $0,$ff,$0 Case "red" ClsColor $40,0,0 Color $ff,$0,$0 Case "blue" ClsColor 0,0,$50 Color $80,$80,$ff Case "orange" ClsColor $0,0,0 Color $ff,$a5,0 Case "yellow" ClsColor $FF,$FF,$0 Color 0,$0,$0 Case "gold" ClsColor $A3,$9F,$34 Color 255,255,23 Case "" ClsColor $ff,$ff,$ff Color 0,0,0 Default ClsColor $FF,$ff,$FF Color $0,$0,$ff End Select Cls Const maxlines=1000 Dim PROG$(maxlines) ;program lines Dim A(82) ; [27-52] = 26 variables ; [53-82] = 30 items math stack Const ArraySize = 7001 ; Size of user Array Dim Array(ArraySize) Local A2d1=1,A2d2=1,A2dMax=2000 Dim Array2d(A2d1,A2d2) Local A3d1=1,A3d2=1,A3d3=1 Dim Array3d(A3d1,A3d2,A3d3) ;Dim rgb(3,1) ;RGB colors 0=BG, 1=Text Dim rndnr(1) Global PRUN=0,Err$="",Errlast$="" Const parmax=24 ;How many parameters, adjust the partxt$ if you want to raise Dim par(parmax) ;Holding Parameter (to reuse code) Par(0) holds the count of parameters to get Const partxt$="01st02nd03rd04th05th06th07th08th09th10th11th12th13th14th15th16th17th18th19th20th21st22nd23rd24th" Const hexstr$="0123456789abcdef" Type seek Field x End Type Global pos.seek = New seek .BEGIN timer=MilliSecs() G$=Chr$(34) : H$=Chr$(10) B=FileType("autoload.bas") rndnr(0)=0 rndnr(1)=1 If B=1 Then Z$="load "+G$+"autoload"+G$+":run" PROG$(0)=Z$ Goto AutoRun End If Print "Tiny (Blitz)BASIC v1.2 from Run BASIC's Source code" Print "Type HELP for commands. Use Ctrl+D to stop." Print "" .Ready simpleFlag = False arrayFlag = False If Err$<>"" Then If E>0 Then Err$="#Err at line "+Str$(E)+": "+Err$ Else Err$="#Err: "+Err$ End If Print Err$ : Errlast$=Err$ : Err$="" End If Print "Ready." .IabInput PRUN=0 z$=Input$(">") PROG$(0)=Z$ .AutoRun L=0 : C=1 : Gosub GetNumber : E=N If N=0 Then ;No line number If char$="" Then Goto Ready ;User just hit the return key Goto NextStatement ;Get the next token Else ;Line number Gosub EnterLine ;enter line of code into program If Err$<>"" Then Goto Ready ;branch and display error Goto IabInput ;Get User input End If .Exec ;get the next number ;If ((MilliSecs()-timer)/1000) Mod 2 = 1 Then Delay 5 ; small delay to release the cpu usage, while running programs Gosub GetNumber : E=N PRUN=1 .NextStatement ;ATMP2=GetKey() If KeyDown(29) And KeyDown(32) ;Ctrl+D stops the running program ATMP$="Break in "+Str$(E) Print ATMP$ : Goto Ready End If Gosub GetLabel If Err$<>"" Then Goto Ready Select D$ Case "waitkey" quit=0 Repeat Delay 1 If GetKey()<>0 Then quit=1 Until quit=1 quit=0 Goto FinishStatement Case "if" Gosub GetExpression If Err$<>"" Then Goto Ready If N<1 Then B00$=PROG$(L) : C=Len( B00$)+1 Goto FinishStatement End If Gosub GetLabel If Err$<>"" Then Goto Ready If D$<>"then" Then Err$="'THEN' expected" Goto Ready End If Goto NextStatement Case "rem" B00$=PROG$(L) : C=Len(B00$)+1 Goto FinishStatement Case "input" Gosub GetVar If Err$<>"" Then Goto Ready N=Input() If arrayFlag Then Array(V)=N Else A(V)=N EndIf Goto FinishStatement Case "print" .LAB_PRINT Gosub SkipSpace Gosub GetChar If char$=G$ Then ;Print Quoted string B00$="" Gosub NextStringMember If Err$<>"" Then Goto Ready Write B00$ Else ;Print Expression Gosub GetExpression If Err$<>"" Then Goto Ready B=0 Write N End If Gosub SkipSpace Gosub GetChar If char$="," Then C = C + 1 : Goto LAB_PRINT Gosub SkipSpace Gosub GetChar If char$<>";" Then Print Else C = C + 1 End If Goto FinishStatement Case "clear" For I=27 To 52 : A(I)=0 : Next ;clear variables a -- z Dim Array(ArraySize) ; clear the Array Dim Array2d(ArraySize,ArraySize) A3d1=1 : A3d2=1 : A3d3=1 Dim Array3d(A3d1,A3d2,A3d3) rndnr(0)=0 : rndnr(1)=1 Err$="" Goto FinishStatement Case "run" For I=27 To 52 : A(I)=0 : Next Dim Array(ArraySize) L=1 : C=1 Goto FinishStatement2 Case "goto" Gosub GetExpression If Err$<>"" Then Goto Ready If E>=N Then L=1 C=1 : T=N .NextGoto If L=maxlines+1 Then Err$="Line not found" Goto Ready End If Gosub GetNumber If N=T Then E=N : Goto NextStatement L = L + 1 : C=1 Goto NextGoto Case "new" For I=1 To maxlines : PROG$(I)="" : Next For I=27 To 52 : A(I)=0 : Next Dim Array(ArraySize) Dim Array2d(ArraySize,ArraySize) A3d1=1 : A3d2=1 : A3d3=1 Dim Array3d(A3d1,A3d2,A3d3) rndnr(0)=0 : rndnr(1)=1 Err$="" AppTitle "Tiny (Blitz)Basic" If E=0 Then Goto FinishStatement Goto Ready Case "cls" Cls : Locate 0,0 :Goto FinishStatement Case "help" Print Print "BYE, CLEAR, CLS, END, HELP, MEM, NEW, RUN, GOTO, RL" Print "LOAD "+G$+"NAME"+G$+" \| SAVE "+G$+"NAME"+G$+" \| DELETE "+G$+"NAME"+G$+" \| TYPE "+G$+"filename.ext"+G$ Print "INPUT <var> \| FILES \| DIR \| WAITKEY \| APP "+G$+"text"+G$ Print "IF <exp> THEN <statement> \| REM <any> \| WHY " Print "[LET] <var>=<exp> \| LIST [<exp\|var>] (hold Shift for Slowdown)" Print "PRINT <exp\|str>[,<exp\|str>][;] \| Locate x,y" Print "SEED <exp\|var> \| SETRND lo,hi (default= 0,1)" Print "1D Array: a[1] to a["+Str$(ArraySize)+ "]" Print "2D array: A2d x,y,nr DimA2d x,y ("+A2d1+","+A2d2+" max="+A2dMax+")" Print "3D Array: A3d x,y,z,nr DimA3d x,y,z ("++A3d1+","+A3d2+","+A3d3+" max=500)" Print Print "Functions available: ticks (=milliseconds),tickspersec (=1000)" Print "msec,sec - Mili/Seconds since the start of TBasic" Print "day, month, year (as numbers) \| mb/mx/my - Mouse functions" Print "getkey - returns ASCII keyboard values \| rnd \| a2d x,y \| a3d x,y,z" Print Print "Graphic commands:" Print "PEN r,g,b \| PAPER r,g,b \| PLOT x,y \| LINE x,y,x1,y1" Print "BOX/BAR x,y,w,h \| CIRCLE x,y,w,h[,filled=1] \| Print Print "> Numeric variables available from 'a' to 'z'" Print "> GOSUB workaround: Set a variable to the line number and use Goto to 'return'" Print "> .bas is added to each filename in load/save/delete commands ! " Print "> autoload.bas is starting automatically with TinyBBasic" Print "> type is used to display text files on screen" Print "rl - reloads the last file used by Load/Save" Goto FinishStatement Case "mem" B=126 For I=1 To maxlines diffI = maxlines - I B00$=PROG$(diffI) : If B00$="" Then B=diffI ;Find the first emtpy line, backwards Next B=(maxlines+1)-B : Print B+" * lines free" Goto FinishStatement Case "end" Goto Ready Case "bye" If PRUN=0 Then Goto ExitTinyBas EndIf B00$=PROG$(L) : C=Len(B00$)+1 Goto FinishStatement Case "why" If PRUN=1 B00$=PROG$(L) : C=Len(B00$)+1 Goto FinishStatement EndIf Print Errlast$ Goto FinishStatement Case "list" ;Gosub GetNumber Gosub GetExpression T=N : A1=L : I=C If T=0 Then Gosub GetLabel If Err$="" And D$="pause" Then I=C Err$="" End If For L=1 To maxlines C=1 : Gosub GetNumber B=(T=0) Or (N=T) If B=True Then If ATMP$<>"" Then Delay 35 If KeyDown(42) Or KeyDown(54) Then Delay 350 ;Shift for delay If KeyDown(29) And KeyDown(32) Then Print "Stopped" : Exit ;Ctrl+D stops the Listing Print ATMP$ End If End If Next L=A1 : C=I Goto FinishStatement Case "save" Gosub GetStringLiteral If PRUN=1 Then Goto FinishStatement ;Saving is enabled only in direct mode ! If B00$="" And Err$="" Then Err$="Missing filename !" If Err$<>"" Then Goto Ready Print "Saving" ATMP$=B00$+BasicFile$ : A1=False atmp1$="y" If FileType(atmp$)>0 Then Print "Path: "+CurrentDir() ATMp1$=AskInput$("File exists, overwrite?",0) EndIf If atmp1$="y" filetmp=WriteFile(ATMP$) If filetmp<>0 For I=1 To maxlines B00$=PROG$(I) If B00$<>"" Then WriteLine(filetmp,B00$) : A1=True Next Else Print "Error, unable to write to '"+atmp$+"'" Print "Path: "+CurrentDir$() EndIf CloseFile filetmp filename$=Atmp$ ;If A1=False Then DeleteFile(ATMP$) Else Print atmp$+" is not saved." EndIf Goto FinishStatement Case "load" Write "LOADING: " Gosub GetStringLiteral If Err$<>"" Then Goto Ready ATMP$=B00$+BasicFile$ B=FileType(ATMP$) If B=0 Then Err$="File "+ATMP$+" not found" Goto Ready End If If B=1 filetmp=ReadFile(ATMP$) B=False : I=1 While B=False B00$=ReadLine(filetmp): PROG$(I)=B00$ : I=I+1 B=Eof(filetmp) Wend CloseFile filetmp While I<=maxlines PROG$(I)="" : I=I+1 Wend EndIf If E=0 Then Print "ok" : filename$=Atmp$ : Goto FinishStatement Goto Ready Case "rl" If PRUN=0 If filename$<>"" Write "ReLOADING :"+filename$ ATMP$=filename$ B=FileType(ATMP$) If B=0 Then Err$="File "+ATMP$+" not found" Goto Ready End If If B=1 filetmp=ReadFile(ATMP$) B=False : I=1 While B=False B00$=ReadLine(filetmp): PROG$(I)=B00$ : I=I+1 B=Eof(filetmp) Wend CloseFile filetmp While I<=maxlines PROG$(I)="" : I=I+1 Wend EndIf E=0 If E=0 Then Print " ... ok" : filename$=Atmp$ : Goto FinishStatement Else Print "No Filename. Either load or save first." EndIf Goto Ready EndIf Goto FinishStatement Case "delete" ;delete a program Gosub GetStringLiteral If Err$<>"" Then Goto Ready ATMP$=b00$+BasicFile$ If FileType(atmp$)=1 ATMP1$="Delete "+ATMP$+" forever ?" If AskInput$(atmp1$,2)="y" DeleteFile Atmp$ If FileType(ATMP$)=0 Print "Done" Else Print "unable to delete ?!!" EndIf Else Print "Not done." EndIf Else Print "File "+atmp$+" does not exists." EndIf Goto FinishStatement Case "dir" folder$=CurrentDir() Print "Displaying files in "+Folder$ myDir=ReadDir(folder$) dispdir=0 Write "[" Repeat fileDir$=NextFile$(myDir) If fileDir$="" Then Exit If FileType(folder$+"\"+fileDir$) = 1 Then If dispdir<1 Write LSet(FileDir$,39) dispdir=dispdir+1 Else dispdir=0 Print LSet(" "+FileDir$,39)+"]" Write "[" EndIf EndIf Forever Print "]" CloseDir myDir Goto FinishStatement Case "type" Gosub GetStringLiteral If Err$<>"" Then Goto Ready ATMP$=B00$ B=FileType(ATMP$) If B=0 Then Goto FinishStatement ; File not found, do nothing If B=1 Display(ATMP$,31) EndIf Goto FinishStatement Case "debug" Print "is program running: "+PRUN Print "Last filename: "+filename$ Goto FinishStatement Case "files" ;list all program files folder$=CurrentDir() Print "Load'able files in "+Folder myDir=ReadDir(folder$) DispDir=0 Write "[" Repeat fileDir$=NextFile$(myDir) If fileDir$="" Then Exit If FileType(folder$+"\"+fileDir$) = 1 Then If Right$(Lower$(fileDir$),Len(BasicFile$))=BasicFile$ fileDir$=Left$(filedir$,Len(filedir$)-Len(BasicFile$)) If dispdir<2 Write LSet(FileDir$,25) dispdir=dispdir+1 Else dispdir=0 Print LSet(" "+FileDir$,25)+" ]" Write "[" EndIf End If EndIf Forever Print "]" CloseDir myDir Goto FinishStatement Case "let" Gosub GetLabel If Err$<>"" Then Goto Ready Case "app" Gosub GetStringLiteral If Err$<>"" Then Goto Ready AppTitle b00$ Goto FinishStatement Case "locate" par(0)=2 Gosub GetParam If Err$<>"" Then Goto Ready Locate par(1),par(2) Goto FinishStatement Case "pen" par(0)=3 Gosub GetParam If Err$<>"" Then Goto Ready Color par(1),par(2),par(3) Goto FinishStatement Case "paper" par(0)=3 Gosub GetParam If Err$<>"" Then Goto Ready ClsColor par(1),par(2),par(3) Goto FinishStatement Case "setrnd" par(0)=2 Gosub GetParam If Err$<>"" Then Goto Ready rndnr(0)=par(1) : rndnr(1)=par(2) Goto FinishStatement Case "seed" par(0)=1 Gosub GetParam If Err$<>"" Then Goto Ready SeedRnd par(1) Goto FinishStatement Case "plot" par(0)=2 Gosub GetParam If Err$<>"" Then Goto Ready Plot par(1),par(2) Goto FinishStatement Case "line" par(0)=4 Gosub GetParam If Err$<>"" Then Goto Ready Line par(1),par(2),par(3),par(4) Goto FinishStatement Case "box" par(0)=4 Gosub GetParam If Err$<>"" Then Goto Ready Rect par(1),par(2),par(3),par(4),0 Goto FinishStatement Case "bar" par(0)=4 Gosub GetParam If Err$<>"" Then Goto Ready Rect par(1),par(2),par(3),par(4),1 Goto FinishStatement Case "circle" par(0)=4 Gosub GetParam If Err$<>"" Then Goto Ready Gosub SkipSpace Gosub GetChar N=0 If char$="," Then ;is there a comma after 4th parameter ? if yes, get the number and set it for the filled circle C = C + 1 Gosub GetExpression If Err$<>"" Then Goto Ready B=0 If N<>0 Then N=1 EndIf Oval par(1),par(2),par(3),par(4),N Goto FinishStatement Case "dima2d" par(0)=2 Gosub GetParam If Err$<>"" Then Goto Ready A2d1=par(1) : A2d2=par(2) If A2d1>A2dMax Or A2d2>A2dMax Then Err$="2D Array index has to be 0-"+A2dMax : Goto Ready Dim Array2d(A2d1,A2d2) Goto FinishStatement Case "a2d" ;a2d x,y,z simulate as a2d(x,y)=z par(0)=3 Gosub GetParam If Err$<>"" Then Goto Ready If par(1)>ArraySize Or par(2)>ArraySize Then Err$="2D Array index out of bounds" : Goto Ready Array2d(par(1),par(2))=par(3) Goto FinishStatement Case "dima3d" par(0)=3 Gosub GetParam If Err$<>"" Then Goto Ready A3d1=par(1) : A3d2=par(2) : A3d3=par(3) If A3d1>500 Or A3d2>500 Or A3d3>500 Then Err$="3D Array index has to be 0-500" : Goto Ready Dim Array3d(A3d1,A3d2,A3d3) Goto FinishStatement Case "a3d" par(0)=4 Gosub GetParam If Err$<>"" Then Goto Ready If par(1)>A3d1 Or par(2)>A3d2 Or par(3)>A3d3 Then Err$="3D Array index out of bounds" : Goto Ready Array3d(par(1),par(2),par(3))=par(4) Goto FinishStatement ; Case "command" ; par(0)=2 ; Gosub GetParam ; If Err$<>"" Then Goto Ready ; command par(1),par(2),par(3),par(4),par(5),par(6),par(7),par(8),par(9) ... ; Goto FinishStatement End Select ;it must be an expression Gosub ReturnVar If Err$<>"" Then Goto Ready Gosub SkipSpace Gosub GetChar If char$<>"=" Then Err$="'=' expected" Goto Ready End If C = C + 1 : T=V If Not(arrayFlag) Then simpleFlag = True ;Left side is A simple variable Gosub GetExpression If Err$<>"" Then Goto Ready If simpleFlag Then A(T)=N ;set the value of simple variable Else Array(T)=N ;set the value of the Array End If arrayFlag = False : simpleFlag = False .FinishStatement Gosub SkipSpace Gosub GetChar If char$=":" Then C = C + 1 : Goto NextStatement Else If char$<>"" Then Err$="End of statement expected" Goto Ready End If End If If L=0 Then Goto Ready L = L + 1 : C=1 If L=maxlines+1 Then Err$="Program Overflow" Goto Ready End If .FinishStatement2 B00$=PROG$(L) If B00$="" Then Goto Ready Goto Exec .ExitTinyBas Print "Thanks for using Tiny BASIC." Print atmp1$=AskInput$("Really quit ?",1) If atmp1$="n" Then Goto Ready End .GetParam ;you have to check for error after return ! ;set par(0) to the number of parameters which your function needs (1-9) If par(0)=0 Then Err$="Par(0) needs to be set to 1~"+parmax Return EndIf If par(0)>parmax Then Err$="Par(0) is higher than "+parmax Return EndIf Gosub GetExpression If Err$<>"" Then Return par(1)=n If par(0)=1 Then Return For x=2 To par(0) Gosub GetChar If char$<>"," Then Err$="Comma expected after "+d$+"'s "+Mid$(partxt$,(((x-2)4)+1),4)+" parameter" Return EndIf c=c+1 Gosub GetExpression If Err$<>"" Then Return par(x)=n Next Return .EnterLine L=1 : C=1 : T=N .NextLine Gosub GetNumber B=(N<T) And (N<>0) And (L<(maxlines+1)) If B=True Then L = L + 1 : C=1 : Goto NextLine End If If L=maxlines+1 Then Err$="Program Overflow" Goto EndEnterLine End If If T<>N Then For I=L To maxlines diffI = (maxlines+L)-I B=diffI-1 : PROG$(diffI)=PROG$(B) Next End If ;DebugLog "l="+l PROG$(L)=Z$ Gosub SkipSpace If char$="" Then For I=L To maxlines-2 B=I+1 : PROG$(I)=PROG$(B) ;DebugLog "PROG$(B)="+PROG$(B) Next End If .EndEnterLine Return .GetExpression ;numeric expressions only A(53)=0 : S=53 Gosub BoolExpression N=A(S) : Goto EndExpression .BoolExpression Gosub AddExpression Gosub SkipSpace Gosub GetChar .NextBool Select char$ Case "=" C = C + 1 : Gosub AddExpression B=S-1 : A(B)=A(B)=A(S) : S = S - 1 Case ">" C = C + 1 : Gosub GetChar If char$="=" Then C = C + 1 : Gosub AddExpression B=S-1 : A(B)=A(B)>=A(S) : S = S - 1 Else Gosub AddExpression B=S-1 : A(B)=A(B)>A(S) : S = S - 1 End If Case "<" C = C + 1 : Gosub GetChar Select char$ Case "=" C = C + 1 : Gosub AddExpression B=S-1 : A(B)=A(B)<=A(S) : S = S - 1 Case ">" C = C + 1 : Gosub AddExpression B=S-1 : A(B)=A(B)<>A(S) : S = S - 1 Default Gosub AddExpression B=S-1 : A(B)=A(B)<A(S) : S = S - 1 End Select End Select Gosub SkipSpace Gosub GetChar B=Asc(char$) : B=(B>=60) And (B<=62) If B=True Then Goto NextBool Goto EndExpression .AddExpression Gosub MulExpression Gosub SkipSpace Gosub GetChar .NextAdd Select char$ Case "+" C = C + 1 : Gosub MulExpression B=S-1 : A(B)=A(B)+A(S) : S = S - 1 Case "-" C = C + 1 : Gosub MulExpression B=S-1 : A(B)=A(B)-A(S) : S = S - 1 End Select Gosub SkipSpace Gosub GetChar B=Asc(char$) : B=(B=43) Or (B=45) If B=True Then Goto NextAdd Goto EndExpression .MulExpression Gosub GroupExpression Gosub SkipSpace Gosub GetChar .NextMul Select char$ Case "" C = C + 1 : Gosub GroupExpression B=S-1 : A(B)=A(B)A(S) : S = S - 1 Case "/" C = C + 1 : Gosub GroupExpression B=A(S) If B=0 Then If Err$="" Then Err$="Division by zero" S = S - 1 : Goto EndExpression Else B=S-1 : A(B)=A(B)/A(S) : S = S - 1 End If Case " " C = C + 1 : Gosub GroupExpression B=A(S) If B=0 Then If Err$="" Then Err$="Division by zero" S = S - 1 : Goto EndExpression Else B=S-1 : A(B)=A(B) Mod A(S) : S = S - 1 End If End Select Gosub SkipSpace Gosub GetChar B=Asc(char$) B=(B=42) Or (B=47) Or (B=92) If B=True Then Goto NextMul Goto EndExpression .GroupExpression Gosub SkipSpace Gosub GetChar Select char$ Case "(" C = C + 1 : Gosub BoolExpression Gosub SkipSpace Gosub GetChar If char$<>")" Then If Err$="" Then Err$="Missing ')'" Goto EndExpression End If C = C + 1 Case "" If Err$="" Then Err$="Invalid Factor" Default B=Asc(char$) : B=(B<48) Or (B>57) If B=False Then Gosub GetNumber S = S + 1 : A(S)=N Else Gosub GetLabel If Err$<>"" Then Goto EndExpression B=Len(D$) If B=1 Or (Left$(D$, 2) = "a[" And Right$(D$,1) = "]")Then Gosub ReturnVar S = S + 1 If arrayFlag Then A(S)=Array(V) Else A(S)=A(V) End If Else Select D$ Case "getkey" S = S + 1 : A(S)=GetKey() Case "day" S = S + 1 : A(S)=Left$(CurrentDate$(),2) Case "month" ;DebugLog Mid$(CurrentDate$(),4,3) S = S + 1 : A(S)=Month2Num (Mid$(CurrentDate$(),4,3)) Case "year" S = S + 1 : A(S)=Right$(CurrentDate$(),4) Case "msec" S = S + 1 : A(S)=(MilliSecs()-timer) ;MilliSeconds Case "sec" S = S + 1 : A(S)=(MilliSecs()-timer)/1000 ;Seconds Case "ticks" S = S + 1 : A(S)=MilliSecs() ;TICKS Case "tickspersec" S = S + 1 : A(S)=1000 ;TICKSPERSEC Case "mb" S = S + 1 : A(S)=MouseDown(1)+(MouseDown(2)2)+(MouseDown(3)*4) Case "mx" S = S + 1 : A(S)=MouseX() Case "my" S = S + 1 : A(S)=MouseY() Case "rnd" S = S + 1 : A(S)=Rand(rndnr(0),rndnr(1)) Case "isrun" S = S + 1 : A(S)=PRUN Case "a2d" par(0)=2 Gosub GetParam If Err$<>"" Then Goto EndExpression If par(1)>A2dMax Or par(1)>A2dMax Then Err$="2d Array index out of bounds" : Goto EndExpression S = S + 1 : A(S)=Array2d(par(1),par(2)) Case "a3d" par(0)=3 Gosub GetParam If Err$<>"" Then Goto EndExpression If par(1)>A3d1 Or par(2)>A3d2 Or par(3)>A3d3 Then Err$="3d Array index out of bounds" : Goto Ready S = S + 1 : A(S)=Array3d(par(1),par(2),par(3)) Default If Err$="" Then Err$="Function expected >"+D$+"<" End Select End If End If End Select .EndExpression Return .GetNumber Gosub SkipSpace B00$="" .NextNumber Gosub GetChar If char$="" Then Goto GetNumberExit B=Asc(char$) B=((B<48) Or (B>57)) And (B<>46) If B=True Then Goto GetNumberExit B00$=B00$+char$ : C = C + 1 : Goto NextNumber .GetNumberExit N=B00$ Return .GetVar Gosub GetLabel If Err$<>"" Then Goto GetVarExit .ReturnVar arrayFlag = False If Left$(D$,2) = "a[" And Right$(D$,1) = "]" Then ;possible Array variable (i.e. A() ) Gosub ExtractArrayIndex Else ;simple variable (i.e. A-z) B=Asc(D$) : A1=Len(D$) A1=(A1<>1) Or (B<97) Or (B>122) If A1=False Then V=B-70 Else If Err$="" Then Err$="Variable expected" End If End If .GetVarExit Return .GetLabel Gosub SkipSpace Gosub GetChar D$="" If char$="" Then Goto GetLabelError B=Asc(char$) : B=((B>=97) And (B<=122)) Or (B=91) Or (B=93) Or ((B>=48) And (B<=57)) ;letters, [] And digits are OK If B=False Then Goto GetLabelError .GetNextLabel D$=D$+char$ : C = C + 1 Gosub GetChar If char$="" Then Goto GetLabelExit B=Asc(char$) : B=((B>=97) And (B<=122)) Or (B=91) Or (B=93) Or ((B>=48) And (B<=57)) ;letters, [] And digits are OK If B=True Then Goto GetNextLabel Goto GetLabelExit .GetLabelError If Err$="" Then Err$="Invalid label" .GetLabelExit Return .SkipSpace Gosub GetChar If char$=" " Then C = C + 1 : Goto SkipSpace Return .GetChar ;get the next character and change it to lowercase ATMP$=PROG$(L) ;efficient? This assignment is made before retrieving each character. char$=Mid$(ATMP$,C,1) : char$=Lower$(char$) Return .GetStringLiteral Gosub SkipSpace Gosub GetChar If char$=G$ Then B00$="" .NextStringMember C = C + 1 : char$=Mid$(ATMP$,C,1) If char$="" Then Err$="Unterminated string" Return Else If char$<>G$ Then B00$=B00$+char$ Goto NextStringMember End If End If C = C + 1 : char$=Mid$(ATMP$,C,1) If char$=G$ Then B00$=B00$+char$ Goto NextStringMember End If End If Return .ExtractArrayIndex ;get the Array index ;the index can be A number Or A simple variable Atmp$=Mid$(D$,3,(Len(D$)-3)) A1 = Atmp$ If A1 = 0 Then ;'index is 0 Or it's A variable B = Asc(Lower$(Atmp$)) If (B >= 97) And (B <= 122) Then ;'it's A variable arrayFlag = True V = A(B-70) ;'get the index value If V = 0 Then If Err$="" Then Err$="Array index should be between 1 and "+Str$(ArraySize) End If Else If Err$="" Then Err$="Array index should be between 1 and "+Str$(ArraySize) End If Else If A1 > ArraySize Then If Err$="" Then Err$="Array index should be between 1 and "+ Str$(ArraySize) Else arrayFlag = True V = A1 ;must use Array flag to determine where to use the V index End If End If Return Function AskInput$(txt$,def=0) If def=1 Then atmp2$="y" If def=2 Then atmp2$="n" If def>0 Then atmp3$=" [def="+atmp2$+"]" Repeat ATMp1$=Lower$(Input$(txt$+" (Yes/No"+atmp3$+") >")) If Len (atmp1$)>1 Then atmp1$=Left$(atmp1$,1) If atmp1$="" If def>0 Then atmp1$=atmp2$ EndIf Until ATMP1$="y" Or atmp1$="n" Return atmp1$ End Function Function Month2Num(mon$) mon$=Lower$(mon$) : x=(Instr("janfebmaraprmayjunjulaugsepoctnovdec",mon$)/3)+1 Return x End Function Function Display(fname$,lines) filetmp=ReadFile(fname$) If filetmp>0 Then B=False : k=0 Cls : Locate 0,0 : pos\x = 0 Repeat k=(k+1) Mod lines Print ReadLine(filetmp) If k=0 Then Print "<N - Previous page> <M-Next Page> - <T - Top> <Q/Esc - Quit>" Repeat If KeyDown(49) ;n quit=1 If pos\x>0 pos.seek = Last seek Delete pos EndIf pos.seek = Last seek SeekFile (filetmp,pos\x) EndIf If KeyDown(50) And b=0 ;m pos.seek = New seek : pos\x= FilePos(filetmp) : quit=1 EndIf If KeyDown(20) ;t Delete Each seek pos.seek = New seek pos\x=0 SeekFile(filetmp,pos\x) quit=1 EndIf If KeyDown(1) Or KeyDown(16) Then Quit=2 : While KeyDown(1) : Delay 5 : Wend FlushKeys() Delay 10 Until Quit>0 Delay 150 If quit=2 Then Exit quit=0 Cls : Locate 0,0 EndIf B=Eof(filetmp) Forever EndIf Cls CloseFile filetmp Delete Each seek pos.seek = New seek End Function --v

TinyBasic (TinyBBasic)