reflex-gloss-scene 0.1 → 0.1.2

raw patch · 6 files changed

+231/−85 lines, 6 filesdep ~basedep ~glossdep ~reflexnew-component:exe:counternew-component:exe:examplePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, gloss, reflex, reflex-animation, reflex-transformers, transformers

API changes (from Hackage documentation)

Files

• examples/Animations.hs +0/−68
• examples/Collections.hs +1/−1
• examples/Counter.hs +87/−0
• examples/Example.hs +58/−0
• reflex-gloss-scene.cabal +13/−3
• src/Reflex/Gloss/Scene.hs +72/−13

@@ -1,68 +0,0 @@--- {-# LANGUAGE RecursiveDo #-}--module Main where--import Reflex-import Reflex.Gloss.Scene--- import Reflex.Monad.Time--- import Reflex.Animation----- import Reflex.Monad--import Graphics.Gloss------ import Control.Applicative hiding (optional)--import Widgets--    ---- data Track time = Rotation Float | Position Vector deriving Ord--- --- --- newtype Tracks time = Tracks { unTracks :: [Track time] }----     ---     ---     ---     --- bounce :: PictureAnimation--- bounce = repeat (half (sine 0.5))-  -  -  -additive :: Reflex t => Scene t ()-additive = do-  -  translation (-60, 0) $ do-    (_, bounceClick) <- translation (0, 80) $ toggleButton (pure "Bounce") (pure (80, 30)) never-    (_, wiggleClick) <- translation (0, 30) $ toggleButton (pure "Wiggle") (pure (80, 30)) never-    -    return ()-    -  translation (60, 0) $ -    render $ square <$> pure green-  -  -  where-    -    square c = color c $ rectangleSolid 40 40-- --widget :: Reflex t => Scene t  ()-widget = do-  additive-  -  return ()----main = playSceneGraph display background frequency widget-  where -    display = InWindow "Animations example" (600, 600) (0, 0)-    background = white-    frequency = 30

@@ -77,7 +77,7 @@            rotation 40 $       button (constant "New") (constant (80, 30))   -  degrees <- integrate 0 (constant 4)+  degrees <- current <$> integrate 0 (constant 4)    activeRotation degrees $ do     newItems <- fmap makeCircle <$> foldRand (mkStdGen 0) randomCircle click  

@@ -0,0 +1,87 @@+{-# LANGUAGE RecursiveDo #-}++module Main where++import Reflex+import Reflex.Gloss.Scene+import Reflex.Monad.Time+import Reflex.Animation+++import Reflex.Monad++import Graphics.Gloss++import Widgets+++counter :: (MonadReflex t m) => Event t a -> m (Behavior t Int)+counter e = mdo+  n <- hold 0 next+  +  let next = attachWith (+) n (1 <$ e)  +  -- (1 <$ e) = fmap (const 1) e+  return n++    +counterButton :: Reflex t =>  Scene t ()+counterButton  = do+  click <- translation (0, 30) $ button (pure "Inc") (pure (80, 30)) +  count <- counter click++  translation (0, -30) $ render (showNumber <$> count)+  return ()+  +  where +    showNumber x = scale 0.2 0.2 $ text (show x)+  ++  +  +resetCounter :: (MonadReflex t m) => Event t a -> Event t a -> m (Behavior t Int)+resetCounter e reset = mdo+  n <- hold 0 $ leftmost [ 0 <$ reset, next ] +  +  let next = attachWith (+) n (1 <$ e)  +  -- (1 <$ e) = fmap (const 1) e+  return n++    +resetButton :: Reflex t =>  Scene t ()+resetButton  = do+  click <- translation (0, 30) $ button (pure "Inc") (pure (80, 30)) +  reset <- translation (0, 90) $ button (pure "Reset") (pure (80, 30)) +  +  count <- resetCounter2 click reset++  translation (0, -30) $ render (showNumber <$> count)+  return ()+  +  where +    showNumber x = scale 0.2 0.2 $ text (show x)+  +  + +resetCounter2 :: (MonadReflex t m) => Event t a -> Event t a -> m (Behavior t Int)+resetCounter2 e reset = do+  d <- foldDyn ($) 0 $ mergeWith (.)  +    [ (+1)    <$ e  +    , const 0 <$ reset +    ]+  +  return (current d) + + + ++widget :: Reflex t => Scene t  ()+widget = do +  translation (-100, 0) $  counterButton+  translation (100, 0) $  resetButton+++main = playSceneGraph display background frequency widget+  where +    display = InWindow "Counter" (600, 600) (0, 0)+    background = white+    frequency = 30

@@ -0,0 +1,58 @@+{-# LANGUAGE RecursiveDo #-}++module Main where++import Reflex+import Reflex.Gloss.Scene+import Reflex.Monad.Time+import Reflex.Animation+++import Reflex.Monad++import Graphics.Gloss+++++import Widgets++    ++pictureButton :: Reflex t => Behavior t Picture -> Scene t (Event t (Behavior t Picture))+pictureButton picture = do+  translation (0, -30) $ render picture+  click <- translation (0, 30) $ button (pure "Select") (pure (80, 30)) +  return (picture  <$ click)+  +  +channels :: Reflex t => Scene t (Event t (Behavior t Picture))+channels = do+  +  time <- getTime+  +    +  translation (-100, 0) $ pictureButton (square <$> pure green)+  translation (0, 0) $ pictureButton (square <$> pure green)+  translation (100, 0) $ pictureButton (square <$> pure green)+  +  +  where+    +    square c = color c $ rectangleSolid 40 40++ ++widget :: Reflex t => Scene t  ()+widget = do+  channels+  +  return ()++++main = playSceneGraph display background frequency widget+  where +    display = InWindow "Animations example" (600, 600) (0, 0)+    background = white+    frequency = 30

@@ -1,5 +1,5 @@ name:                reflex-gloss-scene-version:             0.1+version:             0.1.2 synopsis:            A simple scene-graph using reflex and gloss description:         A scenegraph library using gloss and gloss-reflex, with support for picking,                       continuous time animations and monad based switching. An example of a framework @@ -28,10 +28,10 @@   type: git   location: https://github.com/saulzar/reflex-gloss-scene.git -executable animations+executable example   hs-source-dirs:      examples   default-language:    Haskell2010-  main-is:             Animations.hs+  main-is:             Example.hs   build-depends:       base, gloss, reflex, reflex-transformers, reflex-gloss-scene,  reflex-animation, transformers, mtl, linear, lens, containers   default-extensions:  MultiParamTypeClasses ScopedTypeVariables RankNTypes FlexibleContexts TypeFamilies @@ -49,6 +49,16 @@   main-is:             FrpZoo.hs   build-depends:       base, gloss, reflex, reflex-transformers, reflex-animation, reflex-gloss-scene, transformers, mtl, linear, lens, containers   default-extensions:  MultiParamTypeClasses ScopedTypeVariables RankNTypes FlexibleContexts TypeFamilies+++executable counter+  hs-source-dirs:      examples+  default-language:    Haskell2010+  main-is:             Counter.hs+  build-depends:       base, gloss, reflex, reflex-transformers, reflex-animation, reflex-gloss-scene, transformers, mtl, linear, lens, containers+  default-extensions:  MultiParamTypeClasses ScopedTypeVariables RankNTypes FlexibleContexts TypeFamilies++   library

@@ -26,16 +26,36 @@      , targetRect   , targetCircle+  , targetWindow+     , makeTarget   , hovering   , Target-   +  +  , localMouse+  , globalMouse+         , mouseUp   , mouseDown   , clicked   +  , KeyEvents+  , keyEvents+  +  , specialDown+  , specialUp+  +  , keyDown+  , keyUp+     , mouseOver   +  , observe+  , observeChanges+  +  , integrate+  , integrateDyn+     , MouseButton(..)   , SpecialKey (..)   , Input (..)@@ -147,7 +167,7 @@ runSceneGraph :: forall t m. (Reflex t, MonadHold t m, MonadFix m) => Vector -> Scene t () -> Event t Float -> Event t InputEvent -> m (Behavior t Picture) runSceneGraph initialSize scene tick inputs = do   time <- foldDyn (+) 0 tick  -  mousePosition <- hold (1/0, 1/0) $ previewF _EventMotion inputs+  mousePosition <- hold (0, 0) $ previewF _EventMotion inputs   windowSize <- hold initialSize (toVector <$> previewF _EventResize inputs)      let rootNode = SceneNode @@ -248,11 +268,35 @@ targetRect size = makeTarget (intersectRect <$> size)  --- Match a particular kind of mouse or key event+targetWindow :: Reflex t => Scene t (Target t)+targetWindow = makeTarget (pure (const True))++-- | Match a particular kind of mouse or key event nodeEvent :: Reflex t => Input -> SceneNode t -> Event t () nodeEvent input node = match input $ node ^. sceneEvents    +data KeyEvents t = KeyEvents +  { keyNode  :: SceneNode t   +  }  +  +keyEvents :: Reflex t => Scene t (KeyEvents t)+keyEvents = KeyEvents <$> ask+  +-- | Key event queries+keyDown :: Reflex t => KeyEvents t -> Char -> Event t ()+keyDown (KeyEvents node) c = nodeEvent (CharDown c) node++keyUp :: Reflex t => KeyEvents t -> Char -> Event t ()+keyUp (KeyEvents node) c = nodeEvent (CharUp c) node++specialDown :: Reflex t => KeyEvents t -> SpecialKey -> Event t ()+specialDown (KeyEvents node) s = nodeEvent (SpecialDown s) node++specialUp :: Reflex t => KeyEvents t -> SpecialKey -> Event t ()+specialUp (KeyEvents node) s = nodeEvent (SpecialUp s) node++ -- | Mouse down event on a picking target mouseDown :: Reflex t => MouseButton -> Target t -> Event t () mouseDown button target = gate (hovering target) $ nodeEvent (MouseDown button) (targetNode target)@@ -263,13 +307,13 @@   -- | Mouse over event on a picking target, returns events for (entering, leaving)-mouseOver :: (Reflex t, MonadTime t time m) => Target t -> m (Event t (), Event t ())+mouseOver :: (Reflex t) => Target t -> Scene t (Event t (), Event t ()) mouseOver target = do   ov <- observeChanges (hovering target)   return (match True ov, match False ov)  -- | Mouse click event for picking target, returns click event and behavior indicating current clicking-clicked :: (Reflex t, MonadHold t m) => MouseButton -> Target t -> m (Event t (), Behavior t Bool)+clicked :: (Reflex t) => MouseButton -> Target t -> Scene t (Event t (), Behavior t Bool) clicked button target = do   pressing <- hold False $ leftmost      [ False <$ nodeEvent (MouseUp button) (targetNode target)@@ -282,17 +326,32 @@ getTick = asks _sceneTick  +observe :: Reflex t => Behavior t a -> Scene t (Event t a)+observe b = tag b <$> getTick   -instance Reflex t => MonadTime t Time (Scene t) where -  --observe :: MonadTime t m => Behavior t a -> m (Event t a)-  observe b = tag b <$> getTick   -  --integrate :: (VectorSpace v, Scalar v ~ Time, MonadReflex t m) => v -> Behavior t v -> Scene t (Behavior t v)-  integrate x dx  = do-    frame <- attachWith (^*) dx <$> getTick-    current <$> foldDyn (^+^) x frame-    +-- | Observe changes in a 'Behavior a' it's Eq a instance+observeChanges :: (Eq a, Reflex t) => Behavior t a -> Scene t (Event t a)+observeChanges b = do+  initial <- sample b+  d <- holdDyn initial =<< observe b+  return (updated $ nubDyn d)  +++integrate :: (VectorSpace v, Scalar v ~ Time, Reflex t) => v -> Behavior t v -> Scene t (Dynamic t v)+integrate x dx  = do+  frame <- attachWith (^*) dx <$> getTick+  foldDyn (^+^) x frame+  +integrateDyn :: (VectorSpace v, Scalar v ~ Time, Reflex t) => v -> Dynamic t v -> Scene t (Dynamic t v)+integrateDyn x dx  = do+  frame <- attachDynWith (^*) dx <$> getTick+  foldDyn (^+^) x frame+++instance Reflex t => MonadTime t Time (Scene t) where+    --after :: MonadReflex t m => Time -> Scene t (Event t ())   after t = do