Add distance indicator for forcefield gun

src/Dodge/Creature/Picture.hs

@@ -47,8 +47,8 @@ basicCrPict cr cfig w =
         ]
     )
   where 
-    targetingPic = IM.elems $ IM.mapMaybeWithKey f $ _crInv cr
+    targetingPic = IM.elems $ IM.mapMaybe f $ _crInv cr
-    f invid it = fmap (\g -> g invid it cr cfig w) (it ^? itTargeting . tgDraw)
+    f it = fmap (\g -> g it cr cfig w) (it ^? itTargeting . tgDraw)
 
 drawCrEquipment :: Creature -> SPic
 drawCrEquipment cr = uncurryV translateSPf (_crPos cr) (rotateSP (_crDir cr) $ drawEquipment cr)

src/Dodge/Data.hs

@@ -517,7 +517,7 @@ data Targeting
     | Targeting
         { _tgPos    :: Maybe Point2
         , _tgUpdate :: Item -> Creature -> World -> Targeting -> (World, Targeting)
-        , _tgDraw   :: Int -> Item -> Creature -> Configuration -> World -> Picture
+        , _tgDraw   :: Item -> Creature -> Configuration -> World -> Picture
         , _tgID     :: Maybe Int
         , _tgActive :: Bool
         }

src/Dodge/Item/Weapon/ExtraEffect.hs

@@ -11,6 +11,7 @@ module Dodge.Item.Weapon.ExtraEffect
     , targetRBCreature
     , targetCursor
     , targetLaser
+    , targetDistanceDraw
 --    , rbSetTarget
     ) where
 import Dodge.Data
@@ -28,6 +29,7 @@ import Geometry.Data
 import LensHelp
 import qualified FoldlHelp as L
 import Sound.Data
+import ShortShow
 
 --import Data.Bifunctor
 import Data.Maybe
@@ -75,16 +77,35 @@ targetCursor = defaultTargeting
     & tgUpdate  .~ targetUpdateWith targetCursorUpdate
     & tgDraw    .~ targetSimpleDraw
 
-targetDraw :: (Item -> Picture) -> Int -> Item -> Creature -> Configuration -> World -> Picture
+targetDraw :: (Item -> Picture) -> Item -> Creature -> Configuration -> World -> Picture
-targetDraw f _ it _ cfig w = fromMaybe mempty $ do
+targetDraw f it _ cfig w = fromMaybe mempty $ do
     p <- it ^? itTargeting . tgPos . _Just
     return $ winScale cfig 
         $ setLayer FixedCoordLayer 
         $ color white 
         $ uncurryV translate (worldPosToScreen w p)
         $ f it
-targetSimpleDraw :: Int -> Item -> Creature -> Configuration -> World -> Picture
+targetSimpleDraw :: Item -> Creature -> Configuration -> World -> Picture
 targetSimpleDraw = targetDraw $ const activeTargetCursorPic
+
+targetDistanceDraw :: Item -> Creature -> Configuration -> World -> Picture
+targetDistanceDraw itm _ cfig w = fromMaybe mempty $ do
+    p <- itm ^? itTargeting . tgPos . _Just
+    let p1 = worldPosToScreen w p
+        mwp = mouseWorldPos w
+        p2 = worldPosToScreen w mwp
+    return $ winScale cfig 
+        $ setLayer FixedCoordLayer 
+        $ color white 
+        $ line [p1, p2] 
+            <> translate (20) (f p1 p2) (uncurryV translate (0.5 *.* (p1 +.+ p2)) . scale 0.1 0.1 $ text $ shortShow $ dist p mwp)
+  where
+    f (V2 x y) (V2 x' y') 
+        | y > y' && x > x' = max (-10) (x'-x)
+        | y > y' && x < x' = min 10 (x'-x)
+        | x > x'    = min 10 (x-x')
+        | otherwise = max (-10) (x-x')
+
 targetRBCreatureUp :: Item -> Creature -> World -> Targeting -> (World, Targeting)
 targetRBCreatureUp it cr w t
     | not $ _itIsHeld it = (w, t   
@@ -114,7 +135,7 @@ targetRBCreatureUp it cr w t
         cpos <- w ^? creatures . ix cid . crPos
         Just $ hasLOS cpos (_crPos cr) w
 
-targetRBCreatureDraw :: Int -> Item -> Creature -> Configuration -> World -> Picture
+targetRBCreatureDraw :: Item -> Creature -> Configuration -> World -> Picture
 targetRBCreatureDraw = targetDraw thepic
   where
     thepic it | _tgActive $ _itTargeting it = activeTargetCursorPic

src/Dodge/Item/Weapon/Utility.hs

@@ -147,19 +147,22 @@ forceFieldGun = defaultGun
     , _itUse = ruseInstant useForceFieldGun (HasHammer HammerUp)
         [ hammerCheckI , ammoCheckI , useAmmoAmount 1]
 --    , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-4,-4),(-4,4),(4,4),(4,0),(0,0),(0,-4)]
-    , _itTargeting = targetRBPress
+    , _itTargeting = targetRBPress & tgDraw .~ targetDistanceDraw
     , _itParams = ParamMID Nothing
     }
