'EDITEUR
  nomainwin
      [retour]
      dim info$(10,10)
     FILEDIALOG "Open", DefaultDir$+"\bmp\map\*.bmp", Filename$ '--ci-dessous: grosse magouille
         xj= instr(Filename$, "map")+3 '----pour extraction du nom sec
         charge$ = right$(Filename$,len(Filename$)-xj) '---arrachage de ce qu'il y a devant
         map$ = left$(charge$,len(charge$)-4) '---arrachage de ce qu'il y a derrière

    WindowWidth = 880
    WindowHeight = 538+5
    UpperLeftX=int((DisplayWidth-WindowWidth)/1.5)
    UpperLeftY=int((DisplayHeight-WindowHeight)/2)
    Global ncx, ncy, lc, SpriteCourant, caseValue
    Global optab
    GRAPHICBOX #3b.map, 0, 0, 870, 538
    if op3b=1 then [pass3b]
    open "Editeur de Zones Réactives " for window as #3b
    if map$="" then [Quit]
    op3b=1
    [pass3b]
    #3b "trapclose [Quit]"
    #3b.map, "down"
    #3b.map, "setfocus"
    #3b.map, "When rightButtonUp Cotecase"' côtes en cases
    #3b.map, "When middleButtonDown Cotepix" 'côtes en pixels
    #3b.map "when leftButtonDown [SimpleClick]"
    #3b.map, "when leftButtonMove [SimpleClick]"    'pour tracer et enregistrer les limites.
    #3b.map, "when characterInput Touches"        'pour déplacer le personnage avec les flêches. la même flêche l'arrête.

    #3b.map, "font Comic_Sans_MS 8"
    #3b.map, "home; posxy CenterX CenterY"
    '--------------------------------------- Init Var -----------------------
    lc = 15    'dimension d'une case en pixels
    Gwidth = CenterX * 2
    Gheight = CenterY * 2
    dpx(1) = 0  :dpx(2) = 1 :dpx(3) = 0 :dpx(4) = -1
    dpy(1) = -1 :dpy(2) = 0 :dpy(3) = 1 :dpy(4) = 0    ' incrément de direction , pour la variables tableau
    ncx = int(Gwidth/lc)+1   'nbre de case en x
    ncy = int(Gheight/lc)+1   'nbre de case en y
    dim cas$(ncx,ncy) 'tableau chaine de toute la map
    caseValue$ = "z" ' valeur de la limite par défaut = mur.

    gosub [charge]
        loadbmp "MAP", "bmp\map\"+map$+".bmp"  ' LA CARTE à éditer.
    gosub [grid]
    gosub [montreLimites]
    goto [tabbord]
wait '----
[montreLimites]
    #3b.map, "backcolor blue; color yellow"
    for y = 1 to ncy
        for x = 1 to ncx'----if cas$(x,y)<>"x"-->si différent de "x" on affiche
            if cas$(x,y)<>"x" then #3b.map, "place ";(x*lc)-lc/2-2;" ";y*lc-3;" ;|";cas$(x,y)
        next '----"x" Partie libre (ça ne marchait pas avec: "", ni avec: " ")
    next
    #3b.map,"flush;discard"
return
 
[SimpleClick]
    #tab.va, "!contents? value$"
    caseValue$=value$
    mx = int(MouseX / lc)+1
    my = int(MouseY / lc)+1
    if mx>0 and mx<ncx and my>0 and my<ncy then
        cas$(mx,my) = caseValue$
       #3b.map, "backcolor blue; color blue"
       #3b.map, "place ";(mx-1)*lc+2;" ";(my-1)*lc+2
       #3b.map, "boxfilled ";mx*lc-1;" ";my*lc-1
       #3b.map, "color yellow"
       #3b.map, "place ";(mx*lc)-lc/2-2;" ";my*lc-3;" ;|";cas$(mx,my)
    end if
    #3b.map,"flush;discard"
wait
[grid]
    #3b.map, "drawbmp MAP 0 0" '----Déplacé d'en haut
    #3b.map, "color darkgray"
    for x = 1 to ncx
        #3b.map, "place ";x*lc;" 0"
        #3b.map, "goto ";x*lc;" ";ncy*lc  'traits verticaux de la grille
    next
    for y = 1 to ncy
        #3b.map, "place 0 ";y*lc
        #3b.map, "goto ";ncx*lc;" ";y*lc  'traits horizontaux de la grille
    next
    #3b.map,"flush;discard"
