' http://libertybasic.fr/forum/topic-177+besoin-d-imagination-pour-creer-les-niveaux-de-ce-jeu.php
    ' cassiope01 jul, 26 2012
 
  'ATTENTION: Pour passer de éditor à game, faire: Game-->Editor-->Game
       '...pour remise à zéro myrecord$
    nomainwin
 
    GLOBAL ncx, ncy, dc, oldcurX, oldcurY, curX, curY, nb
 
    ncx = 24   ' nbr of cells X
    ncy = 16    ' nbr of cells Y
    dc = 42    ' size of a cell in pixels
    MapWidth = ncx*dc+int(dc/ncx)
    MapHeight = ncy*dc+int(dc/ncy)
 
    WindowWidth  = MapWidth + 15+90 '§§§§§§§§§§§§§§§§§
    WindowHeight = MapHeight + 75
    UpperLeftX = (DisplayWidth-WindowWidth) / 3
    UpperLeftY = (DisplayHeight-WindowHeight) / 2
 
   ' mois$ = "January February March April May June July August September October November December"
    mois$ = "Janvier Février Mars Avril Mai Juin Juillet Août Septembre Octobre Novembre Décembre"   ' french
    today$ = date$("mm/dd/yyyy")
    j = date$(today$)
   ' jsem$ = word$("Tuesday Wednesday Thursday x Friday Saturday x Sunday Monday",int((j/7-int(j/7))*10)+1)
    jsem$ = word$("Mardi Mercredi Jeudi x Vendredi Samedi x Dimanche Lundi",int((j/7-int(j/7))*10)+1)   ' french
    date$ = jsem$+" "+mid$(today$,4,2)+" "+word$(mois$, val(today$))+" "+right$(today$,4)+"  "+left$(time$(),5)
 
    DIM info$(10,10)
    DIM cell(ncx,ncy)
    DIM mem(ncx,ncy) ' for "undo"
    DIM dirX(4), dirY(4)
    DIM record$(20)
    DIM myrecord$(20)  '§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§
    DIM level$(30)
    dirX(1) = 0  : dirY(1) = -1  'up
    dirX(2) = 1  : dirY(2) = 0   'right
    dirX(3) = 0  : dirY(3) = 1   'down
    dirX(4) = -1 : dirY(4) = 0   'left
 
    loadbmp "billes",  "Billes.bmp"
    loadbmp "bille21", "Bille21.bmp"
    loadbmp "mur2",    "Mur2.bmp"
    loadbmp "mur3",    "Mur3.bmp"
    loadbmp "sable1",  "Sable1.bmp"
    loadbmp "lapin",   "Lapin.bmp"
    list$ = "lapin sable1 mur2 b1 b2 b3 b4 b5 b6 b7 b8 bille21"
    for ex = 1 to 5 :loadbmp "explose";ex, "explosion";ex;".bmp" :next
 
       button #w.bta "Action N°",[undo],UL, WindowWidth-90, 50, 80, 25
       button #w.bt1 "1",[undo1],UL, WindowWidth-90, 80, 80, 25
       button #w.bt2 "2",[undo2],UL, WindowWidth-90, 110, 80, 25
       button #w.bt3 "3",[undo3],UL, WindowWidth-90, 140, 80, 25
       button #w.bt4 "4",[undo4],UL, WindowWidth-90, 170, 80, 25
       button #w.bt5 "5",[undo5],UL, WindowWidth-90, 200, 80, 25
       button #w.bt6 "6",[undo6],UL, WindowWidth-90, 230, 80, 25
       button #w.bt7 "7",[undo7],UL, WindowWidth-90, 260, 80, 25
       button #w.bt8 "8",[undo8],UL, WindowWidth-90, 290, 80, 25
       button #w.bt9 "9",[undo9],UL, WindowWidth-90, 320, 80, 25
       button #w.bt10 "10",[undo10],UL, WindowWidth-90, 350, 80, 25
 
       TEXTBOX #w.testa, WindowWidth-90, 400, 80, 25
    statictext #w.txt "",5,10,270,25
    statictext #w.txt2 "SPACE = On/Off Editor",280,10,200,25
    button #w.lev "Levels",[loadlevel],UL,555,6,65,27
    button #w.bck "Undo",[undo],UL,MapWidth-130,6,60,27
    button #w.new "New",[new],UL,MapWidth-55,6,60,27
    graphicbox #w.gsc1, MapWidth-380,6,86,28
    graphicbox #w.gsc2, MapWidth-290,6,146,28
    graphicbox #w.map, 5, 40, MapWidth, MapHeight
    OPEN "    Boulder Dash JB... "+space$(15)+date$ for window_nf as #w  'graphics_nf_nsb
    #w "trapclose [quit]"
    #w.txt "!font Comic_Sans_MS 12 bold"
    #w.txt2 "!font Comic_Sans_MS 12"
    #w.lev "!font Comic_Sans_MS 12 bold"
    #w.bck "!font Comic_Sans_MS 12 bold"
    #w.new "!font Comic_Sans_MS 12 bold"
    #w.map "down; backcolor black; fill black"
    #w.gsc1 "down; backcolor lightgray ; fill lightgray"
    #w.gsc2 "down; backcolor lightgray ; fill lightgray"
    #w.gsc1 "font Courier_New 19 bold"
    #w.gsc2 "font Courier_New 18 bold"
 
    #w.map "getbmp p0 0 0 ";dc;" ";dc  ' empty cell for deleting
    #w.map "drawbmp billes 0 0"
    for b = 1 to 8
        d = val(word$("0 45 89 133 177 221 266 311",b))  ' exact pixels in the bmp...
        #w.map "getbmp b";b;" ";d;" 0 ";dc;" ";dc  ' make bmps needed
    next
 
    for y = 1 to ncy        ' murs externes et sable
        for x = 1 to ncx
            if y=1 or y=ncy or x=1 or x=ncx then
                #w.map "drawbmp mur3 ";(x-1)*dc;" ";(y-1)*dc
                cell(x,y) = 11
            else
                #w.map "drawbmp sable1 ";(x-1)*dc;" ";(y-1)*dc
                cell(x,y) = 10
            end if
        next
    next
 
    [new]
    if rec > 0 and nbD > 0 then  ' re-init current level.
        call replace record$(1)
        goto [game]
    end if
    if fileExist(defaultDir$, "saved.ini") and first = 0 then
        open "saved.ini" for input as #lev
        line input #lev, game$
        close #lev
        call replace game$
        first = 1
        LVname$ = left$(info$(1,0),len(info$(1,0))-4)
        goto [game]
    else
        if fileExist(DefaultDir$, "level_01.lev") then
            open "level_01.lev" for input as #lev
            line input #lev, game$
            close #lev
            call replace game$
            first = 1
            LVname$ = left$(info$(1,0),len(info$(1,0))-4)
            goto [game]
        end if
    end if
 
    [game]
        editor = 0
        curIM = 1  'rabbit by default in editor mode
        nbD = nbBilles()  'nb of things to catch
        nb = nbD
        gosub [dispNB]
        gosub [dispLVname]
        #w.map "drawbmp lapin ";(curX-1)*dc;" ";(curY-1)*dc
        #w.map "flush ; discard"
        gosub [currentXY] 'rabbit coordonates
        #w.txt ""
        rec = 0
        FIN = 0
        redim record$(nbD)  're-init for undo
        gosub [record]  ' first record for undo
            redim myrecord$(20) '§§§§§§§§§§§§§§§§§
            reco=0              '§§§§§§§§§§§§§§§§§
            print #w.bta, "Action N°";reco '§§§§§§§§
        #w.map "setfocus"
        #w.map "when leftButtonDown [mouse]"    ' x,y cell
        #w.map "when characterInput [keyboard]"    ' x,y cell
       ' #w.map "when mouseMove [infos]"    ' x,y cell
    WAIT
 
    [dispNB]
        #w.gsc1 "fill lightgray ; color red ; place 8 21 ;|";nb
        #w.gsc1 "flush ;discard"
        if nb = 0 then  #w.txt "   Bravo ! c'est Gagné." :gosub [explosion]
    return
 
    [dispLVname]
        #w.gsc2 "fill lightgray ; color blue ; place 8 21 ;|";LVname$
        #w.gsc2 "flush ;discard"
    return
 
    [explosion]
        #w.map "when leftButtonDown"
        #w.map "when characterInput"
        for y=2 to ncy-1
            for x=2 to ncx-1
                if cell(x,y)>0 and cell(x,y)<10 and FIN = 1 then  ' lost !!
                    [good]
                    #w.map "drawbmp p0 ";(x-1)*dc;" ";(y-1)*dc
                    for ex = 1 to 5
                        #w.map "drawbmp explose";ex;" ";6+(x-1)*dc;" ";6+(y-1)*dc
                        timer 10, [tmp1] : wait
                        [tmp1]
                        timer 0
                    next
                    for ex = 5 to 1 step -1
                        #w.map "drawbmp explose";ex;" ";6+(x-1)*dc;" ";6+(y-1)*dc
                        timer 10, [tmp2] : wait
                        [tmp2]
                        timer 0
                    next
                    cell(x,y) = 0
                else
                    if cell(x,y) = 12 and FIN = 0 then [good]
                end if
            next
        next
        FIN = 1
        #w.map "when leftButtonDown [mouse]"    ' x,y cell
        #w.map "when characterInput [keyboard]"    ' x,y cell
    return
 
    [keyboard]
        dir = 0
        codeT = asc(right$(Inkey$,1))
        select case codeT
        case _VK_UP    :dir = 1  ' arrows
        case _VK_RIGHT :dir = 2
        case _VK_DOWN  :dir = 3
        case _VK_LEFT  :dir = 4
        case 8  :goto [undo]  ' DELETE
        case 13 :gosub [new]  ' ENTER
        case 32 :gosub [editor]  ' on/off level editor
        case 114 :gosub [reclevel] ' r
        case 82  :gosub [reclevel] ' R
        case 108 :goto [loadlevel] ' l
        case 76  :goto [loadlevel] ' L
        end select
        if dir>0 and editor = 0 then gosub [action]
    wait
 
    [mouse]
        dir = 0
        mx = int(MouseX/dc)+1
        my = int(MouseY/dc)+1
    if my >1 then           '§§§§§§§§§§§§§§§ Saute la ligne de selection
       gosub [myrecord]    '§§§§§§§§§§§§§§§§§ Le mien record$
       print #w.bta, "Action N°";reco  '§§§§§§§§§§ Affichage dans bouton
    end if    '§§§§§§§§§§§§§§§§§§§§§§§§§§
        select case
        case editor > 0 :if my = 1 and mx > 5 and mx < 18 then curIM = mx-5  'select element
        case oldcurX-mx = 0 and my < oldcurY :dir = 1  ' up
        case oldcurY-my = 0 and mx > oldcurX :dir = 2  ' right
        case oldcurX-mx = 0 and my > oldcurY :dir = 3  ' down
        case oldcurY-my = 0 and mx < oldcurX :dir = 4  ' left
        end select
        if dir > 0 and editor = 0 then gosub [action]   ' gestion des évènements suite à ce déplacement du lapin...
        if dir = 0 and editor > 0 then   ' on est en mode éditeur
            if mx > 1 and mx < ncx and my > 1 and my < ncy then
                #w.map "drawbmp ";word$(list$,curIM);" ";(mx-1)*dc;" ";(my-1)*dc
                cell(mx,my) = val(word$("9 10 11 1 2 3 4 5 6 7 8 12",curIM))
                #w.map "flush ; discard"
                gosub [currentXY] 'rabbit coordonates
                nbD = nbBilles()  'nb of things to catch
                nb = nbD
                gosub [dispNB]
            end if
        end if
    wait
 
    [currentXY] ' the first cell() with 9 => rabbit and so the starting position
        out = 0
        for y=2 to ncy-1
            for x=2 to ncx-1
                if cell(x,y) = 9 then
                    curX = x :oldcurX = curX
                    curY = y :oldcurY = curY
                    out = 1
                    exit for
                end if
            next
            if out then exit for
        next
    return
 
    function nbBilles()  'nb of things to catch
        for y=2 to ncy-1
            for x=2 to ncx-1
                if cell(x,y)>0 and cell(x,y)<9 then nbBilles = nbBilles + 1
            next
        next
    end function
 
    [editor]
        rec = 0  ' disactivate 'undo'
        if editor = 0 then   ' editor ON
            #w.txt " EDITOR"
            redim myrecord$(20) '§§§§§§§§§§§§§§§§§§§   ' Coup de torchon
            reco=0              '§§§§§§§§§§§§§§§§§§           +
            print #w.bta, "Action N°";reco '§§§§§§§§      Affichage
            for im = 1 to 20
                #w.map "drawbmp ";word$("p0 p0 p0 "+list$+" p0 p0 p0 p0 p0",im);" ";(im+1)*dc;" ";0
            next
            #w.map "color yellow ; font Comic_Sans_MS 14 bold"
            #w.map "place ";2*dc+10;" 28 ;|Select -->"
            #w.map "place ";17*dc+16;" 28 ;|R -> Record Level"
            #w.map "flush ; discard"
            editor = 1
            #w.map "when leftButtonMove [draw]"
        else                 ' editor OFF
            gosub [record]
      gosub [myrecord]  '§§§§§§§§§§§§§§§ Le mien [record]
            #w.map "when leftButtonMove"
            #w.txt "" :curIM = 1
            for im = 1 to 20
                #w.map "drawbmp mur3 ";(im+1)*dc;" ";0
            next
            #w.map "flush ; discard"
            #w.map "color black"
            editor = 0
        end if
    return
 
    [draw]
    if editor then
        mx = int(MouseX/dc)+1
        my = int(MouseY/dc)+1
        if mx > 1 and mx < ncx and my > 1 and my < ncy then
            #w.map "drawbmp ";word$(list$,curIM);" ";(mx-1)*dc;" ";(my-1)*dc
            #w.map "flush ; discard"
            cell(mx,my) = val(word$("9 10 11 1 2 3 4 5 6 7 8 12",curIM))
            gosub [currentXY] 'rabbit coordonates
            nbD = nbBilles()  'nb of things to catch
            nb = nbD
            gosub [dispNB]
        end if
    end if
    wait
 
    [action]  ' player game
        if FIN = 1 then [new]
        ok = 0 :record = 0
        curX = oldcurX + dirX(dir)  ' new rabbit's coord.
        curY = oldcurY + dirY(dir)
        if cell(curX,curY) < 11 then
            #w.map "drawbmp p0 ";(oldcurX-1)*dc;" ";(oldcurY-1)*dc
            cell(oldcurX,oldcurY) = 0
            #w.map "drawbmp lapin ";(curX-1)*dc;" ";(curY-1)*dc
            if cell(curX,curY) > 0 and cell(curX,curY) < 9 then  ' element kept
                nb = nb - 1
                gosub [dispNB]
                record = 1  ' ok to record for 'undo'
            end if
            cell(curX,curY) = 9
            if cell(oldcurX,oldcurY-1) = 12 then
                ' si curY - 1 = 12 : PERDU ! car curY - 1 = 12 tombe sur le lapin !
                if dir = 3 then
                    #w.map "drawbmp p0 ";(oldcurX-1)*dc;" ";(oldcurY-2)*dc
                    #w.map "drawbmp bille21 ";(curX-1)*dc;" ";(curY-1)*dc
                    cell(oldcurX,oldcurY-1) = 0
                    cell(oldcurX,oldcurY) = 12
                    FIN = 1
                    #w.txt "  PERDU !"
                    gosub [explosion]
                else
                  ' si oldcurY-1 = 12 elle doit tomber avec celle(s) du dessus
                    call fall oldcurX,oldcurY
                end if
            end if
            ok = 1
        end if
        if cell(curX,curY) = 12 and dir > 1 and (oldcurX+2*dirX(dir)<=ncx and oldcurY+2*dirY(dir)<=ncy) then
            if cell(oldcurX+2*dirX(dir),oldcurY+2*dirY(dir)) = 0 then  ' elle est poussée si la cellule de derrière est vide
                #w.map "drawbmp p0 ";(oldcurX-1)*dc;" ";(oldcurY-1)*dc
                cell(oldcurX,oldcurY) = 0
                #w.map "drawbmp bille21 ";(curX+dirX(dir)-1)*dc;" ";(curY+dirY(dir)-1)*dc
                #w.map "drawbmp lapin ";(curX-1)*dc;" ";(curY-1)*dc
                if cell(curX,curY) > 0 and cell(curX,curY) < 9 then  ' element kept
                    nb = nb - 1
                    gosub [dispNB]
                    record = 1  ' ok to record for 'undo'
                end if
                cell(curX,curY) = 9
                cell(curX+dirX(dir),curY+dirY(dir)) = 12
                ok = 1
                call fall oldcurX,oldcurY
                call fall curX+dirX(dir),curY+dirY(dir)+1
            end if
        end if
        if ok then
            oldcurX = curX
            oldcurY = curY
            if record then gosub [record]
        end if
    wait
 
    [reclevel]      ' record this level (from editor)
        if editor then
            confirm "Record this new level ?"; answer$
            if answer$ = "yes" then
                filedialog "Save As...", "level_**.lev", filename$
                ' care if already exist filename$ !!!!
                if filename$ <> "" then
                    level$ = "" :rabbit = 0
                    for y=2 to ncy-1
                        for x=2 to ncx-1
                            if cell(x,y) = 9 then rabbit = rabbit + 1
                            level$ = level$+using("##",cell(x,y))
                        next
                        if rabbit > 1 then notice "WRONG LEVEL !"+chr$(13)+"It can exist only 1 Rabbit !" :exit for
                    next
                    if rabbit = 1 then
                        open filename$ for output as #lv
                        #lv, level$
                        close #lv
                        notice filename$+" recorded."
                        nbD = nbBilles()
                        nb = nbD
                        rec = 0
                        first = 1
                        files DefaultDir$, filename$, info$(
                        LVname$ = left$(info$(1,0),len(info$(1,0))-4)
                        gosub [dispLVname]
                        gosub [record]
                        'goto [game]
                    end if
                end if
            end if
        end if
    return
 
    [loadlevel]    ' load a level file
        filedialog "Load level file :", "level_*.lev", filename$
        if filename$ <> "" and fileExist(DefaultDir$, filename$) then
            open filename$ for input as #lev
            line input #lev, game$
            close #lev
            redim myrecord$(20) '§§§§§§§§§§§§§§§§§§§§§§ Coup de balai
            reco=0              '§§§§§§§§§§§§§§§§§§§§§      +
            print #w.bta, "Action N°";reco '§§§§§§§§     Affichage
            call replace game$
            first = 1
            LVname$ = left$(info$(1,0),len(info$(1,0))-4)
            goto [game]
        end if
    wait
 
    [myrecord]    ' only for undo  ' My Record whith my variables
        reco = reco + 1               ' And my array
        if reco=11 then reco=1
        if reco <= nbD then
            for y=2 to ncy-1
                for x=2 to ncx-1
                    myrecord$(reco) = myrecord$(reco)+using("##",cell(x,y))
                next
            next
        end if
    return
    [record]    ' only for undo
        rec = rec + 1
        if rec <= nbD then
            for y=2 to ncy-1
                for x=2 to ncx-1
                    record$(rec) = record$(rec)+using("##",cell(x,y))
                next
            next
        end if
    return
 
    [undo1]             ' Démmarrage de la fonction copié/collé de Windows
        reco=1                            ' Tour de chauffe
            call replace myrecord$(reco)
            if nb < nbD then nb = nb + 1
            gosub [dispNB]
        #w.map "setfocus"
    wait
    [undo2]
        reco=2
            call replace myrecord$(reco)
            if nb < nbD then nb = nb + 1
            gosub [dispNB]
        #w.map "setfocus"
    wait
    [undo3]
        reco=3                            ' Montée en régime
            call replace myrecord$(reco)
            if nb < nbD then nb = nb + 1
            gosub [dispNB]
        #w.map "setfocus"
    wait
    [undo4]
       reco=4
            call replace myrecord$(reco)
            if nb < nbD then nb = nb + 1
            gosub [dispNB]
        #w.map "setfocus"
    wait
    [undo5]
       reco=5                               ' 9500 RPM
            call replace myrecord$(reco)
            if nb < nbD then nb = nb + 1
            gosub [dispNB]
        #w.map "setfocus"
    wait
    [undo6]
        reco=6
            call replace myrecord$(reco)
            if nb < nbD then nb = nb + 1
            gosub [dispNB]
        #w.map "setfocus"
    wait
    [undo7]
        reco=7
            call replace myrecord$(reco)
            if nb < nbD then nb = nb + 1
            gosub [dispNB]
        #w.map "setfocus"
    wait
    [undo8]
        reco=8
            call replace myrecord$(reco)
            if nb < nbD then nb = nb + 1
            gosub [dispNB]
        #w.map "setfocus"
    wait
    [undo9]
       reco=9
            call replace myrecord$(reco)
            if nb < nbD then nb = nb + 1
            gosub [dispNB]
        #w.map "setfocus"
    wait
    [undo10]
       reco=10
            call replace myrecord$(reco)
            if nb < nbD then nb = nb + 1
            gosub [dispNB]
        #w.map "setfocus"
    wait                                 ' Extinction/Refroidissement
 
    [undo]
        if rec > 0 and editor = 0 then
            on error goto [no]
            call replace record$(rec)
            rec = rec - 1
            nb = nbBilles()  'nb of things to catch
            gosub [dispNB]
            [no]
        end if
        #w.map "setfocus"
    wait
 
    sub replace string$
        list2$ = "b1 b2 b3 b4 b5 b6 b7 b8 lapin sable1 mur2 bille21"
        cel = 1 :nb = 0
        for y = 2 to ncy-1
            for x = 2 to ncx-1
               value = val(mid$(string$,cel,2))
               if cell(x,y) <> value then
                  cell(x,y) = value
                  if value = 0 then
                      #w.map "drawbmp p0 ";(x-1)*dc;" ";(y-1)*dc
                  else
                      on error goto [bug]
                      #w.map "drawbmp ";word$(list2$,cell(x,y));" ";(x-1)*dc;" ";(y-1)*dc
                      [bug]
                  end if
                  if cell(x,y) = 9 then
                     curX = x :oldcurX = curX
                     curY = y :oldcurY = curY
                  end if
               end if
               cel = cel + 2
            next
        next
        #w.map "flush ; discard"
    end sub
 
    sub fall cx,cy  ' falling down ( cx,cy = coord. of the cell under )
        dy = cy
        while cell(cx,dy-1) = 12
            fy = dy
            while cell(cx,fy) = 0
                call fallstep (cx-1)*dc, (fy-2)*dc, (fy-1)*dc   ' slow down fall...
                cell(cx,fy-1) = 0
                cell(cx,fy) = 12
                fy = fy + 1
            wend
            dy = dy - 1
        wend
        #w.map "flush ; discard"
    end sub
 
    sub fallstep dx, dy, ay   ' slow down fall...
         stp = int(dc/16)
         nstp = int(dc/stp)
         fy = dy
         for p = 1 to nstp
              #w.map "place ";dx;" ";fy;" ;boxfilled ";dx+dc;" ";fy+stp
              fy = fy + stp
              #w.map "drawbmp bille21 ";dx;" ";fy
         next
         #w.map "drawbmp bille21 ";dx;" ";ay
         #w.map "flush ; discard"
    end sub
 
    [infos]  ' only for debug
        cx = int(MouseX/dc)+1 :if cx>ncx then cx=ncx
        cy = int(MouseY/dc)+1 :if cy>ncy then cy=ncy
        #w.txt "cell(";cx;",";cy;") = ";cell(cx,cy)
    wait
 
    function fileExist(path$, filename$)
        files path$, filename$, info$()
        fileExist = val(info$(0, 0))
    end function
 
    [quit]
        CONFIRM "QUIT THE GAME ?"; answer$
        if answer$ = "yes" then
            level$ = ""
            for y=2 to ncy-1
               for x=2 to ncx-1
                   level$ = level$+using("##",cell(x,y))
               next
            next
            open "saved.ini" for output as #clv   ' save current game
            #clv, level$
            close #clv
            unloadbmp "mur3"
            for im = 1 to 12 :unloadbmp word$(list$,im) :next
            for ex = 1 to 5  :unloadbmp "explose";ex :next
            close #w
            END
        end if
    wait
 
 

    [dispNB]
        #w.gsc1 "fill lightgray ; color red ; place 8 21 ;|";nb
        #w.gsc1 "flush ;discard"
        if nb = 0 and editor = 0 then #w.txt "   Bravo ! c'est Gagné." :gosub [explosion]
    return