'J.M.K S.F. BatchBASIC PLž Interpreter 1.5
'The BASIC-Based Batch Programming Language!
'Copyright (C) 2000 by Jan-Max Meyer Krapohl, owner of J.M.K S.F.
'Programming Language, Compiler and Interpreter Developments & Resources
'http://www.jmksf.de.st/
'jmk.software.factory@web.de
'#############################################################################
'J.M.K S.F. BatchBASIC is free software; you can redistribute it and/or
'modify it under the terms of the GNU General Public License as
'published by the Free Software Foundation; either version 2 of
'the License, or (at your option) any later version.
'This program is distributed in the hope that it will be useful,
'but WITHOUT ANY WARRANTY; without even the implied warranty of
'MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
'General Public License for more details.
'You should have received a copy of the GNU General Public License
'along with this program; if not, write to the Free Software
'Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA or at
'jmk.software.factory@web.de !
'#############################################################################
'#############################################################################
'You use this programming language and all part of it under your own risk.
'I never be liable for every consequences, damages and other things recalled
'by this programming langauge and all parts of it. The application in space-,
'air-, water- and groundvehicles, life recive machines, weapon systems and re-
'scue systems of the programming language is strictly forbidden.
'#############################################################################
'If you extend this software program, you agree that J.M.K S.F.  can  put  all
'from you developed, new parts from the programming  language  under  the  GNU
'General Public License, and in the product 'J.M.K S.F. BatchBASIC'.


'*****************
'*  CODE BEGINN  *
'*****************


'Initialize arrys for variable system
DIM numbers(1000) AS LONG
DIM nnumbers(1000) AS STRING
DIM strings(1000) AS STRING
DIM nstrings(1000) AS STRING
searchplace1 = 1
searchplace2 = 1

ON ERROR GOTO fileerror
sprungmarke = 0

'What program open?
filename$ = LTRIM$(RTRIM$(COMMAND$))
'filename$ = "test.bbc"

anfang:
OPEN filename$ FOR INPUT AS #1
IF sprungmarke = 1 THEN
DO
LINE INPUT #1, wennmarke$
LOOP UNTIL wennmarke$ = markenname$
sprungmarke = 0
END IF

ON ERROR GOTO programerror
nextline:
LINE INPUT #1, bbcode$
bbcode$ = LTRIM$(bbcode$)
nextline2:
bbcode2$ = UCASE$(bbcode$)
'Commands since version 1.0
IF LEFT$(bbcode2$, 3) = "PRI" THEN GOTO printbe
IF LEFT$(bbcode2$, 3) = "LPR" THEN GOTO lprintbe
IF LEFT$(bbcode2$, 3) = "PAU" THEN GOTO pausebe
IF LEFT$(bbcode2$, 3) = "WAI" THEN GOTO waitbe
IF LEFT$(bbcode2$, 3) = "SHE" THEN GOTO shellbe
IF LEFT$(bbcode2$, 3) = "INP" THEN GOTO inputbe
IF LEFT$(bbcode2$, 3) = "CLS" THEN CLS : GOTO nextzeile
'Commands since version 1.1
IF LEFT$(bbcode2$, 3) = "BAT" THEN GOTO batch
IF LEFT$(bbcode2$, 4) = "BEEP" THEN BEEP: GOTO nextzeile
'Commands since version 1.3
IF LEFT$(bbcode2$, 4) = "GIVE" THEN GOTO givebe
IF LEFT$(bbcode2$, 4) = "PLAY" THEN GOTO playbe
IF LEFT$(bbcode2$, 4) = "GOTO" THEN GOTO gotobe
'Commands since version 1.4 & 1.5
IF LEFT$(bbcode2$, 2) = "IF" THEN GOTO ifbe
IF LEFT$(bbcode2$, 2) = "AR" THEN GOTO arbe
IF LEFT$(bbcode2$, 4) = "TIME" THEN PRINT TIME$: GOTO nextzeile
IF LEFT$(bbcode2$, 4) = "DATE" THEN PRINT DATE$: GOTO nextzeile
IF LEFT$(bbcode2$, 2) = "FG" THEN GOTO fgbe
IF LEFT$(bbcode2$, 2) = "BG" THEN GOTO bgbe
IF LEFT$(bbcode2$, 6) = "STDCLR" THEN COLOR 7, 0: GOTO nextzeile
GOTO nextzeile

