Forum Liberty Basic France

• Index
• Jeux » Chutes Ancien jeu Remanié 2012
cassiope01
Le 14/07/2012 à 09h33

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
Reprise du message précédent

Roland:
Ceci dit, je suis bien d'accord avec toit pour appeller ce léger défaut que présente les sub's :
une CarlGundelerie...... Je lui descerne donc un navet d'or....


Ce défaut n'a absolument rien à voir avec les SUB.

C'est un pb de contrôle des évènements par JB et je ne sais pas si c'est mieux fait ou différent avec LB ?

@+
____________________
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 14/07/2012 à 10h00

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2489
Oh! ! ! Trop fort ! ! ! :top :top :top .je suis scié ! ! ! C'est l'arme fatale...Un cas d'école à mettre précieusement de coté.
Je n'ai pas réfléchi à la question, mais je suppose qu'on ne peut pas mettre dans la fenetre, une autre map qui serait un faux bouton (si tu peux me dire un bref pourquoi..deux(2) ;) ;) petites lignes .)
Comme il ne doit pas etre possible de désactiver la croix de fermeture pendant la fractale.
Oui, la nouvelle fenetre, c'est que j'ai rechigné à désactiver les cent douze boutons, et puis c'était un petit challenge de retrouver les valeurs brutes de tes relatives dimensions.
Le:.....*dc+int(dc/ncx), me laisse encore... perplexe.
Il reste le problème de: l'exit sub que je ne suis pas arrivé à faire fonctionner, ni avec JB, ni avec LB.
Je ne sais pas quel temps il fait chez toi, ici il y a un concert de grenouilles.......à+



Edité par Roland Le 14/07/2012 à 11h40
____________________
Roro
   
