-
Notifications
You must be signed in to change notification settings - Fork 31
/
Copy pathpong2.0-metapong.hs
138 lines (116 loc) · 4.34 KB
/
pong2.0-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
https://github.com/simonmichael/metapong
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 [
-- "********************************************************************************"
-- ,"* *"
-- ,"* *"
-- ,"* *"
-- ,"* *"
-- ,"* *"
-- ,"* *"
-- ,"* *"
-- ,"* *"
-- ,"* *"
-- ,"* *"
-- ,"* *"
-- ,"* *"
-- ,"* *"
-- ,"* *"
-- ,"* *"
-- ,"* *"
-- ,"* *"
-- ,"* *"
-- ,"* *"
-- ,"* *"
-- ,"* *"
-- ,"* *"
-- ,"********************************************************************************"
-- ]