yampa-gloss 0.2 → 0.2.1
raw patch · 4 files changed
+156/−37 lines, 4 filesdep ~Yampadep ~basePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: Yampa, base
API changes (from Hackage documentation)
Files
- CHANGELOG +5/−0
- examples/Example.hs +95/−9
- src/Graphics/Gloss/Interface/FRP/Yampa.hs +51/−23
- yampa-gloss.cabal +5/−5
CHANGELOG view
@@ -1,3 +1,8 @@+2023-04-08 Ivan Perez <ivan.perez@keera.co.uk>+ * Version bump (0.2.1) (#16).+ * Conformance with style guide (#14).+ * Bumps contraints on base, Yampa (#15).+ 2019-02-24 Ivan Perez <ivan.perez@keera.es> * Bumps version number (0.2).
examples/Example.hs view
@@ -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 view
@@ -1,48 +1,76 @@+-- |+-- Copyright : (c) 2018-2023 Ivan Perez+-- (c) 2015-2018 Konstantin Saveljev+-- License : MIT License (MIT)+-- Maintainer : ivan.perez@keera.co.uk+--+-- 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-- let delta = 0.01 / fromIntegral frequency+ (return NoEvent)+ (\_ updated pic -> do when updated (picRef `writeIORef` pic)+ return False+ )+ mainSF - -- 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))+ 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 = - (\d t -> let delta' = realToFrac d - t- in if delta' > 0- then react handle (delta', Just NoEvent) >> return 0.0- else return (-delta')) + -- 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 view
@@ -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 @@ 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 @@ 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