EVOLUTION DE VEGETAUX : LINDENMEYER-SYSTEMS

par **Papydall-Admin** 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% 2d_pen_color 0,255,0 : 2d_line xm,ym,xm,ym+50 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 ============================================================================

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