This commit is contained in:
2021-12-01 11:11:24 +00:00
parent b9e4a80a46
commit d75ea2b252
5 changed files with 10 additions and 13 deletions
+2 -2
View File
@@ -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
+2 -2
View File
@@ -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
+2 -1
View File
@@ -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]
+3 -3
View File
@@ -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
+1 -5
View File
@@ -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