Forum Liberty Basic France

Jeux » Un Jeu Facile Prendre le dernier ( Page 2 )
Le 22/07/2012 à 15h12

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
Reprise du message précédent

1) Tu dois mettre un # devant la variable grill$ quand tu l'utilises.
Je résume ta SUB:
dans la fenêtre #grill$
tu pose le crayon avec "down"
tu fixe l'épaisseur du crayon à 3 pixels
tu lui donnes la couleur noir
tu le positionne à 53 300 ( c'est à dire en dehors de la fenêtre puisqu'elle mesure 5*dc X 5*dc)
tu déplaces le crayon à 100 (et le y ?) : un trait sera dessiné puisque "down"
tu flush le tout pour "fixer" l'encre en quelque sorte ;)
...
tout ça fonctionne parfaitement mais j'ai comme dans l'idée que c'est pas tout à fait ce que tu voulais faire... :siffle ;)

2) sûrement un pb d'adressage et de couleur utilisée... il faut être précis et bien calculer ce que les formules donnent exactement comme coordonnées : c'est fastidieux mais une fois que c'est fait ça marche bien.

@+



Edité par cassiope01 Le 22/07/2012 à 15h22
____________________
Devise Shadocks : "Mieux vaut mobiliser son intelligence pour des conneries, que mobiliser sa connerie pour des choses intelligentes"
Coluche disait : "C'est parce que la vitesse de la lumière est plus rapide que celle du son que certains peuvent paraîtrent brillants jusqu'à ce qu'ils ouvrent la bouche."

