Cleanup

src/Dodge/DisplayInventory.hs

@@ -47,31 +47,13 @@ updateCombineSections w cfig =
         (getAvailableListLines secondColumnParams cfig)
         [(0, sclose), (-1, sfclose)]
   where
-    (sfclose,sclose) = filterSectionsPair (flip (andOrRegex $ regexCombs invitms))
-        allcombs "COMBINATIONS" $ mstr
+    (sfclose, sclose) =
+        filterSectionsPair
+            (flip . andOrRegex $ regexCombs invitms)
+            (IM.fromDistinctAscList . zip [0 ..] $ combineList w)
+            "COMBINATIONS"
+            $ w ^? hud . hudElement . subInventory . ciFilter . _Just
     invitms = fromMaybe mempty $ w ^? hud . hudElement . diSections . ix 0 . ssItems
-    allcombs = IM.fromDistinctAscList $ zip [0 ..] $ combineList w
---    filtcombs = fromMaybe allcombs $ do
---        str <- mstr
---        invitms <- w ^? hud . hudElement . diSections . ix 0 . ssItems
---        return $ IM.filter (flip (andOrRegex $ regexCombs invitms) str) allcombs
---    showncombs
---        | null filtcombs =
---            IM.singleton 0 $
---                SelectionInfo ["No possible combinations"] 1 False white 0
---        | otherwise = filtcombs
---    filterdisplay = fromMaybe mempty $ do
---        str <- mstr
---        return $
---            IM.singleton 0 $
---                SelectionInfo
---                    ["COMBINATIONS FILTER: " ++ str, numfiltitems]
---                    2
---                    True
---                    white
---                    0
-    mstr = w ^? hud . hudElement . subInventory . ciFilter . _Just
---    numfiltitems = "  " ++ show (length allcombs - length filtcombs) ++ " FILTERED"
 
 regexCombs :: IM.IntMap (SelectionItem ()) -> SelectionItem CombinableItem -> String -> Bool
 regexCombs inv ci str = case str of
@@ -113,21 +95,20 @@ updateDisplaySections w cfig =
         Just (0, _) -> reverse [filtinv, filtclose, invx, youx, closex]
         Just (1, _) -> reverse [filtinv, filtclose, invx, youx, closex]
         Just (2, _) -> reverse [filtinv, filtclose, closex, invx, youx]
-        _ -> reverse [filtinv, filtclose, closex, invx, youx]
-    (sfinv,sinv) = filterSectionsPair plainRegex invitems "INVTORY" $
+        Just (3, _) -> reverse [filtinv, filtclose, closex, invx, youx]
+        _ -> reverse [filtinv, filtclose, invx, closex, youx]
+    (sfinv, sinv) =
+        filterSectionsPair plainRegex invitems "INVENTORY" $
             w ^? hud . hudElement . diInvFilter . _Just
-    (filtinv, invx) = ((-1,sfinv),(0,sinv))
---        filtpair (-1) invitems "INV. " $
---            w ^? hud . hudElement . diInvFilter . _Just
-    (sfclose,sclose) = filterSectionsPair plainRegex coitems "NEARBY" $
+    (filtinv, invx) = ((-1, sfinv), (0, sinv))
+    (sfclose, sclose) =
+        filterSectionsPair plainRegex closeitms "NEARBY" $
             w ^? hud . hudElement . diCloseFilter . _Just
-    (filtclose, closex) = ((2,sfclose),(3,sclose))
---        filtpair 2 coitems "NEARBY " $
---            w ^? hud . hudElement . diCloseFilter . _Just
+    (filtclose, closex) = ((2, sfclose), (3, sclose))
     youx = (1, youitems)
     youitems = IM.singleton 0 $ SelectionItem [thetext] 1 True invDimColor 2 ()
-    thetext = displayFreeSlots nfreeslots
-    coitems =
+    thetext = displayFreeSlots (crNumFreeSlots cr)
+    closeitms =
         IM.fromDistinctAscList . zip [0 ..] $
             map closeObjectToSelectionItem (w ^. hud . closeObjects)
     invitems =
@@ -135,7 +116,7 @@ updateDisplaySections w cfig =
             (\k (y, x) -> invSelectionItem y cr k (x ^. locLDT . ldtValue))
             (allInvLocs $ _crInv cr)
     cr = you w
