Forum Liberty Basic France

Jeux » Chutes Ancien jeu Remanié 2012
Le 20/07/2012 à 14h15

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2253
Reprise du message précédent

SUB quit handle$...! ET OUI ! parbleu!
Les grilles , ça donne des idées, et comme j'ai besoin de tripoter de la "sub", il m'et venu l'idée saugrenue suivante:
Deux grilles d'environ 7x7, une à droite, une à gauche. Dans celle de droite qui est le modèle, des cases d'une couleur disposées en motifs, ou au hasard.
Dans la grille de gauche ( qui est ta grille, avec les sub's: "Mark, "coord, "grid, "info).. On doit reproduire le motif de la grille de droite.
Méééh, les cases de la grille de gauche, oscillent entre deux couleurs, quand on clique sur une case elle change de couleur, tandis que des cases voisines (à définir) basculent dans la couleur opposée.

Présentement, j'ai une syntaxe error sur une ligne, dont la soeur jumelle marche au poil dans la sub d'à coté :s .....Je reprend les travaux dés que j'aurai compris ce que tu fabrique avec ce..." o "......à+..
____________________
Roro

   
Le 20/07/2012 à 14h28

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2253
Ach !...il a unne soucis en fin de ligne... :+1
____________________
Roro

   
Le 20/07/2012 à 14h49

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
quel soucis ???
____________________
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 20/07/2012 à 15h25

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2253
Et bien quand une ou deux billes sont poussées vers la droite, et que devant elles, il y a des cases vides, les billes refusent de passer le Rubycon pour aller sur l'autre rive.
Il semble que la seule méthode viable, c'est: ...à la Russe!...Tovaritch !
____________________
Roro

   
Le 20/07/2012 à 15h33

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
Roland Le 15/07/12 à 15h08 :
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.

C'est vrai que tu n'a pas dit que les boules ne devaient pas dépasser les bords !!!
C'est certainement quand tu as parlé de 'Fall horizontal' que j'ai dû interpréter que les billes devaient s'arrêter aux bords !!!!

Actuellement, la règle respectée à la lettre c'est : "toute bille ne se déplace que si elle est poussée par un mur, et ne peut en aucun cas dépasser les bords."
Exception faite pour la ligne du bas, où seule le fait qu'elle ne puisse pas dépasser les bords est respecté.


@+



Edité par cassiope01 Le 20/07/2012 à 15h45
____________________
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 20/07/2012 à 17h26

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2253
Ah ! d'accord. Je comprend maintenant ce : "ne pas dépasser les bords " que j'ai vu chez les ricains,
et que j'ai pris pour un aléa de traduction....J'ai meme failli en parler, mais l'affaire était déjà pliée.
Et bien, je vais le mettre en option.
Mais là c'est vraiment coton d'avoir toutes les billes en bas. :heink



Edité par Roland Le 20/07/2012 à 17h31
____________________
Roro

   
Le 20/07/2012 à 17h37

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
Roland:
Ah ! d'accord. Je comprend maintenant ce : "ne pas dépasser les bords " que j'ai vu chez les ricains,
et que j'ai pris pour un aléa de traduction....J'ai meme failli en parler, mais l'affaire était déjà pliée.

Tu aurais dû :@ ça m'aurait évité de me tordre le neurône à ce point là ;)

Roland:
Et bien, je vais le mettre en option.

Une option c'est en principe activable/désactivable !!! bon courage :top

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

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2253
Mais ça y est , si tu veux tester, des fois que j'aurais fait une (des) conneries.
Mais c'est que ça devient une vraie petite usine à gaz....mine de rien

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
    global ro, di, oldro, oldi, coup, tscore, push, limit
 
    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)
    DIM depm(ncx,ncy): DIM depb(ncx,ncy)
    DIM depv(ncx,ncy): DIM prebi(ncx,ncy)
 
    button #w.btpu "P...", [pu], UL, MapWidth-15, 40, 50, 20
    button #w.btlim "Limit ?", [lim], UL, MapWidth-25, 60, 70, 20
    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=RND: push=1: limit=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
 
    [pu]
      push=push+1
      if push=3 then push=1
      #w.btpu, " ";word$("Push NoPush",push)
    wait
 
    [lim]
      limit=limit+1
      if limit=3 then limit=1
      if limit=1 then #w.btpu, "!disable"
      if limit=2 then #w.btpu, "!enable"
      #w.btlim, " ";word$("Limits NoLimits",limit)
    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
                                                            'top row with marbles is row 1, right dir 1
        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 limit=2 then goto [nolimitos]  ' limit ou Nolimit
        if limit=1 then
            call slide row, dir   ' slide management of row
            goto [nolimit]
        end if
      ' nolimit
      [nolimitos]
        if dir = 1 then             ' vers la droite        '0=open space, 1=wall, 2=marble
            temp = cell(ncx,row)
            for x=ncx to 2 step -1
                'print x,cell(x,row),cell(x-1,row)
                cell(x,row) = cell(x-1,row)
            next
            cell(1,row) = temp
        if push=2 then goto [nopusha]
 
            for x=1 to ncx
                if cell(x,row)=2 then
                    xx=x
                    while cell(xx,row)=2
                        if xx=1 then exit while
                        xx=xx-1
                    wend
                    if cell(xx,row)=0 then cell(x,row)=0 : cell(xx,row)=2
                end if
            next
        [nopusha]
              '---------------------------------------------
        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
        if push=2 then goto [nopushb]
 
            for x=ncx to 1 step -1
                if cell(x,row)=2 then
                    xx=x
                    while cell(xx,row)=2
                        if xx=16 then exit while
                        xx=xx+1
                    wend
                    if cell(xx,row)=0 then cell(x,row)=0 : cell(xx,row)=2
                end if
            next
        end if
        [nopushb]
        [nolimit]
        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 18
            btn$ = "#w.bt"+word$("11 21 31 41 51 61 71 81 12 22 32 42 52 62 72 82 pu lim",bt)
            #btn$ action$
        next
    end sub
 
    FUNCTION ok(rw,d)  ' renvoi la première case déplaçable
        s = 1  :x = 1
        if d=1 then s = 0-1 :x = ncx
        while cell(x,rw)=2 :x=x+s :wend
        ok = x :if x>1 and x<ncx and cell(x,rw)=1 then ok=0
    END FUNCTION
 
    SUB slide Rw, Dr   ' slide management of Rw
        s = 1 :ax = ncx
        if Dr=1 then s = 0-1 :ax = 1
        o = ok(Rw,Dr)  ' = première case déplaçable
        if o then
            temp = cell(o,Rw)
            for x=o to ax-s step s :cell(x,Rw) = cell(x+s,Rw) :next    ' tout décaler
            if temp<>2 then cell(ax,Rw) = temp
            if Rw < ncy then  ' exception ligne du bas...
                for x=ax to o+s step 0-s     ' recherche les billes qui doivent être remisent à leur place
                    if cell(x,Rw) = 0 and cell(x-s,Rw) = 2 then cell(x,Rw) = cell(x-s,Rw) :cell(x-s,Rw)=0
                next
            end if
        end if
    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]
    #w.map "when leftButtonDown"
    #w.txt coup;" coup(s)"
    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 1,1,1,0,1,1,0,1,1,0,1,1,1,0,1,1
    data 0,1,1,1,1,1,0,1,0,1,1,0,1,1,0,1
    data 1,1,1,0,1,1,1,0,1,1,0,1,0,1,1,0
    data 1,0,1,1,0,1,0,1,0,1,1,1,1,0,1,1
    data 0,1,1,1,1,0,1,1,1,1,0,1,1,1,0,1
    data 0,0,1,1,1,0,1,0,1,0,1,1,0,1,1,1
    data 1,0,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 Roland Le 20/07/2012 à 18h36
