From 1c80447f9af17c6721d0aff29a01fb400dd8199d Mon Sep 17 00:00:00 2001 From: justin Date: Tue, 7 Jun 2022 16:01:08 +0100 Subject: [PATCH] Add distance indicator for forcefield gun --- src/Dodge/Creature/Picture.hs | 4 ++-- src/Dodge/Data.hs | 2 +- src/Dodge/Item/Weapon/ExtraEffect.hs | 29 ++++++++++++++++++++++++---- src/Dodge/Item/Weapon/Utility.hs | 19 ++++++++++-------- src/Dodge/Terminal.hs | 28 ++++++++++++++------------- 5 files changed, 54 insertions(+), 28 deletions(-) diff --git a/src/Dodge/Creature/Picture.hs b/src/Dodge/Creature/Picture.hs index da346d69c..fa3d1f43b 100644 --- a/src/Dodge/Creature/Picture.hs +++ b/src/Dodge/Creature/Picture.hs @@ -47,8 +47,8 @@ basicCrPict cr cfig w = ] ) where - targetingPic = IM.elems $ IM.mapMaybeWithKey f $ _crInv cr - f invid it = fmap (\g -> g invid it cr cfig w) (it ^? itTargeting . tgDraw) + targetingPic = IM.elems $ IM.mapMaybe f $ _crInv cr + 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) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 37af62d97..d7e4636d4 100644 --- a/src/Dodge/Data.hs +++ b/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 } diff --git a/src/Dodge/Item/Weapon/ExtraEffect.hs b/src/Dodge/Item/Weapon/ExtraEffect.hs index 09e480a26..2c3580ce1 100644 --- a/src/Dodge/Item/Weapon/ExtraEffect.hs +++ b/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 f _ it _ cfig w = fromMaybe mempty $ do +targetDraw :: (Item -> Picture) -> Item -> Creature -> Configuration -> World -> Picture +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 diff --git a/src/Dodge/Item/Weapon/Utility.hs b/src/Dodge/Item/Weapon/Utility.hs index 40e53e70f..0f7b47f1f 100644 --- a/src/Dodge/Item/Weapon/Utility.hs +++ b/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 - & walls %~ IM.insertWith (\_ x -> x) i forceField {_wlID = i} - & creatures . ix (_crID cr) . crInv . ix (fromJust (_itInvPos itm)) . itParams . paramMID ?~ i - & moveWallIDUnsafe i wlline +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" diff --git a/src/Dodge/Terminal.hs b/src/Dodge/Terminal.hs index f287d6d22..904a4f96f 100644 --- a/src/Dodge/Terminal.hs +++ b/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 tm w = do - commands1 <- w ^? terminals . ix (_tmID tm) . tmScrollCommands - commands2 <- w ^? terminals . ix (_tmID tm) . tmWriteCommands - return $ commands1 ++ commands2 +getCommands :: Terminal -> [TerminalCommand] +getCommands tm = _tmScrollCommands tm ++ _tmWriteCommands tm 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]