|ハイブリッドOS|File System|ARM|Android|Java|制御システム|オープンシステム

 

技術者コラム

 
フォーム
 
第40回目:Haskellでテトリス(Part8)
2015-01-25
筆者:村田

こんにちは。

新しいプログラミング勉強サイト(exercism.io)を試しています。問題を解くと他のユーザから良い書き方についてのフィードバックがもらえます。問題を解くと次の問題が手に入るというゲーム感覚と、対応言語が多い(現在20種類)ところが面白いです。私はまだHaskell問題しか手をつけていませんが、他にC#、Javaの問題や、Swift、CoffeeScriptなど新しい言語もあります。ちょっと暇な時間にプログラミングでも、という時におすすめです。

さて、テトリス作成の続きです。前回、IORefを扱ってテトリミノを操作できるようになりましたが、今のままではテトリミノが画面外にまで移動できてしまいます。移動できるかどうかの判定が必要ですね。そこで、まずはテトリミノをボードに配置できるかチェックする関数を作りたいと思います。

canPut :: Board -> Mino -> Bool
canPut board mino = all check (getPosList mino)
  where check (x,y) = board!!y!!x == E    -- その場所が空(E)ならば置いてよし 

all関数の型は以下のとおりで、述語関数とリストを渡して、リストの全要素がTrueであるかをチェックする関数です。

all :: (a -> Bool) -> [a] -> Bool

canPut関数をテストしてみましょう。T−ミノを初期位置から左に3回移動できるかテストします。

> let board = initBoard
> let mino = foldr moveMino t_Mino [LEFT,LEFT,LEFT]
> canPut board mino
True

4回は移動できないことをテストします。

> let mino = foldr moveMino t_Mino [LEFT,LEFT,LEFT,LEFT]
> canPut board mino
False

次に、前回作成のキーボードイベント処理を改造します。テトリミノの移動を確定する前にcanPut関数でチェックしたいと思います。if式を使って以下のように書くことができます。

if canPut (getBoard gameStatus) newMino                                   
  then writeIORef gameStatusRef $ gameStatus { getMino = newMino }
  else return ()

if式はthen句とelse句の型を揃える必要があります。then句の方はwriteIORefの戻り値ですからIO ()型です。今回else句でやりたいことが無いのですが、Haskellのif式はelse句を省略できませんので、空のIO ()型の値を生成して返しています。なんだかちょっと無駄な記述ですね。

条件を満たした時にのみ副作用を発生させる、というのは頻出パターンですので、もう少しスッキリ書ける便利な関数があります。Control.Monadモジュールのimportが必要です。

> :m + Control.Monad
> :t when
when :: Monad m => Bool -> m () -> m ()

IOモナド以外にも使える関数ですが、ここでは型変数mをIOに置き換えて考えると

when :: Bool -> IO () -> IO ()

という型になります。when関数を使って先程のif式を書き換え、さらにキーボードイベント処理に組み込みましょう。

  -- キーボード操作イベント処理
  window `on` keyPressEvent $ do
  ...
      -- 移動後の新しいテトリミノを取得
      let newMino = moveMino move (getMino gameStatus)
      -- 新しいテトリミノを配置できる場合にゲーム状態を更新
      when (canPut (getBoard gameStatus) newMino) $
        writeIORef gameStatusRef $ gameStatus { getMino = newMino }
  ...

else句を書かなくて良いので便利です。これでテトリミノが画面外に移動しないようになりました。次は自動落下処理を実装したいと思います。まずはタイマー処理をどんな風に書くか調べてみましょう。Hackageで見つけてきました。Graphics.UI.Gtk.General.GenralモジュールのtimeoutAdd関数を使います。

timeoutAdd :: IO Bool -> Int -> IO HandlerId

第1引数に実行するIOモナドを渡します。このモナドがTrueを返している間繰り返し実行されます。第2引数はタイマ間隔をミリ秒で設定します。ではtimeoutAdd関数に渡すIOモナド(落下処理)を書きましょう。このIOモナドは少し大きいですが、特に新しいトピックはありませんので一気に載せます。

autoDown :: IORef GameStatus -> IO ()
autoDown gameStatusRef = do
  -- 現在のボードとテトリミノを取得する
  gameStatus <- readIORef gameStatusRef
  let board = getBoard gameStatus
  let mino = getMino gameStatus

  -- テトリミノを落下させる
  let downMino = moveMino DOWN mino

  if canPut board downMino then
    -- ボードに置ける場合、落下テトリミノを現在のテトリミノとして確定する
    writeIORef gameStatusRef gameStatus { getMino = downMino }
  else do
    -- ボードに置けない場合、落下前のテトリミノを固定化したボードを作る
    let fixedBoard = putMino mino board
    -- 現在のボードを更新し、新しいテトリミノを出現させる
    writeIORef gameStatusRef gameStatus { getBoard = fixedBoard
                                        , getMino = t_Mino }