____________________
Roro

   
Le 20/07/2012 à 18h25

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2253
Mayrde ! Y'a un BUGUE dans le !disablage...j'y retourne....et hop ! débusquée...La bestiole n'aura pas vécu longtemps.
Tu peux reposer le FlyTox.
Ces SUB's...C'est un vrai bonheur...Quand elles sont "toute faites". Il faudrait en faire une bibliothèque...Une étagère pour les Sub, une autre pour les fonctions....Je prépare le bois et les clous.



Edité par Roland Le 20/07/2012 à 18h49
____________________
Roro

   
Le 20/07/2012 à 19h56

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2253
C'est testé, et c'est jouable, faut juste rester concentré. Je refais le zip " toutes options "

Chutes_GGH.zip
____________________
Roro

   
Le 21/07/2012 à 07h17

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
Grrrr !!!
Toi et tes GOTO :heink :siffle

On peut aussi simplement modifier la SUB slide puisque c'est elle qui est chargée des glissements. Autant la faire bosser comme on le veut ! ;)

Economise donc les lignes de code, tu en auras besoin pour ton prochain jeu ;) ;) :D

De plus push et limit ont forcément une valeur au départ...

Si tu veux, tu peux enregistrer tous ces différents paramètre dans un fichier *.ini ... et les recharger à l'ouverture du programme.


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
   ' with help of tsh73 and NJames : http://justbasic.conforums.com/index.cgi?board=games&action=display&num=1342514807

    nomainwin
 
    GLOBAL ncx, ncy, dc, mm, bb, midx, midy
    global ro, di, oldro, oldi, coup, tscore, limit, push
 
    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.btpu "P...", [pu], UL, MapWidth-15, 40, 50, 20
    button #w.btlim "Limit ?", [lim], UL, MapWidth-25, 60, 70, 20
    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 :limit=1 :push=1
 
    #w.btpu, " ";word$("Push NoPush",push)
    '#w.btlim, word$("!disable !enable",limit)
    #w.btlim, " ";word$("Limits NoLimits",limit)
 
    [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)*2)  ' 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-5*(bb=5)
      #w.bi, "Bille: ";bb
      for y = 1 to ncy :call drawRow y :next
    wait
 
    [mu]                   ' change mur
      mm=mm+1-5*(mm=5)
      #w.mu, "Mur: ";mm
      for y = 1 to ncy :call drawRow y :next
    wait
 
    [pu]
      push=push+1-2*(push=2)
      #w.btpu, " ";word$("Push NoPush",push)
    wait
 
    [lim]
      limit=limit+1-2*(limit=2)
      #w.btpu, word$("!disable !enable",limit)
      #w.btlim, " ";word$("Limits NoLimits",limit)
    wait
 
    sub boutons handle$  ' décalage d'une ligne en fonction du bouton pressé (vers la droite ou vers la gauche)
       ' la règle : les billes ne se déplacent que poussées par un mur, et ne peuvent pas dépasser les bords.
        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
 
        call slide row, dir   ' slide management of row

        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
        #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 slide Rw, Dr   ' slide management of Rw
        s = 1 :ax = ncx :dx = 1
        if Dr=1 then s = 0-1 :ax = 1 :dx = ncx
        if limit = 1 then o = ok(Rw,Dr) else o = dx ' = première case déplaçable
        if o then
            temp = cell(o,Rw)
            for x=o to ax-s step s :cell(x,Rw) = cell(x+s,Rw) :next    ' tout décaler
            if limit = 1 then
                if temp<>2 then cell(ax,Rw) = temp
            else
                cell(ax,Rw) = temp
            end if
            if Rw < ncy and push = 1 then  ' exception ligne du bas...
                for x=ax to o+s step 0-s     ' recherche les billes qui doivent être remisent à leur place
                    if cell(x,Rw) = 0 and cell(x-s,Rw) = 2 then cell(x,Rw) = cell(x-s,Rw) :cell(x-s,Rw)=0
                next
            end if
        end if
    END SUB
 
    FUNCTION ok(rw,d)  ' renvoi la première case déplaçable
        s = 1  :x = 1
        if d=1 then s = 0-1 :x = ncx
        while cell(x,rw)=2 :x=x+s :wend
        ok = x :if x>1 and x<ncx and cell(x,rw)=1 then ok=0
    END FUNCTION
 
    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
       ' #w.map "place 0 ";(r-1)*dc;" ; boxfilled ";(ncx-1)*dc;" ";r*dc
        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
 


