ASCII Mandelbrot (en couleurs)

' **********************************************************************
' ASCII Mandelbrot
' **********************************************************************

' Parametres de base (a modifier eventuellement)

const WChar = 1,  HChar = 1    ' Taille des caracteres en multiples de 8
const NRow  = 90, NCol  = 120  ' Nb de lignes et de colonnes

const Char  = "0123456789."    ' Caracteres

const InsideCol = CL_NOIR      ' Couleur de la partie interne

' ----------------------------------------------------------------------

' Parametres supplementaires

const WChar8 =  WChar * 8  ' Largeur caractere en pixels
const HChar8 =  HChar * 8  ' Hauteur caractere en pixels

const WChar4 =  WChar * 4
const HChar4 =  HChar * 4

const PicWidth  = WChar8 * NCol
const PicHeight = HChar8 * NRow + HChar4

const HalfPicWidth  = PicWidth \ 2
const HalfPicHeight = PicHeight \ 2

const NChar = len(Char)  ' Nb de caracteres

const Esc   = 1.0E+10    ' Rayon d'echappement
const LnEsc = log(Esc)
const Ln2   = log(2)

dim Nom$       ' Nom de l'image
dim x0         ' Coord. X du centre
dim y0         ' Coord. Y du centre
dim MaxIter%   ' Nb maxi d'iterations
dim ZoomFact   ' Facteur de zoom
dim DistFact   ' Plus negatif ==> contour plus sombre
dim ColorFact  ' 0 pour noir et blanc, positif pour bandes de couleur

' Tableau memorisant le nb d'iterations

dim Iter%(NRow, NCol)

' Tableaux memorisant la distance et le "continuous dwell"
' Voir www.unilim.fr/pages_perso/jean.debord/fbcroco/fractales_4.pdf

dim Dist(NRow, NCol), Dwell(NRow, NCol)

' Tableau des caracteres

dim Car$(NRow, NCol)

' ----------------------------------------------------------------------
' Exemple
' ----------------------------------------------------------------------

'           Nom         x0    y0   MaxIter Zoomfact DistFact ColorFact
init_params "mandel",-0.745, 0.1176, 5000,   450,     -2,      2

' **********************************************************************

' Programme principal

dim ColFact, AbsCol, ScaleFact

dim x%, y%, btn%, key$

SetParams()

mode 3, "Clic gauche : zoom + / Clic droit : zoom - / S : sauvegarde / ESC : quitte", PicWidth, PicHeight, WChar, HChar
  
paper InsideCol

Iterate()
PlotChars()

repeat
  get_mouse x, y, btn

  if btn = 1 or btn = 2 then
    getcoord x0, y0, x, y

    SetZoom(btn = 1)
    SetParams()

    Iterate()
    PlotChars()
  end_if
 
  key = inkey()
  if upper(key) = "S" then save()
until key = "ESCAPE"

' **********************************************************************

' Sous-programmes

sub init_params(_Nom$, _x0, _y0, _MaxIter%, _ZoomFact, _DistFact, _ColorFact)
' Initialise les parametres

  Nom       = _Nom
  x0        = _x0
  y0        = _y0
  MaxIter   = _MaxIter
  ZoomFact  = _ZoomFact
  DistFact  = _DistFact
  ColorFact = _ColorFact
end_sub

sub SetParams ()
  ColFact = 0.01 * ColorFact
  AbsCol = abs(ColFact)
  ScaleFact = 4 / (PicHeight * ZoomFact)
end_sub

sub SetZoom (zoom%)
  if zoom then
    ZoomFact = 5 * ZoomFact
    MaxIter = 1.25 * MaxIter
    ColorFact = 1.1 * ColorFact
  else
    ZoomFact = ZoomFact / 5
    MaxIter = MaxIter / 1.25
    ColorFact = ColorFact / 1.1
  end_if
end_sub

sub init_sub (xt, yt, c@, z@, dz@)
' Initialise les iterations au point (xt, yt)

  c  = cmplx(xt, yt)
  z  = C_zero
  dz = C_zero
end_sub

