ようこそ。睡眠不足なプログラマのチラ裏です。

F#でテトリスを実装してみました(１０年ぶり２回目)。

プログラミング F#

F#2.0で動作するコードはこちら↓
F#でテトリス。VS2010 RCまたはVS2010評価版で動くソースです。


※以下の記事の内容は古くなっています。



　

モンハン３の狩猟生活に忙しい今日この頃ですが、
合間を縫って、F#でテトリスを実装してみました。


F#の勉強をするにしても、インタプリタなどでガシガシとコードを打ち込んで、
文法や言語仕様などをただ確認するというだけでは、あまりにも面白みがありません(あまり身にもならないと思う)。
「なにか動くものを作る」ということは、楽しく言語を勉強することができる良い方法だと思います。


ということで、適当な題材として、今年25周年らしい*1ので、「テトリス」をセレクト。
テトリスを実装するのは、およそ10年前にVB6(笑)で書いて以来２回目です。
慣れない言語での実装は適度な難易度で、試行錯誤が有り、なかなか楽しめました。


以下、F#によるテトリスの実装サンプル*2です。
F#初心者であるため、ツッコミどころ満載かもしれません。
有識者の方がいらっしゃいましたら、ちょっとしたことでもよいので何かアドバイスいただけると有難いです。


TetrisLibrary

Tetrimino.fs
テトリスのブロックにまつわる実装など

#light
namespace TetrisLibrary
open System
open System.Collections.Generic 
open System.Linq 

type tetType =
 | n = 0x0000
 | i = 0x0001 
 | o = 0x0002
 | s = 0x0003
 | z = 0x0004
 | j = 0x0005
 | l = 0x0006
 | t = 0x0007
    
type tetrimino = { position : int * int; mutable pattern  : tetType[][]; model : tetType;};;

module Tetrimino =

  let patterns (x:tetType) =
    let n = [||]
    let i =
      [| [| enum 0; enum 0; enum 0; enum 0 |]
         [|      x;      x;      x;      x |]
         [| enum 0; enum 0; enum 0; enum 0 |]
         [| enum 0; enum 0; enum 0; enum 0 |] |]
    let o =
        [| [| x; x |]
           [| x; x |] |]
    let s =
      [| [| enum 0;      x;      x |]
         [|      x;      x; enum 0 |]
         [| enum 0; enum 0; enum 0 |] |]
    let z =
      [| [|      x;      x; enum 0 |]
         [| enum 0;      x;      x |]
         [| enum 0; enum 0; enum 0 |] |]
    let j =
      [| [|      x; enum 0; enum 0 |]
         [|      x;      x;      x |]
         [| enum 0; enum 0; enum 0 |] |]
    let l =
      [| [| enum 0; enum 0;      x |]
         [|      x;      x;      x |]
         [| enum 0; enum 0; enum 0 |] |]
    let t =
      [| [| enum 0;      x; enum 0 |]
         [|      x;      x;      x |]
         [| enum 0; enum 0; enum 0 |] |]
    [| n; i; o; s; z; j; l; t;|]
      
  //テトリミノをランダムに生成
  let create =
    let rand = new Random()
    fun () ->
      let t : tetType = enum (rand.Next(1, (Array.length (patterns tetType.n))))
      let pat = (patterns t).[int <| t]
      let row = Array.length pat
      let col = Array.length pat.[0]
      {
        position = (3, 0)
        pattern  = pat
        model = t
      }
  
  let getTetrimino = 
    let queue = new System.Collections.Generic.Queue<tetrimino>()
    fun() ->   
      match queue.Count with
       | 0 -> for i = 1 to 4 do
                queue.Enqueue(() |> create);
              let current = queue.Dequeue()
              (current,queue.ToArray())
       | _ -> queue.Enqueue(() |> create)
              let current = queue.Dequeue()
              (current,queue.ToArray())  
  
  let convert ((source : 'a[][]),(t : 'b)) = 
    let row = Array.length source
    let col = source.GetLength(0)
    let arrayOf2D =   Array2.create row col t 
    for i = 0 to row - 1 do
      for j = 0 to col - 1 do
          arrayOf2D.[j,i] <- source.[i].[j]
    arrayOf2D

  //回転
  let rotate t =
    let newblock = {
      position = t.position
      pattern  = (patterns t.model).[int <| t.model]
      model = t.model 
    }
    let pattern = convert (t.pattern, t.model) 
    let len = Array2.length1 pattern 
    for i = 0 to len - 1 do
     for j = 0 to len - 1 do
       newblock.pattern.[j].[i] <- pattern.[len - 1 - j,i]
    newblock
    
  //移動方向
  type Direction =
    | Right
    | Left
    | Down
  
  let move block direction =
    let x, y = block.position
    match direction with
    | Right -> { position = (x + 1, y); pattern = block.pattern; model = block.model; }
    | Left  -> { position = (x - 1, y); pattern = block.pattern; model = block.model; }
    | Down  -> { position = (x, y + 1); pattern = block.pattern; model = block.model; }


