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:
build-depends: base ^>=4.12.0.0
, reactive-banana
, sdl2
, GPipe
, sdl2 ^>=2.5.0.0
, GPipe ^>=2.2.4
, linear
, gl
, text

View file

@ -39,16 +39,23 @@ main = do
-- context <- SDL.glCreateContext window
listen@(_, fire) <- newAddHandler
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
{ SDL.windowInitialSize = V2 800 600
, SDL.windowResizable = True
, SDL.windowOpenGL = Just SDL.defaultOpenGL
, SDL.windowGraphicsContext = SDL.OpenGLContext SDL.defaultOpenGL
{ SDL.glProfile = SDL.Core SDL.Normal 3 3
}
}
)
vertexBuffer :: Buffer os (B4 Float, B3 Float) <- newBuffer 3
vertexBuffer :: Buffer os AttrInput <- newBuffer 3
writeBuffer
vertexBuffer
0
@ -57,7 +64,7 @@ main = do
, (V4 1 1 0 1, V3 0 0 1)
]
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
(const
( FrontAndBack
@ -73,13 +80,19 @@ main = do
)
)
fragmentStream
-- SDL.showWindow window
liftIO $ do
actuate network
forever $ do
liftIO $ actuate network
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
fire evs
threadDelay $ 23 * 10 ^ 6
networkDescription
:: (AddHandler [SDL.Event], b)

View file

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