FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC
Vous souhaitez réagir à ce message ? Créez un compte en quelques clics ou connectez-vous pour continuer.
FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC

Développement d'applications avec le langage Panoramic
 
AccueilAccueil  RechercherRechercher  Dernières imagesDernières images  S'enregistrerS'enregistrer  MembresMembres  Connexion  
Derniers sujets
» Logiciel de planétarium.
Une autre merveille Emptypar Pedro Aujourd'hui à 10:37

» Un autre pense-bête...
Une autre merveille Emptypar Froggy One Jeu 21 Nov 2024 - 15:54

» Récupération du contenu d'une page html.
Une autre merveille Emptypar Pedro Sam 16 Nov 2024 - 14:04

» Décompilation
Une autre merveille Emptypar JL35 Mar 12 Nov 2024 - 19:57

» Un album photos comme du temps des grands-mères
Une autre merveille Emptypar jjn4 Mar 12 Nov 2024 - 17:23

» traitement d'une feuille excel
Une autre merveille Emptypar jjn4 Jeu 7 Nov 2024 - 3:52

» Aide-mémoire mensuel
Une autre merveille Emptypar jjn4 Lun 4 Nov 2024 - 18:56

» Des incomprèhension avec Timer
Une autre merveille Emptypar Klaus Mer 30 Oct 2024 - 18:26

» KGF_dll - nouvelles versions
Une autre merveille Emptypar Klaus Mar 29 Oct 2024 - 17:58

» instructions panoramic
Une autre merveille Emptypar maelilou Lun 28 Oct 2024 - 19:51

» Figures fractales
Une autre merveille Emptypar Marc Ven 25 Oct 2024 - 12:18

» Panoramic et Scanette
Une autre merveille Emptypar Yannick Mer 25 Sep 2024 - 22:16

» Editeur d étiquette avec QR évolutif
Une autre merveille Emptypar JL35 Lun 23 Sep 2024 - 22:40

» BUG QR Code DelphiZXingQRCode
Une autre merveille Emptypar Yannick Dim 22 Sep 2024 - 11:40

» fichier.exe
Une autre merveille Emptypar leclode Ven 20 Sep 2024 - 19:02

Navigation
 Portail
 Index
 Membres
 Profil
 FAQ
 Rechercher
Rechercher
 
 

Résultats par :
 
Rechercher Recherche avancée
Novembre 2024
LunMarMerJeuVenSamDim
    123
45678910
11121314151617
18192021222324
252627282930 
CalendrierCalendrier
Le Deal du moment : -40%
(CDAV) Machine à pâtes Philips 7000 ...
Voir le deal
148.88 €

 

 Une autre merveille

Aller en bas 
3 participants
AuteurMessage
Parpaiun

Parpaiun


Nombre de messages : 192
Age : 85
Localisation : HERAULT
Date d'inscription : 15/04/2015

Une autre merveille Empty
MessageSujet: Une autre merveille   Une autre merveille EmptySam 2 Mai 2015 - 18:42

Hello les panoramiciens ! Plan, plan ratataaa (air de fanfare). Approchez, approchez. Venez voir
le spectacle offert par une autre merveille faite par Parpaiun le grand, (je suis un peu prétentieux peut-être ?).

Il s'agit d'une rosace tout à fait exceptionnelle que j'ai construite avec des arcs préalablement mémorisés et avant huit rotations de 45 degrés.

Dès le lancer du programme apparaît d'abord une maquette de courbes qui sont mémorisées.

Ensuite la belle rosace aux entrelacs (un peu gauches je trouve !) vous apparaît progressivement à vos mirettes écarquillées.

Etes vous étonnés par ce spectacle ? Dès lors je vous permets d'enjoliver mon programme avec des ors, des guirlandes, bref tout ce que vous voulez pour que ça fasse plus joli !

