Put config/targeting pictures in sensible places, tweak main loop

src/Dodge/Creature/Picture.hs

@@ -12,49 +12,25 @@ module Dodge.Creature.Picture
     , basicCrCorpse
     ) where
 import Dodge.Data
---import Dodge.Base
---import Dodge.Render.InfoBox
---import Dodge.Render.List
---import Dodge.Creature.AlertLevel.Data
---import Dodge.Picture.Layer
-import Dodge.Clock
 import Dodge.Creature.HandPos (translateToRightHand,translateToLeftHand)
 import Dodge.Creature.Test
 import Dodge.Damage
---import Dodge.Debug.Picture
 import Picture
 import Geometry
 import Shape
 import ShapePicture
 import qualified Quaternion as Q
---import Geometry.Vector3D
 
 import Control.Lens
-import qualified Data.IntMap.Strict as IM
-import qualified Data.Vector as V
-basicCrPict :: Creature 
-    -> Configuration
-    -> World
-    -> SPic
-basicCrPict cr cfig w = 
-    drawCrEquipment cr
-    <>
-    (basicCrShape cr
-    , pictures $
-        targetingPic ++
-        [ creatureDisplayText cfig w cr
-        --, tr . rotdir $ _spPicture $ drawEquipment cr
-        ]
-    )
-  where 
-    targetingPic = IM.elems $ IM.mapMaybe f $ _crInv cr
-    f it = fmap (\g -> g it cr cfig w) (it ^? itTargeting . tgDraw)
+
+basicCrPict :: Creature -> SPic
+basicCrPict cr = drawCrEquipment cr <> (basicCrShape cr , mempty)
 
 drawCrEquipment :: Creature -> SPic
 drawCrEquipment cr = uncurryV translateSPf (_crPos cr) (rotateSP (_crDir cr) $ drawEquipment cr)
 
-shapeAtCrPos :: Shape -> Creature -> Configuration -> World -> SPic
-shapeAtCrPos sh cr _ _ = 
+shapeAtCrPos :: Shape -> Creature -> SPic
+shapeAtCrPos sh cr = 
     ( uncurryV translateSHf (_crPos cr) $ rotateSH (_crDir cr) sh
     , mempty
     )
@@ -77,47 +53,6 @@ basicCrShape cr
     rotdir = rotateSH (_crDir cr)
     rotmdir = rotateSH (_crMvDir cr)
 
-creatureDisplayText :: Configuration -> World -> Creature -> Picture
-creatureDisplayText cfig w cr 
-  | not (debugOn Cr_awareness cfig) = []
-  | otherwise
-    = setLayer DebugLayer 
-    . setDepth 20 
-    . translate x y 
-    . color white 
-    . rotate (0.5 * pi)
---    . rotate (argV v - 0.5 * pi)
-    . scale theScale theScale 
-    . stackText 
-    $ clockCycle 25 (V.fromList 
-        [ \cr' -> [crDisplayVigilance cr']
-        , \cr' -> [crDisplayAwareness cr']
-        ]
-        ) w cr
-  where
-    campos = _cameraViewFrom w
-    theScale = 0.15 / _cameraZoom w
-    cpos = _crPos cr
-    v = cpos -.- campos
-    (V2 x y) = campos +.+ v +.+ _crRad cr *.* normalizeV v
-
-crDisplayAwareness :: Creature -> String
-crDisplayAwareness cr
-    | isSuspicious = "?"
-    | isCognizant  = "!"
-    | otherwise    = "."
-  where
-    imAwarenesses = _cpAwareness (_crPerception cr)
-    isSuspicious = any f imAwarenesses && not (null imAwarenesses)
-    isCognizant  = any g imAwarenesses && not (null imAwarenesses)
-    f (Suspicious _) = True
-    f _ = False
-    g (Cognizant _) = True
-    g _ = False
-
-crDisplayVigilance :: Creature -> String
-crDisplayVigilance = show . _cpVigilance . _crPerception
-
 --damageMod :: Creature -> Picture -> Picture
 --damageMod cr pic = piercingMod $ bluntScale pic
 --  where
