L-System (ou système de Lindenmayer)

rem ============================================================================
rem                L-System
rem ============================================================================
rem Un L-System (ou système de Lindenmayer) est un système de réécriture
rem permettant de générer des chaînes de caractères à partir de règles.
rem Un L-System a deux composantes principales :
rem 1) une chaîne de départ ou axiome
rem 2) au moins une règle de réécriture ou dérivation
rem Les règles décrivent comment faire évoluer, par réécriture, la chaîne de
rem départ pour en obtenir une nouvelle, généralement plus longue (très longue).
rem ============================================================================
rem Interprétation:
rem Une chaîne de caractères produite par un L-System peut être interprétée
rem comme une séquence d’instructions de dessin.
rem Par exemple, on peut attribuer la signification suivante aux caractères
rem F, - et + apparaissant dans l’exemple ci-dessus :
rem le caractère F signifie : dessiner un trait dans la direction courante,
rem le caractère - signifie : tourner à gauche d’un angle défini au depart en °,
rem le caractère + signifie : tourner à droite d’un angle défini au départ en °.
rem ============================================================================
rem En admettant que la direction initiale soit de 0°, donc vers l’est de l’écran
rem et l’angle vaut 60°,
rem la chaîne F-F++F-F s’interprète ainsi :
rem 1) dessiner un trait (F) pour Forward (c.à.d Avancer)
rem 2) tourner d’un angle de 60° vers la gauche (-), c-à-d en direction du nord-est,
rem 3) dessiner un trait (F),
rem 4) tourner de 120° vers la droite (++), c-à-d en direction du sud-est,
rem 5) dessiner un trait (F),
rem 6) tourner de 60° vers la gauche (-), c-à-d en direction de l’est,
rem 7) dessiner un trait (F).

rem En suivant ces instructions, on obtient la figure suivante :

rem        _/\_

