Cleanup
This commit is contained in:
@@ -1,4 +1,4 @@
|
|||||||
{-# LANGUAGE TupleSections #-}
|
--{-# LANGUAGE TupleSections #-}
|
||||||
{- | Actions performed by creatures within the world
|
{- | Actions performed by creatures within the world
|
||||||
-}
|
-}
|
||||||
module Dodge.Creature.Action
|
module Dodge.Creature.Action
|
||||||
@@ -241,7 +241,7 @@ youDropItem w = case yourItem w ^? _Just . itCurseStatus of
|
|||||||
cr = you w
|
cr = you w
|
||||||
{- | Copy an inventory item to the floor. -}
|
{- | Copy an inventory item to the floor. -}
|
||||||
copyInvItemToFloor :: Creature -> Int -> World -> World
|
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. -}
|
{- | Pick up a specific item. -}
|
||||||
pickUpItem :: Int -> FloorItem -> World -> World
|
pickUpItem :: Int -> FloorItem -> World -> World
|
||||||
|
|||||||
@@ -67,9 +67,9 @@ spaceAction :: World -> World
|
|||||||
spaceAction w = if _carteDisplay w
|
spaceAction w = if _carteDisplay w
|
||||||
then w & carteCenter .~ theLoc
|
then w & carteCenter .~ theLoc
|
||||||
else case (_inventoryMode w, selectedCloseObject w) of
|
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))) -> 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
|
_ -> w & inventoryMode .~ TopInventory
|
||||||
where
|
where
|
||||||
theLoc = fst (_seenLocations w IM.! _selLocation w) w
|
theLoc = fst (_seenLocations w IM.! _selLocation w) w
|
||||||
|
|||||||
@@ -1,5 +1,6 @@
|
|||||||
module Dodge.Initialisation where
|
module Dodge.Initialisation where
|
||||||
import Dodge.Default.World
|
import Dodge.Default.World
|
||||||
|
import Dodge.Base
|
||||||
import Dodge.Save
|
import Dodge.Save
|
||||||
import Dodge.Data
|
import Dodge.Data
|
||||||
import Dodge.Creature
|
import Dodge.Creature
|
||||||
@@ -38,4 +39,4 @@ initialWorld = defaultWorld
|
|||||||
}
|
}
|
||||||
|
|
||||||
testStringInit :: World -> [String]
|
testStringInit :: World -> [String]
|
||||||
testStringInit w = [show $ _rewinding w]
|
testStringInit w = [show $ _crInvSel $ you w]
|
||||||
|
|||||||
@@ -76,7 +76,7 @@ augmentedInvSizes = bimapAugmentInv _itInvSize closeObjectSize
|
|||||||
|
|
||||||
bimapAugmentInv :: (Item -> a) -> (Either FloorItem Button -> a) -> World -> IM.IntMap a
|
bimapAugmentInv :: (Item -> a) -> (Either FloorItem Button -> a) -> World -> IM.IntMap a
|
||||||
bimapAugmentInv f g w = IM.union
|
bimapAugmentInv f g w = IM.union
|
||||||
(fmap f $ yourInv w)
|
(f <$> yourInv w)
|
||||||
(IM.fromAscList $ zip [length (yourInv w) ..] $ map g $ _closeObjects w)
|
(IM.fromAscList $ zip [length (yourInv w) ..] $ map g $ _closeObjects w)
|
||||||
|
|
||||||
invSelSize :: Int -> World -> Int
|
invSelSize :: Int -> World -> Int
|
||||||
@@ -108,7 +108,7 @@ updateCloseObjects w = w & closeObjects .~ unionBy closeObjEq oldCloseFiltered c
|
|||||||
& creatures . ix (_yourID w) . crInvSel %~ updateinvsel
|
& creatures . ix (_yourID w) . crInvSel %~ updateinvsel
|
||||||
where
|
where
|
||||||
updateinvsel curinvsel
|
updateinvsel curinvsel
|
||||||
| length (augmentedInvSizes w) <= curinvsel = length (augmentedInvSizes w) - 1
|
| length (augmentedInvSizes w) <= curinvsel = max 0 $ length (augmentedInvSizes w) - 1
|
||||||
| otherwise = curinvsel
|
| otherwise = curinvsel
|
||||||
filt = filter $ \obj -> dist ypos (closeObjPos obj) < 40 && hasLOS ypos (closeObjPos obj) w
|
filt = filter $ \obj -> dist ypos (closeObjPos obj) < 40 && hasLOS ypos (closeObjPos obj) w
|
||||||
ypos = _crPos $ you w
|
ypos = _crPos $ you w
|
||||||
@@ -173,7 +173,7 @@ bestCloseObjectIndex w = findIndex f $ _closeObjects w
|
|||||||
selectedCloseObject :: World -> Maybe (Int,Either FloorItem Button)
|
selectedCloseObject :: World -> Maybe (Int,Either FloorItem Button)
|
||||||
selectedCloseObject w
|
selectedCloseObject w
|
||||||
| invsel >= length inv = Just $ selectNthCloseObject w (invsel - length inv)
|
| invsel >= length inv = Just $ selectNthCloseObject w (invsel - length inv)
|
||||||
| otherwise = fmap (selectNthCloseObject w) $ bestCloseObjectIndex w
|
| otherwise = selectNthCloseObject w <$> bestCloseObjectIndex w
|
||||||
where
|
where
|
||||||
invsel = _crInvSel cr
|
invsel = _crInvSel cr
|
||||||
cr = you w
|
cr = you w
|
||||||
|
|||||||
@@ -111,7 +111,7 @@ displayInv n cfig w = listTextPicturesAt 0 0 cfig invlist
|
|||||||
Nothing -> mempty
|
Nothing -> mempty
|
||||||
Just (i,_) -> listCursorAt 50 0 cfig (selNumPos i w) blue 15 (invSelSize i w)
|
Just (i,_) -> listCursorAt 50 0 cfig (selNumPos i w) blue 15 (invSelSize i w)
|
||||||
inv = _crInv cr
|
inv = _crInv cr
|
||||||
invlist = (concatMap itemToTextPictures $ IM.elems inv)
|
invlist = concatMap itemText (IM.elems inv)
|
||||||
++ displayFreeSlots ++ concatMap (closeObjectToTextPictures nfreeslots) (_closeObjects w)
|
++ displayFreeSlots ++ concatMap (closeObjectToTextPictures nfreeslots) (_closeObjects w)
|
||||||
nfreeslots = crNumFreeSlots cr
|
nfreeslots = crNumFreeSlots cr
|
||||||
displayFreeSlots = case nfreeslots of
|
displayFreeSlots = case nfreeslots of
|
||||||
@@ -208,10 +208,6 @@ mapWall cfig w wl =
|
|||||||
mainListCursor :: Color -> Int -> Configuration -> Picture
|
mainListCursor :: Color -> Int -> Configuration -> Picture
|
||||||
mainListCursor c = openCursorAt 120 c 5 0
|
mainListCursor c = openCursorAt 120 c 5 0
|
||||||
|
|
||||||
itemToTextPictures :: Item -> [Picture]
|
|
||||||
itemToTextPictures it = itemText it
|
|
||||||
|
|
||||||
|
|
||||||
itemText :: Item -> [Picture]
|
itemText :: Item -> [Picture]
|
||||||
{-# INLINE itemText #-}
|
{-# INLINE itemText #-}
|
||||||
itemText it = case _itCurseStatus it of
|
itemText it = case _itCurseStatus it of
|
||||||
|
|||||||
Reference in New Issue
Block a user