Forum Liberty Basic France

Le 27/05/2012 à 08h41

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
Tout est dans le titre !

Code VB :
    'http://justbasic.conforums.com/index.cgi?board=games&action=display&num=1327171295
    'Authors : Flaxen, tsh73, Stefan Pendl, Cassiope34

    nomainwin
    WindowHeight=490
    WindowWidth=500
    UpperLeftX = (DisplayWidth-WindowWidth) / 3
    UpperLeftY = (DisplayHeight-WindowHeight) / 2
    mois$ = "Jan Fév Mar Avr Mai Jun Jui Aou Sep Oct Nov Déc"
    today$ = date$("mm/dd/yyyy")
    j = date$(today$)
    jsem$ = word$("Mar Mer Jeu x Ven Sam x Dim Lun",int((j/7-int(j/7))*10)+1)
    date$ = jsem$+" "+mid$(today$,4,2)+" "+word$(mois$, val(today$))+"   "+left$(time$(),5)'right$(today$,4)

    dim cel(10,10), info$(10,10)
    open "          The  S N A K E..."+space$(20)+date$ for graphics_nf_nsb as #a
    #a "trapclose [quit]"
    #a "down ; setfocus; when characterInput [key]"
    fc$ = "darkcyan"
    dc = 14
    dpx = int((WindowWidth-6)/dc)
    dpy = int((WindowHeight-26)/dc)
    scoreMax = 0
    files DefaultDir$, "Snake.ini", info$()
    if val(info$(0, 0)) then
        open "Snake.ini" for input as #snake
        LINE INPUT #snake, ms$
        scoreMax = val(ms$)
        close #snake
    end if
[Start]
    GameRunning = 1
    #a "fill ";fc$
    right=1
    left=2 'this servers no real purpose, just use it for simplicities sake
    up=3
    down=4
    dir = right
    x=10
    y=10
    redim cel(dpx,dpy)
    list$ = "|"
    maxLen = 4
    curLen = 0
    score = 0
    Speed = 160
    #a "backcolor ";fc$;"; color yellow"
    #a "place ";WindowWidth-60;" 20;|";score;" / ";scoreMax;"       "
    gosub [food]
    timer Speed, [loop]
    wait
 
[loop]
    select case dir
    case up
        y=y-1
        chk$=using("####",x);using("#####",y)   'monitor is #### at most, so we have one extra space
        if instr(list$, "|"+chk$+"|") or y<1 then goto [Lost]
    case down
        y=y+1
        chk$=using("####",x);using("#####",y)
        if instr(list$, "|"+chk$+"|") or y>dpy-1 then goto [Lost]
    case right
        x=x+1
        chk$=using("####",x);using("#####",y)
        if instr(list$, "|"+chk$+"|") or x>dpx-1 then goto [Lost]
    case left
        x=x-1
        chk$=using("####",x);using("#####",y)
        if instr(list$, "|"+chk$+"|") or x<1 then goto [Lost]
    end select
    if cel(x,y)=2 then [Lost]
    if cel(x,y)=1 then     ' the snake eats...!
        maxLen = maxLen+2
        score = score+1
        if scoreMax < score then scoreMax = score
        #a "backcolor ";fc$;"; color yellow"
        #a "place ";WindowWidth-60;" 20;|";score;" / ";scoreMax;"       "
        cel(x,y)=0
        gosub [food]
        Speed = Speed - 5
        if Speed<90 then gosub [walls] 'Speed=80
        capture = 1
    end if
 
    #a "backcolor blue; color blue"
    #a "place ";val(word$(chk$,1))*dc;" ";val(word$(chk$,2))*dc;" ;circlefilled ";dc/2
 
    if  curLen < maxLen then
        curLen = curLen + 1
        list$ = list$+chk$+"|"
    else    '"FORGET" first item of the list
        'get it
        first$=mid$(left$(list$, 10),2)
        'clear it
        #a "backcolor ";fc$;"; color ";fc$
        #a "place ";val(word$(first$,1))*dc;" ";val(word$(first$,2))*dc;" ;circlefilled ";dc/2
        'forget it
        list$=mid$(list$, 11)+chk$+"|"
    end if
    if capture then
        capture = 0
        timer 0
        timer Speed, [loop]
    end if
    wait
 
