1module Control where
2
3import Control.Monad.State.Strict
4import UI.NCurses (Event(..), Key(..))
5import qualified Data.Map as M
6import Data.Maybe
7import Control.Applicative
8import Prelude
9
10import Types
11import Status
12import Time
13import Player
14import Player.Move
15import Peruser
16import Spell
17import CharMap
18import Poison
19import Help
20import View
21import Curses
22
23mainLoop :: Step
24mainLoop (EventCharacter '\t') = forceRedraw
25mainLoop (EventCharacter c) = case M.lookup c charMap of
26	Just (CharControl (Movement d)) -> move d
27	Just (CharControl Inventory) -> inventory
28	Just (CharControl Help) -> showHelp
29	Just (CharControl Quit) -> checkQuit
30	Just (CharControl Wait) -> wait
31	Just (IngredientFor _ _) -> invokeSwallowed c
32	Just (Poison _) -> ignore
33	Nothing -> invokeSwallowed c
34mainLoop e = maybe ignore move (arrowDirection e)
35
36-- Does not step time
37ignore :: M NextStep
38ignore = next mainLoop
39
40-- Does step time
41continue :: M NextStep
42continue = runPeruser =<< next mainLoop
43
44wait :: M NextStep
45wait = continue
46
47showHelp :: M NextStep
48showHelp = do
49	modify $ \s -> s { helpShown = True }
50	helpWindow
51	next $ \_ -> clearWindows >> ignore
52
53diveIn :: M NextStep
54diveIn = go =<< diveThrough
55  where
56	go False = ignore
57	go True = do
58		modify $ \s -> s { helpShown = True }
59		continue
60
61move :: Direction -> M NextStep
62move DDive = diveIn
63move d = go =<< checkedMove =<< supportStaggaring d
64  where
65	go CannotMove = ignore
66	go EscapedScroll = escapedScroll
67	go (SuccessfulMove a) = a continue
68	go SuccessfulBacktrack = continue
69	go TooFullToMove = do
70		n <- length . mapMaybe segmentSwallowed . playerBody <$> gets player
71		showMessage $ concat
72			[ "You've swallowed "
73			, if n > 1 then "some letters" else "a letter"
74			, ", and cannot drag "
75			, if n > 1 then "them" else "it"
76			, " along."
77			]
78		ignore
79
80invokeSwallowed :: Char -> M NextStep
81invokeSwallowed c = do
82	p <- gets player
83	case toggleInvoke c p of
84		(InvokedChar, p') -> do
85			change p'
86			case checkInvokedSpells p' of
87				[] -> continue
88				l -> invoke l continue
89		(DeInvokedChar, p') -> do
90			change p'
91			continue
92		(NoInvoke, _) -> ignore
93  where
94	change p' = modifyPlayer (const p')
95
96inventory :: M NextStep
97inventory = do
98	showWindow (3, 0) =<< spellInventory
99	next $ \_ -> clearWindows >> ignore
100
101checkQuit :: M NextStep
102checkQuit = prompt "Are you sure you want to quit? [yn]" $ \i -> case i of
103	EventCharacter 'y' -> do
104		showMessage "Bye!"
105		endThread
106	_ -> do
107		clearMessage
108		ignore
109
110forceRedraw :: M NextStep
111forceRedraw = do
112	view <- lift . mkView =<< get
113	let view' = view { viewForceRedraw = True }
114	return $ NextStep view' (Just mainLoop)
115
116escapedScroll :: M NextStep
117escapedScroll = do
118	showMessage "You escaped the scroll! You win!"
119	next $ victorydance (30 :: Int)
120  where
121	victorydance 0 _ = endThread
122	victorydance n e = do
123		let dir = case e of
124			(EventCharacter c) -> case M.lookup c charMap of
125				Just (CharControl (Movement d))
126					| d /= DUp && d /= DDive -> d
127				_ -> DDown
128			(EventSpecialKey KeyLeftArrow) -> DLeft
129			(EventSpecialKey KeyRightArrow) -> DRight
130			_ -> DDown
131		moveaway DDown
132		when (dir /= DDown) $
133			moveaway dir
134		next $ victorydance (n-1)
135
136	moveaway dir = do
137		hpos <- getPos <$> gets player
138		let seg = Segment hpos dir CurrentSide Nothing False
139		setHeadPos $ directionOffset dir `offsetPos` hpos
140		modifyPlayer $ \p -> p { playerBody = shiftBody p seg }
141