Novembre 2024 | Lun | Mar | Mer | Jeu | Ven | Sam | Dim |
---|
| | | | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | | Calendrier |
|
|
| comment faire des cercles contigus sur spirale. | |
| | Auteur | Message |
---|
Invité Invité
| Sujet: comment faire des cercles contigus sur spirale. Ven 11 Déc 2015 - 15:39 | |
| Voila un travail pour nos amis matheux. Je voudrais faire un "escargot" de cercles de 2/3 pixels sur une spirale. J'ai trouvé spirale de PapydallJe ne sais pas trop ce que cela peut donner. Normalement ce serait: 3375 cercles à la suite. Si c'est de trop, il y aura une division par ou 3. Comme dirait ce ne sais plus qui: A vos bon coeur Monsieur/Dame. Merci d'avance. |
| | | bignono
Nombre de messages : 1127 Age : 67 Localisation : Val de Marne Date d'inscription : 13/11/2011
| Sujet: Re: comment faire des cercles contigus sur spirale. Ven 11 Déc 2015 - 16:02 | |
| Bonjour à tous Je ne sais pas si cela peut t'aider Cosmos: J'avais fait cela il y a longtemps... - Code:
-
dim C,L,q,i,j,k,el,ec C=32:L=32:q=(C-1)*(L-1) dim a(C,L) full_space 0:font_bold 0:font_size 0,12 for i=0 to C:for j=0 to L:a(i,j)=0:next j:next i i=16:j=16:a(i,j)=q print q 2d_poly_from 200+(i*36),100+(j*20) for k=(q-1) to 1 step -1 if a(i-1,j)=0 then el=j:ec=i-1 if a(i-1,j)=0 and a(i+1,j)<>0 then el=j+1:ec=i if a(i+1,j)=0 and a(i,j-1)<>0 then el=j:ec=i+1 if a(i,j-1)=0 and a(i-1,j)<>0 then el=j-1:ec=i if a(i+1,j)<>0 and a(i,j+1)<>0 then el=j:ec=i-1 j=el:i=ec:a(i,j)=k 2d_poly_to 200+(i*36),100+(j*20) 2d_circle 200+(i*36),100+(j*20),5 : pause 10 next k print:print k end
A+ | |
| | | Klaus
Nombre de messages : 12331 Age : 75 Localisation : Ile de France Date d'inscription : 29/12/2009
| Sujet: Re: comment faire des cercles contigus sur spirale. Ven 11 Déc 2015 - 16:39 | |
| Voici une variante du code de Papydall, avec une version Spirale 2 permettant de dessiner de petits cercles sur la spirale, en paramétrant le diamètre des cercles et l'écart entre les cercles: - Code:
-
' ****************************************************************************** ' Procédures de tracé de quelques figures géométriques Par Papydall ' Figures_Geometriques.bas ' ****************************************************************************** ' Ellipse(250,220,200,100) ' Ellipse(250,220,100,200)
Spirale2(300,200,10,3,10)
' Polygone(250,220,200,3) : ' triangle ou trigone ' Polygone(250,220,200,4) : ' carré ou tétragone ' Polygone(250,220,200,5) : ' pentagone ' Polygone(250,220,200,6) : ' hexagone ' Polygone(250,220,200,7) : ' heptagone ' Polygone(250,220,200,8) : ' octogone ' Polygone(250,220,200,9) : ' nonagone ou ennéagone ' Polygone(250,220,200,10) : ' décagone ' Polygone(250,220,200,11) : ' hendécagone ' Polygone(250,220,200,12) : ' dodécagone ' Polygone(250,220,200,20) : ' icosagone ' Polygone(250,220,200,100) : ' hécatontagone (on s'approche du cercle) ' Polygone(250,220,200,1000) : ' chiliagone (pratiquement un cercle) ' Polygone(250,220,200,10000) : ' myriagone (pratiquement un cercle)
' Pentagramme(250,220,200)
' Coeur(200,250,10)
' concoide(300,200,100)
' Papillon(300,300,50)
' Napperon(300,220,200)
' Secteur_Circulaire(300,220,0,90,200) ' Secteur_Circulaire(300,220,60,120,180) ' Secteur_Circulaire(300,220,-30,-60,200) ' Secteur_Circulaire(300,220,-60,-30,200)
end ' ****************************************************************************** ' Tracé d'une ellipse ' Appel : Ellipse(xc,yc,rx,ry) ' Paramètres: ' xc,yc : coordonnées du centre de l'ellipse ' rx et ry : respectivement rayon horizontal et rayon vertical de l'ellipse ' si rx = ry on obtient un cercle ' Exemple d'appel : ' Ellipse(250,220,100,200) ' Ellipse(250,220,200,100)
SUB Ellipse(xc,yc,rx,ry) dim_local x,y,t,pi,p pi = acos(-1) : p = pi/180 2d_poly_from xc + rx,yc for t = 0 to 2*pi step p x = xc + rx * cos(t) : y = yc + ry * sin(t) : 2d_poly_to x,y next t END_SUB ' ****************************************************************************** ' Tracé d'une spirale ' Appel Spirale(xc,yc,n) ' Paramètres: ' xc,yc : coordonnées du centre de la spirale ' n : nombre de tours ' Exemple d'appel : Spirale(300,200,10)
SUB Spirale(xc,yc,n) dim_local x,y,theta,pi,p pi = acos(-1) : p = pi/180 : 2d_poly_from xc,yc for theta = 0 to 2*n*pi step p x = xc + 3 * theta * cos(theta) : y = yc + 3* theta*sin(theta) 2d_poly_to x,y next theta END_SUB ' ****************************************************************************** ' Tracé d'une spirale avec petits cercles ' Appel Spirale(xc,yc,n) ' Paramètres: ' xc,yc : coordonnées du centre de la spirale ' n : nombre de tours ' d : diamètre des cercles ' e : écart entre cercles, en nombre d'itérations ' Exemple d'appel : Spirale(300,200,10)
SUB Spirale2(xc,yc,n,d,e) dim_local x,y,theta,pi,p, cnt pi = acos(-1) : p = pi/180 : 2d_poly_from xc,yc for theta = 0 to 2*n*pi step p x = xc + 3 * theta * cos(theta) : y = yc + 3* theta*sin(theta) 2d_poly_to x,y cnt = cnt + 1 if cnt=e 2d_circle x,y,d cnt = 0 end_if next theta END_SUB ' ****************************************************************************** ' Tracé d'un polygone convexe régulier ' Paramètres : ' xc,yc : coordonnées du centre du polygone ' rayon : rayon du cercle circonscrit au polygone ' Nbcote : nombre des côtés du polygone ' Exemple d'appel : ' Polygone(250,220,200,3) : ' triangle ' Polygone(250,220,200,4) : ' carré ' Polygone(250,220,200,5) : ' pentagone ' Polygone(250,220,200,10) : ' décagone ' Remarque : ' Pour un grand nombre des côtés on obtient un cercle ' Polygone(250,220,200,360) : ' un cercle
SUB Polygone(xc,yc,rayon,NbCote) dim_local x,y,t,pi,p pi = acos(-1) : p = 2*pi/NbCote 2d_poly_from xc + rayon,yc for t = 0 to 2*pi+.1 step p x = xc + rayon * cos(t) : y = yc + rayon * sin(t) : 2d_poly_to x,y next t END_SUB ' ****************************************************************************** ' Tracé d'un pentagramme (étoile à 5 sommets) ' Paramètres : ' xc,yc : coordonnées du centre du pentagramme ' rayon : rayon du cercle circonscrit au pentagramme ' Exemple d'appel : ' pentagramme(250,220,200)
SUB Pentagramme(xc,yc,rayon) dim_local x,y,t,pi,p pi = acos(-1) : p = 4*pi/5 2d_poly_from xc + rayon,yc for t = 0 to 4*pi step p x = xc + rayon * cos(t) : y = yc + rayon * sin(t) : 2d_poly_to x,y next t END_SUB ' ****************************************************************************** ' Tracé d'un coeur ' Paramètres : ' rx et ry détermine l'allure du coeur dans les sens horizontal et vertical ' epais détermine l'épaisseur du tracé en pixels ' la valeur de epais doit être compris entre 1 et 20, sinon elle sera de 5 pixels ' Exemple d'appel : ' Coeur(200,250,10)
SUB Coeur(rx,ry,epais) dim_local x,y,xc,yc,t,pi,p if (epais < 1) or (epais > 20) then epais = 5 pi = acos(-1) : p = pi/180 : xc = width(0)*.5 : yc = (ry+height(0))*.5 2d_poly_from xc,yc-ry : 2d_pen_color 255,0,0 : 2d_pen_width epais for t = 0 to 2*pi step p x = 4*cos(t)*cos(t)*sin(t)*sin(t)*sin(t) y = (3-2*cos(t)*cos(t))*cos(t)*cos(t) : 2d_poly_to xc+rx*x, yc-ry*y next t END_SUB ' ****************************************************************************** ' Conchoïde de rosace ' Courbe étudiée par Moritz en 1917 ' Autres noms : ' Pétale géométrique, courbe botanique, rosace de Troie (dans le cas e > 1) ' courbe cyclo-harmonique, sinusoïde circulaire ' ------------------------------------------------------------------------------ ' Equation polaire : rho = r *(1 + e * cos(n * theta)) avec n réel > 0 ' Paramètres : ' xc,yc : coordonnées du centre de la concoïde ' r : coefficient multiplicateur ' Exemple d'appel : ' Concoide(300,200,100)
SUB Concoide(xc,yc,r) dim_local pi,p,x,y,theta,rho,n,e pi = acos(-1) : p = pi/180 n = 9/7 : e = .8 : ' Modifier les valeurs de ces 2 constantes pour obtenir différentes formes theta = 0 : rho = (1+e*cos(n*theta)) : x = rho*cos(theta) : y = rho*sin(theta) 2d_poly_from xc+x*r, yc+y for theta = p to 20*pi step p rho = (1+e*cos(n*theta)) : x = rho*cos(theta) : y = rho*sin(theta) 2d_poly_to xc+r*x, yc+r*y next theta END_SUB ' ****************************************************************************** ' Tracé d'un papillon ' Paramètres : ' xc,yc : coordonnées du centre du papillon ' coef : coeffitient multiplicateur ' Exemple d'appel : ' Papillon(300,300,50)
SUB Papillon(xc,yc,coef) dim_local r,theta,x,y,pi,p pi = acos(-1) : p = pi/180 2d_poly_from xc,yc for theta = 0 to 20*pi step p r = exp(sin(theta)) - 2 * cos(4*theta) + sin(1/24 * power((2*theta - pi),5)) x = r*cos(theta) : y = r*sin(theta) 2d_pen_color rnd(255),rnd(155),rnd(25) : 2d_poly_to xc+coef*x,yc-coef*y next theta END_SUB ' ****************************************************************************** ' Tracé d'un napperon ' Paramètres : ' xc,yc : coordonnées du centre du napperon ' r : rayon du cercle circonscrit au napperon ' Exemple d'appel : Napperon(300,220,200)
SUB Napperon(xc,yc,r) dim_local a,b,x,y,n,pi,p,x0,y0 n = 25 : pi = acos(-1) : p = 2*pi/n for a = 0 to 2*pi step p x0 = xc + r * cos(a) : y0 = yc + r * sin(a) for b = a + p to 2 * pi - p step p x = xc + r * cos(b) : y = yc + r * sin(b) : 2d_line x0,y0,x,y next b next a END_SUB ' ****************************************************************************** ' Tracé d'un secteur circulaire ' Paramètres: ' xc,yc : coordonnées du centre du secteur ' deb,fin : respectivement angle de debut et angle de fin du tracé en DEGRES ' rayon : rayon du secteur ' REMARQUES : ' * Le sens du tracé est le sens trigonométrique (sens anti-horraire) ' * les angles deb et fin peuvent être positifs, négatifs ou nuls. ' * Ils peuvent être > 360° en valeur absolue. ' Exemple d'appel : ' Secteur_Circulaire(300,220,0,90,200) ' Secteur_Circulaire(300,220,60,120,150) ' Secteur_Circulaire(300,220,-30,-60,200) ' Secteur_Circulaire(300,220,-60,-30,200)
SUB Secteur_Circulaire(xc,yc,deb,fin,rayon) dim_local x,y,a,pi,rad,p pi = acos(-1) : rad = pi/180 : deb = mod(deb,360) : fin = mod(fin,360) if deb < 0 then deb = deb + 360 if fin < 0 then fin = fin + 360 if deb > fin then deb = deb - 360 2d_poly_from xc,yc for a = deb to fin x = rayon*cos(a*rad) : y = rayon*sin(a*rad) : 2d_poly_to xc+x,yc-y next a 2d_poly_to xc,yc END_SUB ' ****************************************************************************** EDIT Dans mon exemple, j'ai choisi, pour la simplicité, de configurer un écart angulaire constant (nombre d'itérations) entre les cercles, avec des cercles de diamètre constant. On pourrait facilement améliorer cela en grossissant les cercles en fonction de leur distance du centre de la spirale, et adapter l'écart angulaire également à la distance du centre de la spirale, de sorte que les cercles, tout en grossissant, se toucheraient systématiquement. | |
| | | papydall
Nombre de messages : 7017 Age : 74 Localisation : Moknine (Tunisie) Entre la chaise et le clavier Date d'inscription : 03/03/2012
| Sujet: Re: comment faire des cercles contigus sur spirale. Ven 11 Déc 2015 - 18:25 | |
| Salut tout le monde @Cosmos70 Si ça te dit quelque chose. - Code:
-
rem ============================================================================ ' Paramètres: ' xc,yc : coordonnées du centre de la spirale ' n : nombre de tours
SUB Escargot(xc,yc,n) dim_local x,y,theta,pi,p 2d_fill_on : 2d_fill_color 150,100,50 pi = acos(-1) : p = pi/180 : 2d_poly_from xc,yc for theta = 0 to 2*n*pi step p x = xc + 3 * theta * cos(theta) : y = yc + 3* theta*sin(theta) 2d_circle x,y,8 next theta
for theta = 0-2*pi to 0 step p x = 376+xc + 30 * theta * cos(theta) : y = yc - 30* theta*sin(theta) 2d_circle x,y,8 next theta END_SUB rem ============================================================================
| |
| | | Klaus
Nombre de messages : 12331 Age : 75 Localisation : Ile de France Date d'inscription : 29/12/2009
| Sujet: Re: comment faire des cercles contigus sur spirale. Ven 11 Déc 2015 - 18:49 | |
| Tiens, c'est bizarre ! Appelée comme ceci: - Code:
-
full_space 0 escargot(300,300,15) end cette SUB donne: | |
| | | Invité Invité
| Sujet: Re: comment faire des cercles contigus sur spirale. Ven 11 Déc 2015 - 19:48 | |
| Je vous remercie tous pour vos réponses. Je me demandais ce que cela pouvait donner, et je vois que l'idée n'est pas bonne. La décomposition en facteur premier de 255 est si je ne me trompe pas: 3 5 et 17. Il s'agit de couleurs. Je m'étais dis que pour avoir un panel limité de couleur pour du texte serait de faire des sauts de 17 pixels à la fois, entre deux couleurs. Donc 3 x 5 = 15, et 15 ^ 3 donne : 3375 possibilités. Je pensais à une représentation en spirale, mais là ça ne présente rien de bon. Je vais revoir autrement. Pour du texte, il ne sert à rien d'avoir toute la gamme de couleurs. Ce que je voulais éviter, c'est d'avoir à définir deux couleurs très proches. Je vais plutôt choisir peut-être avec scroll_bar, des carrés de couleurs qui seront en mémoire et sauvegardés. Lorsqu'une couleur sera définies, on la retrouvera avec le carré. En tout cas merci à vous. |
| | | Jean Claude
Nombre de messages : 5950 Age : 70 Localisation : 83 Var Date d'inscription : 07/05/2009
| Sujet: Re: comment faire des cercles contigus sur spirale. Ven 11 Déc 2015 - 20:58 | |
| C'est plaisant, Voici une variante, juste pour le plaisir - Code:
-
rem ============================================================================ ' Paramètres: ' xc,yc : coordonnées du centre de la spirale ' n : nombre de tours full_space 0 : color 0,0,0,0 escargot(screen_x/2,screen_y/2,50) end end SUB Escargot(xc,yc,n) dim_local x,y,theta,pi,p 2d_fill_on : 2d_fill_color rnd(255),rnd(255),rnd(255) pi = acos(-1) : p = pi/180 : 2d_poly_from xc,yc for theta = 0 to 2*n*pi step p 2d_fill_color rnd(255),rnd(255),rnd(255) x = xc + 2 * theta * cos(theta) : y = yc + 1.5* theta*sin(theta) 2d_circle x,y,1+(theta/40) next theta
' for theta = 0-2*pi to 0 step p ' x = 376+xc + 30 * theta * cos(theta) : y = yc - 30* theta*sin(theta) ' 2d_circle x,y,8 ' next theta END_SUB rem ============================================================================
A+ | |
| | | Jicehel
Nombre de messages : 5947 Age : 52 Localisation : 77500 Date d'inscription : 18/04/2011
| Sujet: Re: comment faire des cercles contigus sur spirale. Ven 11 Déc 2015 - 21:52 | |
| Une variante de la variante - Code:
-
rem ============================================================================ ' Paramètres: ' xc,yc : coordonnées du centre de la spirale ' n : nombre de tours full_space 0 : color 0,0,0,0 escargot(screen_x/2,screen_y/2,60) end end SUB Escargot(xc,yc,n) dim_local x,y,theta,pi,p 2d_fill_on pi = acos(-1) : p = pi/180 for theta = 0 to 2*n*pi step p 2d_fill_color theta / 2, abs(0.45* theta*sin(theta)), 255 - theta / 1.6 2d_pen_color theta / 2, abs(0.45* theta*sin(theta)), 255 - theta / 1.6 x = xc + 2 * theta * cos(theta) : y = yc + 1.5* theta*sin(theta) 2d_circle x,y,1+(theta/100) next theta END_SUB rem ============================================================================ | |
| | | Invité Invité
| Sujet: Re: comment faire des cercles contigus sur spirale. Ven 11 Déc 2015 - 23:06 | |
| J'ai repris le code de Bignono. Je ne valide pas pour le choix des couleurs, car le choix de l'une d'elle en choisissant des dégradés, ne va pas. Je voulais juste voir ce que cela donne. - Code:
-
dim C,L,q,i,j,k,el,ec , r,v,b C=32:L=32:q=(C-1)*(L-1) dim a(C,L) full_space 0:font_bold 0:font_size 0,12 for i=0 to C:for j=0 to L:a(i,j)=0:next j:next i i=16:j=16:a(i,j)=q print q 2d_poly_from 200+(i*36),100+(j*20) for k=(q-1) to 1 step -1 if a(i-1,j)=0 then el=j:ec=i-1 if a(i-1,j)=0 and a(i+1,j)<>0 then el=j+1:ec=i if a(i+1,j)=0 and a(i,j-1)<>0 then el=j:ec=i+1 if a(i,j-1)=0 and a(i-1,j)<>0 then el=j-1:ec=i if a(i+1,j)<>0 and a(i,j+1)<>0 then el=j:ec=i-1 j=el:i=ec:a(i,j)=k 2d_fill_color r,v,b r = r+20 : if r > 255 then r = 0 : v = v+20 if v > 255 then v= 0 : b=b+20 if b > 255 then b= 0 ' 2d_poly_to 200+(i*36),100+(j*20) 2d_circle 200+(i*9),100+(j*9),5 : pause 10 next k print:print k end Autre version, et ce que cela aurait pu être - Code:
-
dim C,L,q,i,j,k,el,ec , r,v,b , x , y C=32:L=32:q=(C-1)*(L-1) dim a(C,L) full_space 0:font_bold 0:font_size 0,12 for i=0 to C:for j=0 to L:a(i,j)=0:next j:next i i=16:j=16:a(i,j)=q print q 2d_poly_from 200+(i*36),100+(j*20) for k=(q-1) to 1 step -1 if a(i-1,j)=0 then el=j:ec=i-1 if a(i-1,j)=0 and a(i+1,j)<>0 then el=j+1:ec=i if a(i+1,j)=0 and a(i,j-1)<>0 then el=j:ec=i+1 if a(i,j-1)=0 and a(i-1,j)<>0 then el=j-1:ec=i if a(i+1,j)<>0 and a(i,j+1)<>0 then el=j:ec=i-1 j=el:i=ec:a(i,j)=k 2d_fill_color r,v,b : 2d_pen_color r,v,b r = r+34 : if r > 255 then r = 0 : v = v+34 if v > 255 then v= 0 : b=b+34 if b > 255 then b= 0 : exit_for
' 2d_poly_to 200+(i*36),100+(j*20) ' 2d_circle 200+(i*9),100+(j*9),5 :' pause 10 2d_rectangle 200+(i*9),100+(j*9) , 200+((i+1)*9) , 100+((j+1)*9) next k print:print k : pause 1000 repeat x = mouse_x_position(0) : y = mouse_y_position(0) r = color_pixel_red(0,x,y) v = color_pixel_green(0,x,y) b = color_pixel_blue(0,x,y) 2d_fill_color r,v,b : 2d_pen_color r,v,b 2d_rectangle 0,0,100,100 until scancode = 1 end |
| | | Jean Claude
Nombre de messages : 5950 Age : 70 Localisation : 83 Var Date d'inscription : 07/05/2009
| Sujet: Re: comment faire des cercles contigus sur spirale. Sam 12 Déc 2015 - 7:48 | |
| Bravo Cosmos et Jicehel, c'est plutôt joli. J'aime le dernier code de Cosmos, je vais surement jouer avec.... A+ | |
| | | Invité Invité
| Sujet: Re: comment faire des cercles contigus sur spirale. Sam 12 Déc 2015 - 11:30 | |
| Merci Jean Claude - Jean Claude a écrit:
- J'aime le dernier code de Cosmos, je vais surement jouer avec.... Very Happy
Moi aussi je vais jouer avec. Il faut seulement que je reprenne le code pour qu'une couleur n'apparaisse qu'une fois. Je vais garder ce principe pour choisir une couleur, avec des carrés gardant une mémoire de celle-ci pour s'en resservir. Cela me parait plus facile à choisir, que de se servir des scroll_bar. |
| | | Invité Invité
| Sujet: Re: comment faire des cercles contigus sur spirale. Sam 12 Déc 2015 - 15:50 | |
| Finalement, j'ai une figure faite à partir du code de Bignono qui comporte 224 carrés de couleurs, et nettement suffisant pour choisir la représentation d'un texte, par rapport au fond de celui-ci. Cette figure, je la sauvegarde pour la récupérer ensuite dans une des pages de mon programme. - Code:
-
' ==================== 224 carrés de couleurs ================================== dim C,L,q,i,j,k,el,ec , r,v,b , x , y , ecart , a$ , b$ C=32:L=32:q=(C-1)*(L-1) : ecart = 45 : a$=" " dim a(C,L) , f$ f$ = "C:\PANO\spirale_color.bmp" :' pour récupérer l'image finale
full_space 0:font_bold 0:font_size 0,12 for i=0 to C:for j=0 to L:a(i,j)=0:next j:next i i=16:j=16:a(i,j)=q image 1 dlist 2 ' list 3 : left 3,1100:width 3,90 : height 3,height(2) :' on récupère 0,45,90,135,180,225 for k=(q-1) to 1 step -1 if a(i-1,j)=0 then el=j:ec=i-1 if a(i-1,j)=0 and a(i+1,j)<>0 then el=j+1:ec=i if a(i+1,j)=0 and a(i,j-1)<>0 then el=j:ec=i+1 if a(i,j-1)=0 and a(i-1,j)<>0 then el=j-1:ec=i if a(i+1,j)<>0 and a(i,j+1)<>0 then el=j:ec=i-1 j=el:i=ec:a(i,j)=k
2d_fill_color r,v,b : 2d_pen_color r,v,b a$=a$+str$(r)+","+str$(v)+","+str$(b)+" " item_add 2, str$(r)+","+str$(v)+","+str$(b) ' item_add 3,r if r=255 or v=255 or b=255 if r=255 then r = 0 : v=v+ecart : if v > 255 then v=0 if v=255 then v = 0 : b=b+ecart : if b > 255 then b=0 if b=255 then b=0 else r = r+ecart : if r > 255 then r = 0 : v = v+ecart if v > 255 then v= 0 : b=b+ecart if b > 255 then b= 0 :r=0 end_if 2d_rectangle 200+(i*10),100+(j*10) , 200+((i+1)*10) , 100+((j+1)*10) next k sort 2 ' --------------------------------------------------------------------- ' enlever les doublons r = 1 repeat if r >= count(2)-1 then exit_repeat a$ = item_read$(2,r) : v=r +1 caption 0,number_current_line repeat caption 0,number_current_line if item_read$(2,v) = a$ then item_delete 2,v if v > count(2) then exit_repeat until item_read$(2,v) <> a$ or scancode = 27 r = r+1 until r >= count(2) sort 2 repeat : until scancode = 0 ' ajout des couleurs standarts item_add 2,"0,0,255" item_add 2,"255,0,0" item_add 2,"0,255,0" item_add 2,"255,255,0" item_add 2,"255,0,255" item_add 2,"0,255,255" item_add 2,"255,255,255" item_add 2,"0,0,0" ' -------------------------------------------- ' refaire la figure sans les doublons 2d_clear for i=0 to C:for j=0 to L:a(i,j)=0:next j:next i i=16:j=16:a(i,j)=q C=32:L=32:q=(C-1)*(L-1) 2d_poly_from 200+(i*36),100+(j*20) for k= 1 to count(2) if a(i-1,j)=0 then el=j:ec=i-1 if a(i-1,j)=0 and a(i+1,j)<>0 then el=j+1:ec=i if a(i+1,j)=0 and a(i,j-1)<>0 then el=j:ec=i+1 if a(i,j-1)=0 and a(i-1,j)<>0 then el=j-1:ec=i if a(i+1,j)<>0 and a(i,j+1)<>0 then el=j:ec=i-1 j=el:i=ec:a(i,j)=k a$ = item_read$(2,k) r = val (left$(a$,instr(a$,",")-1)) : a$ = right_pos$(a$,instr(a$,",")+1) v = val (left$(a$,instr(a$,",")-1)) : a$ = right_pos$(a$,instr(a$,",")+1) b = val(a$) 2d_fill_color r,v,b : 2d_pen_color r,v,b 2d_rectangle 200+(i*15),100+(j*15) , 200+((i+1)*15) , 100+((j+1)*15) next k 2d_image_copy 1,335,233,560,459 file_save 1,f$ ' ################################################# repeat x = mouse_x_position(0) : y = mouse_y_position(0) caption 0,"sortie par pause x="+ str$(x) + " y="+str$(y) r = color_pixel_red(0,x,y) v = color_pixel_green(0,x,y) b = color_pixel_blue(0,x,y) 2d_fill_color r,v,b : 2d_pen_color r,v,b 2d_rectangle 0,0,100,100 until scancode = 19 end ' ============================================================================== Sortie en appuyant sur pause, qui permet de voir avant en passant la souris sur la figure la récupération de la couleur. Tel-quel les couleurs en sauvegarde n'ont besoin que de 7 caractères de 1 à 7 ou A à G, comme on l'entend: 0,45,90,135,180,225 et 255 ajouté à la fin. Si on prend les lettres A à G cela pourrait être: ABG ce qui correspondrait à color x,0,45,255 Merci pour vos réactions. |
| | | Jicehel
Nombre de messages : 5947 Age : 52 Localisation : 77500 Date d'inscription : 18/04/2011
| Sujet: Re: comment faire des cercles contigus sur spirale. Sam 12 Déc 2015 - 17:28 | |
| Excuses moi Cosmos70, mais mon instinct de coloriste s'est réveillé en voyant ton code et j'ai trop eu envie de jouer avec ... Ca donne ça: - Code:
-
' ==================== 224 carrés de couleurs ================================== dim C,L,q,i,j,k,el,ec , r,v,b C=32:L=32:q=(C-1)*(L-1) dim a(C,L) full_space 0:font_bold 0:font_size 0,12 for i=0 to C:for j=0 to L:a(i,j)=0:next j:next i i=16:j=16:a(i,j)=q image 1 for k=(q-1) to 1 step -1 if a(i-1,j)=0 then el=j:ec=i-1 if a(i-1,j)=0 and a(i+1,j)<>0 then el=j+1:ec=i if a(i+1,j)=0 and a(i,j-1)<>0 then el=j:ec=i+1 if a(i,j-1)=0 and a(i-1,j)<>0 then el=j-1:ec=i if a(i+1,j)<>0 and a(i,j+1)<>0 then el=j:ec=i-1 j=el:i=ec:a(i,j)=k r = i / 32 * 255 : v = j / 32 * 255 : b = k / 4 2d_fill_color r,v,b : 2d_pen_color r,v,b 2d_rectangle 200+(i*10),100+(j*10) , 200+((i+1)*10) , 100+((j+1)*10) next k end ' ============================================================================== Je n'ai pas laissé la gestion de liste qui servait à ton programme car là, moi, c'est juste pour le dessin, mais de toute façon si tu veux, tu peux le réimplanter... | |
| | | Jean Claude
Nombre de messages : 5950 Age : 70 Localisation : 83 Var Date d'inscription : 07/05/2009
| Sujet: Re: comment faire des cercles contigus sur spirale. Sam 12 Déc 2015 - 17:58 | |
| Bravo Jicehel, ça fait un moment que je joue avec ce code, sans rien sortir d’intéressant. A+ | |
| | | Jicehel
Nombre de messages : 5947 Age : 52 Localisation : 77500 Date d'inscription : 18/04/2011
| Sujet: Re: comment faire des cercles contigus sur spirale. Sam 12 Déc 2015 - 19:09 | |
| Tu peux faire plein de variantes simplement en jouant sur les conditions de modification r, v et b Par exemple cette simple transformation change complètement le résultat - Code:
-
' ==================== 224 carrés de couleurs ================================== dim C,L,q,i,j,k,el,ec , r,v,b C=32:L=32:q=(C-1)*(L-1) dim a(C,L) full_space 0:font_bold 0:font_size 0,12 for i=0 to C:for j=0 to L:a(i,j)=0:next j:next i i=16:j=16:a(i,j)=q image 1 for k=(q-1) to 1 step -1 if a(i-1,j)=0 then el=j:ec=i-1 if a(i-1,j)=0 and a(i+1,j)<>0 then el=j+1:ec=i if a(i+1,j)=0 and a(i,j-1)<>0 then el=j:ec=i+1 if a(i,j-1)=0 and a(i-1,j)<>0 then el=j-1:ec=i if a(i+1,j)<>0 and a(i,j+1)<>0 then el=j:ec=i-1 j=el:i=ec:a(i,j)=k r = i / 32 * 255 : v = j / 32 * 255 : b = 255 - r 2d_fill_color r,v,b : 2d_pen_color r,v,b 2d_rectangle 200+(i*10),100+(j*10) , 200+((i+1)*10) , 100+((j+1)*10) next k end ' ============================================================================== Mais bien sûr il y a des tonnes de variantes simples telles que par exemple: - Code:
-
' ==================== 224 carrés de couleurs ================================== dim C,L,q,i,j,k,el,ec , r,v,b C=32:L=32:q=(C-1)*(L-1) dim a(C,L) full_space 0:font_bold 0:font_size 0,12 for i=0 to C:for j=0 to L:a(i,j)=0:next j:next i i=16:j=16:a(i,j)=q image 1 for k=(q-1) to 1 step -1 if a(i-1,j)=0 then el=j:ec=i-1 if a(i-1,j)=0 and a(i+1,j)<>0 then el=j+1:ec=i if a(i+1,j)=0 and a(i,j-1)<>0 then el=j:ec=i+1 if a(i,j-1)=0 and a(i-1,j)<>0 then el=j-1:ec=i if a(i+1,j)<>0 and a(i,j+1)<>0 then el=j:ec=i-1 j=el:i=ec:a(i,j)=k r = b : v = j / 32 * 255 : b = 255 - r 2d_fill_color r,v,b : 2d_pen_color r,v,b 2d_rectangle 200+(i*10),100+(j*10) , 200+((i+1)*10) , 100+((j+1)*10) next k end ' ============================================================================== | |
| | | Invité Invité
| Sujet: Re: comment faire des cercles contigus sur spirale. Sam 12 Déc 2015 - 19:14 | |
| Bravo Jicehel C'est mieux organisé que ce que j'ai fait, mais pour moi il y a trop de couleurs. Déjà je pense que 224 couleurs me semblent beaucoup. Pour avoir un choix assez vaste, pas trop pour du texte, il ne sert à rien d'avoir deux couleurs très proches qu'on ne distinguera pas dans celui-ci. Mais j'ai compris que tu ne faisais que du coloriage. Pour moi rien n'est définitif. Il aura encore beaucoup de temps avant que mon programme soit opérationnel, mais vu le nombre de sub à faire, il faut faire les choses à la suite et la possibilité de choisir plusieurs couleurs, me permet d'avancer et de tester. Merci pour vos approches. Edit: on se croise, mais je regarderai la suite plus tard. |
| | | Jicehel
Nombre de messages : 5947 Age : 52 Localisation : 77500 Date d'inscription : 18/04/2011
| Sujet: Re: comment faire des cercles contigus sur spirale. Sam 12 Déc 2015 - 19:23 | |
| Merci Cosmos70. Tu as raison, moi, ce n'est que pour le coloriage - Code:
-
' ==================== 224 carrés de couleurs ================================== dim C,L,q,i,j,k,el,ec , r,v,b C=32:L=32:q=(C-1)*(L-1) dim a(C,L) full_space 0:font_bold 0:font_size 0,12 for i=0 to C:for j=0 to L:a(i,j)=0:next j:next i i=16:j=16:a(i,j)=q image 1 for k=(q-1) to 1 step -1 if a(i-1,j)=0 then el=j:ec=i-1 if a(i-1,j)=0 and a(i+1,j)<>0 then el=j+1:ec=i if a(i+1,j)=0 and a(i,j-1)<>0 then el=j:ec=i+1 if a(i,j-1)=0 and a(i-1,j)<>0 then el=j-1:ec=i if a(i+1,j)<>0 and a(i,j+1)<>0 then el=j:ec=i-1 j=el:i=ec:a(i,j)=k r = 255 - k/4 : v = j / 32 * 255 : b = k / 4 2d_fill_color r,v,b : 2d_pen_color r,v,b 2d_rectangle 200+(i*10),100+(j*10) , 200+((i+1)*10) , 100+((j+1)*10) next k end ' ============================================================================== | |
| | | Jean Claude
Nombre de messages : 5950 Age : 70 Localisation : 83 Var Date d'inscription : 07/05/2009
| Sujet: Re: comment faire des cercles contigus sur spirale. Sam 12 Déc 2015 - 20:33 | |
| bravo Jicehel, c'est de mieux en mieux. - Cosmos a écrit:
- Merci pour vos approches.
Comme tu l'as précisé "c'est du coloriage". On détourne ta finalité pour s'amuser, mais ne t'inquiète pas, on sera au rendez-vous du programme que tu fabriques. A+ | |
| | | Jicehel
Nombre de messages : 5947 Age : 52 Localisation : 77500 Date d'inscription : 18/04/2011
| Sujet: Re: comment faire des cercles contigus sur spirale. Sam 12 Déc 2015 - 21:01 | |
| oui, c'est juste que le programme est intéressant pour jouer au coloriage car il permet avec quelques petites formules d'obtenir des résultats assez amusants que nous n'avions pas encore obtenus dans nos programmes - Code:
-
' ==================== 224 carrés de couleurs ================================== dim C,L,q,i,j,k,el,ec , r,v,b C=32:L=32:q=(C-1)*(L-1) dim a(C,L) color 0,0,0,0 : full_space 0 2d_fill_color 150,60,140 : 2d_pen_color 150,80,140 : 2d_rectangle 360,260,370,270 for i=0 to C:for j=0 to L:a(i,j)=0:next j:next i i=16:j=16:a(i,j)=q image 1 for k=(q-1) to 1 step -1 if a(i-1,j)=0 then el=j:ec=i-1 if a(i-1,j)=0 and a(i+1,j)<>0 then el=j+1:ec=i if a(i+1,j)=0 and a(i,j-1)<>0 then el=j:ec=i+1 if a(i,j-1)=0 and a(i-1,j)<>0 then el=j-1:ec=i if a(i+1,j)<>0 and a(i,j+1)<>0 then el=j:ec=i-1 j=el:i=ec:a(i,j)=k r = 255 - j / 32 * 255 : v = 255 - k/4 : b = 255 - i /32 * 255 2d_fill_color r,v,b : 2d_pen_color r,v,b 2d_rectangle 200+(i*10),100+(j*10) , 200+((i+1)*10) , 100+((j+1)*10) next k end ' ============================================================================== - Code:
-
' ==================== 224 carrés de couleurs ================================== dim C,L,q,i,j,k,el,ec , r,v,b C=32:L=32:q=(C-1)*(L-1) dim a(C,L) color 0,0,0,0 : full_space 0 2d_fill_color 0,255,0 : 2d_pen_color 0,255,0 : 2d_rectangle 360,260,370,270 for i=0 to C:for j=0 to L:a(i,j)=0:next j:next i i=16:j=16:a(i,j)=q image 1 for k=(q-1) to 1 step -1 if a(i-1,j)=0 then el=j:ec=i-1 if a(i-1,j)=0 and a(i+1,j)<>0 then el=j+1:ec=i if a(i+1,j)=0 and a(i,j-1)<>0 then el=j:ec=i+1 if a(i,j-1)=0 and a(i-1,j)<>0 then el=j-1:ec=i if a(i+1,j)<>0 and a(i,j+1)<>0 then el=j:ec=i-1 j=el:i=ec:a(i,j)=k r = abs (255 - j / 32 * 512) : v = abs(255 - k/2) : b = abs(255 - i /32 * 512) 2d_fill_color r,v,b : 2d_pen_color r,v,b 2d_rectangle 200+(i*10),100+(j*10) , 200+((i+1)*10) , 100+((j+1)*10) next k end ' ============================================================================== | |
| | | Jicehel
Nombre de messages : 5947 Age : 52 Localisation : 77500 Date d'inscription : 18/04/2011
| Sujet: Re: comment faire des cercles contigus sur spirale. Sam 12 Déc 2015 - 21:52 | |
| Bon je mets mon dernier délire sur ce code - Code:
-
' ==================== 224 carrés de couleurs ================================== dim C,L,q,i,j,k,el,ec , r,v,b C=32:L=32:q=(C-1)*(L-1) dim a(C,L) color 0,0,0,0 : full_space 0 2d_fill_color 0,255,0 : 2d_pen_color 0,255,0 2d_rectangle 360,260,370,270: 2d_rectangle 670,570,680,580 2d_fill_color 255,0,0 : 2d_pen_color 255,0,0 2d_rectangle 670,260,680,270 : 2d_rectangle 360,570,370,580 for i=0 to C:for j=0 to L:a(i,j)=0:next j:next i i=16:j=16:a(i,j)=q image 1 for k=(q-1) to 1 step -1 if a(i-1,j)=0 then el=j:ec=i-1 if a(i-1,j)=0 and a(i+1,j)<>0 then el=j+1:ec=i if a(i+1,j)=0 and a(i,j-1)<>0 then el=j:ec=i+1 if a(i,j-1)=0 and a(i-1,j)<>0 then el=j-1:ec=i if a(i+1,j)<>0 and a(i,j+1)<>0 then el=j:ec=i-1 j=el:i=ec:a(i,j)=k r = abs (255 - j / 32 * 512) : v = abs(255 - k/2) : b = abs(255 - i /32 * 512) 2d_fill_color r,v,b : 2d_pen_color r,v,b 2d_rectangle 200+(i*10),100+(j*10) , 200+((i+1)*10) , 100+((j+1)*10) 2d_rectangle 510+(i*10),410+(j*10) , 510+((i+1)*10) , 410+((j+1)*10) 2d_fill_color v,b,r : 2d_pen_color v,b,r 2d_rectangle 510+(i*10),100+(j*10) , 510+((i+1)*10) , 100+((j+1)*10) 2d_rectangle 200+(i*10),410+(j*10) , 200+((i+1)*10) , 410+((j+1)*10)
next k end ' ============================================================================== | |
| | | Invité Invité
| Sujet: Re: comment faire des cercles contigus sur spirale. Sam 12 Déc 2015 - 22:57 | |
| - Citation :
- mais ne t'inquiète pas, on sera au rendez-vous du programme que tu fabriques.
Pour le rendez-vous, vous avez le temps de prendre de grandes vacances. J'ai tout repris, et il me faudrait des heures continues pour avancer, ce que je n'ai pas. Amusez-vous tant que vous voulez. Si je vois quelque chose qui m'intéresse, je saurais le choper. J'avais commencé de faire ce commentaire, et j'ai laissé en stand-by (si le mot est correct) pour le finir maintenant et Jicehel entre temps a encore frappé. Ouille! ça fait mal ! |
| | | Jicehel
Nombre de messages : 5947 Age : 52 Localisation : 77500 Date d'inscription : 18/04/2011
| | | | Contenu sponsorisé
| Sujet: Re: comment faire des cercles contigus sur spirale. | |
| |
| | | | comment faire des cercles contigus sur spirale. | |
|
Sujets similaires | |
|
| Permission de ce forum: | Vous ne pouvez pas répondre aux sujets dans ce forum
| |
| |
| |