diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,23 @@
+Copyright 2009, Jean-Philippe Moresmau.  All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+- Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.
+ 
+- Redistributions in binary form must reproduce the above copyright notice,
+this list of conditions and the following disclaimer in the documentation
+and/or other materials provided with the distribution.
+ 
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY
+EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE
+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
+BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
+IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/MazesOfMonad.cabal b/MazesOfMonad.cabal
new file mode 100644
--- /dev/null
+++ b/MazesOfMonad.cabal
@@ -0,0 +1,36 @@
+Name:                MazesOfMonad
+Version:             1.0
+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 
+	full blown Haskell application is like to develop. Version 1.0 is complete and working, but there's not too many game items as such, I'll build more monsters, spells, 
+	etc.
+License:             BSD3
+License-file:        LICENSE
+Author:              JP Moresmau
+Category:			 Game
+Maintainer:          jpmoresmau@gmail.com
+Synopsis:			 Console-based Role Playing Game
+Build-Type: 		 Simple
+Build-Depends:       base, HUnit, random, 
+	regex-posix, containers, filepath, directory, pretty, haskell98, 
+	array, mtl, old-locale, time
+tested-with:         GHC==6.10.1
+data-files:			 README.txt
+
+Executable:          mazesofmonad
+Main-is:             Main.hs
+extensions: 		 FlexibleInstances, UndecidableInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving
+hs-source-dirs:      src
+include-dirs:		 src/
+other-modules:		 MoresmauJP.Core.Screen, MoresmauJP.Maze1.Maze,MoresmauJP.Maze1.MazeGame
+					 ,MoresmauJP.Rpg.Actions,MoresmauJP.Rpg.ActionsTests,MoresmauJP.Rpg.Arena,MoresmauJP.Rpg.ArenaTests
+					 ,MoresmauJP.Rpg.Character,MoresmauJP.Rpg.CharacterTests,MoresmauJP.Rpg.Fight,MoresmauJP.Rpg.FightTests
+					 ,MoresmauJP.Rpg.Inventory,MoresmauJP.Rpg.InventoryTests,MoresmauJP.Rpg.Items,MoresmauJP.Rpg.ItemsTests
+					 ,MoresmauJP.Rpg.Magic,MoresmauJP.Rpg.MagicTests,MoresmauJP.Rpg.MazeObjects,MoresmauJP.Rpg.MazeObjectsTests
+					 ,MoresmauJP.Rpg.NPC,MoresmauJP.Rpg.NPCTests,MoresmauJP.Rpg.Profile,MoresmauJP.Rpg.ProfileTests
+					 ,MoresmauJP.Rpg.RPG,MoresmauJP.Rpg.Save,MoresmauJP.Rpg.SaveTests,MoresmauJP.Rpg.TextOutput
+					 ,MoresmauJP.Rpg.Trade,MoresmauJP.Rpg.TradeTests
+					 ,MoresmauJP.Util.Lists,MoresmauJP.Util.ListsTests,MoresmauJP.Util.Numbers,MoresmauJP.Util.NumbersTests
+					 ,MoresmauJP.Util.Random,MoresmauJP.Util.RandomTests
+					 
diff --git a/README.txt b/README.txt
new file mode 100644
--- /dev/null
+++ b/README.txt
@@ -0,0 +1,24 @@
+Welcome to Mazes of Monad, JP Moresmau's RPG Game!
+
+Mazes of Monad is a console based game similar to Nethack. I haven't looked for originality there, that's true.
+
+To install, it's as usual: runhaskell Setup.lhs configure, runhaskell Setup.lhs build,runhaskell Setup.lhs install.
+
+Everything is console based, so you have to type in actions (usually one word, or two). There is auto completion so you can type 'h' instead of 'help'. Some actions start little wizards that will ask you to type more information, or to choose from a list of items. To choose an item in the list, type in the number of the item. Just pressing the enter key without any number usually means "Cancel".
+
+You first need to create a character. You can reuse a character for several mazes, but only one at a time. Your character will progress over time, and the monsters should become tougher as you progress. You can save the current state of a game (character + game) so you can go back to a previous situation if you die or go mad.
+
+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.
+
+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.
+
+You navigate with 'n'(orth), 's'(outh), 'e'(ast) and 'w'(est). 'm'(ap) shows you what you've discovered so far. 'i'(nventory) shows what you're carrying (use 'p'(ick) and 'd'(rop) to get or leave behind) items. 'ch'(aracter) shows you your current characteristics.
+
+When you meet a NPC, the NPC may attack you, or leave you alone. In that case you can decide to attack it, trade with it, convert it or steal something from it. Just choose the appropriate action when prompted, or Ignore to leave it alone.
+
+Fighting can be done through melee combat or magic. You can also try to end the fight by praying your opponent to let you go, or bribe it.
+
+You can cast magic spells to your opponent during fights (damaging spells) or to yourself when you're not in a fight (healing or improvement spells).
+
+Send me comments and suggestions!
diff --git a/Setup.lhs b/Setup.lhs
new file mode 100644
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,4 @@
+#! /usr/bin/env runhaskell
+ 
+> import Distribution.Simple
+> main = defaultMain
diff --git a/src/Main.hs b/src/Main.hs
new file mode 100644
--- /dev/null
+++ b/src/Main.hs
@@ -0,0 +1,52 @@
+-- | This is the entry point of the application
+-- (c) JP Moresmau 2009
+module Main where
+
+import MoresmauJP.Core.Screen
+import MoresmauJP.Rpg.ActionsTests
+import MoresmauJP.Rpg.RPG
+import MoresmauJP.Rpg.CharacterTests
+import MoresmauJP.Rpg.FightTests
+import MoresmauJP.Rpg.ItemsTests
+import MoresmauJP.Rpg.InventoryTests
+import MoresmauJP.Rpg.MagicTests
+import MoresmauJP.Rpg.MazeObjectsTests
+import MoresmauJP.Rpg.ProfileTests
+import MoresmauJP.Rpg.NPCTests
+import MoresmauJP.Rpg.TradeTests
+import MoresmauJP.Rpg.SaveTests
+import MoresmauJP.Util.ListsTests
+import MoresmauJP.Util.NumbersTests
+import MoresmauJP.Util.RandomTests
+import MoresmauJP.Rpg.ArenaTests
+
+import Test.HUnit (runTestTT,Test(TestList),Counts(..)) 
+
+-- | main entry point
+main :: IO()
+main = do
+	gs<-initialGameStateInApp
+	start (WList ["Welcome to Mazes of Monad, JP Moresmau's RPG Game","If you don't know what to type, try help!"], gs)
+	return ()
+
+-- | run unit tests
+test :: IO Test.HUnit.Counts
+test = do
+	runTestTT (concatTestList [
+		listsTests,
+		numbersTests,
+		randomTests,
+		characterTests,
+		fightTests,
+		inventoryTests,
+		profileTests,
+		tradeTests,
+		saveTests,
+		actionsTests,
+		npcTests,
+		itemTests,
+		magicTests,
+		mazeObjectsTests,
+		arenaTests])
+
+concatTestList tl = TestList (concat (map (\(TestList ts) -> ts ) tl))	
diff --git a/src/MoresmauJP/Core/Screen.hs b/src/MoresmauJP/Core/Screen.hs
new file mode 100644
--- /dev/null
+++ b/src/MoresmauJP/Core/Screen.hs
@@ -0,0 +1,249 @@
+-- | Console handling code
+-- (c) JP Moresmau 2009
+module MoresmauJP.Core.Screen where
+
+
+import Control.Monad.State
+import Char
+import Data.List
+import Data.Maybe
+
+import MoresmauJP.Util.Random
+
+data Screen a = Screen {actions::[Action a]}
+
+data Action a = Action {
+	actionName::String,
+	actionDescription::String,
+	actionFunction::(ActionFunction a)
+	}
+
+type ScreenT a b= RandT (StateT a IO) b 
+
+type GSWScreenT a= ScreenT (GameState a) (Widget a)
+
+type ActionFunction a = [String] -> GSWScreenT 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) |
+	WNothing
+
+type ScreenState a = (Widget a,GameState a)
+
+getShowCombo :: Show b => [String] -> [b] ->  ((ComboResult b) -> GSWScreenT a) -> Widget a
+getShowCombo= getMappedCombo show
+
+getMappedCombo :: (b->String) -> [String] -> [b] ->  ((ComboResult b) -> GSWScreenT a) -> Widget a
+getMappedCombo myShow s objs af=
+	let 
+		objWithNames=map (\x->(x,myShow x)) objs
+		af2=(\s2 -> do 
+			if null s2
+				then
+					af Empty
+				else
+					do
+					let objChosen=listToMaybe (map fst (filter (\x->(snd x) == s2) objWithNames))
+					case objChosen of
+						Just oc->af (Exact oc)
+						Nothing->af (Unknown s2)
+						)
+	in (WCombo s (map snd objWithNames) af2)
+		
+getPretypedWidget :: Widget a -> [String] -> GSWScreenT 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)
+		then return wc
+		else af (snd $ head chosen)
+getPretypedWidget w _=return w
+		
+removeWithName :: [Action a] -> [Action b] -> [Action a]
+removeWithName aa ab=
+	let names=(map actionName aa) \\ (map actionName ab)
+	in filter (\a -> elem (actionName a) names) aa
+
+data ComboResult a= Empty | Unknown String | Exact a
+	deriving (Show,Read)
+	
+start :: ScreenState a -> IO(a)
+start gs = 
+	do
+		commandLoop gs
+		
+--commandLoop :: ScreenState a -> IO(a)
+commandLoop (w,gs)=do
+	GameState s2 _ <- ioRandT (commandLoop2 w) gs
+	return s2
+
+	
+	
+--commandLoop2 :: Widget a -> GSWScreenT a
+commandLoop2 w = do
+	af<- liftIO $ renderWidget w
+	scr <- gets screen
+	if (isJust scr)
+		then
+			if isJust af
+				then
+					do
+						w2 <- fromJust af
+						commandLoop2 w2
+				else		
+					do
+						liftIO $ putStr ">"
+						input <- liftIO $ getLine
+						let cmds = words input
+						if null cmds
+							then
+								commandLoop2 WNothing
+							else
+								do
+									let (cmd:_)=cmds
+									let af2 = getAction (map Char.toLower cmd) (actions $ fromJust scr)
+									w2 <- af2 cmds
+									commandLoop2 w2
+		else
+			return WNothing
+	
+
+renderWidget :: Widget a -> IO(Maybe(GSWScreenT a))
+renderWidget (WNothing)= do
+	return Nothing
+renderWidget (WText s)= do
+	putStrLn s
+	return Nothing
+renderWidget (WList ss)=do
+	mapM_ putStrLn ss
+	return Nothing
+renderWidget (WInput ss1 af)=do
+	mapM_ putStrLn ss1
+	input <- getLine
+	return (Just $ af input)
+renderWidget (WCheck ss1 s def af)=do
+	mapM_ putStrLn ss1
+	let choices=if def then " (Y/n)" else " (y/N)"
+	putStrLn (s ++choices)
+	--return (Just (checkSelector def af))
+	cmds <- getArgs
+	return (Just (af ((map toUpper (head cmds))=="Y")))
+renderWidget (WCombo ss1 ss2 af)=do
+	mapM_ putStrLn ss1
+	let choices=zipWith (\a b -> ((show a),b)) [1..] ss2
+	mapM_ putStrLn (map (\(a,b) -> a ++ ": "++b) choices)
+	cmds <- getArgs
+	let chosen=if null cmds
+		then [("","")]
+		else filter (\(x,_)->x==(head cmds)) choices
+	if null chosen
+		then return (Just $ af "")
+		else return (Just $ af (snd $ head chosen))
+				
+getArgs :: IO([String])				
+getArgs = do
+	input <- getLine
+	return (words input)
+
+			
+help :: Bool -> ActionFunction a
+help withSystem _ = do
+	let	f (Action s1 s2 _)= (s1++": "++s2)
+	let	sysLines= if withSystem
+			then (map f systemActions)
+			else []
+	gs <- get
+	let acts=actions $ fromJust $ screen gs
+	let wl=WList (sort ( sysLines ++
+			(map f acts)))
+	return (wl) 
+
+unknown ::ActionFunction a
+unknown args = return (WText ("I do not understand the command " ++ (head args)))
+
+quit :: ActionFunction a
+quit _ = do
+	modify (\gs->gs{screen=Nothing})
+	return (WText ("Bye bye, hope you enjoyed the game!")) 
+
+choice :: [String] -> ActionFunction a
+choice ss _ = return (WList ss)
+
+backAction :: Screen a -> Action a
+backAction sc=Action "back" "Go back to main screen" (back sc)
+
+back :: Screen a -> ActionFunction a
+back sc _ =do
+	(GameState a _) <- get
+	put (GameState a (Just sc))
+	return (WText "Back")
+
+systemActions :: [Action a]
+systemActions = [Action "help" "Provides help on available actions" (help True)
+	,Action "?" "Provides help on available actions" (help True)
+	,Action "quit" "Exit the game" quit]
+				
+getAction :: String -> [Action a] -> ActionFunction a
+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]
+		l = length possible
+	in
+		if l==0 then
+			unknown
+		else if l==1 then
+			actionFunction $ head possible
+		else 
+			choice (map (\(Action s1 _ _)->s1) possible)
+	
+{--
+combineActionAfterIO :: ScreenState a -> ActionFunction a -> Event -> IO (ScreenState a)
+combineActionAfterIO ss1@(w1,gs) af e = do
+	(w2,gs2)<-af e gs 
+	return (combineWidget w1 w2,gs2)
+
+combineActionBeforeIO :: ScreenState a -> ActionFunction a -> Event -> IO (ScreenState a)
+combineActionBeforeIO ss1@(w1,gs) af e = do
+	(w2,gs2)<-af e gs 
+	return (combineWidget w2 w1,gs2)
+--}	
+{--combineActionAfter :: Widget a -> [String] -> ActionFunction a
+combineActionAfter w1 cmds= do 
+	w2<-af cmds
+	return (combineWidget w1 w2)
+	--}
+	
+{--
+combineActionBefore :: ScreenState a -> PureActionFunction a ->  [String] -> ScreenState a
+combineActionBefore ss1@(w1,gs) af e =
+	let (w2,gs2)=af e gs 
+	in (combineWidget w2 w1,gs2)
+	--}
+
+combineMaybeWidget :: Widget a -> Maybe (Widget a) -> Widget a
+combineMaybeWidget w Nothing = w
+combineMaybeWidget w1 (Just w2) =combineWidget w1 w2
+	
+combineWidget :: Widget a -> Widget a -> Widget a
+combineWidget WNothing a=a
+combineWidget a WNothing=a
+combineWidget (WText s1) (WText s2)=WList [s1,s2]
+combineWidget (WText s1) (WList ss2)=WList (s1:ss2)
+combineWidget (WText s1) (WInput ss1 ss2)=WInput (s1:ss1) ss2
+combineWidget (WText s1) (WCheck ss1 ss2 ss3 ss4)=WCheck (s1:ss1) ss2 ss3 ss4
+combineWidget (WText s1) (WCombo ss1 ss2 af)=WCombo (s1:ss1) ss2 af
+combineWidget (WList ss1) (WText s2)=WList (ss1++[s2])
+combineWidget (WList ss1) (WList ss2)=WList (ss1++ss2)
+combineWidget (WList ss1) (WInput ss2 ss3)=WInput (ss1++ss2) ss3
+combineWidget (WList s1) (WCheck ss1 ss2 ss3 ss4)=WCheck (s1++ss1) ss2 ss3 ss4
+combineWidget (WList s1) (WCombo ss1 ss2 af)=WCombo (s1++ss1) ss2 af
+combineWidget _ _=error "combineWidget: undefined combination"
diff --git a/src/MoresmauJP/Maze1/Maze.hs b/src/MoresmauJP/Maze1/Maze.hs
new file mode 100644
--- /dev/null
+++ b/src/MoresmauJP/Maze1/Maze.hs
@@ -0,0 +1,134 @@
+-- | Maze handling code: generate and move in the maze
+-- (c) JP Moresmau 2009
+module MoresmauJP.Maze1.Maze 
+where
+
+import MoresmauJP.Util.Random
+import Data.List
+import qualified Data.Map as DataMap
+import qualified Data.Set as DataSet
+import Data.Maybe
+
+import MoresmauJP.Util.Lists
+
+data GameWorld = GameWorld {
+	maze::Maze
+	,position::Cell,
+	explored::CellSet}
+	deriving (Show, Read,Eq)
+
+type Cell=(Int,Int)
+type Size=(Int,Int)
+type Edges=[Cell]
+
+type CellMap = DataMap.Map Cell Edges
+type CellSet = DataSet.Set Cell
+
+data Maze=Maze {cellmap::CellMap
+	,start::Cell
+	,end::Cell
+	,size::Size
+	}
+	deriving (Read,Show,Eq)
+
+isWinning :: GameWorld -> Bool
+isWinning gw= (position gw) == (end $ maze gw)
+
+moveInMaze :: GameWorld -> Cell -> Maybe (GameWorld,Bool)
+moveInMaze gw toCell | 
+	isMovePossible (position gw) toCell (maze gw) =
+		let 
+			expls=explored gw
+			expls2=DataSet.union expls (DataSet.fromList (getNeighbours toCell (maze gw)))
+			--nub (expls ++ (getNeighbours toCell (maze gw)))
+			gw2=gw{position=toCell,explored=expls2}
+			win=isWinning gw2
+		in Just (gw2,win)
+	| otherwise = Nothing	
+
+isMovePossible :: Cell -> Cell -> Maze -> Bool
+isMovePossible from to mz =  elem to (getNeighbours from mz)
+
+getNeighbours :: Cell -> Maze -> Edges
+getNeighbours from mz =
+	fromJust $ DataMap.lookup from (cellmap mz)
+	
+	
+generateGameWorld:: (Monad m) =>Size -> RandT 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 sz = do
+	firstX<-getRandomRange (1,fst sz)
+	firstY<-getRandomRange (1,snd sz)
+	--(firstX,firstY)
+	let m1=DataMap.fromList [((firstX,firstY),[(firstX,firstY)])]
+	let frontiers=getUnprocessedNeighbours (firstX,firstY) sz m1
+	let m2=DataMap.union m1 (DataMap.fromList(map (\x->(x,[])) frontiers))
+	randomFrontiers<-randomHeadp frontiers
+	(m3,end) <- mazeStep m2 sz randomFrontiers
+	let m4=removeFirstCell m3 (firstX,firstY) 
+	return (Maze {cellmap=m4,start=(firstX,firstY),end=end,size=sz})
+
+removeFirstCell :: CellMap -> Cell -> CellMap
+removeFirstCell cm c= 
+	let
+		Just l = DataMap.lookup c cm
+	in
+		 DataMap.insert c (init l) cm
+
+mazeStep :: (Monad m) =>CellMap -> Size -> Edges -> RandT m (CellMap,Cell)
+mazeStep _ _ []=error "mazeStep: empty edges"
+mazeStep cm sz (f:fs) = do
+	let nbs=getInNeighbours f sz cm
+	nb <- randomPickp nbs
+	let edges=DataMap.lookup nb cm
+	let cm1=
+		case edges of
+			Just l 	-> DataMap.insert nb (f:l) cm
+			Nothing -> DataMap.insert nb [f] cm
+	let cm2 = DataMap.insert f [nb] cm1
+	let frontiers=getUnprocessedNeighbours f sz cm2
+	let cm3= DataMap.union cm2 (DataMap.fromList(map (\x->(x,[])) frontiers))
+	randomFrontiers <- randomHeadp (fs ++ frontiers)
+	if null randomFrontiers
+		then
+			return (cm3,f)
+		else
+			mazeStep cm3 sz randomFrontiers
+	
+getLeftNeighbour :: Cell ->  Edges
+getLeftNeighbour (1,_) =[]
+getLeftNeighbour (x,y) =[(x-1,y)]
+
+getRightNeighbour :: Cell -> Size -> Edges
+getRightNeighbour (x,y) (width,_)
+	| (x==width)   =[]
+	| otherwise   =[(x+1,y)]
+
+getAllNeighbours :: Cell -> Size -> Edges
+getAllNeighbours c sz =
+	(getLeftNeighbour c) ++ (getRightNeighbour c sz)
+	++ (map swap (getLeftNeighbour (swap c)))
+	++ (map swap (getRightNeighbour (swap c) (swap sz)))
+
+getUnprocessedNeighbours :: Cell -> Size -> CellMap -> Edges
+getUnprocessedNeighbours c sz cm = filter (flip DataMap.notMember cm)(getAllNeighbours c sz)
+
+getInNeighbours :: Cell -> Size -> CellMap -> Edges
+getInNeighbours c sz cm = filter (isIn cm) (getAllNeighbours c sz)
+	where isIn lm key = 
+		let val=DataMap.lookup key lm
+		in
+			case val of
+				Just l	->not (null l)
+				Nothing	->False
+
+concatRev:: [a] -> [a] -> [a]
+concatRev [] l2=l2
+concatRev (x:xs) l2=concatRev xs (x:l2)
+
diff --git a/src/MoresmauJP/Maze1/MazeGame.hs b/src/MoresmauJP/Maze1/MazeGame.hs
new file mode 100644
--- /dev/null
+++ b/src/MoresmauJP/Maze1/MazeGame.hs
@@ -0,0 +1,132 @@
+-- | Console based navigation in a maze
+-- (c) JP Moresmau 2009
+module MoresmauJP.Maze1.MazeGame where
+
+import MoresmauJP.Util.Random
+import Control.Monad.State
+import Data.Char
+import Data.List
+import qualified Data.Set as DataSet
+
+import MoresmauJP.Core.Screen
+import MoresmauJP.Maze1.Maze
+
+import System.Random
+
+start :: IO()
+start = do
+	sg <- getStdGen
+	gs <- evalRandT initialGameState (ProductionRandom sg)
+	sg<-getStdGen
+	(WList ls,_)<-runStateT (evalRandT (mapAction [""]) (ProductionRandom sg)) gs
+	MoresmauJP.Core.Screen.start (WList ("Maze":ls),gs)
+	return ()
+
+initialGameState ::(Monad m)=>RandT m (GameState GameWorld)
+initialGameState = do
+	gw<-generateGameWorld (10,5)
+	return (buildGameState gw)
+
+buildGameState :: GameWorld -> GameState GameWorld
+buildGameState gw=GameState gw (getScreen gw (getDirections gw))
+
+getScreen :: GameWorld -> [Direction] -> Maybe (Screen GameWorld)
+getScreen _ dirs = 
+	let
+		f dir = Action (map toLower (show dir)) ("Move " ++ (show dir)) (move dir)
+		actions=map f dirs
+		mapA= Action "map" "See the map" mapAction
+	in	
+		Just (Screen (mapA:actions))
+		
+		
+move :: Direction -> ActionFunction GameWorld
+move dir _  = do
+	gw <- gets gsData
+	let mgw2=moveInMaze gw (getNextCell (position gw) dir)
+	case mgw2 of 
+			Nothing->return (WText "Ouch!")
+			Just (gw2,win)->if win 
+				then
+					do
+					put (GameState gw2 Nothing)
+					return (WList ["You win! "])
+				else
+					do
+						let dirs=getDirections gw2
+						let gs2=GameState gw2 (getScreen gw2 dirs)
+						put gs2
+						WList ls<-mapAction [""]
+						return (WList (("You move " ++ (show dir)) : ls))
+		
+getDirectionsText :: [Direction] -> String
+getDirectionsText dirs= "You can move to: " ++ (concat $ intersperse "," (map show dirs))
+		
+data Direction = North | South | East | West 
+	deriving (Show, Read)
+
+getNextCell :: Cell -> Direction -> Cell
+getNextCell (x,y) North=(x,y-1)
+getNextCell (x,y) South=(x,y+1)
+getNextCell (x,y) West=(x-1,y)
+getNextCell (x,y) East=(x+1,y)
+
+getDirections :: GameWorld -> [Direction]
+getDirections (GameWorld mz (x,y) _) = 
+	let
+		n=filter (\(x1,y1)-> isMovePossible (x,y) (x1,y1) mz ) (getNeighbours (x,y) mz)
+		f (x1,y1) 
+			| x1<x  = West
+			| x1>x	= East
+			| y1>y  = South
+			| y1<y  = North
+			| otherwise = error "getDirections: impossible coordinates"
+	in map f n
+
+mapAction :: ActionFunction GameWorld
+mapAction _ =
+	do
+		(GameState {gsData=gw}) <- get
+		let (width,height)=size $ maze gw
+		let xs=[0..((width*2))]
+		let mapLines=map (\y-> map (getMapCharacter gw y) xs) [0..((height*2))]
+		let dirs=getDirections gw
+	--let cells=[(x,y)|x<-[0..((width*2)+1)], y<-[0..((width*2)+1)]]
+		return (WList (mapLines ++ [getDirectionsText dirs]))
+	
+getMapCharacter :: GameWorld -> Int -> Int -> Char
+getMapCharacter _ _ 0 = '#'
+getMapCharacter _ 0 _ = '#'
+getMapCharacter gw y x 	| x == (fst (size $ maze $ gw)) * 2 = wall
+						| y == (snd (size $ maze $ gw)) * 2 = wall
+						| (even x) && (even y) = wall
+						| (x,y) == (doubleSize $ position gw)  = '@'
+						| (odd x) && (odd y) = if DataSet.member (halfSize (x,y))(explored gw)
+							then 
+								if (x,y) == (doubleSize $ end $ maze $ gw)
+									then '$'
+									else ' '
+							else wall
+						| even x = getMaybePassageCharacter gw (halfSize (x-1,y)) (halfSize (x+1,y)) 
+						| even y = getMaybePassageCharacter gw (halfSize (x,y-1)) (halfSize (x,y+1))
+						| otherwise = '?'
+
+getMaybePassageCharacter :: GameWorld -> Cell -> Cell -> Char
+getMaybePassageCharacter gw from to 
+	| isMovePossible from to (maze gw) = getPassageCharacter gw from to
+	| otherwise = wall 
+
+getPassageCharacter :: GameWorld -> Cell -> Cell -> Char
+getPassageCharacter gw from to 
+	| DataSet.member from (explored gw) && DataSet.member to (explored gw) = ' '
+	| otherwise = wall
+
+
+wall :: Char
+wall = '#'
+
+doubleSize :: Cell -> Cell
+doubleSize (x,y)=(x*2-1,y*2-1)
+
+halfSize :: Cell -> Cell
+halfSize (x,y)=(div (x+1) 2 ,div (y+1) 2)
diff --git a/src/MoresmauJP/Rpg/Actions.hs b/src/MoresmauJP/Rpg/Actions.hs
new file mode 100644
--- /dev/null
+++ b/src/MoresmauJP/Rpg/Actions.hs
@@ -0,0 +1,155 @@
+-- | Action resolution, some kind of D20 system
+-- (c) JP Moresmau 2009
+module MoresmauJP.Rpg.Actions where
+
+import Control.Monad
+
+import MoresmauJP.Rpg.Character
+import MoresmauJP.Util.Numbers
+import MoresmauJP.Util.Random
+
+initiative = [Dexterity,Willpower]
+melee = [Strength,Dexterity]
+archery = [Dexterity,Perception,Strength]
+conversion=[Charisma,Willpower,Willpower]
+trade=[Charisma,Charisma,Intelligence]
+spellcasting=[Intelligence,Willpower]
+spelllearning=[Intelligence]
+escape=[Dexterity]
+medecine=[Intelligence,Intelligence,Dexterity,Perception]
+pray=[Charisma,Willpower]
+detectTrap=[Perception]
+disableTrap=[Dexterity,Perception]
+steal=[Dexterity,Dexterity,Intelligence,Perception,Perception]
+
+d20=(1,20)
+
+roll :: (MonadRandom m) => (Int,Int) -> m Int
+roll (low,high)= getRandomRange (low,high)
+
+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 c cs d= do
+	r <- roll d20
+	return (processAction c cs d r)
+
+actionNoExperience :: (MonadRandom 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 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' c cs d f=do
+	diff<-diffResult c cs d
+	let diff'=f diff
+	return 
+		(if (diff<0)
+			then (-diff')
+			else diff')
+
+competeWithDiff :: (MonadRandom 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)
+	
+compete :: (MonadRandom 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 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=
+	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)
+	
+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=
+	let 
+		avgCs=score c cs
+		myScore=bindInt (1,19) (avgCs+d)
+		(rr,em)=evalResult roll myScore
+		expGain=experienceGain myScore em (length cs)
+		c3=foldr (\b c2->addCharacteristic' c2 Experience b expGain) c cs
+	in (c3,rr)
+
+experienceGain :: Int -> Int -> Int -> Int
+experienceGain score expM l= div ((max 1 (div ((20-score)^2) 10)) * expM) l
+	
+evalResult:: Int -> Int -> RollResultExp
+evalResult roll score
+	| (roll < (div score 5)) = (Success Exceptional (score-roll),4)
+	| (roll < (div score 2)) = (Success Remarkable (score-roll),3)
+	| (roll <= score) = (Success Standard (score-roll),2)
+	| (roll > (20-(div score 5))) = (Failure Exceptional (roll-score),1)
+	| (roll > (20-(div score 2))) = (Failure Remarkable (roll-score),1)
+	| otherwise  = (Failure Standard (roll-score),1)
+
+
+type Difficulty=Int
+
+type RollResultExp=(RollResult,ExperienceMultiplier)
+type ExperienceMultiplier=Int
+
+data DifficultyLevel=NearImpossible | VeryHard | Hard | RatherHard | Neutral 
+	| RatherEasy | Easy | VeryEasy | NearUnmissable
+	deriving (Eq,Show,Read,Ord,Bounded,Enum)
+
+toIntLevel :: DifficultyLevel -> Difficulty
+toIntLevel level =3 * ((fromEnum level) - 4)
+
+data RollResult = 
+	Failure {
+		grade::Grade,
+		diff::Int} 
+	| Success {
+		grade::Grade,
+		diff:: Int} 
+	deriving (Show, Eq, Read)
+
+isSuccess :: RollResult -> Bool
+isSuccess (Success {})=True
+isSuccess _ =False
+
+subsequentDifficulty:: Grade -> Difficulty
+subsequentDifficulty Standard=0
+subsequentDifficulty Remarkable=2
+subsequentDifficulty Exceptional=6
+
+resultMultiplier :: Grade -> Int -> Float
+resultMultiplier Standard i= fromIntegral i ** 1.5
+resultMultiplier Remarkable i= fromIntegral i ** 2
+resultMultiplier Exceptional i= fromIntegral i ** 3
+
+resultMultiplierHigh :: Int -> RollResult -> Int
+resultMultiplierHigh i (Failure gr d)=max 0 (i  - round((fromIntegral i * (resultMultiplier gr d))/100))
+resultMultiplierHigh i (Success gr d)=i + round ((fromIntegral i * (resultMultiplier gr d))/100)
+
+resultMultiplierLow :: Int -> RollResult -> Int
+resultMultiplierLow i (Success gr d)=max 0 (i  - round((fromIntegral i * (resultMultiplier gr d))/100))
+resultMultiplierLow i (Failure gr d)=i + round ((fromIntegral i * (resultMultiplier gr d))/100)
+
+resultExtra :: Int -> RollResult -> Int
+resultExtra i (Failure {})=i
+resultExtra i rr=resultMultiplierHigh i rr
+
+data Grade =
+	Standard
+	| Remarkable
+	| Exceptional
+	deriving (Show,Enum,Read,Eq)
diff --git a/src/MoresmauJP/Rpg/ActionsTests.hs b/src/MoresmauJP/Rpg/ActionsTests.hs
new file mode 100644
--- /dev/null
+++ b/src/MoresmauJP/Rpg/ActionsTests.hs
@@ -0,0 +1,57 @@
+-- | Action resolution hunit tests
+-- (c) JP Moresmau 2009
+module MoresmauJP.Rpg.ActionsTests where
+import MoresmauJP.Rpg.Actions
+import MoresmauJP.Rpg.Character
+import MoresmauJP.Rpg.CharacterTests
+
+import MoresmauJP.Util.Random
+
+import Test.HUnit
+import Text.Printf
+
+actionsTests=TestList [testDifficultyLevel,testEvalResults]
+
+testDifficultyLevel = TestLabel "testDifficultyLevel" (TestCase (do
+	--setTestGen [10]
+	let jp=createTestChar "JP"
+	let sg=mkTestWrapper [10]
+	let (_,rr)=evalRand (action jp [Dexterity] (toIntLevel Neutral)) sg
+	assertEqual "Not standard success 0" (Success Standard 0) rr
+	let (_,rr)=evalRand (action jp [Dexterity] (toIntLevel RatherEasy)) sg
+	assertEqual "Not standard success 3" (Success Standard 3) rr
+	let (_,rr)=evalRand (action jp [Dexterity] (toIntLevel Easy)) sg
+	assertEqual "Not standard success 6" (Success Standard 6) rr
+	let (_,rr)=evalRand (action jp [Dexterity] (toIntLevel VeryEasy)) sg
+	assertEqual "Not standard success 9" (Success Standard 9) rr
+	let (_,rr)=evalRand (action jp [Dexterity] (toIntLevel NearUnmissable)) sg
+	assertEqual "Not standard success 9" (Success Standard 9) rr
+			
+	let (_,rr)=evalRand (action jp [Dexterity] (toIntLevel RatherHard)) sg
+	assertEqual "Not standard failure 3" (Failure Standard 3) rr
+	let (_,rr)=evalRand (action jp [Dexterity] (toIntLevel Hard)) sg
+	assertEqual "Not standard failure 6" (Failure Standard 6) rr
+	let (_,rr)=evalRand (action jp [Dexterity] (toIntLevel VeryHard)) sg
+	assertEqual "Not standard failure 9" (Failure Standard 9) rr
+	let (_,rr)=evalRand (action jp [Dexterity] (toIntLevel NearImpossible)) sg
+	assertEqual "Not standard failure 9" (Failure Standard 9) rr
+			
+	))
+	
+
+testEvalResults = TestList [
+		testEvalResult 1 10 (Success Exceptional 9)
+		,testEvalResult 3 10 (Success Remarkable 7)
+		,testEvalResult 8 10 (Success Standard 2)
+		,testEvalResult 11 10 (Failure Standard 1)
+		,testEvalResult 17 10 (Failure Remarkable 7)
+		,testEvalResult 19 10 (Failure Exceptional 9)
+	]
+	
+testEvalResult roll score expected= TestLabel (printf "testEvalResult %d/%d" roll score)
+	(TestCase (do
+		let actual = fst (evalResult roll score)
+		let msg= printf "%d/%d should be %s but is %s " roll score (show expected) (show actual)
+		assertEqual msg expected actual
+		))
+	
diff --git a/src/MoresmauJP/Rpg/Arena.hs b/src/MoresmauJP/Rpg/Arena.hs
new file mode 100644
--- /dev/null
+++ b/src/MoresmauJP/Rpg/Arena.hs
@@ -0,0 +1,404 @@
+-- | The "arena" is where interaction between the character and a NPC is played out
+-- (c) JP Moresmau 2009
+module MoresmauJP.Rpg.Arena where
+
+import Control.Monad.State
+
+import Data.Maybe
+import Data.List
+
+import MoresmauJP.Core.Screen
+import MoresmauJP.Rpg.Actions
+import MoresmauJP.Rpg.Character
+import MoresmauJP.Rpg.Inventory
+import MoresmauJP.Rpg.NPC
+import MoresmauJP.Rpg.Fight
+import MoresmauJP.Rpg.Magic
+import MoresmauJP.Rpg.Trade
+import MoresmauJP.Rpg.TextOutput
+import MoresmauJP.Util.Numbers
+import MoresmauJP.Util.Random
+
+import Text.Printf
+
+data ExitStatus=Death | Victory | Flight | Finished
+	deriving (Show,Read,Eq,Ord,Enum,Bounded)
+
+data ExitState=ExitState {
+	exitCharacter::Character,
+	exitOpponent::NPCCharacter,
+	exitStatus::ExitStatus,
+	newItems::[ItemType],
+	exitTickCount::Int
+	} deriving (Show,Read)
+
+data Arena=Arena {
+	arenaCharacter::Character,
+	arenaOpponent::NPCCharacter,
+	es::Maybe ExitStatus,
+	chToHit::Bool,
+	arenaItems::[ItemType],
+	arenaTickCount::Int
+	} deriving (Show,Read)
+
+screenInteract :: Character -> NPCCharacter -> RandomWrapper -> Int -> IO ExitState
+screenInteract c1 c2 rw tc= do
+	let ar=Arena c1 c2 Nothing True [] tc
+	let initialstate=GameState ar (Just (Screen []))
+	evalStateT (evalRandT (screenInteract' c2) rw) initialstate
+
+screenInteract' c2 = do
+	let wEncounter=WText (printf "You meet a %s " (name $ npcCharacter c2))
+	initial<-getInitialAttitude c2
+	w<-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)
+	(GameState ar2 _)<-get
+	return (ExitState (arenaCharacter ar2) (arenaOpponent ar2) (fromJust $ es ar2) (arenaItems ar2) (arenaTickCount ar2))
+
+chooseAction :: GSWScreenT 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 (Exact Fight)=fightInArena
+chooseF (Exact Trade)=tradeInArena
+chooseF (Exact Convert)=convertInArena
+chooseF (Exact Steal)=stealInArena
+chooseF _=do
+	gs <- get
+	let ar = gsData gs
+	put (gs{gsData=ar{es=Just Finished},screen=Nothing})
+	return WNothing
+	
+tradeInArena :: GSWScreenT 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' Empty = chooseAction
+tradeInArena' (Unknown _)= chooseAction
+tradeInArena' (Exact EndTrade)= chooseAction
+tradeInArena' (Exact action)= do
+	gs <- get
+	let ar@(Arena{arenaCharacter=c1,arenaOpponent=npc@NPCCharacter{npcCharacter=c2}}) = gsData gs
+	((c1b,c2b),rr)<- competeWithDiff c1 c2 trade (diffAttitude npc)
+	let ar2=ar{arenaCharacter=c1b,arenaOpponent=npc{npcCharacter=c2b}}
+	put gs{gsData=ar2}
+	let ops=listTradeItems c1b c2b action rr
+	if null ops
+		then do
+			w<-tradeInArena
+			return $ combineWidget (WText (printf "No good deal you can %s" (show action))) w
+		else
+			return (getMappedCombo 
+				ppTradeOperation'
+				[(printf "What do you want to %s" (show action))]
+				ops tradeChoice)
+	
+tradeChoice :: ComboResult TradeOperation -> GSWScreenT Arena
+tradeChoice Empty = tradeInArena
+tradeChoice (Unknown _)= tradeInArena
+tradeChoice (Exact op)=do
+	gs <- get
+	let (Arena{arenaCharacter=c1,arenaOpponent=npc}) = gsData gs
+	let possiblePos=case op of
+		ToBuy (_,it) _-> (listAllowedPositions (inventory c1) it)
+		ToExchange (pos,_) (_,it)->  map (\(myPos,it)-> if myPos==pos then (myPos,Nothing) else (myPos,it)) (listAllowedPositions (inventory c1) it)
+		ToSell _ _ -> []
+	let npcPos=getNpcPosition op (inventory $ npcCharacter npc)
+	if (null possiblePos)
+		then
+			tradeOperation op npcPos Nothing 
+		else
+			return (getMappedCombo ppInventoryPosition' ["Where do you want to put the item?"] possiblePos (tradeChoice' op npcPos))
+	
+
+	
+tradeChoice' :: TradeOperation -> Maybe Position -> ComboResult (Position,Maybe ItemType) -> GSWScreenT 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 op posNpc posC = do
+	gs <- get
+	let ar@(Arena{arenaCharacter=c1,arenaOpponent=npc@NPCCharacter{npcCharacter=c2}}) = gsData gs
+	let (c1b,c2b,dropped)=doTradeOperation (c1,posC) (c2,posNpc) op
+	let oldDropped=arenaItems ar
+	let ar2=ar{arenaCharacter=c1b,arenaOpponent=npc{npcCharacter=c2b},arenaItems=dropped++oldDropped}
+	arenaTick ar2
+	tradeInArena
+
+arenaTick :: Arena -> ScreenT (GameState Arena) ()
+arenaTick ar=do
+	gs <- get
+	put gs{gsData=ar{arenaTickCount=((arenaTickCount ar)+1)}}
+	
+fightInArena :: GSWScreenT Arena
+fightInArena = 	do
+	gs <- get
+	let ar@(Arena {arenaCharacter=c1,arenaOpponent=c2}) = gsData gs
+	((c1b,c2b),rr) <- compete c1 (npcCharacter c2) initiative
+	case rr of
+		Success {} -> choiceArena
+		_ ->do
+			put (gs{gsData=ar{arenaCharacter=c1b,arenaOpponent=(c2{npcCharacter=c2b}),chToHit=False}})
+		 	fightInArena'
+
+fightInArena' :: GSWScreenT Arena
+fightInArena' = do
+	gs <- get
+	let ar@(Arena {arenaCharacter=c1,arenaOpponent=c2,chToHit=chToHit}) = gsData gs
+	((c1b,c2b),isDead,msgs) <- (case chToHit of
+		True -> giveBlow c1 (npcCharacter c2)
+		False -> liftM swapFS (giveBlow (npcCharacter c2) c1))
+	let ar2=ar{arenaCharacter=c1b,arenaOpponent=(c2{npcCharacter=c2b}),chToHit=not chToHit}
+	arenaTick ar2
+	let w=WList (map show msgs)
+	if isDead
+		then
+			do
+			let (status,txt)=if (isOutOfService c1b)
+					then (Death,"You're killed!")
+					else (Victory,"You triumph!")
+			put (gs{gsData=ar2{es=Just status},screen=Nothing})
+			return (combineWidget w (WText txt))
+		else
+			do
+			w2<- if (not chToHit)
+				then choiceArena
+				else fightInArena'
+			return (combineWidget w w2)
+
+castInArena :: GSWScreenT Arena
+castInArena = do
+	(Arena {arenaCharacter=c1,arenaOpponent=c2}) <- gets gsData
+	let spells=spellsToOpponent c1 (npcCharacter c2)
+	if (null spells)
+		then do
+			w<-choiceArena
+			return (combineWidget (WText "No spell you can cast!") w)
+		else return (getMappedCombo spellName ["Cast spell:"] spells castInArena' )
+
+castInArena' :: (ComboResult Spell) -> GSWScreenT 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
+	let ar2=ar{arenaCharacter=c1b,arenaOpponent=(c2{npcCharacter=c2b}),chToHit=False}
+	arenaTick ar2
+	let w=WList (map show msgs)
+	if dead
+		then
+			do
+			let (status,txt)=if (isDead c1b)
+					then (Death,"You're killed!")
+					else if (isMad c1b) 
+						then (Death,"You become mad!")
+						else (Victory,"You triumph!")
+			put (gs{gsData=ar2{es=Just status},screen=Nothing})
+			return (combineWidget w (WText txt))
+		else
+			do
+			w2<- fightInArena'
+			return (combineWidget w w2)
+
+prayerInArena :: GSWScreenT Arena
+prayerInArena = do
+	gs <- get
+	let ar@(Arena {arenaCharacter=c1,arenaOpponent=c2,arenaTickCount=tc}) = gsData gs
+	((c1b,c2b),rr)<-competeWithDiff c1 (npcCharacter c2) pray (diffAttitude c2)
+	let npc2=c2{npcCharacter=c2b}
+	let ar2=ar{arenaCharacter=c1b,arenaOpponent=npc2,arenaTickCount=tc+1}
+	put (gs{gsData=ar2})
+	case rr of
+		Failure {grade=Exceptional}->  do
+			let npc3=npc2{npcAttitude=1}
+			put (gs{gsData=ar2{arenaOpponent=npc3,chToHit=False}})
+			w<-fightInArena' 
+			return (combineWidget (WText (printf "The %s doesn't like your arguments at all!" (name $ npcCharacter c2))) w)
+		Failure {}->do
+			put (gs{gsData=ar2{chToHit=False}})
+			w<-fightInArena' 
+			return (combineWidget (WText (printf "Your prayer failed to convince the %s!" (name c2b))) w)
+		rr->do
+			let npc3=npc2{npcAttitude=min 20 ((npcAttitude npc2)+diff rr)}
+			put (gs{gsData=ar2{es=Just Finished,arenaOpponent=npc3},screen=Nothing})
+			return (WText (printf "The %s takes pity on you and leaves you alone" (name c2b)))
+
+diffAttitude :: NPCCharacter -> Int
+diffAttitude c2=(div ((npcAttitude c2)-10) 2)
+
+bribeInArena :: GSWScreenT Arena
+bribeInArena = do
+	gs <- get
+	let ar@(Arena {arenaCharacter=c1,arenaOpponent=c2,arenaTickCount=tc}) = gsData gs
+	let currentGold=(getGold $ inventory c1)
+	if currentGold==0
+		then
+			do
+			w<-choiceArena
+			return (combineWidget (WText "You have no gold!") w)
+		else
+			do
+			((c1b,c2b),rr)<-competeWithDiff c1 (npcCharacter c2) trade (diffAttitude c2)
+			let npc2=c2{npcCharacter=c2b}
+			let ar2=ar{arenaCharacter=c1b,arenaOpponent=npc2,arenaTickCount=tc+1}
+			put (gs{gsData=ar2})
+			case rr of
+				Failure {grade=Exceptional} ->  do
+					let npc3=npc2{npcAttitude=1}
+					put (gs{gsData=ar2{arenaOpponent=npc3,chToHit=False}})
+					w<-fightInArena' 
+					return (combineWidget (WText (printf "The %s doesn't like your money at all!" (name $ npcCharacter c2))) w)
+				Failure {}->do
+					put (gs{gsData=ar2{chToHit=False}})
+					w<-fightInArena' 
+					return (combineWidget (WText (printf "The %s doesn't want your money!" (name c2b))) w)
+				rr	-> do
+					let 
+						gold=bindInt (1,currentGold) $ resultMultiplierLow currentGold rr
+						c1c=c1b{inventory=addGold (inventory c1b) (-gold)}
+						npc3=c2{npcCharacter=c2b{inventory=addGold (inventory c2b) gold}}
+					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 = 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 (Exact Escape)=do
+	gs<-get
+	let ar=gsData gs
+	put (GameState (ar{es=Just Flight}) Nothing)
+	return (WText "You escape!")
+choiceArenaF (Exact Melee)=fightInArena'
+choiceArenaF (Exact Magic)=castInArena
+choiceArenaF (Exact Prayer)=prayerInArena
+choiceArenaF (Exact Bribe)=bribeInArena
+choiceArenaF _=choiceArena
+
+data ArenaAction = Melee | Escape | Magic | Prayer | Bribe
+	deriving (Show,Read,Enum,Bounded,Eq,Ord)
+	
+getPossibleArenaActions::Character -> NPCCharacter -> [ArenaAction]
+getPossibleArenaActions c1 np1=let
+	spells=spellsToOpponent c1 (npcCharacter np1)
+	gold=getGold $ inventory c1
+	in 
+		[Melee,Escape] ++ 
+		(if null spells then [] else [Magic]) ++
+		(case npcType np1 of 
+			Animal -> []
+			_ -> [Prayer] ++ (if gold>0 then [Bribe] else []))
+			
+{--	
+getPossibleArenaActions::Gold -> NPCCharacter -> [ArenaAction]
+getPossibleArenaActions g (NPCCharacter{npcType=tp})=case tp of 
+	Animal 		-> [Melee .. Magic]
+	Humanoid 	-> if g>0 then [Melee .. Bribe] else  [Melee .. Prayer]
+	Human 	-> if g>0 then [Melee .. Bribe] else  [Melee .. Prayer]
+	--}
+	
+convertInArena :: GSWScreenT Arena	
+convertInArena=do
+	gs <- get
+	let ar@(Arena {arenaCharacter=c1,arenaOpponent=c2,arenaTickCount=tc}) = gsData gs
+	((c1b,c2b),rr)<-compete c1 (npcCharacter c2) conversion
+	let npc2=c2{npcCharacter=c2b}
+	let ar2=ar{arenaCharacter=c1b,arenaOpponent=npc2,arenaTickCount=tc+1}
+	put (gs{gsData=ar2})
+	case rr of
+		Failure {grade=Exceptional}->  do
+			let npc3=npc2{npcAttitude=1}
+			put (gs{gsData=ar2{arenaOpponent=npc3,chToHit=False}})
+			w<-fightInArena' 
+			return (combineWidget (WText (printf "The %s doesn't like your arguments at all and attacks!" (name $ npcCharacter c2))) w)
+		Failure {}->do
+			put (gs{gsData=ar2{es=Just Finished},screen=Nothing})
+			return (WText (printf "Your arguments failed to convince the %s!" (name c2b)))
+		rr->do
+			gained<-getItemsFromNPC rr listCarriedItemsU
+			let msg=(printf "The %s finds your religion attractive " (name c2b)) ++
+				(case gained of
+					(0,0)->"but has nothing to give you"
+					(0,gold)->(printf "and gives you %d gold coins" gold)
+					(ic,0)->(printf "and abandons %d items, pick what you want" ic)
+					(ic,gold)->(printf ", gives you %d gold coins and abandons %d items, pick what you want" gold ic)
+				)
+			gs2 <- get
+			let ar2= gsData gs2
+			let npc3=arenaOpponent ar2
+			let npc4=npc3{npcAttitude=min 20 ((npcAttitude npc3)+diff rr)}
+			put (gs2{gsData=ar2{es=Just Finished,arenaOpponent=npc4},screen=Nothing})
+			return (WText msg)
+
+stealInArena :: GSWScreenT Arena	
+stealInArena=do
+	gs <- get
+	let ar@(Arena {arenaCharacter=c1,arenaOpponent=c2,arenaTickCount=tc}) = gsData gs
+	((c1b,c2b),rr)<-compete c1 (npcCharacter c2) steal
+	let npc2=c2{npcCharacter=c2b}
+	put (gs{gsData=ar{arenaCharacter=c1b,arenaOpponent=npc2,arenaTickCount=tc+1}})
+	case rr of
+		Failure {grade=Exceptional}->  do
+			let npc3=npc2{npcAttitude=1}
+			put (gs{gsData=ar{arenaOpponent=npc3,chToHit=False}})
+			w<-fightInArena'
+			return (combineWidget (WText (printf "The %s feels your fingers and attacks!" (name $ npcCharacter c2))) w)
+		Failure {}->do
+			let npc3=npc2{npcAttitude=max 1 ((npcAttitude npc2)-diff rr)}
+			put (gs{gsData=ar{es=Just Finished,arenaOpponent=npc3},screen=Nothing})
+			return (WText (printf "You fail to steal anything from the the %s!" (name c2b)))
+		rr->do
+			gained<-getItemsFromNPC rr ((filter (\(p,_)->not $ isActive p)) . listCarriedItemsU)
+			let msg=
+				(case gained of
+					(0,0)->"You find nothing valuable to steal"
+					(0,gold)->(printf "You steal %d gold coins" gold)
+					(ic,0)->(printf "You steal %d items, pick what you want" ic)
+					(ic,gold)->(printf "You steal %d gold coins and %d items, pick what you want" gold ic)
+				)
+			gs2 <- get
+			let ar2 = gsData gs2
+			put (gs2{gsData=ar2{es=Just Finished},screen=Nothing})
+			return (WText msg)
+
+getItemsFromNPC:: RollResult -> (Inventory -> [(Position,ItemType)]) -> ScreenT (GameState Arena) (Int,Gold)	
+getItemsFromNPC rr f= do
+	gs <- get
+	let 
+		ar@(Arena {arenaOpponent=c2,arenaItems=its1}) = gsData gs
+		c2b=npcCharacter c2
+		carried=f $ inventory $ c2b 
+		theoryItemCount=case (grade rr) of
+			Exceptional->4
+			Remarkable->2
+			Standard->1
+		itemCount=min theoryItemCount (length $ carried)
+		gold=min ((theoryItemCount - itemCount)*(case (grade rr) of
+			Exceptional->12+(diff rr)*4
+			Remarkable->6+(diff rr)*2
+			Standard->3+(diff rr))) (getGold $ inventory $ npcCharacter c2)
+		(i2,its)=foldr (\item (inv,its)-> let Right(inv2,Just it)=dropItem inv (fst item)
+			in (inv2,it:its)) ((inventory $ npcCharacter c2),[]) (take itemCount carried)
+		i3=addGold i2 (-gold)
+		i4=addGold (inventory $ arenaCharacter ar) gold
+	put (gs{gsData=ar{arenaCharacter=(arenaCharacter ar){inventory=i4}, arenaOpponent=c2{npcCharacter=c2b{inventory=i3}},arenaItems=its1++its}})
+	return (itemCount,gold)
diff --git a/src/MoresmauJP/Rpg/ArenaTests.hs b/src/MoresmauJP/Rpg/ArenaTests.hs
new file mode 100644
--- /dev/null
+++ b/src/MoresmauJP/Rpg/ArenaTests.hs
@@ -0,0 +1,317 @@
+-- | The "arena" hunit tests
+-- (c) JP Moresmau 2009
+module MoresmauJP.Rpg.ArenaTests where
+
+import Control.Monad.State
+
+
+import MoresmauJP.Core.Screen
+import MoresmauJP.Rpg.Arena
+import MoresmauJP.Rpg.Character
+import MoresmauJP.Rpg.CharacterTests
+import MoresmauJP.Rpg.Inventory
+import MoresmauJP.Rpg.NPC
+import MoresmauJP.Rpg.NPCTests
+
+import MoresmauJP.Util.Random
+
+import Test.HUnit
+
+arenaTests=TestList [testStealFailure,testStealFailureExceptional,testStealSuccess,
+	testStealSuccessGold,testStealSuccessGoldItem,testStealSuccessNothing,
+	testConvertFailure,testConvertFailureExceptional,testConvertSuccess,
+	testBribeSuccess,testBribeSuccessAttitude,testBribeFailure,testBribeFailureExceptional,testBribeNoGold,
+	testPrayerSuccess,testPrayerFailure,testPrayerFailureExceptional,
+	testPossibleActions]
+
+testStealFailure=TestLabel "Test Steal Failure" (TestCase (do
+	let jp=createTestChar "JP"
+	let item=Weapon "Sword" 2 6 1 10
+	let v1=(createTestNPC "Victim")
+	let vc1=(npcCharacter v1){inventory=makeFullInventory [(Bag 1,item)] 10 100}
+	let victim=v1{npcCharacter=vc1}
+	let arena=Arena jp victim Nothing True [] 0
+	let gs=GameState arena Nothing
+	gs2<- execStateT (evalRandT stealInArena (mkTestWrapper [12])) gs
+	let arena2=gsData gs2
+	assertEqual "status not finished" (Just Finished) (es arena2) 
+	assertEqual "not zero items" 0 (length $ arenaItems arena2)
+	assertEqual "not item in victim bag" item (snd $ head $ filter (((Bag 1) ==) . fst) $
+		listCarriedItems $ inventory $ npcCharacter $ arenaOpponent arena2)
+	assertEqual "attitude is not 8" 8 (npcAttitude $ arenaOpponent arena2)
+	assertEqual "gold is not 0" 0 (getGold $ inventory $ arenaCharacter arena2)
+	))
+	
+testStealFailureExceptional=TestLabel "Test Steal Failure Exceptional" (TestCase (do
+	let jp=createTestChar "JP"
+	let item=Weapon "Sword" 2 6 1 10
+	let v1=(createTestNPC "Victim")
+	let vc1=(npcCharacter v1){inventory=makeFullInventory [(Bag 1,item)] 10 100}
+	let victim=v1{npcCharacter=vc1}
+	let arena=Arena jp victim Nothing True [] 0
+	let gs=GameState arena Nothing
+	gs2<- execStateT (evalRandT stealInArena (mkTestWrapper [20])) gs
+	let arena2=gsData gs2
+	assertEqual "status finished" Nothing (es arena2) 
+	assertEqual "not zero items" 0 (length $ arenaItems arena2)
+	assertEqual "not item in victim bag" item (snd $ head $ filter (((Bag 1) ==) . fst) $
+		listCarriedItems $ inventory $ npcCharacter $ arenaOpponent arena2)
+	assertEqual "attitude is not 1" 1 (npcAttitude $ arenaOpponent arena2)
+	assertEqual "gold is not 0" 0 (getGold $ inventory $ arenaCharacter arena2)
+	))	
+	
+testStealSuccess=TestLabel "Test Steal Success" (TestCase (do
+	let jp=createTestChar "JP"
+	let item=Weapon "Sword" 2 6 1 10
+	let v1=(createTestNPC "Victim")
+	let vc1=(npcCharacter v1){inventory=makeFullInventory [(Bag 1,item)] 10 100}
+	let victim=v1{npcCharacter=vc1}
+	let arena=Arena jp victim Nothing True [] 0
+	let gs=GameState arena Nothing
+	gs2<- execStateT (evalRandT stealInArena (mkTestWrapper [8])) gs
+	let arena2=gsData gs2
+	assertEqual "status not finished" (Just Finished) (es arena2) 
+	assertEqual "not one item" 1 (length $ arenaItems arena2)
+	assertEqual "not sword" item (head $ arenaItems arena2)
+	assertEqual "item in victim bag" 0 (length $ filter (((Bag 1) ==) . fst) $
+		listCarriedItems $ inventory $ npcCharacter $ arenaOpponent arena2)
+	assertEqual "attitude is not 10" 10 (npcAttitude $ arenaOpponent arena2)
+	assertEqual "gold is not 0" 0 (getGold $ inventory $ arenaCharacter arena2)
+	))
+	
+testStealSuccessGold=TestLabel "Test Steal Success Gold" (TestCase (do
+	let jp=createTestChar "JP"
+	let v1=(createTestNPC "Victim")
+	let vc1=(npcCharacter v1){inventory=makeFullInventory [] 10 100}
+	let victim=v1{npcCharacter=vc1}
+	let arena=Arena jp victim Nothing True [] 0
+	let gs=GameState arena Nothing
+	gs2<- execStateT (evalRandT stealInArena (mkTestWrapper [8])) gs
+	let arena2=gsData gs2
+	assertEqual "status not finished" (Just Finished) (es arena2) 
+	assertEqual "not zero item" 0 (length $ arenaItems arena2)
+	assertEqual "attitude is not 10" 10 (npcAttitude $ arenaOpponent arena2)
+	assertEqual "jp gold is not 5" 5 (getGold $ inventory $ arenaCharacter arena2)
+	assertEqual "victim gold is not 95" 95 (getGold $ inventory $ npcCharacter $ arenaOpponent arena2)
+	))	
+	
+testStealSuccessGoldItem=TestLabel "Test Steal Success Gold+Item" (TestCase (do
+	let jp=createTestChar "JP"
+	let item=Weapon "Sword" 2 6 1 10
+	let v1=(createTestNPC "Victim")
+	let vc1=(npcCharacter v1){inventory=makeFullInventory [(Bag 1,item)] 10 100}
+	let victim=v1{npcCharacter=vc1}
+	let arena=Arena jp victim Nothing True [] 0
+	let gs=GameState arena Nothing
+	gs2<- execStateT (evalRandT stealInArena (mkTestWrapper [4])) gs
+	let arena2=gsData gs2
+	assertEqual "status not finished" (Just Finished) (es arena2) 
+	assertEqual "not one item" 1 (length $ arenaItems arena2)
+	assertEqual "not sword" item (head $ arenaItems arena2)
+	assertEqual "item in victim bag" 0 (length $ filter (((Bag 1) ==) . fst) $
+		listCarriedItems $ inventory $ npcCharacter $ arenaOpponent arena2)
+	assertEqual "attitude is not 10" 10 (npcAttitude $ arenaOpponent arena2)
+	assertEqual "jp gold is not 18" 18 (getGold $ inventory $ arenaCharacter arena2)
+	assertEqual "victim gold is not 82" 82 (getGold $ inventory $ npcCharacter $ arenaOpponent arena2)
+	
+	))	
+	
+testStealSuccessNothing=TestLabel "Test Steal Success Nothing" (TestCase (do
+	let jp=createTestChar "JP"
+	let v1=(createTestNPC "Victim")
+	let vc1=(npcCharacter v1){inventory=makeFullInventory [] 10 0}
+	let victim=v1{npcCharacter=vc1}
+	let arena=Arena jp victim Nothing True [] 0
+	let gs=GameState arena Nothing
+	gs2<- execStateT (evalRandT stealInArena (mkTestWrapper [8])) gs
+	let arena2=gsData gs2
+	assertEqual "status not finished" (Just Finished) (es arena2) 
+	assertEqual "not zero item" 0 (length $ arenaItems arena2)
+	assertEqual "attitude is not 10" 10 (npcAttitude $ arenaOpponent arena2)
+	assertEqual "gold is not 0" 0 (getGold $ inventory $ arenaCharacter arena2)
+	assertEqual "victim gold is not 0" 0 (getGold $ inventory $ npcCharacter $ arenaOpponent arena2)
+	))	
+	
+testConvertFailure=TestLabel "Test Convert Failure" (TestCase (do
+	let jp=createTestChar "JP"
+	let item=Weapon "Sword" 2 6 1 10
+	let v1=(createTestNPC "Victim")
+	let vc1=(npcCharacter v1){inventory=makeFullInventory [(Bag 1,item)] 10 100}
+	let victim=v1{npcCharacter=vc1}
+	let arena=Arena jp victim Nothing True [] 0
+	let gs=GameState arena Nothing
+	gs2<- execStateT (evalRandT convertInArena (mkTestWrapper [12])) gs
+	let arena2=gsData gs2
+	assertEqual "status not finished" (Just Finished) (es arena2) 
+	assertEqual "not zero items" 0 (length $ arenaItems arena2)
+	assertEqual "not item in victim bag" item (snd $ head $ filter (((Bag 1) ==) . fst) $
+		listCarriedItems $ inventory $ npcCharacter $ arenaOpponent arena2)
+	assertEqual "attitude is not 10" 10 (npcAttitude $ arenaOpponent arena2)
+	assertEqual "gold is not 0" 0 (getGold $ inventory $ arenaCharacter arena2)	
+	))
+	
+testConvertFailureExceptional=TestLabel "Test Convert Failure Exceptional" (TestCase (do
+	let jp=createTestChar "JP"
+	let item=Weapon "Sword" 2 6 1 10
+	let v1=(createTestNPC "Victim")
+	let vc1=(npcCharacter v1){inventory=makeFullInventory [(Bag 1,item)] 10 100}
+	let victim=v1{npcCharacter=vc1}
+	let arena=Arena jp victim Nothing True [] 0
+	let gs=GameState arena Nothing
+	gs2<- execStateT (evalRandT convertInArena (mkTestWrapper [20])) gs
+	let arena2=gsData gs2
+	assertEqual "status finished" Nothing (es arena2) 
+	assertEqual "not zero items" 0 (length $ arenaItems arena2)
+	assertEqual "not item in victim bag" item (snd $ head $ filter (((Bag 1) ==) . fst) $
+		listCarriedItems $ inventory $ npcCharacter $ arenaOpponent arena2)
+	assertEqual "attitude is not 1" 1 (npcAttitude $ arenaOpponent arena2)
+	assertEqual "gold is not 0" 0 (getGold $ inventory $ arenaCharacter arena2)
+	))		
+	
+testConvertSuccess=TestLabel "Test Convert Success" (TestCase (do
+	let jp=createTestChar "JP"
+	let item=Weapon "Sword" 2 6 1 10
+	let v1=(createTestNPC "Victim")
+	let vc1=(npcCharacter v1){inventory=makeFullInventory [(Bag 1,item)] 10 100}
+	let victim=v1{npcCharacter=vc1}
+	let arena=Arena jp victim Nothing True [] 0
+	let gs=GameState arena Nothing
+	gs2<- execStateT (evalRandT convertInArena (mkTestWrapper [8])) gs
+	let arena2=gsData gs2
+	assertEqual "status not finished" (Just Finished) (es arena2) 
+	assertEqual "not one item" 1 (length $ arenaItems arena2)
+	assertEqual "not sword" item (head $ arenaItems arena2)
+	assertEqual "item in victim bag" 0 (length $ filter (((Bag 1) ==) . fst) $
+		listCarriedItems $ inventory $ npcCharacter $ arenaOpponent arena2)
+	assertEqual "attitude is not 12" 12 (npcAttitude $ arenaOpponent arena2)	
+	assertEqual "gold is not 0" 0 (getGold $ inventory $ arenaCharacter arena2)
+	))
+	
+testBribeSuccess=TestLabel "Test Bribe Success" (TestCase (do
+	let jp=(createTestChar "JP"){inventory=makeFullInventory [] 10 100}
+	let v1=(createTestNPC "Victim")
+	let vc1=(npcCharacter v1){inventory=makeFullInventory [] 10 100}
+	let victim=v1{npcCharacter=vc1}
+	let arena=Arena jp victim Nothing True [] 0
+	let gs=GameState arena Nothing
+	gs2<- execStateT (evalRandT bribeInArena (mkTestWrapper [8])) gs
+	let arena2=gsData gs2
+	assertEqual "status not finished" (Just Finished) (es arena2) 
+	assertEqual "victim gold is not 197" 197 (getGold $ inventory $ npcCharacter $ arenaOpponent arena2)
+	assertEqual "gold is not 3" 3 (getGold $ inventory $ arenaCharacter arena2)
+	))
+
+testBribeSuccessAttitude=TestLabel "Test Bribe Success Attitude" (TestCase (do
+	let jp=(createTestChar "JP"){inventory=makeFullInventory [] 10 100}
+	let v1=(createTestNPC "Victim"){npcAttitude=12}
+	let vc1=(npcCharacter v1){inventory=makeFullInventory [] 10 100}
+	let victim=v1{npcCharacter=vc1}
+	let arena=Arena jp victim Nothing True [] 0
+	let gs=GameState arena Nothing
+	gs2<- execStateT (evalRandT bribeInArena (mkTestWrapper [8])) gs
+	let arena2=gsData gs2
+	assertEqual "status not finished" (Just Finished) (es arena2) 
+	assertEqual "victim gold is not 195" 195 (getGold $ inventory $ npcCharacter $ arenaOpponent arena2)
+	assertEqual "gold is not 5" 5 (getGold $ inventory $ arenaCharacter arena2)
+	))
+	
+testBribeFailure=TestLabel "Test Bribe Failure" (TestCase (do
+	let jp=(createTestChar "JP"){inventory=makeFullInventory [] 10 100}
+	let v1=(createTestNPC "Victim")
+	let vc1=(npcCharacter v1){inventory=makeFullInventory [] 10 100}
+	let victim=v1{npcCharacter=vc1}
+	let arena=Arena jp victim Nothing True [] 0
+	let gs=GameState arena Nothing
+	gs2<- execStateT (evalRandT 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)
+	assertEqual "gold is not 100" 100 (getGold $ inventory $ arenaCharacter arena2)
+	))
+	
+testBribeNoGold=TestLabel "Test Bribe No Gold" (TestCase (do
+	let jp=(createTestChar "JP"){inventory=makeFullInventory [] 10 0}
+	let v1=(createTestNPC "Victim")
+	let vc1=(npcCharacter v1){inventory=makeFullInventory [] 10 100}
+	let victim=v1{npcCharacter=vc1}
+	let arena=Arena jp victim Nothing True [] 0
+	let gs=GameState arena Nothing
+	gs2<- execStateT (evalRandT 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)
+	assertEqual "gold is not 0" 0 (getGold $ inventory $ arenaCharacter arena2)
+	))
+		
+	
+testBribeFailureExceptional=TestLabel "Test Bribe Failure Exceptional" (TestCase (do
+	let jp=(createTestChar "JP"){inventory=makeFullInventory [] 10 100}
+	let v1=(createTestNPC "Victim")
+	let vc1=(npcCharacter v1){inventory=makeFullInventory [] 10 100}
+	let victim=v1{npcCharacter=vc1}
+	let arena=Arena jp victim Nothing True [] 0
+	let gs=GameState arena Nothing
+	gs2<- execStateT (evalRandT 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)
+	assertEqual "gold is not 100" 100 (getGold $ inventory $ arenaCharacter arena2)
+	assertEqual "attitude is not 1" 1 (npcAttitude $ arenaOpponent arena2)
+	))	
+	
+testPrayerSuccess=TestLabel "Test Prayer Success" (TestCase (do
+	let jp=(createTestChar "JP")
+	let v1=(createTestNPC "Victim")
+	let arena=Arena jp v1 Nothing True [] 0
+	let gs=GameState arena Nothing
+	gs2<- execStateT (evalRandT 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)
+	))
+	
+testPrayerFailure=TestLabel "Test Prayer Failure" (TestCase (do
+	let jp=(createTestChar "JP"){inventory=makeFullInventory [] 10 100}
+	let v1=(createTestNPC "Victim")
+	let vc1=(npcCharacter v1){inventory=makeFullInventory [] 10 100}
+	let victim=v1{npcCharacter=vc1}
+	let arena=Arena jp victim Nothing True [] 0
+	let gs=GameState arena Nothing
+	gs2<- execStateT (evalRandT prayerInArena (mkTestWrapper [12])) gs
+	let arena2=gsData gs2
+	assertEqual "status finished" Nothing (es arena2)
+	assertEqual "attitude is not 10" 10 (npcAttitude $ arenaOpponent arena2)
+	))
+	
+testPrayerFailureExceptional=TestLabel "Test Prayer Failure Exceptional" (TestCase (do
+	let jp=(createTestChar "JP"){inventory=makeFullInventory [] 10 100}
+	let v1=(createTestNPC "Victim")
+	let vc1=(npcCharacter v1){inventory=makeFullInventory [] 10 100}
+	let victim=v1{npcCharacter=vc1}
+	let arena=Arena jp victim Nothing True [] 0
+	let gs=GameState arena Nothing
+	gs2<- execStateT (evalRandT prayerInArena (mkTestWrapper [20])) gs
+	let arena2=gsData gs2
+	assertEqual "status finished" Nothing (es arena2)
+	assertEqual "attitude is not 1" 1 (npcAttitude $ arenaOpponent arena2)
+	))		
+	
+testPossibleActions=TestLabel "Test possible action" (TestCase (do
+	let jp=(createTestChar "JP"){inventory=makeFullInventory [] 10 0}
+	let v1=(createTestNPC "Victim"){npcType=Animal}
+	let acts1=getPossibleArenaActions jp v1
+	assertEqual (show [Melee,Escape]) [Melee,Escape] acts1
+	let jpM1=jp{spells=[Spell "Feel Better" Physical Recovery Permanent]}
+	let acts2=getPossibleArenaActions jpM1 v1
+	assertEqual (show [Melee,Escape]) [Melee,Escape] acts2
+	let jpM2=jp{spells=[Spell "Greasy Fingers" Dexterity Negative Temporary]}
+	let acts3=getPossibleArenaActions jpM2 v1
+	assertEqual (show [Melee,Escape,Magic]) [Melee,Escape,Magic] acts3	
+	let v2=(createTestNPC "Victim"){npcType=Human}
+	let acts4=getPossibleArenaActions jpM2 v2
+	assertEqual (show [Melee,Escape,Magic,Prayer]) [Melee,Escape,Magic,Prayer] acts4
+	let jpG=jpM2{inventory=makeFullInventory [] 10 10}
+	let acts5=getPossibleArenaActions jpG v2
+	assertEqual (show [Melee,Escape,Magic,Prayer,Bribe]) [Melee,Escape,Magic,Prayer,Bribe] acts5
+	
+	))
diff --git a/src/MoresmauJP/Rpg/Character.hs b/src/MoresmauJP/Rpg/Character.hs
new file mode 100644
--- /dev/null
+++ b/src/MoresmauJP/Rpg/Character.hs
@@ -0,0 +1,176 @@
+-- | Character handling
+-- (c) JP Moresmau 2009
+module MoresmauJP.Rpg.Character where
+
+import Data.Array.IArray
+import Data.List
+
+import Text.Printf
+import Text.Regex.Posix
+
+import MoresmauJP.Rpg.Inventory
+
+import MoresmauJP.Util.Numbers
+
+
+type Name=String
+type CharacteristicRatings=Array Characteristic Rating
+
+data Character = Character {
+	name::Name
+	,gender::Gender
+	,traits::CharacteristicRatings
+	,inventory::Inventory
+	, affects::[Affect]
+	, spells::[Spell]
+	} deriving (Eq,Show,Read)
+	
+data Gender = Male 
+	| Female
+	deriving (Show, Read,Eq)
+
+data Affect=Affect {
+	affected::Characteristic,
+	affect::Int,
+	untilTick::Int,
+	source::String,
+	affectDescription::String,
+	liftDescription::String
+	}
+	deriving (Show, Read,Eq)
+
+data Characteristic = Strength | Dexterity | Constitution | Willpower
+	| Intelligence | Balance | Charisma | Perception | Physical | Mental
+	deriving (Show,Read,Eq,Enum,Bounded,Ord,Ix)
+	
+data RatingScoreType=Normal |
+	Current |
+	Experience
+	deriving (Show,Read,Enum,Eq,Ord,Bounded,Ix)
+
+data RatingScore=RatingScore RatingScoreType Int
+	deriving (Show,Read,Eq)
+
+data Rating=Rating (Array RatingScoreType Int)
+	deriving (Eq)
+
+instance Show Rating where
+	show r=printf "%d/%d(%d)" (getR Current r) (getR Normal r) (getR Experience r)
+	
+instance Read Rating where
+	readsPrec _ s= let
+		(_,_,after,(c:n:e:[]))= (s=~"([0-9]+)/([0-9]+)\\(([0-9]+)\\)") :: (String,String,String,[String])
+		in [(Rating (array (Normal,Experience) [(Normal,(read n)),(Current,(read c)),(Experience,(read e))]),after)]
+	
+data SpellImpact=Negative | Positive | Recovery
+	deriving (Show,Read,Eq)
+
+data SpellDuration=Permanent | Temporary 
+	deriving (Show,Read,Eq)	
+	
+data Spell=Spell {
+	spellName::String,
+	impactedChar::Characteristic,
+	impact::SpellImpact,
+	spellDuration::SpellDuration
+	} deriving (Show,Read,Eq)	
+	
+	
+allCharacteristics= [Strength .. Perception]
+allHealth=[Physical .. Mental]
+			
+getDefaultHealth :: CharacteristicRatings -> CharacteristicRatings
+getDefaultHealth crs=array (Strength,Mental) ((assocs crs) ++ [(Physical,(mkRating $ getCharacteristic crs Normal Constitution)),(Mental,(mkRating $ getCharacteristic crs Normal Balance))])
+
+isOK :: Character -> Bool
+isOK a = not (isOutOfService a)
+
+isOutOfService :: Character -> Bool
+isOutOfService a = (isDead a) || (isMad a)
+
+isDead :: Character -> Bool
+isDead a= (getCharacteristic' a Current Physical) <= 0  
+
+isMad :: Character -> Bool
+isMad a= (getCharacteristic' a Current Mental ) <= 0  
+
+characterLevel :: Character -> Int
+characterLevel c=avg $ map (getCharacteristic' c Normal) allCharacteristics
+
+mkRating :: Int -> Rating
+mkRating v = Rating (array (Normal,Experience) [(Normal,v),(Current, v),(Experience, 0)])
+	
+
+getR :: RatingScoreType -> Rating -> Int
+getR rst (Rating array)= array ! rst
+
+addCharacteristic :: CharacteristicRatings -> RatingScoreType -> Characteristic -> Int -> CharacteristicRatings
+addCharacteristic cr rst char inc= let 
+	(Rating arr)=cr ! char
+	oldVal=arr ! rst
+	arr2=nextLevel (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)])
+	in cr // [(char,Rating arr2)]
+
+nextLevel :: (Array RatingScoreType Int) -> (Array RatingScoreType Int)
+nextLevel arr = let
+	experience=arr ! Experience
+	normal=arr ! Normal
+	nextLevelRequired=round (((fromIntegral normal) ** 3) / 3)
+	in if (experience>nextLevelRequired)
+		then
+			let 
+				experience'=experience-nextLevelRequired
+				normal'=normal+1
+				current=(arr ! Current) +1
+				arr2=array (Normal,Experience) [(Normal,normal'),(Current, current),(Experience, experience')]
+			in nextLevel arr2 	
+		else
+			arr
+
+getCharacteristic :: CharacteristicRatings -> RatingScoreType -> Characteristic -> Int
+getCharacteristic cr rst char = getR rst $ cr ! char
+
+addCharacteristic' :: Character -> RatingScoreType -> Characteristic -> Int -> Character
+addCharacteristic' c rst char inc= c{traits=addCharacteristic (traits c) rst char inc}
+
+setCharacteristic' :: Character -> RatingScoreType -> Characteristic -> Int -> Character
+setCharacteristic' c rst char inc= c{traits=setCharacteristic (traits c) rst char inc}
+
+getCharacteristic' :: Character -> RatingScoreType -> Characteristic -> Int
+getCharacteristic' c = getCharacteristic (traits c)
+
+getHealthSummary :: Character -> [String]
+getHealthSummary c= map (\x->printf "%s: %s" (show x) (show ((traits c) ! x))) allHealth
+
+-- | add an affect to the character
+addAffect :: Character -- ^ the character to affect
+	-> Affect -- ^ the affect
+	-> Character -- ^ the new character
+addAffect c@(Character{affects=a}) aff=let
+	c1=addCharacteristic' c Current (affected aff) (affect aff)
+	in c1{affects=(aff:a)}
+
+-- | remove any expired affects on the character
+expireAffects:: Character -- ^ the character to test
+	-> Int  -- ^ the current tick count
+	-> (Character,[String]) -- ^ the new character and the description of lifted effects
+expireAffects c@(Character{affects=a}) tc=let
+	(a',a'')=partition (\x->(untilTick x)>tc) a
+	in (c{affects=a'},map liftDescription a'')
+	
+recover :: 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))
+	
diff --git a/src/MoresmauJP/Rpg/CharacterTests.hs b/src/MoresmauJP/Rpg/CharacterTests.hs
new file mode 100644
--- /dev/null
+++ b/src/MoresmauJP/Rpg/CharacterTests.hs
@@ -0,0 +1,114 @@
+-- | Character handling unit tests
+-- (c) JP Moresmau 2009
+module MoresmauJP.Rpg.CharacterTests where
+
+import Data.Array.IArray
+
+import MoresmauJP.Rpg.Character
+import MoresmauJP.Rpg.Inventory
+import MoresmauJP.Rpg.Profile
+
+import MoresmauJP.Util.Random
+
+import Test.HUnit
+
+import System.Random
+
+characterTests=TestList [testLevel,testSetOOS,testExperience,testAffects]
+
+createTestChar :: String -> Character
+createTestChar name=Character name Male 
+	(array (Strength,Mental) 
+		(map (\x->(x,(Rating 
+			(array (Normal,Experience) [(Normal,10),(Current,10),(Experience,0)])
+			))) 
+			[Strength .. Mental]
+		)
+	) mkEmptyInventory [] []
+	
+mkEmptyInventory=(makeEmptyInventory 10 0)
+
+	
+testLevel= TestLabel "Test Level" (TestCase (do
+	let jp=createTestChar "JP"
+	assertEqual "Level is not 10" 10 (characterLevel jp)
+	let jp2=Character "jp2" Male (array (Strength,Mental) 
+			(map (\x->(x,(Rating 
+				(array (Normal,Experience) [(Normal,15),(Current,10),(Experience,5)])
+				))) 
+				[Strength .. Mental]
+			)
+		) mkEmptyInventory [] []
+	assertEqual "Level is not 15" 15 (characterLevel jp2)	
+	))
+	
+
+testSetOOS = TestLabel "Test Out Of Service" (
+	TestCase (do
+		sg<-getStdGen
+		mt<-evalRandT(generateTraits $ head $ profiles) (ProductionRandom sg)
+		let c=Character "Test" Male (getDefaultHealth mt) mkEmptyInventory [] []
+		assertBool "Character is not OK" (isOK c)
+		assertBool "Character is out of service" (not (isOutOfService c))
+		let c2=setCharacteristic' c Current Physical 0
+		assertBool "Character is not dead" (isDead c2)
+		assertBool "Character is mad" (not (isMad c2))
+		assertBool "Character is ok" (not (isOK c2))
+		assertBool "Character is not out of service" (isOutOfService c2)
+		let c3=setCharacteristic' c2 Current Physical 10
+		let c4=setCharacteristic' c3 Current Mental 0
+		assertBool "Character is not mad" (isMad c4)
+		assertBool "Character is dead" (not (isDead c4))
+		assertBool "Character is ok" (not (isOK c4))
+		assertBool "Character is not out of service" (isOutOfService c4)
+		let c5=setCharacteristic' c4 Current Physical 0
+		assertBool "Character is not mad" (isMad c5)
+		assertBool "Character is not dead" (isDead c5)
+		assertBool "Character is ok" (not (isOK c5))
+		assertBool "Character is not out of service" (isOutOfService c5)
+	))
+	
+
+testExperience = TestLabel "Test Experience" (TestCase (do
+	let jp=createTestChar "JP"
+	assertEqual "current dexterity is not 10" 10 (getCharacteristic' jp Current Dexterity)
+	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)
+	))		
+	
+testAffects= TestLabel "Test Affects" (TestCase (do
+	let 
+		jp=createTestChar "JP"
+		(jp',descs)=expireAffects jp 1
+	assertEqual "jp has changed" jp jp'
+	assertEqual "descs found while no affect" 0 (length descs)
+	
+	let 
+		aff1=Affect Strength (-3) 5 "weakness" "under a spell of weakness" "you feel stronger"
+		aff2=Affect Dexterity 2 10 "nimble fingers" "under a spell of nimble fingers" "you feel as clumsy as usual"
+		jp2=addAffect (addAffect jp aff1) aff2
+		(jp3,descs1)=expireAffects jp2 1
+		(jp4,descs2)=expireAffects jp3 5
+		(jp5,descs3)=expireAffects jp4 11
+	
+	assertEqual "jp2 has changed" jp2 jp3
+	assertEqual "descs found while tick is <" 0 (length descs1)
+	assertEqual "strength is not 7" 7 (getCharacteristic' jp3 Current Strength)
+	assertEqual "dexterity is not 12" 12 (getCharacteristic' jp3 Current Dexterity)
+	
+	assertEqual "descs2 not found while tick is >" 1 (length descs2)
+	assertEqual "not feel stronger" "you feel stronger" (head descs2)
+	assertEqual "jp4 has not 1 affect left" 1 (length $ affects jp4)
+	assertEqual "jp4 does not have dexterity affect left" aff2 (head $ affects jp4)
+	
+	assertEqual "descs3 not found while tick is >" 1 (length descs3)
+	assertEqual "not feel clumsy" "you feel as clumsy as usual" (head descs3)
+	assertEqual "jp5 has not 0 affect left" 0 (length $ affects jp5)
+
+	
+	))
+	
diff --git a/src/MoresmauJP/Rpg/Fight.hs b/src/MoresmauJP/Rpg/Fight.hs
new file mode 100644
--- /dev/null
+++ b/src/MoresmauJP/Rpg/Fight.hs
@@ -0,0 +1,115 @@
+-- | Fight resolution
+-- (c) JP Moresmau 2009
+module MoresmauJP.Rpg.Fight 
+(giveBlow,FightStatus,swapFS) 
+
+where
+
+import Control.Monad
+import Data.List
+
+import MoresmauJP.Rpg.Actions
+import MoresmauJP.Rpg.Character
+import MoresmauJP.Rpg.Items
+import MoresmauJP.Rpg.Inventory
+
+import MoresmauJP.Util.Random
+
+import Text.Printf
+
+type FightStatus a= ((a,a),Bool,[Message])
+
+
+swapFS :: FightStatus a -> FightStatus a
+swapFS ((c1,c2),b,msgs)=((c2,c1),b,msgs)
+
+giveBlow :: (MonadRandom m)=>Character -> Character -> m (FightStatus Character)
+giveBlow c1 c2 =do 
+	((c1b,c2b),rr) <- compete c1 c2  melee
+	damages c1b c2b rr
+
+	
+damages:: (MonadRandom 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)])
+damages c1 c2 rr@(Success {grade=gr})= do
+	(c11,d1,msgs1) <- damageWeapon c1 rr
+	(c21,d2,msgs2) <- damageArmor c2 gr
+	let total=max 0 (d1-d2+(damageLevel c11 gr))
+	let msg1=Message (c11,Hit total)
+	let c22=addCharacteristic' c21 Current Physical (-total)
+	return ((c11,c22),isOutOfService c22,msgs1++msgs2++[msg1])
+
+damageLevel :: Character-> Grade -> Int
+damageLevel c Standard = damageBonus c
+damageLevel c Remarkable = div ((damageBonus c) * 12) 10
+damageLevel c Exceptional = div ((damageBonus c) * 17) 10
+
+damageBonus :: Character -> Int
+damageBonus c = div (getCharacteristic' c Current Strength) 4
+
+damageWeapon :: (MonadRandom m)=>Character -> RollResult ->  m (Character,Int,[Message])
+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
+		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)])
+				-- if failed, used only right hand weapon	
+				else 
+					return (c1,[head items],[])
+		else
+			return (c,items,[])
+	dmg<-mapM (damageFromItemHigh rr) items2
+	return (c2, sum dmg,msgs) 
+
+damageArmor :: (MonadRandom m)=>Character -> Grade -> m(Character,Int,[Message])
+damageArmor c g = do
+	let items=nub $ (filter isProtective) $ listActiveItems (inventory c)
+	(c2,items2,msg)<-foldM shieldF (c,[],[]) items
+	dmg<-mapM  damageFromItem items2
+	return (c2,sum dmg,msg)
+	where 
+		--shieldF :: (Character,[ItemType],[Message]) -> ItemType -> Rand (Character,[ItemType],[Message])
+		shieldF (c,its,msgs) 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))
+				-- if failed, do not use shields
+				else 
+					return (c1,its,msgs)
+		shieldF (c,its,msgs) it=return (c,(it:its),msgs)
+		
+damageFromItem ::  (MonadRandom m)=>ItemType -> m(Int)
+damageFromItem it =roll (damageLow it,damageHigh it)
+
+damageFromItemHigh::  (MonadRandom m)=>RollResult -> ItemType -> m(Int)
+damageFromItemHigh rr it=do
+	dmg<-damageFromItem it
+	return (resultMultiplierHigh dmg rr) 
+
+newtype Message = Message (Character,MessageType)
+
+data MessageType = Fumble Int | Miss | Hit Int | TwoHandedAttack | ShieldDefense
+
+instance Show Message where
+	showsPrec _ (Message (c,(Fumble damage))) = showString $ printf "%s fumbles and gives himself %d damages" (name c) damage
+	showsPrec _ (Message (c,(Miss))) = showString $ printf "%s misses" (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) 
+
diff --git a/src/MoresmauJP/Rpg/FightTests.hs b/src/MoresmauJP/Rpg/FightTests.hs
new file mode 100644
--- /dev/null
+++ b/src/MoresmauJP/Rpg/FightTests.hs
@@ -0,0 +1,78 @@
+-- | Fight resolution hunit tests
+-- (c) JP Moresmau 2009
+module MoresmauJP.Rpg.FightTests where
+
+import MoresmauJP.Rpg.Character
+import MoresmauJP.Rpg.CharacterTests
+import MoresmauJP.Rpg.Fight
+
+import MoresmauJP.Util.Random
+
+import Test.HUnit
+
+fightTests = TestList [testFightRoundNormal,
+		testFightRoundFumble,testFightRoundKill]
+
+testFightRoundNormal=TestLabel "Test Fight Round Normal Hit" (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 ((jp2,troll2),dead,msgs)=evalRand (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)
+	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 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 "Msg2" "Troll misses" (head $ tail msgs)
+	))
+	
+
+
+
+testFightRoundFumble=TestLabel "Test Fight Round Fumbles" (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]
+	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 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)
+	))
+
+testFightRoundKill=TestLabel "Test Fight Round Kill" (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 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]
+	assertBool "nobody is dead!" 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  OK" (not (isOK troll2))
+	assertBool "Troll is not dead" (isDead troll2)
+	assertBool "Troll is not oos" (isOutOfService troll2)
+	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)
+	))
diff --git a/src/MoresmauJP/Rpg/Inventory.hs b/src/MoresmauJP/Rpg/Inventory.hs
new file mode 100644
--- /dev/null
+++ b/src/MoresmauJP/Rpg/Inventory.hs
@@ -0,0 +1,212 @@
+-- | Inventory management
+-- (c) JP Moresmau 2009
+module MoresmauJP.Rpg.Inventory (
+	Inventory(), Position(..), ItemType(..), InventoryError(..),PotionType(..),
+	makeEmptyInventory, makeFullInventory, takeItem, dropItem, listItems, 
+	listAllowedPositions,listActiveItems,listCarriedItems,listCarriedItemsU,
+	getCarriedItem,	positionAllowed, addGold, getGold,
+	Gold, isActive
+	) where
+
+import Data.List
+import Data.Maybe
+import qualified Data.Map as M
+
+data ItemType = Weapon {
+		itName::String, 
+		damageLow::Int, 
+		damageHigh::Int,
+		hands::Int,
+		price::Gold}
+	| Armor {
+		itName::String, 
+		damageLow::Int, 
+		damageHigh::Int,
+		price::Gold}
+	| Shield {
+		itName::String, 
+		damageLow::Int, 
+		damageHigh::Int,
+		price::Gold}
+	| Helmet {
+		itName::String, 
+		damageLow::Int, 
+		damageHigh::Int,
+		price::Gold}
+	| Potion {
+		itName::String,
+		potionType::PotionType,
+		price::Gold}
+	| Scroll {
+		itName::String,
+		spellType::String,
+		price::Gold}
+	deriving (Show,Read,Eq)
+	
+
+data Position= RightHand | LeftHand | Body | Head | Bag Int
+	deriving (Show,Read,Eq,Ord)
+
+-- | Inventory Map item by Position Bag Size 
+data Inventory = Inventory {
+	invItems::(M.Map Position ItemType),
+	invBagCapacity:: Int,
+	invGold:: Gold
+	} deriving (Eq,Show,Read)
+
+type Gold=Int
+
+data InventoryError = InvalidBagPosition Int
+	| InvalidPositionForItem ItemType Position
+	deriving (Eq,Show,Read)
+
+data PotionType = HealingPotion Int
+	deriving (Show,Read,Eq)
+
+makeEmptyInventory :: Int -> Gold -> Inventory
+makeEmptyInventory a gold= Inventory M.empty a gold
+
+{--
+makeFullInventory :: [(Position,ItemType)] -> Gold -> Inventory
+makeFullInventory [] gold= makeEmptyInventory 0 gold
+makeFullInventory posAndItems gold= let
+	maxPos=maximum (map (getBagPos . fst) posAndItems)
+	in
+		reconcile2Hand (Inventory M.empty maxPos gold) posAndItems
+	where
+		getBagPos (Bag p)=p
+		getBagPos _ =0
+--}
+
+makeFullInventory :: [(Position,ItemType)] -> Int -> Gold -> Inventory
+makeFullInventory [] maxPos gold= makeEmptyInventory maxPos gold
+makeFullInventory posAndItems maxPos gold= reconcile2Hand (Inventory M.empty maxPos gold) posAndItems
+
+addGold :: Inventory -> Gold -> Inventory
+addGold i g=let	oldGold=invGold i
+	in i{invGold=max 0 (oldGold+g)}
+
+getGold :: Inventory -> Gold
+getGold i=invGold i
+
+reconcile2Hand :: Inventory -> [(Position,ItemType)] -> Inventory
+reconcile2Hand i poss=foldr f i poss
+	where 
+		f:: (Position,ItemType) -> Inventory -> Inventory
+		f pos i=
+			case getCarriedItem i (fst pos)	of
+				Right Nothing ->
+					let Right (i2,_)=takeItem i (snd pos) (fst pos)
+					in i2
+				_->i
+
+takeItem :: Inventory -> ItemType -> Position -> Either InventoryError (Inventory,[ItemType])
+takeItem i@(Inventory {invBagCapacity= sz}) it p=  do
+	p2 <- checkPos sz p
+	ti1 <- takeItem' i it p2 True
+	takeTwoHandsItem ti1 it p2
+	
+takeTwoHandsItem ::(Inventory,Maybe ItemType) -> ItemType -> Position  -> Either InventoryError (Inventory,[ItemType])
+takeTwoHandsItem (i,it1) it@(Weapon {hands=2}) RightHand= do
+	(iv2,it2) <- takeItem' i it LeftHand False
+	return (iv2,catMaybes [it1,it2])
+takeTwoHandsItem (i,it1) it@(Weapon {hands=2}) LeftHand= do
+	(iv2,it2) <- takeItem' i it RightHand False
+	return (iv2,catMaybes [it1,it2])
+takeTwoHandsItem (i,it1)  _ _=do
+	return (i,catMaybes [it1])
+	
+
+takeItem' :: Inventory -> ItemType -> Position -> Bool -> Either InventoryError (Inventory,Maybe ItemType)
+takeItem' i it p needDrop=  do
+	let allowed=positionAllowed it p
+	if allowed 
+		then do
+			(i2@(Inventory {invItems=m}),it2) <- if needDrop 
+				then dropItemToBag i p
+				else Right (i, Nothing)
+			return ((i2{invItems=(M.insert p it m)}),it2)
+		else Left (InvalidPositionForItem it p)
+
+dropItemToBag :: Inventory -> Position -> Either InventoryError (Inventory,Maybe ItemType)
+dropItemToBag i p@(Bag _)=dropItem i p
+dropItemToBag i p=do
+	mi2@(i2,it2)<- dropItem i p
+	if isJust it2
+		then do
+			let freeBagPos=getFirstFreeBagPos i2
+			if (isJust freeBagPos)
+				then do
+					(i3,_)<- takeItem i (fromJust it2) (fromJust freeBagPos)
+					return (i3,Nothing)
+				else return mi2
+		else return mi2
+
+instance Monad (Either InventoryError) where
+	Left a >>= _ = Left a
+	Right a >>= f = f a
+	return = Right 
+
+getFirstFreeBagPos:: Inventory -> Maybe Position
+getFirstFreeBagPos (Inventory {invItems=m,invBagCapacity=sz})=listToMaybe $ (filter (flip M.notMember m) (map Bag [1 .. sz]))
+
+
+dropItem :: Inventory -> Position -> Either InventoryError (Inventory,Maybe ItemType)
+dropItem i@(Inventory {invItems=m,invBagCapacity=sz}) p = do
+	p2 <- checkPos sz p
+	let item = M.lookup p2 m
+	let m2 = M.delete p2 m
+	return (i{invItems=(dropTwoHandsItem m2 item p2)},item)
+
+dropTwoHandsItem ::(M.Map Position ItemType) -> Maybe ItemType -> Position  -> (M.Map Position ItemType)
+dropTwoHandsItem m (Just (Weapon {hands=2})) RightHand= M.delete LeftHand m
+dropTwoHandsItem m (Just (Weapon {hands=2})) LeftHand= M.delete RightHand m
+dropTwoHandsItem m  _ _=m
+
+checkPos :: Int -> Position -> Either InventoryError Position
+checkPos capacity (Bag pos) | pos<1 = Left (InvalidBagPosition capacity)
+checkPos capacity (Bag pos) | pos>capacity = Left (InvalidBagPosition capacity)
+checkPos _ p = Right p
+
+listItems :: Inventory -> [(Position,Maybe ItemType)]
+listItems (Inventory {invItems=m,invBagCapacity=sz}) = map 
+	(\x -> (x,M.lookup x m))
+	([RightHand, LeftHand, Body, Head] ++ (map Bag [1..sz]))
+	
+listCarriedItems :: Inventory -> [(Position,ItemType)]	
+listCarriedItems i = map (\(x,y)->(x,fromJust y)) (filter (isJust . snd) (listItems i))
+	
+listCarriedItemsU :: Inventory -> [(Position,ItemType)]	
+listCarriedItemsU i = nubBy (\x y -> (snd x)==(snd y)) (map (\(x,y)->(x,fromJust y)) (filter (isJust . snd) (listItems i)))
+
+	
+getCarriedItem :: Inventory -> Position ->  Either InventoryError (Maybe ItemType)
+getCarriedItem (Inventory {invItems=m,invBagCapacity=sz}) pos=do
+	p2<- checkPos sz pos 
+	return (M.lookup p2 m)
+	
+listActiveItems :: Inventory -> [ItemType]
+listActiveItems i= (map snd (filter (isActive . fst) (listCarriedItems i)))
+	
+isActive :: Position -> Bool
+isActive (Bag {})=False
+isActive _ =True
+	
+listAllowedPositions :: Inventory -> ItemType -> [(Position,Maybe ItemType)]
+listAllowedPositions i it=filter ((positionAllowed it) . fst) (listItems i)
+	
+positionAllowed :: ItemType -> Position -> Bool
+-- everything can go in the bag
+positionAllowed _ (Bag {})=True
+positionAllowed (Weapon {}) RightHand=True
+positionAllowed (Weapon {}) LeftHand=True
+-- only armor on body
+positionAllowed (Armor {}) Body=True
+-- only helmer on head
+positionAllowed (Helmet {}) Head=True
+positionAllowed (Shield {}) RightHand=True
+positionAllowed (Shield {}) LeftHand=True
+positionAllowed _ Body=False
+positionAllowed _ Head=False
+positionAllowed _ RightHand=False
+positionAllowed _ LeftHand=False
diff --git a/src/MoresmauJP/Rpg/InventoryTests.hs b/src/MoresmauJP/Rpg/InventoryTests.hs
new file mode 100644
--- /dev/null
+++ b/src/MoresmauJP/Rpg/InventoryTests.hs
@@ -0,0 +1,81 @@
+-- | Inventory management hunit tests
+-- (c) JP Moresmau 2009
+module MoresmauJP.Rpg.InventoryTests where
+
+import Data.Maybe
+
+import MoresmauJP.Rpg.CharacterTests
+import MoresmauJP.Rpg.Inventory
+import MoresmauJP.Rpg.Items
+
+import Test.HUnit
+
+inventoryTests = TestList [
+		testInventory,testInventory2Hands,testMakeFullInventory]
+		
+
+testInventory = TestLabel "Test Inventory" (TestCase (do
+	let i1=mkEmptyInventory
+	let Right(i2,item1)=dropItem i1 RightHand
+	assertBool "item from empty inventory is not Nothing" (isNothing item1)
+	let (Left (InvalidBagPosition 10))=dropItem i2 (Bag 10)
+	let sw=sword
+	let Right(i3,item2)=takeItem i2 sw RightHand
+	assertBool "item from empty inventory is not Nothing" (null item2)
+	let items=listItems i3
+	assertEqual "Full list is not 14" 14 (length items)
+	assertEqual "Head of items is not right hand and sword" (RightHand,Just sw) (head items)
+	assertEqual "2nd Head of items is not left hand and empty" (LeftHand,Nothing) (head $ tail items)
+	let Right(_,item3)=dropItem i3 RightHand
+	assertBool "item from inventory is not Just" (isJust item3)
+	assertEqual "item dropped is not sword" (Just sw) (item3) 
+	))
+	
+testInventory2Hands=TestLabel "Test Inventory 2 hands" (TestCase (do
+		let i1=mkEmptyInventory
+		let sw=twoHandedWord
+		let Right(i2,item1)=takeItem i1 sw RightHand
+		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 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
+		assertBool "carrying something" (null (listCarriedItems i3))
+		assertBool "didn't drop something" (isJust item2)
+		assertEqual "didn't drop sword" sw (fromJust item2)
+		let Right(i4,item3)=takeItem i3 sw (Bag 1)
+		assertEqual "not carrying 1 item" 1 (length (listCarriedItems i4))
+		assertBool "dropped something" (null item3)
+		let Right(i5,item4)=dropItem i4 (Bag 1)
+		assertBool "carrying something" (null (listCarriedItems i5))
+		assertBool "didn't drop something" (isJust item4)
+		assertEqual "didn't drop sword" sw (fromJust item4)
+		let Right(i6,_)=takeItem i5 sw RightHand
+		let sw2=battleaxe
+		let Right(i7,item6)=takeItem i6 sw2 RightHand
+		assertEqual "dropped one item" 0 (length item6)
+		assertEqual "not carrying 2 things (including an axe occupying 2 hands)" 3 (length (listCarriedItems i7))
+		let (Right mi)=getCarriedItem i7 (Bag 1)
+		assertBool "nothing in bag 1" (isJust mi)
+		assertEqual "no sword in bag 1" sw (fromJust mi)
+		let (Right mi2)=getCarriedItem i7 (Bag 2)
+		assertBool "something in bag 2" (not $ isJust mi2)
+		
+	))	
+	
+testMakeFullInventory= TestLabel "Test makeFullInventory" (TestCase (do
+	let pos1=[(RightHand,sword),(Body,leatherArmor),(Bag 1,minorHealingPotion)]
+	let i1=makeFullInventory pos1 1 0
+	assertEqual "not carrying 3" 3 (length $ listCarriedItems i1)
+	assertEqual "not carrying sword in right hand" (Right $ Just sword) (getCarriedItem i1 RightHand)
+	assertEqual "not carrying leatherarmor on body" (Right $ Just leatherArmor) (getCarriedItem i1 Body)
+	assertEqual "not carrying minor healing potion on bag 1" (Right $ Just minorHealingPotion) (getCarriedItem i1 (Bag 1))
+	let pos2=[(RightHand,twoHandedWord),(LeftHand,sword),(Body,leatherArmor)]
+	let i2=makeFullInventory pos2 0 0
+	assertEqual "not carrying 3" 3 (length $ listCarriedItems i2)
+	assertEqual "not carrying 2hand sword in right hand" (Right $ Just twoHandedWord) (getCarriedItem i2 RightHand)
+	assertEqual "not carrying 2hand sword in left hand" (Right $ Just twoHandedWord) (getCarriedItem i2 LeftHand)
+	assertEqual "not carrying leatherarmor on body" (Right $ Just leatherArmor) (getCarriedItem i2 Body)
+	))
+			
diff --git a/src/MoresmauJP/Rpg/Items.hs b/src/MoresmauJP/Rpg/Items.hs
new file mode 100644
--- /dev/null
+++ b/src/MoresmauJP/Rpg/Items.hs
@@ -0,0 +1,89 @@
+-- | Items that can be found in the mazes
+-- (c) JP Moresmau 2009
+module MoresmauJP.Rpg.Items where
+
+import MoresmauJP.Rpg.Actions
+import MoresmauJP.Rpg.Character
+import MoresmauJP.Rpg.Inventory
+import MoresmauJP.Rpg.Magic
+import MoresmauJP.Util.Random
+
+
+import Text.Printf
+
+sword::ItemType		
+sword=Weapon "Sword" 2 6 1 10
+twoHandedWord=Weapon "2 Handed Sword" 4 12 2 20
+dagger=Weapon "Dagger" 1 4 1 5
+hatchet=Weapon "Hatchet" 1 6 1 8
+battleaxe=Weapon "Battle Axe" 3 10 2 15
+club=Weapon "Club" 1 4 1 2
+bigclub=Weapon "Massive Club" 3 10 2 4
+smallShield=Shield "Small shield" 1 4 8
+bigShield=Shield "Big shield" 3 7 12
+leatherArmor=Armor "Leather armor" 2 6 15
+chainMail=Armor "Chain mail armor" 4 10 25
+fullPlate=Armor "Full plate armor" 5 12 40
+leathercap=Helmet "Leather cap" 1 3 5
+helmet=Helmet "Helmet" 2 7 10
+heaume=Helmet "Full Heaume" 4 10 18
+
+minorHealingPotion=Potion "Minor Healing Potion" (HealingPotion 3) 12
+mediumHealingPotion=Potion "Medium Healing Potion" (HealingPotion 6) 20
+majorHealingPotion=Potion "Major Healing Potion" (HealingPotion 9) 30
+totalHealingPotion=Potion "Total Healing Potion" (HealingPotion 1000) 60
+
+-- occurences of items in the maze
+itemOccurences:: [(ItemType,Int)]
+itemOccurences=	[(sword,12),
+		(twoHandedWord,5),
+		(dagger,8),
+		(hatchet,12),
+		(battleaxe,5),
+		(smallShield,10),
+		(bigShield,5),
+		(leatherArmor,8),
+		(chainMail,4),
+		(fullPlate,2),
+		(leathercap,8),
+		(helmet, 5),
+		(heaume, 2),
+		(minorHealingPotion,8),
+		(mediumHealingPotion,5),
+		(majorHealingPotion,2),
+		(totalHealingPotion,1),
+		(Scroll "" "" 40,8)
+	]
+	
+isWeapon :: ItemType -> Bool
+isWeapon (Weapon {})=True
+isWeapon _ =False
+
+isProtective :: ItemType -> Bool
+isProtective (Armor {})=True
+isProtective (Shield {})=True
+isProtective (Helmet {})=True
+isProtective _ =False
+
+	
+canUseItem :: ItemType -> Bool
+canUseItem (Potion {})=True
+canUseItem (Scroll {})=True
+canUseItem _=False
+	
+useItemEffect :: (Monad m)=>ItemType -> Character -> RandT m (Maybe (String,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))
+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))
+		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))
+useItemEffect _ _=return Nothing
diff --git a/src/MoresmauJP/Rpg/ItemsTests.hs b/src/MoresmauJP/Rpg/ItemsTests.hs
new file mode 100644
--- /dev/null
+++ b/src/MoresmauJP/Rpg/ItemsTests.hs
@@ -0,0 +1,73 @@
+-- | Items hunit tests
+-- (c) JP Moresmau 2009
+module MoresmauJP.Rpg.ItemsTests where
+
+import Data.Maybe
+
+import MoresmauJP.Rpg.Character
+import MoresmauJP.Rpg.CharacterTests
+import MoresmauJP.Rpg.Inventory
+import MoresmauJP.Rpg.Items
+
+import MoresmauJP.Util.Random
+
+import Test.HUnit
+
+itemTests=TestList [testUsePotion,testUseWeapon,testUseScrollSuccess,testUseScrollFailure,testUseScrollFumble]	
+
+testUsePotion = TestLabel "Test Use Potion" (TestCase (do
+	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])
+	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])
+	assertEqual "Physical must be 10 after potion" 10 (getCharacteristic' jp4 Current Physical)
+	assertBool "not remove2" remove2
+	)) 
+
+testUseWeapon = TestLabel "Test Use Weapon" (TestCase (do
+	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])
+	assertBool "result is not Nothing" (isNothing r)
+	)) 
+	
+testUseScrollSuccess = TestLabel "Test Use Scroll Success" (TestCase (do
+	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])
+	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])
+	assertBool "remove2" (not remove2)
+	assertEqual "not already message" "You already know that spell" s
+	assertEqual "spells2 must be one" 1 (length $ spells jp3)
+	assertEqual "spell is not Nimble Fingers" "Nimble Fingers" (spellName $ head $ spells jp3)
+	))
+	
+testUseScrollFailure = TestLabel "Test Use Scroll Failure" (TestCase (do
+	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])
+	assertBool "not remove1" remove1
+	assertEqual "not success message" "You fail to learn that spell" s
+	assertEqual "spells2 must be empty" 0 (length $ spells jp2)
+	))
+	
+testUseScrollFumble = TestLabel "Test Use Scroll Failure" (TestCase (do
+	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])
+	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)
+	assertEqual "Mental must be 9" 9 (getCharacteristic' jp2 Current Mental)
+	))	
diff --git a/src/MoresmauJP/Rpg/Magic.hs b/src/MoresmauJP/Rpg/Magic.hs
new file mode 100644
--- /dev/null
+++ b/src/MoresmauJP/Rpg/Magic.hs
@@ -0,0 +1,87 @@
+-- | Magic spells casting resolution
+-- (c) JP Moresmau 2009
+module MoresmauJP.Rpg.Magic where
+
+import MoresmauJP.Rpg.Actions
+import MoresmauJP.Rpg.Character
+
+import MoresmauJP.Util.Random
+
+import Text.Printf
+	
+type MagicStatus a= ((a,a),Bool,[Message])
+	
+allSpells :: [Spell]
+allSpells= [
+	Spell "Feel Better" Physical Recovery Permanent
+	,Spell "Fire Ball" Physical Negative Permanent
+	,Spell "Nimble Fingers" Dexterity Positive Temporary
+	,Spell "Greasy Fingers" Dexterity Negative Temporary 
+	,Spell "Madness" Mental Negative Permanent
+	,Spell "Sanity" Mental Recovery Permanent
+	,Spell "Focus... Focus... Focus..." Willpower Positive Temporary
+	,Spell "Think! Think! Think!" Intelligence Positive Temporary
+	,Spell "Doh!" Intelligence Negative Temporary
+	,Spell "Ox Strength" Strength Positive Temporary
+	,Spell "Troll Face" Charisma Negative Temporary
+	]
+	
+spellToAffect :: Spell -> RollResult -> Int -> Affect
+spellToAffect spell rr tc=Affect (impactedChar spell)
+	(diff rr)
+	(tc + (((diff rr)+1) ^ 2))
+	(spellName spell)
+	(printf "Under the influence of %s" (spellName spell))
+	(printf "Spell %s is lifting" (spellName spell))
+
+spellsToMyself :: Character -> [Spell]
+spellsToMyself c=removedAlreadyAffecting c $ filter ((Negative /=) . impact) (spells c)
+
+spellsToOpponent :: Character -> Character -> [Spell]
+spellsToOpponent c opponent=removedAlreadyAffecting opponent $ filter ((Negative ==) . impact) (spells c)
+
+removedAlreadyAffecting :: Character -> [Spell] -> [Spell]
+removedAlreadyAffecting c spells=let
+	affectSources=map source (affects c)
+	in filter (\x-> notElem (spellName x) affectSources) spells
+
+spellToMyself ::  (MonadRandom m) => Character -> Spell -> Int ->  m (Character,Message)
+spellToMyself c s tc=do
+	(c2,rr)<-action c spellcasting (toIntLevel Neutral)
+	return $ 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 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))
+	
+spellToOpponent ::(MonadRandom 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
+	
+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 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) ])
+		
+-- complexity
+-- danger
+-- curse: add difficulty to all actions
+-- need a time counter to evaluate when spell is finished
+
+newtype Message=Message (Character,Spell,MessageType)
+
+data MessageType=Fumble | Fail |Myself | Opponent
+
+instance Show Message where
+	showsPrec _ (Message (_,s,Fumble))=showString $printf "The spell %s backfires on you" (spellName s) 
+	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)
diff --git a/src/MoresmauJP/Rpg/MagicTests.hs b/src/MoresmauJP/Rpg/MagicTests.hs
new file mode 100644
--- /dev/null
+++ b/src/MoresmauJP/Rpg/MagicTests.hs
@@ -0,0 +1,62 @@
+-- | Magic hunit tests
+-- (c) JP Moresmau 2009
+module MoresmauJP.Rpg.MagicTests where
+
+import MoresmauJP.Rpg.Character
+import MoresmauJP.Rpg.CharacterTests
+import MoresmauJP.Rpg.Magic
+
+import MoresmauJP.Util.Random
+
+import Test.HUnit
+
+magicTests=TestList [testSpellsToMyself,testSpellToOpponentSuccess,testSpellToOpponentFailure,testSpellToOpponentFumble]
+
+testSpellsToMyself= TestLabel "Test spells to myself" (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)
+	assertEqual "dex is not 11" 11 (getCharacteristic' jp2 Current Dexterity) 
+	let spellsToMe2=spellsToMyself jp2
+	assertEqual "not zero spell2" 0 (length spellsToMe2)
+	let (jp3,_)=expireAffects jp2 4
+	let spellsToMe3=spellsToMyself jp3
+	assertEqual "not zero spell3" 0 (length spellsToMe3)
+	let (jp4,_)=expireAffects jp2 5
+	let spellsToMe4=spellsToMyself jp4
+	assertEqual "not one spell4" 1 (length spellsToMe4)
+	))
+	
+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])
+	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)
+	))
+	
+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])
+	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 fails" (show $ head msgs)
+	))	
+	
+testSpellToOpponentFumble= TestLabel "Test spells to opponent fumble" (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])
+	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 "Mental must be 9" 9 (getCharacteristic' jp1 Current Mental)
+	))	
diff --git a/src/MoresmauJP/Rpg/MazeObjects.hs b/src/MoresmauJP/Rpg/MazeObjects.hs
new file mode 100644
--- /dev/null
+++ b/src/MoresmauJP/Rpg/MazeObjects.hs
@@ -0,0 +1,114 @@
+-- | Handling of items in the maze
+-- (c) JP Moresmau 2009
+module MoresmauJP.Rpg.MazeObjects where
+
+import Control.Monad
+
+import Data.List
+import Data.Maybe
+import qualified Data.Map as M
+import MoresmauJP.Maze1.Maze
+import MoresmauJP.Rpg.Character
+import MoresmauJP.Rpg.Inventory hiding (dropItem)
+import MoresmauJP.Rpg.Items
+import MoresmauJP.Rpg.Magic
+import MoresmauJP.Rpg.NPC
+import MoresmauJP.Util.Lists
+import MoresmauJP.Util.Random
+
+import Text.Printf
+
+data MazeObjects= MazeObjects {
+	items::(M.Map Cell [ItemType]),
+	npcs::(M.Map Cell NPCCharacter)
+	}
+	deriving (Read,Show,Eq)
+
+data MazeOptions = MazeOptions {
+		itemProportion::Int,
+		npcProportion::Int
+	}
+	deriving (Read,Show)
+
+generateObjects :: (Monad m)=>Maze -> MazeOptions -> Int -> RandT m MazeObjects
+generateObjects mz options characterLevel =do
+	let ratio=((fromIntegral characterLevel/10.0) ** 2)::Float
+	-- less items as we progress
+	let realItemProportion=(fromIntegral $ itemProportion options) / ratio
+	itemMap<-generateItems (size mz) realItemProportion
+	npcMap<-generateNPCs mz (fromIntegral $ npcProportion options) characterLevel
+	return (MazeObjects itemMap npcMap)
+	
+generateItems :: (Monad m)=>Size -> Float -> RandT m (M.Map Cell [ItemType])
+generateItems sz proportion=do
+	cellsWithItems<-getCellWithItems sz proportion
+	let occ=occurenceList itemOccurences
+	--print occ
+	foldM (\m cell -> do
+		it <- generateScroll =<< randomPickp occ
+		let m2=case M.lookup cell m of
+			Nothing->M.insert cell [it] m
+			Just its->M.insert cell (it:its) m
+		return m2) M.empty cellsWithItems
+		
+generateScroll :: (Monad m) => ItemType -> RandT m (ItemType)
+generateScroll (Scroll "" "" g)=do
+	s<-randomPickp allSpells
+	return (Scroll (printf "Scroll of %s" (spellName s)) (spellName s) g)
+generateScroll it=return it
+
+generateNPCs :: (Monad m)=> Maze -> Float -> Int -> RandT m (M.Map Cell NPCCharacter)
+generateNPCs mz proportion characterLevel=do
+	cellsWithItems<-(getCellWithItems (size mz) proportion) 
+	let cells2=delete (start mz) cellsWithItems
+	let occ=occurenceList (getNPCOccurences characterLevel)
+	--print occ
+	foldM (\m cell -> do
+		t <- randomPickp occ
+		case M.lookup cell m of
+			Nothing->do
+				c<-generateFromTemplate t
+				return (M.insert cell c m)
+			Just _->return m
+		) M.empty cells2
+	
+--getCellWithItems ::Size -> Float -> Rand [Cell]
+getCellWithItems (w,h) proportion=do
+	let nb=round (fromIntegral (h*w)/proportion)
+	replicateM nb (getCellWithItems' (w,h))
+	
+--getCellWithItems' :: Size -> Rand Cell
+getCellWithItems' (w,h) =do
+		cellx<-getRandomRange (1,w)
+		celly<-getRandomRange (1,h)
+		return (cellx,celly)
+		
+listItems :: GameWorld -> MazeObjects -> [ItemType]
+listItems gw mo =fromMaybe [] $ M.lookup (position gw) (items mo)
+
+takeItem :: GameWorld -> MazeObjects -> ItemType -> MazeObjects
+takeItem gw mo it= 
+	let its=fromJust $ M.lookup (position gw) (items mo)
+	in mo{items=(M.insert (position gw) (delete it its) (items mo))}
+
+dropItem :: GameWorld -> MazeObjects -> ItemType -> MazeObjects
+dropItem gw mo it= 
+	let its=case M.lookup (position gw) (items mo) of 
+		Just its-> its
+		Nothing->[]
+	in mo{items= (M.insert (position gw) (it:its) (items mo))}
+	
+getNPC:: GameWorld -> MazeObjects -> Maybe NPCCharacter
+getNPC gw mo = M.lookup (position gw) (npcs mo)
+	
+killNPC :: GameWorld -> MazeObjects -> Character -> (MazeObjects,Character,Gold)
+killNPC gw mo c@(Character {inventory=inv})= let
+	killed=fromJust $ M.lookup (position gw) (npcs mo)
+	killedItems=map snd (listCarriedItems $ inventory $ npcCharacter killed)
+	mo2=foldl (\mazeobj item->dropItem gw mazeobj item) mo killedItems
+	extraGold=getGold $ inventory $ npcCharacter killed
+	c2=c{inventory=addGold inv extraGold}
+ 	in (mo2{npcs= (M.delete (position gw) (npcs mo2))},c2,extraGold)	
+
+updateNPC :: GameWorld -> MazeObjects -> NPCCharacter -> MazeObjects
+updateNPC gw mo npc= mo{npcs= (M.insert (position gw) npc (npcs mo))}
diff --git a/src/MoresmauJP/Rpg/MazeObjectsTests.hs b/src/MoresmauJP/Rpg/MazeObjectsTests.hs
new file mode 100644
--- /dev/null
+++ b/src/MoresmauJP/Rpg/MazeObjectsTests.hs
@@ -0,0 +1,18 @@
+-- | Items and Mazes hunit tests
+-- (c) JP Moresmau 2009
+module MoresmauJP.Rpg.MazeObjectsTests where
+
+import MoresmauJP.Rpg.Inventory
+import MoresmauJP.Rpg.MazeObjects
+
+import MoresmauJP.Util.Random
+
+import Test.HUnit
+
+mazeObjectsTests=TestList [testScrollFill]
+
+testScrollFill= TestLabel "Test filling scroll" (TestCase (do
+	let sc=Scroll "" "" 5
+	sc2<-evalRandT (generateScroll sc) (mkTestWrapper [2])
+	assertEqual "not proper scroll" (Scroll "Scroll of Feel Better" "Feel Better" 5) sc2
+	))
diff --git a/src/MoresmauJP/Rpg/NPC.hs b/src/MoresmauJP/Rpg/NPC.hs
new file mode 100644
--- /dev/null
+++ b/src/MoresmauJP/Rpg/NPC.hs
@@ -0,0 +1,383 @@
+-- | NPC template definitions and character creation
+-- (c) JP Moresmau 2009
+module MoresmauJP.Rpg.NPC where
+
+import Data.Array.IArray
+import Data.Maybe
+import Data.List
+import MoresmauJP.Rpg.Actions
+import MoresmauJP.Rpg.Inventory
+import MoresmauJP.Rpg.Items
+import MoresmauJP.Rpg.Character
+import MoresmauJP.Util.Lists
+import MoresmauJP.Util.Numbers
+import MoresmauJP.Util.Random
+
+troll=NPCTemplate {
+	typeName="Troll",
+	creatureType=Humanoid,
+	attitudeRange=(3,8),
+	traitRanges=[
+		(Strength,(18,24)),
+		(Dexterity,(7,11)),
+		(Constitution,(16,26)),
+		(Willpower,(10,12)),
+		(Intelligence,(4,8)),
+		(Balance,(4,8)),
+		(Charisma,(3,5)),
+		(Perception,(4,8))],
+	possibleItems=[
+		(RightHand,[
+			(Nothing,3),
+			(Just club,2),
+			(Just bigclub,3)]
+			)],
+	possibleGold=(0,10)		
+	}
+
+goblin=NPCTemplate {
+	typeName="Goblin",
+	creatureType=Humanoid,
+	attitudeRange=(5,10),
+	traitRanges=[
+		(Strength,(5,11)),
+		(Dexterity,(8,11)),
+		(Constitution,(7,12)),
+		(Willpower,(5,8)),
+		(Intelligence,(6,10)),
+		(Balance,(4,8)),
+		(Charisma,(3,7)),
+		(Perception,(4,8))],
+	possibleItems=[
+		(RightHand,[
+			(Just sword,2),
+			(Just dagger,2),
+			(Just hatchet,1)]
+			),
+		(LeftHand, [
+			(Nothing,2),
+			(Just smallShield,1)]
+			),
+		(Body, [
+			(Nothing,3),
+			(Just leatherArmor,1)
+			]
+			)
+		],
+	possibleGold=(0,30)	
+	}
+
+kobold=NPCTemplate {
+	typeName="Kobold",
+	creatureType=Humanoid,
+	attitudeRange=(5,12),
+	traitRanges=[
+		(Strength,(4,8)),
+		(Dexterity,(8,11)),
+		(Constitution,(4,10)),
+		(Willpower,(5,8)),
+		(Intelligence,(7,12)),
+		(Balance,(6,12)),
+		(Charisma,(5,9)),
+		(Perception,(8,12))],
+	possibleItems=[
+		(RightHand,[
+			(Just sword,1),
+			(Just dagger,3),
+			(Just hatchet,1)]
+			)], 
+	possibleGold=(0,7)		
+	}
+
+
+
+giantRat=NPCTemplate {
+	typeName="Giant Rat",
+	creatureType=Animal,
+	attitudeRange=(5,10),
+	traitRanges=[
+		(Strength,(3,6)),
+		(Dexterity,(4,8)),
+		(Constitution,(3,7)),
+		(Willpower,(2,4)),
+		(Intelligence,(2,3)),
+		(Balance,(5,10)),
+		(Charisma,(1,2)),
+		(Perception,(4,8))],
+	possibleItems=[],
+	possibleGold=(0,0)	
+	}
+
+snake=NPCTemplate {
+	typeName="Snake",
+	creatureType=Animal,
+	attitudeRange=(5,10),
+	traitRanges=[
+		(Strength,(3,6)),
+		(Dexterity,(12,16)),
+		(Constitution,(5,10)),
+		(Willpower,(6,10)),
+		(Intelligence,(2,4)),
+		(Balance,(5,10)),
+		(Charisma,(1,2)),
+		(Perception,(8,10))],
+	possibleItems=[],
+	possibleGold=(0,0)	
+	}	
+	
+vampire=NPCTemplate {
+	typeName="Vampire",
+	creatureType=Humanoid,
+	attitudeRange=(3,8),	
+	traitRanges=[
+		(Strength,(12,18)),
+		(Dexterity,(10,14)),
+		(Constitution,(16,24)),
+		(Willpower,(14,22)),
+		(Intelligence,(14,20)),
+		(Balance,(8,14)),
+		(Charisma,(10,15)),
+		(Perception,(6,10))],
+	possibleItems=[],
+	possibleGold=(10,60)	
+	}
+	
+ghoul=NPCTemplate {
+	typeName="Ghoul",
+	creatureType=Humanoid,
+	attitudeRange=(1,6),	
+	traitRanges=[
+		(Strength,(8,14)),
+		(Dexterity,(8,12)),
+		(Constitution,(10,14)),
+		(Willpower,(10,14)),
+		(Intelligence,(6,10)),
+		(Balance,(6,10)),
+		(Charisma,(4,8)),
+		(Perception,(3,7))],
+	possibleItems=[],
+	possibleGold=(0,20)	
+	}
+
+outlaw=NPCTemplate {
+	typeName="Outlaw",
+	creatureType=Human,
+	attitudeRange=(8,12),	
+	traitRanges=[
+		(Strength,(8,14)),
+		(Dexterity,(8,14)),
+		(Constitution,(8,12)),
+		(Willpower,(5,8)),
+		(Intelligence,(6,10)),
+		(Balance,(8,12)),
+		(Charisma,(6,10)),
+		(Perception,(10,15))],
+	possibleItems=[(RightHand,[
+			(Just sword,2),
+			(Just hatchet,1)]
+			),
+		(LeftHand, [
+			(Nothing,2),
+			(Just smallShield,1),
+			(Just dagger,2)
+			]
+			),
+		(Body, [
+			(Nothing,3),
+			(Just leatherArmor,1)
+			]
+			),
+		(Head,[
+			(Nothing, 3),
+			(Just leathercap,1),
+			(Just helmet,1)
+			])],
+		possibleGold=(0,50)		
+	}
+
+blackKnight=NPCTemplate {
+	typeName="Black Knight",
+	creatureType=Human,
+	attitudeRange=(5,10),	
+	traitRanges=[
+		(Strength,(12,18)),
+		(Dexterity,(12,18)),
+		(Constitution,(12,18)),
+		(Willpower,(10,15)),
+		(Intelligence,(6,12)),
+		(Balance,(8,12)),
+		(Charisma,(8,14)),
+		(Perception,(8,14))],
+	possibleItems=[(RightHand,[
+			(Just sword,2),
+			(Just twoHandedWord,1),
+			(Just battleaxe,1)]
+			),
+		(LeftHand, [
+			(Nothing,2),
+			(Just smallShield,2),
+			(Just bigShield,1)
+			]
+			),
+		(Body, [
+			(Just leatherArmor,3),
+			(Just chainMail,2),
+			(Just fullPlate,1)
+			]
+			),
+		(Head,[
+			(Nothing, 3),
+			(Just helmet,2),
+			(Just heaume,1)
+			])],
+	possibleGold=(10,30)	
+	}
+
+minotaur=NPCTemplate {
+	typeName="Minotaur",
+	creatureType=Animal,
+	attitudeRange=(2,5),	
+	traitRanges=[
+		(Strength,(14,20)),
+		(Dexterity,(10,16)),
+		(Constitution,(14,22)),
+		(Willpower,(10,16)),
+		(Intelligence,(6,10)),
+		(Balance,(10,14)),
+		(Charisma,(4,8)),
+		(Perception,(5,10))],
+	possibleItems=[],
+	possibleGold=(0,0)
+	}
+
+peddler=NPCTemplate {
+	typeName="Peddler",
+	creatureType=Human,
+	attitudeRange=(20,20),
+	traitRanges=[
+		(Strength,(6,12)),
+		(Dexterity,(8,13)),
+		(Constitution,(8,14)),
+		(Willpower,(5,12)),
+		(Intelligence,(8,14)),
+		(Balance,(6,12)),
+		(Charisma,(10,14)),
+		(Perception,(8,12))],
+	possibleItems=[
+		(RightHand,[
+			(Nothing,3),
+			(Just dagger,2),
+			(Just sword,3)]
+			),
+		(Body, [
+			(Nothing,3),
+			(Just leatherArmor,1)
+			]
+			)],
+	possibleGold=(100,200)		
+	}
+
+
+allNPCTemplates :: [NPCTemplate]
+allNPCTemplates= [troll,goblin,kobold,giantRat,snake,vampire,ghoul,outlaw,blackKnight,minotaur,peddler]
+
+getNPCOccurences :: Int -> [(NPCTemplate,Int)]
+getNPCOccurences characterLevel=
+	let 
+		totalTemplates=length allNPCTemplates
+		ponderedLevel=div (characterLevel * 8) 10
+		likelyhood npc=(npc,totalTemplates - (abs ((templateLevel npc) - ponderedLevel)))
+	in map likelyhood allNPCTemplates
+		
+templateLevel :: NPCTemplate -> Int
+templateLevel t=avg $ map (\(_,(low,high))-> div (low+high) 2) (traitRanges t)
+		
+type CharacteristicRanges=Array Characteristic (Int,Int)
+
+data NPCTemplate = NPCTemplate {
+	typeName::Name,
+	creatureType::NPCType,
+	attitudeRange::(Int,Int),
+	traitRanges::[(Characteristic,(Int,Int))],
+	possibleItems::[(Position,[(Maybe ItemType,Int)])],
+	possibleGold::(Gold,Gold)
+	} deriving (Show,Read,Eq)
+
+data NPCCharacter = NPCCharacter {
+	npcCharacter::Character,
+	npcType::NPCType,
+	npcAttitude::Int
+	}deriving (Show,Read,Eq)
+
+data NPCType=Animal | Humanoid | Human
+	deriving (Show,Read,Eq,Ord,Enum,Bounded)
+
+{--data AttitudeLevel=Rather | Quite | Very
+	deriving (Show,Read,Eq,Ord,Enum,Bounded)
+
+data Attitude=Friendly | Neutral | Aggressive | Hostile
+	deriving (Show,Read,Eq,Ord,Enum,Bounded)
+
+allAttitudeLevels=[(x,y) | y<-[Friendly .. Hostile], x<-[Rather .. Very]]
+--}
+
+data InteractionFromNPC=NPCFight | NPCTrade | NPCWait
+	deriving (Show,Read,Eq,Enum,Bounded)
+
+getInitialAttitude :: (Monad m)=> NPCCharacter -> RandT m (InteractionFromNPC)
+getInitialAttitude NPCCharacter{npcAttitude=att}=do
+	r <- (roll d20)
+	let (rr,_)=evalResult r att
+	return (case rr of
+		Failure {}	-> NPCFight
+		Success	{}	-> NPCWait)
+
+data InteractionToNPC=Ignore | Fight | Trade | Convert | Steal 
+	deriving (Show,Read,Eq,Enum,Bounded)
+
+possibleNPCInteractions :: NPCCharacter -> [InteractionToNPC]
+possibleNPCInteractions NPCCharacter{npcType=tp}=case tp of 
+	Animal 		-> [Ignore .. Fight]
+	Humanoid 	-> [Ignore .. Trade]
+	Human 		-> [Ignore .. Steal]
+
+maxPosBag :: NPCTemplate -> Int
+maxPosBag nt=case creatureType nt of
+	Animal 		-> 0
+	Humanoid 	-> 0
+	Human 		-> 10
+
+generateFromTemplate :: (Monad m)=> NPCTemplate -> RandT m (NPCCharacter)
+generateFromTemplate template=do
+	let name=typeName template
+	-- get gender
+	rnd <- getRandomRange (1,2)
+	let gender= if rnd==1
+		then Male
+		else Female
+	-- generate ratings
+	ranges<-mapM generateFromRange (sortBy (\x y-> compare (fst x) (fst y)) (traitRanges template))
+	-- fill ratings with health
+	let traits=getDefaultHealth $ array (head allCharacteristics,last allCharacteristics) ranges
+	-- get item or Nothing for each position
+	inv<-mapM (\(pos,items)->do
+		it<-randomPickp (occurenceList items)
+		return (pos,it)) (possibleItems template)
+	-- only keep items, filter out Nothings
+	let inv2=map (\(x,y)->(x,fromJust y)) (filter (isJust . snd) inv)
+	gold<-getRandomRange $ possibleGold template
+	attitudeLevel<-getRandomRange $ attitudeRange template
+	let maxPos=maxPosBag template
+	return (NPCCharacter (Character {
+		name=name,
+		gender=gender,
+		traits=traits,
+		inventory=makeFullInventory inv2 maxPos gold,
+		affects=[],
+		spells=[]
+	}) (creatureType template) attitudeLevel)
+	
+generateFromRange :: (Monad m)=>(Characteristic,(Int,Int))->RandT m (Characteristic,Rating)
+generateFromRange (c,(low,high))=do 
+	rnd<-getRandomRange (low,high)
+	return (c,mkRating rnd)
diff --git a/src/MoresmauJP/Rpg/NPCTests.hs b/src/MoresmauJP/Rpg/NPCTests.hs
new file mode 100644
--- /dev/null
+++ b/src/MoresmauJP/Rpg/NPCTests.hs
@@ -0,0 +1,70 @@
+-- | NPC templates hunit tests
+-- (c) JP Moresmau 2009
+module MoresmauJP.Rpg.NPCTests where
+
+import Data.List
+import Control.Monad
+
+import MoresmauJP.Rpg.Character
+import MoresmauJP.Rpg.CharacterTests
+import MoresmauJP.Rpg.Inventory
+import MoresmauJP.Rpg.NPC
+import MoresmauJP.Util.Random
+
+import Test.HUnit
+
+import System.Random
+
+npcTests = TestList [testNPCTemplate,testNPCOccurences]
+
+createTestNPC :: String -> NPCCharacter
+createTestNPC name=NPCCharacter (createTestChar name) Human 10
+
+
+testNPCTemplate=TestLabel "Test NPC Template" (TestCase (do
+	mapM_ (\template-> do
+		replicateM_ 5 (
+			do
+				sg<-getStdGen
+				NPCCharacter{npcCharacter=t}<-evalRandT (generateFromTemplate template) (ProductionRandom sg)
+				mapM_ (testNPCTraits t) (traitRanges template)
+				mapM_ (testNPCInventory t) (possibleItems template)
+			)
+		) allNPCTemplates))
+	
+testNPCTraits :: Character -> (Characteristic,(Int,Int)) -> IO()
+testNPCTraits c (char,(low,high)) = do
+	let v=getCharacteristic' c Current char
+	assertBool "Value not within range" (v>=low && v<=high)
+	
+
+testNPCInventory :: Character -> (Position,[(Maybe ItemType,Int)]) -> IO()
+testNPCInventory c (pos,items)= do
+	let item=getCarriedItem (inventory c) pos
+	assertBool ("Incorrect pos "++(show pos)) (case item of {Right _ -> True;_->False})
+	let item'=case item of {Right i -> i;_->error "no right"}
+	assertBool ("incorrect position for item "++(show item')++ " in pos "++ (show pos)) (case item' of
+		Nothing-> True
+		Just i -> positionAllowed i pos)
+	case (pos,item') of
+		(LeftHand,Just Weapon {hands=2})-> return ()
+		_ -> assertBool ("Item not from template: "++(name c)++":"++(show item')) (elem  item' (map fst items)) 
+	
+
+testNPCOccurences= TestLabel "Test NPCOccurences" (TestCase (do
+	let allTemplates=allNPCTemplates
+	mapM_ (\template -> do 
+			let level=templateLevel template
+			let levelUp=div (level * 10) 8
+			let levelDown=div (levelUp * 8) 10
+			if levelDown==level
+				then do
+					let occs=getNPCOccurences levelUp
+					let maxTemplate=maximumBy (\t1 t2->compare (snd t1) (snd t2)) occs
+					let allMax=filter (\t1->(snd maxTemplate)==( snd t1))occs
+					--mapM_  (\a->print ((show a)++(show $ templateLevel $ fst a))) allMax
+					assertBool ("template "++(typeName template)++ " is not maximum (level:"++(show level)) (elem (template) (map fst allMax))
+				else
+					return () 
+		) allTemplates
+	))	
diff --git a/src/MoresmauJP/Rpg/Profile.hs b/src/MoresmauJP/Rpg/Profile.hs
new file mode 100644
--- /dev/null
+++ b/src/MoresmauJP/Rpg/Profile.hs
@@ -0,0 +1,121 @@
+-- | Profiles and character creation
+-- (c) JP Moresmau 2009
+module MoresmauJP.Rpg.Profile where
+
+import Data.Array.IArray
+import Control.Monad
+import Data.List
+import Data.Maybe
+
+import MoresmauJP.Rpg.Character
+import MoresmauJP.Util.Lists  hiding ((//))
+import MoresmauJP.Util.Random
+
+
+profiles :: [Profile]
+profiles = [("Warrior",[VeryHigh Strength,High Dexterity, High Constitution])
+	,("Thief",[VeryHigh Dexterity,NotTooLow Intelligence,High Perception])
+	,("Merchant",[VeryHigh Charisma, High Intelligence, NotTooLow Willpower])
+	,("Wizard",[VeryHigh Intelligence, High Willpower, High Balance])
+	,("Priest",[High Charisma, VeryHigh Willpower, NotTooLow Balance])
+	,("Ranger",[VeryHigh Constitution, High Dexterity, VeryHigh Perception, NotTooLow Strength, NotTooLow Balance])
+	]
+
+profileNames :: [String]
+profileNames = map fst profiles
+
+type Profile = (String,[Criteria])
+
+profileByName :: String -> Maybe Profile
+profileByName s= listToMaybe (filter ((== s).fst) profiles)
+
+
+data Criteria = High { 
+		func::Characteristic
+	}
+	| VeryHigh  { 
+		func::Characteristic
+	}
+	| NotTooLow  { 
+		func::Characteristic
+	}
+
+generateTraits :: (Monad m)=>Profile -> RandT 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))
+	let (n,_)=firstProfileAndRatio mt1
+	if (fst p)==(fst n)
+		then
+			return mt1
+		else
+			generateTraits p
+	
+
+makeFit :: (Monad m)=>CharacteristicRatings-> Profile -> Int -> RandT 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 mt (n,cs) = do
+	let modifiableCs=filter ((isRatingBelowMax mt).func) cs
+	let vals=(map (\x -> (x,traitsScore mt x)) modifiableCs)
+	let allZeros=filter (\(_,f)->f==0) vals
+	rf<-if not (null allZeros) 
+		then
+			return (func $ fst $ (head allZeros))
+		else
+			do 
+				let (p,_)=firstProfileAndRatio mt
+				if (fst p)==n 
+					then
+						randomPickp (filter (isRatingBelowMax mt) allCharacteristics)
+					else
+						return (func $ fst $ minimumBy (\a b->compare (snd a) (snd b)) vals)
+	let mt1=addCharacteristic mt Current rf 1
+	return (addCharacteristic mt1 Normal rf 1 )	
+	
+isRatingBelowMax :: CharacteristicRatings -> Characteristic -> Bool
+isRatingBelowMax mt c=(getCharacteristic mt Current c)<17
+
+firstProfileAndRatio:: CharacteristicRatings -> (Profile,Float)
+firstProfileAndRatio mt=foldr1 maxRatio (allProfilesAndRatios mt)
+
+bestProfiles :: CharacteristicRatings -> [(Profile,Float)]
+bestProfiles mt= let
+	aboveAverage=filter (\(_,f)->f>=0.5) (allProfilesAndRatios mt)
+	in 
+		if null aboveAverage
+			then [firstProfileAndRatio mt]
+			else aboveAverage
+
+maxRatio :: (Profile,Float) -> (Profile,Float) -> (Profile,Float)
+maxRatio (p1,f1) (p2,f2)= if f1>f2
+	then (p1,f1)
+	else (p2,f2)
+
+allProfilesAndRatios:: CharacteristicRatings -> [(Profile,Float)]
+allProfilesAndRatios mt = map (\p@(_,cs)->(p,traitsScores mt cs)) profiles
+	
+traitsScores :: CharacteristicRatings -> [Criteria] -> Float
+traitsScores mt cs = combineScores $  map (traitsScore mt) cs
+	
+traitsScore :: CharacteristicRatings -> Criteria -> Float
+traitsScore mt c = ratingScore (getCharacteristic mt Current (func c)) c
+
+ratingScore :: Int -> Criteria -> Float
+ratingScore v (High _)
+	| v<10 = 0
+	| otherwise = sqrt ((fromIntegral (v-10)) / 10)
+ratingScore v (VeryHigh _)
+	| v<12 = 0
+	| otherwise = sqrt $ sqrt ((fromIntegral (v-12)) / 8)
+ratingScore v (NotTooLow _)
+	| v<8 = 0
+	| otherwise = ((fromIntegral (v-8)) / 12)
+	
+combineScores :: [Float] -> Float
+combineScores = minimum
+
diff --git a/src/MoresmauJP/Rpg/ProfileTests.hs b/src/MoresmauJP/Rpg/ProfileTests.hs
new file mode 100644
--- /dev/null
+++ b/src/MoresmauJP/Rpg/ProfileTests.hs
@@ -0,0 +1,31 @@
+-- | Profiles and character creation hunit tests
+-- (c) JP Moresmau 2009
+module MoresmauJP.Rpg.ProfileTests where
+
+import Data.Maybe
+
+import MoresmauJP.Rpg.Character
+import MoresmauJP.Rpg.CharacterTests
+import MoresmauJP.Rpg.Profile
+
+import MoresmauJP.Util.Random
+
+import Test.HUnit
+
+import System.Random
+
+
+
+profileTests=TestList (map (\p -> mkTest ("testCharacterRS" ++ (fst p)) (testCharacterRS (fst p)) ) profiles)
+
+mkTest s f = TestLabel s (TestCase f)
+
+testCharacterRS pName= do
+	sg<-getStdGen
+	mt<-evalRandT (generateTraits $ fromJust $ profileByName pName) (ProductionRandom sg)
+	let (p,_)=firstProfileAndRatio mt
+	assertEqual ("First Profile is "++(fst p)++" instead of "++pName) pName (fst p)
+	let c=Character "Test" Male (getDefaultHealth mt) mkEmptyInventory [] []
+	let s=show c
+	let c2=(read s)::Character
+	assertBool "Reading character from show did not give same" ((show c2)==s)
diff --git a/src/MoresmauJP/Rpg/RPG.hs b/src/MoresmauJP/Rpg/RPG.hs
new file mode 100644
--- /dev/null
+++ b/src/MoresmauJP/Rpg/RPG.hs
@@ -0,0 +1,512 @@
+-- | Handling of main actions (character management, game management, in game actions)
+-- (c) JP Moresmau 2009
+module MoresmauJP.Rpg.RPG where
+
+import Control.Monad.State
+
+import Data.Char
+import Data.List
+import Data.Maybe
+import qualified Data.Set as DataSet
+
+import MoresmauJP.Core.Screen
+import MoresmauJP.Maze1.Maze
+import qualified MoresmauJP.Maze1.MazeGame as MG
+
+import MoresmauJP.Rpg.Actions
+import MoresmauJP.Rpg.Arena
+import MoresmauJP.Rpg.Character
+import MoresmauJP.Rpg.Items
+import MoresmauJP.Rpg.NPC
+import MoresmauJP.Rpg.Profile
+import MoresmauJP.Rpg.TextOutput
+import MoresmauJP.Rpg.Inventory as Inv
+import MoresmauJP.Rpg.Magic
+import MoresmauJP.Rpg.MazeObjects as Objs
+import MoresmauJP.Rpg.Save
+import MoresmauJP.Util.Lists
+import MoresmauJP.Util.Random
+import System.Directory
+
+import Text.Printf
+
+type LocationCode=String
+
+initialGameStateInApp :: IO(GameState RPGState)
+initialGameStateInApp = do
+	dir<-getAppUserDataDirectory "RPG"
+	--createDirectoryIfMissing True dir
+	return $ initialGameState dir
+
+initialGameState :: FilePath -> GameState RPGState
+initialGameState fp=GameState (RPGState Nothing Nothing fp)  (Just initialScreen)
+
+initialScreen :: Screen RPGState 
+initialScreen = Screen [Action "games" "Games: new game, load , delete" games,
+	Action "characters" "Characters: new character, delete" chars
+	]
+	
+games:: ActionFunction RPGState 
+games _=do
+	sc <- gets (fromJust . screen)
+	a <- gets gsData 
+	put (GameState a (Just (getGameScreen sc)))
+	w2 <- help False []
+	return (combineWidget  (WText "Games") w2)
+	--combineActionAfter (WText "Games",) (help False) (Message [])
+	
+chars:: ActionFunction RPGState 
+chars _  = do
+	sc <- gets (fromJust . screen)
+	a <- gets gsData 
+	put (GameState a (Just (getCharacterScreen sc)))
+	w2 <- help False []
+	return (combineWidget  (WText "Characters") w2)
+
+--combineActionAfter (WText "Characters",(GameState a (Just (getCharacterScreen sc)))) (help False) (Message [])
+
+getCharacterScreen ::  Screen RPGState  -> Screen RPGState 
+getCharacterScreen sc= Screen [Action "new" "Create a new character" newCharacter,
+	Action "delete" "Delete an existing character" deleteCharacters,
+	Action "view" "View an existing character" viewCharacters,
+	backAction sc
+	]
+
+newCharacter :: ActionFunction RPGState 
+newCharacter _ =return (WInput ["Enter name:"] nameF)
+
+nameF :: String -> GSWScreenT RPGState 
+nameF "" =return (WText "Creation canceled")
+nameF name =do
+	gs <- get
+	exists<-liftIO $ doesCharacterExists (gsData gs) name 
+	if exists
+		then
+			return (WInput [name++" already exists!","Enter name:"] nameF)
+		else
+			return ((WCombo ["Choose gender:"] (map show [Male,Female]) (genderF name)))
+
+genderF :: String -> String -> GSWScreenT 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 _ Empty=return (WText "Creation canceled")
+profile (name,gender) (Unknown _)= do
+	w2<- (genderF name) (show gender)
+	return (combineWidget (WText "Unknown profile") w2)
+profile (name,gender) (Exact prof)= do
+	mt<-generateTraits prof
+	let h=getDefaultHealth mt
+	let c=Character name gender h (makeEmptyInventory 10 20) [] []
+	extraGoldFromTrade<-diffResult' c trade (subsequentDifficulty Standard) (\x->if x<0 then 0 else x ^ 2)
+	extraGoldFromStealing<-diffResult' c steal (subsequentDifficulty Standard) (\x->if x<0 then 0 else x ^ 2)
+	let extraGold=max extraGoldFromTrade extraGoldFromStealing
+	nbSpellsLearned<-diffResult' c spelllearning (toIntLevel Neutral) (\x->if x<0 then 0 else (round $ sqrt $ fromIntegral x))
+	spells<-randomPickpn allSpells nbSpellsLearned
+	let c'=c{inventory=addGold (inventory c) extraGold,spells=spells} 
+	return (WCheck [ppCharacterAndGold' c'] "Accept?" True (profileAccept c'))
+
+profileAccept :: Character -> Bool -> GSWScreenT RPGState 
+profileAccept c False = (genderF (name c) (show $ gender c))
+profileAccept c True = do
+	gs <- get
+	s <- liftIO $ saveCharacter (gsData gs) c
+	return $ either WText WText s
+
+deleteCharacters :: ActionFunction RPGState 
+deleteCharacters _ = listCharactersW $ deleteFileW deleteCharacter
+
+viewCharacters :: ActionFunction RPGState 
+viewCharacters _=listCharactersW viewCharacter
+
+listCharactersW :: (String -> GSWScreenT RPGState) -> GSWScreenT RPGState
+listCharactersW af= do
+	rs<-gets gsData
+	cs<-liftIO $ listCharacters rs
+	if null cs
+		then return (WText "No character defined")
+	 	else return (WCombo ["Choose character:"] cs (af))	
+	--listFilesW (characterExtension,"Choose character:","No character defined") 
+
+{--		
+listFilesW::  (String,String,String) -> (String -> GSWScreenT RPGState) -> GSWScreenT RPGState
+listFilesW (ext,title,msg) af = do
+	rs<-gets gsData
+	files <- liftIO $ listFiles rs ext
+	return 
+		(if null files
+			then
+				(WText msg)
+			else
+				(WCombo [title] files (af))	
+		)		
+--}
+		
+viewCharacter :: String -> GSWScreenT RPGState 
+viewCharacter ""=return (WText "View canceled")
+viewCharacter shortName=do
+	rs<-gets gsData
+	w<-withCharacter rs shortName 
+		(\c ->	return $ WText $ ppCharacterAndInventory' c)
+	onError w
+
+{--withFileContents :: String -> (String -> IO(Either String a)) -> (a->GSWScreenT RPGState) -> GSWScreenT 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 (Right w)=return w
+onError (Left s)=return $ WText s
+
+getGameScreen ::  Screen RPGState  -> Screen RPGState 
+getGameScreen sc= Screen [Action "new" "Start a new game" newGame,
+	Action "delete" "Delete an existing game" deleteGames,
+	Action "play" "Continue playing a game" playGames,
+	backAction sc
+	]
+	
+newGame :: ActionFunction RPGState 
+newGame _=listCharactersW gameNameF
+	
+gameNameF :: String -> GSWScreenT RPGState 
+gameNameF ""=return (WText "Creation canceled")
+gameNameF shortName=do
+	gs <- get
+	let rs = gsData gs
+	exists<-liftIO $ doesCurrentGameExists rs shortName
+	if exists
+		then
+			return (WText (printf "%s already plays!" shortName))
+		else
+			do
+				r <- withCharacter rs shortName createNewMazeState
+				onError r 
+
+mazeOptions :: MazeOptions
+mazeOptions = MazeOptions {
+	itemProportion=4,
+	npcProportion=3
+}
+
+
+createNewMazeState	::	Character -> GSWScreenT RPGState	
+createNewMazeState c = do
+	(GameState gw _) <- MG.initialGameState
+	mo<-generateObjects (maze $ gw) mazeOptions (characterLevel c)
+	let mgs2=RPGGameState gw mo 0
+	createMazeState' c mgs2
+		--(printf "Game saved to %s " fileName)
+		
+createMazeState' :: Character -> RPGGameState -> GSWScreenT RPGState
+createMazeState' c rgs = do
+	(RPGState {fp=fp}) <- gets gsData
+	s<-getSplit
+	let rpg2=RPGState (Just c) (Just rgs) fp
+	(rpg3,wGold)<-liftIO $ processFight rpg2 s
+	let ms=getMazeScreen rpg3
+	let gs2=GameState rpg3 ms 
+	put gs2
+	w<-if isJust ms
+			then mapAction []
+			else do
+				return (WText "Game over")
+	saveGameAndCharacter (combineWidget wGold w)
+
+getMazeScreen :: RPGState  -> Maybe (Screen RPGState)
+getMazeScreen RPGState{rpgCharacter=Nothing}  = Nothing
+getMazeScreen RPGState{mgs=Nothing}  = Nothing
+getMazeScreen rs | isOutOfService $ fromJust $ rpgCharacter rs = Nothing
+getMazeScreen RPGState{rpgCharacter=Just c1,mgs=Just mgs}  = 
+	let	
+		gw=mazegameworld mgs
+		dirs=MG.getDirections gw
+		f dir = Action (map toLower (show dir)) ("Move " ++ (show dir)) (move dir)
+		actions=map f dirs
+		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
+		items=Objs.listItems (mazegameworld mgs) (objects mgs)
+		acts2=if null items
+			then acts
+			else (Action "pickup" "Pick up an item" (pickupAction items)):acts
+		itemsCarried=Inv.listCarriedItems (inventory $ c1)
+		acts3=if null itemsCarried
+			then acts2
+			else (Action "drop" "Drop an item" (dropAction itemsCarried)):acts2
+		usableItems=filter (canUseItem . snd) itemsCarried
+		acts4=if null usableItems
+			then acts3
+			else (Action "use" "Use an item (drink a potion, etc.)" (useItem usableItems)):acts3
+		usableSpells=spellsToMyself c1
+		acts5=if null usableSpells
+			then acts4
+			else (Action "cast" "Cast a spell" (castSpell usableSpells)):acts4
+	in	
+		Just (Screen acts5)
+
+statusAction :: ActionFunction RPGState
+statusAction _ = do
+	c<-gets (fromJust . rpgCharacter . gsData)
+	return (WText $ ppCharacter' c)
+
+getItems :: RPGState -> Widget RPGState
+getItems (RPGState {mgs=Nothing})= WNothing
+getItems (RPGState {mgs=Just mgs})=	
+	let 
+		items=Objs.listItems (mazegameworld mgs) (objects mgs)
+	in WList ("You see:": 
+			if null items 
+				then ["Nothing"]
+				else zipWith (\x y->(show x) ++ ": "++(itName y)) [1..] items)
+
+getNPCW :: RPGState -> Widget RPGState
+getNPCW (RPGState {mgs=Nothing})= WNothing
+getNPCW (RPGState{mgs=Just mgs})=	
+	let 
+		npc=Objs.getNPC (mazegameworld mgs) (objects mgs)
+	in WText ("You meet: "++ 
+			(if isNothing npc 
+				then "nobody"
+				else ("a " ++ (name $ npcCharacter $ fromJust npc))))
+
+move :: MG.Direction -> ActionFunction RPGState
+move dir _ =do
+	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)
+	let nameC=name $ c1
+	if (isJust sc) 
+		then
+			do
+				rs2<- tick 10 rs{mgs=Just rmgs{mazegameworld=gw2}}
+				srw<-getSplit
+				(rs3,wGold)<-liftIO $ processFight rs2 srw
+				let ms=getMazeScreen rs3
+				let gs2=GameState rs3 ms 
+				let (WList itemNames)=getItems rs3
+				put gs2
+				w<-if isJust ms
+						-- we have escaped, probably
+						then if (position $ mazegameworld $ fromJust $ mgs rs3)== (position $ mazegameworld $ fromJust $ mgs rs2)
+							then return (WList (s++itemNames))
+							else mapAction []
+						else do
+							return (WText "Game over")
+				saveGameAndCharacter (combineWidget wGold w)
+		else
+			do
+				liftIO $ deleteGame rs nameC
+				put (GameState (RPGState Nothing Nothing fp) (Just (getGameScreen initialScreen)))
+				return (WList s)	
+
+processFight :: RPGState -> RandomWrapper -> IO (RPGState,Widget RPGState)
+processFight rs@(RPGState{rpgCharacter=Nothing}) _=return (rs,WNothing)
+processFight rs@(RPGState{mgs=Nothing}) _=return (rs,WNothing)
+processFight rs@(RPGState{rpgCharacter=Just c,mgs=Just mgs}) rw= do
+	let npc=Objs.getNPC (mazegameworld mgs) (objects mgs)
+	if (isJust npc)
+		then do
+			let npc'=fromJust npc
+			let (rw1,rw2)=splitWrapper rw
+			es <- screenInteract c npc' rw1 (tickCount mgs)
+			let (mo,c2,extraGold) =case (exitStatus es) of
+				Victory -> killNPC (mazegameworld mgs) (objects mgs) (exitCharacter es)
+				_ -> (updateNPC (mazegameworld mgs) (objects mgs) (exitOpponent es),exitCharacter es,0)
+			let mo2=foldl (Objs.dropItem (mazegameworld mgs)) mo (newItems es)
+			gw<-case (exitStatus es) of
+				Flight -> do
+					let gw=mazegameworld mgs
+					pos <- evalRandT (randomPickp (DataSet.elems (DataSet.delete (position gw) (explored gw)))) rw2
+					return (gw{position=pos})
+				_ -> return (mazegameworld mgs)
+			let mgs2=mgs{mazegameworld=gw,objects=mo2,tickCount=exitTickCount es}
+			let rs2=rs{rpgCharacter=Just c2,mgs=Just mgs2}
+			let w=if extraGold>0
+				then WText (printf "You pick up %d gold coins" extraGold)
+				else WNothing
+			return (rs2,w)
+		else
+			return (rs,WNothing)
+
+
+
+mapAction :: ActionFunction RPGState
+mapAction _ = do
+	rs@(RPGState {mgs=(Just mgs)}) <- gets gsData
+	let gw=mazegameworld mgs
+	sg <- getSplit
+	(WList l,_)<-liftIO $ runStateT (evalRandT (MG.mapAction []) sg) (GameState gw Nothing)
+	let itemNames=getItems rs
+	return	(combineWidget (WList l) itemNames)
+		
+	
+inventoryAction :: ActionFunction RPGState
+inventoryAction _ =do
+	(RPGState {rpgCharacter=(Just c)}) <- gets gsData
+	return (WText (ppInventory' $ inventory c))
+
+pickupAction :: [ItemType] -> ActionFunction RPGState
+pickupAction items cmds = do 
+	if null items
+		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 Empty=return (WText "Pick up canceled")
+pickupItem (Unknown _)=return (WText "That's not there to pick")
+pickupItem (Exact item) =do
+	(RPGState {rpgCharacter=(Just c1)}) <- gets gsData
+	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 _ _ ""=return (WText "Pick up canceled")
+doPickup item positions pos =do
+	(GameState {gsData=rs@(RPGState {rpgCharacter=Just c1,mgs=(Just mgs)})}) <- get
+	let matching=filter (\x->(ppInventoryPosition' x)==pos) positions
+	if null matching
+		then return (WText "You can't put that in there")
+		else do 
+			let match=head matching
+			let Right (inv,it)=Inv.takeItem (inventory $ c1) item (fst match)
+			let c2=c1{inventory=inv}
+			let objs2=Objs.takeItem (mazegameworld mgs) (objects mgs) item
+			let objs3= foldl (\x y->Objs.dropItem (mazegameworld mgs) x y) objs2 it
+			let rs2=rs{rpgCharacter=Just c2,mgs=Just mgs{objects=objs3}}
+			saveNewGameState rs2
+			let itemNames=getItems rs2	
+			let w =(combineWidget (WText "Item picked up") itemNames)
+			saveGameAndCharacter w
+
+saveNewGameState :: RPGState -> ScreenT (GameState RPGState) ()
+saveNewGameState rs2=do
+	put (GameState rs2 (getMazeScreen rs2))
+
+tick :: Int -> RPGState ->  ScreenT (GameState RPGState) (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})}
+	saveNewGameState rs2
+	return rs2
+
+dropAction :: [(Position,ItemType)] -> ActionFunction RPGState
+dropAction  items _ =do
+	return (if null items
+		then (WText "You're not carrying anything")
+		else (getMappedCombo ppItemPosition' ["What do you want to drop?"] items dropItemAction)
+		)
+	
+dropItemAction ::  ComboResult (Position,ItemType) -> GSWScreenT RPGState
+dropItemAction Empty=return (WText "Drop canceled")
+dropItemAction (Unknown _)=return (WText "You can't drop that")
+dropItemAction (Exact item) =do
+	rs@(RPGState {rpgCharacter=(Just c1),mgs=(Just mgs)}) <- gets gsData
+	let Right (inv,it)=Inv.dropItem (inventory $ c1) (fst item)
+	let c2=c1{inventory=inv}
+	let objs=if isJust it
+		then Objs.dropItem (mazegameworld mgs) (objects mgs) (fromJust it)
+		else (objects mgs)
+	let rs2=rs{rpgCharacter=Just c2,mgs=Just mgs{objects=objs}}
+	saveNewGameState rs2
+	let itemNames=getItems rs2	
+	saveGameAndCharacter (combineWidget (WText "Item dropped") itemNames)
+		
+saveGameAndCharacter :: Widget RPGState -> GSWScreenT RPGState
+saveGameAndCharacter w=do
+	gs@(GameState {gsData=rs@(RPGState {rpgCharacter=(Just c1)})}) <- get
+	when (isOutOfService c1) (put (gs{screen=Just (getGameScreen initialScreen)}))
+	saveResult<- liftIO $ saveCurrent rs			
+	let ws=case saveResult of
+		Right _ -> Nothing
+		Left t -> Just $ WText t
+	return (combineMaybeWidget w ws)
+	
+listGamesW :: (String -> GSWScreenT RPGState) -> String -> GSWScreenT RPGState
+listGamesW af name= do
+	rs<-gets gsData
+	cs<-liftIO $ listGames rs name
+	if null cs
+		then return (WText "No game created")
+	 	else do
+	 		let (l,r)=partition (not . isRight) cs 
+	 		let l'=(map (\(Left a)->a) l)
+	 		let r'=map (\(Right (n,_))->n) r
+	 		return (WCombo ("Choose game:":l') r' (af))	
+
+deleteGames :: ActionFunction RPGState 
+deleteGames _ =listCharactersW (listGamesW $ deleteFileW deleteGame)
+
+deleteFileW :: (RPGState -> String -> IO (Either String String)) -> String -> GSWScreenT 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 _ _ False =  return (WText "Deletion canceled")
+reallyDeleteFileW f name True =  do
+	rs<-gets gsData
+	liftIO $ f rs name
+	return (WText (name++" deleted"))
+	
+
+playGames :: ActionFunction RPGState
+playGames _ =listCharactersW (listGamesW playGame)
+
+playGame :: String -> GSWScreenT RPGState
+playGame ""= return (WText "No game chosen")
+playGame shortName= do
+	rs <- gets gsData
+	r <- withBackup rs shortName
+		(\BackupState{bckCharacter=c,bckGame=(Just g)}->do
+			createMazeState' c g)
+	onError r	
+		
+				
+useItem :: [(Position,ItemType)] -> ActionFunction RPGState
+useItem items _=do
+	return (if null items
+		then (WText "You're not carrying anything to use")
+		else (getMappedCombo ppItemPosition' ["What do you want to use?"] items useItemAction)
+		)
+	
+useItemAction ::  ComboResult (Position,ItemType) -> GSWScreenT 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) ->
+			let 
+				c2=if remove 
+					then
+						let Right (inv,_)=Inv.dropItem (inventory $ c1) (fst item)
+			 			in c'{inventory=inv}
+			 		else c'
+			in (s,c2)
+	let rs2=rs{rpgCharacter=Just c2}
+	saveNewGameState rs2
+	saveGameAndCharacter (WText s)
+	
+castSpell :: [Spell] -> ActionFunction RPGState
+castSpell spells _=do
+	return (if null spells
+		then (WText "You don't know any useful spell")
+		else (getMappedCombo spellName ["Which spell do you want to cast?"] spells castSpellAction)
+		)
+
+castSpellAction ::  ComboResult Spell -> GSWScreenT 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)
+	tick 5 (rs{rpgCharacter=Just c2})
+	saveGameAndCharacter (WText $ show s)
diff --git a/src/MoresmauJP/Rpg/Save.hs b/src/MoresmauJP/Rpg/Save.hs
new file mode 100644
--- /dev/null
+++ b/src/MoresmauJP/Rpg/Save.hs
@@ -0,0 +1,263 @@
+-- | Saving and loading characters and games
+-- (c) JP Moresmau 2009
+module MoresmauJP.Rpg.Save where
+
+import Control.Monad
+import Control.Monad.Trans
+
+import Data.List
+import Data.Maybe
+import Data.Time
+
+import MoresmauJP.Maze1.Maze 
+import MoresmauJP.Rpg.Character
+import MoresmauJP.Rpg.MazeObjects
+
+import System.Directory
+import System.FilePath
+import System.IO
+import System.Locale
+
+import Text.Printf
+
+data RPGState = RPGState {
+	rpgCharacter::(Maybe Character)
+	,mgs::(Maybe RPGGameState)
+	,fp:: FilePath}
+	deriving (Show,Read,Eq)
+
+data RPGGameState = RPGGameState {
+	mazegameworld::GameWorld
+	,objects::MazeObjects
+	,tickCount::Int
+	}
+	deriving (Show,Read,Eq)
+
+data BackupState = BackupState {
+	bckDate::UTCTime,
+	bckCharacter::Character,
+	bckGame::Maybe RPGGameState
+	}	
+	deriving (Show,Read)
+
+backupExtension="sav"
+
+toBackupState :: RPGState -> IO(BackupState)
+toBackupState (RPGState {rpgCharacter=Nothing})=error "toBackupState: empty game state"
+toBackupState (RPGState {rpgCharacter=(Just char),mgs=mgs})=do
+	t<-getCurrentTime
+	return (BackupState t char mgs)  
+
+fromBackupState :: RPGState -> BackupState -> RPGState
+fromBackupState rs  bs = rs{rpgCharacter=(Just $ bckCharacter bs), mgs=(bckGame bs)}
+
+getFile :: String -> String -> RPGState -> IO(FilePath)
+getFile name ext (RPGState {fp=fp})= do
+	createDirectoryIfMissing True fp
+	let fileName=fp </> (makeValid $ (addExtension name ext))
+	return fileName	
+
+getGameFileForName :: RPGState -> Name -> IO(FilePath)
+getGameFileForName rs name=getFile name backupExtension rs
+
+getGameFileForCharacter :: RPGState -> Character -> IO(FilePath)
+getGameFileForCharacter rs c=getGameFileForName rs (name c)
+ 
+getBackupFileForCharacter :: RPGState -> Character -> IO(FilePath)
+getBackupFileForCharacter rs c=checkBackupFile rs (name c) 1
+		
+checkBackupFile rs name ix = do
+	f<-getFile (addExtension name (show ix)) backupExtension rs
+	ex<-doesFileExist f
+	if not ex 
+		then return f
+		else checkBackupFile rs name (ix+1)
+		
+saveCurrent :: RPGState -> IO (Either String (String,String))
+saveCurrent (RPGState {rpgCharacter=Nothing})=return $ Right ("Nothing to save","")
+saveCurrent rs@(RPGState {rpgCharacter=Just c1})=do
+	if isOutOfService c1
+		then do
+			catch (
+				do
+					fileNameC<-getFile (name c1) backupExtension rs
+					removeFile fileNameC
+					return $ Right ("Character erased","")
+				)
+				(\e -> return (Left ("Could not erase character: " ++ (show e))))
+		else do	
+			saveCurrentGame rs
+			
+
+saveCurrentGame :: RPGState -> IO (Either String (String,String))
+saveCurrentGame (RPGState {rpgCharacter=Nothing})=error "saveCurrentGame: no character"
+saveCurrentGame (RPGState {mgs=Nothing})=error "saveCurrentGame: no game state"
+saveCurrentGame rs@(RPGState {rpgCharacter=Just c1})=do 
+	fileNameG<-getGameFileForCharacter rs c1 
+	saveGame rs fileNameG
+	
+listFiles :: RPGState -> String -> IO ([FilePath])
+listFiles (RPGState {fp=fp}) ext =do  
+	createDirectoryIfMissing True fp
+	fps<-getDirectoryContents fp
+	return $ (map (makeRelative fp)) $  filter (isSuffixOf ext) fps	
+	
+listGames :: RPGState -> Name -> IO ([Either String (FilePath,String)])
+listGames rs name= do
+	files<-listFiles rs backupExtension 
+	let myFiles=filter (isPrefixOf name) files
+	foldM (\list x->do
+		m<-withBackup rs x (\bs->do
+			if isJust $ bckGame bs 
+				then return $ Just (dropExtension x,formatTime defaultTimeLocale (iso8601DateFormat $ Just "%R") $ bckDate bs) 
+				else return Nothing
+				)
+		case m of
+			Right (Just x)-> return ((Right x):list)
+			Right (Nothing)-> return list
+			Left a-> return ((Left a):list)
+			) [] myFiles
+	
+deleteCharacter :: RPGState -> String -> IO (Either String String)
+deleteCharacter rs@(RPGState {fp=fp}) name=do
+	files<-listFiles rs backupExtension 
+	let myFiles= filter (isPrefixOf name) files
+	catch (do
+		mapM_ (removeFile . (combine fp)) myFiles
+		return $ Right (printf "Character %s deleted" name)
+		)
+		(\e->return $ Left (printf "The character couldn't be deleted: %s" (show e))) 
+
+deleteGame :: RPGState -> String -> IO (Either String String)
+deleteGame rs name=do
+	file<-getFile name backupExtension rs 
+	catch (do
+		if hasExtension name
+			then do
+				removeFile file
+				return $ Right "Game deleted"
+			else
+				withBackupCond rs (takeFileName file) 
+					(\(BackupState{bckCharacter=c})->do
+						l<-saveCharacter rs c
+						case l of
+							Right _-> return $ Right "Game deleted"
+							a->return a)
+		
+		)
+		(\e->return $ Left (printf "The game couldn't be deleted: %s" (show e))) 
+
+
+listCharacters :: RPGState -> IO ([String])
+listCharacters rs= do
+	files<-listFiles rs backupExtension 
+	return $ filter (not . hasExtension) $ map dropExtension files	
+	
+saveBackup :: RPGState -> IO (Either String (String,String))
+saveBackup (RPGState {rpgCharacter=Nothing}) = return $ Right ("Nothing to save","")
+saveBackup rs@(RPGState {rpgCharacter=(Just c1)}) = do
+	fileNameB<-getBackupFileForCharacter rs c1
+	saveGame rs fileNameB
+	
+saveGame :: RPGState -> String -> IO (Either String  (String,String))
+saveGame rs fileNameB= do	
+	catch (
+			do
+				bs<-toBackupState rs
+				writeFile fileNameB (show bs)
+				return (Right (printf "Game saved to %s" fileNameB,dropExtension $ takeFileName fileNameB))
+			)
+			(\e -> return (Left (printf "Could not save game: %s" (show e))))
+			
+loadBackup :: RPGState -> String -> IO (Either String (String,RPGState))
+loadBackup rs name = do
+		withBackupCond rs (addExtension name backupExtension)
+			(\bs->do
+				let game=fromBackupState rs bs
+				return $ case (mgs game) of
+					Just _->Right ("Game loaded",game)
+					Nothing->Left "This backup contains no started game")
+
+doesCharacterExists :: RPGState -> String -> IO (Bool)
+doesCharacterExists rs name=do
+	fileName<-getFile name backupExtension rs
+	doesFileExist fileName 
+	
+	
+doesCurrentGameExists :: RPGState -> String -> IO(Bool)
+doesCurrentGameExists rs shortName =do
+	fileName<-getFile shortName backupExtension rs
+	exists<-doesFileExist fileName
+	if exists
+		then do
+			e<-withBackup rs fileName
+				(\bs->do
+					let game=fromBackupState rs bs
+					return (isJust (mgs game)))
+			return $ case e of
+				Right b->b
+				Left _->False
+		else return False 
+	
+	
+saveCharacter :: RPGState -> Character -> IO (Either String String)
+saveCharacter rs c=do
+	fileName<-getFile (name c) backupExtension rs
+	catch (do
+		t<-getCurrentTime
+		let bs=(BackupState t c Nothing)  
+		writeFile fileName (show bs)
+		return (Right $ "Character saved to "++fileName)
+		)
+		(\e -> return (Left $ printf "Could not save character: %s" (show e)))	
+		
+readF :: (MonadIO m) => RPGState ->  String -> (String -> IO (Either String a)) -> (a -> m b) -> m (Either String b)
+readF (RPGState {fp=fp}) shortName act act2 = do
+	let sn'=if (takeExtension shortName)==("."++backupExtension)
+		then shortName
+		else addExtension shortName backupExtension
+	let fileName=fp </> sn'
+	exists<-liftIO $ doesFileExist fileName
+	if exists
+		then do 
+			a <- liftIO $ catch (do
+				a<- withFile fileName ReadMode (\h -> do
+						s<-hGetContents h
+						(act s)
+					)
+				return a)
+				(\err-> return (Left (printf "The file %s could not be read: %s" fileName (show err))))
+			case a of
+				Right b -> do
+					d<-act2 b
+					return $ Right d
+				Left c -> return $ Left c
+		else return $ Left (printf "File %s does not exist" fileName)		
+
+withBackup rs name m = do
+	readF rs name readBackup
+		m
+
+withCharacter rs name m = do
+	readF rs name readBackup
+		(\bs-> m $ bckCharacter bs)
+
+withBackupCond rs name m = do
+	ei<-readF rs name readBackup
+		m
+	return $ case ei of
+		Right (Left a)->Left a
+		Right (Right a)->Right a
+		Left a -> Left a		
+
+
+readBackup s=do 
+	catch (do
+		c<-(readIO s)::IO BackupState
+		return $ Right c
+		)
+		(\err-> return (Left (printf "The backup file could not be parsed: %s" (show err))))
+
+
+
+	
diff --git a/src/MoresmauJP/Rpg/SaveTests.hs b/src/MoresmauJP/Rpg/SaveTests.hs
new file mode 100644
--- /dev/null
+++ b/src/MoresmauJP/Rpg/SaveTests.hs
@@ -0,0 +1,269 @@
+-- | Saving and loading hunit tests
+-- (c) JP Moresmau 2009
+module MoresmauJP.Rpg.SaveTests where
+
+import Control.Monad
+
+import qualified Data.Map as M
+
+import MoresmauJP.Maze1.Maze 
+import MoresmauJP.Rpg.Character
+import MoresmauJP.Rpg.MazeObjects
+import MoresmauJP.Rpg.Save
+import MoresmauJP.Rpg.CharacterTests
+import MoresmauJP.Util.Random
+
+import System.Directory
+import System.FilePath
+import System.Random
+import Test.HUnit
+
+saveTests = TestList [testNormalCharacterFlow,testNormalGameFlow,
+	testBackupGameFlow,testBackupAndCurrent,testSaveCurrentOOS]
+
+testNormalCharacterFlow = TestLabel "testNormalCharacterFlow" (TestCase (do
+	rpg<-getTestRpg
+	let name="JP"
+	let c=createTestChar name
+	e<-saveCharacter rpg c
+	assertBool "e is not Right" (case e of 
+		(Right _)-> True
+		_ -> False)
+	characterExists<-doesCharacterExists rpg name
+	assertBool "character does not exist" characterExists
+	currentGameExists<-doesCurrentGameExists rpg name
+	assertBool "game does exist" (not currentGameExists)
+	chars<-listCharacters rpg
+	assertEqual "not 1 character" 1 (length chars)
+	assertEqual "not JP" name (head chars) 
+	games<-listGames rpg name
+	assertEqual ("game found "++show (head games)) 0 (length games)
+	ed<-deleteCharacter rpg name
+	assertBool "ed is not Right" (case ed of 
+		(Right _)-> True
+		_ -> False)
+	characterExists2<-doesCharacterExists rpg name
+	assertBool "character still exists" (not characterExists2)
+	currentGameExists2<-doesCurrentGameExists rpg name
+	assertBool "game does exist" (not currentGameExists2)
+	chars2<-listCharacters rpg
+	assertEqual "not 1 character" 0 (length chars2)
+	))
+	
+testNormalGameFlow = TestLabel "testNormalGameFlow" (TestCase (do
+	rpg<-getTestRpg
+	let name="JP"
+	let c=createTestChar name
+	saveCharacter rpg c
+	sg<-getStdGen
+	gw<-evalRandT (generateGameWorld (10,5)) (ProductionRandom sg)
+	let mgs=RPGGameState (gw) (MazeObjects M.empty M.empty) 0
+	let rpg2=rpg{rpgCharacter=Just c,mgs=Just mgs}
+	e<-saveCurrent rpg2
+	assertBool ("e is not Right "++(show e)) (case e of 
+		(Right _)-> True
+		_ -> False)
+	games<-listGames rpg name
+	assertEqual "not 1 game found" 1 (length games)
+	assertBool "head hames is not Right" (case (head games) of 
+		(Right _)-> True
+		_ -> False)
+	let (Right (n,_))=head games
+	assertEqual "not name" name n
+	
+	lb<-loadBackup rpg name
+	assertBool "lb is not Right" (case (lb) of 
+		(Right _)-> True
+		_ -> False)
+	
+	eD<-deleteGame rpg2 name
+	assertBool ("eD is not Right: "++(show eD)) (case eD of 
+		(Right _)-> True
+		_ -> False)
+	currentGameExists<-doesCurrentGameExists rpg name
+	assertBool "game does exist" (not currentGameExists)
+	chars<-listCharacters rpg
+	assertEqual "not 1 character" 1 (length chars)
+	assertEqual "not JP" name (head chars) 
+	games<-listGames rpg name
+	assertEqual ("game found "++show (head games)) 0 (length games)
+	
+	lb2<-loadBackup rpg name
+	assertBool "lb2 is not Left" (case lb2 of 
+		(Right _)-> False
+		(Left _) -> True)
+	
+	
+	))
+	
+testBackupGameFlow = TestLabel "testBackupGameFlow" (TestCase (do
+	tmp<-getTemporaryDirectory
+	let dir=combine tmp "rpg"
+	removeDirectoryRecursive dir
+	let rpg=RPGState Nothing Nothing dir
+	let name="JP"
+	let c=createTestChar name
+	saveCharacter rpg c
+	sg<-getStdGen
+	gw<-evalRandT (generateGameWorld (10,5)) (ProductionRandom sg)
+	let mgs=RPGGameState (gw) (MazeObjects M.empty M.empty) 0
+	let rpg2=RPGState (Just c) (Just mgs) dir
+	e<-saveBackup rpg2
+	assertBool ("e is not Right "++(show e)) (case e of 
+		(Right _)-> True
+		_ -> False)
+	games<-listGames rpg name
+	assertEqual "not 1 games found" 1 (length games)
+	assertBool "head hames is not Right" (case (head games) of 
+		(Right _)-> True
+		_ -> False)
+	let Right (n,_)=head games
+	assertEqual "not name.1" (name++".1") n
+	currentGameExists<-doesCurrentGameExists rpg name
+	assertBool "game does exist" (not currentGameExists)
+	chars<-listCharacters rpg
+	assertEqual "not 1 character" 1 (length chars)
+	assertEqual "not JP" name (head chars) 
+	
+	lb<-loadBackup rpg n
+	assertBool "lb is not Right" (case lb of 
+		(Right _)-> True
+		_ -> False)
+	
+	eD<-deleteGame rpg2 n
+	assertBool ("eD is not Right: "++(show eD)) (case eD of 
+		(Right _)-> True
+		_ -> False)
+	currentGameExists<-doesCurrentGameExists rpg name
+	assertBool "game does exist" (not currentGameExists)
+	chars<-listCharacters rpg
+	assertEqual "not 1 character" 1 (length chars)
+	assertEqual "not JP" name (head chars) 
+	games<-listGames rpg name
+	assertEqual ("game found "++show (head games)) 0 (length games)
+	
+	lb2<-loadBackup rpg n
+	assertBool "lb2 is not Left" (case lb2 of 
+		(Right _)-> False
+		(Left _) -> True)
+		
+	return ()
+	))
+	
+testBackupAndCurrent= TestLabel "testBackupAndCurrent" (TestCase (do
+	rpg<-getTestRpg
+	let name="JP"
+	let c=createTestChar name
+	saveCharacter rpg c
+	sg<-getStdGen
+	gw<-evalRandT (generateGameWorld (10,5)) (ProductionRandom sg)
+	let mgs=RPGGameState (gw) (MazeObjects M.empty M.empty) 0
+	let rpg2=rpg{rpgCharacter=Just c,mgs=Just mgs}
+	e<-saveBackup rpg2
+	assertBool ("e is not Right "++(show e)) (case e of 
+		(Right _)-> True
+		_ -> False)
+	let Right(_,nB)=e
+	
+	gw2<-evalRandT (generateGameWorld (10,5)) (ProductionRandom sg)
+	let mgs2=RPGGameState (gw2) (MazeObjects M.empty M.empty) 0
+	let rpg3=rpg{rpgCharacter=Just c,mgs=Just mgs2}
+	eC<-saveCurrent rpg3
+	assertBool ("eC is not Right "++(show eC)) (case eC of 
+		(Right _)-> True
+		_ -> False)
+	let Right(_,nC)=eC
+	
+	games<-listGames rpg name
+	assertEqual "not 2 games found" 2 (length games)
+	assertBool "head hames is not Right" (case (head games) of 
+		(Right _)-> True
+		_ -> False)
+	assertBool "second hames is not Right" (case (head $ tail games) of 
+		(Right _)-> True
+		_ -> False)
+		
+	lbB<-loadBackup rpg nB
+	assertBool "lbB is not Right" (case lbB of 
+		(Right _)-> True
+		_ -> False)
+	
+	let Right (_,rpg2a)=lbB
+	assertEqual "backup is not right rpg" rpg2 rpg2a
+	
+	lbC<-loadBackup rpg nC
+	assertBool "lbC is not Right" (case lbC of 
+		(Right _)-> True
+		_ -> False)
+	
+	let Right (_,rpg3a)=lbC
+	assertEqual "Current is not right rpg" rpg3 rpg3a	
+	
+	eD<-deleteGame rpg2 nB
+	assertBool ("eD is not Right: "++(show eD)) (case eD of 
+		(Right _)-> True
+		_ -> False)
+	currentGameExists<-doesCurrentGameExists rpg nB
+	assertBool "game does exist" (not currentGameExists)
+	chars<-listCharacters rpg
+	assertEqual "not 1 character" 1 (length chars)
+	assertEqual "not JP" name (head chars) 
+	games<-listGames rpg nB
+	assertEqual ("game found "++show (head games)) 0 (length games)
+	
+	lb2<-loadBackup rpg nB
+	assertBool "lb2 is not Left" (case lb2 of 
+		(Right _)-> False
+		(Left _) -> True)
+		
+	eDC<-deleteGame rpg2 nC
+	assertBool ("eDC is not Right: "++(show eDC)) (case eDC of 
+		(Right _)-> True
+		_ -> False)	
+		
+	return ()
+	
+	))
+
+
+getTestRpg= do
+	tmp<-getTemporaryDirectory
+	let dir=combine tmp "rpg"
+	b<-doesDirectoryExist dir
+	when b (removeDirectoryRecursive dir)
+	return (RPGState Nothing Nothing dir)
+
+testSaveCurrentOOS= TestLabel "testSaveCurrentOOS" (TestCase (do
+	rpg<-getTestRpg
+	let name="JP"
+	let c=createTestChar name
+	saveCharacter rpg c
+	sg<-getStdGen
+	gw<-evalRandT (generateGameWorld (10,5)) (ProductionRandom sg)
+	let mgs=RPGGameState (gw) (MazeObjects M.empty M.empty) 0
+	let rpg2=rpg{rpgCharacter=Just c,mgs=Just mgs}
+	
+	eC<-saveCurrent rpg2
+	assertBool ("eC is not Right "++(show eC)) (case eC of 
+		(Right _)-> True
+		_ -> False)
+	let Right(_,nC)=eC
+	
+	let c2=setCharacteristic' c Current Physical 0
+
+	let rpg3=rpg{rpgCharacter=Just c2}
+	
+	eC2<-saveCurrent rpg3
+	assertBool ("eC2 is not Right "++(show eC2)) (case eC2 of 
+		(Right _)-> True
+		_ -> False)
+	
+	currentGameExists<-doesCurrentGameExists rpg nC
+	assertBool "game does exist" (not currentGameExists)
+	chars<-listCharacters rpg
+	assertEqual "not 0 character" 0 (length chars)
+	games<-listGames rpg nC
+	assertEqual ("game found "++show (head games)) 0 (length games)
+	
+	))
+
diff --git a/src/MoresmauJP/Rpg/TextOutput.hs b/src/MoresmauJP/Rpg/TextOutput.hs
new file mode 100644
--- /dev/null
+++ b/src/MoresmauJP/Rpg/TextOutput.hs
@@ -0,0 +1,106 @@
+-- | Pretty printing to text output
+-- (c) JP Moresmau 2009
+module MoresmauJP.Rpg.TextOutput where
+
+import Data.Array.IArray
+import Data.List
+
+import MoresmauJP.Rpg.Character
+import MoresmauJP.Rpg.Inventory
+import MoresmauJP.Rpg.Profile
+import MoresmauJP.Rpg.Trade
+
+import Text.PrettyPrint
+import Text.Printf
+
+ppCharacter' :: Character -> String
+ppCharacter'= render . ppCharacter
+
+ppCharacterAndInventory' :: Character -> String
+ppCharacterAndInventory' c = render ((ppCharacter c) $$ (text "---") $$ (ppInventory $ inventory c))
+
+ppCharacterAndGold' :: Character -> String
+ppCharacterAndGold' c = render ((ppCharacter c) $$ (text "---") $$ (ppGold $ getGold $ inventory c))
+
+
+
+ppCharacter :: Character -> Doc
+ppCharacter c= 
+	(text $ name c) 
+		$$ (text $ show $ gender c)
+		$$ (text "---")
+		$$ (ppTraits (traits c))
+		$$ (text "---")
+		$$ (ppSpells c)
+		$$ (text "---")
+		$$ (ppProfiles c)
+		$$ (ppAffects c) 
+		$$ (ppStatus c)
+
+ppTraits :: CharacteristicRatings -> Doc
+ppTraits cr= vcat (map f (assocs cr))
+	where 
+		f (c,r)=(text $ show c) $$ (nest (m+2) (text $ show r))
+		m = maximum (map (length . show) (allCharacteristics++allHealth))
+		
+ppProfiles :: Character -> Doc
+ppProfiles c= (text "Profile(s): " <+> (vcat (map (text.fst.fst) (bestProfiles (traits c)))))
+
+ppStatus :: Character -> Doc
+ppStatus c 
+		| (isDead c) = text "Dead!"
+		| (isMad c) = text "Mad!"
+		| otherwise = empty
+
+ppAffects :: Character -> Doc
+ppAffects c=(vcat (map (text . affectDescription) (affects c)))
+
+ppSpells :: Character -> Doc
+ppSpells c=text "Spell(s) known: " <+> (vcat (map (text . spellName) (spells c)))
+
+ppInventory' :: Inventory -> String
+ppInventory'= render . ppInventory
+
+
+ppInventory :: Inventory -> Doc
+ppInventory i=(text "Inventory:") $$ (ppInventoryItems $listItems i ) $$ (ppGold $ getGold i) 
+
+ppGold :: Gold -> Doc
+ppGold 0=text "No gold"
+ppGold 1=text "1 gold coin"
+ppGold n=(text $ show n) <+> (text "gold coins")
+
+ppInventoryItems :: [(Position,Maybe ItemType)] -> Doc
+ppInventoryItems items=(vcat (map f items))
+	where
+		m = foldl max 0 (map (length . show . fst) items)
+		f (pos,maybeItem)=(text $ show pos) $$ (nest (m+2) (ppMaybeItem maybeItem))
+		 
+ppInventoryPosition' :: (Position,Maybe ItemType) -> String
+ppInventoryPosition' (pos,maybeItem)= render $ (text $ show pos) <+> (f maybeItem)		
+		 where 
+		 	f Nothing=empty
+		 	f (Just it)=parens$ text $ itName it
+		 
+ppMaybeItem :: Maybe ItemType -> Doc
+ppMaybeItem Nothing = text "Nothing"
+ppMaybeItem (Just it) = text $ itName it
+		 
+ppItemPosition :: (Position,ItemType) -> Doc
+ppItemPosition (pos,item) =(text $ itName item) <+> (parens (text $ show pos))
+	
+ppItemPosition' :: (Position,ItemType) -> String
+ppItemPosition' = render . ppItemPosition
+		
+ppTradeOperation :: TradeOperation -> Doc
+ppTradeOperation (ToBuy (_,it) g)=text (printf "Buy a %s for %d gold coins" (itName it) g) 
+ppTradeOperation (ToSell (pos,it) g)=text (printf "Sell a %s (%s) for %d gold coins" (itName it) (show pos) g)
+ppTradeOperation (ToExchange (pos,it1) (_,it2))= text (printf "Exchange a %s (%s) for a %s" (itName it1) (show pos) (itName it2))
+		
+ppTradeOperation' :: TradeOperation -> String
+ppTradeOperation' = render . ppTradeOperation	
+		
+--	let 
+--		bp=bestProfiles (traits c)
+--		pt=concat $ intersperse "," (map (fst.fst) bp)
+--	in ((show c) ++ pt)
diff --git a/src/MoresmauJP/Rpg/Trade.hs b/src/MoresmauJP/Rpg/Trade.hs
new file mode 100644
--- /dev/null
+++ b/src/MoresmauJP/Rpg/Trade.hs
@@ -0,0 +1,108 @@
+-- | Trade resolution
+-- (c) JP Moresmau 2009
+module MoresmauJP.Rpg.Trade where
+
+import Data.List
+import Data.Maybe
+import Data.Ord
+
+import MoresmauJP.Rpg.Actions
+import MoresmauJP.Rpg.Character
+import MoresmauJP.Rpg.Inventory
+
+
+data TradeAction=Buy | Sell | Exchange | EndTrade	
+	deriving (Show,Read,Enum,Eq,Bounded)
+	
+data TradeOperation= ToBuy (Position,ItemType) Gold | ToSell (Position,ItemType) Gold | ToExchange (Position,ItemType) (Position,ItemType)
+	deriving (Show,Read,Eq)
+
+listTradeItems :: Character -> Character -> TradeAction -> RollResult -> [TradeOperation]
+listTradeItems (Character{inventory=inv1}) (Character{inventory=inv2}) Buy rr=
+	let
+		canBuy=listTradeItems' inv1 inv2 rr resultMultiplierLow
+	in map (\(a,b)->ToBuy a b) canBuy
+listTradeItems (Character{inventory=inv1}) (Character{inventory=inv2}) Sell rr=
+	let
+		canBuy=listTradeItems' inv2 inv1 rr resultMultiplierHigh
+	in map (\(a,b)->ToSell a b) canBuy
+listTradeItems c1@(Character{inventory=inv1}) c2@(Character{inventory=inv2}) Exchange rr=
+	let 
+		-- we don't want to restrict to what we could buy/sell with our money
+		-- so let's pretend with have maximum money
+		buy=listTradeItems c1{inventory=addGold inv1 maxBound} c2 Buy rr
+		sell=listTradeItems c1 c2{inventory=addGold inv2 maxBound} Sell rr
+		allMaps=map (\t@(ToBuy _ g)->(t,getOperationForPrice sell g)) buy
+		possible=filter (\(_,y)->isJust y) allMaps
+	in
+		map (\((ToBuy i1 _),Just (ToSell i2 _))->ToExchange i2 i1) possible
+listTradeItems _ _ _ _=[]
+	
+getOperationForPrice :: [TradeOperation] -> Gold -> Maybe TradeOperation
+getOperationForPrice tos g=
+	let 
+		within10=filter (\(ToSell _ gold)-> (abs(g-gold))<(div g 5)) tos
+		closest=sortBy (\(ToSell _ gold1) (ToSell _ gold2)->compare (gold2-g) (gold1-g)) within10
+	in listToMaybe closest
+	
+listTradeItems' :: Inventory -> Inventory -> RollResult -> (Int -> RollResult -> Int)	-> [((Position,ItemType),Gold)]
+listTradeItems' inv1 inv2 rr f=
+	let 
+		maxGold=getGold inv1
+		forSale=map (\a-> (a,valueOfItem rr a f)) (listCarriedItemsU inv2)
+	in filter (\a->(snd a) <=maxGold) forSale
+	
+valueOfItem::RollResult -> (Position,ItemType) -> (Int -> RollResult -> Int)-> Gold
+valueOfItem rr (pos,it) f= 
+	let
+		p=price it
+		p'=max 1 $ f p rr
+	in	positionPremium pos p'
+
+positionPremium :: Position -> Int -> Int
+positionPremium (Bag {}) i = i 
+positionPremium _  i =div (i * 14) 10
+
+doTradeOperation :: (Character,Maybe Position) -> (Character,Maybe Position) -> TradeOperation -> (Character,Character,[ItemType])
+doTradeOperation (c1,Just posTo) (c2,Nothing) (ToBuy (pos,_) g)=
+	let
+		(i22,i12,dropped)=doMoneyOperation (inventory c2,pos) (inventory c1,posTo) g
+	in (c1{inventory=i12},c2{inventory=i22},dropped)
+doTradeOperation (c1,Nothing) (c2,Just posTo) (ToSell (pos,_) g)=
+	let
+		(i12,i22,dropped)=doMoneyOperation (inventory c1,pos) (inventory c2,posTo) g
+	in (c1{inventory=i12},c2{inventory=i22},dropped)	
+doTradeOperation (c1,Just posc1) (c2,Just posc2) (ToExchange (pos1,_) (pos2,_))=
+	let
+		Right (invc11,Just it1)=dropItem (inventory c1) pos1
+		Right (invc21,Just it2)=dropItem (inventory c2) pos2
+		Right (invc12,dropped1)=takeItem invc11 it2 posc1
+		Right (invc22,dropped2)=takeItem invc21 it1 posc2
+	in  (c1{inventory=invc12},c2{inventory=invc22},dropped1++dropped2)	
+doTradeOperation _ _ _=error "doTradeOperation unhandled case"
+
+doMoneyOperation :: (Inventory,Position) -> (Inventory,Position) -> Gold -> (Inventory,Inventory,[ItemType])
+doMoneyOperation (invFrom,pFrom) (invTo,pTo) g=
+	let
+		Right (invFrom1,Just it)=dropItem invFrom pFrom
+		invFrom2=addGold invFrom1 g
+		Right (invTo1,dropped)=takeItem invTo it pTo
+		invTo2=addGold invTo1 (-g)
+	in (invFrom2,invTo2,dropped)
+	
+getNpcPosition :: TradeOperation -> Inventory -> Maybe Position
+getNpcPosition (ToBuy _ _) _ = Nothing
+getNpcPosition (ToExchange (_,it) (pos,_)) i = 
+	let
+		Right (i2,_)=dropItem i pos
+	in 	getNpcPosition (ToSell (undefined,it) undefined) i2
+getNpcPosition (ToSell (_,it) _) i = 
+	let
+		pos1=listAllowedPositions i it
+		(filled,empties)=partition (isJust . snd) pos1
+		slot=if null empties
+			then		
+				minimumBy (\(_,Just y1) (_,Just y2)->comparing price y1 y2) filled
+			else
+				head empties		
+	in Just $ fst slot
diff --git a/src/MoresmauJP/Rpg/TradeTests.hs b/src/MoresmauJP/Rpg/TradeTests.hs
new file mode 100644
--- /dev/null
+++ b/src/MoresmauJP/Rpg/TradeTests.hs
@@ -0,0 +1,99 @@
+-- | trade hunit tests
+-- (c) JP Moresmau 2009
+module MoresmauJP.Rpg.TradeTests where
+
+import MoresmauJP.Rpg.Actions
+import MoresmauJP.Rpg.Character
+import MoresmauJP.Rpg.CharacterTests
+import MoresmauJP.Rpg.Items
+import MoresmauJP.Rpg.Inventory
+import MoresmauJP.Rpg.Trade
+
+import Test.HUnit
+
+	
+tradeTests=TestList [testEmpty,testBuy,testBuyTooDear,testBuyHandPremium,
+	testSell,testSellTooDear,testSellHandPremium,
+	testExchange]
+
+testEmpty=TestLabel "Test Empty" (TestCase (do
+	let jp=createTestChar "JP"
+	let merchant=createTestChar "Merchant"
+	assertEqual "Non empty Buy" 0 (length $ listTradeItems jp merchant Buy (Success Standard 1))
+	assertEqual "Non empty Sell" 0 (length $ listTradeItems jp merchant Sell (Success Standard 1))
+	assertEqual "Non empty Exchange" 0 (length $ listTradeItems jp merchant Exchange (Success Standard 1))
+	))
+
+testBuy=TestLabel "Test Buy" (TestCase (do
+	let jp=(createTestChar "JP"){inventory=(makeEmptyInventory 10 10)}
+	let Right (i,_)=takeItem mkEmptyInventory sword (Bag 1)
+	let merchant=(createTestChar "Merchant"){inventory=i}
+	let buyops=listTradeItems jp merchant Buy (Success Standard 1)
+	assertEqual "Non single Buy" 1 (length buyops)
+	assertEqual "Non equal to sword" (ToBuy (Bag 1,sword) 10) (head buyops)
+	let (jp2,merchant2,dropped)=doTradeOperation (jp,Just (Bag 1)) (merchant,Nothing) (head buyops)
+	assertEqual "merchant gold not equals to 10" 10 (getGold $ inventory merchant2)
+	assertEqual "JP does not have the sword!" (Bag 1,sword) (head $ listCarriedItems $ inventory jp2)
+	assertEqual "Dropped is not null" 0 (length dropped)
+	))	
+	
+testBuyTooDear=TestLabel "Test Buy Too Dear" (TestCase (do
+	let jp=(createTestChar "JP"){inventory=(makeEmptyInventory 10 1)}
+	let Right (i,_)=takeItem mkEmptyInventory sword (Bag 1)
+	let merchant=(createTestChar "Merchant"){inventory=i}
+	assertEqual "Non empty Buy" 0 (length $ listTradeItems jp merchant Buy (Success Standard 1))
+	))	
+	
+testBuyHandPremium=TestLabel "Test Buy Hand Premium" (TestCase (do
+	let jp=(createTestChar "JP"){inventory=(makeEmptyInventory 10 20)}
+	let Right (i,_)=takeItem mkEmptyInventory sword RightHand
+	let merchant=(createTestChar "Merchant"){inventory=i}
+	let buyops=listTradeItems jp merchant Buy (Success Standard 1)
+	assertEqual "Non single Buy" 1 (length buyops)
+	assertEqual "Non equal to sword" (ToBuy (RightHand,sword) 14) (head buyops)
+	))	
+
+testSell=TestLabel "Test Sell" (TestCase (do
+	let Right (i,_)=takeItem mkEmptyInventory sword (Bag 1)
+	let jp=(createTestChar "JP"){inventory=i}
+	let merchant=(createTestChar "Merchant"){inventory=(makeEmptyInventory 10 10)}
+	let sellops=listTradeItems jp merchant Sell (Success Standard 1)
+	assertEqual "Non single Sell" 1 (length sellops)
+	assertEqual "Non equal to sword" (ToSell (Bag 1,sword) 10) (head sellops)
+	))	
+	
+testSellTooDear=TestLabel "Test Sell Too Dear" (TestCase (do
+	let Right (i,_)=takeItem mkEmptyInventory sword (Bag 1)
+	let jp=(createTestChar "JP"){inventory=i}
+	let merchant=(createTestChar "Merchant"){inventory=(makeEmptyInventory 10 1)}
+	assertEqual "Non empty Sell" 0 (length $ listTradeItems jp merchant Sell (Success Standard 1))
+	))		
+	
+testSellHandPremium=TestLabel "Test Sell Hand Premium" (TestCase (do
+	let Right (i,_)=takeItem mkEmptyInventory sword RightHand
+	let jp=(createTestChar "JP"){inventory=i}
+	let merchant=(createTestChar "Merchant"){inventory=(makeEmptyInventory 10 20)}
+	let sellops=listTradeItems jp merchant Sell (Success Standard 1)
+	assertEqual "Non single Sell" 1 (length sellops)
+	assertEqual "Non equal to sword" (ToSell (RightHand,sword) 14) (head sellops)
+	))	
+	
+testExchange=TestLabel "Test Exchange" (TestCase (do
+	let Right (i,_)=takeItem mkEmptyInventory sword (Bag 1)
+	let jp=(createTestChar "JP"){inventory=i}
+	let Right (i2,_)=takeItem mkEmptyInventory sword (Bag 2)
+	let merchant=(createTestChar "Merchant"){inventory=i2}
+	let excops=listTradeItems jp merchant Exchange (Success Standard 1)
+	assertEqual "Non single Exchange" 1 (length excops)
+	assertEqual "Non equal to sword" (ToExchange (Bag 1,sword) (Bag 2,sword) ) (head excops)
+	let Right (ijp2,[])=takeItem i dagger (Bag 2)
+	let Right (im2,[])=takeItem i2 hatchet (Bag 3)
+	assertEqual "getNpcPosition" (Just RightHand) (getNpcPosition (head excops) im2)
+	let (jp2,merchant2,dropped)=doTradeOperation (jp{inventory=ijp2},Just (Bag 2)) (merchant{inventory=im2},Just (Bag 3)) (head excops)
+	assertEqual "JP2 does not have the sword!" (Bag 2,sword) (head $ listCarriedItems $ inventory jp2)
+	assertEqual "Merchant does not have the sword!" (Bag 3,sword) (head $ listCarriedItems $ inventory merchant2)
+	assertEqual "dropped is not 2" 2 (length dropped)
+	assertBool "dropped does not contain dagger" (elem dagger dropped)
+	assertBool "dropped does not contain hatchet" (elem hatchet dropped)
+	))
+	
diff --git a/src/MoresmauJP/Util/Lists.hs b/src/MoresmauJP/Util/Lists.hs
new file mode 100644
--- /dev/null
+++ b/src/MoresmauJP/Util/Lists.hs
@@ -0,0 +1,103 @@
+-- | List utilities
+-- (c) JP Moresmau 2009
+module MoresmauJP.Util.Lists 
+where
+
+import Control.Monad
+import MoresmauJP.Util.Random
+import Data.Either
+import Data.List
+
+tokenize :: (Eq a) => a -> [a] -> [[a]]
+tokenize a l = tokenizeGen (\x->x==a) l
+
+tokenizeGen :: (a->Bool) -> [a] -> [[a]]
+tokenizeGen f l = tokenize' f l []
+
+tokenize' _ [] ss = reverse ss
+tokenize' f s ss = 
+	let 
+		(s1,s2) = break f s
+	in tokenize' f (safeTail s2) (s1:ss)
+	
+safeTail [] = []
+safeTail (_:ss) = ss
+
+maximumIndex :: (Ord a) => [a] -> Int
+maximumIndex []=error "maximumIndex on empty list"
+maximumIndex (x:xs) = snd (maximumIndex' xs (x,0) 1)
+
+maximumIndex' :: (Ord a) => [a] -> (a,Int) -> Int -> (a,Int)
+maximumIndex' [] (m,mi) _ = (m,mi)
+maximumIndex' (x:xs) (m,mi) ix= 
+	let (m',mi')=
+		case x>m of
+			True -> (x, ix)
+			_  -> (m, mi)
+	in maximumIndex' xs (m',mi') (ix+1)
+
+occurenceList :: [(a,Int)] -> [a]
+occurenceList itemOccurences=concat (foldl (\l (it,oc)->(take oc (repeat it)):l) [] itemOccurences)
+
+	
+randomPickp:: (Monad m)=> [a] -> RandT 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' curr [] _= return curr
+		pick' curr (x:xs) prob= do
+			r<-getRandomRange (1,prob)
+			let curr' = if r==1 
+				then x 
+				else curr
+			pick' curr' xs (prob+1)
+
+randomPickpn:: (Monad m,Eq a)=> [a] -> Int -> RandT m [a]
+randomPickpn _ 0= return [] 
+randomPickpn [] _= return []
+randomPickpn l n= pick [] 
+	where 
+	realLength=min (length l) n
+	pick l2 =
+		if	(length l2)==realLength	
+			then return l2
+			else do
+				x<- randomPickp l
+				pick $ nub (x:l2)
+
+randomHeadp :: (Monad m)=> [a] -> RandT m [a]
+randomHeadp [] = return []
+randomHeadp [x] = return [x]
+randomHeadp l =
+	do
+		newIdx<-getRandomRange (0,(length l)-1)
+		let (l1,x:l2) = splitAt newIdx l 
+		return (x:(l1++l2))
+		
+	
+(//) :: [a] -> Int -> a -> [a]
+(//) xs ix newel= let
+	(xs1,xs2)=splitAt ix xs
+	in xs1++(newel:(tail xs2))
+	
+imap :: [a] -> Int -> (a->a) -> [a]
+imap xs ix f= let
+	(xs1,(oldEl:xs2))=splitAt ix xs
+	in xs1++((f oldEl):xs2)
+	
+swap :: (a,b) -> (b,a)
+swap (a,b)=(b,a)
+
+eitherConcat :: [Either [a] [a]] -> Either [a] [a]
+eitherConcat l=foldl eitherConcat' (Right []) l
+
+eitherConcat' (Right a) (Right b)=Right (a++b)
+eitherConcat' (Left a) (Right b)=Left (a++b)
+eitherConcat' (Right a) (Left b)=Left (a++b)
+eitherConcat' (Left a) (Left b)=Left (a++b) 
+
+isRight (Right _)=True
+isRight (Left _)=False
+
diff --git a/src/MoresmauJP/Util/ListsTests.hs b/src/MoresmauJP/Util/ListsTests.hs
new file mode 100644
--- /dev/null
+++ b/src/MoresmauJP/Util/ListsTests.hs
@@ -0,0 +1,43 @@
+-- | List utilites hunit tests
+-- (c) JP Moresmau 2009
+module MoresmauJP.Util.ListsTests where
+
+import Control.Monad.Identity
+
+import MoresmauJP.Util.Lists
+import MoresmauJP.Util.Random
+
+import Test.HUnit
+
+listsTests =TestList [testRandomPickp,testRandomPickpn]
+
+	
+testRandomPickp=TestLabel "Test RandomPick" (TestCase (do
+	let rw=mkTestWrapper [2]
+	let r=runIdentity $ evalRandT (randomPickp [4,5,6,7]) rw
+	assertEqual "r is not first" 4 r
+	let rw=mkTestWrapper [1]
+	let r=runIdentity $ evalRandT (randomPickp [4,5,6,7]) rw
+	assertEqual "r is not last" 7 r
+	let rw=mkTestWrapper [1,2,2,2]
+	let r=runIdentity $ evalRandT (randomPickp [4,5,6,7]) rw
+	assertEqual "r is not second" 5 r
+	))	
+
+testRandomPickpn=TestLabel "Test RandomPickn" (TestCase (do
+	let rw=mkTestWrapper [2]
+	let r=runIdentity $ evalRandT (randomPickpn [4,5,6,7] 1) rw
+	assertEqual "r is not first" [4] r
+	let rw=mkTestWrapper [1]
+	let r=runIdentity $ evalRandT (randomPickpn [4,5,6,7] 1) rw
+	assertEqual "r is not last" [7] r
+	let rw=mkTestWrapper [1,2,2,2]
+	let r=runIdentity $ evalRandT (randomPickpn [4,5,6,7] 1) rw
+	assertEqual "r is not second" [5] r
+	let rw=mkTestWrapper [2,2,2,1,2,2]
+	let r=runIdentity $ evalRandT (randomPickpn [4,5,6,7] 2) rw
+	assertEqual "r is not 5,4" [5,4] r
+	let rw=mkTestWrapper [2,2,1,2,2,2]
+	let r=runIdentity $ evalRandT (randomPickpn [4,5,6,7] 2) rw
+	assertEqual "r is not 4,7" [4,7] r
+	))	
diff --git a/src/MoresmauJP/Util/Numbers.hs b/src/MoresmauJP/Util/Numbers.hs
new file mode 100644
--- /dev/null
+++ b/src/MoresmauJP/Util/Numbers.hs
@@ -0,0 +1,13 @@
+-- | Numeric utilities
+-- (c) JP Moresmau 2009
+module MoresmauJP.Util.Numbers where
+
+avg :: Integral a => [a] -> a
+avg [] = error "Cannot take average of an empty list"
+avg l=avg' (0,0) l
+ 	where 
+ 		avg' (a,b) []=div a b
+		avg' (a,b) (x:xs)=avg' (a+x,b+1) xs
+
+bindInt :: (Int,Int) -> Int -> Int
+bindInt (low,high) score=max low (min high score)
diff --git a/src/MoresmauJP/Util/NumbersTests.hs b/src/MoresmauJP/Util/NumbersTests.hs
new file mode 100644
--- /dev/null
+++ b/src/MoresmauJP/Util/NumbersTests.hs
@@ -0,0 +1,19 @@
+-- | Numeric utilities hunit tests
+-- (c) JP Moresmau 2009
+module MoresmauJP.Util.NumbersTests where
+
+import MoresmauJP.Util.Numbers
+import Test.HUnit
+
+numbersTests=TestList [testAverage,testBindInt]
+
+testAverage=TestLabel "testAverage" (TestCase (do
+	let ls=[1,2,3]
+	assertEqual "average is not 2" 2 (avg ls)
+	))
+	
+testBindInt=TestLabel "testBindInt" (TestCase (do
+	assertEqual "bind low is not 0" 1 (bindInt (1,19) 0)
+	assertEqual "bind normal is not 10" 10 (bindInt (1,19) 10)
+	assertEqual "bind high is not 19" 19 (bindInt (1,19) 20)
+	))
diff --git a/src/MoresmauJP/Util/Random.hs b/src/MoresmauJP/Util/Random.hs
new file mode 100644
--- /dev/null
+++ b/src/MoresmauJP/Util/Random.hs
@@ -0,0 +1,82 @@
+-- | Random handling utilities, including a monad for keeping random generators
+-- (c) JP Moresmau 2009
+module MoresmauJP.Util.Random where
+
+import Control.Monad.Identity
+import Control.Monad.State
+import System.Random
+
+class (Monad m) => MonadRandom m where
+	getRandomRange :: (Int,Int) -> m Int
+	getSplit :: m RandomWrapper
+
+newtype RandT m a = RandT (StateT RandomWrapper m a)
+    deriving (Functor, Monad, MonadTrans, MonadIO)
+
+liftState :: (MonadState s m) => (s -> (a,s)) -> m a
+liftState t = do v <- get
+                 let (x, v') = t v
+                 put v'
+                 return x
+ 
+instance (Monad m) => MonadRandom (RandT m) where
+	getRandomRange (low,high) = RandT . liftState $ randomRange (low,high)
+	getSplit = RandT . liftState $ splitWrapper
+
+evalRandT :: (Monad m) => RandT m a -> RandomWrapper -> m a
+evalRandT (RandT x) g = evalStateT x g
+ 
+runRandT  :: (Monad m) => RandT m a -> RandomWrapper -> m (a, RandomWrapper)
+runRandT (RandT x) g = runStateT x g
+
+--identRandT :: (Monad m) => RandT m a -> RandomWrapper -> Identity a
+identRandT r g= runIdentity (evalRandT r g)
+
+ioRandT r s=do
+	sg<-getStdGen
+	execStateT (evalRandT r (ProductionRandom sg)) s
+
+instance (MonadState s m) => MonadState s (RandT m) where
+    get = lift get
+    put = lift . put
+
+
+newtype Rand a = Rand (RandT Identity a)
+    deriving (Functor, Monad, MonadRandom)
+ 
+evalRand :: Rand a -> RandomWrapper -> a
+evalRand (Rand x) g = runIdentity (evalRandT x g)
+
+runRand :: Rand a -> RandomWrapper -> (a, RandomWrapper)
+runRand (Rand x) g = runIdentity (runRandT x g)
+ 
+evalRandIO :: Rand a -> IO a
+evalRandIO (Rand (RandT x)) =do
+	sg<-getStdGen
+	return $ fst $ (runIdentity . runStateT x) (ProductionRandom sg)
+
+data RandomWrapper =TestRandom [Int]
+	| ProductionRandom StdGen
+	deriving (Show,Read)
+	
+mkTestWrapper l=TestRandom (cycle l)	
+	
+randomRange :: (Int,Int) -> RandomWrapper -> (Int,RandomWrapper)
+randomRange _ (TestRandom [])=error "empty TestRandom"
+randomRange _ (TestRandom (i:l))=(i,TestRandom l)
+randomRange bounds (ProductionRandom g)=let
+	(i,g')=randomR bounds g
+	 in (i,ProductionRandom g')
+	 
+	 
+randomRanges:: (Int,Int) -> RandomWrapper -> Int  -> ([Int],RandomWrapper)
+randomRanges rang gen nb=		
+	foldl (\(r,gen) rang -> 
+		let (r',gen')= randomRange rang gen 
+		in ((r++[r']),gen') 
+		) ([],gen) (replicate nb rang)
+		
+splitWrapper :: RandomWrapper -> (RandomWrapper,RandomWrapper)
+splitWrapper t@(TestRandom {})=(t,t)
+splitWrapper (ProductionRandom g)=let (g1,g2)=split g
+	in (ProductionRandom g1,ProductionRandom g2)
diff --git a/src/MoresmauJP/Util/RandomTests.hs b/src/MoresmauJP/Util/RandomTests.hs
new file mode 100644
--- /dev/null
+++ b/src/MoresmauJP/Util/RandomTests.hs
@@ -0,0 +1,49 @@
+-- | Random handling utilities hunit tests
+-- (c) JP Moresmau 2009
+module MoresmauJP.Util.RandomTests where
+
+import Control.Monad.State
+
+import MoresmauJP.Util.Random
+
+import System.Random
+
+import Test.HUnit
+
+randomTests = TestList [
+	testConstantRandomW,testListRandomW,testRealRandomW,testMonadState]
+	
+testConstantRandomW = TestLabel "Test Constant Random Wrapper" (TestCase (do
+	let tg=mkTestWrapper [2]
+	let l=randomRanges (1,6) tg 3 
+	assertEqual ("l is not 3 2s") [2,2,2] (fst l)
+	return ()
+	))
+	
+testListRandomW = TestLabel "Test List Random Wrapper" (TestCase (do
+	let tg=mkTestWrapper [2,3,4]
+	let l=randomRanges (1,6) tg 4 
+	assertEqual ("l is not 2,3,4,2") [2,3,4,2] (fst l)
+	return ()
+	))
+	
+testRealRandomW = TestLabel "Test Real Random Wrapper" (TestCase (do
+	tg<-getStdGen
+	let prod=ProductionRandom tg
+	let (r,prod')= randomRange (minBound,maxBound) prod 
+	let r'=fst $ randomRange (minBound,maxBound) prod' 
+	assertBool "same value returned" (r/=r')
+	))	
+	
+testMonadState=TestLabel "Test Monad State" (TestCase (do
+	result<-(execStateT (evalRandT (do
+		i<-get
+		die<-getRandomRange (1,6)
+		put (i+die)
+		i<-get
+		die<-getRandomRange (1,6)
+		put (i+die)
+		return ""
+		) (mkTestWrapper [2,4])) 1)
+	assertEqual "result is not 7" 7 result
+	))