TetrisGame.fs

#light
namespace TetrisLibrary

type TetrisGame = {
  size             : int
  width            : int
  height           : int
  mutable gameover : bool
  mutable score    : int
  mutable lines    : int
  mutable level    : int
  mutable current  : TetrisLibrary.tetrimino 
  mutable next     : TetrisLibrary.tetrimino array
  mutable field    : int[,]
}


Tetris.fs
テトリスのゲーム仕様的な実装もろもろ

#light
namespace TetrisLibrary

open System
open System.Drawing
open System.Drawing.Drawing2D 
open System.Windows.Forms
open System.Linq

module Tetris =

  let select  f source = System.Linq.Enumerable.Select(source,new Func<_,_>(f))
  let where   f source = System.Linq.Enumerable.Where(source,new Func<_,_>(f))
  let orderBy f source = System.Linq.Enumerable.OrderBy(source,new Func<_,_>(f))
  let count   f source = System.Linq.Enumerable.Count(source,new Func<_,_>(f))
  let max (source:seq<int>) = System.Linq.Enumerable.Max(source)

  let brush t =
    match t with
     | tetType.n -> new SolidBrush(Color.Transparent)
     | tetType.i -> new SolidBrush(Color.Aqua)
     | tetType.o -> new SolidBrush(Color.Yellow)
     | tetType.s -> new SolidBrush(Color.Lime)
     | tetType.z -> new SolidBrush(Color.Red)
     | tetType.j -> new SolidBrush(Color.DodgerBlue)
     | tetType.l -> new SolidBrush(Color.Orange)
     | tetType.t -> new SolidBrush(Color.HotPink)
     | _ -> new SolidBrush(Color.Transparent)

  let draw (tetris : TetrisLibrary.TetrisGame) (g : Graphics) =
    let drawRect brush (x, y) =
      let size = tetris.size
      let pt = new Point( x * size, y * size )
      let rect = new Rectangle( pt, new Size( size - 2, size - 2 ) )
      g.FillRectangle( brush, rect )
      
    tetris.field |> Array2.iteri
      (fun i j t -> drawRect (brush (enum t)) (i, j))
          
    if tetris.gameover then
      let gp = new System.Drawing.Drawing2D.GraphicsPath()
      gp.AddString("GAME OVER", new FontFamily("メイリオ") , 0, 20.f, new PointF(5.f, 100.f), StringFormat.GenericDefault)
      g.FillPath(Brushes.Red, gp);
      g.DrawPath(Pens.White, gp);
    else
      let x, y = tetris.current.position
      (tetris.current.pattern ,tetris.current.model) |> TetrisLibrary.Tetrimino.convert |> Array2.iteri
        (fun i j t -> drawRect (brush t) (x + i, y + j))
     
  //Next Tetrimino
  let drawNexTetrimino (tetris : TetrisLibrary.TetrisGame) (g : Graphics) (s : Size) (i : int) (size : int) =
    let drawSize (source : TetrisLibrary.tetType[][]) (t : TetrisLibrary.tetType) = 
      let g t= 
       let mutable count = 0
       for item in source do 
         if item.Contains(t) then
           count <- count + 1
         else 
           count <- count
       count
      let h t = source.Count(fun x -> x.Contains(t)) 
                |> fun x -> if x <= 1 then x + (g t) else x
      let w = (source |> select (fun a -> a |> count(fun x -> x <> TetrisLibrary.tetType.n))) |> max 
      (w ,h t)
    let w,h = drawSize tetris.next.[i].pattern tetris.next.[i].model 
    let drawRect brush (x, y) =
      let sw = s.Width - w * size
      let sh = s.Height - h * size
      let pt = new Point( sw / 2 + x * size , sh / 2 + y * size)
      let rect = new Rectangle( pt, new Size(size - 2, size - 2))
      g.FillRectangle( brush, rect )

    (tetris.next.[i].pattern, tetris.next.[i].model) |> TetrisLibrary.Tetrimino.convert |> Array2.iteri
      (fun i j t -> drawRect (brush t) (i, j))

  // TetrisGameの生成
  let create size width height =
    let current,next = Tetrimino.getTetrimino()
    {
       size = size
       width = width
       height = height
       gameover = false
       score = 0
       lines = 0
       level = 1
       current = current
       next = next
       field = Array2.create width height 0
     }

  //当たり判定
  let detectCollision block field =
    let result = ref false
    let x, y = block.position
    (block.pattern, block.model) |> TetrisLibrary.Tetrimino.convert |> Array2.iteri
      (fun i j t ->
        match t with
         | tetType.n -> ()
         | _ ->
          let xi = x + i
          let yj = y + j
          if xi < 0 or xi >= Array2.length1 field or
             yj < 0 or yj >= Array2.length2 field or
             field.[xi, yj] <> 0 then result := true
      )
    !result

  //消去判定など
  let judge tetris =
    //崩す
    let collapse () =
      let isFilledLine y =
        let mutable filled = true
        for x = 0 to tetris.width - 1 do
          if tetris.field.[x, y] = 0 then filled <- false
        filled
      let collapseLine y =
        for yy = y downto 1 do
          for x = 0 to tetris.width - 1 do
            tetris.field.[x, yy] <- tetris.field.[x, yy - 1]
      let mutable count = 0
      for y = tetris.height - 1 downto 0 do
        while isFilledLine y do
          collapseLine y
          count <- count + 1
      count

    if not tetris.gameover then
      //落とす
      let moved = Tetrimino.move tetris.current Tetrimino.Down
      if detectCollision moved tetris.field then
        () |> fun () ->
          let x, y = tetris.current.position
          (tetris.current.pattern, tetris.current.model) |> TetrisLibrary.Tetrimino.convert |> Array2.iteri
            (fun i j t -> 
              match t with
               | tetType.n -> ()
               | _ -> tetris.field.[x + i, y + j] <- tetris.current.model |> int)
        let count = collapse()
        tetris.lines <- tetris.lines + count
        let lv = 
          let c = tetris.lines / 10 + 1
          if c >= 20 then 20
          else c
        tetris.level <- lv
        tetris.score <- tetris.score + count * count * 10
        let current,next = Tetrimino.getTetrimino()
        tetris.current <- current
        tetris.next  <- next
      else
        tetris.current <- moved

      if detectCollision tetris.current tetris.field then
        tetris.gameover <- true

  //キー操作
  let operate tetris keycode =
    let newblock =
      match keycode with
        | Keys.Up    | Keys.Space | Keys.NumPad8 | Keys.NumPad5 -> Some (Tetrimino.rotate tetris.current) 
        | Keys.Right | Keys.NumPad6 -> Some (Tetrimino.move tetris.current Tetrimino.Right)
        | Keys.Left  | Keys.NumPad4 -> Some (Tetrimino.move tetris.current Tetrimino.Left)
        | Keys.Down  | Keys.NumPad2 -> Some (Tetrimino.move tetris.current Tetrimino.Down)
        | _ -> None
    match newblock with
      | None   -> ()  //なんもせーへん
      | Some x ->
        if not (detectCollision x tetris.field) then
          tetris.current <- x