-    nfreeslots = crNumFreeSlots cr
+
 --    filtpair i itms filtdescription mstr =
 --        ( (i, filtsis)
 --        , (i + 1, itms')

src/Dodge/Render/Picture.hs

@@ -2,6 +2,7 @@ module Dodge.Render.Picture (
     fixedCoordPictures,
 ) where
 
+import Control.Monad
 import Control.Lens
 import Data.Maybe
 import Dodge.Base.Coordinate
@@ -18,30 +19,31 @@ fixedCoordPictures :: Universe -> Picture
 fixedCoordPictures u =
     drawMenuOrHUD cfig u
         <> drawConcurrentMessage u
-        <> customMouseCursor u
+        <> drawMouseCursor u
         <> toTopLeft cfig (translate (halfWidth cfig) 0 $ drawList (map text (_uvTestString u u)))
-        <> toTopLeft cfig 
-            (translate (0.5 * halfWidth cfig) (- halfHeight cfig) 
-                $ drawList $ map text $ 
-                    show (u ^. uvWorld . cWorld . lWorld . lTestInt)
-                        : (u ^. uvWorld . cWorld . lWorld . lTestString)
+        <> toTopLeft
+            cfig
+            ( translate (0.5 * halfWidth cfig) (- halfHeight cfig) $
+                drawList $
+                    map text $
+                        show (u ^. uvWorld . cWorld . lWorld . lTestInt) :
+                        (u ^. uvWorld . cWorld . lWorld . lTestString)
             )
         <> displayFrameTicks u
+        <> aimDelaySweep (u ^. uvWorld)
   where
     cfig = _uvConfig u
 
 displayFrameTicks :: Universe -> Picture
-displayFrameTicks u =
-    if debugOn Show_ms_frame $ _uvConfig u
-        then
-            setDepth (-1)
-                . translate (-10) (- halfHeight (_uvConfig u) + 6)
-                . scale 0.2 0.2
-                $ fpsText (u ^. uvFrameTicks - u ^. uvLastFrameTicks)
-        else mempty
+displayFrameTicks u
+    | debugOn Show_ms_frame $ _uvConfig u =
+            translate (-10) (- halfHeight (_uvConfig u) + 6)
+            . scale 0.2 0.2
+            $ fpsText (u ^. uvFrameTicks - u ^. uvLastFrameTicks)
+    | otherwise = mempty
 
 fpsText :: (Show a, Ord a, Num a) => a -> Picture
-fpsText x = color col $ text $ "ms/frame " ++ show x
+fpsText x = color col . text $ "ms/frame " ++ show x
   where
     col
         | x < 22 = blue
@@ -58,15 +60,15 @@ drawMenuOrHUD cfig u = case u ^. uvScreenLayers of
 drawConcurrentMessage :: Universe -> Picture
 drawConcurrentMessage u =
     translate 0 (50 - halfHeight cfig) $
-    stackPicturesAt
-        (map (centerText . f) $ u ^.. uvSideEffects . each)
+        stackPicturesAt
+            (map (centerText . f) $ u ^.. uvSideEffects . each)
   where
     cfig = _uvConfig u
     f (RunningSideEffect ce) = ce ++ " IN PROGRESS"
     f x = _ceString x ++ " QUEUED"
 
-customMouseCursor :: Universe -> Picture
-customMouseCursor u =
+drawMouseCursor :: Universe -> Picture
+drawMouseCursor u =
     uncurryV translate (u ^. uvWorld . input . mousePos)
         . color white
         $ mouseCursorType u
@@ -74,7 +76,7 @@ customMouseCursor u =
 mouseCursorType :: Universe -> Picture
 mouseCursorType u
     | null (u ^. uvScreenLayers) = rotate a (drawPlus 5)
-    | otherwise = mousePlus
+    | otherwise = drawPlus 5
   where
     w = u ^. uvWorld
     a = fromMaybe 0 $ do
@@ -83,8 +85,32 @@ mouseCursorType u
             argV (mouseWorldPos (w ^. input) (w ^. wCam) -.- cpos)
                 - w ^. wCam . camRot
 
-mousePlus :: Picture
-mousePlus = fold [line [V2 (-5) 0, V2 5 0], line [V2 0 (-5), V2 0 5]]
-
 drawPlus :: Float -> Picture
 drawPlus x = fold [line [V2 (- x) 0, V2 x 0], line [V2 0 (- x), V2 0 x]]
+
+aimDelaySweep :: World -> Picture
+aimDelaySweep w = fromMaybe mempty $ do
+    cr <- w ^? cWorld . lWorld . creatures . ix 0
+    aimstatus <- cr ^? crStance . posture
+    guard (aimstatus == Aiming)
+    return $ drawSweep cr w
+
+drawSweep :: Creature -> World -> Picture
+drawSweep cr w = fromMaybe mempty $ do
+    a <- safeArgV (mwp -.- p)
+    let a'
+            | a - cdir > pi = cdir + 2 * pi
+            | a - cdir < - pi = cdir - 2 * pi
+            | otherwise = cdir
+    return $
+        setLayer FixedCoordLayer $
+            uncurryV translate (worldPosToScreen campos p) $
+                arcFull (a - rot) 10 white (a' - rot) 1 white (5 + dist mwp p * campos ^. camZoom) white
+  where
+    cdir = _crDir cr
+    rot = campos ^. camRot
+    p = _crPos cr
+    campos = w ^. wCam
+    theinput = w ^. input
+    mwp = mouseWorldPos theinput campos
+

src/Dodge/Render/ShapePicture.hs

@@ -2,11 +2,8 @@ module Dodge.Render.ShapePicture (
     worldSPic,
 ) where
 
-import qualified Data.Map.Strict as M
 import Control.Lens
-import Control.Monad (guard)
 import Data.Foldable
-import Data.Maybe
 import Data.Strict.Tuple
 import Dodge.Base
 import Dodge.Creature.Picture
@@ -20,7 +17,6 @@ import Geometry
 import qualified IntMapHelp as IM
 import NewInt
 import Picture
-import qualified SDL
 import Shape
 import ShapePicture
 
@@ -36,49 +32,12 @@ worldSPic cfig u =
         <> foldup floorItemSPic (filtOn _flItPos (_unNIntMap . _floorItems))
         <> foldup btSPic (filtOn _btPos _buttons)
         <> foldup mcSPic (filtOn _mcPos _machines)
-        <> aimDelaySweep w
-        <> drawMouseSelection w
   where
     w = _uvWorld u
     foldup = foldMap'
     filtOn f g = IM.filter (pointIsClose . f) (g (_lWorld (_cWorld w)))
     pointIsClose = cullPoint cfig w
 
-drawMouseSelection :: World -> SPic
-drawMouseSelection w = fromMaybe mempty $ do
-    guard (SDL.ButtonLeft `M.member` (w ^. input . mouseButtons)
-        && not (SDL.ButtonRight `M.member` (w ^. input . mouseButtons))
-        )
-    p <- w ^? input . clickPos . ix SDL.ButtonLeft
-    return $ noShape $ color (withAlpha 0.5 white) 
-        $ setLayer FixedCoordLayer $ polygon $ reverse $ rectVV p (w ^. input . mousePos)
-
-aimDelaySweep :: World -> SPic
-aimDelaySweep w = fromMaybe mempty $ do
-    cr <- w ^? cWorld . lWorld . creatures . ix 0
-    aimstatus <- cr ^? crStance . posture
-    guard (aimstatus == Aiming)
-    return $ noShape $ drawSweep cr w
-
-drawSweep :: Creature -> World -> Picture
-drawSweep cr w = fromMaybe mempty $ do
-    a <- safeArgV (mwp -.- p)
-    let a'
-            | a - cdir > pi = cdir + 2 * pi
-            | a - cdir < - pi = cdir - 2 * pi
-            | otherwise = cdir
-    return $
-        setLayer FixedCoordLayer $
-            uncurryV translate (worldPosToScreen campos p) $
-                arcFull (a - rot) 10 white (a' - rot) 1 white (5 + dist mwp p * campos ^. camZoom) white
-  where
-    cdir = _crDir cr
-    rot = campos ^. camRot
-    p = _crPos cr
-    campos = w ^. wCam
-    theinput = w ^. input
-    mwp = mouseWorldPos theinput campos
-
 drawCreature :: Creature -> SPic
 drawCreature cr = case _crType cr of
     Humanoid{} -> basicCrPict cr
@@ -138,7 +97,6 @@ extraPics cfig u =
         <> foldMap drawBlip (_radarBlips lw)
         <> _flares lw
         <> foldMap (dbArg (drawLightSource . _lsPict)) (_lightSources lw)
-        <> testPic cfig w
         <> foldMap ppDraw (_pressPlates lw)
         <> viewClipBounds cfig w
         <> debugDraw cfig w
@@ -156,9 +114,6 @@ extraPics cfig u =
     w = u ^. uvWorld
     lw = w ^. cWorld . lWorld
 
-testPic :: Configuration -> World -> Picture
-testPic _ _ = mempty
-
 ppDraw :: PressPlate -> Picture
 ppDraw c = uncurryV translate (_ppPos c) $ rotate (_ppRot c) (_ppPict c)