Barnsley fern: Difference between revisions
Added uBasic/4tH version
(→{{header|Wren}}: Added image) |
4thcompiler (talk | contribs) (Added uBasic/4tH version) |
||
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.
<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>
=={{header|C}}==
| |||