Forum de Programmation en langage PANORAMIC
Rechercher
 
 

Résultats par :
 


Rechercher Recherche avancée

Mots-clés

Panoramic  Moiré  esthetique  fougère  

Derniers sujets
»  Exemple de menu
Lun 26 Juin - 22:36 par Admin

» Utilisation du caractère Ampersand (&) dans un caption
Lun 26 Juin - 22:32 par Admin

» TRIGONOMETRIE CIRCULAIRE ET HYPERBOLIQUE
Ven 23 Juin - 0:59 par Admin

» RECHERCHE DICHOTOMIQUE DANS UN TABLEAU TRIE
Ven 23 Juin - 0:46 par Admin

» Table de multiplication
Ven 23 Juin - 0:44 par Admin

» Quelle heure est-il ?
Mar 20 Juin - 3:32 par Admin

» Fonctions de la user32.dll
Dim 18 Juin - 14:56 par Admin

»  Biomorphes de PICKOVER
Dim 18 Juin - 0:35 par Admin

» En moins de 10 lignes de code : Effet spectaculaire !
Ven 16 Juin - 2:13 par Admin

Juin 2017
LunMarMerJeuVenSamDim
   1234
567891011
12131415161718
19202122232425
2627282930  

Calendrier Calendrier


EVOLUTION DE VEGETAUX : LINDENMEYER-SYSTEMS

Voir le sujet précédent Voir le sujet suivant Aller en bas

EVOLUTION DE VEGETAUX : LINDENMEYER-SYSTEMS

Message par Admin le Jeu 13 Oct - 14:06

Code:

rem ============================================================================
rem           EVOLUTION DE VEGETAUX
rem               PAR PAPYDALL
rem  Par la méthode des L-systèmes : LINDENMEYER-SYSTEMS
rem ============================================================================
Init()
Principe()
end
rem ============================================================================
SUB Init()
    dim xm,ym,NumCh%,Lp%,ram%,r,i%,L$,L0princ%,Lgprinc%,L1princ%
    dim ch$(20),L0%(20),L1%(20),xn(200),yn(200),a(200)
    dim princ$(8),NbEvol%(8), AngRamDeg(8),f(8)
    dim Long%,plus$ ,Lch% ,n%, c , L ,x, y
    dim angle, pasmax, dpas,ramax%,nb%,pas,noeud%,rf,h%
    dim aleat
    full_space 0 : color 0,0,50,100 : soleil()
    xm = width(0)-100 : ym = height(0)-100
    caption 0 , " CROISSANCE DE VEGETAUX    PAR  PAPYDALL ...... <CLICK> pour arrêter"

END_SUB
rem ============================================================================
SUB Principe()
    dim_local i

    princ$(1) = "1440316030366031403031140360310" : NbEvol%(1) = 6  : AngRamDeg(1) = 25 : f(1) = 55
    princ$(2) = "1415030361503031140360310"       : NbEvol%(2) = 15 : AngRamDeg(2) = 16 : f(2) = 28
    princ$(3) = "140360310"                       : NbEvol%(3) = 7  : AngRamDeg(3) = 20 : f(3) = 6
    princ$(4) = "14031603140310"                  : NbEvol%(4) = 6  : AngRamDeg(4) = 20 : f(4) = 10
    princ$(5) = "1403603140360310"                : NbEvol%(5) = 6  : AngRamDeg(5) = 25 : f(5) = 27
    princ$(6) = "14036031403160310"               : NbEvol%(6) = 6  : AngRamDeg(6) = 25 : f(6) = 24
    princ$(7) = "1603140316031503140310"          : NbEvol%(7) = 5  : AngRamDeg(7) = 36 : f(7) = 18
    princ$(8) = "150316031403160340310"           : NbEvol%(8) = 5  : AngRamDeg(8) = 29 : f(8) = 16
    for i = 1 to 8 : AngRamDeg(i) = AngRamDeg(i) * pi / 180 : next i
    repeat
        L0princ% = 0 : L1princ% = 0  : Lgprinc% = 0
        for i = 1 to 20 : L0%(i) = 0 : L1%(i) = 0 : ch$(i) = "" : next i
        ch$(1) = "0" : L0%(1) = 1 : L1%(1) = 0
        aleat = int(1+rnd(8)) : Verification(princ$(aleat))
        Evolution(aleat)  : Dessin(aleat)
    until scancode <> 0