Code:
rem  Rosace à entrelacs
rem Une figure inédite tirée d un bouquin de géométrie
rem
rem Auteur:Yves Blacher
rem Date-version: 02/05/2015
rem
dim ang,cx,cy,dx,dy,i,j,k,n,pi,px,py,rad,th,x,y
caption 0,"ROSACE A ENTRELACS"
label reprise,fin
n=794
dim mx(n),my(n),td(n)
cx=150:cy=300
j=1
mx(j)=cx: my(j)=cy

droite(cx,cy,10,0,0)
arc(x,y,50,17,70,-1)
arc(x,y,100,7.5,345,1)
px=x:py=y
arc(px,py,50,23.5,70,-1)
arc(px,py,50,19,335,1)
arc(x,y,60,20,56,-1)
px=x:py=y
arc(px,py,50,36,335,1)
arc(px,py,60,29,73,-1)
arc(x,y,100,21,345,1)
px=x:py=y
arc(px,py,143,19,82,-1)
arc(px,py,138,18.5,323,1)
arc(x,y,153,21,62,-1)
px=x:py=y
arc(px,py,230,18,320,1)
arc(px,py,153,26,81,-1)
arc(x,y,240,19,340.5,1)
px=x:py=y
arc(px,py,175,34,80,-1)
arc(px,py,240,26,321,1)
print " Maquette avant rotations - Attendez un instant, s.v.p"
wait 3000
rem =============================
rem Traitement des rotations
2d_clear
th=0
reprise:
for i=1 to j
x=cx-mx(i): y=cy-my(i)
rot(th)
echel(0.7)
2d_fill_color 0,0,0
if td(i)=0 then 2d_fill_color 255,255,255
2d_circle 240+x,230+y,2
if scancode=27 then fin
next i
th=th+45
if th<360 then goto reprise
fin:
END

rem xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
SUB droite(dx,dy,ld,da,ot)
pi=atn(1)*4:rad=pi/180:da=da*rad
for i=1 to ld
  dx=dx+1*cos(da)
  dy=dy-1*sin(da)
  j=j+1: mx(j)=dx: my(j)=dy: td(j)= ot
  if ot=1 then 2d_circle dx,dy,1
  next i
  x=dx: y=dy
  END_SUB
rem ==================================

SUB arc(ax,ay,ray,al,ad,sr)
pi=atn(1)*4: rad=pi/180
n=int(0.5+ray*(al*rad))
ad=(360-ad)*rad
for i=1 to n
2d_circle ax,ay,1
j=j+1:mx(j)=ax:my(j)=ay:td(j)=sr
ax=ax+1*cos(ad)
ay=ay+1*sin(ad)
ad=ad+sr/ray
next i
j=j+1: mx(j)=ax:my(j)=ay:td(j)=sr
x=ax:y=ay

END_SUB
rem ===================================

SUB rot(th)
dim_local cs,ss
th=(360-th)*rad
cs=cos(th): ss=sin(th)
px=x*cs-y*ss
py=x*ss+y*cs
x=px: y=py

END_SUB
rem ===================================

SUB echel(e)
x=x*e: y=y*e
END_SUB
Revenir en haut Aller en bas
papydall

papydall


Nombre de messages : 7017
Age : 74
Localisation : Moknine (Tunisie) Entre la chaise et le clavier
Date d'inscription : 03/03/2012

Une autre merveille Empty
MessageSujet: Re: Une autre merveille   Une autre merveille EmptySam 2 Mai 2015 - 19:39

Very good!

Parpaiun, tu veux bien revoir ton code.
J'y ai ajouté mon grain de sel.

Code:

rem  Rosace à entrelacs
rem Une figure inédite tirée d un bouquin de géométrie
rem
rem Auteur:Yves Blacher
rem Date-version: 02/05/2015
rem
dim ang,cx,cy,dx,dy,i,j,k,n,pi,px,py,rad,th,x,y
caption 0,"ROSACE A ENTRELACS"
' label reprise,fin  : ' J'aime pas < ================================= Papydall
n=794
dim mx(n),my(n),td(n)
cx=150:cy=300
j=1
mx(j)=cx: my(j)=cy

