Vector Field Simulator

[STxAxTIC]

Code: QB64: [Select]

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

[EricE]

Hello STxAxTIC,
I like this program!
Sources, sinks, and rotational motion displayed very nicely.
A good demonstrator for Div, Grad and Curl.
EricE

[_vince]

This kind of thing can look nice with a bunch of little propellers

[STxAxTIC]

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.