From 464b0b16db79e0df862451436cd9fdfdc2606f61 Mon Sep 17 00:00:00 2001 From: justin Date: Tue, 21 Sep 2021 01:28:11 +0100 Subject: [PATCH] Broken commit, just to restore deleted function --- src/Dodge/Creature/Picture.hs | 15 +---------- src/Dodge/Default.hs | 2 +- src/Dodge/Render.hs | 6 ++--- src/Shader/Poke.hs | 46 +++++++++++++++++-------------- src/Shape.hs | 51 +++++++---------------------------- src/Shape/Data.hs | 6 ++--- 6 files changed, 44 insertions(+), 82 deletions(-) diff --git a/src/Dodge/Creature/Picture.hs b/src/Dodge/Creature/Picture.hs index 6360f7639..703f8b757 100644 --- a/src/Dodge/Creature/Picture.hs +++ b/src/Dodge/Creature/Picture.hs @@ -174,22 +174,9 @@ scalp cr | oneH cr = rotateSH 0.5 $ translateSHf (0.25 * crad) 0 fhead | otherwise = translateSHf (0.25 * crad) 0 fhead where - --fhead = colorSH (greyN 0.9) . upperPrismPoly 5 . polyCirc 3 $ crad * 0.5 - fhead = ([ShapeObj TopHexahedron $ map (flip ShapeV (greyN 0.9)) aBox] , mempty) + fhead = colorSH (greyN 0.9) . upperPrismPoly 5 . polyCirc 3 $ crad * 0.5 crad = _crRad cr -aBox :: [Point3] -aBox = - [ V3 0 0 5 - , V3 5 0 5 - , V3 5 5 5 - , V3 0 5 5 - , V3 0 0 0 - , V3 5 0 0 - , V3 5 5 0 - , V3 0 5 0 - ] - oneH :: Creature -> Bool oneH cr = crIsAiming' cr && crIt ^? itAimStance == Just OneHand where diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 4b6f5f32e..c7e9ec6bf 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -36,7 +36,7 @@ defaultCreature = Creature , _crOldDir = 0 , _crMvDir = 0 , _crID = 1 - , _crPict = \_ _ -> (,) (flatCirc 10) blank + , _crPict = \_ _ -> (,) (mempty) blank , _crUpdate = \cr _ -> (Endo id , Just cr) , _crRad = 10 , _crMass = 10 diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index 5ada0586b..b069efea8 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -81,7 +81,7 @@ doDrawing pdata w = do ElementArrayBuffer WriteToBuffer 0 - (fromIntegral $ glushortSize * nIndices) + (fromIntegral $ glushortSize * nSilIndices) (_eboPtr $ _silhouetteEBO pdata) -- set the coordinate uniform ready for drawing elements using world coordinates bufferUBO $ perspectiveMatrixb rot camzoom trans wins viewFroms @@ -120,7 +120,7 @@ doDrawing pdata w = do drawShader (_textureArrayShader pdata) nTextArrayVs --draw lightmap for base buffer bindFramebuffer Framebuffer $= fst (_fboLighting pdata) - createLightMap pdata lightPoints nWalls nSils numShapeVs (snd $ snd $ _fboBase pdata) + createLightMap pdata lightPoints nWalls nSilIndices numShapeVs (snd $ snd $ _fboBase pdata) --createLightMap pdata lightPoints nWalls 0 0 (snd $ snd $ _fboBase pdata) colorMask $= Color4 Enabled Enabled Enabled Enabled clearColor $= Color4 0 0 0 0 @@ -175,7 +175,7 @@ doDrawing pdata w = do depthMask $= Disabled blend $= Enabled bindFramebuffer Framebuffer $= fst (_fboLighting pdata) - createLightMap pdata lightPoints nWalls nSils numShapeVs (snd $ snd $ _fboCloud pdata) + createLightMap pdata lightPoints nWalls nSilIndices numShapeVs (snd $ snd $ _fboCloud pdata) colorMask $= Color4 Enabled Enabled Enabled Enabled clearColor $= Color4 0 0 0 0 --apply lightmap to cloud buffer diff --git a/src/Shader/Poke.hs b/src/Shader/Poke.hs index fa17b7187..017c50ee0 100644 --- a/src/Shader/Poke.hs +++ b/src/Shader/Poke.hs @@ -58,13 +58,27 @@ pokeShapeObjs :: Ptr Float -> Ptr GLushort -> Ptr GLushort -> (Int,Int,Int,Int) -> [ShapeObj] -> IO (Int, Int,Int,Int) -pokeShapeObjs ptr iptr ieptr count = VS.foldlM' (pokeShapeObj ptr iptr) count . VS.fromList +pokeShapeObjs ptr iptr _ count = VS.foldlM' (pokeShapeObj ptr iptr) count . VS.fromList pokeShapeObj :: Ptr Float -> Ptr GLushort -> (Int,Int,Int,Int) -> ShapeObj -> IO (Int,Int,Int,Int) pokeShapeObj ptr iptr counts (ShapeObj shType shVerts) = case shType of ListV -> pokeShapeVs ptr iptr counts shVerts - TopHexahedron -> pokeTopHexahedron ptr iptr counts shVerts + TopPrism size -> pokeTopPrism size ptr iptr counts shVerts +pokeTopPrism :: Int -> Ptr Float -> Ptr GLushort -> (Int,Int,Int,Int) -> [ShapeV] -> IO (Int,Int,Int,Int) +pokeTopPrism size ptr iptr count svs = do + count' <- pokeTopPrismIndices size iptr count + VS.foldlM' (pokeJustV ptr) count' (VS.fromList svs) + +pokeTopPrismIndices :: Int -> Ptr GLushort -> (Int,Int,Int,Int) -> IO (Int,Int,Int,Int) +pokeTopPrismIndices size iptr (nv,ne,ni,nei) = do + ni' <- foldM (pokeTopPrismIndex nv iptr) ni (topPrismIndices size) + return (nv,ne,ni',nei) + +pokeTopPrismIndex :: Int -> Ptr GLushort -> Int -> Int -> IO Int +pokeTopPrismIndex nv iptr ni ioff = do + pokeElemOff iptr ni (fromIntegral $ nv + ioff) + return (ni + 1) pokeShapeVs :: Ptr Float -> Ptr GLushort -> (Int,Int,Int,Int) -> [ShapeV] -> IO (Int, Int,Int,Int) pokeShapeVs ptr iptr count = VS.foldlM' (pokeShapeV ptr iptr) count . VS.fromList @@ -78,26 +92,18 @@ pokeShapeE eptr ieptr (nv,n,ni,nei) (V3 a b c) = do pokeElemOff eptr (n * 3) a pokeElemOff eptr (n * 3 + 1) b pokeElemOff eptr (n * 3 + 2) c - pokeElemOff ieptr nei (fromIntegral nei) + pokeElemOff ieptr nei (fromIntegral n) return $ (nv,n + 1,ni,nei+1) -pokeTopHexahedron :: Ptr Float -> Ptr GLushort -> (Int,Int,Int,Int) -> [ShapeV] -> IO (Int,Int,Int,Int) -pokeTopHexahedron ptr iptr count svs = do - count' <- pokeHexahedronIndices iptr count - VS.foldlM' (pokeJustV ptr) count' (VS.fromList svs) - -pokeHexahedronIndices :: Ptr GLushort -> (Int,Int,Int,Int) -> IO (Int,Int,Int,Int) -pokeHexahedronIndices iptr (nv,ne,ni,nei) = do - ni' <- foldM (pokeHexhedronIndex nv iptr) ni hexIndices - return (nv,ne,ni',nei) - -pokeHexhedronIndex :: Int -> Ptr GLushort -> Int -> Int -> IO Int -pokeHexhedronIndex nv iptr ni ioff = do - pokeElemOff iptr ni (fromIntegral $ nv + ioff) - return (ni + 1) - -hexIndices :: [Int] -hexIndices = [0,1,2,0,2,3,0,4,5,0,5,1,1,5,6,1,6,2,2,6,7,2,7,8,3,7,4,3,4,0] +topPrismIndices :: Int -> [Int] +topPrismIndices n = concatMap f [1..n-2] -- triangles on top face + ++ [2*n-2,2*n-1,1 + ,2*n-2,1,0] -- last side triangle (applies mod 2n) + ++ concatMap g [0..n-2] -- other triangles on sides + where + f x = [0,2*x,2*x+2] + g x = [2*x,2*x+1,2*x+3 + ,2*x,2*x+3,2*x+2] pokeJustV :: Ptr Float -> (Int,Int,Int,Int) -> ShapeV -> IO (Int,Int,Int,Int) pokeJustV ptr (nv,ne,ni,nei) sh = do diff --git a/src/Shape.hs b/src/Shape.hs index 965531c22..6e456fb12 100644 --- a/src/Shape.hs +++ b/src/Shape.hs @@ -3,10 +3,7 @@ module Shape ( module Shape.Data , translateSH , emptySH - , polyCirc , upperPrismPoly - , prismPoly - , flatCirc , translateSHz , translateSHf , rotateSH @@ -26,13 +23,9 @@ emptySH :: Shape {-# INLINE emptySH #-} emptySH = mempty -flatCirc :: Float -> Shape -{-# INLINE flatCirc #-} -flatCirc = flatPoly . polyCirc 3 - polyCirc :: Int -> Float -> [Point2] -{-# INLINE polyCirc #-} -polyCirc n x = map (\a -> rotateV a (V2 x 0)) $ take (n*2) [0,pi/(fromIntegral n)..] +{-# INLINE polycirc #-} +polyCirc n r = map (\i -> rotateV ) [0..n] upperPrismPoly :: Float -- ^ height, expected to be strictly positive @@ -40,42 +33,18 @@ upperPrismPoly -> Shape {-# INLINE upperPrismPoly #-} upperPrismPoly h ps = - ( [ShapeObj ListV (topFace <> sideFaces)] + ( [ShapeObj (TopPrism n) (f upps downps)] , topEdges <> bottomEdges <> sideEdges ) where - topFace = shVfromList $ polyToTris $ map f' ps + n = length ps + upps = map f' ps + downps = map f'' ps + f (a:as) (b:bs) = a:b:f as bs + f [] _ = [] + f _ [] = [] f' (V2 x y) = pairToSV (V3 x y h, black) - sideFaces = shVfromList $ map addCol $ concat - $ zipWith (\a b -> polyToTris (extendSide a b)) ps (tail ps ++ [head ps]) - addCol x = pairToSV ( x, black) - extendSide (V2 x y) (V2 x' y') = [V3 x y 0, V3 x' y' 0, V3 x' y' h, V3 x y h] - topEdges = shEfromList $ concat $ zipWith makeTopEdge ps (tail ps ++ [head ps]) - makeTopEdge (V2 x y) (V2 x' y') = [V3 x y h,V3 x' y' h,V3 x y 0,V3 xcen ycen h] - V2 xcen ycen = centroid ps - bottomEdges = shEfromList $ concat $ zipWith makeBottomEdge ps (tail ps ++ [head ps]) - makeBottomEdge (V2 x' y') (V2 x y) = [V3 x y 0,V3 x' y' 0,V3 x y h,V3 xcen ycen 0] - sideEdges = shEfromList $ concat $ zipWith3 makeSideEdge ps (tail ps ++ [head ps]) (drop 2 ps ++ take 2 ps) - makeSideEdge (V2 xl yl) (V2 x y) (V2 xr yr) = [V3 x y 0, V3 x y h, V3 xr yr 0, V3 xl yl h] - -prismPoly - :: Float -- ^ height, expected to be strictly positive - -> [Point2] - -> Shape -{-# INLINE prismPoly #-} -prismPoly h ps = - ( [ShapeObj ListV (topFace <> bottomFace <> sideFaces)] - , topEdges <> bottomEdges <> sideEdges - ) - where - topFace = shVfromList $ polyToTris $ map f' ps - f' (V2 x y) = pairToSV ( V3 x y h, black ) - f (V2 x y) = pairToSV ( V3 x y 0, black ) - bottomFace = shVfromList $ polyToTris $ map f $ reverse ps - sideFaces = shVfromList $ map addCol $ concat - $ zipWith (\a b -> polyToTris (extendSide a b)) ps (tail ps ++ [head ps]) - addCol x = pairToSV ( x, black) - extendSide (V2 x y) (V2 x' y') = [V3 x y 0, V3 x' y' 0, V3 x' y' h, V3 x y h] + f'' (V2 x y) = pairToSV (V3 x y 0, black) topEdges = shEfromList $ concat $ zipWith makeTopEdge ps (tail ps ++ [head ps]) makeTopEdge (V2 x y) (V2 x' y') = [V3 x y h,V3 x' y' h,V3 x y 0,V3 xcen ycen h] V2 xcen ycen = centroid ps diff --git a/src/Shape/Data.hs b/src/Shape/Data.hs index bd2cd5ccd..64de280c4 100644 --- a/src/Shape/Data.hs +++ b/src/Shape/Data.hs @@ -39,9 +39,9 @@ data ShapeObj = ShapeObj } data ShapeType - = ListV - | TopHexahedron -- ^ assumed convex, eight vertices - | TopPrism Int + = TopPrism Int + | ListV +-- | TopHexahedron -- ^ assumed convex, eight vertices -- edges are given by four consecutive points data ShapeV = ShapeV