nomainwin
 
    global STARTX, STARTY, ENDX, ENDY, c, nc, type, lo$, lf$, dia, show
 
    c = 20   'dimension d'un coté de case en pixels
    nc = 30   'nombre de cases sur 1 coté  (c'est un carré !)
   ' BackgroundColor$ = cl$
   ' ForegroundColor$ = "darkblue"
 
    WindowWidth = nc*c + 14
    if WindowWidth < 25*20+14 then WindowWidth = 25*20+14
    WindowHeight = nc*c + 130
    if WindowHeight < 25*20+130 then WindowHeight = 25*20+130
 
    UpperLeftX=(DisplayWidth-WindowWidth)/4
    UpperLeftY=(DisplayHeight-WindowHeight)/4
 
    graphicbox #a.g, 2, 2, nc*c+6, nc*c+6
    radiobutton #a.dep, "Start (green)", [start], [nothing], 30, WindowHeight-110, 90, 20
    radiobutton #a.arr, "End (red)", [end], [nothing], 30, WindowHeight-80, 90, 20
    radiobutton #a.mur, "Wall", [wall], [nothing], 125, WindowHeight-110, 40, 20
    radiobutton #a.sol, "Del", [ground], [nothing], 125, WindowHeight-80, 40, 20
    checkbox #a.dia, "Diagonal OK", [diagonal], [nodiag], 30, WindowHeight-52, 90, 20
    checkbox #a.voir, "Show Work", [look], [noshow], 125, WindowHeight-52, 80, 20
    button #a.bt, "PathFinding", [search], UL, 190, WindowHeight-110
    button #a.raz, "Reset", raz, UL, 215, WindowHeight-70
    button #a.save, "Save", [save], UL, WindowWidth-60, WindowHeight-110
    button #a.load, "Load", [load], UL, WindowWidth-60, WindowHeight-70
    statictext #a.time, "Time :", 310, WindowHeight-110, 70, 15
    statictext #a.ind, "Double-click on board to", 410, WindowHeight-110, 130, 15
    statictext #a.case, "Dim...", 310, WindowHeight-90, 70, 15
    statictext #a.ind2, "make a random MAZE !", 410, WindowHeight-90, 130, 15
    statictext #a.iter, "Iteration :", 310, WindowHeight-70, 130, 15
    statictext #a.len, "Path lenght :", 310, WindowHeight-50, 140, 15      'future
 
    open "A* Shorter Path Finding" for dialog as #a   ' graphics_nf_nsb as #a
    #a "trapclose [quit]"
 
    #a.mur "set"   'construction de murs par défaut du radiobutton.
    type = 1  '1=eff   2=mur   3=pion vert    4=pion rouge
 
    STARTX = int(nc/2)+1   'coord. pion vert = point de départ
    STARTY = nc-1
    ENDX = int(nc/2)+1     'coord. pion rouge = point d'arrivée
    ENDY = 2
 
    dim cas(nc,nc)
 
    #a.g "down"
    #a.mur "set"
    type = 2
    call board
 
    #a.g "when leftButtonMove LeftButtonClick"
    #a.g "when leftButtonDown pawns"
    #a.g "when leftButtonDouble random"
    #a.g "when characterInput keyb"
 
    [loopHere]
    #a.g "setfocus"
    scan
    goto [loopHere]
 
    wait
 
 
  [ground]
        type = 1  ' eff  case = 0
    wait
 
  [wall]
        type = 2  ' mur  case = 1
    wait
 
  [start]
        type = 3  ' pion Vert
    wait
 
  [end]
        type = 4  ' pion Rouge
    wait
 
  [diagonal]
    dia = 4
    gosub [search]
    wait
 
  [nodiag]
    dia = 0
    gosub [search]
    wait
 
  [look]
    show = 1
    gosub [search]
    wait
 
  [noshow]
    show = 0
    gosub [search]
    wait
 
  [search]
    call board
    call pathfindOK handle$
    wait
 
  [nothing]
 
    wait
 
  [save]
    f$ = date$("mm/dd/yyyy")+time$()
    filename$ = str$(nc)+"x"+str$(nc)+"_"+mid$(f$,4,2)+mid$(f$,1,2)+mid$(f$,7,4)+"_"+mid$(f$,11,2)+mid$(f$,14,2)+right$(f$,2)+".sav"
    open filename$ for output as #sv   'sauvegarde la partie
    #sv, nc
    #sv, STARTX
    #sv, STARTY
    #sv, ENDX
    #sv, ENDY
    tabl$ = ""
      for y = 1 to nc
        for x = 1 to nc     'car les colonnes seront lu en commençant par le bas !
          tabl$ = tabl$ + str$(cas(x,y))
        next
      next
    #sv, tabl$
    close #sv
   ' notice "plateau sauvé"
  wait
 
  [load]
    filedialog "Charge...", "*.sav", filename$
    on error goto [padfich]
 
    open filename$ for input as #tbl
    line input #tbl, nca$
    if val(nca$)<>nc then
        close #tbl
        notice nca$+"x"+nca$+" file incompatible..."
        goto [padfich]
    end if
    nc = val(nca$)
    line input #tbl, stx$ : STARTX = val(stx$)
    line input #tbl, sty$ : STARTY = val(sty$)
    line input #tbl, enx$ : ENDX = val(enx$)
    line input #tbl, eny$ : ENDY = val(eny$)
    line input #tbl, tabl$
      for y = 1 to nc
        for x = 1 to nc     'car les colonnes seront lu en commençant par le bas !
          cas(x,y) = val(mid$(tabl$,nc*(y-1)+x,1))
        next
      next
    close #tbl
    call board
    call pathfindOK handle$
    [padfich]
  wait
 
