MazesOfMonad-1.0.4: src/MoresmauJP/Rpg/NPCTests.hs
-- | 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,testFightAttitudes,
testFightAttitudesAlready,testFightAttitudesAnimal]
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 0) (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
))
testFightAttitudes=TestLabel "Test Fight Attitudes" (TestCase (do
let npc1=createTestNPC "NPC"
let vc1=addCharacteristic' ((npcCharacter npc1){inventory=makeFullInventory [] 10 100}) Current Physical (-5)
assertEqual "not 50%" 50 (getCurrentPercentOfNormal vc1 Physical)
let npc=npc1{npcCharacter=vc1}
let fightInfo=addCharacterLoss (addCharacterLoss
(addNPCLosses newFightInfo npc1 npc)
Physical 1) Physical 1
let attitudes=getFightAttitudes npc fightInfo
assertEqual "not 4 attitudes" 4 (length attitudes)
let expected=[(ContinueFight,11),(TryEscape,6),(PrayForClemency,3),(OfferBribe 100,3)]
assertEqual "not expected" expected attitudes
))
testFightAttitudesAlready=TestLabel "Test Fight Attitudes Excluding Already Chosen" (TestCase (do
let npc1=createTestNPC "NPC"
let vc1=addCharacteristic' ((npcCharacter npc1){inventory=makeFullInventory [] 10 100}) Current Physical (-5)
assertEqual "not 50%" 50 (getCurrentPercentOfNormal vc1 Physical)
let npc=npc1{npcCharacter=vc1}
let fightInfo=(addCharacterLoss (addCharacterLoss
(addNPCLosses newFightInfo npc1 npc)
Physical 1) Physical 1){hasBribed=True,hasPrayed=True}
let attitudes=getFightAttitudes npc fightInfo
assertEqual "not 4 attitudes" 4 (length attitudes)
let expected=[(ContinueFight,11),(TryEscape,6),(PrayForClemency,0),(OfferBribe 100,0)]
assertEqual "not expected" expected attitudes
))
testFightAttitudesAnimal=TestLabel "Test Fight Attitudes Animal" (TestCase (do
let npc1=(createTestNPC "NPC"){npcType=Animal}
let vc1=addCharacteristic' ((npcCharacter npc1){inventory=makeFullInventory [] 10 100}) Current Physical (-5)
assertEqual "not 50%" 50 (getCurrentPercentOfNormal vc1 Physical)
let npc=npc1{npcCharacter=vc1}
let fightInfo=(addCharacterLoss (addCharacterLoss
(addNPCLosses newFightInfo npc1 npc)
Physical 1) Physical 1)
let attitudes=getFightAttitudes npc fightInfo
assertEqual "not 4 attitudes" 4 (length attitudes)
let expected=[(ContinueFight,11),(TryEscape,6),(PrayForClemency,0),(OfferBribe 100,0)]
assertEqual "not expected" expected attitudes
))