ポイントは最後のelse句です。落下できないテトリミノはその場所で固定化されユーザーは操作できなくなります。そして、次の新しいブロックが画面上端から落ちてきます。なお、今のところ新しく出現するテトリミノはT-ミノに限定しています。さて、このautoDownというIOモナドをtimeoutAdd関数に渡してタイマー実行してみましょう。main関数の中でtimeout関数を使います。

main = do
  ...
  -- タイムアウトイベント処理(1秒間隔)
  timeoutAdd (autoDown gameStatusRef) 1000
  ... 

っと、コンパイルエラーです。timeoutAdd関数の第1引数にはIO Bool型が必要ですが、(autoDwon gameStatusRef)はIO ()型ですね。タイマ呼び出しをずっと繰り返したいのでTrueをIOモナドに包んで最後に返します。複数のIOモナドを合成する方法は、do記法(Part2で解説)の中でIOモナドを並べるだけです。以下のように書いてみましょう。

  timeoutAdd (do
    autoDown gameStatusRef
    return True) 1000

コンパイルは通りました。ですが、まだバグがあります。ゲーム状態の上ではテトリミノが落下しているのですが、画面が更新されていません。描画イベントをキックしましょう。最終的に以下のようなコードになります。

  -- タイムアウトイベント処理(1秒間隔)
  timeoutAdd (do
    autoDown gameStatusRef -- 自動落下
    widgetQueueDraw window -- 描画イベントをキック
    return True) 1000

もう一歩実装を進めましょう。新しく出現するテトリミノをT-ミノに限定していましたが、ランダムに出現するようにしたいと思います。ランダムな値の取得も副作用の一つなのでIOモナドの出番です。以下のgetStdRandom関数でランダムな値を取得できます。System.Randomモジュールのインポートが必要です。

> :m System.Random
> :t getStdRandom
getStdRandom :: (StdGen -> (a, StdGen)) -> IO a

型を見ると引数を渡す必要があるようです。引数の型は(StdGen -> (a, StdGen))という型ですね。つまり関数を渡すようです。まずはStdGen型について調べてみましょう。

> :i StdGen
data StdGen = System.Random.StdGen GHC.Int.Int32 GHC.Int.Int32
    -- Defined in ‘System.Random’
instance Read StdGen -- Defined in ‘System.Random’
instance Show StdGen -- Defined in ‘System.Random’
instance RandomGen StdGen -- Defined in ‘System.Random’

ここで一つ手掛かりを得ました。StdGenはRandomGen型クラスのインスタンスになっているようです。RandomGen型クラスはどんなインタフェースを持っているか・・・ここでは深く見ていきませんが、:iで調べることができます。

