From 6ac53c052c085d9692d09e276ef0aeed3a790f77 Mon Sep 17 00:00:00 2001 From: justin Date: Fri, 17 Sep 2021 23:12:51 +0100 Subject: [PATCH] Working (but slow) shadow shapes --- shader/lighting/cap.geom | 1 + shader/lighting/lineShadow.geom | 12 +++--- src/Dodge/Creature.hs | 2 - src/Dodge/Creature/Picture.hs | 47 ++++++++++++++++------- src/Dodge/Creature/Silhouette.hs | 21 ---------- src/Dodge/Data.hs | 4 +- src/Dodge/Default.hs | 5 ++- src/Dodge/Initialisation.hs | 2 + src/Dodge/Render.hs | 4 +- src/Dodge/Render/Picture.hs | 3 +- src/Dodge/Render/Shape.hs | 7 +++- src/Polyhedra.hs | 19 ++++++++- src/Shape.hs | 66 +++++++++++++++++++++++++++----- src/Shape/Data.hs | 6 +++ src/ShapePicture.hs | 17 ++++++++ src/ShapePicture/Data.hs | 11 ++++++ 16 files changed, 167 insertions(+), 60 deletions(-) delete mode 100644 src/Dodge/Creature/Silhouette.hs create mode 100644 src/ShapePicture.hs create mode 100644 src/ShapePicture/Data.hs diff --git a/shader/lighting/cap.geom b/shader/lighting/cap.geom index e1aed2f5a..8ad0b4ff7 100644 --- a/shader/lighting/cap.geom +++ b/shader/lighting/cap.geom @@ -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 diff --git a/shader/lighting/lineShadow.geom b/shader/lighting/lineShadow.geom index f10775003..fa7122ac9 100644 --- a/shader/lighting/lineShadow.geom +++ b/shader/lighting/lineShadow.geom @@ -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) diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index 06a4a406d..facc87b97 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -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 diff --git a/src/Dodge/Creature/Picture.hs b/src/Dodge/Creature/Picture.hs index 9256dacf1..8b554ab9a 100644 --- a/src/Dodge/Creature/Picture.hs +++ b/src/Dodge/Creature/Picture.hs @@ -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 diff --git a/src/Dodge/Creature/Silhouette.hs b/src/Dodge/Creature/Silhouette.hs deleted file mode 100644 index d3da45331..000000000 --- a/src/Dodge/Creature/Silhouette.hs +++ /dev/null @@ -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 diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 73d7bdf08..6e7afae65 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -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 diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 5fa4b3920..cfc70600e 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -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 diff --git a/src/Dodge/Initialisation.hs b/src/Dodge/Initialisation.hs index 7a45c0c5b..df6110769 100644 --- a/src/Dodge/Initialisation.hs +++ b/src/Dodge/Initialisation.hs @@ -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 diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index c7fa76084..1c0ae7c57 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -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) diff --git a/src/Dodge/Render/Picture.hs b/src/Dodge/Render/Picture.hs index 3af49944d..1958909f7 100644 --- a/src/Dodge/Render/Picture.hs +++ b/src/Dodge/Render/Picture.hs @@ -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 diff --git a/src/Dodge/Render/Shape.hs b/src/Dodge/Render/Shape.hs index 6fde1ee81..412329aa9 100644 --- a/src/Dodge/Render/Shape.hs +++ b/src/Dodge/Render/Shape.hs @@ -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 diff --git a/src/Polyhedra.hs b/src/Polyhedra.hs index 60c5af4eb..4688682a4 100644 --- a/src/Polyhedra.hs +++ b/src/Polyhedra.hs @@ -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 diff --git a/src/Shape.hs b/src/Shape.hs index 6ec9b77b7..4d9bea8a7 100644 --- a/src/Shape.hs +++ b/src/Shape.hs @@ -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 } - diff --git a/src/Shape/Data.hs b/src/Shape/Data.hs index bd99d0397..394165e8b 100644 --- a/src/Shape/Data.hs +++ b/src/Shape/Data.hs @@ -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 diff --git a/src/ShapePicture.hs b/src/ShapePicture.hs new file mode 100644 index 000000000..7b831a2bd --- /dev/null +++ b/src/ShapePicture.hs @@ -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) diff --git a/src/ShapePicture/Data.hs b/src/ShapePicture/Data.hs new file mode 100644 index 000000000..815d479d4 --- /dev/null +++ b/src/ShapePicture/Data.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TemplateHaskell #-} +module ShapePicture.Data + where +import Shape +import Picture +data SPic = SPic + { _spShape :: Shape + , _spPicture :: Picture + } +