-
Notifications
You must be signed in to change notification settings - Fork 0
/
Main.hs
181 lines (164 loc) · 6.43 KB
/
Main.hs
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
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
{-Written by Måns Andersson-}
module Main where
import UI.NCurses
import Data.Time.Clock.POSIX(POSIXTime, getPOSIXTime)
import Control.Monad.IO.Class(liftIO)
import Data.Char(toUpper)
import System.Exit(exitSuccess)
import Control.Concurrent(threadDelay)
import Data.List(genericLength)
import Game
main = runCurses $ do
setEcho False
w <- newWindow (rows+1) (columns+20) 0 0
gameLoop w initialGameState
{-The main gameloop!-}
gameLoop :: Window -> GameState -> Curses ()
gameLoop w gs = do
red <- newColorID ColorRed ColorDefault 1
blue <- newColorID ColorBlue ColorDefault 2
white <- newColorID ColorWhite ColorDefault 3
{-This part renders gameplay.-}
updateWindow w $ do
setColor white
sequence drawWalls
setColor red
sequence (drawPlayer (getP1 gs) 'x')
setColor blue
sequence (drawPlayer (getP2 gs) 'o')
setColor white
drawScores (getScore gs)
render
checkWinScore w gs
checkState w gs
{-Reads the current time from the system. We need this to control the
pace of the game. It is possible to use liftIO since Curses is an instance
of the MonadIO typeclass.-}
currenttime <- liftIO getPOSIXTime
{-Halts for 1 ms looking for events. If these are any relevant button
presses they will affect the game.-}
e <- getEvent w (Just 1)
gameLoop w $ updateGameState gs e currenttime
{-If a player has reached the winningScore the inner state is changed.-}
checkWinScore :: Window -> GameState -> Curses ()
checkWinScore w gs
| p1score == winningScore = checkState w $ changeState Player1Won gs
| p2score == winningScore = checkState w $ changeState Player2Won gs
| otherwise = return ()
where (p1score, p2score) = getScore gs
{-Checks the inner state of the GameState and acts accordingly.-}
checkState :: Window -> GameState -> Curses()
checkState w gs
| state == Running = return ()
| state == Player1Coll = do
drawMessage "PLAYER 2 GOT A POINT!" w
delaySeconds 2 w
updateWindow w clear
gameLoop w $ GameState Running initialP1 initialP2 0 (getScore gs)
| state == Player2Coll = do
drawMessage "PLAYER 1 GOT A POINT!" w
delaySeconds 2 w
updateWindow w clear
gameLoop w $ GameState Running initialP1 initialP2 0 (getScore gs)
| state == DoubleColl = do
drawMessage "YOU BOTH GOT A POINT!" w
delaySeconds 2 w
updateWindow w clear
gameLoop w $ GameState Running initialP1 initialP2 0 (getScore gs)
| state == Player1Won = do
drawMessage "PLAYER 1 WON THE GAME!" w
delaySeconds 3 w
updateWindow w clear
gameLoop w $ initialGameState
| state == Player2Won = do
drawMessage "PLAYER 2 WON THE GAME!" w
delaySeconds 3 w
updateWindow w clear
gameLoop w $ initialGameState
| state == Draw = do
drawMessage "NOBODY WON! IT IS A DRAW!" w
delaySeconds 3 w
updateWindow w clear
gameLoop w $ initialGameState
| state == Quit = liftIO exitSuccess
| state == MainMenu = do
drawMessage "WELCOME TO HASKADE! PRESS SPACE TO START" w
waitForSpace w
updateWindow w clear
gameLoop w $ changeState Running gs
where state = getState gs
{-Uses the getEvent function in ncurses to simply delay the game.
Used for messages.-}
delaySeconds :: Integer -> Window -> Curses ()
delaySeconds s w = do
liftIO $ threadDelay (fromIntegral time)
return ()
where time = s * 1000000
{-Loops until spacebar is pressed. If esc is pressed the game exits.-}
waitForSpace :: Window -> Curses ()
waitForSpace w = loop
where loop = do
e <- getEvent w Nothing
case e of
Just (EventCharacter ' ') -> return ()
Just (EventCharacter '\ESC') -> liftIO exitSuccess
_ -> loop
{-Calls a composition of functions that changes the gamestate in some way.-}
updateGameState :: GameState -> Maybe Event -> POSIXTime -> GameState
updateGameState gs e ptime = (readEvent e) . (moveGame time) $ gs
where time = getMilliSeconds ptime
{-Transforms the POSIXTime timestamp to a millisecond value.
Used to control the pace of the game.-}
getMilliSeconds :: POSIXTime -> Timestamp
getMilliSeconds t = round $ t * 1000
{-Checks if the event is a relevant button press and performs the relevant
action.-}
readEvent :: Maybe Event -> GameState -> GameState
readEvent (Just (EventCharacter k)) gs@(GameState s p1 p2 ts sc)
| k `isKey` 'w' = GameState s (changeDirection p1 Game.Up) p2 ts sc
| k `isKey` 'a' = GameState s (changeDirection p1 Game.Left) p2 ts sc
| k `isKey` 's' = GameState s (changeDirection p1 Game.Down) p2 ts sc
| k `isKey` 'd' = GameState s (changeDirection p1 Game.Right) p2 ts sc
| k `isKey` 'i' = GameState s p1 (changeDirection p2 Game.Up) ts sc
| k `isKey` 'j' = GameState s p1 (changeDirection p2 Game.Left) ts sc
| k `isKey` 'k' = GameState s p1 (changeDirection p2 Game.Down) ts sc
| k `isKey` 'l' = GameState s p1 (changeDirection p2 Game.Right) ts sc
| k `isKey` '\ESC' = changeState Quit gs
where isKey k i = k == i || k == (toUpper i)
readEvent _ gs = gs
{-Drawing functions.-}
{-Draws a string at the center of the game area.-}
drawMessage :: String -> Window -> Curses ()
drawMessage m w = do
updateWindow w $ do
moveCursor (centerY-5) (centerX - ((genericLength m) `div`2))
drawString m
render
-- updateWindow w clear
{-Draws a specified char at specified coordinates.-}
drawChar :: Char -> Integer -> Integer -> Update ()
drawChar ch row col = do
moveCursor row col
drawString [ch]
{-Draws a specified char at the location of a specified PBlock.-}
drawPBlock :: Char -> PBlock -> Update ()
drawPBlock ch pb = drawChar ch (yCoord pb) (xCoord pb)
{-Draws the walls based on the constants rows and columns in the Game module.-}
drawWalls :: [Update ()]
drawWalls = leftright ++ topbottom
where leftright = (drawChar '#') <$> [0..rows-1] <*> [0,columns-1]
topbottom = (drawChar '#') <$> [0,rows-1] <*> [0..columns-1]
{-Draws all the PBlocks that form the Player. The head gets drawn differently
(as an arrow) than the rest of the Player.-}
drawPlayer :: Player -> Char -> [Update ()]
drawPlayer [] _ = []
drawPlayer (h:t) ch = (drawPBlock dirChar h):(drawPlayerTail t)
where drawPlayerTail t = map (drawPBlock ch) t
dirChar = getDirectionChar(getDir h)
{-Draws the scores at the right side of the playing field.-}
drawScores :: Score -> Update ()
drawScores (p1, p2) = do
moveCursor 2 (columns+2)
drawString ("Player 1: " ++ (show p1))
moveCursor 3 (columns+2)
drawString ("Player 2: " ++ (show p2))