packages feed

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))}