diff --git a/src/Data/Preload/Render.hs b/src/Data/Preload/Render.hs index 0d5f5efc4..7a0739701 100644 --- a/src/Data/Preload/Render.hs +++ b/src/Data/Preload/Render.hs @@ -62,6 +62,9 @@ data RenderData = RenderData , _toDiffuse :: TO , _wallVBO :: VBO , _wallShader :: FullShader + , _cloudVBO :: VBO + , _cloudShader :: Shader + , _cloudEBO :: EBO } makeLenses ''RenderData diff --git a/src/Dodge/Item/Draw/SPic.hs b/src/Dodge/Item/Draw/SPic.hs index 4b57910d0..5476b9ca7 100644 --- a/src/Dodge/Item/Draw/SPic.hs +++ b/src/Dodge/Item/Draw/SPic.hs @@ -241,7 +241,10 @@ baseCaneShape :: Shape baseCaneShape = colorSH red $ upperPrismPoly 3 $ rectXH 15 1.5 baseRifleShape :: Shape -baseRifleShape = colorSH red $ upperPrismPoly 3 $ rectXH 25 2 +--baseRifleShape = colorSH red $ upperPrismPoly 3 $ rectXH 25 2 +--baseRifleShape = colorSH red . rotateSHq (V3 0 1 0) (pi/2) . upperCylinder 25 $ polyCirc 3 2 +--baseRifleShape = colorSH red $ xCylinder 4 2 25 +baseRifleShape = colorSH red $ xCylinder' 3 25 addBullets :: Item -> Shape addBullets itm = fromMaybe mempty $ do @@ -409,13 +412,14 @@ flamerPic it = am = fractionLoadedAmmo2 it launcherPic :: Item -> SPic -launcherPic _ = - ( colorSH cyan $ - prismPoly - (map (+.+.+ V3 20 0 5) $ polyCircx 4 5) - (map (+.+.+ V3 0 0 5) $ polyCircx 4 5) - , mempty - ) +launcherPic _ = noPic . colorSH cyan $ xCylinder' 5 20 +--launcherPic _ = noPic . colorSH cyan $ xCylinder 4 5 20 +-- ( colorSH cyan $ +-- prismPoly +-- (map (+.+.+ V3 20 0 5) $ polyCircx 4 5) +-- (map (+.+.+ V3 0 0 5) $ polyCircx 4 5) +-- , mempty +-- ) baseRodShape :: Shape baseRodShape = colorSH orange $ upperPrismPoly 3 $ rectXH 20 2 diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index e432bda7a..d676de488 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -5,6 +5,7 @@ module Dodge.Render ( --import qualified Data.Vector as V +import Shader.Poke.Cloud import GLHelp import Control.Lens import Control.Monad @@ -95,6 +96,14 @@ doDrawing' win pdata u = do , (pdata ^. wallVBO, trueNWalls) ] bufferPokedVBO (_vboShapes pdata) nShapeVs + (nCloudVs,nCloudIs) <- foldM (pokeCloud (pdata ^. cloudVBO . vboPtr) (pdata ^. cloudEBO . eboPtr)) + (0,0) (w ^. cWorld . lWorld . clouds) + bufferPokedVBO (pdata ^. cloudVBO) nCloudVs + glNamedBufferSubData + (_eboName $ _cloudEBO pdata) + 0 + (fromIntegral $ glushortSize * nCloudIs) + (_eboPtr $ _cloudEBO pdata) glNamedBufferSubData (_eboName $ _shapeEBO pdata) 0 @@ -242,6 +251,13 @@ doDrawing' win pdata u = do 0 ptr renderLayer MidLayer shadV layerCounts +-- glUseProgram (pdata ^. cloudShader . shaderUINT) +-- glBindVertexArray $ pdata ^. cloudShader . shaderVAO . vaoName +-- glDrawElements +-- (pdata ^. cloudShader . shaderPrimitive) +-- (fromIntegral nCloudIs) +-- GL_UNSIGNED_SHORT +-- nullPtr drawShader (_windowShader pdata) nWins -- when (_graphics_cloud_shadows cfig) $ do -- ----render transparency depths diff --git a/src/Preload/Render.hs b/src/Preload/Render.hs index d4a10e4a9..33bee37ba 100644 --- a/src/Preload/Render.hs +++ b/src/Preload/Render.hs @@ -162,17 +162,19 @@ preloadRender = do wallTextureShad <- makeShaderUsingVAO "wall/texture" [vert, geom, frag] EPoints wpColVAO let wallverxstrd = 8 - wallvbo <- setupVBO' wallverxstrd + wallvbo <- setupVBO wallverxstrd wallshader <- makeShader4 "wall/basic" [vert,geom,frag] [4,4] wallverxstrd EPoints wallvbo let floorverxstrd = 8 - floorvbo <- setupVBO' floorverxstrd + floorvbo <- setupVBOStatic floorverxstrd floorshader <- makeShader4 "floor/arrayPos" [vert, frag] [4,4] floorverxstrd ETriangles floorvbo tonormalmap <- initTexture2DArray 3 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR "data/normalMaps/normalArray.png" todiffusemap <- initTexture2DArray 3 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR "data/normalMaps/diffuseArray.png" --- let cloudverxstrd = 16 --- cloudvbo <- setupVBO' cloudverxstrd --- cloudshader <- makeShader4 "floor/arrayPos" [vert, frag] [4,4,4,4] cloudverxstrd ETriangles floorvbo + let cloudverxsizes = [4,4,4,4] + cloudvbo <- setupVBO (sum cloudverxsizes) + (cloudshader, cloudebo) + <- makeShaderEBO "floor/arrayPos" [vert, frag] cloudverxsizes (sum cloudverxsizes) + GL_TRIANGLES floorvbo -- bind fixed vertex data bufferPokedVBO (snd fsShad) 4 framebuf2 <- setupTextureFramebuffer 800 600 @@ -261,6 +263,9 @@ preloadRender = do , _toDiffuse = todiffusemap , _wallVBO = wallvbo , _wallShader = wallshader + , _cloudVBO = cloudvbo + , _cloudShader = cloudshader + , _cloudEBO = cloudebo } --------------------end preloadRender diff --git a/src/Shader/Compile.hs b/src/Shader/Compile.hs index af4d0911f..b99af2119 100644 --- a/src/Shader/Compile.hs +++ b/src/Shader/Compile.hs @@ -1,7 +1,7 @@ module Shader.Compile ( setupVBO, - setupVBO', - makeShaderVAOEBO, + setupVBOStatic, + makeShaderEBO, makeShader, makeShader4, makeByteStringShaderUsingVAO, @@ -47,7 +47,7 @@ makeShader s shaderlist sizes pm = do } , vbo) -makeShaderVAOEBO :: +makeShaderEBO :: -- | First part of the name of the shader String -> -- | shader types @@ -58,14 +58,13 @@ makeShaderVAOEBO :: Int -> GLenum -> VBO -> - IO (Shader, VAO, EBO) -makeShaderVAOEBO s shaderlist sizes strd pm vbo = do + IO (Shader, EBO) +makeShaderEBO s shaderlist sizes strd pm vbo = do prog <- makeSourcedShader s shaderlist vao <- setupVAOvbo sizes strd vbo ebo <- setupEBO vao return - ( Shader prog pm - , vao + ( Shader prog pm vao , ebo ) @@ -102,8 +101,8 @@ setupVBO vertexsize = do GL_STREAM_DRAW return VBO {_vboName = vboname, _vboPtr = thePtr, _vboVertexSize = vertexsize} -setupVBO' :: Int -> IO VBO -setupVBO' vertexsize = do +setupVBOStatic :: Int -> IO VBO +setupVBOStatic vertexsize = do vboname <- mglCreate glCreateBuffers thePtr <- mallocArray (vertexsize * numDrawableElements) -- Allocate space diff --git a/src/Shader/Data.hs b/src/Shader/Data.hs index 5bedd2d37..99b02b446 100644 --- a/src/Shader/Data.hs +++ b/src/Shader/Data.hs @@ -13,6 +13,7 @@ module Shader.Data , vaoName , shaderUINT , shaderPrimitive + , shaderVAO , textureObject @@ -45,6 +46,7 @@ data FullShader = FullShader data Shader = Shader { _shaderUINT :: GLuint -- should be shaderID , _shaderPrimitive :: GLenum + , _shaderVAO :: VAO } {- | Vertex array object: contains the reference to the object, and its buffer targets. -} diff --git a/src/Shader/Poke/Cloud.hs b/src/Shader/Poke/Cloud.hs new file mode 100644 index 000000000..4f780e157 --- /dev/null +++ b/src/Shader/Poke/Cloud.hs @@ -0,0 +1,33 @@ +module Shader.Poke.Cloud ( + pokeCloud, +) where + +import qualified Data.Vector.Unboxed as UV +import Dodge.Data.Cloud +import Foreign +import Geometry +import Graphics.GL.Core45 + +pokeCloud :: Ptr Float -> Ptr GLushort -> (Int, Int) -> Cloud -> IO (Int, Int) +pokeCloud vptr iptr (nv,ni) cl = do + UV.imapM_ (pokeCloudVerx vptr cl nv) $ UV.fromList [(1, 1), (1, -1), (-1, -1), (-1, 1)] + UV.imapM_ (pokeCloudIndex iptr nv ni) $ UV.fromList [0, 1, 2, 2, 1, 3] + return (nv + 4, ni + 6) + +pokeCloudVerx :: Ptr Float -> Cloud -> Int -> Int -> (Float, Float) -> IO () +pokeCloudVerx ptr cl nv i (dx, dy) = + UV.imapM_ (pokeCloudFloat ptr (nv + i)) $ UV.fromList + [x, y, cz, 1, r, g, b, a, cx, cy, cz, rad, dx, dy, 0, 0] + where + V3 cx cy cz = _clPos cl + V2 x y = V2 cx cy - rad *.* V2 dx dy + rad = _clRad cl + V4 r g b a = case _clPict cl of + CloudColor _ _ col -> col + DrawGasCloud col -> col + +pokeCloudFloat :: Ptr Float -> Int -> Int -> Float -> IO () +pokeCloudFloat ptr nv i = pokeElemOff ptr (nv * 16 + i) + +pokeCloudIndex :: Ptr GLushort -> Int -> Int -> Int -> Int -> IO () +pokeCloudIndex ptr nv ni ioff voff = pokeElemOff ptr (ni + ioff) (fromIntegral $ nv + voff) diff --git a/src/Shape.hs b/src/Shape.hs index 2cfd5cc39..ce78ce690 100644 --- a/src/Shape.hs +++ b/src/Shape.hs @@ -11,6 +11,7 @@ module Shape , translateSHxy , rotateSH , rotateSHx + , rotateSHq , polyCircx , scaleSH , colorSH @@ -18,10 +19,13 @@ module Shape , overPosSH , upperCylinder , upperRounded + , xCylinder + , xCylinder' ) where import Geometry import Shape.Data import Color +import qualified Quaternion as Q -- - approximate a circle by a polygon with n*2 points of radius x polyCirc :: Int -> Float -> [Point2] @@ -41,7 +45,6 @@ prismPoly -> [Point3] -> Shape {-# INLINE prismPoly #-} ---prismPoly upps downps = [Surface (TopPrism n) (f upps downps) white FullShadowFidelity] prismPoly upps downps = [Surface (RoundedFaces n) (cp:cp:f upps downps) white FullShadowFidelity] where cp = centroidNum $ upps ++ downps @@ -56,6 +59,17 @@ upperPrismPoly {-# INLINE upperPrismPoly #-} upperPrismPoly h ps = prismPoly (map (addZ h) ps) (map (addZ 0) ps) +xCylinder :: Int -> Float -> Float -> Shape +xCylinder n r x = rotateSHq (V3 0 1 0) (pi/2) . translateSHxy (-r) 0 . upperCylinder x $ polyCirc n r + +xCylinder' :: Float -> Float -> Shape +xCylinder' r x = translateSHz r . rotateSHq (V3 0 1 0) (pi/2) . upperCylinder x $ + [V2 r (r) + ,V2 (-r/2) (r/2) + ,V2 (-r/2) (negate $ r/2) + ,V2 r (-r) + ] + upperBox :: Float -- ^ height, expected to be strictly positive -> [Point2] @@ -68,6 +82,9 @@ upperBox h ps = [Surface (FlatFaces n) (f ps) white FullShadowFidelity] f (x:xs) = g h x : g 0 x : f xs f _ = [] +rotateSHq :: Point3 -> Float -> Shape -> Shape +rotateSHq p = overPosSH . Q.rotate . Q.axisAngle p + upperCylinder :: Float -- ^ height, expected to be strictly positive -> [Point2] @@ -75,7 +92,7 @@ upperCylinder {-# INLINE upperCylinder #-} upperCylinder h ps = [Surface (Cylinder n) (addZ (h-0.5) cc:addZ 0.5 cc:f ps) white FullShadowFidelity] where - cc = centroid ps + cc = V2 0 0 n = length ps g h' (V2 x y) = V3 x y h' f (x:xs) = g h x : g 0 x : f xs