Codeworld: 使用Haskell实现一个贪吃蛇小游戏

1
2
3
4
5

import CodeWorld

main :: IO()
main = do
       drawingOf $ circle 1

1
2
3
4
5
6
7

import CodeWorld

main :: IO ()
main = drawingOf triangle

triangle :: Picture
triangle = polygon [(9,9),(0,-9),(-9,9)]

1
2
3
4
5
6

import CodeWorld

main :: IO ()
main = drawingOf ourPicture

ourPicture = colored green $ solidCircle 2

1
2
3
4
5
6

import CodeWorld

main :: IO ()
main = drawingOf $ ourPicture & (solidCircle 5)

ourPicture = colored green $ solidCircle 2

1
2
3
4
5
6

import CodeWorld

main :: IO ()
main = drawingOf $ ourPicture & translated 1 2 $ solidCircle 1

ourPicture = colored green $ solidCircle 1

  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
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221

import CodeWorld
import Data.List
import Data.Text(pack, unpack)
import System.Random

type RandomNumber = Int
gridSize = 0.5
-- 为了美观，
gridSizeHf = 0.25
-- 坐标（0，0）为中心， 经调整（0，0）的格子占用（0，0）-（0.5，0.5）空间

main :: IO()
main = do
       gen <- getStdGen
       activityOf (initialWorld gen) handleEvent drawWorld
       --         初始化              事件相应     绘制
       
-- 定义游戏状态，GameIdle              
data GameState = GameIdle 
               | GameRunning
               | GameOver
               deriving(Show, Eq)
              
data World = World {
        rnds :: [RandomNumber]
      , state :: GameState
      , snake :: Snake
      , apple :: Apple
      , areaWidth :: Double
      , areaHeight :: Double
      }

initialWorld :: StdGen -> World
initialWorld gen = restartWorld rnds width height
      where rnds = randomRs (round(0-width), round(width-2)) gen
            width = 20 :: Double
            height = 20 :: Double
      
