Sujet - Code en cours de défrichage

Roland

Le 10/07/2012 à 17h28

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2484

Bonjour à tous, pour ceux qui aiment bien voir du code en cours de défrichage, en voici un:
Le but du code:
Huit barres superposées coulissantes latéralement l'une par rapport à l'autre et comportants des trous.
En haut, des objets... Qui descendent quand ils sont au dessus d'un trou.
Le but du jeu: faire descendre les objets en faisant coulisser les barres.( en un nombre limité de coups)
Ne connaissant ni la syntaxe du langage ( qui semble etre du basic) pas de simulateur pour le tester, j'ai mis (ou du moins j'ai tenté de mettre) la chose en mode texte.
Une option rendrait le jeu plus attractif, serait de faire en sorte que: quand un objet a deux trous alignés au dessus de lui, il remonte.

Code JB :

 
 
    NOMAINWIN
    WindowWidth=700
    WindowHeight=500
    UpperLeftX=INT((DisplayWidth-WindowWidth)/2)
    UpperLeftY=INT((DisplayHeight-WindowHeight)/2)
     STATICTEXT #w.t, "N°Ligne_esp_G ou D_esp_n Pas", 510, 50, 160, 20
     STATICTEXT #w.t, "Exemple: 5 G 2", 510, 80, 160, 20
     STATICTEXT #w.t, "               3 D 1", 510, 95, 160, 20
      TEXTBOX #w.inf, 540 , 120, 60, 20
     STATICTEXT #w.rep, "", 555, 150, 60, 20
    BUTTON #w.a1, "go", [go], UL, 610, 120, 25, 20
    BUTTON #w.a2, "new", [new], UL, 580, 200, 30, 20
 
    GRAPHICBOX #w.g, 5, 5, 500, 400 '600
    open "Pinball" FOR WINDOW AS #w ' graphics
    print #w, "trapclose [quit]"
    #w.g, "setfocus"                         ' pour prise de coord
    #w.g, "When rightButtonUp ButtonrightUp" ' prise de coord
 
    dim h(17,9) : dim z$(3)
    sc=0: br=0  'sc= coups : br= score
 
     print #w.g, "down"
     #w.g, "fill blue"
     #w.g, "Backcolor blue"
 
  [new]
    redim h(17,9) : redim z$(3)
    sc=0: br=0
    print #w.inf, "": print #w.rep, ""  ' vide textbox et report
    for x=1 to 17
      for y=2 to 9
        h(x,y)=1
      next y
    next x
    for y= 2 to 9  ' 4 trous par barre (commentaire origine)
      for b=1 to 4
        x= int(rnd(1)*16)+1
        h(x,y)=0
      next b
    next y
    for b=1 to 8  '  1---8 au sommet (commentaire origine)
     '' h(2*b,1)=b+100 'houla 101 à 108 (ça doit etre des caractères)
    next b
    gosub [draw1]
 wait
    gosub [aa2000]
    gosub [draw1]
 [saisie]
    ''input "barre, g, d, pas: ":z$ 'ligne d'origine
    wait
    [go]
      print #w.inf, "!contents? var$"
      zz$ = var$
      print #w.inf, ""   ' vide textbox
      print #w.rep, zz$  ' report entrée
    for tt=1 to 3
     z$(tt)= word$(zz$,tt) ' rempli le tableau car z$ est lue ()comme un tableau
     next tt
 
    y=val(z$(1))+1   ' le + 1 est à creuser (origine--> val z$(1)+1
    if y< 2 or y >9 then goto [saisie]  'entrée hors limites
    d$=z$(2)                           ' lecture de z$ comme tableau
    dx=val(z$(3))                      ' extraction nombre de pas
    if dx=0 then goto [saisie]         'entrée nulle
    if d$<>"G" and d$<>"D"then goto [saisie]
 [aa570]
    if d$="G" then gosub [gauche]  ' coulisse à gauche
    if d$="D" then gosub [droite]  ' à droite
    br=br+1                       ' score
    gosub [aa2000]
    gosub [draw1]
    ''''''''''''''if sc=8 then stop (instruc origine) fin de jeu
    if dx>1 then dx=dx-1: goto [aa570]
    goto [saisie]
 [draw1]
    for c=1 to 9
      if c=1 then       ' origine--> print "     " ( ligne supérieure)
        #w.g, "color yellow; backcolor black"  ' backcolor différent pour visualiser
        #w.g, "font courier_new 10 bold"
        #w.g, "PLACE "; x; " "; c+50  ' a voir *************
        #w.g, "\dddd"
      end if  'ajouté car affichage necessite plusieurs lignes
      if c >1 then
        #w.g, "color yellow; backcolor black"
        #w.g, "font courier_new 10 bold"
        #w.g, "PLACE "; x; " "; (c*20)+50   ' *20 pour écarter; +50 mise en place
        #w.g, "\";c-1; ">"  'ok affiche N° de ligne
      end if
      for x=1 to 17
        z=h(x,c)
        gosub [draw2]
      next x
      ' print '(la ligne d'origine qui tue car c'est peut etre un saut de ligne
    next c
    'print "score:";sc; "coups:";br
    'print    ' (et re-saut de ligne
    return
 wait
 [draw2]
    if z=0 then    ' origine--> print  " "  ( les trous de la barre)
      #w.g, "color red; backcolor black"
      #w.g, "font courier_new 10 bold"
      #w.g, "PLACE "; x*25; " "; (c*20)+50
      #w.g, "\U   "
    end if
    if z=1 then    ' origine--> print paper 0 " " ( le plein de la barre)
        #w.g, "color yellow; backcolor black"
        #w.g, "font courier_new 10 bold"
        #w.g, "PLACE "; x*25; " "; (c*20)+50  ' a voir *************
        #w.g, "\T"
    end if
    'if z >100 then
    '  zu$=chr$(z-52) 'print chr$(z-52) 'c'est un caractere d'un pc inconnu à voir...
    '  k$="g": x=330: y=50
    '  #w.g "backcolor darkgray"
    ' #w.g "color lightgray"
    ' #w.g, "font courier_new 10 bold"
    ' #w.g, "PLACE "; x; " "; y  ' vide
    ' #w.g, "\"; zu$ 'print chr$(z-52) 'ici c'est le caractere
 
    'end if
    return
 wait
 [aa2000]
    for c=9 to 1 step -1
      for x=1 to 17
        ty=c
        if h(x,c)< 100 then goto [aa2100]
 [aa2040]
        if ty >9 then goto [aa2130]
        if h(x,ty+1)<>0 then goto [aa2100]
        h(x,ty+1)=h(x,ty)
        h(x,ty)=0
        ty=ty+1
        goto [aa2040]
 [aa2100]
      next x
    next c
    return
 [aa2130]
    ''sc=sc+1 ' ligne d'origine ( score)
    h(x,ty)=0
    goto [aa2100]
 [gauche]
    tm=h(1,y)
    for x=1 to 16
      h(x,y)=h(x+1,y)
    next x
    h(17,y)=tm
    return
 [droite]
    tm=h(17,y)
    for x=17 to 2 step -1
    h(x,y)=h(x-1,y)
    next x
    h(1,y)=tm
    return
  ' fin code origine
 
    Sub ButtonrightUp handle$, xClick, yClick  'Sub prise de cotes
       #w.g, "Backcolor black"
       #w.g, "Color yellow"
       #w.g, "Place ";xClick;" ";yClick
       #w.g, "\";xClick
       #w.g, "\"; yClick
       '#w.g, "\MouseY=";yClick
    End Sub
wait
 
  wait
  [quit]
    CLOSE #w
    END

Edité par Roland Le 10/07/2012 à 17h31

____________________
Roro

Nephthys

Le 10/07/2012 à 17h59

Administrateur

Groupe: Administrateur

Inscrit le: 24/09/2010
Messages: 238

Le code est fonctionnel ? Car quand je tape quelque chose rien ne se passe

____________________

MSN Yahoo Web

Roland

Le 10/07/2012 à 18h19

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2484

Déjà beau que je sois arrivé jusque là, parce que la grande différence entre avant et maintenant...
c'est: ... l'Affichage,

sans parler de la résolution.
Je vais essayer de le faire fonctionner..mais je garanti rien....car , faut pas l'oublier, je suis: newbee..bzzzzz

____________________
Roro

cassiope01

Le 10/07/2012 à 19h01

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767

Je ne comprends pas très bien Roland, dès la mise en place du jeu, des trucs doivent tomber puisqu'il y a des trous dans la première barre ?
De combien peut-on déplacer une barre au maxi ?
Tu es sûr de l'intérêt du jeu ?

Ce serait plutôt le bon truc pour t'essayer au GUI (sur la base du prog de grille) avec les bitmaps de boule de pétanque de ton jeu de boules qui tombaient dans les colonnes, le tout jouable entièrement à la souris bien sûr !

@+

Edité par cassiope01 Le 10/07/2012 à 19h06

____________________
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

Roland

Le 10/07/2012 à 20h02

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2484

J'y ai pensé, mais je ne maitrise pas encore trés bien l'affichage. Par exemple, je suis toujours sur le jeu de billes, et j'ai du mal avec le réaffichage du background.
J'ai vu qu'à un moment tu sort les sprites de la fenetre, j'ai fait des essais à part, et j'ai vu des trucs vraiment bizarres quand le sprite reste dans la fenetre.
Il y a encore pas mal de choses qui m'échappent...
L'intérét du jeu...ne doit pas casser des briques... c'est plus pour me faire les griffes, que pour réhabiliter le jeu. J'en suis encore aux exercices, pas aux vraies réalisations..
.J'ai peut-etre le cerf-volant....

Edité par Roland Le 10/07/2012 à 20h03

____________________
Roro

cassiope01

Le 10/07/2012 à 22h00

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767

O background et 0 sprites : pas besoin de tout ça.
Juste afficher les bmp aux bon endroits aux bon moment en gérant bien la grille et hop, le tour est joué.

____________________
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

Roland

Le 10/07/2012 à 22h22

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2484

En parallele à la transcription , je le tente en partant de zéro...c'est pas gagné...

Pour le background et les sprites, c'est de la cafetière que je parlais
je ne m'avoue pas vaincu sur ce coup là. .............à+

____________________
Roro

cassiope01

Le 11/07/2012 à 09h30

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767

Effectivement l'intérêt du jeu n'est pas si facile à percevoir, mais tu peux te faire la main là dessus

fichiers images :

et

ou

( à nommer Bille21.bmp et Mur3.bmp ou Mur1.bmp )

Le code : le plus simple que j'ai pu avec des SUBs...
Tu pourrais ajouter un bouton pour changer de niveau par exemple, c'est très facile.

Code VB :

nomainwin
 
    GLOBAL ncx, ncy, dc
 
    ncx = 16   ' nbr of cells X
    ncy = 9    ' nbr of cells Y
    dc = 42    ' size of a cell in pixels
    MapWidth = (ncx+2)*dc+int(dc/ncx)
    MapHeight = (ncy)*dc+int(dc/ncy)
 
    WindowWidth  = MapWidth + 15
    WindowHeight = MapHeight + 75
    UpperLeftX = (DisplayWidth-WindowWidth) / 3
    UpperLeftY = (DisplayHeight-WindowHeight) / 2
 
   ' mois$ = "January February March April May June July August September October November December"
    mois$ = "Janvier Février Mars Avril Mai Juin Juillet Août Septembre Octobre Novembre Décembre"   ' french
    today$ = date$("mm/dd/yyyy")
    j = date$(today$)
   ' jsem$ = word$("Tuesday Wednesday Thursday x Friday Saturday x Sunday Monday",int((j/7-int(j/7))*10)+1)
    jsem$ = word$("Mardi Mercredi Jeudi x Vendredi Samedi x Dimanche Lundi",int((j/7-int(j/7))*10)+1)   ' french
    date$ = jsem$+" "+mid$(today$,4,2)+" "+word$(mois$, val(today$))+" "+right$(today$,4)+"  "+left$(time$(),5)
 
    DIM cell(ncx,ncy)
 
    loadbmp "mur",   "Mur1.bmp"
    loadbmp "boule", "Bille21.bmp"
 
    statictext #w.txt "",5,10,350,25  ' just for debug
    graphicbox #w.map, 5+dc, 40, MapWidth-2*dc, MapHeight
    button #w.bt11 "", boutons, UL, 3, 40+(1*dc), dc, dc
    button #w.bt21 "", boutons, UL, 3, 40+(2*dc)+1, dc, dc
    button #w.bt31 "", boutons, UL, 3, 40+(3*dc)+2, dc, dc
    button #w.bt41 "", boutons, UL, 3, 40+(4*dc)+3, dc, dc
    button #w.bt51 "", boutons, UL, 3, 40+(5*dc)+4, dc, dc
    button #w.bt61 "", boutons, UL, 3, 40+(6*dc)+5, dc, dc
    button #w.bt71 "", boutons, UL, 3, 40+(7*dc)+6, dc, dc
    button #w.bt81 "", boutons, UL, 3, 40+(8*dc)+7, dc, dc
    button #w.bt12 "", boutons, UL, 9+17*dc, 40+(1*dc), dc, dc
    button #w.bt22 "", boutons, UL, 9+17*dc, 40+(2*dc)+1, dc, dc
    button #w.bt32 "", boutons, UL, 9+17*dc, 40+(3*dc)+2, dc, dc
    button #w.bt42 "", boutons, UL, 9+17*dc, 40+(4*dc)+3, dc, dc
    button #w.bt52 "", boutons, UL, 9+17*dc, 40+(5*dc)+4, dc, dc
    button #w.bt62 "", boutons, UL, 9+17*dc, 40+(6*dc)+5, dc, dc
    button #w.bt72 "", boutons, UL, 9+17*dc, 40+(7*dc)+6, dc, dc
    button #w.bt82 "", boutons, UL, 9+17*dc, 40+(8*dc)+7, dc, dc
    button #w.new "New",[new],UL,MapWidth-55,6,60,27
    OPEN "    TEST Chute(s)... "+space$(15)+date$ for window_nf as #w  'graphics_nf_nsb
    #w "trapclose [quit]"
    #w.map "down; backcolor black; fill black"
    #w.map "getbmp p0 0 0 ";dc;" ";dc  ' empty cell for deleting
    #w.new "!font Arial 12 bold"
 
    for bt = 1 to 16
        btn$ = "#w.bt"+word$("11 21 31 41 51 61 71 81 12 22 32 42 52 62 72 82",bt)
        #btn$ "!font Arial 16 bold"
        if bt<9 then #btn$ ">" else #btn$ "<"
    next
 
    [new]
 
    RESTORE [niveau1]
 
    for y=1 to ncy
        for x=1 to ncx
            read val  ' read ne peut pas affecter directement une var. tableau.
            cell(x,y) = val
        next
        call drawRow y
    next
 
    call fall  ' première chute dès la mise en place

 
    WAIT
 
    sub fall   ' gère toutes les chutes potentielles dans toute la grille
        for cy = ncy-1 to 1 step -1 ' en partant du bas bien sûr !
            for cx = 1 to ncx
                by = cy
                while by+1 <= ncy
                    if cell(cx,by) = 2 and cell(cx,by+1) = 0 then
                        cell(cx,by) = 0
                        #w.map "drawbmp p0 ";(cx-1)*dc;" ";(by-1)*dc
                        cell(cx,by+1) = 2
                        #w.map "drawbmp boule ";(cx-1)*dc;" ";by*dc
                    end if
                    by = by + 1
                wend
            next
        next
    end sub
 
    sub boutons handle$  ' décalage d'une ligne en fonction du bouton pressé
                         ' les extrémités reviennent de l'autre côté...
        row = val(mid$(handle$,6,1))+1 'extraction de la ligne grace aux noms des boutons (judicieusement nommés ;) )
        dir = val(mid$(handle$,7,1))   'et extraction du sens
        if dir = 1 then             ' vers la droite
            temp = cell(ncx,row)
            for x=ncx to 2 step -1
                cell(x,row) = cell(x-1,row)
            next
            cell(1,row) = temp
        else                        ' vers la gauche
            temp = cell(1,row)
            for x=1 to ncx-1
                cell(x,row) = cell(x+1,row)
            next
            cell(ncx,row) = temp
        end if
        call drawRow row
        call fall
    end sub
 
    sub drawRow r    ' dessine le contenu d'une ligne
        for x=1 to ncx
            select case cell(x,r)
            case 0 :#w.map "drawbmp p0 ";(x-1)*dc;" ";(r-1)*dc
            case 1 :#w.map "drawbmp mur ";(x-1)*dc;" ";(r-1)*dc
            case 2 :#w.map "drawbmp boule ";(x-1)*dc;" ";(r-1)*dc
            end select
        next
    end sub
 
    [niveau1]
    data 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2    ' 2 = boule, 1 = mur, 0 = trou
    data 1,1,0,1,1,0,1,1,0,1,1,0,1,1,1,1
    data 1,1,1,0,1,1,1,0,1,1,1,1,1,0,1,1
    data 1,0,1,1,1,0,1,1,1,1,1,0,1,1,1,1
    data 1,1,0,0,1,1,1,0,1,0,1,1,1,1,0,1
    data 1,1,0,1,1,0,1,1,1,1,0,1,1,1,1,1
    data 1,0,1,1,0,1,1,0,1,1,1,1,0,1,1,1
    data 1,1,1,0,1,1,1,1,0,1,1,1,1,0,1,1
    data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
 
    [niveau2]
    data 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2    ' 2 = boule, 1 = mur, 0 = trou
    data 1,1,0,1,1,0,1,1,0,1,0,0,1,1,1,1
    data 1,0,1,0,1,0,1,0,1,1,0,1,1,0,1,1
    data 0,0,1,0,1,0,0,1,0,1,0,0,1,1,1,1
    data 1,1,0,0,1,0,1,0,1,0,1,1,0,0,0,1
    data 0,1,0,1,1,0,1,0,0,1,0,1,1,1,1,1
    data 1,0,1,1,0,1,1,0,1,1,0,1,0,1,1,1
    data 0,1,1,0,1,0,0,1,0,1,0,1,1,0,0,1
    data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
 
    [quit]
        unloadbmp "mur"
        unloadbmp "boule"
        close #w
        end
    wait

PS: il faudrait voir si un modo ne pourrait pas corriger le fait que les fichiers mis à dispo depuis le petit espace dédié au stockage par utilisateur renvoi le nom du fichier et non son contenu. Il me semble que ça ne le faisait pas avant. merci bien au modo qui passerait par là éventuellement !

Edité par cassiope01 Le 11/07/2012 à 10h30

____________________
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

Roland

Le 11/07/2012 à 10h54

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2484

Merci pour le code...

Pour ton PS: ça doit dépendre du navigateur; parce que avec "Chrome" quand je clique sur un lien, il y a une grosse fleche bleue qui descend , et le zip va tout seul dans le dossier "Donwload" .
Si ce n'est pas de ça que tu parle, je ne comprend pas le sens du PS.....à+

____________________
Roro

cassiope01

Le 11/07/2012 à 11h02

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767

J'utilise FireFox, et dans mon post je vois pas de lien mais directement l'image...!
Il te faut donc faire 'clic droit' et 'enregistrer sous' pour le télécharger (et lui donner un nom) au lieu d'avoir directement un dialogue 'Enregistrer sous'.

Dans le code, j'ai remplacé la ligne Code VB :

read val

par Code VB :

if y=1 then val = 2 else if y=ncy then val = 0 else val = int(rnd(0)*2)  ' tirage au hasard

pour que les trous et les murs soient tirés au hasard, et c'est pas mal

@+

Edité par cassiope01 Le 11/07/2012 à 11h08

____________________
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

Roland

Le 11/07/2012 à 11h38

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2484

Ha.. tu parle des images..j'ai vu ça aussi, quand j'en ai mis, j'ai du en faire un zip.

Ton code, qui est :

....................

...Comme d'hab, m'a fait saisir l'intérét du jeu.
A l'époque ces jeux étaient destinés à des jeunes, et le fait de devoir entrer les données au clavier obligeait à une certaine attention. C'était ça l'intérét.
Les modifs que je vais tenter d'intégrer (à mon niveau, ça va va etre "coton") sont:
a)- Un seul "pas" par barre/coup .
b)- Au coup suivant, la bille doit etre "enfermée", sinon elle remonte.
Avec ta permission, je vais regrouper les boutons du meme coté (tu veux me niquer les tendons du poignet ou quouuua...

)

