module FRP.Yampa.GLUT.UI
( UI
, redisplay, reshaped, windowSize
, mousePosition, simpleMousePosition
, keyAction, mouseButtonAction, modifiers
, keyPressed
, crossed
) where
import Control.Arrow
import FRP.Yampa (SF, hold)
import FRP.Yampa.Event
import FRP.Yampa.GLUT.InternalUI
import Graphics.Rendering.OpenGL
import Graphics.UI.GLUT.Callbacks
redisplay :: SF (Event UI) (Event ())
redisplay = arr $ tagWith () . filterE (GlutDisplay==)
reshaped :: SF (Event UI) (Event Size)
reshaped = arr (mapFilterE f) where
f (GlutReshape sz) = Just sz
f _ = Nothing
windowSize :: SF (Event UI) Size
windowSize = hold (Size 1 1) <<< reshaped
mousePosition :: SF (Event UI) Position
mousePosition = hold (Position 0 0) <<< arr (mapFilterE f) where
f (GlutMotion p) = Just p
f (GlutPassiveMotion p) = Just p
f (GlutKeyboardMouse _ _ _ p) = Just p
f _ = Nothing
simpleMousePosition :: Fractional a => SF (Event UI) (Vector2 a)
simpleMousePosition = windowSize &&& mousePosition >>> arr f where
f (Size w h, Position x y) = Vector2 x' y' where
b = realToFrac (w `min` h)
x' = (2 * realToFrac x realToFrac w) / b
y' = (realToFrac h 2 * realToFrac y) / b
keyAction :: SF (Event UI) (Event (KeyState, Either Char SpecialKey))
keyAction = arr (mapFilterE f) where
f (GlutKeyboardMouse (Char c) ks _ _) = Just (ks, Left c)
f (GlutKeyboardMouse (SpecialKey k) ks _ _) = Just (ks, Right k)
f _ = Nothing
mouseButtonAction :: SF (Event UI) (Event (KeyState, MouseButton))
mouseButtonAction = arr (mapFilterE f) where
f (GlutKeyboardMouse (MouseButton mb) ks _ _) = Just (ks, mb)
f _ = Nothing
modifiers :: SF (Event UI) (Event Modifiers)
modifiers = arr (mapFilterE f) where
f (GlutKeyboardMouse _ _ m _) = Just m
f _ = Nothing
keyPressed :: SF (Event UI) (Event (Either Char SpecialKey))
keyPressed = keyAction >>> arr (fmap snd . filterE ((==Down) . fst))
crossed :: SF (Event UI) (Event Crossing)
crossed = arr (mapFilterE f) where
f (GlutCrossing c) = Just c
f _ = Nothing