MazesOfMonad 1.0.2 → 1.0.3

raw patch · 27 files changed

+691/−270 lines, 27 files

Files

• MazesOfMonad.cabal +2/−2
• README.txt +1/−0
• TODO.txt +7/−3
• WHATSNEW.txt +17/−0
• src/MoresmauJP/Core/Screen.hs +41/−18
• src/MoresmauJP/Maze1/Maze.hs +3/−3
• src/MoresmauJP/Maze1/MazeGame.hs +4/−3
• src/MoresmauJP/Rpg/Actions.hs +28/−18
• src/MoresmauJP/Rpg/ActionsTests.hs +31/−10
• src/MoresmauJP/Rpg/Arena.hs +38/−34
• src/MoresmauJP/Rpg/ArenaTests.hs +18/−18
• src/MoresmauJP/Rpg/Character.hs +38/−11
• src/MoresmauJP/Rpg/CharacterTests.hs +3/−3
• src/MoresmauJP/Rpg/Fight.hs +82/−34
• src/MoresmauJP/Rpg/FightTests.hs +91/−8
• src/MoresmauJP/Rpg/Inventory.hs +8/−4
• src/MoresmauJP/Rpg/InventoryTests.hs +23/−1
• src/MoresmauJP/Rpg/Items.hs +18/−7
• src/MoresmauJP/Rpg/ItemsTests.hs +10/−7
• src/MoresmauJP/Rpg/Magic.hs +74/−19
• src/MoresmauJP/Rpg/MagicTests.hs +92/−13
• src/MoresmauJP/Rpg/MazeObjects.hs +4/−4
• src/MoresmauJP/Rpg/NPC.hs +3/−3
• src/MoresmauJP/Rpg/Profile.hs +3/−3
• src/MoresmauJP/Rpg/RPG.hs +47/−35
• src/MoresmauJP/Rpg/TextOutput.hs +1/−5
• src/MoresmauJP/Util/Lists.hs +4/−4

@@ -1,5 +1,5 @@ Name:                MazesOfMonad
-Version:             1.0.2
+Version:             1.0.3
 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 
@@ -20,7 +20,7 @@ 
 Executable:          mazesofmonad
 Main-is:             Main.hs
-extensions:          FlexibleInstances, UndecidableInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving
+extensions:          FlexibleContexts, FlexibleInstances, UndecidableInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving
 hs-source-dirs:      src
 include-dirs:        src/
 other-modules:       MoresmauJP.Core.Screen, MoresmauJP.Maze1.Maze,MoresmauJP.Maze1.MazeGame

@@ -10,6 +10,7 @@ 
 To create a character, type 'c' on the initial screen (get into the characters mode), then 'n' for new. You'll have to type in the name and gender, and then choose a profile. A profile is only an indication on how to generate your initial characteristic, but brings no limitations. As you progress your profile will be updated if you use other characteristics more. For example, a thief is not as strong as a warrior, but better in dexterity and intelligence. If you start as a warrior but do a lot of stuff requiring dexterity or intelligence, you may evolve into a thief.
 You can refuse the character given to you any number of times. The number of gold coins and known spells you have is dependant on your characteristics, a merchant with a great charisma for example will probably have more gold to start with than a ranger.
+For each characteristic you get three numbers: the first one is the current value, the second the normal value, the third the experience. When a characteristic is temporarily affected, its current value change but its normal value stays unchanged. Everytime you use a characteristic you may gain experience points, and experience points allow you to increase the normal value of the characteristic. So the more you use a skill, the better you get at it. For example, the more you try to trade with people, the better your intelligence and charisma will become.
 
 Once you have a character, you exit the character screens ('b' for back), go into 'g' (ames) and start a 'n'(ew) game. You will find yourself in a maze. The goal is to find the exit.
 

@@ -1,8 +1,12 @@-- traps in maze (can be detected)
+- 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
 - npcs can use magic?
 - difficulty level
 	- npc attitude down (except peddlers?)
 	- traps up
-	- items up
-- message displayed when characteristic goes 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

@@ -1,6 +1,23 @@+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
+	UI: you now see a message when a characteristic is raised due to experience
+	Internal: fumble can cause different effects than self wound: 
+		melee fumble:
+			self wound
+			weapon breaks
+			bad scar causes charisma loss
+			hand wound cause dexterity loss 
+		magic fumble:
+			mental health can go down
+			spell can affect player
+			spell can be forgotten
+			intelligence can go down
+			
 1.0.2:
 	Fix: when a monster yielding a two-handed weapon was killed, two instances of the weapon were dropped
 		Thanks to Christopher Skrzętnicki
+
 1.0.1:
 	Fix issue on Y/N question (crash on hitting enter directly, now uses default value correctly)
 		Thanks to Justin Bailey

@@ -4,6 +4,7 @@ 
 
 import Control.Monad.State
+import Control.Monad.Writer
 import Char
 import Data.List
 import Data.Maybe
@@ -18,30 +19,44 @@ 	actionFunction::(ActionFunction a)
 	}
 
-type ScreenT a b= RandT (StateT a IO) b 
+type ScreenT a b= (RandT (StateT a IO)) b 
 
+
+type ScreenMessage = String
+type ScreenMessages = [ScreenMessage]
+
+addScreenMessage :: (MonadWriter ScreenMessages m,Monad m)=> ScreenMessage -> m ()
+addScreenMessage msg=tell [msg]
+	
+
 type GSWScreenT a= ScreenT (GameState a) (Widget a)
+type WScreenT a=WriterT ScreenMessages (RandT (StateT (GameState a) IO)) (Widget a)
 
-type ActionFunction a = [String] -> GSWScreenT a
+instance (Monad m) =>  MonadRandom (WriterT ScreenMessages (RandT m)) where
+	getRandomRange =lift . getRandomRange
+	getSplit = lift getSplit
 
 
+	
+type ActionFunction a = [String] -> WScreenT a
+
 data GameState a = GameState {gsData::a,
 	screen::Maybe (Screen a)
 	}
 
 data Widget a= WText String |
 	WList [String] |
-	WInput [String] (String -> GSWScreenT a) |
-	WCombo [String] [String] (String -> GSWScreenT a) |
-	WCheck [String] String Bool (Bool -> GSWScreenT a) |
+	WInput [String] (String -> WScreenT a) |
+	WCombo [String] [String] (String -> WScreenT a) |
+	WCheck [String] String Bool (Bool -> WScreenT a) |
 	WNothing
 
 type ScreenState a = (Widget a,GameState a)
 
-getShowCombo :: Show b => [String] -> [b] ->  ((ComboResult b) -> GSWScreenT a) -> Widget a
+getShowCombo :: Show b => [String] -> [b] ->  ((ComboResult b) -> WScreenT a) -> Widget a
 getShowCombo= getMappedCombo show
 
-getMappedCombo :: (b->String) -> [String] -> [b] ->  ((ComboResult b) -> GSWScreenT a) -> Widget a
+getMappedCombo :: (b->String) -> [String] -> [b] ->  ((ComboResult b) -> WScreenT a) -> Widget a
 getMappedCombo myShow s objs af=
 	let 
 		objWithNames=map (\x->(x,myShow x)) objs
@@ -58,7 +73,7 @@ 						)
 	in (WCombo s (map snd objWithNames) af2)
 		
-getPretypedWidget :: Widget a -> [String] -> GSWScreenT a
+getPretypedWidget :: Widget a -> [String] -> WScreenT a
 getPretypedWidget wc@(WCombo _ choices af) (typed:_) = do
 	let chosen=filter (\(x,_)->x==typed) (zipWith (\a b -> ((show a),b)) [1..] choices)
 	if (null chosen)
@@ -79,15 +94,19 @@ 	do
 		commandLoop gs
 		
---commandLoop :: ScreenState a -> IO(a)
+commandLoop :: ScreenState a -> IO(a)
 commandLoop (w,gs)=do
 	GameState s2 _ <- ioRandT (commandLoop2 w) gs
-	return s2
-
+	--sg<-getStdGen
+	--GameState s2 _ <- execStateT (evalRandT (runWriterT $ commandLoop2 w) (ProductionRandom sg)) gs
 	
+	return s2
 	
---commandLoop2 :: Widget a -> GSWScreenT a
+commandLoop2 :: Widget a -> GSWScreenT a
 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)
@@ -95,7 +114,8 @@ 			if isJust af
 				then
 					do
-						w2 <- fromJust af
+						(w2,msgs) <-runWriterT $ fromJust af
+						when (not $ null msgs) (liftIO $ (mapM_ putStrLn (reverse msgs)))	
 						commandLoop2 w2
 				else		
 					do
@@ -109,13 +129,14 @@ 								do
 									let (cmd:_)=cmds
 									let af2 = getAction (map Char.toLower cmd) (actions $ fromJust scr)
-									w2 <- af2 cmds
+									(w2,msgs)<-runWriterT (af2 cmds)
+									when (not $ null msgs) (liftIO $ (mapM_ putStrLn msgs))	
 									commandLoop2 w2
 		else
 			return WNothing
-	
 
-renderWidget :: Widget a -> IO(Maybe(GSWScreenT a))
+
+renderWidget :: Widget a -> IO(Maybe(WScreenT a))
 renderWidget (WNothing)= do
 	return Nothing
 renderWidget (WText s)= do
@@ -165,6 +186,8 @@ 	let acts=actions $ fromJust $ screen gs
 	let wl=WList (sort ( sysLines ++
 			(map f acts)))
+	tell ["help1"]
+	tell ["help2"]
 	return (wl) 
 
 unknown ::ActionFunction a
@@ -196,8 +219,8 @@ getAction "help" _ = help True
 getAction cmd acts =
 	let	
-		filt=listToMaybe .  (filter (\x->isPrefixOf cmd (map Char.toLower (actionName x))))
-		possible=catMaybes [filt systemActions,filt acts]
+		filt=(filter (\x->isPrefixOf cmd (map Char.toLower (actionName x))))
+		possible=(filt systemActions) ++ (filt acts)
 		l = length possible
 	in
 		if l==0 then

@@ -54,14 +54,14 @@ 	fromJust $ DataMap.lookup from (cellmap mz)
 	
 	
-generateGameWorld:: (Monad m) =>Size -> RandT m GameWorld
+generateGameWorld:: (MonadRandom m) =>Size -> m GameWorld
 generateGameWorld sz= do
 	maze <- generateMaze sz
 	let startCell=start maze
 	let explored= DataSet.insert startCell (DataSet.fromList (getNeighbours startCell maze))
   	return GameWorld {maze=maze,position=startCell,explored=explored}
 
-generateMaze :: (Monad m) =>Size -> RandT m Maze
+generateMaze :: (MonadRandom m) =>Size -> m Maze
 generateMaze sz = do
 	firstX<-getRandomRange (1,fst sz)
 	firstY<-getRandomRange (1,snd sz)
@@ -81,7 +81,7 @@ 	in
 		 DataMap.insert c (init l) cm
 
-mazeStep :: (Monad m) =>CellMap -> Size -> Edges -> RandT m (CellMap,Cell)
+mazeStep :: (MonadRandom m) =>CellMap -> Size -> Edges -> m (CellMap,Cell)
 mazeStep _ _ []=error "mazeStep: empty edges"
 mazeStep cm sz (f:fs) = do
 	let nbs=getInNeighbours f sz cm

@@ -4,6 +4,7 @@ 
 import MoresmauJP.Util.Random
 import Control.Monad.State
+import Control.Monad.Writer
 import Data.Char
 import Data.List
 import qualified Data.Set as DataSet
@@ -18,11 +19,11 @@ 	sg <- getStdGen
 	gs <- evalRandT initialGameState (ProductionRandom sg)
 	sg<-getStdGen
-	(WList ls,_)<-runStateT (evalRandT (mapAction [""]) (ProductionRandom sg)) gs
+	((WList ls,_),_)<-runStateT (evalRandT (runWriterT $ mapAction [""]) (ProductionRandom sg)) gs
 	MoresmauJP.Core.Screen.start (WList ("Maze":ls),gs)
 	return ()
 
-initialGameState ::(Monad m)=>RandT m (GameState GameWorld)
+initialGameState ::(MonadRandom m)=>m (GameState GameWorld)
 initialGameState = do
 	gw<-generateGameWorld (10,5)
 	return (buildGameState gw)
@@ -50,7 +51,7 @@ 				then
 					do
 					put (GameState gw2 Nothing)
-					return (WList ["You win! "])
+					return (WList ["You emerge victorious from the maze! "])
 				else
 					do
 						let dirs=getDirections gw2

@@ -2,12 +2,15 @@ -- (c) JP Moresmau 2009
 module MoresmauJP.Rpg.Actions where
 
-import Control.Monad
+import Control.Monad.Writer
 
+import MoresmauJP.Core.Screen
 import MoresmauJP.Rpg.Character
 import MoresmauJP.Util.Numbers
 import MoresmauJP.Util.Random
 
+import Text.Printf
+
 initiative = [Dexterity,Willpower]
 melee = [Strength,Dexterity]
 archery = [Dexterity,Perception,Strength]
@@ -30,22 +33,22 @@ rolls :: (MonadRandom m) => Int -> (Int,Int) -> m [Int]
 rolls a (low,high)= replicateM a (roll (low,high)) 
 
-action :: (MonadRandom m) => Character -> [Characteristic] -> Difficulty -> m (Character,RollResult)	
+action :: (MonadRandom m,MonadWriter ScreenMessages m) => Character -> [Characteristic] -> Difficulty -> m (Character,RollResult)	
 action c cs d= do
 	r <- roll d20
-	return (processAction c cs d r)
+	processAction c cs d r
 
-actionNoExperience :: (MonadRandom m) => Character -> [Characteristic] -> Difficulty -> m RollResult	
+actionNoExperience :: (MonadRandom m,MonadWriter ScreenMessages m) => Character -> [Characteristic] -> Difficulty -> m RollResult	
 actionNoExperience c cs d=liftM snd (action c cs d)
 
-diffResult :: (MonadRandom m) => Character -> [Characteristic] -> Difficulty -> m Int
+diffResult :: (MonadRandom m,MonadWriter ScreenMessages m) => Character -> [Characteristic] -> Difficulty -> m Int
 diffResult c cs d= do
 	r <- roll d20
 	let avgCs=score c cs
 	let myScore=avgCs+d
 	return (myScore-r)
 
-diffResult' :: (MonadRandom m) => Character -> [Characteristic] -> Difficulty -> (Int -> Int) -> m Int	
+diffResult' :: (MonadRandom m,MonadWriter ScreenMessages m) => Character -> [Characteristic] -> Difficulty -> (Int -> Int) -> m Int	
 diffResult' c cs d f=do
 	diff<-diffResult c cs d
 	let diff'=f diff