Roland
Le 14/07/2012 à 11h43

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2489
Je pense ajouter la chose suivante:
Désactiver les boutons au fur et à mesure que les lignes supérieure se vident de billes.
J'essaie de faire ça en une seule procédure, je ne sais pas si ce sera possible.......à+
J(ai fait un nouveau zip avec tes modifs:

Chutes.zip



Edité par Roland Le 14/07/2012 à 11h47
____________________
Roro
   
Roland
Le 14/07/2012 à 16h41

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2489
C'est fait, et ça marche, les boutons sont désactivés au fur et à mesure que les lignes se vident
.Par contre, j'ai été obligé de réactiver les boutons au [new]

Code JB :
 
 
 
 'http://libertybasic.fr/forum/topic-162-1+code-en-cours-de-defrichage.php
  'http://libertybasic.fr/forum/topic-163+chutes.php
   'with coolFractal.bas contributed by Rod extract of JB exemples
 
    nomainwin
 
    GLOBAL ncx, ncy, dc, mm, bb, midx, midy, FIN
    global ro, di, oldro, oldi, coup, coup, tscore, midx, midy
 
    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 = 378  ' (ncy)*dc+int(dc/ncy)  '378
 
    midx=int(MapWidth/2)-80
    midy=int(MapHeight/2)
 
    WindowWidth  = MapWidth + 65
    WindowHeight = MapHeight + 75  ' 498  ' 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): DIM quoi(ncx+1,ncy)
 
    button #w.bi "Bille", [bi], UL, 40, 5, 60, 25
    button #w.mu "Mur", [mu], UL, 120, 5, 60, 25
    statictext #w.txt "Jeu",460,10,200,30
    button #w.ni "Niveau: 1", [niv], UL, 310, 5, 80, 25
    statictext #w.tt "Triche", 40+17*dc, 40+(8*dc)+7,50,20
    graphicbox #w.map, 5+dc, 40, MapWidth-2*dc, MapHeight
    button #w.bt11 "", boutons, UL, 775, 44+(1*dc), dc, dc-10  '  à droite
    button #w.bt21 "", boutons, UL, 775, 44+(2*dc)+1, dc, dc-10
    button #w.bt31 "", boutons, UL, 775, 44+(3*dc)+2, dc, dc-10
    button #w.bt41 "", boutons, UL, 775, 44+(4*dc)+3, dc, dc-10
    button #w.bt51 "", boutons, UL, 775, 43+(5*dc)+4, dc, dc-10
    button #w.bt61 "", boutons, UL, 775, 43+(6*dc)+5, dc, dc-10
    button #w.bt71 "", boutons, UL, 775, 41+(7*dc)+6, dc, dc-10
    button #w.bt81 "", boutons, UL, 775, 54+(8*dc)+7, dc, 20 ' 775, 46+(8*dc)+7, dc, dc-10
 
    button #w.bt12 "", boutons, UL, 9+17*dc, 44+(1*dc), dc, dc-10  '  à gauche
    button #w.bt22 "", boutons, UL, 9+17*dc, 44+(2*dc)+1, dc, dc-10
    button #w.bt32 "", boutons, UL, 9+17*dc, 44+(3*dc)+2, dc, dc-10
    button #w.bt42 "", boutons, UL, 9+17*dc, 44+(4*dc)+3, dc, dc-10
    button #w.bt52 "", boutons, UL, 9+17*dc, 43+(5*dc)+4, dc, dc-10
    button #w.bt62 "", boutons, UL, 9+17*dc, 43+(6*dc)+5, dc, dc-10
    button #w.bt72 "", boutons, UL, 9+17*dc, 41+(7*dc)+6, dc, dc-10
    button #w.bt82 "", boutons, UL, 9+17*dc, 54+(8*dc)+7, dc, 20 ' 9+17*dc, 46+(8*dc)+7, dc, dc-10
    button #w.new "New",[new],UL,MapWidth-20,6,60,27
    OPEN "    TEST Chute(s)... "+space$(15)+date$ for window_nf as #w  'graphics_nf_nsb
    #w.map "trapclose [quit]"
    #w.map, "setfocus"
    #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"
    #w.txt "!font Arial 11 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
 
    for im = 1 to 5         '  chargement en mémoire des fichiers BMP qui pourront ensuite être utilisés.
        loadbmp "mur";im, "Mur";im;".bmp"
        loadbmp "bille";im, "Bille";im;".bmp"
    next
 
    bb=4: mm=5: niv=3
 
    [niv]
      niv=niv+1
      if niv=4 then niv=1
      #w.ni, "Niveau: ";word$("1 2 RND",niv)
    'goto [new]
 
    [new]
    #w.new "!enable" ' réactiver TOUS les boutons pour si on viens de sortir...
    #w.ni "!enable"
    #w.mu "!enable"
    #w.bi "!enable"
    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$ "!enable"
    next bt
    FIN = 0
    coup=0
    print #w.txt, "Jeu N° ";coup
    print #w.bi, "Bille: ";bb
    print #w.mu, "Mur: ";mm
 
    if niv=1 then RESTORE [niveau1]
    if niv=2 then RESTORE [niveau2]
 
    for y=1 to ncy
        for x=1 to ncx
          if niv<3 then
            read val  ' read ne peut pas affecter directement une var. tableau.
          else
            if y=1 then val = 2 else if y=ncy then val = 0 else val = int(rnd(0)*2)  ' tirage au hasard
          end if
          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 bille";bb;" ";(cx-1)*dc;" ";by*dc
                    end if
                    by = by + 1
                wend
            next
        next
        #w.map "flush; discard"
    end sub
 
    [bi]                   ' change bille
      bb=bb+1
      if bb =6 then bb=1
      #w.bi, "Bille: ";bb
      for y = 1 to ncy :call drawRow y :next
    wait
 
    [mu]                   ' change mur
      mm=mm+1
      if mm =6 then mm=1
      #w.mu, "Mur: ";mm
      for y = 1 to ncy :call drawRow y :next
    wait
 
    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
        ro=row-1: di=dir
        if olro<>0 or oldi<>0 then    ' secur premier coup
            han$ = "#w.bt" + STR$(oldro)+STR$(oldi)
            #han$, "!enable"             'réactive bouton
        end if
 
        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
 
        hand$ = "#w.bt" + STR$(ro)+STR$(di)
        #hand$, "!disable"         ' désactive bouton
        oldro=ro: oldi=di                'memorise ligne direction
        coup=coup+1
        print #w.txt, "Jeu N° ";coup
        tscore=0
        for xx=1 to ncx
          if cell(xx,ncy)=2 then tscore=tscore+1
        next xx
        if tscore=16 then FIN = 1 :call frac
        ' --------------desactivation boutons lignes vides supérieures
        somm=0
        for xx=1 to ncx
           if cell(xx,1)=2 then somm=somm+1
        next xx
        if somm=0 then            'la ligne 1 (présentation) est vide
           xx=1: yy=2: somm=0
           [cont]
           for xx=1 to ncx
           if cell(xx,yy)=2 then somm=somm+1
           next xx
           if somm=0 then         ' la ligne concernée est vide
              btn$ = "#w.bt"+str$(yy-1)+"1"
              #btn$ "!disable"
              btn$ = "#w.bt"+str$(yy-1)+"2"
              #btn$ "!disable"
              if yy=8 and xx=16 then goto [suite] ' fin du tableau
              somm=0: yy=yy+1: goto [cont]        ' ligne suivante
           end if
         end if
         [suite]
 
    end sub       ' c'est ici que le prog attend le coup suivant******************************
 
    sub frac
    #w.new "!disable"  ' désactiver TOUS les boutons pour éviter une erreur...
    #w.ni "!disable"
    #w.mu "!disable"
    #w.bi "!disable"
    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$ "!disable"
    next
    #w.map, "down ; fill black"
    #w.txt "Clic sur la fractale = Retour"
    #w.map "when leftButtonDown [out]"   ' pour sortir de la SUB frac quand clic dans #w.map
    [draw]
    'set up some random colors
    redim col$(12)
    for c=0 to 12
        col$(c)=str$(int(rnd(0)*256))+" "+str$(int(rnd(0)*256))+" "+str$(int(rnd(0)*256))
    next c
 
    'set up some random starting positions
    a=rnd(0)
    b=0.9998
    c=2-2*a
    dots=12000
    x=j=0
    y=rnd(0)*12+0.1
    'calculate and draw the points
    for i=0 to dots
        scan
        z=x
        x=b*y+j
        j=a*x+c*(x^2)/(1+x^2)
        y=j-z
        xp=(x*20)+midx
        yp=(y*20)+midy
        #w.map, "color ";col$(i/1000)
        #w.map, "set ";xp;" ";yp
    next i
    goto [draw]
    [out]
    #w.new "!enable" ' réactiver TOUS les boutons avant de sortir...
    #w.ni "!enable"
    #w.mu "!enable"
    #w.bi "!enable"
    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$ "!enable"
    next
 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";mm;" ";(x-1)*dc;" ";(r-1)*dc
            case 2 :#w.map "drawbmp bille";bb;" ";(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 0,1,1,1,0,1,1,1,1,0,1,1,1,0,1,1
    data 1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,1
    data 0,1,1,1,0,1,0,1,0,1,0,1,0,1,1,1
    data 1,1,0,1,1,1,1,0,1,0,1,1,1,0,1,1
    data 0,1,1,1,1,0,1,1,0,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 0,1,1,0,1,1,0,1,1,1,0,1,1,1,0,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,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
 
    [quit]
        for im = 1 to 5
            unloadbmp "mur";im
            unloadbmp "bille";im
        next
        close #w
        end
    wait
 
 
