Barnsley fern: Difference between revisions
→{{header|Locomotive Basic}}: add screenshot
m (Uploaded C++ Barnsley fern image) |
(→{{header|Locomotive Basic}}: add screenshot) |
||
| (22 intermediate revisions by 13 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 686 ⟶ 873:
=={{header|Common Lisp}}==
{{libheader|opticl}}
<syntaxhighlight lang="lisp">(defpackage #:barnsley-fern
(:use #:cl
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}}==
[[File:Barnsley fern emacs lisp.png|thumb|Output]]
<syntaxhighlight lang="lisp">; Barnsley fern
Line 1,276 ⟶ 1,511:
=={{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,877 ⟶ 2,118:
=={{header|Locomotive Basic}}==
{{trans|ZX Spectrum Basic}}
[[File:Cpcbasic barnsley.png|thumb|Output with CPCBasic (graphics mode 3)]]
<syntaxhighlight lang="locobasic">10 mode 2:ink 0,0:ink 1,18:randomize time
20 scale=38
Line 1,968 ⟶ 2,210:
=={{header|Nim}}==
<syntaxhighlight lang="nim">
import nimPNG, std/random
randomize()
Line 2,016 ⟶ 2,258:
for i in 1..iterations:
var r =
var nx, ny: float
if r <= 85:
Line 2,353 ⟶ 2,595:
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,784:
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,268 ⟶ 3,647:
call
demoWindow () ;
=={{header|SuperCollider }}==
{{works with|SuperCollider|3.13.0}}
Submitted to Rosetta Code 2024-06-07 by: MusicCoder.
The first line of code excuted is the LAST line in this listing: <br> drawFern.();
SuperCollider is a CLIENT / SERVER software system for the generation of music. <br>
CLIENT = (language+IDE) <br>
SERVER = (music-sound engine) <br>
However, the language is a complete / general purpose OO/functional programming language. <br>
SEE: <br>
https://supercollider.github.io/ <br>
https://en.wikipedia.org/wiki/SuperCollider <br>
<syntaxhighlight lang="SuperCollider">
// ==========================================================================
// START-SuperCollider solution to Rosetta Code TASK: Barnsley fern
// ==========================================================================
(
/* Barnsley_fern
https://rosettacode.org/wiki/Barnsley_fern
Create this fractal fern, using the following transformations:
ƒ1 1%: xn+1 = 0 yn+1 = 0.16 yn
ƒ2 85%: xn+1 = 0.85 xn + 0.04 yn yn+1 = −0.04 xn + 0.85 yn + 1.6
ƒ3 7% xn+1 = 0.2 xn − 0.26 yn yn+1 = 0.23 xn + 0.22 yn + 1.6
ƒ4 7% xn+1 = −0.15 xn + 0.28 yn yn+1 = 0.26 xn + 0.24 yn + 0.44.
Starting position: x = 0, y = 0
//BY: MusicCoder : 2024-06-07//
Create arrays to hold the various constants from the formulae above.
Replicate the arrays to create 100 of them,
*** biased by the percentages above ***.
Scramble the 100 arrays of constants.
Function nextXY will pick a set of constants at random and given the current
X and Y values will generate the next X and Y values.
Before we plot the X-Y values run function findScale so that we can make
sure the generated X & Y values will 'fit' within the bounds of the given display size.
SuperCollider is a CLIENT / SERVER software system for the generation of music.
CLIENT = (language+IDE)
SERVER = (music-sound engine)
However, the language is a complete / general purpose OO/functional programming language.
https://supercollider.github.io/
https://en.wikipedia.org/wiki/SuperCollider
*/
// ==========================================================================
// The first line of code executed is the LAST line in this listing:
// drawFern.();
// ==========================================================================
var fConstants =
// _NEXT_X___________ _NEXT_Y___________
// a*x + b*y +c d*x + e*y + f
( // duplicate each array of constants by the specified % number
([ 0.00, 0.00, 0.00, 0.00, 0.16, 0.00 ]!1 )++ // 1%
([ 0.85, 0.04, 0.00, -0.04, 0.85, 1.6 ]!85)++ // 85%
([ 0.2 , -0.26, 0.00, 0.23, 0.22, 1.6 ]!7 )++ // 7%
([-0.15, 0.28, 0.00, 0.26, 0.24, 0.44 ]!7) // 7%
// the ++ will construct a container array to hold theses arrays
).scramble; // randomly rearrange sub-arrays
// ==========================================================================
var fcSize = fConstants.size;
// ==========================================================================
var nextXY = {|x, y|
var a,b,c,d,e,f;
// split up the array of constants
#a,b,c,d,e,f = fConstants[fcSize.rand];
// apply the constants to the ADD and MUL operations on X and Y
// NEXT_X_________ NEXT_Y___________
[ (a*x) + (b*y) +c, (d*x) + (e*y) + f ]; // return new [x, y]
};
// ==========================================================================
var scaleAndShift = {|num, scale, shift|
roundUp((num*scale)+shift);
};
// ==========================================================================
var findScale = {|screenX=500, screenY=500, runs=1000, show=false|
// use to find min/max in loop of fern functions
var x=0, y=0;
// hold min/max results
var minX=x, maxX=x, minY=y, maxY=y;
// how much 'space' do the X and Y values need
var lengthX, lengthY;
var scaleX, scaleY;
// return the following 3 values to position & scale X and Y
// to stay within the given screen size
var shiftX=0; // add to generated X value to position X on screen
var shiftY=0; // add to generated Y value to position Y on screen
var scale; // multiply X and Y to scale the values to stay on the screen
// we need to use the same scaling factor for both X and Y to avoid distortion
// find min & max of both X and Y
runs.do {
#x, y = nextXY.(x, y);
if (x<minX) {minX=x};
if (x>maxX) {maxX=x};
if (y<minY) {minY=y};
if (y>maxY) {maxY=y};
};
// calculate amount of 'space' needed by X and by Y
lengthX = maxX-minX;
lengthY = maxY-minY;
scaleX = screenX/lengthX;
scaleY = screenY/lengthY;
// use the smaller of scaleX and scaleY as we need ONE scale to avoid distortion
// since we have only sampled possible X and Y values ...
// ... reduce scale to 90% of calculated value to allow space to larger X or Y
scale = 0.9*min(scaleX, scaleY);
// if min X or Y is negative 'shift' the ZERO point
// so that all neg and pos values are on the screen
if (minX.isNegative) {shiftX = minX.abs * scaleX};
if (minY.isNegative) {shiftY = minY.abs * scaleY};
// if calculated shift is 0, to move ZERO away from the edge
// set it as 1% of screen size
// (this is OK as we decreased scale by 10%)
if (shiftX ==0) {shiftX = screenX/100};
if (shiftY ==0) {shiftY = screenY/100};
// round up to nearest integer values
# scale, shiftX, shiftY = roundUp([scale, shiftX, shiftY ]);
if (show) {
var minXsas = scaleAndShift.(minX, scale, shiftX);
var maxXsas = scaleAndShift.(maxX, scale, shiftX);
var minYsas = scaleAndShift.(minY, scale, shiftY);
var maxYsas = scaleAndShift.(maxY, scale, shiftY);
postln("");
postf("scale=%, shiftX=%, shiftY=%\n", scale, shiftX, shiftY);
postf("MIN scaled & shifted X value=%\n", minXsas);
postf("MIN scaled & shifted Y value=%\n", minYsas);
postf("MAX scaled & shifted X value=% screenX=%\n", maxXsas, screenX);
postf("MAX scaled & shifted Y value=% screenY=%\n", maxYsas, screenY);
};
[scale, shiftX, shiftY]; // return these three values
};
// ==========================================================================
var drawFern = {|screenX=400, screenY=600, dotSize=1, windowCorner=50, runs=1000000|
var win = Window.new("Barnsley Fern", Rect(windowCorner, windowCorner, screenX, screenY)).front;
var x=0, y=0;
var bigX, bigY;
var scale, shiftX, shiftY;
# scale, shiftX, shiftY = findScale.(screenX, screenY, show: true);
win.view.background_(Color.white);
win.drawFunc = {
runs.do {|i|
# x, y = nextXY.(x, y); // generate next X and Y values
bigX = scaleAndShift.(x, scale, shiftX);
// Y=0 is at top of screen,
// so substract Y from screenY to flip orientation
bigY = screenY - scaleAndShift.(y, scale, shiftY);
Pen.color = Color.rand(); // *** JUST FOR FUN: pick a random color ***
Pen.addRect(Rect(bigX, bigY, dotSize, dotSize));
Pen.fill;
}; // end-of: do
}; // end-of: drawFunc
win.refresh;
}; // end-of: drawFern
// ==========================================================================
// The following line of code is executed first:
drawFern.();
)
// ==========================================================================
// **END-SuperCollider solution to Rosetta Code TASK: Barnsley fern
// ==========================================================================
</syntaxhighlight>
=={{header|Swift}}==
Line 3,505 ⟶ 4,063:
{{trans|Kotlin}}
{{libheader|DOME}}
<syntaxhighlight lang="
import "dome" for Window
import "random" for Random
Line 3,558 ⟶ 4,116:
var Game = BarnsleyFern.new(640, 640, 200000)</syntaxhighlight>
{{out}}
[[File:Wren-Barnsley_fern.png|400px]]
=={{header|XPL0}}==
| |||