packages feed

MazesOfMonad 1.0.3 → 1.0.4

raw patch · 22 files changed

+623/−202 lines, 22 filesdep ~base

Dependency ranges changed: base

Files

MazesOfMonad.cabal view
@@ -1,5 +1,5 @@ Name:                MazesOfMonad
-Version:             1.0.3
+Version:             1.0.4
 Description:         MazesOfMonad is a console-based Role Playing Game. You create characters
 	with their strong and weak points, and try to complete mazes that are randomly generated. You can pick up gold and items on the way,
 	meet monsters, and deal with them as you want. You can fight, use magic, bribe, trade, steal... This is only a simple game that I did to see what building a 
@@ -12,7 +12,7 @@ Maintainer:          jpmoresmau@gmail.com
 Synopsis:            Console-based Role Playing Game
 Build-Type:          Simple
-Build-Depends:       base, HUnit, random, 
+Build-Depends:       base >= 3 && < 4, HUnit, random, 
 	regex-posix, containers, filepath, directory, pretty, haskell98, 
 	array, mtl, old-locale, time
 tested-with:         GHC==6.10.1
TODO.txt view
@@ -1,12 +1,7 @@-- traps in maze (can be detected) -> will change mazeobjects format hence current games would be lost, maybe try to ensure backwards compatibility
-- npcs can choose to bribe/pray/escape
+- traps in maze (can be detected) 
+	-> will change mazeobjects format hence current games would be lost, maybe try to ensure backwards compatibility
+	-> when level improve, more traps
 - npcs can use magic?
-- difficulty level
-	- npc attitude down (except peddlers?)
-	- traps up
-	- items down
-- when trading, show which items are better than what we have in hands or on body
-- show hints on NPC health/status
 
-- potions that can restore mental points
-- disconnect serialization of item/spell names from their characteristics (characteristics stay in code) -> will change format
+- when trading, show which items are better than what we have in hands or on body? Maybe this is too much information...
+
WHATSNEW.txt view
@@ -1,3 +1,12 @@+1.0.4:
+	Feature: Mind Potions can restore mental points (only in new mazes created with 1.0.4 version)
+	UI: When meeting and fighting a NPC, you see its attitude and status (physical and mental)
+	Internal: Attitude of NPCs is worse as your character improves
+	Internal: More chances to have exceptional failure or success (1 in 20 of each, as with normal d20 rules)
+	Feature: NPCs can decide to escape, offer you gold or pray for mercy if the fight takes a bad turn for them
+	Internal: Data is now stored in getAppUserDataDirectory "MazesOfMonad" instead of getAppUserDataDirectory "RPG". Copy your data over!
+	Feature: Characters and NPCs get back mental/physical points when times go (depending on balance/constitution)
+	
 1.0.3:
 	Fix: picking up a two-handed weapon when you had a different weapon in each hand caused the disappearance of one of the two weapons
 	Internal: use a Writer monad to manage messages
src/MoresmauJP/Core/Screen.hs view
@@ -11,25 +11,36 @@ 
 import MoresmauJP.Util.Random
 
-data Screen a = Screen {actions::[Action a]}
+-- | a Screen represent a certain UI state, with possible actions
+data Screen a = Screen {
+	actions::[Action a] -- ^ possible action in that screen
+	}
 
+-- | Action doable in the ui
 data Action a = Action {
-	actionName::String,
-	actionDescription::String,
-	actionFunction::(ActionFunction a)
+	actionName::String -- ^ the name of the action (what to type)
+	, actionDescription::String -- ^ the description (showed when using help)
+	, actionFunction::(ActionFunction a) -- ^ the function to call
 	}
 
+-- | a Monad transformer, wrapping state (a), IO and Random
 type ScreenT a b= (RandT (StateT a IO)) b 
 
-
+-- | Screen Message to display
 type ScreenMessage = String
+
+-- | Screen Messages
 type ScreenMessages = [ScreenMessage]
 
+-- | add a ScreenMessage to the current messages
 addScreenMessage :: (MonadWriter ScreenMessages m,Monad m)=> ScreenMessage -> m ()
 addScreenMessage msg=tell [msg]
 	
-
+-- | A Monad Transformer, ScreenT with GameState and returning Widgets
 type GSWScreenT a= ScreenT (GameState a) (Widget a)
+
+-- | The real Monad Transformer used: allows to write messages, get random number, stores
+-- a state of a GameState containing a, returning Widgets
 type WScreenT a=WriterT ScreenMessages (RandT (StateT (GameState a) IO)) (Widget a)
 
 instance (Monad m) =>  MonadRandom (WriterT ScreenMessages (RandT m)) where
@@ -37,26 +48,60 @@ 	getSplit = lift getSplit
 
 
-	
+-- | An Action function get its arguments typed in the GUI and works in a WScreenT
 type ActionFunction a = [String] -> WScreenT a
 
