Barnsley fern: Difference between revisions
Added uBasic/4tH version
Hendursaga (talk | contribs) m (Standardize reference to opticl library) |
(Added uBasic/4tH version) |
||
(18 intermediate revisions by 9 users not shown) | |||
Line 283:
</syntaxhighlight>
=={{header|
==={{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}}===
{{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.
<syntaxhighlight lang="text">
color 060
for i = 1 to 200000
r = randomf
if r < 0.01
Line 887 ⟶ 1,120:
x = nx
y = ny
move 50 + x * 15
rect 0.3 0.3
.
</syntaxhighlight>
=={{header|Emacs Lisp}}==
Line 1,276 ⟶ 1,510:
=={{header|Fōrmulæ}}==
{{FormulaeEntry|page=https://formulae.org/?script=examples/Barnsley_fern}}
'''Solution'''
[[File:Fōrmulæ - Barnsley fern 01.png]]
'''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 =
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="
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}}==
|