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