Working (but slow) shadow shapes

This commit is contained in:
2021-09-17 23:12:51 +01:00
parent 294e01479a
commit 6ac53c052c
16 changed files with 167 additions and 60 deletions
+1
View File
@@ -3,6 +3,7 @@ layout (triangles) in;
layout (triangle_strip, max_vertices = 3) out;
layout (std140, binding = 0) uniform TheMat { mat4 theMat; } ;
uniform vec3 lightPos;
// this code is duplicated in lineShadow.geom, should not be changed on its own
vec4 projNear (vec4 pos)
{
// note we project to a specific height
+7 -5
View File
@@ -4,7 +4,7 @@ layout (triangle_strip, max_vertices = 4) out;
layout (std140, binding = 0) uniform TheMat { mat4 theMat; } ;
uniform vec3 lightPos;
vec4 shift (vec4 p) { return (vec4 (p.xyz + (100000*(p.xyz-lightPos)), 1));}
// copied from lighting/cap.geom
// copied from lighting/cap.geom, should not be changed on its own
vec4 projNear (vec4 pos)
{
// note we project to a specific height
@@ -21,13 +21,16 @@ vec4 shiftNear (vec4 pos)
else
{ return sp ; }
}
vec4 f (vec4 p) {return (theMat * p);}
void main()
{
vec4 p0 = gl_in[0].gl_Position;
vec3 n0 = gl_in[2].gl_Position.xyz;
vec3 n1 = gl_in[3].gl_Position.xyz;
vec4 p1 = gl_in[1].gl_Position;
vec3 n0a = gl_in[2].gl_Position.xyz;
vec3 n1a = gl_in[3].gl_Position.xyz;
vec3 n0 = cross(p1.xyz - p0.xyz, n0a - p0.xyz) ;
vec3 n1 = cross(p0.xyz - p1.xyz, n1a - p1.xyz) ;
//vec3 n2 = n0 + n1; // assumes the summands are normalized
vec3 lightDir = p0.xyz - lightPos.xyz;
// first test if the edge is part of the silhouette
@@ -35,7 +38,6 @@ void main()
// "different directions" wrt the light direction
if ( dot(n0 , lightDir) * dot(n1 , lightDir) < 0 )
{
vec4 p1 = gl_in[1].gl_Position;
vec4 p2 = shiftNear(p0);
vec4 p3 = shiftNear(p1);
if ( dot(n0 , lightDir) > 0)
-2
View File
@@ -27,7 +27,6 @@ import Dodge.Creature.SpreadGunCrit
import Dodge.Creature.AutoCrit
import Dodge.Creature.ChaseCrit
import Dodge.Creature.ArmourChase
import Dodge.Creature.Silhouette
import Dodge.Data
import Dodge.Default
import Dodge.Item.Weapon
@@ -149,7 +148,6 @@ startCr = defaultCreature
, _crMvDir = pi/2
, _crID = 0
, _crPict = basicCrPict black
, _crSilhouette = basicCrSilhouette
, _crUpdate = stateUpdate yourControl
, _crRad = 10
, _crMass = 10
+34 -13
View File
@@ -22,6 +22,8 @@ import Dodge.Item.Data
import Dodge.Clock
import Picture
import Geometry
import Shape
import ShapePicture
--import Geometry.Vector3D
import Control.Lens
@@ -32,11 +34,10 @@ basicCrPict
:: Color -- ^ Creature color
-> Creature
-> World
-> Picture
basicCrPict col cr w = pictures $
-> SPic
basicCrPict col cr w = SPic (basicCrShape col cr w) $ pictures $
targetingPic ++
[ tr . dm . rotdir $ scalp cr
, tr . dm . rotdir $ upperBody col cr
[ tr . dm . rotdir $ upperBody col cr
, tr . dm . rotmdir $ feet cr
, tr . rotdir $ drawEquipment cr
, creatureDisplayText w cr
@@ -51,6 +52,24 @@ basicCrPict col cr w = pictures $
. setDepth 1
. color (greyN 0.3)
basicCrShape
:: Color -- ^ Creature color
-> Creature
-> World
-> Shape
basicCrShape col cr w = mconcat
[ tr . translateSHz 25 . dm . rotdir $ scalp cr
]
where
dm = damageModSH cr
targetingPic = IM.elems $ IM.mapMaybeWithKey f $ _crInv cr
f invid it = fmap ((\g -> g invid it cr w) . snd) (it ^? itTargeting . _Just)
tr = uncurryV translateSHf (_crPos cr)
rotdir = rotateSH (_crDir cr)
rotmdir = rotate (_crMvDir cr)
. setDepth 1
. color (greyN 0.3)
creatureDisplayText :: World -> Creature -> Picture
creatureDisplayText w cr
= setLayer 4
@@ -109,6 +128,8 @@ damageMod cr pic = piercingMod $ bluntScale pic
piercingMod = case fmap argV piercingDam of
Just a -> rotate (a + cdir) . scale 0.8 1.2 . rotate (negate $ cdir + a)
_ -> id
damageModSH :: Creature -> Shape -> Shape
damageModSH cr = id
feet :: Creature -> Picture
feet cr = case cr ^? crStance . carriage of
@@ -148,14 +169,14 @@ arms cr
sLen = _strideLength $ _crStance cr
f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen
scalp :: Creature -> Picture
scalp :: Creature -> Shape
scalp cr
| twists cr = translate 0 (0.5*crad) . rotate (-1) $ translate (negate 0.25 * crad) 0.25 fhead
| oneH cr = rotate 0.5 $ translate (0.25 * crad) 0 fhead
| otherwise = translate (0.25 * crad) 0 fhead
| twists cr = translateSHf 0 (0.5*crad) . rotateSH (-1) $ translateSHf (negate 0.25 * crad) 0.25 fhead
| oneH cr = rotateSH 0.5 $ translateSHf (0.25 * crad) 0 fhead
| otherwise = translateSHf (0.25 * crad) 0 fhead
where
fhead = setDepth 22 $ circleSolid $ crad * 0.5
fhead = colorSH (greyN 0.9) . prismPoly 5 . polyCirc $ crad * 0.5
crad = _crRad cr
oneH :: Creature -> Bool
@@ -232,10 +253,10 @@ drawEquipment cr = pictures $ map f $ IM.toList (_crInv cr)
circLine :: Float -> Picture
circLine x = line [V2 0 0,V2 x 0]
picAtCrPos :: Picture -> Creature -> World -> Picture
picAtCrPos :: Picture -> Creature -> World -> SPic
--{-# INLINE picAtCrPos #-}
picAtCrPos thePic cr _ = tranRot (_crPos cr) (_crDir cr) thePic
picAtCrPos thePic cr _ = SPic empty $ tranRot (_crPos cr) (_crDir cr) thePic
picAtCrPosNoRot :: Picture -> Creature -> World -> Picture
picAtCrPosNoRot :: Picture -> Creature -> World -> SPic
--{-# INLINE picAtCrPos #-}
picAtCrPosNoRot thePic cr _ = uncurryV translate (_crPos cr) thePic
picAtCrPosNoRot thePic cr _ = SPic empty $ uncurryV translate (_crPos cr) thePic
-21
View File
@@ -1,21 +0,0 @@
module Dodge.Creature.Silhouette
( creatureSilhouettes
, basicCrSilhouette
)
where
import Dodge.Data
import Polyhedra
import Geometry
import qualified Data.IntMap as IM
creatureSilhouettes :: World -> [Point3]
creatureSilhouettes w = concatMap f . IM.elems $ _creatures w
where
f cr = _crSilhouette cr cr
basicCrSilhouette :: Creature -> [Point3]
basicCrSilhouette cr = constructEdgesList . map (map f . polyToTris) $ boxXYZ 12 12 15
where
f = (+ V3 (x-6) (y-6) 0)
V2 x y = _crPos cr
+2 -2
View File
@@ -25,6 +25,7 @@ import Dodge.World.Trigger.Data
import Dodge.Bounds
import Data.Preload
import Picture.Data
import ShapePicture
import Geometry.Data
import Polyhedra.Data
import Sound.Data
@@ -193,8 +194,7 @@ data Creature = Creature
, _crOldDir :: Float
, _crMvDir :: Float
, _crID :: Int
, _crPict :: Creature -> World -> Picture
, _crSilhouette :: Creature -> [Point3]
, _crPict :: Creature -> World -> SPic
, _crUpdate
:: Creature
-> World
+3 -2
View File
@@ -19,6 +19,8 @@ import Dodge.SoundLogic.LoadSound
import Dodge.Picture.Layer
import Geometry
import Picture
import ShapePicture
import Shape
import Control.Lens
import qualified Data.IntMap.Strict as IM
@@ -34,8 +36,7 @@ defaultCreature = Creature
, _crOldDir = 0
, _crMvDir = 0
, _crID = 1
, _crPict = \_ _ -> setLayer 0 $ onLayer CrLayer $ circleSolid 10
, _crSilhouette = const []
, _crPict = \_ _ -> SPic (flatCirc 10) blank
, _crUpdate = \cr _ -> (Endo id , Just cr)
, _crRad = 10
, _crMass = 10
+2
View File
@@ -13,6 +13,8 @@ import Dodge.SoundLogic
import Dodge.SoundLogic.LoadSound
--import Dodge.Creature.Perception
import Geometry.Data
--import Shape.Data
--import Dodge.Render.Shape
--import Picture
--import Dodge.GameRoom
--import Geometry
+2 -2
View File
@@ -9,7 +9,6 @@ import Dodge.Config.Data
import Dodge.Base.Window
import Dodge.Render.Picture
--import Dodge.Creature.ShadowBox
import Dodge.Creature.Silhouette
import Dodge.Render.Shape
import Geometry
import Render
@@ -57,11 +56,12 @@ doDrawing pdata w = do
-- poke wall points and colors
nWalls <- poke224s (shadVBOptr $ _wallTextureShader pdata) wallPointsCol
nSils <- pokePoint3s (shadVBOptr $ _lightingLineShadowShader pdata)
$ creatureSilhouettes w
$ (_shEdges $ worldShape w)
++ _foregroundEdgeVerx w
-- poke foreground geometry for caps
nCaps <- pokePoint3s (shadVBOptr $ _lightingCapShader pdata)
$ concatMap polyToGeoRender (foregroundPics w)
++ map _svPos (_shVertices $ worldShape w)
-- bind wall points, silhouette data, surface geometry
uncurry bindShaderBuffers $ unzip
[ ( _wallTextureShader pdata, nWalls)
+2 -1
View File
@@ -15,6 +15,7 @@ import Sound.Data
import Geometry
import Picture
import Polyhedra.Data
import ShapePicture
import Control.Lens
import Data.Maybe
@@ -88,7 +89,7 @@ soundPic w s = fixedSizePicClampArrow 50 50 thePic p w
f x = 1 - 0.5 * (1 - x)
crDraw :: World -> Creature -> Picture
crDraw w c = _crPict c c w
crDraw w c = _spPicture $ _crPict c c w
ppDraw :: PressPlate -> Picture
ppDraw c = uncurryV translate (_ppPos c) $ rotate (_ppRot c) (_ppPict c)
btDraw :: Button -> Picture
+6 -1
View File
@@ -4,6 +4,11 @@ import Dodge.Data
import Shape
import Geometry
import Color
import ShapePicture
import qualified Data.IntMap as IM
worldShape :: World -> Shape
worldShape _ = colorSh green . translateSh (V3 (-20) 200 50) . flatPoly $ rectNSWE 20 0 0 20
worldShape w = mconcat (map (crShape w) (IM.elems (_creatures w)))
crShape :: World -> Creature -> Shape
crShape w c = _spShape $ _crPict c c w
+18 -1
View File
@@ -1,4 +1,14 @@
module Polyhedra
( translateXY
, rotateXY
, polyToEdges
, constructEdgesList
, boxXYZ
, boxABC
, boxXYZnobase
, polyToGeoRender
, polysToPic
)
where
import Geometry
--import Geometry.Data
@@ -129,7 +139,14 @@ polysToPic :: [Polyhedra] -> Picture
polysToPic = pictures . concatMap polyToPics
polyToEdges :: Polyhedra -> [(Point3,Point3,Point3,Point3)]
polyToEdges = constructEdges . map (map fst) . _pyFaces
polyToEdges = map denormalEdges . constructEdges . map (map fst) . _pyFaces
denormalEdges :: (Point3,Point3,Point3,Point3) -> (Point3,Point3,Point3,Point3)
denormalEdges (a,b,n,m) = (a,b,a - x, b - y)
where
x = crossProd (b - a) n
y = crossProd (a - b) m
polyToGeoRender :: Polyhedra -> [Point3]
polyToGeoRender = concatMap (polyToTris . map fst) . _pyFaces
+56 -10
View File
@@ -5,7 +5,8 @@ module Shape
)
where
import Geometry
--import Geometry.Vector3D
import Geometry.Vector3D
import Geometry.ConvexPoly
import Shape.Data
import Color
@@ -13,6 +14,39 @@ empty :: Shape
{-# INLINE empty #-}
empty = Shape [] []
flatCirc :: Float -> Shape
flatCirc = flatPoly . polyCirc
polyCirc :: Float -> [Point2]
{-# INLINE polyCirc #-}
polyCirc x = map (\a -> rotateV a (V2 x 0)) $ take 8 [0,pi/4..]
prismPoly
:: Float -- ^ height, expected to be strictly positive
-> [Point2]
-> Shape
{-# INLINE prismPoly #-}
prismPoly h ps = Shape
{ _shVertices = topFace ++ bottomFace ++ sideFaces
, _shEdges = topEdges ++ bottomEdges ++ sideEdges
}
where
topFace = polyToTris $ map f' ps
f' (V2 x y) = ShapeV {_svPos = V3 x y h, _svCol = black }
f (V2 x y) = ShapeV {_svPos = V3 x y 0, _svCol = black }
bottomFace = polyToTris $ map f $ reverse ps
sideFaces = map addCol $ concat
$ zipWith (\a b -> polyToTris (extendSide a b)) ps (tail ps ++ [head ps])
addCol x = ShapeV {_svPos = x, _svCol = 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 = 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 = 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 = 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]
flatPoly :: [Point2] -> Shape
flatPoly ps = Shape
{ _shVertices = polyToTris $ map f ps
@@ -23,12 +57,16 @@ flatPoly ps = Shape
g (V2 x y) (V2 a b) =
[ V3 x y 0
, V3 a b 0
, V3 x y (-1)
, V3 a b 1
, V3 x y 0 - n
, V3 a b 0 - n
]
where
n = addZ 0 $ vNormal (V2 (a-x) (b-y))
-- where
--n =
colorSh :: Color -> Shape -> Shape
colorSh col = overCol $ const col
colorSH :: Color -> Shape -> Shape
colorSH col = overCol $ const col
overCol :: (Point4 -> Point4) -> Shape -> Shape
overCol f Shape{_shVertices=vs,_shEdges=es} = Shape
@@ -42,11 +80,20 @@ overPos f Shape{_shVertices=vs,_shEdges=es} = Shape
,_shEdges = map f es
}
translateSh :: Point3 -> Shape -> Shape
translateSh !p = overPos (+p)
translateSH :: Point3 -> Shape -> Shape
translateSH !p = overPos (+p)
scale :: Point3 -> Shape -> Shape
scale !p = overPos (*p)
translateSHf :: Float -> Float -> Shape -> Shape
translateSHf x y = translateSH (V3 x y 0)
translateSHz :: Float -> Shape -> Shape
translateSHz z = translateSH (V3 0 0 z)
rotateSH :: Float -> Shape -> Shape
rotateSH a = overPos (rotate3 a)
scaleSH :: Point3 -> Shape -> Shape
scaleSH !p = overPos (*p)
overColVertex :: (Point4 -> Point4) -> ShapeV -> ShapeV
overColVertex f ShapeV{_svPos=pos,_svCol=col} = ShapeV
@@ -59,4 +106,3 @@ overPosVertex f ShapeV{_svPos=pos,_svCol=col} = ShapeV
{_svPos = f pos
,_svCol = col
}
+6
View File
@@ -4,10 +4,16 @@ module Shape.Data
where
import Geometry.Data
import Control.Lens
--import Data.Monoid
data Shape = Shape
{ _shVertices :: [ShapeV]
, _shEdges :: [Point3]
}
instance Semigroup Shape where
(<>) (Shape sv1 se1) (Shape sv2 se2) = Shape (sv1 ++ sv2) (se1 ++ se2)
instance Monoid Shape where
mempty = Shape [] []
-- edges are given by four consecutive points
data ShapeV = ShapeV
{ _svPos :: Point3
+17
View File
@@ -0,0 +1,17 @@
module ShapePicture
( module ShapePicture
, module ShapePicture.Data
)
where
import Shape
import ShapePicture.Data
import Picture
import Geometry
emptyBlank :: SPic
emptyBlank = SPic empty blank
translateSP :: Float -> Float -> SPic -> SPic
translateSP x y (SPic sh pic) = SPic
(translateSH (V3 x y 0) sh)
(translate x y pic)
+11
View File
@@ -0,0 +1,11 @@
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module ShapePicture.Data
where
import Shape
import Picture
data SPic = SPic
{ _spShape :: Shape
, _spPicture :: Picture
}