Forum Liberty Basic France
• Index
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...
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
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...
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."
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
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"
Ca, c'est à force de mettre des textbox partout, en coordonnées "fenetre"
____________________
Roro
Roro
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...
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
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...
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
Roro
voici ce que j'ai pêché je t'en donne un bout : fais en bon usage cérébral 
Code VB :
je t'en donne un bout : fais en bon usage cérébral 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."
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
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.
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.
____________________
Roro
Roro
.......FABULEUX......! ...jamais ..de mon vivant....Je n'aurais pu trouver un truc pareil.
Oui, je sais...juste quelques variables...
...jamais ..de mon vivant....Je n'aurais pu trouver un truc pareil.Oui, je sais...juste quelques variables...
____________________
Roro
Roro
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.
Heureusement, je sais résoudre les petits mystères.....bientot les gros...peut-etre.
____________________
Roro
Roro
Ce coup-ci, je crois qu'il est bon, avec un motif en plus.
Code JB :
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
Roro
A mon tour : petit nettoyage d'été (je suis fainéant donc 49 lignes économisées )
Code VB :
Edité par cassiope01 Le 23/07/2012 à 19h51
(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."
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
Poooooooooouh ! Redoutable !
La modif est tellement discrète, que je suis resté coinçé un bon moment sur le val+2, avec les yeux comme des soucoupes.
Les variables .....c'est formidable....
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
La modif est tellement discrète, que je suis resté coinçé un bon moment sur le val+2,
avec les yeux comme des soucoupes. Les variables .....c'est formidable....
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
Roro
Grillage fin...sans la sub grid...hé..hé....je-mai-trise hum...je crois.
____________________
Roro
Roro
[mapa] & [map2] se ressemblaient vraiment trop pour que je n'intervienne pas
Code VB :
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."
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
Il ne reste plu grand chose ! 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.... ....à+
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
Roro
Aie aie aie
____________________
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."
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
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 de out of nowhere ...de: [Mark]
J'ai dit essayer...Sinon, il me reste une palanquée de gosub.
....tout est à craindre....Mais le pire n'est jamais sur..
Il me faut une revanche. Je vais essayer d'exploiter les deux lignes
de out of nowhere ...de: [Mark]J'ai dit essayer...Sinon, il me reste une palanquée de gosub.
....tout est à craindre....Mais le pire n'est jamais sur..
____________________
Roro
Roro
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 :
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
Roro
____________________
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."
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
Exactement ! 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. ou alors,
Tu a une methode de classement. 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.
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.
Un gros merci à ce monsieur: Altbas. Je suis curieux de voir comment il a géré ce guépierET à 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.
ou alors,Tu a une methode de classement.
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.
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
Roro
• Index
1 Utilisateur en ligne : 0 Administrateur, 0 Modérateur, 0 Membre et 1 Visiteur
Utilisateur en ligne : Aucun membre connecté
Utilisateur en ligne : Aucun membre connecté
Répondre
Vous n'êtes pas autorisé à écrire dans cette catégorie