____________________
Roro
   
cassiope01
Le 14/07/2012 à 17h42

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
Ca fait plaisir de réussir un défi :top

Pourquoi faire une boucle sur toutes les lignes ?
Les billes ne remontent pas !
Il suffirait de mémoriser la dernière ligne qui n'a plus de billes, et à partir d'elle, descendre en désactivant les boutons jusqu'à la première ligne où on trouve encore au moins une bille !

Dès que je vois que trop de lignes identiques se répètent à plusieurs endroits du code (boucles pour analyser une ligne, réactivation des boutons, etc... ) UP, écriture d'une petite function() ou une SUB ou une procédure qui s'en occupera et sera simplement appelée quand nécessaire.

Cela t'intéresserait que je te montre comment j'aurai fait ?

@+
____________________
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 14/07/2012 à 19h07

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2489
Mais pour sur que oui,.. :miam ..mais si tu l'intègre à une partie existante, ( c'est pas les petits recoins qui doivent manquer là dedans)...mets y des étoiles ou ce que tu voudra en commentaire.

Il y a aussi les noms des variables de boucle,...mais quand une variable est mal réutilisée ,la panique que ça mets est tellement raide à traiter, que je préfère prendre des précautions...superflues.
____________________
Roro
   
cassiope01
Le 15/07/2012 à 10h40

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
Je pense que ça fonctionne bien ;)
Minimum de travail pour un maximum de résultat !!! (y compris pour l'ordi ;) ) , et code raccourcis.

Tu peux voir l'avantage des SUB ou FUNCTION !!!

La SUB AllButtonsActivate OnOff devrait te plaire ;) :top

Pour le RND, je te propose de trouver comment faire pour qu'il y ait moins de trous...! (c'est très facile)