'===============BEGIN OF PROGRAMMING LANGUAGE COMMAND FUNCTIONS BLOC===============
'-----------------------------------------------------------------------------
printbe:
'Print s.th. on screen
'Beispiel:    PRINT Hello !//
'             PRINT Good morning./\
'             PRINT Variable1$/
text$ = MID$(bbcode$, 7)
text$ = RTRIM$(text$)
IF RIGHT$(text$, 2) = "$/" THEN GOTO stringvar1
IF RIGHT$(text$, 2) = "!/" THEN GOTO numbervar1
IF RIGHT$(text$, 2) = "$\" THEN GOTO stringvar1
IF RIGHT$(text$, 2) = "!\" THEN GOTO numbervar1
IF RIGHT$(text$, 2) = "//" THEN GOTO printtext
IF RIGHT$(text$, 2) = "/\" THEN GOTO printtext

COLOR 4, 0
PRINT "error :> "; bbcode$
COLOR 7, 0
GOTO nextzeile

printtext:
textlang = LEN(text$)
text2$ = LEFT$(text$, textlang - 2)
IF RIGHT$(text$, 2) = "/\" THEN PRINT text2$;  ELSE PRINT text2$
GOTO nextzeile

stringvar1:
text2$ = MID$(text$, 1, LEN(text$) - 1)
FOR i% = 1 TO 1000
IF nstrings(i%) = text2$ THEN text2$ = strings(i%): EXIT FOR
NEXT i%
IF RIGHT$(text$, 1) = "\" THEN PRINT text2$;  ELSE PRINT text2$
GOTO nextzeile

numbervar1:
text2$ = MID$(text$, 1, LEN(text$) - 1)
FOR i% = 1 TO 1000
IF nnumbers(i%) = text2$ THEN text2 = numbers(i%): EXIT FOR
NEXT i%
IF RIGHT$(text$, 1) = "\" THEN PRINT text2;  ELSE PRINT text2
GOTO nextzeile

'-----------------------------------------------------------------------------
lprintbe:
'Print s.th. on LPT-1
'Beispiel:    LPRINT Hello !//
'             LPRINT Good morning./\
'             LPRINT Variable1$/

text$ = MID$(bbcode$, 8)
text$ = RTRIM$(text$)
IF RIGHT$(text$, 2) = "$/" THEN GOTO stringvar2
IF RIGHT$(text$, 2) = "!/" THEN GOTO numbervar2
IF RIGHT$(text$, 2) = "$\" THEN GOTO stringvar2
IF RIGHT$(text$, 2) = "!\" THEN GOTO numbervar2
IF RIGHT$(text$, 2) = "//" THEN GOTO lprinttext
IF RIGHT$(text$, 2) = "/\" THEN GOTO lprinttext
COLOR 4, 0
PRINT "error :> "; bbcode$
COLOR 7, 0
GOTO nextzeile

lprinttext:
textlang = LEN(text$)
text2$ = LEFT$(text$, textlang - 2)
IF RIGHT$(text$, 1) = "\" THEN LPRINT text2$;  ELSE LPRINT text2$
GOTO nextzeile

stringvar2:
text2$ = MID$(text$, 1, LEN(text$) - 1)
FOR i% = 1 TO 1000
IF nstrings(i%) = text2$ THEN text2$ = strings(i%): EXIT FOR
NEXT i%
IF RIGHT$(text$, 1) = "\" THEN LPRINT text2$;  ELSE LPRINT text2$
GOTO nextzeile

