reflex-gloss-scene-0.1.2: examples/Counter.hs

{-# 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