MazesOfMonad-1.0: src/MoresmauJP/Rpg/MazeObjects.hs
-- | Handling of items in the maze
-- (c) JP Moresmau 2009
module MoresmauJP.Rpg.MazeObjects where
import Control.Monad
import Data.List
import Data.Maybe
import qualified Data.Map as M
import MoresmauJP.Maze1.Maze
import MoresmauJP.Rpg.Character
import MoresmauJP.Rpg.Inventory hiding (dropItem)
import MoresmauJP.Rpg.Items
import MoresmauJP.Rpg.Magic
import MoresmauJP.Rpg.NPC
import MoresmauJP.Util.Lists
import MoresmauJP.Util.Random
import Text.Printf
data MazeObjects= MazeObjects {
items::(M.Map Cell [ItemType]),
npcs::(M.Map Cell NPCCharacter)
}
deriving (Read,Show,Eq)
data MazeOptions = MazeOptions {
itemProportion::Int,
npcProportion::Int
}
deriving (Read,Show)
generateObjects :: (Monad m)=>Maze -> MazeOptions -> Int -> RandT m MazeObjects
generateObjects mz options characterLevel =do
let ratio=((fromIntegral characterLevel/10.0) ** 2)::Float
-- less items as we progress
let realItemProportion=(fromIntegral $ itemProportion options) / ratio
itemMap<-generateItems (size mz) realItemProportion
npcMap<-generateNPCs mz (fromIntegral $ npcProportion options) characterLevel
return (MazeObjects itemMap npcMap)
generateItems :: (Monad m)=>Size -> Float -> RandT m (M.Map Cell [ItemType])
generateItems sz proportion=do
cellsWithItems<-getCellWithItems sz proportion
let occ=occurenceList itemOccurences
--print occ
foldM (\m cell -> do
it <- generateScroll =<< randomPickp occ
let m2=case M.lookup cell m of
Nothing->M.insert cell [it] m
Just its->M.insert cell (it:its) m
return m2) M.empty cellsWithItems
generateScroll :: (Monad m) => ItemType -> RandT m (ItemType)
generateScroll (Scroll "" "" g)=do
s<-randomPickp allSpells
return (Scroll (printf "Scroll of %s" (spellName s)) (spellName s) g)
generateScroll it=return it
generateNPCs :: (Monad m)=> Maze -> Float -> Int -> RandT m (M.Map Cell NPCCharacter)
generateNPCs mz proportion characterLevel=do
cellsWithItems<-(getCellWithItems (size mz) proportion)
let cells2=delete (start mz) cellsWithItems
let occ=occurenceList (getNPCOccurences characterLevel)
--print occ
foldM (\m cell -> do
t <- randomPickp occ
case M.lookup cell m of
Nothing->do
c<-generateFromTemplate t
return (M.insert cell c m)
Just _->return m
) M.empty cells2
--getCellWithItems ::Size -> Float -> Rand [Cell]
getCellWithItems (w,h) proportion=do
let nb=round (fromIntegral (h*w)/proportion)
replicateM nb (getCellWithItems' (w,h))
--getCellWithItems' :: Size -> Rand Cell
getCellWithItems' (w,h) =do
cellx<-getRandomRange (1,w)
celly<-getRandomRange (1,h)
return (cellx,celly)
listItems :: GameWorld -> MazeObjects -> [ItemType]
listItems gw mo =fromMaybe [] $ M.lookup (position gw) (items mo)
takeItem :: GameWorld -> MazeObjects -> ItemType -> MazeObjects
takeItem gw mo it=
let its=fromJust $ M.lookup (position gw) (items mo)
in mo{items=(M.insert (position gw) (delete it its) (items mo))}
dropItem :: GameWorld -> MazeObjects -> ItemType -> MazeObjects
dropItem gw mo it=
let its=case M.lookup (position gw) (items mo) of
Just its-> its
Nothing->[]
in mo{items= (M.insert (position gw) (it:its) (items mo))}
getNPC:: GameWorld -> MazeObjects -> Maybe NPCCharacter
getNPC gw mo = M.lookup (position gw) (npcs mo)
killNPC :: GameWorld -> MazeObjects -> Character -> (MazeObjects,Character,Gold)
killNPC gw mo c@(Character {inventory=inv})= let
killed=fromJust $ M.lookup (position gw) (npcs mo)
killedItems=map snd (listCarriedItems $ inventory $ npcCharacter killed)
mo2=foldl (\mazeobj item->dropItem gw mazeobj item) mo killedItems
extraGold=getGold $ inventory $ npcCharacter killed
c2=c{inventory=addGold inv extraGold}
in (mo2{npcs= (M.delete (position gw) (npcs mo2))},c2,extraGold)
updateNPC :: GameWorld -> MazeObjects -> NPCCharacter -> MazeObjects
updateNPC gw mo npc= mo{npcs= (M.insert (position gw) npc (npcs mo))}