Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Gloss GUI events not responding #264

Open
mohanr opened this issue Aug 27, 2022 · 5 comments
Open

Gloss GUI events not responding #264

mohanr opened this issue Aug 27, 2022 · 5 comments

Comments

@mohanr
Copy link

mohanr commented Aug 27, 2022

I was looking for guidance to use Gloss GUI events and react based on keystrokes. But here it is not clear how one would wait for a Gloss GUI event and react. Can I look at other examples ?
Since this example is using loops I couldn't use it for my Gloss GUI.

{-----------------------------------------------------------------------------
    Event sources
------------------------------------------------------------------------------}
-- Event Sources - allows you to register event handlers
-- Your GUI framework should provide something like this for you
type EventSource a = (AddHandler a, a -> IO ())

Is this example the recommended way ? It is hidden in the documentation.

do
    (addHandler, fire) <- newAddHandler
    register addHandler putStrLn
    fire "Hello!"

The code that compiles is this. It works only the first time when eventLoop fires an event. But KeyBoard events etc. are required to react.

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

   picRef ← newIORef blank
   (eventHandler, event) ← newAddHandler
   -- register eventHandler eventLoop

  
   sources <- makeSources
   network <- compile $ networkDescriptor picRef sources
   actuate network
   eventLoop sources
   let handleEvent e@(EventKey k Down _ _) = case k of
            (SpecialKey KeySpace) -> (event e)  
            _                   -> (event e)
       handleEvent e = (event e)

   Gloss.playIO
    (InWindow "Functional Reactive" (320, 240) (800, 200))
    white
    30
    ()
    (\() -> readIORef picRef)
    (\ ev   _ → quit ev >> () <$ handleEvent ev)
    -- (\ ev () -> handleEvent 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)  = do
  putStrLn "Fired Event"
  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



Update :

Removed unused code.

Primarily I was trying to use this code to trap events and fire reactive-banana events. Maybe that isn't possible.

(eventHandler, event) ← newAddHandler
   -- register eventHandler eventLoop

  
   sources <- makeSources
   network <- compile $ networkDescriptor picRef sources
   actuate network
   eventLoop sources
   let handleEvent e@(EventKey k Down _ _) = case k of
            (SpecialKey KeySpace) -> (event e)  
            _                   -> (event e)
       handleEvent e = (event e)

If I remove the additional eventHandler then using only sources I can trigger reactive-banana events ? Somehow I
couldn't make it compile.

@HeinrichApfelmus
Copy link
Owner

I'm not really familiar with Gloss, so I can't give a good answer. Your code is a bit confusing, e.g. makeNewEvent is defined, but not used. Could you try to distill a minimal example that does not work but should?

It looks like the AddHandler in sources is used by networkDescriptor to create the network, but the arguments Gloss.playIO use the other AddHandler named eventHandler that was created before — the two are talking past each other.

@HeinrichApfelmus HeinrichApfelmus changed the title GUI Bindings Gloss GUI events not responding Sep 1, 2022
@mohanr
Copy link
Author

mohanr commented Sep 2, 2022

This pattern wasn't clear. Hope it is right. This works.
This is just trapping the keys and restricting. Not sure if there can be multiple networkDescriptor functions for each key.
The other way is to restrict the keys inside the networkDescriptor.

   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" (320, 240) (800, 200))
    white
    30
    ()
    (\() -> readIORef picRef)
    (\ ev () -> handleEvent ev)
    (\_ () -> pure ())

@ocharles
Copy link
Collaborator

ocharles commented Sep 5, 2022

@mohanr I'm afraid I'm struggling to understand exactly what your question is, but I'm going to interpret it as "how do I integrate gloss events with reactive-banana". If that's not question, let me know and I'll try again! Here is one suggestion:

main :: IO ()
main = do
  -- Create an AddHandler that notifies us when gloss Events occur
  (eventAddHandler, notifyEvent) <- newAddHandler

  -- Create another AddHandler for when we want rendering to happen
  (renderAddHandler, render) <- newAddHandler

  picRef <- newIORef blank

  actuate =<< compile (game picRef eventAddHandler renderAddHandler)

  Gloss.playIO
    (InWindow "Functional Reactive" (320, 240) (800, 200))
    white
    30
    ()
    (\() -> render >> readIORef picRef)
    (\ev _ -> notifyEvent ev)
    (\_ () -> pure ())

game :: IORef Picture -> AddHandler Gloss.Event -> AddHandler () -> MomentIO ()
game picRef eventAddHandler renderAddHandler = do
  onEvent <- fromAddHandler eventAddHandler
  onSample <- fromAddHandler sampleAddHandler
  
  -- Here we accumulate gloss events into a new world satte
  worldState <- accumB .. ..

  -- Whenever 'onRender' fires
  reactimate $ writeIORef picRef . drawWorld <$> worldState <@ onRender

@ocharles
Copy link
Collaborator

@mohanr Was my response above helpful? Can we close this issue, or are you still stuck?

@mohanr
Copy link
Author

mohanr commented Oct 17, 2022

game picRef eventAddHandler renderAddHandler = do
  onEvent <- fromAddHandler eventAddHandler
  onSample <- fromAddHandler sampleAddHandler
  
  -- Here we accumulate gloss events into a new world state. 'accumB' means that I just draw a new state ?
  worldState <- accumB .. ..

  -- Whenever 'onRender' fires. Could you explain what 'onRender' here means ?
  reactimate $ writeIORef picRef . drawWorld <$> worldState <@ onRender

I have these 'inlined' questions as now I do this. Am I complicating this ? It works though but the new Picture is just very simple.

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

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
None yet
Projects
None yet
Development

No branches or pull requests

3 participants