Move towards resolving picture rendering bug

The bug concerns a mutable vector storing the amount of data that has
been poked.

src/Dodge/Render/Label.hs

@@ -20,6 +20,7 @@ drawPointLabel p =
 
 drawCrossCol :: Color -> Point2 -> Picture
 drawCrossCol col p = setLayer DebugLayer . color col . uncurryV translate p $ crossPic 5
+--drawCrossCol col p = mempty
 
 drawCross :: Point2 -> Picture
 drawCross = drawCrossCol red

src/Dodge/Render/Picture.hs

@@ -149,7 +149,7 @@ drawQuitTerminal x =
         <> polygonWire (square x)
 
 drawEmptySet :: Float -> Picture
-drawEmptySet x = line [V2 x x, V2 (- x) (- x)] <> circle x
+drawEmptySet x = line [V2 x x, -(V2 x x)] <> circle x
 
 drawReturn :: Float -> Picture
 drawReturn x =

src/Dodge/Render/ShapePicture.hs

@@ -1,12 +1,6 @@
 --{-# LANGUAGE LambdaCase #-}
 module Dodge.Render.ShapePicture (worldSPic) where
 
-import Dodge.DoubleTree
-import Dodge.Data.DoubleTree
-import Dodge.HeldUse
-import NewInt
-import Dodge.Item.Grammar
-import Dodge.Render.Label
 import Dodge.Debug
 import Control.Lens
 import Data.Foldable
@@ -27,30 +21,31 @@ import ShapePicture
 
 worldSPic :: Config -> Universe -> SPic
 worldSPic cfig u =
-    (mempty :!: extraPics cfig u)
-        <> foldup propSPic (filtOn _prPos _props)
-        <> foldMap' debrisSPic (filtOn' (xyV3 . _dbPos) _debris)
-        <> foldup drawProjectile (filtOn (^. pjPos . _xy) _projectiles)
-        <> foldup drawPulseBall (filtOn _pbPos _pulseBalls)
-        <> foldup (shiftDraw _blPos _blDir (const drawBlock)) (filtOn _blPos _blocks)
-        <> foldMap' (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn' _fsPos _foreShapes)
-        <> foldup (drawCreature (lw ^. items)) (filtOn (^. crPos . _xy) _creatures)
-        <> foldup
-            (Prelude.uncurry floorItemSPic)
-            ( IM.intersectionWith
-                (,)
-                (lw ^. items)
-                (filtOn _flItPos _floorItems)
-            )
-        <> foldup btSPic (filtOn _btPos _buttons)
-        <> foldup (mcSPic (w ^. cWorld)) (filtOn _mcPos _machines)
-        <> foldMap' drawChasm (w ^. cWorld . chasms)
-        <> w ^. cWorld . lWorld . tempSPic
-        <> testSPic cfig u
+--    (mempty :!: extraPics cfig u)
+--        <> foldup propSPic (filtOn _prPos _props)
+--        <> foldMap' debrisSPic (filtOn' (xyV3 . _dbPos) _debris)
+--        <> foldup drawProjectile (filtOn (^. pjPos . _xy) _projectiles)
+--        <> foldup drawPulseBall (filtOn _pbPos _pulseBalls)
+--        <> foldup (shiftDraw _blPos _blDir (const drawBlock)) (filtOn _blPos _blocks)
+--        <> foldMap' (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn' _fsPos _foreShapes)
+--        <> foldup (drawCreature (lw ^. items)) (filtOn (^. crPos . _xy) _creatures)
+--        <> foldup
+--            (Prelude.uncurry floorItemSPic)
+--            ( IM.intersectionWith
+--                (,)
+--                (lw ^. items)
+--                (filtOn _flItPos _floorItems)
+--            )
+--        <> foldup btSPic (filtOn _btPos _buttons)
+--        <> foldup (mcSPic (w ^. cWorld)) (filtOn _mcPos _machines)
+--        <> foldMap' drawChasm (w ^. cWorld . chasms)
+--        <> w ^. cWorld . lWorld . tempSPic
+--        <> 
+          testSPic cfig u
   where
     w = u ^. uvWorld
     lw = w ^. cWorld . lWorld
-    foldup = foldMap'
+    --foldup = foldMap'
     filtOn f g = IM.filter (pointIsClose . f) (g lw)
     filtOn' f g = filter (pointIsClose . f) (g lw)
     pointIsClose = cullPoint cfig w
@@ -59,18 +54,24 @@ testSPic :: Config -> Universe -> SPic
 testSPic cfig u = noShape $ testPic cfig u
 
 testPic :: Config -> Universe -> Picture
-testPic _ u = fold $ do
-    cr <- u ^? uvWorld . cWorld . lWorld . creatures . ix 0
---    return mempty
-    invid <- cr ^? crManipulation . manObject . imRootSelectedItem . unNInt
-    loc <- invIndents ((\k -> u ^?! uvWorld . cWorld . lWorld . items . ix k) <$> _crInv cr) 
-        ^? ix invid . _2
-    return . color red $ setLayer DebugLayer $ reduceLocDT (f cr) loc
-  where
-    f cr loc = foldMap g $ map (muzzlePos loc cr)  (itemMuzzles $ loc ^. locDT . dtValue . _1)
-      where
-        g :: Point3Q -> Picture
-        g pq = translate3 (pq ^. _1) $ crossPic 5
+testPic _ _ = setLayer DebugLayer 
+    $ mempty
+--    <> color white (line [0,10])
+--    <> text "A"
+    <> translate 20 20 (arc pi 0 10)
+    <> translate 0 20 (circleSolidCol white red 10)
+--    fold $ do
+--    cr <- u ^? uvWorld . cWorld . lWorld . creatures . ix 0
+----    return mempty
+--    invid <- cr ^? crManipulation . manObject . imRootSelectedItem . unNInt
+--    loc <- invIndents ((\k -> u ^?! uvWorld . cWorld . lWorld . items . ix k) <$> _crInv cr) 
+--        ^? ix invid . _2
+--    return . color red $ setLayer DebugLayer $ reduceLocDT (f cr) loc
+--  where
+--    f cr loc = foldMap g $ map (muzzlePos loc cr)  (itemMuzzles $ loc ^. locDT . dtValue . _1)
+--      where
+--        g :: Point3Q -> Picture
+--        g pq = translate3 (pq ^. _1) $ crossPic 5
 
 
 drawBlock :: Block -> SPic