はじめに

Haskell Advent Calendar 2024 の 12 日目の投稿です。
Haskellのアドベントカレンダーが開催されていることを知り、何か書いて参加したいな〜と思っていたのですが、なかなかいい感じのネタが見つからず...

ふとゲームを作ればいいということに気づいたので、ちょっと前に流行っていたゲーム2048を作成してみることにしました！

まだまだHaskellに関しては未熟者ですが、一応完成したので簡単なコードの説明を書いておきます。

ChatGPTと協力しながら書いているので、変な書き方をしているかもしれないです。もっといい書き方がありましたら指摘していただけるとありがたいです！

スクリーンショット

目標

ターミナルで動く2048を作成する。

ゲームのルール

グリッド構成
4×4のグリッド上に数字が書かれたタイルを配置します。ゲーム開始時にランダムに2つのタイルが配置されます。
操作方法
W、A、S、Dキーを使用してタイルを移動させます。すべてのタイルが指定した方向にスライドします。
タイルの結合
スライド中に、同じ数字のタイルが衝突すると1つのタイルに結合され、その値が合計されます（例: 2 + 2 = 4）。結合されたタイルは次のスライドまで再び結合することはありません。（例えば、[2,2,2,2]を左にスライドさせると、[4,4,0,0]になる。）
新しいタイルの生成
各スライドの後、空いている位置に新しいタイル（2または4）がランダムに生成されます。生成されるタイルは、2が90%、4が10%の確率です。
ゲームの終了
プレイヤーがタイルをスライドさせる操作ができなくなった場合（すべてのグリッドが埋まり、結合できるタイルがない状態）、ゲームオーバーとなります。
目標
数字「2048」のタイルを作成することが一応目標です。ただ、2048を作ったあともさらに高いスコアを目指してプレイを続けることができます。

準備

プロジェクトはstackで作成しました。
ちなみにstackはmacであれば、Homebrewを使って簡単にインストールできます。

brew install stack

今回のプロジェクトは以下のコマンドで作成しました。

stack new game2048

コード

早速コードを全部貼っちゃいます。
今回はすべて、Main.hsに書く設計にしました。

module Main (main) where

import Control.Monad.State
import Control.Monad (when)
import Data.List (intercalate, transpose)
import Data.Maybe (fromJust)
import System.Random (randomRIO)
import System.Console.ANSI (Color(..), SGR(..), ConsoleLayer(..), ColorIntensity(..), setSGRCode)
import System.Exit (exitSuccess)

----------
-- Grid --
----------

type Grid = [[Int]]
type Pos = (Int, Int)

-- グリッドのサイズ
size :: Int
size = 4

-- 空のグリッドを作成する関数
emptyGrid :: Grid
emptyGrid = replicate size (replicate size 0)

-- グリッドをコンソールに描画する関数
renderGrid :: Grid -> IO ()
renderGrid grid = do
    mapM_ (putStrLn . renderRow) grid

-- グリッドを更新する関数
updateGrid :: Grid -> [(Pos, Int)] -> Grid
updateGrid = foldl updateCell
  where
    updateCell g ((r, c), val) = take r g
                            ++ [updateRow (g !! r) c val]
                            ++ drop (r + 1) g
    updateRow row c val = take c row ++ [val] ++ drop (c + 1) row

-- 一行をレンダリングするための補助関数
renderRow :: [Int] -> String
renderRow row = "|" ++ intercalate " | " (map formatTile row) ++ "|"

-- 固定幅と色で1つのタイルをフォーマットする補助関数
formatTile :: Int -> String
formatTile 0 = "    "  -- 空のセルはスペースとして表現
formatTile n = coloredString (tileColor n) (padString $ show n) 

-- タイルを揃えるためのパディングを追加
padString :: String -> String
padString s = let padding = replicate (4 - length s) ' ' in padding ++ s

-----------
-- Color --
-----------

-- 数値に対応する色を指定する関数
tileColor :: Int -> Color
tileColor n = case n of
    2    -> Yellow
    4    -> Green
    8    -> Cyan
    16   -> Blue
    32   -> Magenta
    64   -> Red
    128  -> Yellow
    256  -> Green
    512  -> Cyan
    1024 -> Blue
    2048 -> Magenta
    _    -> Red -- 2048以上のタイル用

-- 文字列に色を適用する関数
coloredString :: Color -> String -> String
coloredString color s = setSGRCode [SetColor Foreground Vivid color] ++ s ++ setSGRCode [Reset]

-----------
-- Game --
-----------

type Game a = StateT Grid IO a
data Direction = L | R | U | D

-- 入力文字列を方向に変換する関数
convertToDirection :: String -> Maybe Direction
convertToDirection "w" = Just U
convertToDirection "a" = Just L
convertToDirection "s" = Just D
convertToDirection "d" = Just R
convertToDirection _ = Nothing