@@ -285,13 +220,13 @@ drawEquipment cr = foldMap f (_crInv cr)
 circLine :: Float -> Picture
 circLine x = line [V2 0 0,V2 x 0]
 
-picAtCrPos :: Picture -> Creature -> Configuration -> World -> SPic
+picAtCrPos :: Picture -> Creature -> SPic
 --{-# INLINE picAtCrPos #-}
-picAtCrPos thePic cr _ _ = (,) emptySH $ tranRot (_crPos cr) (_crDir cr) thePic
+picAtCrPos thePic cr = (,) emptySH $ tranRot (_crPos cr) (_crDir cr) thePic
 
-picAtCrPosNoRot :: Picture -> Creature -> Configuration -> World -> SPic
+picAtCrPosNoRot :: Picture -> Creature -> SPic
 --{-# INLINE picAtCrPos #-}
-picAtCrPosNoRot thePic cr _ _ = (,) emptySH $ uncurryV translate (_crPos cr) thePic
+picAtCrPosNoRot thePic cr = (,) emptySH $ uncurryV translate (_crPos cr) thePic
 
 basicCrCorpse :: Creature -> Corpse -> SPic
 basicCrCorpse cr cp = noPic . tr . scaleSH (V3 crsize crsize crsize) $ mconcat

src/Dodge/Creature/Picture/Awareness.hs

@@ -0,0 +1,45 @@
+module Dodge.Creature.Picture.Awareness where
+import Dodge.Data
+import Dodge.Clock
+import Picture
+import Geometry
+
+import qualified Data.Vector as V
+
+creatureDisplayText :: World -> Creature -> Picture
+creatureDisplayText w cr = setLayer DebugLayer 
+    . setDepth 20 
+    . translate x y 
+    . color white 
+    . rotate (0.5 * pi)
+--    . rotate (argV v - 0.5 * pi)
+    . scale theScale theScale 
+    . stackText 
+    $ clockCycle 25 (V.fromList 
+        [ \cr' -> [crDisplayVigilance cr']
+        , \cr' -> [crDisplayAwareness cr']
+        ]
+        ) w cr
+  where
+    campos = _cameraViewFrom w
+    theScale = 0.15 / _cameraZoom w
+    cpos = _crPos cr
+    v = cpos -.- campos
+    (V2 x y) = campos +.+ v +.+ _crRad cr *.* normalizeV v
+
+crDisplayAwareness :: Creature -> String
+crDisplayAwareness cr
+    | isSuspicious = "?"
+    | isCognizant  = "!"
+    | otherwise    = "."
+  where
+    imAwarenesses = _cpAwareness (_crPerception cr)
+    isSuspicious = any f imAwarenesses && not (null imAwarenesses)
+    isCognizant  = any g imAwarenesses && not (null imAwarenesses)
+    f (Suspicious _) = True
+    f _ = False
+    g (Cognizant _) = True
+    g _ = False
+
+crDisplayVigilance :: Creature -> String
+crDisplayVigilance = show . _cpVigilance . _crPerception

src/Dodge/Data.hs

@@ -346,7 +346,8 @@ data Creature = Creature
     , _crMvDir          :: Float
     , _crTwist          :: Float
     , _crID             :: Int
-    , _crPict           :: Creature -> Configuration -> World -> SPic
+    --, _crPict           :: Creature -> Configuration -> World -> SPic
+    , _crPict           :: Creature -> SPic
     , _crSkin           :: CreatureSkin
     , _crUpdate         :: Creature -> World -> World
     , _crRad            :: Float

src/Dodge/Placement/Instance/Turret.hs

@@ -75,7 +75,7 @@ updateTurret rotSpeed mc w
                 & crOldPos .~ mcpos
                 & crRad    .~ 1
                 & crDir .~ mcdir
