-- | 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.NPC 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 c) $$ (text "---") $$ (ppSpells c) $$ (text "---") $$ (ppProfiles c) $$ (ppAffects c) $$ (ppStatus c) ppTraits :: Character -> Doc ppTraits c= vcat (map f (assocs $ traits c)) where f (char,r)=(text $ show char) $$ (nest (m+2) (text $ show r)) $$ (nest (m+15) ( case char of Physical -> text $ ppPhysical c Mental -> text $ ppMental c _ -> empty )) 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 "-" 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 ppAttitude :: NPCCharacter -> String ppAttitude (NPCCharacter{npcAttitude=a}) | a<5="very vostile" | a<9="hostile" | a<13="neutral" | a<17="friendly" | otherwise="very friendly" ppPhysical :: Character -> String ppPhysical c=ppPhysical' $ getCurrentPercentOfNormal c Physical where ppPhysical' :: Int -> String ppPhysical' a | a<11="nearly dead" | a<26="very seriously wounded" | a<51="badly wounded" | a<75="injured" | a<100="bruised and scratched" | otherwise="in perfect health" ppMental :: Character -> String ppMental c=ppPhysical' $ getCurrentPercentOfNormal c Mental where ppPhysical' :: Int -> String ppPhysical' a | a<11="verging on the totally insane" | a<26="rambling" | a<51="chaotic" | a<75="haggard" | a<100="a bit agitated" | otherwise="fully sane" ppNPC :: NPCCharacter -> String ppNPC npc=let c=npcCharacter npc in printf "a %s, looking %s and apparently %s and %s" (name c) (ppAttitude npc) (ppPhysical c) (ppMental c)