TextOutput.hs

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