1module Player.Consume where
2
3import Control.Monad.State.Strict
4import Data.Char
5import qualified Data.CaseInsensitive as CI
6import qualified Data.Map as M
7
8import Types
9import Status
10import Unicode
11import World
12import Spell
13import Rand
14import Player
15import Time
16
17isEdible :: Char -> Bool
18isEdible c = isPunctuation c || isSymbol c || isLetter c
19
20playerConsume :: M NextStep -> Char -> M NextStep
21playerConsume cont = handle
22  where
23	handle '!' = do
24		immediateConsume
25		showMessage "Yum! You grow longer.."
26		modifyPlayer $ \p -> p { playerLen = succ (playerLen p) }
27		cont
28	handle '.' = do
29		immediateConsume
30		roll <- randFrom [1..10 :: Int]
31		if roll > 6
32			then do
33				p' <- teachRandomSpell =<< gets player
34				modifyPlayer $ \_ -> p'
35			else showMessage "You try to remember a spell, but fail. (i:Inventory)"
36		cont
37	handle ',' = powerup cont
38	handle '\'' = powerup cont
39	handle c | isPunctuation c || isSymbol c = do
40		showMessage $ "You turn up your nose at eating the " ++ unicodeCharString c
41		noswallow
42	handle c | isEdible c = do
43		m <- gets poisons
44		case M.lookup (CI.mk c) m of
45			Just poison -> do
46				immediateConsume
47				poison c cont
48			Nothing -> do
49				swallowIngredient c cont
50	handle _ = noswallow
51
52	noswallow = do
53		modifyPlayer $ \p -> p { playerSwallowing = Nothing }
54		cont
55
56immediateConsume :: M ()
57immediateConsume = do
58	modifyPlayer $ \p -> p { playerSwallowing = Nothing }
59	p <- gets player
60	writeWorld (playerHead p) ' '
61
62swallowIngredient :: Char -> M NextStep -> M NextStep
63swallowIngredient c cont = do
64	p <- gets player
65	unless (spellCaster p) $
66		showMessage $ "Swallowing " ++ unicodeCharDesc c
67	modifyPlayer $ \_ -> p { playerSwallowing = Just c }
68	cont
69
70powerup :: M NextStep -> M NextStep
71powerup cont = do
72	immediateConsume
73	duration <- randFrom [3..10 :: Int]
74	showMessage "Yum! You feel energetic!"
75	modifyPlayer $ \p -> p { playerEnergized = True }
76	delayAction duration cont $ do
77		p <- gets player
78		when (playerEnergized p && not (playerBerzerk p)) $ do
79			showMessage "The burst of energy fades away.."
80			modifyPlayer $ \pl -> pl { playerEnergized = False }
81