52700.fb2
Основные библиотеки | 297
loop state
simulate :: State -> IO Time
simulate a = do
t0 <- get G. time
H. step (stateSpace a) dt
t1 <- get G. time
return (t1 - t0)
initGLFW :: IO ()
initGLFW = do
G. initialize
G. openWindow (G.Size (d2gli width) (d2gli height)) [] G.Window
G. windowTitle $= title
G. windowCloseCallback $= exitWith ExitSuccess
G. windowSizeCallback
$= (\size -> G. viewport $= (G.Position 0 0, size))
G. clearColor $= G.Color4 1 1 1 1
G. ortho (-dw2) (dw2) (-dh2) (dh2) (-1) 1
where dw2 = realToFrac w2
dh2 = realToFrac h2
initState :: IO State
initState = do
space <- H. newSpace
initWalls space
ball <- initBall space initPos initVel
return $ State ball space
initWalls :: H.Space -> IO ()
initWalls space = mapM_ (uncurry $ initWall space) wallPoints
initWall :: H.Space -> H.Position -> H.Position -> IO ()
initWall space a b = do
body
<- H. newBody H. infinity H. infinity
shape
<- H. newShape body (H.LineSegment a b wallThickness) 0
H. elasticity shape $= nearOne
H. spaceAdd space body
H. spaceAdd space shape
initBall :: H.Space -> H.Position -> H.Velocity -> IO H.Body
initBall space pos vel = do
body
<- H. newBody ballMass ballMoment
shape
<- H. newShape body (H.Circle ballRadius) 0
H. position body $= pos
H. velocity body $= vel
H. elasticity shape $= nearOne
H. spaceAdd space body
H. spaceAdd space shape
return body