diff --git a/src/Dodge/Creature/Action.hs b/src/Dodge/Creature/Action.hs index 3fa247e6d..ab7bc8863 100644 --- a/src/Dodge/Creature/Action.hs +++ b/src/Dodge/Creature/Action.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TupleSections #-} +--{-# LANGUAGE TupleSections #-} {- | Actions performed by creatures within the world -} module Dodge.Creature.Action @@ -241,7 +241,7 @@ youDropItem w = case yourItem w ^? _Just . itCurseStatus of cr = you w {- | Copy an inventory item to the floor. -} copyInvItemToFloor :: Creature -> Int -> World -> World -copyInvItemToFloor cr i w = copyItemToFloor (_crPos cr) (_crInv cr IM.! i) w +copyInvItemToFloor cr i = copyItemToFloor (_crPos cr) (_crInv cr IM.! i) {- | Pick up a specific item. -} pickUpItem :: Int -> FloorItem -> World -> World diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index 4083a9fc1..636577c82 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/src/Dodge/Event/Keyboard.hs @@ -67,9 +67,9 @@ spaceAction :: World -> World spaceAction w = if _carteDisplay w then w & carteCenter .~ theLoc else case (_inventoryMode w, selectedCloseObject w) of - (TopInventory,(Just (_,Left flit))) -> pickUpItem 0 flit w + (TopInventory,Just (_,Left flit)) -> pickUpItem 0 flit w --(TopInventory,(Just (_,Right but))) -> updateTopCloseObject (_btID but) $ _btEvent but but w - (TopInventory,(Just (_,Right but))) -> _btEvent but but w + (TopInventory,Just (_,Right but)) -> _btEvent but but w _ -> w & inventoryMode .~ TopInventory where theLoc = fst (_seenLocations w IM.! _selLocation w) w diff --git a/src/Dodge/Initialisation.hs b/src/Dodge/Initialisation.hs index 21cd471f6..cfccb061e 100644 --- a/src/Dodge/Initialisation.hs +++ b/src/Dodge/Initialisation.hs @@ -1,5 +1,6 @@ module Dodge.Initialisation where import Dodge.Default.World +import Dodge.Base import Dodge.Save import Dodge.Data import Dodge.Creature @@ -38,4 +39,4 @@ initialWorld = defaultWorld } testStringInit :: World -> [String] -testStringInit w = [show $ _rewinding w] +testStringInit w = [show $ _crInvSel $ you w] diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index 45ad17e41..be5a69641 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -76,7 +76,7 @@ augmentedInvSizes = bimapAugmentInv _itInvSize closeObjectSize bimapAugmentInv :: (Item -> a) -> (Either FloorItem Button -> a) -> World -> IM.IntMap a bimapAugmentInv f g w = IM.union - (fmap f $ yourInv w) + (f <$> yourInv w) (IM.fromAscList $ zip [length (yourInv w) ..] $ map g $ _closeObjects w) invSelSize :: Int -> World -> Int @@ -108,7 +108,7 @@ updateCloseObjects w = w & closeObjects .~ unionBy closeObjEq oldCloseFiltered c & creatures . ix (_yourID w) . crInvSel %~ updateinvsel where updateinvsel curinvsel - | length (augmentedInvSizes w) <= curinvsel = length (augmentedInvSizes w) - 1 + | length (augmentedInvSizes w) <= curinvsel = max 0 $ length (augmentedInvSizes w) - 1 | otherwise = curinvsel filt = filter $ \obj -> dist ypos (closeObjPos obj) < 40 && hasLOS ypos (closeObjPos obj) w ypos = _crPos $ you w @@ -173,7 +173,7 @@ bestCloseObjectIndex w = findIndex f $ _closeObjects w selectedCloseObject :: World -> Maybe (Int,Either FloorItem Button) selectedCloseObject w | invsel >= length inv = Just $ selectNthCloseObject w (invsel - length inv) - | otherwise = fmap (selectNthCloseObject w) $ bestCloseObjectIndex w + | otherwise = selectNthCloseObject w <$> bestCloseObjectIndex w where invsel = _crInvSel cr cr = you w diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 946d66db5..ea62dd1da 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -111,7 +111,7 @@ displayInv n cfig w = listTextPicturesAt 0 0 cfig invlist Nothing -> mempty Just (i,_) -> listCursorAt 50 0 cfig (selNumPos i w) blue 15 (invSelSize i w) inv = _crInv cr - invlist = (concatMap itemToTextPictures $ IM.elems inv) + invlist = concatMap itemText (IM.elems inv) ++ displayFreeSlots ++ concatMap (closeObjectToTextPictures nfreeslots) (_closeObjects w) nfreeslots = crNumFreeSlots cr displayFreeSlots = case nfreeslots of @@ -208,10 +208,6 @@ mapWall cfig w wl = mainListCursor :: Color -> Int -> Configuration -> Picture mainListCursor c = openCursorAt 120 c 5 0 -itemToTextPictures :: Item -> [Picture] -itemToTextPictures it = itemText it - - itemText :: Item -> [Picture] {-# INLINE itemText #-} itemText it = case _itCurseStatus it of