justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Broken commit, just to restore deleted function

Browse Source
This commit is contained in:
justin
2021-09-21 01:28:11 +01:00
parent 7f1a365cac
commit 464b0b16db
6 changed files with 44 additions and 82 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Picture.hs
+1 -14
View File
@@ -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
src/Dodge/Default.hs
+1 -1
View File
@@ -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
src/Dodge/Render.hs
+3 -3
View File
@@ -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
src/Shader/Poke.hs
+26 -20
View File
@@ -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
src/Shape.hs
+10 -41
View File
@@ -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
src/Shape/Data.hs
+3 -3
View File
@@ -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