@@ -54,39 +57,46 @@ 			then (-diff')
 			else diff')
 
-competeWithDiff :: (MonadRandom m) => Character -> Character-> [Characteristic] -> Int ->  m ((Character,Character),RollResult)
+competeWithDiff :: (MonadRandom m,MonadWriter ScreenMessages m) => Character -> Character-> [Characteristic] -> Int -> m ((Character,Character),RollResult)
 competeWithDiff c1 c2 cs d=do
 	r <- roll d20
-	return (processCompeteDiff c1 c2 cs r d)
+	processCompeteDiff c1 c2 cs r d
 	
-compete :: (MonadRandom m) => Character -> Character-> [Characteristic] -> m ((Character,Character),RollResult)
+compete :: (MonadRandom m,MonadWriter ScreenMessages m) => Character -> Character-> [Characteristic] -> m ((Character,Character),RollResult)
 compete c1 c2 cs=competeWithDiff c1 c2 cs 0
 	
-processCompete :: Character -> Character-> [Characteristic] -> Int -> ((Character,Character),RollResult)
+processCompete :: (MonadWriter ScreenMessages m) => Character -> Character-> [Characteristic] -> Int -> m ((Character,Character),RollResult)
 processCompete c1 c2 cs r =processCompeteDiff c1 c2 cs r 0
 
-processCompeteDiff :: Character -> Character-> [Characteristic] -> Int -> Int -> ((Character,Character),RollResult)
-processCompeteDiff c1 c2 cs r di=
+processCompeteDiff :: (MonadWriter ScreenMessages m) => Character -> Character-> [Characteristic] -> Int -> Int -> m ((Character,Character),RollResult)
+processCompeteDiff c1 c2 cs r di= do
 	let
 		avgCs1=score c1 cs
 		avgCs2=score c2 cs
 		d=(div (avgCs1-avgCs2) 2)+di
-		(c1b,rr1) = (processAction c1 cs d r)
-		(c2b,_) = (processAction c2 cs (-d) r)
-	in ((c1b,c2b),rr1)
+	(c1b,rr1) <- (processAction c1 cs d r)
+	(c2b,_) <- (processAction c2 cs (-d) r)
+	return ((c1b,c2b),rr1)
 	
 score :: Character -> [Characteristic] -> Int
 score c cs = avg (map (getCharacteristic' c Current) cs)	
 	
-processAction :: Character-> [Characteristic] -> Difficulty -> Int -> (Character,RollResult)	
-processAction c cs d roll=
+processAction :: (MonadWriter ScreenMessages m) => Character-> [Characteristic] -> Difficulty -> Int -> m (Character,RollResult)	
+processAction c cs d roll= do
 	let 
 		avgCs=score c cs
 		myScore=bindInt (1,19) (avgCs+d)
 		(rr,em)=evalResult roll myScore
 		expGain=experienceGain myScore em (length cs)
+		previousNormal=map (getCharacteristic' c Normal) allCharacteristics
 		c3=foldr (\b c2->addCharacteristic' c2 Experience b expGain) c cs
-	in (c3,rr)
+		newNormal=map (getCharacteristic' c3 Normal) allCharacteristics
+		augmented=filter (\(_,b)->b>0) $map (\(a,b,c)->(a,c-b)) $ zip3 allCharacteristics previousNormal newNormal
+	mapM_ (\(a,b)->addScreenMessage (printf (msg b) (name c3) b (show a))) augmented
+	return (c3,rr)
+	where 
+		msg 1="%s gains %d point in %s"
+		msg _="%s gains %d points in %s"	
 
 experienceGain :: Int -> Int -> Int -> Int
 experienceGain score expM l= div ((max 1 (div ((20-score)^2) 10)) * expM) l

@@ -1,6 +1,9 @@ -- | Action resolution hunit tests
 -- (c) JP Moresmau 2009
 module MoresmauJP.Rpg.ActionsTests where
+
+import Control.Monad.Writer
+
 import MoresmauJP.Rpg.Actions
 import MoresmauJP.Rpg.Character
 import MoresmauJP.Rpg.CharacterTests
@@ -10,30 +13,30 @@ import Test.HUnit
 import Text.Printf
 
-actionsTests=TestList [testDifficultyLevel,testEvalResults]
+actionsTests=TestList [testDifficultyLevel,testEvalResults,testActionCausesLevel]
 
 testDifficultyLevel = TestLabel "testDifficultyLevel" (TestCase (do
 	--setTestGen [10]
 	let jp=createTestChar "JP"
 	let sg=mkTestWrapper [10]
-	let (_,rr)=evalRand (action jp [Dexterity] (toIntLevel Neutral)) sg
+	((_,rr),_)<-evalRandT (runWriterT $ action jp [Dexterity] (toIntLevel Neutral)) sg
 	assertEqual "Not standard success 0" (Success Standard 0) rr
-	let (_,rr)=evalRand (action jp [Dexterity] (toIntLevel RatherEasy)) sg
+	((_,rr),_)<-evalRandT (runWriterT $ action jp [Dexterity] (toIntLevel RatherEasy)) sg
 	assertEqual "Not standard success 3" (Success Standard 3) rr
-	let (_,rr)=evalRand (action jp [Dexterity] (toIntLevel Easy)) sg
+	((_,rr),_)<-evalRandT (runWriterT $ action jp [Dexterity] (toIntLevel Easy)) sg
 	assertEqual "Not standard success 6" (Success Standard 6) rr
-	let (_,rr)=evalRand (action jp [Dexterity] (toIntLevel VeryEasy)) sg
+	((_,rr),_)<-evalRandT (runWriterT $ action jp [Dexterity] (toIntLevel VeryEasy)) sg
 	assertEqual "Not standard success 9" (Success Standard 9) rr
-	let (_,rr)=evalRand (action jp [Dexterity] (toIntLevel NearUnmissable)) sg
+	((_,rr),_)<-evalRandT (runWriterT $ action jp [Dexterity] (toIntLevel NearUnmissable)) sg
 	assertEqual "Not standard success 9" (Success Standard 9) rr
 			
-	let (_,rr)=evalRand (action jp [Dexterity] (toIntLevel RatherHard)) sg
+	((_,rr),_)<-evalRandT (runWriterT $ action jp [Dexterity] (toIntLevel RatherHard)) sg
 	assertEqual "Not standard failure 3" (Failure Standard 3) rr
-	let (_,rr)=evalRand (action jp [Dexterity] (toIntLevel Hard)) sg
+	((_,rr),_)<-evalRandT (runWriterT $ action jp [Dexterity] (toIntLevel Hard)) sg
 	assertEqual "Not standard failure 6" (Failure Standard 6) rr
-	let (_,rr)=evalRand (action jp [Dexterity] (toIntLevel VeryHard)) sg
+	((_,rr),_)<-evalRandT (runWriterT $ action jp [Dexterity] (toIntLevel VeryHard)) sg
 	assertEqual "Not standard failure 9" (Failure Standard 9) rr
-	let (_,rr)=evalRand (action jp [Dexterity] (toIntLevel NearImpossible)) sg
+	((_,rr),_)<-evalRandT (runWriterT $ action jp [Dexterity] (toIntLevel NearImpossible)) sg
 	assertEqual "Not standard failure 9" (Failure Standard 9) rr
 			
 	))
@@ -54,4 +57,22 @@ 		let msg= printf "%d/%d should be %s but is %s " roll score (show expected) (show actual)
 		assertEqual msg expected actual
 		))
+		
+testActionCausesLevel=  TestLabel "testActionCausesLevel" (TestCase (do
+	let jp=createTestChar "JP"
+	assertEqual "current dexterity is not 10" 10 (getCharacteristic' jp Current Dexterity)
+	assertEqual "normal dexterity is not 10" 10 (getCharacteristic' jp Normal Dexterity)
+	assertEqual "experience dexterity is not 0" 0 (getCharacteristic' jp Experience Dexterity)
+	let jp2=setCharacteristic' jp Experience Dexterity 333
+	assertEqual "current dexterity is not 10" 10 (getCharacteristic' jp2 Current Dexterity)
+	assertEqual "normal dexterity is not 10" 10 (getCharacteristic' jp2 Normal Dexterity)
+	assertEqual "experience dexterity is not 333" 333 (getCharacteristic' jp2 Experience Dexterity)
+	let sg=mkTestWrapper [10]
+	((jp3,_),msgs)<-evalRandT (runWriterT $ action jp2 [Dexterity] (toIntLevel Neutral)) sg
+	assertEqual "current dexterity is not 11" 11 (getCharacteristic' jp3 Current Dexterity)
+	assertEqual "normal dexterity is not 11" 11 (getCharacteristic' jp3 Normal Dexterity)
+	assertEqual "experience dexterity is not 20" 20 (getCharacteristic' jp3 Experience Dexterity)
+	assertEqual "not 1 message" 1 (length msgs)
+	assertEqual "not right message" "JP gains 1 point in Dexterity" (head msgs)
+	))
 	

@@ -3,6 +3,7 @@ module MoresmauJP.Rpg.Arena where
 
 import Control.Monad.State
+import Control.Monad.Writer
 
 import Data.Maybe
 import Data.List
@@ -41,32 +42,35 @@ 	arenaTickCount::Int
 	} deriving (Show,Read)
 
-screenInteract :: Character -> NPCCharacter -> RandomWrapper -> Int -> IO ExitState
+screenInteract :: Character -> NPCCharacter -> RandomWrapper -> Int -> IO (ExitState)
 screenInteract c1 c2 rw tc= do
 	let ar=Arena c1 c2 Nothing True [] tc
 	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))
 	initial<-getInitialAttitude c2
-	w<-case initial of
+	(w,msgs)<-case initial of
 		NPCFight -> do
-			w<-fightInArena 
-			return (combineWidget (WText (printf "The %s attacks!" (name $ npcCharacter c2))) w)
-		NPCWait -> chooseAction
-		NPCTrade ->tradeInArena	
-	commandLoop2 (combineWidget wEncounter w)
+			(w,msgs)<-runWriterT fightInArena 
+			return (w, (printf "The %s attacks!" (name $ npcCharacter c2)):msgs)
+		NPCWait -> runWriterT chooseAction
+		NPCTrade ->runWriterT tradeInArena
+	let wmsgs=WList msgs
+	let w2=combineWidget wmsgs w
+	commandLoop2 (combineWidget wEncounter w2)
 	(GameState ar2 _)<-get
 	return (ExitState (arenaCharacter ar2) (arenaOpponent ar2) (fromJust $ es ar2) (arenaItems ar2) (arenaTickCount ar2))
 
-chooseAction :: GSWScreenT Arena
+chooseAction :: WScreenT Arena
 chooseAction = do
 	gs <- get
 	let (Arena{arenaOpponent=npc}) = gsData gs
 	return (getShowCombo ["What do you want to do?"] (possibleNPCInteractions npc) chooseF)
 
-chooseF::ComboResult InteractionToNPC -> GSWScreenT Arena 
+chooseF::ComboResult InteractionToNPC -> WScreenT Arena 
 chooseF (Exact Fight)=fightInArena
 chooseF (Exact Trade)=tradeInArena
 chooseF (Exact Convert)=convertInArena
@@ -77,14 +81,14 @@ 	put (gs{gsData=ar{es=Just Finished},screen=Nothing})
 	return WNothing
 	
-tradeInArena :: GSWScreenT Arena	
+tradeInArena :: WScreenT Arena	
 tradeInArena=do
 	gs <- get
 	let (Arena{arenaCharacter=c1}) = gsData gs
 	let gold=printf "You have %d gold coins" (getGold $ inventory c1)
 	return (getShowCombo [gold,"Choose trade operation"] [Buy .. Exchange] tradeInArena')
 	
-tradeInArena' :: ComboResult TradeAction -> GSWScreenT Arena
+tradeInArena' :: ComboResult TradeAction -> WScreenT Arena
 tradeInArena' Empty = chooseAction
 tradeInArena' (Unknown _)= chooseAction
 tradeInArena' (Exact EndTrade)= chooseAction
@@ -105,7 +109,7 @@ 				[(printf "What do you want to %s" (show action))]
 				ops tradeChoice)
 	
-tradeChoice :: ComboResult TradeOperation -> GSWScreenT Arena
+tradeChoice :: ComboResult TradeOperation -> WScreenT Arena
 tradeChoice Empty = tradeInArena
 tradeChoice (Unknown _)= tradeInArena
 tradeChoice (Exact op)=do
@@ -124,12 +128,12 @@ 	
 
 	
-tradeChoice' :: TradeOperation -> Maybe Position -> ComboResult (Position,Maybe ItemType) -> GSWScreenT Arena
+tradeChoice' :: TradeOperation -> Maybe Position -> ComboResult (Position,Maybe ItemType) -> WScreenT Arena
 tradeChoice' _ _ Empty = tradeInArena
 tradeChoice' _ _ (Unknown _) = tradeInArena
 tradeChoice' op posNpc (Exact pos) = tradeOperation op posNpc (Just $ fst pos)
 	
-tradeOperation :: TradeOperation -> Maybe Position -> Maybe Position -> GSWScreenT Arena
+tradeOperation :: TradeOperation -> Maybe Position -> Maybe Position -> WScreenT Arena
 tradeOperation op posNpc posC = do
 	gs <- get
 	let ar@(Arena{arenaCharacter=c1,arenaOpponent=npc@NPCCharacter{npcCharacter=c2}}) = gsData gs
@@ -139,12 +143,12 @@ 	arenaTick ar2
 	tradeInArena
 
-arenaTick :: Arena -> ScreenT (GameState Arena) ()
+arenaTick :: Arena -> WriterT ScreenMessages (RandT (StateT (GameState Arena) IO)) ()
 arenaTick ar=do
 	gs <- get
 	put gs{gsData=ar{arenaTickCount=((arenaTickCount ar)+1)}}
 	
-fightInArena :: GSWScreenT Arena
+fightInArena :: WScreenT Arena
 fightInArena = 	do
 	gs <- get
 	let ar@(Arena {arenaCharacter=c1,arenaOpponent=c2}) = gsData gs
@@ -155,16 +159,16 @@ 			put (gs{gsData=ar{arenaCharacter=c1b,arenaOpponent=(c2{npcCharacter=c2b}),chToHit=False}})
 		 	fightInArena'
 
-fightInArena' :: GSWScreenT Arena
+fightInArena' :: WScreenT Arena
 fightInArena' = do
 	gs <- get
 	let ar@(Arena {arenaCharacter=c1,arenaOpponent=c2,chToHit=chToHit}) = gsData gs
-	((c1b,c2b),isDead,msgs) <- (case chToHit of
+	((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)
+	--let w=WList (map show msgs)
 	if isDead
 		then
 			do
@@ -172,15 +176,15 @@ 					then (Death,"You're killed!")
 					else (Victory,"You triumph!")
 			put (gs{gsData=ar2{es=Just status},screen=Nothing})
-			return (combineWidget w (WText txt))
+			return (WText txt)
 		else
 			do
 			w2<- if (not chToHit)
 				then choiceArena
 				else fightInArena'
-			return (combineWidget w w2)
+			return w2
 
-castInArena :: GSWScreenT Arena
+castInArena :: WScreenT Arena
 castInArena = do
 	(Arena {arenaCharacter=c1,arenaOpponent=c2}) <- gets gsData
 	let spells=spellsToOpponent c1 (npcCharacter c2)
@@ -190,16 +194,16 @@ 			return (combineWidget (WText "No spell you can cast!") w)
 		else return (getMappedCombo spellName ["Cast spell:"] spells castInArena' )
 
-castInArena' :: (ComboResult Spell) -> GSWScreenT Arena
+castInArena' :: (ComboResult Spell) -> WScreenT Arena
 castInArena' Empty = choiceArena
 castInArena' (Unknown _)= choiceArena
 castInArena' (Exact spell)=do
 	gs <- get
 	let ar@(Arena {arenaCharacter=c1,arenaOpponent=c2,arenaTickCount=tc}) = gsData gs
-	((c1b,c2b),dead,msgs) <- spellToOpponent c1 (npcCharacter c2) spell tc
+	((c1b,c2b),dead) <- spellToOpponent c1 (npcCharacter c2) spell tc
 	let ar2=ar{arenaCharacter=c1b,arenaOpponent=(c2{npcCharacter=c2b}),chToHit=False}
 	arenaTick ar2
-	let w=WList (map show msgs)
+	--let w=WList (map show msgs)
 	if dead
 		then
 			do
@@ -209,13 +213,13 @@ 						then (Death,"You become mad!")
 						else (Victory,"You triumph!")
 			put (gs{gsData=ar2{es=Just status},screen=Nothing})
-			return (combineWidget w (WText txt))
+			return $ WText txt
 		else
 			do
 			w2<- fightInArena'
-			return (combineWidget w w2)
+			return w2
 
-prayerInArena :: GSWScreenT Arena
+prayerInArena :: WScreenT Arena
 prayerInArena = do
 	gs <- get
 	let ar@(Arena {arenaCharacter=c1,arenaOpponent=c2,arenaTickCount=tc}) = gsData gs
@@ -241,7 +245,7 @@ diffAttitude :: NPCCharacter -> Int
 diffAttitude c2=(div ((npcAttitude c2)-10) 2)
 
-bribeInArena :: GSWScreenT Arena
+bribeInArena :: WScreenT Arena
 bribeInArena = do
 	gs <- get
 	let ar@(Arena {arenaCharacter=c1,arenaOpponent=c2,arenaTickCount=tc}) = gsData gs
@@ -275,14 +279,14 @@ 					put (gs{gsData=ar2{es=Just Finished,arenaCharacter=c1c,arenaOpponent=npc3},screen=Nothing})
 					return (WText (printf "The %s takes your money (%d gold coins) and leaves you alone" (name c2b) gold))
 
-choiceArena :: GSWScreenT Arena
+choiceArena :: WScreenT Arena
 choiceArena = do
 	ar<-gets gsData
 	let status=getHealthSummary (arenaCharacter ar)
 	let actions=getPossibleArenaActions (arenaCharacter ar) (arenaOpponent ar)
 	return (getShowCombo (["Your health:"]++status++["Choose next action"]) actions choiceArenaF)
 
-choiceArenaF :: ComboResult ArenaAction -> GSWScreenT Arena
+choiceArenaF :: ComboResult ArenaAction -> WScreenT Arena
 choiceArenaF (Exact Escape)=do
 	gs<-get
 	let ar=gsData gs
@@ -316,7 +320,7 @@ 	Human 	-> if g>0 then [Melee .. Bribe] else  [Melee .. Prayer]
 	--}
 	
-convertInArena :: GSWScreenT Arena	
+convertInArena :: WScreenT Arena	
 convertInArena=do
 	gs <- get
 	let ar@(Arena {arenaCharacter=c1,arenaOpponent=c2,arenaTickCount=tc}) = gsData gs
@@ -349,7 +353,7 @@ 			put (gs2{gsData=ar2{es=Just Finished,arenaOpponent=npc4},screen=Nothing})
 			return (WText msg)
 
-stealInArena :: GSWScreenT Arena	
+stealInArena :: WScreenT Arena	
 stealInArena=do
 	gs <- get
 	let ar@(Arena {arenaCharacter=c1,arenaOpponent=c2,arenaTickCount=tc}) = gsData gs
@@ -380,7 +384,7 @@ 			put (gs2{gsData=ar2{es=Just Finished},screen=Nothing})
 			return (WText msg)
 
-getItemsFromNPC:: RollResult -> (Inventory -> [(Position,ItemType)]) -> ScreenT (GameState Arena) (Int,Gold)	
+getItemsFromNPC:: RollResult -> (Inventory -> [(Position,ItemType)]) ->WriterT ScreenMessages (RandT (StateT (GameState Arena) IO)) (Int,Gold)	
 getItemsFromNPC rr f= do
 	gs <- get
 	let 

@@ -3,7 +3,7 @@ module MoresmauJP.Rpg.ArenaTests where
 
 import Control.Monad.State
-
+import Control.Monad.Writer
 
 import MoresmauJP.Core.Screen
 import MoresmauJP.Rpg.Arena
@@ -32,7 +32,7 @@ 	let victim=v1{npcCharacter=vc1}
 	let arena=Arena jp victim Nothing True [] 0
 	let gs=GameState arena Nothing
-	gs2<- execStateT (evalRandT stealInArena (mkTestWrapper [12])) gs
+	gs2<- execStateT (evalRandT (runWriterT stealInArena) (mkTestWrapper [12])) gs
 	let arena2=gsData gs2
 	assertEqual "status not finished" (Just Finished) (es arena2) 
 	assertEqual "not zero items" 0 (length $ arenaItems arena2)
@@ -50,7 +50,7 @@ 	let victim=v1{npcCharacter=vc1}
 	let arena=Arena jp victim Nothing True [] 0
 	let gs=GameState arena Nothing
-	gs2<- execStateT (evalRandT stealInArena (mkTestWrapper [20])) gs
+	gs2<- execStateT (evalRandT (runWriterT stealInArena) (mkTestWrapper [20])) gs
 	let arena2=gsData gs2
 	assertEqual "status finished" Nothing (es arena2) 
 	assertEqual "not zero items" 0 (length $ arenaItems arena2)
@@ -68,7 +68,7 @@ 	let victim=v1{npcCharacter=vc1}
 	let arena=Arena jp victim Nothing True [] 0
 	let gs=GameState arena Nothing
-	gs2<- execStateT (evalRandT stealInArena (mkTestWrapper [8])) gs
+	gs2<- execStateT (evalRandT (runWriterT stealInArena) (mkTestWrapper [8])) gs
 	let arena2=gsData gs2
 	assertEqual "status not finished" (Just Finished) (es arena2) 
 	assertEqual "not one item" 1 (length $ arenaItems arena2)
@@ -86,7 +86,7 @@ 	let victim=v1{npcCharacter=vc1}
 	let arena=Arena jp victim Nothing True [] 0
 	let gs=GameState arena Nothing
-	gs2<- execStateT (evalRandT stealInArena (mkTestWrapper [8])) gs
+	gs2<- execStateT (evalRandT (runWriterT stealInArena) (mkTestWrapper [8])) gs
 	let arena2=gsData gs2
 	assertEqual "status not finished" (Just Finished) (es arena2) 
 	assertEqual "not zero item" 0 (length $ arenaItems arena2)
@@ -103,7 +103,7 @@ 	let victim=v1{npcCharacter=vc1}
 	let arena=Arena jp victim Nothing True [] 0
 	let gs=GameState arena Nothing
-	gs2<- execStateT (evalRandT stealInArena (mkTestWrapper [4])) gs
+	gs2<- execStateT (evalRandT (runWriterT stealInArena) (mkTestWrapper [4])) gs
 	let arena2=gsData gs2
 	assertEqual "status not finished" (Just Finished) (es arena2) 
 	assertEqual "not one item" 1 (length $ arenaItems arena2)
@@ -123,7 +123,7 @@ 	let victim=v1{npcCharacter=vc1}
 	let arena=Arena jp victim Nothing True [] 0
 	let gs=GameState arena Nothing
-	gs2<- execStateT (evalRandT stealInArena (mkTestWrapper [8])) gs
+	gs2<- execStateT (evalRandT (runWriterT stealInArena) (mkTestWrapper [8])) gs
 	let arena2=gsData gs2
 	assertEqual "status not finished" (Just Finished) (es arena2) 
 	assertEqual "not zero item" 0 (length $ arenaItems arena2)
@@ -140,7 +140,7 @@ 	let victim=v1{npcCharacter=vc1}
 	let arena=Arena jp victim Nothing True [] 0
 	let gs=GameState arena Nothing
-	gs2<- execStateT (evalRandT convertInArena (mkTestWrapper [12])) gs
+	gs2<- execStateT (evalRandT (runWriterT convertInArena) (mkTestWrapper [12])) gs
 	let arena2=gsData gs2
 	assertEqual "status not finished" (Just Finished) (es arena2) 
 	assertEqual "not zero items" 0 (length $ arenaItems arena2)
@@ -158,7 +158,7 @@ 	let victim=v1{npcCharacter=vc1}
 	let arena=Arena jp victim Nothing True [] 0
 	let gs=GameState arena Nothing
-	gs2<- execStateT (evalRandT convertInArena (mkTestWrapper [20])) gs
+	gs2<- execStateT (evalRandT (runWriterT convertInArena) (mkTestWrapper [20])) gs
 	let arena2=gsData gs2
 	assertEqual "status finished" Nothing (es arena2) 
 	assertEqual "not zero items" 0 (length $ arenaItems arena2)
@@ -176,7 +176,7 @@ 	let victim=v1{npcCharacter=vc1}
 	let arena=Arena jp victim Nothing True [] 0
 	let gs=GameState arena Nothing
-	gs2<- execStateT (evalRandT convertInArena (mkTestWrapper [8])) gs
+	gs2<- execStateT (evalRandT (runWriterT convertInArena) (mkTestWrapper [8])) gs
 	let arena2=gsData gs2
 	assertEqual "status not finished" (Just Finished) (es arena2) 
 	assertEqual "not one item" 1 (length $ arenaItems arena2)
@@ -194,7 +194,7 @@ 	let victim=v1{npcCharacter=vc1}
 	let arena=Arena jp victim Nothing True [] 0
 	let gs=GameState arena Nothing
-	gs2<- execStateT (evalRandT bribeInArena (mkTestWrapper [8])) gs
+	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)
@@ -208,7 +208,7 @@ 	let victim=v1{npcCharacter=vc1}
 	let arena=Arena jp victim Nothing True [] 0
 	let gs=GameState arena Nothing
-	gs2<- execStateT (evalRandT bribeInArena (mkTestWrapper [8])) gs
+	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)
@@ -222,7 +222,7 @@ 	let victim=v1{npcCharacter=vc1}
 	let arena=Arena jp victim Nothing True [] 0
 	let gs=GameState arena Nothing
-	gs2<- execStateT (evalRandT bribeInArena (mkTestWrapper [12])) gs
+	gs2<- execStateT (evalRandT (runWriterT bribeInArena) (mkTestWrapper [12])) gs
 	let arena2=gsData gs2
 	assertEqual "status finished" Nothing (es arena2) 
 	assertEqual "victim gold is not 100" 100 (getGold $ inventory $ npcCharacter $ arenaOpponent arena2)
@@ -236,7 +236,7 @@ 	let victim=v1{npcCharacter=vc1}
 	let arena=Arena jp victim Nothing True [] 0
 	let gs=GameState arena Nothing
-	gs2<- execStateT (evalRandT bribeInArena (mkTestWrapper [8])) gs
+	gs2<- execStateT (evalRandT (runWriterT bribeInArena) (mkTestWrapper [8])) gs
 	let arena2=gsData gs2
 	assertEqual "status finished" Nothing (es arena2) 
 	assertEqual "victim gold is not 100" 100 (getGold $ inventory $ npcCharacter $ arenaOpponent arena2)
@@ -251,7 +251,7 @@ 	let victim=v1{npcCharacter=vc1}
 	let arena=Arena jp victim Nothing True [] 0
 	let gs=GameState arena Nothing
-	gs2<- execStateT (evalRandT bribeInArena (mkTestWrapper [20])) gs
+	gs2<- execStateT (evalRandT (runWriterT bribeInArena) (mkTestWrapper [20])) gs
 	let arena2=gsData gs2
 	assertEqual "status finished" Nothing (es arena2) 
 	assertEqual "victim gold is not 100" 100 (getGold $ inventory $ npcCharacter $ arenaOpponent arena2)
@@ -264,7 +264,7 @@ 	let v1=(createTestNPC "Victim")
 	let arena=Arena jp v1 Nothing True [] 0
 	let gs=GameState arena Nothing
-	gs2<- execStateT (evalRandT prayerInArena (mkTestWrapper [8])) gs
+	gs2<- execStateT (evalRandT (runWriterT prayerInArena) (mkTestWrapper [8])) gs
 	let arena2=gsData gs2
 	assertEqual "status not finished" (Just Finished) (es arena2) 
 	assertEqual "attitude is not 12" 12 (npcAttitude $ arenaOpponent arena2)
@@ -277,7 +277,7 @@ 	let victim=v1{npcCharacter=vc1}
 	let arena=Arena jp victim Nothing True [] 0
 	let gs=GameState arena Nothing
-	gs2<- execStateT (evalRandT prayerInArena (mkTestWrapper [12])) gs
+	gs2<- execStateT (evalRandT (runWriterT prayerInArena) (mkTestWrapper [12])) gs
 	let arena2=gsData gs2
 	assertEqual "status finished" Nothing (es arena2)
 	assertEqual "attitude is not 10" 10 (npcAttitude $ arenaOpponent arena2)
@@ -290,7 +290,7 @@ 	let victim=v1{npcCharacter=vc1}
 	let arena=Arena jp victim Nothing True [] 0
 	let gs=GameState arena Nothing
-	gs2<- execStateT (evalRandT prayerInArena (mkTestWrapper [20])) gs
+	gs2<- execStateT (evalRandT (runWriterT prayerInArena) (mkTestWrapper [20])) gs
 	let arena2=gsData gs2
 	assertEqual "status finished" Nothing (es arena2)
 	assertEqual "attitude is not 1" 1 (npcAttitude $ arenaOpponent arena2)

@@ -2,14 +2,17 @@ -- (c) JP Moresmau 2009
 module MoresmauJP.Rpg.Character where
 
+import Control.Monad.Writer
+
+
 import Data.Array.IArray
 import Data.List
 
 import Text.Printf
 import Text.Regex.Posix
 
+import MoresmauJP.Core.Screen
 import MoresmauJP.Rpg.Inventory
-
 import MoresmauJP.Util.Numbers
 
 
@@ -108,13 +111,17 @@ addCharacteristic cr rst char inc= let 
 	(Rating arr)=cr ! char
 	oldVal=arr ! rst
-	arr2=nextLevel (arr // [(rst,max 0 (oldVal+inc))])
+	arr2=(if (rst==Experience) 
+		then nextLevel
+		else id) (arr // [(rst,max 0 (oldVal+inc))])
 	in cr // [(char,Rating arr2)]
 
 setCharacteristic :: CharacteristicRatings -> RatingScoreType -> Characteristic -> Int -> CharacteristicRatings
 setCharacteristic cr rst char inc= let 
 	(Rating arr)=cr ! char
-	arr2=nextLevel (arr // [(rst,inc)])
+	arr2=(if (rst==Experience) 
+		then nextLevel 
+		else id) (arr // [(rst,inc)])
 	in cr // [(char,Rating arr2)]
 
 nextLevel :: (Array RatingScoreType Int) -> (Array RatingScoreType Int)
@@ -164,13 +171,33 @@ 	(a',a'')=partition (\x->(untilTick x)>tc) a
 	in (c{affects=a'},map liftDescription a'')
 	
-recover :: Character
+recover :: (MonadWriter ScreenMessages m) => Character
 	-> Characteristic
 	-> Int
-	-> (Character,Int)
-recover c ch n=let
-	current = getCharacteristic' c Current ch
-	normal = getCharacteristic' c Normal ch
-	updated = min normal (current + n)
-	in (setCharacteristic' c Current ch updated,(updated-current))
-	+	-> m (Character,Int)
+recover c ch n=do
+	let
+		current = getCharacteristic' c Current ch
+		normal = getCharacteristic' c Normal ch
+		updated = min normal (current + n)
+		diff = updated-current
+	when (diff>0) (addScreenMessage (printf "You recover %s!" (points ch diff)))
+	return (setCharacteristic' c Current ch updated,(updated-current))
+	
+	
+reflective :: Character -> String
+reflective c=case gender c of
+	Male -> "himself"
+	Female -> "herself"
+	
+possessive :: Character -> String
+possessive c=case gender c of
+	Male -> "his"
+	Female -> "her"
+	
+points :: Characteristic -> Int -> String
+points c diff=let
+	end=if diff==1 
+			then "point"
+			else "points"
+	in (printf ("%d %s " ++ end) diff (show c))	

@@ -75,9 +75,9 @@ 	assertEqual "normal dexterity is not 11" 10 (getCharacteristic' jp Normal Dexterity)
 	assertEqual "experience dexterity is not 0" 0 (getCharacteristic' jp Experience Dexterity)
 	let jp2=setCharacteristic' jp Experience Dexterity 334
-	assertEqual "current dexterity is not 10" 11 (getCharacteristic' jp2 Current Dexterity)
-	assertEqual "normal dexterity is not 10" 11 (getCharacteristic' jp2 Normal Dexterity)
-	assertEqual "experience dexterity is not 10" 1 (getCharacteristic' jp2 Experience Dexterity)
+	assertEqual "current dexterity is not 11" 11 (getCharacteristic' jp2 Current Dexterity)
+	assertEqual "normal dexterity is not 11" 11 (getCharacteristic' jp2 Normal Dexterity)
+	assertEqual "experience dexterity is not 1" 1 (getCharacteristic' jp2 Experience Dexterity)
 	))		
 	
 testAffects= TestLabel "Test Affects" (TestCase (do

@@ -5,48 +5,85 @@ 
 where
 
-import Control.Monad
+import Control.Monad.Writer
 import Data.List
 
+import MoresmauJP.Core.Screen
 import MoresmauJP.Rpg.Actions
 import MoresmauJP.Rpg.Character
 import MoresmauJP.Rpg.Items
 import MoresmauJP.Rpg.Inventory
 
+import MoresmauJP.Util.Lists
 import MoresmauJP.Util.Random
 
 import Text.Printf
 
-type FightStatus a= ((a,a),Bool,[Message])
+type FightStatus a= ((a,a),Bool)
 
 
 swapFS :: FightStatus a -> FightStatus a
-swapFS ((c1,c2),b,msgs)=((c2,c1),b,msgs)
+swapFS ((c1,c2),b)=((c2,c1),b)
 
-giveBlow :: (MonadRandom m)=>Character -> Character -> m (FightStatus Character)
+giveBlow :: (MonadRandom m,MonadWriter [String] m)=>Character -> Character -> m (FightStatus Character)
 giveBlow c1 c2 =do 
 	((c1b,c2b),rr) <- compete c1 c2  melee
 	damages c1b c2b rr
 
+addMessage :: (MonadWriter ScreenMessages m)=> Message -> m ()
+addMessage =addScreenMessage . show 
 	
-damages:: (MonadRandom m)=>Character -> Character -> RollResult -> m (FightStatus Character)
+damages:: (MonadRandom m,MonadWriter ScreenMessages m)=>Character -> Character -> RollResult -> m (FightStatus Character)
 damages a b (Failure {grade=Exceptional}) = 
 	do 
-		(c11,d1,msgs1) <- damageWeapon a (Success Standard 0)
-		(c12,d2,msgs2) <- damageArmor c11 Standard
-		let total=max 0 (d1-d2+(damageLevel c12 Standard))
-		let msg1=Message (c12,Fumble total)
-		let c13=addCharacteristic' c12 Current Physical (-total)
-		return ((c13,b),isOutOfService c13,msgs1++msgs2++[msg1])
-damages a b (Failure {})= return ((a,b),False,[Message (a, Miss)])
+		fe<-randomPickp [minBound..maxBound]
+		c2<-damagesFumble a fe
+		return ((c2,b),isOutOfService c2)
+damages a b (Failure {})= do
+	addMessage $ Message (a, Miss)
+	return ((a,b),False)
 damages c1 c2 rr@(Success {grade=gr})= do
-	(c11,d1,msgs1) <- damageWeapon c1 rr
-	(c21,d2,msgs2) <- damageArmor c2 gr
+	(c11,d1) <- damageWeapon c1 rr
+	(c21,d2) <- damageArmor c2 gr
 	let total=max 0 (d1-d2+(damageLevel c11 gr))
-	let msg1=Message (c11,Hit total)
+	addMessage $ Message (c11,Hit total)
 	let c22=addCharacteristic' c21 Current Physical (-total)
-	return ((c11,c22),isOutOfService c22,msgs1++msgs2++[msg1])
+	return ((c11,c22),isOutOfService c22)
 
+damagesFumble ::(MonadRandom m,MonadWriter ScreenMessages m)=> Character -> FumbleEvent -> m Character
+damagesFumble a SelfWound=do 
+	(c11,d1) <- damageWeapon a (Success Standard 0)
+	(c12,d2) <- damageArmor c11 Standard
+	let total=max 0 (d1-d2+(damageLevel c12 Standard))
+	let c13=addCharacteristic' c12 Current Physical (-total)
+	addMessage $ Message (c13,Fumble SelfWound total "")
+	return c13
+damagesFumble a DexterityLoss=do 
+	let c11=addCharacteristic' a Current Physical (-1)
+	let c12=addCharacteristic' c11 Current Dexterity (-1)
+	addMessage $ Message (c12,Fumble DexterityLoss 0 "")
+	return c12
+damagesFumble a CharismaLoss=do 
+	let c11=addCharacteristic' a Current Physical (-1)
+	let c12=addCharacteristic' c11 Current Charisma (-1)
+	addMessage $ Message (c12,Fumble CharismaLoss 0 "")
+	return c12
+damagesFumble a WeaponBreak=do 
+	let 
+		i=inventory a
+		mis=filter (\(p,_)->p==RightHand || p==LeftHand) $ listCarriedItems i
+	if null mis
+		then
+			damagesFumble a DexterityLoss
+		else do 
+			mi<-randomPickp mis
+			let 
+				Right (i2,_)=dropItem i (fst mi)
+				wn=itName (snd mi)
+				c2=a{inventory=i2}
+			addMessage $ Message (c2,Fumble WeaponBreak 0 wn)
+			return c2
+
 damageLevel :: Character-> Grade -> Int
 damageLevel c Standard = damageBonus c
 damageLevel c Remarkable = div ((damageBonus c) * 12) 10
@@ -55,44 +92,46 @@ damageBonus :: Character -> Int
 damageBonus c = div (getCharacteristic' c Current Strength) 4
 
-damageWeapon :: (MonadRandom m)=>Character -> RollResult ->  m (Character,Int,[Message])
+damageWeapon :: (MonadRandom m,MonadWriter ScreenMessages m)=>Character -> RollResult ->  m (Character,Int)
 damageWeapon c rr=do
 	-- get items, no duplicate (for two hands weapon)
 	let items=nub $ (filter isWeapon) $ listActiveItems (inventory c)
-	(c2,items2,msgs)<-if length items==2
+	(c2,items2)<-if length items==2
 		then
 			do
 			-- dexterity roll to see if we could use the second weapon
 			(c1,rr)<-action c [Dexterity] (subsequentDifficulty (grade rr))
 			if (isSuccess rr)
-				then
-					return (c1,items,[Message(c1,TwoHandedAttack)])
+				then do
+					addMessage $ Message(c1,TwoHandedAttack)
+					return (c1,items)
 				-- if failed, used only right hand weapon	
 				else 
-					return (c1,[head items],[])
+					return (c1,[head items])
 		else
-			return (c,items,[])
+			return (c,items)
 	dmg<-mapM (damageFromItemHigh rr) items2
-	return (c2, sum dmg,msgs) 
+	return (c2, sum dmg) 
 
-damageArmor :: (MonadRandom m)=>Character -> Grade -> m(Character,Int,[Message])
+damageArmor :: (MonadRandom m,MonadWriter ScreenMessages m)=>Character -> Grade -> m(Character,Int)
 damageArmor c g = do
 	let items=nub $ (filter isProtective) $ listActiveItems (inventory c)
-	(c2,items2,msg)<-foldM shieldF (c,[],[]) items
+	(c2,items2)<-foldM shieldF (c,[]) items
 	dmg<-mapM  damageFromItem items2
-	return (c2,sum dmg,msg)
+	return (c2,sum dmg)
 	where 
-		--shieldF :: (Character,[ItemType],[Message]) -> ItemType -> Rand (Character,[ItemType],[Message])
-		shieldF (c,its,msgs) it@(Shield {})=do
+		--shieldF :: (Character,[ItemType],[Message]) -> ItemType -> Rand (Character,[ItemType])
+		shieldF (c,its) it@(Shield {})=do
 			-- dexterity roll on the shield
 			(c1,rr)<-action c [Dexterity] (subsequentDifficulty g)
 			if (isSuccess rr)
-				then
-					return (c1,(it:its),(Message(c1,ShieldDefense):msgs))
+				then do
+					addMessage $ Message(c1,ShieldDefense)
+					return (c1,(it:its))
 				-- if failed, do not use shields
 				else 
-					return (c1,its,msgs)
-		shieldF (c,its,msgs) it=return (c,(it:its),msgs)
+					return (c1,its)
+		shieldF (c,its) it=return (c,(it:its))
 		
 damageFromItem ::  (MonadRandom m)=>ItemType -> m(Int)
 damageFromItem it =roll (damageLow it,damageHigh it)
@@ -104,11 +143,20 @@ 
 newtype Message = Message (Character,MessageType)
 
-data MessageType = Fumble Int | Miss | Hit Int | TwoHandedAttack | ShieldDefense
+data MessageType = Fumble FumbleEvent Int String  
+	| Miss | Hit Int | TwoHandedAttack | ShieldDefense
+	deriving (Show,Read,Eq)
 
+data FumbleEvent = SelfWound | DexterityLoss | CharismaLoss | WeaponBreak
+	deriving (Show,Read,Eq,Bounded,Enum,Ord)
+
 instance Show Message where
-	showsPrec _ (Message (c,(Fumble damage))) = showString $ printf "%s fumbles and gives himself %d damages" (name c) damage
+	showsPrec _ (Message (c,(Fumble SelfWound damage _))) = showString $ printf "%s fumbles and gives %s %d damages" (name c) (reflective c) damage
+	showsPrec _ (Message (c,(Fumble DexterityLoss _ _))) = showString $ printf "%s fumbles and gives %s a hand injury (-1 Dexterity)" (name c) (reflective c)
+	showsPrec _ (Message (c,(Fumble CharismaLoss _ _))) = showString $ printf "%s fumbles and gives %s a face injury (-1 Charisma)" (name c) (reflective c)
+	showsPrec _ (Message (c,(Fumble WeaponBreak _ s))) = showString $ printf "%s fumbles and breaks %s %s" (name c) (possessive c) s
 	showsPrec _ (Message (c,(Miss))) = showString $ printf "%s misses" (name c)
+	showsPrec _ (Message (c,(Hit 0))) = showString $ printf "%s hits but causes no damages" (name c)
 	showsPrec _ (Message (c,(Hit damage))) = showString $ printf "%s hits and causes %d damages" (name c) damage
 	showsPrec _ (Message (c,TwoHandedAttack))= showString $ printf "%s manages a two-hand attack" (name c) 
 	showsPrec _ (Message (c,ShieldDefense))= showString $ printf "%s manages to shield" (name c) 

@@ -2,16 +2,21 @@ -- (c) JP Moresmau 2009
 module MoresmauJP.Rpg.FightTests where
 
+import Control.Monad.Writer
+
 import MoresmauJP.Rpg.Character
 import MoresmauJP.Rpg.CharacterTests
 import MoresmauJP.Rpg.Fight
+import MoresmauJP.Rpg.Inventory
 
 import MoresmauJP.Util.Random
 
 import Test.HUnit
 
 fightTests = TestList [testFightRoundNormal,
-		testFightRoundFumble,testFightRoundKill]
+		testFightRoundFumbleSelfWound,testFightRoundFumbleDexterityLoss,
+		testFightRoundFumbleCharismaLoss,testFightRoundFumbleWeaponBreak,testFightRoundFumbleWeaponBreakNoWeapon,
+		testFightRoundKill]
 
 testFightRoundNormal=TestLabel "Test Fight Round Normal Hit" (TestCase (do
 	--let jpChars=unlines (map (\x-> (show x) ++ " 10/10(0)") [Strength .. Mental])
@@ -21,7 +26,7 @@ 	let troll=createTestChar "Troll"
 	assertBool "Troll is not OK" (isOK troll)
 	
-	let ((jp2,troll2),dead,msgs)=evalRand (giveBlow jp troll) (mkTestWrapper[8])--processFightRound jp troll [11,8,11]
+	(((jp2,troll2),dead),msgs)<-evalRandT (runWriterT $ giveBlow jp troll) (mkTestWrapper[8])--processFightRound jp troll [11,8,11]
 	assertBool "somebody is dead!" (not dead)
 	assertEqual "jp2 is not jp" (name jp2) (name jp)
 	assertEqual "troll2 is not troll" (name troll2) (name troll)
@@ -30,20 +35,20 @@ 	assertEqual "jp2 physical is not jp physical" (getCharacteristic' jp2 Current Physical) (getCharacteristic' jp Current Physical)
 	assertEqual "troll didn't lose 2 physical" (getCharacteristic' troll2 Current Physical) ((getCharacteristic' troll Current Physical)-2)
 	assertEqual "Not 1 message" 1 (length msgs)
-	assertEqual "Msg1" "JP hits and causes 2 damages" (show $ head msgs)
+	assertEqual "Msg1" "JP hits and causes 2 damages" (head msgs)
 	--assertEqual "Msg2" "Troll misses" (head $ tail msgs)
 	))
 	
 
 
 
-testFightRoundFumble=TestLabel "Test Fight Round Fumbles" (TestCase (do
+testFightRoundFumbleSelfWound=TestLabel "Test Fight Round Fumbles SelfWound" (TestCase (do
 	--let jpChars=unlines (map (\x-> (show x) ++ " 10/10(0)") [Strength .. Mental])
 	let jp=createTestChar "JP"
 	assertBool "JP is not OK" (isOK jp)
 	let troll=createTestChar "Troll"
 	assertBool "Troll is not OK" (isOK troll)
-	let ((troll2,jp2),dead,msgs)=evalRand (giveBlow troll jp) (mkTestWrapper [20]) --processFightRound jp troll [11,11,20]
+	(((troll2,jp2),dead),msgs)<-evalRandT (runWriterT $ giveBlow troll jp) (mkTestWrapper [20]) --processFightRound jp troll [11,11,20]
 	assertBool "somebody is dead!" (not dead)
 	assertEqual "jp2 is not jp" (name jp2) (name jp)
 	assertEqual "troll2 is not troll" (name troll2) (name troll)
@@ -53,9 +58,87 @@ 	assertEqual "troll didn't lose 2 physical" ((getCharacteristic' troll Current Physical)-2) (getCharacteristic' troll2 Current Physical)
 	assertEqual "Not 1 message" 1 (length msgs)
 	--assertEqual "Msg1" "JP misses" (head msgs)
-	assertEqual "Msg2" "Troll fumbles and gives himself 2 damages" (show $ head msgs)
+	assertEqual "Msg2" "Troll fumbles and gives himself 2 damages" (head msgs)
 	))
+	
+testFightRoundFumbleDexterityLoss=TestLabel "Test Fight Round Fumbles DexterityLoss" (TestCase (do
+	let jp=createTestChar "JP"
+	assertBool "JP is not OK" (isOK jp)
+	let troll=(createTestChar "Troll"){gender=Female}
+	assertBool "Troll is not OK" (isOK troll)
+	(((troll2,jp2),dead),msgs)<-evalRandT (runWriterT $ giveBlow troll jp) (mkTestWrapper [20,1,20,20,20,20,20]) 
+	assertBool "somebody is dead!" (not dead)
+	assertEqual "jp2 is not jp" (name jp2) (name jp)
+	assertEqual "troll2 is not troll" (name troll2) (name troll)
+	assertBool "JP is not OK" (isOK jp2)
+	assertBool "Troll is not OK" (isOK troll2)
+	assertEqual "jp2 physical is not jp physical" (getCharacteristic' jp2 Current Physical) (getCharacteristic' jp Current Physical)
+	assertEqual "troll didn't lose 1 physical" ((getCharacteristic' troll Current Physical)-1) (getCharacteristic' troll2 Current Physical)
+	assertEqual "troll didn't lose 1 dexterity" ((getCharacteristic' troll Current Dexterity)-1) (getCharacteristic' troll2 Current Dexterity)
+	
+	assertEqual "Not 1 message" 1 (length msgs)
+	assertEqual "Msg2" "Troll fumbles and gives herself a hand injury (-1 Dexterity)" (head msgs)
+	))	
 
+testFightRoundFumbleCharismaLoss=TestLabel "Test Fight Round Fumbles CharismaLoss" (TestCase (do
+	let jp=createTestChar "JP"
+	assertBool "JP is not OK" (isOK jp)
+	let troll=(createTestChar "Troll"){gender=Female}
+	assertBool "Troll is not OK" (isOK troll)
+	(((troll2,jp2),dead),msgs)<-evalRandT (runWriterT $ giveBlow troll jp) (mkTestWrapper [20,20,1,20,20,20,20]) 
+	assertBool "somebody is dead!" (not dead)
+	assertEqual "jp2 is not jp" (name jp2) (name jp)
+	assertEqual "troll2 is not troll" (name troll2) (name troll)
+	assertBool "JP is not OK" (isOK jp2)
+	assertBool "Troll is not OK" (isOK troll2)
+	assertEqual "jp2 physical is not jp physical" (getCharacteristic' jp2 Current Physical) (getCharacteristic' jp Current Physical)
+	assertEqual "troll didn't lose 1 physical" ((getCharacteristic' troll Current Physical)-1) (getCharacteristic' troll2 Current Physical)
+	assertEqual "troll didn't lose 1 charisma" ((getCharacteristic' troll Current Charisma)-1) (getCharacteristic' troll2 Current Charisma)
+	
+	assertEqual "Not 1 message" 1 (length msgs)
+	assertEqual "Msg2" "Troll fumbles and gives herself a face injury (-1 Charisma)" (head msgs)
+	))	
+
+testFightRoundFumbleWeaponBreak=TestLabel "Test Fight Round Fumbles WeaponBreak" (TestCase (do
+	let jp=createTestChar "JP"
+	assertBool "JP is not OK" (isOK jp)
+	let Right (i,_)=takeItem mkEmptyInventory (Weapon "Massive Club" 3 10 2 4) RightHand
+	let troll=(createTestChar "Troll"){gender=Female,inventory=i}
+	assertBool "Troll is not OK" (isOK troll)
+	(((troll2,jp2),dead),msgs)<-evalRandT (runWriterT $ giveBlow troll jp) (mkTestWrapper [20,20,20,1,20,20,20]) 
+	assertBool "somebody is dead!" (not dead)
+	assertEqual "jp2 is not jp" (name jp2) (name jp)
+	assertEqual "troll2 is not troll" (name troll2) (name troll)
+	assertBool "JP is not OK" (isOK jp2)
+	assertBool "Troll is not OK" (isOK troll2)
+	assertEqual "jp2 physical is not jp physical" (getCharacteristic' jp2 Current Physical) (getCharacteristic' jp Current Physical)
+	assertEqual "troll2 physical is not troll physical" (getCharacteristic' troll Current Physical) (getCharacteristic' troll2 Current Physical)
+	assertEqual "troll2 charisma is not troll charisma" (getCharacteristic' troll Current Charisma) (getCharacteristic' troll2 Current Charisma)
+	assertEqual "troll2 dexterity is not troll dexterity" (getCharacteristic' troll Current Dexterity) (getCharacteristic' troll2 Current Dexterity)
+	
+	assertEqual "Not 1 message" 1 (length msgs)
+	assertEqual "Msg2" "Troll fumbles and breaks her Massive Club" (head msgs)
+	))	
+
+testFightRoundFumbleWeaponBreakNoWeapon=TestLabel "Test Fight Round Fumbles WeaponBreakNoWeapon" (TestCase (do
+	let jp=createTestChar "JP"
+	assertBool "JP is not OK" (isOK jp)
+	let troll=(createTestChar "Troll"){gender=Female}
+	assertBool "Troll is not OK" (isOK troll)
+	(((troll2,jp2),dead),msgs)<-evalRandT (runWriterT $ giveBlow troll jp) (mkTestWrapper [20,20,20,1,20,20,20]) 
+	assertBool "somebody is dead!" (not dead)
+	assertEqual "jp2 is not jp" (name jp2) (name jp)
+	assertEqual "troll2 is not troll" (name troll2) (name troll)
+	assertBool "JP is not OK" (isOK jp2)
+	assertBool "Troll is not OK" (isOK troll2)
+	assertEqual "jp2 physical is not jp physical" (getCharacteristic' jp2 Current Physical) (getCharacteristic' jp Current Physical)
+	assertEqual "troll didn't lose 1 physical" ((getCharacteristic' troll Current Physical)-1) (getCharacteristic' troll2 Current Physical)
+	assertEqual "troll didn't lose 1 dexterity" ((getCharacteristic' troll Current Dexterity)-1) (getCharacteristic' troll2 Current Dexterity)
+	
+	assertEqual "Not 1 message" 1 (length msgs)
+	assertEqual "Msg2" "Troll fumbles and gives herself a hand injury (-1 Dexterity)" (head msgs)
+	))	
+
 testFightRoundKill=TestLabel "Test Fight Round Kill" (TestCase (do
 	--let jpChars=unlines (map (\x-> (show x) ++ " 10/10(0)") [Strength .. Mental])
 	let jp=createTestChar "JP"
@@ -63,7 +146,7 @@ 	let troll1=createTestChar "Troll"
 	let troll=setCharacteristic' troll1 Current Physical 2
 	assertBool "Troll is not OK" (isOK troll)
-	let ((jp2,troll2),dead,msgs)=evalRand (giveBlow jp troll) (mkTestWrapper [8]) -- processFightRound jp troll [11,8,11]
+	(((jp2,troll2),dead),msgs)<-evalRandT (runWriterT $ giveBlow jp troll) (mkTestWrapper [8]) -- processFightRound jp troll [11,8,11]
 	assertBool "nobody is dead!" dead
 	assertEqual "jp2 is not jp" (name jp2) (name jp)
 	assertEqual "troll2 is not troll" (name troll2) (name troll)
@@ -74,5 +157,5 @@ 	assertEqual "jp2 physical is not jp physical" (getCharacteristic' jp2 Current Physical) (getCharacteristic' jp Current Physical)
 	assertEqual "troll didn't lose 2 physical" ((getCharacteristic' troll Current Physical)-2) (getCharacteristic' troll2 Current Physical)
 	assertEqual "Not 1 message" (length msgs) 1
-	assertEqual "Msg1" "JP hits and causes 2 damages" (show $ head msgs)
+	assertEqual "Msg1" "JP hits and causes 2 damages" (head msgs)
 	))

@@ -108,14 +108,17 @@ 	
 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
+	(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 False
+	(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
@@ -137,9 +140,10 @@ 			let freeBagPos=getFirstFreeBagPos i2
 			if (isJust freeBagPos)
 				then do
-					(i3,_)<- takeItem i (fromJust it2) (fromJust freeBagPos)
+					(i3,_)<- takeItem i2 (fromJust it2) (fromJust freeBagPos)
 					return (i3,Nothing)
-				else return mi2
+				else 
+					return mi2
 		else return mi2
 
 instance Monad (Either InventoryError) where

@@ -11,7 +11,7 @@ import Test.HUnit
 
 inventoryTests = TestList [
-		testInventory,testInventory2Hands,testMakeFullInventory]
+		testInventory,testInventory2Hands,testInventoryPick2Hands,testMakeFullInventory]
 		
 
 testInventory = TestLabel "Test Inventory" (TestCase (do
@@ -38,6 +38,7 @@ 		assertBool "item from empty inventory is not Nothing" (null item1)
 		let carriedItems=listCarriedItems i2
 		assertEqual "not carrying 2 items" 2 (length carriedItems)
+		assertEqual "not carrying 1 unique item" 1 (length $ listCarriedItemsUniqueObject i2)
 		assertEqual "not carrying in right hand" 1 (length (filter (\(pos,i)->pos==RightHand && sw==i) carriedItems))
 		assertEqual "not carrying in left hand" 1 (length (filter (\(pos,i)->pos==LeftHand && sw==i) carriedItems))
 		let Right(i3,item2)=dropItem i2 RightHand
@@ -63,6 +64,27 @@ 		assertBool "something in bag 2" (not $ isJust mi2)
 		
 	))	
+	
+testInventoryPick2Hands=TestLabel "Test Inventory Pick 2 handed weapon" (TestCase (do	
+		let i1=mkEmptyInventory
+		let sw=twoHandedWord
+		let sw1=sword
+		let sw2=dagger
+		let Right(i2,item1)=takeItem i1 sw1 RightHand
+		assertBool "item from empty inventory is not Nothing" (null item1)
+		let Right(i3,item2)=takeItem i2 sw2 LeftHand
+		assertBool "item from empty inventory is not Nothing" (null item2)
+		assertEqual "not carrying 2 items" 2 (length $ listCarriedItems i3)
+		assertEqual "not carrying 2 unique items" 2 (length $ listCarriedItemsUniqueObject i3)
+		let Right(i4,item3)=takeItem i3 sw RightHand
+		assertBool "item from empty inventory is not Nothing" (null item3)
+		assertEqual "not carrying 4 items" 4 (length $ listCarriedItems i4)
+		assertEqual "not carrying 3 unique items" 3 (length $ listCarriedItemsUniqueObject i4)
+		assertEqual "not carrying 2 handed sword in right hand" (Right $ Just sw) (getCarriedItem i4 RightHand)
+		assertEqual "not carrying 2 handed sword in left hand" (Right $ Just sw) (getCarriedItem i4 LeftHand)
+		assertEqual "not carrying sword in bag" (Right $ Just sw1) (getCarriedItem i4 (Bag 1))
+		assertEqual "not carrying dagger in bag" (Right $ Just sw2) (getCarriedItem i4 (Bag 2))
+	))
 	
 testMakeFullInventory= TestLabel "Test makeFullInventory" (TestCase (do
 	let pos1=[(RightHand,sword),(Body,leatherArmor),(Bag 1,minorHealingPotion)]

@@ -2,6 +2,9 @@ -- (c) JP Moresmau 2009
 module MoresmauJP.Rpg.Items where
 
+import Control.Monad.Writer
+
+import MoresmauJP.Core.Screen
 import MoresmauJP.Rpg.Actions
 import MoresmauJP.Rpg.Character
 import MoresmauJP.Rpg.Inventory
@@ -71,19 +74,27 @@ canUseItem (Scroll {})=True
 canUseItem _=False
 	
-useItemEffect :: (Monad m)=>ItemType -> Character -> RandT m (Maybe (String,Character,Bool))
+useItemEffect :: (MonadRandom m,MonadWriter ScreenMessages m)=>ItemType -> Character -> m (Maybe (Character,Bool))
 useItemEffect (Potion{potionType=(HealingPotion n)}) c1= do
 	(c2,rr)<-action c1 medecine (toIntLevel Neutral)
 	let n'=resultExtra n rr
-	let (c3,recovered)=recover c2 Physical n'
-	return (Just (printf "You regain %d physical health points" recovered,c3,True))
+	(c3,_)<-recover c2 Physical n'
+	return (Just (c3,True))
 useItemEffect (Scroll{spellType=s}) c1@(Character {spells=knownSpells})= do
 	if (elem s (map spellName knownSpells))
-		then return (Just ("You already know that spell",c1,False))
+		then do
+			addScreenMessage $ "You already know that spell"
+			return (Just (c1,False))
 		else do
 			(c2,rr)<-action c1 spelllearning (toIntLevel RatherHard)
 			case rr of 
-				Success{}->return (Just ((printf "You learn the spell %s" s),c2{spells=knownSpells++(filter ((s ==) . spellName) allSpells)},True))
-				Failure{grade=Exceptional}->return (Just ("You fail badly to learn that spell",addCharacteristic' c2 Current Mental (-1),True))
-				Failure{}->return (Just ("You fail to learn that spell",c2,True))
+				Success{}->do
+					addScreenMessage (printf "You learn the spell %s" s)
+					return (Just (c2{spells=knownSpells++(filter ((s ==) . spellName) allSpells)},True))
+				Failure{grade=Exceptional}->do
+					addScreenMessage "You fail badly to learn that spell"
+					return (Just (addCharacteristic' c2 Current Mental (-1),True))
+				Failure{}->do
+					addScreenMessage "You fail to learn that spell"
+					return (Just (c2,True))
 useItemEffect _ _=return Nothing

@@ -2,6 +2,7 @@ -- (c) JP Moresmau 2009
 module MoresmauJP.Rpg.ItemsTests where
 
+import Control.Monad.Writer
 import Data.Maybe
 
 import MoresmauJP.Rpg.Character
@@ -19,10 +20,12 @@ 	let jp=createTestChar "JP"
 	assertEqual "Physical must be 10" 10 (getCharacteristic' jp Current Physical)
 	let jp2=setCharacteristic' jp Current Physical 5
-	(Just (_,jp3,remove1))<-evalRandT (useItemEffect minorHealingPotion jp2) (mkTestWrapper [8])
+	((Just (jp3,remove1)),msgs)<-evalRandT (runWriterT (useItemEffect minorHealingPotion jp2)) (mkTestWrapper [8])
+	assertEqual "not recover message1" "You recover 3 Physical points!" (head msgs)
 	assertEqual "Physical must be 8 after potion" 8 (getCharacteristic' jp3 Current Physical)
 	assertBool "not remove1" remove1
-	(Just (_,jp4,remove2))<-evalRandT (useItemEffect minorHealingPotion jp3) (mkTestWrapper [8])
+	((Just (jp4,remove2)),msgs2)<-evalRandT (runWriterT (useItemEffect minorHealingPotion jp3)) (mkTestWrapper [8])
+	assertEqual "not recover message2" "You recover 2 Physical points!" (head msgs2)
 	assertEqual "Physical must be 10 after potion" 10 (getCharacteristic' jp4 Current Physical)
 	assertBool "not remove2" remove2
 	)) 
@@ -31,7 +34,7 @@ 	let jp=createTestChar "JP"
 	assertEqual "Physical must be 10" 10 (getCharacteristic' jp Current Physical)
 	let jp2=setCharacteristic' jp Current Physical 5
-	r<-evalRandT (useItemEffect battleaxe jp2) (mkTestWrapper [10])
+	(r,_)<-evalRandT (runWriterT (useItemEffect battleaxe jp2)) (mkTestWrapper [10])
 	assertBool "result is not Nothing" (isNothing r)
 	)) 
 	
@@ -39,12 +42,12 @@ 	let jp=createTestChar "JP"
 	assertEqual "spells must be empty" 0 (length $ spells jp)
 	let sc=Scroll "Scroll of nimble fingers" "Nimble Fingers" 5
-	(Just (s,jp2,remove1))<-evalRandT (useItemEffect sc jp) (mkTestWrapper [7])
+	((Just (jp2,remove1)),(s:[]))<-evalRandT (runWriterT (useItemEffect sc jp)) (mkTestWrapper [7])
 	assertBool "not remove1" remove1
 	assertEqual "not success message" "You learn the spell Nimble Fingers" s
 	assertEqual "spells2 must be one" 1 (length $ spells jp2)
 	assertEqual "spell is not Nimble Fingers" "Nimble Fingers" (spellName $ head $ spells jp2)
-	(Just (s,jp3,remove2))<-evalRandT (useItemEffect sc jp2) (mkTestWrapper [9])
+	((Just (jp3,remove2)),(s:[]))<-evalRandT (runWriterT (useItemEffect sc jp2)) (mkTestWrapper [9])
 	assertBool "remove2" (not remove2)
 	assertEqual "not already message" "You already know that spell" s
 	assertEqual "spells2 must be one" 1 (length $ spells jp3)
@@ -55,7 +58,7 @@ 	let jp=createTestChar "JP"
 	assertEqual "spells must be empty" 0 (length $ spells jp)
 	let sc=Scroll "Scroll of nimble fingers" "Nimble Fingers" 5
-	(Just (s,jp2,remove1))<-evalRandT (useItemEffect sc jp) (mkTestWrapper [8])
+	((Just (jp2,remove1)),(s:[]))<-evalRandT (runWriterT (useItemEffect sc jp)) (mkTestWrapper [8])
 	assertBool "not remove1" remove1
 	assertEqual "not success message" "You fail to learn that spell" s
 	assertEqual "spells2 must be empty" 0 (length $ spells jp2)
@@ -65,7 +68,7 @@ 	let jp=createTestChar "JP"
 	assertEqual "spells must be empty" 0 (length $ spells jp)
 	let sc=Scroll "Scroll of nimble fingers" "Nimble Fingers" 5
-	(Just (s,jp2,remove1))<-evalRandT (useItemEffect sc jp) (mkTestWrapper [20])
+	((Just (jp2,remove1)),(s:[]))<-evalRandT (runWriterT (useItemEffect sc jp)) (mkTestWrapper [20])
 	assertBool "not remove1" remove1
 	assertEqual "not success message" "You fail badly to learn that spell" s
 	assertEqual "spells2 must be empty" 0 (length $ spells jp2)

@@ -2,14 +2,18 @@ -- (c) JP Moresmau 2009
 module MoresmauJP.Rpg.Magic where
 
+import Control.Monad.Writer
+
+import MoresmauJP.Core.Screen
 import MoresmauJP.Rpg.Actions
 import MoresmauJP.Rpg.Character
 
+import MoresmauJP.Util.Lists
 import MoresmauJP.Util.Random
 
 import Text.Printf
 	
-type MagicStatus a= ((a,a),Bool,[Message])
+type MagicStatus a= ((a,a),Bool)
 	
 allSpells :: [Spell]
 allSpells= [
@@ -24,6 +28,7 @@ 	,Spell "Doh!" Intelligence Negative Temporary
 	,Spell "Ox Strength" Strength Positive Temporary
 	,Spell "Troll Face" Charisma Negative Temporary
+	,Spell "Drop dead gorgeous" Charisma Positive Temporary
 	]
 	
 spellToAffect :: Spell -> RollResult -> Int -> Affect
@@ -31,7 +36,7 @@ 	(diff rr)
 	(tc + (((diff rr)+1) ^ 2))
 	(spellName spell)
-	(printf "Under the influence of %s" (spellName spell))
+	(printf "Under the influence of %s (%s)" (spellName spell) (points (impactedChar spell) (diff rr)))
 	(printf "Spell %s is lifting" (spellName spell))
 
 spellsToMyself :: Character -> [Spell]
@@ -45,31 +50,75 @@ 	affectSources=map source (affects c)
 	in filter (\x-> notElem (spellName x) affectSources) spells
 
-spellToMyself ::  (MonadRandom m) => Character -> Spell -> Int ->  m (Character,Message)
+spellToMyself ::  (MonadRandom m,MonadWriter ScreenMessages m) => Character -> Spell -> Int ->  m Character
 spellToMyself c s tc=do
 	(c2,rr)<-action c spellcasting (toIntLevel Neutral)
-	return $ spellToMyselfEffect c2 s tc rr
+	spellToMyselfEffect c2 s tc rr
 
-spellToMyselfEffect :: 	Character -> Spell -> Int -> RollResult -> (Character,Message)
-spellToMyselfEffect c s _ (Failure {grade=Exceptional})=(addCharacteristic' c Current Mental (-1),Message (c,s,Fumble))
-spellToMyselfEffect c s _ (Failure {})=(c,Message (c,s,Fail))
+spellToMyselfEffect :: 	(MonadRandom m,MonadWriter ScreenMessages m) => Character -> Spell -> Int -> RollResult -> m Character
+spellToMyselfEffect c s tc rr@(Failure {grade=Exceptional})=do
+	fe<-randomPickp [ForgetSpell .. maxBound]
+	damagesFumble c s tc rr fe
+spellToMyselfEffect c s _ (Failure {})=do
+	addMessage $ Message (c,s,Fail)
+	return c
 spellToMyselfEffect c s tc rr@(Success {})=
 	case spellDuration s of
-		Temporary->(addAffect c (spellToAffect s rr tc),Message (c,s,Myself))
-		Permanent->((fst $ recover c (impactedChar s) (diff rr)),Message (c,s,Myself))
+		Temporary->do
+			addMessage  $ Message (c,s,Myself)
+			let aff=(spellToAffect s rr tc)
+			addScreenMessage $ affectDescription aff
+			return (addAffect c aff)
+		Permanent->do
+			addMessage $ Message (c,s,Myself)
+			(a,_)<-recover c (impactedChar s) (diff rr)
+			return a
 	
-spellToOpponent ::(MonadRandom m)=> Character -> Character -> Spell -> Int -> m (MagicStatus Character)
+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)
+	addMessage $ Message (c12,s,Fumble SpellBounce 0)
+	return c12
+damagesFumble c s _ _ ForgetSpell= do
+	let c12=c{spells=filter (s /=) (spells c)}
+	addMessage $ Message (c12,s,Fumble ForgetSpell 0)
+	return c12
+damagesFumble c s _ _ MentalLoss= do
+	let c12=addCharacteristic' c Current Mental (-1)
+	addMessage $ Message (c12,s,Fumble MentalLoss 1)
+	return c12
+damagesFumble c s _ _ IntelligenceLoss= do
+	let c12=addCharacteristic' c Current Intelligence (-1)
+	addMessage $ Message (c12,s,Fumble IntelligenceLoss 1)
+	return c12
+
+
+addMessage :: (MonadWriter ScreenMessages m)=> Message -> m ()
+addMessage =addScreenMessage . show 
+	
+spellToOpponent ::(MonadRandom m,MonadWriter ScreenMessages m)=> Character -> Character -> Spell -> Int -> m (MagicStatus Character)
 spellToOpponent c1 c2 s tc= do
-	((c1b,c2b),rr) <- compete c1 c2  melee
-	return $ spellToOpponentEffect c1b c2b s tc rr
+	((c1b,c2b),rr) <- compete c1 c2 spellcasting
+	spellToOpponentEffect c1b c2b s tc rr
 	
-spellToOpponentEffect :: 	Character -> Character -> Spell -> Int -> RollResult -> MagicStatus Character
-spellToOpponentEffect c1 c2 s _ (Failure {grade=Exceptional})=((addCharacteristic' c1 Current Mental (-1),c2),isOutOfService c1,[Message (c1,s,Fumble)])
-spellToOpponentEffect c1 c2 s _ (Failure {})=((c1,c2),False,[Message (c1,s,Fail)])
+spellToOpponentEffect :: (MonadRandom m,MonadWriter ScreenMessages m) => Character -> Character -> Spell -> Int -> RollResult -> m (MagicStatus Character)
+spellToOpponentEffect c1 c2 s tc rr@(Failure {grade=Exceptional})=do
+	fe<-randomPickp [minBound .. maxBound]
+	c1'<-damagesFumble c1 s tc rr fe
+	return $ ((c1',c2),isOutOfService c1')
+spellToOpponentEffect c1 c2 s _ (Failure {})=do
+	addMessage $ Message (c1,s,Fail)
+	return $ ((c1,c2),False)
 spellToOpponentEffect c1 c2 s tc rr@(Success {})=
 	case spellDuration s of
-		Temporary->((c1,addAffect c2 (spellToAffect s rr tc)),isOutOfService c2,[Message (c1,s,Opponent) ])
-		Permanent->((c1,(addCharacteristic' c2 Current (impactedChar s) (-(diff rr)))),isOutOfService c2,[Message (c1,s,Opponent) ])
+		Temporary->do
+			addMessage $ Message (c1,s,Opponent)
+			let c2'=addAffect c2 (spellToAffect s rr tc)
+			return ((c1,c2'),isOutOfService c2')
+		Permanent->do
+			addMessage $ Message (c1,s,Opponent)
+			let c2'=(addCharacteristic' c2 Current (impactedChar s) (-(diff rr)))
+			return ((c1,c2'),isOutOfService c2')
 		
 -- complexity
 -- danger
@@ -78,10 +127,16 @@ 
 newtype Message=Message (Character,Spell,MessageType)
 
-data MessageType=Fumble | Fail |Myself | Opponent
+data MessageType=Fumble FumbleEvent Int | Fail |Myself | Opponent
 
+data FumbleEvent = SpellBounce | ForgetSpell | MentalLoss | IntelligenceLoss
+	deriving (Show,Read,Eq,Bounded,Enum,Ord)
+
 instance Show Message where
-	showsPrec _ (Message (_,s,Fumble))=showString $printf "The spell %s backfires on you" (spellName s) 
+	showsPrec _ (Message (_,s,Fumble MentalLoss a))=showString $ printf "The spell %s backfires on you and causes you to lose %s!" (spellName s) (points Mental a)
+	showsPrec _ (Message (_,s,Fumble ForgetSpell _))=showString $ printf "The spell %s backfires and you promptly forget it!" (spellName s)
+	showsPrec _ (Message (_,s,Fumble SpellBounce _))=showString $ printf "The spell %s bounces back and hits you!" (spellName s)
+	showsPrec _ (Message (_,s,Fumble IntelligenceLoss a))=showString $ printf "The spell %s confuses you and causes you to lose %s!" (spellName s) (points Intelligence a)
 	showsPrec _ (Message (_,s,Fail))=showString $printf "The spell %s fails" (spellName s)
 	showsPrec _ (Message (_,s,Myself))=showString $printf "The spell %s worked" (spellName s)
 	showsPrec _ (Message (c,s,Opponent))=showString $printf "%s casts %s" (name c) (spellName s)

@@ -2,6 +2,8 @@ -- (c) JP Moresmau 2009
 module MoresmauJP.Rpg.MagicTests where
 
+import Control.Monad.Writer
+
 import MoresmauJP.Rpg.Character
 import MoresmauJP.Rpg.CharacterTests
 import MoresmauJP.Rpg.Magic
@@ -10,15 +12,20 @@ 
 import Test.HUnit
 
-magicTests=TestList [testSpellsToMyself,testSpellToOpponentSuccess,testSpellToOpponentFailure,testSpellToOpponentFumble]
+magicTests=TestList [testSpellsToMyselfTemporary,testSpellsToMyselfPermanent,testSpellToOpponentSuccess
+	,testSpellToOpponentSuccessWeak,testSpellToOpponentFailure,testSpellToOpponentFumble,
+	testSpellToOpponentFumbleMad,testSpellToOpponentFumbleIntelligence,testSpellToOpponentFumbleForget,
+	testSpellToOpponentFumbleBackFires]
 
-testSpellsToMyself= TestLabel "Test spells to myself" (TestCase (do
+testSpellsToMyselfTemporary= TestLabel "Test spells to myself Temporary" (TestCase (do
 	let jp=(createTestChar "jp"){spells=[Spell "Nimble Fingers" Dexterity Positive Temporary]}
 	let spellsToMe1=spellsToMyself jp
 	assertEqual "not one spell" 1 (length spellsToMe1)
 	assertEqual "not nimble fingers" "Nimble Fingers" (spellName $ head spellsToMe1)
-	(jp2,msg)<-evalRandT (spellToMyself jp (head spellsToMe1) 1) (TestRandom [9])
-	assertEqual "not Fire Ball message" "The spell Nimble Fingers worked" (show msg)
+	(jp2,msgs)<-evalRandT (runWriterT (spellToMyself jp (head spellsToMe1) 1)) (TestRandom [9])
+	assertEqual "not two messages" 2 (length msgs)
+	assertEqual "not Nimble Fingers message" "The spell Nimble Fingers worked" (head msgs)
+	assertEqual "not under affect message" "Under the influence of Nimble Fingers (1 Dexterity point)" (head $ tail msgs)
 	assertEqual "dex is not 11" 11 (getCharacteristic' jp2 Current Dexterity) 
 	let spellsToMe2=spellsToMyself jp2
 	assertEqual "not zero spell2" 0 (length spellsToMe2)
@@ -30,33 +37,105 @@ 	assertEqual "not one spell4" 1 (length spellsToMe4)
 	))
 	
-testSpellToOpponentSuccess= TestLabel "Test spell to opponent success " (TestCase (do
+testSpellsToMyselfPermanent= TestLabel "Test spells to myself Permanent" (TestCase (do
+	let jp0=(createTestChar "jp"){spells=[Spell "Feel Better" Physical Recovery Permanent]}
+	let jp=setCharacteristic' jp0 Current Physical 9
+	let spellsToMe1=spellsToMyself jp
+	assertEqual "not one spell" 1 (length spellsToMe1)
+	assertEqual "not Feel Better" "Feel Better" (spellName $ head spellsToMe1)
+	(jp2,msgs)<-evalRandT (runWriterT (spellToMyself jp (head spellsToMe1) 1)) (TestRandom [9])
+	assertEqual "not two messages" 2 (length msgs)
+	assertEqual "not Feel Better message" "The spell Feel Better worked" (head msgs)
+	assertEqual "not recover message" "You recover 1 Physical point!" (head $ tail msgs)
+	assertEqual "physical is not 10" 10 (getCharacteristic' jp2 Current Physical) 
+	let spellsToMe2=spellsToMyself jp2
+	assertEqual "not one spell" 1 (length spellsToMe2)
+	assertEqual "not Feel Better" "Feel Better" (spellName $ head spellsToMe2)
+	))	
+	
+testSpellToOpponentSuccess= TestLabel "Test spell to opponent success" (TestCase (do
 	let jp=(createTestChar "JP") {spells=[Spell "Fire Ball" Physical Negative Permanent]}
 	let troll=createTestChar "Troll"
-	((_,troll1),isDead,msgs)<-evalRandT (spellToOpponent jp troll (head $ spells jp) 0) (TestRandom [9])
+	(((_,troll1),isDead),msgs)<-evalRandT (runWriterT (spellToOpponent jp troll (head $ spells jp) 0)) (TestRandom [9])
 	assertBool "dead" (not isDead)
 	assertEqual "not physical 9" 9 (getCharacteristic' troll1 Current Physical)
 	assertEqual "not 1 message" 1 (length msgs)
-	assertEqual "not Fire Ball message" "JP casts Fire Ball" (show $ head msgs)
+	assertEqual "not Fire Ball message" "JP casts Fire Ball" (head msgs)
 	))
 	
+testSpellToOpponentSuccessWeak= TestLabel "Test spell to weak opponent success" (TestCase (do
+	let jp=(createTestChar "JP") {spells=[Spell "Fire Ball" Physical Negative Permanent]}
+	let troll=setCharacteristic' (createTestChar "Troll") Current Willpower 5
+	(((_,troll1),isDead),msgs)<-evalRandT (runWriterT (spellToOpponent jp troll (head $ spells jp) 0)) (TestRandom [9])
+	assertBool "dead" (not isDead)
+	assertEqual "not physical 8" 8 (getCharacteristic' troll1 Current Physical)
+	assertEqual "not 1 message" 1 (length msgs)
+	assertEqual "not Fire Ball message" "JP casts Fire Ball" (head msgs)
+	))	
+	
 testSpellToOpponentFailure= TestLabel "Test spells to opponent failure" (TestCase (do
 	let jp=(createTestChar "JP") {spells=[Spell "Fire Ball" Physical Negative Permanent]}
 	let troll=createTestChar "Troll"
-	((_,troll1),isDead,msgs)<-evalRandT (spellToOpponent jp troll (head $ spells jp) 0) (TestRandom [11])
+	(((jp1,troll1),isDead),msgs)<- evalRandT (runWriterT (spellToOpponent jp troll (head $ spells jp) 0)) (TestRandom [11])
 	assertBool "dead" (not isDead)
 	assertEqual "not physical 10" 10 (getCharacteristic' troll1 Current Physical)
+	assertEqual "not mental 10" 10 (getCharacteristic' jp1 Current Mental)
 	assertEqual "not 1 message" 1 (length msgs)
-	assertEqual "not Fire Ball message" "The spell Fire Ball fails" (show $ head msgs)
+	assertEqual "not Fire Ball message" "The spell Fire Ball fails" ( head msgs)
 	))	
 	
-testSpellToOpponentFumble= TestLabel "Test spells to opponent fumble" (TestCase (do
+testSpellToOpponentFumble= TestLabel "Test spells to opponent fumble mental" (TestCase (do
 	let jp=(createTestChar "JP") {spells=[Spell "Fire Ball" Physical Negative Permanent]}
 	let troll=createTestChar "Troll"
-	((jp1,troll1),isDead,msgs)<-evalRandT (spellToOpponent jp troll (head $ spells jp) 0) (TestRandom [20])
+	(((jp1,troll1),isDead),msgs)<- evalRandT (runWriterT(spellToOpponent jp troll (head $ spells jp) 0)) (mkTestWrapper [20,10,1])
 	assertBool "dead" (not isDead)
 	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 backfires on you" (show $ head msgs)
+	assertEqual "not Fire Ball message" "The spell Fire Ball backfires on you and causes you to lose 1 Mental point!" (head msgs)
 	assertEqual "Mental must be 9" 9 (getCharacteristic' jp1 Current Mental)
-	))	+	))	
+	
+testSpellToOpponentFumbleMad= TestLabel "Test spells to opponent fumble mad" (TestCase (do
+	let jp=(createTestChar "JP") {spells=[Spell "Fire Ball" Physical Negative Permanent]}
+	let jp'=setCharacteristic' jp Current Mental 1
+	let troll=createTestChar "Troll"
+	(((jp1,troll1),isMad),msgs)<- evalRandT (runWriterT(spellToOpponent jp' troll (head $ spells jp') 0)) (mkTestWrapper [20,10,1])
+	assertBool "not dead" (isMad)
+	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 backfires on you and causes you to lose 1 Mental point!" (head msgs)
+	assertEqual "Mental must be 0" 0 (getCharacteristic' jp1 Current Mental)
+	))
+	
+testSpellToOpponentFumbleIntelligence= TestLabel "Test spells to opponent fumble intelligence" (TestCase (do
+	let jp=(createTestChar "JP") {spells=[Spell "Fire Ball" Physical Negative Permanent]}
+	let troll=createTestChar "Troll"
+	(((jp1,troll1),isMad),msgs)<- evalRandT (runWriterT(spellToOpponent jp troll (head $ spells jp) 0)) (mkTestWrapper [20,10,20,1,20,20])
+	assertBool "mad" (not isMad)
+	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 confuses you and causes you to lose 1 Intelligence point!" (head msgs)
+	assertEqual "Mental must be 9" 9 (getCharacteristic' jp1 Current Intelligence)
+	))		
+	
+testSpellToOpponentFumbleForget= TestLabel "Test spells to opponent fumble forget" (TestCase (do
+	let jp=(createTestChar "JP") {spells=[Spell "Fire Ball" Physical Negative Permanent]}
+	let troll=createTestChar "Troll"
+	(((jp1,troll1),isMad),msgs)<- evalRandT (runWriterT(spellToOpponent jp troll (head $ spells jp) 0)) (mkTestWrapper [20,1,20,20,20,20,20])
+	assertBool "mad" (not isMad)
+	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 backfires and you promptly forget it!" (head msgs)
+	assertEqual "Still has spells" 0 (length $ spells jp1)
+	))		
+	
+testSpellToOpponentFumbleBackFires= TestLabel "Test spells to opponent fumble back fires" (TestCase (do
+	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)
+	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)
+	))		

@@ -30,7 +30,7 @@ 	}
 	deriving (Read,Show)
 
-generateObjects :: (Monad m)=>Maze -> MazeOptions -> Int -> RandT m MazeObjects
+generateObjects :: (MonadRandom m)=>Maze -> MazeOptions -> Int -> m MazeObjects
 generateObjects mz options characterLevel =do
 	let ratio=((fromIntegral characterLevel/10.0) ** 2)::Float
 	-- less items as we progress
@@ -39,7 +39,7 @@ 	npcMap<-generateNPCs mz (fromIntegral $ npcProportion options) characterLevel
 	return (MazeObjects itemMap npcMap)
 	
-generateItems :: (Monad m)=>Size -> Float -> RandT m (M.Map Cell [ItemType])
+generateItems :: (MonadRandom m)=>Size -> Float -> m (M.Map Cell [ItemType])
 generateItems sz proportion=do
 	cellsWithItems<-getCellWithItems sz proportion
 	let occ=occurenceList itemOccurences
@@ -51,13 +51,13 @@ 			Just its->M.insert cell (it:its) m
 		return m2) M.empty cellsWithItems
 		
-generateScroll :: (Monad m) => ItemType -> RandT m (ItemType)
+generateScroll :: (MonadRandom m) => ItemType -> 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 :: (MonadRandom m)=> Maze -> Float -> Int -> m (M.Map Cell NPCCharacter)
 generateNPCs mz proportion characterLevel=do
 	cellsWithItems<-(getCellWithItems (size mz) proportion) 
 	let cells2=delete (start mz) cellsWithItems

@@ -324,7 +324,7 @@ data InteractionFromNPC=NPCFight | NPCTrade | NPCWait
 	deriving (Show,Read,Eq,Enum,Bounded)
 
-getInitialAttitude :: (Monad m)=> NPCCharacter -> RandT m (InteractionFromNPC)
+getInitialAttitude :: (MonadRandom m)=> NPCCharacter -> m (InteractionFromNPC)
 getInitialAttitude NPCCharacter{npcAttitude=att}=do
 	r <- (roll d20)
 	let (rr,_)=evalResult r att
@@ -347,7 +347,7 @@ 	Humanoid 	-> 0
 	Human 		-> 10
 
-generateFromTemplate :: (Monad m)=> NPCTemplate -> RandT m (NPCCharacter)
+generateFromTemplate :: (MonadRandom m)=> NPCTemplate -> m (NPCCharacter)
 generateFromTemplate template=do
 	let name=typeName template
 	-- get gender
@@ -377,7 +377,7 @@ 		spells=[]
 	}) (creatureType template) attitudeLevel)
 	
-generateFromRange :: (Monad m)=>(Characteristic,(Int,Int))->RandT m (Characteristic,Rating)
+generateFromRange :: (MonadRandom m)=>(Characteristic,(Int,Int))->m (Characteristic,Rating)
 generateFromRange (c,(low,high))=do 
 	rnd<-getRandomRange (low,high)
 	return (c,mkRating rnd)

@@ -40,7 +40,7 @@ 		func::Characteristic
 	}
 
-generateTraits :: (Monad m)=>Profile -> RandT m CharacteristicRatings
+generateTraits :: (MonadRandom m)=>Profile -> m CharacteristicRatings
 generateTraits p=do
 	let mt=array (head allCharacteristics,last allCharacteristics) (map (\x->(x,(mkRating 3))) allCharacteristics)
 	mt1<-makeFit mt p (8*(length allCharacteristics))
@@ -52,13 +52,13 @@ 			generateTraits p
 	
 
-makeFit :: (Monad m)=>CharacteristicRatings-> Profile -> Int -> RandT m CharacteristicRatings
+makeFit :: (MonadRandom m)=>CharacteristicRatings-> Profile -> Int -> m CharacteristicRatings
 makeFit mt _ 0 = return (mt)
 makeFit mt p t = do
 	mt1<-makeFitter mt p
 	makeFit mt1 p (t-1)
 
-makeFitter :: (Monad m)=>CharacteristicRatings -> Profile -> RandT m CharacteristicRatings
+makeFitter :: (MonadRandom m)=>CharacteristicRatings -> Profile -> m CharacteristicRatings
 makeFitter mt (n,cs) = do
 	let modifiableCs=filter ((isRatingBelowMax mt).func) cs
 	let vals=(map (\x -> (x,traitsScore mt x)) modifiableCs)

@@ -3,6 +3,7 @@ module MoresmauJP.Rpg.RPG where
 
 import Control.Monad.State
+import Control.Monad.Writer
 
 import Data.Char
 import Data.List
@@ -75,7 +76,7 @@ newCharacter :: ActionFunction RPGState 
 newCharacter _ =return (WInput ["Enter name:"] nameF)
 
-nameF :: String -> GSWScreenT RPGState 
+nameF :: String -> WScreenT RPGState 
 nameF "" =return (WText "Creation canceled")
 nameF name =do
 	gs <- get
@@ -86,13 +87,13 @@ 		else
 			return ((WCombo ["Choose gender:"] (map show [Male,Female]) (genderF name)))
 
-genderF :: String -> String -> GSWScreenT RPGState 
+genderF :: String -> String -> WScreenT RPGState 
 genderF _ ""=return (WText "Creation canceled")
 genderF name genderName= do
 	let gender=read (genderName)
 	return ((getMappedCombo fst ["Choose profile:"] profiles (profile (name,gender))))
 
-profile :: (String,Gender) -> ComboResult Profile -> GSWScreenT RPGState 
+profile :: (String,Gender) -> ComboResult Profile -> WScreenT RPGState 
 profile _ Empty=return (WText "Creation canceled")
 profile (name,gender) (Unknown _)= do
 	w2<- (genderF name) (show gender)
@@ -109,7 +110,7 @@ 	let c'=c{inventory=addGold (inventory c) extraGold,spells=spells} 
 	return (WCheck [ppCharacterAndGold' c'] "Accept?" True (profileAccept c'))
 
-profileAccept :: Character -> Bool -> GSWScreenT RPGState 
+profileAccept :: Character -> Bool -> WScreenT RPGState 
 profileAccept c False = (genderF (name c) (show $ gender c))
 profileAccept c True = do
 	gs <- get
@@ -122,7 +123,7 @@ viewCharacters :: ActionFunction RPGState 
 viewCharacters _=listCharactersW viewCharacter
 
-listCharactersW :: (String -> GSWScreenT RPGState) -> GSWScreenT RPGState
+listCharactersW :: (String -> WScreenT RPGState) -> WScreenT RPGState
 listCharactersW af= do
 	rs<-gets gsData
 	cs<-liftIO $ listCharacters rs
@@ -132,7 +133,7 @@ 	--listFilesW (characterExtension,"Choose character:","No character defined") 
 
 {--		
-listFilesW::  (String,String,String) -> (String -> GSWScreenT RPGState) -> GSWScreenT RPGState
+listFilesW::  (String,String,String) -> (String -> WScreenT RPGState) -> WScreenT RPGState
 listFilesW (ext,title,msg) af = do
 	rs<-gets gsData
 	files <- liftIO $ listFiles rs ext
@@ -145,7 +146,7 @@ 		)		
 --}
 		
-viewCharacter :: String -> GSWScreenT RPGState 
+viewCharacter :: String -> WScreenT RPGState 
 viewCharacter ""=return (WText "View canceled")
 viewCharacter shortName=do
 	rs<-gets gsData
@@ -153,13 +154,13 @@ 		(\c ->	return $ WText $ ppCharacterAndInventory' c)
 	onError w
 
-{--withFileContents :: String -> (String -> IO(Either String a)) -> (a->GSWScreenT RPGState) -> GSWScreenT RPGState
+{--withFileContents :: String -> (String -> IO(Either String a)) -> (a->WScreenT RPGState) -> WScreenT RPGState
 withFileContents shortName act act2= do
 	rs<-gets gsData
 	r<-readF rs shortName act act2
 	onError r--}
 
-onError :: Either String (Widget a) -> GSWScreenT a
+onError :: Either String (Widget a) -> WScreenT a
 onError (Right w)=return w
 onError (Left s)=return $ WText s
 
@@ -173,7 +174,7 @@ newGame :: ActionFunction RPGState 
 newGame _=listCharactersW gameNameF
 	
-gameNameF :: String -> GSWScreenT RPGState 
+gameNameF :: String -> WScreenT RPGState 
 gameNameF ""=return (WText "Creation canceled")
 gameNameF shortName=do
 	gs <- get
@@ -194,7 +195,7 @@ }
 
 
-createNewMazeState	::	Character -> GSWScreenT RPGState	
+createNewMazeState	::	Character -> WScreenT RPGState	
 createNewMazeState c = do
 	(GameState gw _) <- MG.initialGameState
 	mo<-generateObjects (maze $ gw) mazeOptions (characterLevel c)
@@ -202,7 +203,7 @@ 	createMazeState' c mgs2
 		--(printf "Game saved to %s " fileName)
 		
-createMazeState' :: Character -> RPGGameState -> GSWScreenT RPGState
+createMazeState' :: Character -> RPGGameState -> WScreenT RPGState
 createMazeState' c rgs = do
 	(RPGState {fp=fp}) <- gets gsData
 	s<-getSplit
@@ -230,7 +231,8 @@ 		mapA= Action "map" "See the map" mapAction
 		invA= Action "inventory" "See what you're carrying" inventoryAction
 		statusA=Action "character" "See your current character characteristics" statusAction
-		acts=statusA:mapA:invA:(backAction $ getGameScreen initialScreen):actions
+		bckA= Action "archive" "Save a backup of your game and character" saveBackupAction
+		acts=bckA:statusA:mapA:invA:(backAction $ getGameScreen initialScreen):actions
 		items=Objs.listItems (mazegameworld mgs) (objects mgs)
 		acts2=if null items
 			then acts
@@ -242,7 +244,7 @@ 		usableItems=filter (canUseItem . snd) itemsCarried
 		acts4=if null usableItems
 			then acts3
-			else (Action "use" "Use an item (drink a potion, etc.)" (useItem usableItems)):acts3
+			else (Action "use" "Use an item (drink a potion, read a scroll, etc.)" (useItem usableItems)):acts3
 		usableSpells=spellsToMyself c1
 		acts5=if null usableSpells
 			then acts4
@@ -280,7 +282,7 @@ 	rs@(RPGState {rpgCharacter=Just c1,mgs=(Just rmgs),fp=fp}) <- gets gsData
 	let gw=mazegameworld rmgs
 	sg <- getSplit
-	(WList s,(GameState gw2 sc))<- liftIO $ runStateT (evalRandT (MG.move dir []) sg) (GameState gw Nothing)
+	((WList s,_),(GameState gw2 sc))<- liftIO $ runStateT (evalRandT (runWriterT $ MG.move dir []) sg) (GameState gw Nothing)
 	let nameC=name $ c1
 	if (isJust sc) 
 		then
@@ -342,7 +344,7 @@ 	rs@(RPGState {mgs=(Just mgs)}) <- gets gsData
 	let gw=mazegameworld mgs
 	sg <- getSplit
-	(WList l,_)<-liftIO $ runStateT (evalRandT (MG.mapAction []) sg) (GameState gw Nothing)
+	((WList l,_),_)<-liftIO $ runStateT (evalRandT (runWriterT $ MG.mapAction []) sg) (GameState gw Nothing)
 	let itemNames=getItems rs
 	return	(combineWidget (WList l) itemNames)
 		
@@ -358,7 +360,7 @@ 		then return (WText "Nothing to pick up")
 		else getPretypedWidget (getMappedCombo itName ["Which item?"] items pickupItem) (if null cmds then [] else (tail cmds))
 
-pickupItem :: ComboResult ItemType -> GSWScreenT RPGState
+pickupItem :: ComboResult ItemType -> WScreenT RPGState
 pickupItem Empty=return (WText "Pick up canceled")
 pickupItem (Unknown _)=return (WText "That's not there to pick")
 pickupItem (Exact item) =do
@@ -366,7 +368,7 @@ 	let positions=Inv.listAllowedPositions (inventory $ c1) item
 	return (WCombo ["Put it where?"] (map ppInventoryPosition' positions) (doPickup item positions))
 
-doPickup :: ItemType -> [(Position,Maybe ItemType)] -> String -> GSWScreenT RPGState
+doPickup :: ItemType -> [(Position,Maybe ItemType)] -> String -> WScreenT RPGState
 doPickup _ _ ""=return (WText "Pick up canceled")
 doPickup item positions pos =do
 	(GameState {gsData=rs@(RPGState {rpgCharacter=Just c1,mgs=(Just mgs)})}) <- get
@@ -385,11 +387,19 @@ 			let w =(combineWidget (WText "Item picked up") itemNames)
 			saveGameAndCharacter w
 
-saveNewGameState :: RPGState -> ScreenT (GameState RPGState) ()
+saveNewGameState :: RPGState -> WriterT ScreenMessages (RandT (StateT (GameState RPGState) IO)) ()
 saveNewGameState rs2=do
 	put (GameState rs2 (getMazeScreen rs2))
 
-tick :: Int -> RPGState ->  ScreenT (GameState RPGState) (RPGState)
+saveBackupAction :: ActionFunction RPGState
+saveBackupAction _ = do
+	rs <- gets gsData
+	saveResult<- liftIO $ saveBackup rs			
+	return (case saveResult of
+		Right (t,_) -> WText t
+		Left t -> WText t)
+
+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})}
@@ -403,7 +413,7 @@ 		else (getMappedCombo ppItemPosition' ["What do you want to drop?"] items dropItemAction)
 		)
 	
-dropItemAction ::  ComboResult (Position,ItemType) -> GSWScreenT RPGState
+dropItemAction ::  ComboResult (Position,ItemType) -> WScreenT RPGState
 dropItemAction Empty=return (WText "Drop canceled")
 dropItemAction (Unknown _)=return (WText "You can't drop that")
 dropItemAction (Exact item) =do
@@ -418,7 +428,7 @@ 	let itemNames=getItems rs2	
 	saveGameAndCharacter (combineWidget (WText "Item dropped") itemNames)
 		
-saveGameAndCharacter :: Widget RPGState -> GSWScreenT RPGState
+saveGameAndCharacter :: Widget RPGState -> WScreenT RPGState
 saveGameAndCharacter w=do
 	gs@(GameState {gsData=rs@(RPGState {rpgCharacter=(Just c1)})}) <- get
 	when (isOutOfService c1) (put (gs{screen=Just (getGameScreen initialScreen)}))
@@ -428,7 +438,7 @@ 		Left t -> Just $ WText t
 	return (combineMaybeWidget w ws)
 	
-listGamesW :: (String -> GSWScreenT RPGState) -> String -> GSWScreenT RPGState
+listGamesW :: (String -> WScreenT RPGState) -> String -> WScreenT RPGState
 listGamesW af name= do
 	rs<-gets gsData
 	cs<-liftIO $ listGames rs name
@@ -443,11 +453,11 @@ deleteGames :: ActionFunction RPGState 
 deleteGames _ =listCharactersW (listGamesW $ deleteFileW deleteGame)
 
-deleteFileW :: (RPGState -> String -> IO (Either String String)) -> String -> GSWScreenT RPGState 
+deleteFileW :: (RPGState -> String -> IO (Either String String)) -> String -> WScreenT RPGState 
 deleteFileW _ ""=return (WText "Deletion canceled")
 deleteFileW f name=return (WCheck ["Delete "++name] "Are you sure?" False (reallyDeleteFileW f name))
 
-reallyDeleteFileW :: (RPGState -> String -> IO (Either String String)) -> Name -> Bool -> GSWScreenT RPGState 
+reallyDeleteFileW :: (RPGState -> String -> IO (Either String String)) -> Name -> Bool -> WScreenT RPGState 
 reallyDeleteFileW _ _ False =  return (WText "Deletion canceled")
 reallyDeleteFileW f name True =  do
 	rs<-gets gsData
@@ -458,7 +468,7 @@ playGames :: ActionFunction RPGState
 playGames _ =listCharactersW (listGamesW playGame)
 
-playGame :: String -> GSWScreenT RPGState
+playGame :: String -> WScreenT RPGState
 playGame ""= return (WText "No game chosen")
 playGame shortName= do
 	rs <- gets gsData
@@ -475,25 +485,27 @@ 		else (getMappedCombo ppItemPosition' ["What do you want to use?"] items useItemAction)
 		)
 	
-useItemAction ::  ComboResult (Position,ItemType) -> GSWScreenT RPGState
+useItemAction ::  ComboResult (Position,ItemType) -> WScreenT RPGState
 useItemAction Empty=return (WText "Use canceled")
 useItemAction (Unknown _)=return (WText "You can't use that")
 useItemAction (Exact item) =do
 	rs@(RPGState {rpgCharacter=Just c1}) <- gets gsData
 	maybeSC1<- useItemEffect (snd item) c1
-	let (s,c2)= case maybeSC1 of
-		Nothing -> ("You can't use that",c1)
-		Just (s,c',remove) ->
+	(c2)<- case maybeSC1 of
+		Nothing -> do
+			addScreenMessage "You can't use that"
+			return c1
+		Just (c',remove) ->do
 			let 
 				c2=if remove 
 					then
 						let Right (inv,_)=Inv.dropItem (inventory $ c1) (fst item)
 			 			in c'{inventory=inv}
 			 		else c'
-			in (s,c2)
+			return  (c2)
 	let rs2=rs{rpgCharacter=Just c2}
 	saveNewGameState rs2
-	saveGameAndCharacter (WText s)
+	saveGameAndCharacter (WNothing)
 	
 castSpell :: [Spell] -> ActionFunction RPGState
 castSpell spells _=do
@@ -502,11 +514,11 @@ 		else (getMappedCombo spellName ["Which spell do you want to cast?"] spells castSpellAction)
 		)
 
-castSpellAction ::  ComboResult Spell -> GSWScreenT RPGState
+castSpellAction ::  ComboResult Spell -> WScreenT RPGState
 castSpellAction Empty=return (WText "Cast canceled")
 castSpellAction (Unknown _)=return (WText "You can't cast that")
 castSpellAction (Exact spell) =do
 	rs@(RPGState {rpgCharacter=Just c1,mgs=Just mgs}) <- gets gsData
-	(c2,s)<-spellToMyself c1 spell (tickCount mgs)
+	c2<-spellToMyself c1 spell (tickCount mgs)
 	tick 5 (rs{rpgCharacter=Just c2})
-	saveGameAndCharacter (WText $ show s)+	saveGameAndCharacter (WNothing)

@@ -99,8 +99,4 @@ 		
 ppTradeOperation' :: TradeOperation -> String
 ppTradeOperation' = render . ppTradeOperation	
-		
---	let 
---		bp=bestProfiles (traits c)
---		pt=concat $ intersperse "," (map (fst.fst) bp)
---	in ((show c) ++ pt)+

@@ -40,12 +40,12 @@ occurenceList itemOccurences=concat (foldl (\l (it,oc)->(take oc (repeat it)):l) [] itemOccurences)
 
 	
-randomPickp:: (Monad m)=> [a] -> RandT m a
+randomPickp:: (MonadRandom m)=> [a] -> m a
 randomPickp [] = error "randomPickp cannot run on an empty list" 
 randomPickp [x] = return x
 randomPickp (x:xs) = pick' x xs 2
 	where 
-		pick' :: (Monad m)=> a -> [a] -> Int -> RandT m a
+		pick' :: (MonadRandom m)=> a -> [a] -> Int -> m a
 		pick' curr [] _= return curr
 		pick' curr (x:xs) prob= do
 			r<-getRandomRange (1,prob)
@@ -54,7 +54,7 @@ 				else curr
 			pick' curr' xs (prob+1)
 
-randomPickpn:: (Monad m,Eq a)=> [a] -> Int -> RandT m [a]
+randomPickpn:: (MonadRandom m,Eq a)=> [a] -> Int -> m [a]
 randomPickpn _ 0= return [] 
 randomPickpn [] _= return []
 randomPickpn l n= pick [] 
@@ -67,7 +67,7 @@ 				x<- randomPickp l
 				pick $ nub (x:l2)
 
-randomHeadp :: (Monad m)=> [a] -> RandT m [a]
+randomHeadp :: (MonadRandom m)=> [a] -> m [a]
 randomHeadp [] = return []
 randomHeadp [x] = return [x]
 randomHeadp l =