Author Topic: Filled Circles and Ellipses (collaborative)  (Read 3651 times)

0 Members and 1 Guest are viewing this topic.

Offline Junior Librarian

  • Moderator
  • Newbie
  • Posts: 19
Filled Circles and Ellipses (collaborative)
« on: September 25, 2021, 06:48:06 am »
Filled Circles and Ellipses

Contributor(s): @bplus, @Pete, @SMcNeill, @STxAxTIC
Source: qb64.org Forum
URL: https://www.qb64.org/forum/index.php?topic=1044.0

Description:
We develop four variations on the CIRCLE command in the form of four SUBs:
(i) CircleFill = Filled circle
(ii) EllipseFill = Filled ellipse
(iii) EllipseTilt = Tilted ellipse
(iv) EllipseTiltFill = Tilted and filled ellipse

These works have been optimized for speed and respect for alpha transparency.


Source Code:
Code: QB64: [Select]
  1. SCREEN _NEWIMAGE(800, 600, 32)
  2.  
  3. DIM TransRed AS _UNSIGNED LONG
  4. DIM TransGreen AS _UNSIGNED LONG
  5. DIM TransBlue AS _UNSIGNED LONG
  6. TransRed = _RGBA(255, 0, 0, 128)
  7. TransGreen = _RGBA(0, 255, 0, 128)
  8. TransBlue = _RGBA(0, 0, 255, 128)
  9.  
  10. CALL CircleFill(100, 100, 75, TransRed)
  11. CALL CircleFill(120, 120, 75, TransBlue)
  12.  
  13. CALL EllipseFill(550, 100, 150, 75, TransBlue)
  14. CALL EllipseFill(570, 120, 150, 75, TransGreen)
  15.  
  16. CALL EllipseTilt(200, 400, 150, 75, 0, TransGreen)
  17. CALL EllipseTilt(220, 420, 150, 75, 3.14 / 4, TransRed)
  18.  
  19. CALL EllipseTiltFill(0, 550, 400, 150, 75, 3.14 / 6, TransRed)
  20. CALL EllipseTiltFill(0, 570, 420, 150, 75, 3.14 / 4, TransGreen)
  21.  
  22.  
  23. SUB CircleFill (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
  24.     ' CX = center x coordinate
  25.     ' CY = center y coordinate
  26.     '  R = radius
  27.     '  C = fill color
  28.     DIM Radius AS INTEGER, RadiusError AS INTEGER
  29.     DIM X AS INTEGER, Y AS INTEGER
  30.     Radius = ABS(R)
  31.     RadiusError = -Radius
  32.     X = Radius
  33.     Y = 0
  34.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
  35.     LINE (CX - X, CY)-(CX + X, CY), C, BF
  36.     WHILE X > Y
  37.         RadiusError = RadiusError + Y * 2 + 1
  38.         IF RadiusError >= 0 THEN
  39.             IF X <> Y + 1 THEN
  40.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  41.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  42.             END IF
  43.             X = X - 1
  44.             RadiusError = RadiusError - X * 2
  45.         END IF
  46.         Y = Y + 1
  47.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  48.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  49.     WEND
  50.  
  51. SUB EllipseFill (CX AS INTEGER, CY AS INTEGER, a AS INTEGER, b AS INTEGER, C AS _UNSIGNED LONG)
  52.     ' CX = center x coordinate
  53.     ' CY = center y coordinate
  54.     '  a = semimajor axis
  55.     '  b = semiminor axis
  56.     '  C = fill color
  57.     IF a = 0 OR b = 0 THEN EXIT SUB
  58.     DIM h2 AS _INTEGER64
  59.     DIM w2 AS _INTEGER64
  60.     DIM h2w2 AS _INTEGER64
  61.     DIM x AS INTEGER
  62.     DIM y AS INTEGER
  63.     w2 = a * a
  64.     h2 = b * b
  65.     h2w2 = h2 * w2
  66.     LINE (CX - a, CY)-(CX + a, CY), C, BF
  67.     DO WHILE y < b
  68.         y = y + 1
  69.         x = SQR((h2w2 - y * y * w2) \ h2)
  70.         LINE (CX - x, CY + y)-(CX + x, CY + y), C, BF
  71.         LINE (CX - x, CY - y)-(CX + x, CY - y), C, BF
  72.     LOOP
  73.  
  74. SUB EllipseTilt (CX, CY, a, b, ang, C AS _UNSIGNED LONG)
  75.     '  CX = center x coordinate
  76.     '  CY = center y coordinate
  77.     '   a = semimajor axis
  78.     '   b = semiminor axis
  79.     ' ang = clockwise orientation of semimajor axis in radians (0 default)
  80.     '   C = fill color
  81.     FOR k = 0 TO 6.283185307179586 + .025 STEP .025
  82.         i = a * COS(k) * COS(ang) + b * SIN(k) * SIN(ang)
  83.         j = -a * COS(k) * SIN(ang) + b * SIN(k) * COS(ang)
  84.         i = i + CX
  85.         j = -j + CY
  86.         IF k <> 0 THEN
  87.             LINE -(i, j), C
  88.         ELSE
  89.             PSET (i, j), C
  90.         END IF
  91.     NEXT
  92.  
  93. SUB EllipseTiltFill (destHandle&, CX, CY, a, b, ang, C AS _UNSIGNED LONG)
  94.     '  destHandle& = destination handle
  95.     '  CX = center x coordinate
  96.     '  CY = center y coordinate
  97.     '   a = semimajor axis
  98.     '   b = semiminor axis
  99.     ' ang = clockwise orientation of semimajor axis in radians (0 default)
  100.     '   C = fill color
  101.     DIM max AS INTEGER, mx2 AS INTEGER, i AS INTEGER, j AS INTEGER
  102.     DIM prc AS _UNSIGNED LONG
  103.     DIM D AS INTEGER, S AS INTEGER
  104.     D = _DEST: S = _SOURCE
  105.     prc = _RGB32(255, 255, 255, 255)
  106.     IF a > b THEN max = a + 1 ELSE max = b + 1
  107.     mx2 = max + max
  108.     tef& = _NEWIMAGE(mx2, mx2)
  109.     _DEST tef&
  110.     _SOURCE tef&
  111.     FOR k = 0 TO 6.283185307179586 + .025 STEP .025
  112.         i = max + a * COS(k) * COS(ang) + b * SIN(k) * SIN(ang)
  113.         j = max + a * COS(k) * SIN(ang) - b * SIN(k) * COS(ang)
  114.         IF k <> 0 THEN
  115.             LINE (lasti, lastj)-(i, j), prc
  116.         ELSE
  117.             PSET (i, j), prc
  118.         END IF
  119.         lasti = i: lastj = j
  120.     NEXT
  121.     DIM xleft(mx2) AS INTEGER, xright(mx2) AS INTEGER, x AS INTEGER, y AS INTEGER
  122.     FOR y = 0 TO mx2
  123.         x = 0
  124.         WHILE POINT(x, y) <> prc AND x < mx2
  125.             x = x + 1
  126.         WEND
  127.         xleft(y) = x
  128.         WHILE POINT(x, y) = prc AND x < mx2
  129.             x = x + 1
  130.         WEND
  131.         WHILE POINT(x, y) <> prc AND x < mx2
  132.             x = x + 1
  133.         WEND
  134.         IF x = mx2 THEN xright(y) = xleft(y) ELSE xright(y) = x
  135.     NEXT
  136.     _DEST destHandle&
  137.     FOR y = 0 TO mx2
  138.         IF xleft(y) <> mx2 THEN LINE (xleft(y) + CX - max, y + CY - max)-(xright(y) + CX - max, y + CY - max), C, BF
  139.     NEXT
  140.     _DEST D: _DEST S
  141.     _FREEIMAGE tef&
  142.  

Attachments:
 
                                                                                                                                         (191 downloads previously)

Ellipses.png
« Last Edit: September 25, 2021, 06:53:46 am by Junior Librarian »