Code VB :
 
   'http://libertybasic.fr/forum/topic-162-1+code-en-cours-de-defrichage.php
   'http://libertybasic.fr/forum/topic-163+chutes.php
   'with coolFractal.bas contributed by Rod extract of JB exemples

    nomainwin
 
    GLOBAL ncx, ncy, dc, mm, bb, midx, midy
    global ro, di, oldro, oldi, coup, tscore
 
    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 = 378  ' (ncy)*dc+int(dc/ncy)  '378

    midx=int(MapWidth/2)-80
    midy=int(MapHeight/2)
 
    WindowWidth  = MapWidth + 65
    WindowHeight = MapHeight + 75  ' 498  ' 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): DIM quoi(ncx+1,ncy)
 
    button #w.bi "Bille", [bi], UL, 40, 5, 60, 25
    button #w.mu "Mur", [mu], UL, 120, 5, 60, 25
    statictext #w.txt "",460,10,200,30
    button #w.ni "Niveau: 1", [niv], UL, 310, 5, 80, 25
    statictext #w.tt "Triche", 40+17*dc, 40+(8*dc)+7,50,20
    graphicbox #w.map, 5+dc, 40, MapWidth-2*dc, MapHeight
    button #w.bt11 "", boutons, UL, 775, 44+(1*dc), dc, dc-10  '  à droite
    button #w.bt21 "", boutons, UL, 775, 44+(2*dc)+1, dc, dc-10
    button #w.bt31 "", boutons, UL, 775, 44+(3*dc)+2, dc, dc-10
    button #w.bt41 "", boutons, UL, 775, 44+(4*dc)+3, dc, dc-10
    button #w.bt51 "", boutons, UL, 775, 43+(5*dc)+4, dc, dc-10
    button #w.bt61 "", boutons, UL, 775, 43+(6*dc)+5, dc, dc-10
    button #w.bt71 "", boutons, UL, 775, 41+(7*dc)+6, dc, dc-10
    button #w.bt81 "", boutons, UL, 775, 54+(8*dc)+7, dc, 20 ' 775, 46+(8*dc)+7, dc, dc-10

    button #w.bt12 "", boutons, UL, 9+17*dc, 44+(1*dc), dc, dc-10  '  à gauche
    button #w.bt22 "", boutons, UL, 9+17*dc, 44+(2*dc)+1, dc, dc-10
    button #w.bt32 "", boutons, UL, 9+17*dc, 44+(3*dc)+2, dc, dc-10
    button #w.bt42 "", boutons, UL, 9+17*dc, 44+(4*dc)+3, dc, dc-10
    button #w.bt52 "", boutons, UL, 9+17*dc, 43+(5*dc)+4, dc, dc-10
    button #w.bt62 "", boutons, UL, 9+17*dc, 43+(6*dc)+5, dc, dc-10
    button #w.bt72 "", boutons, UL, 9+17*dc, 41+(7*dc)+6, dc, dc-10
    button #w.bt82 "", boutons, UL, 9+17*dc, 54+(8*dc)+7, dc, 20 ' 9+17*dc, 46+(8*dc)+7, dc, dc-10
    button #w.new "New",[new],UL,MapWidth-20,6,60,27
    OPEN "    TEST Chute(s)... "+space$(15)+date$ for window_nf as #w  'graphics_nf_nsb
    #w.map "trapclose [quit]"
    #w.map, "setfocus"
    #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"
    #w.txt "!font Arial 11 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
 
    for im = 1 to 5         '  chargement en mémoire des fichiers BMP qui pourront ensuite être utilisés.
        loadbmp "mur";im, "Mur";im;".bmp"
        loadbmp "bille";im, "Bille";im;".bmp"
    next
 
    bb=4: mm=5: niv=3
 
    [niv]
      niv=niv+1
      if niv=4 then niv=1
      #w.ni, "Niveau: ";word$("1 2 RND",niv)
    'goto [new]

    [new]
    call AllButtonsActivate 1  ' active tous les bouttons
    FIN = 0
    coup=0
    print #w.txt, coup;" coup(s)"
    print #w.bi, "Bille: ";bb
    print #w.mu, "Mur: ";mm
 
    if niv=1 then RESTORE [niveau1]
    if niv=2 then RESTORE [niveau2]
 
    for y=1 to ncy
        for x=1 to ncx
          if niv<3 then
            read val  ' read ne peut pas affecter directement une var. tableau.
          else
            if y=1 then val = 2 else if y=ncy then val = 0 else val = int(rnd(0)*2)  ' tirage au hasard
          end if
          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 bille";bb;" ";(cx-1)*dc;" ";by*dc
                    end if
                    by = by + 1
                wend
            next
        next
        #w.map "flush; discard"
    end sub
 
    [bi]                   ' change bille
      bb=bb+1
      if bb =6 then bb=1
      #w.bi, "Bille: ";bb
      for y = 1 to ncy :call drawRow y :next
    wait
 
    [mu]                   ' change mur
      mm=mm+1
      if mm =6 then mm=1
      #w.mu, "Mur: ";mm
      for y = 1 to ncy :call drawRow y :next
    wait
 
    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
        ro=row-1: di=dir
        if olro<>0 or oldi<>0 then    ' secur premier coup
            han$ = "#w.bt" + STR$(oldro)+STR$(oldi)
            #han$, "!enable"             'réactive bouton
        end if
        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
        call ButtonsRow  ' désactive les bouttons d'une ligne sans bille à partir du haut.

        hand$ = "#w.bt" + STR$(ro)+STR$(di)
        #hand$, "!disable"         ' désactive bouton
        oldro=ro: oldi=di                'memorise ligne direction
        coup=coup+1
        print #w.txt, coup;" coup(s)"
        tscore=0
        for xx=1 to ncx
          if cell(xx,ncy)=2 then tscore=tscore+1
        next xx
        if tscore=16 then
            timer 1000, [temp]
            wait
            [temp]
            timer 0
            call frac
        end if
    end sub       ' c'est ici que le prog attend le coup suivant******************************

    SUB ButtonsRow   ' désactive les bouttons d'une ligne sans bille à partir du haut.
        for cy = 1 to ncy-1  'on commence à partir de la 1ère qui n'a pas de boutons
            if emptyRow(cy) = 0 then exit for
            if cy > 1 then  ' verifie si c'est une ligne qui comporte des boutons
                btn$ = "#w.bt";cy-1;1 : #btn$ "!disable"    ' cy-1 car les boutons commence à 1 et le 1er cy avec boutons = 2 !
                btn$ = "#w.bt";cy-1;2 : #btn$ "!disable"
            end if
        next
    end sub
 
    function emptyRow(rw)  ' retourne 1 si la ligne 'rw' est vide, 0 si non.
        emptyRow = 1
        for xx=1 to ncx
           if cell(xx,rw)=2 then emptyRow = 0 :exit function
        next xx
    end function
 
    SUB AllButtonsActivate OnOff  ' si OnOff = 1 "!enable" , 0 = ""!disable"
        action$ = word$("!disable !enable",OnOff+1)
        #w.new action$ ' réactiver TOUS les boutons avant de sortir...
        #w.ni action$
        #w.mu action$
        #w.bi action$
        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$ action$
        next
    end sub
 
 sub frac
    call AllButtonsActivate 0
    #w.map, "down ; fill black"
    #w.txt "Clic sur la fractale = Retour"
    #w.map "when leftButtonDown [out]"   ' pour sortir de la SUB frac quand clic dans #w.map
    [draw]
    'set up some random colors
    redim col$(12)
    for c=0 to 12
        col$(c)=str$(int(rnd(0)*256))+" "+str$(int(rnd(0)*256))+" "+str$(int(rnd(0)*256))
    next c
 
    'set up some random starting positions
    a=rnd(0)
    b=0.9998
    c=2-2*a
    dots=12000
    x=j=0
    y=rnd(0)*12+0.1
    'calculate and draw the points
    for i=0 to dots
        scan
        z=x
        x=b*y+j
        j=a*x+c*(x^2)/(1+x^2)
        y=j-z
        xp=(x*20)+midx
        yp=(y*20)+midy
        #w.map, "color ";col$(i/1000)
        #w.map, "set ";xp;" ";yp
    next i
    goto [draw]
    [out]
    call AllButtonsActivate 1
 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";mm;" ";(x-1)*dc;" ";(r-1)*dc
            case 2 :#w.map "drawbmp bille";bb;" ";(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 0,1,1,1,0,1,1,1,1,0,1,1,1,0,1,1
    data 1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,1
    data 0,1,1,1,0,1,0,1,0,1,0,1,0,1,1,1
    data 1,1,0,1,1,1,1,0,1,0,1,1,1,0,1,1
    data 0,1,1,1,1,0,1,1,0,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 0,1,1,0,1,1,0,1,1,1,0,1,1,1,0,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,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
 
    [quit]
        for im = 1 to 5
            unloadbmp "mur";im
            unloadbmp "bille";im
        next
        close #w
        end
    wait
 




