Author Topic: Vector Field Simulator  (Read 188 times)

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 692
  • Savage.
    • Domum
Vector Field Simulator
« on: February 10, 2020, 02:00:40 AM »
Code: QB64: [Select]
  1. CONST Aquamarine = _RGB32(127, 255, 212)
  2. CONST Lime = _RGB32(0, 255, 0)
  3.  
  4.  
  5. SCREEN _NEWIMAGE(600, 600, 32)
  6. DIM SHARED XSize
  7. DIM SHARED YSize
  8. DIM SHARED XCells
  9. DIM SHARED YCells
  10. XSize = INT(_WIDTH / 25)
  11. YSize = INT(_HEIGHT / 25)
  12. XCells = INT(_WIDTH / XSize)
  13. YCells = INT(_HEIGHT / YSize)
  14. NPC = .1 * SQR(XCells * YCells)
  15.  
  16. TYPE Vector
  17.     x AS DOUBLE
  18.     y AS DOUBLE
  19.  
  20. TYPE FieldLine
  21.     Center AS Vector
  22.     Tangent AS Vector
  23.  
  24. TYPE Particle
  25.     Displacement AS Vector
  26.     Velocity AS Vector
  27.     Shade AS _UNSIGNED LONG
  28.  
  29. TYPE Charge
  30.     Center AS Vector
  31.     Gradient AS Vector
  32.     Curl AS Vector
  33.  
  34. DIM VectorField(XCells, YCells) AS FieldLine
  35. DIM Particles(XCells, YCells, NPC) AS Particle
  36. DIM Charges(100) AS Charge
  37. DIM SHARED ChargeCount
  38.  
  39. ChargeCount = 1
  40. Charges(ChargeCount).Center.x = 0
  41. Charges(ChargeCount).Center.y = 0
  42. Charges(ChargeCount).Gradient.x = .05
  43. Charges(ChargeCount).Gradient.y = .05
  44. Charges(ChargeCount).Curl.x = 0
  45. Charges(ChargeCount).Curl.y = 0
  46.  
  47. FOR i = 1 TO XCells
  48.     FOR j = 1 TO YCells
  49.         VectorField(i, j).Center.x = (1 / 2) * XSize * (2 * i - XCells) - XSize / 2
  50.         VectorField(i, j).Center.y = (1 / 2) * YSize * (2 * j - YCells) - YSize / 2
  51.         FOR k = 1 TO NPC
  52.             Particles(i, j, k).Shade = Lime
  53.             Particles(i, j, k).Displacement.x = XSize * (RND - .5)
  54.             Particles(i, j, k).Displacement.y = YSize * (RND - .5)
  55.         NEXT
  56.     NEXT
  57.  
  58. GOSUB ResetVectorField
  59.  
  60.         x = _MOUSEX
  61.         y = _MOUSEY
  62.         IF ((x > 0) AND (x < _WIDTH) AND (y > 0) AND (y < _HEIGHT)) THEN
  63.             Charges(ChargeCount).Center.x = (x - _WIDTH / 2)
  64.             Charges(ChargeCount).Center.y = (-y + _HEIGHT / 2)
  65.             GOSUB ResetVectorField
  66.         END IF
  67.     LOOP
  68.  
  69.     k = _KEYHIT
  70.     SELECT CASE k
  71.         CASE 49
  72.             Charges(ChargeCount).Gradient.x = .05
  73.             Charges(ChargeCount).Gradient.y = .05
  74.             Charges(ChargeCount).Curl.x = 0
  75.             Charges(ChargeCount).Curl.y = 0
  76.         CASE 50
  77.             Charges(ChargeCount).Gradient.x = -.05
  78.             Charges(ChargeCount).Gradient.y = -.05
  79.             Charges(ChargeCount).Curl.x = 0
  80.             Charges(ChargeCount).Curl.y = 0
  81.         CASE 51
  82.             Charges(ChargeCount).Gradient.x = .05
  83.             Charges(ChargeCount).Gradient.y = -.05
  84.             Charges(ChargeCount).Curl.x = 0
  85.             Charges(ChargeCount).Curl.y = 0
  86.         CASE 52
  87.             Charges(ChargeCount).Gradient.x = -.05
  88.             Charges(ChargeCount).Gradient.y = .05
  89.             Charges(ChargeCount).Curl.x = 0
  90.             Charges(ChargeCount).Curl.y = 0
  91.         CASE 53
  92.             Charges(ChargeCount).Gradient.x = 0
  93.             Charges(ChargeCount).Gradient.y = 0
  94.             Charges(ChargeCount).Curl.x = .05
  95.             Charges(ChargeCount).Curl.y = -.05
  96.         CASE 54
  97.             Charges(ChargeCount).Gradient.x = 0
  98.             Charges(ChargeCount).Gradient.y = 0
  99.             Charges(ChargeCount).Curl.x = -.05
  100.             Charges(ChargeCount).Curl.y = .05
  101.         CASE 32
  102.             ChargeCount = ChargeCount + 1
  103.             Charges(ChargeCount).Center.x = Charges(ChargeCount - 1).Center.x
  104.             Charges(ChargeCount).Center.y = Charges(ChargeCount - 1).Center.y
  105.             Charges(ChargeCount).Gradient.x = Charges(ChargeCount - 1).Gradient.x
  106.             Charges(ChargeCount).Gradient.y = Charges(ChargeCount - 1).Gradient.y
  107.             Charges(ChargeCount).Curl.x = Charges(ChargeCount - 1).Curl.x
  108.             Charges(ChargeCount).Curl.y = Charges(ChargeCount - 1).Curl.y
  109.     END SELECT
  110.     IF (k <> 0) THEN
  111.         GOSUB ResetVectorField
  112.     END IF
  113.     _KEYCLEAR
  114.  
  115.     LINE (0, 0)-(_WIDTH, _HEIGHT), _RGBA(0, 0, 0, 20), BF
  116.     CALL cline(0, 0, _WIDTH / 2, 0, Aquamarine)
  117.     CALL cline(0, 0, -_WIDTH / 2, 0, Aquamarine)
  118.     CALL cline(0, 0, 0, _HEIGHT / 2, Aquamarine)
  119.     CALL cline(0, 0, 0, -_HEIGHT / 2, Aquamarine)
  120.  
  121.     LOCATE 1, 1: PRINT "Press 1-6 to change charge type. Press space to fix charge."
  122.     FOR i = 1 TO XCells
  123.         FOR j = 1 TO YCells
  124.             xc = VectorField(i, j).Center.x
  125.             yc = VectorField(i, j).Center.y
  126.             FOR k = 1 TO NPC
  127.                 xd = 0
  128.                 yd = 0
  129.                 xx = Particles(i, j, k).Displacement.x + .1 * Particles(i, j, k).Velocity.x
  130.                 yy = Particles(i, j, k).Displacement.y + .1 * Particles(i, j, k).Velocity.y
  131.                 IF (xx < -XSize / 2) THEN
  132.                     xd = -xx + XSize / 2
  133.                 END IF
  134.                 IF (xx > XSize / 2) THEN
  135.                     xd = -xx - XSize / 2
  136.                 END IF
  137.                 IF (yy < -YSize / 2) THEN
  138.                     yd = -yy + YSize / 2
  139.                 END IF
  140.                 IF (yy > YSize / 2) THEN
  141.                     yd = -yy + -YSize / 2
  142.                 END IF
  143.                 Particles(i, j, k).Displacement.x = xx + xd
  144.                 Particles(i, j, k).Displacement.y = yy + yd
  145.                 CALL cpset(xc + Particles(i, j, k).Displacement.x, yc + Particles(i, j, k).Displacement.y, Particles(i, j, k).Shade)
  146.             NEXT
  147.         NEXT
  148.     NEXT
  149.     _LIMIT 60
  150.     _DISPLAY
  151.  
  152. ResetVectorField:
  153. FOR i = 1 TO XCells
  154.     FOR j = 1 TO YCells
  155.         xx = 0
  156.         yy = 0
  157.         FOR k = 1 TO ChargeCount
  158.             dx = VectorField(i, j).Center.x - Charges(k).Center.x
  159.             dy = VectorField(i, j).Center.y - Charges(k).Center.y
  160.             d2 = 5000 / (dx * dx + dy * dy)
  161.             xx = xx + (Charges(k).Gradient.x * dx * d2) + (Charges(k).Curl.x * dy * d2)
  162.             yy = yy + (Charges(k).Gradient.y * dy * d2) + (Charges(k).Curl.y * dx * d2)
  163.         NEXT
  164.         VectorField(i, j).Tangent.x = xx
  165.         VectorField(i, j).Tangent.y = yy
  166.         FOR k = 1 TO NPC
  167.             Particles(i, j, k).Velocity.x = VectorField(i, j).Tangent.x
  168.             Particles(i, j, k).Velocity.y = VectorField(i, j).Tangent.y
  169.         NEXT
  170.     NEXT
  171.  
  172.  
  173. SUB cline (x1, y1, x2, y2, col)
  174.     LINE (_WIDTH / 2 + x1, -y1 + _HEIGHT / 2)-(_WIDTH / 2 + x2, -y2 + _HEIGHT / 2), col
  175.  
  176. SUB cpset (x1, y1, col)
  177.     PSET (_WIDTH / 2 + x1, -y1 + _HEIGHT / 2), col
  178.  
