it draws!

This commit is contained in:
nek0 2019-08-25 14:22:02 +02:00
parent d7c77f7098
commit a9a15fdec1
3 changed files with 36 additions and 18 deletions

View file

@ -22,8 +22,8 @@ executable frpball
-- other-extensions: -- other-extensions:
build-depends: base ^>=4.12.0.0 build-depends: base ^>=4.12.0.0
, reactive-banana , reactive-banana
, sdl2 , sdl2 ^>=2.5.0.0
, GPipe , GPipe ^>=2.2.4
, linear , linear
, gl , gl
, text , text

View file

@ -39,16 +39,23 @@ main = do
-- context <- SDL.glCreateContext window -- context <- SDL.glCreateContext window
listen@(_, fire) <- newAddHandler listen@(_, fire) <- newAddHandler
network <- compile (networkDescription listen) network <- compile (networkDescription listen)
runContextT FRPBallCtxConfig $ do runContextT (FRPBallCtxConfig "frpball"
SDL.defaultWindow
{ SDL.windowInitialSize = V2 800 600
, SDL.windowResizable = True
, SDL.windowGraphicsContext = SDL.OpenGLContext SDL.defaultOpenGL
{ SDL.glProfile = SDL.Core SDL.Normal 3 3
}
}) $ do
win <- newWindow (WindowFormatColor RGB8) ("frpball", SDL.defaultWindow win <- newWindow (WindowFormatColor RGB8) ("frpball", SDL.defaultWindow
{ SDL.windowInitialSize = V2 800 600 { SDL.windowInitialSize = V2 800 600
, SDL.windowResizable = True , SDL.windowResizable = True
, SDL.windowOpenGL = Just SDL.defaultOpenGL , SDL.windowGraphicsContext = SDL.OpenGLContext SDL.defaultOpenGL
{ SDL.glProfile = SDL.Core SDL.Normal 3 3 { SDL.glProfile = SDL.Core SDL.Normal 3 3
} }
} }
) )
vertexBuffer :: Buffer os (B4 Float, B3 Float) <- newBuffer 3 vertexBuffer :: Buffer os AttrInput <- newBuffer 3
writeBuffer writeBuffer
vertexBuffer vertexBuffer
0 0
@ -57,7 +64,7 @@ main = do
, (V4 1 1 0 1, V3 0 0 1) , (V4 1 1 0 1, V3 0 0 1)
] ]
shader <- compileShader $ do shader <- compileShader $ do
primitiveStream <- toPrimitiveStream id primitiveStream :: PrimitiveStream Triangles (V4 VFloat, V3 VFloat) <- toPrimitiveStream id :: Shader os (PrimitiveArray Triangles AttrInput) (PrimitiveStream Triangles (VertexFormat AttrInput))
fragmentStream <- rasterize fragmentStream <- rasterize
(const (const
( FrontAndBack ( FrontAndBack
@ -73,13 +80,19 @@ main = do
) )
) )
fragmentStream fragmentStream
-- SDL.showWindow window -- SDL.showWindow window
liftIO $ do liftIO $ actuate network
actuate network forever $ do
forever $ do render $ do
clearWindowColor win (V3 0 0 0)
vertexArray <- newVertexArray vertexBuffer
let primitiveArray = toPrimitiveArray TriangleList vertexArray
shader primitiveArray
swapWindowBuffers win
liftIO $ do
evs <- SDL.pollEvents evs <- SDL.pollEvents
fire evs fire evs
threadDelay $ 23 * 10 ^ 6
networkDescription networkDescription
:: (AddHandler [SDL.Event], b) :: (AddHandler [SDL.Event], b)

View file

@ -29,7 +29,7 @@ data MouseEvent = MouseEvent
data FRPBallCtx = FRPBallCtx data FRPBallCtx = FRPBallCtx
{ frpContexts :: TVar [SDL.GLContext] { frpContexts :: TVar [SDL.GLContext]
, frpWindow :: Maybe SDL.Window , frpWindow :: TVar [SDL.Window]
, frpThread :: SDL.ThreadID , frpThread :: SDL.ThreadID
} }
@ -40,13 +40,13 @@ type Window = SDL.Window
type WindowConfig = SDL.WindowConfig type WindowConfig = SDL.WindowConfig
instance ContextHandler FRPBallCtx where instance ContextHandler FRPBallCtx where
data ContextHandlerParameters FRPBallCtx = FRPBallCtxConfig data ContextHandlerParameters FRPBallCtx = FRPBallCtxConfig T.Text SDL.WindowConfig
type ContextWindow FRPBallCtx = SDL.Window type ContextWindow FRPBallCtx = SDL.Window
type WindowParameters FRPBallCtx = (T.Text, SDL.WindowConfig) type WindowParameters FRPBallCtx = (T.Text, SDL.WindowConfig)
contextHandlerCreate bla = do contextHandlerCreate (FRPBallCtxConfig ititle iwinconfig) = do
tid <- SDL.threadID tid <- SDL.threadID
win <- return Nothing win <- newTVarIO [] -- SDL.createWindow ititle iwinconfig
ctx <- newTVarIO [] ctx <- newTVarIO []
return $ FRPBallCtx ctx win tid return $ FRPBallCtx ctx win tid
@ -55,15 +55,16 @@ instance ContextHandler FRPBallCtx where
createContext frpctx (Just (bits, config)) = do createContext frpctx (Just (bits, config)) = do
win <- SDL.createWindow (fst config) (snd config) win <- SDL.createWindow (fst config) (snd config)
ctx <- SDL.glCreateContext (fromJust $ frpWindow frpctx) atomically $ modifyTVar (frpWindow frpctx) (win :)
ctx <- SDL.glCreateContext win
atomically $ modifyTVar (frpContexts frpctx) (ctx :) atomically $ modifyTVar (frpContexts frpctx) (ctx :)
SDL.showWindow win SDL.showWindow win
return win return win
createContext frpctx Nothing = do createContext frpctx Nothing = do
ctx <- SDL.glCreateContext (fromJust $ frpWindow frpctx) ctx <- SDL.glCreateContext =<< (head <$> readTVarIO (frpWindow frpctx))
atomically $ modifyTVar (frpContexts frpctx) (ctx :) atomically $ modifyTVar (frpContexts frpctx) (ctx :)
return $ fromJust $ frpWindow frpctx head <$> readTVarIO (frpWindow frpctx)
contextDoAsync ctx mwin act = contextDoAsync ctx mwin act =
liftIO act liftIO act
@ -81,5 +82,9 @@ instance ContextHandler FRPBallCtx where
glFinish glFinish
ctxs <- readTVarIO $ frpContexts frpctx ctxs <- readTVarIO $ frpContexts frpctx
forM_ ctxs $ \mmContext -> do forM_ ctxs $ \mmContext -> do
GPipe.contextDelete frpctx (fromJust $ frpWindow frpctx) GPipe.contextDelete frpctx =<< (head <$> readTVarIO (frpWindow frpctx))
SDL.glDeleteContext mmContext SDL.glDeleteContext mmContext
type AttrInput = (B4 Float, B3 Float)
type RIStream = (Float, AttrInput)