droite(cx,cy,10,0,0)
arc(x,y,50,17,70,-1)
arc(x,y,100,7.5,345,1)
px=x:py=y
arc(px,py,50,23.5,70,-1)
arc(px,py,50,19,335,1)
arc(x,y,60,20,56,-1)
px=x:py=y
arc(px,py,50,36,335,1)
arc(px,py,60,29,73,-1)
arc(x,y,100,21,345,1)
px=x:py=y
arc(px,py,143,19,82,-1)
arc(px,py,138,18.5,323,1)
arc(x,y,153,21,62,-1)
px=x:py=y
arc(px,py,230,18,320,1)
arc(px,py,153,26,81,-1)
arc(x,y,240,19,340.5,1)
px=x:py=y
arc(px,py,175,34,80,-1)
arc(px,py,240,26,321,1)
print " Maquette avant rotations - Attendez un instant, s.v.p"
wait 3000
rem =============================
rem Traitement des rotations
2d_clear
' th=0
' reprise:           : ' J'aime pas < ================================= Papydall
for th = 0 to 360 step 45   : ' J'AIME < ============================== Papydall
for i=1 to j
x=cx-mx(i): y=cy-my(i)
rot(th)
echel(0.7)
2d_fill_color 0,0,0
if td(i)=0 then 2d_fill_color 255,255,255
2d_circle 240+x,230+y,2
if scancode=27 then fin : ' Cette syntaxe n'est pas permise en Panoramic
                          ' il faut faire : if scancode=27 then GOTO fin
                          ' Comme Papydall n'aime pas GOTO, on peut faire
                          ' if scancode=27 then end (ou TERMINATE)
next i
' th=th+45           : ' J'aime pas < ================================= Papydall
' if th<360 then goto reprise  : ' J'aime pas < ======================= Papydall
next th                     : ' J'AIME < ============================== Papydall
' fin:               : ' J'aime pas < ================================= Papydall
END

rem xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
SUB droite(dx,dy,ld,da,ot)
pi=atn(1)*4:rad=pi/180:da=da*rad
for i=1 to ld
  dx=dx+1*cos(da)
  dy=dy-1*sin(da)
  j=j+1: mx(j)=dx: my(j)=dy: td(j)= ot
  if ot=1 then 2d_circle dx,dy,1
  next i
  x=dx: y=dy
  END_SUB
rem ==================================

SUB arc(ax,ay,ray,al,ad,sr)
pi=atn(1)*4: rad=pi/180
n=int(0.5+ray*(al*rad))
ad=(360-ad)*rad
for i=1 to n
2d_circle ax,ay,1
j=j+1:mx(j)=ax:my(j)=ay:td(j)=sr
ax=ax+1*cos(ad)
ay=ay+1*sin(ad)
ad=ad+sr/ray
next i
j=j+1: mx(j)=ax:my(j)=ay:td(j)=sr
x=ax:y=ay

END_SUB
rem ===================================

SUB rot(th)
dim_local cs,ss
th=(360-th)*rad
cs=cos(th): ss=sin(th)
px=x*cs-y*ss
py=x*ss+y*cs
x=px: y=py

END_SUB
rem ===================================

SUB echel(e)
x=x*e: y=y*e
END_SUB

Un petit conseil : use (et abuse si tu veux) de l'indentation : ça rend le code plus clair. lol!
Revenir en haut Aller en bas
http://papydall-panoramic.forumarabia.com/
Jicehel

Jicehel


Nombre de messages : 5947
Age : 52
Localisation : 77500
Date d'inscription : 18/04/2011

Une autre merveille Empty
MessageSujet: Re: Une autre merveille   Une autre merveille EmptySam 2 Mai 2015 - 22:58

Merci pour cette création originale
Je vous mets une version légèrement modifiée
Code:
rem xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
rem Rosace à entrelacs
rem Une figure inédite tirée d un bouquin de géométrie
rem
rem Auteur:Yves Blacher
rem Date-version: 02/05/2015
rem xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
rem
dim ang,dx,dy,i,k,px,py,th,x,y
dim pi  : pi=atn(1)*4
dim rad : rad=pi/180
dim n : n=794
dim mx(n),my(n),td(n)
dim cx,cy,j : cx=150:cy=300 : j=1

