Author Topic: Sierpinski Carpet (Rosetta Code task)  (Read 2903 times)

0 Members and 1 Guest are viewing this topic.

Offline AndyA

  • Newbie
  • Posts: 73
    • View Profile
Sierpinski Carpet (Rosetta Code task)
« on: April 16, 2021, 12:06:09 am »
https://rosettacode.org/wiki/Sierpinski_carpet#QB64

'==================================================
Task
Produce a graphical or ASCII-art representation of a Sierpinski carpet of order   N.
'==================================================

I produced the graphical option.

Code: QB64: [Select]
  1. _Title "Sierpinski Carpet"
  2.  
  3. Screen _NewImage(500, 545, 8)
  4. Cls , 15: Color 1, 15
  5.  
  6. 'labels
  7. _PrintString (96, 8), "Order 0"
  8. _PrintString (345, 8), "Order 1"
  9. _PrintString (96, 280), "Order 3"
  10. _PrintString (345, 280), "Order 4"
  11.  
  12. 'carpets
  13. Call carpet(5, 20, 243, 0)
  14. Call carpet(253, 20, 243, 1)
  15. Call carpet(5, 293, 243, 2)
  16. Call carpet(253, 293, 243, 3)
  17.  
  18.  
  19. Sub carpet (x As Integer, y As Integer, size As Integer, order As Integer)
  20.     Dim As Integer ix, iy, isize, iorder, side, newX, newY
  21.     ix = x: iy = y: isize = size: iorder = order
  22.     Line (ix, iy)-(ix + isize - 1, iy + isize - 1), 1, BF
  23.  
  24.     side = Int(isize / 3)
  25.     newX = ix + side
  26.     newY = iy + side
  27.     Line (newX, newY)-(newX + side - 1, newY + side - 1), 15, BF
  28.     iorder = iorder - 1
  29.     If iorder >= 0 Then
  30.         Call carpet(newX - side, newY - side + 1, side, iorder)
  31.         Call carpet(newX, newY - side + 1, side, iorder)
  32.         Call carpet(newX + side, newY - side + 1, side, iorder)
  33.         Call carpet(newX + side, newY, side, iorder)
  34.         Call carpet(newX + side, newY + side, side, iorder)
  35.         Call carpet(newX, newY + side, side, iorder)
  36.         Call carpet(newX - side, newY + side, side, iorder)
  37.         Call carpet(newX - side, newY, side, iorder)
  38.     End If