さて、どういう式でStdGen -> (a, StdGen)という型の値(関数)を作れるでしょうか。よく分からないのでHoogle(https://www.haskell.org/hoogle/)で調べてみましょう。サーチボックスにStdGen -> (a, StdGen)と調べたい型を入力すると関連する関数を検索してくれます。ドンピシャの関数は見つかりませんでしたが、以下の2つの関数に目をつけました。

random :: (Random a, RandomGen g) => g -> (a, g)
randomR :: (Random a, RandomGen g) => (a, a) -> g -> (a, g)

StdGen型はRandomGenの一員ですので、上記は以下の関数として見ることができます。

random :: (Random a) => StdGen -> (a, StdGen)
randomR :: (Random a) => (a, a) -> StdGen -> (a, StdGen)

それと型変数aにも型クラス制約が付いていますね。型変数aはRandom型クラスのインスタンスでなければなりません。またghciに聞いてみましょう。

> :i Random
class Random a where
  (省略)
    -- Defined in ‘System.Random’
instance Random Integer -- Defined in ‘System.Random’
instance Random Int -- Defined in ‘System.Random’
instance Random Float -- Defined in ‘System.Random’
instance Random Double -- Defined in ‘System.Random’
instance Random Char -- Defined in ‘System.Random’
instance Random Bool -- Defined in ‘System.Random’

なるほど、数値や文字などランダムな値になりうる型はRandom型クラスのインスタンスになっているようです。うーむ、一度に頭に入れる型や型クラスが多くなってくると結構辛いものがありますが、型合わせのパズルゲームだと思って色々試して感覚をつかみましょう。えっと、つらつら書きましたが、実はちゃんとマニュアル(http://hackage.haskell.org/package/random-1.1/docs/System-Random.html)を見れば使い方が書いてあります。

ではgetStdRandom関数にrandom関数(StdGen -> (a, StdGen))をそのまま渡しましょう。

> getStdRandom random
4148883647209122850
> getStdRandom random
4539755041900508187
> getStdRandom random
147028643959194987

ランダムな数値が得られました。しかし、数が大きすぎますね。もらった数を剰余(mod)すれば丸められますが、もう一方の関数、randomR関数を調べてみましょう。この関数は引数に(a,a)をもらうところがrandom関数と異なるところです。マニュアルを見ると値の範囲(range)を渡すようです。試してみましょう。

> getStdRandom $ randomR (0,6)
3
> getStdRandom $ randomR (0,6)
2
> getStdRandom $ randomR (0,6)
6

OK、これを使っていきましょう。7種類のテトリミノからランダムに選択する関数は以下のようになります。

-- テトリミノをランダムに選択する
getRandomMino :: IO Mino
getRandomMino = do
  i <- getStdRandom $ randomR (0,6)
  return $ [i_Mino,o_Mino,s_Mino,z_Mino,j_Mino,l_Mino,t_Mino]!!i

では先程のautoDown関数を修正して、T-ミノ固定ではなくランダムなテトリミノが出現するようにしましょう。

autoDown :: IORef GameStatus -> IO ()
autoDown gameStatusRef = do
  ... 
    -- 新しいテトリミノをランダムに選択する
    newMino <- getRandomMino
    -- 現在のボードを更新し、新しいテトリミノを出現させる
    writeIORef gameStatusRef gameStatus { getBoard = fixedBoard
                                        , getMino = newMino }

今回はここまでにします。参考画像のように大分テトリスっぽくなりました。あとはライン消し処理を実装するだけです。ふ〜。

以上。
 
参考画像
2015-01-25
 
第39回目:Haskellでテトリス(Part7)
2015-01-10
筆者:村田

新年おめでとうございます。今年も皆様にとって実り多い良き一年でありますように。

昨年に引き続きテトリスの実装を行います。今回はキーボードでテトリミノを操作できるようにしたいと思います。キーボードの入力もイベントモナドで取得します。Hackageサイトでそれっぽいイベントを探してみるとkeyPressEventというイベントがありました。

keyPressEvent :: WidgetClass self => Signal self (EventM EKey Bool)

このイベントモナドの中でeventKeyVal関数を使用してキーの値を取得します。

eventKeyVal :: EventM EKey KeyVal

モナド関数の使い方を覚えていますか?EventMモナドに包まれたKeyVal型の値を取り出すにはdo構文を使います。

window `on` keyPressEvent $ do
  keyval <- eventKeyVal
  ...

取り出したkeyvalは16bitの数値です。キーボードの上下左右キーを押した時の数値と、自作のMove型をマッピングするとこんな感じです。

window `on` keyPressEvent $ do
  keyval <- eventKeyVal
  let move = case keyval of
               65364 -> DOWN
               65361 -> LEFT
               65363 -> RIGHT
               65362 -> ROTATE
               _     -> NONE
  ...

KeyVal型にEnumのような命名的な値コンストラクタがあればいいのですが、無いので仕方なく数値によるパターンマッチを行っています。が、しばらく諦めずにマニュアルを漁っていると16bitのキー値を文字列に変換する方法がありました。

keyName :: KeyVal -> Text

Text型からString型に変換する関数も一緒に使います。

unpack :: Text -> String

16bit数値のKeyVal型 => Text型 => String型への変換をghciで試してみましょう。なおunpack関数を使うためにData.Textモジュールをimportしておく必要があります。

> :m + Data.Text
> unpack (keyName 65364)
"Down"

65364という値から分かりやすい文字列に変換できました。これで以下のように数値ではなく文字列でパターンマッチができますね。

window `on` keyPressEvent $ do
  keyval <- eventKeyVal
  let move = case unpack (keyName keyval) of
               "Down"  -> DOWN
               "Left"  -> LEFT
               "Right" -> RIGHT
               "Up"    -> ROTATE
               _       -> NONE
  ...

では取得したmoveを以下のようにコンソールに表示してみましょう。コンソール出力はprint関数で行いますが、これはIOモナド関数ですので、liftIO関数を使ってIOモナドをEventMモナドに持ち上げて使います。

main = do
  (省略)
  window `on` keyPressEvent $ do
    keyval <- eventKeyVal
    let move = case unpack (keyName keyval) of
                 "Down"  -> DOWN
                 "Left"  -> LEFT
                 "Right" -> RIGHT
                 "Up"    -> ROTATE
                 _       -> NONE
    liftIO $ print move  -- コンソールに表示してみる
    return True
  (省略)

上下左右キーを押すとコンソールに"DOWN"や"ROTATE"と表示され、キーの値が取れることを確認できました。さて、この時点で少しリファクタリングしましょう。上記のmoveを取り出す部分をgetMove関数として切り出してみようと思います。

getMove :: ??? (型はどうなる?)
getMove = do
  keyval <- eventKeyVal
  let move = case unpack (keyName keyval) of
               "Down"  -> DOWN
               "Left"  -> LEFT
               "Right" -> RIGHT
               "Up"    -> ROTATE
               _       -> NONE
  return move

切り出した関数はイベントモナド関数になっています。最後にmoveをモナドに包み込んで返しています。ところでgetMove関数の型は分かりますか?イベントモナドにMove型を包んで返すので、答えは以下のようになります。

getMove :: EventM EKey Move

では、元の処理からgetMove関数を呼び出すようにしましょう。

window `on` keyPressEvent $ do
  move <- getMove
  liftIO $ print move
  return True

OK、すっきりしました。では次の課題、今回の山場です。getMoveでmoveを取得した後のことを考えましょう。今はコンソールに表示していますが、moveMino関数でテトリミノを動かすように直しましょう。こんな感じでしょうか?

window `on` keyPressEvent $ do
  move <- getMove
  let mino = moveMino move mino
  ...

これはNG。右辺で現在のminoを参照し、左辺でminoを上書きしていますが、純粋関数型言語であるHaskellでは変数の書き換えができません。では別の変数に束縛すれば良いでしょうか?

window `on` keyPressEvent $ do
  move <- getMove
  let newMino = moveMino move oldMino
  ...

確かにnewMinoは書き換えられていません。しかし、いづれどこかでnewMinoからoldMinoに反映させなければなりませんね。いつまでたってもoldMinoが同じ値ではテトリミノは連続して動きません。ところがoldMinoの書き換えもNGなので、ほんと困りマックスです。

他の言語では当たり前に行っている変数の書き換えが、Haskellでは簡単にはできません。ですがもちろん解決策はあります。変数の書き換え(状態の更新)は、ファイルI/Oやコンソール入出力と同じ副作用です。副作用ということはIOモナドの出番ですね。この後紹介する3つのIOモナド関数を覚えて、書き換え可能な変数を扱えるようになりましょう。まずは書き換え可能な変数を作るnewIORef関数です。なお、Data.IORefモジュールのインポートが必要です。

newIORef :: a -> IO (IORef a)

モナド関数の見方は慣れてきましたか?これはIOモナド関数ですね。IOモナドに(IORef a型)が包まれています。使用例を見てみましょう。

import Data.IORef

main = do
  strref <- newIORef "Merry Christmas!"
  ...

このstrrefはどんな型だか分かりますか? "<-"を使うとIO (IORef a)の中身を取り出せるので、正解はIORef String型です。(String型ではない)

では、(IORef String)型の値を作れたので、参照を剥がして(?)さらに中身の値を取り出してみましょう。readIORef関数を使います。

readIORef :: IORef a -> IO a

これもIOモナド関数です。使用例を見てみましょう。

main = do
  strref <- newIORef "Merry Christmas!"
  str <- readIORef strref  -- 参照を剥がしてIORefの中身、Stringを取り出す
  print str                -- 「Merry Christmas!」と表示 

最後に(IORef String)型の値を書き換えてみましょう。writeIORef関数を使います。

writeIORef :: IORef a -> a -> IO ()

変数を書き換えるという副作用を起こしてみましょう。

main = do
  strref <- newIORef "Merry Christmas!"
  str <- readIORef strref
  print str
  writeIORef strref "A Happy New Year!"  -- strrefを書き換える!!
  str' <- readIORef strref   -- もう一度参照を剥がしてIORefの中身を取り出してみる
  print str'                 -- 「A Happy New Year!」と表示

上記mainを実行すると"Merry Christmas!"と表示した後、"A Happy New Year!"と表示されます。writeIORefでstrref変数を書き換えることができました。なお、Stringを束縛しているstr変数やstr'変数は相変わらず書き換えられないので注意してください。

それではテトリスに戻りましょう。ボードとテトリミノのIORefをバラバラに作っても良いですが、ボードとテトリミノを合わせて「ゲーム状態」という型を作り、まとめて書き換えられるようにしようと思います。今回のテトリス作成では実装しませんが、ゲームスコア機能を追加しようとした場合、スコアも書き換えが必要な状態変数になりますので、そのときは以下のゲーム状態型に加えてもいいかもしれません。

-- ゲーム状態を表す型
data GameStatus = GameStatus {
                    getBoard :: Board,
                    getMino  :: Mino
                  } deriving Show

ゲーム状態の初期状態を表す(IORef GameStatus)型はmain関数の最初にでも作ってしまいましょう。

main = do
  -- ゲーム状態の初期値を生成
  gameStatusRef <- newIORef $ GameStatus {
                                getBoard = initBoard,
                                getMino  = t_Mino  -- とりあえずT-ミノを初期値とした
                              }
  initGUI
  window <- windowNew
  ...

次にmain関数内の描画イベント処理を修正します。これまではいつも同じ状態を描画していましたが、現在のボード+テトリミノを描画するようにしましょう。

  -- 描画イベント処理
  window `on` exposeEvent $ do
    -- 現在のゲーム状態を取得する
    gameStatus <- liftIO $ readIORef gameStatusRef
    -- 現在のテトリミノをボードに置く
    let board = putMino (getMino gameStatus) (getBoard gameStatus)
    -- ボードを描画する
    updateWindow board

前半で作ったキーボードイベント処理も直します。getMove関数で取り出した操作に応じて、現在のテトリミノ状態を書き換えましょう。それと処理の最後に描画イベントが発生するようにキックしておきます。これを行わないとゲーム状態変数が変わるだけで画面に反映されません。

  -- キーボード操作イベント処理
  window `on` keyPressEvent $ do
    move <- getMove
    liftIO $ do
      -- 現在のゲーム状態を取得する
      gameStatus <- readIORef gameStatusRef
      -- 移動後の新しいテトリミノを取得
      let newMino = moveMino move (getMino gameStatus)
      -- ゲーム状態を更新
      writeIORef gameStatusRef $ gameStatus { getMino = newMino }
      -- 描画イベントをキック
      widgetQueueDraw window
    return True

さあ、動かしてみましょう。上下左右キーを操作するとテトリミノが移動したり、回転するようになりました。(参考画像1)

HaskellでもIOモナド(IORef)を使えば状態変数が割と簡単に書けます。ただし、IORefはここぞというところで使うべきでしょう。この部分だけはどうしても状態書き換えが必要なんだ!というところまでは純粋関数で作り込むことで、Haskellらしいプログラムになると思います:) 今回はここまで。

以上
   
第38回目:Haskellでテトリス(Part6)
2014-12-27
筆者:村田

こんにちは。

今年も残すところあと僅かとなりました。振り返ってみてどんな一年でしたか?こんなとき日記を付けていればな〜と年始に買った日記帳を開いては、驚きの白さにそっ閉じしてしまいます。ですが、図書館に行くときなどに持っていたA4ノートをめくってみたところ、こちらは書き込まれていて味が出ていました。試験勉強の跡、買い物リスト、地図、棒人間(ユースケース図っぽいけど、ただの落書き)、謎のページ数メモ(どの本だよ)・・・。皆さんも普段プライベートに書き込んでいる物、例えばスケジュール帳や手帳などを読み返してみると面白いかもです:-)

