MazesOfMonad 1.0.4 → 1.0.5

raw patch · 16 files changed

+300/−76 lines, 16 files

Files

MazesOfMonad.cabal +3/−4
TODO.txt +1/−3
WHATSNEW.txt +10/−0
src/Main.hs +5/−0
src/MoresmauJP/Maze1/Maze.hs +7/−0
src/MoresmauJP/Rpg/Actions.hs +3/−3
src/MoresmauJP/Rpg/Arena.hs +13/−10
src/MoresmauJP/Rpg/Character.hs +16/−3
src/MoresmauJP/Rpg/CharacterTests.hs +2/−1
src/MoresmauJP/Rpg/Fight.hs +2/−2
src/MoresmauJP/Rpg/Inventory.hs +6/−0
src/MoresmauJP/Rpg/Items.hs +14/−0
src/MoresmauJP/Rpg/MazeObjects.hs +33/−7
src/MoresmauJP/Rpg/NPC.hs +55/−5
src/MoresmauJP/Rpg/RPG.hs +69/−38
src/MoresmauJP/Rpg/Stats.hs +61/−0

MazesOfMonad.cabal view

@@ -1,10 +1,9 @@ Name:                MazesOfMonad
-Version:             1.0.4
+Version:             1.0.5
 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.
+	full blown Haskell application is like to develop. Version 1.0.5 is complete and working.
 License:             BSD3
 License-file:        LICENSE
 Author:              JP Moresmau
@@ -29,7 +28,7 @@ 					 ,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.RPG,MoresmauJP.Rpg.Save,MoresmauJP.Rpg.SaveTests,MoresmauJP.Rpg.Stats,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

TODO.txt view

@@ -1,6 +1,4 @@-- traps in maze (can be detected) 
-	-> will change mazeobjects format hence current games would be lost, maybe try to ensure backwards compatibility
-	-> when level improve, more traps
+
 - npcs can use magic?
 
 - when trading, show which items are better than what we have in hands or on body? Maybe this is too much information...

WHATSNEW.txt view

@@ -1,3 +1,13 @@+1.0.5:
+	Feature: Traps in maze (can be detected) (only in new mazes created with 1.0.5 version)
+		-> when level of character improve, more traps are present
+	Fix: number of items went up instead of down as level went up
+	Fix: Dexterity roll to use shield was easier instead of harder when attacker hit better
+	Fix: Spells to yourself lasted forever instead of expiring
+	Internal: gather statistics on games, tune some difficulty settings
+	Fix: escaping caused wrong map output (some corridors marked as walls)
+	Internal: attacking a NPC first causes its attitude to worsen and become hostile, even if he was friendly at first
+	
 1.0.4:
 	Feature: Mind Potions can restore mental points (only in new mazes created with 1.0.4 version)
 	UI: When meeting and fighting a NPC, you see its attitude and status (physical and mental)

src/Main.hs view

@@ -19,6 +19,7 @@ import MoresmauJP.Util.NumbersTests
 import MoresmauJP.Util.RandomTests
 import MoresmauJP.Rpg.ArenaTests
+import MoresmauJP.Rpg.Stats
 
 import Test.HUnit (runTestTT,Test(TestList),Counts(..)) 
 
@@ -28,6 +29,10 @@ 	gs<-initialGameStateInApp
 	start (WList ["Welcome to Mazes of Monad, JP Moresmau's Role-Playing Game","If you don't know what to type, try help!"], gs)
 	return ()
+
+-- | statistics on a game
+stats :: FilePath -> IO(GameStats)
+stats fp=fileGameStats fp
 
 -- | run unit tests
 test :: IO Test.HUnit.Counts

src/MoresmauJP/Maze1/Maze.hs view

@@ -46,6 +46,13 @@ 		in Just (gw2,win)
 	| otherwise = Nothing	
 
