Merge branch 'release-0.2.1'. Refs #16.

CHANGELOG

@@ -1,3 +1,8 @@
+2023-04-08 Ivan Perez <[email protected]>
+        * Version bump (0.2.1) (#16).
+        * Conformance with style guide (#14).
+        * Bumps contraints on base, Yampa (#15).
+
 2019-02-24 Ivan Perez <[email protected]>
 
         * Bumps version number (0.2).

examples/Example.hs

@@ -1,18 +1,104 @@
-{-# LANGUAGE Arrows #-}
-import Control.Arrow                      ( (^<<), returnA )
-import FRP.Yampa                          ( SF, time )
+{-# LANGUAGE Arrows           #-}
+{-# LANGUAGE ParallelListComp #-}
+import Control.Arrow                      ( returnA, (&&&), (>>^), (^<<) )
+import FRP.Yampa                          ( SF, Event, after, constant, switch, time )
 import GHC.Float                          ( double2Float )
-import Graphics.Gloss                     ( Picture (Color, Translate)
-                                          , Display(InWindow), circleSolid
-                                          , red, rotate, white, withAlpha )
-import Graphics.Gloss.Interface.FRP.Yampa ( playYampa )
+import Graphics.Gloss                     ( Color, Display (InWindow)
+                                          , Picture (Color, Pictures, Translate)
+                                          , aquamarine, azure, blue
+                                          , chartreuse, circleSolid
+                                          , cyan, green, magenta
+                                          , orange, polygon, red, red
+                                          , rose, rotate, thickArc
+                                          , violet, white, withAlpha
+                                          , yellow
+                                          )
+import Graphics.Gloss.Interface.FRP.Yampa ( InputEvent, playYampa )
 
 main :: IO ()
-main = playYampa (InWindow "YampaDemo" (1280, 1050) (200, 200)) white 30 rotatingColor
+main = defaultPlay rotatingColor
+
+defaultPlay :: SF (Event InputEvent) Picture -> IO ()
+defaultPlay = playYampa (InWindow "YampaDemo" (1280, 1050) (200, 200)) white 30
 
 rotatingColor :: SF a Picture
 rotatingColor = proc _ -> do
-  t <- double2Float ^<< time -< () -- Yampa's time is Double, Gloss units are Float.
+  t <- ftime -< () -- Yampa's time is Double, Gloss units are Float.
   returnA -< rotate (180 * t / pi) $ Translate 200 200
                                    $ Color (withAlpha 0.8 red)
                                    $ circleSolid 80
+
+--
+plainWave :: SF a Picture
+plainWave = proc _ -> do
+    t <- (*1.25) ^<< ftime -< ()
+
+    let t2      n = (sin (t + 2 * pi * fromIntegral n / 45)) ** 2
+        circleX n = fromIntegral n * 20 - 400
+        circleY n = t2 n * 200
+
+    returnA -< Pictures
+      [ Translate (circleX n) (circleY n)
+        $ Color (withAlpha 0.8 magenta)
+        $ circleSolid 10
+      | n <- [0 .. length colors]
+      | c <- colors
+      ]
+
+
+
+wave :: SF a Picture
+wave = proc _ -> do
+  t  <- (*20) ^<< ftime -< ()
+  let t2 = (t - 20) `modF` 60
+  let t3 = (t - 40) `modF` 60
+  let t4 = t `modF` 60
+  let a1 = if t4 < 5 then Pictures [] else thickArc 0 90 t4 10
+      a2 = if t2 < 5 then Pictures [] else thickArc 0 90 t2 10
+      a3 = if t3 < 5 then Pictures [] else thickArc 0 90 t3 10
+  returnA -< rotate 45 $ Pictures [a1, a2, a3]
+
+linearTween :: Double -> SF a Double
+linearTween maxTime =
+    switch (progress &&& after maxTime ()) (\_ -> constant 1)
+  where
+    progress = proc _ -> do
+      t <- time -< ()
+      let prop = t / maxTime
+      returnA -< prop
+
+-- * Auxiliary definitions
+
+-- ** Auxiliary Gloss definitions
+
+thickRectangle thickness w h =
+   Pictures [ polygon [(0,0), (w, 0), (w, thickness), (0, thickness), (0, 0)]
+            , polygon [(w-thickness,0), (w, 0), (w, h), (w-thickness, h), (w-thickness, 0)]
+            , polygon [(0,0), (thickness, 0), (thickness, h), (0, h), (0, 0)]
+            , polygon [(0,h-thickness), (w, h-thickness), (w, h), (0, h), (0, h-thickness)]
+            ]
+
+colors :: [Color]
+colors = [ red,  orange, yellow, chartreuse, green,   aquamarine
+         , cyan, azure,  blue,   violet,     magenta, rose
+         ]
+
+arrowHead :: Picture
+arrowHead = polygon [(100,0), (0, 40), (0, -40)]
+
+nothing :: Picture
+nothing = Pictures []
+
+-- ** Auxiliary Num definitions
+
+modF :: Float -> Float -> Float
+modF f1 m = if f1 > m then modF (f1 - m) m else f1
+
+-- ** Auxiliary Yampa definitions
+
+untilSF  sf1 sf2 = sf1 &&& sf2
+forSF    sf1 t   = sf1 `untilSF` after t ()
+andThen_ sf1 sf2 = switch sf1 (\_ -> sf2)
+
+ftime :: SF a Float
+ftime = time >>^ double2Float

src/Graphics/Gloss/Interface/FRP/Yampa.hs

@@ -1,48 +1,76 @@
+-- |
+-- Copyright  : (c) 2018-2023 Ivan Perez
+--              (c) 2015-2018 Konstantin Saveljev
+-- License    : MIT License (MIT)
+-- Maintainer : [email protected]
+--
+-- Gloss backend for Yampa.
+--
+-- Gloss is a purely functional library to create pictures and animations.
+-- Yampa is a Functional Reactive Programming DSL structured around signal
+-- functions.
+--
+-- This module provides a function to create an interactive Gloss animation
+-- driven by a signal function that transforms a Gloss input signal into a
+-- Gloss 'Picture'.
 module Graphics.Gloss.Interface.FRP.Yampa
-    (playYampa, InputEvent)
+    (InputEvent, playYampa)
   where
 
+-- External imports
 import           Control.Monad                    (when)
 import           Data.IORef                       (newIORef, readIORef,
                                                    writeIORef)
-import           FRP.Yampa                        (Event (..), SF, react,
+import           FRP.Yampa                        (DTime, Event (..), SF, react,
                                                    reactInit)
 import           Graphics.Gloss                   (Color, Display, Picture,
                                                    blank)
-import qualified Graphics.Gloss
 import           Graphics.Gloss.Interface.IO.Game (playIO)
 import qualified Graphics.Gloss.Interface.IO.Game as G
 
+-- | Type representing input events to the signal function.
+--
+-- Note that this type represents the kind of information placed inside the
+-- Yampa 'Event'. It will still be wrapped in an 'Event' to represent the fact
+-- that an 'InputEvent' may or may not be present at one particular point in
+-- time, and that it changes discretely.
 type InputEvent = G.Event
 
--- | Play the game in a window, updating when the value of the provided 
-playYampa :: Display -- ^ The display method
-          -> Color   -- ^ The background color
-          -> Int     -- ^ The refresh rate, in Hertz
-          -> SF (Event InputEvent) Picture
+-- | Play the game in a window, updating when the value of the provided
+playYampa :: Display                       -- ^ The display method
+          -> Color                         -- ^ The background color
+          -> Int                           -- ^ The refresh rate, in Hertz
+          -> SF (Event InputEvent) Picture -- ^ Signal function
           -> IO ()
 playYampa display color frequency mainSF = do
   picRef <- newIORef blank
 
   handle <- reactInit
-    (return NoEvent)
-    (\_ updated pic -> when updated (picRef `writeIORef` pic) >> return False)
-    mainSF
+              (return NoEvent)
+              (\_ updated pic -> do when updated (picRef `writeIORef` pic)
+                                    return False
+              )
+              mainSF
 
-  let delta = 0.01 / fromIntegral frequency
-
-      -- An action to convert the world to a picture
-      toPic = (const $ readIORef picRef)
+  let -- An action to convert the world to a picture
+      toPic :: DTime -> IO Picture
+      toPic = const $ readIORef picRef
 
       -- A function to handle input events
-      handleInput = (\e t -> react handle (delta, Just (Event e)) >> return (t + delta))
-
-      -- A function to step the world one  iteration. It is passed the period
-      -- of time (in seconds) needing to be  advanced 
-      stepWorld   = 
-         (\d t -> let delta' = realToFrac d - t
-                 in if delta' > 0
-                      then react handle (delta', Just NoEvent) >> return 0.0
-                      else return (-delta')) 
+      handleInput :: G.Event -> DTime -> IO DTime
+      handleInput event timeAcc = do
+          _quit <- react handle (delta, Just (Event event))
+          return (timeAcc + delta)
+        where
+          delta = 0.01 / fromIntegral frequency
+
+      -- A function to step the world one iteration. It is passed the period of
+      -- time (in seconds) needing to be advanced
+      stepWorld :: Float -> DTime -> IO DTime
+      stepWorld delta timeAcc
+          | delta' > 0 = react handle (delta', Just NoEvent) >> return 0.0
+          | otherwise  = return (-delta')
+        where
+          delta' = realToFrac delta - timeAcc
 
   playIO display color frequency 0 toPic handleInput stepWorld

yampa-gloss.cabal

@@ -1,5 +1,5 @@
 name:                yampa-gloss
-version:             0.2
+version:             0.2.1
 synopsis:            A GLOSS backend for Yampa
 description:
   A Gloss backend for Yampa.
@@ -30,9 +30,9 @@ flag examples
 
 library
   exposed-modules:     Graphics.Gloss.Interface.FRP.Yampa
-  build-depends:       base  >= 4.7   && <4.13
+  build-depends:       base  >= 4.7   && <4.19
                      , gloss >= 1.10  && <1.14
-                     , Yampa >= 0.9.6 && <0.14
+                     , Yampa >= 0.9.6 && <0.15
   hs-source-dirs:      src
   default-language:    Haskell2010
 
@@ -43,9 +43,9 @@ executable yampa-examples-gloss-rotatingcolor
   default-language:    Haskell2010
   if flag(examples)
     buildable: True
-    build-depends:       base        >= 4.7   && <4.13
+    build-depends:       base        >= 4.7   && <4.19
                        , gloss       >= 1.10  && <1.14
-                       , Yampa       >= 0.9.6 && <0.14
+                       , Yampa       >= 0.9.6 && <0.15
                        , yampa-gloss
   else
     buildable: False