ControlEx.fs
描画用のコントロールです。
ダブルバッファとか特殊キー許可とか。

#light
namespace TetrisLibrary
open System
open System.Drawing 
open System.Windows.Forms 

[<Sealed>]
type ControlEx = 
    inherit Control
    new() as this = {inherit Control();} then
      this.SetStyle(ControlStyles.OptimizedDoubleBuffer , true);
      this.DoubleBuffered <- true;
            
    //プリプロセスを必要とする特殊なキーを許可する
    override this.IsInputKey keyData =
      match keyData with
          | Keys.Left 
          | Keys.Up
          | Keys.Right
          | Keys.Down -> true
          | _ -> base.IsInputKey keyData


TetrisLibraryを利用するクライアント側の実装

Program.fs
画面デザイン部分の手書き実装は正直きついものがあるｗ
画面部分に関してはC#等を使って、IDE上でぺたぺたコントロールを貼って作るのが現実的な気がしました。

#light
open System
open System.Windows.Forms
open System.Drawing
open TetrisLibrary

let tetrismain =
  let tetris = Tetris.create 14 10 20

  let panel = 
    let c = new ControlEx()
    let w = tetris.size * tetris.width
    let h = tetris.size * tetris.height
    c.Size <- new Size(w, h)
    c.Location <- new Point(2, 2)
    c.BackColor <- Color.Black

    let panel_Paint = 
      c.Paint |> Event.map(fun e -> Tetris.draw tetris e.Graphics)
    do panel_Paint 
      |> Event.listen(ignore)

    let panel_keyDown =
       c.KeyDown |> Event.map(fun e -> Tetris.operate tetris e.KeyCode; c.Invalidate();)
    do panel_Paint 
       |> Event.listen(ignore)
    c

  let nextLabel = 
    let c = new Label()
    let w = tetris.size * 5
    let h = 15
    c.Text <- "NEXT"
    c.Size <- new Size(w, h)
    c.Location <- new Point(panel.Width + 4, 2)
    c.BorderStyle <- BorderStyle.FixedSingle
    c.TextAlign <- ContentAlignment.MiddleCenter 
    c.BackColor <- Color.Red 
    c.ForeColor <- Color.White 
    c.Font <- new Font(c.Font,FontStyle.Bold)
    c
    
  let panelNext1 = 
    let c = new ControlEx()
    let w = tetris.size * 5
    let h = tetris.size * 5
    c.Size <- new Size(w, h)
    c.Location <- new Point(nextLabel.Left, 2 + nextLabel.Height)
    c.BackColor <- Color.Black

    let panel_Paint =
        c.Paint  
        |> Event.map(fun e -> Tetris.drawNexTetrimino tetris e.Graphics c.Size 0 tetris.size)
    do panel_Paint 
       |> Event.listen(ignore)
    c

  let panelNext2 = 
    let c = new ControlEx()
    let w = tetris.size / 2 * 5 - 1
    let h = tetris.size / 2 * 5
    c.Size <- new Size(w, h)
    c.Location <- new Point(panelNext1.Left, panelNext1.Top + panelNext1.Height + 2)
    c.BackColor <- Color.Black

    let panel_Paint =
        c.Paint  
        |> Event.map(fun e -> Tetris.drawNexTetrimino tetris e.Graphics c.Size 1 (tetris.size / 2))
    do panel_Paint 
       |> Event.listen(ignore)
    c

  let panelNext3 = 
    let c = new ControlEx()
    let w = tetris.size / 2 * 5 - 1
    let h = tetris.size / 2 * 5
    c.Size <- new Size(w, h)
    c.Location <- new Point(panelNext2.Left + panelNext2.Width + 2, panelNext1.Top + panelNext1.Height + 2)
    c.BackColor <- Color.Black

    let panel_Paint =
        c.Paint  
        |> Event.map(fun e -> Tetris.drawNexTetrimino tetris e.Graphics c.Size 2 (tetris.size / 2))
    do panel_Paint 
       |> Event.listen(ignore)
    c

  let linesLabel = 
    let c = new Label()
    let w = tetris.size * 5
    let h = 15
    c.Text <- "LINES"
    c.Size <- new Size(w, h)
    c.Location <- new Point(panelNext2.Left , panelNext2.Top + panelNext2.Height + 20)
    c.BorderStyle <- BorderStyle.FixedSingle
    c.TextAlign <- ContentAlignment.MiddleCenter 
    c.BackColor <- Color.Green
    c.ForeColor <- Color.White 
    c.Font <- new Font(c.Font,FontStyle.Bold)
    c

  let lines = 
    let c = new Label()
    let w = tetris.size * 5
    let h = 15
    c.Text <- "0"
    c.Size <- new Size(w, h)
    c.Location <- new Point(panelNext2.Left , linesLabel.Top + linesLabel.Height)
    c.BorderStyle <- BorderStyle.FixedSingle 
    c.TextAlign <- ContentAlignment.MiddleRight 
    c.BackColor <- Color.Black 
    c.ForeColor <- Color.White 
    c.Font <- new Font(c.Font,FontStyle.Bold)
    c

  let levelLabel = 
    let c = new Label()
    let w = tetris.size * 5
    let h = 15
    c.Text <- "LEVEL"
    c.Size <- new Size(w, h)
    c.Location <- new Point(panelNext2.Left , lines.Top + lines.Height + 4)
    c.BorderStyle <- BorderStyle.FixedSingle
    c.TextAlign <- ContentAlignment.MiddleCenter 
    c.BackColor <- Color.DodgerBlue 
    c.ForeColor <- Color.White 
    c.Font <- new Font(c.Font,FontStyle.Bold)
    c
  let level = 
    let c = new Label()
    let w = tetris.size * 5
    let h = 15
    c.Text <- "1"
    c.Size <- new Size(w, h)
    c.Location <- new Point(panelNext2.Left , levelLabel.Top + levelLabel.Height)
    c.BorderStyle <- BorderStyle.FixedSingle
    c.TextAlign <- ContentAlignment.MiddleRight  
    c.BackColor <- Color.Black 
    c.ForeColor <- Color.White 
    c.Font <- new Font(c.Font,FontStyle.Bold)
    c

  let scoreLabel = 
    let c = new Label()
    let w = tetris.size * 5
    let h = 15
    c.Text <- "SOCRE"
    c.Size <- new Size(w, h)
    c.Location <- new Point(panelNext2.Left , level.Top + level.Height + 4)
    c.BorderStyle <- BorderStyle.FixedSingle
    c.TextAlign <- ContentAlignment.MiddleCenter 
    c.BackColor <- Color.Orange
    c.ForeColor <- Color.White 
    c.Font <- new Font(c.Font,FontStyle.Bold)
    c
  let score = 
    let c = new Label()
    let w = tetris.size * 5
    let h = 15
    c.Text <- "0"
    c.Size <- new Size(w, h)
    c.Location <- new Point(panelNext2.Left , scoreLabel.Top + scoreLabel.Height)
    c.BorderStyle <- BorderStyle.FixedSingle
    c.TextAlign <- ContentAlignment.MiddleRight  
    c.BackColor <- Color.Black 
    c.ForeColor <- Color.White 
    c.Font <- new Font(c.Font,FontStyle.Bold)
    c
   
  let timer =
    let t = new System.Timers.Timer()
    t.Enabled <- true
    t.Interval <- 500.0 - (float tetris.level) * 20.0
    t.Elapsed.Add( fun _ ->
      lines.Invoke(new MethodInvoker(fun () -> 
                                     lines.Text <- string tetris.lines))
      |> ignore
      score.Invoke(new MethodInvoker(fun () -> 
                                     score.Text <- string tetris.score)) 
      |> ignore
      level.Invoke(new MethodInvoker(fun () -> 
                                     level.Text <- string tetris.level)) 
      |> ignore
      t.Interval <- 500.0 - (float tetris.level) * 20.0
      Tetris.judge tetris
      if tetris.gameover then t.Enabled <- false
      panelNext1.Invalidate()
      panelNext2.Invalidate()
      panelNext3.Invalidate()
      panel.Invalidate() 
      )
    t
    
  let form =
    let f = new Form()
    let w = panel.Width + panelNext1.Width + 6
    let h = panel.Height + 4

    let initTetris = fun () -> tetris.field <- Array2.create tetris.width tetris.height 0;
                               tetris.gameover <- false;
                               tetris.score <- 0;
                               tetris.lines <- 0;
                               tetris.level <- 1;
                               timer.Enabled <- true;
    ()
    
    f.Text <- "F#でテトリス"
    f.FormBorderStyle <- FormBorderStyle.FixedSingle 
    f.StartPosition <- FormStartPosition.CenterScreen 
    f.KeyPreview <- true
    f.Controls.Add(panel)
    f.Controls.Add(nextLabel)
    f.Controls.Add(panelNext1)
    f.Controls.Add(panelNext2)
    f.Controls.Add(panelNext3)
    f.Controls.Add(linesLabel)
    f.Controls.Add(lines)
    f.Controls.Add(levelLabel)
    f.Controls.Add(level)
    f.Controls.Add(scoreLabel)
    f.Controls.Add(score)
    f.ClientSize <- new Size(w, h) 

    let form_keyDown =
        f.KeyDown 
        |> Event.filter(fun _ -> not timer.Enabled)
        |> Event.filter(fun e -> match e.KeyCode with
                                   | Keys.Space -> true
                                   | _ -> false)
        |> Event.map(fun e ->
           match e.KeyCode with
            | Keys.Space  -> e
            | _ -> null)
    do form_keyDown 
       |> Event.listen(fun _ ->
                        let dr = MessageBox.Show(f,"Retry?",f.Text ,MessageBoxButtons.YesNo) 
                        match dr with
                         | DialogResult.Yes -> initTetris()
                         | _ -> ())
    f
  form
  
#if COMPILED
[<STAThread>]
do Application.Run(tetrismain);;
#endif

以上です。お疲れ様でした。
気が向いたら、ホールド機能や、ブロックのゴースト表示機能なども実装してみようかなと思ってます。
あと、例外処理などが一切入っていないのが気になりますが、たぶん・・・大丈夫です(ぇ
というか、F#での例外処理の正しい扱い方についてよくわかっていません。・・・出直してきます(;´・ω・｀)

*1:もちろんGoogleのロゴで知った

*2:正式な仕様とは異なっているかもしれません