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

F#でテトリス。VS2010 RCまたはVS2010評価版で動くソースです。

プログラミング VS2010 F# .NET

というわけで、さっそくVS2010評価版をインストールしてみましたよ。めでたいですねｗ
みなさんもデフォルト言語はF#に設定しましょう。そうしましょう。いやいや、そんなこと言わずに・・。





F#の仕様もこの短い期間でいろいろと変更が加わりました。
以前書いた「F#でテトリスを実装してみました(１０年ぶり２回目)。」のコードはもう過去のもの。
いまではビルドも通らなくなってしまいました。なので、とりあえずF#2.0で動作するように手直ししてみました。
できればWindowsFormからWPFやSilverlightへ置き換えたかったところですが、取り急ぎこのままアップします。
だいぶ前に書いたコードがベースとなっていますので、F#的に残念なところが多々見受けられますが、
そのぶんリファクタリングや機能追加をする余地がたくさんあるコードとなっています。


　


Block.fs

namespace TetrisLibrary
open System
open System.Collections.Generic 
open System.Linq 
open Microsoft.FSharp.Control 

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 : 'a)) = 
    let row = Array.length source
    let col = source.GetLength(0)
    let arrayOf2D = Array2D.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 = Array2D.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; }


ControlEx.fs

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


Tetris.fs

namespace TetrisLibrary

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

///テトリスの実行状態
type TetrisState = {
  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[,]
}

///テトリスゲーム
type TetrisGame =
  val mutable private _ts : TetrisState
  new(ts : TetrisState) = { _ts = ts;} 
  ///サイズを取得します。
  member this.Size with get() = this._ts.size
  ///幅を取得します。
  member this.Width with get() = this._ts.width
  ///高さを取得します。
  member this.Height with get() = this._ts.height
  ///ゲームオーバーか否かを取得します。
  member this.IsGameOver with get()  = this._ts.gameover
                          and set(v) = this._ts.gameover <- v
  ///現在のスコアを取得します。
  member this.Score with get()  = this._ts.score
                     and set(v) = this._ts.score <- v
  ///消去したライン数を取得します。
  member this.Lines with get()  = this._ts.lines
                     and set(v) = this._ts.lines <- v
  ///現在のゲームレベルを取得します。
  member this.Level with get()  = this._ts.level 
                     and set(v) = this._ts.level <- v
  ///現在のブロックを取得します。
  member this.Current with get()  = this._ts.current 
                       and set(v) = this._ts.current <- v
  ///次のブロックを取得します
  member this.Next with get() = this._ts.next 
                    and set(v) = this._ts.next <- v
  ///フィールドを取得します。
  member this.Field with get() = this._ts.field
  ///ゲームをリセットします。
  member this.Reset = 
   this._ts.field <- Array2D.create this.Width this.Height 0;
   this._ts.gameover <- false;
   this._ts.score <- 0;
   this._ts.lines <- 0;
   this._ts.level <- 1;

  ///判定
  member this.Judge = ()


///テトリス
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 : 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 |> Array2D.iteri
      (fun i j t -> drawRect (brush (enum t)) (i, j))
          
    if tetris.IsGameOver 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 |> Array2D.iteri
        (fun i j t -> drawRect (brush t) (x + i, y + j))
     
  //Next Tetrimino
  let drawNexTetrimino (tetris : 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 |> Array2D.iteri
      (fun i j t -> drawRect (brush t) (i, j))

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

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

  //消去判定など
  let judge (tetris : TetrisGame) =
    //崩す
    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.IsGameOver 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 |> Array2D.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.IsGameOver <- true

  //キー操作
  let operate (tetris : TetrisGame) 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

Program.fs

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.add(ignore)

    let panel_keyDown =
       c.KeyDown |> Event.map(fun e -> Tetris.operate tetris e.KeyCode; c.Invalidate();)
    do panel_Paint 
       |> Event.add(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.add(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.add(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.add(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 <- 1000.0 - (float tetris.Level) * 20.0
      Tetris.judge tetris
      if tetris.IsGameOver 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.Reset
                               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.add(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


そうそうWPFやSilverlightへの移植も面白いと思います。F#学習の材料などになれば幸いです。