____________________
Roro

cassiope01

Le 11/07/2012 à 11h48

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767

C'est fait pour toi : tu en fais ce que tu veux bien entendu

a) y a déjà un seul "pas" par barre/coup !?!
b) ça ça va pas être simple

Bonne idée pour les boutons. (les tendons des neurônes plutôt

)

@+

Edité par cassiope01 Le 11/07/2012 à 11h48

____________________
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

Roland

Le 11/07/2012 à 11h48

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2484

Hey , tu serais pas le fils caché d'Einstein..toi ?...Rapport à la relativité des coordonnées..

____________________
Roro

cassiope01

Le 11/07/2012 à 12h28

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767

ça doit être ça

Dès lors que des coordonnées doivent changer selon une action quelconque, autant utiliser des variables non !!!!

la version jouable entièrement au clavier.

Code VB :

nomainwin
 
    GLOBAL ncx, ncy, dc
 
    ncx = 16   ' nbr of cells X
    ncy = 9    ' nbr of cells Y
    dc = 42    ' size of a cell in pixels
    MapWidth = (ncx+2)*dc+int(dc/ncx)
    MapHeight = (ncy)*dc+int(dc/ncy)
 
    WindowWidth  = MapWidth + 15
    WindowHeight = MapHeight + 75
    UpperLeftX = (DisplayWidth-WindowWidth) / 3
    UpperLeftY = (DisplayHeight-WindowHeight) / 2
 
   ' mois$ = "January February March April May June July August September October November December"
    mois$ = "Janvier Février Mars Avril Mai Juin Juillet Août Septembre Octobre Novembre Décembre"   ' french
    today$ = date$("mm/dd/yyyy")
    j = date$(today$)
   ' jsem$ = word$("Tuesday Wednesday Thursday x Friday Saturday x Sunday Monday",int((j/7-int(j/7))*10)+1)
    jsem$ = word$("Mardi Mercredi Jeudi x Vendredi Samedi x Dimanche Lundi",int((j/7-int(j/7))*10)+1)   ' french
    date$ = jsem$+" "+mid$(today$,4,2)+" "+word$(mois$, val(today$))+" "+right$(today$,4)+"  "+left$(time$(),5)
 
    DIM cell(ncx,ncy)
 
    loadbmp "mur",   "Mur1.bmp"
    loadbmp "boule", "Boule.bmp"
 
    statictext #w.txt "",5,10,350,25  ' just for debug
    graphicbox #w.map, 5, 40, MapWidth-2*dc, MapHeight
    button #w.bt11 "", boutons, UL, 9+17*dc, 40+(1*dc), dc, dc
    button #w.bt21 "", boutons, UL, 9+17*dc, 40+(2*dc)+1, dc, dc
    button #w.bt31 "", boutons, UL, 9+17*dc, 40+(3*dc)+2, dc, dc
    button #w.bt41 "", boutons, UL, 9+17*dc, 40+(4*dc)+3, dc, dc
    button #w.bt51 "", boutons, UL, 9+17*dc, 40+(5*dc)+4, dc, dc
    button #w.bt61 "", boutons, UL, 9+17*dc, 40+(6*dc)+5, dc, dc
    button #w.bt71 "", boutons, UL, 9+17*dc, 40+(7*dc)+6, dc, dc
    button #w.bt81 "", boutons, UL, 9+17*dc, 40+(8*dc)+7, dc, dc
    button #w.bt12 "", boutons, UL, 9+16*dc, 40+(1*dc), dc, dc
    button #w.bt22 "", boutons, UL, 9+16*dc, 40+(2*dc)+1, dc, dc
    button #w.bt32 "", boutons, UL, 9+16*dc, 40+(3*dc)+2, dc, dc
    button #w.bt42 "", boutons, UL, 9+16*dc, 40+(4*dc)+3, dc, dc
    button #w.bt52 "", boutons, UL, 9+16*dc, 40+(5*dc)+4, dc, dc
    button #w.bt62 "", boutons, UL, 9+16*dc, 40+(6*dc)+5, dc, dc
    button #w.bt72 "", boutons, UL, 9+16*dc, 40+(7*dc)+6, dc, dc
    button #w.bt82 "", boutons, UL, 9+16*dc, 40+(8*dc)+7, dc, dc
    button #w.new "New",[new],UL,MapWidth-55,6,60,27
    OPEN "    TEST Chute(s)... "+space$(15)+date$ for window_nf as #w  'graphics_nf_nsb
    #w "trapclose [quit]"
    #w.map "down; backcolor black; fill black"
    #w.map "getbmp p0 0 0 ";dc;" ";dc  ' empty cell for deleting
    #w.new "!font Arial 12 bold"
 
    for bt = 1 to 16
        btn$ = "#w.bt"+word$("11 21 31 41 51 61 71 81 12 22 32 42 52 62 72 82",bt)
        #btn$ "!font Arial 16 bold"
        if bt<9 then #btn$ ">" else #btn$ "<"
    next
 
    [new]
 
    RESTORE [niveau1]
 
    for y=1 to ncy
        for x=1 to ncx
            'read val  ' read ne peut pas affecter directement une var. tableau.
            if y=1 then val = 2 else if y=ncy then val = 0 else val = int(rnd(0)*2)  ' tirage au hasard
            cell(x,y) = val
        next
        call drawRow y
    next
 
    call fall  ' première chute dès la mise en place

    curentRow = 1
 
    #w.map "setfocus"
    #w.map "when characterInput [arrows]"
 
    goto [arrows]
    WAIT
 
    [arrows]
        dir = 0
        codeT = asc(right$(Inkey$,1))
        select case codeT
        case _VK_UP    :curentRow = curentRow -1 + 8*(curentRow=1)
        case _VK_RIGHT :dir = 1
        case _VK_DOWN  :curentRow = curentRow +1 - 8*(curentRow=8)
        case _VK_LEFT  :dir = 2
        end select
        for btn = 1 to 8
            btn$ = "#w.bt";btn;1
            #btn$ "!disable"
            btn$ = "#w.bt";btn;2
            #btn$ "!disable"
        next
        btn$ = "#w.bt";curentRow;1
        #btn$ "!enable"
        btn$ = "#w.bt";curentRow;2
        #btn$ "!enable"
        if dir then call boutons "#w.bt"+str$(curentRow)+str$(dir)
    wait
 
    sub fall   ' gère toutes les chutes potentielles dans toute la grille
        for cy = ncy-1 to 1 step -1 ' en partant du bas bien sûr !
            for cx = 1 to ncx
                by = cy
                while by+1 <= ncy
                    if cell(cx,by) = 2 and cell(cx,by+1) = 0 then
                        cell(cx,by) = 0
                        #w.map "drawbmp p0 ";(cx-1)*dc;" ";(by-1)*dc
                        cell(cx,by+1) = 2
                        #w.map "drawbmp boule ";(cx-1)*dc;" ";by*dc
                    end if
                    by = by + 1
                wend
            next
        next
    end sub
 
    sub boutons handle$  ' décalage d'une ligne en fonction du bouton pressé
                         ' les extrémités reviennent de l'autre côté...
        row = val(mid$(handle$,6,1))+1 'extraction de la ligne grace aux noms des boutons (judicieusement nommés ;) )
        dir = val(mid$(handle$,7,1))   'extraction du sens
        if dir = 1 then             ' vers la droite
            temp = cell(ncx,row)
            for x=ncx to 2 step -1
                cell(x,row) = cell(x-1,row)
            next
            cell(1,row) = temp
        else                        ' vers la gauche
            temp = cell(1,row)
            for x=1 to ncx-1
                cell(x,row) = cell(x+1,row)
            next
            cell(ncx,row) = temp
        end if
        call drawRow row
        call fall
        #w.map "flush; discard"
        #w.map "setfocus"
    end sub
 
    sub drawRow r    ' dessine le contenu d'une ligne
        for x=1 to ncx
            select case cell(x,r)
            case 0 :#w.map "drawbmp p0 ";(x-1)*dc;" ";(r-1)*dc
            case 1 :#w.map "drawbmp mur ";(x-1)*dc;" ";(r-1)*dc
            case 2 :#w.map "drawbmp boule ";(x-1)*dc;" ";(r-1)*dc
            end select
        next
    end sub
 
    [niveau1]
    data 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2    ' 2 = boule, 1 = mur, 0 = trou
    data 1,1,0,1,1,0,1,1,0,1,1,0,1,1,1,1
    data 1,1,1,0,1,1,1,0,1,1,1,1,1,0,1,1
    data 1,0,1,1,1,0,1,1,1,1,1,0,1,1,1,1
    data 1,1,0,0,1,1,1,0,1,0,1,1,1,1,0,1
    data 1,1,0,1,1,0,1,1,1,1,0,1,1,1,1,1
    data 1,0,1,1,0,1,1,0,1,1,1,1,0,1,1,1
    data 1,1,1,0,1,1,1,1,0,1,1,1,1,0,1,1
    data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
 
    [niveau2]
    data 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2    ' 2 = boule, 1 = mur, 0 = trou
    data 1,1,0,1,1,0,1,1,0,1,0,0,1,1,1,1
    data 1,0,1,0,1,0,1,0,1,1,0,1,1,0,1,1
    data 0,0,1,0,1,0,0,1,0,1,0,0,1,1,1,1
    data 1,1,0,0,1,0,1,0,1,0,1,1,0,0,0,1
    data 0,1,0,1,1,0,1,0,0,1,0,1,1,1,1,1
    data 1,0,1,1,0,1,1,0,1,1,0,1,0,1,1,1
    data 0,1,1,0,1,0,0,1,0,1,0,1,1,0,0,1
    data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
 
    [quit]
        unloadbmp "mur"
        unloadbmp "boule"
        close #w
        end
    wait

