Useful syntax for working with @Arrow@ and associated combinators

> {-# LANGUAGE Arrows #-}
> import Control.Arrow

We know that our @Action@ objects have @Monoid@ property. Use that fact by
combining them through @mconcat@

> import Data.Monoid

Nice set of operators for Vectors manipulation

> import Data.VectorSpace
> import Data.VectorSpace.OpenGL

GLUT supplies us with a lot of already predefined objects (among them is teapot and sphere).

> import Graphics.UI.GLUT

Here we get our @Reaction@ processing and @simpleMousePosition@ signal
function.

> import FRP.Yampa.GLUT.Adapter

> import FRP.Yampa (SF, integral, delay, initially, edge, accumHoldBy)
> import FRP.Yampa.Event

Our small Simple game

> main = do
>     simpleInit "Simple"
>     cullFace $= Just Back
>     frontFace $= CW
>     shadeModel $= Smooth
>
>     blend $= Enabled
>     blendFunc $= (SrcAlpha, OneMinusSrcAlpha)
>
>     lighting $= Enabled
>     ambient (Light 0) $= Color4 0.1 0.1 0.1 (1::GLfloat)
>     diffuse (Light 0) $= Color4 0.9 0.9 0.9 (1::GLfloat)
>     position (Light 0) $= Vertex4 0.5 0.5 (-10) 0
>     light (Light 0) $= Enabled
>     colorMaterial $= Just (Front, AmbientAndDiffuse)
>
>     adapt leaveMainLoop simple

Description of events flow through our game

> simple :: Reaction
> simple = proc ev -> do
>     pos <- ball -< ev
>     disp <- redisplay -< ev
>     reshapedAction <- fmap (actionIO . reshape) ^<< reshaped -< ev
>     returnA -< mconcat [
>       reshapedAction,
>       disp `tag` actionIO (display pos)
>       ]

Display takes our in-game state and draws it

> display (x, y) = do
>     clear [ ColorBuffer, DepthBuffer ]
>
>     preservingMatrix $ do
>         translate (Vector3 (realToFrac x) (realToFrac y) (0 :: GLfloat))
>         color $ Color4 0.2 0.8 0 (0.5::GLfloat)
>         renderObject Solid (Sphere' 0.1 50 50)
>
>     swapBuffers

Our reshape callback is trying to keep aspect ratio.

> reshape sz@(Size w h) = do
>     let b = fromIntegral (w `min` h) * 2
>         w' = fromIntegral w / b
>         h' = fromIntegral h / b
>
>     viewport $= (Position 0 0, sz)
>
>     matrixMode $= Projection
>     loadIdentity
>     frustum (-w') w' (-h') h' 2 100
>
>     matrixMode $= Modelview 0
>     loadIdentity
>
>     translate (Vector3 0 0 (-4 :: GLfloat))

Internal state of in-game object represented by two @Float@'s. That's recursive
signal function that affected by user input.

> ball :: SF (Event UI) (Float, Float)
> ball = proc ev -> do
>         d <- moveDirection -< ev
>         (Vector2 tx ty) <- simpleMousePosition -< ev
>         rec
>             let mpos = (tx, ty)
>                 dpos = mpos ^-^ pos
>                 speed = normalized dpos ^* 0.5 ^* d
>             pos <- integral <<< delay 0.2 zeroV -< speed
>         returnA -< pos

Direction

> moveDirection :: SF (Event UI) Float
> moveDirection = mouseButtonPressed LeftButton >>> edge >>> accumHoldBy (const . negate) 1