Edité par cassiope01 Le 15/07/2012 à 10h42
____________________
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 15/07/2012 à 11h48

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2489
Bonjour maitre... ;) Avec le rnd, qui parait trop facile avec tous ces trous, et qui ne l'est pas, il y a une chose qui saute aux yeux, alors qu'elle passe totalement inapperçue avec les niveaux 1 et 2.
Je n'en dis pas plus pour l'instant...ça va etre l'objet de mon prochain défi, ce qui va générer quelques questions de faisabilité.
Ta deuxième ligne me fait craindre le pire ( remaniement de fond en comble....? )
Les sub's me sont moins redoutable, maintenant que j'en connais "une issue de secours".
Tu n'aurait pas, par hasard, jeté un oeil à " Wykersham" pour mettre au point le saut carpé du: "clic on the fractal" ?
J'y ai un peu planché...Pas si "trés simple" la lecture des datas qu'il faut découper en rondelles de 16.
Je recule de trois pas.. :s ....Et je charge ton dernier code.......à+
____________________
Roro
   
cassiope01
Le 15/07/2012 à 12h25

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
Roland:
Bonjour maitre... ;) Avec le rnd, qui parait trop facile avec tous ces trous, et qui ne l'est pas, il y a une chose qui saute aux yeux, alors qu'elle passe totalement inapperçue avec les niveaux 1 et 2.
Je n'en dis pas plus pour l'instant...ça va etre l'objet de mon prochain défi, ce qui va générer quelques questions de faisabilité.

Peut-être parles-tu du fait qu'avec RND, il est possible qu'une ligne n'ait AUCUN trou !!!!!
Je n'y avais pas fait gaffe, mais ça se gère en très peu de lignes... ;)


Roland:
Tu n'aurait pas, par hasard, jeté un oeil à " Wykersham" pour mettre au point le saut carpé du: "clic on the fractal" ?

Non.
Mais je vais peut-être demander une éventuelle autre solution plus 'propre' sur le forum anglophone...

Roland:
Pas si "trés simple" la lecture des datas qu'il faut découper en rondelles de 16.

Pas grand chose de plus simple !!!

@+



Edité par cassiope01 Le 15/07/2012 à 12h47
____________________
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 15/07/2012 à 13h22

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2489
Une ligne avec aucun trou !?!?!? :heink :heink :heink ... Mamma Mia ! ! !
il faut mettre alors une boule "marteau piqeur" !!!
Moi non plus je n'y avait pas pensé, mais maintenant que tu en parle, il y a aussi le tirage sans mur, il faut donc prévoir des boules rembourrées pour les chutes brutales.
Tu n'a pas deviné, c'est normal, car c'est toi qui a conçu le code...je te laisse mijoter encore un peu. ;)

