1module Poison where
2
3import Control.Monad.State.Strict
4import qualified Data.CaseInsensitive as CI
5import qualified Data.Map as M
6import Data.Char
7import Data.Maybe
8import Control.Applicative
9import Prelude
10
11import Types
12import Rand
13import Status
14import Time
15import Peruser
16import Poison.Enum
17import CharMap
18import Player
19import World
20
21allPoisons :: M.Map (CI.CI Char) PoisonEffect
22allPoisons = M.fromList
23	[ (find PoisonMold, mold)
24	, (find PoisonStunner, stunner)
25	, (find PoisonFungus, fungus)
26	]
27  where
28	find p = case M.lookup (Poison p) charUseMap of
29		Nothing -> error $ "internal error; cannot find " ++ show p ++ " in charUseMap"
30		Just c -> CI.mk c
31
32mold :: PoisonEffect
33mold c cont = do
34	showMessage $ "You eat a moldy " ++ [toUpper c] ++ ". You feel lethargic.."
35	origspeed <- peruseSpeed <$> gets peruser
36	let newspeed = max 0 (origspeed - 2)
37	let delta = origspeed - newspeed
38	changePeruser $ \p -> p
39		{ peruseSpeed = newspeed
40		, peruseCountDown = peruseCountDown p - 1
41		}
42	duration <- randM $ randomR (10,15)
43	delayAction duration cont $ do
44		-- Note use of delta to restore, not origspeed.
45		-- Other things may also be changing the peruser speed.
46		changePeruser $ \p -> p { peruseSpeed = peruseSpeed p + delta }
47		showMessage "You feel less lethargic now."
48
49stunner :: PoisonEffect
50stunner c cont = do
51	showMessage $ "The " ++ [toUpper c] ++ " stuns you! You can't walk straight!"
52	modifyPlayer $ \p -> p { playerStaggering = True }
53	duration <- randM $ randomR (5,10)
54	delayAction duration cont $ do
55		modifyPlayer $ \p -> p { playerStaggering = False }
56		len <- length . playerBody <$> gets player
57		showMessage $ "You now feel more steady on your " ++ show (len * 2) ++ " tiny feet."
58
59supportStaggaring :: Direction -> M Direction
60supportStaggaring d = go . playerStaggering =<< gets player
61  where
62	go False = return d
63	go True = do
64		showMessage "Stunned, you stagger.."
65		d' <- randFrom [minBound..maxBound]
66		roll <- randFrom [1..10 :: Int]
67		if roll < 8 && d' /= DDive
68			then return d'
69			else return d
70
71fungus :: PoisonEffect
72fungus = startFungalInfection
73
74moreFungus :: PoisonEffect
75moreFungus c cont = go =<< stillInfected c
76  where
77	go False = startFungalInfection c cont
78	go True = do
79		showMessage $ "Pushing through this fungus is slowing you down.."
80		next $ \_ -> cont
81
82startFungalInfection :: Char -> M NextStep -> M NextStep
83startFungalInfection sporechar cont = do
84	spreadFungus sporechar
85	go =<< stillInfected sporechar
86  where
87	go True = do
88		modify $ \s -> s { poisons = M.insert (CI.mk sporechar) moreFungus (poisons s) }
89		showMessage $ "The fungal " ++ [toUpper sporechar] ++ " covers your body with spores! You should scrape them off somehow before they spread.."
90		fork (fungalInfection sporechar) cont
91	go False = do
92		showMessage "You deftly avoid the fungal spores."
93		cont
94
95fungalInfection :: Char -> M NextStep
96fungalInfection sporechar = go =<< stillInfected sporechar
97  where
98	go False = do
99		showMessage "Finally you escaped the fungal infection!"
100		endThread
101	go True = do
102		spreadFungus sporechar
103		next $ \_ -> fungalInfection sporechar
104
105spreadFungus :: Char -> M ()
106spreadFungus sporechar = do
107	-- Look for any whitespace surrounding the front half of
108	-- the body, on the current scroll side, and plant fungus there.
109	-- Note that fungus is not placed in front of the head.
110	p <- gets player
111	wp <- wormPositions
112	let contagionzone = take ((playerLen p `div` 2) + 2) wp
113	let exclusionzone = wp ++ (nearby $ playerHead p)
114	wspos <- filter (`notElem` exclusionzone) . concat
115		<$> mapM (findNearby isSpace) contagionzone
116	mapM_ (growSpore sporechar) wspos
117
118-- If there is no more fungus around the worm's tail the infection is over.
119stillInfected :: Char -> M Bool
120stillInfected sporechar = not . null . concat
121	<$> (mapM (findNearby (== sporechar)) =<< wormTailPositions)
122
123growSpore :: Char -> Pos -> M ()
124growSpore sporechar p = do
125	roll <- randFrom [1..10 :: Int]
126	when (roll > 3) $
127		writeWorld p sporechar
128
129nearby :: Pos -> [Pos]
130nearby pos = map (flip offsetPos pos . directionOffset)
131	[DLeft, DRight, DUp, DDown]
132
133findNearby :: (Char -> Bool) -> Pos -> M [Pos]
134findNearby want pos = catMaybes <$> mapM check (nearby pos)
135  where
136	check p = do
137		v <- readWorldSafe p
138		case v of
139			Just c | want c -> return (Just p)
140			_ -> return Nothing
141