{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE BangPatterns #-} module Renderer where import SDL (($=)) import qualified Graphics.Rendering.OpenGL as GL import qualified Graphics.GL.Functions as GLRaw (glVertexAttribDivisor) import qualified Graphics.GLUtil as GLU import qualified Data.Map.Strict as M import qualified Data.ByteString as BS import Codec.Picture import Linear import Foreign import Control.Monad (replicateM) import System.Random -- internal imports import Types initSpriteRenderObjects aggModel = do quadVAO <- GL.genObjectName quadVBO <- GL.genObjectName quadInstances <- GL.genObjectName GL.bindBuffer GL.ArrayBuffer $= Just quadInstances withArray aggModel $ \ptr -> GL.bufferData GL.ArrayBuffer $= ( fromIntegral $ length aggModel * sizeOf (undefined :: Float) , ptr , GL.StaticDraw ) GL.bindBuffer GL.ArrayBuffer $= Nothing GL.bindBuffer GL.ArrayBuffer $= Just quadVBO withArray rawVertices $ \ptr -> GL.bufferData GL.ArrayBuffer $= ( fromIntegral $ length rawVertices * sizeOf (undefined :: Float) , ptr , GL.StaticDraw ) GL.bindVertexArrayObject $= Just quadVAO GL.vertexAttribArray (GL.AttribLocation 0) $= GL.Enabled GL.vertexAttribPointer (GL.AttribLocation 0) $= ( GL.ToFloat , GL.VertexArrayDescriptor 4 GL.Float 0 (nullPtr) ) mapM_ (\intId -> do GL.bindBuffer GL.ArrayBuffer $= Just quadInstances GL.vertexAttribArray (GL.AttribLocation (3 + fromIntegral intId)) $= GL.Enabled GL.vertexAttribPointer (GL.AttribLocation (3 + fromIntegral intId)) $= ( GL.ToFloat , GL.VertexArrayDescriptor 4 GL.Float (fromIntegral $ 4 * 4 * (sizeOf (undefined :: GL.GLfloat))) (nullPtr `plusPtr` (intId * 4 * sizeOf (undefined :: GL.GLfloat))) ) GL.bindBuffer GL.ArrayBuffer $= Nothing GLRaw.glVertexAttribDivisor (3 + fromIntegral intId) 1 ) ([ 0 .. 3 ] :: [Int]) -- GL.bindBuffer GL.ArrayBuffer $= Nothing GL.bindVertexArrayObject $= Nothing return (SpriteRenderObjects quadVAO quadVBO) rawVertices :: [Float] rawVertices = [ 0, 1, 0, 1 , 1, 0, 1, 0 , 0, 0, 0, 0 , 0, 1, 0, 1 , 1, 1, 1, 1 , 1, 0, 1, 0 ] initSpriteShaderObjects = do vertexShaderSrc <- BS.readFile "shader/vertex.sl" fragmentShaderSrc <- BS.readFile "shader/fragment.sl" shaderProgram <- GLU.simpleShaderProgramBS vertexShaderSrc fragmentShaderSrc return (SpriteShaderObjects shaderProgram) initSpriteTextureObjects :: [(String, FilePath)] -> IO (M.Map AssetId (GL.TextureObject, V2 Int)) initSpriteTextureObjects lookupList = do M.fromList <$> mapM (\(name, fp) -> do -- texture <- Gl.genObjectName -- GL.bindBuffer GL.ArrayBuffer $= Just texture -- withArray rawVertices $ \ptr -> -- GL.bufferData GL.ArrayBuffer $= -- ( fromIntegral $ length rawVertices * sizeof (0 :: Float) -- , ptr -- , GL.StaticDraw -- ) -- GL.vertexAttribPointer (GL.AttribLocation 1) $= -- ( GL.ToFloat -- , GL.VertexArrayDescriptor 2 GL.Float 0 (plusPtr nullPtr 0) -- ) ts <- loadTex fp return (name, ts) ) lookupList loadTex :: FilePath -> IO (GL.TextureObject, V2 Int) loadTex fp = do t <- either error id <$> GLU.readTexture fp img <- convertRGBA8 <$> either error id <$> readImage fp let size = V2 (imageWidth img) (imageHeight img) return (t, size) loadSprites :: Int -> IO (AssetDetails SpriteRenderObjects SpriteShaderObjects Sprite) loadSprites amount = do let lookups = [ ("lynx", "assets/img/lynx.png") ] -- positions = -- [ (V2 0 0) -- ] textObj <- initSpriteTextureObjects lookups positions <- replicateM amount $ do x <- randomRIO (-1, 1) y <- randomRIO (-1, 1) return (V2 x y) sizes <- mapM (\origSize -> do scale <- randomRIO (0.1, (2 :: Float)) return (fmap (scale *) $ (fmap fromIntegral origSize) / (V2 980 540)) ) (replicate amount (snd $ snd $ head $ M.assocs textObj)) let aggModel :: [Float] !aggModel = foldl (\acc (pos@(V2 px py), size@(V2 sx sy)) -> let qMatrix = [ sx, 0, 0, 0 , 0, sy, 0, 0 , 0, 0, 1, 0 , fromIntegral px, fromIntegral py, 0, 1 ] in (acc ++ qMatrix) ) [] (zip positions sizes) vertObj <- initSpriteRenderObjects aggModel shadObj <- initSpriteShaderObjects return AssetDetails { adVertObj = vertObj , adShadObj = shadObj , adTextObj = M.fromList $ map (\(k, v) -> (k, fst v)) (M.assocs textObj) , adDataObj = M.fromList $ map (\(k, v) -> ( k , map (\pos -> Sprite pos (snd v)) positions ) ) (M.assocs textObj) }