-data GameState a = GameState {gsData::a,
-	screen::Maybe (Screen a)
+-- | GameState: the data (a) and the current screen
+data GameState a = GameState {gsData::a -- ^ the data
+	, screen::Maybe (Screen a) -- ^ the current screen
 	}
 
-data Widget a= WText String |
-	WList [String] |
-	WInput [String] (String -> WScreenT a) |
-	WCombo [String] [String] (String -> WScreenT a) |
-	WCheck [String] String Bool (Bool -> WScreenT a) |
-	WNothing
+-- | Widgets are the actual ui component returned by an action
+data Widget a= 
+	-- | simple line of text
+	WText {
+		wtext::String -- ^ line of text
+		}
+	-- | list of items
+	| WList {witems :: [String] -- ^ lines of text
+		} 
+	-- | ask for the user to type in a string
+	| WInput {
+		witems :: [String] -- ^ lines of text
+		, wact::(String -> WScreenT a) -- ^ handler action
+		}
+	-- | choose an item from a list
+	| WCombo {
+		witems :: [String] -- ^ lines of text
+		,wlist :: [String] -- ^ list items
+		,wact :: (String -> WScreenT a) -- ^ handler action
+		}
+	-- | asks a yes/no question 
+	| WCheck {
+		witems :: [String]  -- ^ lines of text
+		,wquestion :: String -- ^ question 
+		,wdefault :: Bool -- ^ default answer 
+		,wbact :: (Bool -> WScreenT a) -- ^ handler action
+		}
+	-- | placeholder for no action 
+	| WNothing
 
+-- | a widget and a gamestate
 type ScreenState a = (Widget a,GameState a)
 
-getShowCombo :: Show b => [String] -> [b] ->  ((ComboResult b) -> WScreenT a) -> Widget a
+-- | get a Combo widget that uses the show method of the objects passed to automatically build the list
+getShowCombo :: Show b => [String] -- ^ lines of text
+	-> [b] -- ^ objects to display in list 
+	->  ((ComboResult b) -> WScreenT a) -- ^ handler action (gets the selected object as parameter
+	-> Widget a -- ^ the resulting widget
 getShowCombo= getMappedCombo show
 
-getMappedCombo :: (b->String) -> [String] -> [b] ->  ((ComboResult b) -> WScreenT a) -> Widget a
+-- | get a Combo widget that uses an arbitrary method of the objects passed to automatically build the list
+getMappedCombo :: (b->String) -- ^ the method to use to translate the object in a string from the menu
+	-> [String] -- ^ lines of text
+	-> [b] -- ^ objects to display in list 
+	->  ((ComboResult b) -> WScreenT a) -- ^ handler action (gets the selected object as parameter
+	-> Widget a -- ^ the resulting widget
 getMappedCombo myShow s objs af=
 	let 
 		objWithNames=map (\x->(x,myShow x)) objs
@@ -73,11 +118,16 @@ 						)
 	in (WCombo s (map snd objWithNames) af2)
 		
-getPretypedWidget :: Widget a -> [String] -> WScreenT a
+-- | checks if the rest of the command line is already an option from the menu
+getPretypedWidget :: Widget a -- ^ the original widget
+	-> [String] -- ^ the rest of the parameters typed by the user
+	-> WScreenT a -- ^ the result
 getPretypedWidget wc@(WCombo _ choices af) (typed:_) = do
+	-- see if the next parameter is a number corresponding to one of the items in the list
 	let chosen=filter (\(x,_)->x==typed) (zipWith (\a b -> ((show a),b)) [1..] choices)
 	if (null chosen)
 		then return wc
+		-- we have a match, run the action
 		else af (snd $ head chosen)
 getPretypedWidget w _=return w
 		
@@ -86,27 +136,23 @@ 	let names=(map actionName aa) \\ (map actionName ab)
 	in filter (\a -> elem (actionName a) names) aa
 
-data ComboResult a= Empty | Unknown String | Exact a
+-- | result from a user action
+data ComboResult a= Empty -- ^ no result, nothing chosen
+	 | Unknown String -- ^ unknown result (typed something not in a list)
+	 | Exact a -- ^ proper choice
 	deriving (Show,Read)
 	
-start :: ScreenState a -> IO(a)
-start gs = 
-	do
-		commandLoop gs
-		
-commandLoop :: ScreenState a -> IO(a)
-commandLoop (w,gs)=do
+-- | start a UI loop
+start :: ScreenState a -- ^ initial state
+	-> IO(a) -- ^ result
+start (w,gs)=do
 	GameState s2 _ <- ioRandT (commandLoop2 w) gs
-	--sg<-getStdGen
-	--GameState s2 _ <- execStateT (evalRandT (runWriterT $ commandLoop2 w) (ProductionRandom sg)) gs
-	
 	return s2
 	
-commandLoop2 :: Widget a -> GSWScreenT a
+-- | internal UI loop
+commandLoop2 :: Widget a -- ^ current widget to render 
+	-> GSWScreenT a -- ^ screen monad we run in
 commandLoop2 w = do
-	--msgs <- lift $ getMessages
-	--listen
-	--when (not $ null msgs) (liftIO $ (mapM_ putStrLn (reverse msgs)))								
 	af<- liftIO $ renderWidget w
 	scr <- gets screen
 	if (isJust scr)
@@ -115,7 +161,7 @@ 				then
 					do
 						(w2,msgs) <-runWriterT $ fromJust af
-						when (not $ null msgs) (liftIO $ (mapM_ putStrLn (reverse msgs)))	
+						when (not $ null msgs) (liftIO $ (mapM_ putStrLn msgs))	
 						commandLoop2 w2
 				else		
 					do
@@ -135,8 +181,9 @@ 		else
 			return WNothing
 
-
-renderWidget :: Widget a -> IO(Maybe(WScreenT a))
+-- | render a widget onto the console
+renderWidget :: Widget a -- ^ the widget to render	
+	-> IO(Maybe(WScreenT a)) -- ^ the result (may be empty)
 renderWidget (WNothing)= do
 	return Nothing
 renderWidget (WText s)= do
@@ -169,14 +216,16 @@ 	if null chosen
 		then return (Just $ af "")
 		else return (Just $ af (snd $ head chosen))
-				
-getArgs :: IO([String])				
+			
+-- | get arguments typed in at the command line	
+getArgs :: IO([String])	-- ^ the resulting arguments			
 getArgs = do
 	input <- getLine
 	return (words input)
 
-			
-help :: Bool -> ActionFunction a
+-- | show help with available commands			
+help :: Bool -- ^ display help on system commands too? 
+	-> ActionFunction a -- ^ the handler function 
 help withSystem _ = do
 	let	f (Action s1 s2 _)= (s1++": "++s2)
 	let	sysLines= if withSystem
@@ -186,36 +235,46 @@ 	let acts=actions $ fromJust $ screen gs
 	let wl=WList (sort ( sysLines ++
 			(map f acts)))
-	tell ["help1"]
-	tell ["help2"]
 	return (wl) 
 
-unknown ::ActionFunction a
+-- | default handler for unknown actions
+unknown :: ActionFunction a
 unknown args = return (WText ("I do not understand the command " ++ (head args)))
 
+-- | quit the game action
 quit :: ActionFunction a
 quit _ = do
 	modify (\gs->gs{screen=Nothing})
 	return (WText ("Bye bye, hope you enjoyed the game!")) 
 
-choice :: [String] -> ActionFunction a
+-- | when several actions could fit what the user typed, display the list of full names
+choice :: [String] -- ^ possible actions
+	-> ActionFunction a -- ^ resulting handler
 choice ss _ = return (WList ss)
 
-backAction :: Screen a -> Action a
+-- | back action
+backAction :: Screen a -- ^ Screen to go back to 
+	-> Action a -- ^ resulting action
 backAction sc=Action "back" "Go back to main screen" (back sc)
 
-back :: Screen a -> ActionFunction a
+-- | back handler
+back :: Screen a -- ^ Screen to go back to 
+	-> ActionFunction a -- ^ result
 back sc _ =do
 	(GameState a _) <- get
 	put (GameState a (Just sc))
 	return (WText "Back")
 
+-- | default system actions
 systemActions :: [Action a]
 systemActions = [Action "help" "Provides help on available actions" (help True)
 	,Action "?" "Provides help on available actions" (help True)
 	,Action "quit" "Exit the game" quit]
 				
-getAction :: String -> [Action a] -> ActionFunction a
+-- | get action from what the user typed and the possible actions
+getAction :: String -- ^ the first word the user typed 
+	-> [Action a] -- ^ the possible actions 
+	-> ActionFunction a -- ^ the chosen action handler
 getAction "help" _ = help True
 getAction cmd acts =
 	let	
@@ -229,36 +288,18 @@ 			actionFunction $ head possible
 		else 
 			choice (map (\(Action s1 _ _)->s1) possible)
-	
-{--
-combineActionAfterIO :: ScreenState a -> ActionFunction a -> Event -> IO (ScreenState a)
-combineActionAfterIO ss1@(w1,gs) af e = do
-	(w2,gs2)<-af e gs 
-	return (combineWidget w1 w2,gs2)
 
-combineActionBeforeIO :: ScreenState a -> ActionFunction a -> Event -> IO (ScreenState a)
-combineActionBeforeIO ss1@(w1,gs) af e = do
-	(w2,gs2)<-af e gs 
-	return (combineWidget w2 w1,gs2)
---}	
-{--combineActionAfter :: Widget a -> [String] -> ActionFunction a
-combineActionAfter w1 cmds= do 
-	w2<-af cmds
-	return (combineWidget w1 w2)
-	--}
-	
-{--
-combineActionBefore :: ScreenState a -> PureActionFunction a ->  [String] -> ScreenState a
-combineActionBefore ss1@(w1,gs) af e =
-	let (w2,gs2)=af e gs 
-	in (combineWidget w2 w1,gs2)
-	--}
-
-combineMaybeWidget :: Widget a -> Maybe (Widget a) -> Widget a
+-- | combine a widget with maybe another
+combineMaybeWidget :: Widget a -- ^ initial widget 
+	-> Maybe (Widget a) -- ^ next widget 
+	-> Widget a -- ^ resulting widget
 combineMaybeWidget w Nothing = w
 combineMaybeWidget w1 (Just w2) =combineWidget w1 w2
 	
-combineWidget :: Widget a -> Widget a -> Widget a
+-- | combine a widget with another	
+combineWidget :: Widget a -- ^ initial widget 
+	-> Widget a -- ^ next widget 
+	-> Widget a -- ^ resulting widget
 combineWidget WNothing a=a
 combineWidget a WNothing=a
 combineWidget (WText s1) (WText s2)=WList [s1,s2]
src/MoresmauJP/Rpg/Actions.hs view
@@ -85,7 +85,7 @@ processAction c cs d roll= do
 	let 
 		avgCs=score c cs
-		myScore=bindInt (1,19) (avgCs+d)
+		myScore=bindInt (1,20) (avgCs+d)
 		(rr,em)=evalResult roll myScore
 		expGain=experienceGain myScore em (length cs)
 		previousNormal=map (getCharacteristic' c Normal) allCharacteristics
@@ -103,9 +103,11 @@ 	
 evalResult:: Int -> Int -> RollResultExp
 evalResult roll score
-	| (roll < (div score 5)) = (Success Exceptional (score-roll),4)
-	| (roll < (div score 2)) = (Success Remarkable (score-roll),3)
-	| (roll <= score) = (Success Standard (score-roll),2)
+	| roll==20                    = (Failure Exceptional (max 2 (roll-score)),1)
+	| roll==1                     = (Success Exceptional (max 2 (score-roll)),1)
+	| (roll < (div score 5)) 	  = (Success Exceptional (score-roll),4)
+	| (roll < (div score 2)) 	  = (Success Remarkable (score-roll),3)
+	| (roll <= score)             = (Success Standard (score-roll),2)
 	| (roll > (20-(div score 5))) = (Failure Exceptional (roll-score),1)
 	| (roll > (20-(div score 2))) = (Failure Remarkable (roll-score),1)
 	| otherwise  = (Failure Standard (roll-score),1)
@@ -142,10 +144,21 @@ subsequentDifficulty Exceptional=6
 
 resultMultiplier :: Grade -> Int -> Float
-resultMultiplier Standard i= fromIntegral i ** 1.5
-resultMultiplier Remarkable i= fromIntegral i ** 2
-resultMultiplier Exceptional i= fromIntegral i ** 3
+resultMultiplier Standard i= fromIntegral i * 2
+resultMultiplier Remarkable i= fromIntegral i * 4
+resultMultiplier Exceptional i= fromIntegral i * 10
 
+{--
+resultMultiplierSc :: Grade -> Int -> Float
+resultMultiplierSc Standard i= fromIntegral $ div i 4 
+resultMultiplierSc Remarkable i= fromIntegral $ div i 2 
+resultMultiplierSc Exceptional i= fromIntegral i
+
+resultMultiplierScale :: Int -> RollResult -> Int
+resultMultiplierScale i (Failure gr d)=max 0 (i  - (round $ resultMultiplierSc gr (abs d)))
+resultMultiplierScale i (Success gr d)=i + (round $ resultMultiplierSc gr d)
+--}
+
 resultMultiplierHigh :: Int -> RollResult -> Int
 resultMultiplierHigh i (Failure gr d)=max 0 (i  - round((fromIntegral i * (resultMultiplier gr d))/100))
 resultMultiplierHigh i (Success gr d)=i + round ((fromIntegral i * (resultMultiplier gr d))/100)
@@ -163,3 +176,11 @@ 	| Remarkable
 	| Exceptional
 	deriving (Show,Enum,Read,Eq)
+
+	
+testRM = do
+	mapM (s 10) [(Success x y) | x<-[Standard .. Exceptional],y<-[1,5,10,15,20]]
+	where s i rr=do
+		putStrLn (printf "High: %d %s -> %d" i (show rr) (resultMultiplierHigh i rr))
+		putStrLn (printf "Low: %d %s -> %d" i (show rr) (resultMultiplierLow i rr))
+		--putStrLn (printf "Scale: %d %s -> %d" i (show rr) (resultMultiplierScale i rr))
src/MoresmauJP/Rpg/ActionsTests.hs view
@@ -28,8 +28,8 @@ 	((_,rr),_)<-evalRandT (runWriterT $ action jp [Dexterity] (toIntLevel VeryEasy)) sg
 	assertEqual "Not standard success 9" (Success Standard 9) rr
 	((_,rr),_)<-evalRandT (runWriterT $ action jp [Dexterity] (toIntLevel NearUnmissable)) sg
-	assertEqual "Not standard success 9" (Success Standard 9) rr
-			
+	assertEqual "Not standard success 10" (Success Standard 10) rr
+		
 	((_,rr),_)<-evalRandT (runWriterT $ action jp [Dexterity] (toIntLevel RatherHard)) sg
 	assertEqual "Not standard failure 3" (Failure Standard 3) rr
 	((_,rr),_)<-evalRandT (runWriterT $ action jp [Dexterity] (toIntLevel Hard)) sg
src/MoresmauJP/Rpg/Arena.hs view
@@ -22,7 +22,7 @@ 
 import Text.Printf
 
-data ExitStatus=Death | Victory | Flight | Finished
+data ExitStatus=Death | Victory | Flight | Finished | EnnemyFlight
 	deriving (Show,Read,Eq,Ord,Enum,Bounded)
 
 data ExitState=ExitState {
@@ -39,18 +39,19 @@ 	es::Maybe ExitStatus,
 	chToHit::Bool,
 	arenaItems::[ItemType],
-	arenaTickCount::Int
+	arenaTickCount::Int,
+	fightInfo::FightInfo
 	} deriving (Show,Read)
 
 screenInteract :: Character -> NPCCharacter -> RandomWrapper -> Int -> IO (ExitState)
 screenInteract c1 c2 rw tc= do
-	let ar=Arena c1 c2 Nothing True [] tc
+	let ar=Arena c1 c2 Nothing True [] tc newFightInfo
 	let initialstate=GameState ar (Just (Screen []))
 	evalStateT (evalRandT (screenInteract' c2) rw) initialstate
 
 screenInteract' :: NPCCharacter -> (RandT (StateT (GameState Arena) IO)) ExitState
 screenInteract' c2 = do
-	let wEncounter=WText (printf "You meet a %s " (name $ npcCharacter c2))
+	let wEncounter=WText (printf "You meet a %s." (ppNPC c2))
 	initial<-getInitialAttitude c2
 	(w,msgs)<-case initial of
 		NPCFight -> do
@@ -162,28 +163,73 @@ fightInArena' :: WScreenT Arena
 fightInArena' = do
 	gs <- get
-	let ar@(Arena {arenaCharacter=c1,arenaOpponent=c2,chToHit=chToHit}) = gsData gs
-	((c1b,c2b),isDead) <- (case chToHit of
-		True -> giveBlow c1 (npcCharacter c2)
-		False -> liftM swapFS (giveBlow (npcCharacter c2) c1))
-	let ar2=ar{arenaCharacter=c1b,arenaOpponent=(c2{npcCharacter=c2b}),chToHit=not chToHit}
-	arenaTick ar2
-	--let w=WList (map show msgs)
-	if isDead
-		then
-			do
-			let (status,txt)=if (isOutOfService c1b)
-					then (Death,"You're killed!")
-					else (Victory,"You triumph!")
-			put (gs{gsData=ar2{es=Just status},screen=Nothing})
+	let ar@(Arena {arenaCharacter=c1,arenaOpponent=c2,chToHit=chToHit,fightInfo=fightInfo}) = gsData gs
+	-- here NPC can decide to escape, bribe or pray if chToHit==false
+	(fightAttitude,fi2)<-if not chToHit
+		then getFightAttitude c2 fightInfo
+		else return (ContinueFight,fightInfo)
+	let ar2=ar{fightInfo=fi2}
+	put (gs{gsData=ar2})
+	case fightAttitude of
+		ContinueFight -> do
+			((c1b,c2b),isDead) <- (case chToHit of
+				True -> giveBlow c1 (npcCharacter c2)
+				False -> liftM swapFS (giveBlow (npcCharacter c2) c1))
+			let npc2=(c2{npcCharacter=c2b})
+			let fi3=addNPCLosses (addCharacterLosses fi2 c1 c1b) c2 npc2
+			let ar3=ar2{arenaCharacter=c1b,arenaOpponent=npc2,chToHit=not chToHit,fightInfo=fi3}
+			arenaTick ar3
+			--let w=WList (map show msgs)
+			if isDead
+				then
+					do
+					let (status,txt)=if (isOutOfService c1b)
+							then (Death,"You're killed!")
+							else (Victory,"You triumph!")
+					put (gs{gsData=ar3{es=Just status},screen=Nothing})
+					return (WText txt)
+				else
+					do
+					w2<- if (not chToHit)
+						then choiceArena
+						else fightInArena'
+					return w2
+		OfferBribe gold -> do
+			let txt=printf "The %s offers you %d gold coins for your mercy!" (name $ npcCharacter c2) gold
+			return $ WCheck [txt] "Do you accept?" True (bribeResponse gold)
+		PrayForClemency -> do
+			let txt=printf "The %s begs you for mercy!" (name $ npcCharacter c2)
+			return $ WCheck [txt] "Do you accept?" True prayResponse
+		TryEscape -> do
+			-- attitude gets better: if the npc escaped, he'll be less likely to attack next time
+			let npc2=c2{npcAttitude=max 20 ((npcAttitude c2)+2)}
+			put (gs{gsData=ar2{arenaOpponent=npc2,es=Just EnnemyFlight},screen=Nothing})
+			let txt=printf "The %s escapes!" (name $ npcCharacter c2)
 			return (WText txt)
-		else
-			do
-			w2<- if (not chToHit)
-				then choiceArena
-				else fightInArena'
-			return w2
 
+bribeResponse :: Int -> Bool -> WScreenT Arena
+bribeResponse _ False= choiceArena
+bribeResponse gold True= do
+	gs <- get
+	let ar@(Arena {arenaCharacter=c1,arenaOpponent=npc2}) = gsData gs
+	let c2=addCharacterGold (npcCharacter npc2) (-gold)
+	let me2=addCharacterGold c1 gold
+	let ar2=ar{arenaCharacter=me2,arenaOpponent=npc2{npcAttitude=20,npcCharacter=c2}}
+	put (gs{gsData=ar2{es=Just Finished},screen=Nothing})
+	let txt=printf "You take the gold and let the %s go!" (name $ c2)
+	return (WText txt)
+
+prayResponse :: Bool -> WScreenT Arena
+prayResponse False= choiceArena
+prayResponse True= do
+	gs <- get
+	let ar@(Arena {arenaOpponent=c2}) = gsData gs
+	let ar2=ar{arenaOpponent=c2{npcAttitude=20}}
+	put (gs{gsData=ar2{es=Just Finished},screen=Nothing})
+	let txt=printf "You let the %s go!" (name $ npcCharacter c2)
+	return (WText txt)
+	
+
 castInArena :: WScreenT Arena
 castInArena = do
 	(Arena {arenaCharacter=c1,arenaOpponent=c2}) <- gets gsData
@@ -199,9 +245,11 @@ castInArena' (Unknown _)= choiceArena
 castInArena' (Exact spell)=do
 	gs <- get
-	let ar@(Arena {arenaCharacter=c1,arenaOpponent=c2,arenaTickCount=tc}) = gsData gs
+	let ar@(Arena {arenaCharacter=c1,arenaOpponent=c2,arenaTickCount=tc,fightInfo=fightInfo}) = gsData gs
 	((c1b,c2b),dead) <- spellToOpponent c1 (npcCharacter c2) spell tc
-	let ar2=ar{arenaCharacter=c1b,arenaOpponent=(c2{npcCharacter=c2b}),chToHit=False}
+	let npc2=(c2{npcCharacter=c2b})
+	let fi2=addNPCLosses (addCharacterLosses fightInfo c1 c1b) c2 npc2
+	let ar2=ar{arenaCharacter=c1b,arenaOpponent=npc2,chToHit=False,fightInfo=fi2}
 	arenaTick ar2
 	--let w=WList (map show msgs)
 	if dead
@@ -283,8 +331,9 @@ choiceArena = do
 	ar<-gets gsData
 	let status=getHealthSummary (arenaCharacter ar)
+	let statusOpp=printf "You're fighting a %s." (ppNPC (arenaOpponent ar))
 	let actions=getPossibleArenaActions (arenaCharacter ar) (arenaOpponent ar)
-	return (getShowCombo (["Your health:"]++status++["Choose next action"]) actions choiceArenaF)
+	return (getShowCombo (["Your health:"]++status++[statusOpp]++["Choose next action"]) actions choiceArenaF)
 
 choiceArenaF :: ComboResult ArenaAction -> WScreenT Arena
 choiceArenaF (Exact Escape)=do
src/MoresmauJP/Rpg/ArenaTests.hs view
@@ -30,7 +30,7 @@ 	let v1=(createTestNPC "Victim")
 	let vc1=(npcCharacter v1){inventory=makeFullInventory [(Bag 1,item)] 10 100}
 	let victim=v1{npcCharacter=vc1}
-	let arena=Arena jp victim Nothing True [] 0
+	let arena=Arena jp victim Nothing True [] 0 newFightInfo
 	let gs=GameState arena Nothing
 	gs2<- execStateT (evalRandT (runWriterT stealInArena) (mkTestWrapper [12])) gs
 	let arena2=gsData gs2
@@ -48,7 +48,7 @@ 	let v1=(createTestNPC "Victim")
 	let vc1=(npcCharacter v1){inventory=makeFullInventory [(Bag 1,item)] 10 100}
 	let victim=v1{npcCharacter=vc1}
-	let arena=Arena jp victim Nothing True [] 0
+	let arena=Arena jp victim Nothing True [] 0 newFightInfo
 	let gs=GameState arena Nothing
 	gs2<- execStateT (evalRandT (runWriterT stealInArena) (mkTestWrapper [20])) gs
 	let arena2=gsData gs2
@@ -66,7 +66,7 @@ 	let v1=(createTestNPC "Victim")
 	let vc1=(npcCharacter v1){inventory=makeFullInventory [(Bag 1,item)] 10 100}
 	let victim=v1{npcCharacter=vc1}
-	let arena=Arena jp victim Nothing True [] 0
+	let arena=Arena jp victim Nothing True [] 0 newFightInfo
 	let gs=GameState arena Nothing
 	gs2<- execStateT (evalRandT (runWriterT stealInArena) (mkTestWrapper [8])) gs
 	let arena2=gsData gs2
@@ -84,7 +84,7 @@ 	let v1=(createTestNPC "Victim")
 	let vc1=(npcCharacter v1){inventory=makeFullInventory [] 10 100}
 	let victim=v1{npcCharacter=vc1}
-	let arena=Arena jp victim Nothing True [] 0
+	let arena=Arena jp victim Nothing True [] 0 newFightInfo
 	let gs=GameState arena Nothing
 	gs2<- execStateT (evalRandT (runWriterT stealInArena) (mkTestWrapper [8])) gs
 	let arena2=gsData gs2
@@ -101,7 +101,7 @@ 	let v1=(createTestNPC "Victim")
 	let vc1=(npcCharacter v1){inventory=makeFullInventory [(Bag 1,item)] 10 100}
 	let victim=v1{npcCharacter=vc1}
-	let arena=Arena jp victim Nothing True [] 0
+	let arena=Arena jp victim Nothing True [] 0 newFightInfo
 	let gs=GameState arena Nothing
 	gs2<- execStateT (evalRandT (runWriterT stealInArena) (mkTestWrapper [4])) gs
 	let arena2=gsData gs2
@@ -121,7 +121,7 @@ 	let v1=(createTestNPC "Victim")
 	let vc1=(npcCharacter v1){inventory=makeFullInventory [] 10 0}
 	let victim=v1{npcCharacter=vc1}
-	let arena=Arena jp victim Nothing True [] 0
+	let arena=Arena jp victim Nothing True [] 0 newFightInfo
 	let gs=GameState arena Nothing
 	gs2<- execStateT (evalRandT (runWriterT stealInArena) (mkTestWrapper [8])) gs
 	let arena2=gsData gs2
@@ -138,7 +138,7 @@ 	let v1=(createTestNPC "Victim")
 	let vc1=(npcCharacter v1){inventory=makeFullInventory [(Bag 1,item)] 10 100}
 	let victim=v1{npcCharacter=vc1}
-	let arena=Arena jp victim Nothing True [] 0
+	let arena=Arena jp victim Nothing True [] 0 newFightInfo
 	let gs=GameState arena Nothing
 	gs2<- execStateT (evalRandT (runWriterT convertInArena) (mkTestWrapper [12])) gs
 	let arena2=gsData gs2
@@ -156,7 +156,7 @@ 	let v1=(createTestNPC "Victim")
 	let vc1=(npcCharacter v1){inventory=makeFullInventory [(Bag 1,item)] 10 100}
 	let victim=v1{npcCharacter=vc1}
-	let arena=Arena jp victim Nothing True [] 0
+	let arena=Arena jp victim Nothing True [] 0 newFightInfo
 	let gs=GameState arena Nothing
 	gs2<- execStateT (evalRandT (runWriterT convertInArena) (mkTestWrapper [20])) gs
 	let arena2=gsData gs2
@@ -174,7 +174,7 @@ 	let v1=(createTestNPC "Victim")
 	let vc1=(npcCharacter v1){inventory=makeFullInventory [(Bag 1,item)] 10 100}
 	let victim=v1{npcCharacter=vc1}
-	let arena=Arena jp victim Nothing True [] 0
+	let arena=Arena jp victim Nothing True [] 0 newFightInfo
 	let gs=GameState arena Nothing
 	gs2<- execStateT (evalRandT (runWriterT convertInArena) (mkTestWrapper [8])) gs
 	let arena2=gsData gs2
@@ -192,13 +192,13 @@ 	let v1=(createTestNPC "Victim")
 	let vc1=(npcCharacter v1){inventory=makeFullInventory [] 10 100}
 	let victim=v1{npcCharacter=vc1}
-	let arena=Arena jp victim Nothing True [] 0
+	let arena=Arena jp victim Nothing True [] 0 newFightInfo
 	let gs=GameState arena Nothing
 	gs2<- execStateT (evalRandT (runWriterT bribeInArena) (mkTestWrapper [8])) gs
 	let arena2=gsData gs2
 	assertEqual "status not finished" (Just Finished) (es arena2) 
-	assertEqual "victim gold is not 197" 197 (getGold $ inventory $ npcCharacter $ arenaOpponent arena2)
-	assertEqual "gold is not 3" 3 (getGold $ inventory $ arenaCharacter arena2)
+	assertEqual "victim gold is not 196" 196 (getGold $ inventory $ npcCharacter $ arenaOpponent arena2)
+	assertEqual "gold is not 4" 4 (getGold $ inventory $ arenaCharacter arena2)
 	))
 
 testBribeSuccessAttitude=TestLabel "Test Bribe Success Attitude" (TestCase (do
@@ -206,13 +206,13 @@ 	let v1=(createTestNPC "Victim"){npcAttitude=12}
 	let vc1=(npcCharacter v1){inventory=makeFullInventory [] 10 100}
 	let victim=v1{npcCharacter=vc1}
-	let arena=Arena jp victim Nothing True [] 0
+	let arena=Arena jp victim Nothing True [] 0 newFightInfo
 	let gs=GameState arena Nothing
 	gs2<- execStateT (evalRandT (runWriterT bribeInArena) (mkTestWrapper [8])) gs
 	let arena2=gsData gs2
 	assertEqual "status not finished" (Just Finished) (es arena2) 
-	assertEqual "victim gold is not 195" 195 (getGold $ inventory $ npcCharacter $ arenaOpponent arena2)
-	assertEqual "gold is not 5" 5 (getGold $ inventory $ arenaCharacter arena2)
+	assertEqual "victim gold is not 194" 194 (getGold $ inventory $ npcCharacter $ arenaOpponent arena2)
+	assertEqual "gold is not 6" 6 (getGold $ inventory $ arenaCharacter arena2)
 	))
 	
 testBribeFailure=TestLabel "Test Bribe Failure" (TestCase (do
@@ -220,7 +220,7 @@ 	let v1=(createTestNPC "Victim")
 	let vc1=(npcCharacter v1){inventory=makeFullInventory [] 10 100}
 	let victim=v1{npcCharacter=vc1}
-	let arena=Arena jp victim Nothing True [] 0
+	let arena=Arena jp victim Nothing True [] 0 newFightInfo
 	let gs=GameState arena Nothing
 	gs2<- execStateT (evalRandT (runWriterT bribeInArena) (mkTestWrapper [12])) gs
 	let arena2=gsData gs2
@@ -234,7 +234,7 @@ 	let v1=(createTestNPC "Victim")
 	let vc1=(npcCharacter v1){inventory=makeFullInventory [] 10 100}
 	let victim=v1{npcCharacter=vc1}
-	let arena=Arena jp victim Nothing True [] 0
+	let arena=Arena jp victim Nothing True [] 0 newFightInfo
 	let gs=GameState arena Nothing
 	gs2<- execStateT (evalRandT (runWriterT bribeInArena) (mkTestWrapper [8])) gs
 	let arena2=gsData gs2
@@ -249,7 +249,7 @@ 	let v1=(createTestNPC "Victim")
 	let vc1=(npcCharacter v1){inventory=makeFullInventory [] 10 100}
 	let victim=v1{npcCharacter=vc1}
-	let arena=Arena jp victim Nothing True [] 0
+	let arena=Arena jp victim Nothing True [] 0 newFightInfo
 	let gs=GameState arena Nothing
 	gs2<- execStateT (evalRandT (runWriterT bribeInArena) (mkTestWrapper [20])) gs
 	let arena2=gsData gs2
@@ -262,7 +262,7 @@ testPrayerSuccess=TestLabel "Test Prayer Success" (TestCase (do
 	let jp=(createTestChar "JP")
 	let v1=(createTestNPC "Victim")
-	let arena=Arena jp v1 Nothing True [] 0
+	let arena=Arena jp v1 Nothing True [] 0 newFightInfo
 	let gs=GameState arena Nothing
 	gs2<- execStateT (evalRandT (runWriterT prayerInArena) (mkTestWrapper [8])) gs
 	let arena2=gsData gs2
@@ -275,7 +275,7 @@ 	let v1=(createTestNPC "Victim")
 	let vc1=(npcCharacter v1){inventory=makeFullInventory [] 10 100}
 	let victim=v1{npcCharacter=vc1}
-	let arena=Arena jp victim Nothing True [] 0
+	let arena=Arena jp victim Nothing True [] 0 newFightInfo
 	let gs=GameState arena Nothing
 	gs2<- execStateT (evalRandT (runWriterT prayerInArena) (mkTestWrapper [12])) gs
 	let arena2=gsData gs2
@@ -288,7 +288,7 @@ 	let v1=(createTestNPC "Victim")
 	let vc1=(npcCharacter v1){inventory=makeFullInventory [] 10 100}
 	let victim=v1{npcCharacter=vc1}
-	let arena=Arena jp victim Nothing True [] 0
+	let arena=Arena jp victim Nothing True [] 0 newFightInfo
 	let gs=GameState arena Nothing
 	gs2<- execStateT (evalRandT (runWriterT prayerInArena) (mkTestWrapper [20])) gs
 	let arena2=gsData gs2
src/MoresmauJP/Rpg/Character.hs view
@@ -7,6 +7,7 @@ 
 import Data.Array.IArray
 import Data.List
+import Data.Ord
 
 import Text.Printf
 import Text.Regex.Posix
@@ -98,11 +99,14 @@ isMad a= (getCharacteristic' a Current Mental ) <= 0  
 
 characterLevel :: Character -> Int
-characterLevel c=avg $ map (getCharacteristic' c Normal) allCharacteristics
+characterLevel c=(avg $ map (getCharacteristic' c Normal) 
+		-- take only 4 best characteristics
+		(take 4 (sortBy (comparing (\ch-> (-(getCharacteristic' c Normal ch)))) allCharacteristics)))
+	+ (div (length $ spells c) 3) -- ponder with spells
+	+ (div (length $ listCarriedItems $ inventory c) 4) -- ponder with items
 
 mkRating :: Int -> Rating
 mkRating v = Rating (array (Normal,Experience) [(Normal,v),(Current, v),(Experience, 0)])
-	
 
 getR :: RatingScoreType -> Rating -> Int
 getR rst (Rating array)= array ! rst
@@ -152,9 +156,18 @@ getCharacteristic' :: Character -> RatingScoreType -> Characteristic -> Int
 getCharacteristic' c = getCharacteristic (traits c)
 
+getCurrentPercentOfNormal :: Character -> Characteristic -> Int
+getCurrentPercentOfNormal c char=let
+	current=getCharacteristic' c Current char
+	normal=getCharacteristic' c Normal char
+	in (current * 100) `div` normal
+
 getHealthSummary :: Character -> [String]
 getHealthSummary c= map (\x->printf "%s: %s" (show x) (show ((traits c) ! x))) allHealth
 
+addCharacterGold :: Character -> Gold -> Character
+addCharacterGold c@(Character{inventory=inv}) g=c{inventory=addGold inv g}
+
 -- | add an affect to the character
 addAffect :: Character -- ^ the character to affect
 	-> Affect -- ^ the affect
@@ -200,4 +213,22 @@ 	end=if diff==1 
 			then "point"
 			else "points"
-	in (printf ("%d %s " ++ end) diff (show c))	+	in (printf ("%d %s " ++ end) diff (show c))	
+	
+restoreWithTime :: Character -> Int -> Int -> Character
+restoreWithTime c tickCount toAdd= restoreWithTimeC (restoreWithTimeC c Physical Constitution tickCount toAdd) Mental Balance tickCount toAdd
+	
+restoreWithTimeC :: Character -> Characteristic -> Characteristic -> Int -> Int -> Character
+restoreWithTimeC c ch1 ch2 tickCount tickToAdd=let 
+	current = getCharacteristic' c Current ch1
+	normal = getCharacteristic' c Normal ch1
+	in if (current<normal) 
+		then let
+			current2=getCharacteristic' c Current ch2
+			val=(max 1 (25-current2)) * 20
+			prev=div tickCount val
+			next=div (tickCount+tickToAdd) val
+			toAdd=min (normal-current) (next-prev)
+			in addCharacteristic' c Current ch1 toAdd
+		else c
+
src/MoresmauJP/Rpg/CharacterTests.hs view
@@ -14,7 +14,7 @@ 
 import System.Random
 
-characterTests=TestList [testLevel,testSetOOS,testExperience,testAffects]
+characterTests=TestList [testLevel,testSetOOS,testExperience,testAffects,testRestoreWithTime]
 
 createTestChar :: String -> Character
 createTestChar name=Character name Male 
@@ -40,6 +40,20 @@ 			)
 		) mkEmptyInventory [] []
 	assertEqual "Level is not 15" 15 (characterLevel jp2)	
+	let jp3=jp2{spells=[Spell "Feel Better" Physical Recovery Permanent
+		,Spell "Fire Ball" Physical Negative Permanent
+		,Spell "Nimble Fingers" Dexterity Positive Temporary
+		,Spell "Greasy Fingers" Dexterity Negative Temporary]}
+	assertEqual "Level is not 16" 16 (characterLevel jp3)
+	let (Right (i2,_))=takeItem (inventory jp3) (Weapon "Sword" 2 6 1 10) (RightHand)
+	let (Right (i3,_))=takeItem i2 (Weapon "Sword" 2 6 1 10) (LeftHand)
+	let (Right (i4,_))=takeItem i3 (Weapon "Sword" 2 6 1 10) (Bag 1)
+	let (Right (i5,_))=takeItem i4 (Weapon "Sword" 2 6 1 10) (Bag 2)
+	let jp4=jp3{inventory=i5}
+	assertEqual "Level is not 17" 17 (characterLevel jp4)
+	let jp5=setCharacteristic' jp4 Normal Willpower 5
+	assertEqual "Level is not 17" 17 (characterLevel jp5)
+	
 	))
 	
 
@@ -112,3 +126,32 @@ 	
 	))
 	
+testRestoreWithTime= TestLabel "Test RestoreWithTime" (TestCase (do
+	let 
+		jp=setCharacteristic' (createTestChar "JP") Current Physical 8
+		jp2=restoreWithTime jp 100 50
+		jp3=restoreWithTime jp 100 200
+		jp4=restoreWithTime jp 100 400
+		jp5=restoreWithTime jp 100 600
+		jp6=restoreWithTime jp 300 100
+	assertEqual "jp2 should still have 8" 8 (getCharacteristic' jp2  Current Physical)
+	assertEqual "jp3 should have 9" 9 (getCharacteristic' jp3  Current Physical)
+	assertEqual "jp4 should have 9" 9 (getCharacteristic' jp4  Current Physical)
+	assertEqual "jp5 should have 10" 10 (getCharacteristic' jp5  Current Physical)
+	assertEqual "jp6 should still have 8" 8 (getCharacteristic' jp6  Current Physical)
+	
+	let 
+		jp=setCharacteristic' (setCharacteristic' (createTestChar "JP") Current Physical 8) Current Constitution 15
+		jp2=restoreWithTime jp 100 50
+		jp3=restoreWithTime jp 100 200
+		jp4=restoreWithTime jp 100 400
+		jp5=restoreWithTime jp 100 600
+		jp6=restoreWithTime jp 300 50
+	assertEqual "jp2 should still have 8" 8 (getCharacteristic' jp2  Current Physical)
+	assertEqual "jp3 should have 9" 9 (getCharacteristic' jp3  Current Physical)
+	assertEqual "jp4 should have 10" 10 (getCharacteristic' jp4  Current Physical)
+	assertEqual "jp5 should have 10" 10 (getCharacteristic' jp5  Current Physical)
+	assertEqual "jp6 should still have 8" 8 (getCharacteristic' jp6  Current Physical)
+	
+	
+	))
src/MoresmauJP/Rpg/Fight.hs view
@@ -120,7 +120,7 @@ 	dmg<-mapM  damageFromItem items2
 	return (c2,sum dmg)
 	where 
-		--shieldF :: (Character,[ItemType],[Message]) -> ItemType -> Rand (Character,[ItemType])
+		shieldF :: (MonadRandom m,MonadWriter ScreenMessages m)=> (Character,[ItemType]) -> ItemType -> m (Character,[ItemType])
 		shieldF (c,its) it@(Shield {})=do
 			-- dexterity roll on the shield
 			(c1,rr)<-action c [Dexterity] (subsequentDifficulty g)
src/MoresmauJP/Rpg/Inventory.hs view
@@ -60,7 +60,7 @@ 	| InvalidPositionForItem ItemType Position
 	deriving (Eq,Show,Read)
 
-data PotionType = HealingPotion Int
+data PotionType = HealingPotion Int | MindPotion Int
 	deriving (Show,Read,Eq)
 
 makeEmptyInventory :: Int -> Gold -> Inventory
src/MoresmauJP/Rpg/Items.hs view
@@ -36,6 +36,11 @@ majorHealingPotion=Potion "Major Healing Potion" (HealingPotion 9) 30
 totalHealingPotion=Potion "Total Healing Potion" (HealingPotion 1000) 60
 
+minorMindPotion=Potion "Minor Mind Potion" (MindPotion 3) 12
+mediumMindPotion=Potion "Medium Mind Potion" (MindPotion 6) 20
+majorMindPotion=Potion "Major Mind Potion" (MindPotion 9) 30
+totalMindPotion=Potion "Total Mind Potion" (MindPotion 1000) 60
+
 -- occurences of items in the maze
 itemOccurences:: [(ItemType,Int)]
 itemOccurences=	[(sword,12),
@@ -55,6 +60,10 @@ 		(mediumHealingPotion,5),
 		(majorHealingPotion,2),
 		(totalHealingPotion,1),
+		(minorMindPotion,8),
+		(mediumMindPotion,5),
+		(majorMindPotion,2),
+		(totalMindPotion,1),
 		(Scroll "" "" 40,8)
 	]
 	
@@ -79,6 +88,11 @@ 	(c2,rr)<-action c1 medecine (toIntLevel Neutral)
 	let n'=resultExtra n rr
 	(c3,_)<-recover c2 Physical n'
+	return (Just (c3,True))
+useItemEffect (Potion{potionType=(MindPotion n)}) c1= do
+	(c2,rr)<-action c1 medecine (toIntLevel Neutral)
+	let n'=resultExtra n rr
+	(c3,_)<-recover c2 Mental n'
 	return (Just (c3,True))
 useItemEffect (Scroll{spellType=s}) c1@(Character {spells=knownSpells})= do
 	if (elem s (map spellName knownSpells))
src/MoresmauJP/Rpg/ItemsTests.hs view
@@ -14,9 +14,9 @@ 
 import Test.HUnit
 
-itemTests=TestList [testUsePotion,testUseWeapon,testUseScrollSuccess,testUseScrollFailure,testUseScrollFumble]	
+itemTests=TestList [testUseHealingPotion,testUseMindPotion,testUseWeapon,testUseScrollSuccess,testUseScrollFailure,testUseScrollFumble]	
 
-testUsePotion = TestLabel "Test Use Potion" (TestCase (do
+testUseHealingPotion = TestLabel "Test Use Healing Potion" (TestCase (do
 	let jp=createTestChar "JP"
 	assertEqual "Physical must be 10" 10 (getCharacteristic' jp Current Physical)
 	let jp2=setCharacteristic' jp Current Physical 5
@@ -29,6 +29,20 @@ 	assertEqual "Physical must be 10 after potion" 10 (getCharacteristic' jp4 Current Physical)
 	assertBool "not remove2" remove2
 	)) 
+	
+testUseMindPotion = TestLabel "Test Use Mind Potion" (TestCase (do
+	let jp=createTestChar "JP"
+	assertEqual "Mental must be 10" 10 (getCharacteristic' jp Current Mental)
+	let jp2=setCharacteristic' jp Current Mental 5
+	((Just (jp3,remove1)),msgs)<-evalRandT (runWriterT (useItemEffect minorMindPotion jp2)) (mkTestWrapper [8])
+	assertEqual "not recover message1" "You recover 3 Mental points!" (head msgs)
+	assertEqual "Mental must be 8 after potion" 8 (getCharacteristic' jp3 Current Mental)
+	assertBool "not remove1" remove1
+	((Just (jp4,remove2)),msgs2)<-evalRandT (runWriterT (useItemEffect minorMindPotion jp3)) (mkTestWrapper [8])
+	assertEqual "not recover message2" "You recover 2 Mental points!" (head msgs2)
+	assertEqual "Mental must be 10 after potion" 10 (getCharacteristic' jp4 Current Mental)
+	assertBool "not remove2" remove2
+	)) 	
 
 testUseWeapon = TestLabel "Test Use Weapon" (TestCase (do
 	let jp=createTestChar "JP"
src/MoresmauJP/Rpg/Magic.hs view
@@ -32,11 +32,13 @@ 	]
 	
 spellToAffect :: Spell -> RollResult -> Int -> Affect
-spellToAffect spell rr tc=Affect (impactedChar spell)
-	(diff rr)
+spellToAffect spell rr tc=let
+	pt=resultMultiplierHigh (diff rr) rr
+	in Affect (impactedChar spell)
+	pt
 	(tc + (((diff rr)+1) ^ 2))
 	(spellName spell)
-	(printf "Under the influence of %s (%s)" (spellName spell) (points (impactedChar spell) (diff rr)))
+	(printf "Under the influence of %s (%s)" (spellName spell) (points (impactedChar spell) pt))
 	(printf "Spell %s is lifting" (spellName spell))
 
 spellsToMyself :: Character -> [Spell]
@@ -76,7 +78,7 @@ 	
 damagesFumble :: (MonadWriter ScreenMessages m) => Character -> Spell -> Int ->  RollResult  -> FumbleEvent -> m Character
 damagesFumble c s tc rr SpellBounce= do
-	let c12=addAffect c (spellToAffect s rr{diff=(-diff rr)} tc)
+	let c12=addAffect c (spellToAffect s (Success Standard (-diff rr)) tc)
 	addMessage $ Message (c12,s,Fumble SpellBounce 0)
 	return c12
 damagesFumble c s _ _ ForgetSpell= do
src/MoresmauJP/Rpg/MagicTests.hs view
@@ -133,9 +133,9 @@ 	let jp=(createTestChar "JP") {spells=[Spell "Fire Ball" Physical Negative Permanent]}
 	let troll=createTestChar "Troll"
 	(((jp1,troll1),outOfOrder),msgs)<- evalRandT (runWriterT(spellToOpponent jp troll (head $ spells jp) 0)) (mkTestWrapper [20,20,20,20,20,20,20])
-	assertBool "outOfOrder" (outOfOrder)
+	assertBool "outOfOrder" (not outOfOrder)
 	assertEqual "not physical 10" 10 (getCharacteristic' troll1 Current Physical)
 	assertEqual "not 1 message" 1 (length msgs)
 	assertEqual "not Fire Ball message" "The spell Fire Ball bounces back and hits you!" (head msgs)
-	assertEqual "not physical 0" 0 (getCharacteristic' jp1 Current Physical)
+	assertEqual "not physical 2" 2 (getCharacteristic' jp1 Current Physical)
 	))
src/MoresmauJP/Rpg/MazeObjects.hs view
@@ -60,24 +60,24 @@ generateNPCs :: (MonadRandom m)=> Maze -> Float -> Int -> m (M.Map Cell NPCCharacter)
 generateNPCs mz proportion characterLevel=do
 	cellsWithItems<-(getCellWithItems (size mz) proportion) 
+	let attitudeModifier=floor ((fromIntegral characterLevel/10.0) ** 2)
 	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
+				c<-generateFromTemplate t attitudeModifier
 				return (M.insert cell c m)
 			Just _->return m
 		) M.empty cells2
 	
---getCellWithItems ::Size -> Float -> Rand [Cell]
+getCellWithItems :: (MonadRandom m)=> Size -> Float -> m [Cell]
 getCellWithItems (w,h) proportion=do
 	let nb=round (fromIntegral (h*w)/proportion)
 	replicateM nb (getCellWithItems' (w,h))
 	
---getCellWithItems' :: Size -> Rand Cell
+getCellWithItems' :: (MonadRandom m)=> Size -> m Cell
 getCellWithItems' (w,h) =do
 		cellx<-getRandomRange (1,w)
 		celly<-getRandomRange (1,h)
@@ -111,4 +111,17 @@  	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))}+updateNPC gw mo npc= mo{npcs= (M.insert (position gw) npc (npcs mo))}
+
+moveNPC :: (MonadRandom m)=> GameWorld -> MazeObjects -> NPCCharacter -> m MazeObjects
+moveNPC gw mo npc= do
+	let mo2=mo{npcs= (M.delete (position gw) (npcs mo))}
+	let eligibleCells= filter (\x->x /= (position gw) && M.notMember x (npcs mo2)) (M.keys $ cellmap $ maze $ gw)
+	cell<-randomPickp eligibleCells 
+	return mo2{npcs= (M.insert cell npc (npcs mo2))}
+	
+recoverNPCWithTime:: MazeObjects -> Int -> Int -> MazeObjects
+recoverNPCWithTime mo tickCount toAdd=let
+	allnpcs=npcs mo
+	allnpcs2=M.map (\npc@(NPCCharacter{npcCharacter=c})->npc{npcCharacter=restoreWithTime c tickCount toAdd}) allnpcs
+	in mo{npcs=allnpcs2}
src/MoresmauJP/Rpg/NPC.hs view
@@ -2,9 +2,12 @@ -- (c) JP Moresmau 2009
 module MoresmauJP.Rpg.NPC where
 
+import Control.Monad
+
 import Data.Array.IArray
 import Data.Maybe
 import Data.List
+import qualified Data.Map as M
 import MoresmauJP.Rpg.Actions
 import MoresmauJP.Rpg.Inventory
 import MoresmauJP.Rpg.Items
@@ -41,7 +44,7 @@ 	attitudeRange=(5,10),
 	traitRanges=[
 		(Strength,(5,11)),
-		(Dexterity,(8,11)),
+		(Dexterity,(8,13)),
 		(Constitution,(7,12)),
 		(Willpower,(5,8)),
 		(Intelligence,(6,10)),
@@ -59,7 +62,7 @@ 			(Just smallShield,1)]
 			),
 		(Body, [
-			(Nothing,3),
+			(Nothing,2),
 			(Just leatherArmor,1)
 			]
 			)
@@ -113,13 +116,13 @@ 	creatureType=Animal,
 	attitudeRange=(5,10),
 	traitRanges=[
-		(Strength,(3,6)),
+		(Strength,(5,8)),
 		(Dexterity,(12,16)),
 		(Constitution,(5,10)),
 		(Willpower,(6,10)),
 		(Intelligence,(2,4)),
 		(Balance,(5,10)),
-		(Charisma,(1,2)),
+		(Charisma,(1,4)),
 		(Perception,(8,10))],
 	possibleItems=[],
 	possibleGold=(0,0)	
@@ -149,7 +152,7 @@ 	traitRanges=[
 		(Strength,(8,14)),
 		(Dexterity,(8,12)),
-		(Constitution,(10,14)),
+		(Constitution,(18,24)),
 		(Willpower,(10,14)),
 		(Intelligence,(6,10)),
 		(Balance,(6,10)),
@@ -177,14 +180,15 @@ 			(Just hatchet,1)]
 			),
 		(LeftHand, [
-			(Nothing,2),
+			(Nothing,1),
 			(Just smallShield,1),
 			(Just dagger,2)
 			]
 			),
 		(Body, [
-			(Nothing,3),
-			(Just leatherArmor,1)
+			(Nothing,2),
+			(Just leatherArmor,2),
+			(Just chainMail,1)
 			]
 			),
 		(Head,[
@@ -200,11 +204,11 @@ 	creatureType=Human,
 	attitudeRange=(5,10),	
 	traitRanges=[
-		(Strength,(12,18)),
-		(Dexterity,(12,18)),
-		(Constitution,(12,18)),
+		(Strength,(14,18)),
+		(Dexterity,(14,18)),
+		(Constitution,(14,18)),
 		(Willpower,(10,15)),
-		(Intelligence,(6,12)),
+		(Intelligence,(8,12)),
 		(Balance,(8,12)),
 		(Charisma,(8,14)),
 		(Perception,(8,14))],
@@ -238,7 +242,7 @@ 	creatureType=Animal,
 	attitudeRange=(2,5),	
 	traitRanges=[
-		(Strength,(14,20)),
+		(Strength,(14,22)),
 		(Dexterity,(10,16)),
 		(Constitution,(14,22)),
 		(Willpower,(10,16)),
@@ -281,6 +285,8 @@ allNPCTemplates :: [NPCTemplate]
 allNPCTemplates= [troll,goblin,kobold,giantRat,snake,vampire,ghoul,outlaw,blackKnight,minotaur,peddler]
 
+templateAttitudeNoChange=[peddler]
+
 getNPCOccurences :: Int -> [(NPCTemplate,Int)]
 getNPCOccurences characterLevel=
 	let 
@@ -332,6 +338,83 @@ 		Failure {}	-> NPCFight
 		Success	{}	-> NPCWait)
 
+data FightAttitude = ContinueFight | OfferBribe Int | PrayForClemency | TryEscape 
+	deriving (Show,Read,Eq)
+
+data FightInfo=FightInfo {
+		npcLosses :: M.Map Characteristic Int,
+		cLosses :: M.Map Characteristic Int,
+		hasPrayed :: Bool,
+		hasBribed :: Bool
+	}
+	deriving (Show,Read,Eq)
+
+newFightInfo :: FightInfo
+newFightInfo=FightInfo M.empty M.empty False False
+
+addNPCLosses:: FightInfo -> NPCCharacter -> NPCCharacter -> FightInfo
+addNPCLosses fi c1 c2=fi{npcLosses=addLosses (npcLosses fi) (npcCharacter c1) (npcCharacter c2)}
+
+addNPCLoss:: FightInfo -> Characteristic -> Int -> FightInfo
+addNPCLoss fi c v=fi{npcLosses=addToFightInfo (npcLosses fi) (c,v)}
+
+addCharacterLoss:: FightInfo -> Characteristic -> Int -> FightInfo
+addCharacterLoss fi c v=fi{cLosses=addToFightInfo (cLosses fi) (c,v)}
+
+addCharacterLosses:: FightInfo -> Character -> Character -> FightInfo
+addCharacterLosses fi c1 c2=fi{cLosses=addLosses (cLosses fi) c1 c2}
+
+
+addLosses :: M.Map Characteristic Int -> Character -> Character -> M.Map Characteristic Int
+addLosses m1 c1 c2= let
+	both=zipWith (\(c1,r1) (_,r2) -> (c1,(getR Current r1)-(getR Current r2))) (assocs $ traits c1) (assocs $ traits c2)
+	changed=filter (\((_,diff))->diff>0) both
+	in foldl addToFightInfo m1 changed
+
+addToFightInfo :: M.Map Characteristic Int -> (Characteristic, Int) -> M.Map Characteristic Int
+addToFightInfo m1 (c,v)=let
+	i=M.lookup c m1
+	in case i of
+		Nothing -> M.insert c v m1
+		Just v1 -> M.insert c (v+v1) m1
+
+getFightAttitudes :: NPCCharacter -> FightInfo -> [(FightAttitude,Int)]
+getFightAttitudes npc fi=let 
+	fight=21-(npcAttitude npc)
+	percentPhysical=getCurrentPercentOfNormal (npcCharacter npc) Physical
+	percentMental=getCurrentPercentOfNormal (npcCharacter npc) Mental
+	npcLossesSum=(M.fold (+) 0 (npcLosses fi))
+	cLossesSum=(M.fold (+) 0 (cLosses fi))
+	percentLoss=if npcLossesSum>0
+		then (cLossesSum * 100) `div` npcLossesSum
+		else 100
+	escape=max 0 (if (percentPhysical<11)
+		then 10+(11-percentPhysical)
+		else if (percentMental<11)
+			then 10+(11-percentMental)
+			else 10-((percentPhysical + percentMental) `div` 10))
+		+ (if (percentLoss<80)
+			then (10 - (percentLoss `div` 10))
+			else 0
+		)
+	pray=if (hasPrayed fi || (npcType npc)==Animal) 
+		then 0
+		else div escape 2
+	gold=getGold $ inventory $ npcCharacter npc
+	bribe=if gold>0 && (not $ hasBribed fi)  && ((npcType npc)/=Animal)
+		then div escape 2
+		else 0
+	in [(ContinueFight,fight),(TryEscape,escape),(PrayForClemency,pray),(OfferBribe gold,bribe)]
+
+getFightAttitude :: (MonadRandom m)=> NPCCharacter -> FightInfo -> m (FightAttitude,FightInfo)
+getFightAttitude npc fi = do
+	fa<-randomPickp $ occurenceList $ getFightAttitudes npc fi
+	let fi2= case fa of
+		PrayForClemency -> fi{hasPrayed=True}
+		OfferBribe _->fi{hasBribed=True}
+		_ -> fi
+	return (fa,fi2)
+
 data InteractionToNPC=Ignore | Fight | Trade | Convert | Steal 
 	deriving (Show,Read,Eq,Enum,Bounded)
 
@@ -347,8 +430,8 @@ 	Humanoid 	-> 0
 	Human 		-> 10
 
-generateFromTemplate :: (MonadRandom m)=> NPCTemplate -> m (NPCCharacter)
-generateFromTemplate template=do
+generateFromTemplate :: (MonadRandom m)=> NPCTemplate -> Int -> m (NPCCharacter)
+generateFromTemplate template attitudeModifier=do
 	let name=typeName template
 	-- get gender
 	rnd <- getRandomRange (1,2)
@@ -366,7 +449,10 @@ 	-- only keep items, filter out Nothings
 	let inv2=map (\(x,y)->(x,fromJust y)) (filter (isJust . snd) inv)
 	gold<-getRandomRange $ possibleGold template
-	attitudeLevel<-getRandomRange $ attitudeRange template
+	attitudeLevel<-liftM (	if (elem template templateAttitudeNoChange)
+			then id
+			else ((max 1) . (\x->x - attitudeModifier)))
+		(getRandomRange $ attitudeRange template)
 	let maxPos=maxPosBag template
 	return (NPCCharacter (Character {
 		name=name,
src/MoresmauJP/Rpg/NPCTests.hs view
@@ -15,7 +15,8 @@ 
 import System.Random
 
-npcTests = TestList [testNPCTemplate,testNPCOccurences]
+npcTests = TestList [testNPCTemplate,testNPCOccurences,testFightAttitudes,
+	testFightAttitudesAlready,testFightAttitudesAnimal]
 
 createTestNPC :: String -> NPCCharacter
 createTestNPC name=NPCCharacter (createTestChar name) Human 10
@@ -26,7 +27,7 @@ 		replicateM_ 5 (
 			do
 				sg<-getStdGen
-				NPCCharacter{npcCharacter=t}<-evalRandT (generateFromTemplate template) (ProductionRandom sg)
+				NPCCharacter{npcCharacter=t}<-evalRandT (generateFromTemplate template 0) (ProductionRandom sg)
 				mapM_ (testNPCTraits t) (traitRanges template)
 				mapM_ (testNPCInventory t) (possibleItems template)
 			)
@@ -67,4 +68,47 @@ 				else
 					return () 
 		) allTemplates
-	))	+	))	
+	
+
+testFightAttitudes=TestLabel "Test Fight Attitudes" (TestCase (do
+	let npc1=createTestNPC "NPC"
+	let vc1=addCharacteristic' ((npcCharacter npc1){inventory=makeFullInventory [] 10 100}) Current Physical (-5)
+	assertEqual "not 50%" 50 (getCurrentPercentOfNormal vc1 Physical)
+	let npc=npc1{npcCharacter=vc1}
+	let fightInfo=addCharacterLoss (addCharacterLoss
+			(addNPCLosses newFightInfo npc1 npc)
+	 	Physical 1) Physical 1
+	let attitudes=getFightAttitudes npc fightInfo
+	assertEqual "not 4 attitudes" 4 (length attitudes)
+	let expected=[(ContinueFight,11),(TryEscape,6),(PrayForClemency,3),(OfferBribe 100,3)]
+	assertEqual "not expected" expected attitudes
+	))
+	
+testFightAttitudesAlready=TestLabel "Test Fight Attitudes Excluding Already Chosen" (TestCase (do
+	let npc1=createTestNPC "NPC"
+	let vc1=addCharacteristic' ((npcCharacter npc1){inventory=makeFullInventory [] 10 100}) Current Physical (-5)
+	assertEqual "not 50%" 50 (getCurrentPercentOfNormal vc1 Physical)
+	let npc=npc1{npcCharacter=vc1}
+	let fightInfo=(addCharacterLoss (addCharacterLoss
+			(addNPCLosses newFightInfo npc1 npc)
+	 	Physical 1) Physical 1){hasBribed=True,hasPrayed=True}
+	let attitudes=getFightAttitudes npc fightInfo
+	assertEqual "not 4 attitudes" 4 (length attitudes)
+	let expected=[(ContinueFight,11),(TryEscape,6),(PrayForClemency,0),(OfferBribe 100,0)]
+	assertEqual "not expected" expected attitudes
+	))
+	
+testFightAttitudesAnimal=TestLabel "Test Fight Attitudes Animal" (TestCase (do
+	let npc1=(createTestNPC "NPC"){npcType=Animal}
+	let vc1=addCharacteristic' ((npcCharacter npc1){inventory=makeFullInventory [] 10 100}) Current Physical (-5)
+	assertEqual "not 50%" 50 (getCurrentPercentOfNormal vc1 Physical)
+	let npc=npc1{npcCharacter=vc1}
+	let fightInfo=(addCharacterLoss (addCharacterLoss
+			(addNPCLosses newFightInfo npc1 npc)
+	 	Physical 1) Physical 1)
+	let attitudes=getFightAttitudes npc fightInfo
+	assertEqual "not 4 attitudes" 4 (length attitudes)
+	let expected=[(ContinueFight,11),(TryEscape,6),(PrayForClemency,0),(OfferBribe 100,0)]
+	assertEqual "not expected" expected attitudes
+	))
src/MoresmauJP/Rpg/Profile.hs view
@@ -3,11 +3,15 @@ module MoresmauJP.Rpg.Profile where
 
 import Data.Array.IArray
-import Control.Monad
+import Control.Monad.Writer
 import Data.List
 import Data.Maybe
 
+import MoresmauJP.Core.Screen
+import MoresmauJP.Rpg.Actions
 import MoresmauJP.Rpg.Character
+import MoresmauJP.Rpg.Inventory
+import MoresmauJP.Rpg.Magic
 import MoresmauJP.Util.Lists  hiding ((//))
 import MoresmauJP.Util.Random
 
@@ -39,6 +43,19 @@ 	| NotTooLow  { 
 		func::Characteristic
 	}
+
+generateCharacter::  (MonadRandom m,MonadWriter ScreenMessages m)=>Name -> Gender -> Profile -> m Character
+generateCharacter name gender prof=do
+	mt<-generateTraits prof
+	let h=getDefaultHealth mt
+	let c=Character name gender h (makeEmptyInventory 10 20) [] []
+	extraGoldFromTrade<-diffResult' c trade (subsequentDifficulty Standard) (\x->if x<0 then 0 else x ^ 2)
+	extraGoldFromStealing<-diffResult' c steal (subsequentDifficulty Standard) (\x->if x<0 then 0 else x ^ 2)
+	let extraGold=max extraGoldFromTrade extraGoldFromStealing
+	nbSpellsLearned<-diffResult' c spelllearning (toIntLevel Neutral) (\x->if x<0 then 0 else (round $ sqrt $ fromIntegral x))
+	spells<-randomPickpn allSpells nbSpellsLearned
+	let c'=c{inventory=addGold (inventory c) extraGold,spells=spells} 
+	return c'
 
 generateTraits :: (MonadRandom m)=>Profile -> m CharacteristicRatings
 generateTraits p=do
src/MoresmauJP/Rpg/RPG.hs view
@@ -14,7 +14,6 @@ import MoresmauJP.Maze1.Maze
 import qualified MoresmauJP.Maze1.MazeGame as MG
 
-import MoresmauJP.Rpg.Actions
 import MoresmauJP.Rpg.Arena
 import MoresmauJP.Rpg.Character
 import MoresmauJP.Rpg.Items
@@ -35,7 +34,7 @@ 
 initialGameStateInApp :: IO(GameState RPGState)
 initialGameStateInApp = do
-	dir<-getAppUserDataDirectory "RPG"
+	dir<-getAppUserDataDirectory "MazesOfMonad"
 	--createDirectoryIfMissing True dir
 	return $ initialGameState dir
 
@@ -99,16 +98,8 @@ 	w2<- (genderF name) (show gender)
 	return (combineWidget (WText "Unknown profile") w2)
 profile (name,gender) (Exact prof)= do
-	mt<-generateTraits prof
-	let h=getDefaultHealth mt
-	let c=Character name gender h (makeEmptyInventory 10 20) [] []
-	extraGoldFromTrade<-diffResult' c trade (subsequentDifficulty Standard) (\x->if x<0 then 0 else x ^ 2)
-	extraGoldFromStealing<-diffResult' c steal (subsequentDifficulty Standard) (\x->if x<0 then 0 else x ^ 2)
-	let extraGold=max extraGoldFromTrade extraGoldFromStealing
-	nbSpellsLearned<-diffResult' c spelllearning (toIntLevel Neutral) (\x->if x<0 then 0 else (round $ sqrt $ fromIntegral x))
-	spells<-randomPickpn allSpells nbSpellsLearned
-	let c'=c{inventory=addGold (inventory c) extraGold,spells=spells} 
-	return (WCheck [ppCharacterAndGold' c'] "Accept?" True (profileAccept c'))
+	c<-generateCharacter name gender prof
+	return (WCheck [ppCharacterAndGold' c] "Accept?" True (profileAccept c))
 
 profileAccept :: Character -> Bool -> WScreenT RPGState 
 profileAccept c False = (genderF (name c) (show $ gender c))
@@ -318,9 +309,12 @@ 			let npc'=fromJust npc
 			let (rw1,rw2)=splitWrapper rw
 			es <- screenInteract c npc' rw1 (tickCount mgs)
-			let (mo,c2,extraGold) =case (exitStatus es) of
-				Victory -> killNPC (mazegameworld mgs) (objects mgs) (exitCharacter es)
-				_ -> (updateNPC (mazegameworld mgs) (objects mgs) (exitOpponent es),exitCharacter es,0)
+			(mo,c2,extraGold) <- case (exitStatus es) of
+				Victory -> return $ killNPC (mazegameworld mgs) (objects mgs) (exitCharacter es)
+				EnnemyFlight -> do
+					mo2<-evalRandT (moveNPC (mazegameworld mgs) (objects mgs) (exitOpponent es)) rw2
+					return (mo2,exitCharacter es,0)
+				_ -> return $ (updateNPC (mazegameworld mgs) (objects mgs) (exitOpponent es),exitCharacter es,0)
 			let mo2=foldl (Objs.dropItem (mazegameworld mgs)) mo (newItems es)
 			gw<-case (exitStatus es) of
 				Flight -> do
@@ -402,7 +396,12 @@ tick :: Int -> RPGState ->  WriterT ScreenMessages (RandT (StateT (GameState RPGState) IO)) (RPGState)
 tick _ rs@(RPGState{mgs=Nothing})=return rs
 tick tc rs@(RPGState{mgs=Just mgs})=do
-	let rs2=rs{mgs=(Just mgs{tickCount=(tickCount mgs)+tc})}
+	let 
+		Just c=rpgCharacter rs
+		currentTc=tickCount mgs
+		c2=restoreWithTime c currentTc tc
+		mo2=recoverNPCWithTime (objects mgs) currentTc tc
+		rs2=rs{rpgCharacter=Just c2,mgs=(Just mgs{objects=mo2,tickCount=currentTc+tc})}
 	saveNewGameState rs2
 	return rs2
src/MoresmauJP/Rpg/TextOutput.hs view
@@ -7,6 +7,7 @@ 
 import MoresmauJP.Rpg.Character
 import MoresmauJP.Rpg.Inventory
+import MoresmauJP.Rpg.NPC
 import MoresmauJP.Rpg.Profile
 import MoresmauJP.Rpg.Trade
 
@@ -29,7 +30,7 @@ 	(text $ name c) 
 		$$ (text $ show $ gender c)
 		$$ (text "---")
-		$$ (ppTraits (traits c))
+		$$ (ppTraits c)
 		$$ (text "---")
 		$$ (ppSpells c)
 		$$ (text "---")
@@ -37,10 +38,15 @@ 		$$ (ppAffects c) 
 		$$ (ppStatus c)
 
-ppTraits :: CharacteristicRatings -> Doc
-ppTraits cr= vcat (map f (assocs cr))
+ppTraits :: Character -> Doc
+ppTraits c= vcat (map f (assocs $ traits c))
 	where 
-		f (c,r)=(text $ show c) $$ (nest (m+2) (text $ show r))
+		f (char,r)=(text $ show char) $$ (nest (m+2) (text $ show r)) $$ (nest (m+15) (
+			case char of
+				Physical -> text $ ppPhysical c
+				Mental -> text $ ppMental c
+				_ -> empty
+			))
 		m = maximum (map (length . show) (allCharacteristics++allHealth))
 		
 ppProfiles :: Character -> Doc
@@ -83,7 +89,7 @@ 		 	f (Just it)=parens$ text $ itName it
 		 
 ppMaybeItem :: Maybe ItemType -> Doc
-ppMaybeItem Nothing = text "Nothing"
+ppMaybeItem Nothing = text "-"
 ppMaybeItem (Just it) = text $ itName it
 		 
 ppItemPosition :: (Position,ItemType) -> Doc
@@ -100,3 +106,40 @@ ppTradeOperation' :: TradeOperation -> String
 ppTradeOperation' = render . ppTradeOperation	
 
+ppAttitude :: NPCCharacter -> String
+ppAttitude (NPCCharacter{npcAttitude=a}) 
+	| a<5="very vostile"
+	| a<9="hostile"
+	| a<13="neutral"
+	| a<17="friendly"
+	| otherwise="very friendly"
+	
+ppPhysical :: Character -> String
+ppPhysical c=ppPhysical' $ getCurrentPercentOfNormal c Physical
+	where 
+		ppPhysical' :: Int -> String
+		ppPhysical' a 
+			| a<11="nearly dead"
+			| a<26="very seriously wounded"
+			| a<51="badly wounded"
+			| a<75="injured"
+			| a<100="bruised and scratched"
+			| otherwise="in perfect health"
+	
+ppMental :: Character -> String
+ppMental c=ppPhysical' $ getCurrentPercentOfNormal c Mental
+	where 
+		ppPhysical' :: Int -> String
+		ppPhysical' a 
+			| a<11="verging on the totally insane"
+			| a<26="rambling"
+			| a<51="chaotic"
+			| a<75="haggard"
+			| a<100="a bit agitated"
+			| otherwise="fully sane"	
+					
+ppNPC :: NPCCharacter -> String
+ppNPC npc=let
+	c=npcCharacter npc
+	in printf "a %s, looking %s and apparently %s and %s" (name c) (ppAttitude npc) (ppPhysical c) (ppMental c)
+