-                & crPict .~ (\cr _ _ -> drawCrEquipment cr)
+                & crPict .~ drawCrEquipment
                 & crUpdate .~ stateUpdate followThenClearImpulses
                 & crStance . posture .~ Aiming
                 & crApplyDamage .~ applyNoDamage

src/Dodge/Render.hs

@@ -47,17 +47,15 @@ doDrawing pdata u = do
     -- bind as much data into vbos as feasible at this point
     -- count mutable vectors setup
     layerCounts  <- UMV.replicate (numLayers*6) 0
---    shapeCounts  <- UMV.replicate 3 0
-    wlwiflCounts <- UMV.replicate 3 0
     -- attempt to poke in parallel
     let (ws,wp) = wallSPics <> worldSPic cfig w
-    (nShapeVs, nIndices, nSilIndices) <- MP.bindM3 (\ _ _ counts -> return counts)
+    ( (nWalls, nWins , nFls),(nShapeVs, nIndices, nSilIndices) )
+        <- MP.bindM3 (\ _ wlwifl counts -> return (wlwifl,counts))
         ( pokeBindFoldableLayer shadV layerCounts wp)
         ( pokeWallsWindowsFloor
             (shadVBOptr $ _wallTextureShader pdata) 
             (shadVBOptr $ _windowShader pdata) 
             (shadVBOptr $ _textureArrayShader pdata)
-            wlwiflCounts
             wallPointsCol
             windowPoints
             (_floorTiles w)
@@ -68,9 +66,6 @@ doDrawing pdata u = do
             (_eboPtr $ _silhouetteEBO pdata)
             ws
         )
