Koodit: Brainfuck-tulkki QB:lle

' Yksinkertainen QBasic-Brainfuck-tulkki
' Käyttö: Lukee oletuksena ohjelman tiedostosta ohjelma.txt
'         Suoritettavan ohjelman voi antaa myös komentoriviltä
'         (kun on ensin kääntänyt ohjelman) seuraavasti:
'         BF [ohjelma]
' Esim:   BF ohjelma2.txt
' Korjattavaa:
'         * mahdollisesti merkkien kysyminen
'         * tuki usealle tiedostolle

DECLARE SUB AjaOhjelma (ohjelma AS STRING)
DECLARE FUNCTION TarkistaOhjelma% (ohjelma AS STRING)
DECLARE FUNCTION LueTiedosto$ (tiedostonNimi AS STRING)
DECLARE SUB TulostaOhje ()
DECLARE FUNCTION KelpoMerkki% (merkki AS STRING)

DIM SHARED muisti(30000) AS INTEGER
DIM SHARED p AS INTEGER
DIM SHARED virhe AS INTEGER
DIM SHARED tulostepuskuri AS STRING

DIM tiedosto AS STRING
DIM ohjelma AS STRING
DIM krp AS STRING

ON ERROR GOTO Virheenkasittelija


tulostepuskuri = ""
p = 0
virhe = 0
tiedosto = "ohjelma.txt"


CLS

' Mahdollisen komentoriviparametrin lukeminen
IF COMMAND$ <> "" THEN tiedosto = COMMAND$

' Luetaan ohjelma tiedostosta
ohjelma = LueTiedosto(tiedosto)

' Tarkistetaan onko sulkuvirheitä
IF TarkistaOhjelma(ohjelma) <> 1 THEN
    PRINT "Virhe! Ohjelmassa " + tiedosto + " on syntaksivirhe!"
    END
END IF

' Suoritetaan ohjelma
AjaOhjelma (ohjelma)

'Lopetetaan
END


' Virheenkäsittelyä tiedoston lukemisen epäonnistumisen varalta.
Virheenkasittelija:

IF virhe = 1 THEN
    PRINT "Virhe! Tiedoston " + tiedosto + " lukeminen ei onnistunut."
    TulostaOhje
    END
ELSE
    PRINT "Virhe! Homma vaan kusee jossain!"
    TulostaOhje
    END
END IF
END

' Ajetaan parametrina annettu bf-ohjelma.
SUB AjaOhjelma (ohjelma AS STRING)

    DIM i AS INTEGER
    DIM sulut AS INTEGER
    DIM merkki AS STRING

    ' Nollataan muisti ja osoitin
    FOR i = 0 TO 29999
        muisti(i) = 0
    NEXT i
    p = 0

    i = 0
    sulut = 0

    ' Käydään ohjelma läpi nollamerkkiin asti.
    DO WHILE MID$(ohjelma, i + 1, 1) <> "0"
        SELECT CASE MID$(ohjelma, i + 1, 1)

            CASE "<": p = p - 1
            CASE ">": p = p + 1
            CASE "+": muisti(p) = muisti(p) + 1
            CASE "-": muisti(p) = muisti(p) - 1
            CASE ".":
                tulostepuskuri = tulostepuskuri + CHR$(muisti(p))
                CLS
                PRINT tulostepuskuri
            CASE ",":
                INPUT merkki
                muisti(p) = ASC(merkki)
            CASE "[":
                IF muisti(p) = 0 THEN
                    sulut = 1
                    DO WHILE sulut <> 0
                        i = i + 1
                        IF MID$(ohjelma, i + 1, 1) = "[" THEN sulut = sulut + 1
                        IF MID$(ohjelma, i + 1, 1) = "]" THEN sulut = sulut - 1
                    LOOP
                END IF
            CASE "]":
                IF muisti(p) <> 0 THEN
                    sulut = 1
                    DO WHILE sulut <> 0
                        i = i - 1
                        IF MID$(ohjelma, i + 1, 1) = "[" THEN sulut = sulut - 1
                        IF MID$(ohjelma, i + 1, 1) = "]" THEN sulut = sulut + 1
                    LOOP
                END IF
        END SELECT

        ' Seuraava kohta
        i = i + 1
    LOOP

END SUB

' Tarkistaa onko parametrina annettu merki bf-kieleen kuuluva.
' Palauttaa 1 jos kelpoinen, muutoin 0
FUNCTION KelpoMerkki% (merkki AS STRING)
    IF merkki = "<" OR merkki = ">" OR merkki = "+" OR merkki = "-" OR merkki = "." OR merkki = "," OR merkki = "[" OR merkki = "]" THEN
        KelpoMerkki% = 1
    ELSE
        KelpoMerkki% = 0
    END IF
END FUNCTION

' Lukee parametrina annetun tiedoston ja palauttaa siitä puretun ohjelman merkkijonona.
FUNCTION LueTiedosto$ (tiedostonNimi AS STRING)
    DIM rivi AS STRING
    DIM i AS INTEGER
    DIM ohj AS STRING
    DIM merkki AS STRING

    ' Asetetaan virhe-muuttuja, jotta virheen sattuessa osataan käsitellä se oikein.
    virhe = 1

    ' Tyhjennetään puskuri
    ohj = ""

    ' Avataan tiedosto ja luetaan viimeiseen merkkiin.
    OPEN tiedostonNimi FOR INPUT AS #1
    DO WHILE NOT EOF(1)
        LINE INPUT #1, rivi
        FOR i = 0 TO LEN(rivi) - 1
            ' Jos merkki on kelpoinen, lisätään se ohjelmaan.
            merkki = MID$(rivi, i + 1, 1)
            IF KelpoMerkki(merkki) = 1 THEN
                ohj = ohj + merkki
            END IF
        NEXT i
    LOOP

    ' Lisätään nolla loppuun merkkaamaan ohjelman loppua.
    ohj = ohj + "0"
    CLOSE #1
    LueTiedosto = ohj
    virhe = 0
END FUNCTION

' Tarkistaa ohjelman sulkuvirheiden varalta.
' Palauttaa 1 jos ohjelmassa ei virheitä, muutoin 0.
FUNCTION TarkistaOhjelma% (ohjelma AS STRING)
    DIM i AS INTEGER
    DIM merkki AS STRING
    DIM sulut AS INTEGER

    ' Käydään ohjelma läpi ja lasketaan sulut.
    sulut = 0
    FOR i = 0 TO LEN(ohjelma)
        IF MID$(ohjelma, i + 1, 1) = "[" THEN sulut = sulut + 1
        IF MID$(ohjelma, i + 1, 1) = "]" THEN sulut = sulut - 1
    NEXT i

    IF sulut <> 0 THEN
        TarkistaOhjelma = 0
    ELSE
        TarkistaOhjelma = 1
    END IF
END FUNCTION

SUB TulostaOhje
    PRINT "Brainfuck-tulkki v. 1.0 (Mika K. 2006)"
    PRINT "Toiminta: bf [ohjelma]"
END SUB