'------ Labyrinthe ------'
'       Par Jagang       '
'------------------------'

 
'---------------- Configuration ---------------- '
'Taille du labyrinthe
LX = 10         'Nombre de case horizontale
LY = 5         'Nombre de case verticale

'Affichage du labyrinthe
labH = 700      'Hauteur
labW = 1400     'Largeur

dx = 10         'Marge à gauche et à droite
dy = 10         'Marge en haut et en bas

'Animation
anim = 2        '0 Pas d'animation, 1 Animation de la conception, 2 'Tarte' de progression
vitesse = 1000  'En ms entre chaque etapes pour anim=1

'-------------- Fin configuration -------------- '

idLab = rand(0,999999)
 
size = int((labH-2*dy)/LY)
if size > (labW-2*dx)/LX then size = int((labW-2*dx)/LX)
 
dx = (labW-size*LX)/2
dy = (labH-size*LY)/2
 
'Taille et position de la fenêtre
WindowWidth  = labW+22
WindowHeight = labH+71
 
UpperLeftX = DisplayWidth/2 - WindowWidth/2
UpperLeftY = DisplayHeight/2 - WindowHeight/2
 
 
 
'Tableaux
dim lm$(LX,LY) 'Indice des pièces
dim lid(LX,LY) 'Position des murs
tailleSol = LX*LY
dim sol(tailleSol) 'Tableau pour le solveur

on error goto [quitError]
 
'Ouverture de la fenêtre
nomainwin
graphicbox #main.g, 3, 30, labW,labH
statictext #main.pourcent "", 3+labW/2-30/2, 10, 30, 15
button #main.bg "Générer", [generer], UL, 3, 3, 150, 24
button #main.br "Résoudre", [resoudre], UL, labW-150+3, 3, 150, 24
open "Labyrinthe" for window as #main
#main, "trapclose [quit]"
 
#main.g, "down; backcolor black; fill black; flush"
 
wait
 
'Génération du labyrinthe
[generer]
idLab = idLab + 1
'Initialisation du tableau
for y=0 to LY-1
    for x=0 to LX-1
        lm$(x,y) = "HBGD"
        lid(x,y) = x+y*LX
    next
next
 
'Placement de l'entrée et de la sortie
Xentree = 0
Yentree = rand(0,LY-1)
call ouvrir Xentree,Yentree,"G"
Xsortie = LX-1
Ysortie = rand(0,LY-1)
call ouvrir Xsortie,Ysortie,"D"
 
'On ouvre les murs LX*LY-1 fois
murAOuvrir = LX*LY-1
 
'Initialisation de l'animation
if anim = 2 then
    psize = labW
    if psize > labH then psize = labH
 
    psize = psize*2/3
 
    #main.g, "backcolor black;cls;set ";labW/2;" ";labH/2;"; color 100 100 100; backcolor 25 25 25;size ";psize/20
end if
 
[animGene]
murAOuvrirAv = murAOuvrir
 
while murAOuvrirAv = murAOuvrir and murAOuvrir > 0
 
    x = rand(0,LX-1)
    y = rand(0,LY-1)
    id = lid(x,y)
    dir = rand(0,3)    '0:haut 1:bas 2:gauche 3:droite

    if dir = 0 and y>0 then
        id2 = lid(x,y-1)
        if id <> id2 then
            call ouvrir x,y,"H"
            call ouvrir x,y-1,"B"
            call replaceId id,id2,LX,LY
            murAOuvrir = murAOuvrir - 1
        end if
    end if
    if dir = 1 and y<LY-1 then
        id2 = lid(x,y+1)
        if id <> id2 then
            call ouvrir x,y,"B"
            call ouvrir x,y+1,"H"
            call replaceId id,id2,LX,LY
            murAOuvrir = murAOuvrir - 1
        end if
    end if
    if dir = 2 and x>0 then
        id2 = lid(x-1,y)
        if id <> id2 then
            call ouvrir x,y,"G"
            call ouvrir x-1,y,"D"
            call replaceId id,id2,LX,LY
            murAOuvrir = murAOuvrir - 1
        end if
    end if
    if dir = 3 and x<LX-1 then
        id2 = lid(x+1,y)
        if id <> id2 then
            call ouvrir x,y,"D"
            call ouvrir x+1,y,"G"
            call replaceId id,id2,LX,LY
            murAOuvrir = murAOuvrir - 1
        end if
    end if