La: "ButtonRow", super, trés clair
la: "EmptyRow()",va demander un peu de pratique du: (...)
Mais à la: "AllButtonsActiv....."...j'ai décroché.. du coup, j'ai du aller voir les trois lignes dans lesquelles tu mets en place les: "<", ">" (auxquelles je n'avais pas prété attention). et aprés avoir bien relu:
"Word$" dans l'aide, j'ai tout compris.( ...comprendre n'étant pas maitriser... )
C'est sur que ces sub's et fonctions sont d'une puissance remarquable, mais tous ces appels, qui maintenant demandent de tenir (pour ma part), un organigramme "papier", ne se rapprochent-ils pas du code "spaghetti" que tu semble mépriser ? N'ayant pour différence , que le nommage des sous programmes, et les passages de paramètres qui en font la puissance.
Ceci dit, j'adopte, bien sur. ( j'aime l'élégance.)
Bien le timer...petite chose...super idée. :top



Edité par Roland Le 15/07/2012 à 13h31
____________________
Roro
   
cassiope01
Le 15/07/2012 à 13h53

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
Roland:
C'est sur que ces sub's et fonctions sont d'une puissance remarquable, mais tous ces appels, qui maintenant demandent de tenir (pour ma part), un organigramme "papier", ne se rapprochent-ils pas du code "spaghetti" que tu semble mépriser ? N'ayant pour différence , que le nommage des sous programmes, et les passages de paramètres qui en font la puissance.

C'est une façon de voir...!
En tout cas pour débugger y a pas photo ;)
Personnellement je préfère voir ça comme des 'outils' qui n'existent pas tout fait dans ce langage, j'en ressens le besoin, donc je le fabrique, et je l'utilise dès que j'en ai besoin, à l'image des anciens artisants ;)

Et aussi j'ai toujours un pb avec des lignes de code inutilement répétées... ;)
Et aussi avec les variables inutiles : trop de variables peuvent vite faire perdrent le fil lorsqu'il faut debugger ;)

@+
____________________
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    
cassiope01
Le 15/07/2012 à 14h15

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
Voilà, pb d'éventuelle ligne sans trou dans le niveau RND : réglé. (dans [new] bien sûr )

Pb de sortie de Fractale avec la petite croix en haut à droite de la fenêtre est aussi résolu.

Code VB :
 
   'http://libertybasic.fr/forum/topic-162-1+code-en-cours-de-defrichage.php
   'http://libertybasic.fr/forum/topic-163+chutes.php
   'with coolFractal.bas contributed by Rod extract of JB exemples

    nomainwin
 
    GLOBAL ncx, ncy, dc, mm, bb, midx, midy
    global ro, di, oldro, oldi, coup, tscore
 
    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 = 378  ' (ncy)*dc+int(dc/ncy)  '378

    midx=int(MapWidth/2)-80
    midy=int(MapHeight/2)
 
    WindowWidth  = MapWidth + 65
    WindowHeight = MapHeight + 75  ' 498  ' 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): DIM quoi(ncx+1,ncy)
 
    button #w.bi "Bille", [bi], UL, 40, 5, 60, 25
    button #w.mu "Mur", [mu], UL, 120, 5, 60, 25
    statictext #w.txt "",460,10,200,30
    button #w.ni "Niveau: 1", [niv], UL, 310, 5, 80, 25
    statictext #w.tt "Triche", 40+17*dc, 40+(8*dc)+7,50,20
    graphicbox #w.map, 5+dc, 40, MapWidth-2*dc, MapHeight
    button #w.bt11 "", boutons, UL, 775, 44+(1*dc), dc, dc-10  '  à droite
    button #w.bt21 "", boutons, UL, 775, 44+(2*dc)+1, dc, dc-10
    button #w.bt31 "", boutons, UL, 775, 44+(3*dc)+2, dc, dc-10
    button #w.bt41 "", boutons, UL, 775, 44+(4*dc)+3, dc, dc-10
    button #w.bt51 "", boutons, UL, 775, 43+(5*dc)+4, dc, dc-10
    button #w.bt61 "", boutons, UL, 775, 43+(6*dc)+5, dc, dc-10
    button #w.bt71 "", boutons, UL, 775, 41+(7*dc)+6, dc, dc-10
    button #w.bt81 "", boutons, UL, 775, 54+(8*dc)+7, dc, 20 ' 775, 46+(8*dc)+7, dc, dc-10

    button #w.bt12 "", boutons, UL, 9+17*dc, 44+(1*dc), dc, dc-10  '  à gauche
    button #w.bt22 "", boutons, UL, 9+17*dc, 44+(2*dc)+1, dc, dc-10
    button #w.bt32 "", boutons, UL, 9+17*dc, 44+(3*dc)+2, dc, dc-10
    button #w.bt42 "", boutons, UL, 9+17*dc, 44+(4*dc)+3, dc, dc-10
    button #w.bt52 "", boutons, UL, 9+17*dc, 43+(5*dc)+4, dc, dc-10
    button #w.bt62 "", boutons, UL, 9+17*dc, 43+(6*dc)+5, dc, dc-10
    button #w.bt72 "", boutons, UL, 9+17*dc, 41+(7*dc)+6, dc, dc-10
    button #w.bt82 "", boutons, UL, 9+17*dc, 54+(8*dc)+7, dc, 20 ' 9+17*dc, 46+(8*dc)+7, dc, dc-10
    button #w.new "New",[new],UL,MapWidth-20,6,60,27
    OPEN "    TEST Chute(s)... "+space$(15)+date$ for window_nf as #w  'graphics_nf_nsb
    #w "trapclose quit"
    #w.map "setfocus"
    #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"
    #w.txt "!font Arial 11 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
 
    for im = 1 to 5         '  chargement en mémoire des fichiers BMP qui pourront ensuite être utilisés.
        loadbmp "mur";im, "Mur";im;".bmp"
        loadbmp "bille";im, "Bille";im;".bmp"
    next
 
    bb=4: mm=5: niv=2
 
    [niv]
      niv=niv+1
      if niv=4 then niv=1
      #w.ni, "Niveau: ";word$("1 2 RND",niv)
 
    [new]
    call AllButtonsActivate 1  ' active tous les bouttons
    coup=0
    print #w.txt, coup;" coup(s)"
    print #w.bi, "Bille: ";bb
    print #w.mu, "Mur: ";mm
 
    if niv=1 then RESTORE [niveau1]
    if niv=2 then RESTORE [niveau2]
    for y=1 to ncy      ' mise en place du niveau courrant ( cell(x,y) -> 0 = trou, 1 = mur, 2 = bille )
        [trou]
        cm = 0
        for x=1 to ncx
          if niv<3 then
            read val  ' read ne peut pas affecter directement une var. tableau.
          else
            val = int(rnd(0)*3)  ' 1 sur 3 peut être un trou (=0)
            if val>1 then val=1
            if y=1 then val = 2 else if y=ncy then val = 0
          end if
          cell(x,y) = val
          if val = 0 then cm = 1
        next
        if cm = 0 and y > 1 then [trou]
        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 bille";bb;" ";(cx-1)*dc;" ";by*dc
                    end if
                    by = by + 1
                wend
            next
        next
        #w.map "flush; discard"
    end sub
 
    [bi]                   ' change bille
      bb=bb+1
      if bb =6 then bb=1
      #w.bi, "Bille: ";bb
      for y = 1 to ncy :call drawRow y :next
    wait
 
    [mu]                   ' change mur
      mm=mm+1
      if mm =6 then mm=1
      #w.mu, "Mur: ";mm
      for y = 1 to ncy :call drawRow y :next
    wait
 
    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
        ro=row-1: di=dir
        if olro<>0 or oldi<>0 then    ' secur premier coup
            han$ = "#w.bt" + STR$(oldro)+STR$(oldi)
            #han$, "!enable"             'réactive bouton
        end if
        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
        call ButtonsRow  ' désactive les bouttons d'une ligne sans bille à partir du haut.

        hand$ = "#w.bt" + STR$(ro)+STR$(di)
        #hand$, "!disable"         ' désactive bouton
        oldro=ro: oldi=di                'memorise ligne direction
        coup=coup+1
        print #w.txt, coup;" coup(s)"
        tscore=0
        for xx=1 to ncx
          if cell(xx,ncy)=2 then tscore=tscore+1
        next xx
        if tscore=16 then
            timer 1000, [temp]
            wait
            [temp]
            timer 0
            call frac
        end if
    end sub       ' c'est ici que le prog attend le coup suivant******************************

    SUB ButtonsRow   ' désactive les bouttons d'une ligne sans bille à partir du haut.
        for cy = 1 to ncy-1  'on commence à partir de la 1ère qui n'a pas de boutons
            if emptyRow(cy) = 0 then exit for
            if cy > 1 then  ' verifie si c'est une ligne qui comporte des boutons
                btn$ = "#w.bt";cy-1;1 : #btn$ "!disable"    ' cy-1 car les boutons commence à 1 et le 1er cy avec boutons = 2 !
                btn$ = "#w.bt";cy-1;2 : #btn$ "!disable"
            end if
        next
    end sub
 
    function emptyRow(rw)  ' retourne 1 si la ligne 'rw' est vide, 0 si non.
        emptyRow = 1
        for xx=1 to ncx
           if cell(xx,rw)=2 then emptyRow = 0 :exit function
        next xx
    end function
 
    SUB AllButtonsActivate OnOff  ' si OnOff = 1 "!enable" , 0 = ""!disable"
        action$ = word$("!disable !enable",OnOff+1)
        #w.new action$ ' réactiver TOUS les boutons avant de sortir...
        #w.ni action$
        #w.mu action$
        #w.bi action$
        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$ action$
        next
    end sub
 
 sub frac
    call AllButtonsActivate 0
    #w.map, "down ; fill black"
    #w.txt "Clic sur la fractale = Retour"
    #w.map "when leftButtonDown [out]"   ' pour sortir de la SUB frac quand clic dans #w.map
    [draw]
    'set up some random colors
    redim col$(12)
    for c=0 to 12
        col$(c)=str$(int(rnd(0)*256))+" "+str$(int(rnd(0)*256))+" "+str$(int(rnd(0)*256))
    next c
 
    'set up some random starting positions
    a=rnd(0)
    b=0.9998
    c=2-2*a
    dots=12000
    x=j=0
    y=rnd(0)*12+0.1
    'calculate and draw the points
    for i=0 to dots
        scan
        z=x
        x=b*y+j
        j=a*x+c*(x^2)/(1+x^2)
        y=j-z
        xp=(x*20)+midx
        yp=(y*20)+midy
        #w.map, "color ";col$(i/1000)
        #w.map, "set ";xp;" ";yp
    next i
    goto [draw]
    [out]
    call AllButtonsActivate 1
 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";mm;" ";(x-1)*dc;" ";(r-1)*dc
            case 2 :#w.map "drawbmp bille";bb;" ";(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 0,1,1,1,0,1,1,1,1,0,1,1,1,0,1,1
    data 1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,1
    data 0,1,1,1,0,1,0,1,0,1,0,1,0,1,1,1
    data 1,1,0,1,1,1,1,0,1,0,1,1,1,0,1,1
    data 0,1,1,1,1,0,1,1,0,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 0,1,1,0,1,1,0,1,1,1,0,1,1,1,0,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,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
 
    sub quit handle$
        for im = 1 to 5
            unloadbmp "mur";im
            unloadbmp "bille";im
        next
        close #handle$
        end
    end sub
 




