-
Notifications
You must be signed in to change notification settings - Fork 1
/
Test.hs
53 lines (41 loc) · 1.33 KB
/
Test.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
{-# LANGUAGE FlexibleInstances #-}
module Test where
import Event
import Graphics
import Math.Point
import Physics.Body
import Physics.Shape
import Physics.Vector
import Physics.World
import Data.IORef (newIORef,writeIORef,readIORef)
import Data.Maybe (fromJust)
import System.Exit (exitSuccess)
main = do
initGraphics "Test" 800 600
let ground = mkPhysicalState $ fromJust $ rectangle (Point 0 0) 10 0.1
wall = mkPhysicalState $ fromJust $ rectangle (Point (-5) 5) 0.1 10
let square = mkPhysicalState $ fromJust $ rectangle (Point 0 5) 1 1
let s2 = mkPhysicalState $ fromJust $ rectangle (Point 2 5) 1 1
let world = (emptyWorld 1000 1000)
{ worldGravity = Just (Vector 0 (-0.1))
, worldRestitution = 0.8
}
ref <- newIORef $ addBody ground { psStatic = True }
$ addBody wall { psStatic = True }
$ addBody (applyImpulse (Vector 0.01 0) square)
$ addBody s2
world
withEventManager $ \em -> do
setLineWidth 2
setPointSize 2
color3 1 1 1
em `listen` \ QuitEvent -> exitSuccess
em `listen` \ (TickEvent now delta) -> do
w <- readIORef ref
let w' = stepWorld delta w
writeIORef ref w'
clearScreen
translate 0 (-5) (-20)
render w'
updateScreen
eventLoop em