Refactor, try to limit dependencies

src/Dodge/Render/HUD.hs

@@ -1,53 +1,48 @@
 --{-# LANGUAGE TupleSections #-}
-module Dodge.Render.HUD
-    ( hudDrawings
-    ) where
-import Dodge.WorldPos
-import Dodge.Data
-import Dodge.Tweak.Show
-import Dodge.Item.Display
-import Dodge.Combine
-import Dodge.Clock
+module Dodge.Render.HUD (
+    hudDrawings,
+) where
+
+import Control.Lens
+import qualified Data.Map.Strict as M
+import Data.Maybe
+import qualified Data.Text as T
+import qualified Data.Vector as V
 import Dodge.Base
---import Dodge.InputFocus
---import Dodge.Combine.Combinations
+import Dodge.Clock
+import Dodge.Combine
+import Dodge.Data.Universe
 import Dodge.Inventory
 import Dodge.Inventory.ItemSpace
+import Dodge.Item.Display
 import Dodge.Render.Connectors
 import Dodge.Render.List
-import Picture
+import Dodge.Tweak.Show
+import Dodge.WorldPos
 import Geometry
-import Padding
-import ListHelp
-
-import qualified Data.Vector as V
---import Data.Foldable
-import Data.Maybe
 import qualified IntMapHelp as IM
-import qualified Data.Map.Strict as M
---import qualified Data.Set as S
---import qualified Data.IntSet as IS
-import Control.Lens
+import ListHelp
+import Padding
+import Picture
 import SDL (MouseButton (..))
-import qualified Data.Text as T
---import Data.List
---import Data.Bifunctor
 
 hudDrawings :: Universe -> Picture
 hudDrawings uv = case _hudElement $ _hud (_cWorld w) of
     DisplayCarte -> drawCarte cfig w
-    DisplayInventory subinv -> drawInGameHUD uv
-        <> subInventoryDisplay subinv cfig w
+    DisplayInventory subinv ->
+        drawInGameHUD uv
+            <> subInventoryDisplay subinv cfig w
   where
     w = _uvWorld uv
     cfig = _uvConfig uv
 
 drawInGameHUD :: Universe -> Picture
-drawInGameHUD uv = pictures
-    [ winScale cfig . dShadCol white $ displayHP 0 cfig w
-    , listPicturesAt (halfWidth cfig) 0 cfig $ map text (_uvTestString uv uv)
-    , inventoryDisplay cfig w
-    ]
+drawInGameHUD uv =
+    pictures
+        [ winScale cfig . dShadCol white $ displayHP 0 cfig w
+        , listPicturesAt (halfWidth cfig) 0 cfig $ map text (_uvTestString uv uv)
+        , inventoryDisplay cfig w
+        ]
   where
     w = _uvWorld uv
     cfig = _uvConfig uv
@@ -57,13 +52,14 @@ inventoryDisplay cfig w = listPicturesAt 0 0 cfig invlist
   where
     cr = you w
     inv = _crInv cr
-    invlist = concatMap (itemText' cr) (IM.toList inv)
-        ++ displayFreeSlots
-        ++ concatMap (closeObjectToTextPictures nfreeslots) (_closeObjects (_cWorld w))
---        ++ map floorItemsColor (concatMap (closeObjectToTextPictures nfreeslots) (_closeObjects w))
---    floorItemsColor = case _hudElement (_hud w) of
---        DisplayInventory NoSubInventory -> id
---        _ -> color invDimColor
+    invlist =
+        concatMap (itemText' cr) (IM.toList inv)
+            ++ displayFreeSlots
+            ++ concatMap (closeObjectToTextPictures nfreeslots) (_closeObjects (_cWorld w))
+    --        ++ map floorItemsColor (concatMap (closeObjectToTextPictures nfreeslots) (_closeObjects w))
+    --    floorItemsColor = case _hudElement (_hud w) of
+    --        DisplayInventory NoSubInventory -> id
+    --        _ -> color invDimColor
     nfreeslots = crNumFreeSlots cr
     displayFreeSlots = case nfreeslots of
         0 -> [color invDimColor . text $ "  INVENTORY FULL"]
@@ -73,58 +69,72 @@ inventoryDisplay cfig w = listPicturesAt 0 0 cfig invlist
 subInventoryDisplay :: SubInventory -> Configuration -> World -> Picture
 subInventoryDisplay subinv cfig w = case subinv of
     LockedInventory -> mempty -- topInvCursor col cursPos cfig w
-    NoSubInventory -> pictures
-        [ selcursor
-        , closeobjectcursor
-        , equipcursors
-        , equipcursor -- the order is important, this should go on top of the other equipcursors
-        , rboptions
-        ]
-    TweakInventory mtweaki -> pictures
-        --[ mCurs it cfig w
-        [ selcursor' listCursorNESW
---        , cursorsZ cfig curpos it
-        , fromMaybe mempty $ do
-            tweaki <-  mtweaki
+    NoSubInventory ->
+        pictures
+            [ selcursor
+            , closeobjectcursor
+            , equipcursors
+            , equipcursor -- the order is important, this should go on top of the other equipcursors
+            , rboptions
+            ]
+    TweakInventory mtweaki ->
+        pictures
+            --[ mCurs it cfig w
+            [ selcursor' listCursorNESW
+            , --        , cursorsZ cfig curpos it
+              fromMaybe mempty $ do
+                tweaki <- mtweaki
                 -- consider moving this functionality out into a tweaks module
-            tparam <- it ^? _Just . itTweaks . tweakParams . ix tweaki
-            return $ lnkMidInvSel cfig w curpos tweaki
-                <> listCursorNSW subInvX 60 cfig tweaki white (length $ showTweak tparam) 1
-        , invHead cfig "TWEAK"
-        , listPicturesAt subInvX 60 cfig $ map text (ammoTweakStrings it)
-        ]
+                tparam <- it ^? _Just . itTweaks . tweakParams . ix tweaki
+                return $
+                    lnkMidInvSel cfig w curpos tweaki
+                        <> listCursorNSW subInvX 60 cfig tweaki white (length $ showTweak tparam) 1
+            , invHead cfig "TWEAK"
+            , listPicturesAt subInvX 60 cfig $ map text (ammoTweakStrings it)
+            ]
     DisplayTerminal tid -> displayTerminal tid cfig w
-    CombineInventory mi -> pictures
-        [ invHead cfig "COMBINE"
-        , listPicturesAt subInvX 60 cfig $ combineListStringPictures w
-        , fromMaybe mempty $ do
-            i   <- mi
-            cpos  <- combinePoss w !? i
-            col   <- (combineItemListYou w !? i) <&> _itInvColor . snd
-            return $ pictures
-                [ fromMaybe mempty $ do
-                    strs  <- fmap (fst . snd) (combineListInfo w !? i)
-                    return $ listPicturesAtOff (subInvX + 150) 60 cfig cpos $ map (color red . text) strs
-                , fromMaybe mempty $ do
-                    csize <- combineSizes w !? i
-                    return $ listCursorNSW subInvX 60 cfig cpos col 15 csize
-                , fromMaybe mempty $ do
-                    lnks <- map fst (combineItemListYou w) !? i
-                    return $ lnkMidPosInvSelsCol cfig w cpos col lnks
-                        <> foldMap (topCursorTypeWidth listCursorNESW (topInvW +2) cfig w) lnks
-                        <> combineCounts cfig w lnks
-                ]
-        ]
-    InspectInventory -> mconcat
-        [ selcursor' listCursorNESW
-        , invHead cfig "INSPECT"
-        , listPicturesAt subInvX 60 cfig $ map text (itmInfo it)
-        ]
-  where 
+    CombineInventory mi ->
+        pictures
+            [ invHead cfig "COMBINE"
+            , listPicturesAt subInvX 60 cfig $ combineListStringPictures w
+            , fromMaybe mempty $ do
+                i <- mi
+                cpos <- combinePoss w !? i
+                col <- (combineItemListYou w !? i) <&> _itInvColor . snd
+                return $
+                    pictures
+                        [ fromMaybe mempty $ do
+                            strs <- fmap (fst . snd) (combineListInfo w !? i)
+                            return $ listPicturesAtOff (subInvX + 150) 60 cfig cpos $ map (color red . text) strs
+                        , fromMaybe mempty $ do
+                            csize <- combineSizes w !? i
+                            return $ listCursorNSW subInvX 60 cfig cpos col 15 csize
+                        , fromMaybe mempty $ do
+                            lnks <- map fst (combineItemListYou w) !? i
+                            return $
+                                lnkMidPosInvSelsCol cfig w cpos col lnks
+                                    <> foldMap (topCursorTypeWidth listCursorNESW (topInvW + 2) cfig w) lnks
+                                    <> combineCounts cfig w lnks
+                        ]
+            ]
+    InspectInventory ->
+        mconcat
+            [ selcursor' listCursorNESW
+            , invHead cfig "INSPECT"
+            , listPicturesAt subInvX 60 cfig $ map text (itmInfo it)
+            ]
+  where
     closeobjectcursor = case selectedCloseObject w of
         Nothing -> mempty
-        Just (i,co) -> listCursorNS 
-            clObjFloatIn 0 cfig (selNumPos i w) (closeObjectCol co) topInvW (invSelSize i w)
+        Just (i, co) ->
+            listCursorNS
+                clObjFloatIn
+                0
+                cfig
+                (selNumPos i w)
+                (closeObjectCol co)
+                topInvW
+                (invSelSize i w)
     itcol = fromMaybe (greyN 0.5) (it ^? _Just . itInvColor)
     cr = you w
     it = yourItem w
@@ -134,15 +144,16 @@ subInventoryDisplay subinv cfig w = case subinv of
         | ButtonRight `M.member` _mouseButtons w = listCursorNESW
         | otherwise = listCursorNSW
     curpos = invSelPos w
-    cury   = fromMaybe 1 $ augmentedInvSizes w IM.!? crSel (you w)
+    cury = fromMaybe 1 $ augmentedInvSizes w IM.!? crSel (you w)
     equipcursor = case _crLeftInvSel cr of
         Just invid -> f cyan invid (_crInvEquipped cr IM.! invid)
         _ -> mempty
     equipcursors = IM.foldMapWithKey (f yellow) (_crInvEquipped cr)
     f col invid epos = listTextPictureAt 144 0 cfig (selNumPos invid w) . color col $ text $ eqPosText epos
-    rboptions = if ButtonRight `M.member` _mouseButtons w
-        then drawRBOptions cfig w (_rbOptions w)
-        else mempty
+    rboptions =
+        if ButtonRight `M.member` _mouseButtons w
+            then drawRBOptions cfig w (_rbOptions w)
+            else mempty
 
 itmInfo :: Maybe Item -> [String]
 itmInfo mit = fromMaybe [] $ do
@@ -152,38 +163,40 @@ itmInfo mit = fromMaybe [] $ do
 displayTerminal :: Int -> Configuration -> World -> Picture
 displayTerminal tid cfig w = fromMaybe mempty $ do
     tm <- w ^? cWorld . terminals . ix tid
-    return $ pictures
-        [ invHead cfig (_tmTitle tm ++ ":T" ++ show tid)
-        , renderListAt subInvX 60 cfig 
-            . displayTermInput tm
-            . reverse 
-            . take (_tmMaxLines tm) 
-            $ _tmDisplayedLines tm
-        ]
+    return $
+        pictures
+            [ invHead cfig (_tmTitle tm ++ ":T" ++ show tid)
+            , renderListAt subInvX 60 cfig
+                . displayTermInput tm
+                . reverse
+                . take (_tmMaxLines tm)
+                $ _tmDisplayedLines tm
+            ]
   where
     displayTermInput tm = case _tmInput tm of
-        TerminalInput s hasfoc _ -> (++ [(displayInputText tm s++displayBlinkCursor hasfoc,white)])
+        TerminalInput s hasfoc _ -> (++ [(displayInputText tm s ++ displayBlinkCursor hasfoc, white)])
     displayInputText tm s
-        | _tmStatus tm == TerminalReady = '>':T.unpack s
+        | _tmStatus tm == TerminalReady = '>' : T.unpack s
         | otherwise = ""
-    displayBlinkCursor hasfoc | hasfoc = clockCycle 10 (V.fromList ["_",""]) w
+    displayBlinkCursor hasfoc
+        | hasfoc = clockCycle 10 (V.fromList ["_", ""]) w
         | otherwise = []
 
 drawRBOptions :: Configuration -> World -> RightButtonOptions -> Picture
-drawRBOptions cfig w EquipOptions{_opEquip = es,_opSel=i, _opAllocateEquipment=ae} = 
-  listPicturesAtOff 342 0 cfig (curpos-i) (map (text . eqPosText) es)
-  <> case ae of
-    DoNotMoveEquipment -> mempty
-    PutOnEquipment {}
-        -> midtext "PUT ONTO"
-    MoveEquipment {}
-        -> midtext "MOVE  TO" <> extratext []
-    SwapEquipment { _allocOldPos = oldp, _allocSwapID = sid }
-        -> midtext "MOVE  TO" <> extratext ("SWAPS "++otheritem sid ++ " ONTO " ++eqPosText oldp)
-    ReplaceEquipment { _allocRemoveID = rid }
-        -> midtext "PUT ONTO" <> extratext ("REMOVES " ++ otheritem rid)
-    RemoveEquipment { }
-        -> midtext "TAKE OFF"
+drawRBOptions cfig w EquipOptions{_opEquip = es, _opSel = i, _opAllocateEquipment = ae} =
+    listPicturesAtOff 342 0 cfig (curpos - i) (map (text . eqPosText) es)
+        <> case ae of
+            DoNotMoveEquipment -> mempty
+            PutOnEquipment{} ->
+                midtext "PUT ONTO"
+            MoveEquipment{} ->
+                midtext "MOVE  TO" <> extratext []
+            SwapEquipment{_allocOldPos = oldp, _allocSwapID = sid} ->
+                midtext "MOVE  TO" <> extratext ("SWAPS " ++ otheritem sid ++ " ONTO " ++ eqPosText oldp)
+            ReplaceEquipment{_allocRemoveID = rid} ->
+                midtext "PUT ONTO" <> extratext ("REMOVES " ++ otheritem rid)
+            RemoveEquipment{} ->
+                midtext "TAKE OFF"
   where
     midtext str = listTextPictureAt 252 0 cfig curpos (text str)
     extratext str = listTextPictureAt 432 0 cfig curpos (text (str ++ deactivatetext))
@@ -196,13 +209,13 @@ drawRBOptions _ _ _ = mempty
 
 eqPosText :: EquipPosition -> String
 eqPosText ep = case ep of
-    OnHead          -> "HEAD"
-    OnChest         -> "CHEST"
-    OnBack          -> "BACK"
-    OnLeftWrist     -> "L.WRIST"
-    OnRightWrist    -> "R.WRIST"
-    OnLegs          -> "LEGS"
-    OnSpecial       -> "EQUIPPED"
+    OnHead -> "HEAD"
+    OnChest -> "CHEST"
+    OnBack -> "BACK"
+    OnLeftWrist -> "L.WRIST"
+    OnRightWrist -> "R.WRIST"
+    OnLegs -> "LEGS"
+    OnSpecial -> "EQUIPPED"
 
 topInvW :: Int
 topInvW = 15
@@ -211,19 +224,20 @@ subInvX :: Float
 subInvX = 9 * fromIntegral topInvW + 50
 
 lnkMidInvSel :: Configuration -> World -> Int -> Int -> Picture
-lnkMidInvSel cfig w lefti midi = winScale cfig
-    . color white 
-    . zConnect rp $ selNumMidHeight cfig w lefti
+lnkMidInvSel cfig w lefti midi =
+    winScale cfig
+        . color white
+        . zConnect rp
+        $ selNumMidHeight cfig w lefti
   where
---    lp ipos = V2 (150 - hw) ( hh - (20 * fromIntegral ipos + 17.5))
-    rp = V2 (190 - hw) ( hh - (20 * fromIntegral midi + 77.5))
+    --    lp ipos = V2 (150 - hw) ( hh - (20 * fromIntegral ipos + 17.5))
+    rp = V2 (190 - hw) (hh - (20 * fromIntegral midi + 77.5))
     hh = halfHeight cfig
-    hw = halfWidth  cfig
-    
+    hw = halfWidth cfig
 
 --lnkMidPosInvSels :: Configuration -> World -> Int -> [Int] -> Picture
---lnkMidPosInvSels cfig w i = winScale cfig 
---    . color white 
+--lnkMidPosInvSels cfig w i = winScale cfig
+--    . color white
 --    . concatMap (zConnect rp . selNumMidHeight cfig w)
 --  where
 ----    lp ipos = V2 (150 - hw) ( hh - (20 * fromIntegral ipos + 17.5))
@@ -234,32 +248,38 @@ lnkMidInvSel cfig w lefti midi = winScale cfig
 combineCounts :: Configuration -> World -> [Int] -> Picture
 combineCounts cfig w = winScale cfig . foldMap f . group
   where
-    f (i:is) = case yourInv w ^? ix i . itUse . useAmount of
-        Just _ -> color (selNumCol i w) $ uncurryV translate (selNumTextPos cfig w i) . scale 0.1 0.1 . text $ ('-': show (length is + 1))
+    f (i : is) = case yourInv w ^? ix i . itUse . useAmount of
+        Just _ -> color (selNumCol i w) $ uncurryV translate (selNumTextPos cfig w i) . scale 0.1 0.1 . text $ ('-' : show (length is + 1))
         _ -> mempty
     f _ = mempty
 
 lnkMidPosInvSelsCol :: Configuration -> World -> Int -> Color -> [Int] -> Picture
-lnkMidPosInvSelsCol cfig w i col = winScale cfig 
-    . foldMap (\j -> zConnectCol rp (V2 18 0+selNumMidHeight cfig w j) col white white (selNumCol j w))
+lnkMidPosInvSelsCol cfig w i col =
+    winScale cfig
+        . foldMap (\j -> zConnectCol rp (V2 18 0 + selNumMidHeight cfig w j) col white white (selNumCol j w))
   where
---    lp ipos = V2 (150 - hw) ( hh - (20 * fromIntegral ipos + 17.5))
-    rp = V2 (190 - hw) ( hh - (20 * fromIntegral i + 77.5))
+    --    lp ipos = V2 (150 - hw) ( hh - (20 * fromIntegral ipos + 17.5))
+    rp = V2 (190 - hw) (hh - (20 * fromIntegral i + 77.5))
     hh = halfHeight cfig
-    hw = halfWidth  cfig
+    hw = halfWidth cfig
 
-topCursorTypeWidth ::  (Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture)
-    -> Int
-    -> Configuration -> World -> Int -> Picture
-topCursorTypeWidth ctype width cfig w i 
-    = ctype 0 0 cfig (selNumPos i w) (selNumCol i w) width (selNumSlots i w)
+topCursorTypeWidth ::
+    (Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture) ->
+    Int ->
+    Configuration ->
+    World ->
+    Int ->
+    Picture
+topCursorTypeWidth ctype width cfig w i =
+    ctype 0 0 cfig (selNumPos i w) (selNumCol i w) width (selNumSlots i w)
 
 determineInvSelCursorWidth :: World -> Int
 determineInvSelCursorWidth w = case _rbOptions w of
     NoRightButtonOptions -> topInvW
-    EquipOptions {} -> if ButtonRight `M.member` _mouseButtons w
-        then 47
-        else topInvW
+    EquipOptions{} ->
+        if ButtonRight `M.member` _mouseButtons w
+            then 47
+            else topInvW
 
 --listSelHeight :: Configuration -> World -> Int -> Float
 --listSelHeight
@@ -278,74 +298,77 @@ tweakString :: TweakParam -> String
 tweakString tp = rightPad 12 ' ' (show $ _tweakType tp) ++ " " ++ showTweak tp
 
 invHead :: Configuration -> String -> Picture
-invHead cfig s = winScale cfig 
-    . translate (-halfWidth cfig + subInvX + 20) (halfHeight cfig - 40) 
-    . dShadCol white
-    . scale 0.4 0.4
-    $ text s
+invHead cfig s =
+    winScale cfig
+        . translate (- halfWidth cfig + subInvX + 20) (halfHeight cfig - 40)
+        . dShadCol white
+        . scale 0.4 0.4
+        $ text s
 
 invDimColor :: Color
 invDimColor = greyN 0.7
+
 closeObjectToTextPictures :: Int -> Either FloorItem Button -> [Picture]
 closeObjectToTextPictures nfreeslots e = case e of
     Left flit -> let it = _flIt flit in map (applycolor it . textindent) $ itemDisplay it
-    Right bt  -> [color yellow $ textindent $ _btText bt]
+    Right bt -> [color yellow $ textindent $ _btText bt]
   where
-    textindent = text . (replicate clObjIntIn ' '++)
+    textindent = text . (replicate clObjIntIn ' ' ++)
     applycolor it
         | nfreeslots >= itSlotsTaken it = color $ _itInvColor it
         | otherwise = color invDimColor
 
 clObjIntIn :: Int
 clObjIntIn = 2
+
 clObjFloatIn :: Float
 clObjFloatIn = fromIntegral clObjIntIn * 9
 
-
 drawCarte :: Configuration -> World -> Picture
-drawCarte cfig w = pictures $ 
-    renderListAt 0 0 cfig locs
-    : zipWith bConnect (displayListEndCoords cfig locTexts) locPoss
-    ++ mapOverlay cfig w
-    ++ [mainListCursor white iPos cfig]
+drawCarte cfig w =
+    pictures $
+        renderListAt 0 0 cfig locs :
+        zipWith bConnect (displayListEndCoords cfig locTexts) locPoss
+            ++ mapOverlay cfig w
+            ++ [mainListCursor white iPos cfig]
   where
     iPos = _selLocation (_cWorld w)
-    locs = map (\(_,s) -> (s,white)) . IM.elems . _seenLocations $ _cWorld w
+    locs = map (\(_, s) -> (s, white)) . IM.elems . _seenLocations $ _cWorld w
     locPoss = map (cartePosToScreen cfig w . ($ w) . doWorldPos . fst) . IM.elems . _seenLocations $ _cWorld w
     locTexts = map fst locs
 
 displayListEndCoords :: Configuration -> [String] -> [Point2]
-displayListEndCoords cfig ss = map (doWindowScale cfig) $ zipWith h ss $ map f [1..]
-  where 
+displayListEndCoords cfig ss = map (doWindowScale cfig) $ zipWith h ss $ map f [1 ..]
+  where
     f :: Int -> Point2
-    f i = V2 ( 15 - halfWidth cfig ) ( 2.5 + halfHeight cfig - (20 * fromIntegral i))
+    f i = V2 (15 - halfWidth cfig) (2.5 + halfHeight cfig - (20 * fromIntegral i))
     h :: String -> Point2 -> Point2
     h s (V2 x y) = V2 (x + 9 * fromIntegral (length s)) y
 
-
 mapOverlay :: Configuration -> World -> [Picture]
-mapOverlay cfig w = (color (withAlpha 0.5 black) . polygon $ reverse $ rectNSWE 1 (-1) 1 (-1)) : 
-            (mapMaybe (mapWall cfig w) . IM.elems $ _walls (_cWorld w))
+mapOverlay cfig w =
+    (color (withAlpha 0.5 black) . polygon $ reverse $ rectNSWE 1 (-1) 1 (-1)) :
+    (mapMaybe (mapWall cfig w) . IM.elems $ _walls (_cWorld w))
 
 mapWall :: Configuration -> World -> Wall -> Maybe Picture
 mapWall cfig w wl =
     if _wlSeen wl
-    then Just . color c . polygon $ map (cartePosToScreen cfig w) [x,x +.+ n2,y +.+ n2, y]
-    else Nothing
-  where 
+        then Just . color c . polygon $ map (cartePosToScreen cfig w) [x, x +.+ n2, y +.+ n2, y]
+        else Nothing
+  where
     t = normalizeV (y -.- x)
     n2 = 20 *.* vNormal t
-    (x,y) = _wlLine wl
+    (x, y) = _wlLine wl
     c = _wlColor wl
 
-
 --selectedCloseObjectLink :: Configuration -> World -> Picture
 --selectedCloseObjectLink cfig w = mempty
 
-{- | Pictures of popup text for items close to your position.-}
+-- | Pictures of popup text for items close to your position.
+
 --closeObjectTexts :: Configuration -> World -> Picture
---closeObjectTexts cfig w = pictures $ 
---    renderListAt pushout (negate 20 * fromIntegral invPos) cfig (map colAndText $ _closeObjects w) 
+--closeObjectTexts cfig w = pictures $
+--    renderListAt pushout (negate 20 * fromIntegral invPos) cfig (map colAndText $ _closeObjects w)
 --    : maybeToList maybeLine
 --  where
 --    colAndText (Left x)  = ( _itName $ _flIt x, _itInvColor $ _flIt x)
@@ -358,11 +381,11 @@ mapWall cfig w wl =
 --    maybeLeft (Left x) = Just x
 --    maybeLeft _  = Nothing
 --    pushout = 120
---    objPos obj = case obj of 
+--    objPos obj = case obj of
 --        Left flit -> _flItPos flit
 --        Right bt  -> _btPos bt
 --    mayScreenPos = fmap (worldPosToScreen w . objPos) mayObj
---    maybeLine = do 
+--    maybeLine = do
 --          itScreenPos <- mayScreenPos
 --          (theText,col) <- fmap colAndText mayObj
 --          let textWidth = 9 * fromIntegral (length theText)
@@ -373,9 +396,9 @@ mapWall cfig w wl =
 mainListCursor :: Color -> Int -> Configuration -> Picture
 mainListCursor c = openCursorAt 120 c 5 0
 
-itemText' :: Creature -> (Int,Item) -> [Picture]
+itemText' :: Creature -> (Int, Item) -> [Picture]
 {-# INLINE itemText' #-}
-itemText' cr (i,it) = f $ case _itCurseStatus it of
+itemText' cr (i, it) = f $ case _itCurseStatus it of
     UndroppableIdentified -> map (color yellow . text) (itemDisplay it)
     _ | crSel cr == i -> map (color thecolor . text) (selectedItemDisplay cr it)
     _ -> map (color thecolor . text) (itemDisplay it)
@@ -383,40 +406,44 @@ itemText' cr (i,it) = f $ case _itCurseStatus it of
     thecolor = _itInvColor it
     f = take (itSlotsTaken it) . (++ replicate 10 (color (_itInvColor it) $ text "*"))
 
-
-
 itemText :: Item -> [Picture]
 {-# INLINE itemText #-}
 itemText it = f $ case _itCurseStatus it of
     UndroppableIdentified -> map (color yellow . text) (itemDisplay it)
---        <> color (withAlpha 0.9 thecolor) (polygon (rectNSEW 110 (-65) 885 (-90)))
+    --        <> color (withAlpha 0.9 thecolor) (polygon (rectNSEW 110 (-65) 885 (-90)))
     _ -> map (color thecolor . text) (itemDisplay it)
   where
     thecolor = _itInvColor it
     f = take (itSlotsTaken it) . (++ replicate 10 (color (_itInvColor it) $ text "*"))
 
-openCursorAt 
-    :: Float    -- ^ Width
-    -> Color
-    -> Float    -- ^ x offset
-    -> Float    -- ^ y offset
-    -> Int      -- ^ y offset (discrete)
-    -> Configuration 
-    -> Picture
-openCursorAt wth col xoff yoff yint w = winScale w
-    . translate (xoff-halfWidth w) (halfHeight w - (20* fromIntegral yint + yoff) - 20)
-    $ lineCol 
-        [(V2  wth 12.5  ,withAlpha 0 col)
-        ,(V2  0   12.5  ,col)
-        ,(V2  0   (-7.5),col)
-        ,(V2  wth (-7.5),withAlpha 0 col)
-        ]
+openCursorAt ::
+    -- | Width
+    Float ->
+    Color ->
+    -- | x offset
+    Float ->
+    -- | y offset
+    Float ->
+    -- | y offset (discrete)
+    Int ->
+    Configuration ->
+    Picture
+openCursorAt wth col xoff yoff yint w =
+    winScale w
+        . translate (xoff - halfWidth w) (halfHeight w - (20 * fromIntegral yint + yoff) - 20)
+        $ lineCol
+            [ (V2 wth 12.5, withAlpha 0 col)
+            , (V2 0 12.5, col)
+            , (V2 0 (-7.5), col)
+            , (V2 wth (-7.5), withAlpha 0 col)
+            ]
 
 displayHP :: Int -> Configuration -> World -> Picture
-displayHP cid cfig w = translate (halfWidth cfig-80) (halfHeight cfig-20) 
-    . scale 0.2 0.2 
-    . text
-    . leftPad 5 ' ' 
-    . show
-    . _crHP 
-    $ _creatures (_cWorld w) IM.! cid
+displayHP cid cfig w =
+    translate (halfWidth cfig -80) (halfHeight cfig -20)
+        . scale 0.2 0.2
+        . text
+        . leftPad 5 ' '
+        . show
+        . _crHP
+        $ _creatures (_cWorld w) IM.! cid

src/Dodge/Render/InfoBox.hs

@@ -1,29 +1,26 @@
 module Dodge.Render.InfoBox where
-import Dodge.Data
---import Dodge.Base.Window
---import Dodge.Base.WinScale
+
+import Dodge.Base
+import Dodge.Data.Universe
 import Dodge.Render.Connectors
 import Dodge.Render.List
-import Dodge.Base
-import Picture
 import Geometry
+import Picture
 
---import qualified Control.Foldl as L
---import Control.Monad
---import Data.Maybe
-
-renderInfoListAt :: Float -> Float -> Configuration -> World -> (Point2,[String]) -> Picture
-renderInfoListAt x y cfig w (p,ss) = renderListAt x y cfig (zip ss (repeat white))
-    <> winScale cfig (color white $ lConnect (V2 (x-hw) (hh-25-y)) (worldPosToScreen w p))
-    <> listCursorNSW x y cfig 0 white 19 (length ss)
+renderInfoListAt :: Float -> Float -> Configuration -> World -> (Point2, [String]) -> Picture
+renderInfoListAt x y cfig w (p, ss) =
+    renderListAt x y cfig (zip ss (repeat white))
+        <> winScale cfig (color white $ lConnect (V2 (x - hw) (hh -25 - y)) (worldPosToScreen w p))
+        <> listCursorNSW x y cfig 0 white 19 (length ss)
   where
     hw = halfWidth cfig
     hh = halfHeight cfig
 
-renderInfoListsAt :: Float -> Float -> Configuration -> World -> [(Point2,[String])] -> Picture
-renderInfoListsAt x y cfig w = 
-    fst . foldr f (mempty,0)
+renderInfoListsAt :: Float -> Float -> Configuration -> World -> [(Point2, [String])] -> Picture
+renderInfoListsAt x y cfig w =
+    fst . foldr f (mempty, 0)
   where
-    f (p,ss) (pic,offset) = (pic <> renderInfoListAt x (y + offset) cfig w (p,ss)
+    f (p, ss) (pic, offset) =
+        ( pic <> renderInfoListAt x (y + offset) cfig w (p, ss)
         , offset + 20 * fromIntegral (length ss)
         )

src/Dodge/Render/Lights.hs

@@ -1,27 +1,27 @@
-module Dodge.Render.Lights
-    ( lightsToRender
-    ) where
-import Dodge.Data
---import Dodge.CullBox
-import Geometry
+module Dodge.Render.Lights (
+    lightsToRender,
+) where
 
 import Data.Maybe
+import Dodge.Data.Universe
+import Geometry
 import qualified IntMapHelp as IM
 
-lightsToRender :: Configuration -> World -> [(Point3,Float,Point3)]
-lightsToRender cfig w = mapMaybe getLS (IM.elems $ _lightSources (_cWorld w)) 
-    ++ mapMaybe getTLS (_tempLightSources (_cWorld w))
-  where 
-    getLS  = getlsparam . _lsParam
-    getTLS = getlsparam . _tlsParam 
+lightsToRender :: Configuration -> World -> [(Point3, Float, Point3)]
+lightsToRender cfig w =
+    mapMaybe getLS (IM.elems $ _lightSources (_cWorld w))
+        ++ mapMaybe getTLS (_tempLightSources (_cWorld w))
+  where
+    getLS = getlsparam . _lsParam
+    getTLS = getlsparam . _tlsParam
     cbox = _boundBox (_cWorld w)
     cpos = _cameraCenter (_cWorld w)
     getlsparam ls
         | not (pointInPolygon lpos cbox) && extraculltest = Nothing
-        | otherwise = Just ( _lsPos ls,  rad^(2::Int) , _lsCol ls)
+        | otherwise = Just (_lsPos ls, rad ^ (2 :: Int), _lsCol ls)
       where
         lpos = xyV3 $ _lsPos ls
-        rad  = _lsRad ls
+        rad = _lsRad ls
         extraculltest
             | debugOn Cull_more_lights cfig = True
             | otherwise = isNothing (intersectSegPolyFirst lpos (lpos +.+ rad *.* normalizeV (cpos -.- lpos)) cbox)

src/Dodge/Render/List.hs

@@ -1,12 +1,12 @@
 module Dodge.Render.List where
-import Dodge.Data
-import Dodge.Base.Window
-import Dodge.Base.WinScale
-import Picture
-import Geometry
---import Control.Monad
-import Data.Maybe
+
 import Data.Foldable
+import Data.Maybe
+import Dodge.Base.WinScale
+import Dodge.Base.Window
+import Dodge.Data.Universe
+import Geometry
+import Picture
 
 -- given a list of pictures that are each the size of a "text" call, displays them as
 -- a list on the screen
@@ -14,62 +14,72 @@ listPicturesAt :: Float -> Float -> Configuration -> [Picture] -> Picture
 listPicturesAt tx ty cfig = listPicturesAtOff tx ty cfig 0
 
 listPicturesAtOff :: Float -> Float -> Configuration -> Int -> [Picture] -> Picture
-listPicturesAtOff tx ty cfig i = mconcat . zipWith (listTextPictureAt tx ty cfig) [i..]
+listPicturesAtOff tx ty cfig i = mconcat . zipWith (listTextPictureAt tx ty cfig) [i ..]
 
 -- displays a cursor that should match up to list text pictures
 -- the width of a character appears to be 9(?!)
 -- this is probably because it is 8 pixels plus one for the border
 listCursorChooseBorder :: [Bool] -> Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
-listCursorChooseBorder borders xoff yoff cfig yint col cursxsize cursysize = winScale cfig
-    . translate (6+xoff-halfWidth cfig) 
-        (halfHeight cfig + 12.5 - (20* fromIntegral yint + yoff + 20 + hgt))
-    . color col
-    $ chooseCursorBorders wth hgt borders
+listCursorChooseBorder borders xoff yoff cfig yint col cursxsize cursysize =
+    winScale cfig
+        . translate
+            (6 + xoff - halfWidth cfig)
+            (halfHeight cfig + 12.5 - (20 * fromIntegral yint + yoff + 20 + hgt))
+        . color col
+        $ chooseCursorBorders wth hgt borders
   where
     x = 9
-    wth =  x * fromIntegral cursxsize + 9
+    wth = x * fromIntegral cursxsize + 9
     hgt = 20 * fromIntegral cursysize
+
 -- note we cannot simply scale lines because they are drawn as solid rectangles
 chooseCursorBorders :: Float -> Float -> [Bool] -> Picture
-chooseCursorBorders wth hgt = fold . catMaybes . zipWith f
-    [ line [V2   0 hgt , V2 wth hgt ] 
-    , line [V2 wth hgt , V2 wth   0 ] 
-    , line [V2 wth   0 , V2   0   0 ]
-    , line [V2   0   0 , V2   0 hgt ] 
-    ]
+chooseCursorBorders wth hgt =
+    fold . catMaybes
+        . zipWith
+            f
+            [ line [V2 0 hgt, V2 wth hgt]
+            , line [V2 wth hgt, V2 wth 0]
+            , line [V2 wth 0, V2 0 0]
+            , line [V2 0 0, V2 0 hgt]
+            ]
   where
     f _ False = Nothing
-    f a True  = Just a
+    f a True = Just a
 
 listCursorNS :: Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
-listCursorNS = listCursorChooseBorder [True,False,True]
+listCursorNS = listCursorChooseBorder [True, False, True]
 
 listCursorNES :: Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
-listCursorNES = listCursorChooseBorder [True,True,True]
+listCursorNES = listCursorChooseBorder [True, True, True]
 
 listCursorNESW :: Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
-listCursorNESW = listCursorChooseBorder [True,True,True,True]
+listCursorNESW = listCursorChooseBorder [True, True, True, True]
 
 listCursorNSW :: Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
-listCursorNSW = listCursorChooseBorder [True,False,True,True]
+listCursorNSW = listCursorChooseBorder [True, False, True, True]
 
 listTextPictureAt :: Float -> Float -> Configuration -> Int -> Picture -> Picture
-listTextPictureAt xoff yoff cfig yint = winScale cfig
-    . translate (xoff + 15 - hw) (negate yoff + hh - (20 * (fromIntegral yint+1)))
-    . scale 0.1 0.1
+listTextPictureAt xoff yoff cfig yint =
+    winScale cfig
+        . translate (xoff + 15 - hw) (negate yoff + hh - (20 * (fromIntegral yint + 1)))
+        . scale 0.1 0.1
   where
-    hw = halfWidth  cfig
+    hw = halfWidth cfig
     hh = halfHeight cfig
 
-renderListAt :: Float -> Float -> Configuration -> [(String,Color)] -> Picture
-renderListAt tx ty cfig = listPicturesAt tx ty cfig . map (\(str,col) -> color col $ text str)
+renderListAt :: Float -> Float -> Configuration -> [(String, Color)] -> Picture
+renderListAt tx ty cfig = listPicturesAt tx ty cfig . map (\(str, col) -> color col $ text str)
+
 --    concatMapPic (winScale cfig) . zipWith (listPairAt tx ty cfig) [0..]
 
 --TODO put the following functions in an appropriate place
-{- | Colour picture and add black drop shadow. -}
+
+-- | Colour picture and add black drop shadow.
 dShadCol :: Color -> Picture -> Picture
 {-# INLINE dShadCol #-}
-dShadCol c p = pictures
-    [ color black $ translate 1.2 (-1.2) p
-    , color c p
-    ]
+dShadCol c p =
+    pictures
+        [ color black $ translate 1.2 (-1.2) p
+        , color c p
+        ]

src/Dodge/Render/MenuScreen.hs

@@ -1,23 +1,23 @@
 {- The menu picture.  -}
-module Dodge.Render.MenuScreen
-    ( menuScreen
-    ) where
-import Dodge.Data
-import Dodge.WindowLayout
-import Dodge.Base.Window
-import Picture
-import Dodge.Menu
-import Padding
+module Dodge.Render.MenuScreen (
+    menuScreen,
+) where
 
 import qualified Data.Text as T
+import Dodge.Base.Window
+import Dodge.Data.Universe
+import Dodge.Menu
+import Dodge.WindowLayout
+import Padding
+import Picture
 
 menuScreen :: Universe -> ScreenLayer -> Picture
 menuScreen w screen = case screen of
-    OptionScreen {_scTitle = titf, _scOptions = mos, _scOptionsOffset = off} 
-                            -> drawOptions w (titf w) mos off "Use keys to navigate the menu"
-    (WaitScreen sf _)       -> drawOptions w (sf w) [] 0 ""
-    (InputScreen inputstr help)    -> drawOptions w ('>':T.unpack inputstr) [] 0 help
-    (DisplayScreen sd )     -> sd w
+    OptionScreen{_scTitle = titf, _scOptions = mos, _scOptionsOffset = off} ->
+        drawOptions w (titf w) mos off "Use keys to navigate the menu"
+    (WaitScreen sf _) -> drawOptions w (sf w) [] 0 ""
+    (InputScreen inputstr help) -> drawOptions w ('>' : T.unpack inputstr) [] 0 help
+    (DisplayScreen sd) -> sd w
     (ColumnsScreen titf pairs) -> drawTwoColumnsScreen (_uvConfig w) (titf w) pairs
 
 --displayStringList :: World -> [String] -> Picture
@@ -30,40 +30,48 @@ menuScreen w screen = case screen of
 --    ys = [0,22..]
 --    f y s = translate (10-hw) y . scale 0.15 0.15 $ text s
 
-drawTwoColumnsScreen :: Configuration -> String -> [(String,String)] -> Picture
-drawTwoColumnsScreen cfig title lps = pictures
-    [darkenBackground cfig
-    ,drawTitle cfig title
-    ,drawTwoColumns cfig lps
-    ]
+drawTwoColumnsScreen :: Configuration -> String -> [(String, String)] -> Picture
+drawTwoColumnsScreen cfig title lps =
+    pictures
+        [ darkenBackground cfig
+        , drawTitle cfig title
+        , drawTwoColumns cfig lps
+        ]
 
-drawTwoColumns :: Configuration -> [(String,String)] -> Picture
-drawTwoColumns cfig lps = pictures $ zipWith f [hh-100,hh-130..] lps
+drawTwoColumns :: Configuration -> [(String, String)] -> Picture
+drawTwoColumns cfig lps = pictures $ zipWith f [hh -100, hh -130 ..] lps
   where
-    f y (s1,s2) = placeString (50-hw) y 0.15 $ rightPad ln '.' s1 ++ s2
+    f y (s1, s2) = placeString (50 - hw) y 0.15 $ rightPad ln '.' s1 ++ s2
     hh = halfHeight cfig
-    hw = halfWidth  cfig
+    hw = halfWidth cfig
     ln = maximum (map (length . fst) lps) + 3
-    
-drawOptions 
-    :: Universe
-    -> String       -- ^ Title
-    -> [MenuOption] -- ^ Options
-    -> Int          -- ^ Options offset
-    -> String       -- ^ Help Text
-    -> Picture
-drawOptions u title ops off footer = pictures $
-    [ darkenBackground cfig 
-    , drawTitle cfig title
-    , drawFooterText cfig red footer
-    ] ++
-    zipWith (\s vpos -> placeString (-hw + 50) vpos 0.2 s) 
-        ops''
-        [hh-100,hh-150 ..]
---    ++ [color yellow $ concat [line [V2 (negate hw) (hh-y), V2 hw (hh-y)] | 
---            y <- map (+75) [0,50..hh*2]]
---        ]
+
+drawOptions ::
+    Universe ->
+    -- | Title
+    String ->
+    -- | Options
+    [MenuOption] ->
+    -- | Options offset
+    Int ->
+    -- | Help Text
+    String ->
+    Picture
+drawOptions u title ops off footer =
+    pictures $
+        [ darkenBackground cfig
+        , drawTitle cfig title
+        , drawFooterText cfig red footer
+        ]
+            ++ zipWith
+                (\s vpos -> placeString (- hw + 50) vpos 0.2 s)
+                ops''
+                [hh -100, hh -150 ..]
   where
+    --    ++ [color yellow $ concat [line [V2 (negate hw) (hh-y), V2 hw (hh-y)] |
+    --            y <- map (+75) [0,50..hh*2]]
+    --        ]
+
     maxOptionLength = 3 + maximum (0 : map (optionValueOffset u) ops')
     ops' = case availableMenuLines cfig of
         x | x < length ops -> take (availableMenuLines cfig) (drop off visibleops)
@@ -72,36 +80,39 @@ drawOptions u title ops off footer = pictures $
         x | x < length ops -> map (menuOptionToString u maxOptionLength) ops' ++ ["SPACE: MORE OPTIONS"]
         _ -> map (menuOptionToString u maxOptionLength) ops'
     visibleops = filter notInvisible ops
-    notInvisible InvisibleToggle {} = False
+    notInvisible InvisibleToggle{} = False
     notInvisible _ = True
     hh = halfHeight cfig
-    hw = halfWidth  cfig
+    hw = halfWidth cfig
     cfig = _uvConfig u
 
 optionValueOffset :: Universe -> MenuOption -> Int
 optionValueOffset u mo = case _moString mo u of
     Left _ -> 0
-    Right (s,_) -> length s
+    Right (s, _) -> length s
 
 darkenBackground :: Configuration -> Picture
 darkenBackground = color (withAlpha 0.5 black) . polygon . reverse . screenBox
 
 drawTitle :: Configuration -> String -> Picture
-drawTitle cfig = placeString (-hw + 30) (hh - 50) 0.4
+drawTitle cfig = placeString (- hw + 30) (hh - 50) 0.4
   where
     hh = halfHeight cfig
-    hw = halfWidth  cfig
+    hw = halfWidth cfig
 
-placeString 
-    :: Float -- | x distance from center
-    -> Float -- | y distance from center
-    -> Float -- | scale
-    -> String
-    -> Picture
+placeString ::
+    -- | x distance from center
+    Float ->
+    -- | y distance from center
+    Float ->
+    -- | scale
+    Float ->
+    String ->
+    Picture
 placeString x y sc = color white . translate x y . scale sc sc . text
 
 drawFooterText :: Configuration -> Color -> String -> Picture
-drawFooterText cfig col = color col . placeString (-hw + 30) (-hh+10) 0.1
+drawFooterText cfig col = color col . placeString (- hw + 30) (- hh + 10) 0.1
   where
     hh = halfHeight cfig
     hw = halfWidth cfig
@@ -111,9 +122,9 @@ menuOptionToString w padAmount mo = theKeys ++ optionText
   where
     optionText = case _moString mo w of
         Left s -> s
-        Right (s,t) -> rightPad padAmount '.' s ++ t
+        Right (s, t) -> rightPad padAmount '.' s ++ t
     theKeys = case mo of
-        Toggle  {_moKey = k} -> stc k : ":"
-        Toggle2 {_moKey1 = k1, _moKey2 = k2} -> stc k1 : '/' : stc k2 : ":"
+        Toggle{_moKey = k} -> stc k : ":"
+        Toggle2{_moKey1 = k1, _moKey2 = k2} -> stc k1 : '/' : stc k2 : ":"
         _ -> undefined
     stc = scodeToChar

src/Dodge/Render/Picture.hs

@@ -1,28 +1,29 @@
---{-# LANGUAGE TupleSections #-}
-module Dodge.Render.Picture
-    ( fixedCoordPictures
-    ) where
-import Dodge.Data
---import Dodge.Base.Window
+module Dodge.Render.Picture (
+    fixedCoordPictures,
+) where
+
 import Dodge.Base.WinScale
+import Dodge.Data.Universe
 import Dodge.Render.HUD
 import Dodge.Render.MenuScreen
 import Geometry
 import Picture
 
 fixedCoordPictures :: Universe -> Picture
-fixedCoordPictures u = case _menuLayers u of 
-    [] -> pictures
-        [ hudDrawings u
-        , customMouseCursor cfig w
-        ]
-    (lay:_) -> setDepth (-1) . winScale cfig $ menuScreen u lay
-  where 
+fixedCoordPictures u = case _menuLayers u of
+    [] ->
+        pictures
+            [ hudDrawings u
+            , customMouseCursor cfig w
+            ]
+    (lay : _) -> setDepth (-1) . winScale cfig $ menuScreen u lay
+  where
     w = _uvWorld u
     cfig = _uvConfig u
 
 customMouseCursor :: Configuration -> World -> Picture
-customMouseCursor cfig w = winScale cfig
-    . uncurryV translate (_mousePos w)
-    . color white
-    $ pictures [ line [V2 (-5) 0,V2 5 0] , line [V2 0 (-5),V2 0 5] ]
+customMouseCursor cfig w =
+    winScale cfig
+        . uncurryV translate (_mousePos w)
+        . color white
+        $ pictures [line [V2 (-5) 0, V2 5 0], line [V2 0 (-5), V2 0 5]]

src/Dodge/Render/ShapePicture.hs

@@ -31,8 +31,8 @@ import Dodge.Data.Config
 import Dodge.Render.InfoBox
 import Dodge.Debug.Picture
 import Dodge.Picture.SizeInvariant
-import Dodge.Data
 import Dodge.Zone
+import Dodge.Data.World
 import Dodge.Base
 import Dodge.SoundLogic.LoadSound
 import Dodge.Graph

src/Dodge/Render/ShapePicture.hs.orig

@@ -7,10 +7,9 @@ import Dodge.Config.Data
 import Dodge.Render.InfoBox
 import Dodge.Debug.Picture
 import Dodge.Picture.SizeInvariant
-import Dodge.Data
+import Dodge.Data.World
 import Dodge.Zone
 import Dodge.Base
---import Dodge.Base.Window
 import Dodge.SoundLogic.LoadSound
 import Dodge.Graph
 import Dodge.GameRoom
@@ -18,16 +17,13 @@ import Dodge.Update.Camera
 import Dodge.Item.Draw
 import Dodge.Render.List
 import Dodge.Path
---import Dodge.Zone
 import Geometry
 import Geometry.Zone
 import ShapePicture
 import Picture
 import Sound.Data
 import Geometry.ConvexPoly
---import Dodge.Base.Collide
 
---import Data.Foldable
 import qualified IntMapHelp as IM -- Lazy?
 import qualified Data.Map.Strict as M
 --import qualified Data.Set as Set

src/Dodge/Render/Walls.hs

@@ -1,29 +1,32 @@
-module Dodge.Render.Walls
-    ( wallsToDraw
-    ) where
-import Dodge.Zoning.World
+module Dodge.Render.Walls (
+    wallsToDraw,
+) where
+
+import qualified Control.Foldl as L
+import Control.Lens
+import Dodge.Base.Wall
+import Dodge.Data.World
+import Dodge.Wall.Draw
 import Dodge.Zoning.Base
 import Dodge.Zoning.Wall
-import Dodge.Data
-import Dodge.Wall.Draw
-import Dodge.Base.Wall
+import Dodge.Zoning.World
 import Geometry
 import ShapePicture
 
-import Control.Lens
---import Data.Maybe
-import qualified Control.Foldl as L
-wallsToDraw :: World -> ( [((Point2,Point2),Point4)]  ,[((Point2,Point2),Point4)], SPic )
-wallsToDraw w
-    = ( wls, wins,spic)
+wallsToDraw :: World -> ([((Point2, Point2), Point4)], [((Point2, Point2), Point4)], SPic)
+wallsToDraw w =
+    (wls, wins, spic)
   where
     f wl = (_wlLine wl, _wlColor wl)
-    (wls, wins, spic) = L.fold
-        ((,,)
-        <$> L.prefilter wlOpaqueDraw (L.premap f L.list)
-        <*> L.prefilter wlSeeThroughDraw (L.premap f L.list)
-        <*> L.premap getWallSPic L.mconcat
-        ) (wlsFromIXs w $ zonesExtract (w ^. cWorld . wlZoning) $ zoneOfSight' wlZoneSize w)
+    (wls, wins, spic) =
+        L.fold
+            ( (,,)
+                <$> L.prefilter wlOpaqueDraw (L.premap f L.list)
+                <*> L.prefilter wlSeeThroughDraw (L.premap f L.list)
+                <*> L.premap getWallSPic L.mconcat
+            )
+            (wlsFromIXs w $ zonesExtract (w ^. cWorld . wlZoning) $ zoneOfSight' wlZoneSize w)
+
 --wallsToDraw
 --    :: World
 --    -> ( [((Point2,Point2),Point4)]  ,[((Point2,Point2),Point4)], SPic )
@@ -31,26 +34,26 @@ wallsToDraw w
 --    = ( wls, wins,spic)
 --  where
 --    f wl = (_wlLine wl, _wlColor wl)
---    (wls, wins, spic) = runIdentity $ L.purely S.fold_ 
+--    (wls, wins, spic) = runIdentity $ L.purely S.fold_
 --        ((,,)
 --        <$> L.prefilter wlOpaqueDraw (L.premap f L.list)
 --        <*> L.prefilter wlSeeThroughDraw (L.premap f L.list)
 --        <*> L.premap getWallSPic L.mconcat
 --        ) (S.concat $ S.mapMaybe g $ zoneOfSight wlZoneSize w)
 --    g (V2 i j) = w ^? wlZoning . znObjects . ix i . ix j
-    
+
 wlOpaqueDraw :: Wall -> Bool
 wlOpaqueDraw wl = wlIsOpaque wl && _wlHeight wl == 100
+
 wlSeeThroughDraw :: Wall -> Bool
 wlSeeThroughDraw wl = wlIsSeeThrough wl && _wlHeight wl == 100
 
 getWallSPic :: Wall -> SPic
 getWallSPic wl = case wl ^? wlOpacity . opDraw of
     Nothing -> mempty
-    Just f  -> drawWall f wl
+    Just f -> drawWall f wl
 
 --    (wins,wls) = partition theTest . IM.elems . IM.filter _wlUnshadowed $ wallsDoubleScreen cfig w
 --    theTest wl = case _wlOpacity wl of
 --        Opaque -> False
 --        _ -> True
-