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