How to resolve the algorithm Barnsley fern step by step in the Action! programming language

Published on 12 May 2024 09:40 PM
#Action!

How to resolve the algorithm Barnsley fern step by step in the Action! programming language

Table of Contents

Problem Statement

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

Create this fractal fern, using the following transformations: Starting position: x = 0, y = 0

Let's start with the solution:

Step by Step solution about How to resolve the algorithm Barnsley fern step by step in the Action! programming language

Source code in the action! programming language

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

You may also check:How to resolve the algorithm Exceptions/Catch an exception thrown in a nested call step by step in the Smalltalk programming language
You may also check:How to resolve the algorithm World Cup group stage step by step in the Common Lisp programming language
You may also check:How to resolve the algorithm Comments step by step in the ProDOS programming language
You may also check:How to resolve the algorithm Apply a callback to an array step by step in the VBA programming language
You may also check:How to resolve the algorithm Reverse a string step by step in the Kotlin programming language