justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Add distance indicator for forcefield gun

Browse Source
This commit is contained in:
justin
2022-06-07 16:01:08 +01:00
parent c8c299cfb5
commit 1c80447f9a
5 changed files with 54 additions and 28 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Picture.hs
+2 -2
View File
@@ -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)
src/Dodge/Data.hs
+1 -1
View File
@@ -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
+25 -4
View File
@@ -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
src/Dodge/Item/Weapon/Utility.hs
+11 -8
View File
@@ -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"
src/Dodge/Terminal.hs
+15 -13
View File
@@ -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]