Unify world shape and picture into spic

2021-11-01 02:00:12 +00:00
parent 86fdfd260e
commit da346bc3a0
9 changed files with 266 additions and 158 deletions
@@ -1,7 +1,15 @@
 {-# LANGUAGE TupleSections #-}
 {- | Basic collision detection for a moving point -}
 module Dodge.Base.Collide
-    where
+    ( hasLOS
+    , reflectPointWalls
+    , ssfold
+    , collidePointUpToIndirectMinDist
+    , canSeeIndirect
+    , isWalkable
+    , canSee
+    , hasLOSIndirect
+    ) where
 import Dodge.Data
 import Dodge.Zone
 import Geometry
@@ -17,15 +25,15 @@ hasLOS :: Point2 -> Point2 -> World -> Bool
 {-# INLINE hasLOS #-}
 hasLOS p1 p2 w = not $ pointHitsWalls p1 p2 $ wallsAlongLine p1 p2 w

-hitPointLines
-    :: Point2
-    -> Point2
-    -> [(Point2,Point2)]
-    -> Maybe (Point2,(Point2,Point2))
-hitPointLines p1 p2
-    = safeMinimumOn (dist p1 . fst)
-    . mapMaybe
-    (\(x,y) -> (, (x,y)) <$> intersectSegSeg p1 p2 x y)
+--hitPointLines
+--    :: Point2
+--    -> Point2
+--    -> [(Point2,Point2)]
+--    -> Maybe (Point2,(Point2,Point2))
+--hitPointLines p1 p2
+--    = safeMinimumOn (dist p1 . fst)
+--    . mapMaybe
+--    (\(x,y) -> (, (x,y)) <$> intersectSegSeg p1 p2 x y)

 -- | looks for first collision of a point with walls
 -- if found, gives point and reflection velocity
@@ -40,22 +48,22 @@ reflectPointWalls p1 p2 ws
                 (intersectSegSeg p1 p2 x y)
         ) 
        . _wlLine) ws
-- | Looks for first collision of a point with walls.
-- If found, gives point and reflection velocity, reflection damped in normal.
-reflectPointWallsDamped 
-    :: Float    -- ^ Damping factor, probably should be in (0,1)
-    -> Point2 
-    -> Point2 
-    -> IM.IntMap Wall 
-    -> Maybe (Point2,Point2)
-reflectPointWallsDamped dfact p1 p2 ws 
-    = safeMinimumOn (dist p1 . fst)
-    $ IM.mapMaybe 
-        (( \(x,y) -> fmap ((, reflectInParam dfact (x -.- y) (p2 -.- p1)) 
-                            . (+.+ errorNormalizeV 40 (vNormal (x -.- y)))) 
-                                (intersectSegSeg p1 p2 x y)) 
-         . _wlLine
-        ) ws
+---- | Looks for first collision of a point with walls.
+---- If found, gives point and reflection velocity, reflection damped in normal.
+--reflectPointWallsDamped 
+--    :: Float    -- ^ Damping factor, probably should be in (0,1)
+--    -> Point2 
+--    -> Point2 
+--    -> IM.IntMap Wall 
+--    -> Maybe (Point2,Point2)
+--reflectPointWallsDamped dfact p1 p2 ws 
+--    = safeMinimumOn (dist p1 . fst)
+--    $ IM.mapMaybe 
+--        (( \(x,y) -> fmap ((, reflectInParam dfact (x -.- y) (p2 -.- p1)) 
+--                            . (+.+ errorNormalizeV 40 (vNormal (x -.- y)))) 
+--                                (intersectSegSeg p1 p2 x y)) 
+--         . _wlLine
+--        ) ws
 -- | Test if a point collides with walls
 pointHitsWalls :: Point2 -> Point2 -> IM.IntMap Wall -> Bool
 pointHitsWalls p1 p2 
@@ -66,42 +74,42 @@ collidePointWalkable p1 p2 ws
    = any (isJust . uncurry (intersectSegSeg p1 p2) . _wlLine) 
    $ IM.filter (fromMaybe True . (^? wlPathable)) ws

