Performance tweaks

2021-09-18 15:38:46 +01:00
parent 2d8f1089a1
commit 80aa67015c
10 changed files with 194 additions and 160 deletions
@@ -8,11 +8,11 @@ module Dodge.Creature.Picture
    , picAtCrPosNoRot
    ) where
 import Dodge.Data
-import Dodge.Data.DamageType
+--import Dodge.Data.DamageType
 --import Dodge.Base
 --import Dodge.Creature.Stance.Data
 import Dodge.Creature.Perception.Data
-import Dodge.Creature.State.Data
+--import Dodge.Creature.State.Data
 import Dodge.Creature.Stance.Data
 --import Dodge.Creature.Memory.Data
 import Dodge.Creature.Test
@@ -27,7 +27,6 @@ import ShapePicture
 --import Geometry.Vector3D

 import Control.Lens
-import Data.List
 import qualified Data.IntMap.Strict as IM
 import qualified Data.Vector as V
 basicCrPict 
@@ -35,36 +34,29 @@ basicCrPict
    -> Creature 
    -> World
    -> SPic
-basicCrPict col cr w = SPic (basicCrShape col cr w) $ pictures $
+basicCrPict col cr w = SPic (basicCrShape col cr) $ pictures $
    targetingPic ++
    [ creatureDisplayText w cr
    , tr . rotdir $ _spPicture $ drawEquipment cr
    ]
  where 
-    dm = damageMod 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 translate (_crPos cr) 
    rotdir = rotate (_crDir cr)
-    rotmdir = rotate (_crMvDir cr)
-        . setDepth 1 
-        . color (greyN 0.3)

 basicCrShape 
    :: Color    -- ^ Creature color
    -> Creature 
-    -> World
    -> Shape
-basicCrShape col cr w = mconcat
-    [ tr . rotdir $ _spShape $ drawEquipment cr
-    , tr . translateSHz 25 . dm . rotdir $ scalp cr
-    , tr . dm . rotmdir $ feet cr
-    , tr . dm . rotdir $ upperBody col cr
+basicCrShape col cr = tr $ mconcat
+    [ rotdir $ _spShape $ drawEquipment cr
+    , translateSHz 25 . dm . rotdir $ scalp cr
+    , dm . rotmdir $ feet cr
+    , dm . rotdir $ upperBody col 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 = rotateSH (_crMvDir cr)
@@ -110,26 +102,27 @@ crDisplayAwake cr = case _crAwakeLevel (_crPerception cr) of
    Lethargic   -> "L"
    Vigilant    -> "V"
    Overstrung  -> "O"
-damageMod :: Creature -> Picture -> Picture
-damageMod cr pic = piercingMod $ bluntScale pic
-  where
-    cdir = _crDir cr
-    pastDams = _crPastDamage $ _crState cr
-    bluntDam :: Maybe Point2
-    bluntDam = find isBluntDam (concat pastDams) >>= (\dm -> (-.-) <$> dm ^? dmFrom <*> dm ^? dmTo)
-    bluntScale = case fmap argV bluntDam of
-        Just a -> rotate (a + cdir) . scale 0.8 1.2 . rotate (negate $ cdir + a)
-        _   -> id
-    isBluntDam Blunt{} = True
-    isBluntDam _ = False
-    piercingDam = find isPiercingDam (concat pastDams) >>= (\dm -> (-.-) <$> dm ^? dmFrom <*> dm ^? dmTo)
-    isPiercingDam Piercing{} = True
-    isPiercingDam _ = False
-    piercingMod = case fmap argV piercingDam of
-        Just a -> rotate (a + cdir) . scale 0.8 1.2 . rotate (negate $ cdir + a)
-        _   -> id
+
+--damageMod :: Creature -> Picture -> Picture
+--damageMod cr pic = piercingMod $ bluntScale pic
+--  where
+--    cdir = _crDir cr
+--    pastDams = _crPastDamage $ _crState cr
+--    bluntDam :: Maybe Point2
+--    bluntDam = find isBluntDam (concat pastDams) >>= (\dm -> (-.-) <$> dm ^? dmFrom <*> dm ^? dmTo)
+--    bluntScale = case fmap argV bluntDam of
+--        Just a -> rotate (a + cdir) . scale 0.8 1.2 . rotate (negate $ cdir + a)
+--        _   -> id
+--    isBluntDam Blunt{} = True
+--    isBluntDam _ = False
+--    piercingDam = find isPiercingDam (concat pastDams) >>= (\dm -> (-.-) <$> dm ^? dmFrom <*> dm ^? dmTo)
+--    isPiercingDam Piercing{} = True
+--    isPiercingDam _ = False
+--    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
+damageModSH _ = id

 feet :: Creature -> Shape
 feet cr = case cr ^? crStance . carriage of
@@ -147,7 +140,7 @@ feet cr = case cr ^? crStance . carriage of
        ]
  where
    aFoot :: Shape
-    aFoot = prismPoly 10 $ polyCirc 3 4
+    aFoot = upperPrismPoly 10 $ polyCirc 3 4
    off = 5
    sLen = _strideLength $ _crStance cr
    f i = 6 * fromIntegral (sLen - i) / fromIntegral sLen
@@ -165,7 +158,7 @@ arms cr
        _ -> emptySH 
  where
    aHand :: Shape
-    aHand = translateSHz (-4) . prismPoly 4 $ polyCirc 3 4
+    aHand = translateSHz (-4) . upperPrismPoly 4 $ polyCirc 3 4
    crad = _crRad cr
    off = 8
    sLen = _strideLength $ _crStance cr
@@ -176,9 +169,8 @@ scalp cr
    | 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 = colorSH (greyN 0.9) . prismPoly 5 . polyCirc 3 $ crad * 0.5
+    fhead = colorSH (greyN 0.9) . upperPrismPoly 5 . polyCirc 3 $ crad * 0.5
    crad = _crRad cr

 oneH :: Creature -> Bool
@@ -206,9 +198,15 @@ torso cr
        , translateSHf 0 (negate 3) . rotateSH 0.2 $ aShoulder
        ]
  where
