Moe (empty) → 0.1
raw patch · 9 files changed
+700/−0 lines, 9 filesdep +GLUTdep +basedep +randomsetup-changed
Dependencies added: GLUT, base, random
Files
- FRP/Moe.hs +5/−0
- FRP/Moe/Combinators.hs +105/−0
- FRP/Moe/Core.hs +385/−0
- FRP/MoeExample.hs +66/−0
- FRP/MoeGLUT.hs +89/−0
- FRP/MoePure.hs +5/−0
- LICENSE +24/−0
- Moe.cabal +19/−0
- Setup.hs +2/−0
+ FRP/Moe.hs view
@@ -0,0 +1,5 @@+module FRP.Moe (module FRP.Moe, module Control.Arrow, module FRP.Moe.Core, module FRP.Moe.Combinators) where++import FRP.Moe.Core+import FRP.Moe.Combinators+import Control.Arrow
+ FRP/Moe/Combinators.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE Arrows #-}++module FRP.Moe.Combinators where++import Prelude hiding (cycle)+import FRP.Moe.Core+import Control.Arrow+import System.Random++sfConst :: a -> SF b a+-- ^ Input: <i1, i2, ...> (ignored)++-- ^ Output: <x, x, ...>+sfConst x = arr (const x)++time :: SF () Double+-- ^ Input: <(), (), ...>++-- ^ Outputs the sequence of the current time at each sample point+time = sfConst 1 >>> integral++noise :: (Random a, RandomGen b) => b -> SF () a+-- ^ Input: <i1, i2, ...> (ignored)++-- ^ Outputs a sequence of random generated numbers using g0+noise g0 = proc () -> do rec let (x, g') = random g+ g <- delay g0 -< g'+ returnA -< x++noiseR :: (Random a, RandomGen b) => (a, a) -> b -> SF () a+-- ^ Input: <i1, i2, ...> (ignored)++-- ^ Outputs a sequence of random generated numbers using g0, with lh++-- ^ indicating the minimum and maximum numbers that are allowed.+noiseR lh g0 = proc () -> do rec let (x, g') = randomR lh g+ g <- delay g0 -< g'+ returnA -< x++rep :: Int -> SF a a -> SF a a+-- ^ rep n sf = sf >>> sf >>> ... >>> sf (n times)+rep 0 sf = arr (\x -> x)+rep n sf = sf >>> rep (n - 1) sf++cycle :: [a] -> SF () a+-- ^ xs: [x1, x2, x3]++-- ^ Input: <(), (), (), (), (), ...>++-- ^ Output: <x1, x2, x3, x1, x2, ...>+cycle [] = error "Cycle: list is empty."+cycle xs = proc () -> do rec let (y : ys) = zs+ zs <- delay xs -< case ys of+ [] -> xs+ _ -> ys+ returnA -< y++timedCycle :: [(DTime, a)] -> SF () a+timedCycle [] = error "TimedCycle: list is empty."+timedCycle txs = auxCycle txs where+ auxCycle ((timeOut, x) : txs') = dswitch aux (\_ -> if null txs' + then auxCycle txs+ else auxCycle txs') where+ aux = proc () -> do t <- time -< ()+ returnA -< (x, if t > timeOut+ then Event ()+ else NoEvent)++data MemOp a = Read | Write a++memory :: a -> SF (MemOp a) a+-- ^ Input: <Read, Write x1, Read, ...>++-- ^ Output: <x0, x1, x1, ...>+memory x0 = proc op -> do rec let y = case op of+ Read -> z+ Write y' -> y'+ z <- delay x0 -< y+ returnA -< y++stateful :: (a -> a) -> a -> SF () a+-- ^ Input: <(), (), (), ...>++-- ^ Output: <x0, f x0, f (f x0), ...>+stateful f x0 = proc () -> do rec let z = f y+ y <- delay x0 -< z+ returnA -< y++stateful2 :: (a -> b -> a) -> a -> SF b a+-- ^ Input: <i1, i2, i3, ...>++-- ^ Output: <x0, f x0 i1, f (f x0 i1) i2, ...>+stateful2 f x0 = proc i -> do rec let z = f y i+ y <- delay x0 -< z+ returnA -< y+ +integral :: SF Double Double+-- ^ Simple integration+integral = proc x -> do dt <- dTime -< ()+ rec let y = i + x * dt+ i <- delay 0 -< y+ returnA -< i++broadcast :: Functor col => col sf -> a -> col (a, sf)+broadcast sfs x = fmap ((,) x) sfs
+ FRP/Moe/Core.hs view
@@ -0,0 +1,385 @@+{-# LANGUAGE Arrows, RankNTypes #-}+module FRP.Moe.Core where++import Prelude hiding ((.))+import Data.Monoid+import Data.Functor+import Control.Category+import Control.Applicative+import Control.Arrow++type DTime = Double++-- | SF a b can be seen as a function from [x1, x2, ...] to [y1, y2, ...], in which++-- | x1, x2, ... have the type of a, and y1, y2, ... have the type of b. Notice that ++-- | each value is in fact a sample of a continuous temporal function of values in ++-- | some certain time. The time stamps are omitted in most of the comments.+newtype SF a b = MkSF {runSF :: DTime -> a -> (b, SF a b)}++sfId :: SF a a+-- ^ Input: [x1, x2, ...]++-- ^ Output: [x1, x2, ...]+sfId = MkSF (\dt x -> (x, sfId))++sfArr :: (a -> b) -> SF a b+-- ^ Input: [x1, x2, ...]++-- ^ Output: [f x1, f x2, ...]+sfArr f = sf where sf = MkSF (\dt x -> (f x, sf))++sfComp :: SF b c -> SF a b -> SF a c+-- ^ Input of sf1: [y1, y2, ...]++-- ^ Output of sf1: [z1, z2, ...]++-- ^ Input of sf2: [x1, x2, ...]++-- ^ Output of sf2: [y1, y2, ...]++-- ^ Input: [x1, x2, ...]++-- ^ Output: [z1, z2, ...]+sfComp sf1 sf2 = MkSF (\dt x -> let (y, sf2') = runSF sf2 dt x+ (z, sf1') = runSF sf1 dt y+ in (z, sfComp sf1' sf2'))++sfLoop :: SF (a, c) (b, c) -> SF a b+-- ^ Returns a signal function that:++-- ^ Input: [x1, x2, ...]++-- ^ Output: [y1, y2, ...]++-- ^ whenever the following property holds for sf:++-- ^ Input of sf: [(x1, z1), (x2, z2), ...]++-- ^ Output of sf: [(y1, z1), (y2, z2), ...]+sfLoop sf = MkSF (\dt x -> let ((y, z), sf') = runSF sf dt (x, z)+ in (y, sfLoop sf'))++sfFirst :: SF a b -> SF (a, c) (b, c)+-- ^ Input of sf: [x1, x2, ...]++-- ^ Output of sf: [y1, y2, ...]++-- ^ Input: [(x1, z1), (x2, z2), ...]++-- ^ Output: [(y1, z1), (y2, z2), ...]+sfFirst sf = MkSF (\dt (x, y) -> let (z, sf') = runSF sf dt x+ in ((z, y), sfFirst sf'))+ +sfSecond :: SF a b -> SF (c, a) (c, b)+-- ^ Input of sf: [x1, x2, ...]++-- ^ Output of sf: [y1, y2, ...]++-- ^ Input: [(z1, x1), (z2, x2), ...]++-- ^ Output: [(z1, y1), (z2, y2), ...]+sfSecond sf = MkSF (\dt (x, y) -> let (z, sf') = runSF sf dt y+ in ((x, z), sfSecond sf'))++sfLeft :: SF a b -> SF (Either a c) (Either b c) +-- ^ Input of sf: [x1, x2, ...]++-- ^ Output of sf: [y1, y2, ...]++-- ^ Input: [Left x1, Right z1, Left x2, ...]++-- ^ Output: [Left y1, Right z1, Left y2, ...]+sfLeft sf = MkSF (\dt xy -> case xy of+ Left x -> let (z, sf') = runSF sf dt x+ in (Left z, sfLeft sf')+ Right y -> (Right y, sfLeft sf))+ +sfRight :: SF a b -> SF (Either c a) (Either c b) +-- ^ Input of sf: [x1, x2, ...]++-- ^ Output of sf: [y1, y2, ...]++-- ^ Input: [Right x1, Left z1, Right x2, ...]++-- ^ Output: [Right y1, Left z2, Right y2, ...]+sfRight sf = MkSF (\dt xy -> case xy of+ Left x -> (Left x, sfRight sf)+ Right y -> let (z, sf') = runSF sf dt y+ in (Right z, sfRight sf'))++sfDelay :: a -> SF a a+-- ^ Input of sf: [x1, x2, ...]++-- ^ Output of sf: [x0, x1, x2, ...]+sfDelay x0 = MkSF (\dt x -> (x0, sfDelay x))++dTime :: SF () DTime+-- ^ Input of sf: [x1, x2, ...]++-- ^ Output of sf: [dt1, dt2, ...] (dt_i is the time interval between x_(i-1) and x_i)+dTime = MkSF (\dt x -> (dt, dTime))++instance Monoid b => Monoid (SF a b) where+ mempty = sfArr (\_ -> mempty)+ mappend sf1 sf2 = mappend <$> sf1 <*> sf2++instance Functor (SF a) where+ -- ^ Input of sf: [x1, x2, ...]++ -- ^ Output of sf: [y1, y2, ...]++ -- ^ Input: [x1, x2, ...]++ -- ^ Output: [f y1, f y2, ...]+ fmap f sf = MkSF (\dt x -> let (y, sf') = runSF sf dt x+ in (f y, fmap f sf'))++instance Applicative (SF a) where+ -- ^ Input: [i1, i2, ...] (ignored)++ -- ^ Output: [x, x, ...] + pure x = sfArr (const x)+ -- ^ Input of sff: [x1, x2, ...]++ -- ^ Output of sff: [f1, f2, ...]++ -- ^ Input of sfy: [x1, x2, ...]++ -- ^ Output of sfy: [y1, y2, ...]++ -- ^ Input: [x1, x2, ...]++ -- ^ Output: [f1 y1, f2 y2, ...]+ sff <*> sfy = MkSF (\dt x -> let (f, sff') = runSF sff dt x+ (y, sfy') = runSF sfy dt x+ in (f y, sff' <*> sfy'))++instance Category SF where+ id = sfId+ (.) = sfComp++-- ^ second, (&&&) and (***) are not necessary. They exist only for optimization+instance Arrow SF where + arr = sfArr+ first = sfFirst+ second = sfSecond+ -- ^ Input of sf1: [x1, x2, ...]++ -- ^ Output of sf1: [y1, y2, ...]++ -- ^ Input of sf2: [x1, x2, ...]++ -- ^ Output of sf2: [z1, z2, ...]++ -- ^ Input: [x1, x2, ...]++ -- ^ Output: [(y1, z1), (y2, z2), ...]+ sf1 &&& sf2 = MkSF (\dt x -> let (y, sf1') = runSF sf1 dt x+ (z, sf2') = runSF sf2 dt x+ in ((y, z), sf1' &&& sf2'))+ -- ^ Input of sf1: [x1, x2, ...]++ -- ^ Output of sf1: [y1, y2, ...]++ -- ^ Input of sf2: [u1, u2, ...]++ -- ^ Output of sf2: [z1, z2, ...]++ -- ^ Input: [(x1, u1), (x2, u2), ...]++ -- ^ Output: [(y1, z1), (y2, z2), ...]+ sf1 *** sf2 = MkSF (\dt (x, y) -> let (z, sf1') = runSF sf1 dt x+ (u, sf2') = runSF sf2 dt y+ in ((z, u), sf1' *** sf2'))+ +instance ArrowLoop SF where + loop = sfLoop+ +class Arrow a => ArrowDelay a where+ delay :: b -> a b b+ +instance ArrowDelay SF where+ delay = sfDelay+ +-- ^ right, (|||) and (+++) are not necessary. They exist only for optimization+instance ArrowChoice SF where + left = sfLeft+ right = sfRight+ -- ^ Input of sf1: [x1, x2, ...]++ -- ^ Output of sf1: [y1, y2, ...]++ -- ^ Input of sf2: [u1, u2, ...]++ -- ^ Output of sf2: [z1, z2, ...]++ -- ^ Input: [Left x1, Right u1, Left x2, ...]++ -- ^ Output: [y1, z1, y2, ...]+ sf1 ||| sf2 = MkSF (\dt xy -> case xy of+ Left x -> let (z, sf1') = runSF sf1 dt x+ in (z, sf1' ||| sf2)+ Right y -> let (z, sf2') = runSF sf2 dt y+ in (z, sf1 ||| sf2'))+ -- ^ Input of sf1: [x1, x2, ...]++ -- ^ Output of sf1: [y1, y2, ...]++ -- ^ Input of sf2: [u1, u2, ...]++ -- ^ Output of sf2: [z1, z2, ...]++ -- ^ Input: [Left x1, Right u1, Left x2, ...]++ -- ^ Output: [Left y1, Right z1, Left y2, ...]+ sf1 +++ sf2 = MkSF (\dt xy -> case xy of+ Left x -> let (z, sf1') = runSF sf1 dt x+ in (Left z, sf1' +++ sf2)+ Right y -> let (z, sf2') = runSF sf2 dt y+ in (Right z, sf1 +++ sf2'))++data Event a = Event a | NoEvent++switch :: SF b (c, Event d) -> (d -> SF b c) -> SF b c+-- ^ Input of sf: [x1, x2, x3, ...]++-- ^ Output of sf: [(y1, NoEvent), (y2, Event e1), (y3, NoEvent), ...]++-- ^ Input of (gen e): [x2, x3, ...]++-- ^ Output of (gen e): [y(e1)1, y(e1)2, ...]++-- ^ Input: [x1, x2, x3, ...]++-- ^ Output: [y1, y(e1)1, y(e1)2, ...]+switch sf gen = MkSF (\dt x -> let ((y, ev), sf') = runSF sf dt x+ in case ev of+ NoEvent -> (y, switch sf' gen)+ Event e -> runSF (gen e) dt x)++dswitch :: SF b (c, Event d) -> (d -> SF b c) -> SF b c+-- ^ Input of sf: [x1, x2, x3, ...]++-- ^ Output of sf: [(y1, NoEvent), (y2, Event e1), (y3, NoEvent), ...]++-- ^ Input of (gen e): [x2, x3, ...]++-- ^ Output of (gen e): [y(e1)1, y(e1)2, ...]++-- ^ Input: [x1, x2, x3, ...]++-- ^ Output: [y1, y2, y(e1)2, ...]+dswitch sf gen = MkSF (\dt x -> let ((y, ev), sf') = runSF sf dt x+ in case ev of+ NoEvent -> (y, dswitch sf' gen)+ Event e -> (y, snd (runSF (gen e) dt x)))+ +kswitch :: SF a b -> SF (a, b) (Event c) -> (SF a b -> c -> SF a b) -> SF a b+-- ^ Input of sf: [x1, x2, x3, ...]++-- ^ Output of sf: [y1, y2, y3, ...]++-- ^ Input of sfe: [(x1, y1), (x2, y2), (x3, y3), ...]++-- ^ Output of sfe: [NoEvent, Event e1, NoEvent, ...]++-- ^ Input of (gen sf3 e1): [x2, x3, ...]++-- ^ Output of (gen sf3 e1): [y(sf3,e1)1, y(sf3,e1)2, ...]++-- ^ Input: [x1, x2, x3, ...]++-- ^ Output: [y1, y(sf3,e1)1, y(sf3,e2)2, ...]++-- ^ where sf1 = [x1, x2, x3, ...] -- ^> [y1, y2, y3, ...]++-- ^ sf2 = [x2, x3, ...] -- ^> [y2, y3, ...]++-- ^ sf3 = [x3, ...] -- ^> [y3, ...]++-- ^ ... +kswitch sf sfe gen = MkSF (\dt x -> let (y, sf') = runSF sf dt x+ (ev, sfe') = runSF sfe dt (x, y)+ in case ev of+ NoEvent -> (y, kswitch sf' sfe' gen)+ Event e -> runSF (gen sf' e) dt x)++dkswitch :: SF a b -> SF (a, b) (Event c) -> (SF a b -> c -> SF a b) -> SF a b+-- ^ Input of sf: [x1, x2, x3, ...]++-- ^ Output of sf: [y1, y2, y3, ...]++-- ^ Input of sfe: [(x1, y1), (x2, y2), (x3, y3), ...]++-- ^ Output of sfe: [NoEvent, Event e1, NoEvent, ...]++-- ^ Input of (gen sf3 e1): [x2, x3, ...]++-- ^ Output of (gen sf3 e1): [y(sf3,e1)1, y(sf3,e1)2, ...]++-- ^ Input: [x1, x2, x3, ...]++-- ^ Output: [y1, y2, y(sf3,e2)2, ...]++-- ^ where sf1 = [x1, x2, x3, ...] -- ^> [y1, y2, y3, ...]++-- ^ sf2 = [x2, x3, ...] -- ^> [y2, y3, ...]++-- ^ sf3 = [x3, ...] -- ^> [y3, ...]++-- ^ ... +dkswitch sf sfe gen = MkSF (\dt x -> let (y, sf') = runSF sf dt x+ (ev, sfe') = runSF sfe dt (x, y)+ in case ev of+ NoEvent -> (y, dkswitch sf' sfe' gen)+ Event e -> (y, snd (runSF (gen sf' e) dt x)))+ +pswitch :: Functor col => + (forall sf. a -> col sf -> col (b, sf)) -> + col (SF b c) -> + SF (a, col c) (Event d) -> + (col (SF b c) -> d -> SF a (col c)) ->+ SF a (col c)+pswitch route sfs sfe gen = MkSF (\dt x -> let ysfs = route x sfs+ zssfs = fmap (\(y, sf) -> runSF sf dt y) ysfs+ zs = fmap fst zssfs+ sfs' = fmap snd zssfs+ (e, sfe') = runSF sfe dt (x, zs)+ in case e of+ NoEvent -> (zs, pswitch route sfs' sfe' gen)+ Event ev -> runSF (gen sfs' ev) dt x)+ +dpswitch :: Functor col => + (forall sf. a -> col sf -> col (b, sf)) -> + col (SF b c) -> + SF (a, col c) (Event d) -> + (col (SF b c) -> d -> SF a (col c)) ->+ SF a (col c)+dpswitch route sfs sfe gen = MkSF (\dt x -> let ysfs = route x sfs+ zssfs = fmap (\(y, sf) -> runSF sf dt y) ysfs+ zs = fmap fst zssfs+ sfs' = fmap snd zssfs+ (e, sfe') = runSF sfe dt (x, zs)+ in case e of+ NoEvent -> (zs, dpswitch route sfs' sfe' gen)+ Event ev -> (zs, snd (runSF (gen sfs' ev) dt x)))++nth :: Int -> DTime -> SF () a -> a+-- ^ Get the element (x_n) the output [y1, y2, ...] of sf.++-- ^ Time interval is fixed to (dt).+nth n dt sf = let f = runSF sf+ (x, sf') = f dt ()+ in if n == 0 + then x + else x `seq` nth (n - 1) dt sf'++gen :: SF a b -> [(DTime, a)] -> [b]+-- ^ Turn sf into a stream function.+gen sf [] = []+gen sf ((dt, x) : dtxs) = let f = runSF sf+ (y, sf') = f dt x+ in y `seq` (y : gen sf' dtxs)
+ FRP/MoeExample.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE NoMonomorphismRestriction, Arrows #-}+import Control.Applicative+import Control.Arrow+import Data.Monoid+import FRP.MoePure+import FRP.MoeGLUT+import Graphics.UI.GLUT++white = Color3 1 1 1 :: Color3 GLfloat++red = Color3 1 0 0++green = Color3 0 1 0++blue = Color3 0 0 1++-- Rate of acceleration.+g = 200++-- X position of the ground.+xGround = 200++-- A ball falling with gravity.+fallingBall (x0, v0) = proc () -> do v <- arr (+ v0) <<< integral -< g+ x <- arr (+ x0) <<< integral -< v+ returnA -< (x, v)++-- If the ball hits the ground, reverses the velocity to let it bounce.+hit (x, v) = (x, if x >= xGround && v > 0 then Event (x, -v) else NoEvent)++-- Example for the (dswitch) combinator.+bouncingBall xv0 = dswitch (fallingBall xv0 >>> arr hit) bouncingBall++-- Example for the (timedCycle) combinator.+coloredBouncingBall :: (Double, Double) -> SF () (Color3 GLfloat, Double)+coloredBouncingBall xv0 = timedCycle [(interval, green), (interval, red), (interval, blue)] &&&+ bouncingBall xv0 where+ interval = 0.5++-- Example for the (dkswitch) combinator.+bouncingBall2 xv0 = dkswitch (bouncingBall xv0 >>> arr (\x -> [x]))+ (arr (\((), (x : _)) -> if x > xGround then Event () else NoEvent))+ (\sfs _ -> mappend (bouncingBall2 xv0) sfs)++drawPoly ps = renderPrimitive Polygon $ mapM_ vertex ps ++drawBall :: GLdouble -> GLdouble -> GLdouble -> IO ()+drawBall r x0 y0 = mapM_ (\th -> drawPoly [Vertex2 x0 y0, + Vertex2 (x0 + r * cos th) (y0 + r * sin th),+ Vertex2 (x0 + r * cos (th + dth)) (y0 + r * sin (th + dth))]) + $ [0,dth..2*pi] where dth = 0.1*pi+ + +output (x, (c, x'), xs) = do color white+ drawBall 20 100 (300 - realToFrac x)+ color c+ drawBall 20 200 (300 - realToFrac x)+ color white+ mapM_ (\(i, x) -> drawBall 20 (300 + 20*i) (300 - realToFrac x)) (zip [0,1..] $ reverse xs)++example = liftA3 (,,) + (bouncingBall (0, 0))+ (coloredBouncingBall (0, 0))+ (bouncingBall2 (0, 0))++main = start 20 (sfConst () >>> example) (0, (green, 0), [0]) output
+ FRP/MoeGLUT.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE FlexibleInstances, RankNTypes #-}+module FRP.MoeGLUT (module FRP.MoeGLUT,+ module Graphics.UI.GLUT) where++import FRP.Moe.Core+import Control.Arrow+import Data.IORef+import Graphics.UI.GLUT++type Time = Int++type Input = Maybe (Key, KeyState, Modifiers, Position)++type Prog b = SF Input b++type Handle b = IORef (Prog b, Time, b)++timer :: Handle b -> Int -> (b -> IO ()) -> IdleCallback+timer r tick act = do clear [ColorBuffer]+ (sf, t, y) <- readIORef r+ t' <- get elapsedTime+ let deltat = t' - t+ timeOut = tick * 2+ deltat' = if deltat < timeOut then deltat else timeOut+ dt = fromIntegral deltat' / 1000+ (y, sf') = runSF sf dt Nothing+ writeIORef r (sf', t', y)+ print deltat'+ addTimerCallback tick (timer r tick act) + act y+ swapBuffers++ +keyMouse :: Handle b -> KeyboardMouseCallback+keyMouse r k ks mod pos = do (sf, t, _) <- readIORef r+ t' <- get elapsedTime+ let (y, sf') = runSF sf (fromIntegral (t' - t) / 1000) (Just (k, ks, mod, pos))+ y `seq` writeIORef r (sf', t', y)+ +defaultReshape :: ReshapeCallback+defaultReshape size@(Size w h) = do+ viewport $= (Position 0 0, size)+ matrixMode $= Projection+ loadIdentity+ ortho2D 0 (fromIntegral w) 0 (fromIntegral h)+ matrixMode $= Modelview 0++data DisplaySetup = DisplaySetup {displayTitle :: String,+ displayMode :: [DisplayMode],+ displaySize :: Size,+ displayPosition :: Position,+ displayColor :: Color4 GLclampf,+ displayReshape :: ReshapeCallback,+ displayInit :: (String, [String]) -> IO ()+ }++defaultDisplaySetup = DisplaySetup {displayTitle = "moeDefault",+ displayMode = [DoubleBuffered, RGBAMode],+ displaySize = Size 800 600,+ displayPosition = Position 0 0,+ displayColor = Color4 0 0 0 0,+ displayReshape = defaultReshape,+ displayInit = const $ return ()+ } ++startProg :: DisplaySetup -> Int -> Prog b -> b -> (b -> IO ()) -> IO ()+startProg ds tick sf y0 act = let title = displayTitle ds+ mode = displayMode ds+ size = displaySize ds+ position = displayPosition ds+ color = displayColor ds+ reshape = displayReshape ds+ init = displayInit ds+ in do nameAndArgs <- getArgsAndInitialize+ initialDisplayMode $= mode+ initialWindowSize $= size+ initialWindowPosition $= position+ createWindow title+ clearColor $= color+ init nameAndArgs+ t0 <- get elapsedTime+ r <- newIORef (sf, t0, y0)+ reshapeCallback $= Just reshape+ keyboardMouseCallback $= Just (keyMouse r)+ addTimerCallback tick (timer r tick act)+ displayCallback $= return ()+ mainLoop ++start = startProg defaultDisplaySetup
+ FRP/MoePure.hs view
@@ -0,0 +1,5 @@+module FRP.MoePure (module FRP.MoePure, module Control.Arrow, module FRP.Moe.Core, module FRP.Moe.Combinators) where++import FRP.Moe.Core hiding (dTime, sfDelay, delay, MkSF)+import FRP.Moe.Combinators hiding (cycle, stateful, stateful2)+import Control.Arrow
+ LICENSE view
@@ -0,0 +1,24 @@+Copyright (c) <2011>, <Xinyu Jiang> +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of the <organization> nor the + names of its contributors may be used to endorse or promote products + derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL <COPYRIGHT HOLDER> BE LIABLE FOR ANY +DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Moe.cabal view
@@ -0,0 +1,19 @@+Name: Moe +Version: 0.1 +Description: A FRP library based on signal functions. +License: BSD3 +License-file: LICENSE +Author: Xinyu Jiang +Maintainer: fnnirvana@gmail.com +Category: FRP +Synopsis: A FRP library based on signal functions. +Build-Type: Simple +Cabal-Version: >=1.2 + +Library + Exposed-Modules: FRP.Moe, FRP.MoePure, FRP.MoeGLUT FRP.Moe.Core FRP.Moe.Combinators + Build-Depends: base >=3 && <5, random, GLUT + +Executable MoeExample + Main-Is: FRP/MoeExample.hs + Build-Depends: base, random, GLUT
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple +main = defaultMain