-furthestPointWalkable :: Point2 -> Point2 -> IM.IntMap Wall -> Point2
-furthestPointWalkable p1 p2 ws 
-    = fromMaybe p2
-    . safeMinimumOn (dist p1) 
-    $ IM.mapMaybe ( uncurry (intersectSegSeg p1 p2) . _wlLine) ws
+--furthestPointWalkable :: Point2 -> Point2 -> IM.IntMap Wall -> Point2
+--furthestPointWalkable p1 p2 ws 
+--    = fromMaybe p2
+--    . safeMinimumOn (dist p1) 
+--    $ IM.mapMaybe ( uncurry (intersectSegSeg p1 p2) . _wlLine) ws

-collideDirectionIndirect 
-    :: Float    -- ^max distance to look
-    -> Point2   -- ^start point
-    -> Point2   -- ^point in direction
-    -> IM.IntMap Wall 
-    -> Float
-{-# INLINE collideDirectionIndirect #-}
-collideDirectionIndirect d p1 p2 wls
-    = fromMaybe d
-    $
-    ( L.fold
-    . L.prefilter wlIsOpaque
-    . L.premapMaybe (fmap (dist p1) . uncurry (intersectSegSeg p1 p3) . _wlLine)
-    ) L.minimum 
-    wls
-  where
-    p3 = p1 +.+ d *.* safeNormalizeV (p2 -.- p1)
+--collideDirectionIndirect 
+--    :: Float    -- ^max distance to look
+--    -> Point2   -- ^start point
+--    -> Point2   -- ^point in direction
+--    -> IM.IntMap Wall 
+--    -> Float
+--{-# INLINE collideDirectionIndirect #-}
+--collideDirectionIndirect d p1 p2 wls
+--    = fromMaybe d
+--    $
+--    ( L.fold
+--    . L.prefilter wlIsOpaque
+--    . L.premapMaybe (fmap (dist p1) . uncurry (intersectSegSeg p1 p3) . _wlLine)
+--    ) L.minimum 
+--    wls
+--  where
+--    p3 = p1 +.+ d *.* safeNormalizeV (p2 -.- p1)

 wlIsOpaque :: Wall -> Bool
 wlIsOpaque wl = _wlOpacity wl == Opaque

-collidePointUpToIndirect
-    :: Point2   -- ^start point
-    -> Point2   -- ^end point
-    -> IM.IntMap Wall 
-    -> Point2
-{-# INLINE collidePointUpToIndirect #-}
-collidePointUpToIndirect p1 p2 = foldr f p2 . IM.filter wlIsOpaque
-  where
-    f wl x = fromMaybe x . uncurry (intersectSegSeg p1 x) $ _wlLine wl
+--collidePointUpToIndirect
+--    :: Point2   -- ^start point
+--    -> Point2   -- ^end point
+--    -> IM.IntMap Wall 
+--    -> Point2
+--{-# INLINE collidePointUpToIndirect #-}
+--collidePointUpToIndirect p1 p2 = foldr f p2 . IM.filter wlIsOpaque
+--  where
+--    f wl x = fromMaybe x . uncurry (intersectSegSeg p1 x) $ _wlLine wl

 collidePointUpToIndirectMinDist
    :: Point2   -- ^start point
@@ -138,21 +146,21 @@ collidePointIndirect'  p1 p2
    . L.premapMaybe (uncurry (intersectSegSeg p1 p2) . _wlLine)
    $ L.minimumOn (dist p1)

-{- | Checks to see whether someone can fire bullets effectively between two points. 
- - Not sure if this needs vision as well, need to make this uniform. -}
-collidePointFire :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Point2
-collidePointFire p1 p2 ws 
-    = safeMinimumOn (dist p1) 
-    . IM.mapMaybe ( uncurry (intersectSegSeg p1 p2) . _wlLine ) 
-    $ IM.filter (\wl -> not (_wlFireThrough wl) || wlIsOpaque wl) ws
-{- | Checks to see whether someone can fire bullets effectively between two points. 
- - Not sure if this needs vision as well, need to make this uniform. -}
-collidePointFireVision :: Point2 -> Point2 -> IM.IntMap Wall -> Bool
-collidePointFireVision p1 p2 ws 
-    = any ( isJust . uncurry (intersectSegSeg p1 p2) . _wlLine) 
-    $ IM.filter theTest ws
-  where 
-    theTest wl = not (_wlFireThrough wl) || wlIsOpaque wl
+--{- | Checks to see whether someone can fire bullets effectively between two points. 
+-- - Not sure if this needs vision as well, need to make this uniform. -}
+--collidePointFire :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Point2
+--collidePointFire p1 p2 ws 
+--    = safeMinimumOn (dist p1) 
+--    . IM.mapMaybe ( uncurry (intersectSegSeg p1 p2) . _wlLine ) 
+--    $ IM.filter (\wl -> not (_wlFireThrough wl) || wlIsOpaque wl) ws
+--{- | Checks to see whether someone can fire bullets effectively between two points. 
+-- - Not sure if this needs vision as well, need to make this uniform. -}
+--collidePointFireVision :: Point2 -> Point2 -> IM.IntMap Wall -> Bool
+--collidePointFireVision p1 p2 ws 
+--    = any ( isJust . uncurry (intersectSegSeg p1 p2) . _wlLine) 
+--    $ IM.filter theTest ws
+--  where 
+--    theTest wl = not (_wlFireThrough wl) || wlIsOpaque wl

 -- the reason for using the dashed version is the hope that this will short
 -- circuit
@@ -172,47 +180,47 @@ canSee i j w = hasLOS p1 p2 w
    p1 = _crPos (_creatures w IM.! i)
    p2 = _crPos (_creatures w IM.! j)

-canSeePoint :: Int -> Point2 -> World -> Bool
-canSeePoint i p w = hasLOS p1 p w
-  where
-    p1 = _crPos (_creatures w IM.! i)
+--canSeePoint :: Int -> Point2 -> World -> Bool
+--canSeePoint i p w = hasLOS p1 p w
+--  where
+--    p1 = _crPos (_creatures w IM.! i)

-pathToPointFireable :: Int -> Point2 -> World -> Bool
-pathToPointFireable i p w 
-    = not 
-    . pointHitsWalls (_crPos $ _creatures w IM.! i) p
-    $ IM.filter (not . _wlFireThrough ) $ wallsAlongLine p1 p w
-  where 
-    p1 = _crPos (_creatures w IM.! i)
+--pathToPointFireable :: Int -> Point2 -> World -> Bool
+--pathToPointFireable i p w 
+--    = not 
+--    . pointHitsWalls (_crPos $ _creatures w IM.! i) p
+--    $ IM.filter (not . _wlFireThrough ) $ wallsAlongLine p1 p w
+--  where 
+--    p1 = _crPos (_creatures w IM.! i)

-canSeePointAll :: Int -> Point2 -> World -> Bool
-canSeePointAll i targPos w 
-    = all (flip (canSeePoint i) w . (\p -> targPos +.+ radius *.* p) . toV2) [(1,0),(0,1),(-1,0),(0,-1)]
-  where 
-    cr = _creatures w IM.! i
-    radius = _crRad cr
+--canSeePointAll :: Int -> Point2 -> World -> Bool
+--canSeePointAll i targPos w 
+--    = all (flip (canSeePoint i) w . (\p -> targPos +.+ radius *.* p) . toV2) [(1,0),(0,1),(-1,0),(0,-1)]
+--  where 
+--    cr = _creatures w IM.! i
+--    radius = _crRad cr

-canSeeAny :: Int -> Int -> World -> Bool
-canSeeAny fromID toID w 
-    = any (flip (canSeePoint fromID) w . (\p -> cpos +.+ radius *.* p) . toV2) [(1,0),(0,1),(-1,0),(0,-1)]
-  where 
-    cr = _creatures w IM.! toID
-    cpos = _crPos cr
-    radius = _crRad cr
+--canSeeAny :: Int -> Int -> World -> Bool
+--canSeeAny fromID toID w 
+--    = any (flip (canSeePoint fromID) w . (\p -> cpos +.+ radius *.* p) . toV2) [(1,0),(0,1),(-1,0),(0,-1)]
+--  where 
+--    cr = _creatures w IM.! toID
+--    cpos = _crPos cr
+--    radius = _crRad cr

-canSeeAll :: Int -> Int -> World -> Bool
-canSeeAll fromID toID w 
-    = all (flip (canSeePoint fromID) w . (\p -> cpos +.+ radius *.* p) . toV2) [(1,0),(0,1),(-1,0),(0,-1)]
-  where 
-    cr = _creatures w IM.! toID
-    cpos = _crPos cr
-    radius = _crRad cr
+--canSeeAll :: Int -> Int -> World -> Bool
+--canSeeAll fromID toID w 
+--    = all (flip (canSeePoint fromID) w . (\p -> cpos +.+ radius *.* p) . toV2) [(1,0),(0,1),(-1,0),(0,-1)]
+--  where 
+--    cr = _creatures w IM.! toID
+--    cpos = _crPos cr
+--    radius = _crRad cr

-canWalk :: Int -> Int -> World -> Bool
-canWalk i j w = not $ collidePointWalkable ipos jpos $ wallsAlongLine ipos jpos w
-  where 
-    ipos = _crPos (_creatures w IM.! i)
-    jpos = _crPos (_creatures w IM.! j)
+--canWalk :: Int -> Int -> World -> Bool
+--canWalk i j w = not $ collidePointWalkable ipos jpos $ wallsAlongLine ipos jpos w
+--  where 
+--    ipos = _crPos (_creatures w IM.! i)
+--    jpos = _crPos (_creatures w IM.! j)

 canSeeIndirect :: Int -> Int -> World -> Bool
 canSeeIndirect i j w = isNothing . collidePointIndirect ipos jpos $ wallsAlongLine ipos jpos w
@@ -220,43 +228,43 @@ canSeeIndirect i j w = isNothing . collidePointIndirect ipos jpos $ wallsAlongLi
    ipos = _crPos (_creatures w IM.! i)
    jpos = _crPos (_creatures w IM.! j)
    
-canSeeFire :: Point2 -> Point2 -> World -> Bool
-canSeeFire p p' w = not $ collidePointFireVision p p' $ wallsAlongLine p p' w
+--canSeeFire :: Point2 -> Point2 -> World -> Bool
+--canSeeFire p p' w = not $ collidePointFireVision p p' $ wallsAlongLine p p' w

-canSeeFireVision :: Int -> Int -> World -> Bool
-canSeeFireVision i j w = canSeeFire ipos jpos w
-  where 
-    ipos = _crPos (_creatures w IM.! i)
-    jpos = _crPos (_creatures w IM.! j)
-{- | Test whether both of the outside lines between two creatures are blocked -}
-canSeeFireVisionAny :: Int -> Int -> World -> Bool
-canSeeFireVisionAny i j w 
-    = not 
-    $ collidePointFireVision (ipos +.+ ni) (jpos +.+ nj) 
-        (wallsAlongLine (ipos +.+ ni) (jpos +.+ nj) w)
-    && collidePointFireVision (ipos -.- ni) (jpos -.- nj) 
-        (wallsAlongLine (ipos -.- ni) (jpos -.- nj) w)
-  where
-    icr = _creatures w IM.! i
-    jcr = _creatures w IM.! j
-    ipos = _crPos icr
-    jpos = _crPos jcr
-    n = normalizeV $ vNormal $ ipos -.- jpos
-    ni = _crRad icr *.* n
-    nj = _crRad jcr *.* n
-{- | Test whether either of the outside lines between two creatures are blocked -}
-canSeeFireVisionAll :: Int -> Int -> World -> Bool
-canSeeFireVisionAll i j w 
-    = not 
-    $ collidePointFireVision (ipos +.+ ni) (jpos +.+ nj) 
-        (wallsAlongLine (ipos +.+ ni) (jpos +.+ nj) w)
-    || collidePointFireVision (ipos -.- ni) (jpos -.- nj) 
-        (wallsAlongLine (ipos -.- ni) (jpos -.- nj) w)
-  where
-    icr = _creatures w IM.! i
-    jcr = _creatures w IM.! j
-    ipos = _crPos icr
-    jpos = _crPos jcr
-    n = normalizeV $ vNormal $ ipos -.- jpos
-    ni = _crRad icr *.* n
-    nj = _crRad jcr *.* n
+--canSeeFireVision :: Int -> Int -> World -> Bool
+--canSeeFireVision i j w = canSeeFire ipos jpos w
+--  where 
+--    ipos = _crPos (_creatures w IM.! i)
+--    jpos = _crPos (_creatures w IM.! j)
+--{- | Test whether both of the outside lines between two creatures are blocked -}
+--canSeeFireVisionAny :: Int -> Int -> World -> Bool
+--canSeeFireVisionAny i j w 
+--    = not 
+--    $ collidePointFireVision (ipos +.+ ni) (jpos +.+ nj) 
+--        (wallsAlongLine (ipos +.+ ni) (jpos +.+ nj) w)
+--    && collidePointFireVision (ipos -.- ni) (jpos -.- nj) 
+--        (wallsAlongLine (ipos -.- ni) (jpos -.- nj) w)
+--  where
+--    icr = _creatures w IM.! i
+--    jcr = _creatures w IM.! j
+--    ipos = _crPos icr
+--    jpos = _crPos jcr
+--    n = normalizeV $ vNormal $ ipos -.- jpos
+--    ni = _crRad icr *.* n
+--    nj = _crRad jcr *.* n
+--{- | Test whether either of the outside lines between two creatures are blocked -}
+--canSeeFireVisionAll :: Int -> Int -> World -> Bool
+--canSeeFireVisionAll i j w 
+--    = not 
+--    $ collidePointFireVision (ipos +.+ ni) (jpos +.+ nj) 
+--        (wallsAlongLine (ipos +.+ ni) (jpos +.+ nj) w)
+--    || collidePointFireVision (ipos -.- ni) (jpos -.- nj) 
+--        (wallsAlongLine (ipos -.- ni) (jpos -.- nj) w)
+--  where
+--    icr = _creatures w IM.! i
+--    jcr = _creatures w IM.! j
+--    ipos = _crPos icr
+--    jpos = _crPos jcr
+--    n = normalizeV $ vNormal $ ipos -.- jpos
+--    ni = _crRad icr *.* n
+--    nj = _crRad jcr *.* n
@@ -538,6 +538,7 @@ data Prop
        }
    | LinearShockwave 
        { _prDraw :: Prop -> SPic
+        , _pjPos :: Point2
        , _pjID :: Int
        , _pjUpdate :: Prop -> World -> World
        , _pjPoints :: [(Point2,Point2)]
@@ -66,3 +66,4 @@ intersectLinefromScreen w a b = listToMaybe
    . mapMaybe (\(x,y) -> intersectSegLineFrom x y b (b +.+ b -.- a))
    . loopPairs 
    $ screenPolygon w
+
@@ -74,6 +74,7 @@ addBoostShockwave pjid p v w = w & props %~
  where
    thePJ = LinearShockwave
        { _prDraw = drawBoostShockwave
+        , _pjPos = p
        , _pjID = pjid
        , _pjUpdate = updateLinearShockwave
        , _pjPoints = [(p,v)]
@@ -67,7 +67,7 @@ placeSpotID ps w = case _psType ps of
    PutBtDoor c bp f a b speed -> addButtonDoor c (doShift bp) (f + rot) 
                            (doShift a) (doShift b) speed w
    PutLineBlock wl width depth a b
-        -> putLineBlock wl width depth (doShift a) (doShift b) w
+        -> placeLineBlock wl width depth (doShift a) (doShift b) w
    PutWall { _pwPoly = ps', _pwWall = wl } -> (0,rmCrossPaths $ over walls (addWalls qs wl) w)
      where 
        qs = map doShift ps'
@@ -1,7 +1,7 @@
 {- | Creation, update and destruction of destructible walls.  -}
 module Dodge.LevelGen.Block 
    ( placeBlock
-    , putLineBlock
+    , placeLineBlock
    )
    where
 import Dodge.Data
@@ -63,7 +63,7 @@ placeBlock poly i c opac is w = (0, foldr (uncurry removePathsCrossing) wWithBlo
    wWithBlock = addBlock poly i c opac is w

 {- | Splits a line into many four cornered blocks. -}
-putLineBlock 
+placeLineBlock 
    :: Wall     -- ^ Base pane
    -> Float    -- ^ Block width
    -> Float    -- ^ Block depth
@@ -71,7 +71,7 @@ putLineBlock
    -> Point2   -- ^ End point (symmetric)
    -> World 
    -> (Int, World)
-putLineBlock basePane blockWidth depth a b w = (,) 0 
+placeLineBlock basePane blockWidth depth a b w = (,) 0 
    $ removePathsCrossing a b $ foldr insertWall (insertBlocks w) listWalls
  where 
    d = dist a b
@@ -9,6 +9,7 @@ import Dodge.Config.Data
 import Dodge.Base.Window
 import Dodge.Render.Picture
 import Dodge.Render.Shape
+import Dodge.Render.ShapePicture
 import Geometry
 import Render
 import Data.Preload.Render
@@ -49,8 +50,10 @@ doDrawing pdata w = do
    shapeCounts  <- UMV.replicate 3 (0 :: Int)
    wlwiflCounts <- UMV.replicate 3 (0 :: Int)
    -- attempt to poke in parallel
+    let (ws,wp) = worldSPic w
    MP.bindM3 (\ _ _ _ -> return ())
-        ( pokeBindFoldableLayer shadV layerCounts $ worldPictures w )
+        --( pokeBindFoldableLayer shadV layerCounts $ worldPictures w )
+        ( pokeBindFoldableLayer shadV layerCounts wp)
        ( pokeWallsWindowsFloor
            (shadVBOptr $ _wallTextureShader pdata) 
            (shadVBOptr $ _windowShader pdata) 
@@ -65,7 +68,8 @@ doDrawing pdata w = do
            (_eboPtr $ _shapeEBO pdata)
            (_eboPtr $ _silhouetteEBO pdata)
            shapeCounts
-            $ worldShape w
+            -- $ worldShape w
+            ws
        )
    nShapeVs    <- UMV.read shapeCounts 0
    nIndices    <- UMV.read shapeCounts 1
@@ -71,6 +71,7 @@ customMouseCursor w =
    . color white
    $ pictures [ line [V2 (-5) 0,V2 5 0] , line [V2 0 (-5),V2 0 5] ]

+-- TODO remove duplicate!
 testPic :: World -> Picture
 testPic _ = []

@@ -1,16 +1,108 @@
 module Dodge.Render.ShapePicture
    ( floorItemSPic
+    , worldSPic
    )
    where
+import Dodge.Config.Data
+--import Dodge.Debug.Picture
+import Dodge.Picture.SizeInvariant
 import Dodge.Data
+import Dodge.Base
+import Dodge.Base.Window
+import Dodge.SoundLogic.LoadSound
+import Dodge.Graph
+import Dodge.GameRoom
+import Dodge.Update.Camera
 import Geometry
 import ShapePicture
--import Shape
--import Picture
+import Shape
+import Picture
+import Sound.Data
+
+import qualified Data.IntMap.Strict as IM
+import qualified Data.Map.Strict as M
+
+worldSPic :: World -> SPic
+worldSPic w = 
+    (extraShapes w, extraPics w)
+    <> foldMap (dbArg _prDraw) (filtOn _pjPos _props)
+    <> foldMap (($ w) . dbArg _crPict) (filtOn _crPos _creatures)
+    <> foldMap floorItemSPic (filtOn _flItPos _floorItems)
+    <> foldMap btSPic (filtOn _btPos _buttons)
+    <> foldMap mcSPic (filtOn _mcPos _machines)
+  where
+    filtOn f g = IM.filter (pointIsClose . f) (g w)
+    pointIsClose p = dist camCen p < winSize
+    winSize = 30 + max (getWindowX w) (getWindowY w)
+    camCen = _cameraCenter w
+
+extraShapes :: World -> Shape
+extraShapes w = _foregroundShape w
+
+extraPics :: World -> Picture
+extraPics w = pictures (_decorations w)
+    <> concatMapPic (dbArg _ptDraw) (_particles    w)
+    <> concatMapPic (dbArg _lsPict) (_lightSources w)
+    <> testPic w
+    <> concatMapPic clDraw (_clouds w      )
+    <> concatMapPic ppDraw (_pressPlates w )
+    <> soundPics w
+    <> viewBoundaries w
+    <> drawPathing w
+
+-- TODO remove duplicate!
+testPic :: World -> Picture
+testPic _ = []
+clDraw :: Cloud -> Picture
+clDraw c = translate3 (_clPos c) (_clPict c c)
+ppDraw :: PressPlate -> Picture
+ppDraw c = uncurryV translate (_ppPos c) $ rotate (_ppRot c) (_ppPict c)

 floorItemSPic :: FloorItem -> SPic
-floorItemSPic flit 
-    = uncurryV translateSPf (_flItPos flit) 
+floorItemSPic flit = uncurryV translateSPf (_flItPos flit) 
    $ rotateSP (_flItRot flit)  (_itFloorPict (_flIt flit) (_flIt flit))

--TODO combine worldShape and worldPicture here
+btSPic :: Button -> SPic
+btSPic bt = uncurryV translateSPf (_btPos bt)
+    $ rotateSP (_btRot bt) (_btPict bt bt)
+mcSPic :: Machine -> SPic
+mcSPic bt = uncurryV translateSPf (_mcPos bt)
+    $ rotateSP (_mcDir bt) (_mcDraw bt bt)
+
+soundPics :: World -> Picture
+soundPics w 
+    | _show_sound (_config w) = pictures $ M.map (soundPic w) $ _playingSounds w
+    | otherwise = []
+
+soundPic :: World -> Sound -> Picture
+soundPic w s = fixedSizePicClampArrow 50 50 thePic p w
+  where
+    p = _soundPos s
+    thePic 
+        = rotate (_cameraRot w) 
+        . scale theScale theScale 
+        . centerText 
+        . soundToOnomato 
+        $ _soundChunkID s
+    theScale = 0.15 * f (_soundVolume s * 0.0001)
+    f x = 1 - 0.5 * (1 - x)
+
+drawPathing :: World -> Picture
+drawPathing w
+    | _debug_pathing (_config w) 
+        = -- setLayer 5 $ 
+        (color green . pictures . map (flip thickLine 5 . tflat2) $ graphToEdges gr)
+        <> concatMap dispInc (graphToIncidence gr)
+    | otherwise = []
+  where
+    dispInc (p,n) = setDepth 2 . uncurryV translate p . scale 0.1 0.1 $ text $ show n
+    gr = _pathGraph w
+viewBoundaries :: World -> Picture
+viewBoundaries w
+    | _debug_view_boundaries (_config w) 
+        = setLayer 5 $ color green (concatMap (polygonWire . _grBound) grs)
+        <> color yellow (concatMap (\q -> line [p,q]) $ farWallPoints p w)
+    | otherwise = []
+  where
+    p = _crPos $ you w
+    grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms w)