numbervar2:
text2$ = MID$(text$, 1, LEN(text$) - 1)
FOR i% = 1 TO 1000
IF nnumbers(i%) = text2$ THEN text2 = numbers(i%): EXIT FOR
NEXT i%
IF RIGHT$(text$, 1) = "\" THEN LPRINT text2;  ELSE LPRINT text2
GOTO nextzeile

'-----------------------------------------------------------------------------
givebe:
'Gives variables values and declares them
'Beispiel:     give variable1$=Hello !
'              give variable1!=12345

'Get Type (String or Number)
vartyp$ = ""
solang1 = LEN(bbcode$)
lang1 = 6
weiter1:
vartyp2$ = MID$(bbcode$, lang1, 1)
IF vartyp2$ = "$" THEN GOTO stringvar0
IF vartyp2$ = "!" THEN GOTO numbervar0
lang1 = lang1 + 1
IF lang1 > solang1 THEN GOTO nextzeile
GOTO weiter1

stringvar0:
varname$ = ""
'Get varname
lang1 = 6
weiter2:
wenngleich$ = MID$(bbcode$, lang1, 1)
IF wenngleich$ = "=" THEN GOTO weiter3
varname$ = varname$ + wenngleich$
lang1 = lang1 + 1
IF lang1 > solang1 THEN GOTO nextzeile
GOTO weiter2

weiter3:
'Get value
lang1 = lang1 + 1
wert$ = MID$(bbcode$, lang1)
zaehler = 0

searchplace3 = searchplace1
DO
zaehler = zaehler + 1
IF nstrings(zaehler) = varname$ THEN
searchplace3 = zaehler
EXIT DO
END IF
LOOP UNTIL zaehler = 1000
nstrings(searchplace3) = varname$
strings(searchplace3) = wert$
searchplace1 = searchplace1 + 1
GOTO nextzeile

numbervar0:
varname$ = ""
'Get varname
lang1 = 6
weiter4:
wenngleich$ = MID$(bbcode$, lang1, 1)
IF wenngleich$ = "=" THEN GOTO weiter5
varname$ = varname$ + wenngleich$
lang1 = lang1 + 1
IF lang1 > solang1 THEN GOTO nextzeile
GOTO weiter4

weiter5:
'Get value
lang1 = lang1 + 1
wert$ = MID$(bbcode$, lang1)
wert = VAL(wert$)

zaehler = 0

searchplace4 = searchplace2
DO
zaehler = zaehler + 1
IF nnumbers(zaehler) = varname$ THEN
searchplace4 = zaehler
EXIT DO
END IF
LOOP UNTIL zaehler = 1000

nnumbers(searchplace4) = varname$
numbers(searchplace4) = wert
searchplace2 = searchplace2 + 1
GOTO nextzeile

'-----------------------------------------------------------------------------
batch:
'Alowes batches in the BBASIC Code
'Beispiel:  BATCH=START
'           @echo off
'           echo Hello World !
'           pause
'           BATCH=END
OPEN "temp.bat" FOR APPEND AS #3
andnext:
INPUT #1, bbcode$
bbcode2$ = UCASE$(bbcode$)
IF LEFT$(bbcode2$, 9) = "BATCH=END" THEN GOTO weiter
PRINT #3, bbcode$
GOTO andnext
weiter:
CLOSE #3
'Run Batch
SHELL "temp"
'Delete Batch; Batch not needed any more...
SHELL "del temp.bat"
GOTO nextzeile
'-----------------------------------------------------------------------------
playbe:
'Plays music
'Beispiel: PLAY abde

'Thanks to Sebastian Kaspari (Q-System) for the first version of this command!
musik$ = MID$(bbcode$, 6)

'is the value if musik$ a variable?
zaehler = 0
IF RIGHT$(musik$, 1) = "$" THEN GOTO loadstring2
PLAY musik$
GOTO nextzeile

loadstring2:
'Search string
zaehler = zaehler + 1

IF nstrings(zaehler) = musik$ THEN
   playwert$ = strings(zaehler)
   PLAY playwert$
ELSE GOTO loadstring2
END IF
GOTO nextzeile
'-----------------------------------------------------------------------------
gotobe:
'Jumps to jump point.
'Beispiel: GOTO marke1
'          IF (variable$=Hallo !) GOTO marke
markenname$ = MID$(bbcode$, 6)
markenname$ = "#" + markenname$
sprungmarke = 1
CLOSE #1
GOTO anfang

'-----------------------------------------------------------------------------
ifbe:
'IF-Function
'Beispiel: IF (variable$=Hallo !) GOTO marke
'          IF (variable24$=Herbert) print Eingabe war HERBERT! /

von = 5
buchstabe1$ = ""
varname2$ = ""
loop5:
buchstabe1$ = MID$(bbcode$, von, 1)
varname2$ = varname2$ + buchstabe1$
von = von + 1
IF buchstabe1$ = "$" THEN typ$ = "$"
IF buchstabe1$ = "!" THEN typ$ = "!"
IF buchstabe1$ = "$" OR buchstabe1$ = "!" THEN GOTO weiter0
GOTO loop5
weiter0:
wennwert$ = ""
von = von + 1
buchstabe1$ = ""
loop6:
buchstabe1$ = MID$(bbcode$, von, 1)
von = von + 1
IF buchstabe1$ = ")" THEN GOTO ready1
wennwert$ = wennwert$ + buchstabe1$
GOTO loop6
ready1:
IF typ$ = "$" THEN GOTO ifstrings
IF typ$ = "!" THEN GOTO ifnumbers
GOTO nextzeile

ifstrings:
zaehler = 0
loop7:
zaehler = zaehler + 1
IF nstrings(zaehler) = varname2$ THEN
   IF strings(zaehler) = wennwert$ THEN ifwert$ = "true" ELSE ifwert$ = "false"
ELSE GOTO loop7
END IF
GOTO auswert

ifnumbers:
zaehler = 0
loop8:
zaehler = zaehler + 1
IF nnumbers(zaehler) = varname2$ THEN
   IF numbers(zaehler) = VAL(wennwert$) THEN ifwert$ = "true" ELSE ifwert$ = "false"
ELSE GOTO loop8
END IF
GOTO auswert

auswert:
IF ifwert$ = "false" THEN GOTO nextzeile
bbcode$ = MID$(bbcode$, von + 1)
GOTO nextline2

'-----------------------------------------------------------------------------
arbe:
'Calculates values
'Beispiel:
'ar 4 + 5
'ar var1! / var2!
'ar var1! - 3
'ar var1! * var2!
'not allowed: ar 4 + 5 / 2
'not allowed: ar var1! + 5 / 2 * var2!

text$ = MID$(bbcode$, 4)
'GetVar

FOR i% = 1 TO LEN(text$)
    IF MID$(text$, i%, 1) = " " THEN
        v1$ = LEFT$(text$, i% - 1)
        v2$ = MID$(text$, i% + 3)
        op$ = MID$(text$, i% + 1, 1)
        EXIT FOR
    END IF
NEXT

zaehler = 0
loop13:
zaehler = zaehler + 1
IF zaehler = 1000 THEN GOTO nextvar
IF nnumbers(zaehler) = v1$ THEN v1 = numbers(zaehler) ELSE GOTO loop13
nextvar:
IF zaehler = 1000 THEN v1 = VAL(v1$)
zaehler = 0
loop14:
zaehler = zaehler + 1
IF zaehler = 1000 THEN GOTO nextvar2
IF nnumbers(zaehler) = v2$ THEN v2 = numbers(zaehler) ELSE GOTO loop14
nextvar2:
IF zaehler = 1000 THEN v2 = VAL(v2$)

SELECT CASE op$
CASE "+": erg = v1 + v2
CASE "-": erg = v1 - v2
CASE "*": erg = v1 * v2
CASE "/": erg = v1 / v2
END SELECT

'******

bbcode$ = "give " + v1$ + "=" + STR$(erg)
GOTO givebe