color 0,255,0,0 : caption 0,"ROSACE A ENTRELACS" : 2d_pen_color 255,0,0

mx(j)=cx: my(j)=cy : droite(cx,cy,10,0,0) : arc(x,y,50,17,70,-1) : arc(x,y,100,7.5,345,1)
px=x:py=y : arc(px,py,50,23.5,70,-1) : arc(px,py,50,19,335,1)    : arc(x,y,60,20,56,-1)
px=x:py=y : arc(px,py,50,36,335,1)  : arc(px,py,60,29,73,-1)    : arc(x,y,100,21,345,1)
px=x:py=y : arc(px,py,143,19,82,-1)  : arc(px,py,138,18.5,323,1) : arc(x,y,153,21,62,-1)
px=x:py=y : arc(px,py,230,18,320,1)  : arc(px,py,153,26,81,-1)  : arc(x,y,240,19,340.5,1)
px=x:py=y : arc(px,py,175,34,80,-1)  : arc(px,py,240,26,321,1)

rem xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
rem Traitement des rotations
2d_clear : 2d_pen_color 128,0,0
for th = 0 to 360 step 45
  for i=1 to j
    x=cx-mx(i): y=cy-my(i) : rot(th)
    echel(0.7)
    2d_point 240+x,230+y
    if scancode=27 then th=380 : exit_for
  next i
next th

2d_flood 10,10,0,0,0

END
rem xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

rem ==================================
SUB droite(dx,dy,ld,da,ot)
da=da*rad
for i=1 to ld
  dx=dx+1*cos(da) :  dy=dy-1*sin(da)
  j=j+1: mx(j)=dx: my(j)=dy: td(j)= ot
next i
x=dx: y=dy
END_SUB

rem ==================================
SUB arc(ax,ay,ray,al,ad,sr)
n=int(0.5+ray*(al*rad)) : ad=(360-ad)*rad
for i=1 to n
  2d_point ax,ay
  j=j+1:mx(j)=ax:my(j)=ay:td(j)=sr
  ax=ax+1*cos(ad) : ay=ay+1*sin(ad) : ad=ad+sr/ray
next i
j=j+1: mx(j)=ax:my(j)=ay:td(j)=sr : x=ax:y=ay
END_SUB

rem ===================================
SUB rot(th)
dim_local cs,ss
th=(360-th)*rad : cs=cos(th): ss=sin(th)
px=x*cs-y*ss : py=x*ss+y*cs
x=px: y=py
END_SUB

rem ===================================
SUB echel(e)
x=x*e: y=y*e
END_SUB
Revenir en haut Aller en bas
Parpaiun

Parpaiun


Nombre de messages : 192
Age : 85
Localisation : HERAULT
Date d'inscription : 15/04/2015

Une autre merveille Empty
MessageSujet: Une autre merveille   Une autre merveille EmptyDim 3 Mai 2015 - 0:41

Jicehel ta dernière modification de mon programme ne me plait pas . Pourquoi ? Parce que je
trouve la couleur rouge de la rosace trop agressive, à croire qu'un taureau va foncer immanquablement dessus! Désolé!

Si tu veux , mets y une couleur plus douce, verte ou orange par exemple. J'aurais préféré que ce soit multicolore genre couleurs qui ne se rencontrent jamais. Il paraît que c'est un bon exercice maintes fois proposé dans des articles je ne me rappelle plus où.

Merci Jicehel ! affraid

Revenir en haut Aller en bas
Jicehel

Jicehel


Nombre de messages : 5947
Age : 52
Localisation : 77500
Date d'inscription : 18/04/2011

Une autre merveille Empty
MessageSujet: Re: Une autre merveille   Une autre merveille EmptyDim 3 Mai 2015 - 11:09

