diff --git a/src/Main.hs b/src/Main.hs index cc015fd..c4c8551 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -7,22 +7,18 @@ module Main where -import qualified SDL +import qualified SDL hiding (V2(..)) import qualified SDL.Raw.Video as SDL (glSetAttribute) import qualified SDL.Raw.Enum as SDL -import SDL (($=)) import Control.Concurrent.STM import Graphics.GPipe -import Linear - import Control.Monad import Control.Monad.Trans import Reactive.Banana.Frameworks as RBF -import Reactive.Banana as RB import Data.Maybe (fromMaybe) @@ -72,13 +68,15 @@ main = do shader <- compileShader $ do primitiveStream :: PrimitiveStream Triangles (V4 VFloat, V3 VFloat) <- toPrimitiveStream id :: Shader os (PrimitiveArray Triangles AttrInput) (PrimitiveStream Triangles (VertexFormat AttrInput)) uniform <- getUniform (const (uniformBuffer,0)) - let primitiveStream2 = fmap (\(pos, clr) -> (pos - V4 1 1 0 0, clr / 10)) primitiveStream + let primitiveStream2 = fmap + (\(position, color) -> (position - V4 1 1 0 0, color / 10)) + primitiveStream primitiveStream3 = primitiveStream `mappend` primitiveStream2 rotationMatrix a = V4 (V4 (cos a) (-sin a) 0 0) (V4 (sin a) (cos a) 0 0) (V4 0 0 1 0) (V4 0 0 0 1) - first fun (pos, col) = (fun pos, col) + first fun (position, color) = (fun position, color) primitiveStream4 = fmap (first (rotationMatrix (uniform) !*)) primitiveStream3 fragmentStream <- rasterize (const @@ -115,25 +113,27 @@ main = do evs <- SDL.pollEvents fire evs --- networkDescription --- :: (ContextHandler ctx ~ ContextHandler FRPBallCtx) --- => (AddHandler [SDL.Event], x) --- -> TMVar (Buffer os (Uniform (B Float))) --- -> MomentIO () -networkDescription (listenerah, listenerfire) univar = mdo +networkDescription + :: (AddHandler [SDL.Event], b) + -> TMVar Float + -> MomentIO () +networkDescription (listenerah, _) univar = mdo (mouseah, mousefire) <- liftIO $ newAddHandler blistener <- fromChanges [] =<< registerListenerEvent listenerah mousefire - eventChanged <- changes blistener + _ <- changes blistener emouse <- fromAddHandler =<< registerMouseEvent univar mouseah let reaction = fmap (\x -> do - let input = (\(V2 x _) -> fromIntegral x :: Float) $ SDL.mouseMotionEventRelMotion $ (\(SDL.MouseMotionEvent dat) -> dat) $ SDL.eventPayload $ head x - void $ atomically $ swapTMVar univar input - print x) emouse - let -- eventChangedReaction :: RB.Event (Future (IO ())) - eventChangedReaction = fmap - (\(x :: Future [SDL.Event]) -> - fmap (\y -> if null y then return () else print y) x) - eventChanged + let input = (\(V2 xx _) -> + fromIntegral xx / 100 :: Float) $ SDL.mouseMotionEventRelMotion $ + (\(SDL.MouseMotionEvent dat) -> dat) $ SDL.eventPayload $ head x + past <- fromMaybe 0 <$> (atomically $ tryReadTMVar univar) + void $ atomically $ swapTMVar univar (past + input) + print input) emouse + -- let eventChangedReaction :: RB.Event (Future (IO ())) + -- eventChangedReaction = fmap + -- (\(x :: Future [SDL.Event]) -> + -- fmap (\y -> if null y then return () else print y) x) + -- eventChanged -- liftIO $ mousefire "Hello!" reactimate reaction -- reactimate' eventChanged @@ -153,15 +153,11 @@ registerListenerEvent listenerah mousefire = do if null fevs then return () else mousefire fevs return listenerah --- registerMouseEvent --- :: (MonadIO m, ContextHandler ctx ~ ContextHandler FRPBallCtx) --- => Buffer os (Uniform (B Float)) --- -> AddHandler [SDL.Event] --- -> m (AddHandler [SDL.Event]) +registerMouseEvent + :: MonadIO m + => TMVar Float + -> AddHandler [SDL.Event] + -> m (AddHandler [SDL.Event]) registerMouseEvent univar mouseah = do - _ <- liftIO $ register mouseah ((\evs -> do - let input = (\(V2 x y) -> fromIntegral x :: Float) $ SDL.mouseMotionEventRelMotion $ (\(SDL.MouseMotionEvent dat) -> dat) $ SDL.eventPayload $ head evs - void $ atomically $ swapTMVar univar input - ) :: [SDL.Event] -> IO () - ) + _ <- liftIO $ register mouseah $ \_ -> return () return mouseah