restartWorld :: [RandomNumber] -> Double -> Double -> World
restartWorld rnds w h = World rnds' GameRunning snake apple w h
    where snake = mkSnake (-3, 0) 3 blue
          apple = mkApple ((fromIntegral r1) / 2, (fromIntegral r2) / 2) green
          (r1:r2:rnds') = rnds
 
drawWorld :: World -> Picture
drawWorld world
  | state world == GameOver = draw world
                              & translated 0 (1)
                                (styledLettering Bold Handwriting 
                                  (pack "Game Over"))
                              & translated 0 (-1)
                                (styledLettering Bold Handwriting 
                                  (pack score_str))
  | otherwise = draw world
  where draw world = drawSnake (snake world)
                   & drawApple (apple world)
                   & rectangle (areaWidth world) (areaHeight world)
        score_str = "Playing Score is: " ++ (show $ score $ snake world)

-- 蛇的方向
data Direction = DirectUp
               | DirectDown
               | DirectLeft
               | DirectRight
               deriving(Show, Eq, Ord)
-- 蛇的动作
data SnakeAction = SnakeNoAct
                 | SnakeMove
                 | SnakeEat
                 | SnakeDead
                 deriving(Show, Eq)
-- 定义蛇 
data Snake = Snake {
    bodyPoints :: [Point]
  , ds :: Double
  , score :: Double
  , direct :: Direction
  , color :: Color
  , width :: Double
 }
 
-- 初始化蛇 
mkSnake :: Point -> Int -> Color -> Snake
mkSnake startPoint len color = Snake body 0 0 DirectUp color w
  -- unfoldr 展开函数，从一个点生成其他点，直到产生Nothing
  where body = unfoldr (\\i -> if i < len 
                              then Just((x, y - w * fromIntegral i), i+1) 
                              else Nothing) 
                        0 -- 初始值
        (x, y) = startPoint
        w = gridSize
--  foldr1 相当于 foldr 起始值为列表第一个值
--  . 函数与数学定义相似，f.g(x) 相当于 g(f(x))
drawSnake :: Snake -> Picture
drawSnake snake = foldr1 (&) blks 
  where blks = map ((colored snkColor) . drawBodyBlk) snkBody
        snkColor = color snake
        snkBody = bodyPoints snake
        drawBodyBlk (x, y) = translated (x + gridSizeHf) (y + gridSizeHf)
                           $ solidRectangle (w - 0.05) (w - 0.05)
        -- solidRectangle 画图默认中心（0，0）， translated 加上 gridSizeHf 使其正好对应方格
        w = width snake

-- 蛇转向
turnSnake :: Direction -> Snake -> Snake
turnSnake dir snake = if isConflictDirect dir (direct snake)
                         then snake
                         else snake { direct = dir }
                         where isConflictDirect dir1 dir2
                                 | dir1 == DirectUp && dir2 == DirectDown = True
                                 | dir1 == DirectDown && dir2 == DirectUp = True
                                 | dir1 == DirectRight && dir2 == DirectLeft = True
                                 | dir1 == DirectLeft && dir2 == DirectRight = True
                                 | otherwise = False
-- 蛇前进一个单位  
moveSnake :: Snake -> Snake
moveSnake snake = snake { ds = 0, bodyPoints = pts }
                  where ptsOrg = bodyPoints snake
                        pts = pt : init ptsOrg -- 去尾加头
                        pt = translatedPoint dx dy $ head ptsOrg
                        (dx, dy) = getSnakeDxDy snake
-- 按当前方向蛇头的移动dx，dy                        
getSnakeDxDy snake@(Snake _ _ _ direct _ w)
  | direct == DirectUp = (0, w)
  | direct == DirectDown = (0, -w)
  | direct == DirectLeft = (-w, 0)
  | direct == DirectRight = (w, 0)

-- 吃苹果
eatingSnake :: Snake -> Snake
eatingSnake snake = snake { ds = 0, score = score', bodyPoints = pts}
                      where ptsOrg = bodyPoints snake
                            pts = pt : ptsOrg
                            pt = translatedPoint dx dy $ head ptsOrg
                            (dx, dy) = getSnakeDxDy snake
                            score' = score snake + 1
                                                
data Apple = Apple {
    positionA :: Point
  , colorA :: Color
  , widthA :: Double
    }
mkApple :: Point -> Color -> Apple
mkApple pos color = Apple pos color 0.25

-- 显示苹果
drawApple :: Apple -> Picture
drawApple apple@(Apple pos color width)
    = translated (x + gridSizeHf) (y + gridSizeHf)
      $ colored color
      $ solidCircle width
      where (x, y) = pos

-- 随机生成苹果     
randowApple :: World ->  (Apple, [RandomNumber])
randowApple world@(World rnds _ _ apple w h) = (mkApple pos color, rnds')
  where pos = ((fromIntegral r1) / 2, (fromIntegral r2) /2)
        color = if colorOrg == red then green else red
        (r1:r2:rnds') = rnds
        colorOrg = colorA apple
        
handleEvent :: Event -> World -> World

-- 计时事件
handleEvent (TimePassing dt) w
  | state w == GameOver = w
  | otherwise = handleSnakeAction snake' action 
                $ w
  where (snake', action) = checkSnakeAction dt w (snake w)

-- 按键事件
handleEvent (KeyPress keyText) w
  | state w == GameOver
     && unpack keyText == "Enter" = restartWorld (rnds w) areaW areaH
  | unpack keyText == "Down" = w { snake = turnSnake DirectDown snake' }
  | unpack keyText == "Up" = w { snake = turnSnake DirectUp snake' }
  | unpack keyText == "Left" = w { snake = turnSnake DirectLeft snake' }
  | unpack keyText == "Right" = w { snake = turnSnake DirectRight snake' }
  | otherwise = w
    where snake' = snake w
          areaW = areaWidth w
          areaH = areaHeight w
handleEvent _ w = w

-- 进行一步动作
handleSnakeAction :: Snake -> SnakeAction -> World -> World
handleSnakeAction snake' action w
  | action == SnakeMove = w {snake = moveSnake snake'}
  | action == SnakeEat = w { snake = eatingSnake snake'
                           , apple = apple' -- 重新生成苹果
                           , rnds = rnds'}
  | action == SnakeNoAct = w { snake = snake' }
  | action == SnakeDead = w { state = GameOver }
    where (apple', rnds') = randowApple w

snakeSpeed = 0.05

-- 碰撞检测部分
checkSnakeAction :: Double -> World -> Snake -> (Snake, SnakeAction)
checkSnakeAction dt world snakeS
  = if ds' > snkW then (snakeS { ds = 0 }, action ) -- 动了超过一格
                  else (snakeS { ds = ds' }, action1 )
    where ds' = ds snakeS + dt + snakeSpeed
          snkW = width snakeS
          headOrg = head $ bodyPoints $ snake world -- 蛇头
          headN = translatedPoint dx dy headOrg -- 新蛇头
          (dx, dy) = getSnakeDxDy snakeS
          
          appleOrg = apple world
          (snkHead:snkTail) = bodyPoints $ snake world
          -- 动了超过一格，判断吃或只移动（死了下一帧判断）
          action = if headN == positionA appleOrg then SnakeEat else SnakeMove
          -- 判断蛇头是否撞蛇身或出界
          action1 = if headOrg `elem` snkTail
                     || outofBound headOrg
                    then SnakeDead else SnakeNoAct
          outofBound (x, y) = if x < 0 - maxW || x > maxW - gridSize
                                || y < 0 - maxH || y > maxH - gridSize
                              then True else False
          maxW = areaWidth world / 2
          maxH = areaHeight world / 2