END_SUB
rem ============================================================================
SUB Evolution(num)
    for NumCh% = 1 to (NbEvol%(num) - 1)
        Long% = 0
        for i% = 1 to len(ch$(NumCh%))
            L$ = mid$(ch$(NumCh%),i%,1)
            if L$ = "0"
               plus$ = princ$(num)
               L0%(NumCh% + 1) = L0%(NumCh% + 1) + L0princ%
               L1%(NumCh% + 1) = L1%(NumCh% + 1) + L1princ%
               if ram% <>  0 then long% = long%  + lgprinc%
            end_if
            if L$ = "1"
               plus$ = "11"
               L1%(NumCh% + 1) = L1%(NumCh% + 1) + 2
               if ram% = 0  then Long% = Long% + 2
            end_if
            if L$ = "5"
               plus$ = str$(int(rnd(2)+2)*2)
               ram% = ram% + 1
            end_if
            if L$ = "3"
               if ram% > ramax%
                  ramax% = ram%
               end_if
               ram% = ram% - 1
               plus$ = "3"
           end_if
           if (L$ = "4") or (L$ = "6")
              plus$ = L$
             ram% = ram% + 1
           end_if
           ch$(NumCh% + 1) = ch$(NumCh% + 1) + plus$
        next i%
    if NumCh% < (NbEvol%(num) - 1) then erreur(num)
    next NumCh%

END_SUB
rem ============================================================================
SUB Dessin(i)
    xm = int(rnd(width(0)-200)+100) : ym = height(0)-int(rnd(200))-100
    angle = pi/2 : pasmax = ym*f(i)/long% : dpas = (pasmax/3)/ramax%
    for NumCh% = 1 to NbEvol%(i)
        y = ym  : x = xm
        for i% = 1 to len(ch$(NumCh%))
            nb% = val(mid$(ch$(NumCh%),i%,1))
            pas = pasmax - noeud% * dpas : rf = pas/8
            select nb%+1
                case 1 : fleur()
                case 2 : tige()
                case 3 :'   rien
                case 4 : fermer()
                case 5 : ouvrir(i)
                case 6 : hasard(i)
                case 7 : ouvrir(i)
            end_select
            if scancode <> 0 then caption 0, "Programme arrêté par l'utilisateur" : end
        next i%
    next NumCh%

END_SUB
rem ============================================================================
SUB Verification(princip$)
    repeat
       Lp% = len(princip$)
       ram% = 0 : r = 0
       for i% = 1 to Lp%
           L$ = mid$(princip$,i%,1)
           if L$ = "0"
              L0princ% = L0princ% + 1
              if ram% = 0
                 Lgprinc% = Lgprinc% + 1
              end_if
           else
              if L$ = "1"
                 L1princ% = L1princ% + 1
                 if ram% = 0
                    Lgprinc% = Lgprinc% + 1
                 end_if
              else
                 if L$ = "3"
                    ram% = ram% - 1
                 else
                    if (L$ = "4") or (L$ = "6") or (L$ = "5")
                       ram% = ram% + 1
                    else
                       R = 1
                    end_if
                 end_if
              end_if
           end_if
       next i%
    until (R < 1) and (ram% = 0)
END_SUB
rem ============================================================================
SUB Erreur(i)
    dim_local t$
    Lch% = len(ch$(NumCh% + 1))+ L1%(NumCh% + 1)+ L0%(NumCh% + 1)*(Lp% - 1)
    if Lch% > 32767
    '   t$ = "  La chaîne à traiter est trop longue." + chr$(13)
    '   t$ = t$ + "  Vous serez limité à la géneration n° "  + str$(NumCh% + 1)
    '   message t$
       n% = NumCh% + 1 : NumCh% = NbEvol%(i) : NbEvol%(i) = n%
   end_if
END_SUB
rem ============================================================================

SUB Tige()
    c = x : L = y : x = x + pas * cos(angle) : y = y - pas * sin(angle)
    2d_pen_color 0,255,0 : 2d_line c,l,x,y
END_SUB
rem ============================================================================

SUB Fleur()
    pas = pas - (2*rf) : tige()
    c = x + rf * cos(angle) : L = y - rf * sin(angle)
    2d_pen_color 255,0,0 : 2d_circle c, L, rf+1
END_SUB
rem ============================================================================

SUB Ouvrir(i)
    noeud% = noeud% + 1 : a(noeud%) = angle : xn(noeud%) = x : yn(noeud%) = y
    angle = angle + (5 - nb%) * AngRamDeg(i)
END_SUB
rem ============================================================================

SUB Hasard(i)
    Ouvrir(i)
    h% = rnd(2) + 1
    if h% = 2
       angle = angle + AngRamDeg(i)
    else
       angle = angle - AngRamDeg(i)
    end_if
END_SUB
rem ============================================================================

SUB Fermer()
    x = xn(noeud%) : y = yn(noeud%) : angle = a(noeud%) : noeud% = noeud% - 1
END_SUB
rem ============================================================================

SUB Soleil()
    x = 30 +rnd(width(0)-10) : y = 30 + rnd(100)
    2d_fill_color 255,255,0 : 2d_circle x,y,20
END_SUB
rem ============================================================================

_________________
Invité, merci d'être passé par ici.
avatar
Admin
Admin

Messages : 58
Date d'inscription : 08/09/2015
Age : 66
Localisation : MOKNINE (Tunisie)

Voir le profil de l'utilisateur http://papydall-panoramic.forumarabia.com

Revenir en haut Aller en bas

Voir le sujet précédent Voir le sujet suivant Revenir en haut

- Sujets similaires

 
Permission de ce forum:
Vous ne pouvez pas répondre aux sujets dans ce forum