\begin{code}
module HasInput where
import WH
import FranPrim
import StaticTypes

class Has_Input w where
 bindAction :: Action -> Listener UserAction -> w -> w

resizeL :: Has_Input w => Listener Vector2 -> w -> w
resizeL l = bindAction AskResize (mapMaybeL getL l)
 where
   getL (Resize v) = Just v

destroyL :: Has_Input w => Listener () -> w -> w
destroyL l = bindAction AskDestroy (mapMaybeL getL l)
 where
   getL _ = Just ()
{-
charKey :: Has_Input w => Bool -> Maybe Char -> [Modifier] -> Listener Char
        -> w -> w
charKey press mbc ms l = key press (fmap toKey mbc) ms (mapL fromKey l)
 where
   fromKey Return = '\n'
   fromKey (KeyChar c) = c
   fromKey 
-}
key :: Has_Input w => Bool -> Maybe Key -> [Modifier] -> Listener Key
    -> w -> w
key b mbk ms l = bindAction (AskKey b mbk ms) (mapMaybeL getL l)
 where
   getL (CharKey _ k ms) | maybe True (== k) mbk = Just k
   getL _ = Nothing

keyPress :: Has_Input w => Key -> Listener () -> w -> w
keyPress k l = key True (Just k) [] (tellL l ()) 

keyRelease :: Has_Input w => Key -> Listener () -> w -> w
keyRelease k l = key False (Just k) [] (tellL l ()) 

keyPressAny :: Has_Input w => Listener Key -> w -> w
keyPressAny l = key True Nothing [] l

keyReleaseAny :: Has_Input w => Listener Key -> w -> w
keyReleaseAny l = key True Nothing [] l

mouseMove' :: Has_Input w => [Modifier] -> Listener Point2
	    -> w -> w
mouseMove' ms l = bindAction (AskMotion ms) (mapMaybeL getL l)
 where 
   getL (MouseMove p ms) = Just p
   getL _ = Nothing

mouseMove :: Has_Input w => Listener Point2 -> w -> w
mouseMove l = mouseMove' [] l 

mouseEnter' :: Has_Input w => [Modifier] -> Listener () -> w -> w
mouseEnter' ms l = bindAction (AskMotion ms) (mapMaybeL getL l)
 where 
   getL (Enter ms) = Just ()
   getL _ = Nothing

mouseLeave' :: Has_Input w => [Modifier] -> Listener () -> w -> w
mouseLeave' ms l = bindAction (AskLeave ms) (mapMaybeL getL l)
 where
  getL (Leave ms) = Just ()
  getL _ = Nothing

mouseEnter :: Has_Input w => Listener () -> w -> w
mouseEnter = mouseEnter' []

mouseLeave :: Has_Input w => Listener () -> w -> w
mouseLeave = mouseLeave' []

mouseButton :: Has_Input w => Int -> Bool -> [Modifier] -> Listener ()
	    -> w -> w
mouseButton x b ms l = bindAction (AskButton x b ms) (mapMaybeL getL l)
 where
   getL (Button n b' ms) | b == b' = Just ()
   getL _ = Nothing

mousePress :: Has_Input w => Int -> Listener () -> w -> w
mousePress n l = mouseButton n True [] l

mouseRelease :: Has_Input w => Int -> Listener () -> w -> w
mouseRelease n l = mouseButton n False [] l

\end{code}