sub keyb handle$, key$
    notice key$
    select case lower$(key$)
    case "s"
        notice "board saved"
    case "r"
        notice "board restored"
    end select
end sub
 
sub random handle$, x, y   'générateur de murs !
    call raz "#a.g"
    nb = int((nc*nc*30)/100)  '30% du nombre total de cases seront des murs...!
    do
        x=int(rnd(0)*nc)+1
        y=int(rnd(0)*nc)+1
        if cas(x,y) = 0 and (x <> STARTX or y <> STARTY) and (x <> ENDX or y <> ENDY) then
            cas(x,y) = 1
            call drawcell x, y, 1
            i = i + 1
        end if
    loop until i = nb
    call pathfindOK handle$
end sub
 
sub LeftButtonClick handle$, MouseX, MouseY
    if type = 1 or type = 2  then
        mx = int(MouseX / c)+1
        my = int(MouseY / c)+1
        'print mx;"  /  ";my
        #a.case, "......  ";mx;" / ";my;"   type= ";type
        if mx>1 and mx<nc and my>1 and my<nc and (mx<>STARTX or my<>STARTY) and (mx<>ENDX or my<>ENDY) then
            cas(mx,my) = type-1
            call drawcell mx, my, cas(mx,my)
        end if
    end if
end sub
 
sub pawns handle$, MouseX, MouseY
    if type = 3 or type = 4  then  'pion Vert=départ,   rouge=arrivée
        nouvX = int((MouseX) / c)+1
        nouvY = int((MouseY) / c)+1
        call drawpawn type, nouvX, nouvY
        call board
        call pathfindOK handle$
    end if
end sub
 
sub board      'start board nc x nc   with edges = 1 and update of cas(x,y)
    #a.case, "Dim. : ";nc;" x ";nc
    #a.g "color blue"
    for i = 0 to nc
        #a.g "place 1 ";i*c;"; goto ";nc*c;" ";i*c
    next
    for i = 0 to nc
        #a.g "place ";i*c;" 1; goto ";i*c;" ";nc*c
    next
 
    y=1
    for i = 1 to nc*nc
        x=x+1
        if x = 1 or x = nc then cas(x,y) = 1  'les bords = 1
        if y = 1 or y = nc then cas(x,y) = 1
        call drawcell x, y, cas(x,y)
        if x>nc-1 then
            x=0
            y=y+1
        end if
    next
    call drawpawn 3, STARTX, STARTY
    call drawpawn 4, ENDX, ENDY
    #a.g "Flush"
    #a.g "Discard"
end sub
 
sub raz handle$   'reset the board
    redim cas(nc,nc)
    y=1
    for i = 1 to nc*nc
        x=x+1
       ' cas(x,y) = 0
        if x = 1 or x = nc then cas(x,y) = 1  'les bords = 1
        if y = 1 or y = nc then cas(x,y) = 1
        call drawcell x, y, cas(x,y)
        if x>nc-1 then
            x=0
            y=y+1
        end if
    next
    call drawpawn 3, STARTX, STARTY
    call drawpawn 4, ENDX, ENDY
    #a.g "Flush"
    #a.g "Discard"
