Author Topic: Lissajous Curve Table by FellippeHeitor  (Read 3966 times)

0 Members and 1 Guest are viewing this topic.

Offline Qwerkey

  • Forum Resident
  • Posts: 755
Lissajous Curve Table by FellippeHeitor
« on: March 10, 2020, 11:00:24 am »
Lissajous Curve Table

Author: @FellippeHeitor
Source: qb64.org Forum
URL: https://www.qb64.org/forum/index.php?topic=683.0
Version: « Reply #8 on: October 09, 2018, 02:48:07 PM »
Tags: [2D], [Graphics], [Mathematics]

Description:
Graphical Lissajou's Figures.  For added eye-candy-ness, I've changed the plot line to paint using HSB colors so that ink color will vary according to the current rotational angle.

Source Code:
Code: QB64: [Select]
  1. _TITLE "Lissajous Curve Table"
  2.  
  3.  
  4. TYPE vector
  5.     x AS SINGLE
  6.     y AS SINGLE
  7.  
  8. DIM SHARED angle
  9. DIM SHARED rows, cols
  10.  
  11. SCREEN _NEWIMAGE(800, 800, 32)
  12.  
  13. setup:
  14. angle = 0
  15. w = 80
  16. rows = INT(_HEIGHT / w) - 1
  17. cols = INT(_WIDTH / w) - 1
  18. REDIM dot(rows, cols) AS vector
  19.  
  20. plot = _NEWIMAGE(_WIDTH, _HEIGHT, 32)
  21. _DEST plot
  22.  
  23.         oldScreen = _DEST
  24.         _FREEIMAGE oldScreen
  25.         _FREEIMAGE plot
  26.         GOTO setup
  27.     END IF
  28.  
  29.     _PUTIMAGE , plot
  30.  
  31.     d = w - 0.2 * w
  32.     r = d / 2
  33.  
  34.     FOR i = 0 TO cols
  35.         cx = w + i * w + w / 2
  36.         cy = w / 2
  37.         CIRCLE (cx, cy), r
  38.  
  39.         x = r * COS(angle * (i + 1) - _PI(.5))
  40.         y = r * SIN(angle * (i + 1) - _PI(.5))
  41.  
  42.         LINE (cx + x, 0)-(cx + x, _HEIGHT), _RGB32(127, 127, 127)
  43.         CircleFill cx + x, cy + y, 4, _RGB32(28, 222, 50)
  44.         CircleFill cx + x, cy + y, 2, _RGB32(11, 33, 249)
  45.  
  46.         FOR j = 0 TO rows
  47.             dot(j, i).x = cx + x
  48.         NEXT
  49.     NEXT
  50.  
  51.     FOR i = 0 TO rows
  52.         cx = w / 2
  53.         cy = w + i * w + w / 2
  54.         CIRCLE (cx, cy), r
  55.  
  56.         x = r * COS(angle * (i + 1) - _PI(.5))
  57.         y = r * SIN(angle * (i + 1) - _PI(.5))
  58.  
  59.         LINE (0, cy + y)-(_WIDTH, cy + y), _RGB32(127, 127, 127)
  60.         CircleFill cx + x, cy + y, 4, _RGB32(28, 222, 50)
  61.         CircleFill cx + x, cy + y, 2, _RGB32(11, 33, 249)
  62.  
  63.         FOR j = 0 TO cols
  64.             dot(i, j).y = cy + y
  65.         NEXT
  66.     NEXT
  67.  
  68.     _DEST plot
  69.     LINE (0, 0)-(_WIDTH, _HEIGHT), _RGBA32(0, 0, 0, 4), BF
  70.     FOR j = 0 TO rows
  71.         FOR i = 0 TO cols
  72.             CircleFill dot(j, i).x, dot(j, i).y, 1, hsb(_R2D(angle), 127, 127, 255)
  73.         NEXT
  74.     NEXT
  75.  
  76.     angle = angle + 0.01
  77.     IF angle > _PI(2) THEN angle = 0
  78.  
  79.     _DEST 0
  80.  
  81.     _DISPLAY
  82.     _LIMIT 30
  83.  
  84. SUB CircleFill (x AS LONG, y AS LONG, R AS LONG, C AS _UNSIGNED LONG)
  85.     DIM x0 AS SINGLE, y0 AS SINGLE
  86.     DIM e AS SINGLE
  87.  
  88.     x0 = R
  89.     y0 = 0
  90.     e = -R
  91.     DO WHILE y0 < x0
  92.         IF e <= 0 THEN
  93.             y0 = y0 + 1
  94.             LINE (x - x0, y + y0)-(x + x0, y + y0), C, BF
  95.             LINE (x - x0, y - y0)-(x + x0, y - y0), C, BF
  96.             e = e + 2 * y0
  97.         ELSE
  98.             LINE (x - y0, y - x0)-(x + y0, y - x0), C, BF
  99.             LINE (x - y0, y + x0)-(x + y0, y + x0), C, BF
  100.             x0 = x0 - 1
  101.             e = e - 2 * x0
  102.         END IF
  103.     LOOP
  104.     LINE (x - R, y)-(x + R, y), C, BF
  105.  
  106. FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
  107.     map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
  108.  
  109. FUNCTION hsb~& (__H AS _FLOAT, __S AS _FLOAT, __B AS _FLOAT, A AS _FLOAT)
  110.     DIM H AS _FLOAT, S AS _FLOAT, B AS _FLOAT
  111.  
  112.     H = map(__H, 0, 255, 0, 360)
  113.     S = map(__S, 0, 255, 0, 1)
  114.     B = map(__B, 0, 255, 0, 1)
  115.  
  116.     IF S = 0 THEN
  117.         hsb~& = _RGBA32(B * 255, B * 255, B * 255, A)
  118.         EXIT FUNCTION
  119.     END IF
  120.  
  121.     DIM fmx AS _FLOAT, fmn AS _FLOAT
  122.     DIM fmd AS _FLOAT, iSextant AS INTEGER
  123.     DIM imx AS INTEGER, imd AS INTEGER, imn AS INTEGER
  124.  
  125.     IF B > .5 THEN
  126.         fmx = B - (B * S) + S
  127.         fmn = B + (B * S) - S
  128.     ELSE
  129.         fmx = B + (B * S)
  130.         fmn = B - (B * S)
  131.     END IF
  132.  
  133.     iSextant = INT(H / 60)
  134.  
  135.     IF H >= 300 THEN
  136.         H = H - 360
  137.     END IF
  138.  
  139.     H = H / 60
  140.     H = H - (2 * INT(((iSextant + 1) MOD 6) / 2))
  141.  
  142.     IF iSextant MOD 2 = 0 THEN
  143.         fmd = (H * (fmx - fmn)) + fmn
  144.     ELSE
  145.         fmd = fmn - (H * (fmx - fmn))
  146.     END IF
  147.  
  148.     imx = _ROUND(fmx * 255)
  149.     imd = _ROUND(fmd * 255)
  150.     imn = _ROUND(fmn * 255)
  151.  
  152.     SELECT CASE INT(iSextant)
  153.         CASE 1
  154.             hsb~& = _RGBA32(imd, imx, imn, A)
  155.         CASE 2
  156.             hsb~& = _RGBA32(imn, imx, imd, A)
  157.         CASE 3
  158.             hsb~& = _RGBA32(imn, imd, imx, A)
  159.         CASE 4
  160.             hsb~& = _RGBA32(imd, imn, imx, A)
  161.         CASE 5
  162.             hsb~& = _RGBA32(imx, imn, imd, A)
  163.         CASE ELSE
  164.             hsb~& = _RGBA32(imx, imd, imn, A)
  165.     END SELECT
  166.  
  167.  

 
Lissajou's Figures Screenshot.jpg
« Last Edit: March 27, 2020, 05:58:15 am by Qwerkey »