{-# OPTIONS_HADDOCK hide #-}
{- | 
This FunGEn module controls the user input (mouse, keyboard, joystick...)
-}
{- 

FunGEN - Functional Game Engine
http://www.cin.ufpe.br/~haskell/fungen
Copyright (C) 2002  Andre Furtado <awbf@cin.ufpe.br>

This code is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

-}

module Graphics.UI.Fungen.Input (
        InputBinding, InputHandler,
        KeyEvent(..), Key(..), SpecialKey(..), MouseButton(..), Modifiers(..), Position(..),
        funInitInput
) where

import Graphics.UI.Fungen.Game
import Graphics.UI.GLUT
import Graphics.UI.GLUT.Input (KeyEvent(..), KeyBinder, StillDownHandler, glutInitInput)

-- | A FunGEn input handler is like an IOGame (game action) that takes
-- two extra arguments: the current keyboard modifiers state, and the
-- current mouse position. (For a StillDown event, these will be the
-- original state and position from the Press event.)
type InputHandler t s u v = Modifiers -> Position -> IOGame t s u v ()

-- | A mapping from an input event to an input handler.
type InputBinding t s u v = (Key, KeyEvent, InputHandler t s u v)

-- | Initialise the input system, which keeps a list of input event to
-- action bindings and executes the the proper actions automatically.
-- Returns a function for adding bindings (GLUT's - should return the
-- FunGEn-aware one instead ?), and another which should be called
-- periodically (eg from refresh) to trigger still-down actions.
funInitInput :: [InputBinding t s u v] -> Game t s u v -> IO (KeyBinder, StillDownHandler)
funInitInput :: forall t s u v.
[InputBinding t s u v]
-> Game t s u v -> IO (KeyBinder, StillDownHandler)
funInitInput [InputBinding t s u v]
bindings Game t s u v
game = do
  (KeyBinder
glutBindKey, StillDownHandler
glutStillDown) <- IO (KeyBinder, StillDownHandler)
glutInitInput
  let funBindKey :: (Key, KeyEvent, Modifiers -> Position -> IOGame t s u v a)
-> StillDownHandler
funBindKey (Key
key, KeyEvent
keyEvent, Modifiers -> Position -> IOGame t s u v a
inputHandler) =
        KeyBinder
glutBindKey Key
key KeyEvent
keyEvent (forall a. a -> Maybe a
Just (\Modifiers
mods Position
pos -> forall t s u v a.
IOGame t s u v a -> Game t s u v -> StillDownHandler
runIOGameM (Modifiers -> Position -> IOGame t s u v a
inputHandler Modifiers
mods Position
pos) Game t s u v
game))
  forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {a}.
(Key, KeyEvent, Modifiers -> Position -> IOGame t s u v a)
-> StillDownHandler
funBindKey [InputBinding t s u v]
bindings
  forall (m :: * -> *) a. Monad m => a -> m a
return (KeyBinder
glutBindKey, StillDownHandler
glutStillDown)