end sub
 
sub drawpawn p, nx, ny   'mise à jour et positionnement des pions
    if cas(nx,ny) = 1 then exit sub
    xx = STARTX   'pion vert
    yy = STARTY
    if p = 4 then   'pion rouge
        xx = ENDX
        yy = ENDY
        #a.g "color red; backcolor red"
    end if
    #a.g "color white"
    #a.g "backcolor white"
    #a.g "place ";(xx-1)*c+2;" ";(yy-1)*c+2  'efface la case sur laquelle il était.
    #a.g "boxfilled ";xx*c-1;" ";yy*c-1
    select case p
    case 3   'pion rouge
        STARTX = nx   'pion vert
        STARTY = ny
        #a.g "color green; backcolor green"   'pion vert
    case 4   'pion rouge
        ENDX = nx
        ENDY = ny
        #a.g "color red; backcolor red"     'pion rouge
    end select
    #a.g "place ";(nx-1)*c+(c/2);" ";(ny-1)*c+(c/2)
    #a.g "circlefilled 8"
end sub
 
sub drawcell xx, yy, v
    #a.g "color white"
    #a.g "backcolor white"
    if v then #a.g "backcolor blue"
    #a.g "place ";(xx-1)*c+2;" ";(yy-1)*c+2
    #a.g "boxfilled ";xx*c-1;" ";yy*c-1
    ' option d'affichage valeur des cases...
   ' #a.g "color lightgray"
   ' #a.g "place ";(xx-1)*c+c/3;" ";(yy-1)*c+2*(c/3)+2
   ' #a.g "|";v
end sub
 
'************************************ DEBUT de la RECHERCHE du PLUS COURT CHEMIN ***************************************
 
