blob: 6cf22135a7a4441dc5202fe652a4617d4699a3df (
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
51
52
53
54
55
56
57
58
59
60
61
62
63
64
|
module Xanthous.App (makeApp) where
import Xanthous.Prelude
import Brick hiding (App, halt, continue, raw)
import qualified Brick
import Graphics.Vty.Attributes (defAttr)
import Graphics.Vty.Input.Events (Event(EvKey))
import Control.Monad.State (get)
import Xanthous.Command
import Xanthous.Data (move, Position(..))
import qualified Xanthous.Data.EntityMap as EntityMap
import Xanthous.Game
import Xanthous.Game.Draw (drawGame)
import Xanthous.Monad
import Xanthous.Resource (Name)
import Xanthous.Entities.Creature (Creature)
import qualified Xanthous.Entities.Creature as Creature
import Xanthous.Entities.RawTypes (EntityRaw(..))
import Xanthous.Entities.Raws (raw)
import Xanthous.Entities.SomeEntity
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
testGormlak :: Creature
testGormlak =
let Just (Creature gormlak) = raw "gormlak"
in Creature.newWithType gormlak
startEvent :: AppM ()
startEvent = do
() <- say ["welcome"]
entities %= EntityMap.insertAt (Position 10 10) (SomeEntity testGormlak)
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
|
