Biomorphes de Pickover

' **********************************************************************
' Biomorphe de Pickover
' **********************************************************************

' Variables definies par l'utilisateur

dim PicWidth%  : PicWidth%  = 640   : ' Taille de l'image en pixels
dim PicHeight% : PicHeight% = 480

dim c_X        : c_X = 0.4          : ' Coordonnees du parametre c
dim c_Y        : c_Y = 0.7

dim x0         : x0 = 0             : ' Coord. du centre de l'image
dim y0         : y0 = 0
dim Esc        : Esc = 10           : ' Rayon d'echappement
dim MaxIter%   : MaxIter% = 100     : ' Nb maxi d'iterations
dim ZoomFact   : ZoomFact = 1       : ' Facteur de zoom
dim ColorFact  : ColorFact = -2     : ' Facteur de coloration
dim CstVal     : CstVal = 0.9       : ' Luminosite HSV (constante)

' Variables supplementaires

dim HalfPicWidth%  : HalfPicWidth%  = PicWidth% / 2
dim HalfPicHeight% : HalfPicHeight% = PicHeight% / 2

dim Ln2   : Ln2   = log(2)
dim Esc2  : Esc2  = Esc * Esc
dim LnEsc : LnEsc = log(Esc)

dim H, S, V, R%, G%, B%  : ' Parametres de coloration

dim AbsColor             : ' abs(ColorFact)
dim ScaleFact            : ' Facteur d'echelle = distance entre 2 pixels

dim Nx%, Ny%             : ' Coordonnees d'un point (pixels)
dim xt, yt               : ' Coordonnees d'un point (algebriques)

dim Iter%                : ' Nb d'iterations
dim zn_x, zn_y           : ' Nombre complexe z(n)

' Variables utilisees en interne par les sous-programmes

dim II%, ZZ, FF, PP, QQ, TT, RR, GG, BB  : ' HSVtoRGB
dim M2, Dwell, Q, Angle, Radius          : ' MdbCol
dim x, y                                 : ' Biomorph

label Func, Biomorph, MdbCol, HSVtoRGB

' ----------------------------------------------------------------------
' Description des objets
' ----------------------------------------------------------------------

' Fenetre principale

left    0, 50
top     0, 50
width   0, PicWidth% + 70
height  0, PicHeight% + 120
caption 0, "Biomorphe de Pickover ... Veuillez patienter."

' Image

picture 1
left    1, 30
top     1, 40
width   1, PicWidth%
height  1, PicHeight%

2d_target_is 1

' ----------------------------------------------------------------------
' Programme principal
' ----------------------------------------------------------------------

ColorFact = 0.01 * ColorFact
AbsColor  = abs(ColorFact)
ScaleFact = 4 / (PicHeight% * ZoomFact)

for Ny% = 0 to PicHeight% - 1
  yt = y0 - ScaleFact * (Ny% - HalfPicHeight%)
  for Nx% = 0 to PicWidth% - 1
    xt = x0 + ScaleFact * (Nx% - HalfPicWidth%)
    gosub Biomorph
    2d_pen_color R%, G%, B%
    2d_point Nx%, Ny%
  next Nx%
next Ny%

caption 0, "Biomorphe de Pickover ... Terminé."

end

' ----------------------------------------------------------------------
' Sous-programmes
' ----------------------------------------------------------------------

Func:
' Calcul de la fonction complexe : (zn_x, zn_y) = f(x, y) + c

  zn_x = x * x - y * y + c_X
  zn_y = 2 * x * y + c_Y
return

Biomorph:
' Iteration de la fonction complexe au point (xt, yt)

  zn_x = xt
  zn_y = yt
  
  Iter% = 0
  M2 = 0

  while Iter% < MaxIter% and M2 < Esc2

    x = zn_x
    y = zn_y

    gosub Func

    M2 = zn_x * zn_x + zn_y * zn_y
    
    Iter% = Iter% + 1

  end_while

  if abs(zn_x) < Esc or abs(zn_y) < Esc
    R% = 0
    G% = 0
    B% = 0
    return
  end_if

  gosub MdbCol
return

MdbCol:
' Determine la teinte (Hue, H) et la Saturation (S)
' d'apres le "Continuous dwell"

  Dwell = Iter% + log(LnEsc / log(M2)) / Ln2
  if Dwell <= 0 then Dwell = 0.1
  Q = log(Dwell) * AbsColor

  if Q < 0.5
    Q = 1 - 1.5 * Q
    Angle = 1 - Q
  else
    Q = 1.5 * Q - 0.5
    Angle = Q
  end_if

  Radius = sqr(Q)

' Si ColorFact > 0, assombrir une bande sur 2

  V = CstVal

  if (ColorFact > 0) and (odd(Iter%) > 0)
    V = 0.85 * V
    Radius = 0.667 * Radius
  end_if

  H = Angle * 10
  H = H - int(H)
  H = H * 360

  S = Radius - int(Radius)

' Convertir HSV en RGB

  gosub HSVtoRGB
return

HSVtoRGB:
' Conversion HSV --> RGB.
' Entree : H, S, V. Sortie : R%, G%, B%

  if S = 0
    R% = int(V * 255)
    G% = R%
    B% = R%
    return
  end_if

  ZZ  = H / 60
  II% = int(ZZ)
  FF  = ZZ - int(ZZ)
  PP  = V * (1 - S)
  QQ  = V * (1 - S * FF)
  TT  = V * (1 - S * (1 - FF))

  select II%
    case 0
      RR = V  : GG = TT : BB = PP
    case 1
      RR = QQ : GG = V  : BB = PP
    case 2
      RR = PP : GG = V  : BB = TT
    case 3
      RR = PP : GG = QQ : BB = V
    case 4
      RR = TT : GG = PP : BB = V
    case 5
      RR = V  : GG = PP : BB = QQ
  end_select

  R% = int(RR * 255)
  G% = int(GG * 255)
  B% = int(BB * 255)
return