Fight.hs

-- | 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)