wend
 
'Animation de la progression
pm = 100*(1-murAOuvrir/(LX*LY-1))
#main.pourcent, int(pm);"%"
if anim = 2 then
    #main.g, "piefilled ";psize;" ";psize;" -89 ";pm*3.6+1
end if
 
 
if murAOuvrir = 0 then 'On a fini !!
    timer 0
    gosub [afficher]
    #main.pourcent, ""
    #main.g, "getbmp image 0 0 ";labW;" ";labH
    bmpsave "image", "labyrinthe-";idLab;".bmp"
else
    if anim = 1 then
        timer vitesse, [animGene]
        gosub [afficher]
    else
 
        goto [animGene]
    end if
end if
 
wait
 
'Resoud le labyrinthe
[resoudre]
x=Xentree
y=Yentree
i=0
sol(i) = x+y*LX
dir = 3 'vers le 0:haut 1:bas 2:gauche 3:droite

 
x1 = Xentree-1
y1 = Yentree
x2 = Xentree
y2 = Yentree
 
#main.g, "color ";rvb$(lid(0,0)*100/(LX*LY-1)+33);"; line ";(x1+0.5)*size+dx;" ";(y1+0.5)*size+dy;" ";(x2+0.5)*size+dx;" ";(y2+0.5)*size+dy;""
 
 
while x<>Xsortie or y<>Ysortie
    ' On tourne
    c=1
    if c=1 and dir = 0 and instr(lm$(x,y),"D")=0 then dir=3:c=0
    if c=1 and dir = 1 and instr(lm$(x,y),"G")=0 then dir=2:c=0
    if c=1 and dir = 2 and instr(lm$(x,y),"H")=0 then dir=0:c=0
    if c=1 and dir = 3 and instr(lm$(x,y),"B")=0 then dir=1:c=0
 
    ' On avance
    c=1
    if c=1 and dir = 0 then
        if instr(lm$(x,y),"H")=0 then
            y=y-1
        else
            dir = 2:c=0
        end if
    end if
    if c=1 and dir = 1 then
        if instr(lm$(x,y),"B")=0 then
            y=y+1
        else
            dir=3:c=0
        end if
    end if
    if c=1 and dir = 2 then
        if instr(lm$(x,y),"G")=0 then
            x=x-1
        else
            dir=1:c=0
        end if
    end if
    if c=1 and dir = 3 then
        if instr(lm$(x,y),"D")=0 then
            x=x+1
        else
            dir=0:c=0
        end if
    end if
 
    'On cherche si on est pas déjà passé par là
    ii=i
    while ii>=0
        if sol(ii) = x+y*LX then i=ii
        ii=ii-1
    wend
 
    i=i+1
    if i >= tailleSol then
 
        print tailleSol
 
        tailleSol = tailleSol + 10
        redim sol(tailleSol)
    end if
    sol(i) = x+y*LX
 
    #main.g, "line ";((sol(i-1) mod LX)+0.5)*size+dx;" ";(int(sol(i-1)/LX)+0.5)*size+dy;" ";(x+0.5)*size+dx;" ";(y+0.5)*size+dy;""
 
wend
 
x1 = Xsortie
y1 = Ysortie
x2 = Xsortie+1
y2 = Ysortie
 
#main.g, "line ";(x1+0.5)*size+dx;" ";(y1+0.5)*size+dy;" ";(x2+0.5)*size+dx;" ";(y2+0.5)*size+dy;""
 
 
'On dessine le chemin trouvé
i=0
x1 = Xentree-1
y1 = Yentree
x2 = Xentree
y2 = Yentree
 
#main.g, "color ";rvb$(lid(0,0)*100/(LX*LY-1)+66);"; line ";(x1+0.5)*size+dx;" ";(y1+0.5)*size+dy;" ";(x2+0.5)*size+dx;" ";(y2+0.5)*size+dy;""
 
