Add capability to examine you (empty slots) and close objects
This commit is contained in:
@@ -2,15 +2,15 @@ module Dodge.Creature.YourControl (
|
|||||||
yourControl,
|
yourControl,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.Maybe
|
|
||||||
import Data.Foldable
|
import Data.Foldable
|
||||||
import qualified Data.Map.Strict as M
|
import qualified Data.Map.Strict as M
|
||||||
|
import Data.Maybe
|
||||||
import Dodge.Base.Coordinate
|
import Dodge.Base.Coordinate
|
||||||
import Dodge.Creature.Impulse.Movement
|
import Dodge.Creature.Impulse.Movement
|
||||||
import Dodge.Creature.Test
|
import Dodge.Creature.Test
|
||||||
import Dodge.Data.World
|
import Dodge.Data.World
|
||||||
import Dodge.InputFocus
|
import Dodge.InputFocus
|
||||||
import Dodge.LightSource
|
--import Dodge.LightSource
|
||||||
import Dodge.Update.UsingInput
|
import Dodge.Update.UsingInput
|
||||||
import Geometry
|
import Geometry
|
||||||
import LensHelp
|
import LensHelp
|
||||||
@@ -19,15 +19,15 @@ import qualified SDL
|
|||||||
-- | The AI equivalent for your control.
|
-- | The AI equivalent for your control.
|
||||||
yourControl :: Creature -> World -> World
|
yourControl :: Creature -> World -> World
|
||||||
yourControl cr w
|
yourControl cr w
|
||||||
| inTermFocus w = dimCreatureLight cr w & updateUsingInput
|
| inTermFocus w = w & updateUsingInput
|
||||||
| otherwise =
|
| otherwise =
|
||||||
dimCreatureLight cr w
|
w
|
||||||
& cWorld . lWorld . creatures . ix (_crID cr)
|
& cWorld . lWorld . creatures . ix (_crID cr)
|
||||||
%~ (wasdWithAiming w (_mvSpeed $ _crMvType cr) . mouseActionsCr (_mouseButtons (_input w)))
|
%~ (wasdWithAiming w (_mvSpeed $ _crMvType cr) . mouseActionsCr (_mouseButtons (_input w)))
|
||||||
& updateUsingInput
|
& updateUsingInput
|
||||||
|
|
||||||
dimCreatureLight :: Creature -> World -> World
|
--dimCreatureLight :: Creature -> World -> World
|
||||||
dimCreatureLight cr = cWorld . lWorld . tempLightSources .:~ tlsTimeRadColPos 1 300 0.1 (addZ 100 $ _crPos cr)
|
--dimCreatureLight cr = cWorld . lWorld . tempLightSources .:~ tlsTimeRadColPos 1 300 0.1 (addZ 100 $ _crPos cr)
|
||||||
|
|
||||||
-- note the order of operation, setting the posture first--this prevents the twist fire bug
|
-- note the order of operation, setting the posture first--this prevents the twist fire bug
|
||||||
|
|
||||||
@@ -41,7 +41,6 @@ wasdWithAiming ::
|
|||||||
wasdWithAiming w speed cr
|
wasdWithAiming w speed cr
|
||||||
| isAiming = addAnyTwist $ aimTurn mouseDir $ theMovement $ setMvAim cr
|
| isAiming = addAnyTwist $ aimTurn mouseDir $ theMovement $ setMvAim cr
|
||||||
| crIsReloading cr && SDL.ButtonRight `M.member` _mouseButtons (_input w) =
|
| crIsReloading cr && SDL.ButtonRight `M.member` _mouseButtons (_input w) =
|
||||||
--addAnyTwist $ aimTurn (mouseDir + anytwist) $ theMovement $ setMvAim cr
|
|
||||||
aimTurn mouseDir $ removeTwist $ theMovement $ setMvAim cr
|
aimTurn mouseDir $ removeTwist $ theMovement $ setMvAim cr
|
||||||
| otherwise = noaimmove $ theTurn $ removeTwist $ setMvAim cr
|
| otherwise = noaimmove $ theTurn $ removeTwist $ setMvAim cr
|
||||||
where
|
where
|
||||||
@@ -51,17 +50,10 @@ wasdWithAiming w speed cr
|
|||||||
cr'
|
cr'
|
||||||
& crDir +~ _crTwist cr'
|
& crDir +~ _crTwist cr'
|
||||||
& crTwist .~ 0
|
& crTwist .~ 0
|
||||||
anytwist = case cr ^? crInv . ix (crSel cr) . itUse . heldAim . aimStance of
|
addAnyTwist = case (cr ^? crInv . ix (crSel cr) . itUse . heldAim . aimStance, cr^. crTwist) of
|
||||||
Just TwoHandTwist -> twistamount * pi
|
(Just TwoHandTwist, 0) -> (crTwist .~ twistamount * pi)
|
||||||
_ -> 0
|
|
||||||
--addAnyTwist = crTwist .~ anytwist
|
|
||||||
addAnyTwist = case cr ^? crInv . ix (crSel cr) . itUse . heldAim . aimStance of
|
|
||||||
Just TwoHandTwist -> case cr ^. crTwist of
|
|
||||||
0 -> (crTwist .~ twistamount * pi)
|
|
||||||
. (crDir -~ twistamount * pi)
|
. (crDir -~ twistamount * pi)
|
||||||
_ -> id
|
_ -> id
|
||||||
_ -> id
|
|
||||||
|
|
||||||
theMovement
|
theMovement
|
||||||
| movDir == V2 0 0 = id
|
| movDir == V2 0 0 = id
|
||||||
| otherwise = crMvAbsolute (speed *.* movAbs)
|
| otherwise = crMvAbsolute (speed *.* movAbs)
|
||||||
@@ -69,7 +61,6 @@ wasdWithAiming w speed cr
|
|||||||
| movDir == V2 0 0 = id
|
| movDir == V2 0 0 = id
|
||||||
| otherwise = crMvForward speed
|
| otherwise = crMvForward speed
|
||||||
theTurn cr' = creatureTurnTowardDir (_crMvAim cr') 0.2 cr'
|
theTurn cr' = creatureTurnTowardDir (_crMvAim cr') 0.2 cr'
|
||||||
-- theTurn' cr' = creatureTurnTowardDir dir 0.2 cr'
|
|
||||||
movDir = wasdDir w
|
movDir = wasdDir w
|
||||||
dir = fmap ((w ^. cWorld . camPos . camRot) +) (safeArgV movDir)
|
dir = fmap ((w ^. cWorld . camPos . camRot) +) (safeArgV movDir)
|
||||||
movAbs = rotateV (w ^. cWorld . camPos . camRot) $ normalizeV movDir
|
movAbs = rotateV (w ^. cWorld . camPos . camRot) $ normalizeV movDir
|
||||||
|
|||||||
@@ -23,6 +23,7 @@ module Dodge.Inventory (
|
|||||||
crInvSize,
|
crInvSize,
|
||||||
selectedCloseObject,
|
selectedCloseObject,
|
||||||
invDimColor,
|
invDimColor,
|
||||||
|
trimapAugmentInv,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Color
|
import Color
|
||||||
@@ -102,6 +103,7 @@ augmentedInvSizes :: World -> IM.IntMap Int
|
|||||||
augmentedInvSizes = trimapAugmentInv itSlotsTaken 1 closeObjectSize
|
augmentedInvSizes = trimapAugmentInv itSlotsTaken 1 closeObjectSize
|
||||||
|
|
||||||
trimapAugmentInv :: (Item -> a) -> a -> (Either FloorItem Button -> a) -> World -> IM.IntMap a
|
trimapAugmentInv :: (Item -> a) -> a -> (Either FloorItem Button -> a) -> World -> IM.IntMap a
|
||||||
|
{-# INLINE trimapAugmentInv #-}
|
||||||
trimapAugmentInv f x g w =
|
trimapAugmentInv f x g w =
|
||||||
IM.insert n x $
|
IM.insert n x $
|
||||||
IM.union
|
IM.union
|
||||||
|
|||||||
@@ -1,11 +1,18 @@
|
|||||||
module Dodge.Item.Info where
|
module Dodge.Item.Info where
|
||||||
|
|
||||||
|
import Data.Char
|
||||||
import Dodge.Data.Item
|
import Dodge.Data.Item
|
||||||
import qualified Data.Map.Strict as M
|
import qualified Data.Map.Strict as M
|
||||||
import LensHelp
|
import LensHelp
|
||||||
|
|
||||||
itmInfo :: Item -> String
|
itemInfo :: Item -> String
|
||||||
itmInfo itm = itmBaseInfo itm ++ " " ++ itmUsageInfo itm
|
itemInfo itm = itmBaseInfo itm ++ " " ++ itmUsageInfo itm
|
||||||
|
++ itmSpaceInfo itm
|
||||||
|
|
||||||
|
itmSpaceInfo :: Item -> String
|
||||||
|
itmSpaceInfo itm = case (ceiling $ _itInvSize itm) of
|
||||||
|
1 -> "It takes up one inventory slot. "
|
||||||
|
x -> "It takes up " ++ map toLower (showInt x) ++ " inventory slots. "
|
||||||
|
|
||||||
itmBaseInfo :: Item -> String
|
itmBaseInfo :: Item -> String
|
||||||
itmBaseInfo itm = case itm ^. itType . iyBase of
|
itmBaseInfo itm = case itm ^. itType . iyBase of
|
||||||
|
|||||||
+42
-15
@@ -3,7 +3,7 @@ module Dodge.Render.HUD (
|
|||||||
drawHUD,
|
drawHUD,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Justify
|
import Dodge.Creature.Info
|
||||||
import Control.Lens
|
import Control.Lens
|
||||||
import qualified Data.Map.Strict as M
|
import qualified Data.Map.Strict as M
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
@@ -27,6 +27,7 @@ import Dodge.Tweak.Show
|
|||||||
import Dodge.WorldPos
|
import Dodge.WorldPos
|
||||||
import Geometry
|
import Geometry
|
||||||
import qualified IntMapHelp as IM
|
import qualified IntMapHelp as IM
|
||||||
|
import Justify
|
||||||
import ListHelp
|
import ListHelp
|
||||||
import Padding
|
import Padding
|
||||||
import Picture
|
import Picture
|
||||||
@@ -70,7 +71,7 @@ defaultSubInvSelectionList =
|
|||||||
invDisplayParams :: World -> ListDisplayParams
|
invDisplayParams :: World -> ListDisplayParams
|
||||||
invDisplayParams w =
|
invDisplayParams w =
|
||||||
defaultListDisplayParams
|
defaultListDisplayParams
|
||||||
-- & ldpWidth .~ FixedSelectionWidth topInvW
|
-- & ldpWidth .~ FixedSelectionWidth topInvW
|
||||||
& ldpCursorType .~ BorderCursor selcursortype
|
& ldpCursorType .~ BorderCursor selcursortype
|
||||||
& ldpWidth .~ FixedSelectionWidth (determineInvSelCursorWidth w)
|
& ldpWidth .~ FixedSelectionWidth (determineInvSelCursorWidth w)
|
||||||
where
|
where
|
||||||
@@ -88,21 +89,29 @@ drawSubInventory :: SubInventory -> Configuration -> World -> Picture
|
|||||||
drawSubInventory subinv cfig w = case subinv of
|
drawSubInventory subinv cfig w = case subinv of
|
||||||
LockedInventory -> mempty -- topInvCursor col cursPos cfig w
|
LockedInventory -> mempty -- topInvCursor col cursPos cfig w
|
||||||
NoSubInventory -> drawNoSubInventory cfig w
|
NoSubInventory -> drawNoSubInventory cfig w
|
||||||
ExamineInventory mtweaki ->
|
ExamineInventory mtweaki -> drawExamineInventory cfig mtweaki w
|
||||||
titledSub
|
|
||||||
"EXAMINE"
|
|
||||||
(defaultSubInvSelectionList & slItems .~ ammoTweakSelectionItems itm ++ map f (mitmInfo itm))
|
|
||||||
<> examineInventoryExtra mtweaki itm cfig
|
|
||||||
DisplayTerminal tid -> displayTerminal tid cfig (w ^. cWorld . lWorld)
|
DisplayTerminal tid -> displayTerminal tid cfig (w ^. cWorld . lWorld)
|
||||||
CombineInventory mi ->
|
CombineInventory mi ->
|
||||||
titledSub
|
titledSub
|
||||||
|
cfig
|
||||||
"COMBINE"
|
"COMBINE"
|
||||||
(combineListSelection w mi)
|
(combineListSelection w mi)
|
||||||
<> combineInventoryExtra mi cfig w
|
<> combineInventoryExtra mi cfig w
|
||||||
where
|
|
||||||
titledSub subtitle subitems =
|
titledSub :: Configuration -> String -> SelectionList a -> Picture
|
||||||
|
titledSub cfig subtitle subitems =
|
||||||
invHead cfig subtitle
|
invHead cfig subtitle
|
||||||
<> drawSelectionList secondColumnParams cfig subitems
|
<> drawSelectionList secondColumnParams cfig subitems
|
||||||
|
|
||||||
|
drawExamineInventory :: Configuration -> Maybe Int -> World -> Picture
|
||||||
|
drawExamineInventory cfig mtweaki w =
|
||||||
|
titledSub
|
||||||
|
cfig
|
||||||
|
"EXAMINE"
|
||||||
|
(defaultSubInvSelectionList & slItems .~ ammoTweakSelectionItems itm
|
||||||
|
++ map f (makeParagraph 60 $ yourAugmentedItem itemInfo (yourInfo (you w)) (closeObjectInfo (crNumFreeSlots (you w)) ) w))
|
||||||
|
<> examineInventoryExtra mtweaki itm cfig
|
||||||
|
where
|
||||||
itm = yourItem w
|
itm = yourItem w
|
||||||
f str =
|
f str =
|
||||||
SelectionItem
|
SelectionItem
|
||||||
@@ -115,6 +124,25 @@ drawSubInventory subinv cfig w = case subinv of
|
|||||||
, _siPayload = ()
|
, _siPayload = ()
|
||||||
}
|
}
|
||||||
|
|
||||||
|
closeObjectInfo :: Int -> Either FloorItem Button -> String
|
||||||
|
closeObjectInfo n x = case x of
|
||||||
|
Left (FlIt {_flIt = itm}) -> "This item is on the floor " ++ floorItemPickupInfo n itm ++ itemInfo itm
|
||||||
|
Right _ -> "This is some sort of switch or button."
|
||||||
|
|
||||||
|
floorItemPickupInfo :: Int -> Item -> String
|
||||||
|
floorItemPickupInfo n itm
|
||||||
|
| n >= ceiling (_itInvSize itm) = ", but you have space to pick it up. "
|
||||||
|
| otherwise = " and you don't have space to pick it up. "
|
||||||
|
|
||||||
|
yourAugmentedItem :: (Item -> a) -> a -> (Either FloorItem Button -> a) -> World -> a
|
||||||
|
yourAugmentedItem f x g w
|
||||||
|
| i < n = f $ yourInv w ^?! ix i
|
||||||
|
| i == n = x
|
||||||
|
| otherwise = g $ w ^?! hud . closeObjects . ix (i - n - 1)
|
||||||
|
where
|
||||||
|
i = crSel (you w)
|
||||||
|
n = length $ yourInv w
|
||||||
|
|
||||||
drawNoSubInventory :: Configuration -> World -> Picture
|
drawNoSubInventory :: Configuration -> World -> Picture
|
||||||
drawNoSubInventory cfig w =
|
drawNoSubInventory cfig w =
|
||||||
pictures
|
pictures
|
||||||
@@ -150,7 +178,7 @@ examineInventoryExtra mtweaki mitm cfig =
|
|||||||
-- consider moving this functionality out into a tweaks module
|
-- consider moving this functionality out into a tweaks module
|
||||||
tparam <- mitm ^? _Just . itTweaks . tweakParams . ix tweaki
|
tparam <- mitm ^? _Just . itTweaks . tweakParams . ix tweaki
|
||||||
return $ listCursorNSW subInvX 60 cfig tweaki white (length $ showTweak tparam) 15
|
return $ listCursorNSW subInvX 60 cfig tweaki white (length $ showTweak tparam) 15
|
||||||
-- , drawSelectionList thirdColumnParams cfig (thirdColumnPara (itmInfo mitm))
|
-- , drawSelectionList thirdColumnParams cfig (thirdColumnPara (itmInfo mitm))
|
||||||
]
|
]
|
||||||
|
|
||||||
combineInventoryExtra :: Maybe Int -> Configuration -> World -> Picture
|
combineInventoryExtra :: Maybe Int -> Configuration -> World -> Picture
|
||||||
@@ -201,9 +229,6 @@ secondColumnParams =
|
|||||||
-- , _siPayload = ()
|
-- , _siPayload = ()
|
||||||
-- }
|
-- }
|
||||||
|
|
||||||
mitmInfo :: Maybe Item -> [String]
|
|
||||||
mitmInfo = maybe [] $ makeParagraph 60 . itmInfo
|
|
||||||
|
|
||||||
displayTerminal :: Int -> Configuration -> LWorld -> Picture
|
displayTerminal :: Int -> Configuration -> LWorld -> Picture
|
||||||
displayTerminal tid cfig w = fromMaybe mempty $ do
|
displayTerminal tid cfig w = fromMaybe mempty $ do
|
||||||
tm <- w ^? terminals . ix tid
|
tm <- w ^? terminals . ix tid
|
||||||
@@ -302,7 +327,8 @@ determineInvSelCursorWidth w = case _rbOptions w of
|
|||||||
NoRightButtonOptions -> topInvW
|
NoRightButtonOptions -> topInvW
|
||||||
EquipOptions{}
|
EquipOptions{}
|
||||||
| ButtonRight `M.member` _mouseButtons (_input w)
|
| ButtonRight `M.member` _mouseButtons (_input w)
|
||||||
&& w ^? hud . hudElement . subInventory == Just NoSubInventory -> 47
|
&& w ^? hud . hudElement . subInventory == Just NoSubInventory ->
|
||||||
|
47
|
||||||
| otherwise -> topInvW
|
| otherwise -> topInvW
|
||||||
|
|
||||||
combineListSelection :: World -> Maybe Int -> SelectionList ()
|
combineListSelection :: World -> Maybe Int -> SelectionList ()
|
||||||
@@ -365,8 +391,9 @@ mapOverlay :: Configuration -> World -> [Picture]
|
|||||||
mapOverlay cfig w =
|
mapOverlay cfig w =
|
||||||
(color (withAlpha 0.5 black) . polygon $ reverse $ rectNSWE 1 (-1) 1 (-1)) :
|
(color (withAlpha 0.5 black) . polygon $ reverse $ rectNSWE 1 (-1) 1 (-1)) :
|
||||||
[foldMap (drawMapWall cfig (w ^. hud)) $ IM.restrictKeys (lw ^. walls) (w ^. cWorld . seenWalls)]
|
[foldMap (drawMapWall cfig (w ^. hud)) $ IM.restrictKeys (lw ^. walls) (w ^. cWorld . seenWalls)]
|
||||||
--(mapMaybe (mapWall cfig (w ^. hud)) . IM.elems $ w ^. cWorld . lWorld . walls)
|
|
||||||
where
|
where
|
||||||
|
--(mapMaybe (mapWall cfig (w ^. hud)) . IM.elems $ w ^. cWorld . lWorld . walls)
|
||||||
|
|
||||||
lw = w ^. cWorld . lWorld
|
lw = w ^. cWorld . lWorld
|
||||||
|
|
||||||
drawMapWall :: Configuration -> HUD -> Wall -> Picture
|
drawMapWall :: Configuration -> HUD -> Wall -> Picture
|
||||||
|
|||||||
Reference in New Issue
Block a user