-- | Inventory management -- (c) JP Moresmau 2009 module MoresmauJP.Rpg.Inventory ( Inventory(), Position(..), ItemType(..), InventoryError(..),PotionType(..), makeEmptyInventory, makeFullInventory, takeItem, dropItem, listItems, listAllowedPositions,listActiveItems,listCarriedItems,listCarriedItemsUniqueObject, getCarriedItem, positionAllowed, addGold, getGold, Gold, isActive ) where import Data.List import Data.Maybe import qualified Data.Map as M data ItemType = Weapon { itName::String, damageLow::Int, damageHigh::Int, hands::Int, price::Gold} | Armor { itName::String, damageLow::Int, damageHigh::Int, price::Gold} | Shield { itName::String, damageLow::Int, damageHigh::Int, price::Gold} | Helmet { itName::String, damageLow::Int, damageHigh::Int, price::Gold} | Potion { itName::String, potionType::PotionType, price::Gold} | Scroll { itName::String, spellType::String, price::Gold} deriving (Show,Read,Eq) data Position= RightHand | LeftHand | Body | Head | Bag Int deriving (Show,Read,Eq,Ord) -- | Inventory Map item by Position Bag Size data Inventory = Inventory { invItems::(M.Map Position ItemType), invBagCapacity:: Int, invGold:: Gold } deriving (Eq,Show,Read) type Gold=Int data InventoryError = InvalidBagPosition Int | InvalidPositionForItem ItemType Position deriving (Eq,Show,Read) data PotionType = HealingPotion Int deriving (Show,Read,Eq) makeEmptyInventory :: Int -> Gold -> Inventory makeEmptyInventory a gold= Inventory M.empty a gold {-- makeFullInventory :: [(Position,ItemType)] -> Gold -> Inventory makeFullInventory [] gold= makeEmptyInventory 0 gold makeFullInventory posAndItems gold= let maxPos=maximum (map (getBagPos . fst) posAndItems) in reconcile2Hand (Inventory M.empty maxPos gold) posAndItems where getBagPos (Bag p)=p getBagPos _ =0 --} makeFullInventory :: [(Position,ItemType)] -> Int -> Gold -> Inventory makeFullInventory [] maxPos gold= makeEmptyInventory maxPos gold makeFullInventory posAndItems maxPos gold= reconcile2Hand (Inventory M.empty maxPos gold) posAndItems addGold :: Inventory -> Gold -> Inventory addGold i g=let oldGold=invGold i in i{invGold=max 0 (oldGold+g)} getGold :: Inventory -> Gold getGold i=invGold i reconcile2Hand :: Inventory -> [(Position,ItemType)] -> Inventory reconcile2Hand i poss=foldr f i poss where f:: (Position,ItemType) -> Inventory -> Inventory f pos i= case getCarriedItem i (fst pos) of Right Nothing -> let Right (i2,_)=takeItem i (snd pos) (fst pos) in i2 _->i takeItem :: Inventory -> ItemType -> Position -> Either InventoryError (Inventory,[ItemType]) takeItem i@(Inventory {invBagCapacity= sz}) it p= do p2 <- checkPos sz p ti1 <- takeItem' i it p2 True takeTwoHandsItem ti1 it p2 takeTwoHandsItem ::(Inventory,Maybe ItemType) -> ItemType -> Position -> Either InventoryError (Inventory,[ItemType]) takeTwoHandsItem (i,it1) it@(Weapon {hands=2}) RightHand= do (iv2,it2) <- takeItem' i it LeftHand False return (iv2,catMaybes [it1,it2]) takeTwoHandsItem (i,it1) it@(Weapon {hands=2}) LeftHand= do (iv2,it2) <- takeItem' i it RightHand False return (iv2,catMaybes [it1,it2]) takeTwoHandsItem (i,it1) _ _=do return (i,catMaybes [it1]) takeItem' :: Inventory -> ItemType -> Position -> Bool -> Either InventoryError (Inventory,Maybe ItemType) takeItem' i it p needDrop= do let allowed=positionAllowed it p if allowed then do (i2@(Inventory {invItems=m}),it2) <- if needDrop then dropItemToBag i p else Right (i, Nothing) return ((i2{invItems=(M.insert p it m)}),it2) else Left (InvalidPositionForItem it p) dropItemToBag :: Inventory -> Position -> Either InventoryError (Inventory,Maybe ItemType) dropItemToBag i p@(Bag _)=dropItem i p dropItemToBag i p=do mi2@(i2,it2)<- dropItem i p if isJust it2 then do let freeBagPos=getFirstFreeBagPos i2 if (isJust freeBagPos) then do (i3,_)<- takeItem i (fromJust it2) (fromJust freeBagPos) return (i3,Nothing) else return mi2 else return mi2 instance Monad (Either InventoryError) where Left a >>= _ = Left a Right a >>= f = f a return = Right getFirstFreeBagPos:: Inventory -> Maybe Position getFirstFreeBagPos (Inventory {invItems=m,invBagCapacity=sz})=listToMaybe $ (filter (flip M.notMember m) (map Bag [1 .. sz])) dropItem :: Inventory -> Position -> Either InventoryError (Inventory,Maybe ItemType) dropItem i@(Inventory {invItems=m,invBagCapacity=sz}) p = do p2 <- checkPos sz p let item = M.lookup p2 m let m2 = M.delete p2 m return (i{invItems=(dropTwoHandsItem m2 item p2)},item) dropTwoHandsItem ::(M.Map Position ItemType) -> Maybe ItemType -> Position -> (M.Map Position ItemType) dropTwoHandsItem m (Just (Weapon {hands=2})) RightHand= M.delete LeftHand m dropTwoHandsItem m (Just (Weapon {hands=2})) LeftHand= M.delete RightHand m dropTwoHandsItem m _ _=m checkPos :: Int -> Position -> Either InventoryError Position checkPos capacity (Bag pos) | pos<1 = Left (InvalidBagPosition capacity) checkPos capacity (Bag pos) | pos>capacity = Left (InvalidBagPosition capacity) checkPos _ p = Right p listItems :: Inventory -> [(Position,Maybe ItemType)] listItems (Inventory {invItems=m,invBagCapacity=sz}) = map (\x -> (x,M.lookup x m)) ([RightHand, LeftHand, Body, Head] ++ (map Bag [1..sz])) listCarriedItems :: Inventory -> [(Position,ItemType)] listCarriedItems i = map (\(x,y)->(x,fromJust y)) (filter (isJust . snd) (listItems i)) listCarriedItemsUniqueType :: Inventory -> [(Position,ItemType)] listCarriedItemsUniqueType = nubBy (\x y -> (snd x)==(snd y)) . listCarriedItems listCarriedItemsUniqueObject :: Inventory -> [(Position,ItemType)] listCarriedItemsUniqueObject = (filter f) . listCarriedItems where f (LeftHand,Weapon{hands=2})=False f _=True getCarriedItem :: Inventory -> Position -> Either InventoryError (Maybe ItemType) getCarriedItem (Inventory {invItems=m,invBagCapacity=sz}) pos=do p2<- checkPos sz pos return (M.lookup p2 m) listActiveItems :: Inventory -> [ItemType] listActiveItems i= (map snd (filter (isActive . fst) (listCarriedItems i))) isActive :: Position -> Bool isActive (Bag {})=False isActive _ =True listAllowedPositions :: Inventory -> ItemType -> [(Position,Maybe ItemType)] listAllowedPositions i it=filter ((positionAllowed it) . fst) (listItems i) positionAllowed :: ItemType -> Position -> Bool -- everything can go in the bag positionAllowed _ (Bag {})=True positionAllowed (Weapon {}) RightHand=True positionAllowed (Weapon {}) LeftHand=True -- only armor on body positionAllowed (Armor {}) Body=True -- only helmer on head positionAllowed (Helmet {}) Head=True positionAllowed (Shield {}) RightHand=True positionAllowed (Shield {}) LeftHand=True positionAllowed _ Body=False positionAllowed _ Head=False positionAllowed _ RightHand=False positionAllowed _ LeftHand=False