sub pathfindOK handle$ 
 
    'dim dirX(8)
    'dim dirY(8)
 
    dirX(1) = 0  : dirY(1) = -1  'up
    dirX(2) = 1  : dirY(2) = 0   'right
    dirX(3) = -1 : dirY(3) = 0   'left
    dirX(4) = 0  : dirY(4) = 1   'down    'il est possible de prévoir 4 directions suplémentaires si les diagonales sont admises...
    dirX(5) = -1  : dirY(5) = -1  'up,left
    dirX(6) = 1  : dirY(6) = -1   'up,right
    dirX(7) = -1 : dirY(7) = 1    'down,left    'les diagonales...
    dirX(8) = 1  : dirY(8) = 1    'down,right
    xc = STARTX   'case courante
    yc = STARTY
    ppp = 0       'distance pour arriver là du parent... en l'occurance 0 puisque c'est la case de départ !
 
    'format des listes = "_XXYYxxyypppCCC_XXYYxxyypppCCC_XXYYxxyypppCCC_XXYYxxyypppCCC" etc...  une case = 15 caractères.
                        ' XXYY = coord. de la case
                        ' xxyy = coord. de son parent (la case d'où elle vient)
                        ' ppp = coût de ce parent pour venir jusqu'ici dans le chemin.  (cpv)
                        ' CCC = coût de la case = ppp + 1 + distance de la case à l'arrivée à vol d'oiseau...
 
              '                     la case                                           son parent                           ppp                   son coût (sur 3 chiffres)
    lf$ = "_"+right$(str$(100+STARTX),2)+right$(str$(100+STARTY),2)+right$(str$(100+STARTX),2)+right$(str$(100+STARTY),2)'+"000"+right$(str$(1000+cost(cpv,STARTX,STARTY)),3)  'liste fermée
    lo$ = ""    'liste ouverte
    td = time$("ms")
 
    DO
        'check all 4 (or 8) available directions
        for i = 1 to 4 + dia      'ou 8 si les diagonales sont admises...
            nextX = xc + dirX(i)     'coordonnée de la case voisine dans la direction i
            nextY = yc + dirY(i)
 
            if cas(nextX, nextY) = 0 then   ' if not a wall
               ' ccc = cost(ppp,nextX,nextY)   'Calcul du Coût de cette case voisine.
                ccc = ppp + abs(ENDY-nextY) + abs(ENDX-nextX)  'Calcul du Coût de cette case voisine.
                ct$ = "_"+right$(str$(100+nextX),2)+right$(str$(100+nextY),2)  'case à rechercher...
 
                if nextY = ENDY and nextX = ENDX then    'arrivée... 'and nextX = ENDX si nécessité d'une arrivée sur ENDX,ENDY précisément.
                    lf$ = lf$ + ct$ +right$(str$(100+xc),2)+right$(str$(100+yc),2)'+right$(str$(1000+ppp),3)+right$(str$(1000+ccc),3)  'liste fermée
                    success = 1
                    goto [getout]
 
                else
                    if instr(lf$,ct$) = 0 then     'si la case n'est PAS dans la liste fermée ...
 
                        slo = instr(lo$, ct$)  'on la cherche dans la Liste Ouverte LO$
 
                        if slo = 0 then    'si la case n'est pas dans la liste ouverte : on l'y met et c'est tout...
 
                            lo$ = lo$ + ct$ +right$(str$(100+xc),2)+right$(str$(100+yc),2)+right$(str$(1000+ppp),3)+right$(str$(1000+ccc),3)  'liste ouverte
 
                            if show then #a.g "backcolor darkgray; color darkgray; place ";(nextX-1)*c+(c/2);" ";(nextY-1)*c+(c/2);"; circlefilled 4"
 
                        else   'si elle y est : comparer les 2 coûts
                            cclo = val(mid$(lo$, slo + 12, 3))   ' coût de cette case déjà présente dans lo$
 
                            if ccc < cclo then     'si le coût actuel est inférieur à celui de cette case trouvée dans lo$ :
                                'mise à jour des données de cette case dans la liste ouverte : " parent ppp et coût"
                                lt$ = left$(lo$,slo+4)    'partie gauche de lo$ y compris les XXYY de la case à mettre à jour
                                lt$ = lt$ + right$(str$(100+xc),2) + right$(str$(100+yc),2) + right$(str$(1000+ppp),3) + right$(str$(1000+ccc),3)  'mise à jour du parent + cout
                                lo$ = lt$ + right$(lo$,len(lo$)-len(lt$))             ' reconstruction de lo$
                            end if
 
                        end if
                    end if
                end if
            end if
        next i
 
        nclo = len(lo$)/15    'nbre total de cases dans lo$ (liste ouverte)  (rappel: 1 case = 15 caractères)
 
        select case nclo
        case 0                    'si liste ouverte vide = pas de solution... on arrête.
            goto [getout]
 
        case 1                    's'il n'y a qu'une case dans lo$ alors c'est celle là qui est sélectionnée bien sûr...!
            ncppc = 1
 
        case else               'localise dans lo$ le n° de la case qui a le plus petit coût... = ncppc
 
            mc = val(right$(lo$,3))   'coût référence = celui de la DERNIERE case enregistrée dans lo$
            ncppc = nclo
            for n = nclo to 1 step -1     'puis on remonte case par case dans lo$ en partant de la fin...
                mc2 = val(mid$(lo$, n*15-2, 3))  'coût de la case précédente dans lo$
                if mc2 < mc then     'cout inférieur trouvé...
                    mc = mc2
                    ncppc = n        'ncppc = localisation (base 15) dans lo$ de la case qui a le plus petit cout.
                end if
            next
 
        end select
 
        ' maintenant retirer de lo$ la case qui a le plus petit coût (déterminée ci-dessus)
        ' la mettre dans la liste fermée.
        ' en faire la case courante.
 
        lt$ = mid$(lo$,(ncppc-1)*15+1,15)  ' la case choisie dans lo$ est mise dans une chaine temporaire.
 
        xc = val(mid$(lt$,2,2))  'devient la nouvelle case courante, (et donc le nouveau parent...)
        yc = val(mid$(lt$,4,2))
        ppp = val(mid$(lt$,10,3)) + 1    'nouveau coût pour venir jusqu'ici (dans le chemin)
 
    'print "Liste Ouverte = ";lo$
    'print "  Choix =";lt$
 
        lf$ = lf$ + left$(lt$,9)          'ajoutée à la liste fermée  (constitution du chemin)
 
    'print "Liste Fermée = ";lf$
 
        'retrait de cette case de lo$ (liste ouverte) :
        lt$ = left$(lo$,(ncppc-1)*15)  'partie gauche de lo$ avant la case choisie
        rst = nclo - (len(lt$)/15+1)
        lo$ = lt$ + right$(lo$,rst*15)    'reconstitution de la Liste Ouverte
 
    'print
    'print "Liste Ouverte = ";lo$
    'print
    'print
 
        iterations = iterations + 1
 
    LOOP UNTIL success
 
    [getout]    ' FIN de la RECHERCHE du PLUS COURT CHEMIN
 
    t = time$("ms") - td
 
    'pathLenght = val(right$(lf$,3)) + 1  'dernier coût de la dernière case enregistrée dans la liste fermée lf$
    pathLenght = (len(lf$)/9)-2
    if success then
        #a.time, "Time : "; t; " ms."
        #a.iter, "len( lo$ ) : ";len(lo$)
       ' #a.len, "Path lenght : --"
       ' call showpath
 
        'print
        'print "Shortest path found in "; iterations; " iterations."
        'print "Longueur du chemin "; pathLenght; " cases  -   Trouvé en "; t; " ms."
        'print
 
     'variante plus propre de lecture de lf$ de Joseph...   manque la dernière case !!!
        #a.g "down; size 1; backcolor red; color red"
        i = instr(lf$,"_"+right$(str$(100+nextX),2)+right$(str$(100+nextY),2))
        while i > 1
            x = val(mid$(lf$,i+5,2))
            y = val(mid$(lf$,i+7,2))
            #a.g "place ";(x-1)*c+(c/2);" ";(y-1)*c+(c/2);"; circlefilled 4"
            l = l + 1
            i = instr(lf$,"_"+right$(str$(100+x),2)+right$(str$(100+y),2))
        Wend
        #a.len, "Path lenght : ";l
        #a.g "backcolor white"
        #a.g "Flush"
        #a.g "Discard"
    else
        #a.len, "Path lenght : impossible. (";pathLenght;")"
    end if
 
