Write snake game in haskell using deepseek-r1

deepseek-r1.txt

使用 haskell 实现一个命令行中的贪吃蛇游戏

贪吃蛇.hs

import System.IO
import System.Random
import Control.Concurrent
import Control.Monad (when, forever)
import Data.List (nub)
import System.Console.ANSI

-- 定义类型别名
type Pos = (Int, Int)
type Direction = (Int, Int)

-- 游戏状态
data GameState = GameState
  { snake :: [Pos]      -- 蛇的身体坐标（头部在列表头）
  , food :: Pos         -- 食物位置
  , dir :: Direction    -- 当前移动方向
  , gen :: StdGen       -- 随机数生成器
  , score :: Int        -- 得分
  }

-- 初始状态
initialState :: StdGen -> GameState
initialState g = GameState
  { snake = [(5, 5), (5,4), (5,3)]  -- 初始蛇身
  , food = (10, 10)                 -- 初始食物位置
  , dir = (0, 1)                    -- 初始方向向右
  , gen = g
  , score = 0
  }

-- 主函数
main :: IO ()
main = do
  hSetBuffering stdin NoBuffering   -- 禁用输入缓冲
  hSetEcho stdin False              -- 关闭输入回显
  g <- newStdGen
  playGame (initialState g)

-- 游戏主循环
playGame :: GameState -> IO ()
playGame state = do
  clearScreen
  drawGame state
  checkInput state

-- 绘制游戏界面
drawGame :: GameState -> IO ()
drawGame state = do
  setCursorPosition 0 0
  putStrLn $ "Score: " ++ show (score state)
  putStrLn $ replicate 20 '-'
  let maxX = 20
      maxY = 15
  mapM_ (drawRow maxX (snake state) (food state)) [0..maxY]

drawRow :: Int -> [Pos] -> Pos -> Int -> IO ()
drawRow maxX snakePos foodPos y = do
  let cells = [cellChar x y | x <- [0..maxX]]
  putStrLn cells
 where
  cellChar x y
    | (x,y) == foodPos = '@'
    | (x,y) `elem` snakePos = if (x,y) == head snakePos then 'O' else 'o'
    | otherwise = ' '

-- 处理输入
checkInput :: GameState -> IO ()
checkInput state = do
  threadDelay 100000  -- 控制游戏速度（100ms）
  input <- getChar'
  let newDir = case input of
        'w' -> (-1, 0)
        's' -> (1, 0)
        'a' -> (0, -1)
        'd' -> (0, 1)
        _   -> dir state
      -- 防止180度转向
      allowedDir = if newDir == oppositeDir (dir state)
                   then dir state
                   else newDir
      newState = state { dir = allowedDir }
  updateGame newState

-- 获取非阻塞输入
getChar' :: IO Char
getChar' = do
  available <- hReady stdin
  if available then getChar else return ' '

oppositeDir :: Direction -> Direction
oppositeDir (dx, dy) = (-dx, -dy)

-- 更新游戏状态
updateGame :: GameState -> IO ()
updateGame state = do
  let (newSnake, ateFood) = moveSnake (snake state) (dir state) (food state)
      (newFood, newGen) = if ateFood
                          then generateNewFood (gen state) newSnake
                          else (food state, gen state)
      collision = checkCollision newSnake
      newScore = if ateFood then score state + 1 else score state
  if collision
    then gameOver newScore
    else playGame $ state { snake = newSnake
                          , food = newFood
                          , gen = newGen
                          , score = newScore
                          }

-- 移动蛇并检测是否吃到食物
moveSnake :: [Pos] -> Direction -> Pos -> ([Pos], Bool)
moveSnake snake dir foodPos = 
  let newHead = moveHead (head snake) dir
      ateFood = newHead == foodPos
      newBody = if ateFood then snake else init snake
  in (newHead : newBody, ateFood)

moveHead :: Pos -> Direction -> Pos
moveHead (x,y) (dx, dy) = (x + dx, y + dy)

-- 生成新食物位置
generateNewFood :: StdGen -> [Pos] -> (Pos, StdGen)
generateNewFood gen snake = 
  let (x, g1) = randomR (0, 20) gen
      (y, g2) = randomR (0, 15) g1
  in if (x,y) `elem` snake
     then generateNewFood g2 snake
     else ((x,y), g2)

-- 碰撞检测
checkCollision :: [Pos] -> Bool
checkCollision snake =
  let headPos = head snake
      body = tail snake
      wallCollision = fst headPos < 0 || fst headPos > 20 ||
                      snd headPos < 0 || snd headPos > 15
  in wallCollision || headPos `elem` body

-- 游戏结束
gameOver :: Int -> IO ()
gameOver score = do
  clearScreen
  setCursorPosition 5 0
  putStrLn "Game Over!"
  putStrLn $ "Final Score: " ++ show score
  putStrLn "Press q to quit"
  waitForQ
  where
    waitForQ = do
      c <- getChar'
      when (c /= 'q') waitForQ