sub iter_sub (c@, z@, dz@, zn@, dzn@)
' Calcul d'une iteration

  zn  = z * z + c       ' z^2 + c
  dzn = 2 * z * dz + 1  ' Derivee dz/dc
end_sub

sub mandelbrot (x%, y%, iter%, dist, dwell)
' Iteration de la fonction complexe au point (x, y)

  dim c@, z@, dz@, zn@, dzn@
  dim xt, yt, mz, mdz, lmz

  xt = x0 + ScaleFact * (x - HalfPicWidth)
  yt = y0 + ScaleFact * (y - HalfPicHeight)

  init_sub xt, yt, c, z, dz

  iter = 0
  mz = cabs(z)

  while iter < MaxIter and mz < Esc
    iter_sub c, z, dz, zn, dzn
    z = zn
    dz = dzn
    mz = cabs(z)
    iter = iter + 1
  wend

  if iter = MaxIter then dist = 0 : dwell = 0 : exit_sub

  mdz = cabs(dz)
  lmz = log(mz)

  dist = 2 * mz * lmz / mdz
  dist = log(dist / ScaleFact) / Ln2 + DistFact

  dwell = iter + log(LnEsc / lmz) / Ln2
  dwell = log(abs(dwell)) * AbsCol
end_sub

sub Iterate ()

  dim i%, j%, x%, y%

  ' (x, y) = Coordonnees du centre du caractere
  ' Echelle verticale vers le haut

  x = WChar4                
  y = (NRow - 0.5) * HChar8  
  
  for i = 1 to NRow
    for j = 1 to NCol
      mandelbrot x, y, Iter(i,j), Dist(i,j), Dwell(i,j)
      x = x + WChar8
    next j
    x = WChar4
    y = y - HChar8
  next i
end_sub

function rgbcol% (i%, j%)
' Determine la teinte (Hue) et la saturation d'apres le "Continuous Dwell"

  dim q, angle, radius, h, s, v, r%, g%, b%

  q = Dwell(i,j)

  if q < 0.5 then
    q = 1 - 1.5 * q
    angle = 1 - q
  else
    q = 1.5 * q - 0.5
    angle = q
  end_if

  radius = sqr(q)

  v = 1
  if (ColFact > 0) and odd(Iter(i,j)) then
    v = 0.85
    radius = 0.667 * radius
  end_if

  h = frac(angle * 10) * 360
  s = frac(radius)

  HSVtoRGB h, s, v, r, g, b
  return RGB(r, g, b)
end_function

sub PlotChars ()

  dim DistMin, DistMax, DistRange
  dim i%, j%, k, x, y

  DistMin = Dist(1,1)
  DistMax = Dist(1,1)
  
  cls
  for i = 1 to NRow
    for j = 1 to NCol
      if Dist(i,j) < DistMin then
        DistMin = Dist(i,j)
      elseif Dist(i,j) > DistMax then
        DistMax = Dist(i,j)
      end if
    next j
  next i

  DistRange = DistMax - DistMin

  ' Choix du caractere en fonction de la distance

  for i = 1 to NRow
    for j = 1 to NCol
      if Dist(i,j) = 0 then
        Car(i,j) = " "
      else
        k = (Dist(i,j) - DistMin) / DistRange
        Car(i,j) = mid(Char, int(k * NChar) + 1, 1)
      end_if
    next j
  next i

  ' Affichage des caracteres

  x = 0                
  y = PicHeight  
  
  for i = 1 to NRow
    for j = 1 to NCol
      pen rgbcol(i,j)
      print Car(i,j), x, y
      x = x + WChar8
    next j
    x = 0
    y = y - HChar8
  next i
end_sub

sub getcoord (x0, y0, x%, y%)
' Calcule les coordonnees (x0,y0) du centre
' d'apres la position (x,y) de la souris

  x0 = x0 + ScaleFact * (x - HalfPicWidth)
  y0 = y0 + ScaleFact * (y - HalfPicHeight)
end_sub

sub save ()
' Sauvegarde l'image et les parametres

  img_save Nom + ".png"
  openout #1, Nom + ".par"
  write #1, Nom, x0, y0, MaxIter, ZoomFact, DistFact, ColorFact
  closeout #1
end_sub