« Last Edit: February 10, 2020, 02:04:49 AM by STxAxTIC »
An ounce of theory outweighs a pound of code.

Online EricE

  • Newbie
  • Posts: 77
Re: Vector Field Simulator
« Reply #1 on: February 10, 2020, 08:50:12 AM »
Hello STxAxTIC,
I like this program!
Sources, sinks, and rotational motion displayed very nicely.
A good demonstrator for Div, Grad and Curl.
EricE

Offline _vince

  • Forum Regular
  • Posts: 196
Re: Vector Field Simulator
« Reply #2 on: February 16, 2020, 08:46:15 PM »
This kind of thing can look nice with a bunch of little propellers

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 692
  • Savage.
    • Domum
Re: Vector Field Simulator
« Reply #3 on: February 16, 2020, 09:52:56 PM »
Funny thing vince - I thought about doing that to demonstrate the curl... and for that matter i thought about an inflatable membrane that would respond to divergence, but I digress... What I *can* see is maybe making a silly game where you have to get a particle from one part of the screen to the other, along field lines caused by charges. Harder levels would have obstacles so you'd have to get the particle to suck into a magnet and out the other end or whatever... Maybe instead of one particle, you have to take care of a fleet of them like lemmings. Hmm.
An ounce of theory outweighs a pound of code.