Barnsley fern: Difference between revisions

Content added Content deleted

Inline

@@ Line 25: / Line 25: @@
 Starting position: x = 0, y = 0
 <br><br>
+=={{header|Action!}}==
+{{libheader|Action! Tool Kit}}
+<lang Action!>INCLUDE "D2:REAL.ACT" ;from the Action! Tool Kit
+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
+INT FUNC MyRealToInt(REAL POINTER r)
+  BYTE ARRAY x
+  REAL tmp
+  INT i
+  x=r
+  IF (x(0)&$80)=0 THEN
+    i=RealToInt(r)
+  ELSE
+    RealAssign(r,tmp)
+    x=tmp
+    x(0)==&$7F
+    i=-RealToInt(tmp)
+  FI
+RETURN (i)
+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=MyRealToInt(tmp2) ;fern is rotated to fit the screen size
+    iy=MyRealToInt(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</lang>
+{{out}}
+[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/Barnsley_fern.png Screenshot from Atari 8-bit computer]
 =={{header|Ada}}==