diff --git a/src/Dodge/AssignHotkey.hs b/src/Dodge/AssignHotkey.hs index 812550058..fd0c747a8 100644 --- a/src/Dodge/AssignHotkey.hs +++ b/src/Dodge/AssignHotkey.hs @@ -1,18 +1,16 @@ module Dodge.AssignHotkey (assignHotkey) where -import Dodge.Data.Equipment.Misc import Control.Lens import Data.Maybe +import Dodge.Data.Equipment.Misc import Dodge.Data.World import NewInt --- it is not obvious to me whether hotkeys should belong to LWorld, CWorld or --- World assignHotkey :: NewInt ItmInt -> Hotkey -> LWorld -> LWorld -assignHotkey i hk lw = lw +assignHotkey i hk lw = + lw & handleoldposition & hotkeys . at hk ?~ i - -- & imHotkeys . unNIntMap . at itid ?~ hk & imHotkeys . at i ?~ hk where handleoldposition = fromMaybe id $ do diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs index 63fbe2e01..fd6c11f8a 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/src/Dodge/Creature/YourControl.hs @@ -1,20 +1,18 @@ {-# LANGUAGE LambdaCase #-} -module Dodge.Creature.YourControl ( - yourControl, -) where +module Dodge.Creature.YourControl (yourControl) where -import qualified Data.IntMap.Strict as IM -import Dodge.Creature.MoveType -import Dodge.Data.Equipment.Misc import Control.Monad +import qualified Data.IntMap.Strict as IM import qualified Data.Map.Strict as M import Data.Maybe +import Dodge.AssignHotkey import Dodge.Creature.Impulse.Movement import Dodge.Creature.Impulse.UseItem +import Dodge.Creature.MoveType import Dodge.Data.AimStance +import Dodge.Data.Equipment.Misc import Dodge.Data.World -import Dodge.AssignHotkey import Dodge.InputFocus import Dodge.Inventory import Dodge.Item.AimStance @@ -35,26 +33,24 @@ yourControl _ w & cWorld . lWorld . creatures . ix 0 %~ wasdWithAiming w & tryClickUse pkeys & handleHotkeys - | otherwise = - w & cWorld . lWorld . creatures . ix 0 %~ wasdWithAiming w + | otherwise = w & cWorld . lWorld . creatures . ix 0 %~ wasdWithAiming w where - f NoSubInventory = True - f ExamineInventory = True - f _ = False + f = \case + NoSubInventory -> True + ExamineInventory -> True + _ -> False pkeys = w ^. input . mouseButtons +-- the following only works because modifier keys are ordered after scancode "hotkeys" handleHotkeys :: World -> World handleHotkeys w | ispressed SDL.ScancodeLShift || ispressed SDL.ScancodeRShift - , Just hk <- - listToMaybe . mapMaybe scancodeToHotkey . M.keys $ w ^. input . pressedKeys + , (hk:_) <- mapMaybe scancodeToHotkey . M.keys $ pkeys , Just invid <- lw ^? creatures . ix 0 . crManipulation . manObject . imSelectedItem , Just itid <- lw ^? creatures . ix 0 . crInv . ix invid = w & cWorld . lWorld %~ assignHotkey (NInt itid) hk | ispressed SDL.ScancodeLCtrl || ispressed SDL.ScancodeRCtrl - , Just hk <- - listToMaybe . mapMaybe scancodeToHotkey . M.keys $ - w ^. input . pressedKeys + , (hk:_) <- mapMaybe scancodeToHotkey . M.keys $ pkeys , Just itid <- lw ^? hotkeys . ix hk . unNInt , Just invid <- lw ^? items . ix itid . itLocation . ilInvID = w & invSetSelectionPos 0 (_unNInt invid) @@ -64,17 +60,26 @@ handleHotkeys w w (M.intersectionWith (,) thehotkeys (w ^. input . pressedKeys)) where + pkeys = w ^. input . pressedKeys ispressed k = k `M.member` _pressedKeys (_input w) thehotkeys = M.mapKeys hotkeyToScancode $ w ^. cWorld . lWorld . hotkeys lw = w ^. cWorld . lWorld +--modifierKeys :: S.Set SDL.Scancode +--modifierKeys = S.fromList +-- [ SDL.ScancodeLShift +-- , SDL.ScancodeRShift +-- , SDL.ScancodeRCtrl +-- , SDL.ScancodeLCtrl +-- ] + useHotkey :: World -> (NewInt ItmInt, Int) -> World useHotkey w (NInt itid, pt) = fromMaybe w $ do invid <- w ^? cWorld . lWorld . items . ix itid . itLocation . ilInvID . unNInt useItem invid pt w hotkeyToScancode :: Hotkey -> SDL.Scancode -hotkeyToScancode x = case x of +hotkeyToScancode = \case HotkeyQ -> SDL.ScancodeQ HotkeyE -> SDL.ScancodeE HotkeyR -> SDL.ScancodeE @@ -94,7 +99,7 @@ hotkeyToScancode x = case x of Hotkey0 -> SDL.Scancode0 scancodeToHotkey :: SDL.Scancode -> Maybe Hotkey -scancodeToHotkey x = case x of +scancodeToHotkey = \case SDL.ScancodeQ -> Just HotkeyQ SDL.ScancodeE -> Just HotkeyE SDL.ScancodeR -> Just HotkeyR @@ -129,8 +134,8 @@ wasdAim inp w cr | Just 0 <- inp ^? mouseButtons . ix SDL.ButtonRight , Nothing <- inp ^? mouseButtons . ix SDL.ButtonLeft = setAimPosture (w ^. cWorld . lWorld . items) cr - | SDL.ButtonRight `M.member` _mouseButtons inp = aimTurn (w ^. cWorld . lWorld) - mousedir cr + | SDL.ButtonRight `M.member` _mouseButtons inp = + aimTurn (w ^. cWorld . lWorld) mousedir cr | Aiming <- cr ^. crStance . posture = removeAimPosture m cr | otherwise = creatureTurnTowardDir (_crMvAim cr) 0.2 cr where @@ -231,6 +236,7 @@ tryClickUse pkeys w = fromMaybe w $ do ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject - . imSelectedItem . unNInt of + . imSelectedItem + . unNInt of Just invid -> useItem invid ltime w Nothing -> interactWithCloseObj <$> getSelectedCloseObj w ?? w diff --git a/src/Dodge/TestString.hs b/src/Dodge/TestString.hs index 1d20489cf..5e80701ca 100644 --- a/src/Dodge/TestString.hs +++ b/src/Dodge/TestString.hs @@ -31,11 +31,7 @@ import NewInt import Data.Foldable testStringInit :: Universe -> [String] -testStringInit u = map show - ( u ^.. uvWorld . cWorld . lWorld . items . each . itLocation . ilEquipSite) - <> ["---"] <> map show - ( u ^.. uvWorld . cWorld . lWorld . items . each . itID) - <> ["---"] <> map show (M.toList $ fold $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crEquipment) +testStringInit _ = mempty -- map f (IM.toList $ u ^. uvWorld . cWorld . lWorld . items) -- <> ["---"] -- <> map show (IM.toList . fold $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crInv . unNIntMap)