Rosetta Code

Barnsley fern: Difference between revisions

Page Discussion

Barnsley fern (view source)

Revision as of 18:39, 29 March 2024

8,386 bytes added ,  1 month ago
Added uBasic/4tH version
m (Standardize reference to opticl library)
(Added uBasic/4tH version)
 
(18 intermediate revisions by 9 users not shown)
Line 283:
</syntaxhighlight>
 
=={{header|Applesoft BASIC}}==
==={{header|Applesoft BASIC}}===
<syntaxhighlight lang="applesoftbasic"> 100 LET YY(1) = .16
110 XX(2) = .85:XY(2) = .04
Line 310 ⟶ 311:
</syntaxhighlight>
 
==={{header|BASIC256}}===
<syntaxhighlight lang="basic256"># adjustable window altoght
# call the subroutine with the altoght you want
Line 351 ⟶ 352:
[https://www.dropbox.com/s/8rkgguj3ol57771/Barnsley_fern_BASIC256.png?dl=0 Barnsley fern BASIC256 image]
 
==={{header|BBC BASIC}}===
 
=={{header|BBC BASIC}}==
{{works with|BBC BASIC for Windows}}
<syntaxhighlight lang="bbcbasic"> GCOL 2 : REM Green Graphics Color
Line 368:
NEXT
END</syntaxhighlight>
==={{header|uBasic/4tH}}===
uBasic/4tH does not feature graphics or floating point, so it requires some extra code to achieve this. This version uses binary scaling.
<syntaxhighlight lang="qbasic">Dim @o(5) ' 0 = SVG file, 1 = color, 2 = fillcolor, 3 = pixel, 4 = text
 
' === Begin Program ===
 
If Info("wordsize") < 64 Then Print "This program requires a 64-bit uBasic" : End
 
Proc _SVGopen ("svgfern.svg")
Proc _Canvas (500, 768) ' light gray background
Proc _Background (FUNC(_RGBtoColor (0, 0, 0)))
Proc _SetMode ("dot") ' we want dots, not pixels
 
For i = 1 To 25000
Let r = Rnd (100)
 
If r = 1 Then
Let x = 0
Let y = FUNC (_Fmul(FUNC(_Fdiv(16, 100)) , y))
Else
 
If r < 9 Then
Let x = FUNC(_Fmul(FUNC(_Fdiv(2, 10)), x)) - FUNC(_Fmul(FUNC(_Fdiv(26, 100)), y))
Let y = FUNC(_Fmul(FUNC(_Fdiv(-23, 100)), x)) + FUNC(_Fmul(FUNC(_Fdiv(22, 100)), y)) + FUNC(_Fdiv(16, 10))
Else
 
If r < 16 then
Let x = FUNC(_Fmul(FUNC(_Fdiv(-15, 100)), x)) + FUNC(_Fmul(FUNC(_Fdiv(28, 100)), y))
Let y = FUNC(_Fmul(FUNC(_Fdiv(26, 100)), x)) + FUNC(_Fmul(FUNC(_Fdiv(24, 100)), y)) + FUNC(_Fdiv(44, 100))
Else
 
Let x = FUNC(_Fmul(FUNC(_Fdiv(85, 100)), x)) + FUNC(_Fmul(FUNC(_Fdiv(4, 100)), y))
Let y = FUNC(_Fmul(FUNC(_Fdiv(-4, 100)), x)) + FUNC(_Fmul(FUNC(_Fdiv(85, 100)), y)) + FUNC(_Fdiv(16, 10))
EndIf
EndIf
EndIf
 
Let q = FUNC(_Fround(FUNC(_Fmul(x + FUNC(_Ntof(3)), FUNC(_Ntof(70))))))
Let p = FUNC(_Fround(FUNC(_Ntof(700)) - FUNC(_Fmul(y, FUNC(_Ntof(70))))))
 
Proc _SetColor (FUNC(_RGBtoColor (0, 128 + Rnd(128), 0)))
Proc _SetPixel (p+20, q)
Next
 
Proc _SVGclose
End
 
' === End Program ===
 
_Ntof Param (1) : Return (a@*16384)
_Ftoi Param (1) : Return ((10000*a@)/16384)
_Fmul Param (2) : Return ((a@*b@)/16384)
_Fdiv Param (2) : Return ((a@*16384)/b@)
_Fround Param (1) : Return ((a@+8192)/16384)
 
_RGBtoColor Param (3) : Return (a@ * 65536 + b@ * 256 + c@)
_SetColor Param (1) : @o(1) = a@ : Return
_GetColor Return (@o(1))
_SetFill Param (1) : @o(2) = a@ : Return
_GetFill Return (@o(2))
_SetPixel Param(2) : Proc @o(3)(a@, b@) : Return
_SVGclose Write @o(0), "</svg>" : Close @o(0) : Return
_color_ Param (1) : Proc _PrintRGB (a@) : Write @o(0), "\q />" : Return
 
_PrintRGB
Param (1)
Radix 16
 
If a@ < 0 Then
Write @o(0), "none";
Else
Write @o(0), Show(Str ("#!######", a@));
EndIf
 
Radix 10
Return
 
_Background
Param (1)
 
Write @o(0), "<rect width=\q100%\q height=\q100%\q fill=\q";
Proc _color_ (a@)
Return
 
_pixel_
Param (2)
 
Write @o(0), "<rect x=\q";b@;"\q y=\q";a@;
Write @o(0), "\q width=\q1px\q height=\q1px\q fill=\q";
Proc _color_ (@o(1))
Return
 
_dot_
Param (2)
 
Write @o(0), "<circle cx=\q";b@;"\q cy=\q";a@;
Write @o(0), "\q r=\q0.5px\q fill=\q";
Proc _color_ (@o(1))
Return
 
_SetMode
Param (1)
 
If Comp(a@, "pixel") = 0 Then
@o(3) = _pixel_
Else If Comp(a@, "dot") = 0 Then
@o(3) = _dot_
Else Print "Bad mode" : Raise 1
Endif : Endif
Return
 
_Canvas
Param (2)
 
Write @o(0), "<svg width=\q";a@;"\q height=\q";b@;"\q viewBox=\q0 0 ";a@;" ";b@;
Write @o(0), "\q xmlns=\qhttp://www.w3.org/2000/svg\q ";
Write @o(0), "xmlns:xlink=\qhttp://www.w3.org/1999/xlink\q>"
Return
 
_SVGopen
Param (1)
 
If Set (@o(0), Open (a@, "w")) < 0 Then
Print "Cannot open \q";Show (a@);"\q" : Raise 1
Else
Write @o(0), "<?xml version=\q1.0\q encoding=\qUTF-8\q standalone=\qno\q?>"
Write @o(0), "<!DOCTYPE svg PUBLIC \q-//W3C//DTD SVG 1.1//EN\q ";
Write @o(0), "\qhttp://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd\q>"
EndIf
Return</syntaxhighlight>
This version uses decimal fixed-point numbers. It is not only faster, but also provides a better rendition of the Barnsley fern. It uses the very same SVG routines as the version above, so these are not included.
{{Trans|Forth}}
<syntaxhighlight lang="qbasic">Dim @o(5) ' 0 = SVG file, 1 = color, 2 = fillcolor, 3 = pixel, 4 = text
Dim @c(20) ' coefficients
 
w = 400 : h = 600 : s = 17
 
Proc _coefficients
Proc _SVGopen ("svgfern.svg")
Proc _Canvas (w, h) ' light gray background
Proc _Background (FUNC(_RGBtoColor (0, 0, 0)))
Proc _SetMode ("dot") ' we want dots, not pixels
 
For i = 0 to 50000
Proc _transformation (FUNC (_randomchoice))
 
Proc _SetColor (FUNC(_RGBtoColor (0, 128 + Rnd(128), 0)))
p = h - y/s
q = w/2 + x/s
 
Proc _SetPixel (p, q)
Next
 
Proc _SVGclose
End
 
_coefficients
Local (1)
 
Push 0 , 0 , 0 , 160 , 0 ' 1% of the time - f1
Push 200 , -260 , 230 , 220 , 1600 ' 7% of the time - f3
Push -150 , 280 , 260 , 240 , 440 ' 7% of the time - f4
Push 850 , 40 , -40 , 850 , 1600 ' 85% of the time - f2
 
For a@ = 19 To 0 Step -1 : @c(a@) = Pop() : Next
Return
 
_randomchoice
Local (1)
 
Push Rnd (100)
a@ = (Tos() > 0)
a@ = a@ + (Tos () > 7)
Return ((a@ + (Pop () > 14)) * 5)
 
_transformation
Param (1)
Local (2)
 
b@ = @c(a@) * x
b@ = (b@ + @c(a@+1) * y) / 1000
 
c@ = @c(a@+2) * x
c@ = (c@ + @c(a@+3) * y) / 1000
 
x = b@ : y = @c(a@+4) + c@
Return</syntaxhighlight>
 
=={{header|C}}==
Line 735 ⟶ 922:
(multiple-value-setq (x y) (funcall (choose-transform) x y)))
(write-png-file filespec image)))</syntaxhighlight>
 