Edité par cassiope01 Le 15/07/2012 à 14h57
____________________
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 15/07/2012 à 15h08

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2489
Bon, je te livre mes cogitations:
Comme tu le sais, ce sont les lignes qui se déplacent, avec ce qu'elles contiennent.
Ce dont on prend conscience dans le rnd, en voyant des boules isolées se déplacer sans contact latéral.

J'envisage de ne déplacer que les barres, les boules, fixes, n'étant déplacées que par la poussée de la barre.

Je pense etre obligé de gérer un tableau "pos boules" à comparer, le moment venu avec cell( ).
Je pense ne pas etre obligé de toucher, ni à "fall", ni à "draw".
Tes derniers apports ne devraient pas avoir d'incidence sur cette éventuelle modif.
Qu'en pense-tu ?
____________________
Roro
   
cassiope01
Le 15/07/2012 à 15h55

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
Oui, très bonne idée, j'y avais pensé aussi.
ceci dit on se sert parfois du fait que les billes peuvent aller de l'autre côté pour les faire tomber.
Effectivement c'est très faisable en très peu de lignes.
Il s'agit de bien gérer cell(x,y) et le tour est joué.
Cela doit se passer au début de la SUB boutons.
A toi de jouer ;)

Bien sûr je vais le faire aussi mais je te laisse travailler.

