blob: 3561d35a3bb211a9472ab2e7a731bdcd1581fb20 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
|
module Xanthous.App (makeApp) where
import Xanthous.Prelude
import Brick hiding (App, halt, continue)
import qualified Brick
import Graphics.Vty.Attributes (defAttr)
import Graphics.Vty.Input.Events (Event(EvKey))
import Control.Monad.State (get)
import Xanthous.Game
import Xanthous.Game.Draw (drawGame)
import Xanthous.Resource (Name)
import Xanthous.Command
import Xanthous.Data (move)
import Xanthous.Monad
type App = Brick.App GameState () Name
type AppM a = AppT (EventM Name) a
makeApp :: IO App
makeApp = pure $ Brick.App
{ appDraw = drawGame
, appChooseCursor = const headMay
, appHandleEvent = \state event -> runAppM (handleEvent event) state
, appStartEvent = runAppM $ startEvent >> get
, appAttrMap = const $ attrMap defAttr []
}
runAppM :: AppM a -> GameState -> EventM Name a
runAppM appm = fmap fst . runAppT appm
startEvent :: AppM ()
startEvent = say ["welcome"]
handleEvent :: BrickEvent Name () -> AppM (Next GameState)
handleEvent (VtyEvent (EvKey k mods))
| Just command <- commandFromKey k mods
= do messageHistory %= hideMessage
handleCommand command
handleEvent _ = continue
handleCommand :: Command -> AppM (Next GameState)
handleCommand Quit = halt
handleCommand (Move dir) = do
characterPosition %= move dir
continue
handleCommand PreviousMessage = do
messageHistory %= popMessage
continue
|