end sub
 
function cost(cp,vx,vy)  'cout du parent pour venir par le chemin + distance de vy à ENDY.
    cost = cp + abs(ENDY-vy) + abs(ENDX-vx)  'distance entre vy et ENDY (l'arrivée)
end function
 
sub showpath
    ' en partant de l'arrivée ... c.à.d. la dernière case de la liste fermée.
 
    #a.g "down; size 1; backcolor red; color red"
 
    n = len(lf$)/9
    x = val(mid$(lf$,(n-1)*9+2,2))   'x,y de la dernière case de la liste fermée
    y = val(mid$(lf$,(n-1)*9+4,2))
    #a.g "place ";(x-1)*c+(c/2);" ";(y-1)*c+(c/2);"; circlefilled 4"
    do
        x = val(mid$(lf$,(n-1)*9+6,2))   'x,y du parent précédent dans la liste fermée
        y = val(mid$(lf$,(n-1)*9+8,2))
        #a.g "place ";(x-1)*c+(c/2);" ";(y-1)*c+(c/2);"; circlefilled 4"
        'possible de constituer la chaine du chemin en enregistrant ici les x,y
       ' n$ = "_"+right$(str$(100+x),2)+right$(str$(100+y),2)  'recherche la "case" = au "parent" en remontant dans la liste fermée
        n$ = "_"+mid$(lf$,(n-1)*9+6,4)  'recherche la "case" = au "parent" en remontant dans la liste fermée
        n = ((instr(lf$,n$)-1)/9)+1
        l = l + 1
       ' x = val(mid$(lf$,(n-1)*15+2,2))
       ' y = val(mid$(lf$,(n-1)*15+4,2))
       ' #a.g "place ";(x-1)*c+(c/2);" ";(y-1)*c+(c/2);"; circlefilled 4"
    loop until n < 3
    #a.len, "Path lenght : ";l - 1
    #a.g "backcolor white"
    #a.g "Flush"
    #a.g "Discard"
end sub
 
'************************************************ FIN Recherche *********************************************
 
function rept$(c$,n)  'répétition d'un caractère dans un chaine.
    for i = 1 to n
        rept$ = rept$ + c$
    next
end function
 
sub pause temp
    t=time$("ms")
    t2=t
    while t2<t+temp
      t2=time$("ms")
    wend
end sub
 
[quit]
    close #a
end
 

struct monPoint, x as long, y as long
monPoint.x = 4
monPoint.y = monPoint.x + 2
print "Mon point de coordonnées (";monPoint.x;", ";monPoint.y

dim point.x(200)
dim point.y(200)