module FRP.Yampa.GLFW.UI
( UI
, resized, windowResize, redraw
, mousePosition, simpleMousePosition
, keyAction, mouseButtonAction
, keyPress, keyPressed, mouseButtonPressed
) where
import Control.Arrow
import FRP.Yampa (SF, hold)
import FRP.Yampa.Event
import qualified Graphics.Rendering.OpenGL as GL
import Graphics.Rendering.OpenGL (Size(..), Position(..), GLfloat, GLdouble)
import FRP.Yampa.GLFW.InternalUI
import Graphics.UI.GLFW
redraw :: SF (Event UI) (Event ())
redraw = arr $ tagWith () . filterE (GlfwRedraw==)
resized :: SF (Event UI) (Event Size)
resized = arr (mapFilterE f) where
f (GlfwWindowResize sz) = Just sz
f _ = Nothing
windowResize :: SF (Event UI) Size
windowResize = hold (Size 1 1) <<< resized
mousePosition :: SF (Event UI) Position
mousePosition = hold (Position 0 0) <<< arr (mapFilterE f) where
f (GlfwMousePosition posn) = Just posn
f _ = Nothing
simpleMousePosition :: Fractional a => SF (Event UI) (GL.Vector2 a)
simpleMousePosition = windowResize &&& mousePosition >>> arr f where
f (Size w h, Position x y) = GL.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 (Bool, Either Char Key))
keyAction = arr (mapFilterE f) where
f (GlfwChar c ks) = Just (ks, Left c)
f (GlfwKey k ks) = Just (ks, Right k)
f _ = Nothing
mouseButtonAction :: SF (Event UI) (Event (Bool, MouseButton))
mouseButtonAction = arr (mapFilterE f) where
f (GlfwMouseButton mb ks) = Just (ks, mb)
f _ = Nothing
keyPress :: SF (Event UI) (Event (Either Char Key))
keyPress = keyAction >>^ fmap snd . filterE ((==True) . fst)
keyPressed :: Either Char Key -> SF (Event UI) Bool
keyPressed key = hold False <<< mapFilterE f ^<< keyAction where
f (x, key') | key == key' = Just (x == True)
f _ = Nothing
mouseButtonPressed :: MouseButton -> SF (Event UI) Bool
mouseButtonPressed button = hold False <<< mapFilterE f ^<< mouseButtonAction where
f (x, button') | button == button' = Just (x == True)
f _ = Nothing