1module Player where
2
3import Control.Monad.State.Strict
4import qualified Data.Vector.Mutable as MV
5import Control.Applicative
6import Data.Maybe
7import Prelude
8
9import Types
10import Level.Border
11
12modifyPlayer :: (Player -> Player) -> M ()
13modifyPlayer f = modify $ \s -> s { player = f (player s) }
14
15isSpellCaster :: M ()
16isSpellCaster = modify $ \s -> s { player = (player s) { spellCaster = True } }
17
18shiftBody :: Player -> Segment -> [Segment]
19shiftBody p segment
20	| playerLen p == 0 = []
21	| length (playerBody p) >= playerLen p = segment : shrinkBody p
22	| otherwise = segment : playerBody p
23
24shrinkBody :: Player -> [Segment]
25shrinkBody = reverse . drop 1 . reverse . playerBody
26
27-- Does not adjust the body.
28setHeadPos :: Pos -> M ()
29setHeadPos pos = modifyPlayer $ \p -> p { playerHead = pos }
30
31-- Moves the player head and each segment up 1 space.
32-- This is called when the scroll moves.
33shiftPlayerUp :: M ()
34shiftPlayerUp = modifyPlayer $ offsetPos (id, pred)
35
36-- Find a starting position for the player that is
37-- not occupied a letter, and from which the player can dive to the help
38-- level.
39--
40-- The help level has a lot of whitespace in its first line, so the player
41-- is put on the first line. In the unlikely event that there is no
42-- suitable starting in the first line, one letter is destroyed to make
43-- one.
44startingPosition :: M ()
45startingPosition = do
46	w <- gets world
47	l <- lift $ MV.read w 2
48	divable <- scanv [0..MV.length l - 1] checkCanDiveTo
49	usable <- scanv divable $ lift . checkBounded w
50	if null usable
51		then do
52			let x = midpoint divable
53			lift $ MV.write l x ' '
54			setHeadPos (x, 2)
55		else setHeadPos (midpoint usable, 2)
56  where
57	scanv range cond = do
58		ms <- forM range $ \x -> do
59			ok <- cond (x, 2)
60			return $ if ok then Just x else Nothing
61		return (catMaybes ms)
62	midpoint [x] = x
63	midpoint l = l !! pred (length l `div` 2)
64
65-- In order to be able to dive through the scroll, there needs to be a
66-- bordered area waiting on the flipSide.
67--
68-- This does not check if the player is in a position (empty stomach,
69-- etc to use the spot), or check if the player will be able to dive
70-- back from the flipSide to this side.
71checkCanDive :: M Bool
72checkCanDive = checkCanDiveTo =<< (playerHead <$> gets player)
73
74checkCanDiveTo :: Pos -> M Bool
75checkCanDiveTo pos = do
76	w <- gets flipSide
77	lift $ checkBounded w pos
78
79removeSwallowing :: (Char -> Bool) -> Player -> Player
80removeSwallowing match p = case playerSwallowing p of
81	Just c | match c -> p { playerSwallowing = Nothing }
82	_ -> p
83
84-- Only positions on the current side of the scroll.
85wormPositions :: M [Pos]
86wormPositions = do
87	p <- gets player
88	ps <- wormTailPositions
89	return (playerHead p : ps)
90
91wormTailPositions :: M [Pos]
92wormTailPositions = do
93	p <- gets player
94	let segs = filter (\s -> segmentSide s == CurrentSide) (playerBody p)
95	return $ map getPos segs
96