-    aShoulder = translateSHz (-10) . scaleSH (V3 0.5 1 1) . prismPoly 10 $ polyCirc 3 crad
+    --aShoulder = translateSHz (-10) . scaleSH (V3 0.5 1 1) . upperPrismPoly 10 $ polyCirc 3 crad
+    aShoulder = scaleSH (V3 crad crad 1) baseShoulder
    crad = _crRad cr

+baseShoulder :: Shape
+baseShoulder = translateSHz (-10) . scaleSH (V3 0.5 1 1) . upperPrismPoly 10 $ polyCirc 3 1
+
+
+
 upperBody :: Color -> Creature -> Shape
 upperBody col cr = colorSH (light4 col) $ mconcat
    [ arms cr
@@ -226,11 +224,6 @@ upperBody col cr = colorSH (light4 col) $ mconcat
 --    pdam = sum $ concatMap (map _dmAmount) pastDams
 --    pastDams = _crPastDamage $ _crState cr

-shoulderH :: Picture -> Picture
-shoulderH = setDepth 20
-waistH :: Picture -> Picture
-waistH = setDepth 10
-
 shoulderSH :: Shape -> Shape
 shoulderSH = translateSHz 20
 waistSH :: Shape -> Shape
@@ -2,10 +2,10 @@ module Dodge.Item.Draw
    where
 import Dodge.Data
 import Dodge.Item.Data
-import Dodge.Picture.Layer
+--import Dodge.Picture.Layer
 import Dodge.Creature.Stance.Data
-import Picture
-import Shape
+--import Picture
+--import Shape
 import ShapePicture

 import qualified Data.IntMap.Strict as IM
@@ -38,6 +38,7 @@ import Control.Monad
 import Graphics.Rendering.OpenGL hiding (color,scale,translate,rotate)
 import qualified SDL
 import qualified Data.Vector.Unboxed.Mutable as UMV
+import qualified Data.Vector.Fusion.Stream.Monadic as VS

 doDrawing :: RenderData -> World -> IO Word32
 doDrawing pdata w = do
@@ -56,12 +57,14 @@ doDrawing pdata w = do
    -- poke wall points and colors
    nWalls <- poke224s (shadVBOptr $ _wallTextureShader pdata) wallPointsCol
    nSils <- pokePoint3s (shadVBOptr $ _lightingLineShadowShader pdata) 
-        $ (_shEdges $ worldShape w)
-        ++ _foregroundEdgeVerx w
+        $  VS.fromList
+        $ (shEList $ worldShape w)
+        ++ (_foregroundEdgeVerx w)
    -- poke foreground geometry for caps
    nCaps <- pokePoint3s (shadVBOptr $ _lightingCapShader pdata)
+        $ VS.fromList
        $ concatMap polyToGeoRender (foregroundPics w)
-            ++ map _svPos (_shVertices $ worldShape w)
+            ++ (fmap _svPos (shVList $ worldShape w))
    -- bind wall points, silhouette data, surface geometry
    uncurry bindShaderBuffers $ unzip
        [ ( _wallTextureShader pdata, nWalls)
@@ -91,7 +94,7 @@ doDrawing pdata w = do
    renderLayer 0 shadV layerCounts

    numShapeVs <- pokeShapeVs (_vboPtr $ _vaoVBO $ _shadVAO $ _shapeShader pdata) 
-        $ _shVertices $ worldShape w
+        $ VS.fromList $ shVList $ worldShape w
    bindShaderBuffers [_shapeShader pdata] [numShapeVs]
    drawShader (_shapeShader pdata) numShapeVs

@@ -3,7 +3,7 @@ module Dodge.Render.Shape
 import Dodge.Data
 import Shape
 import Geometry
-import Color
+--import Color
 import ShapePicture
 import Dodge.Base.Window