Je ne sais pas si j'ai bien géré la compatibilité d'humeur entre push et limit ??
Ces 2 boutons ne devraient pas être accessibles en cour de jeu sinon c'est un peu de la triche tu ne trouves pas ?

@+



Edité par cassiope01 Le 21/07/2012 à 07h35
____________________
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 21/07/2012 à 10h37

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2253
Alors... Le pb du fichier ".ini", c'est que ça oblige à avoir un dossier, et plus un fichier "volant".
Il suffit de rester constant dans le choix de l'emplacement des initialisations, et surtout de les grouper.

Les goto's, ne m'en parle pas . je suis sur ta grille (je devrais dire: sur le grill ),.. pour m'y retrouver, et surtout arriver à faire fonctionner ce que j'ai fait, j'ai du tout regrouper ( une seule sub a résisté).
Je mets mon truc au point en gosub, et ensuite j'essaierai d'en faire des sub's.

En programmation, il n'y a pas que la connaissance...Le pouvoir d'abstraction est aussi primordial.
Je peste contre ma "lunaison"...à quelques jours prés, j'étais dans le bon créneau. ;)

Pour les boutons, c'est du gateau, avec ta sub magique d'énablage/désablage...Mais d'abord, il faut que je vois ce que tu a trafiqué dans la "slide". Je crains que ce qui s'implifie pour les uns, complexifie pour les autres, en l'absence de gras et généreux commentaires.
____________________
Roro

   
Le 21/07/2012 à 11h03

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2253
C'est bien ce que je craignais... :|
____________________
Roro

   
Le 21/07/2012 à 11h09

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
Roland:
Alors... Le pb du fichier ".ini", c'est que ça oblige à avoir un dossier, et plus un fichier "volant".
Il suffit de rester constant dans le choix de l'emplacement des initialisations, et surtout de les grouper