'-----------------------------------------------------------------------------
pausebe:
DO: LOOP WHILE INKEY$ = ""
GOTO nextzeile
'-----------------------------------------------------------------------------
waitbe:
'Waits seconds
'Beispiel: WAIT=4
sekunden$ = MID$(bbcode$, 6)
SLEEP VAL(sekunden$)
GOTO nextzeile
'-----------------------------------------------------------------------------
shellbe:
'Runs MS-DOS Commands on the command.com Shell Interpreter
'Beispiel: SHELL dir *.bbf
'          SHELL a$
makeonshell$ = MID$(bbcode$, 7)
zaehler = 0
IF RIGHT$(makeonshell$, 1) = "$" THEN GOTO loadstring3 ELSE SHELL makeonshell$
GOTO nextzeile
loadstring3:
'Suchen d. Strings
zaehler = zaehler + 1
IF nstrings(zaehler) = makeonshell$ THEN SHELL strings(zaehler) ELSE GOTO loadstring3
GOTO nextzeile
'-----------------------------------------------------------------------------
inputbe:
'Read text from keyboard.
'Beispiel: INPUT Enter something:\variable$
'          INPUT Enter something:\variable!
text$ = ""
von = 7
textlang = LEN(bbcode$)
weiter9:
buchstabe1$ = MID$(bbcode$, von, 1)
IF buchstabe1$ = "\" THEN GOTO weiter6
text$ = text$ + buchstabe1$
von = von + 1
IF lang1 > textlang THEN GOTO nextzeile
GOTO weiter9

weiter6:
PRINT text$;
varname2$ = ""
buchstabe2$ = ""
von = von + 1
loop10:
buchstabe2$ = MID$(bbcode$, von, 1)
varname2$ = varname2$ + buchstabe2$
IF buchstabe2$ = "$" THEN typ$ = "$": GOTO weiter7
IF buchstabe2$ = "!" THEN typ$ = "!": GOTO weiter7
von = von + 1
GOTO loop10

weiter7:
IF typ$ = "$" THEN
zaehler = 0
loop11:
zaehler = zaehler + 1
IF nstrings(zaehler) = varname2$ THEN LINE INPUT "", strings(zaehler) ELSE GOTO loop11
END IF
IF typ$ = "!" THEN
zaehler = 0
loop12:
zaehler = zaehler + 1
IF nnumbers(zaehler) = varname2$ THEN INPUT "", numbers(zaehler) ELSE GOTO loop12
END IF
GOTO nextzeile
'-----------------------------------------------------------------------------
'FG
'BG
'Set colors.
'Beispiel: BG=0
'          FG=7
bgbe:
farbwert = VAL(MID$(bbcode$, 4, 1))
COLOR , farbwert
GOTO nextzeile
fgbe:
farbwert = VAL(MID$(bbcode$, 4, 1))
COLOR farbwert
GOTO nextzeile

'-----------------------------------------------------------------------------
'================END OF PROGRAMMING LANGUAGE FUNCTION BLOC====================


nextzeile:
IF LEFT$(UCASE$(bbcode$), 3) = "END" THEN GOTO endbbasic ELSE GOTO nextline
endbbasic:
CLOSE #1
IF sprungmarke = 1 THEN GOTO anfang
SLEEP 1
CLS
END

fileerror:
COLOR 7, 0
PRINT "J.M.K S.F. BatchBASIC PLž Interpreter 1.5"
PRINT "ž 2000 by Jan-Max Meyer Krapohl, owner of J.M.K S.F."
PRINT "Programming Language, Compiler and Interpreter Developments"
PRINT "http://www.jmksf.de.st/ ++ jmk.software.factory@web.de"
PRINT
PRINT
PRINT "No J.M.K S.F. BatchBASIC program found."
PRINT "Usage: bbasic [Programmname]"
PRINT
END

programerror:

PRINT
COLOR 4, 0
PRINT "FATAL ERROR: Please control source code immediatelly!"
SLEEP 2
PRINT "Program breaked."
END

