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
+