-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathmetapong.hs
138 lines (115 loc) · 4.3 KB
/
metapong.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
{-
metapong.hs
http://hackage.haskell.org/package/ansi-terminal-game/docs/Terminal-Game.html
-}
{-# LANGUAGE RecordWildCards #-}
module Main where
import Terminal.Game
-- import Lib
--------------------------------------------------------------------------------
-- Data types
-- Game st - an ANSI terminal game with custom state, from Terminal.Game.
-- The "world" state of a pong game.
data Pong = Pong {
sQuit :: Bool
,sBallX :: Column
,sBallY :: Row
,sBallVX :: Int
,sBallVY :: Int
}
-- A pong game.
type PongGame = Game Pong
--------------------------------------------------------------------------------
-- Setup
fps = 30
w = 80
h = 24::Int
xmin = 2
xmax = 79
ymin = 2
ymax = 23
main :: IO ()
main = do
g <- newPongGame
playGame g
newPongGame :: IO PongGame
newPongGame = do
s <- newPong
return $
Game{
gTPS = fps
,gInitState = s
,gLogicFunction = gameUpdate
,gDrawFunction = gameDraw
,gQuitFunction = gameShouldQuit
}
newPong :: IO Pong
newPong = return $ Pong {
sQuit = False
,sBallX = w `div` 2
,sBallY = h `div` 2
,sBallVX = 2
,sBallVY = 1
}
--------------------------------------------------------------------------------
-- Logic
gameShouldQuit = sQuit
gameUpdate genv s ev =
gameShouldQuitUpdate s ev &
ballUpdate
gameShouldQuitUpdate s ev =
case ev of
KeyPress 'q' -> s{sQuit = True}
_ -> s
ballUpdate s@Pong{..} =
s{sBallX=bx''
,sBallY=by''
,sBallVX=bvx
,sBallVY=bvy
}
where
bx' = sBallX + sBallVX
by' = sBallY + sBallVY
(bx'', bvx) | bx' > xmax = (bx' - 1, -sBallVX)
| bx' < xmin = (bx' + 1, -sBallVX)
| otherwise = (bx' , sBallVX)
(by'', bvy) | by' > ymax = (by' - 1, -sBallVY)
| by' < ymin = (by' + 1, -sBallVY)
| otherwise = (by' , sBallVY)
--------------------------------------------------------------------------------
-- Drawing
gameDraw genv s@Pong{..} =
walls s &
(sBallY,sBallX) % ball s
ball s = color White Vivid $ cell 'o'
walls _ =
color Blue Dull $
box w h '*' &
(2,2) % box (w-2) (h-2) ' ' &
(h,w `div` 2 - 4) % stringPlane " q: quit "
-- stringPlane $ unlines [
-- "********************************************************************************"
-- ,"* *"
-- ,"* *"
-- ,"* *"
-- ,"* *"
-- ,"* *"
-- ,"* *"
-- ,"* *"
-- ,"* *"
-- ,"* *"
-- ,"* *"
-- ,"* *"
-- ,"* *"
-- ,"* *"
-- ,"* *"
-- ,"* *"
-- ,"* *"
-- ,"* *"
-- ,"* *"
-- ,"* *"
-- ,"* *"
-- ,"* *"
-- ,"* *"
-- ,"********************************************************************************"
-- ]