@+
____________________
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 15/07/2012 à 16h58

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2489
Mais avec un tableau pour la position des billes ou sans.
Sans tableau, avec juste l'existant, j'y ai eu peu taté,ça me parait plus compliqué.
Cas de: 1111202111
ne vaut-il pas mieux: plus simple à l'analyse, au détriment de la compacité et du volume, tant que cela n'impacte pas le temps d'execution. ?



Edité par Roland Le 15/07/2012 à 17h12
____________________
Roro
   
Roland
Le 15/07/2012 à 18h13

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2489
Ah la vache ! Ce n'est pas une question de tableau ! Il faut faire un "anti-fall" horizontal ! ! ! C'est pas gagné !!!
La "fall"...C'est la sub la plus craignos de toute la machinerie.
Y'a intérét à faire mettre une copie de l'original à l'abri, parce qu'y va y'avoir des dégats !!!!!!!



Edité par Roland Le 15/07/2012 à 18h27
____________________
Roro
   
cassiope01
Le 15/07/2012 à 18h24

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
Y a déjà tout ce qu'il faut.
C'est juste une question de judiciosité ;)

@+
____________________
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 15/07/2012 à 18h29

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2489
Tu m'étonne !!! y'en a meme de reste !
____________________
Roro
   
cassiope01
Le 15/07/2012 à 20h11

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
C'est pas du tout dans la sub fall qu'il te faut zieuter ! :heink
____________________
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 15/07/2012 à 20h35

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2489
Je zieute pas dans la sub "fall", mais je vois bien qu'il faut faire une sorte de fall horizontale
De mon coté, ça marche, les barres poussent et ne tirent plus...
Mais...hum...comment dire ?........Y'a des billes qui disparaissent. :heink :heink :heink
Et ça..c'est pas bon signe ! :s



Edité par Roland Le 15/07/2012 à 22h00
____________________
Roro
   
Roland
Le 15/07/2012 à 22h08

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2489
Hey ! Hola ! Du Donjon ! ..Qui c'est qui joue avec mon avatar ??? ...Et qui l'a mis en " EXPERT ".. :heink
Expert en Bug , plantages et formatage d'urgence tu veux dire ! :D



Edité par Roland Le 15/07/2012 à 22h10
____________________
Roro
   
• Jeux » Chutes Ancien jeu Remanié 2012  
• Index

 |  |

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