-- タイルを結合し、サイズを正規化する関数
mergeTiles :: Int -> [Int] -> [Int]
mergeTiles n tiles = normalize n (merge (filter (/= 0) tiles))

-- ゼロを取り除き、長さを正規化
normalize :: Int -> [Int] -> [Int]
normalize n xs = take n (xs ++ repeat 0)

-- タイルを結合する補助関数
merge :: [Int] -> [Int]
merge [] = []
merge [x] = [x]
merge (x:y:xs)
    | x == y    = x * 2 : merge xs
    | otherwise = x : merge (y : xs)

-- 指定した方向にタイルを移動する関数
applyMove :: Direction -> Grid -> Grid
applyMove direction grid = case direction of
    L -> map (mergeTiles size) grid
    R -> map (reverse . mergeTiles size . reverse) grid
    U -> transpose $ map (mergeTiles size) (transpose grid)
    D -> transpose $ map (reverse . mergeTiles size . reverse) (transpose grid)

-- ランダムな位置にタイルを生成する関数
generateRandomTile :: Grid -> IO (Maybe Grid)
generateRandomTile grid = do
  let emptyTiles = [(r, c) | r <- [0..size-1], c <- [0..size-1], grid !! r !! c == 0]
  if null emptyTiles then return Nothing
  else do
        newTilePos <- (emptyTiles !!) <$> randomRIO (0, length emptyTiles - 1)
  　　　-- 値をランダムに選択（90%が2、10%が4）
        newTileValue <- randomRIO (1, 10 :: Int) >>= \x -> return $ if x <= 9 then 2 else 4
        -- 新しいタイルでグリッドを更新
        return $ Just $ updateGrid grid [(newTilePos, newTileValue)]

-- ゲームオーバーかどうかを判定する関数
checkGameOver :: Grid -> Bool
checkGameOver grid = all (== grid) [applyMove d grid | d <- [L, R, U, D]]

-- ゲームのメインループ 
runGame :: String -> Game ()
runGame consoleLog = do
    grid <- get

    liftIO $ do
        putStrLn "(Use WASD to move the tiles, and Q to quit.)"
        renderGrid grid
        putStrLn $ "Score: " ++ show (sum $ map sum grid)
    
    if checkGameOver grid
      then do
        liftIO $ do
            putStrLn $ coloredString Red "Game Over!"
            exitSuccess  -- プログラムを終了
      else do
        liftIO $ putStrLn consoleLog

    playerInput <- liftIO getLine

    -- Qキーでゲームを終了する 
    when (playerInput == "q") $ do
        liftIO $ do
          putStrLn "Thanks for playing!"
          exitSuccess  -- プログラムを終了

    -- WASDキーで移動する
    case convertToDirection playerInput of
        Just direction -> do
            let movedGrid = applyMove direction grid
            newGrid <- liftIO $ generateRandomTile movedGrid
            case newGrid of
                Just g -> do
                    put g
                Nothing -> return ()
        Nothing -> do
            runGame $ coloredString Yellow "Invalid input. Try again."
    runGame ""

-- ゲームを初期化して実行するメイン関数
main :: IO ()
main = do
    firstGrid <- fromJust <$> generateRandomTile emptyGrid 
    secondGrid <- fromJust <$> generateRandomTile firstGrid
    evalStateT (runGame "") secondGrid

githubはこちら
game2048のディレクトリ内で以下を実行すれば遊べると思います！

stack build
stack run

基本方針

グリッドは、type Grid = [[Int]]で表し、数字がないタイルは0で表します。
mergeが実際の結合を行っている関数で、mergeTilesが今回の状況に合うようにいい感じにmergeをラップした関数です。

詰まったところ

import文のエラー

not found: Could not load module ‘Control.Monad.State’
It is a member of the hidden package ‘mtl-2.3.1’.

というエラーが出ました。
これは、packgae.yamlのdependenciesの部分を修正することで直ります。

dependencies:
- base >= 4.7 && < 5
- mtl >= 2.3 && < 3
- ...（他の依存関係）

プログラムを終了させる方法

System.ExitのexitSuccessを使用します。

ログをまとめて出力する

Invalid input. Try again.のような警告の文章はユーザーの入力に近い場所、つまり、一番下に出力したいです。しかし、コンソールに出力する処理はrunGame関数のプレイヤーの入力を受け取る前だけで行いたいです。そこで、consoleLogというStringの引数を追加して、次のrungameで警告がある際は表示するというようにしました。
何もログで出力する必要がない場合は、空の文字列を出力して、行数が崩れないようにしました。

感想

知らない関数がたくさんありました...
要精進です！

参考記事