F#でテトリスを作ってみた
※ [2007.10.29] 画像載せました＆ちょっと追記
ダウンロードはこちら。
http://www.geocities.jp/u_1roh/software/tetris_by_fsharp.zip
ソースはこちら。
いまいち F# らしいコードになっていない気がする。誰か添削してくれるといいのに。
#light open System open System.Windows.Forms open System.Drawing type TetrisBlock = { position : int * int pattern : int[,] } type TetrisGame = { mutable block : TetrisBlock field : int[,] rectsize : int width : int height : int mutable point : int mutable gameover : bool } module Block = let createAtRandom = let patterns = let a = [| [| 1; 1 |] [| 1; 1 |] |] let b = [| [| 0; 1; 0 |] [| 0; 1; 0 |] [| 0; 1; 1 |] |] let c = [| [| 0; 1; 0 |] [| 0; 1; 1 |] [| 0; 1; 0 |] |] let d = [| [| 1; 1; 0 |] [| 0; 1; 1 |] [| 0; 0; 0 |] |] let e = [| [| 0; 1; 0; 0 |] [| 0; 1; 0; 0 |] [| 0; 1; 0; 0 |] [| 0; 1; 0; 0 |] |] [| a; b; c; d; e |] let rand = new Random() fun () -> let pat = patterns.[rand.Next() % (Array.length patterns)] let row = Array.length pat let col = Array.length pat.[0] let block = { position = (3, 0) pattern = Array2.create row col 0 } for i = 0 to row - 1 do for j = 0 to col - 1 do block.pattern.[j, i] <- pat.[i].[j] block let rotate block = let len = Array2.length1 block.pattern let newblock = { position = block.position pattern = Array2.create len len 0 } for i = 0 to len - 1 do for j = 0 to len - 1 do newblock.pattern.[i, j] <- block.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 } | Left -> { position = (x - 1, y); pattern = block.pattern } | Down -> { position = (x, y + 1); pattern = block.pattern } module Tetris = let draw tetris (g : Graphics) = let drawRect brush (x, y) = let size = tetris.rectsize 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 を描画 let brush = new SolidBrush( Color.Blue ) tetris.field |> Array2.iteri (fun i j a -> if a <> 0 then drawRect brush (i, j) ) if tetris.gameover then // GAME OVER と表示 let font = new Font( "MS UI Gothic", 20.f ) g.DrawString( "GAME OVER", font, Brushes.Red, 4.f, 16.f ) else // tetris.block を描画 let x, y = tetris.block.position let brush = new SolidBrush( Color.Gold ) tetris.block.pattern |> Array2.iteri (fun i j a -> if a <> 0 then drawRect brush (x + i, y + j)) let create rectsize width height = { block = Block.createAtRandom() field = Array2.create width height 0 rectsize = rectsize width = width height = height point = 0 gameover = false } let detectCollision block field = let result = ref false let x, y = block.position block.pattern |> Array2.iteri (fun i j a -> if a <> 0 then 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 transit tetris = let fix () = let x, y = tetris.block.position tetris.block.pattern |> Array2.iteri (fun i j a -> if a <> 0 then tetris.field.[x + i, y + j] <- 1) 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 = Block.move tetris.block Block.Down if detectCollision moved tetris.field then fix() let count = collapse() tetris.point <- tetris.point + count * count tetris.block <- Block.createAtRandom() else tetris.block <- moved if detectCollision tetris.block tetris.field then tetris.gameover <- true let operate tetris keycode = let newblock = match keycode with | Keys.Space -> Some (Block.rotate tetris.block) | Keys.Up -> Some (Block.rotate tetris.block) | Keys.Right -> Some (Block.move tetris.block Block.Right) | Keys.Left -> Some (Block.move tetris.block Block.Left) | Keys.Down -> Some (Block.move tetris.block Block.Down) | _ -> None match newblock with | None -> () | Some x -> if not (detectCollision x tetris.field) then tetris.block <- x let mainform = let tetris = Tetris.create 16 10 16 let panel = let c = new Control() let w = tetris.rectsize * tetris.width let h = tetris.rectsize * tetris.height c.Size <- new Size( w, h ) c.Location <- new Point( 2, 32 ) c.BackColor <- Color.Black c.Paint.Add ( fun e -> Tetris.draw tetris e.Graphics ) c.KeyUp.Add (fun e -> Tetris.operate tetris e.KeyCode; c.Invalidate()) c let label = let l = new Label() l.Width <- panel.Width l.Location <- new Point( 2, 2 ) l.Font <- new Font( "MS UI Gothic", 16.f ) l let timer = let t = new System.Timers.Timer() t.Enabled <- true t.Interval <- 400.0 t.Elapsed.Add( fun _ -> Tetris.transit tetris label.Text <- "POINT: " + tetris.point.ToString() if tetris.gameover then t.Enabled <- false panel.Invalidate() ) t let form = let f = new Form() let w = panel.Width + 4 let h = panel.Height + label.Height + 10 f.Text <- "TETRIS" f.Controls.Add( label ) f.Controls.Add( panel ) f.ClientSize <- new Size( w, h ) f form Application.Run( mainform )
