Unknown - haskell-notes

-- frames per second

fps :: Int

fps =60

296 | Глава 20: Императивное программирование

-- frame time in milliseconds

frameTime :: Time

frameTime =1000 *((1 ::Double) /fromIntegral fps)

nearOne =0.9999

ballMass =20

ballMoment = H.momentForCircle ballMass (0, ballRadius) 0

ballRadius =10

initPos = H.Vector0 0

initVel = H.Vector0 0

wallThickness =1

wallPoints =fmap (uncurry f) [

(( -ow2, -oh2), ( -ow2, oh2)),

(( -ow2, oh2),

(ow2, oh2)),

((ow2, oh2),

(ow2, -oh2)),

((ow2, -oh2),

( -ow2, -oh2))]

wheref a b =(g a, g b)

g (a, b) = H.Vectora b

dt :: Double

dt =0.5

minVel :: Double

minVel =10

width, height :: Double

height =500

width =700

w2, h2 :: Double

h2 =height /2

w2 =width /2

ow2, oh2 :: Double

ow2 =w2 -50

oh2 =h2 -50

data State = State

{ stateBall

:: H.Body

, stateSpace

:: H.Space

}

ballPos :: State -> StateVar H.Position

ballPos = H.position .stateBall

ballVel :: State -> StateVar H.Velocity

ballVel = H.velocity .stateBall

main = do

H.initChipmunk

initGLFW

state <-newIORef =<<initState

loop state

loop :: IORef State -> IO()

loop state = do

display state

onMouse state

sleep frameTime

Основные библиотеки | 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.Position0 0, size))

G.clearColor $= G.Color41 1 1 1

G.ortho ( -dw2) (dw2) ( -dh2) (dh2) ( -1) 1

wheredw2 =realToFrac w2

dh2 =realToFrac h2

initState :: IO State

initState = do

space <- H.newSpace

initWalls space

ball <-initBall space initPos initVel

return $ Stateball 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.LineSegmenta 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.CircleballRadius) 0

H.position body $=pos

H.velocity body $=vel

H.elasticity shape $=nearOne

H.spaceAdd space body

H.spaceAdd space shape

return body

-------------------------------

-- graphics

display state = do

drawState =<<get state

simTime <-simulate =<<get state

sleep (max 0 $frameTime -simTime)

drawState :: State -> IO()

drawState st = do

pos <-get $ballPos st

G.clear [ G.ColorBuffer]

drawWalls

drawBall pos

G.swapBuffers

drawBall :: H.Position -> IO()

298 | Глава 20: Императивное программирование

drawBall pos = do

G.color red

circle x y $d2gl ballRadius

where(x, y) =vec2gl pos

drawWalls :: IO()

drawWalls = do

G.color black

line ( -dow2) ( -doh2) ( -dow2) doh2

line ( -dow2) doh2

dow2

doh2

line dow2

doh2

dow2

( -doh2)

line dow2

( -doh2)

( -dow2) ( -doh2)

wheredow2 =d2gl ow2

doh2 =d2gl oh2

onMouse state = do

mb <- G.getMouseButton ButtonLeft

when (mb == Press) (get G.mousePos >>=updateVel state)

updateVel state pos = do

size <-get G.windowSize

st <-get state

p0 <-get $ballPos st

v0 <-get $ballVel st

letp1 =mouse2canvas size pos

ballVel st $=

H.scale ( H.normalize $p1 -p0) (max minVel $ H.len v0)

mouse2canvas :: G.Size -> G.Position -> H.Vector

mouse2canvas ( G.Sizesx sy) ( G.Positionmx my) = H.Vectorx y

whered a b

=fromIntegral a /fromIntegral b

x

=width *(d mx sx -0.5)

y

=height *(negate $d my sy -0.5)