return
wait
[charge]
     redim cas$(ncx,ncy) 'on vide l'ancien tableau
     file$=map$+".txt"
    if fileExist(DefaultDir$+"\bmp\map\", file$) then
        open "bmp\map\"; file$ for input as #grid
        for y=1 to ncy
            for x=1 to ncx
            if eof(#grid) <> 0 then sortgrid=1: exit for 'test de fin de fichier
                LINE INPUT #grid, cas$(x,y)
            next
            if sortgrid=1 then exit for '2 for/next--> 2 exits par flag: "sortgrid"
        next
        close #grid
    else
        notice " "+chr$(13)+"Pas de fichier : "+ map$+".txt'...!"+chr$(13)+"Il faut donc traçer les limites de cette carte..."
        for y=1 to ncy '---on rempli la map de "x" (partie libre)
            for x=1 to ncx '---ce qui permet d'effacer (en remplaçant par: "x")
                cas$(x,y)="x"
            next
            if sortgrid=1 then exit for
        next
    end if
return
[save]
    filesave$= map$+".txt"
        confirm "Enregistrer les limites de cette carte ?"; answer$
        if answer$ = "yes" then
            open "bmp\map\"; filesave$ for output as #grid
            for y = 1 to ncy
                for x = 1 to ncx
                    #grid, cas$(x,y)
                next
            next
            close #grid
            notice "Enregistrement"+chr$(13)+"limites de la carte enregistrées dans le fichier"+chr$(13)+map$+".txt"
        end if
        goto [Quit]
wait
[tabbord] '----------------------- Tableau de Bord -------------------------
    if optab=1 then [passtab]
    WindowWidth = 200
    WindowHeight = 130
    UpperLeftX=20
    UpperLeftY=100
    BUTTON #tab.cart, "Carte", [carte], UL, 5, 10, 50, 20
    BUTTON #tab.grio, "Grid On", [gridon], UL, 60, 10, 60, 20
    BUTTON #tab.limo, "Limit On", [limiton], UL, 125, 10, 60, 20
    BUTTON #tab.casva, "Case Value", [caseval], UL, 10, 40, 70, 20
    textbox #tab.va, 90, 40, 30, 20
    BUTTON #tab.des, "Destroy", [destroy], UL, 10, 70, 50, 20
    BUTTON #tab.sav, "Save Limites Carte", [save], UL, 80, 70, 110, 20
    open "Tableau de bord" for window_nf as #tab
    [passtab]
    optab=1
    print #tab, "trapclose [Quittab]"
    #tab.va, caseValue$
wait '------------
[limiton] '----------------- Et.... Ses boutons ---------
    gosub [montreLimites]
wait
[carte]
    #3b.map, "drawbmp MAP 0 0"
wait
[gridon]
    gosub [grid]
wait
[destroy]
   kill$=map$+".txt"
   confirm "Vous allez Détruire toutes les données";reponse$
   if reponse$="no" then wait
   if reponse$="yes" then
      if fileExist(DefaultDir$+"\bmp\map\", kill$) then
         kill DefaultDir$+"\bmp\map\"+kill$
         #3b.map, "fill black"
         goto [retour]
      else
         notice "Le fichier: "+kill$+" n'existe pas encore."
      end if
   end if
wait
 
function fileExist(path$,filename$) ' gestion des fichiers (note: infos(10,10) en tête de code)
    files path$,filename$, info$()
    fileExist = val(info$(0, 0))
end function
Function text(x,y,msg$) '------fonction d'affichage de textes
    #3b.map,"color yellow;backcolor black"
    #3b.map,"Place ";x;" ";y;";|";msg$
End Function
 Sub Cotecase handle$, xClick, yClick  '----prise de cotes en cases
    #3b.map, "color yellow;backcolor black"
    xcase=int(xClick/lc)+1 'coord en N° de case
    ycase=int(yClick/lc)+1
    Print text(xClick,yClick,"xc = "+Str$(xcase))
    Print text(xClick,yClick+15,"yc = "+Str$(ycase))
 End Sub
 Sub Cotepix handle$, xClick, yClick  '-----prise de cotes en pixels
    #3b.map, "color yellow;backcolor black"
    xcase=int(xClick/lc)+1 'coord en N° de case
    ycase=int(yClick/lc)+1
    Print text(xClick,yClick,"xp = "+Str$(xClick))
    Print text(xClick,yClick+15,"yp = "+Str$(yClick))
 End Sub
wait
[Quittab]
    close #tab: optab=0
wait
[Quit]
    if optab=1 then close #tab:optab=0
    if map$<>"" then unloadbmp "MAP"
    close #3b
    END
 
 
 
 

 
 ' FENETRE de TESTS
 nomainwin
    WindowWidth = 880
    WindowHeight = 538+5
    UpperLeftX=int((DisplayWidth-WindowWidth)/1.5)
    UpperLeftY=int((DisplayHeight-WindowHeight)/2)
 
    'Global ncx, ncy, lc, SpriteCourant', caseValue
    Global ncx, ncy, lc, SpriteCourant', caseValue$

    lc = 15    'dimension d'une case en pixels

    GRAPHICBOX #3b.map, 0, 0, 870, 538
    BUTTON #3b, "Lim", [montreLimites], UL, 5, 10, 40, 20
    open " Fenêtre de Test" for window as #3b
    #3b.map, "trapclose Quit"
    #3b.map, "down"
    #3b.map, "setfocus; when leftButtonDown [DoubleClick]"
    #3b.map, "When rightButtonUp Cotecase"' côtes en cases
    #3b.map, "When middleButtonDown Cotepix" 'côtes en pixels
    #3b.map, "font Comic_Sans_MS 8"
 
    #3b.map, "home; posxy CenterX CenterY"
    Gwidth = CenterX * 2
    Gheight = CenterY * 2
    dpx(1) = 0  :dpx(2) = 1 :dpx(3) = 0 :dpx(4) = -1
    dpy(1) = -1 :dpy(2) = 0 :dpy(3) = 1 :dpy(4) = 0    ' incrément de direction , pour la variables tableau
    ncx = int(Gwidth/lc)+1   'nbre de case en x
    ncy = int(Gheight/lc)+1   'nbre de case en y

    ' dim cas(ncx,ncy)  'variable tableau de toutes la map.
     dim cas$(ncx,ncy)
    dim info$(10,10)
 
    indice=2
    pCX = 14  ' position initiale du personnage (en cases)
    pCY = 18
[restart]
    nom$="maphum"+str$(indice)
    map$=nom$+".bmp"
    lim$=nom$+".txt"
 
    gosub [charge]
    loadbmp "MAP", "bmp\map\";map$
    #3b.map, "drawbmp MAP 0 0"
    print #3b.map, "background MAP"
 
    sprites$ = "perso1d perso2d perso3d perso4d perso1s perso2s perso3s perso4s "+_
               "perso1q perso2q perso3q perso4q perso1z perso2z perso3z perso4z"
    for s = 1 to 16
        loadbmp word$(sprites$,s), "bmp\"+word$(sprites$,s)+".bmp"
    next
    #3b.map, "addsprite perso1 perso1z perso2z perso3z perso4z"  'création des 4 sprites pour chaque futures direction de déplacement...
    #3b.map, "addsprite perso2 perso1d perso2d perso3d perso4d"
    #3b.map, "addsprite perso3 perso1s perso2s perso3s perso4s"
    #3b.map, "addsprite perso4 perso1q perso2q perso3q perso4q"
 
    for SpriteCourant = 1 to 4
        #3b.map, "spritexy perso";SpriteCourant;" ";pCX*lc;" ";pCY*lc   'place tous les sprites du personnage là.
        #3b.map, "cyclesprite perso";SpriteCourant;" 1"
        #3b.map, "spritevisible perso";SpriteCourant;" off"
    next
    SpriteCourant = 3
    #3b.map, "spritevisible perso";SpriteCourant;" on"
    #3b.map, "drawsprites"   'affiche le sprite courant.
wait
[DoubleClick]
    mX = MouseX
    mY = MouseY
    icp = 6   'incrément de déplacement en pixels.
    #3b.map, "spritexy? perso";SpriteCourant;" cursX cursY"   'coordonnées actuelles du personnage   <------
    dir = direction(cursX,cursY,mX,mY)    'fonction qui donne la direction du déplacement... destinée à utiliser le sprite adéquat.
    for s=1 to 4 : #3b.map, "spritevisible perso";s;" off" : next
    SpriteCourant = dir
    #3b.map, "spritexy perso";SpriteCourant;" ";cursX;" ";cursY
    #3b.map, "spritevisible perso";SpriteCourant;" on"  'ne montre QUE le sprite concerné par la direction choisie.
    do
        #3b.map, "spritexy? perso";SpriteCourant;" cursX cursY"
        cx = int(cursX/lc)+1             'position du sprite exprimé en n° de case pour la variable tableau
        cy = int(cursY/lc)+1
        'if cx+dpx(dir)>0 and cx+dpx(dir)<ncx and cy+dpy(dir)>0 and cy+dpy(dir)<ncy and cas(cx+dpx(dir),cy+dpy(dir)) = 0 then
        if cx+dpx(dir)>0 and cx+dpx(dir)<ncx and cy+dpy(dir)>0 and cy+dpy(dir)<ncy and cas$(cx+dpx(dir),cy+dpy(dir)) = "x" then
            nx = cursX + dpx(dir)*icp
            ny = cursY + dpy(dir)*icp
            #3b.map, "spritexy perso";SpriteCourant;" ";nx;" ";ny      'cheminement du sprite... tranquilou...
            #3b.map, "drawsprites"
            'call pause 90
            temp=90
            gosub [pause]
        else
            sortir = 1
        end if
        if cas$(cx+dpx(dir),cy+dpy(dir)) = "A" then
           indice =indice+1 'incrémente le N° de la map
           if indice=23 then indice =2
           pCX = 39: pCY = 2 ' replace perso (unité= N° de case)
           goto [restart]
        end if  '----------NOTE: LES CONDITIONS CI-DESSOUS NE FONCTIONNENT QUE: dans la mesure...
  '§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§
        if cas$(cx+dpx(dir),cy+dpy(dir)) = "B" then notice "Prendre des congés" ' ...où le fichier de données (limites) existe.
        if cas$(cx+dpx(dir),cy+dpy(dir)) = "E" then Print text(379,124,"Dynamite!!") 'Et ne réagirons, que pour la carte comportant les données
        if cas$(cx+dpx(dir),cy+dpy(dir)) = "2" then Print text(618,130,"Tu marche dans les cailloux!")
        if cas$(cx+dpx(dir),cy+dpy(dir)) = "3" then Print text(590,175,"Tu va te casser la gu..le!")
  '/////////////////////////////////////////////////////////////////////////////////////////////////
        if (dir = 2 and nx >= mX) or (dir = 4 and nx <= mX) or (dir = 1 and ny <= mY) or (dir = 3 and ny >= mY) then sortir = 1  'on est arrivé en l'endroit du clic de souris...
    loop until sortir
    sortir=0
wait
[montreLimites]
    #3b.map, "backcolor blue; color yellow"
    for y = 1 to ncy
        for x = 1 to ncx
           ' if cas(x,y) then #3b.map, "place ";(x*lc)-lc/2-2;" ";y*lc-3;" ;|";cas(x,y)
            if cas$(x,y)<>"x" then #3b.map, "place ";(x*lc)-lc/2-2;" ";y*lc-3;" ;|";cas$(x,y)
        next
    next
    #3b.map,"flush;discard"
wait
[charge]
     file$=lim$
    if fileExist(DefaultDir$+"\bmp\map", file$) then
       redim cas$(ncx,ncy)
        open "bmp\map\";file$ for input as #grid
        for y=1 to ncy
            for x=1 to ncx
            'if eof(#grid) <> 0 then sortgrid=1: exit for 'test de fin de fichier
                LINE INPUT #grid, cas$(x,y)
            next
            if sortgrid=1 then exit for
        next
        close #grid
    else
        c$=" "+chr$(13)+"La Carte: "+ map$+" n'a Pas de fichier 'Limites' Associé..."+chr$(13)
        c$=c$+" Il faut en Créer un à l'aide de l'Editeur"
        'notice " "+chr$(13)+"Cette Carte n'a Pas de fichier 'Limites' Associé..."
        notice c$
    end if
return
 
function direction(dx,dy,ax,ay) 'fonction qui donne la direction du déplacement... destinée à utiliser le sprite adéquat.
    dirX = ax - dx
    dirY = ay - dy
    if abs(dirX) < abs(dirY) then sens = 1 else sens = 2   '1 = vertical  2 = horizontal
    select case
    case sens = 1 : if dirY > 0 then direction = 3 else direction = 1   'direction à prendre: 1 = HAUT,   3 = BAS
    case sens = 2 : if dirX > 0 then direction = 2 else direction = 4   '                     2 = DROITE, 4 = GAUCHE
    end select
end function
Function text(x,y,msg$) '------fonction d'affichage de textes
    #3b.map,"color yellow;backcolor darkgreen"
    #3b.map,"Place ";x;" ";y;";|";msg$
End Function
[pause]
    timer temp, [suit]
    wait
    [suit]
    timer 0
return
 Sub Cotecase handle$, xClick, yClick  'prise de cotes en cases
    #3b.map, "color yellow;backcolor black"
    xcase=int(xClick/lc)+1 'coord en N° de case
    ycase=int(yClick/lc)+1
    Print text(xClick,yClick,"xc = "+Str$(xcase))
    Print text(xClick,yClick+15,"yc = "+Str$(ycase))
 End Sub
 Sub Cotepix handle$, xClick, yClick  'prise de cotes en pixels
    #3b.map, "color yellow;backcolor black"
    xcase=int(xClick/lc)+1 'coord en N° de case
    ycase=int(yClick/lc)+1
    Print text(xClick,yClick,"xp = "+Str$(xClick))
    Print text(xClick,yClick+15,"yp = "+Str$(yClick))
 End Sub
function fileExist(path$,filename$)
    files path$,filename$, info$()
    fileExist = val(info$(0, 0))
end function
sub Quit handle$
    unloadbmp "MAP"
    sprites$ = "perso1d perso2d perso3d perso4d perso1s perso2s perso3s perso4s "+_
               "perso1q perso2q perso3q perso4q perso1z perso2z perso3z perso4z"
    for s = 1 to 16
        unloadbmp word$(sprites$,s)
    next
    close #3b
    END
end sub