Edité par cassiope01 Le 11/07/2012 à 13h00

____________________
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

Roland

Le 11/07/2012 à 13h44

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2484

La première difficulté, et non des moindres, c'est d'obliger à changer de barre à chaque coup,
pas de double appui sur le meme bouton. ( flag ou pas flag ?...)
J'apprend, et je le mets dans l'aide parce que ce n'était pas évident, que quand un bouton appelle une sub,
le prog se mets en attente sur le: "End Sub".

____________________
Roro

cassiope01

Le 11/07/2012 à 14h20

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767

Roland:

La première difficulté, et non des moindres, c'est d'obliger à changer de barre à chaque coup, pas de double appui sur le meme bouton. ( flag ou pas flag ?...)

je ne comprends pas. Tu veux dire d'imposer la barre suivante au prochain coup ? ou bien jamais 2 fois la même barre d'affilé ?

Roland:

J'apprend, et je le mets dans l'aide parce que ce n'était pas évident, que quand un bouton appelle une sub, le prog se mets en attente sur le: "End Sub".

Je ne crois pas non.
Vu qu'il n'y a pas de 'wait' nécessaire pour attendre l'appui sur un bouton (cela peut se produire à n'importe quel moment à la volonté de l'utilisateur ! ), le programme se met en attente tout simplement au dernier 'wait' rencontré, bouton ou pas bouton.

