packages feed

Yampa 0.10.6 → 0.10.6.1

raw patch · 8 files changed

+446/−67 lines, 8 filesdep +SDLdep +hcwiidnew-component:exe:yampa-examples-sdl-bouncingboxnew-component:exe:yampa-examples-sdl-circlingmousenew-component:exe:yampa-examples-sdl-wiimotePVP ok

version bump matches the API change (PVP)

Dependencies added: SDL, hcwiid

API changes (from Hackage documentation)

Files

CHANGELOG view
@@ -1,8 +1,13 @@+2017-08-17 Ivan Perez <ivan.perez@keera.co.uk>+        * Yampa.cabal: Version bump (0.10.6.1).+        * examples/: new examples, using wiimote.+        * src/: Minor improvements to documentation.+ 2017-05-05 Ivan Perez <ivan.perez@keera.co.uk>         * Yampa.cabal: Version bump (0.10.6).         * tests/: do not warn if they contain tabs.-	* src/: Includes combinators to deal with collections,-	  to iterate over time (for custom/discrete integration),+        * src/: Includes combinators to deal with collections,+          to iterate over time (for custom/discrete integration),           implements ArrowChoice.  2017-04-26 Ivan Perez <ivan.perez@keera.co.uk>
Yampa.cabal view
@@ -1,5 +1,5 @@ name: Yampa-version: 0.10.6+version: 0.10.6.1 cabal-version: >= 1.8 license: BSD3 license-file: LICENSE@@ -49,6 +49,10 @@   default: True   manual: True +flag examples+  default: False+  manual: True+ library   hs-source-dirs:  src   ghc-options : -O3 -Wall -fno-warn-name-shadowing@@ -132,6 +136,30 @@     build-depends:       base,       Yampa++executable yampa-examples-sdl-bouncingbox+  main-is: MainBouncingBox.hs+  hs-source-dirs:  examples/yampa-game/+  ghc-options : -O3 -Wall -fno-warn-name-shadowing+  build-Depends: base < 5, random, deepseq, SDL, Yampa+  if !flag(examples)+    buildable: False++executable yampa-examples-sdl-circlingmouse+  main-is: MainCircleMouse.hs+  hs-source-dirs:  examples/yampa-game/+  ghc-options : -O3 -Wall -fno-warn-name-shadowing+  build-Depends: base < 5, random, deepseq, SDL, Yampa+  if !flag(examples)+    buildable: False++executable yampa-examples-sdl-wiimote+  main-is: MainWiimote.hs+  hs-source-dirs:  examples/yampa-game/+  ghc-options : -O3 -Wall -fno-warn-name-shadowing -rtsopts+  build-Depends: base < 5, random, deepseq, SDL, hcwiid, Yampa+  if !flag(examples)+    buildable: False  source-repository head   type:     git
+ examples/yampa-game/MainBouncingBox.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE Arrows #-}+import Data.IORef+import Debug.Trace+import FRP.Yampa       as Yampa+import Graphics.UI.SDL as SDL++-- Helper functions+import YampaSDL++width :: Num a => a+width  = 640+height :: Num a => a+height = 480++-- | Reactimation.+--+-- This main function runs an FRP system by producing a signal, passing it+-- through a signal function, and consuming it.+--+-- The first two arguments to reactimate are the value of the input signal+-- at time zero and at subsequent times, together with the times between+-- samples.+-- +-- The third argument to reactimate is the output consumer that renders+-- the signal.+--+-- The last argument is the actual signal function.+--+main = do+  timeRef <- yampaSDLTimeInit+  reactimate initGraphs+             (\_ -> do+                dtSecs <- yampaSDLTimeSense timeRef+                return (dtSecs, Nothing))+             (\_ e -> display e >> return False)+             (bounce (fromIntegral height / 2) 0)++-- * FRP stuff++-- | Vertical coordinate and velocity of a falling mass starting+-- at a height with an initial velocity.+falling :: Double -> Double -> SF () (Double, Double)+falling y0 v0 = proc () -> do+  vy <- (v0+) ^<< integral -< gravity+  py <- (y0+) ^<< integral -< vy+  returnA -< (py, vy)++-- | Vertical coordinate and velocity of a bouncing mass starting+-- at a height with an initial velicity.+bounce :: Double -> Double -> SF () (Double, Double)+bounce y vy = switch (falling y vy >>> (Yampa.identity &&& hitBottom))+                     (\(y, vy) -> bounce y (-vy))++-- | Fire an event when the input height and velocity indicate+-- that the object has hit the bottom (so it's falling and the+-- vertical position is under the floor).+hitBottom :: SF (Double, Double) (Yampa.Event (Double, Double))+hitBottom = arr (\(y,vy) ->+                  let boxTop = y + fromIntegral boxSide+                  in if (boxTop > fromIntegral height) && (vy > 0)+                       then Yampa.Event (y, vy)+                       else Yampa.NoEvent)++-- * Graphics++-- | Initialise rendering system.+initGraphs :: IO ()+initGraphs = do+  -- Initialise SDL+  SDL.init [InitVideo]++  -- Create window+  screen <- setVideoMode width height 16 [SWSurface]+  setCaption "Test" ""++-- | Display a box at a position.+display :: (Double, Double) -> IO()+display (boxY,_) = do+  -- Obtain surface+  screen <- getVideoSurface++  -- Paint screen green+  let format = surfaceGetPixelFormat screen+  bgColor <- mapRGB format 55 60 64+  fillRect screen Nothing bgColor++  -- Paint small red square, at an angle 'angle' with respect to the center+  foreC <- mapRGB format 212 108 73+  let x = (width - boxSide) `div` 2+      y = round boxY+  fillRect screen (Just (Rect x y boxSide boxSide)) foreC++  -- Double buffering+  SDL.flip screen++gravity :: Double+gravity = 6.2++boxSide :: Int+boxSide = 30
+ examples/yampa-game/MainCircleMouse.hs view
@@ -0,0 +1,107 @@+{-# LANGUAGE Arrows #-}+import Data.IORef+import Debug.Trace+import FRP.Yampa       as Yampa+import Graphics.UI.SDL as SDL++-- Helper functions+import YampaSDL++width :: Num a => a+width  = 640+height :: Num a => a+height = 480++-- | Reactimation.+--+-- This main function runs an FRP system by producing a signal, passing it+-- through a signal function, and consuming it.+--+-- The first two arguments to reactimate are the value of the input signal+-- at time zero and at subsequent times, together with the times between+-- samples.+-- +-- The third argument to reactimate is the output consumer that renders+-- the signal.+--+-- The last argument is the actual signal function.+--+main = do+  timeRef <- newIORef (0 :: Int)+  controllerRef <- newIORef $ Controller (0,0)+  reactimate (initGraphs >> readIORef controllerRef)+             (\_ -> do+                dtSecs <- yampaSDLTimeSense timeRef+                mInput <- sdlGetController controllerRef+                -- print (mInput)+                return (dtSecs, Just mInput)+             )+             (\_ e -> display (e) >> return False)+             player++-- * FRP stuff++-- | Player is going in circles around the input controller position+player :: SF Controller (Double, Double)+player = arr controllerPos >>> inCircles++-- | Coordinate of a body going in circles around another body.+inCircles :: SF (Double, Double) (Double, Double)+inCircles = proc (centerX, centerY) -> do+  t <- time -< ()+  let x      = centerX + cos t * radius+      y      = centerY + sin t * radius+      radius = 30+  returnA -< (x,y)++-- * SDL stuff++-- ** Input subsystem++-- | Input controller+data Controller = Controller+ { controllerPos   :: (Double, Double)+ }++-- | Give a controller, refresh its state and return the latest value.+-- We need a non-blocking controller-polling function.+sdlGetController :: IORef Controller -> IO Controller+sdlGetController controllerState = do+  state <- readIORef controllerState+  e     <- pollEvent+  case e of+    MouseMotion x y _ _ -> writeIORef controllerState (Controller (fromIntegral x, fromIntegral y)) >> sdlGetController controllerState+    _                   -> return state++-- * Graphics++-- | Initialise rendering system.+initGraphs :: IO ()+initGraphs = do+  -- Initialise SDL+  SDL.init [InitVideo]++  -- Create window+  screen <- SDL.setVideoMode width height 16 [SWSurface]+  SDL.setCaption "Test" ""++-- | Display a box at a position.+display :: (Double, Double) -> IO()+display (playerX, playerY) = do+  -- Obtain surface+  screen <- getVideoSurface++  -- Paint screen green+  let format = surfaceGetPixelFormat screen+  bgColor <- mapRGB format 55 60 64+  fillRect screen Nothing bgColor++  -- Paint small red square, at an angle 'angle' with respect to the center+  foreC <- mapRGB format 212 108 73+  let side = 10+      x = round playerX+      y = round playerY+  fillRect screen (Just (Rect x y side side)) foreC++  -- Double buffering+  SDL.flip screen
+ examples/yampa-game/MainWiimote.hs view
@@ -0,0 +1,125 @@+{-# LANGUAGE Arrows #-}+import Control.Monad+import Data.IORef+import Data.Maybe+import Debug.Trace+import FRP.Yampa       as Yampa+import Graphics.UI.SDL as SDL+import System.CWiid++-- Helper functions+import YampaSDL++width :: Num a => a+width  = 640+height :: Num a => a+height = 480++-- | Reactimation.+--+-- This main function runs an FRP system by producing a signal, passing it+-- through a signal function, and consuming it.+--+-- The first two arguments to reactimate are the value of the input signal+-- at time zero and at subsequent times, together with the times between+-- samples.+-- +-- The third argument to reactimate is the output consumer that renders+-- the signal.+--+-- The last argument is the actual signal function.+--+main = do+  mWiimote <- initializeWiimote+  timeRef <- newIORef (0 :: Int)+  if isNothing mWiimote+    then putStrLn "Couldn't find wiimote"+    else do let wiimote = fromJust mWiimote+            reactimate (initGraphs >> senseWiimote wiimote)+                       (\_ -> do+                          dtSecs <- yampaSDLTimeSense timeRef+                          mInput <- senseWiimote wiimote+                          return (dtSecs, Just mInput)+                       )+                       (\_ e -> display (e) >> return False)+                       player++-- Pure SF+inCircles :: SF (Double, Double) (Double, Double)+inCircles = proc (centerX, centerY) -> do+  t <- time -< ()+  let x      = centerX + cos t * radius+      y      = centerY + sin t * radius+      radius = 30+  returnA -< (x,y)++-- * Graphics++-- | Initialise rendering system.+initGraphs :: IO ()+initGraphs = do+  -- Initialise SDL+  SDL.init [InitVideo]++  -- Create window+  screen <- SDL.setVideoMode width height 16 [SWSurface]+  SDL.setCaption "Test" ""++-- | Display a box at a position.+display :: (Double, Double) -> IO()+display (playerX, playerY) = do+  -- Obtain surface+  screen <- getVideoSurface++  -- Paint screen green+  let format = surfaceGetPixelFormat screen+  bgColor <- mapRGB format 55 60 64+  fillRect screen Nothing bgColor++  -- Paint small red square, at an angle 'angle' with respect to the center+  foreC <- mapRGB format 212 108 73+  let side = 30+      x = round playerX+      y = round playerY+  fillRect screen (Just (Rect x y side side)) foreC++  -- Double buffering+  SDL.flip screen++player :: SF (Double, Double) (Double, Double)+player = inCircles++senseWiimote :: CWiidWiimote -> IO (Double, Double)+senseWiimote wmdev = do+  irs   <- cwiidGetIR wmdev++  -- Obtain positions of leds 1 and 2 (with a normal wii bar, those+  -- will be the ones we use).+  let led1   = irs!!0+      led2   = irs!!1++  -- Calculate mid point between sensor bar leds+  let posX = ((cwiidIRSrcPosX led1) + (cwiidIRSrcPosX led2)) `div` 2+      posY = ((cwiidIRSrcPosY led1) + (cwiidIRSrcPosY led2)) `div` 2++  -- Calculate proportional coordinates+  let propX = fromIntegral (1024 - posX) / width+      propY = fromIntegral (max 0 (posY - 384)) / 384.0++  -- Calculate game area coordinates+  let finX  = width  * propX+      finY  = height * propY++  return (finX, finY) ++-- | Initializes the wiimote, optionally returning the sensing function. It+-- returns Nothing if the Wiimote cannot be detected. Users should have a BT+-- device and press 1+2 to connect to it. A message is shown on stdout.+initializeWiimote :: IO (Maybe CWiidWiimote)+initializeWiimote = do+  putStrLn "Initializing WiiMote. Please press 1+2 to connect."+  wm <- cwiidOpen+  case wm of+    Nothing  -> return ()+    Just wm' -> void $ cwiidSetRptMode wm' 15 -- Enable button reception, acc and IR+  return wm
src/FRP/Yampa.hs view
@@ -18,8 +18,11 @@ -- -- You can find examples, tutorials and documentation on Yampa here: ----- <www.haskell.org/haskellwiki/Yampa>+-- <https://wiki.haskell.org/Yampa> --+-- <https://github.com/ivanperez-keera/Yampa/tree/master/examples>+--+-- -- Structuring a hybrid system in Yampa is done based on two main concepts: -- -- * Signal Functions: 'SF'. Yampa is based on the concept of Signal Functions,@@ -39,11 +42,10 @@ -- an input sensing action and an actuation/consumer action and executes -- until explicitly stopped), and 'react' (which executes only one cycle). ----- This will be the last version of Yampa to include mergeable records,--- point2 and point3, vector2 and vector3, and other auxiliary definitions. The--- internals have now changed. Although not all will be exposed in the next--- version, below is the new project structure. Please, take a look and let us--- know if you think there are any potential problems with it.+-- This will be the last version of Yampa to include mergeable records, point2+-- and point3, vector2 and vector3, and other auxiliary definitions. The+-- internals have now changed. Also, please let us know if you see any problems+-- with the new project structure. -- -- Main Yampa modules: --@@ -108,7 +110,7 @@ -- * "FRP.Yampa.Diagnostics" -- -- * "FRP.Yampa.Forceable"--- +-- -- * "FRP.Yampa.Internals"  -- No longer in use -- -- * "FRP.Yampa.MergeableRecord"@@ -116,48 +118,42 @@ -- * "FRP.Yampa.Miscellany" -- -- * "FRP.Yampa.Utilities"------ CHANGELOG:------ * Adds (most) documentation.------ * New version using GADTs.---+ -- ToDo: ----- * Specialize def. of repeatedly. Could have an impact on invaders.+-- - Specialize def. of repeatedly. Could have an impact on invaders. ----- * New defs for accs using SFAcc+-- - New defs for accs using SFAcc ----- * Make sure opt worked: e.g.+-- - Make sure opt worked: e.g. -----   >     repeatedly >>> count >>> arr (fmap sqr)+-- - >     repeatedly >>> count >>> arr (fmap sqr) ----- * Introduce SFAccHld.+-- - Introduce SFAccHld. ----- * See if possible to unify AccHld wity Acc??? They are so close.+-- - See if possible to unify AccHld wity Acc??? They are so close. ----- * Introduce SScan. BUT KEEP IN MIND: Most if not all opts would---   have been possible without GADTs???+-- - Introduce SScan. BUT KEEP IN MIND: Most if not all opts would+-- - have been possible without GADTs??? ----- * Look into pairs. At least pairing of SScan ought to be interesting.+-- - Look into pairs. At least pairing of SScan ought to be interesting. ----- * Would be nice if we could get rid of first & second with impunity---   thanks to Id optimizations. That's a clear win, with or without---   an explicit pair combinator.+-- - Would be nice if we could get rid of first & second with impunity+-- - thanks to Id optimizations. That's a clear win, with or without+-- - an explicit pair combinator. ----- * delayEventCat is a bit complicated ...+-- - delayEventCat is a bit complicated ... -- -- -- Random ideas: ----- * What if one used rules to optimize+-- - What if one used rules to optimize --   - (arr :: SF a ()) to (constant ()) --   - (arr :: SF a a) to identity --   But inspection of invader source code seem to indicate that --   these are not very common cases at all. ----- * It would be nice if it was possible to come up with opt. rules+-- - It would be nice if it was possible to come up with opt. rules --   that are invariant of how signal function expressions are --   parenthesized. Right now, we have e.g. --       arr f >>> (constant c >>> sf)@@ -169,7 +165,7 @@ --      SFComp :: <tfun> -> SF' a b -> SF' b c -> SF' a c --   ??? ----- * The transition function would still be optimized in (pretty much)+-- - The transition function would still be optimized in (pretty much) --   the current way, but it would still be possible to look "inside" --   composed signal functions for lost optimization opts. --   Seems to me this could be done without too much extra effort/no dupl.@@ -185,10 +181,10 @@ --                      (sf2', c) = (sfTF' sf2) dt b -- @ ----- * The ONLY change was changing the constructor from SF' to SFComp and+-- - The ONLY change was changing the constructor from SF' to SFComp and --   adding sf1 and sf2 to the constructor app.! ----- * An optimized case:+-- - An optimized case: --     cpAuxC1 b sf1 sf2               = SFComp tf sf1 sf2 --   So cpAuxC1 gets an extra arg, and we change the constructor. --   But how to exploit without writing 1000s of rules???@@ -197,10 +193,10 @@ --   recursive call? E.g. we're in the arr case, and the first sf is another --   arr, so we'd like to combine the two. ----- * It would also be intersting, then, to know when to STOP playing this+-- - It would also be intersting, then, to know when to STOP playing this --   game, due to the overhead involved. ----- * Why don't we have a "SWITCH" constructor that indicates that the+-- - Why don't we have a "SWITCH" constructor that indicates that the --   structure will change, and thus that it is worthwile to keep --   looking for opt. opportunities, whereas a plain "SF'" would --   indicate that things NEVER are going to change, and thus we can just@@ -300,7 +296,7 @@     rMerge,               -- :: Event a -> Event a -> Event a,    infixl 6     merge,                -- :: Event a -> Event a -> Event a,    infixl 6     mergeBy,              -- :: (a -> a -> a) -> Event a -> Event a -> Event a-    mapMerge,             -- :: (a -> c) -> (b -> c) -> (a -> b -> c) +    mapMerge,             -- :: (a -> c) -> (b -> c) -> (a -> b -> c)                           --    -> Event a -> Event b -> Event c     mergeEvents,          -- :: [Event a] -> Event a     catEvents,            -- :: [Event a] -> Event [a]
src/FRP/Yampa/InternalCore.hs view
@@ -49,48 +49,48 @@ -- "FRP.Yampa.Event" defines events and event-manipulation functions. -- -- Finally, see [<#g:26>] for sources of randomness (useful in games).---+ -- CHANGELOG: ----- * Adds (most) documentation.+-- - Adds (most) documentation. ----- * New version using GADTs.+-- - New version using GADTs. -- -- ToDo: ----- * Specialize def. of repeatedly. Could have an impact on invaders.+-- - Specialize def. of repeatedly. Could have an impact on invaders. ----- * New defs for accs using SFAcc+-- - New defs for accs using SFAcc ----- * Make sure opt worked: e.g.+-- - Make sure opt worked: e.g. -----   >     repeatedly >>> count >>> arr (fmap sqr)+-- - >     repeatedly >>> count >>> arr (fmap sqr) ----- * Introduce SFAccHld.+-- - Introduce SFAccHld. ----- * See if possible to unify AccHld wity Acc??? They are so close.+-- - See if possible to unify AccHld wity Acc??? They are so close. ----- * Introduce SScan. BUT KEEP IN MIND: Most if not all opts would---   have been possible without GADTs???+-- - Introduce SScan. BUT KEEP IN MIND: Most if not all opts would+-- - have been possible without GADTs??? ----- * Look into pairs. At least pairing of SScan ought to be interesting.+-- - Look into pairs. At least pairing of SScan ought to be interesting. ----- * Would be nice if we could get rid of first & second with impunity---   thanks to Id optimizations. That's a clear win, with or without---   an explicit pair combinator.+-- - Would be nice if we could get rid of first & second with impunity+-- - thanks to Id optimizations. That's a clear win, with or without+-- - an explicit pair combinator. ----- * delayEventCat is a bit complicated ...+-- - delayEventCat is a bit complicated ... -- -- -- Random ideas: ----- * What if one used rules to optimize+-- - What if one used rules to optimize --   - (arr :: SF a ()) to (constant ()) --   - (arr :: SF a a) to identity --   But inspection of invader source code seem to indicate that --   these are not very common cases at all. ----- * It would be nice if it was possible to come up with opt. rules+-- - It would be nice if it was possible to come up with opt. rules --   that are invariant of how signal function expressions are --   parenthesized. Right now, we have e.g. --       arr f >>> (constant c >>> sf)@@ -102,7 +102,7 @@ --      SFComp :: <tfun> -> SF' a b -> SF' b c -> SF' a c --   ??? ----- * The transition function would still be optimized in (pretty much)+-- - The transition function would still be optimized in (pretty much) --   the current way, but it would still be possible to look "inside" --   composed signal functions for lost optimization opts. --   Seems to me this could be done without too much extra effort/no dupl.@@ -118,10 +118,10 @@ --                      (sf2', c) = (sfTF' sf2) dt b -- @ ----- * The ONLY change was changing the constructor from SF' to SFComp and+-- - The ONLY change was changing the constructor from SF' to SFComp and --   adding sf1 and sf2 to the constructor app.! ----- * An optimized case:+-- - An optimized case: --     cpAuxC1 b sf1 sf2               = SFComp tf sf1 sf2 --   So cpAuxC1 gets an extra arg, and we change the constructor. --   But how to exploit without writing 1000s of rules???@@ -130,10 +130,10 @@ --   recursive call? E.g. we're in the arr case, and the first sf is another --   arr, so we'd like to combine the two. ----- * It would also be intersting, then, to know when to STOP playing this+-- - It would also be intersting, then, to know when to STOP playing this --   game, due to the overhead involved. ----- * Why don't we have a "SWITCH" constructor that indicates that the+-- - Why don't we have a "SWITCH" constructor that indicates that the --   structure will change, and thus that it is worthwile to keep --   looking for opt. opportunities, whereas a plain "SF'" would --   indicate that things NEVER are going to change, and thus we can just@@ -514,7 +514,7 @@                   Left x  -> let (sf', b') = sfTF' fSF dt x                              in (futureArrowLeft sf', Left b')                   Right x -> (futureArrowLeft fSF, Right x)-          +  instance Arrow SF where     arr    = arrPrim
src/FRP/Yampa/Switches.hs view
@@ -9,7 +9,25 @@ -- Stability   :  provisional -- Portability :  non-portable (GHC extensions) --------------------------------------------------------------------------------------------+-- Switches allow you to change the signal function being applied.+--+-- The basic idea of switching is fromed by combining a subordinate signal function+-- and a signal function continuation parameterised over some initial data.+--+-- For example, the most basic switch has the following signature:+--+-- @switch :: SF a (b, Event c) -> (c -> SF a b) -> SF a b@+--+-- which indicates that it has two parameters: a signal function+-- that produces an output and indicates, with an event, when it is time to+-- switch, and a signal function that starts with the residual data left by the+-- first SF in the event and continues onwards.+--+-- Note that switching occurs, at most, once. If you want something to switch+-- repeatedly, you need to loop. However, some switches are immediate (meaning+-- that the second SF is started at the time of switching). If you use the same+-- SF that originally provoked the switch, you are very likely to fall into an+-- infinite loop.  module FRP.Yampa.Switches (     -- Re-exported module, classes, and types@@ -296,7 +314,7 @@  -- | Recurring switch. ----- See <http://www.haskell.org/haskellwiki/Yampa#Switches> for more+-- See <https://wiki.haskell.org/Yampa#Switches> for more -- information on how this switch works.  -- !!! Suboptimal. Overall, the constructor is invarying since rSwitch is@@ -320,7 +338,7 @@  -- | Recurring switch with delayed observation. ----- See <http://www.haskell.org/haskellwiki/Yampa#Switches> for more+-- See <https://wiki.haskell.org/Yampa#Switches> for more -- information on how this switch works. drSwitch :: SF a b -> SF (a, Event (SF a b)) b drSwitch sf = dSwitch (first sf) ((noEventSnd >=-) . drSwitch)@@ -336,7 +354,7 @@  -- | "Call-with-current-continuation" switch. ----- See <http://www.haskell.org/haskellwiki/Yampa#Switches> for more+-- See <https://wiki.haskell.org/Yampa#Switches> for more -- information on how this switch works.  -- !!! Has not been optimized properly.@@ -455,7 +473,7 @@  -- | 'kSwitch' with delayed observation. ----- See <http://www.haskell.org/haskellwiki/Yampa#Switches> for more+-- See <https://wiki.haskell.org/Yampa#Switches> for more -- information on how this switch works.  -- !!! Has not been optimized properly. Should be like kSwitch.