Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: AndyA on April 16, 2021, 12:06:09 am

Title: Sierpinski Carpet (Rosetta Code task)
Post by: AndyA on April 16, 2021, 12:06:09 am
https://rosettacode.org/wiki/Sierpinski_carpet#QB64 (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.  
  20.  
  21. Sub carpet (x As Integer, y As Integer, size As Integer, order As Integer)
  22.     Dim As Integer ix, iy, isize, iorder, side, newX, newY
  23.     ix = x: iy = y: isize = size: iorder = order
  24.     Line (ix, iy)-(ix + isize - 1, iy + isize - 1), 1, BF
  25.  
  26.     side = Int(isize / 3)
  27.     newX = ix + side
  28.     newY = iy + side
  29.     Line (newX, newY)-(newX + side - 1, newY + side - 1), 15, BF
  30.     iorder = iorder - 1
  31.     If iorder >= 0 Then
  32.         Call carpet(newX - side, newY - side + 1, side, iorder)
  33.         Call carpet(newX, newY - side + 1, side, iorder)
  34.         Call carpet(newX + side, newY - side + 1, side, iorder)
  35.         Call carpet(newX + side, newY, side, iorder)
  36.         Call carpet(newX + side, newY + side, side, iorder)
  37.         Call carpet(newX, newY + side, side, iorder)
  38.         Call carpet(newX - side, newY + side, side, iorder)
  39.         Call carpet(newX - side, newY, side, iorder)
  40.     End If
Text Only | Text with Attachments