{-# LANGUAGE TypeFamilies #-} module Types where import Linear (V2(..)) import qualified Data.Text as T import Data.Maybe (fromJust) import Control.Monad (forM_) import Control.Concurrent.STM (atomically) import Control.Concurrent.STM.TVar import Control.Concurrent.STM.TMVar import Control.Monad.IO.Class (liftIO) import qualified SDL import qualified SDL.Raw.Thread as SDL (threadID) import qualified SDL.Raw.Types as SDL (ThreadID) import Graphics.GL (glFinish) import Graphics.GPipe as GPipe import Foreign.C.Types (CInt(..)) data MouseEvent = MouseEvent { pos :: V2 Int } data FRPBallCtx = FRPBallCtx { frpContexts :: TVar [SDL.GLContext] , frpWindow :: TMVar SDL.Window , frpThread :: SDL.ThreadID } type ContextParams = (T.Text, SDL.WindowConfig) type Window = SDL.Window type WindowConfig = SDL.WindowConfig instance ContextHandler FRPBallCtx where data ContextHandlerParameters FRPBallCtx = FRPBallCtxConfig T.Text SDL.WindowConfig type ContextWindow FRPBallCtx = SDL.Window type WindowParameters FRPBallCtx = (T.Text, SDL.WindowConfig) contextHandlerCreate (FRPBallCtxConfig ititle iwinconfig) = do tid <- SDL.threadID win <- atomically $ newEmptyTMVar ctx <- newTVarIO [] return $ FRPBallCtx ctx win tid contextHandlerDelete ctx = return () createContext frpctx (Just (bits, config)) = do win <- SDL.createWindow (fst config) (snd config) atomically $ putTMVar (frpWindow frpctx) win ctx <- SDL.glCreateContext win atomically $ modifyTVar (frpContexts frpctx) (ctx :) SDL.showWindow win return win createContext frpctx Nothing = do ctx <- SDL.glCreateContext =<< atomically (readTMVar $ frpWindow frpctx) atomically $ modifyTVar (frpContexts frpctx) (ctx :) atomically (readTMVar $ frpWindow frpctx) contextDoAsync ctx mwin act = liftIO act contextSwap ctx win = SDL.glSwapWindow win contextFrameBufferSize ctx win = do (V2 w h) <- (\(V2 (CInt int1) (CInt int2) ) -> V2 (fromIntegral int1) (fromIntegral int2)) <$> SDL.get (SDL.windowSize win) return (w, h) contextDelete frpctx win = do glFinish ctxs <- readTVarIO $ frpContexts frpctx forM_ ctxs $ \mmContext -> do GPipe.contextDelete frpctx =<< (atomically $ readTMVar $ frpWindow frpctx) SDL.glDeleteContext mmContext type AttrInput = (B4 Float, B3 Float) type RIStream = (Float, AttrInput)