Scalar Field

[STxAxTIC]

Code: QB64: [Select]

1. OPTION _EXPLICIT
2.  
3. DO UNTIL _SCREENEXISTS: LOOP
4. _TITLE "Scalar Field"
5.  
6. SCREEN _NEWIMAGE(800, 600, 32)
7. RANDOMIZE TIMER
8.  
9. TYPE Vector
10.     x AS DOUBLE
11.     y AS DOUBLE
12. END TYPE
13.  
14. DIM SHARED Position(10) AS Vector
15. DIM SHARED Velocity(10) AS Vector
16. DIM AS INTEGER j, k
17. DIM AS DOUBLE f, f1, f3, f7, f9, g
18.  
19. FOR j = 1 TO UBOUND(Position)
20.     Position(j).x = _WIDTH * (RND - .5)
21.     Position(j).y = _HEIGHT * (RND - .5)
22.     Velocity(j).x = 5 * (RND - .5)
23.     Velocity(j).y = 5 * (RND - .5)
24. NEXT
25.  
26. DO
27.     CLS
28.  
29.     FOR j = 1 TO UBOUND(Position)
30.         Position(j).x = Position(j).x + Velocity(j).x
31.         Position(j).y = Position(j).y + Velocity(j).y
32.         IF (Position(j).x < -_WIDTH / 2) THEN Velocity(j).x = -Velocity(j).x
33.         IF (Position(j).x > _WIDTH / 2) THEN Velocity(j).x = -Velocity(j).x
34.         IF (Position(j).y < -_HEIGHT / 2) THEN Velocity(j).y = -Velocity(j).y
35.         IF (Position(j).y > _HEIGHT / 2) THEN Velocity(j).y = -Velocity(j).y
36.     NEXT
37.  
38.     FOR j = -_WIDTH / 2 TO _WIDTH / 2 STEP 10
39.         FOR k = -_HEIGHT / 2 TO _HEIGHT / 2 STEP 10
40.             f = 15 * CalcPotential#(j, k)
41.             CALL CCircle(j, k, 4, _RGB(255 * f, 255 * f / 2, 255 * f / 4))
42.             'NEXT
43.             'NEXT
44.  
45.             'FOR j = -_WIDTH / 2 TO _WIDTH / 2 STEP 10
46.             'FOR k = -_HEIGHT / 2 TO _HEIGHT / 2 STEP 10
47.             f1 = 10 * CalcPotential#(j - 5, k - 5)
48.             f3 = 10 * CalcPotential#(j + 5, k - 5)
49.             f7 = 10 * CalcPotential#(j - 5, k + 5)
50.             f9 = 10 * CalcPotential#(j + 5, k + 5)
51.             FOR g = .15 TO .65 STEP .1
52.                 f = .5
53.                 IF (f1 > g) AND (f3 > g) AND (f7 > g) AND (f9 > g) THEN f = 1
54.                 IF (f1 < g) AND (f3 < g) AND (f7 < g) AND (f9 < g) THEN f = 0
55.                 IF (f = .5) THEN
56.                     IF (f1 < g) AND (f3 < g) AND (f7 > g) AND (f9 > g) THEN CALL CLine(j - 5, k, j + 5, k, _RGB(255, 255, 255 / 2))
57.                     IF (f1 > g) AND (f3 > g) AND (f7 < g) AND (f9 < g) THEN CALL CLine(j - 5, k, j + 5, k, _RGB(255, 255, 255 / 2))
58.                     IF (f1 > g) AND (f3 < g) AND (f7 > g) AND (f9 < g) THEN CALL CLine(j, k - 5, j, k + 5, _RGB(255, 255, 255 / 2))
59.                     IF (f1 < g) AND (f3 > g) AND (f7 < g) AND (f9 > g) THEN CALL CLine(j, k - 5, j, k + 5, _RGB(255, 255, 255 / 2))
60.                     IF (f1 > g) AND (f3 < g) AND (f7 < g) AND (f9 < g) THEN CALL CLine(j - 5, k, j, k - 5, _RGB(255, 255, 255 / 2))
61.                     IF (f1 < g) AND (f3 > g) AND (f7 < g) AND (f9 < g) THEN CALL CLine(j, k - 5, j + 5, k, _RGB(255, 255, 255 / 2))
62.                     IF (f1 < g) AND (f3 < g) AND (f7 > g) AND (f9 < g) THEN CALL CLine(j - 5, k, j, k + 5, _RGB(255, 255, 255 / 2))
63.                     IF (f1 < g) AND (f3 < g) AND (f7 < g) AND (f9 > g) THEN CALL CLine(j, k + 5, j + 5, k, _RGB(255, 255, 255 / 2))
64.                 END IF
65.             NEXT
66.         NEXT
67.     NEXT
68.  
69.     _DISPLAY
70.     _LIMIT 60
71. LOOP
72.  
73. END
74.  
75. FUNCTION CalcPotential# (x0 AS DOUBLE, y0 AS DOUBLE)
76.     DIM TheReturn AS DOUBLE
77.     DIM AS INTEGER j
78.     DIM AS DOUBLE dx, dy, r
79.     TheReturn = 0
80.     FOR j = 1 TO UBOUND(Position)
81.         dx = x0 - Position(j).x
82.         dy = y0 - Position(j).y
83.         r = SQR(dx * dx + dy * dy)
84.         TheReturn = TheReturn + 1 / r
85.     NEXT
86.     CalcPotential# = TheReturn
87. END FUNCTION
88.  
89. SUB CCircle (x0 AS DOUBLE, y0 AS DOUBLE, rad AS DOUBLE, shade AS _UNSIGNED LONG)
90.     CIRCLE (_WIDTH / 2 + x0, -y0 + _HEIGHT / 2), rad, shade
91. END SUB
92.  
93. SUB CLine (x0 AS DOUBLE, y0 AS DOUBLE, x1 AS DOUBLE, y1 AS DOUBLE, shade AS _UNSIGNED LONG)
94.     LINE (_WIDTH / 2 + x0, -y0 + _HEIGHT / 2)-(_WIDTH / 2 + x1, -y1 + _HEIGHT / 2), shade
95. END SUB
96.  

