Author Topic: Draw Spinners by bplus  (Read 6842 times)

0 Members and 1 Guest are viewing this topic.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Draw Spinners by bplus
« on: March 01, 2020, 04:40:43 pm »
Author: bplus
Source: qb64.org Forum
URL: https://www.qb64.org/forum/index.php?topic=1431
Version: QB64
Tags:  [graphics] [screen saver]

Description:
Give it a second for things to develop, to quit just press escape. SMcNeill and Petr offered mods see URL.

Code: QB64: [Select]
  1. _TITLE "draw Spinner" 'B+ started 2019-06-15
  2. DIM i, i2, lc, sc&
  3.  
  4. CONST nSpinners = 100
  5. TYPE SpinnerType
  6.     x AS SINGLE
  7.     y AS SINGLE
  8.     dx AS SINGLE
  9.     dy AS SINGLE
  10.     sz AS SINGLE
  11.     c AS _UNSIGNED LONG
  12.  
  13. DIM SHARED s(1 TO nSpinners) AS SpinnerType
  14.  
  15.  
  16. SCREEN _NEWIMAGE(xmax, ymax, 32)
  17. '_SCREENMOVE 300, 20
  18.  
  19.  
  20. COLOR , &HFFAABBCC
  21. FOR i = 1 TO nSpinners
  22.     newSpinner i
  23. i2 = 1
  24.     _PUTIMAGE , sc&
  25.     lc = lc + 1
  26.     IF lc MOD 100 = 99 THEN
  27.         lc = 0
  28.         IF i2 < nSpinners THEN i2 = i2 + 1
  29.     END IF
  30.     FOR i = 1 TO i2
  31.         drawSpinner s(i).x, s(i).y, s(i).sz, _ATAN2(s(i).dy, s(i).dx), s(i).c
  32.         s(i).x = s(i).x + s(i).dx: s(i).y = s(i).y + s(i).dy
  33.         IF s(i).x < -100 OR s(i).x > xmax + 100 OR s(i).y < -100 OR s(i).y > ymax + 100 THEN newSpinner i
  34.     NEXT
  35.     _DISPLAY
  36.     _LIMIT 15
  37.  
  38. SUB newSpinner (i AS INTEGER) 'set Spinners dimensions start angles, color?
  39.     DIM r
  40.     s(i).sz = RND * .25 + .5
  41.     IF RND < .5 THEN r = -1 ELSE r = 1
  42.     s(i).dx = (s(i).sz * RND * 8) * r * 2: s(i).dy = (s(i).sz * RND * 8) * r * 2
  43.     r = INT(RND * 4)
  44.     SELECT CASE r
  45.         CASE 0: s(i).x = RND * (xmax - 120) + 60: s(i).y = 0: IF s(i).dy < 0 THEN s(i).dy = -s(i).dy
  46.         CASE 1: s(i).x = RND * (xmax - 120) + 60: s(i).y = ymax: IF s(i).dy > 0 THEN s(i).dy = -s(i).dy
  47.         CASE 2: s(i).x = 0: s(i).y = RND * (ymax - 120) + 60: IF s(i).dx < 0 THEN s(i).dx = -s(i).dx
  48.         CASE 3: s(i).x = xmax: s(i).y = RND * (ymax - 120) + 60: IF s(i).dx > 0 THEN s(i).dx = -s(i).dx
  49.     END SELECT
  50.     r = RND * 120
  51.     s(i).c = _RGB32(r, RND * .5 * r, RND * .25 * r)
  52.  
  53. SUB drawSpinner (x AS INTEGER, y AS INTEGER, scale AS SINGLE, heading AS SINGLE, c AS _UNSIGNED LONG)
  54.     DIM x1, x2, x3, x4, y1, y2, y3, y4, r, a, a1, a2, lg, d, rd, red, blue, green
  55.     STATIC switch AS INTEGER
  56.     switch = switch + 2
  57.     switch = switch MOD 16 + 1
  58.     red = _RED32(c): green = _GREEN32(c): blue = _BLUE32(c)
  59.     r = 10 * scale
  60.     x1 = x + r * COS(heading): y1 = y + r * SIN(heading)
  61.     r = 2 * r 'lg lengths
  62.     FOR lg = 1 TO 8
  63.         IF lg < 5 THEN
  64.             a = heading + .9 * lg * _PI(1 / 5) + (lg = switch) * _PI(1 / 10)
  65.         ELSE
  66.             a = heading - .9 * (lg - 4) * _PI(1 / 5) - (lg = switch) * _PI(1 / 10)
  67.         END IF
  68.         x2 = x1 + r * COS(a): y2 = y1 + r * SIN(a)
  69.         drawLink x1, y1, 3 * scale, x2, y2, 2 * scale, _RGB32(red + 20, green + 10, blue + 5)
  70.         IF lg = 1 OR lg = 2 OR lg = 7 OR lg = 8 THEN d = -1 ELSE d = 1
  71.         a1 = a + d * _PI(1 / 12)
  72.         x3 = x2 + r * 1.5 * COS(a1): y3 = y2 + r * 1.5 * SIN(a1)
  73.         drawLink x2, y2, 2 * scale, x3, y3, scale, _RGB32(red + 35, green + 17, blue + 8)
  74.         rd = INT(RND * 8) + 1
  75.         a2 = a1 + d * _PI(1 / 8) * rd / 8
  76.         x4 = x3 + r * 1.5 * COS(a2): y4 = y3 + r * 1.5 * SIN(a2)
  77.         drawLink x3, y3, scale, x4, y4, scale, _RGB32(red + 50, green + 25, blue + 12)
  78.     NEXT
  79.     r = r * .5
  80.     fcirc x1, y1, r, _RGB32(red - 20, green - 10, blue - 5)
  81.     x2 = x1 + (r + 1) * COS(heading - _PI(1 / 12)): y2 = y1 + (r + 1) * SIN(heading - _PI(1 / 12))
  82.     fcirc x2, y2, r * .2, &HFF000000
  83.     x2 = x1 + (r + 1) * COS(heading + _PI(1 / 12)): y2 = y1 + (r + 1) * SIN(heading + _PI(1 / 12))
  84.     fcirc x2, y2, r * .2, &HFF000000
  85.     r = r * 2
  86.     x1 = x + r * .9 * COS(heading + _PI): y1 = y + r * .9 * SIN(heading + _PI)
  87.     TiltedEllipseFill 0, x1, y1, r, .7 * r, heading + _PI, _RGB32(red, green, blue)
  88.  
  89. SUB drawLink (x1, y1, r1, x2, y2, r2, c AS _UNSIGNED LONG)
  90.     DIM a, a1, a2, x3, x4, x5, x6, y3, y4, y5, y6
  91.     a = _ATAN2(y2 - y1, x2 - x1)
  92.     a1 = a + _PI(1 / 2)
  93.     a2 = a - _PI(1 / 2)
  94.     x3 = x1 + r1 * COS(a1): y3 = y1 + r1 * SIN(a1)
  95.     x4 = x1 + r1 * COS(a2): y4 = y1 + r1 * SIN(a2)
  96.     x5 = x2 + r2 * COS(a1): y5 = y2 + r2 * SIN(a1)
  97.     x6 = x2 + r2 * COS(a2): y6 = y2 + r2 * SIN(a2)
  98.     fquad x3, y3, x4, y4, x5, y5, x6, y6, c
  99.     fcirc x1, y1, r1, c
  100.     fcirc x2, y2, r2, c
  101.  
  102. 'need 4 non linear points (not all on 1 line) list them clockwise so x2, y2 is opposite of x4, y4
  103. SUB fquad (x1 AS INTEGER, y1 AS INTEGER, x2 AS INTEGER, y2 AS INTEGER, x3 AS INTEGER, y3 AS INTEGER, x4 AS INTEGER, y4 AS INTEGER, c AS _UNSIGNED LONG)
  104.     ftri x1, y1, x2, y2, x4, y4, c
  105.     ftri x3, y3, x4, y4, x1, y1, c
  106.  
  107. SUB ftri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
  108.     DIM a&
  109.     a& = _NEWIMAGE(1, 1, 32)
  110.     _DEST a&
  111.     PSET (0, 0), K
  112.     _DEST 0
  113.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
  114.     _FREEIMAGE a& '<<< this is important!
  115.  
  116. SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
  117.     DIM Radius AS INTEGER, RadiusError AS INTEGER
  118.     DIM X AS INTEGER, Y AS INTEGER
  119.     Radius = ABS(R): RadiusError = -Radius: X = Radius: Y = 0
  120.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
  121.     LINE (CX - X, CY)-(CX + X, CY), C, BF
  122.     WHILE X > Y
  123.         RadiusError = RadiusError + Y * 2 + 1
  124.         IF RadiusError >= 0 THEN
  125.             IF X <> Y + 1 THEN
  126.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  127.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  128.             END IF
  129.             X = X - 1
  130.             RadiusError = RadiusError - X * 2
  131.         END IF
  132.         Y = Y + 1
  133.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  134.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  135.     WEND
  136.  
  137. SUB TiltedEllipseFill (destHandle&, x0, y0, a, b, ang, c AS _UNSIGNED LONG)
  138.     DIM max AS INTEGER, mx2 AS INTEGER, i AS INTEGER, j AS INTEGER, k AS SINGLE, lasti AS SINGLE, lastj AS SINGLE
  139.     DIM prc AS _UNSIGNED LONG, tef AS LONG
  140.     prc = _RGB32(255, 255, 255, 255)
  141.     IF a > b THEN max = a + 1 ELSE max = b + 1
  142.     mx2 = max + max
  143.     tef = _NEWIMAGE(mx2, mx2)
  144.     _DEST tef
  145.     _SOURCE tef 'point wont read without this!
  146.     FOR k = 0 TO 6.2832 + .05 STEP .1
  147.         i = max + a * COS(k) * COS(ang) + b * SIN(k) * SIN(ang)
  148.         j = max + a * COS(k) * SIN(ang) - b * SIN(k) * COS(ang)
  149.         IF k <> 0 THEN
  150.             LINE (lasti, lastj)-(i, j), prc
  151.         ELSE
  152.             PSET (i, j), prc
  153.         END IF
  154.         lasti = i: lastj = j
  155.     NEXT
  156.     DIM xleft(mx2) AS INTEGER, xright(mx2) AS INTEGER, x AS INTEGER, y AS INTEGER
  157.     FOR y = 0 TO mx2
  158.         x = 0
  159.         WHILE POINT(x, y) <> prc AND x < mx2
  160.             x = x + 1
  161.         WEND
  162.         xleft(y) = x
  163.         WHILE POINT(x, y) = prc AND x < mx2
  164.             x = x + 1
  165.         WEND
  166.         WHILE POINT(x, y) <> prc AND x < mx2
  167.             x = x + 1
  168.         WEND
  169.         IF x = mx2 THEN xright(y) = xleft(y) ELSE xright(y) = x
  170.     NEXT
  171.     _DEST destHandle&
  172.     FOR y = 0 TO mx2
  173.         IF xleft(y) <> mx2 THEN LINE (xleft(y) + x0 - max, y + y0 - max)-(xright(y) + x0 - max, y + y0 - max), c, BF
  174.     NEXT
  175.     _FREEIMAGE tef
  176.  
  177.  
« Last Edit: March 03, 2020, 12:18:19 pm by Qwerkey »