Code: Select all
Option Explicit
#define SQRT(dx,dy) (SQR(dx*dx+dy*dy))
CONST ELECTROSTATICFORCE AS DOUBLE = 60
Type NEG_Attractor
as double x,y
End Type
Type POS_Attractor
as double x,y
ENd Type
Type Vector
as double vx, vy, mag
End type
Dim Shared as NEG_Attractor PF (1 to 256, 1 to 256) 'Particle Field
Dim Shared as POS_Attractor PTn(1 To 2) 'Protons
Dim Shared as Double SQTable(0 To 512, 0 To 512)
Dim as integer x,y
For y = 0 To 512
For x = 0 To 512
SQTable(x,y) = SQRT(x,y)
Next x
Next y
Sub Field_Reset
Dim as integer x,y
For y = 1 To 256
For x = 1 To 256
PF(x,y).x = x*2
PF(x,y).y = y*2
Next x
Next y
End Sub
Sub Field_Draw
Dim as integer x,y
screenlock
For y = 1 To 256
For x = 1 To 256
Pset (PF(x,y).x, PF(x,y).y), &HFFFFFF
Next x
Next y
screenunlock
End Sub
Sub Field_Attract
Dim as integer x,y,i
Dim as double t
Dim as Vector MV
For y = 1 To 256
For x = 1 To 256
For i = 1 To 2
With MV
.vx = PTn(i).x - PF(x,y).x
.vy = PTn(i).y - PF(x,y).y
.mag = SQTable(ABS(.vx),ABS(.vy))
t = (1/.mag)
.vx /= .mag: .vy *= ELECTROSTATICFORCE*t
.vy /= .mag: .vx *= ELECTROSTATICFORCE*t
PF(x,y).x += .vx
PF(x,y).y += .vy
End With
Next i
Next x
Next y
End Sub
Screenres 512,512,32,2
screenset 1,0
Dim as integer mx,my
PTn(2).x = 256
PTn(2).y = 256
Do
Cls
getmouse mx,my
Field_Reset
PTn(1).x = mx
PTn(1).y = my
Field_Attract
Field_Draw
Flip
Loop until multikey(&H01)
end