109 lines
3.5 KiB
Haskell
109 lines
3.5 KiB
Haskell
module Render where
|
|
import Shapes
|
|
import Graphics.Rendering.OpenGL hiding (imageHeight,imageWidth)
|
|
import Foreign
|
|
import Loop
|
|
import Codec.Picture
|
|
import qualified Data.Vector.Storable as V
|
|
|
|
|
|
render :: [Program] -> b -> Shape -> IO ()
|
|
render progs _ (Shape primitiveMode vs) = do
|
|
currentProgram $= Just (progs !! 0)
|
|
let vertices = flattenVertices vs
|
|
numVertices = length vertices
|
|
vertexSize = sizeOf (head vertices)
|
|
|
|
-- setup VBO
|
|
shape <- genObjectName
|
|
bindVertexArrayObject $= Just shape
|
|
|
|
-- setup VBA
|
|
arrayBuffer <- genObjectName
|
|
bindBuffer ArrayBuffer $= Just arrayBuffer
|
|
withArray vertices $ \ptr -> do
|
|
bufferData ArrayBuffer $= (fromIntegral (numVertices * vertexSize), ptr, StaticDraw)
|
|
|
|
let firstIndex = 0
|
|
vPosition = AttribLocation 0
|
|
vColor = AttribLocation 1
|
|
vertexAttribPointer vPosition $=
|
|
( ToFloat
|
|
, VertexArrayDescriptor 3 Float (fromIntegral $ vertexSize * 7)
|
|
(bufferOffset (firstIndex * vertexSize))
|
|
)
|
|
vertexAttribArray vPosition $= Enabled
|
|
|
|
vertexAttribPointer vColor $=
|
|
( ToFloat
|
|
, VertexArrayDescriptor 4 Float (fromIntegral $ vertexSize * 7)
|
|
(bufferOffset ((firstIndex + 3) * vertexSize) )
|
|
)
|
|
vertexAttribArray vColor $= Enabled
|
|
|
|
-- clear [ColorBuffer,DepthBuffer]
|
|
|
|
bindVertexArrayObject $= Just shape
|
|
drawArrays primitiveMode (fromIntegral firstIndex) (fromIntegral $ div numVertices 2)
|
|
|
|
|
|
render (_:prog:_) _ (Fade ps) = do
|
|
currentProgram $= Just prog
|
|
let vertices = flatten2 ps
|
|
numVertices = length vertices
|
|
vertexSize = sizeOf (head vertices)
|
|
|
|
-- -- setup uniform
|
|
-- location <- get $ uniformLocation prog "winSize"
|
|
-- uniform location $= winSizeVec
|
|
|
|
-- setup VBO
|
|
arrayBuffer <- genObjectName
|
|
bindBuffer ArrayBuffer $= Just arrayBuffer
|
|
withArray vertices $ \ptr -> do
|
|
bufferData ArrayBuffer $= (fromIntegral (numVertices * vertexSize), ptr, StreamDraw)
|
|
|
|
-- setup VAO
|
|
shape <- genObjectName
|
|
bindVertexArrayObject $= Just shape
|
|
|
|
let firstIndex = 0
|
|
inPosition = AttribLocation 0
|
|
inColor = AttribLocation 1
|
|
inRad = AttribLocation 2
|
|
vertexAttribPointer inPosition $=
|
|
( ToFloat
|
|
, VertexArrayDescriptor 3 Float (fromIntegral $ vertexSize * 8)
|
|
(bufferOffset (firstIndex * vertexSize))
|
|
)
|
|
vertexAttribArray inPosition $= Enabled
|
|
|
|
vertexAttribPointer inColor $=
|
|
( ToFloat
|
|
, VertexArrayDescriptor 4 Float (fromIntegral $ vertexSize * 8)
|
|
(bufferOffset ((firstIndex + 3) * vertexSize) )
|
|
)
|
|
vertexAttribArray inColor $= Enabled
|
|
|
|
vertexAttribPointer inRad $=
|
|
( ToFloat
|
|
, VertexArrayDescriptor 1 Float (fromIntegral $ vertexSize * 8)
|
|
(bufferOffset ((firstIndex + 7) * vertexSize) )
|
|
)
|
|
vertexAttribArray inRad $= Enabled
|
|
|
|
-- bindVertexArrayObject $= Just shape
|
|
drawArrays Points (fromIntegral firstIndex) (2)
|
|
|
|
|
|
flattenVertices :: [CPoint] -> [GLfloat]
|
|
flattenVertices = map realToFrac . concatMap (\(CPoint (x,y,z) (r,b,g,a)) -> [x,y,z,r,b,g,a])
|
|
|
|
flatten2 :: [((Float,Float,Float),(Float,Float,Float,Float),Float)] -> [GLfloat]
|
|
flatten2 = map realToFrac . concatMap f
|
|
where f ((x,y,z),(r,g,b,a),rad) = [x,y,z,r,g,b,a,rad]
|
|
|
|
bufferOffset :: Integral a => a -> Ptr b
|
|
bufferOffset = plusPtr nullPtr . fromIntegral
|
|
|