Unify world shape and picture into spic

src/Dodge/Base/Collide.hs

@@ -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
+--hitPointLines
-    :: Point2
+--    :: Point2
-    -> Point2
+--    -> Point2
-    -> [(Point2,Point2)]
+--    -> [(Point2,Point2)]
-    -> Maybe (Point2,(Point2,Point2))
+--    -> Maybe (Point2,(Point2,Point2))
-hitPointLines p1 p2
+--hitPointLines p1 p2
-    = safeMinimumOn (dist p1 . fst)
+--    = safeMinimumOn (dist p1 . fst)
-    . mapMaybe
+--    . mapMaybe
-    (\(x,y) -> (, (x,y)) <$> intersectSegSeg p1 p2 x y)
+--    (\(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.
+---- | Looks for first collision of a point with walls.
--- If found, gives point and reflection velocity, reflection damped in normal.
+---- If found, gives point and reflection velocity, reflection damped in normal.
-reflectPointWallsDamped 
+--reflectPointWallsDamped 
-    :: Float    -- ^ Damping factor, probably should be in (0,1)
+--    :: Float    -- ^ Damping factor, probably should be in (0,1)
-    -> Point2 
+--    -> Point2 
-    -> Point2 
+--    -> Point2 
-    -> IM.IntMap Wall 
+--    -> IM.IntMap Wall 
-    -> Maybe (Point2,Point2)
+--    -> Maybe (Point2,Point2)
-reflectPointWallsDamped dfact p1 p2 ws 
+--reflectPointWallsDamped dfact p1 p2 ws 
-    = safeMinimumOn (dist p1 . fst)
+--    = safeMinimumOn (dist p1 . fst)
-    $ IM.mapMaybe 
+--    $ IM.mapMaybe 
-        (( \(x,y) -> fmap ((, reflectInParam dfact (x -.- y) (p2 -.- p1)) 
+--        (( \(x,y) -> fmap ((, reflectInParam dfact (x -.- y) (p2 -.- p1)) 
-                            . (+.+ errorNormalizeV 40 (vNormal (x -.- y)))) 
+--                            . (+.+ errorNormalizeV 40 (vNormal (x -.- y)))) 
-                                (intersectSegSeg p1 p2 x y)) 
+--                                (intersectSegSeg p1 p2 x y)) 
-         . _wlLine
+--         . _wlLine
-        ) ws
+--        ) 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 :: Point2 -> Point2 -> IM.IntMap Wall -> Point2
-furthestPointWalkable p1 p2 ws 
+--furthestPointWalkable p1 p2 ws 
-    = fromMaybe p2
+--    = fromMaybe p2
-    . safeMinimumOn (dist p1) 
+--    . safeMinimumOn (dist p1) 
-    $ IM.mapMaybe ( uncurry (intersectSegSeg p1 p2) . _wlLine) ws
+--    $ IM.mapMaybe ( uncurry (intersectSegSeg p1 p2) . _wlLine) ws
 
-collideDirectionIndirect 
+--collideDirectionIndirect 
-    :: Float    -- ^max distance to look
+--    :: Float    -- ^max distance to look
-    -> Point2   -- ^start point
+--    -> Point2   -- ^start point
-    -> Point2   -- ^point in direction
+--    -> Point2   -- ^point in direction
-    -> IM.IntMap Wall 
+--    -> IM.IntMap Wall 
-    -> Float
+--    -> Float
-{-# INLINE collideDirectionIndirect #-}
+--{-# INLINE collideDirectionIndirect #-}
-collideDirectionIndirect d p1 p2 wls
+--collideDirectionIndirect d p1 p2 wls
-    = fromMaybe d
+--    = fromMaybe d
-    $
+--    $
-    ( L.fold
+--    ( L.fold
-    . L.prefilter wlIsOpaque
+--    . L.prefilter wlIsOpaque
-    . L.premapMaybe (fmap (dist p1) . uncurry (intersectSegSeg p1 p3) . _wlLine)
+--    . L.premapMaybe (fmap (dist p1) . uncurry (intersectSegSeg p1 p3) . _wlLine)
-    ) L.minimum 
+--    ) L.minimum 
-    wls
+--    wls
-  where
+--  where
-    p3 = p1 +.+ d *.* safeNormalizeV (p2 -.- p1)
+--    p3 = p1 +.+ d *.* safeNormalizeV (p2 -.- p1)
 
 wlIsOpaque :: Wall -> Bool
 wlIsOpaque wl = _wlOpacity wl == Opaque
 
-collidePointUpToIndirect
+--collidePointUpToIndirect
-    :: Point2   -- ^start point
+--    :: Point2   -- ^start point
-    -> Point2   -- ^end point
+--    -> Point2   -- ^end point
-    -> IM.IntMap Wall 
+--    -> IM.IntMap Wall 
-    -> Point2
+--    -> Point2
-{-# INLINE collidePointUpToIndirect #-}
+--{-# INLINE collidePointUpToIndirect #-}
-collidePointUpToIndirect p1 p2 = foldr f p2 . IM.filter wlIsOpaque
+--collidePointUpToIndirect p1 p2 = foldr f p2 . IM.filter wlIsOpaque
-  where
+--  where
-    f wl x = fromMaybe x . uncurry (intersectSegSeg p1 x) $ _wlLine wl
+--    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. 
+--{- | 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. -}
+-- - Not sure if this needs vision as well, need to make this uniform. -}
-collidePointFire :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Point2
+--collidePointFire :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Point2
-collidePointFire p1 p2 ws 
+--collidePointFire p1 p2 ws 
-    = safeMinimumOn (dist p1) 
+--    = safeMinimumOn (dist p1) 
-    . IM.mapMaybe ( uncurry (intersectSegSeg p1 p2) . _wlLine ) 
+--    . IM.mapMaybe ( uncurry (intersectSegSeg p1 p2) . _wlLine ) 
-    $ IM.filter (\wl -> not (_wlFireThrough wl) || wlIsOpaque wl) ws
+--    $ IM.filter (\wl -> not (_wlFireThrough wl) || wlIsOpaque wl) ws
-{- | Checks to see whether someone can fire bullets effectively between two points. 
+--{- | 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. -}
+-- - Not sure if this needs vision as well, need to make this uniform. -}
-collidePointFireVision :: Point2 -> Point2 -> IM.IntMap Wall -> Bool
+--collidePointFireVision :: Point2 -> Point2 -> IM.IntMap Wall -> Bool
-collidePointFireVision p1 p2 ws 
+--collidePointFireVision p1 p2 ws 
-    = any ( isJust . uncurry (intersectSegSeg p1 p2) . _wlLine) 
+--    = any ( isJust . uncurry (intersectSegSeg p1 p2) . _wlLine) 
-    $ IM.filter theTest ws
+--    $ IM.filter theTest ws
-  where 
+--  where 
-    theTest wl = not (_wlFireThrough wl) || wlIsOpaque wl
+--    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 :: Int -> Point2 -> World -> Bool
-canSeePoint i p w = hasLOS p1 p w
+--canSeePoint i p w = hasLOS p1 p w
-  where
+--  where
-    p1 = _crPos (_creatures w IM.! i)
+--    p1 = _crPos (_creatures w IM.! i)
 
-pathToPointFireable :: Int -> Point2 -> World -> Bool
+--pathToPointFireable :: Int -> Point2 -> World -> Bool
-pathToPointFireable i p w 
+--pathToPointFireable i p w 
-    = not 
+--    = not 
-    . pointHitsWalls (_crPos $ _creatures w IM.! i) p
+--    . pointHitsWalls (_crPos $ _creatures w IM.! i) p
-    $ IM.filter (not . _wlFireThrough ) $ wallsAlongLine p1 p w
+--    $ IM.filter (not . _wlFireThrough ) $ wallsAlongLine p1 p w
-  where 
+--  where 
-    p1 = _crPos (_creatures w IM.! i)
+--    p1 = _crPos (_creatures w IM.! i)
 
-canSeePointAll :: Int -> Point2 -> World -> Bool
+--canSeePointAll :: Int -> Point2 -> World -> Bool
-canSeePointAll i targPos w 
+--canSeePointAll i targPos w 
-    = all (flip (canSeePoint i) w . (\p -> targPos +.+ radius *.* p) . toV2) [(1,0),(0,1),(-1,0),(0,-1)]
+--    = all (flip (canSeePoint i) w . (\p -> targPos +.+ radius *.* p) . toV2) [(1,0),(0,1),(-1,0),(0,-1)]
-  where 
+--  where 
-    cr = _creatures w IM.! i
+--    cr = _creatures w IM.! i
-    radius = _crRad cr
+--    radius = _crRad cr
 
-canSeeAny :: Int -> Int -> World -> Bool
+--canSeeAny :: Int -> Int -> World -> Bool
-canSeeAny fromID toID w 
+--canSeeAny fromID toID w 
-    = any (flip (canSeePoint fromID) w . (\p -> cpos +.+ radius *.* p) . toV2) [(1,0),(0,1),(-1,0),(0,-1)]
+--    = any (flip (canSeePoint fromID) w . (\p -> cpos +.+ radius *.* p) . toV2) [(1,0),(0,1),(-1,0),(0,-1)]
-  where 
+--  where 
-    cr = _creatures w IM.! toID
+--    cr = _creatures w IM.! toID
-    cpos = _crPos cr
+--    cpos = _crPos cr
-    radius = _crRad cr
+--    radius = _crRad cr
 
-canSeeAll :: Int -> Int -> World -> Bool
+--canSeeAll :: Int -> Int -> World -> Bool
-canSeeAll fromID toID w 
+--canSeeAll fromID toID w 
-    = all (flip (canSeePoint fromID) w . (\p -> cpos +.+ radius *.* p) . toV2) [(1,0),(0,1),(-1,0),(0,-1)]
+--    = all (flip (canSeePoint fromID) w . (\p -> cpos +.+ radius *.* p) . toV2) [(1,0),(0,1),(-1,0),(0,-1)]
-  where 
+--  where 
-    cr = _creatures w IM.! toID
+--    cr = _creatures w IM.! toID
-    cpos = _crPos cr
+--    cpos = _crPos cr
-    radius = _crRad cr
+--    radius = _crRad cr
 
-canWalk :: Int -> Int -> World -> Bool
+--canWalk :: Int -> Int -> World -> Bool
-canWalk i j w = not $ collidePointWalkable ipos jpos $ wallsAlongLine ipos jpos w
+--canWalk i j w = not $ collidePointWalkable ipos jpos $ wallsAlongLine ipos jpos w
-  where 
+--  where 
-    ipos = _crPos (_creatures w IM.! i)
+--    ipos = _crPos (_creatures w IM.! i)
-    jpos = _crPos (_creatures w IM.! j)
+--    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 :: Point2 -> Point2 -> World -> Bool
-canSeeFire p p' w = not $ collidePointFireVision p p' $ wallsAlongLine p p' w
+--canSeeFire p p' w = not $ collidePointFireVision p p' $ wallsAlongLine p p' w
 
-canSeeFireVision :: Int -> Int -> World -> Bool
+--canSeeFireVision :: Int -> Int -> World -> Bool
-canSeeFireVision i j w = canSeeFire ipos jpos w
+--canSeeFireVision i j w = canSeeFire ipos jpos w
-  where 
+--  where 
-    ipos = _crPos (_creatures w IM.! i)
+--    ipos = _crPos (_creatures w IM.! i)
-    jpos = _crPos (_creatures w IM.! j)
+--    jpos = _crPos (_creatures w IM.! j)
-{- | Test whether both of the outside lines between two creatures are blocked -}
+--{- | Test whether both of the outside lines between two creatures are blocked -}
-canSeeFireVisionAny :: Int -> Int -> World -> Bool
+--canSeeFireVisionAny :: Int -> Int -> World -> Bool
-canSeeFireVisionAny i j w 
+--canSeeFireVisionAny i j w 
-    = not 
+--    = not 
-    $ collidePointFireVision (ipos +.+ ni) (jpos +.+ nj) 
+--    $ collidePointFireVision (ipos +.+ ni) (jpos +.+ nj) 
-        (wallsAlongLine (ipos +.+ ni) (jpos +.+ nj) w)
+--        (wallsAlongLine (ipos +.+ ni) (jpos +.+ nj) w)
-    && collidePointFireVision (ipos -.- ni) (jpos -.- nj) 
+--    && collidePointFireVision (ipos -.- ni) (jpos -.- nj) 
-        (wallsAlongLine (ipos -.- ni) (jpos -.- nj) w)
+--        (wallsAlongLine (ipos -.- ni) (jpos -.- nj) w)
-  where
+--  where
-    icr = _creatures w IM.! i
+--    icr = _creatures w IM.! i
-    jcr = _creatures w IM.! j
+--    jcr = _creatures w IM.! j
-    ipos = _crPos icr
+--    ipos = _crPos icr
-    jpos = _crPos jcr
+--    jpos = _crPos jcr
-    n = normalizeV $ vNormal $ ipos -.- jpos
+--    n = normalizeV $ vNormal $ ipos -.- jpos
-    ni = _crRad icr *.* n
+--    ni = _crRad icr *.* n
-    nj = _crRad jcr *.* n
+--    nj = _crRad jcr *.* n
-{- | Test whether either of the outside lines between two creatures are blocked -}
+--{- | Test whether either of the outside lines between two creatures are blocked -}
-canSeeFireVisionAll :: Int -> Int -> World -> Bool
+--canSeeFireVisionAll :: Int -> Int -> World -> Bool
-canSeeFireVisionAll i j w 
+--canSeeFireVisionAll i j w 
-    = not 
+--    = not 
-    $ collidePointFireVision (ipos +.+ ni) (jpos +.+ nj) 
+--    $ collidePointFireVision (ipos +.+ ni) (jpos +.+ nj) 
-        (wallsAlongLine (ipos +.+ ni) (jpos +.+ nj) w)
+--        (wallsAlongLine (ipos +.+ ni) (jpos +.+ nj) w)
-    || collidePointFireVision (ipos -.- ni) (jpos -.- nj) 
+--    || collidePointFireVision (ipos -.- ni) (jpos -.- nj) 
-        (wallsAlongLine (ipos -.- ni) (jpos -.- nj) w)
+--        (wallsAlongLine (ipos -.- ni) (jpos -.- nj) w)
-  where
+--  where
-    icr = _creatures w IM.! i
+--    icr = _creatures w IM.! i
-    jcr = _creatures w IM.! j
+--    jcr = _creatures w IM.! j
-    ipos = _crPos icr
+--    ipos = _crPos icr
-    jpos = _crPos jcr
+--    jpos = _crPos jcr
-    n = normalizeV $ vNormal $ ipos -.- jpos
+--    n = normalizeV $ vNormal $ ipos -.- jpos
-    ni = _crRad icr *.* n
+--    ni = _crRad icr *.* n
-    nj = _crRad jcr *.* n
+--    nj = _crRad jcr *.* n

src/Dodge/Data.hs

@@ -538,6 +538,7 @@ data Prop
         }
     | LinearShockwave 
         { _prDraw :: Prop -> SPic
+        , _pjPos :: Point2
         , _pjID :: Int
         , _pjUpdate :: Prop -> World -> World
         , _pjPoints :: [(Point2,Point2)]

src/Dodge/Debug/Picture.hs

@@ -66,3 +66,4 @@ intersectLinefromScreen w a b = listToMaybe
     . mapMaybe (\(x,y) -> intersectSegLineFrom x y b (b +.+ b -.- a))
     . loopPairs 
     $ screenPolygon w
+

src/Dodge/Item/Weapon/Booster.hs

@@ -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)]

src/Dodge/LevelGen.hs

@@ -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'

src/Dodge/LevelGen/Block.hs

@@ -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

src/Dodge/Render.hs

@@ -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

src/Dodge/Render/Picture.hs

@@ -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 _ = []
 

src/Dodge/Render/ShapePicture.hs

@@ -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 Shape
---import Picture
+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 
+floorItemSPic flit = uncurryV translateSPf (_flItPos 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)