
A Barnsley fern is a fractal named after British mathematician Michael Barnsley and can be created using an iterated function system (IFS).



Task

Create this fractal fern, using the following transformations:

 ƒ1   (chosen 1% of the time)
        xn + 1 = 0
        yn + 1 = 0.16 yn

 ƒ2   (chosen 85% of the time)
        xn + 1 = 0.85 xn + 0.04 yn
        yn + 1 = −0.04 xn + 0.85 yn + 1.6

 ƒ3   (chosen 7% of the time)
        xn + 1 = 0.2 xn − 0.26 yn
        yn + 1 = 0.23 xn + 0.22 yn + 1.6

 ƒ4   (chosen 7% of the time)
        xn + 1 = −0.15 xn + 0.28 yn
        yn + 1 = 0.26 xn + 0.24 yn + 0.44.

Starting position: x = 0, y = 0




INCLUDE "H6:REALMATH.ACT"
 
BYTE CH=$02FC,COLOR1=$02C5,COLOR2=$02C6
REAL r0,r4,r15,r16,r20,r22,r23,r24,r26,r28,r44,r85,r160
 
PROC Init()
  ValR("0",r0)
  ValR("0.04",r4)
  ValR("0.15",r16)
  ValR("0.16",r16)
  ValR("0.2",r20)
  ValR("0.22",r22)
  ValR("0.23",r23)
  ValR("0.24",r24)
  ValR("0.26",r26)
  ValR("0.28",r28)
  ValR("0.44",r44)
  ValR("0.85",r85)
  ValR("1.6",r160)
RETURN
 
PROC Fern(REAL POINTER scale)
  BYTE r
  REAL x,y,xp,yp,tmp1,tmp2
  INT i,ix,iy
 
  RealAssign(r0,x)
  RealAssign(r0,y)
 
  DO
    RealMult(x,scale,tmp1)
    RealMult(y,scale,tmp2)
    ix=Round(tmp2) ;fern is rotated to fit the screen size
    iy=Round(tmp1)+85
 
    IF (ix>=0) AND (ix<=319) AND (iy>=0) AND (iy<=191) THEN
      Plot(ix,iy)
    FI
    r=Rand(100)
    RealAssign(x,xp) ;xp=x
    RealAssign(y,yp) ;yp=y
    IF r<1 THEN
      RealAssign(r0,x)   ;x=0
      RealMult(r16,yp,y) ;y=0.16*yp
    ELSEIF r<86 THEN
      RealMult(r85,xp,tmp1) ;tmp1=0.85*xp
      RealMult(r4,yp,tmp2)  ;tmp2=0.4*yp
      RealAdd(tmp1,tmp2,x)  ;x=0.85*xp+0.4*yp
 
      RealMult(r4,xp,tmp1)    ;tmp1=0.04*xp
      RealSub(r160,tmp1,tmp2) ;tmp2=-0.04*xp+1.6
      RealMult(r85,yp,tmp1)   ;tmp1=0.85*yp
      RealAdd(tmp1,tmp2,y)    ;y=-0.04*xp+0.85*yp+1.6
    ELSEIF r<93 THEN
      RealMult(r20,xp,tmp1) ;tmp1=0.2*xp
      RealMult(r26,yp,tmp2) ;tmp2=0.26*yp
      RealSub(tmp1,tmp2,x)  ;x=0.2*xp-0.26*yp
 
      RealMult(r23,xp,tmp1)   ;tmp1=0.23*xp
      RealAdd(r160,tmp1,tmp2) ;tmp2=0.23*xp+1.6
      RealMult(r22,yp,tmp1)   ;tmp1=0.22*yp
      RealAdd(tmp1,tmp2,y)    ;y=0.23*xp+0.22*yp+1.6
    ELSE
      RealMult(r15,xp,tmp1) ;tmp1=0.15*xp
      RealMult(r28,yp,tmp2) ;tmp2=0.28*yp
      RealSub(tmp2,tmp1,x)  ;x=-0.15*xp+0.28*yp
 
      RealMult(r26,xp,tmp1)  ;tmp1=0.26*xp
      RealAdd(r44,tmp1,tmp2) ;tmp2=0.26*xp+0.44
      RealMult(r24,yp,tmp1)  ;tmp1=0.24*yp
      RealAdd(tmp1,tmp2,y)   ;y=0.26*xp+0.44*yp+0.44
    FI
 
    Poke(77,0) ;turn off the attract mode
  UNTIL CH#$FF ;until key pressed
  OD
  CH=$FF
RETURN
 
PROC Main()
  REAL scale
 
  Graphics(8+16)
  Color=1
  COLOR1=$BA
  COLOR2=$B2
 
  Init()
  ValR("30",scale)
  Fern(scale)
RETURN