rem C’est la courbe de Koch après 1 évolution.
rem En faisant évoluer ce L-System trois fois encore, on obtient une chaîne qui,
rem interprétée, produit  une fractale connue sous le nom de courbe de Koch 
rem ============================================================================
rem Les symbols les plus utilisés sont les suivants:
rem
rem F : Se déplacer d’un pas unitaire.
rem f : Se déplcer d’un pas unitaire comme pour F mais sans laisser de trace
rem G : Reculer d’un pas unitaire
rem + : Tourner à droite d’un angle a.
rem - : Tourner à gauche d’un angle a.
rem [ : Sauvegarder la position courante.
rem ] : Restaurer la dernière position sauvée.
rem | : Tourner de 180°
rem
rem D’autres symboles peuvent être ajoutés pour gérer la couleur ou l’épaisseur
rem du tracé ou autre chose.
rem Ce programme implémente seulement les 8 symboles indiqués ci-haut, ce qui est
rem amplement suffisant pour obtenir des beaux dessins.
rem ============================================================================
rem Exemple (voir la courbe N° 4 du choix : Quadratic Koch Island
rem Considérons une chaine de caractères initiale (appelée axiome): F+F+F+F
rem Et une règle de réécriture ou de remplacement: F --> F+F-F-FF+F+F-F
rem Après une seule itération, on obtient la chaine suivante sans parenthèses:
rem (F+F-F-FF+F+F-F) + (F+F-F-FF+F+F-F) + (F+F-F-FF+F+F-F) + (F+F-F-FF+F+F-F)
rem La deuxième itération nous donne la chaine suivante:
rem F+ F-F-FF+ F+ F-F+ F+ F-F-FF+ F+ F-F-F+ F-F-FF+ F+ F-F-F+ F-F-FF+ F+ F-FF+
rem F-F-FF+ F+ F-F+ F+ F-F-FF+ F+ F-F+ F+ F-F-FF+ F+ F-F-F+ F-F-FF+ F+ F-F+ F+
rem F-F-FF+ F+ F-F+ F+ F-F-FF+ F+ F-F-F+ F-F-FF+ F+ F-F-F+ F-F-FF+ F+ F-FF+
rem F-F-FF+ F+ F-F+ F+ F-F-FF+ F+ F-F+ F+ F-F-FF+ F+ F-F-F+ F-F-FF+ F+ F-F+ F+
rem F-F-FF+ F+ F-F+ F+ F-F-FF+ F+ F-F-F+ F-F-FF+ F+ F-F-F+ F-F-FF+ F+ F-FF+
rem F-F-FF+ F+ F-F+ F+ F-F-FF+ F+ F-F+ F+ F-F-FF+ F+ F-F-F+ F-F-FF+ F+ F-F+ F+
rem F-F-FF+ F+ F-F+ F+ F-F-FF+ F+ F-F-F+ F-F-FF+ F+ F-F-F+ F-F-FF+ F+ F-FF+
rem F-F-FF+ F+ F-F+ F+ F-F-FF+ F+ F-F+ F+ F-F-FF+ F+ F-F-F+ F-F-FF+ F+ F-F
rem Remarquez que la chaine résultante croit très rapidement et risque de devenir
rem très longue.
rem Dans le programme j’ai prévu pour les symboles [ et ] (sauvegarde et restauration
rem de la position une pile pour 100 000 positions; c’est peut-être beaucoup trop
rem mais ça évitera le désagréable message d’erreur : index overflow
rem ============================================================================
rem Le programme vous propose pas moins de 27 choix de courbes
rem ============================================================================
rem &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
rem ============================================================================
 
dim x,y,theta,angle,distance,i,axiome$,regle$,evolution,lsystem$,niveau
dim pile : pile = 100000  
dim whereX(pile),whereY(pile),cap(pile)
label choix

width 0,1000 : height 0,700
picture 10 : width 10,700 : height 10,600 : 2d_target_is 10 : 2d_pen_color 255,255,255
' 2d_pen_width 2
container_option 20 : top 20,10 : left 20,width(10)+20 : width 20,250 : height 20,590
font_bold 20 : caption 20, "Faites votre choix !"
option 30  : caption 30,"Courbe de Koch"
option 40  : caption 40,"Courbe de Koch avec angles droits"
option 50  : caption 50,"Flocon de Koch"
option 60  : caption 60,"Quadratic Koch Island"
option 70  : caption 70,"Triangle de Sierpinski"
option 80  : caption 80,"Courbe de Lévy"
option 90  : caption 90,"Courbe de Peano"
option 100 : caption 100,"Courbe de Penrose"
option 110 : caption 110,"Courbe Carrée"
option 120 : caption 120,"Courbe Triangle"
option 130 : caption 130,"Crystal"
option 140 : caption 140,"Quadratic Snowflake I"
option 150 : caption 150,"Quadratic Snowflake II"
option 160 : caption 160,"Plaque"
option 170 : caption 170,"Levy II"
option 180 : caption 180,"Rings"
option 190 : caption 190,"Courbe de Koch II"
option 200 : caption 200,"Plante I"
option 210 : caption 210,"Plante II"
option 220 : caption 220,"Plante III"
option 230 : caption 230,"Plante IV"
option 240 : caption 240,"test 1"
option 250 : caption 250,"Plante V"
option 260 : caption 260,"Plante VI"
option 270 : caption 270,"Cactus"
option 280 : caption 280,"Brindille"
option 290 : caption 290,"Pentigree"

for i = 30 to 290 step 10
    parent i,20 : top i,2*i-30 : left i,10 : width i,230 : on_click i,choix
next i
button 900 : top 900,height(0)-80 : left 900,width(10)+80 : caption 900,"Quitter"
on_click 900,choix
alpha 999 : top 999,height(0)-80 : left 999,20 : font_bold 999
font_name 999,"Arial" : font_color 999,255,0,0 : font_size 999,12
caption 999,"Papydall vous propose des Fractales tracées par L-System (Système de Lindenmayer)"

degrees

end
rem ============================================================================
Choix:
    select number_click
        case  30 : Koch()
        case  40 : Koch_Droit()
        case  50 : Flocon_Koch()
        case  60 : Koch_Island()
        case  70 : Sierpinski_Triangle()
        case  80 : Levy()
        case  90 : Peano()
        case 100 : Penrose()
        case 110 : Carree()
        case 120 : Triangle()
        case 130 : Crystal()
        case 140 : Snowflake_1()
        case 150 : Snowflake_2()
        case 160 : Plaque()
        case 170 : Levy_2()
        case 180 : Rings()
        case 190 : Courbe_Koch_Droit_II()
        case 200 : Plante_I()
        case 210 : plante_II()
        case 220 : plante_III()
        case 230 : plante_IV()
        case 240 : test1()
        case 250 : Plante_V()
        case 260 : Plante_VI()
        case 270 : Cactus()
        case 280 : Brindille()
        case 290 : Pentigree()
        
        case 900 : terminate
    end_select
    lsystem$ = Generer_Chaine$(axiome$,regle$,evolution)
    Dessiner(lsystem$)
return
rem ============================================================================
SUB Koch()
    caption 0,"Courbe de Koch"
    axiome$ =  "F"
    regle$ = "F-F++F-F"
    evolution = 4 : distance = 20/evolution
    x = 100 : y = 400 : angle = 60  : theta = 0
END_SUB
rem ============================================================================
SUB Flocon_Koch()
    caption 0,"Courbe de Flocon de Koch : Tracé en cours ..."
    axiome$ = "F++F++F++"
    regle$ = "F-F++F-F"
    evolution = 4 : distance = 20/evolution
    x = 100 : y = 200 : angle = 60  : theta = 0
END_SUB
rem ============================================================================
SUB Koch_Droit()
    caption 0,"Courbe de Koch à angles droits : Tracé en cours ..."
    axiome$ = "F"
    regle$ = "F+F-F-F+F"
    evolution = 5 : distance = 10/evolution
    x = 500 : y = 100 : angle = 90 : theta = angle
END_SUB
rem ============================================================================
SUB Koch_Island()
    caption 0,"Courbe de Koch Island : Tracé en cours ..."
    axiome$ = "F+F+F+F"
    regle$ = "F+F-F-FF+F+F-F"
    evolution = 3 : distance = 12/evolution
    x = 200 : y = 200 : angle = 90 : theta = 0
END_SUB
rem ============================================================================
SUB Sierpinski_Triangle()
    caption 0,"Triangle de Sierpinski : Tracé en cours ..."
    axiome$ = "F"
    regle$ = "F+F-F-F+F"
    evolution = 6 : distance = 50/evolution
    x = 100 : y = 100 : angle = 120 : theta = 0
END_SUB
rem ============================================================================
SUB Peano()
    caption 0,"Courbe de Peano : Tracé en cours ..."
    axiome$ = "F-F-F-F"
    regle$ = "F-F+F+F+F-F-F-F+F"
    evolution = 3 : distance = 30/evolution
    x = 200 : y = 450 : angle = 90 : theta = 0
END_SUB
rem ============================================================================
SUB Penrose()
    caption 0,"Courbe de Penrose : Tracé en cours ..."
    axiome$ = "F----F----F----F----F"
    regle$ = "F----F----F----------F++F----F"
    evolution = 4 : distance = 28/evolution
    x = 200 : y = 550 : angle = 18 : theta = 0
END_SUB
rem ============================================================================
SUB Levy()
    caption 0,"Courbe de Lévy : Tracé en cours ..."
    axiome$ = "F"
    regle$ = "+F--F+"
    evolution = 14 : distance = 28/evolution
    x = 200 : y = 150 : angle = 45 : theta = 0
END_SUB
rem ============================================================================
SUB Carree()
    caption 0,"Courbe carrée : Tracé en cours ..."
    axiome$ = "F+F+F+F"
    regle$ = "FF+F-F+F+FF"
    evolution = 3 : distance = 60/evolution
    x = 500 : y = 400 : angle = 90 : theta = 0
END_SUB
rem ============================================================================
SUB Triangle()
    caption 0,"Courbe Triangle : Tracé en cours ..."
    axiome$ = "F+F+F"
    regle$ = "F-F+F"
    evolution = 8 : distance = 40/evolution
    x = 600 : y = 150 : angle = 120 : theta = 0
END_SUB
rem ============================================================================
SUB Crystal()
    caption 0,"Crystal : Tracé en cours ..."
    axiome$ = "F+F+F+F"
    regle$ = "FF+F++F+F"
    evolution = 5 : distance = 10/evolution
    x = 100 : y = 50 : angle = 90 : theta = 0
END_SUB
rem ============================================================================
SUB Snowflake_1()
    caption 0,"Quadratic Snowflake : Tracé en cours ..."
    axiome$ = "F"
    regle$ = "F-F+F+F-F"
    evolution = 5 : distance = 14/evolution
    x = 5 : y = 400 : angle = 90 : theta = 0
END_SUB
rem ============================================================================
SUB Snowflake_2()
    caption 0,"Quadratic Snowflake II : Tracé en cours ..."
    axiome$ = "FF+FF+FF+FF"
    regle$ = "F+F-F-F+F"
    evolution = 5 : distance = 5/evolution
    x = 150 : y = 50 : angle = 90 : theta = 0
END_SUB
rem ============================================================================
SUB Plaque()
    caption 0,"Plaque : Tracé en cours ..."
    axiome$ = "F+F+F+F"
    regle$ = "FF+F+F+F+FF"
    evolution = 5 : distance = 10/evolution
    x = 100 : y = 50 : angle = 90 : theta = 0
END_SUB
rem ============================================================================
SUB Levy_2()
    caption 0,"Levy II : Tracé en cours ..."
    axiome$ = "F"
    regle$ = "-F++F-"
    evolution = 12 : distance = 50/evolution
    x = 250 : y = 400 : angle = 45 : theta = 0
END_SUB
rem ============================================================================
SUB Rings()
    caption 0,"Rings : Tracé en cours ..."
    axiome$ = "F+F+F+F"
    regle$ = "FF+F+F+F+F+F-F"
    evolution = 4 : distance = 16/evolution
    x = 480 : y = 50 : angle = 90 : theta = 0
END_SUB
rem ============================================================================
SUB Courbe_Koch_Droit_II()
    caption 0,"Courbe de Koch II : Tracé en cours ..."
    axiome$ = "F"
    regle$ = "F+F-F-F+F"
    evolution = 5 : distance = 15/evolution
    x = 0 : y = 200 : angle = 90  : theta = 0
END_SUB
rem ============================================================================
SUB Plante_I()
    caption 0,"Plante I : Tracé en cours ..."
    axiome$ = "F"
    regle$ = "F[+F]F[-F][F]"
    evolution = 5 : distance = 30/evolution
    x = 300 : y = 600 : angle = 24 : theta = 270
    2d_pen_color 0,127,0
END_SUB
rem ============================================================================
SUB Plante_II()
    caption 0,"Plante II : Tracé en cours ..."
    axiome$ = "F"
    regle$ = "[-F+F]FF[+FF]"
    evolution = 5 : distance = 30/evolution
    x = 300 : y = 500 : angle = 24 : theta = 270
    2d_pen_color 0,127,0
END_SUB
rem ============================================================================
SUB Plante_III()
    caption 0,"Plante III : Tracé en cours ..."
    axiome$ = "F"
    regle$ = "FF[+FF][-FF]"
    evolution = 5 : distance = 30/evolution
    x = 300 : y = 600 : angle = 18 : theta = 270
    2d_pen_color 0,127,0
END_SUB
rem ============================================================================
 SUB Plante_IV()
    caption 0,"Plante IV : Tracé en cours ..."
    axiome$ = "F"
    regle$ = "FF-[-F+F]+[+F-F]"
    evolution = 5 : distance = 30/evolution
    x = 300 : y = 600 : angle = 24 : theta = 270
    2d_pen_color 0,127,0
END_SUB
rem ============================================================================
SUB test1()
    caption 0,"test1 : Tracé en cours ..."
    axiome$ = "F"
    regle$ = "F+F-F-FF+F+F+F-F"
    evolution = 5 : distance = 20/evolution
    x = 500 : y = 550 : angle = 90 : theta = angle
END_SUB
rem ============================================================================
SUB Plante_V()
    caption 0,"Plante V : Tracé en cours ..."
    axiome$ = "F"
    regle$ = "FF-[-F+F+F]+[+F-F-F]"
    evolution = 5 : distance = 25/evolution
    x = 400 : y = 600 : angle = 360/16 : theta = 270
    2d_pen_color 0,127,0
END_SUB
rem ============================================================================
SUB Plante_VI()
    caption 0,"Plante VI : Tracé en cours ... "
    axiome$ = "F"
    regle$ = "F[-F]F[+F][F]"
    evolution = 6 : distance = 25/evolution
    x = 400 : y = 600 : angle = 65 : theta = -90
    2d_pen_color 0,127,0
END_SUB
rem ============================================================================
SUB Cactus()
    caption 0,"Cactus : Tracé en cours ..."
    axiome$ = "F"
    regle$ = "FF[+F-F]FF[-F+F]FF"
    evolution = 3 : distance = 3/evolution
    x = 400 : y = 550 : angle = -90 : theta = angle
    2d_pen_color 0,127,0  
END_SUB
rem ============================================================================
SUB Brindille()
    caption 0,"Brindille : Tracé en cours ..."
    axiome$ = "F"
    regle$ = "F[-F]F[+F]F"
    evolution = 4 : distance = 20/evolution
    x = 400 : y = 600 : angle = -35 : theta = 270
    2d_pen_color 0,127,0
END_SUB
rem ============================================================================
SUB Pentigree()
    caption 0,"Pentigree : Tracé en cours ..."
    axiome$ = "F-F-F-F-F"
    regle$ = "F-F++F+F-F-F"
    evolution = 5 : distance = 10/evolution
    x = 500 : y = 100 : angle = 72 : theta = 0
    2d_pen_color 0,127,0
END_SUB
rem ============================================================================
rem &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
rem ============================================================================
' Cette fonction fait évoluer la chaine de départ donnée par la chaine axiome$
' selon les indications de la chaine regle$ et retourne comme résultat une
' chaine finale$ contenant le L-System
FNC Generer_Chaine$(axiome$,regle$,evolution)
    dim_local i,j,tmp$,finale$ ,c$
    finale$ = axiome$
    for j = 1 to evolution
        tmp$ = ""  
        for i = 1 to len(finale$)
            c$ = mid$(finale$,i,1)
            if c$ = "F"
               tmp$ = tmp$ + regle$
            else
               tmp$ = tmp$ + c$
            end_if
        next i
        finale$ =  tmp$
    next j
    result finale$
END_FNC
rem ============================================================================
' Tourner de angle °
' Si angle > 0 tourner à droite
' Sinon tourner à gauche
' Cette procédure modifie donc le cap du tracé
SUB Turn(angle)
    theta = wrap_value(theta + angle)
END_SUB
rem ============================================================================
' Tracer un trait de longueur distance dans la direction du cap sauvegardé dans
' la variable globale theta
' Cette procédure modifie les coordonnées du curseur graphique (x,y)
SUB Forward(distance)
    dim_local x1,y1
    x1 = x + distance * cos(theta)
    y1 = y + distance * sin(theta)
    2d_poly_to x1,y1
    x = x1 : y = y1
END_SUB
rem ============================================================================
' Cette procédure sanvegarde (empile) l'état actuel du curseur graphique :
' coordonnées x,y et l'angle du cap theta
SUB Push()
    niveau = niveau + 1
    whereX(niveau) = x
    whereY(niveau) = y
    cap(niveau) = theta
END_SUB
rem ============================================================================
' Cette procédure restaure (dépile) le précédent état du curseur graphique :
' coordonnées x,y et l'angle du cap theta
SUB Pop()
    x = whereX(niveau)
    y = whereY(niveau)    
    theta = cap(niveau)
    niveau = niveau -1
    2d_poly_from x,y
    
END_SUB
rem ============================================================================
' Interpréter la chaine lsystem$ obtenue par la fonction :
' Generer_Chaine$(axiome$,regle$,evolution)
SUB Dessiner(lsystem$)
    dim_local i,c$,s$
    s$ = lsystem$
    inactive 20  : ' inactiver les options
                   ' pour obliger M. Bourrin à attendre la fin du tracé en cours
                   ' avant d'entamer un autre
    color 10,0,0,0
    2d_poly_from x,y
    for i = 1 to len(lsystem$)
        c$ = mid$(s$,i,1)
        select asc(c$)
            case 70 : Forward(distance)    : ' F pour avancer
            case 71 : Forward(0-distance)  : ' G pour reculer
            case 43 : Turn(angle)          : ' + pour tourner à droite
            case 45 : Turn(0-angle)        : ' - pour touner à gauche
            case 91 : Push()               : ' [ pour empiler
            case 93 : Pop()                : ' ] pour dépiler
            case 102 : 2d_poly_from x,y    : ' f pour avancer sans laisser de trace
            case 124 : angle = angle + 180 : ' | pour faire demi-tour, tourner de 180°
        end_select
        display
    next i
    caption 0,"Terminé"
    active 20 : ' réactiver les options pour un éventuel nouveau tracé
END_SUB
rem ============================================================================
rem &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
rem ============================================================================