Control.hs

   1 module Control where
   2
   3 import Data.Int
   4 import Graphics.UI.SDL
   5
   6 data Action = Press | Release deriving (Show,Eq,Ord)
   7
   8 -- an abstract controller
   9 data Control =
  10   L | R | U | D | NLR | NUD |
  11   FirePress | FireRelease |
  12   Abort
  13   deriving (Show,Eq,Ord,Read)
  14
  15
  16 newtype KAxisState = KAxisState ((SDLKey,Action) -> (Maybe Control, KAxisState))
  17 mkKAxisSM :: (Control,Control,Control) -> (SDLKey,SDLKey) -> KAxisState
  18 mkKAxisSM (cl,c0,cr) (kl,kr) = KAxisState s00 where
  19   goto00 = KAxisState s00
  20   gotol0 = KAxisState sl0
  21   goto0r = KAxisState s0r
  22   gotolr = KAxisState slr
  23   s00 (k,Press)   | k == kl   = (Just cl, gotol0)
  24                   | k == kr   = (Just cr, goto0r)
  25                   | otherwise = (Nothing, goto00)
  26   s00 (_,Release)             = (Nothing, goto00)
  27   sl0 (k,Press)   | k == kr   = (Just cr, gotolr)
  28                   | otherwise = (Nothing, gotol0)
  29   sl0 (k,Release) | k == kl   = (Just c0, goto00)
  30                   | otherwise = (Nothing, gotol0)
  31   s0r (k,Press)   | k == kl   = (Just cl, gotolr)
  32                   | otherwise = (Nothing, goto0r)
  33   s0r (k,Release) | k == kr   = (Just c0, goto00)
  34                   | otherwise = (Nothing, goto0r)
  35   slr (_,Press)               = (Nothing, gotolr)
  36   slr (k,Release) | k == kl   = (Just cr, goto0r)
  37                   | k == kr   = (Just cl, gotol0)
  38                   | otherwise = (Nothing, gotolr)
  39 runKAxis :: (SDLKey,Action) -> KAxisState -> (Maybe Control, KAxisState)
  40 runKAxis (k,a) (KAxisState s) = s (k,a)
  41
  42 newtype JAxisState = JAxisState (Int16 -> (Maybe Control, JAxisState))
  43 mkJAxisSM :: (Control,Control,Control) -> Int16 -> JAxisState
  44 mkJAxisSM (cl,c0,cr) thresh = JAxisState s0 where
  45   gotor = JAxisState sr
  46   gotol = JAxisState sl
  47   goto0 = JAxisState s0
  48   s0 v | v > thresh  = (Just cr, gotor)
  49        | v < -thresh = (Just cl, gotol)
  50        | otherwise   = (Nothing, goto0)
  51   sr v | v > thresh  = (Nothing, gotor)
  52        | v < -thresh = (Just cl, gotol)
  53        | otherwise   = (Just c0, goto0)
  54   sl v | v > thresh  = (Just cl, gotor)
  55        | v < -thresh = (Nothing, gotol)
  56        | otherwise   = (Just c0, goto0)
  57 runJAxis :: Int16 -> JAxisState -> (Maybe Control, JAxisState)
  58 runJAxis v (JAxisState s) = s v