Web    
Le 22/07/2012 à 16h12

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2457
Les coordonnées sont relatives à la box, pas à la fenetre...je mérite un coup de fouet.
Ca, c'est à force de mettre des textbox partout, en coordonnées "fenetre"
____________________
Roro

   
Le 22/07/2012 à 17h09

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2457
Bon, je m'en suis sorti, j'ai fait au fil de fer.4 lignes pour les fils horizontaux, 4 pour les verticaux. Pour la campagne, ça ira...
La ligne qui tue, (j'ai meme fait des essais dans une box à part) je la garde pour plus tard.
Et maintenant, le gros morceau... :s :s :s
Le pb, c'est que j'ai déjà planché sur ce truc qui était dans " réaction en chaine", et que c'était un peu trop velu pour mon Système .Nerveux.Central...Mais qui ne tente rien.....Ce coup-ci, tu peux meme emporter les cannes à peche....



Edité par Roland Le 22/07/2012 à 17h26
____________________
Roro

   
Le 22/07/2012 à 20h04

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
voici ce que j'ai pêché ;) je t'en donne un bout : fais en bon usage cérébral :top

Code VB :
...
    dim cell(ncx,ncy), cello(ncx,ncy), celco(ncx,ncy)
    col$(1)= "red"
    col$(2)= "yellow"
    col$(3)= "blue"
    col$(4)= "white"
    niv=3: c=1: ca=1
    dirX(1) = 0  : dirY(1) = -1  'up        offset pour les 4 directions
    dirX(2) = 1  : dirY(2) = 0   'right
    dirX(3) = 0  : dirY(3) = 1   'down
    dirX(4) = -1 : dirY(4) = 0   'left

                        '-------------------
    #w.map "down"
    #w.map2 "down"
    #w.map "when leftButtonDown [Mark]"
 
    [moti]
      niv=niv+1
      if niv=4 then niv=1
      #w.ni, "Motif: ";word$("1 2 3",niv)
 
  [new]
    gosub [map2]
    gosub [mapa]
  wait
 
  [Mark]    ' gére l'inversion des 4 cases autour de la case cliquée + cette dernière.
        mX = int(MouseX/dc)+1
        mY = int(MouseY/dc)+1
        if celco(mX,mY)=2 then celco(mX,mY)=3 else celco(mX,mY)=2  ' inversion
        for dir = 1 to 4
            if mX+dirX(dir)>0 and mX+dirX(dir)<=ncx and mY+dirY(dir)>0 and mY+dirY(dir)<=ncy then
                if celco(mX+dirX(dir),mY+dirY(dir))=2 then celco(mX+dirX(dir),mY+dirY(dir))=3 else celco(mX+dirX(dir),mY+dirY(dir))=2
            end if
        next
 
  [trace]
    for mY=0 to 4        ' retrace map
        for mX=0 to 4
           x=mX+1: y=mY+1
           #w.map "backcolor ";col$(celco(x,y));" ; color ";col$(celco(x,y))
           #w.map "place ";mX*dc+1;" ";mY*dc+1;"; boxfilled ";mX*dc+dc-1;" ";mY*dc+dc-1
        next mX
    next mY
  wait
...
____________________
Devise Shadocks : "Mieux vaut mobiliser son intelligence pour des conneries, que mobiliser sa connerie pour des choses intelligentes"
Coluche disait : "C'est parce que la vitesse de la lumière est plus rapide que celle du son que certains peuvent paraîtrent brillants jusqu'à ce qu'ils ouvrent la bouche."

Web    
Le 22/07/2012 à 21h25

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2457
Bon, j'ai intégré ton dernier bout, ça marche. Je ne l'ai pas encore étudié.
Mais tu me sauve d'une chasse au bug "épique"...la case en bas à gauche envoyait un out of range
Le bug, introuvable, des textbox-espions dans tous les coins
Finalement,la cause est due, je pense à la non exclusivité des tests < et > J'ai remplacé les gosub/return par des goto/goto...et le bug a disparu.
Voyons comment tu a éliminé 70 lignes. :heink
____________________
Roro

   
Le 22/07/2012 à 21h41

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2457
.......FABULEUX......! :| :top :top ...jamais ..de mon vivant....Je n'aurais pu trouver un truc pareil.

Oui, je sais...juste quelques variables... :(
____________________
Roro

   
Le 22/07/2012 à 22h22

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2457
Hey ! Mais y'a plus rien de global !...Et le pauvre "dc" emporté par la tempete a embarqué le grillage avec lui.
Heureusement, je sais résoudre les petits mystères.....bientot les gros...peut-etre. :)
____________________
Roro

   
Le 22/07/2012 à 23h10

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2457
Ce coup-ci, je crois qu'il est bon, avec un motif en plus.

Code JB :
 
  ' http://libertybasic.fr/forum/topic-173-2+un-jeu-facile.php
  'Easy ?  puzzle...Whith the two rows come from another world in: [Mark] look at.. for fun.
  nomainwin
    NbXmax = 5  'nombre de case en X
    NbYmax = 5  'nombre de case en Y  (pas utile si la grille est carré ;) )
    dc = 53  'dimension d'une case en pixels
    MapHeight = NbYmax*dc
    MapWidth = NbXmax*dc
 
    WindowWidth = 2*MapWidth+50
    WindowHeight = MapHeight+90
    UpperLeftX = (DisplayWidth-WindowWidth) / 3
    UpperLeftY = (DisplayHeight-WindowHeight) / 2
 
    ncx = 5  'nb of X cells
    ncy = 5 'nb of Y cells
 
    statictext #w.a "REPRODUIRE LE MODELE",70,15,180,20
    statictext #w.B "MODELE",400,17,80,20
    button #w.ni "Motif: 1", [moti], UL, 250, 5, 80, 25
    button #w.ne "New", [new], UL, 480, 5, 70, 25
   ' statictext #w.txt "",5,12,160,20
    graphicbox #w.map1, 10, 40, MapWidth, MapHeight
    graphicbox #w.map2, 300, 40, MapWidth, MapHeight
    open "    Facile ?..." for window_nf as #w  'graphics_nf_nsb
    #w "trapclose quit"
                        '--------INI---------
    dim cell(ncx,ncy), cello(ncx,ncy), celco(ncx,ncy)
    Global dc
    col$(1)= "red"
    col$(2)= "yellow"
    col$(3)= "blue"
    col$(4)= "white"
    niv=4: c=1: ca=1
    dirX(1) = 0  : dirY(1) = -1  'up        offset pour les 4 directions
    dirX(2) = 1  : dirY(2) = 0   'right
    dirX(3) = 0  : dirY(3) = 1   'down
    dirX(4) = -1 : dirY(4) = 0   'left
 
                        '-------------------
    #w.map1 "down"
    #w.map2 "down"
    #w.map1 "when leftButtonDown [Mark]"
 
    [moti]
      niv=niv+1
      if niv=5 then niv=1
      #w.ni, "Motif: ";word$("1 2 3 4",niv)
      #w.ne, "New: ";word$("1 2 3 4",niv)
 
    gosub [map2]
  [new]
    gosub [mapa]
  wait
 
  [Mark]    ' gére l'inversion des 4 cases autour de la case cliquée + cette dernière.
        mX = int(MouseX/dc)+1
        mY = int(MouseY/dc)+1
        if celco(mX,mY)=2 then celco(mX,mY)=3 else celco(mX,mY)=2  ' inversion case cliquée
        for dir = 1 to 4
            if mX+dirX(dir)>0 and mX+dirX(dir)<=ncx and mY+dirY(dir)>0 and mY+dirY(dir)<=ncy then
                if celco(mX+dirX(dir),mY+dirY(dir))=2 then celco(mX+dirX(dir),mY+dirY(dir))=3 else celco(mX+dirX(dir),mY+dirY(dir))=2
            end if
        next
 
    for mY=0 to 4        ' retrace map
        for mX=0 to 4
           x=mX+1: y=mY+1
           #w.map1 "backcolor ";col$(celco(x,y));" ; color ";col$(celco(x,y))
           #w.map1 "place ";mX*dc+1;" ";mY*dc+1;"; boxfilled ";mX*dc+dc-1;" ";mY*dc+dc-1
        next mX
    next mY
    grill$="#w.map1"
     call grid grill$
  wait
                   ' ---------------------------
    [mapa]
    if niv=1 then RESTORE [data1]
    if niv=2 then RESTORE [data2]
    if niv=3 then RESTORE [data3]
    if niv=4 then RESTORE [data4]
    for y=1 to ncy                      ' charge cello()
        for x=1 to ncx
            read val   ' (read ne charge pas tableaux.)
            cello(x,y) = val
        next
    next
    for y=1 to ncy        ' trace map1
        for x=1 to ncx
            select case cello(x,y)
            case 0
            co=3
            #w.map1 "backcolor ";col$(co);" ; color ";col$(co)
            #w.map1 "place ";(x-1)*dc;" ";(y-1)*dc;"; boxfilled ";x*dc+dc-1;" ";y*dc+dc-1
            celco(x,y)=co ' stocke couleur case
            case 1
            co=2
            #w.map1 "backcolor ";col$(co);" ; color ";col$(co)
            #w.map1 "place ";(x-1)*dc;" ";(y-1)*dc;"; boxfilled ";x*dc+dc-1;" ";y*dc+dc-1
            celco(x,y)=co ' stocke couleur case
            end select
        next x
    next y
    grill$="#w.map1"
     call grid grill$
  return
                ' -----------------------------
    [map2]
    if niv=1 then RESTORE [motif1]
    if niv=2 then RESTORE [motif2]
    if niv=3 then RESTORE [motif3]
    if niv=4 then RESTORE [motif4]
    for y=1 to ncy                      ' charge cello()
        for x=1 to ncx
            read val   ' (read ne charge pas tableaux.)
            cello(x,y) = val
        next
    next
    for y=1 to ncy        ' trace map2
        for x=1 to ncx
            select case cello(x,y)
            case 0
            #w.map2 "backcolor ";col$(2);" ; color ";col$(2)
            #w.map2 "place ";(x-1)*dc+1;" ";(y-1)*dc+1;"; boxfilled ";x*dc+dc-1;" ";y*dc+dc-1
            case 1
            #w.map2 "backcolor ";col$(3);" ; color ";col$(3)
            #w.map2 "place ";(x-1)*dc+1;" ";(y-1)*dc+1;"; boxfilled ";x*dc+dc-1;" ";y*dc+dc-1
            end select
        next
    next
    grill$="#w.map2"
     call grid grill$
  return
 
  sub inv byref c, byref ca, byref cb
    c=c+1: ca=ca+1: cb=cb+1
    if c=4 then c=2
    if ca=4 then ca=2
    if cb=4 then cb=2
  end sub
 
  sub grid grill$
      print #grill$, "down"
      print #grill$, "color black"
      for t=1 to 4
          print #grill$, "place "; t*dc;" ";dc-dc
          print #grill$, "goto "; t*dc;" ";5*dc
       next t
      for u=1 to 4
          print #grill$, "place "; dc-dc;" ";u*dc
          print #grill$, "goto "; 5*dc;" ";u*dc
       next u
       print #grill$, "flush"
  end sub
 
wait
  [motif1]
    data 0,0,0,0,0   ' 0 = yellow, 1 = blue
    data 0,0,0,0,0
    data 0,0,0,0,0
    data 0,0,0,0,0
    data 0,0,0,0,0
  [motif2]
    data 0,0,0,0,0   '  0 = yellow, 1 = blue
    data 0,1,1,1,0
    data 0,1,1,1,0
    data 0,1,1,1,0
    data 0,0,0,0,0
  [motif3]
    data 1,1,1,1,1   '  0 = yellow, 1 = blue
    data 1,0,0,0,1
    data 1,0,1,0,1
    data 1,0,0,0,1
    data 1,1,1,1,1
  [motif4]
    data 0,0,1,0,0   '  0 = yellow, 1 = blue
    data 0,1,0,1,0
    data 1,0,0,0,1
    data 0,1,0,1,0
    data 0,0,1,0,0
  [data1]
    data 0,1,0,1,0   '  1= yellow, 0 = blue
    data 1,0,1,0,1
    data 0,1,0,1,0
    data 1,0,1,0,1
    data 0,1,0,1,0
  [data2]
    data 1,0,0,0,1   '  1 = yellow, 0 = blue
    data 0,1,0,1,0
    data 0,0,1,0,0
    data 0,1,0,1,0
    data 1,0,0,0,1
  [data3]
    data 0,0,1,0,0   '  1 = yellow, 0 = blue
    data 0,0,1,0,0
    data 1,1,1,1,1
    data 0,0,1,0,0
    data 0,0,1,0,0
 
  [data4]
    data 0,0,0,0,0   '  1 = yellow, 0 = blue
    data 0,1,0,1,0
    data 0,0,0,0,0
    data 0,1,0,1,0
    data 0,0,0,0,0
 
  wait
    sub quit handle$ 
        close #w
        end
    end sub
 
 

____________________
Roro

   
Le 23/07/2012 à 19h45

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
A mon tour : petit nettoyage d'été ;) (je suis fainéant donc 49 lignes économisées ;) )

Code VB :
 
  ' http://libertybasic.fr/forum/topic-173-2+un-jeu-facile.php
  'Easy ?  puzzle...Whith the two rows come from another world in: [Mark] look at.. for fun.
  nomainwin
    Global dc
    ncx = 5  'nombre de case en X
    ncy = 5  'nombre de case en Y  (pas utile si la grille est carré ;) )
    dc = 53  'dimension d'une case en pixels
    MapHeight = ncy*dc
    MapWidth = ncx*dc
 
    WindowWidth = 2*MapWidth+50
    WindowHeight = MapHeight+90
    UpperLeftX = (DisplayWidth-WindowWidth) / 3
    UpperLeftY = (DisplayHeight-WindowHeight) / 2
 
    statictext #w.a "REPRODUIRE LE MODELE",70,15,180,20
    statictext #w.B "MODELE",400,17,80,20
    button #w.ni "Motif: 1", [moti], UL, 250, 5, 80, 25
    button #w.ne "New", [new], UL, 480, 5, 70, 25
   ' statictext #w.txt "",5,12,160,20
    graphicbox #w.map1, 10, 40, MapWidth, MapHeight
    graphicbox #w.map2, 300, 40, MapWidth, MapHeight
    open "    Facile ?..." for window_nf as #w  'graphics_nf_nsb
    #w "trapclose quit"
                        '--------INI---------
    dim cell(ncx,ncy), cello(ncx,ncy), celco(ncx,ncy)
    col$(1)= "red"
    col$(2)= "yellow"
    col$(3)= "blue"
    col$(4)= "white"
    niv=4: c=1: ca=1
    dirX(1) = 0  : dirY(1) = -1  'up        offset pour les 4 directions
    dirX(2) = 1  : dirY(2) = 0   'right
    dirX(3) = 0  : dirY(3) = 1   'down
    dirX(4) = -1 : dirY(4) = 0   'left
                        '-------------------
    #w.map1 "down"
    #w.map2 "down"
    #w.map1 "when leftButtonDown [Mark]"
 
    call grid "#w.map1"
    call grid "#w.map2"
 
    [moti]
      niv=niv+1-4*(niv=4)
      #w.ni, "Motif: ";word$("1 2 3 4",niv)
      #w.ne, "New: ";word$("1 2 3 4",niv)
      gosub [map2]
 
  [new]
      gosub [mapa]
  wait
 
  [Mark]    ' gére l'inversion des 4 cases autour de la case cliquée + cette dernière.
        mX = int(MouseX/dc)+1
        mY = int(MouseY/dc)+1
        if celco(mX,mY)=3 then celco(mX,mY)=2 else celco(mX,mY)=3  ' inversion case cliquée
        for dir = 1 to 4
            if mX+dirX(dir)>0 and mX+dirX(dir)<=ncx and mY+dirY(dir)>0 and mY+dirY(dir)<=ncy then
                if celco(mX+dirX(dir),mY+dirY(dir))=3 then celco(mX+dirX(dir),mY+dirY(dir))=2 else celco(mX+dirX(dir),mY+dirY(dir))=3
            end if
        next
 
        for mY=1 to 5        ' retrace map sans toucher le grillage ;)
            for mX=1 to 5
                #w.map1 "backcolor ";col$(celco(mX,mY));" ; color ";col$(celco(mX,mY))
                #w.map1 "place ";(mX-1)*dc+1;" ";(mY-1)*dc+1;"; boxfilled ";mX*dc-1;" ";mY*dc-1
            next mX
        next mY
  wait
                   ' ---------------------------
    [mapa]
    if niv=1 then RESTORE [data1]
    if niv=2 then RESTORE [data2]
    if niv=3 then RESTORE [data3]
    if niv=4 then RESTORE [data4]
    for y=1 to ncy                      ' charge cello()
        for x=1 to ncx
            read val   ' (read ne charge pas tableaux.)
            celco(x,y) = val+2
            #w.map1 "backcolor ";col$(celco(x,y));" ; color ";col$(celco(x,y))
            #w.map1 "place ";(x-1)*dc+1;" ";(y-1)*dc+1;"; boxfilled ";x*dc-1;" ";y*dc-1
        next
    next
  return
                ' -----------------------------
    [map2]
    if niv=1 then RESTORE [motif1]
    if niv=2 then RESTORE [motif2]
    if niv=3 then RESTORE [motif3]
    if niv=4 then RESTORE [motif4]
    for y=1 to ncy                      ' charge cello()
        for x=1 to ncx
            read val   ' (read ne charge pas tableaux.)
            cello(x,y) = val+2
            #w.map2 "backcolor ";col$(cello(x,y));" ; color ";col$(cello(x,y))
            #w.map2 "place ";(x-1)*dc+1;" ";(y-1)*dc+1;"; boxfilled ";x*dc-1;" ";y*dc-1
        next
    next
  return
 
  sub grid grill$
    for mY=1 to 5        ' grille
        for mX=1 to 5
           #grill$ "backcolor black ; color black"
           #grill$ "place ";(mX-1)*dc;" ";(mY-1)*dc;"; box ";mX*dc+1;" ";mY*dc+1
        next mX
    next mY
  end sub
 
  [motif1]
    data 0,0,0,0,0   ' 0 = yellow, 1 = blue
    data 0,0,0,0,0
    data 0,0,0,0,0
    data 0,0,0,0,0
    data 0,0,0,0,0
  [motif2]
    data 0,0,0,0,0   '  0 = yellow, 1 = blue
    data 0,1,1,1,0
    data 0,1,1,1,0
    data 0,1,1,1,0
    data 0,0,0,0,0
  [motif3]
    data 1,1,1,1,1   '  0 = yellow, 1 = blue
    data 1,0,0,0,1
    data 1,0,1,0,1
    data 1,0,0,0,1
    data 1,1,1,1,1
  [motif4]
    data 0,0,1,0,0   '  0 = yellow, 1 = blue
    data 0,1,0,1,0
    data 1,0,0,0,1
    data 0,1,0,1,0
    data 0,0,1,0,0
  [data1]
    data 0,1,0,1,0   '  1= yellow, 0 = blue
    data 1,0,1,0,1
    data 0,1,0,1,0
    data 1,0,1,0,1
    data 0,1,0,1,0
  [data2]
    data 1,0,0,0,1   '  1 = yellow, 0 = blue
    data 0,1,0,1,0
    data 0,0,1,0,0
    data 0,1,0,1,0
    data 1,0,0,0,1
  [data3]
    data 0,0,1,0,0   '  1 = yellow, 0 = blue
    data 0,0,1,0,0
    data 1,1,1,1,1
    data 0,0,1,0,0
    data 0,0,1,0,0
  [data4]
    data 0,0,0,0,0   '  1 = yellow, 0 = blue
    data 0,1,0,1,0
    data 0,0,0,0,0
    data 0,1,0,1,0
    data 0,0,0,0,0
 
    sub quit handle$ 
        close #w
        end
    end sub




Edité par cassiope01 Le 23/07/2012 à 19h51
____________________
Devise Shadocks : "Mieux vaut mobiliser son intelligence pour des conneries, que mobiliser sa connerie pour des choses intelligentes"
Coluche disait : "C'est parce que la vitesse de la lumière est plus rapide que celle du son que certains peuvent paraîtrent brillants jusqu'à ce qu'ils ouvrent la bouche."

Web    
Le 23/07/2012 à 21h33

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2457
Poooooooooouh ! Redoutable ! :clap
La modif est tellement discrète, que je suis resté coinçé un bon moment sur le val+2, :heink avec les yeux comme des soucoupes.
Les variables .....c'est formidable.... :top

Hey! on peut couper encore 8 lignes, mais le grillage est plus épais.....c'est moins ...Class'



Edité par Roland Le 23/07/2012 à 22h23
____________________
Roro

   
Le 24/07/2012 à 01h06

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2457
Grillage fin...sans la sub grid...hé..hé....je-mai-trise hum...je crois.
____________________
Roro

   
Le 24/07/2012 à 12h40

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
[mapa] & [map2] se ressemblaient vraiment trop pour que je n'intervienne pas ;) :siffle

Code VB :
 
  ' http://libertybasic.fr/forum/topic-173-2+un-jeu-facile.php
  'Easy ?  puzzle...Whith the two rows come from another world in: [Mark] look at.. for fun.
  nomainwin
    Global dc, ncx, ncy, niv
    ncx = 5  'nombre de case en X
    ncy = 5  'nombre de case en Y  (pas utile si la grille est carré ;) )
    dc = 53  'dimension d'une case en pixels
    MapHeight = ncy*dc
    MapWidth = ncx*dc
 
    WindowWidth = 2*MapWidth+50
    WindowHeight = MapHeight+90
    UpperLeftX = (DisplayWidth-WindowWidth) / 3
    UpperLeftY = (DisplayHeight-WindowHeight) / 2
 
    statictext #w.a "REPRODUIRE LE MODELE",70,15,180,20
    statictext #w.B "MODELE",400,17,80,20
    button #w.ni "Motif: 1", [moti], UL, 250, 5, 80, 25
    button #w.ne "New", [new], UL, 480, 5, 70, 25
   ' statictext #w.txt "",5,12,160,20
    graphicbox #w.map1, 10, 40, MapWidth, MapHeight
    graphicbox #w.map2, 300, 40, MapWidth, MapHeight
    open "    Facile ?..." for window_nf as #w  'graphics_nf_nsb
    #w "trapclose quit"
                        '--------INI---------
    dim cell(ncx,ncy), cello(ncx,ncy), celco(ncx,ncy)
    col$(1)= "red"
    col$(2)= "yellow"
    col$(3)= "blue"
    col$(4)= "white"
    niv=4
    dirX(1) = 0  : dirY(1) = -1  'up        offset pour les 4 directions
    dirX(2) = 1  : dirY(2) = 0   'right
    dirX(3) = 0  : dirY(3) = 1   'down
    dirX(4) = -1 : dirY(4) = 0   'left
                        '-------------------
    #w.map1 "down"
    #w.map2 "down"
    #w.map1 "when leftButtonDown [Mark]"
 
    call grid "#w.map1"
    call grid "#w.map2"
 
    [moti]
        niv=niv+1-4*(niv=4)
        #w.ni, "Motif: ";word$("1 2 3 4",niv)
        #w.ne, "New: ";word$("1 2 3 4",niv)
        call map 2
 
    [new]
        call map 1
    wait
 
  [Mark]    ' gére l'inversion des 4 cases autour de la case cliquée + cette dernière.
        mX = int(MouseX/dc)+1
        mY = int(MouseY/dc)+1
        if celco(mX,mY)=3 then celco(mX,mY)=2 else celco(mX,mY)=3  ' inversion case cliquée
        for dir = 1 to 4
            if mX+dirX(dir)>0 and mX+dirX(dir)<=ncx and mY+dirY(dir)>0 and mY+dirY(dir)<=ncy then
                if celco(mX+dirX(dir),mY+dirY(dir))=3 then celco(mX+dirX(dir),mY+dirY(dir))=2 else celco(mX+dirX(dir),mY+dirY(dir))=3
            end if
        next
        for mY=1 to 5        ' retrace map sans toucher le grillage ;)
            for mX=1 to 5
                #w.map1 "backcolor ";col$(celco(mX,mY));" ; color ";col$(celco(mX,mY))
                #w.map1 "place ";(mX-1)*dc+1;" ";(mY-1)*dc+1;"; boxfilled ";mX*dc-1;" ";mY*dc-1
            next mX
        next mY
        #w.map1 "flush ; discard"
   wait
                   ' ---------------------------

    sub map side    ' side =1 <-  side =2 ->
        select case niv
        case 1 :if side = 1 then RESTORE [data1] else RESTORE [motif1]
        case 2 :if side = 1 then RESTORE [data2] else RESTORE [motif2]
        case 3 :if side = 1 then RESTORE [data3] else RESTORE [motif3]
        case 4 :if side = 1 then RESTORE [data4] else RESTORE [motif4]
        end select
        graph$ = "#w.map";side
        for y=1 to ncy
            for x=1 to ncx
                read val   ' (read ne charge pas tableaux.)
                if side = 1 then celco(x,y) = val+2 else cello(x,y) = val+2   ' charge celco() ou cello()
                #graph$ "backcolor ";col$(val+2);" ; color ";col$(val+2)
                #graph$ "place ";(x-1)*dc+1;" ";(y-1)*dc+1;"; boxfilled ";x*dc-1;" ";y*dc-1
            next
        next
        #graph$ "flush ; discard"
        [motif1]
            data 0,0,0,0,0   ' 0 = yellow, 1 = blue
            data 0,0,0,0,0
            data 0,0,0,0,0
            data 0,0,0,0,0
            data 0,0,0,0,0
        [motif2]
            data 0,0,0,0,0   '  0 = yellow, 1 = blue
            data 0,1,1,1,0
            data 0,1,1,1,0
            data 0,1,1,1,0
            data 0,0,0,0,0
        [motif3]
            data 1,1,1,1,1   '  0 = yellow, 1 = blue
            data 1,0,0,0,1
            data 1,0,1,0,1
            data 1,0,0,0,1
            data 1,1,1,1,1
        [motif4]
            data 0,0,1,0,0   '  0 = yellow, 1 = blue
            data 0,1,0,1,0
            data 1,0,0,0,1
            data 0,1,0,1,0
            data 0,0,1,0,0
        [data1]
            data 0,1,0,1,0   '  1= yellow, 0 = blue
            data 1,0,1,0,1
            data 0,1,0,1,0
            data 1,0,1,0,1
            data 0,1,0,1,0
        [data2]
            data 1,0,0,0,1   '  1 = yellow, 0 = blue
            data 0,1,0,1,0
            data 0,0,1,0,0
            data 0,1,0,1,0
            data 1,0,0,0,1
        [data3]
            data 0,0,1,0,0   '  1 = yellow, 0 = blue
            data 0,0,1,0,0
            data 1,1,1,1,1
            data 0,0,1,0,0
            data 0,0,1,0,0
        [data4]
            data 0,0,0,0,0   '  1 = yellow, 0 = blue
            data 0,1,0,1,0
            data 0,0,0,0,0
            data 0,1,0,1,0
            data 0,0,0,0,0
    end sub
 
    sub grid grill$       ' grille
        for mY=1 to 5
            for mX=1 to 5
                #grill$ "backcolor black ; color black"
                #grill$ "place ";(mX-1)*dc;" ";(mY-1)*dc;"; box ";mX*dc+1;" ";mY*dc+1
            next mX
        next mY
    end sub
 
    sub quit handle$ 
        close #w
        end
    end sub
 
____________________
Devise Shadocks : "Mieux vaut mobiliser son intelligence pour des conneries, que mobiliser sa connerie pour des choses intelligentes"
Coluche disait : "C'est parce que la vitesse de la lumière est plus rapide que celle du son que certains peuvent paraîtrent brillants jusqu'à ce qu'ils ouvrent la bouche."

Web    
Le 24/07/2012 à 13h12

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2457
Il ne reste plu grand chose ! :heink Tu va finir par avoir le "Guiness" du jeu le plus court du monde.
Bon, mais c'est pas tout...ça....En regardant la belle grille du Path Finding, il m'est venu une idée...
Promis, aprés j'arrete avec les grilles....Je vais avancer un peu avant de dévoiler le cahier des charges. ;)

Il y aura beaucoup de couleurs, du tout souris comme on l'aime, et de la réflexion off course.
Je garde la "window Dialog", bien que je ne sache rien de ses particularités (si ce n'est qu'elle est "modale". )J'espère qu'elle ne va pas me faire des difficultés.
Ah...les messages d'erreur ont changés...maintenant j'ai des " sub mismach". Mais le mic-mac, avec moi c'est un peu normal...je reste 'serin...cui..cui.... ....à+
____________________
Roro

   
Le 24/07/2012 à 16h36

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
Aie aie aie :heink :|
____________________
Devise Shadocks : "Mieux vaut mobiliser son intelligence pour des conneries, que mobiliser sa connerie pour des choses intelligentes"
Coluche disait : "C'est parce que la vitesse de la lumière est plus rapide que celle du son que certains peuvent paraîtrent brillants jusqu'à ce qu'ils ouvrent la bouche."

Web    
Le 24/07/2012 à 16h55

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2457
Surtout que là y va y avoir du arround et du neighbor. Tu m'a trop énervé avec la réaction en chaine. ;)
Il me faut une revanche. Je vais essayer d'exploiter les deux lignes :s de out of nowhere ...de: [Mark]
J'ai dit essayer...Sinon, il me reste une palanquée de gosub. :gne ....tout est à craindre....Mais le pire n'est jamais sur..
____________________
Roro

   
Le 25/07/2012 à 01h07

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2457
je ne pensais pas avoir inventé la poudre avec mon idée, mais en fait j'ai redécouvert l'eau chaude.
Je poste le départ, tu va vite comprendre.
Quand à exploiter tes procédures extragalatiques, je crois que ce n'est pas pour tout de suite.
Mais je continu de me faire le dents sur cet os, ma foi un peu dur.
PS: j'ai rectifié en catastrophe pour t'éviter un redemmarage.

Code JB :
 
 
 
   nomainwin
 
    c = 30   'dimension d'un coté de case en pixels
    nc = 20   'nombre de cases sur 1 coté  (c'est un carré !)
 
    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-WinosdowHeight)/4
 
    TEXTBOX #a.testa, WindowWidth-120, WindowHeight-110, 100, 25  ' espion
            ' print #a.testa, col$(u) ' ligne en reserve (no delete)
    statictext #a.txt, "Infos :", 10, WindowHeight-50, 170, 25
 
    TEXTBOX #a.coul, 25, WindowHeight-110, 75, 25
    button #a.rotn, "< -", [rotn], UL, 10, WindowHeight-80, 30, 20
    button #a.rot8, "8", [rot8], UL, 45, WindowHeight-80, 30, 20
    button #a.rotp, "+ >", [rotp], UL, 80, WindowHeight-80, 30, 20
 
    button #a.ne, "New", [new], UL, 150, WindowHeight-110
    'button #a.bt2, "OP 2", [op2], UL, 20, WindowHeight-80
    graphicbox #a.g, 2, 2, nc*c+6, nc*c+6
 
    open "ColorTetris" for dialog as #a   ' graphics_nf_nsb as #a
    #a "trapclose [quit]"
    #a.g "down"
    #a.g  "when leftButtonDown [Mark]"
 
             '--------------------Entrée Zone Minée 1-----------------
    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
 
    DIM info$(nc,nc)
    dim cell(nc,nc)           ' -1, 0, 1, 2 or 3  (at 4 maxi it explode )
    dim arround.cell$(nc,nc)  ' "xxyy xxyy xxyy xxyy" coord. of it's 4 (maxi) neighbors cells
    dim arround.cell(nc,nc)   ' how many neighbors cells
 
    global offset
 
             '---------------------Sortie Zone Minée 1-----------------
 
    dim cocell(nc,nc): dim col$(16): dim gene(nc,nc)  '+++++++++++++++++INITIALISE++++++++++++++
    global dnr, c, nc, n
    n=15: jeu=1
    colo$= "yellow brown red pink blue green cyan black lightgray "+_
    "darkred darkpink darkblue darkgreen darkcyan darkgray white"
      for i=1 to n
        if n >15 then n=15 ' sécurité ( pas de white)
        col$(i)= WORD$(colo$, i)  ' charge col$()
    next
 
  [rot8]
    n=n+1
    n=8
    goto [new]
  [rotp]
    n=n+1
    if n=16 then n=1
    goto [new]
  [rotn]
    n=n-1
    if n=0 then n=15
 
  [new]
  gosub [rempli]  ' grillage+ remplissage
  wait
 
  [Mark]
    gosub [infos]
    mX = int(MouseX/c)+1  'case (0,0)-->+1
    mY = int(MouseY/c)+1
    u=16:col$(u)="white"
    temp=cocell(mX,mY)
    print #a.testa, col$(temp) '§§§§§§§§§§§§§§§
    call drawcell mX, mY, u  ' mise en white case cliquée
    gosub [inspecte]
 
  wait
 
  [inspecte] '----------------Entrée Zone Minée 2---------------
    'do while yes=1  'ici je crois enore au père noel
      u=16:col$(u)="white"
      if mX >1 then
         if cocell(mX-1,mY)=temp then
            yes=1:wx=mX+1:wy=mY:call drawcell wx, wy, u 'houla! il faut avancer sur la case testée
         end if                                           ' et pour les culs de sac !?!?!?
      end if
      yes=0
      if mX < nc-1 then
         if cocell(mX+1,mY)=temp then
            yes=1:wx=mX+1:wy=mY:call drawcell wx, wy, u
         end if
      end if
      if mY >1 then
         if cocell(mX,mY-1)=temp then
            yes=1:wx=mX:wy=mY-1:call drawcell wx, wy, u
         end if
      end if
      if mY < nc-1 then
         if cocell(mX,mY+1)=temp then
            yes=1:wx=mX:wy=mY+1:call drawcell wx, wy, u
         end if
      end if
      yes=1
   'loop
  return
             '----------------Sortie Zone Minée 2---------------
 
  [cascade]  '----------------Entrée Zone Minée 3---------------
 
             '----------------Sortie Zone Minée 3---------------
 
  [rempli]   ' remplissage de départ
    dnr=int(rnd(1)*n) + 1  ' cette ligne est obligatoire ici (sais pas pourquoi)
    '-----------------------------le grillage
    #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
    '---------------------------remplissage grid
        y=1
    for i = 1 to nc*nc  ' la var compteur est différente des coord
        x=x+1
        call drawcell x, y, dnr
        if x>nc-1 then
            x=0
            y=y+1
        end if
        dnr=int(rnd(1)*n) + 1
    next i
    #a.g "Flush"
    #a.g "Discard"
  return
 
  sub drawcell xx, yy, v
    #a.g "color white"
    #a.g "backcolor white"
    #a.g "backcolor ";col$(v)' gare à l'espace aprés backcolor
    #a.g "place ";(xx-1)*c+2;" ";(yy-1)*c+2
    #a.g "boxfilled ";xx*c-1;" ";yy*c-1
    cocell(xx,yy)=v 'stocke rang col$(15)dans cocell(nc,nc) tableau general couleur
    print #a.coul, "N colors = ";n
