module FRP.Helm.Mouse
(
Mouse(..),
position, x, y,
isDown,
isDownButton,
clicks
) where
import Control.Applicative (pure)
import Data.Bits
import Foreign.Marshal.Alloc
import Foreign.Ptr
import Foreign.Storable
import FRP.Elerea.Param hiding (Signal)
import FRP.Helm.Sample
import FRP.Helm.Signal
import qualified Graphics.UI.SDL as SDL
data Mouse
= LeftMouse
| MiddleMouse
| RightMouse
| X1Mouse
| X2Mouse deriving (Show, Eq, Ord, Read)
instance Enum Mouse where
fromEnum LeftMouse = 1
fromEnum MiddleMouse = 2
fromEnum RightMouse = 3
fromEnum X1Mouse = 4
fromEnum X2Mouse = 5
toEnum 1 = LeftMouse
toEnum 2 = MiddleMouse
toEnum 3 = RightMouse
toEnum 4 = X1Mouse
toEnum 5 = X2Mouse
toEnum _ = error "FRP.Helm.Mouse.Mouse.toEnum: bad argument"
position :: Signal (Int, Int)
position = Signal $ getPosition >>= transfer (pure (0,0)) update
where
getPosition = effectful $ alloca $ \xptr -> alloca $ \yptr -> do
_ <- SDL.getMouseState xptr yptr
x_ <- peek xptr
y_ <- peek yptr
return (fromIntegral x_, fromIntegral y_)
x :: Signal Int
x = fst <~ position
y :: Signal Int
y = snd <~ position
isDown :: Signal Bool
isDown = isDownButton LeftMouse
isDownButton :: Mouse -> Signal Bool
isDownButton m = Signal $ getDown >>= transfer (pure False) update
where
getDown = effectful $ do
flags <- SDL.getMouseState nullPtr nullPtr
return $ (.&.) (fromIntegral flags) (fromEnum m) /= 0
clicks :: Signal ()
clicks = Signal $ signalGen isDown >>= transfer (pure ()) update_
where update_ _ (Changed True) _ = Changed ()
update_ _ _ _ = Unchanged ()