Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
This is the code that
vertex = "#version 110\n attribute vec3 position; void main() { gl_Position = vec4(position, 1.0); }"
fragment = "#version 110\n void main() { gl_FragColor = vec4(1.0, 0.0, 0.0, 1.0); } "
time = Monotonic
tris = [Triangle 0 0 0 (cos x) (sin x) 0 (cos (x^2)) (sin (x^2)) 0 | x <- [0.0,0.08..2*pi]]
nums = zip tris [0..]
len = length tris
main = do
withBasicWindow windowWidth windowHeight "Metropolis" $ \window -> do
buffer <- createVertexBuffer
triangleShader <- compileShaderProgram "triangles" vertex fragment
channel <- newTChanIO
vector <- M.new $ len
setupEventHandlers window channel
let buffers = Buffers vector
gameState = GameState buffer (pi / 2) 0.02 (windowHeight/windowWidth)
shaders = Shaders triangleShader
gameLoop window channel buffers shaders gameState 30
createVertexBuffer = do
alloca $ \bufferPtr -> do
glGenBuffers 1 bufferPtr
bufferId <- peek bufferPtr
return bufferId
gameLoop window channel buffers shaders gameState previousFps = do
startTime <- getTime time
newGameState <- gameFrame window channel buffers shaders gameState
endGame <- windowShouldClose window
endTime <- getTime time
print $ truncate $ fps startTime endTime
if endGame then return () else gameLoop window channel buffers shaders newGameState (previousFps * 0.1 + newFps * 0.9)
fps (TimeSpec a b) (TimeSpec x y) = 1 / frameTime
where frameTime = seconds + nanosecond
seconds = fromIntegral $ x - a
nanosecond = fromIntegral (y - b) / (10^9)
gameFrame window channel buffers shaders gameState' = do
pollEvents
gameState <- processEvents channel gameState'
clearWindow
mapM_ (\(t, i) -> M.write (triangles buffers) i t) nums
let (ptr, size) = M.unsafeToForeignPtr0 (triangles buffers)
activateShaderProgram (triangleShader shaders)
bufferData (buffer gameState') ptr (size * sizeOf (undefined :: Triangle))
describeBufferedData (triangleShader shaders) [("position", 3, gl_FLOAT, 0, 0)]
drawArrays (3 * len) -- This is line is incredibly slow (3 frames per second)
-- Without it, this runs at thousands of frames per second
swapBuffers window
return gameState
describeBufferedData (Shader programId) attributes = mapM_ describeAttribute attributes
where describeAttribute (name, size, openGLType, stride, offset) = do
withCString name $ \namePtr -> do
location <- glGetAttribLocation programId namePtr
glEnableVertexAttribArray $ fromIntegral location
glVertexAttribPointer (fromIntegral location) (fromIntegral size) openGLType (fromIntegral gl_FALSE) (fromIntegral stride) (plusPtr nullPtr offset)
bufferData buffer dataPtr size = do
withForeignPtr dataPtr $ \ptr -> do
glBindBuffer gl_ARRAY_BUFFER buffer
glBufferData gl_ARRAY_BUFFER (fromIntegral size) ptr gl_STREAM_DRAW
drawArrays vertexCount = glDrawArrays gl_TRIANGLES 0 (fromIntegral vertexCount)
processEvents channel gameState = do
event <- nextEvent channel
return $ case event of
Nothing -> gameState
Just event -> applyEvent event gameState
nextEvent channel = atomically $ do
channelIsEmpty <- isEmptyTChan channel
if channelIsEmpty
then return Nothing
else do
event <- readTChan channel
return $ Just event
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.