diff --git a/CHANGELOG b/CHANGELOG new file mode 100644 --- /dev/null +++ b/CHANGELOG @@ -0,0 +1,6 @@ +2018-10-29 Ivan Perez + + * Initial release (0.1). + +Copyright (C) 2015-2018 Konstantin Saveljev, 2018 Ivan Perez +All rights reserved. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,22 @@ +The MIT License (MIT) + +Copyright (c) 2015-2018 Konstantin Saveljev, 2018 Ivan Perez + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/examples/Example.hs b/examples/Example.hs new file mode 100644 --- /dev/null +++ b/examples/Example.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE Arrows #-} +import Control.Arrow ( (^<<), returnA ) +import FRP.Yampa ( SF, 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 ) + +main :: IO () +main = playYampa (InWindow "YampaDemo" (1280, 1050) (200, 200)) white 30 rotatingColor + +rotatingColor :: SF a Picture +rotatingColor = proc _ -> do + t <- double2Float ^<< time -< () -- Yampa's time is Double, Gloss units are Float. + returnA -< rotate (180 * t / pi) $ Translate 200 200 + $ Color (withAlpha 0.8 red) + $ circleSolid 80 diff --git a/src/Graphics/Gloss/Interface/FRP/Yampa.hs b/src/Graphics/Gloss/Interface/FRP/Yampa.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/Gloss/Interface/FRP/Yampa.hs @@ -0,0 +1,48 @@ +module Graphics.Gloss.Interface.FRP.Yampa + (playYampa, InputEvent) + where + +import Control.Monad (when) +import Data.IORef (newIORef, readIORef, + writeIORef) +import FRP.Yampa (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 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 + -> 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 + + -- An action to convert the world to a 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')) + + playIO display color frequency 0 toPic handleInput stepWorld diff --git a/yampa-gloss.cabal b/yampa-gloss.cabal new file mode 100644 --- /dev/null +++ b/yampa-gloss.cabal @@ -0,0 +1,55 @@ +name: yampa-gloss +version: 0.1.0.0 +synopsis: A GLOSS backend for Yampa +description: + A Gloss backend for Yampa. + . + Gloss is a purely functional library to create pictures and animations. + Yampa is a Functional Reactive Programming DSL structured using arrow + combinators. + . + This library provides a function to create an interactive gloss animation + driven by a signal function that transforms a Gloss input signal into a Gloss + Picture. + +homepage: http://github.com/ivanperez-keera/yampa-gloss +license: MIT +license-file: LICENSE +author: Konstantin Saveljev , Ivan Perez +maintainer: ivan.perez@keera.co.uk +copyright: (C) 2015-2018 Konstantin Saveljev, 2018 Ivan Perez +category: Graphics +build-type: Simple +extra-source-files: CHANGELOG +cabal-version: >=1.10 + +flag examples + Description: Enable examples + default: False + manual: True + +library + exposed-modules: Graphics.Gloss.Interface.FRP.Yampa + build-depends: base >= 4.7 && <4.13 + , gloss >= 1.10 && <1.13 + , Yampa >= 0.9.6 && <0.13 + hs-source-dirs: src + default-language: Haskell2010 + +executable yampa-examples-gloss-rotatingcolor + main-is: Example.hs + hs-source-dirs: examples/ + ghc-options : -Wall + default-language: Haskell2010 + if flag(examples) + buildable: True + build-depends: base >= 4.7 && <4.13 + , gloss >= 1.10 && <1.13 + , Yampa >= 0.9.6 && <0.13 + , yampa-gloss + else + buildable: False + +source-repository head + type: git + location: git://github.com/ivanperez-keera/yampa-gloss.git