さて、前回はボード上のブロックを置き換える関数を作りました。もう少しでテトリミノを画面に表示できそうですので頑張りたいと思います。まずはテトリミノの値から各ブロックの位置を計算する関数を作りましょう。

getPosList :: Mino -> [Pos]
getPosList mino = map (\(sx,sy) -> (sx+x,sy+y)) shape
  where (x,y) = getPos mino
        shape = getShape mino

where句でminoの中心位置を(x,y)に、相対位置リストをshapeに束縛します。getPosやgetShape関数は前回登場したレコード構文で作った関数ですね。そして相対位置に中心位置を足すことで、各ブロックの実際の位置を計算することができます。相対位置はリストになっていますので、またまたいつものパターンですね。リストをなめて「リスト」を生成するので、map関数の出番です。ちなみに前回の復習になりますが、リストをなめて「一つの値」に畳み込む場合はfoldr関数を使うのでした。ではgetPosList関数をテストしてみましょう。

> getPosList i_Mino
[(5,2),(5,1),(5,0),(5,3)]

> getPosList z_Mino
[(5,2),(4,2),(5,3),(6,3)]

初期位置にあるI-ミノやZ−ミノの値から各ブロックの実際の位置を計算できました。これでようやくputMino関数が書けそうです。

putMino :: Mino -> Board -> Board
putMino mino board = putBlocks (getBlock mino) (getPosList mino) board

