'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
'#############################################################################
'Dieses Programm ist freie Software. Sie koennen es unter
'den Bedingungen der GNU General Public License, wie von der
'Free Software Foundation herausgegeben, weitergeben und/oder
'modifizieren, entweder unter Version 2 der Lizenz oder (wenn
'Sie es wuenschen) jeder spaeteren Version.

'Die Veroeffentlichung dieses Programms erfolgt in der
'Hoffnung, dass es Ihnen von Nutzen sein wird, aber OHNE JEDE
'GEWAEHRLEISTUNG - sogar ohne die implizite Gewaehrleistung
'der MARKTREIFE oder der EIGNUNG FUER EINEN BESTIMMTEN ZWECK.
'Details finden Sie in der GNU General Public License.

'Sie sollten eine Kopie der GNU General Public License zusammen
'mit diesem Programm erhalten haben. Falls nicht, schreiben Sie
'an die Free Software Foundation, Inc., 675 Mass Ave, Cambridge,
'MA 2139, USA oder an jmk.software.factory@web.de !
'#############################################################################
'#############################################################################
'Sie benutzen diese Programmiersprache unter Ihrem eigenem Risiko. Ich
'werde fr keine Konsequenzen, Beschdigungen oder andere Sachen, die
'durch diese Programmiersprache, und alle Teile davon verursacht werden,
'haften. Der Einsatz in Raum-, Luft-, Wasser- und Bodenfahrzeugen, Leben-
'serhaltungssystemen, Waffen Systemen aller Art und Rettungssystemen ist
'strengstens verboten.
'#############################################################################
'#############################################################################
'Sie  muessen  bei  jeder von Ihnen weiterentwickelten oder kopierten Version,
'die unter Ihrem Namen laeuft, mir Copyrights und Credits (wie ganz oben)  ge-
'ben,   und   eine   Kopie   inklusive   Quellcode   via  eMail   an    J.M.K,
'jmk.software.factory@web.de , senden. Jeder, der seine Version  an J.M.K S.F.
'sendet, verpflichtet sich dazu, dass J.M.K S.F. das alleinige Recht hat,  die
'weiterentwickelte  Version  unter  dem Namen 'J.M.K S.F. BatchBASIC' als Open
'Source weiter zu vertreiben. Gewisse Credits des  Programmierers werden ber-
'cksichtigt, wenn gewnscht.
'#############################################################################

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


'Dimensionieren und Initialisieren der Arrays
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

'Welches Programm laden ?
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$)
'Befehle seit 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
'Befehle seit Version 1.1
IF LEFT$(bbcode2$, 3) = "BAT" THEN GOTO batch
IF LEFT$(bbcode2$, 4) = "BEEP" THEN BEEP: GOTO nextzeile
'Befehle seit 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
'Befehle seit Version 1.4
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

'===============BEGINN DES PROGRAMMIERSPRACHEN FUNKTIONS BLOCKS===============
'-----------------------------------------------------------------------------
printbe:
'Schreibt etwas auf den Bildschirm
'Beispiel:    PRINT Hallo !//
'             PRINT Guten Morgen./\
'             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:
'Druckt etwas auf den Drucker LPT-1
'Beispiel:    LPRINT Hallo !//
'             LPRINT Guten Morgen./\
'             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:
'Teilt Variablen Werte zu.
'Beispiel:     give variable1$=Hallo !
'              give variable1!=12345

'Herrausfinden des Typs (String oder Number) der Variable
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$ = ""
'Herrausfinden des Namens der Variable
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:
'Herrausfinden des Wertes
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$ = ""
'Herrausfinden des Namens der Variable
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:
'Herrausfinden des Wertes
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:
'Erlaubt die einbindung von Batchprogrammen in BatchBASIC-Programme
'Beispiel:  BATCH=START
'           @echo off
'           echo Hallo Welt !
'           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
'Starten des Batchprogramms
SHELL "temp"
'Und, da wir das Batchprogramm nicht mehr brauchen...
SHELL "del temp.bat"
GOTO nextzeile
'-----------------------------------------------------------------------------
playbe:
'Spielt eine Melodie ab
'Beispiel: PLAY abde

'Dank an Sebastian Kaspari (Q-System) fr die Vorversion dieses Befehls.
musik$ = MID$(bbcode$, 6)

'Gucke, ob musik$ eine Variable ist
zaehler = 0
IF RIGHT$(musik$, 1) = "$" THEN GOTO loadstring2
PLAY musik$
GOTO nextzeile

loadstring2:
'String wird gesucht
zaehler = zaehler + 1

IF nstrings(zaehler) = musik$ THEN
   playwert$ = strings(zaehler)
   PLAY playwert$
ELSE GOTO loadstring2
END IF
GOTO nextzeile
'-----------------------------------------------------------------------------
gotobe:
'Springt zur angegebenen Sprungmarke (kann mit IF verkettet werden)
'Beispiel: GOTO marke1
'          IF (variable$=Hallo !) GOTO marke
markenname$ = MID$(bbcode$, 6)
markenname$ = "#" + markenname$
sprungmarke = 1
CLOSE #1
GOTO anfang

'-----------------------------------------------------------------------------
ifbe:
'Bedingungs-Funktion
'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:
'Fhrt eine Rechnung aus. Es drfen keine komplexen Ausdrcke (d.h. keine
'Ausdrcke in Klammern) verwendet werden, und es darf nur eine Rechnung aufs
'mal erfolgen.
'Beispiel:
'ar 4 + 5
'ar var1! / var2!
'ar var1! - 3
'ar var1! * var2!
'nicht erlaubt: ar 4 + 5 / 2
'nicht erlaubt: 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
GOTO nextzeile


'-----------------------------------------------------------------------------
pausebe:
DO: LOOP WHILE INKEY$ = ""
GOTO nextzeile
'-----------------------------------------------------------------------------
waitbe:
'Wartet bestimmte Sekundenzahl ab.
'Beispiel: WAIT=4
sekunden$ = MID$(bbcode$, 6)
SLEEP VAL(sekunden$)
GOTO nextzeile
'-----------------------------------------------------------------------------
shellbe:
'Fhrt MS-DOS Befehle aus !
'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:
'Einlesen von Daten von der Tastatur.
'Beispiel: INPUT Bitte was eingeben:\variable$
'          INPUT Bitte was eingeben:\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
'Einstellen von Farben.
'Beispiel: BACKCOLOR=0
'          FORECOLOR=7
bgbe:
farbwert = VAL(MID$(bbcode$, 4, 1))
COLOR , farbwert
GOTO nextzeile
fgbe:
farbwert = VAL(MID$(bbcode$, 4, 1))
COLOR farbwert
GOTO nextzeile

'-----------------------------------------------------------------------------
'================ENDE DES PROGRAMMIERSPRACHEN FUNKTIONS BLOCKS================


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 "Kein J.M.K S.F. BatchBASIC Programm gefunden."
PRINT "Usage: bbasic [Programmname]"
PRINT
END

programerror:

PRINT
COLOR 4, 0
PRINT "FATAL ERROR: Bitte kontrollieren Sie den Quellcode des Programms sofort !"
SLEEP 2
PRINT "Programm beendet."
END