=={{header|Craft Basic}}==
<syntaxhighlight lang="basic">define x1 = 0, y1 = 0
 
bgcolor 0, 0, 0
cls graphics
 
for i = 1 to 10000
 
let r = rnd
 
if r > 0 and r < .01 then
 
let x = .0
let y = .16 * y
 
endif
 
if r > .01 and r < .08 then
 
let x = .22 * x - .26 * y
let y = -.23 * x + .22 * y + 1.6
 
endif
 
if r > .075 and r < .15 then
 
let x = .15 * x + .28 * y
let y = -.29 * x + .24 * y + .44
 
endif
 
let x = .85 * x + .04 * y
let y = -.04 * x + .85 * y + 1.6
 
let x1 = (x + 3) * 70
let y1 = 700 - y * 70
 
fgcolor 0, int(rnd * 255), 0
 
dot x1, y1
 
wait
 
next i</syntaxhighlight>
 
=={{header|D}}==
Line 867 ⟶ 1,099:
=={{header|EasyLang}}==
 
[https://easylang.onlinedev/apps/barnsley-fern.html Run it]
 
<syntaxhighlight lang="text">color 060
color 060
for i range 200000
for i = 1 to 200000
r = randomf
if r < 0.01
Line 887 ⟶ 1,120:
x = nx
y = ny
move 50 + x * 15 100 - y * 10
rect 0.3 0.3
.
.</syntaxhighlight>
</syntaxhighlight>
 
=={{header|Emacs Lisp}}==
Line 1,276 ⟶ 1,510:
=={{header|Fōrmulæ}}==
 
{{FormulaeEntry|page=https://formulae.org/?script=examples/Barnsley_fern}}
Fōrmulæ programs are not textual, visualization/edition of programs is done showing/manipulating structures but not text. Moreover, there can be multiple visual representations of the same program. Even though it is possible to have textual representation &mdash;i.e. XML, JSON&mdash; they are intended for storage and transfer purposes more than visualization and edition.
 
'''Solution'''
Programs in Fōrmulæ are created/edited online in its [https://formulae.org website], However they run on execution servers. By default remote servers are used, but they are limited in memory and processing power, since they are intended for demonstration and casual use. A local server can be downloaded and installed, it has no limitations (it runs in your own computer). Because of that, example programs can be fully visualized and edited, but some of them will not run if they require a moderate or heavy computation/memory resources, and no local server is being used.
 
[[File:Fōrmulæ - Barnsley fern 01.png]]
In '''[https://formulae.org/?example=Barnsley_fern this]''' page you can see the program(s) related to this task and their results.
 
'''Test case'''
 
[[File:Fōrmulæ - Barnsley fern 02.png]]
 
[[File:Fōrmulæ - Barnsley fern 03.png]]
 
=={{header|G'MIC}}==
Line 1,968 ⟶ 2,208:
=={{header|Nim}}==
<syntaxhighlight lang="nim">
import nimPNG, std/random
 
randomize()
Line 2,016 ⟶ 2,256:
 
for i in 1..iterations:
var r = randomrand(101)
var nx, ny: float
if r <= 85:
Line 2,353 ⟶ 2,593:
 
set(m, n, "#00ff00")</syntaxhighlight>
 
=={{header|Prolog}}==
<syntaxhighlight lang="prolog>
% a straight forward adaption from the Ada example
% these imports are needed for Ciao Prolog but needed
% modules will vary with your Prolog system
:- use_module(library(streams)).
:- use_module(library(stream_utils)).
:- use_module(library(lists)).
:- use_module(library(llists)).
:- use_module(library(hiordlib)).
:- use_module(library(random)).
:- use_module(library(format)).
 
replicate(Term, Times, L) :-
length(L, Times),
maplist(=(Term), L).
 
replace(0, [_|T], E, [E|T]).
replace(X, [H|T0], E, [H|T]) :-
X0 is X -1,
replace(X0, T0, E, T).
replace_2d(X, 0, [H|T], E, [R|T]) :-
replace(X, H, E, R).
replace_2d(X, Y, [H|T0], E, [H|T]) :-
Y0 is Y -1,
replace_2d(X, Y0, T0, E, T).
 
fern_iteration(10000, _X, _Y, Final, Final).
fern_iteration(N, X, Y, I, Final) :-
random(R),
( R =< 0.01
-> ( X1 is 0.0,
Y1 is 0.16*Y )
; ( R =< 0.86
-> ( X1 is 0.85*X + 0.04*Y,
Y1 is -0.04*X + 0.85*Y + 1.6 )
; ( R =< 0.93
-> ( X1 is 0.20*X - 0.26*Y,
Y1 is 0.23*X + 0.22*Y + 1.60 )
; ( X1 is -0.15*X + 0.28*Y,
Y1 is 0.26*X + 0.24*Y + 0.44 )
) ) ),
PointX is 250 + floor(70.0*X1),
PointY is 750 - floor(70.0*Y1),
replace_2d(PointX, PointY, I, [0, 255, 0], I1), !,
N1 is N + 1,
fern_iteration(N1, X1, Y1, I1, Final).
 
draw_fern :-
replicate([0, 0, 0], 500, Row),
replicate(Row, 750, F),
fern_iteration(0, 0, 0, F, Fern),
% the following lines are written for ciao prolog and
% write to a ppm6 file for viewing
% adapting to SWI or Scryer should be straighforward
open('fern.ppm', write, File),
flatten(Fern, FP),
format(File, "P6\n~d ~d\n255\n", [500, 750]),
write_bytes(File, FP),
close(File).
</syntaxhighlight>
 
=={{header|PureBasic}}==
Line 2,480 ⟶ 2,782:
System</syntaxhighlight>
 
=={{header|Quackery}}==
 
<syntaxhighlight lang="Quackery"> [ $ "turtleduck.qky" loadfile ] now!
 
[ ' [ 79 121 66 ] fill
[ 3 2 circle ] ] is dot ( --> )
 
[ 1 fly
-1 4 turn
1 fly
1 4 turn ] is toxy ( n n --> )
 
[ 100 1 v* /
dip [ 100 1 v* / ]
2dup toxy
dot
1 2 turn
toxy
1 2 turn ] is plot ( n n --> )
 
 
[ 2swap 2drop 0 1
2swap 16 100 v* ] is f1 ( n/d n/d --> n/d n/d )
 
[ 2over -4 100 v*
2over 85 100 v*
16 10 v+ v+
join dip
[ 4 100 v*
2swap 85 100 v*
v+ ]
do ] is f2 ( n/d n/d --> n/d n/d )
 
[ 2over 23 100 v*
2over 22 100 v*
16 10 v+ v+
join dip
[ -26 100 v*
2swap 20 100 v*
v+ ]
do ] is f3 ( n/d n/d --> n/d n/d )
 
[ 2over 26 100 v*
2over 24 100 v*
44 100 v+ v+
join dip
[ 28 100 v*
2swap -15 100 v*
v+ ]
do ] is f4 ( n/d n/d --> n/d n/d )
 
[ 100 random
[ dup 0 = iff
[ drop f1 ] done
dup 86 < iff
[ drop f2 ] done
93 < iff f3 done
f4 ]
2swap 1000000000 round
2swap 1000000000 round
2over 2over plot ] is nextpoint ( n/d n/d --> n/d n/d )
 
turtle
' [ 79 121 66 ] colour
-500 1 fly
0 1 0 1
0 frames
20000 times nextpoint
1 frames
4 times drop
</syntaxhighlight>
 
{{out}}
 
[[File:Quackery Barnsley fern.png|thumb|center]]
 
=={{header|R}}==
Line 3,505 ⟶ 3,882:
{{trans|Kotlin}}
{{libheader|DOME}}
<syntaxhighlight lang="ecmascriptwren">import "graphics" for Canvas, Color
import "dome" for Window
import "random" for Random
Line 3,558 ⟶ 3,935:
 
var Game = BarnsleyFern.new(640, 640, 200000)</syntaxhighlight>
 
{{out}}
[[File:Wren-Barnsley_fern.png|400px]]
 
=={{header|XPL0}}==
Thebeez
1

edit

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/331583...363026"