+randomMove :: (MonadRandom m) => GameWorld -> m GameWorld
+randomMove gw=do
+	let expls=explored gw
+	toCell <- randomPickp (DataSet.elems (DataSet.delete (position gw) expls))
+	let expls2=DataSet.union expls (DataSet.fromList (getNeighbours toCell (maze gw)))
+	return (gw{position=toCell,explored=expls2})
+
 isMovePossible :: Cell -> Cell -> Maze -> Bool
 isMovePossible from to mz =  elem to (getNeighbours from mz)

src/MoresmauJP/Rpg/Actions.hs view

@@ -13,7 +13,7 @@ 
 initiative = [Dexterity,Willpower]
 melee = [Strength,Dexterity]
-archery = [Dexterity,Perception,Strength]
+--archery = [Dexterity,Perception,Strength]
 conversion=[Charisma,Willpower,Willpower]
 trade=[Charisma,Charisma,Intelligence]
 spellcasting=[Intelligence,Willpower]
@@ -21,8 +21,8 @@ escape=[Dexterity]
 medecine=[Intelligence,Intelligence,Dexterity,Perception]
 pray=[Charisma,Willpower]
-detectTrap=[Perception]
-disableTrap=[Dexterity,Perception]
+detectTrap=[Perception,Perception,Intelligence]
+--disableTrap=[Dexterity,Perception]
 steal=[Dexterity,Dexterity,Intelligence,Perception,Perception]
 
 d20=(1,20)

src/MoresmauJP/Rpg/Arena.hs view

@@ -43,15 +43,15 @@ 	fightInfo::FightInfo
 	} deriving (Show,Read)
 
-screenInteract :: Character -> NPCCharacter -> RandomWrapper -> Int -> IO (ExitState)
-screenInteract c1 c2 rw tc= do
+screenInteract :: Character -> NPCCharacter -> [String]-> RandomWrapper -> Int -> IO (ExitState)
+screenInteract c1 c2 ss rw tc= do
 	let ar=Arena c1 c2 Nothing True [] tc newFightInfo
 	let initialstate=GameState ar (Just (Screen []))
