RosettaCodeData/Task/Pythagoras-tree/QB64/pythagoras-tree.qb64
2023-07-01 13:44:08 -04:00

36 lines
886 B
Text

_Title "Pythagoras Tree"
Dim As Integer sw, sh
sw = 640
sh = 480
Screen _NewImage(sw, sh, 32)
Call pythTree(sw / 2 - sw / 12, sh - 30, sw / 2 + sw / 12, sh - 30, 0)
Sleep
System
Sub pythTree (ax As Integer, ay As Integer, bx As Integer, by As Integer, depth As Integer)
Dim As Single cx, cy, dx, dy, ex, ey
Dim As Integer c
cx = ax - ay + by
cy = ax + ay - bx
dx = bx + by - ay
dy = ax - bx + by
ex = (cx - cy + dx + dy) * 0.5
ey = (cx + cy - dx + dy) * 0.5
c = depth * 15
Color _RGB(c Mod 256, Abs((255 - c)) Mod 256, (144 + c) Mod 256)
Line (cx, cy)-(ax, ay)
Line (ax, ay)-(bx, by)
Line (bx, by)-(dx, dy)
Line (dx, dy)-(cx, cy)
Line (cx, cy)-(ex, ey)
Line (ex, ey)-(dx, dy)
If depth < 12 Then
Call pythTree(cx, cy, ex, ey, depth + 1)
Call pythTree(ex, ey, dx, dy, depth + 1)
End If
End Sub