Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: AndyA on April 14, 2021, 01:21:46 am

Title: Pythagoras Tree (Rosetta Code task)
Post by: AndyA on April 14, 2021, 01:21:46 am
https://rosettacode.org/wiki/Pythagoras_tree (https://rosettacode.org/wiki/Pythagoras_tree)


'==================================================
Task
Construct a Pythagoras tree of order 7 using only vectors (no rotation or trigonometric functions).
'==================================================


Code: QB64: [Select]
  1. _Title "Pythagoras Tree"
  2.  
  3. Dim As Integer sw, sh
  4. sw = 640
  5. sh = 480
  6.  
  7. Screen _NewImage(sw, sh, 32)
  8.  
  9. Call pythTree(sw / 2 - sw / 12, sh - 30, sw / 2 + sw / 12, sh - 30, 0)
  10.  
  13.  
  14. Sub pythTree (ax As Integer, ay As Integer, bx As Integer, by As Integer, depth As Integer)
  15.     Dim As Single cx, cy, dx, dy, ex, ey
  16.     Dim As Integer c
  17.  
  18.     cx = ax - ay + by
  19.     cy = ax + ay - bx
  20.     dx = bx + by - ay
  21.     dy = ax - bx + by
  22.     ex = (cx - cy + dx + dy) * 0.5
  23.     ey = (cx + cy - dx + dy) * 0.5
  24.     c = depth * 15
  25.     Color _RGB(c Mod 256, Abs((255 - c) Mod 256), (144 + c) Mod 256)
  26.     Line (cx, cy)-(ax, ay)
  27.     Line (ax, ay)-(bx, by)
  28.     Line (bx, by)-(dx, dy)
  29.     Line (dx, dy)-(cx, cy)
  30.     Line (cx, cy)-(ex, ey)
  31.     Line (ex, ey)-(dx, dy)
  32.     If depth < 12 Then
  33.         Call pythTree(cx, cy, ex, ey, depth + 1)
  34.         Call pythTree(ex, ey, dx, dy, depth + 1)
  35.     End If
Title: Re: Pythagoras Tree (Rosetta Code task)
Post by: bplus on April 14, 2021, 01:44:35 pm
The coloring is nice touch!
Title: Re: Pythagoras Tree (Rosetta Code task)
Post by: AndyA on April 14, 2021, 05:45:53 pm
Yeah, too bad no one but people who download and run the source code will see it.
Text Only | Text with Attachments