[Dimster]

That' pretty cool. Like something you'd see in a droplet of water under a microscope. In your code you use vectors and I can appreciate why in terms of displaying the results but doesn't SCALAR imply no vectors?

[STxAxTIC]

I'm still allowed to use TYPEs, aren't I? Haha.

Naw, the reason you know its a scalar thing is CalculatePotential returns one number, not two. Feel me on that? (Using concepts other than electricity, temperature is one number, so scalar. Wind is more than one number, so vector.)

[Dimster]

Ya, I'm feeling it. As for TYPE meaning "a category of people or things having common characteristics" you by all means can use TYPE. In fact, given that all programmers fall into a TYPE, it should be mandatory usage in our coding.

[bplus]

Not too different:

Code: QB64: [Select]

1. _Title "Build Contours Rnd Pts 2- zzz... press any, esc to quit" ' b+ 2021-11-11
2. ' 2022-02-14 mod to move points around
3.  
4. _ScreenMove 400, 60
5. Dim Shared tile(5) As String
6. tile(1) = "."
7. tile(2) = "~"
8. tile(3) = "="
9. tile(4) = "o"
10. tile(5) = "#"
11.  
12. Randomize Timer
13. Width 80, 80
14. _Font 8
15.  
16. Re:
17. nP = Rnd * 7 + 3
18. ReDim pX(1 To nP), pY(1 To nP), dx(1 To nP), dy(1 To nP)
19. For i = 1 To nP
20.     pX(i) = Rnd * _Width * .9 + .05 * _Width
21.     dx(i) = Rnd * 2 - 1
22.     pY(i) = Rnd * _Height * .9 + .05 * _Height
23.     dy(i) = Rnd * 1 - 1
24. Next
25.  
26. Do
27.     Cls
28.     If InKey$ = " " Then GoTo Re
29.     For level = 1 To 5
30.         For i = 1 To nP
31.             'move points
32.             pX(i) = pX(i) + dx(i)
33.             If pX(i) < 2 Or pX(i) > 78 Then dx(i) = -dx(i)
34.             pY(i) = pY(i) + dy(i)
35.             If pY(i) < 2 Or pY(i) > 78 Then dy(i) = -dy(i)
36.  
37.             If Rnd < .5 Then dir = -1 Else dir = 1
38.             x = pX(i) + dir * (Rnd * (6 - level) * 1)
39.             If Rnd < .5 Then dir = -1 Else dir = 1
40.             y = pY(i) + dir * (Rnd * (6 - level) * 1)
41.             R = (Rnd * (6 - level) * 3) + 5 * (6 - level)
42.             For row = y - R To y + R
43.                 For col = x - R To x + R
44.                     If row >= 1 And row <= _Height Then
45.                         If col > 1 And col <= _Width Then
46.                             If Sqr(((col - x) ^ 2) + (row - y) ^ 2) <= R Then
47.                                 Locate row, col: Print tile(level);
48.                             End If
49.                         End If
50.                     End If
51.                 Next
52.             Next
53.  
54.         Next
55.     Next
56.     _Display
57.     _Limit 5
58. Loop Until _KeyDown(27)
59.  
60.  
61.