Inventory.hs

-- | 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}
        | Trap {
                itName::String,
                damageLow::Int, 
                damageHigh::Int,
                triggerDescription::String
                }
        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 | MindPotion 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 (needSndDrop it1)
        return (iv2,catMaybes [it1,it2])
takeTwoHandsItem (i,it1) it@(Weapon {hands=2}) LeftHand= do
        (iv2,it2) <- takeItem' i it RightHand (needSndDrop it1)
        return (iv2,catMaybes [it1,it2])
takeTwoHandsItem (i,it1)  _ _=do
        return (i,catMaybes [it1])
        
needSndDrop :: Maybe ItemType -> Bool
needSndDrop (Just (Weapon {hands=2}))=False
needSndDrop _=True

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 i2 (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