-    nWalls <- UMV.read wlwiflCounts 0
-    nWins  <- UMV.read wlwiflCounts 1
-    nFls   <- UMV.read wlwiflCounts 2
     -- bind wall points, silhouette data, surface geometry
     uncurry bindShaderBuffers $ unzip
         [ ( _wallTextureShader pdata, nWalls)

src/Dodge/Render/ShapePicture.hs

@@ -1,6 +1,7 @@
 module Dodge.Render.ShapePicture
     ( worldSPic
     ) where
+import Dodge.Creature.Picture.Awareness
 import Dodge.ShortShow
 import Dodge.Config.Data
 import Dodge.Render.InfoBox
@@ -25,6 +26,7 @@ import Sound.Data
 import Geometry.ConvexPoly
 --import Dodge.Base.Collide
 
+--import Data.Foldable
 import qualified Data.IntMap.Strict as IM -- Lazy?
 import qualified Data.Map.Strict as M
 import Control.Lens
@@ -33,22 +35,26 @@ import qualified Streaming.Prelude as S
 
 -- TODO only filter out shapes outside the range of the furthest shown light source
 worldSPic :: Configuration -> World -> SPic
-worldSPic cfig w = 
-    (mempty, extraPics cfig w)
-    --(mempty, extraPics cfig w)
+worldSPic cfig w = (mempty, extraPics cfig w)
     <> foldMap (dbArg _prDraw) (filtOn _prPos _props)
     <> foldMap (shiftDraw _blPos _blDir _blDraw) (filtOn _blPos _blocks)
     <> foldMap (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn _fsPos _shapes)
---    <> foldMap (\fs -> uncurryV translateSPf (_fsPos fs) . rotateSP (_fsDir fs) $ _fsSPic fs) (_shapes w)
     <> foldMap (dbArg _cpPict) (filtOn _cpPos _corpses)
-    <> foldMap ((($ w) . ($ cfig)) . dbArg _crPict) (filtOn _crPos _creatures)
+    <> foldMap (dbArg _crPict) (filtOn _crPos _creatures)
     <> foldMap floorItemSPic (filtOn _flItPos _floorItems)
     <> foldMap btSPic (filtOn _btPos _buttons)
     <> foldMap mcSPic (filtOn _mcPos _machines)
+    <> anyTargeting cfig w
   where
     filtOn f g = IM.filter (pointIsClose . f) (g w)
     pointIsClose = cullPoint cfig w
 
+anyTargeting :: Configuration -> World -> SPic
+anyTargeting cfig w = (mempty,pictures $ IM.elems $ IM.mapMaybe f $ _crInv cr)
+  where
+    cr = you w
+    f it = fmap (\g -> g it cr cfig w) (it ^? itTargeting . tgDraw)
+
 shiftDraw :: (a -> Point2) -> (a -> Float) -> (a -> a -> SPic) -> a -> SPic
 shiftDraw fpos fdir fdraw x = uncurryV translateSPf (fpos x)
     . rotateSP (fdir x)
@@ -80,14 +86,18 @@ extraPics cfig w = pictures (_decorations w)
     <> cfigdraw Show_bound_box (const drawBoundingBox)
     <> cfigdraw Show_wall_search_rays (const drawWallSearchRays)
     <> cfigdraw Show_dda_test (const drawDDATest)
-    <> cfigdraw Show_far_wall_detect (const drawFarWallDetect)
-    <> cfigdraw Show_select          (const drawWorldSelect)
-    <> cfigdraw Inspect_wall         (const drawInspectWalls)
+    <> cfigdraw Show_far_wall_detect    (const drawFarWallDetect)
+    <> cfigdraw Show_select             (const drawWorldSelect)
+    <> cfigdraw Inspect_wall            (const drawInspectWalls)
+    <> cfigdraw Cr_awareness            (const drawCreatureDisplayTexts)
   where
     cfigdraw boption draw
         | debugOn boption cfig = draw cfig w
         | otherwise = mempty
 
+drawCreatureDisplayTexts :: World -> Picture
+drawCreatureDisplayTexts w = foldMap (creatureDisplayText w) (_creatures w)
+
 drawInspectWalls :: World -> Picture
 drawInspectWalls w = foldMap (drawInspectWall w) 
     $ filter (isJust . uncurry (intersectSegSeg a b) . _wlLine)
@@ -113,9 +123,12 @@ drawWorldSelect w = setLayer DebugLayer . color cyan
     (a,b) = _wSelect w
 
 drawFarWallDetect :: World -> Picture
-drawFarWallDetect w = setLayer DebugLayer . color yellow 
-    . concatMap (\q -> line [p,q]) 
-    . map (\q -> fst $ collidePoint p q $ S.filter wlIsOpaque $ wallsAlongLine p q w)
+drawFarWallDetect w = setLayer DebugLayer 
+    . color yellow 
+    . concatMap (\q -> line 
+        [ p
+        , fst $ collidePoint p q $ S.filter wlIsOpaque $ wallsAlongLine p q w
+        ]   )
     $ runIdentity $ S.toList_ $ streamViewpoints p w
   where
     p = _cameraViewFrom w

src/Dodge/Room/Foreground.hs

@@ -5,7 +5,7 @@ import Picture
 import Geometry
 import Shape
 import Quaternion
-import Bound
+--import Bound
 
 --import Dodge.Data.ForegroundShape
 import Dodge.Default.Foreground
@@ -13,8 +13,8 @@ import Data.List
 import Data.Maybe
 import Control.Lens
 import ShapePicture
-import Streaming
-import qualified Streaming.Prelude as S
+--import Streaming
+--import qualified Streaming.Prelude as S
 
 highDiagonalMesh
     :: Point2 
@@ -123,7 +123,7 @@ putShape :: Shape -> PSType
 putShape sh = PutForeground $ defaultForeground
     & fsPos .~ m
     & fsRad .~ radBounds bnds
-    & fsSPic .~ noPic (uncurryV translateSHf (-m) $ sh)
+    & fsSPic .~ noPic (uncurryV translateSHf (-m) sh)
   where
     bnds = (0,0,0,0) -- shapeBounds sh
     m = midBounds bnds