Rosetta Code

Pythagoras tree: Difference between revisions

Page Discussion

Pythagoras tree (view source)

Revision as of 18:26, 18 December 2023

3,394 bytes removed ,  6 months ago
→‎{{header|uBasic/4tH}}
imported>Thebeez
(Added uBasic/4tH version)
imported>Thebeez
Line 2,441:
{{out}}
[[File:PythtreeXPL0.gif]]
 
=={{header|uBasic/4tH}}==
{{trans|BASIC256}}
<syntaxhighlight lang="qbasic">Dim @o(5) ' 0 = SVG file, 1 = color, 2 = fillcolor, 3 = pixel, 4 = text
 
' === Begin Program ===
 
w = 800 : h = w * 11 / 16
v = w / 2 : d = w / 12
 
Proc _SVGopen ("pythtree.svg") ' open the SVG file
Proc _Canvas (w, h) ' set the canvas size
Proc _Background (FUNC(_Color ("White")))
' we have a white background
Proc _Pythagoras_tree (v - d, h - 10, v + d, h - 10, 0)
Proc _SVGclose
End
 
_Pythagoras_tree
Param (5)
Local (8)
 
If e@ > 10 Then Return
 
f@ = c@ - a@ : g@ = b@ - d@
h@ = c@ - g@ : i@ = d@ - f@
j@ = a@ - g@ : k@ = b@ - f@
l@ = j@ + (f@ - g@) / 2
m@ = k@ - (f@ + g@) / 2
 
Proc _SetColor (FUNC(_RGBtoColor (0, e@*25, 0)))
' draw the box
Proc _Line (b@, a@, d@, c@) : Proc _Line (d@, c@, i@, h@)
Proc _Line (i@, h@, k@, j@) : Proc _Line (k@, j@, b@, a@)
 
Proc _Pythagoras_tree (j@, k@, l@, m@, e@ +1)
Proc _Pythagoras_tree (l@, m@, h@, i@, e@ +1)
Return
 
' === End Program ===
 
_RGBtoColor Param (3) : Return (a@ * 65536 + b@ * 256 + c@)
_SetColor Param (1) : @o(1) = a@ : Return
_SVGclose Write @o(0), "</svg>" : Close @o(0) : Return
_color_ Param (1) : Proc _PrintRGB (a@) : Write @o(0), "\q />" : Return
 
_PrintRGB ' print an RBG color in hex
Param (1)
Radix 16
 
If a@ < 0 Then
Write @o(0), "none";
Else
Write @o(0), Show(Str ("#!######", a@));
EndIf
 
Radix 10
Return
 
_Background ' set the background color
Param (1)
 
Write @o(0), "<rect width=\q100%\q height=\q100%\q fill=\q";
Proc _color_ (a@)
Return
 
_Color ' retrieve color code from its name
Param (1)
Local (1)
Radix 16
 
if Comp(a@, "black") = 0 Then
b@ = 000000
else if Comp(a@, "blue") = 0 Then
b@ = 0000ff
else if Comp(a@, "green") = 0 Then
b@ = 00ff00
else if Comp(a@, "cyan") = 0 Then
b@ = 00ffff
else if Comp(a@, "red") = 0 Then
b@ = 0ff0000
else if Comp(a@, "magenta") = 0 Then
b@ = 0ff00ff
else if Comp(a@, "yellow") = 0 Then
b@ = 0ffff00
else if Comp(a@, "white") = 0 Then
b@ = 0ffffff
else if Comp(a@, "none") = 0 Then
b@ = Info ("nil")
else Print "Invalid color" : Raise 1
fi : fi : fi : fi : fi : fi : fi : fi : fi
 
Radix 10
Return (b@)
 
_Line ' draw an SVG line from x1,y1 to x2,y2
Param (4)
 
Write @o(0), "<line x1=\q";d@;"\q y1=\q";c@;
Write @o(0), "\q x2=\q";b@;"\q y2=\q";a@;"\q stroke=\q";
Proc _color_ (@o(1))
Return
 
_Canvas ' set up a canvas x wide and y high
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 ' open an SVG file by name
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|Yabasic}}==
Anonymous user
Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/351235"