左辺、右辺の最後の引数(board)が同じ場合は以下のように省略できます。

putMino :: Mino -> Board -> Board
putMino mino = putBlocks (getBlock mino) (getPosList mino)

へ〜省略できるんだ〜というテクニックとして覚えても良いのですが、これは正しい説明ではありません。putMinoはMinoとBoardをもらって新しいBoardを返す関数、という考え方から、putMinoはMinoを与えると、「BoardをもらってBoardを返す関数」を返す関数であると解釈するテクニック(カリー化)です。そして、右辺のputBlocksも第1引数、第2引数を与えると「BoardをもらってBoardを返す関数」を返します。それぞれ関数の型にカッコを足してみましょう。

putMino :: Mino -> (Board -> Board)
putBlocks :: Block -> [Pos] -> (Board -> Board)

となり、どちらも「関数を返す」関数なんだということがイメージしやすくなります。関数型プログラミングでは引数に関数を与えたり、今回のように戻り値として関数を返すといった、関数を値のように扱うことが日常的に行われます。

それではputMino関数をテストしてみましょう。

> putMino i_Mino initBoard
[[G,E,E,E,E,I,E,E,E,E,E,G],
 [G,E,E,E,E,I,E,E,E,E,E,G],
 [G,E,E,E,E,I,E,E,E,E,E,G],
 [G,E,E,E,E,I,E,E,E,E,E,G]・・・(省略)

> putMino z_Mino initBoard
[[G,E,E,E,E,E,E,E,E,E,E,G],
 [G,E,E,E,E,E,E,E,E,E,E,G],
 [G,E,E,E,Z,Z,E,E,E,E,E,G],
 [G,E,E,E,E,Z,Z,E,E,E,E,G]・・・(省略)

ghciの出力結果を整形して見やすく並べてみました。I-ミノは縦に並び、Z-ミノもZ型に並んでいるのが分かると思います。

これからPart4で書いたコードを一部リファクタリングしたいと思います。main関数内に描画イベントハンドラをベタ〜っと書いてしまっているので長いんですよね。この部分を別関数に切り出してmain関数をすっきりしたいと思います。またPart4のコードは以下の部分で固定ボード値を参照しており、このままでは初期状態のボードしか表示できません。

  -- 描画イベント処理
  window `on` exposeEvent $ do
         (省略)
          -- ブロックの色をgcに設定する
          gcSetValues gc newGCValues {
            foreground = blockColor $ initBoard!!j!!i  -- initBoard固定 (-—;)
          }

この部分も直しましょう。引数でboardデータをもらうようにすれば良いですね。まず描画イベントハンドラをそのまま持ってきて新しい関数(updateWindow)に仕立て上げましょう。型はBoardをもらってイベントモナドを返す関数となります。

updateWindow :: Board -> EventM EExpose Bool
updateWindow board = do
  win <- eventWindow
  liftIO $ do
    gc <- gcNew win
        (省略)
        -- ブロックの色をgcに設定する
        gcSetValues gc newGCValues {
          foreground = blockColor $ board!!j!!i  -- 引数boardを参照 (^^)/
        }
        (省略)

main関数側は上記updateWindow関数を呼ぶようにします。引数boardにはZ-ミノを置いた後のボードを渡してみました。

main = do
  initGUI
  window <- windowNew
  (省略)
  -- 描画イベント処理
  window `on` exposeEvent $ do
    let board = putMino z_Mino initBoard -- Z-ミノを置いたボード
    updateWindow board

ではghciからmain関数を呼び出してみましょう。Z型のテトリミノが表示されました(参考画像1)。ようやくテトリスっぽくなってきました。

ふ〜無事に新しい関数を抜き出すことができました。リファクタリングをうまく行うコツは一度に行う作業を極力一つに絞ることです。コードを移動しつつ、変数を直して、処理も奇麗にして、インデントも直して・・・というのは失敗の元です。極端ですが、イベントハンドラのコードをそのまま別の場所にカット&ペーストしてコンパイルを試します。当然関数名がなくて怒られるので、そこで初めて関数名を与えます。その後で固定化していたinitBoardの替わりにboardを引数でもらうように修正します。まあ今回のようにリファクタリング工程が少なければいっぺんにやることも可能ですが、自分の中の作業モードを機能開発モードからリファクタリングモードに切り替えるために、あえて機械的な作業手順を踏んだりします。リファクタリング中は機能追加や偶然見つけたバグ修正をしないほうがいいですからね。

次の目標はどうしましょう。この辺りから実装の結果がGUI画面に表示されるので楽しいです。う〜ん、よし、テトリミノの移動や回転を行う関数を考えてみることにしましょう。となると、操作を表す型があった方が良さそうです。1ならば左移動、2ならば右移動と数値パラメータでも実装できますが、やはりきちんと型を作るべきでしょう。

data Move = DOWN | LEFT | RIGHT | ROTATE | NONE deriving (Show, Eq)

Move型を作りました。値コンストラクタはDOWNからROTATE、それとNONEは移動しないことを表す値です。ではテトリミノを移動する関数を型から考えます。

moveMino :: Move -> Mino -> Mino

こんな感じですね。次に実装を考えましょう。例えばZ-ミノを右に一つ移動したい場合どうしましょうか。関数型プログラミングでは値を書き換えられませんので、Z−ミノの位置データを直接書き換えることはできません。したがって、パターンマッチ、またはレコード構文のgetPos関数を使って現在位置(x,y)を取り出し、xに1を足して、新しいZ-ミノを構築することになります。少しghciでアイデアを練りましょう。

まずは元のミノの確認。
> let mino = z_Mino
> mino
Mino {getBlock = Z, getPos = (5,2), getShape = [(0,0),(-1,0),(0,1),(1,1)]}

元のミノの位置を取り出す。
> let (x,y) = getPos mino
> x
5

右に一つ移動した新しいミノを作る(mino’)
> let mino' = Mino Z (x+1,y) [(0,0),(-1,0),(0,1),(1,1)]
> mino'
Mino {getBlock = Z, getPos = (6,2), getShape = [(0,0),(-1,0),(0,1),(1,1)]}

これで右に移動したmino’を作ることができました。最後の部分はもう少しだけ簡単に書けます。レコード構文で作られたアクセサを通して位置(getPos)の部分だけ新しい値を設定することができます。

> let mino' = mino { getPos = (x+1,y) }
> mino'
Mino {getBlock = Z, getPos = (6,2), getShape = [(0,0),(-1,0),(0,1),(1,1)]}

上記をふまえてmoveMino関数を実装してみます。

moveMino :: Move -> Mino -> Mino
moveMino move mino = case move of
    DOWN   -> mino {getPos = (x,y+1)}
    LEFT   -> mino {getPos = (x-1,y)}
    RIGHT  -> mino {getPos = (x+1,y)}
    ROTATE -> undefined -- TODO
    NONE   -> mino
  where (x,y) = getPos mino

テストしてみます。

> moveMino DOWN z_Mino
Mino {getBlock = Z, getPos = (5,3), getShape = [(0,0),(-1,0),(0,1),(1,1)]}
> moveMino LEFT z_Mino
Mino {getBlock = Z, getPos = (4,2), getShape = [(0,0),(-1,0),(0,1),(1,1)]}
> moveMino ROTATE z_Mino
*** Exception: Prelude.undefined

DOWNもLEFTも問題ないようですね。ROTATEはundefinedで未実装にしているので当然エラーです。回転実装はテトリスの山場の一つです。テトリスの回転は少し癖があります。どのテトリミノも4回転して元の形状に戻りそうですが、そうではありません。例えば四角形のO-Minoは1回転で元に戻ります(回転しないとも言えます)。I-Minoは2回転で元に戻ります。縦棒の状態から1回転すると横棒の状態になり、2回転すると元の縦棒の状態に戻るということです。Z−ミノもよく観察すると2回転で戻ります。L-ミノやT-ミノは4回転で戻ります。このことは各テトリミノの属性と見なせるので、Part5で作ったMino型の属性に加えたいと思います。今説明した各ミノの最大回転数と、現在の回転数を加えました。

data Mino = Mino { getBlock     :: Block
                 , getPos       :: Pos
                 , getShape     :: [Pos]
                 , getRotate    :: Int   -- 現在の回転数
                 , getRotateMax :: Int   -- 最大回転数
                 } deriving Show

ついでに各ミノの初期状態に現在の回転数、最大回転数を設定するように修正しましょう。

i_Mino = Mino I (5,2) [(0,0),(0,-1),(0,-2),(0,1)] 0 2  -- I-ミノ
o_Mino = Mino O (5,2) [(0,0),(0,1),(1,0),(1,1)]   0 1  -- O-ミノ
(省略)
t_Mino = Mino T (5,2) [(0,0),(0,-1),(-1,0),(1,0)] 0 4  -- T-ミノ

そして先ほど作ったmoveMinoのROTATE部分は現在の回転数を1増やすようにします。

moveMino move mino = case move of
    (省略)
    ROTATE -> mino {getRotate = r+1}
    (省略)
  where (x,y) = getPos mino
      r = getRotate mino

テストしてみます。

> let mino = z_Mino
> let mino' = moveMino ROTATE mino
> mino'
Mino {getBlock = Z, getPos = (5,2), getShape = [(0,0),(-1,0),(0,1),(1,1)], getRotate = 1, getRotateMax = 2}

OK。現在の回転数が0から1に増えていますね。まだ回転数を設定できるようになっただけです。実際にブロックを回転をするのはブロックをボードに置く際に行います。本日最初に作ったgetPosList関数を思い出してください。テトリミノの各ブロックの位置を計算してくれる関数でした。ここで回転数から回転済み位置を計算するように改造すればうまくいきそうですね。

さあ、回転の山場を乗り越えましょう。回転行列やcos/sinを考えて回転方法を考えても良いですが、ブロックを時計回りに90°回転させるだけならば、紙でお絵描きすれば思いつくと思います。頭にグラフ用紙を思い描いてください。ただしY座標は今回のボードに合わせて上がマイナスです。では(1,-2)にある点を(0,0)を中心に時計回り90°回転するとどこに移動するでしょうか。(2,1)ですね。ということは、(x,y)の点を回転すると(-y,x)に移動するということです。アイデアをghciで試してみましょう。

> let i_shape = getShape i_Mino
> i_shape
[(0,0),(0,-1),(0,-2),(0,1)]
> let i_shape' = map (\(x,y) -> (-y,x)) i_shape
> i_shape'
[(0,0),(1,0),(2,0),(-1,0)]

元の縦棒(i_shape)をmap関数を使って回転させてみました。i_shape’は横棒になっていますね。うまくいきました。今は1回転しただけですが、関数にする場合は今の処理を繰り返せるようにしましょう。繰り返して一つの値を求める・・・foldrの出番のようですが今回は再帰呼び出しで書こうと思います。foldrでも書いてみましたが、少し読みにくかったので。興味のある方は、練習を兼ねてfoldrで書いてみるのもいいと思います。というわけでこんな関数になりました。

rotate :: [Pos] -> Int -> [Pos]
rotate xs 0 = xs
rotate xs n = rotate xs' (n-1)
  where xs' = map (\(x,y) -> (-y,x)) xs

ではrotate関数をgetPosList関数に組み込みましょう。前述の通りテトリミノによって最大回転数が決まっていますので、回転数(r)は剰余(mod)で求める必要があります。

getPosList :: Mino -> [Pos]
getPosList mino = map (\(sx,sy) -> (sx+x,sy+y)) shape
  where (x,y) = getPos mino
        r =  getRotate mino `mod` getRotateMax mino
        shape = rotate (getShape mino) r

ではここまでの成果を画面に出してみましょう。T-ミノをDOWN->DOWN->RIGHT->ROTATEした状態を表示してみます。main関数の描画イベント処理を以下のように書き換えます。moveMinoは2引数関数なのでfoldrで畳み込みしやすいですね。

main = do
  (省略)
  window `on` exposeEvent $ do
    let mino = foldr moveMino t_Mino [DOWN,DOWN,RIGHT,ROTATE]
    let board = putMino mino initBoard
    updateWindow board

main関数を呼び出して画面を表示するとT-ミノが回転していることがわかると思います。(参考画像2)

う〜む、今年中にテトリスを完成させることはできませんでしたが、来年はゲーム状態の更新(IOモナド)、キーボードによる操作、ライン消し、タイマーによる落下、などを作ってテトリスを完成させたいと思います。

来年もよろしくお願いいたします。それでは皆様良いお年を!!

以上
 

連載記事のソースコード

連載記事のソースコード
 
・Haskellで問題を解く(Part1〜Part4) ソースコード
・Clojureで8クイーン問題にチャレンジ(Part1〜Part5) ソースコード
・OCamlでへびゲームを作る(Part1〜Part5) ソースコード
・Swiftでオセロを作る(Part1〜Part5) ソースコード
・Processingでシューティング(Part1〜Part4) ソースコード 
Haskellでテトリス(Part1〜Part9) ソースコード
・プチコン3号(BASIC)でさめがめ(Part1〜Part3) ソースコード
・Prologでさめがめを解く(Part1〜Part6) ソースコード