CoolBasic Forums

Code: Select all

    //*****CB brainfuck*************//
    //Tehnyt: Pie2                  //
    //Nopeasti koodasin tämmössen.  //
    //Saa käyttää miten haluaa :)   //
    //////////////////////////////////

    //PERUSASETUKSET
        strict_run=1    //0 = ei olla niin ankaria väärille komennoille, voit laittaa 1 jos haluat ohittaa muistitarkastuksen
        make_error=0    //heittää erroria kun tulee virhe, ei huomaa "["
        show_unknown=1  //kun tulee tuntematon komento niin tulostuu "?"
        memo_size=255   //varattavien muistipalikoiden määrä
        console_size=255 //kuinka monta riviä "konsolissa" on
        loop_size=255   //maksimimäärä silmukoita "[" --> "]" 
    //INITIALISOIDAAN
        //MUISTI
        Dim memo(memo_size) As Byte   //muisti
        Global memo_p As integer      //muistin "pointeri"
        //KONSOLI
        Dim console(console_size) As String     //konsolin rivit
        Global console_p As integer   //konsolin "poineri" aka. millä rivillä mennään
        //KOODI
        Global code As String         //itse koodi
        Global code_len As integer    //koodin pituus
        //SILMUKAT
        Dim loop_start(loop_size) As integer //silmukan alku
        Global loop_p As integer             //silmukan "pointer"
        loop_p=-1
    //ANNETAAN ARVOT
    code="++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+."
    code_len=Len(code)-1
    For k=0 To code_len
        c$=com(k)  //haetaan komento
        SetWindow ""+k+"/"+code_len+"    "+c
        Select c
            Case "+"
                memo(memo_p)=memo(memo_p)+1    //lisätään pointerin kohdalla olevaa arvoa
            Case "-"
                memo(memo_p)=memo(memo_p)-1    //vähennetään pointerin kohdalla olevaa arvoa
            Case "."
                tex(Chr(memo(memo_p)))         //tulostetaan
                draw=1                         //optimoinnin vuoksi ruutu piirretään ainoastaan kun tulostetaan...
            Case ">"
                memo_p=memo_p+1                //liikutetaan pointeria oikealle
            Case "<"
                memo_p=memo_p-1                //liikutetaan pointeria vasemmalle
            Case ","
                tmp_timer=10                           
                tmp_blink=1
                ClearKeys()                    //jos suorituksen aikana on painettu jtn niin unohdetaan se
                Locate 0,-15    //siirretään input pois näkyvistä
                Repeat
                    //OTETAAN INPUT
                    f$=Left(Input(""),1)
                    //PIIRRETÄÄN konsoli
                    For i=0 To console_p
                        Text 0,i*15,console(i)
                    Next i
                    //PIIRRETÄÄN INPUT ja välkkyvä kursori
                    Text TextWidth(console(console_p)),console_p*15,f
                    If tmp_blink Then Text TextWidth(console(console_p)),console_p*15,"_"
                    //päivitetään välkkymistimeriä
                    tmp_timer=tmp_timer-1
                    If tmp_timer<0 Then tmp_timer=10:tmp_blink=Not tmp_blink
                   
                    DrawScreen
                Until KeyHit(28)
                Cls
                CloseInput()
                memo(memo_p)=Asc(f)  //asetetaan pointerin kohdalla olevalle muistille arvoksi juuri saatu näppäin
            Case "["
                loop_p=loop_p+1        //lisätään looppipoineria=uusi looppi
                loop_start(loop_p)=k   //laitetaan muistiin alkukohta
            Case "]"
                If loop_p=-1 Then
                    tex("E")                  //ohjelma kaatuisi koska sulkuja olisi liikaa
                    tmp_sulkuja=tmp_sulkuja+1  //lasketaan virheellisiä sulkuja
                    If make_error Then MakeError "Ylimääräinen sulku "+Chr(34)+c+Chr(34)+" kohta:"+k
                Else
                    If memo(memo_p)>0 Then
                        k=loop_start(loop_p)  //jos pointerin kohdalla oleva arvo ei ole 0 niin palataan
                    Else
                        loop_start(loop_p)=0  //...jos se taas on niin nollataan looppi muistista
                        loop_p=loop_p-1       // loopin pointeri takaisin=looppi loppui
                    EndIf
                EndIf
            Default
                If c<>" " And show_unknown Then tex("?")
                If c<>" " And make_error Then MakeError "Tuntematon komento "+Chr(34)+c+Chr(34)+" kohta:"+k
                If c<>" " Then tmp_komentoja=tmp_komentoja+1   //lasketaan komentovirheitä
        End Select
       
        If strict_run=0 Then
            //tarkistetaan muisti
            For i=0 To memo_size
                memo(i)=Max(0,Min(memo(i),255))  //maksimiarvo on 255 ja minimi 0
            Next i
            //tarkistetaan pointerit
            memo_p=Max(0,Min(memo_size,memo_p))
            console_p=Max(0,Min(console_size,console_p))
            loop_p=Max(-1,Min(loop_size,loop_p))
        EndIf
        //LOPPUVIESTI, kertoo virheet etc
        If k=code_len Then
            tex(Chr(10)):tex("======================VALMIS======================"):draw=1
            If loop_p>-1 Then tex("Sulkemattomia looppeja! ("+(loop_p+1)+")"):tex(Chr(10))
            If tmp_sulkuja>0 Then tex("Liikaa sulkuja ("+(tmp_sulkuja)+")"):tex(Chr(10))
            If tmp_komentoja>0 Then tex("Tuntemattomia komentoja ("+tmp_komentoja+")")
        EndIf
        //PIIRRETÄÄN (ainoastaan jos on juuri tulostettu jtn)
        If draw Then
            tmp_y=Max(0,console_p-19)
            For i=0 To Min(console_size,23) 'Max(0,console_p-23) To console_p
                Text 0,i*15,console(tmp_y+i)
            Next i
            DrawScreen
            draw=0
        EndIf
    Next k
    //LOPPU
    WaitKey
    End

    Function com(i)
        Return Mid(code,i+1,1)
    EndFunction

    Function tex(t$)
        While Len(console(console_p))>49
            console_p=console_p+1
        Wend
        If Asc(t)=10 Then
            console_p=console_p+1
        ElseIf Asc(t)=8 Then
            console(console_p)=Left(console(console_p),Len(console(console_p))-1)
        Else
            console(console_p)=console(console_p)+t
        EndIf
    EndFunction

Code: Select all

lol + 1