packages feed

shine-varying (empty) → 0.1.0.0

raw patch · 7 files changed

+336/−0 lines, 7 filesdep +basedep +ghcjs-domdep +keycodesetup-changed

Dependencies added: base, ghcjs-dom, keycode, shine, shine-varying, varying

Files

+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2016 Francesco Gazzetta++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.
+ README.md view
@@ -0,0 +1,8 @@+# shine-varying++**FRP interface for [`shine`](https://github.com/fgaz/shine) in terms of [`Var`s](https://github.com/schell/varying)**++This package exports a function that lets you control shine's+functionality through a `Var` that maps from inputs to a `Picture`+plus a bunch of utility `Var`s, like the current time and the+keypresses.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ shine-varying.cabal view
@@ -0,0 +1,48 @@+name:                shine-varying+version:             0.1.0.0+synopsis:            FRP interface for shine using the varying package+description:+  This package exports a function that lets you control shine's+  functionality through a `Var` that maps from inputs to a `Picture`+  plus a bunch of utility `Var`s, like the current time and the+  keypresses.+copyright: (c) 2016 Francesco Gazzetta+author:              Francesco Gazzetta+maintainer: Francesco Gazzetta <francygazz@gmail.com>+stability: experimental+homepage: https://github.com/fgaz/shine-varying+bug-reports: https://github.com/fgaz/shine-varying/issues+license:             MIT+license-file:        LICENSE+category:            Graphics, Web, FRP, Javascript+build-type:          Simple+extra-source-files:  README.md+cabal-version:       >=1.8++source-repository head+    type: git+    location: https://github.com/fgaz/shine-varying++library+  exposed-modules:     Graphics.Shine.FRP.Varying+  -- other-modules:       +  -- other-extensions:    +  build-depends:       base >=4.8 && <5.0,+                       ghcjs-dom,+                       shine >=0.0 && <1.0,+                       varying >=0.5 && < 0.6,+                       keycode+  hs-source-dirs:      src++ --TODO run this in an actual window+test-suite test-shine-varying-misc+    type:       exitcode-stdio-1.0+    main-is:    misc.hs+    hs-source-dirs: tests+    build-depends: base, ghcjs-dom, shine, shine-varying, varying, keycode++test-suite test-shine-varying-resize+    type:       exitcode-stdio-1.0+    main-is:    resizeNarwhal.hs+    hs-source-dirs: tests+    build-depends: base, ghcjs-dom, shine, shine-varying
+ src/Graphics/Shine/FRP/Varying.hs view
@@ -0,0 +1,163 @@+{-|+Module      : Graphics.Shine.FRP.Varying+Description : FRP interface for shine+Copyright   : (c) Francesco Gazzetta, 2016+License     : MIT+Maintainer  : francygazz@gmail.com+Stability   : experimental++This package lets you interact with the screen Elm-style.+This is especially useful for small games or visualizations.+You can get something on the screen quickly using the Vars provided below.++Try to run this:++> import Graphics.Shine.FRP.Varying+> import Graphics.Shine+> import Graphics.Shine.Picture+> import Graphics.Shine.Image+> import GHCJS.DOM (webViewGetDomDocument, runWebGUI)+>+> resizeImage img (x',y') = Translate (x/2) (y/2) -- Pictures are centered on (0,0), so we need to move it+>                         $ Image (Stretched x y) img -- Scale de picture to the given position+>   where+>     x = fromIntegral x' -- mousePosition is Integral+>     y = fromIntegral y'+>+> main :: IO ()+> main = runWebGUI $ \ webView -> do+>     ctx <- fixedSizeCanvas webView 1024 768+>     Just doc <- webViewGetDomDocument webView+>     narwhal <- makeImage "https://wiki.haskell.org/wikiupload/8/85/NarleyYeeaaahh.jpg"+>     let resizedNarwhal = resizeImage narwhal <$> mousePosition+>     playVarying ctx doc 30 resizedNarwhal+++-}+module Graphics.Shine.FRP.Varying (+  ShineInput(..),+  -- * Running the Var+  playVarying,+  playVaryingIO,+  -- * Useful Vars+  timeDeltaNumeric,+  timeDeltaEvent,+  time,+  isDownButton,+  isDownKey,+  mousePosition,+  mouseButtonsDown,+  keysDown+) where++import Graphics.Shine.Input+import Graphics.Shine.Picture+import Graphics.Shine+import Control.Varying.Core+import Control.Varying.Event+import Control.Category ((.))+import Prelude hiding ((.))+import Web.KeyCode+import Data.Functor.Identity+import Data.List (delete)+import GHCJS.DOM.CanvasRenderingContext2D (CanvasRenderingContext2D)+import GHCJS.DOM.Types (IsDocument)+import GHCJS.DOM.EventTarget (IsEventTarget)+++-- | Datatype representing all possible inputs coming from shine's main loop+data ShineInput =+    -- | An input event (keypress, mousemove...)+    Input Input+    -- | An advancement in time+    | Time Float+++-- | Feed the input to the Var and draw the result+playVarying :: (IsEventTarget eventElement, IsDocument eventElement)+            => CanvasRenderingContext2D -- ^ The context to draw on+            -> eventElement -- ^ the element used to catch events+            -> Float -- ^ FPS+            -> Var ShineInput Picture -- ^ A 'Var' that maps time and input events to a 'Picture'+            -> IO ()+playVarying ctx doc fps v =+    play ctx doc fps (Empty, v) fst (\a b -> runIdentity $ handleInput a b) (\a b -> runIdentity $ step a b)++-- | Feed the input to the VarT IO and draw the result+playVaryingIO :: (IsEventTarget eventElement, IsDocument eventElement)+              => CanvasRenderingContext2D -- ^ The context to draw on+              -> eventElement -- ^ the element used to catch events+              -> Float -- ^ FPS+              -> VarT IO ShineInput Picture -- ^ An effectful 'VarT' that maps time and input events to a 'Picture'+              -> IO ()+playVaryingIO ctx doc fps v =+    playIO ctx doc fps (Empty, v) (return . fst) handleInput step++handleInput :: Monad m => Input -> (Picture, VarT m ShineInput Picture) -> m (Picture, VarT m ShineInput Picture)+handleInput i (_,v) = do+  v' <- snd <$> runVarT v (Input i)+  return (Empty, v')++step :: Monad m => Float -> (Picture, VarT m ShineInput Picture) -> m (Picture, VarT m ShineInput Picture)+step t (_,v) = runVarT v $ Time t+++-- | Time delta. On non-time inputs the value is 0.+timeDeltaNumeric :: Monad m => VarT m ShineInput Float+timeDeltaNumeric = var f+  where+    f (Input _) = 0+    f (Time t) = t++-- | Time delta. On non-time inputs the value is NoEvent.+timeDeltaEvent :: Monad m => VarT m ShineInput (Event Float)+timeDeltaEvent = var f+  where+    f (Input _) = NoEvent+    f (Time t) = Event t++-- | Time since beginning.+time :: Monad m => VarT m ShineInput Float+time = accumulate (+) 0 . timeDeltaNumeric+++-- | Whether a mouse button is pressed.+isDownButton :: Monad m => MouseBtn -> VarT m ShineInput Bool+isDownButton b = accumulate f False+  where+    f _ (Input (MouseBtn b' Down _)) | b == b' = True+    f _ (Input (MouseBtn b' Up _)) | b == b' = False+    f s _ = s++-- | A list of mouse buttons that are currently being pressed.+mouseButtonsDown :: Monad m => VarT m ShineInput [MouseBtn]+mouseButtonsDown = accumulate f []+  where+    f bs (Input (MouseBtn b Down _)) = if b `elem` bs then bs else b:bs+    f bs (Input (MouseBtn b Up _)) = delete b bs+    f bs _ = bs++-- | The pointer's position, relative to the canvas.+-- The top-left corner is the origin.+mousePosition :: Monad m => VarT m ShineInput (Int,Int)+mousePosition = accumulate f (0,0)+  where+    f _ (Input (MouseMove coords)) = coords+    f s _ = s+++-- | Whether a key is pressed.+isDownKey :: Monad m => Key -> VarT m ShineInput Bool+isDownKey k = accumulate f False+  where+    f _ (Input (Keyboard k' Down _)) | k == k' = True+    f _ (Input (Keyboard k' Up _)) | k == k' = False+    f s _ = s++-- | A list of keys that are currently being pressed.+keysDown :: Monad m => VarT m ShineInput [Key]+keysDown = accumulate f []+  where+    f ks (Input (Keyboard k Down _)) = if k `elem` ks then ks else k:ks+    f ks (Input (Keyboard k Up _)) = delete k ks+    f ks _ = ks
+ tests/misc.hs view
@@ -0,0 +1,76 @@+import Prelude hiding ((.))+import Control.Category ((.))+import Graphics.Shine+import Graphics.Shine.FRP.Varying hiding (time)+import Graphics.Shine.Input+import Graphics.Shine.Picture+import Control.Varying.Core+import Web.KeyCode+import GHCJS.DOM (webViewGetDomDocument, runWebGUI)++main :: IO ()+main = runWebGUI $ \ webView -> do+    ctx <- fixedSizeCanvas webView 800 600+    Just doc <- webViewGetDomDocument webView+    playVarying ctx doc 30 pictureVar++pictureVar :: Var ShineInput Picture+pictureVar = expandingRectangle+         <> (Colored (Color 255 0 255 1) <$> Translate 200 200 <$> keys)+         <> (Colored (Color 255 0 0 1) <$> arrowsCircle)+         <> (Colored (Color 255 0 0 1) <$> trail redTransparency 20 arrowsCircle)+         <> (Colored (Color 0 200 100 1) <$> trail lightGreenTransparency 5 mouseCircle)++time :: Var ShineInput Float+time = accumulate+           (\t (btnDown,td) -> if btnDown then 0 else t+td) --reset if clicked+           0+       . ((,) <$> isDownButton BtnLeft <*> timeDeltaNumeric) --(click,time delta)++expandingRectangle :: Var ShineInput Picture+expandingRectangle = fmap (\x -> RectF (x*500) (x*100)) time++vX :: Var ShineInput Float+vX = accumulate addV 0 . ((,) <$> isDownKey ArrowLeft <*> isDownKey ArrowRight)+vY :: Var ShineInput Float+vY = accumulate addV 0 . ((,) <$> isDownKey ArrowUp <*> isDownKey ArrowDown)++addV :: Num a => a -> (Bool, Bool) -> a+addV v (False, True) = v+5+addV v (True, False) = v-5+addV v _ = v++posX :: Var ShineInput Float+posX = accumulate (+) 400 . (vX * timeDeltaNumeric)+posY :: Var ShineInput Float+posY = accumulate (+) 300 . (vY * timeDeltaNumeric)++arrowsCircle :: Var ShineInput Picture+arrowsCircle = arrowsCircle' <$> posX <*> posY+  where arrowsCircle' x y = Translate x y $ CircleF 10++mouseCircle :: Var ShineInput Picture+mouseCircle = translateMouse <*> pure (CircleF 20)++translateMouse :: Var ShineInput (Picture -> Picture)+translateMouse = uncurry Translate <$> (bimap fromIntegral <$> mousePosition)+  where bimap f (a, b) = (f a, f b)++keys :: Var ShineInput Picture+keys = (Text "12px sans" CenterAlign 400 . show) <$> keysDown++redTransparency :: Float -> Color+redTransparency = Color 255 0 0+lightGreenTransparency :: Float -> Color+lightGreenTransparency = Color 0 200 100++--TODO bubbling to prevent it to depend on the number of events+trail :: Monad m => (Float -> Color) -> Int -> VarT m a Picture -> VarT m a Picture+trail transparency l' v = foldMap (\(t,p) -> Colored (transparency t) <$> p)+                        $ zip (map (/l) [l,(l-1)..(l/10)])+                        $ history Empty v+  where l = fromIntegral l'++history :: Monad m => b -> VarT m a b -> [VarT m a b]+history def v = v' : history def v'+  where v' = delay def v
+ tests/resizeNarwhal.hs view
@@ -0,0 +1,19 @@+import Graphics.Shine.FRP.Varying+import Graphics.Shine+import Graphics.Shine.Picture+import Graphics.Shine.Image+import GHCJS.DOM (webViewGetDomDocument, runWebGUI)++resizeImage img (x',y') = Translate (x/2) (y/2) -- Pictures are centered on (0,0), so we need to move it+                        $ Image (Stretched x y) img -- Scale de picture to the given position+  where+    x = fromIntegral x' -- mousePosition is Integral+    y = fromIntegral y'++main :: IO ()+main = runWebGUI $ \ webView -> do+    ctx <- fixedSizeCanvas webView 1024 768+    Just doc <- webViewGetDomDocument webView+    narwhal <- makeImage "https://wiki.haskell.org/wikiupload/8/85/NarleyYeeaaahh.jpg"+    let resizedNarwhal = resizeImage narwhal <$> mousePosition+    playVarying ctx doc 30 resizedNarwhal