Une SUB ou une FUNCTION s'execute jusqu'à son END, qui dit juste au programme de continuer là où elles ont été appelées. C'est aussi simple que ça.

Edité par cassiope01 Le 11/07/2012 à 15h11

____________________
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

Roland

Le 11/07/2012 à 15h23

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2484

Je dis ça parce que je l'ai vu au débuggeur. Je m'attendais à ce qu'il s'arrete au wait, et il s'est arrété au end sub.
Il s'agit de ne pouvoir faire faire qu'un seul pas à la barre par coup, pas de double appui, choix obligatoire d'une autre barre au coup suivant , avec: !disable et le handle, il doit y avoir moyen de s'éviter 2x8 instructions , peut-etre ?

____________________
Roro

cassiope01

Le 11/07/2012 à 15h29

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767

Ok.
Il te faut simplement mémoriser le n° de la dernière barre activée, puis vérifier que la barre qu'on est en train de chercher à bouger n'a pas le même n° et si c'est le cas, enregistrer ce nouveau n° comme référence...

Comme ça : ( regarde 'oldRow' )

Code VB :

nomainwin
 
    GLOBAL ncx, ncy, dc
 
    ncx = 16   ' nbr of cells X
    ncy = 9    ' nbr of cells Y
    dc = 42    ' size of a cell in pixels
    MapWidth = (ncx+2)*dc+int(dc/ncx)
    MapHeight = (ncy)*dc+int(dc/ncy)
 
    WindowWidth  = MapWidth + 15
    WindowHeight = MapHeight + 75
    UpperLeftX = (DisplayWidth-WindowWidth) / 3
    UpperLeftY = (DisplayHeight-WindowHeight) / 2
 
   ' mois$ = "January February March April May June July August September October November December"
    mois$ = "Janvier Février Mars Avril Mai Juin Juillet Août Septembre Octobre Novembre Décembre"   ' french
    today$ = date$("mm/dd/yyyy")
    j = date$(today$)
   ' jsem$ = word$("Tuesday Wednesday Thursday x Friday Saturday x Sunday Monday",int((j/7-int(j/7))*10)+1)
    jsem$ = word$("Mardi Mercredi Jeudi x Vendredi Samedi x Dimanche Lundi",int((j/7-int(j/7))*10)+1)   ' french
    date$ = jsem$+" "+mid$(today$,4,2)+" "+word$(mois$, val(today$))+" "+right$(today$,4)+"  "+left$(time$(),5)
 
    DIM cell(ncx,ncy)
 
    loadbmp "mur",   "Mur1.bmp"
    loadbmp "boule", "Boule.bmp"
 
    statictext #w.txt "",5,10,350,25  ' just for debug
    graphicbox #w.map, 5, 40, MapWidth-2*dc, MapHeight
    button #w.bt11 "", boutons, UL, 9+17*dc, 40+(1*dc), dc, dc
    button #w.bt21 "", boutons, UL, 9+17*dc, 40+(2*dc)+1, dc, dc
    button #w.bt31 "", boutons, UL, 9+17*dc, 40+(3*dc)+2, dc, dc
    button #w.bt41 "", boutons, UL, 9+17*dc, 40+(4*dc)+3, dc, dc
    button #w.bt51 "", boutons, UL, 9+17*dc, 40+(5*dc)+4, dc, dc
    button #w.bt61 "", boutons, UL, 9+17*dc, 40+(6*dc)+5, dc, dc
    button #w.bt71 "", boutons, UL, 9+17*dc, 40+(7*dc)+6, dc, dc
    button #w.bt81 "", boutons, UL, 9+17*dc, 40+(8*dc)+7, dc, dc
    button #w.bt12 "", boutons, UL, 9+16*dc, 40+(1*dc), dc, dc
    button #w.bt22 "", boutons, UL, 9+16*dc, 40+(2*dc)+1, dc, dc
    button #w.bt32 "", boutons, UL, 9+16*dc, 40+(3*dc)+2, dc, dc
    button #w.bt42 "", boutons, UL, 9+16*dc, 40+(4*dc)+3, dc, dc
    button #w.bt52 "", boutons, UL, 9+16*dc, 40+(5*dc)+4, dc, dc
    button #w.bt62 "", boutons, UL, 9+16*dc, 40+(6*dc)+5, dc, dc
    button #w.bt72 "", boutons, UL, 9+16*dc, 40+(7*dc)+6, dc, dc
    button #w.bt82 "", boutons, UL, 9+16*dc, 40+(8*dc)+7, dc, dc
    button #w.new "New",[new],UL,MapWidth-55,6,60,27
    OPEN "    TEST Chute(s)... "+space$(15)+date$ for window_nf as #w  'graphics_nf_nsb
    #w "trapclose [quit]"
    #w.map "down; backcolor black; fill black"
    #w.map "getbmp p0 0 0 ";dc;" ";dc  ' empty cell for deleting
    #w.new "!font Arial 12 bold"
 
    for bt = 1 to 16
        btn$ = "#w.bt"+word$("11 21 31 41 51 61 71 81 12 22 32 42 52 62 72 82",bt)
        #btn$ "!font Arial 16 bold"
        if bt<9 then #btn$ ">" else #btn$ "<"
    next
 
    [new]
 
    RESTORE [niveau1]
 
    for y=1 to ncy
        for x=1 to ncx
            'read val  ' read ne peut pas affecter directement une var. tableau.
            if y=1 then val = 2 else if y=ncy then val = 0 else val = int(rnd(0)*2)  ' tirage au hasard
            cell(x,y) = val
        next
        call drawRow y
    next
 
    call fall  ' première chute dès la mise en place

    curentRow = 1
    oldRow = 0
 
    #w.map "setfocus"
    #w.map "when characterInput [arrows]"
 
    goto [arrows]
 
    WAIT
 
    [arrows]
        dir = 0
        codeT = asc(right$(Inkey$,1))
        select case codeT
        case _VK_UP    :curentRow = curentRow -1 + 8*(curentRow=1)
        case _VK_RIGHT :dir = 1
        case _VK_DOWN  :curentRow = curentRow +1 - 8*(curentRow=8)
        case _VK_LEFT  :dir = 2
        end select
        if curentRow = oldRow then dir = 0  ' si même ligne que la dernière fois : il ne devra rien se passer...
        for btn = 1 to 8
            btn$ = "#w.bt";btn;1
            #btn$ "!disable"
            btn$ = "#w.bt";btn;2
            #btn$ "!disable"
        next
        btn$ = "#w.bt";curentRow;1
        #btn$ "!enable"
        btn$ = "#w.bt";curentRow;2
        #btn$ "!enable"
        if dir then call boutons "#w.bt"+str$(curentRow)+str$(dir) :oldRow = curentRow  ' mémorise le n° de la ligne bougée.
    wait
 
    sub fall   ' gère toutes les chutes potentielles dans toute la grille
        for cy = ncy-1 to 1 step -1 ' en partant du bas bien sûr !
            for cx = 1 to ncx
                by = cy
                while by+1 <= ncy
                    if cell(cx,by) = 2 and cell(cx,by+1) = 0 then
                        cell(cx,by) = 0
                        #w.map "drawbmp p0 ";(cx-1)*dc;" ";(by-1)*dc
                        cell(cx,by+1) = 2
                        #w.map "drawbmp boule ";(cx-1)*dc;" ";by*dc
                    end if
                    by = by + 1
                wend
            next
        next
    end sub
 
    sub boutons handle$  ' décalage d'une ligne en fonction du bouton pressé
                         ' les extrémités reviennent de l'autre côté...
        row = val(mid$(handle$,6,1))+1 'extraction de la ligne grace aux noms des boutons (judicieusement nommés ;) )
        dir = val(mid$(handle$,7,1))   'extraction du sens
        if dir = 1 then             ' vers la droite
            temp = cell(ncx,row)
            for x=ncx to 2 step -1
                cell(x,row) = cell(x-1,row)
            next
            cell(1,row) = temp
        else                        ' vers la gauche
            temp = cell(1,row)
            for x=1 to ncx-1
                cell(x,row) = cell(x+1,row)
            next
            cell(ncx,row) = temp
        end if
        call drawRow row
        call fall
        #w.map "flush; discard"
        #w.map "setfocus"
    end sub
 
    sub drawRow r    ' dessine le contenu d'une ligne
        for x=1 to ncx
            select case cell(x,r)
            case 0 :#w.map "drawbmp p0 ";(x-1)*dc;" ";(r-1)*dc
            case 1 :#w.map "drawbmp mur ";(x-1)*dc;" ";(r-1)*dc
            case 2 :#w.map "drawbmp boule ";(x-1)*dc;" ";(r-1)*dc
            end select
        next
    end sub
 
    [niveau1]
    data 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2    ' 2 = boule, 1 = mur, 0 = trou
    data 1,1,0,1,1,0,1,1,0,1,1,0,1,1,1,1
    data 1,1,1,0,1,1,1,0,1,1,1,1,1,0,1,1
    data 1,0,1,1,1,0,1,1,1,1,1,0,1,1,1,1
    data 1,1,0,0,1,1,1,0,1,0,1,1,1,1,0,1
    data 1,1,0,1,1,0,1,1,1,1,0,1,1,1,1,1
    data 1,0,1,1,0,1,1,0,1,1,1,1,0,1,1,1
    data 1,1,1,0,1,1,1,1,0,1,1,1,1,0,1,1
    data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
 
    [niveau2]
    data 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2    ' 2 = boule, 1 = mur, 0 = trou
    data 1,1,0,1,1,0,1,1,0,1,0,0,1,1,1,1
    data 1,0,1,0,1,0,1,0,1,1,0,1,1,0,1,1
    data 0,0,1,0,1,0,0,1,0,1,0,0,1,1,1,1
    data 1,1,0,0,1,0,1,0,1,0,1,1,0,0,0,1
    data 0,1,0,1,1,0,1,0,0,1,0,1,1,1,1,1
    data 1,0,1,1,0,1,1,0,1,1,0,1,0,1,1,1
    data 0,1,1,0,1,0,0,1,0,1,0,1,1,0,0,1
    data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
 
    [quit]
        unloadbmp "mur"
        unloadbmp "boule"
        close #w
        end
    wait

Le jeu en devient assez différent et un peu laborieux

@+

Edité par cassiope01 Le 11/07/2012 à 15h32

____________________
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

Roland

Le 11/07/2012 à 15h58

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2484

Houla!...attend,je reste avec la version "non aléatoire" ( plus facile visuellement pour bricoler)
.....Please.....ne me mets pas des farces et attrapes:...Bille21.bmp-->Boule.bmp (ou je te confisque ton "arrache"

J'ai réussi à écrire ce qu'il faut pour !désabler, que j'ai mis juste avant le end sub
mais il me !désable le bouton suivant dans la bonne colonne (dir)!?!

____________________
Roro

cassiope01

Le 11/07/2012 à 16h03

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767

Ha ha ! c'est bien, ça prouve que tu suis

Tu veux !disabler quoi ? c'est déjà fait ça !!! (en tout cas si tu as pris la version clavier

)

Edité par cassiope01 Le 11/07/2012 à 16h51

____________________
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

Forum Liberty Basic France