while x2<>Xsortie or y2<>Ysortie
    x1=sol(i) mod LX
    y1=int(sol(i)/LX)
    i=i+1
    x2=sol(i) mod LX
    y2=int(sol(i)/LX)
    #main.g, "line ";(x1+0.5)*size+dx;" ";(y1+0.5)*size+dy;" ";(x2+0.5)*size+dx;" ";(y2+0.5)*size+dy;""
wend
 
x1 = Xsortie
y1 = Ysortie
x2 = Xsortie+1
y2 = Ysortie
 
#main.g, "line ";(x1+0.5)*size+dx;" ";(y1+0.5)*size+dy;" ";(x2+0.5)*size+dx;" ";(y2+0.5)*size+dy;""
 
#main.g, "getbmp image 0 0 ";labW;" ";labH
bmpsave "image", "labyrinthe-";idLab;"-solved.bmp"
 
wait
 
 
[quitError]
timer 0
notice "Erreur ";Err;chr$(13);"Erreur : ";Err$
wait
 
[quit]
close #main
[q]
end
 
'Dessine le labyrinthe
[afficher]
    'On efface
    #main.g, "backcolor black;cls"
 
    'On dessine
    lt = int(size/16)
    ld = lt
    #main.g, "size ";lt
    for x=0 to LX-1
        for y=0 to LY-1
            #main.g, "color ";rvb$(lid(x,y)*100/(LX*LY-1))
            if instr(lm$(x,y),"H")>0 then #main.g, "line ";(x+0)*size+dx;" ";(y+0)*size+dy+ld;" ";(x+1)*size+dx;" ";(y+0)*size+dy+ld;""
            if instr(lm$(x,y),"B")>0 then #main.g, "line ";(x+0)*size+dx;" ";(y+1)*size+dy-ld;" ";(x+1)*size+dx;" ";(y+1)*size+dy-ld;""
            if instr(lm$(x,y),"G")>0 then #main.g, "line ";(x+0)*size+dx+ld;" ";(y+0)*size+dy;" ";(x+0)*size+dx+ld;" ";(y+1)*size+dy;""
            if instr(lm$(x,y),"D")>0 then #main.g, "line ";(x+1)*size+dx-ld;" ";(y+0)*size+dy;" ";(x+1)*size+dx-ld;" ";(y+1)*size+dy;""
        next
    next
    #main.g, "flush"
return
 
'Ouvre un mur
sub ouvrir x,y,d$
    murs$ = ""
    if instr(lm$(x,y),"H")>0 and d$<>"H" then murs$ = murs$;"H"
    if instr(lm$(x,y),"B")>0 and d$<>"B" then murs$ = murs$;"B"
    if instr(lm$(x,y),"G")>0 and d$<>"G" then murs$ = murs$;"G"
    if instr(lm$(x,y),"D")>0 and d$<>"D" then murs$ = murs$;"D"
    lm$(x,y) = murs$
end sub
 
'Remplace tout les id2 par id1
sub replaceId id1,id2,LX,LY
    for x=0 to LX-1
        for y=0 to LY-1
            if lid(x,y) = id2 then lid(x,y) = id1
        next
    next
end sub
 
'Retourne une couleur allant du rouge au bleu en passant par le vert en fonction de x en % (0% = rouge, 33% = vert, 66% = bleu)
function rvb$(x)
    x = x mod 100
    if 0>x or x>100 then
        rvb$ = "white"
    else
        if x<=33.3333 then
            rvb$ = 255*(1-x/33.3333);" ";255*x/33.3333;" 0"
        end if
        if 33.3333<x and x<=66.6666 then
            rvb$ = "0 ";255*(2-x/33.3333);" ";255*(x/33.3333-1)
        end if
        if 66.6666<x then
            rvb$ = 255*(x/33.3333-2);" 0 ";255*(3-x/33.3333)
        end if
    end if
end function
 
'Retourne un nombre aléatoir compris dans [[min,max]]
function rand(min,max)
    rand = int(rnd(1)*(max-min+1))+min
end function