MainWiimote.hs

{-# LANGUAGE Arrows #-}
import Control.Monad
import Data.IORef
import Data.Maybe
import FRP.Yampa       as Yampa
import Graphics.UI.SDL as SDL
import System.CWiid

-- Helper functions
import YampaSDL

width :: Num a => a
width  = 640
height :: Num a => a
height = 480

-- | Reactimation.
--
-- This main function runs an FRP system by producing a signal, passing it
-- through a signal function, and consuming it.
--
-- The first two arguments to reactimate are the value of the input signal
-- at time zero and at subsequent times, together with the times between
-- samples.
--
-- The third argument to reactimate is the output consumer that renders
-- the signal.
--
-- The last argument is the actual signal function.
--
main = do
  mWiimote <- initializeWiimote
  timeRef <- newIORef (0 :: Int)
  if isNothing mWiimote
    then putStrLn "Couldn't find wiimote"
    else do let wiimote = fromJust mWiimote
            reactimate (initGraphs >> senseWiimote wiimote)
                       (\_ -> do
                          dtSecs <- yampaSDLTimeSense timeRef
                          mInput <- senseWiimote wiimote
                          return (dtSecs, Just mInput)
                       )
                       (\_ e -> display (e) >> return False)
                       player

-- Pure SF
inCircles :: SF (Double, Double) (Double, Double)
inCircles = proc (centerX, centerY) -> do
  t <- time -< ()
  let x      = centerX + cos t * radius
      y      = centerY + sin t * radius
      radius = 30
  returnA -< (x,y)

-- * Graphics

-- | Initialise rendering system.
initGraphs :: IO ()
initGraphs = do
  -- Initialise SDL
  SDL.init [InitVideo]

  -- Create window
  screen <- SDL.setVideoMode width height 16 [SWSurface]
  SDL.setCaption "Test" ""

-- | Display a box at a position.
display :: (Double, Double) -> IO()
display (playerX, playerY) = do
  -- Obtain surface
  screen <- getVideoSurface

  -- Paint screen green
  let format = surfaceGetPixelFormat screen
  bgColor <- mapRGB format 55 60 64
  fillRect screen Nothing bgColor

  -- Paint small red square, at an angle 'angle' with respect to the center
  foreC <- mapRGB format 212 108 73
  let side = 30
      x = round playerX
      y = round playerY
  fillRect screen (Just (Rect x y side side)) foreC

  -- Double buffering
  SDL.flip screen

player :: SF (Double, Double) (Double, Double)
player = inCircles

senseWiimote :: CWiidWiimote -> IO (Double, Double)
senseWiimote wmdev = do
  irs   <- cwiidGetIR wmdev

  -- Obtain positions of leds 1 and 2 (with a normal wii bar, those
  -- will be the ones we use).
  let led1   = irs!!0
      led2   = irs!!1

  -- Calculate mid point between sensor bar leds
  let posX = ((cwiidIRSrcPosX led1) + (cwiidIRSrcPosX led2)) `div` 2
      posY = ((cwiidIRSrcPosY led1) + (cwiidIRSrcPosY led2)) `div` 2

  -- Calculate proportional coordinates
  let propX = fromIntegral (1024 - posX) / width
      propY = fromIntegral (max 0 (posY - 384)) / 384.0

  -- Calculate game area coordinates
  let finX  = width  * propX
      finY  = height * propY

  return (finX, finY)

-- | Initializes the wiimote, optionally returning the sensing function. It
-- returns Nothing if the Wiimote cannot be detected. Users should have a BT
-- device and press 1+2 to connect to it. A message is shown on stdout.
initializeWiimote :: IO (Maybe CWiidWiimote)
initializeWiimote = do
  putStrLn "Initializing WiiMote. Please press 1+2 to connect."
  wm <- cwiidOpen
  case wm of
    Nothing  -> return ()
    Just wm' -> void $ cwiidSetRptMode wm' 15 -- Enable button reception, acc
                                              -- and IR
  return wm