Author Topic: Pythagoras Tree (Rosetta Code task)  (Read 3054 times)

0 Members and 1 Guest are viewing this topic.

Offline AndyA

  • Newbie
  • Posts: 73
    • View Profile
Pythagoras Tree (Rosetta Code task)
« on: April 14, 2021, 01:21:46 am »
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.  
  11.  
  12. Sub pythTree (ax As Integer, ay As Integer, bx As Integer, by As Integer, depth As Integer)
  13.     Dim As Single cx, cy, dx, dy, ex, ey
  14.     Dim As Integer c
  15.  
  16.     cx = ax - ay + by
  17.     cy = ax + ay - bx
  18.     dx = bx + by - ay
  19.     dy = ax - bx + by
  20.     ex = (cx - cy + dx + dy) * 0.5
  21.     ey = (cx + cy - dx + dy) * 0.5
  22.     c = depth * 15
  23.     Color _RGB(c Mod 256, Abs((255 - c) Mod 256), (144 + c) Mod 256)
  24.     Line (cx, cy)-(ax, ay)
  25.     Line (ax, ay)-(bx, by)
  26.     Line (bx, by)-(dx, dy)
  27.     Line (dx, dy)-(cx, cy)
  28.     Line (cx, cy)-(ex, ey)
  29.     Line (ex, ey)-(dx, dy)
  30.     If depth < 12 Then
  31.         Call pythTree(cx, cy, ex, ey, depth + 1)
  32.         Call pythTree(ex, ey, dx, dy, depth + 1)
  33.     End If

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Pythagoras Tree (Rosetta Code task)
« Reply #1 on: April 14, 2021, 01:44:35 pm »
The coloring is nice touch!

Offline AndyA

  • Newbie
  • Posts: 73
    • View Profile
Re: Pythagoras Tree (Rosetta Code task)
« Reply #2 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.