-	evalStateT (evalRandT (screenInteract' c2) rw) initialstate
+	evalStateT (evalRandT (screenInteract' c2 ss) rw) initialstate
 
-screenInteract' :: NPCCharacter -> (RandT (StateT (GameState Arena) IO)) ExitState
-screenInteract' c2 = do
-	let wEncounter=WText (printf "You meet a %s." (ppNPC c2))
+screenInteract' :: NPCCharacter -> [String] -> (RandT (StateT (GameState Arena) IO)) ExitState
+screenInteract' c2 ss= do
+	let wEncounter=combineWidget (WList ss) (WText (printf "You meet a %s." (ppNPC c2)))
 	initial<-getInitialAttitude c2
 	(w,msgs)<-case initial of
 		NPCFight -> do
@@ -59,7 +59,7 @@ 			return (w, (printf "The %s attacks!" (name $ npcCharacter c2)):msgs)
 		NPCWait -> runWriterT chooseAction
 		NPCTrade ->runWriterT tradeInArena
-	let wmsgs=WList msgs
+	let wmsgs=WList ( msgs)
 	let w2=combineWidget wmsgs w
 	commandLoop2 (combineWidget wEncounter w2)
 	(GameState ar2 _)<-get
@@ -154,11 +154,14 @@ 	gs <- get
 	let ar@(Arena {arenaCharacter=c1,arenaOpponent=c2}) = gsData gs
 	((c1b,c2b),rr) <- compete c1 (npcCharacter c2) initiative
+	let att=bindInt (1,8) ((npcAttitude c2)-2)
+	let ar2=ar{arenaCharacter=c1b,arenaOpponent=(c2{npcCharacter=c2b,npcAttitude=att})}
+	put (gs{gsData=ar2})
 	case rr of
 		Success {} -> choiceArena
-		_ ->do
-			put (gs{gsData=ar{arenaCharacter=c1b,arenaOpponent=(c2{npcCharacter=c2b}),chToHit=False}})
-		 	fightInArena'
+		_ -> do
+			put (gs{gsData=ar2{chToHit=False}})
+			fightInArena'
 
 fightInArena' :: WScreenT Arena
 fightInArena' = do

src/MoresmauJP/Rpg/Character.hs view

@@ -103,7 +103,9 @@ 		-- take only 4 best characteristics
 		(take 4 (sortBy (comparing (\ch-> (-(getCharacteristic' c Normal ch)))) allCharacteristics)))
 	+ (div (length $ spells c) 3) -- ponder with spells
-	+ (div (length $ listCarriedItems $ inventory c) 4) -- ponder with items
+	+ (div (length $ listCarriedItems $ inventory c) 3) -- ponder with items
+	- (if (length $ listActiveItems $ inventory c) == 0 then 2 else 0) -- nothing active is a huge problem
+	
 
 mkRating :: Int -> Rating
 mkRating v = Rating (array (Normal,Experience) [(Normal,v),(Current, v),(Experience, 0)])
@@ -176,14 +178,25 @@ 	c1=addCharacteristic' c Current (affected aff) (affect aff)
 	in c1{affects=(aff:a)}
 
+-- | add an affect to the character
+removeAffect :: Character -- ^ the character to affect
+	-> Affect -- ^ the affect
+	-> Character -- ^ the new character
+removeAffect c aff=let
+	c1=addCharacteristic' c Current (affected aff) (-(affect aff))
+	in c1
+
 -- | 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'')
+	c1=foldl removeAffect c a''
+	in (c1{affects=a'},map liftDescription a'')
 	
+	
+	
 recover :: (MonadWriter ScreenMessages m) => Character
 	-> Characteristic
 	-> Int
@@ -222,7 +235,7 @@ restoreWithTimeC c ch1 ch2 tickCount tickToAdd=let 
 	current = getCharacteristic' c Current ch1
 	normal = getCharacteristic' c Normal ch1
-	in if (current<normal) 
+	in if (current>0 && current<normal) 
 		then let
 			current2=getCharacteristic' c Current ch2
 			val=(max 1 (25-current2)) * 20

src/MoresmauJP/Rpg/CharacterTests.hs view

@@ -118,11 +118,12 @@ 	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 "jp5 has not 10 strength" 10 (getCharacteristic' jp5 Current Strength)
 	
 	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)
-
+	assertEqual "jp5 has not 10 dexterity" 10 (getCharacteristic' jp5 Current Dexterity)
 	
 	))

src/MoresmauJP/Rpg/Fight.hs view

@@ -1,7 +1,7 @@ -- | Fight resolution
 -- (c) JP Moresmau 2009
 module MoresmauJP.Rpg.Fight 
-(giveBlow,FightStatus,swapFS) 
+(giveBlow,FightStatus,swapFS,damageArmor) 
 
 where
 
@@ -123,7 +123,7 @@ 		shieldF :: (MonadRandom m,MonadWriter ScreenMessages m)=> (Character,[ItemType]) -> ItemType -> m (Character,[ItemType])
 		shieldF (c,its) it@(Shield {})=do
 			-- dexterity roll on the shield
-			(c1,rr)<-action c [Dexterity] (subsequentDifficulty g)
+			(c1,rr)<-action c [Dexterity] (-(subsequentDifficulty g))
 			if (isSuccess rr)
 				then do
 					addMessage $ Message(c1,ShieldDefense)

src/MoresmauJP/Rpg/Inventory.hs view

@@ -41,6 +41,12 @@ 		itName::String,
 		spellType::String,
 		price::Gold}
+	| Trap {
+		itName::String,
+		damageLow::Int, 
+		damageHigh::Int,
+		triggerDescription::String
+		}
 	deriving (Show,Read,Eq)

src/MoresmauJP/Rpg/Items.hs view

@@ -41,6 +41,11 @@ majorMindPotion=Potion "Major Mind Potion" (MindPotion 9) 30
 totalMindPotion=Potion "Total Mind Potion" (MindPotion 1000) 60
 
+trapDoor=Trap "Trap Door" 3 10 "A trap door opens under your feet!"
+dartLauncher=Trap "Dart Launcher" 2 8 "A dart launches from the wall and hits you!"
+boulderFall=Trap "Boulder" 2 12 "A big boulder falls from the ceiling!"
+
+
 -- occurences of items in the maze
 itemOccurences:: [(ItemType,Int)]
 itemOccurences=	[(sword,12),
@@ -66,6 +71,11 @@ 		(totalMindPotion,1),
 		(Scroll "" "" 40,8)
 	]
+
+trapOccurences :: [(ItemType,Int)]
+trapOccurences = [(trapDoor,4),
+		(dartLauncher,3),
+		(boulderFall,2)]
 	
 isWeapon :: ItemType -> Bool
 isWeapon (Weapon {})=True
@@ -77,6 +87,10 @@ isProtective (Helmet {})=True
 isProtective _ =False
 
+	
+isTrap :: ItemType -> Bool
+isTrap (Trap{})=True
+isTrap _=False	
 	
 canUseItem :: ItemType -> Bool
 canUseItem (Potion {})=True

src/MoresmauJP/Rpg/MazeObjects.hs view

@@ -26,24 +26,26 @@ 
 data MazeOptions = MazeOptions {
 		itemProportion::Int,
-		npcProportion::Int
+		npcProportion::Int,
+		trapProportion::Int
 	}
 	deriving (Read,Show)
 
 generateObjects :: (MonadRandom m)=>Maze -> MazeOptions -> Int -> m MazeObjects
 generateObjects mz options characterLevel =do
-	let ratio=((fromIntegral characterLevel/10.0) ** 2)::Float
+	let ratio=((fromIntegral characterLevel/12.0) ** 2)::Float
 	-- less items as we progress
-	let realItemProportion=(fromIntegral $ itemProportion options) / ratio
+	let realItemProportion=(fromIntegral $ itemProportion options) * ratio
 	itemMap<-generateItems (size mz) realItemProportion
+	let realTrapProportion=(fromIntegral $ trapProportion options) / ratio
+	itemMap2<-generateTraps (size mz) realTrapProportion itemMap
 	npcMap<-generateNPCs mz (fromIntegral $ npcProportion options) characterLevel
-	return (MazeObjects itemMap npcMap)
+	return (MazeObjects itemMap2 npcMap)
 	
 generateItems :: (MonadRandom m)=>Size -> Float -> 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
@@ -57,10 +59,23 @@ 	return (Scroll (printf "Scroll of %s" (spellName s)) (spellName s) g)
 generateScroll it=return it
 
+generateTraps :: (MonadRandom m)=>Size -> Float -> (M.Map Cell [ItemType]) -> m (M.Map Cell [ItemType])
+generateTraps sz proportion m=do
+	cellsWithItems<-getCellWithItems sz proportion
+	let occ=occurenceList trapOccurences
+	foldM (\m cell -> do
+		it <- 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 cellsWithItems
+		
+
 generateNPCs :: (MonadRandom m)=> Maze -> Float -> Int -> m (M.Map Cell NPCCharacter)
 generateNPCs mz proportion characterLevel=do
 	cellsWithItems<-(getCellWithItems (size mz) proportion) 
 	let attitudeModifier=floor ((fromIntegral characterLevel/10.0) ** 2)
+	-- no npc on start cell
 	let cells2=delete (start mz) cellsWithItems
 	let occ=occurenceList (getNPCOccurences characterLevel)
 	foldM (\m cell -> do
@@ -83,8 +98,19 @@ 		celly<-getRandomRange (1,h)
 		return (cellx,celly)
 		
-listItems :: GameWorld -> MazeObjects -> [ItemType]
-listItems gw mo =fromMaybe [] $ M.lookup (position gw) (items mo)
+listPickableItems :: GameWorld -> MazeObjects -> [ItemType]
+listPickableItems gw mo=(filter (not . isTrap)) $ listItems' gw mo
+
+getTrap:: GameWorld -> MazeObjects -> (MazeObjects,Maybe ItemType)
+getTrap gw mo=let
+ 	maybeTrap=listToMaybe $ (filter isTrap) $ listItems' gw mo
+	in case maybeTrap of
+		Nothing->(mo,Nothing)
+		Just it->((MoresmauJP.Rpg.MazeObjects.takeItem gw mo it),Just it)
+
+listItems':: GameWorld -> MazeObjects -> [ItemType]
+listItems' gw mo =fromMaybe [] $ M.lookup (position gw) (items mo)
+
 
 takeItem :: GameWorld -> MazeObjects -> ItemType -> MazeObjects
 takeItem gw mo it=

src/MoresmauJP/Rpg/NPC.hs view

@@ -128,6 +128,23 @@ 	possibleGold=(0,0)	
 	}	
 	
+scorpion=NPCTemplate {
+	typeName="Giant Scorpion",
+	creatureType=Animal,
+	attitudeRange=(4,8),
+	traitRanges=[
+		(Strength,(12,18)),
+		(Dexterity,(14,20)),
+		(Constitution,(15,25)),
+		(Willpower,(12,16)),
+		(Intelligence,(4,6)),
+		(Balance,(10,12)),
+		(Charisma,(1,4)),
+		(Perception,(10,14))],
+	possibleItems=[],
+	possibleGold=(0,0)	
+	}		
+	
 vampire=NPCTemplate {
 	typeName="Vampire",
 	creatureType=Humanoid,
@@ -218,9 +235,10 @@ 			(Just battleaxe,1)]
 			),
 		(LeftHand, [
-			(Nothing,2),
+			(Nothing,1),
 			(Just smallShield,2),
-			(Just bigShield,1)
+			(Just bigShield,1),
+			(Just dagger,2)
 			]
 			),
 		(Body, [
@@ -230,12 +248,43 @@ 			]
 			),
 		(Head,[
-			(Nothing, 3),
+			(Nothing, 1),
 			(Just helmet,2),
 			(Just heaume,1)
 			])],
 	possibleGold=(10,30)	
 	}
+	
+darkElf=NPCTemplate {
+	typeName="Dark Elf",
+	creatureType=Human,
+	attitudeRange=(5,10),	
+	traitRanges=[
+		(Strength,(12,18)),
+		(Dexterity,(16,22)),
+		(Constitution,(10,16)),
+		(Willpower,(10,15)),
+		(Intelligence,(15,22)),
+		(Balance,(10,14)),
+		(Charisma,(12,20)),
+		(Perception,(16,22))],
+	possibleItems=[(RightHand,[
+			(Just sword,3),
+			(Just dagger,1),
+			(Just hatchet,1)]
+			),
+		(LeftHand, [
+			(Nothing,2),
+			(Just sword,2),
+			(Just dagger,4),
+			(Just hatchet,4)]
+			),
+		(Body, [
+			(Just leatherArmor,1),
+			(Nothing,2)	]
+			)],
+	possibleGold=(10,30)	
+	}	
 
 minotaur=NPCTemplate {
 	typeName="Minotaur",
@@ -283,7 +332,8 @@ 
 
 allNPCTemplates :: [NPCTemplate]
-allNPCTemplates= [troll,goblin,kobold,giantRat,snake,vampire,ghoul,outlaw,blackKnight,minotaur,peddler]
+allNPCTemplates= [troll,goblin,kobold,giantRat,snake,scorpion,
+	vampire,ghoul,outlaw,blackKnight,minotaur,peddler,darkElf]
 
 templateAttitudeNoChange=[peddler]
 
@@ -292,7 +342,7 @@ 	let 
 		totalTemplates=length allNPCTemplates
 		ponderedLevel=div (characterLevel * 8) 10
-		likelyhood npc=(npc,totalTemplates - (abs ((templateLevel npc) - ponderedLevel)))
+		likelyhood npc=(npc,max 1 (totalTemplates - (2 * (abs ((templateLevel npc) - ponderedLevel)))))
 	in map likelyhood allNPCTemplates
 		
 templateLevel :: NPCTemplate -> Int

src/MoresmauJP/Rpg/RPG.hs view

@@ -8,14 +8,15 @@ 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.Fight
 import MoresmauJP.Rpg.Items
 import MoresmauJP.Rpg.NPC
 import MoresmauJP.Rpg.Profile
@@ -182,7 +183,8 @@ mazeOptions :: MazeOptions
 mazeOptions = MazeOptions {
 	itemProportion=4,
-	npcProportion=3
+	npcProportion=3,
+	trapProportion=10
 }
 
 
@@ -197,17 +199,12 @@ createMazeState' :: Character -> RPGGameState -> WScreenT 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 
+	let ms=getMazeScreen rpg2
+	let gs2=GameState rpg2 ms 
 	put gs2
-	w<-if isJust ms
-			then mapAction []
-			else do
-				return (WText "Game over")
-	saveGameAndCharacter (combineWidget wGold w)
+	w<-mapAction []
+	saveGameAndCharacter w
 
 getMazeScreen :: RPGState  -> Maybe (Screen RPGState)
 getMazeScreen RPGState{rpgCharacter=Nothing}  = Nothing
@@ -224,7 +221,7 @@ 		statusA=Action "character" "See your current character characteristics" statusAction
 		bckA= Action "archive" "Save a backup of your game and character" saveBackupAction
 		acts=bckA:statusA:mapA:invA:(backAction $ getGameScreen initialScreen):actions
-		items=Objs.listItems (mazegameworld mgs) (objects mgs)
+		items=Objs.listPickableItems (mazegameworld mgs) (objects mgs)
 		acts2=if null items
 			then acts
 			else (Action "pickup" "Pick up an item" (pickupAction items)):acts
@@ -252,7 +249,7 @@ getItems (RPGState {mgs=Nothing})= WNothing
 getItems (RPGState {mgs=Just mgs})=	
 	let 
-		items=Objs.listItems (mazegameworld mgs) (objects mgs)
+		items=Objs.listPickableItems (mazegameworld mgs) (objects mgs)
 	in WList ("You see:": 
 			if null items 
 				then ["Nothing"]
@@ -274,41 +271,74 @@ 	let gw=mazegameworld rmgs
 	sg <- getSplit
 	((WList s,_),(GameState gw2 sc))<- liftIO $ runStateT (evalRandT (runWriterT $ 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)
+				let (objects2,trap)=Objs.getTrap (gw2) (objects rmgs)
+				case trap of
+					Nothing -> checkFight rs2 [] s
+					Just trap-> do
+						let rs3=rs2{mgs=Just (fromJust $ mgs rs2){objects=objects2}}
+						(c2,rr)<-action c1 detectTrap (toIntLevel RatherHard)
+						case rr of 
+							Success {}-> do
+								checkFight rs3 [(printf "You avoid a %s" (itName trap))] s							
+							Failure {grade=gr}-> do
+								--addScreenMessage (triggerDescription trap)
+								let s2=[(triggerDescription trap)]
+								dmg<-roll (damageLow trap, damageHigh trap)
+								(c3,armor)<-damageArmor c2 gr
+								let diff=max 0 (dmg-armor)
+								if (diff>0) 
+									then do
+										let s3=s2++[(printf "You lose %s!" (points Physical diff))]
+										--addScreenMessage (printf "You lose %s!" (points Physical diff))
+										let c4=addCharacteristic' c3 Current Physical (-diff)
+										let rs4=rs3{rpgCharacter=Just c4}
+										let ms=getMazeScreen rs4
+										if isJust ms
+											then checkFight rs4 s3 s
+											else do
+												let gs2=GameState rs4 ms
+												put gs2
+												saveGameAndCharacter (WList  (s3 ++ ["Game over"]))
+									else 
+										checkFight rs3 (s2 ++ ["Your armor protects you."]) s
 		else
 			do
+				let nameC=name $ c1
 				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
+checkFight :: RPGState -> [String] -> [String] -> WScreenT RPGState
+checkFight rs2 pre post= do
+	srw<-getSplit
+	(rs3,wGold)<-liftIO $ processFight rs2 pre 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 (post++itemNames))
+				else mapAction []
+			else do
+				return (WText "Game over")
+	saveGameAndCharacter (combineWidget wGold w)
+
+processFight :: RPGState -> [String] -> 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}) pre 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)
+			es <- screenInteract c npc' pre rw1 (tickCount mgs)
 			(mo,c2,extraGold) <- case (exitStatus es) of
 				Victory -> return $ killNPC (mazegameworld mgs) (objects mgs) (exitCharacter es)
 				EnnemyFlight -> do
@@ -319,8 +349,7 @@ 			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})
+					evalRandT (randomMove gw) rw2
 				_ -> return (mazegameworld mgs)
 			let mgs2=mgs{mazegameworld=gw,objects=mo2,tickCount=exitTickCount es}
 			let rs2=rs{rpgCharacter=Just c2,mgs=Just mgs2}
@@ -329,7 +358,7 @@ 				else WNothing
 			return (rs2,w)
 		else
-			return (rs,WNothing)
+			return (rs,WList pre)
 
 
 
@@ -399,9 +428,11 @@ 	let 
 		Just c=rpgCharacter rs
 		currentTc=tickCount mgs
-		c2=restoreWithTime c currentTc tc
+		newTick=currentTc+tc
+		(c2,s)=expireAffects (restoreWithTime c currentTc tc) newTick
 		mo2=recoverNPCWithTime (objects mgs) currentTc tc
-		rs2=rs{rpgCharacter=Just c2,mgs=(Just mgs{objects=mo2,tickCount=currentTc+tc})}
+		rs2=rs{rpgCharacter=Just c2,mgs=(Just mgs{objects=mo2,tickCount=newTick})}
+	mapM addScreenMessage s
 	saveNewGameState rs2
 	return rs2

+ src/MoresmauJP/Rpg/Stats.hs view

@@ -0,0 +1,61 @@+
+module MoresmauJP.Rpg.Stats where
+
+import qualified Data.Map as M
+import Data.Maybe
+
+import MoresmauJP.Maze1.Maze
+
+import MoresmauJP.Rpg.Character
+import MoresmauJP.Rpg.Items
+import MoresmauJP.Rpg.MazeObjects
+import MoresmauJP.Rpg.NPC
+import MoresmauJP.Rpg.Save
+
+import MoresmauJP.Util.Numbers
+
+import System.Directory
+import System.FilePath
+import System.IO
+
+data GameStats = GameState {
+	charLevel::Int
+	,numberOfNPCs::Int
+	,proportionNPCs::Int
+	,averageNPCLevel::Int
+	,averageNPCAttitude::Int
+	,numberOfItems::Int
+	,proportionItems::Int
+	,numberOfTraps::Int
+	,proportionTraps::Int
+	} deriving (Show,Read)
+
+gameStats :: RPGState -> GameStats
+gameStats rs=let
+	chLevel=characterLevel (fromJust $ rpgCharacter rs)
+	mgw=mazegameworld $ fromJust $ mgs rs
+	(h,w)=size $ maze mgw
+	cellCount=h*w
+	allNPCs=M.elems $ npcs $ objects $ fromJust $ mgs rs
+	npcCount=length allNPCs
+	npcProp=div cellCount npcCount
+	avgAttitude=avg (map npcAttitude allNPCs)
+	avgLevel=avg (map (characterLevel . npcCharacter) allNPCs)
+	allItems=(filter (not . isTrap)) $ concat $ M.elems $ items $ objects $ fromJust $ mgs rs
+	itemCount=length allItems
+	itemProp=div cellCount itemCount
+	allTraps=(filter isTrap) $ concat $ M.elems $ items $ objects $ fromJust $ mgs rs
+	trapCount=length allTraps
+	trapProp=div cellCount trapCount		
+	in GameState chLevel npcCount npcProp avgLevel avgAttitude itemCount itemProp trapCount trapProp
+	
+fileGameStats :: String -> IO GameStats
+fileGameStats name=do
+	dir<-getAppUserDataDirectory "MazesOfMonad"
+	let fp=dir</> (makeValid $ (addExtension name backupExtension))
+	withFile fp ReadMode (\h -> do
+		s<-hGetContents h
+		c<-(readIO s)::IO BackupState
+		let rs=fromBackupState (RPGState Nothing Nothing (takeDirectory fp)) c
+		return (gameStats rs)
+		)