????

Un dossier par jeu, tout ce qui lui faut est dedans, et basta !!!!!!!


@+
____________________
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 21/07/2012 à 11h12

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2253
C'est sur que pour simplifier....Ca simplifie :s Mais pas pour un débutant.
maintenant, niveau commentaires, c'est un livret qu'il faut... comme à l'opéra...
____________________
Roro

   
Le 21/07/2012 à 11h26

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
tu n'es plus débutant maintenant !
____________________
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 21/07/2012 à 15h12

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2253
Tu l'a dit..Je suis meme passé "Expert" : :D ... Et bientot "Grand Chant-Bèlant".. :s .Mais je vise: " Pape" :p
____________________
Roro

   
Le 21/07/2012 à 15h17

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
Tu as raison : "il faut viser la Lune, car même si on la rate, on atteindra toujours les étoiles...!" :lol :lol
____________________
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 21/07/2012 à 16h00

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2253
En attendant, je m'emmèle bien les pinceaux avec ces P....n de lignes" 0 " et de colonnes "0" :s
____________________
Roro

   
Le 21/07/2012 à 16h28

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
j'ai pas suivi là ?
____________________
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 21/07/2012 à 16h43

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2253
"place ";mX*dc+1;" ";mY*dc+1;"; boxfilled ";mX*dc+dc-1;" ";mY*dc+dc-1
ça ne te rappelle rien ?
Et comme un con, j'ai fait un tableau de couleur qui commence à "1" :s
Mais bon, je maitrise...Avec la fameuse technique des : "textbox-espions". J'en ai 8 en fonction...(et j'ai de la place pour en mettre 8 de plus...au cas où !.).....ça devrais aller. :)
____________________
Roro

   
Jeux » Chutes Ancien jeu Remanié 2012  

 |  |

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