haskellfrpreactive-banana

Setup custom Events with data in reactive-banana


I have a sample I picked up from the reactive-banana repo. This uses gloss. But when I work with events I have my own events with data. These events are not necessarily UI events. So I was expecting that FRP can help me code with custom events. So, for example, a list could change and the changed data is inside an event and another part of the application uses the changed data. My preliminary Haskell knowledge didn't help me to achieve this using reactive-banana but I did come across something similar.

How can I use my own events likemakeTickEvent and fire them ? Can it hold data ?

{-# LANGUAGE ScopedTypeVariables #-}

module Main where
import Control.Monad (when)
import Data.Maybe (isJust, fromJust)
import Data.List (nub)
import System.Random
import System.IO
import Debug.Trace
import Data.IORef
import Reactive.Banana as R
import Reactive.Banana.Frameworks as R

import Graphics.Gloss
import Graphics.Gloss.Data.Extent
import Graphics.Gloss.Interface.Pure.Game
import Graphics.Gloss.Data.Picture

main :: IO()
main = do
    sources <- makeSources
    network <- compile $ networkDescription sources
    actuate network
    eventLoop sources
    display windowDisplay white drawBoard

windowDisplay :: Display
windowDisplay = InWindow "Window" (200, 200) (10, 10)

makeTickEvent :: MomentIO (R.Event ())
makeTickEvent = do
  (etick, tick) <- newEvent
  
  tid <- liftIO  $ do
    tick ()

  pure etick

drawBoard :: Picture
drawBoard =
  Pictures $ [ translate x y $ rectangleWire 90 90| x<-[0,90..180], y<-[0,90..180] ] 


makeSources =  newAddHandler


type EventSource a = (AddHandler a, a -> IO ())



addHandler :: EventSource a -> AddHandler a
addHandler = fst

eventLoop :: (EventSource ())  -> IO ()
eventLoop (displayvalueevent)  =
  fire displayvalueevent ()

fire :: EventSource a -> a -> IO ()
fire = snd


networkDescription :: (EventSource ()) -> MomentIO ()
networkDescription ( displayvalueevent )= do
  -- Obtain events 
  displayvalue <- fromAddHandler (addHandler displayvalueevent)
  reactimate $ putStrLn . showValue <$> displayvalue
 
showValue value = "Value is " ++ show value

This is from the documentation.

plainChanges :: Behavior a -> MomentIO (Event a)
plainChanges b = do
    (e, handle) <- newEvent
    eb <- changes b
    reactimate' $ (fmap handle) <$> eb
    return e

Does this create a new Event that can be fired ?


Solution

  • I have managed to make this code work for now. An event is fired and a new frame is rendered in the initial Gloss Window. It seems to be possible to fire a custom event. But I am not sure about encapsulating data inside the event.

    makeNewEvent :: MomentIO (Reactive.Banana.Event ())
    makeNewEvent = do
      (enew, new) <- newEvent
      
      tid <- liftIO  $ do
        putStrLn "Fire new Event" 
        new ()
    
      return enew 
    

    The following code answers some questions. If I have more details I can edit later. This is still very basic as I am learning reactive-banana and 'haskell'

    ------------------------------------------------------------------------------}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE BlockArguments #-}
    
    module Main where
    import Data.IORef
    import Data.Bool (bool)
    import Data.IORef (newIORef, readIORef, writeIORef)
    import Graphics.Gloss hiding (pictures)
    import Reactive.Banana
    import Reactive.Banana.Frameworks
    import Graphics.Gloss.Interface.IO.Game( Event(..) )
    import Graphics.Gloss.Interface.IO.Game( MouseButton(..) )
    import Graphics.Gloss.Interface.IO.Game( KeyState( Down ) )
    import Graphics.Gloss.Interface.IO.Game
    import qualified Graphics.Gloss.Interface.IO.Game as Gloss (Event, playIO)
    
    
    main = do
    
       (eventHandler,event)<- makeSources
       picRef ← newIORef blank
      
       network <- compile $ networkDescriptor picRef eventHandler
       actuate network
       let handleEvent e@(EventKey k Down _ _) = case k of
                (SpecialKey KeySpace) -> event e
                _                   -> return ()
           handleEvent e = return ()
    
       Gloss.playIO
        (InWindow "Functional Reactive" (550, 490) (800, 200))
        white
        30
        ()
        (\() -> readIORef picRef)
        (\ ev () -> handleEvent ev)
        (\_ () -> pure ())
    
    reactToKeyPress :: IO ()
    reactToKeyPress = putStrLn "Key Pressed"
    
    drawBoard :: Picture
    drawBoard =
       Pictures $ [ color violet $ translate x y $ rectangleWire 90 90| x<-[0,90..180], y<-[0,90..180] ] 
    
    makeSources =  newAddHandler
    
    type EventSource a = (AddHandler a, a -> IO ())
    
    addHandler :: EventSource a -> AddHandler a
    addHandler = fst
    
    fire :: EventSource a -> a -> IO ()
    fire = snd
    
    networkDescriptor :: IORef Picture -> AddHandler Gloss.Event -> MomentIO ()
    networkDescriptor lastFrame  displayGlossEvent = do
      glossEvent <- fromAddHandler displayGlossEvent
      reactimate $ putStrLn . showValue <$> glossEvent
    
      picture <- liftMoment (handleKeys glossEvent )
      changes picture >>= reactimate' . fmap (fmap (writeIORef lastFrame))
      valueBLater picture >>= liftIO . writeIORef lastFrame
    
    showValue value = "Value is " ++ show value
    
    handleKeys :: Reactive.Banana.Event e  -> Moment (Behavior Picture)
    handleKeys glossEvent = do
    
      let picture = drawBoard
      return $ pure picture