[walls]
    Speed = 160
    #a "backcolor ";fc$;"; color ";fc$
    for L = 1 to curLen           ' <------ Shortens the snake
        #a "place ";val(mid$(list$,(L-1)*10+2,4))*dc;" ";val(mid$(list$,(L-1)*10+6,5))*dc;" ;circlefilled ";dc/2
    next
    maxLen = 4
    curLen = 0
    list$ = "" 'right$(list$,41)
    nwalls = 4          ' <------------- 4 walls :  cel(x,y) = 2
    for nw = 1 to nwalls
        do :xf = 5+int(rnd(0)*(dpx-10))   'new wall
            yf = 5+int(rnd(0)*(dpy-10))
        loop until instr(list$, "|"+using("####",xf);using("#####",yf)+"|")=0 and cel(xf,yf) = 0  'not into the snake !!!
        cel(xf,yf) = 2
        #a "backcolor darkred; color darkred"
        #a "place ";xf*dc-dc/2;" ";yf*dc-dc/2;" ;boxfilled ";xf*dc+dc/2;" ";yf*dc+dc/2   ' wall
    next
    return
 
[food]
    do :xf = 5+int(rnd(0)*(dpx-10))   'new food
        yf = 5+int(rnd(0)*(dpy-10))
    loop until instr(list$, "|"+using("####",xf);using("#####",yf)+"|")=0 and cel(xf,yf) = 0  'not into the snake !!!
    cel(xf,yf) = 1      ' <------------- food :   cel(x,y) = 1
    #a "backcolor green; color red"
    #a "place ";xf*dc;" ";yf*dc;" ;circlefilled ";dc/2
    return
 
[Lost]
    timer 0
    #a "backcolor ";fc$;"; color red"
    #a "place ";WindowWidth/2-40;" ";WindowHeight/2;";|LOST...!"
    GameRunning = 0
    wait
 
[key]
    if GameRunning = 1 then
        key$ = right$(Inkey$,1)
        select case
        case key$ = chr$(_VK_UP) or instr("wWzZ",key$)>0
            if dir=down then goto [Lost]
            dir=up
        case key$ = chr$(_VK_DOWN) or instr("sS",key$)>0
            if dir=up then goto [Lost]
            dir=down
        case key$ = chr$(_VK_LEFT) or instr("aAqQ",key$)>0
            if dir=right then goto [Lost]
            dir=left
        case key$ = chr$(_VK_RIGHT) or instr("dD",key$)>0
            if dir=left then goto [Lost]
            dir=right
        case key$ = chr$(27) :goto [quit]  'ESC
        end select
    else
        goto [Start]
    end if
    wait
 
[quit]
    open "Snake.ini" for output as #snake
    #snake, scoreMax
    close #snake
    close #a
    end
 




Edité par cassiope01 Le 27/05/2012 à 08h44
____________________
Devise Shadocks : "Mieux vaut mobiliser son intelligence pour des conneries, que mobiliser sa connerie pour des choses intelligentes"
Coluche disait : "C'est parce que la vitesse de la lumière est plus rapide que celle du son que certains peuvent paraîtrent brillants jusqu'à ce qu'ils ouvrent la bouche."

Web    
Le 18/07/2012 à 14h28

Libertynaute Avancé

Groupe: Membre

Inscrit le: 08/06/2012
Messages: 270
Pas mal
____________________
Si le meilleurs langage de programmation existe, alors le Just Basic est loin devant.
Ne me tappez pas dessus ! Je débute :D

Web    

 |  |

1 Utilisateur en ligne : 0 Administrateur, 0 Modérateur, 0 Membre et 1 Visiteur
Utilisateur en ligne : Aucun membre connecté
Répondre
Vous n'êtes pas autorisé à écrire dans cette catégorie