ocharles
commented
9 years ago I think I will need a minimal example, because
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Main where
import Control.Concurrent
import Control.Monad
import Data.Function (fix)
import Foreign.C.Types (CInt)
import Linear.Affine
import Linear.V2
import Linear.V4
import Reactive.Banana
import Reactive.Banana.Frameworks
import SDL
data InputEvent
= UpPressed
| DownPressed
deriving Show
main :: IO ()
main = do
SDL.initialize [SDL.InitEverything]
window <- SDL.createWindow "Pong" SDL.defaultWindow
renderer <- SDL.createRenderer window (-1) SDL.defaultRenderer
(frameAddHandler, fireFrame) <- newAddHandler
(eventAddHandler, fireEvent) <- newAddHandler
network <- compile (makeNetwork renderer frameAddHandler eventAddHandler)
actuate network
forkIO . forever $ do
fireFrame ()
threadDelay 1000000 -- 1 fps
fix $ \loop -> do
e <- SDL.pollEvent
case e of
Just e ->
case SDL.eventPayload e of
SDL.KeyboardEvent (SDL.KeyboardEventData _ pressed _ (SDL.Keysym _ keycode _)) ->
case (keycode, pressed) of
(SDL.KeycodeUp, SDL.Pressed) -> fireEvent UpPressed >> loop
(SDL.KeycodeDown, SDL.Pressed) -> fireEvent DownPressed >> loop
(SDL.KeycodeQ, SDL.Pressed) -> pure ()
_ -> loop
_ -> loop
Nothing -> loop
makeNetwork :: forall t. Frameworks t => SDL.Renderer -> AddHandler () -> AddHandler InputEvent -> Moment t ()
makeNetwork renderer frameAddHandler eventAddHandler = do
frames <- fromAddHandler frameAddHandler
events <- fromAddHandler eventAddHandler
let bpaddle :: Behavior t Paddle
bpaddle = accumB initPaddle (f <$> events)
where
f :: InputEvent -> Paddle -> Paddle
f UpPressed = paddleUp
f DownPressed = paddleDown
epaddle = bpaddle <@ frames
reactimate $ renderPaddle renderer <$> epaddle
type Paddle = Rectangle CInt
initPaddle :: Paddle
initPaddle = Rectangle (P (V2 100 100)) (V2 20 20)
paddleDown :: Paddle -> Paddle
paddleDown (Rectangle x y) = Rectangle (x + (P (V2 0 1))) y
paddleUp :: Paddle -> Paddle
paddleUp (Rectangle x y) = Rectangle (x - (P (V2 0 1))) y
renderPaddle :: Renderer -> Paddle -> IO ()
renderPaddle renderer p = do
renderDrawColor renderer $= V4 0 0 255 255
renderFillRect renderer (Just p)
renderPresent rendererDoes not seg fault, for me. I'm using an unreleased version of reactive-banana (the gc-new branch) and the new-api branch of SDL2.
mitchellwrosen
Rydgel
akhra
afwlehmann
hadronized
Crossposting HeinrichApfelmus/reactive-banana#103, I'll update this ticket tomorrow with a more minimal example.