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
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
|
--------------------------------------------------------------------------------
module Xanthous.Game.Draw
( drawGame
) where
--------------------------------------------------------------------------------
import Xanthous.Prelude
import Brick hiding (loc, on)
import Brick.Widgets.Border
import Brick.Widgets.Border.Style
import Brick.Widgets.Edit
--------------------------------------------------------------------------------
import Xanthous.Data
import Xanthous.Data.App (ResourceName, Panel(..))
import qualified Xanthous.Data.App as Resource
import Xanthous.Data.EntityMap (EntityMap, atPosition)
import qualified Xanthous.Data.EntityMap as EntityMap
import Xanthous.Game.State
import Xanthous.Entities.Character
import Xanthous.Entities.Item (Item)
import Xanthous.Game
( GameState(..)
, entities
, revealedPositions
, characterPosition
, characterVisiblePositions
, character
, MessageHistory(..)
, messageHistory
, GamePromptState(..)
, promptState
, debugState, allRevealed
)
import Xanthous.Game.Prompt
import Xanthous.Orphans ()
--------------------------------------------------------------------------------
cursorPosition :: GameState -> Widget ResourceName -> Widget ResourceName
cursorPosition game
| WaitingPrompt _ (Prompt _ SPointOnMap (PointOnMapPromptState pos) _ _)
<- game ^. promptState
= showCursor Resource.Prompt (pos ^. loc)
| otherwise
= showCursor Resource.Character (game ^. characterPosition . loc)
drawMessages :: MessageHistory -> Widget ResourceName
drawMessages = txtWrap . (<> " ") . unwords . reverse . oextract
drawPromptState :: GamePromptState m -> Widget ResourceName
drawPromptState NoPrompt = emptyWidget
drawPromptState (WaitingPrompt msg (Prompt _ pt ps pri _)) =
case (pt, ps, pri) of
(SStringPrompt, StringPromptState edit, _) ->
txtWrap msg <+> txt " " <+> renderEditor (txt . fold) True edit
(SDirectionPrompt, DirectionPromptState, _) -> txtWrap msg
(SContinue, _, _) -> txtWrap msg
(SMenu, _, menuItems) ->
txtWrap msg
<=> foldl' (<=>) emptyWidget (map drawMenuItem $ itoList menuItems)
_ -> txtWrap msg
where
drawMenuItem (chr, MenuOption m _) =
str ("[" <> pure chr <> "] ") <+> txtWrap m
drawEntities
:: (Position -> Bool)
-- ^ Is a given position directly visible to the character?
-> (Position -> Bool)
-- ^ Has a given position *ever* been seen by the character?
-> EntityMap SomeEntity -- ^ all entities
-> Widget ResourceName
drawEntities isVisible isRevealed allEnts
= vBox rows
where
entityPositions = EntityMap.positions allEnts
maxY = fromMaybe 0 $ maximumOf (folded . y) entityPositions
maxX = fromMaybe 0 $ maximumOf (folded . x) entityPositions
rows = mkRow <$> [0..maxY]
mkRow rowY = hBox $ renderEntityAt . flip Position rowY <$> [0..maxX]
renderEntityAt pos
= let entitiesAtPosition = allEnts ^. atPosition pos
immobileEntitiesAtPosition =
filter (not . entityCanMove) entitiesAtPosition
in renderTopEntity pos
$ if | isVisible pos -> entitiesAtPosition
| isRevealed pos -> immobileEntitiesAtPosition
| otherwise -> mempty
renderTopEntity pos ents
= let neighbors = EntityMap.neighbors pos allEnts
in maybe (str " ") (drawWithNeighbors neighbors)
$ maximumBy (compare `on` drawPriority)
<$> fromNullable ents
drawMap :: GameState -> Widget ResourceName
drawMap game
= viewport Resource.MapViewport Both
. cursorPosition game
$ drawEntities
(`member` characterVisiblePositions game)
(\pos -> (game ^. debugState . allRevealed)
|| (pos `member` (game ^. revealedPositions)))
(game ^. entities)
bullet :: Char
bullet = '•'
drawInventoryPanel :: GameState -> Widget ResourceName
drawInventoryPanel game
= drawWielded (game ^. character . inventory . wielded)
<=> drawBackpack (game ^. character . inventory . backpack)
where
drawWielded (Hands Nothing Nothing) = emptyWidget
drawWielded (DoubleHanded i) =
txtWrap $ "You are holding " <> description i <> " in both hands"
drawWielded (Hands l r) = drawHand "left" l <=> drawHand "right" r
drawHand side = maybe emptyWidget $ \i ->
txtWrap ( "You are holding "
<> description i
<> " in your " <> side <> " hand"
)
<=> txt " "
drawBackpack :: Vector Item -> Widget ResourceName
drawBackpack Empty = txtWrap "Your backpack is empty right now."
drawBackpack backpackItems
= txtWrap ( "You are currently carrying the following items in your "
<> "backpack:")
<=> txt " "
<=> foldl' (<=>) emptyWidget
(map
(txtWrap . ((bullet <| " ") <>) . description)
backpackItems)
drawPanel :: GameState -> Panel -> Widget ResourceName
drawPanel game panel
= border
. hLimit 35
. viewport (Resource.Panel panel) Vertical
. case panel of
InventoryPanel -> drawInventoryPanel
$ game
drawCharacterInfo :: Character -> Widget ResourceName
drawCharacterInfo ch = txt " " <+> charName <+> charHitpoints
where
charName | Just n <- ch ^. characterName
= txt $ n <> " "
| otherwise
= emptyWidget
charHitpoints
= txt "Hitpoints: "
<+> txt (tshow $ let Hitpoints hp = characterHitpoints ch in hp)
drawGame :: GameState -> [Widget ResourceName]
drawGame game
= pure
. withBorderStyle unicode
$ case game ^. promptState of
NoPrompt -> drawMessages (game ^. messageHistory)
_ -> emptyWidget
<=> drawPromptState (game ^. promptState)
<=>
(maybe emptyWidget (drawPanel game) (game ^. activePanel)
<+> border (drawMap game)
)
<=> drawCharacterInfo (game ^. character)
|