-
+-- I believe because the targeting returns to nothing straight after you release
+-- the rmb, it is possible for this to do nothing
+-- TODO investigate more and fix
 useForceFieldGun :: Item -> Creature -> World -> World
-useForceFieldGun itm cr w = w
+useForceFieldGun itm cr w = fromMaybe w $ do 
+    a <- _tgPos $ _itTargeting itm
+    let wlline = (a,mouseWorldPos w)
+    return $ w 
         & walls %~ IM.insertWith (\_ x -> x) i forceField {_wlID = i}
         & creatures . ix (_crID cr) . crInv . ix (fromJust (_itInvPos itm)) . itParams . paramMID ?~ i
         & moveWallIDUnsafe i wlline
   where
     i = fromMaybe (IM.newKey (_walls w)) $ itm ^? itParams . paramMID . _Just
-    a = fromJust . _tgPos $ _itTargeting itm
-    wlline = (a,mouseWorldPos w)
 
 -- grapGun = defaultGun 
 --     { _itName = "grapGun"

src/Dodge/Terminal.hs

@@ -108,23 +108,20 @@ getCommandsHelp :: Terminal -> World -> M.Map String [TerminalLine]
 --getCommandsHelp tm w = fromMaybe mempty $ do
 --    tcs <- getCommands tm w
 --    return $ foldr f mempty tcs
-getCommandsHelp tm w = maybe mempty (foldr f mempty) (getCommands tm w)
+getCommandsHelp tm w = foldr f mempty $ getCommands tm
   where
     f tc = M.insert (_tcString tc) 
         ( [makeTermLine "COMMAND:"
-            , makeColorTermLine yellow (_tcString tc)
+            , makeColorTermLine commandColor (_tcString tc)
             ,makeTermLine "ALIASES:" 
-            , makeColorTermLine yellow ( unwords (_tcAlias tc)) ] 
+            , makeColorTermLine commandColor ( unwords (_tcAlias tc)) ] 
             ++ case argumentHelp tc tm w of
                 (arghelp,Nothing) -> makeTermPara $ _tcHelp tc ++ " " ++ arghelp
                 (arghelp,Just args) -> makeTermPara (_tcHelp tc ++ " " ++ arghelp)
-                    ++ [makeColorTermLine yellow $ unwords args]
+                    ++ [makeColorTermLine commandColor $ unwords args]
         )
-getCommands :: Terminal -> World -> Maybe [TerminalCommand]
+getCommands :: Terminal -> [TerminalCommand]
-getCommands tm w = do
+getCommands tm = _tmScrollCommands tm ++ _tmWriteCommands tm
-    commands1 <- w ^? terminals . ix (_tmID tm) . tmScrollCommands
-    commands2 <- w ^? terminals . ix (_tmID tm) . tmWriteCommands
-    return $ commands1 ++ commands2
 
 infoClearInput :: Terminal -> [TerminalLine] -> World -> World
 infoClearInput tm tls = terminals . ix (_tmID tm) %~
@@ -142,6 +139,9 @@ argumentHelp tc tm w = case _tcEffect tc tm w of
 makeTermPara :: String -> [TerminalLine]
 makeTermPara = map makeTermLine . makeParagraph 60
 
+makeColorTermPara :: Color -> String -> [TerminalLine]
+makeColorTermPara col = map (makeColorTermLine col) . makeParagraph 60
+
 makeColorTermLine :: Color -> String -> TerminalLine
 makeColorTermLine col str = TerminalLineDisplay 0 $ const (str,col)
 
@@ -168,12 +168,15 @@ commandsCommand = TerminalCommand
     { _tcString = "COMMANDS"
     , _tcAlias  = ["COMMAND","COM"]
     , _tcHelp   = "DISPLAYS AVAILABLE COMMANDS."
-    , _tcEffect = \tm w -> NoArguments
+    , _tcEffect = \tm _ -> NoArguments
         ( makeTermLine "AVAILABLE COMMANDS:"
-        : makeTermPara (unwords (maybe [""] (map _tcString) $ getCommands tm w))
+        : makeColorTermPara commandColor (unwords (map _tcString $ getCommands tm))
                 )
     }
 
+commandColor :: Color
+commandColor = yellow
+
 singleCommand :: [String] -> String -> [String] -> String -> (World -> World) -> TerminalCommand
 singleCommand followingLines command aliases htext eff = TerminalCommand
     {_tcString = command
@@ -197,9 +200,8 @@ terminalReturnEffect tm w = fromMaybe w $ do
 
 commandFutureLines :: String -> Terminal -> World -> [TerminalLine]
 commandFutureLines s tm w = fromMaybe [errline "^ INVALID COMMAND"] $ do
-    commands    <- getCommands tm w
     (str,args)  <- safeUncons $ words s
-    command     <- find (\tc -> _tcString tc == str || str `elem` _tcAlias tc) commands
+    command     <- find (\tc -> _tcString tc == str || str `elem` _tcAlias tc) (getCommands tm)
     case _tcEffect command tm w of
         NoArguments tls -> Just tls
         OneArgument argtype m -> Just $ fromMaybe [errline $ "^ INVALID ARGUMENT: EXPECTS "++ argtype]