Setup custom Events with data in reactive-banana-CodePudding

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 ?

CodePudding user response：

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

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

   picRef ← newIORef blank
   (eventHandler, event) ← newAddHandler

   sources <- makeSources
   network <- compile $ networkDescriptor picRef sources
   actuate network
   eventLoop sources

   Gloss.playIO
    (InWindow "Functional Reactive" (320, 240) (800, 200))
    white
    30
    ()
    (\() -> readIORef picRef)
    (\ ev   _ → quit ev >> () <$ event ev)
    (\_ () -> pure ())
  where
    quit (EventKey (Char 's' )
                          _ _ _) = reactToKeyPress
    quit  _ = return ()

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

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

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



networkDescriptor :: IORef Picture -> EventSource() -> MomentIO ()
networkDescriptor lastFrame  displayGlossEvent = do
  glossEvent <- fromAddHandler (addHandler displayGlossEvent )
  reactimate $ putStrLn . showValue <$> glossEvent

  picture <- liftMoment (handleKeys displayGlossEvent )
  changes picture >>= reactimate' . fmap (fmap (writeIORef lastFrame))
  valueBLater picture >>= liftIO . writeIORef lastFrame




showValue value = "Value is "    show value

handleKeys :: EventSource ()  -> Moment (Behavior Picture)
handleKeys glossEvent = do


  let picture = drawBoard
  return $ pure picture