Cleanup

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)