-
Notifications
You must be signed in to change notification settings - Fork 0
/
World.hs
102 lines (87 loc) · 3.28 KB
/
World.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
module World where
import Debug.Trace
import Graphics.Rendering.OpenGL
import ParticlesConfig
import Primitives
data CelestialObject = CelestialObject {
getRadius :: Float,
getPosition :: Primitives.Position,
getVelocity :: Velocity
}
instance Show CelestialObject where
show (CelestialObject r position velocity) =
"(Celestial r=" ++ show r ++ " " ++ show position ++ " v=" ++ show velocity ++ ")"
getMass (CelestialObject r _ _) = 4/3 * pi * (r**3)
distanceBetween a b
| posA == posB = 2000000000.0
| otherwise = len
where
posA = getPosition a
posB = getPosition b
len = value $ sub posA posB
--f=G(M*m)/(r^2)
gravConst = 0.0001
--forceBetween :: (CelestialObject a) => a -> a -> Force
scalarForceBetween celA celB
| distance < 5 = forceFactor / (5)
| otherwise = forceFactor / distance
where
massA = getMass celA
massB = getMass celB
distance = distanceBetween celA celB
forceFactor = gravConst * (massA * massB)
--from A to B
vectorForceBetween celA celB =
let
posA = getPosition celA
posB = getPosition celB
in sub posB posA
vectorBetween celA celB =
let
normalized = normalize' $ vectorForceBetween celA celB
factor = scalarForceBetween celA celB
in scalarMult factor normalized
gravityBetween celA celB =
let
force = vectorBetween celA celB
massA = getMass celA
velocity = scalarMult (1.0/massA) force
in velocity
applyPosition vector (CelestialObject r position velocity) =
CelestialObject r (add vector position) velocity
applyVelocity (CelestialObject r position velocity) =
CelestialObject r (add position velocity) (scalarMult 0.99 velocity)
applyAcceleration acceleration (CelestialObject r position velocity) =
CelestialObject r position (add acceleration velocity)
prepRenderCelestial (CelestialObject _ position _) = prepRenderPos position
scaleByBounds (Vertex3 x y z) = Vertex3 (x/bound) (y/bound) (z/bound)
data State = State { getObjects :: [CelestialObject] } deriving (Show)
tick (State cels) = State $ monadComp cels
where
gravComp cel cells = do
dest <- cells
return $ gravityBetween cel dest
monadComp cels = do
cel <- cels
let gravities = gravComp cel cels
let gravity = foldl add (Vector 0.0 0.0) gravities
let gravitedCel = applyAcceleration gravity cel
return $ applyVelocity gravitedCel
prepRenderState :: State -> [Vertex3 Float]
prepRenderState (State cels) = map (scaleByBounds.prepRenderCelestial) cels
sampleCell1 = CelestialObject 1 (Vector 0 0) (Vector 10 10)
sampleCell2 = CelestialObject 1 (Vector 0 0) (Vector (-10) 10)
sampleCell3 = CelestialObject 1 (Vector 0 0) (Vector 10 (-10))
sampleCell4 = CelestialObject 1 (Vector 0 0) (Vector (-10) (-10))
sampleCell10 = CelestialObject 1 (Vector 0 0) (Vector 0 10)
sampleCell20 = CelestialObject 1 (Vector 0 0) (Vector 10 0)
sampleCell30 = CelestialObject 1 (Vector 0 0) (Vector 0 (-10))
sampleCell40 = CelestialObject 1 (Vector 0 0) (Vector (-10) 0)
--sampleState1 = State [sampleCell1, sampleCell2, sampleCell3, sampleCell4,
--sampleCell10, sampleCell20, sampleCell30, sampleCell40]
gravCell1 = CelestialObject 1 (Vector 10 0) (Vector 0 0)
gravCell2 = CelestialObject 1 (Vector (-10) 0) (Vector 0 0)
planet1 = CelestialObject 20 (Vector (-50.0) 0.0) (Vector 0.0 0.0)
world1 = State
(planet1:
[(CelestialObject 0.1 (Vector x y) (Vector 0.0 0.0)) | x <- [(-5)..5], y<- [(-5)..5]])