'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