end sub
 
    [infos]
        mX = int(MouseX/c)  ' gare à la case 0,0
        mY = int(MouseY/c)
        #a.txt "pixels : ";MouseX;" / ";MouseY;_
        "         Cell ( ";mX;" , ";mY;" )"
    return
 
[quit]
    close #a
end
 
 
____________________
Roro

   
Le 25/07/2012 à 07h08

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
Ce ne serait-y pas ce genre de truc que tu voulais faire par hasard ?

@+
____________________
Devise Shadocks : "Mieux vaut mobiliser son intelligence pour des conneries, que mobiliser sa connerie pour des choses intelligentes"
Coluche disait : "C'est parce que la vitesse de la lumière est plus rapide que celle du son que certains peuvent paraîtrent brillants jusqu'à ce qu'ils ouvrent la bouche."

Web    
Le 25/07/2012 à 09h40

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2457
Exactement ! :top Un gros merci à ce monsieur: Altbas. Je suis curieux de voir comment il a géré ce guépier
ET à toi, qui t'y retrouve dans les centaines de prog's et de post's, et que je me demande comment tu fais.
ET que tu ne veux pas le dire.
Tu doit t'etre fais un index. :s ou alors,
Tu a une methode de classement. :s Ou alors
Tu a une trompe et des grandes oreilles, et la mémory qui va avec.
Bon, je vais quand meme le bricoler un peu, ce récursif programme. :miam
Dans la mesure de mes petits moyens

Y'a un truc qui me turlupine: J'ai downloadé la totalité des sites JB et LB,(forum, wiki,archive...TOUT !)j'ai passé des heures à trier et à fouiller....Comment est-il possible que je n'ai pas ce programme.
____________________
Roro

   
Jeux » Un Jeu Facile Prendre le dernier ( Page 2 )  

 |  |

1 Utilisateur en ligne : 0 Administrateur, 0 Modérateur, 0 Membre et 1 Visiteur
Utilisateur en ligne : Aucun membre connecté
Répondre
Vous n'êtes pas autorisé à écrire dans cette catégorie