je n'ai pas réussi à faire un truc simple, il faudrait un matheux ... là ce n'est pas mon domaine (Papydall peut être ?)
Bon en attendant, je te mets une version avec un peu de rose et de couleurs différentes mais bon ce n'est pas ce que tu demandais
Code:
rem xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
rem Rosace à entrelacs
rem Une figure inédite tirée d un bouquin de géométrie
rem
rem Auteur:Yves Blacher
rem Date-version: 02/05/2015
rem xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
rem
dim ang,dx,dy,i,k,px,py,th,x,y
dim pi  : pi=atn(1)*4
dim rad : rad=pi/180
dim n : n=794
dim mx(n),my(n),td(n)
dim cx,cy,j : cx=150:cy=300 : j=1

color 0,255,128,128 : caption 0,"ROSACE A ENTRELACS" : 2d_pen_color 255,0,0

mx(j)=cx: my(j)=cy : droite(cx,cy,10,0,0) : arc(x,y,50,17,70,-1) : arc(x,y,100,7.5,345,1)
px=x:py=y : arc(px,py,50,23.5,70,-1) : arc(px,py,50,19,335,1)    : arc(x,y,60,20,56,-1)
px=x:py=y : arc(px,py,50,36,335,1)  : arc(px,py,60,29,73,-1)    : arc(x,y,100,21,345,1)
px=x:py=y : arc(px,py,143,19,82,-1)  : arc(px,py,138,18.5,323,1) : arc(x,y,153,21,62,-1)
px=x:py=y : arc(px,py,230,18,320,1)  : arc(px,py,153,26,81,-1)  : arc(x,y,240,19,340.5,1)
px=x:py=y : arc(px,py,175,34,80,-1)  : arc(px,py,240,26,321,1)

rem xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
rem Traitement des rotations
2d_clear : 2d_pen_color 128,0,0
for th = 0 to 405 step 45
  for i=1 to j
    x=cx-mx(i): y=cy-my(i) : rot(th)
    echel(0.7)
    2d_point 240+x,230+y
    if scancode=27 then th=380 : exit_for
  next i
  for i = 0 to 12
    x=i*12 + 15 : y = 0 : rot(th)
    2d_flood 240 + x, 230 - y , (i*12+64) , i*5, i*5
    2d_flood 240 - x, 230 + y , (i*12+64) , i*5, i*5
  next i
next th

2d_flood 10,10,0,0,0

END
rem xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

rem ==================================
SUB droite(dx,dy,ld,da,ot)
da=da*rad
for i=1 to ld
  dx=dx+1*cos(da) :  dy=dy-1*sin(da)
  j=j+1: mx(j)=dx: my(j)=dy: td(j)= ot
next i
x=dx: y=dy
END_SUB

rem ==================================
SUB arc(ax,ay,ray,al,ad,sr)
n=int(0.5+ray*(al*rad)) : ad=(360-ad)*rad
for i=1 to n
  2d_point ax,ay
  j=j+1:mx(j)=ax:my(j)=ay:td(j)=sr
  ax=ax+1*cos(ad) : ay=ay+1*sin(ad) : ad=ad+sr/ray
next i
j=j+1: mx(j)=ax:my(j)=ay:td(j)=sr : x=ax:y=ay
END_SUB

rem ===================================
SUB rot(th)
dim_local cs,ss
th=(360-th)*rad : cs=cos(th): ss=sin(th)
px=x*cs-y*ss : py=x*ss+y*cs
x=px: y=py
END_SUB

rem ===================================
SUB echel(e)
x=x*e: y=y*e
END_SUB
Revenir en haut Aller en bas
Contenu sponsorisé





Une autre merveille Empty
MessageSujet: Re: Une autre merveille   Une autre merveille Empty

Revenir en haut Aller en bas
 
Une autre merveille
Revenir en haut 
Page 1 sur 1
 Sujets similaires
-
» Début d'un autre IDE
» RichEditFunction
» Utilisation de PLAY
» Centrer une fenetre à l'écran
» Autre bordure

Permission de ce forum:Vous ne pouvez pas répondre aux sujets dans ce forum
FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC :: PANORAMIC :: Les inutilitaires-
Sauter vers: