{-# OPTIONS_GHC -Wall #-}
----------------------------------------------------------------------
-- |
-- Module : Test
-- Copyright : (c) Conal Elliott 2008
-- License : BSD3
--
-- Maintainer : conal@conal.net
-- Stability : experimental
--
-- Testing out reactive+glut
----------------------------------------------------------------------
module Test where
import Control.Applicative (pure,(<$>))
import qualified Graphics.UI.GLUT as G
import FRP.Reactive (Behavior,time)
import FRP.Reactive.GLUT.Adapter
main :: IO ()
main = adaptSimple "Reactive on GLUT" $ (fmap.fmap) view t2
type G = UI -> Behavior Action
t1, t2 :: G
t1 = const (pure (drawBox zeros))
where
zeros :: (G.GLdouble,G.GLdouble)
zeros = (0,0)
t2 = const (f <$> fmap realToFrac time)
where
f t = drawBox (t',t')
where
t' = t * 1 :: G.GLdouble
---- Utilities
view :: IO () -> IO ()
view act = G.preservingMatrix $
do G.translate (G.Vector3 0 0 (-30 :: G.GLdouble))
act
vertexPF :: G.VertexComponent a => (a,a) -> IO ()
vertexPF = G.vertex . uncurry G.Vertex2
drawBox :: (G.MatrixComponent c, Fractional c) => (c, c) -> IO ()
drawBox (centerX,centerY) = G.preservingMatrix $
do G.translate $ G.Vector3 centerX centerY 0
G.renderPrimitive G.Polygon (mapM_ vertexPF ps)
where
ps :: [(G.GLfloat,G.GLfloat)]
ps = [(-1,-1),(-1,1),(1,1),(1,-1)]