Démo dédicacé à Papydall

' ******************************************************************************
'                  Julia.bas par Papydall
' ******************************************************************************
Run()
end
' ******************************************************************************
SUB Run()
    label fin
    dim ec,x0,y0,xp0,yp0,Nxp,Nyp
    caption 0,"Tracé de la fractale de Julia en cours ... Veuillez patienter ... <CLICK> pour arrêter"
    ec = 400 : width 0, 2*ec+20 : color 0,0,0,0
' Essayez ces differents paramètres pour d'autres ensembles de Julia
    x0 = 0 : y0 = 0 : xp0 = .36237 : yp0 = .32
'    x0 = 0 : y0 = 0 : xp0 = .3 : yp0 = .5
'    x0 = 0-.5 : y0 = 0 : xp0 = .285 : yp0 = .013
'    x0 = 0-.5 : y0 = 0 : xp0 = .3 : yp0 = 0 -.49
'    x0 = 0-.5 : y0 = 0 : xp0 = .285 : yp0 = .01
'    x0 = .5 : y0 = .123 : xp0 = .3777 : yp0 = .123456
'    x0 = 0-.5 : y0 = .0123 : xp0 = .3456789 : yp0 = 0-.423456789

    Nxp = (xp0 - x0) * ec  / 4 + ec / 2 : Nyp = (y0 - yp0) * ec  / 4 + ec / 2
    alpha 1 : top 1,420 :left 1,100 : font_color 1,255,255,0 : font_bold 1
    color 1,255,0,0 : font_size 1,10 : caption 1," Fractale en Couleur "
    alpha 2 : top 2,420 :left 2,600 : font_color 2,255,255,0 : font_bold 2
    color 2,255,0,0 : font_size 2,10 : caption 2," Fractale en Noir "
    display : Julia(Nxp,Nyp) : caption 0,"Terminé"
END_SUB
' *****************************************************************************
' Tracé de la fractale ; optimisation du tracé par la symétrie
SUB Julia(Nxp, Nyp)
    dim_local cx,cy,x,y,xn,yn,modul ,nx,ny,Nb_iter
    cx = x0 + 4 / ec * (Nxp - ec / 2) : cy = y0 - 4 / ec * (Nyp - ec / 2)
    FOR Nx = 1 TO ec
        FOR Ny = 1 TO Nx
            X = 3 / ec * (Nx - ec / 2) : Y =  -3 / ec * (Ny - ec / 2)
' Diminuer le nombre d'itérations accélère le tracé mais on perd en netteté !
' Augmenter le nombre d'itérations donne une image plus nette, plus detaillée
' Mais le temps de calcul sera plus long.
            FOR Nb_iter = 1 TO 150
                xn = X*X - Y*Y + cx : yn = 2*X*Y + cy
                modul = SQR((x-xn)*(x-xn) + (y-yn)*(y-yn)) : X = xn : Y = yn
                IF SQR(xn * xn + yn * yn) > 2
                  2d_pen_color 50,150,150
                  2d_point Nx, Ny : 2d_point ec - Nx + 1, ec - Ny + 1
                  2d_point ec + nx, Ny : 2d_point 2*ec - Nx +1, ec -Ny + 1
                  GOTO fin
                END_IF
            NEXT Nb_iter
            IF modul >= 2  THEN 2d_pen_color 0,0,0
            IF modul < 2    THEN 2d_pen_color 255,0,255
            IF modul < 1.75  THEN 2d_pen_color 255,255,0
            IF modul < 1.5  THEN 2d_pen_color 255,255,255
            IF modul < 1.25 THEN 2d_pen_color 0,255,0
            IF modul < 1    THEN 2d_pen_color 0,255,255
            IF modul < .7  THEN 2d_pen_color 0,0,255
            IF modul < .5  THEN 2d_pen_color 127,127,127
            IF modul < .4  THEN 2d_pen_color 127,127,0
            IF modul < .3  THEN 2d_pen_color 127,0,127
            IF modul < .2  THEN 2d_pen_color 127,0,0
            IF modul < .1  THEN 2d_pen_color 255,0,0
            2d_point Nx, Ny : 2d_point ec - Nx + 1, ec - Ny + 1
fin:
            if scancode <> 0 then caption 0,"Arrêté par l'utilisateur ! Dommage !!!" :end
        NEXT Ny
    NEXT Nx
END_SUB
' ******************************************************************************

' ******************************************************************************
'                      La Fractale de Mandelbrot
'                    Mandelbrot.bas par Papydall
' ******************************************************************************
Mandelbrot()
end
' ******************************************************************************
SUB Mandelbrot()
  dim xp,yp,cy,cx,x,y,Nb_iter,j,z,c,r,v,b
  xp = 350: yp = 225
  caption 0,"Tracé du Mandelbrot en cours ... Veuillez patienter ... <CLICK> pour arrêter"
  alpha 1 : top 1,20 : left 1,170 :color 1, 255,0,0 : font_color 1,255,255,0
  font_bold 1 : font_size 1,12 : caption 1," PAPYDALL vous propose ... "
  alpha 2 : top 2,400 : left 2,150 :color 2, 255,0,0 : font_color 2,255,255,0
  font_bold 2 : font_size 2,12 : caption 2," ... La fractale de MANDELBROT "
  for cy = -1.5 to 0.006 step 0.006
    for cx = -2.5 to 1 step 0.006
        x = .01: y = .01 : Nb_iter = 0
        while Nb_iter < 60 :' augmenter le nombre d'itérations pour une meilleure définition.
                            ' mais le temps de calcul devient excessivement long.
            if scancode <> 0 then end
            z = x * y : x = x * x - y * y + cx : y = z + z + cy
            if x < -2 or x > 2 or y < -2 or y > 2
              couleur() : 2d_pen_color r,v,b
              2d_point xp + cx*100, yp - cy*100
              2d_point xp + cx*100, yp + cy*100
              exit_while
            end_if
            Nb_iter = Nb_iter + 1
        end_while
    next cx
  next cy
  caption 0,"fin"
END_SUB
' *****************************************************************************
sub couleur()
    IF Nb_iter < 10 THEN r = 0    : v = 0  : b = 255 : exit_sub
    IF Nb_iter < 20 THEN r = 0    : v = 255 : b = 0  : exit_sub
    IF Nb_iter < 30 THEN r = 255 : v = 0  : b = 255 : exit_sub
    IF Nb_iter < 40 THEN r = 255 : v = 0  : b = 0  : exit_sub
    IF Nb_iter < 50 THEN r = 255 : v = 255 : b = 0 : exit_sub
    r = 64 : v = 64 : b = 0
end_sub
' ******************************************************************************