Ｍが如くF#ive 夢、叶えしMono
この記事は、F# Advent Calendar 2012 の12日目です。ひとつ前の記事は@katayama_kさんの「スキャナが出力したPDFを、出力デバイスに合わせて変換しよう-F#マスターへの道」です。ありがたいことにソースコードを公開してくださっているので、iTextSharpを使ってPDFを扱いたい場合に参考になりそうです。
龍が如く５、NewスーパーマリオブラザーズU、などプレイしたいゲームが盛りだくさんだけど、ぜんぜんやる時間が取れない今日この頃ですが、みなさんいかがお過ごしでしょうか。
この記事では、F# と MonoGame でゲームを作ろう(Mac編)という話題を扱います。F#をゲーム制作に実用してみようという話です。関数型楽しい。ゲーム作るの楽しい。ならば組み合わせない手はない！ いわゆるひとつの「カツカレー理論」を採用しましたが、あなたを満足させられるような 実用 や F# の 成分は少ないかもしれません。
私がはじめて関数型言語に触れたのは５年近く前で、言語は Haskell でした。まだ関数型について右も左もわからなかった頃、Webで偶然見つけた Haskell で書かれた テトリスクローンに心が躍り、Haskellで書かれたグラディウスクローン「Monadius」 に衝撃を受けた。「いつか俺も関数型言語でなんかゲーム作る」と胸が熱くなったのを今でもよく覚えています。関数型言語は、Webアプリケーションを開発できる程度には実用です。ゲームを作れる程度には実用です。正味な話だいたいなんでも作れます。ジョジョに人気も高まってきているせいか、Scala や F# などで実際にゲームを作って楽しんでいる人も少しずつ増えてきているようです。歩みは遅くとも流れは来ている。そう感じます。ひとむかし前と比べて、スマホやタブレットPCが一般層にまで浸透してきた今、個人で作ったゲームでも手軽に大きなマーケットに公開できるインフラも整ってきました。もしあなたがお気に入りのプログラミング言語でゲームを作れたら。それってとっても実用だなって。
MonoGameとは
MonoGame は一言で言うと XNA4.0 のオープンソース実装です。XNAは、Windows、Xbox 360、Windows Phone向けのゲームを作ることができるマルチプラットフォーム(ただしマイクロソフト系に限る)に対応のイケているフレームワークです。実際に利用してみるとすぐにわかりますが、初心者でも手軽にゲームを作ることができるように考えられて設計されています。もちろん、初心者のみをターゲットにしているものではなく、上級者なら高度な技術力をいかんなく発揮することもできます。C#、VB、F#など、いずれかの .NETの言語さえ知っていれば、すぐにゲームプログラミングに取り組める環境が整っています。実際、ゲームプログラミングもXNAも素人な私ですが、特にハマることもなくゲームを作ることができました。「とことんF#よぷよ！」は、スーパーファミコンぷよぷよ通のとことんぷよぷよモード相当のもので、F# で書いた私のXNA処女作です。そんなかわいい XNA ですが、 Windows8 では XNA はサポート対象外となってしまいました。この決定に、多くの XNA ゲーム開発者が涙したことは言うまでもありません。そこで救いの手を差し伸べるのが、オープンソースのゲーム開発フレームワーク MonoGame です。
MonoGameは、内部的にはOpenGLベースでの総書き換えなので、Windowsに限らずともさまざまなOS上で動作します。前身は XNA で開発されたゲームを iOS 上で動作させる目的で開発されていた XNATouch でした。@smallgeek さんが紹介してくださった、Mono for Android のお仲間です（Mono for Android と F# - FsNinja）。現在では Android、iOS、Mac OS X、Linux 。そして Windows 8 ストア向けゲームの開発も可能になりました。また、今後 PlayStation Mobile をサポートする予定があり、鋭意開発中とのことです。「PSVita で F# が動くぞ...!！」が来る日も近い？ 胸が熱くなる。
MonoGame のここがいいね！
MonoGame の素晴らしい点は、なにより XNA4.0 で使用するのと全く同じ名前空間を使用していることです。これにより、XNA の API が完全に保たれていてます。2Dのみでなく、部分的ではあるものの3Dのサポートもされているので、理論的には XNAで書かれたプログラムを参照設定の変更や各プラットフォームに依存するゲーム起動部分(Gameクラスの起動）などに関するわずかな変更を加えるだけで、異なるプラットフォームに簡単に移植することができます。WOPE (Write Once, Play Everywhere) 「一度書けば、どこでも動く」 の御旗のもとに開発されている MonoGame を利用することで、初心者でも手軽にクロスプラットフォームに対応したゲームを作ることができます。.NET Framework や XNA の知識や経験をそのまま使えるという恩恵を受けながら、あらゆるプラットフォーム（市場）に対してゲームを発信することができます。MonoGame には、 iOS や Android 向けのハイクオリティなゲームが開発（あるいはXNAからの移植）されているという実績があり、十分にその有用性が確認できます。 また、MonoDevelop はもちろん、 Visual Studio での開発もサポートされています。XNA あるいは .NET開発者にとって、最も注目すべきゲーム開発フレームワークのひとつと言えるでしょう。この記事を書いたきっかけ
MonoGame の F# テンプレートの作者である@7sharp9氏のツイートおよびブログの記事を見たのがきっかけです。素敵な記事を書いてくださっています。感謝。
F# and MonoGame on the Mac
http://7sharpnine.com/posts/Fsharp-and-MonoGame-on-the-Mac/
現在は、簡単に導入ができるアドインが提供されているので、この記事の内容は古いものになってしまっていますが、
MonoGameのF#テンプレートの導入方法について書かれています。初めて利用するときに参考にさせていただきました。
MonoGame 3D Basics
http://7sharpnine.com/posts/monogame-3d-basics/
正四面体の描画方法について解説されています。
とりあえず MonoGame を使ってみる (Windows8編)
Windows環境では、MonoGameインストーラをダウンロードして、インストールします。すると、Visual Studio 向けの MonoGameのプロジェクトテンプレート(C#用)が追加されますので、それで開発することができます。「えっ？F#のテンプレートはないのかい？」まだありません。XNA4.0同様にF#向けのテンプレートは用意されていませんが、デスクトップゲームであれば、 XNA4.0 と同じ要領で 各MonoGame FrameworkのDLLを参照設定してWindows アプリケーションとして作成することで F# でMonoGameを利用したゲームを作れます。動画は以前私が F# + XNA4.0で作ったものを F# + MonoGameへ移植したものです。ソースコードの修正を必要とせず動作しました。MonoGameは Windows8 ストア向けのゲーム開発もサポートしています。しかし、 F# で開発することはできません(2012/12/12現在)。
例の非常に残念な画像
F# で作れる部分はあくまで Portable Class Library（F#では Portable Library）のみに限られるので、MonoGame に依存する部分は F#で書く事はできません（くやしいです！）。MonoGame のAPI に合わせたインターフェイスを Portable Library に定義して１つ被せてラップすることで、依存部分のみ C# に委譲して F# で書ける部分を増やすように作ることも可能ですが、非常に面倒くさい作業になりますし、正直やってられないので現実的な方法ではないでしょう。Portable Library で書けない部分は、素直に C# に頼りましょう。ちなみに「とことんF#よぷよ！」の例で言うと、MonoGame（XNA）に依存しない namespace PuyoPuyoLibrary(PuyoPuyo.fs) (ソースコードがある記事)の部分を Portable Libraryとして利用することができます。
なお、VMWare (5.0.1)上のWindows8でも動作しましたが、VMWareではGPUやドライバーに大きく影響されてしまいますので、環境によっては SpriteFontがうまく描画されないようです。
XNA4.0 から MonoGameへ 「とことんF#よぷよ！」の移植
非常に退屈な動画
この動画は、F#とXNAで動作していたゲームを MonoGame を使って Mac OS X上で動くように移植する様子を録画したものです。（一部、端折ってます）。開発環境を整えるところが大半で移植作業というほどの手間はなく、ソースコードの変更はごくごくわずかです。 F#とXNAで作ったゲームがこうも簡単に Mac で動いてしまったのには、感動しました。「Mac でも、Monoがあるからできるよ！」と聞いて 「それ知ってます！」とは答えることはできたものの、実際やってみるまであまりピンときませんでした。今回こうして 自分で書いたものが 実際に Mac で動くのを目の当たりにすると、なんだかとっても気分が良いものです。自分は特に何もしていないんですが、なぜか悦に浸れますｗ
Mono も MonoDevelop も MonoGameもすばらしいね！
F# と MonoGame のゲーム開発環境構築について補足
非常に退屈な動画をご覧いただけたのなら、ほぼ説明は必要ないかもしれませんが、Macでの F# + MonoGame の開発環境の構築について補足情報を書いておきます。
インストール前の下準備
なにかしらの Mac を用意します（仮想環境でもよい）。■Xcode をダウンロードします（無料）
https://developer.apple.com/jp/technologies/tools/
最新のものを取得するとよいでしょう。
せっかくなので、Macの開発者登録もしておくとよいかも（無料）
■MonoDevelopをダウンロードします（無料）
http://monodevelop.com/Download
MonoDevelop 3.0.5(安定版） MonoDevelop 3.0.5 installer (Mac OS X) をダウンロードします
MonoDevelop 3.0.6(Beta)でもよいです。
■ Mono Framework をダウンロードします(無料)
http://www.go-mono.com/mono-downloads/download.html
Mono + GTK# Beta Version: 3.0.2 (Mac OS X)
Mono MRE installer および Mono MDK installer をダウンロードします
■MonoGameのソースコード を GitHub から取得します（無料)
https://github.com/mono/MonoGame
この工程はもしかするとなくすことができるのかもしれません。
インストールの手順
■Xcodeをインストールします
動画では省略した部分です。
ただダブルクリックしてもマシンにはインストールされませんので、アプリケーションフォルダにコピーしましょう。
Windowsと勝手が違うので、Mac 初心者のわたしは最初よくわかりませんでしたよ。
■Mono Frameworkをインストールします。
Mono MRE 3.0.2 installer と Mono MDK 3.0.2 installer をそれぞれインストールします。
動画のとおりです。
つい最近 バージョン3.0.2が出たので、ワンステップでF#をインストールできるようになりました（いいね！）。
F# 3.0 now available on Mac OSX with one step install - URL (F# 3.0 is now part of Mono 3.0.2 bundle on Mac) #fsharp
2012-12-06 07:48:29 via web
バージョン 3.0.1までは、F#がバンドルされていなかったので、
GitHub から fsharpのソースコードを取得してきて、home brewを入れたりターミナルからのコマンド操作でビルドをするという、ちょっとした工程が必要でしたが、
3.0.2からは、F#3.0 がMonoに標準装備されたので、本当にお手軽に MonoのF#の環境を作れるようになりました。ま、おかげで動画作り直しだったわけですが。
■MonoDevelop を インストールします。
動画のとおりです。ドラッグアンドドロップしましょう。
■F# アドインを追加します。
動画のとおりです。ワンクリックでバインディングできます。
■MonoGame テンプレートアドインを追加します。
動画のとおりです。こちらのURLをコピーして(http://www.infinitespace-studios.co.uk/monodevelop/main.mrep)アドインを追加しましょう。
これで F#の MonoGameプロジェクトテンプレートが利用できます。
MonoGame 3.0 BETA - MonoDevelop AddIn Available URL #XNA #MonoDevelo #MonoGame #gamedev
2012-11-26 07:04:44 via web
こちらも、わたしがMonoGameを触り始めた11月中ごろにはまだなくて、F#のMonoGameテンプレートを利用するにはちょっとした工程が必要でした。先ほどもご紹介しましたが、テンプレートの作者である @7sharp9 氏の記事で解説されてる内容を実行する必要がありました(F# and MonoGame on the Mac)。動画を見ていただけるとわかりますが、実際にテンプレートを開いてみると、バインディングがうまくいっていないように見えます。わたしの環境の問題でしょうか。直接的な解決策ではありませんが、GitHubから取得した MonoGameのMacOS向けのソリューションを、xbuildでビルドしたものを、直接参照設定することで、MonoGameを利用することができるようになります。
これでF#でMonoGameを使ってゲームプログラミングができます。
準備は整った！さぁShow Timeだ
「F# と MonoGame でゲームが作れるって言われてもさ。 そもそもゲームなんて作ったことないし、何から始めたらよいかわからん。」
ですよねー。最初はだれでもそうです。でもよく考えてみてください。そもそも仕事などで作る業務アプリケーションやWebアプリケーション。基幹システムや組み込み開発など、どんなプログラムだって初めは「作ったことのないもの」ばかりのはずです。作ったことのないものを作る楽しさ。みなさんなら知っていますよね？ わたしもゲームを作るのは素人で趣味の域を脱していませんので偉そうなことは言えませんが、やってみると楽しいのでぜひ手を動かしてみてください。
はじめてゲームを作るときは、まずは真似から始めることをおすすめします。アマチュアバンドが、好きなバンドの曲をコピーするのと同じように、それはとてもよい練習です。まずは真似から始めて、慣れてきたら自分たちでちょっとアレンジする、ゆくゆくはオリジナルもやってみたいね！みたいなね。プログラミングを楽しく上達することができます。何事もまずは真似からじゃないでしょうか。「落ちものパズルゲーム」は比較的簡単に作れるので、テトリスクローンは、しばしば練習題材に使われます。「いや俺が作りたいのはね、よくあるオーソドックスな横スクロールのアクションゲームなんだけど。その手のやつのサンプルないの？」ないこともないですが、言語を限定しないとしても、参考にできそうなものは少ないでしょう。「C#で欲しい」と言われると更に減りますし、F# でとなると非常に限定されます。
MonoGameゲームプログラミングの基本（というかXNAと同じ！）
MonoGame はすべてのAPI が XNA4.0 と一致するので、XNA と全く同じ感覚でゲームプログラミングができます。基本は、Gameクラスを継承したゲームを起動するためのクラスを作成し、必要な処理について、メソッドを適宜オーバーライドして実装します。各コンテンツを読み込んだり(LoadContent)、ゲームの状態を更新したり(Update)、描画(Draw)をする処理を書く、それがはじめの一歩です。
namespace MgaGotoku open MonoMac.AppKit open MonoMac.Foundation open System open System.Runtime.Serialization open Microsoft.Xna.Framework open Microsoft.Xna.Framework.Audio open Microsoft.Xna.Framework.Graphics open Microsoft.Xna.Framework.Input open Microsoft.Xna.Framework.Storage /// Ｍが如く type MgaGotokuGame () as this = inherit Game() /// ゲームタイトル、グラフィックデバイスマネージャ、スプライトバッチ let gametitle, gmanager, sprite = "Ｍが如く", new GraphicsDeviceManager(this), lazy new SpriteBatch(this.GraphicsDevice) /// サンドを鳴らす let soundPlay (se:Lazy<SoundEffectInstance>) = se.Force().Play() /// デフォルトコンストラクタ do // Windowの横幅 gmanager.PreferredBackBufferWidth <- 800 // Windowの縦幅 gmanager.PreferredBackBufferHeight <- 480 () /// ゲームが実行開始する前に必要な初期化処理をここに書きます。 /// ここで必要なサービスを照会して、関連するグラフィック以外のコンテンツを読む込めます。 override this.Initialize() = base.Window.Title <-gametitle; base.Initialize() /// LoadContentはゲームごとに１回呼び出されます。 /// 基本的には、ここですべてのコンテンツを読み込みます。 override this.LoadContent() = base.LoadContent() /// UnloadContentはゲームごとに１回呼び出されます。 /// ここですべてのコンテンツをアンロードします。 override this.UnloadContent () = base.UnloadContent() /// ゲームの状態の更新処理をここに書きます。 /// プレイヤーの入力判定、キャラクタの衝突判定、オーディオの再生などなど override this.Update(gameTime) = base.Update gameTime /// ゲームの描画処理をここに書きます /// gameTimeは、ゲームの瞬間的なタイミング情報です。 override this.Draw(gameTime) = base.Draw gameTime |> fun _ -> gmanager.GraphicsDevice.Clear(Color.CornflowerBlue) sprite.Force().Begin () // Texture2Dであれば、ここでスプライトバッチを描画します。 sprite.Force().End () /// 終了時の処理をここに書きます。 override this.EndRun () = base.EndRun(); type AppDelegate() = inherit NSApplicationDelegate() override x.FinishedLaunching(notification) = let game = new MgaGotokuGame() game.Run() override x.ApplicationShouldTerminateAfterLastWindowClosed(sender) = true module main = [<EntryPoint>] let main args = NSApplication.Init () using (new NSAutoreleasePool()) (fun n -> NSApplication.SharedApplication.Delegate <- new AppDelegate() NSApplication.Main(args) ) 0
ここからジョジョに肉付けをしていきます。プレイヤーの入力（キーボード、ゲームパッド、タッチ操作など）も簡単に取得できますので、プレイヤーの操作に合わせて2Dの画像を上下左右に動かせるようにしてみましょう。そして、SoungクラスやSoundEffectクラスを使うと*.wavや*.mp3などの音を簡単に鳴らせるので、お気に入りの曲を鳴らしてみましょう。なんだかゲームが作れそうな気になってきます！
Ｍが如くF#ive 夢、叶えしMono
ここからは、おまけです。
さて、そろそろ寒〜い記事のタイトルについて触れなければならない。
「また、くだらないこと考えて...」ご名答である。でも思いついちゃったんだからしょうがない。
これを書くきっかけを与えてくれた（？）のは @gab_km さんである。
龍が如く5がやりたいけど #FsAdventJP の進捗がなさすぎてやばい
@gab_km えっ。手伝ってくれるんですか？（そういう問題じゃない
@zecl 完全に門外漢です…＞＜
2012-12-06 08:54:02 via Tween to @zecl
@gab_km みーとぅー...
Mが如くF#ive 夢、叶えしMono
うん。龍が如くは無理。知ってます！ 無理だとわかっていて言っていますね？いじわるだねッ☆ 無理なものは無理なんだけど、できることもあるんじゃないかと思って考えた。古き良き王道横スクロールアクション的なアレなら今からでも間に合うもしれない。上記のやり取りで何か悪い電波を受信してしまいました。人に強制されるのは嫌いだけど、自分で思いつちゃったらこれはもうしょうがない。やるしかない。
WiiU でも新しいやつがでたばかりですが、全世界で人気の王道横スクロールアクションゲームは多くの人がそのクローンを作ろうと試みています。YouTube等の動画サイトで 「Mario C#」とか「Mario XNA」あたりで検索をすると、XNAで作ろうとしたクローンの動画がたくさんでてくる。JavaScriptで実装してみた話とかが割と有名でしょうか。私もパズルゲームやシューティングゲームは趣味でいくつか作った経験があるのだけど、アクションゲームは作ったことがなかった。時間もなかったのでそれっぽいものができるかどうか微妙なところでしたが、なんとなくそれっぽい動き(Ｍが如く)になりました。ぜんぜん全くF#である必要性もないし、どちらかというと「それC#で」が求められている感がある。だが、F#で書いた。この誰にも求められていない感が良いね。「龍が如く５」と、「New スーパーマリオブラザーズ U」の誘惑に負けそうになりながらも、我慢して書きました。全然時間がなくてコードをきれいに書いている余裕がなかったので質は非常にアレですが、コメントは多めに書きましたので、どうか生温かい目で見てください。加えて、「〇〇をF#で書いてみた」的なネタ記事はもっと増えてもいいと思っている。別に屁理屈を言ったり言い訳をするつもりは毛頭ないけど、そういうのも逆説的に"実用"なのではないのかなって。
マリオの動きを真似る
実際にやってみて改めてわかったんですが、マリオの動きや操作感はむかしから非常によく練られていたということ。操作していて楽しいようによく考えて作られている。勉強になるなあ。
Mario.fs
namespace MarioLibrary open System open System.Collections.Generic open System.Text open Microsoft.Xna.Framework.Content open Microsoft.Xna.Framework.Graphics open Microsoft.Xna.Framework open Microsoft.Xna.Framework.Audio [<AutoOpen>] module MarioLibrary = type Direction = Left | Right // キャラの向き type Motion = Stop | Run | Break // 停止、移動、ブレーキ type State = Stand | Squat // 立ち、しゃがみ type CollisionType = Head | Foot | No // Y軸の当たり判定タイプ：頭、足、なし // 幅、立ち状態の高さ、しゃがみ状態の高さ let characterWidth, standHeight, squatHeight = 32, 52, 36 /// ヒゲの配管工 [<AllowNullLiteral>] type Mario internal () = member val Game : Game = null with get,set // ゲームメイン member val X = 0. with get,set // キャラクタのX座標を取得または設定します。 member val Y = 0. with get,set // キャラクタのY座標を取得または設定します。 member val YPrev = 0. with get,set // キャラの前回のY座標を保持 member val Direction = Right with get,set // キャラの方向 member val HeadBlock = false with get,set // 頭にぶつかったか否かを取得または設定します。 member val Condition = Stand with get,set // 立ち、しゃがみの状態を取得または設定します。 member val State = Stop with get,set // キャラの動作状態 member val Jumping = false with get,set // ジャンプ中か否かを取得または設定します。 member val Air = false with get,set // キャラクタが空中にいるか否かを取得または設定します。 member val Jumpval = 0. with get,set // Verlet法の加算値 member val Dash = false with get,set // ダッシュ状態か否か member val JumpUp = false with get,set // 上昇か落下かどうか member val LeverVX = 0. with get,set // 方向キーによる加速度 member val DashVX = 0. with get,set // ダッシュによる加速度 member val AddjumpCnt = 0 with get,set // Verlet法の加算カウンタ member val Jumpadded = 0 with get,set // Verlet法上昇下降カウンタ member val Timer = 0. with get,set // アニメーション用のタイマー member val Blocks = Seq.empty<Rectangle> with get,set // 当たり判定対象のブロックを取得または設定します。 /// マリオをつくる let createMario x y game = new Mario(X = x, Y =y, YPrev = y, Game = game, Direction = Right, State = Stop, Condition = Stand) // ダッシュによる最大速度、ダッシュによる加速度、歩行による最大速度、歩行による加速度 let dashMaxSpeed, dashAcceleration, leverMaxSpeed, leverAcceleration = 6.5, 0.08, 5.5, 0.08 /// Verlet法の加算値。値を変更でジャンプの放物線を調整 let verletArr = [ 1.0; 0.5; 0.5; 0.5; 0.5; 0.5; 0.25; 0.25; 0.25; 0.25; 0.25; 0.25; 0.15;] // 歩行アニメーション用のベースフレーム、FPS let baseFreamRight, baseFreamLeft, fps = 55., -55., 60. /// スペースキーを押し続けた場合の加算の割合 let jumpAddSep = Math.Max(Math.Round((fps |> decimal) / 5m, 1), 1m) /// 1メートルを何ピクセルとするか let mppx = 34. /// 重力加速度 let gravity = 9.8 * mppx /// 重力加速度 × フレーム表示間隔(秒)の2乗 let gh2 = Convert.ToSingle(gravity * Math.Pow((1. / fps), 2.)) /// キャラクタテクスチャ幅を取得します let width = characterWidth /// 移動アニメフレーム let mutable moveFrame = 0 /// キャラクタテクスチャ高さを取得します let height (m:Mario) = m.Condition |> function | Squat -> squatHeight | Stand -> standHeight /// 現在のキャラクタのX軸における加速度を取得します。 let getAcceleration (m:Mario) = m.DashVX + m.LeverVX /// 初速度を取得します let getV (m:Mario) = let peakY = m.Y - float (standHeight * 3) -1. * Math.Sqrt(2. * gravity * (m.Y - peakY)) /// キャラの座標を表すRectangleを返します let posRect (m:Mario) px py = m.Condition |> function | Stand -> Rectangle (px, py, characterWidth, standHeight) | Squat -> Rectangle (px, py + 16, characterWidth, squatHeight) /// ジャンプ音、頭ぶつけた時の音の遅延ロード用 let se (m:Mario) = let jumpSuper, bump = ["jump-super";"bump";] |> List.map (fun name -> m.Game.Content.Load<SoundEffect>(@"Content\sound\" + name).CreateInstance() |> fun x -> x.Volume <- 1.0f; lazy x) |> function | a::b::[] -> a,b | _ -> invalidArg "tlist" "リストの長さが違うよ。" jumpSuper, bump /// Y軸 キャラクタと障害物の当たり判定 let collisionY (m:Mario) (nextY:float) bumpPlay = let px, py = m.X |> int, (Math.Ceiling(nextY)) |> int let prec = posRect m px py let normalAction () = m.Air <- true let normal = normalAction () ; false, float py let footAction () = m.HeadBlock <- false; m.Air <- false let headAction () = if bumpPlay then se m |> snd |> fun bump -> bump.Force().Play() m.HeadBlock <- true let f (brec:Rectangle) = if prec.Intersects(brec) then // 空中 m.Air <- true // 頭の衝突 if ((prec.Top < brec.Bottom || prec.Top < brec.Bottom) && prec.Bottom > brec.Bottom) then true, brec.Bottom |> float, Head // 足の衝突 elif ((prec.Bottom > brec.Top || prec.Bottom > brec.Top) && prec.Top < brec.Top) then true, (brec.Top - standHeight) |> float, Foot else false, float py, No else false, float py, No if m.Blocks = null || m.Blocks |> Seq.length = 0 then false, nextY else m.Blocks |> Seq.map f |> Seq.tryFind(fun (x,_,_) -> x) |> function | None -> normal | Some (r,y,c) -> c |> function | Head -> headAction(); r,y | Foot -> footAction(); r,y | No -> normalAction(); r,y /// ジャンプ let jump (m:Mario) = let px, py = m.X |> int, m.Y - 17. |> int let prec = Rectangle(px, py, width, m |> height) let result,_ = collisionY m (prec.Y |> float) true let jumpSuper, bump = se m if result then bump.Force().Play() else jumpSuper.Force().Play() m.JumpUp <- true m.Jumping <- true /// Verlet法で次のY座標を取得する let calcVerlet (m:Mario) = let f () = // キャラクターの次のY座標をVerlet法で算出 let possibleY = if m.Jumping && m.Y = m.YPrev then // 初速度から算出 gravity / (Convert.ToDouble(2. * Math.Pow(fps, 2.))) + getV m / fps + m.Y else // 現在の加速値から算出 m.Y + m.Y - m.YPrev + m.Jumpval // Y座標の当たり判定を行う let result, backY = collisionY m possibleY true m.YPrev <- m.Y //tempY if result |> not then possibleY else m.JumpUp <- false m.AddjumpCnt <- 0 m.Jumpadded <- 0 m.Jumping <- false backY if m.JumpUp then // 上昇中 verletArr |> List.map (fun x -> x * -1.) |> fun varray -> if m.AddjumpCnt > 0 then m.Jumpadded <- m.Jumpadded + 1 if (m.Jumpadded >= Seq.length varray) then // 最後の加算。これ以上キーを押し続けても加算しない m.Jumpval <- varray.[Seq.length varray - 1] m.AddjumpCnt <- 0 m.JumpUp <- false else m.Jumpval <- varray.[m.Jumpadded - 1] m.AddjumpCnt <- m.AddjumpCnt + 1 f () else // 落下中 m.JumpUp <- false m.AddjumpCnt <- 0 m.Jumpadded <- m.Jumpadded + 1 verletArr |> List.rev |> fun varray -> if m.Jumpadded >= Seq.length varray then m.Jumpval <- varray.[Seq.length varray - 1] else m.Jumpval <- varray.[m.Jumpadded - 1] f() /// X軸 キャラクタと障害物との当たり判定 let collisionX (m:Mario) nextX = let normal = false, m.X let px = nextX |> int let py = m.Y |> int let prec = posRect m px py let f (brec:Rectangle) = let slowdown () = m.DashVX <- m.DashVX / 1.3 m.LeverVX <- m.LeverVX / 1.3 if prec.Intersects(brec) then if m |> getAcceleration > 0. then if brec.Left < prec.Right then slowdown () true, (brec.Left - characterWidth) |> float elif brec.Right < prec.Left then slowdown () true, brec.Right |> float else normal elif m |> getAcceleration < 0. then if brec.Left < prec.Right then slowdown () true, brec.Right|> float elif brec.Right < prec.Left then slowdown () true, (brec.Right + characterWidth)|> float else normal else normal else normal if m.Blocks = null || m.Blocks |> Seq.length = 0 then false, nextX else m.Blocks |> Seq.map f |> Seq.tryFind(fun (x,y) -> x) |> function | None -> normal | Some x -> x /// キャラクタの描画 let drawMario (m:Mario) (spriteBatch : SpriteBatch) (gameTime : GameTime) = /// 状態に応じたSpriteEffectを返します let getSpriteEffect = fun () -> m.Direction |> function | Left -> SpriteEffects.FlipHorizontally // 反転 | Right -> SpriteEffects.None // そのまま描画 /// 現在のキャラクタテクスチャの短形を取得する let textureRectangle () = let height = m |> height if m.Condition = Squat then Nullable (Rectangle(192, 16, characterWidth, height)) // しゃがみ elif m.Air && m.HeadBlock then Nullable (Rectangle(160, 0, width, height)) // 頭ぶつけて空中 elif m.Air && m.Jumping |> not then Nullable (Rectangle(64, 0, width, height)) elif m.Jumping then Nullable (Rectangle(160, 0, width, height)) elif m |> getAcceleration = 0. then Nullable (Rectangle(96, 0, characterWidth, height)) elif m.State = Break then Nullable (Rectangle(128, 0, characterWidth, height)) // ブレーキしてたら // 加速してたら elif m.State = Run then m.Timer <- m.Timer + getAcceleration m * 4. let nextFrame = ref 0. m.Direction |> function | Left -> nextFrame := baseFreamLeft - getAcceleration m | Right -> nextFrame := baseFreamRight - getAcceleration m if m.Direction = Right && m.Timer > !nextFrame || m.Direction = Left && m.Timer < !nextFrame then m.Timer <- 0. let rect = Rectangle(moveFrame * characterWidth, 0, characterWidth, height) moveFrame <- moveFrame + 1 if moveFrame > 2 then moveFrame <- 0 Nullable rect else Nullable (Rectangle(moveFrame * characterWidth, 0, characterWidth, height)) else Nullable (Rectangle(96, 0, characterWidth, height)) /// 右向きのマリオのテクスチャ遅延ロード let marioTexture = lazy m.Game.Content.Load<Texture2D>(@"Content\image\right") let px, py = m.X |> int, m.Y |> int spriteBatch.Draw(marioTexture.Force(), posRect m px py, textureRectangle (), Color.White, 0.f, Vector2.Zero, getSpriteEffect(), 0.f) /// 加速度から割り出される次のフレームのX座標 let nextX (m:Mario) = Math.Ceiling(m.X + getAcceleration m) /// Verlet法から割り出される次のフレームのY座標 let nextY (m:Mario) = m |> calcVerlet /// X軸移動 let moveX (m:Mario) = let nextX = nextX m let result,x = collisionX m nextX if (m.Air |> not && m.Condition = Squat) then if result |> not then m.X <- nextX |> float else m.X <- x elif result |> not then m.X <- nextX |> float /// Y軸移動 let moveY (m:Mario) = m.Y <- nextY m |> float /// 立つ let standUp (m:Mario) = let py = m.Y - 17. if m |> getAcceleration <> 0. then let result,_ = collisionY m py false if not result then m.Condition <- Stand else let result,_ = collisionY m py false if not result then m.Condition <- Stand moveX m // 緩やかに減速 let slowdown (m:Mario) = if m.LeverVX > 0. then if m.LeverVX - leverAcceleration < 0. then m.LeverVX <- 0. else m.LeverVX <- m.LeverVX - leverAcceleration elif m.LeverVX < 0. then if m.LeverVX + leverAcceleration > 0. then m.LeverVX <- 0. else m.LeverVX <- m.LeverVX + leverAcceleration if m.DashVX > 0. then if m.DashVX - leverAcceleration < 0. then m.DashVX <- 0. else m.DashVX <- m.DashVX - leverAcceleration elif m.DashVX < 0. then if m.DashVX + leverAcceleration > 0. then m.DashVX <- 0. else m.DashVX <- m.DashVX + leverAcceleration /// ブレーキ let break' (m:Mario) = m.State <- Break m |> slowdown /// 最大加速度を制御します let getMaxAcceleration (m:Mario) = if m.LeverVX > 0. && m.LeverVX > leverMaxSpeed then m.LeverVX <- leverMaxSpeed elif (m.LeverVX < leverMaxSpeed * -1.) then m.LeverVX <- leverMaxSpeed * -1. if m.DashVX > 0. && m.DashVX > dashMaxSpeed then m.DashVX <- dashMaxSpeed elif (m.DashVX < dashMaxSpeed * -1.) then m.DashVX <- dashMaxSpeed * -1. /// デフォルトは右に加速 let accel (m:Mario) f d c = if m.Direction = Left then m.State <- Break if not m.Jumping then // 空中ではない場合キャラの向きを変える m.Direction <- c if m.LeverVX < 0. |> d then m.DashVX <- m.DashVX + f (dashAcceleration * 1.5) if m.DashVX >= 0. |> d then if m.DashVX - f (leverAcceleration * 0.8) < 0. then m.DashVX<- 0. else m.DashVX <- m.DashVX - f (leverAcceleration * 0.8) m.LeverVX <- m.LeverVX + f (dashAcceleration * 2.5) if m.LeverVX >= 0. |> d then m.DashVX <- 0. else if m |> getAcceleration > 0. |> d then m.State <- Run if m.Dash then m.DashVX <- m.DashVX + f dashAcceleration else if m.DashVX > 0. |> d then if m.DashVX - f (leverAcceleration * 0.8) < 0. then //m.DashVX <- 0. m.DashVX <- m.DashVX - f (leverAcceleration * 0.8) m.LeverVX <- m.LeverVX + f leverAcceleration m |> getMaxAcceleration
Main.fs
namespace MgaGotoku open MonoMac.AppKit open MonoMac.Foundation open System open System.Linq open System.Collections.Generic open System.Runtime.Serialization open Microsoft.Xna.Framework open Microsoft.Xna.Framework.Audio open Microsoft.Xna.Framework.Graphics open Microsoft.Xna.Framework.Input open Microsoft.Xna.Framework.Storage open Microsoft.Xna.Framework.Media open MarioLibrary type GameState = Playing | Die | Gameover | End /// Ｍが如く type MgaGotokuGame () as this = inherit Game() /// ゲームタイトル、グラフィックデバイスマネージャ、スプライトバッチ let gametitle, gmanager, sprite = "Ｍが如くF#ive 夢、叶えしMono", new GraphicsDeviceManager(this), lazy new SpriteBatch(this.GraphicsDevice) /// プレイヤー let mutable player : Mario = Unchecked.defaultof<_> /// ゲームの状態 let mutable gameState = Playing /// コイン、フロアタイル、ソリッドタイル、土管のテクスチャ遅延ロード用 let coinTexture,floorTileTexture,solidTileTexture,greenPipeTexture, gameoverTexture = ["coin";"brownFloorTile";"brownSolidTile";"greenPipe";"gameover"] |> List.map (fun name -> lazy this.Content.Load<Texture2D>(@"Content\image\" + name)) |> function | a::b::c::d::e::[] -> a,b,c,d,e | _ -> invalidArg "tlist" "長さが違う" /// coin取得音 let getCoin = lazy (this.Content.Load<SoundEffect>(@"Content\sound\getcoin")) /// die let die = lazy (this.Content.Load<SoundEffect>(@"Content\sound\smb_mariodie").CreateInstance()) let gameover = lazy (this.Content.Load<SoundEffect>(@"Content\sound\smb_gameover").CreateInstance()) /// ゲームのBGM遅延ロード用 let bgm = lazy (this.Content.Load<SoundEffect>(@"Content\sound\overworld").CreateInstance()) /// サンドを鳴らす let soundPlay (se:Lazy<SoundEffectInstance>) = se.Force().Play() // 配置するフロアタイル let floors = [-5..15]@[17..30] |> List.map (fun x -> new Rectangle(33 * x, 452, 32, 32)) // フロアタイルの描画 let drawFloors () = // すべてのフロアタイルを描画 floors |> List.iter (fun rect -> sprite.Force().Draw(floorTileTexture.Force(), rect, Color.White)) // 配置するブロック let blocks = [2..4] |> List.map (fun x -> new Rectangle(100 + 32 * x, 416 - (33 * (x - 1)), 32, 32)) // ブロックの描画 let drawBlocks () = // すべてのブロックを描画 blocks |> List.iter (fun rect -> sprite.Force().Draw(solidTileTexture.Force(), rect, Color.White)) // アニメーション用テクスチャRectangleを取得するクロージャー let animationTextureRectangle width hight max = let flame = 10 let animeWait, counter = ref 0, ref 0 (fun () -> animeWait := !animeWait + 1 let rect = new Rectangle(!counter * width, 0, width, hight) if !animeWait > flame then animeWait := 0; incr counter if !counter > max then counter := 0 Nullable rect else Nullable rect) // 配置するコイン let coins = new List<Rectangle>() // コインの点滅を表現 let coinTextureRect = animationTextureRectangle 20 28 3 // コインの描画 let drawCoins () = // クロージャからコインのカレントテクスチャRectangleを取得 let coinRect = coinTextureRect () // すべての配置するコインを描画 coins.ToList() |> Seq.iter (fun rect -> sprite.Force().Draw(coinTexture.Force(), new Vector2(rect.X |> float32, rect.Y |> float32), coinRect, Color.White)) // 配置する土管 let greenPipes = [0..0] |> List.map (fun x -> new Rectangle(32 * 15, 452-77 , 48, 77)) // 土管の描画 let drawGreenPipes () = // すべての配置する土管を描画 greenPipes |> List.iter (fun rect -> sprite.Force().Draw(greenPipeTexture.Force(), rect, Color.White)) /// コインとの当たり判定 let checkTouchCoin = let wait =ref 0. (fun () -> async { let terget = coins.ToList() wait := !wait + 1. if !wait > 2. then let prect = new Rectangle(player.X |> int, player.Y |> int, 32, 52) terget |> Seq.filter (fun coin -> prect.Intersects(coin)) |> Seq.iter (fun coin -> ignore <| getCoin.Force().Play(); ignore <| coins.Remove(coin)) wait := 0. } |> Async.Start) /// X座標における画面からはみ出した場合、反対側から出てくるように let checkWindowOut () = if player.X > 800. && player |> getAcceleration > 0. then player.X <- -32.// 画面右隅へ if player.X < -32. && player |> getAcceleration < 0. then player.X <- 800.// 画面左隅へ /// しんでしまったか判定 let checkDie () = if gameState = Playing && player.Y > 510. then ignore <| bgm.Force().Stop() ignore <| die.Force().Play() gameState <- Die /// プレイヤーの情報を更新 let updatePlayer () = let f () = player |> moveX ; player |> moveY checkTouchCoin >> checkWindowOut >> checkDie <| () // ゲームの終了条件をチェックします。 if (GamePad.GetState(PlayerIndex.One).Buttons.Back = ButtonState.Pressed) then this.Exit() // ジャンプ処理 if player.Jumping |> not then if (Keyboard.GetState(PlayerIndex.One).IsKeyDown(Keys.Z) && (player.HeadBlock |> not)) then if (player.Air |> not) then player |> jump elif player.Jumping then if (Keyboard.GetState(PlayerIndex.One).IsKeyDown(Keys.Z) |> not) then player.JumpUp <- false // 左右両方入力されていたら if (Keyboard.GetState(PlayerIndex.One).IsKeyDown(Keys.Right) && Keyboard.GetState(PlayerIndex.One).IsKeyDown(Keys.Left)) then // ブレーキ player |> break'; f () else // 左右未入力なら緩やかに減速 if ((Keyboard.GetState(PlayerIndex.One).IsKeyDown(Keys.Right) |> not) && (Keyboard.GetState(PlayerIndex.One).IsKeyDown(Keys.Left) |> not)) then if (Keyboard.GetState(PlayerIndex.One).IsKeyDown(Keys.Down)) then player.Condition <- Squat // 緩やかに減速 player |> slowdown; f () else player |> standUp player |> slowdown; f () else player |> standUp if (Keyboard.GetState(PlayerIndex.One).IsKeyDown(Keys.Right)) then if (Keyboard.GetState(PlayerIndex.One).IsKeyDown(Keys.X)) then player.Dash <- true else player.Dash <- false accel player id id Right if (Keyboard.GetState(PlayerIndex.One).IsKeyDown(Keys.Left)) then if (Keyboard.GetState(PlayerIndex.One).IsKeyDown(Keys.X)) then player.Dash <- true else player.Dash <- false accel player (fun x -> -1. * x) not Left f () /// デフォルトコンストラクタ do gmanager.PreferredBackBufferWidth <- 800 // Windowの横幅 gmanager.PreferredBackBufferHeight <- 480 // Windowの縦幅 this.TargetElapsedTime <- TimeSpan.FromSeconds(1./60.) /// ゲームが実行開始する前に必要な初期化処理をここに書きます。 override this.Initialize() = // ウィンドウタイトルを設定 base.Window.Title <-gametitle; // コインを配置 let d, m, width, height = 30, 25, 20, 28 let space = let f source = [0..31] |> Seq.filter(fun x -> source |> Seq.exists (fun y -> x = y) |> not ) seq { yield [] |> f yield [10..14]@18::[20] |> f yield [10;18;20;] |> f yield 10::[17..21] |> f yield [10..13]@18::[20] |> f yield 10::[17..21] |> f yield [10;18;20;] |> f yield [10;18;20] |> f yield [] |> f yield [] |> f } |> Seq.mapi (fun i x -> x,i) space |> Seq.iter (fun (h,i) -> h |> Seq.iter (fun x -> coins.Add(new Rectangle(m * x, d * i, width, height)))) // BGMを鳴らす ignore <| bgm.Force().Play() base.Initialize() /// LoadContentはゲームごとに１回呼び出されます。 /// 基本的には、ここですべてのコンテンツを読み込みます。 override this.LoadContent() = player <- createMario 0. 400. this player.Blocks <- floors.Concat(blocks).Concat(greenPipes) base.LoadContent() /// UnloadContentはゲームごとに１回呼び出されます。 /// ここですべてのコンテンツをアンロードします。 override this.UnloadContent () = base.UnloadContent() /// ゲームの状態の更新処理をここに書きます。 /// プレイヤーの入力判定、キャラクタの衝突判定、オーディオの再生などなど override this.Update(gameTime) = gameState |> function | Playing -> updatePlayer () | Die -> if die.Force().State = SoundState.Stopped then gameState <- Gameover | Gameover -> gameover.Force().Play() gameState <- End | End -> () base.Update gameTime /// ゲームの描画処理をここに書きます /// gameTimeは、ゲームの瞬間的なタイミング情報です。 override this.Draw(gameTime) = base.Draw gameTime |> fun _ -> gameState |> function | Playing | Die -> gmanager.GraphicsDevice.Clear(Color.CornflowerBlue) // スプライトバッチ処理開始 sprite.Force().Begin () // 各描画処理を実行 [drawFloors; drawCoins;drawBlocks;drawGreenPipes;] |> List.iter (fun f -> f()) // プレイヤーを描画 drawMario player (sprite.Force()) gameTime // スプライトバッチ処理終了 sprite.Force().End () | Gameover | End -> gmanager.GraphicsDevice.Clear(Color.Black) sprite.Force().Begin () sprite.Force().Draw(gameoverTexture.Force(), Vector2(200.f,150.f), Color.White) sprite.Force().End () /// 終了時の処理をここに書きます。 override this.EndRun () = base.EndRun() type AppDelegate() = inherit NSApplicationDelegate() override x.FinishedLaunching(notification) = let game = new MgaGotokuGame() game.Run() override x.ApplicationShouldTerminateAfterLastWindowClosed(sender) = true module main = [<EntryPoint>] let main args = NSApplication.Init () using (new NSAutoreleasePool()) (fun n -> NSApplication.SharedApplication.Delegate <- new AppDelegate() NSApplication.Main(args) ) 0
マリオの歩行とダッシュ
マリオは左右の方向キーが押下されている間、歩行状態となり特定のスピードまで加速します。左右の方向キーに加えてダッシュ用のボタンを押下していると、さらに最大スピードに達するまで加速します。というのが、横移動の基本となります。減速
これは歩行とダッシュに密接に関係があるところ。加速があれば減速もある、そりゃそうだ。運動には慣性が働くもの。それを無視してしまうと非常に違和感のあるものになります。方向キーが離さてすぐにキャラクタがその場に急停止してしまうと非常に不自然です。なのでボタンが離されると緩やかに減速してから停止するように速度を調整してやる必要があります。物理エンジンでも使っていれば、この辺のことは勝手にやってくれるんでしょうが。他にも移動している方向と逆に方向キーを入力したとき、急ブレーキをする表現があったり、移動中にしゃがむことで緩やかに減速するなど、細かな仕様を満たす必要がある。
マリオのジャンプの実装
マリオのジャンプは、これまでも様々なアクションゲームで模倣されてきたと思う。ボタンの押下時間に応じてジャンプ力が変化するところなんかは、アクション性に大きな影響を与えている。あの心地よい放物線を描くジャンプは、どんな風につくられているのか？ 以前、読んだマリオのジャンプ実装法とVerlet積分 - Gemmaの日記を思い出しまして、再度拝見。なるほどーシンプルな原理でつくられているんですね。とりあえずそのままやってみると、当然ジャンプはする。だが、記事のまんま実装してもマリオ的な放物線にはならない。まぁそりゃそうですよね。続編として、マリオのジャンプ実装法とVerlet積分(実践編) - Gemmaの日記もありますが、ソースコードへのはリンクは切れていた。Verlet法というのを使うといい感じにできるということがわかったので、ググってみる。すると、どうやら分子動力学に関する話題のようである。なんとなく理屈はわかったけどどう実装すれば？なるほどわからん。すると、そのままズバリのわかりやすい良記事を発見。ありがたい。→ ジャンプしたときの座標をVerlet法で求める - 無職のプログラミング
上記記事では、既定値とする地面(Y座標)に操作対象のオブジェクトが接地しているときは、キャラクタに重力が働かないように実装されてる。それだと、ジャンプして上にあるブロックに乗っかることもできないし、乗っかったブロックから落下することもできない。なので、記事を参考にしつつジャンプをしていないときも常にキャラクタに重力がかかるように実装する。するとマリオ的なジャンプのソレがうまいこといく。誤解を恐れずにいうと、使う側からすると、Verlet法というのは「現在の位置と前回の位置と経過する時間から次の位置を割り出せば楽じゃん」というもの。キャラクタの位置状況を把握しやすいし便利。よくよく考えてみると、X軸方向の移動に関しても結局は時間経過による移動なので、同様の方法で実装することもできる。ただ、マリオを表現する場合、移動している方向と逆に方向キーを入力したとき、急ブレーキをする表現が必要なので、キー入力時間による加速度を制御したほうが、実装は楽かもしれません。結果オーライだった。
コインの取得（というか、物体との当たり判定）
MonoGame(XNA)には、矩形（四角形の位置とサイズ）を表すのに便利な Rectangle構造体 があります。Rectangle構造体 には、当たり判定（ある矩形が別の矩形に重なるかを判定）を手軽にできるIntersectメソッドが提供されています。なので、それを使えばあたり判定できる。ただし、これだけではどの方向からどの面に対してぶつかったのかの判定材料にはならないので、実際に必要な当たり判定を得るには、もう少し考慮が必要となる。判定をミスるとキャラが地面やブロックにめり込んで残念なことに。よくわかりませんが、だいぶＭが如く感（マリオっぽさ）を出せたんじゃないだろうか。これくらい実装できてくると、だんだんと面白くなってきて次第に欲がでてくる。ステージ１−１を丸ごと実装しようかななんて脳裏に浮かんだけど、冷静に考えると非常に面倒くさそうなので１発ネタはこれにて終了。ただ、今回書いたコードはあまりにもやっつけ仕事すぎるので、余裕ができたらキレイに書き直してみたいかも。
まとめ：つまり結局、どういうことだってばよ！？
ﾄﾞﾗｲﾊﾞｰ ｵﾝ
ﾓﾉﾄﾞｩﾋﾞﾀｯﾁﾍｰﾝｼｰﾝ!
ﾓﾉﾄﾞｩﾋﾞﾀｯﾁﾍｰﾝｼｰﾝ!
ﾓﾉﾄﾞｩﾋﾞﾀｯﾁﾍｰﾝｼｰﾝ!
ﾓﾉｹﾞｰﾑ ﾌﾟﾘｰｽﾞ ｴー、ｴー! xna!
ﾓﾉﾃﾞﾍﾞﾛｯﾌﾟ ﾍｰﾝｼｰﾝ!
ﾓﾉﾃﾞﾍﾞﾛｯﾌﾟ ﾍｰﾝｼｰﾝ!
ﾓﾉﾃﾞﾍﾞﾛｯﾌﾟ ﾍｰﾝｼｰﾝ!
ｱﾊﾞﾝﾁｭ・ﾏｯｸ・ﾀｯﾁｺﾞｰ!
ｷｬﾓﾅ ｴﾌｼｬｰﾌﾟ ｼｪｲｸﾊｰﾝｽﾞ ﾁｮｰｲｰﾈ!!
任意のOSで実行!! ｻｲｺｰ!!
「さぁ、Show Timeだ」
次は、@otfさんですね。楽しみです。
F# Implementation of BackPropagation Neural Network for Pattern Recognition(LifeGame)
この記事は、F# Advent Calendar 2011の21日目です。
きっかけは、11月19日に札幌で行われた第64回CLR/H勉強会で、愛甲健二さん(@07c00)がお話してくれた「コンピューターに萌えを教えてみたよ」というセッションです。「アダルトサイトの検知」のメカニズムだったり、愛甲さん自身の"萌えの嗜好"をコンピューターに学習させてみるという少しアレゲなテーマでのお話しでしたが、内容はとても真面目で面白かった。見慣れない数式など、その全てを理解することはできませんでしたが、ニューラルネットワークの雰囲気や概要がわかりました。オライリーの「集合知プログラミング」でニューラルネットワークについて少し読んだことがあったり、何となく見聞きしたことはありましたが、基本的な考え方を知ったのはそのときがはじめてです。とても面白くもっと知りたいと思ったので、勉強会の後にモクモクとニューラルネットワークに関する情報を集めて自分なりに勉強してみました。"脳を模してモデル化したアルゴリズムによって、コンピュータに学習能力をもたせる。" なんだか面白かっこいい！じゃないですか。いろいろと調べているうちに、これなら自分にも実装できそう！と思ったので、みんな大好きF#でやってみました。F#の記事というよりも、むしろニューラルネットワーク成分多い目だが、
「大丈夫だ、ゆるふわなので問題ない。」
ニューラルネットワークとは
情報分野におけるニューラルネットワークとは、われわれ人間の脳の神経回路の仕組みを模してモデル化したもので、コンピュータに学習能力を持たせることで、様々な問題を解決しようとするアプローチのひとつで、人工知能の一分野で機械学習というジャンルに属します。もともとニューラルネットワークという研究分野は、人間が自然と行っているパターン認識や経験則を導き出したりする仕組みをモデル化して、ロボットが経験から学習していくことで、正しい反応や行動を獲得していく仕組みを実現することを目的とした側面が強かったようですが、次第に工学寄りにシフトしてきて、「データの中で明らかなものから、明らかではないものを予測する（ことをコンピュータにやらせるための）」技術や理論を指すことがほとんどになってきたようです。近年の自然言語処理や画像のパターン認識、データマイニング、あるいは信用リスク格付け予測など、ビジネス用途での応用分野における成功を要因に、普及と発展が進んでいて現在も広くその研究や応用が進められている。
教師あり学習というアプローチ
機械学習の扱う問題には、大きく分けて教師あり学習 （supervised learning） と、教師なし学習 (unsupervised learning) の２つがある。 単純にその２つに分類することができない、複合的な問題や独自に発展した特殊問題もあるようですが、基本的には、この２つに分類することができる。愛甲さんがお話してくれた、アダルトサイトの検知だったり、「コンピューターに萌えを教えてみたよ」は、ちょうど教師あり学習にあたります。教師あり学習では、入力データ（条件として明らかとなっている情報）が与えられたとき、これに対する出力（答えが明らかではない情報）を正しく予測することが目的です。 もちろん、ただ入力を入れられただけでは、コンピューターは答えとして何を出力したらよいのかわかりません。そこで、訓練データ（あるいは教師データ）と呼ばれる、入出力のペアとしたデータを、あらかじめコンピューター複数与えます。「コレの入力があったら、コレを出力しなさい」というパターンをいくつか与えて機械に学習させます。新しい入力データが来たときに、それに対する正しい出力をするような機械（関数）を作るのが目的です。複雑で広い領域の問題では、すべてのパターンを機械に学習させることは不可能で、当然、あらかじめ学習に用いる訓練データの中には現れない入力データが与えられる場合もあります。そのようなデータに対応するために、与えられた訓練データを一般化して、未知のデータに対処して予測を出力する能力（汎化能力）がなるべく高くなるような、学習アルゴリズムを設計することが、教師あり学習の主要なテーマとなります。ニューラルネットワークは、汎化能力の高い教師あり学習のアプローチのひとつです。
F#でニューラルネットワーク
F#でバックプロパゲーションアルゴリズムを用いた３層パーセプトロンを実装しました。時間がなくて整理しきれなかった部分があり心残りな面もありますが、以下、NNモジュールです。参考になればと思い、普段は書かないような説明的なコメントも多めに書いてみました。
F#
namespace NN open System [<AutoOpen>] module NN = /// 訓練データパターン type Pattern = { Inputs : double list; (* 入力 *) TeachingSignal: double list (* 教師信号 *) } // 層をつくる let createLayer size build = let rec create size acc = if size <= 0 then acc else create ((-) size 1) (acc@[build ()]) create size [] /// シグモイド関数 /// 関数のある点での勾配を求めて誤差Eが少なくなる方向へ結合重みWを変化させていきます。 let sigmoid input bias = /// α(gain)を1.0とするとき標準シグモイド関数と言う let gain : double = 5.0 1.0 / (1.0 + Math.Exp(-gain * (input + bias))) /// ニューロン type Neuron = { mutable bias : double // バイアス mutable error : double // E mutable input : double // 入力 mutable output : double // 出力 learnRate : double // 学習レート weights : Weight list // 重み } /// 出力 member this.Output with get () = if (this.output <> Core.double.MinValue) then this.output else // 判別問題を学習させる場合は階段関数やシグモイド関数を用いる。回帰問題を学習させる場合は線形関数を用いる。 // 今回はシグモイドで sigmoid this.input this.bias and set (v) = this.output <- v // 重み and Weight = { In: Neuron; mutable Value:double } // 層 and Layer = Neuron list /// 活性化 let activate neuron = neuron.input <- 0.0 for w in neuron.weights do neuron.input <- neuron.input + w.Value * w.In.Output /// エラーフィードバック let errorFeedback (neuron:Neuron) (input:Neuron) = neuron.Output * (1.0 - neuron.Output) |> fun derivative -> // より大きな重みで接続された前段のニューロンに対して、局所誤差の責任があると判定する。 let w = neuron.weights |> List.find (fun t -> t.In = input) neuron.error * derivative * w.Value /// 各ニューロンの重みを局所誤差が小さくなるよう調整する。 let adjustWeights (neuron:Neuron) (value:double) = neuron.Output * (1.0 - neuron.Output) |> fun derivative -> neuron.error <- value for i in [0..neuron.weights.Length-1] do // 出力と教師信号が異なれば、出力値を少しだけ教師信号寄りに重みを修正する neuron.weights.[i].Value <- neuron.weights.[i].Value + (neuron.error * neuron.learnRate * derivative * neuron.weights.[i].In.Output) // バイアスの補正 neuron.bias <- neuron.bias + neuron.error * neuron.learnRate * derivative /// 素のニューロンを生成 let createNewron () = { bias = 0.0 error = 0.0 input = 0.0 output = Core.double.MinValue learnRate = 0.5 weights = [] } /// 入力についてランダムな重みを持つニューロンを生成 let createNewron' inputs (rnd:Random) = let createWeights () = inputs |> List.map (fun input -> { In = input; Value = rnd.NextDouble() * 2.0 - 1.0 }) |> List.fold (fun a b -> a@[b]) [] { bias = 0.0 error = 0.0 input = 0.0 output = Core.double.MinValue learnRate = 0.5 weights = createWeights () } /// ネットワーク type Network = { InputSize : int MiddleSize : int OutputSize : int RestartAfter : int TryCount : int Inputs : Layer Middle : Layer Outputs : Layer Patterns : Pattern list } /// 入力層、中間層、出力層のニューロンを生成 let createNeuron inputSize middleSize outputSize = let rnd = new Random() let inputs = createLayer inputSize (fun () -> createNewron ()) let middle = createLayer middleSize (fun () -> createNewron' inputs rnd) let outputs = createLayer outputSize (fun () -> createNewron' middle rnd) inputs, middle, outputs /// ニューラルネットワークの各ニューロンを活性化 let networkActivate (network:Network) (pattern:Pattern) = for i in [0..pattern.Inputs.Length - 1] do network.Inputs.[i].Output <- pattern.Inputs.[i] for neuron in network.Middle do activate neuron for output in network.Outputs do activate output network.Outputs |> List.map (fun output -> output.Output) /// 初期化 let initializeNetwork (network:Network) = let inputs,middle,outputs = createNeuron network.InputSize network.MiddleSize network.OutputSize { network with Inputs = inputs; Middle = middle; Outputs = outputs; TryCount = 0 } /// 訓練データをNetworkに読み込む let loadPatterns (network:Network) (trainingData :(double list * double list) list) = let rec create n acc = if n <= 0 then acc else let inputs,teachingSignal = trainingData.[n] create ((-) n 1) (acc@[{Inputs=inputs; TeachingSignal=teachingSignal}]) { network with Patterns = create (trainingData.Length-1) [] } /// 訓練 let training (network:Network) = /// 重み調整:バックプロパゲーション let adjustWeights (delta:double) = // 個々のニューロンの期待される出力値と倍率(scaling factor)、要求された出力と実際の出力の差を計算する。これを局所誤差と言う。 for output in network.Outputs do adjustWeights output delta for neuron in network.Middle do // そのように判定された前段のニューロンのさらに前段の中間層における隠れニューロン群について同様の処理を行う。 adjustWeights neuron (errorFeedback output neuron) let mutable error = 0.0 for pattern in network.Patterns do // ネットワークの出力とそのサンプルの最適解を比較する。各出力ニューロンについて誤差を計算する。 for i in [0..pattern.TeachingSignal.Length - 1] do let output = (networkActivate network pattern).[i] let delta = pattern.TeachingSignal.[i] - output adjustWeights delta // 二乗誤差でEを求める error <- error + Math.Pow(delta, 2.0) { network with TryCount = network.TryCount + 1}, error /// 三層ネットワークを生成 let createNetwork (inputs:Layer) (middle:Layer) (outputs:Layer) restartAfter = { InputSize = inputs.Length MiddleSize = middle.Length OutputSize = outputs.Length TryCount = 0 RestartAfter = restartAfter Inputs = inputs Middle = middle Outputs = outputs Patterns = [] }
線形分離問題「OR」および「AND」、非線形分離問題 XORを解く
以下、NNモジュールを使って各問題を解くF#
open System open NN open ListExModule [<STAThread>] // 三層分のニューロンを生成 let inputs,middle,outputs = createNeuron 2 3 1 // ニューラルネットワークを構築 let mutable (network:Network,error:float) = createNetwork inputs middle outputs 500 , 1.0 let rec flat = function | [] -> [] | x::_ when x = [] -> [] | x::xs -> x @ flat xs let rec insert v i lst = match i, lst with | 0, xs -> v::xs | i, x::xs -> x::insert v (i - 1) xs | i, [] -> failwith "境界外デス！" let condition = [1..8] let createPattern target ts (source: int list) = let inputs = condition |> List.map (fun i -> if source |> List.exists (fun x -> x = i) then 1.0 else 0.0) |> insert (if target = 1 then 1.0 else 0.0) 4 inputs,[ts] // AND問題 (線形分離可能) let andProblem = [ [0.0; 0.0;], [0.0]; [0.0; 1.0;], [0.0]; [1.0; 0.0;], [0.0]; [1.0; 1.0;], [1.0]; ] // OR問題 (線形分離可能) let orProblem = [ [0.0; 0.0;], [0.0]; [0.0; 1.0;], [1.0]; [1.0; 0.0;], [1.0]; [1.0; 1.0;], [1.0]; ] // XOR問題 (線形分離不可能) let xorProblem = [ [0.0; 0.0;], [0.0]; [0.0; 1.0;], [1.0]; [1.0; 0.0;], [1.0]; [1.0; 1.0;], [0.0]; ] // 訓練データをロード network <- loadPatterns network xorProblem // ここではXORを解く let main () = /// 実行 let run (network:Network) = while true do try Console.Write("Input x, y: ") let values = Console.ReadLine() let line = values.Split(',') let pattern = [0..network.InputSize-1] |> List.map (fun i -> Core.double.Parse(line.[i])) let inputs = List.init(network.InputSize) (fun i-> pattern.[i]) for output in networkActivate network { Inputs=inputs; TeachingSignal = []} do printfn "%d(%f)" <| Convert.ToInt32(output) <| output with | e -> Console.WriteLine(e.Message) // ニューラルネットワークを訓練する while error > 0.1 do let x,y = training network network <- x; error <- y printfn "Try %d\tError %f" x.TryCount y if network.TryCount > network.RestartAfter then network <- initializeNetwork network // 実行 run network main () Console.ReadKey () |> ignore
非線形分離問題も問題なく解けますな。
パターン認識でライフゲーム
バックプロパゲーションアルゴリズムで３層パーセプトロンによって構築したニューラルネットでXOR判定をすることができた。ここで終わってもよかったのですが、せっかくなので欲張って、もう少しだけ複雑な非線形問題のパターン認識もやらせてみました。第64回CLR/H勉強会の、@mentaroさんのセッションの最終デモで「ライフゲーム」が取り上げられていました。勉強会後に、「そういや、ライフゲームのセル生死判定は、判定対象セルとその周囲８つのセルをパターンとして捉えることがきて、セルの生死結果を教師データとするパターンをつくって、多数の訓練データで学習させることで、ニューラルネットワークにライフゲームの生死判定をさせることができるんじゃね？」と思いました。それを実践してみようという。練習にはちょうど良いですね。判定対象セルと周囲の８つのセルを合わせた９つのセルを入力とし、生死の結果を教師データとする訓練データを作成して、ニューラルネットに食わせてシバけばおーけー！
以下、NNモジュールを使って、
F#+XNAで、ニューラルネットのパターン認識でライフゲームなコード
F#
namespace LG open System open Microsoft.Xna.Framework open Microsoft.Xna.Framework.Graphics open Microsoft.Xna.Framework.Input open Microsoft.Xna.Framework.Content open NN open ListExModule [<AutoOpen>] module Assist = // リスト平坦化 let rec flat = function | [] -> [] | x::_ when x = [] -> [] | x::xs -> x @ flat xs // リストへの挿入 let rec insert v i lst = match i, lst with | 0, xs -> v::xs | i, x::xs -> x::insert v (i - 1) xs | i, [] -> failwith "境界外デス！" let condition = [1..8] // パターン生成 let createPattern target ts (source: int list) = let inputs = condition |> List.map (fun i -> if source |> List.exists (fun x -> x = i) then 1.0 else 0.0) |> insert (if target = 1 then 1.0 else 0.0) 4 inputs,[ts] // ライフゲームの教師データ生成 let lifeGameTrainingData = let pattern = [0..8] |> List.map (fun x -> combinations x condition) let survive = List.map (fun x -> x |> createPattern 1 1.0) // 生存 let keep = List.map (fun x -> x |> createPattern 0 0.0) // 維持 let birth = List.map (fun x -> x |> createPattern 0 1.0) // 誕生 let die = List.map (fun x -> x |> createPattern 1 0.0) // 過疎or過密 pattern |> List.mapi (fun i x -> i |> function | 2 -> survive x @ keep x | 3 -> survive x @ birth x | _ -> die x @ keep x) |> flat /// 初期ボード：グライダー銃 let getGliderguns () = [|[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|]; [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|]; [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|]; [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;0;1;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|]; [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;1;0;0;0;0;0;0;1;1;0;0;0;0;0;0;0;0;0;0;0;0;1;1;0;0;0;0;0;0|]; [|0;0;0;0;0;0;0;0;0;0;0;0;0;1;0;0;0;1;0;0;0;0;1;1;0;0;0;0;0;0;0;0;0;0;0;0;1;1;0;0;0;0;0;0|]; [|0;0;1;1;0;0;0;0;0;0;0;0;1;0;0;0;0;0;1;0;0;0;1;1;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|]; [|0;0;1;1;0;0;0;0;0;0;0;0;1;0;0;0;1;0;1;1;0;0;0;0;1;0;1;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|]; [|0;0;0;0;0;0;0;0;0;0;0;0;1;0;0;0;0;0;1;0;0;0;0;0;0;0;1;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|]; [|0;0;0;0;0;0;0;0;0;0;0;0;0;1;0;0;0;1;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|]; [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;1;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|]; [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|]; [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|]; [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|]; [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|]; [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|]; [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|]; [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|]; [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|]; [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|]; [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|]; [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|]; [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|]; [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|]; [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|]; [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|]; [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|]; [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|]|] /// 同じ長さを持つジャグ配列を二次元配列へ変換 let convert (source:int [][]) = (source.[0].GetLength(0),Array.length source) ||> fun row col -> Array2D.create row col 0 |> fun array -> seq { for i in 0..row - 1 do for j in 0..col - 1 do yield i,j } |> Seq.iter (fun (i,j) -> array.[i,j] <- source.[j].[i]) array /// ライフゲーム type LifeGame () as this = inherit Game() // ゲームタイトル, GraphicsDeviceManager, SpriteBatch let gametitle, gmanager, spriteBatch = "LifeGame", new GraphicsDeviceManager(this), lazy new SpriteBatch(this.GraphicsDevice) // 三層パーセプトロンの各ニューロンを生成 -> 入力:9 , 隠れ:17 , 出力:1 let inputs,middle,outputs = createNeuron 9 17 1 // ニューラルネットワークを構築, error状態を取得 let mutable (network:Network,error:float) = createNetwork inputs middle outputs 500 , 1.0 // SpriteFont let font = lazy this.Content.Load<SpriteFont>(@"Content\font\SpriteFont1") // セルのテクスチャ let textureCell = lazy this.Content.Load<Texture2D>(@"Content\hagure") // セルエフェクト用マスクテクスチャ let normalmapTextureCell = lazy this.Content.Load<Texture2D>(@"Content\hagure_alpha") // HLSLエフェクト let normalmapEffect = lazy this.Content.Load<Effect>(@"Content\normalmap") // セルとセルの間の間隔 let borderWidth, borderHeight = 0, 0 // セル描画の開始位置 let boardStartX, boardStartY = 0, 0 // セルのサイズ（テクスチャのサイズによりけり） let cellWidth, cellHeight = 18, 17 // ライフゲームの状態を表すボード let board = getGliderguns() |> convert // ボードのサイズ let width, height = Array2D.length1 board , Array2D.length2 board // ライフゲームの状態の更新制御 let mutable runFlg = true let mutable nowRunFlg = false let mutable previousRunFlg = false // ライフゲームの世代交代インターバル let mutable interval = 10.0 // マウスボタンのリリース状態 let mutable mouseButtonReleased = false // 訓練が終了したか否か let mutable trainingEnd = false // マウスクリック位置の取得 let getPos x y = new Vector2(float32(boardStartX + x * cellWidth + x * borderWidth), float32(boardStartY + y * cellHeight + y * borderHeight)) // セル描画 サークル動作 let moveInCircle (gameTime:GameTime) (speed:float) = let time = gameTime.TotalGameTime.TotalSeconds * speed let x = Math.Sin(time) |> float32 let y = Math.Cos(time) |> float32 new Vector2(x, y) // キー操作 let operateKeys () = let mouseState = Mouse.GetState() let keyboardState = Keyboard.GetState() if mouseState.LeftButton = ButtonState.Pressed && mouseButtonReleased && this.IsActive then // マウスボタン押下中 mouseButtonReleased <- false let mouseStateX, mouseStateY = mouseState.X |> float32, mouseState.Y |> float32 let mousePos = new Vector2(mouseStateX, mouseStateY ) for x in [0..width-1] do for y in [0..height-1] do let pos = getPos x y if pos.X < mousePos.X && pos.X + float32(cellWidth) > mousePos.X && pos.Y < mousePos.Y && pos.Y + float32(cellHeight) > mousePos.Y then // マウスでクリックされたところのセルの生死状態のトグル board.[x, y] <- if board.[x, y] = 0 then 1 else 0 else if mouseState.LeftButton <> ButtonState.Pressed then // マウスボタンをリリース mouseButtonReleased <- true // Pキーによる、PAUSE ON/OFF previousRunFlg <- nowRunFlg nowRunFlg <- keyboardState.IsKeyDown(Keys.P) if nowRunFlg && not previousRunFlg then runFlg <- not runFlg // ライフゲーム状態の更新 let updateState = let updateBoard () = let tmp = Array2D.create width height 0 for x in [0..width-1] do for y in [0..height-1] do let inputs = // x7:左上, x8;上, x9:右上, x4:左, x5:評価対象のセル, x6:右, x1:左下, x2:下, x3:右下 let x7 = if x-1 >= 0 && y-1 >= 0 && board.[x-1, y-1] = 1 then 1.0 else 0.0 let x8 = if y-1 >= 0 && board.[x, y-1] = 1 then 1.0 else 0.0 let x9 = if x+1 < width && y-1 >= 0 && board.[x+1, y-1] = 1 then 1.0 else 0.0 let x4 = if x-1 >= 0 && board.[x-1, y] = 1 then 1.0 else 0.0 let x5 = board.[x, y] |> float let x6 = if x+1 < width && board.[x+1, y] = 1 then 1.0 else 0.0 let x1 = if x-1 > 0 && y+1 < height && board.[x-1, y+1] = 1 then 1.0 else 0.0 let x2 = if y+1 < height && board.[x, y+1] = 1 then 1.0 else 0.0 let x3 = if x+1 < width && y+1 < height && board.[x+1, y+1] = 1 then 1.0 else 0.0 // ライフゲームのパターン [x7;x8;x9; x4;x5;x6; x1;x2;x3] // ニューラルネットワークで判定 let outputs = networkActivate network { Inputs=inputs; TeachingSignal = []} // パターンに対する出力を取得 let output = Convert.ToInt32(outputs.[0]) tmp.[x, y] <- output // ボードに状態を反映 for x in [0..width-1] do for y in [0..height-1] do board.[x, y] <- tmp.[x, y] let settim : double ref = ref 0.0 (fun (gameTime:GameTime) -> if runFlg then let nowMillSeconds = gameTime.TotalGameTime.TotalMilliseconds if !settim + interval < nowMillSeconds then settim := nowMillSeconds // インターバルごとに状態を更新 updateBoard()) let update = let lag = 300. let wait = ref 0. // ニューラルネットワークに訓練データを読み込み network <- loadPatterns network lifeGameTrainingData (fun gameTime -> wait := !wait + 60. if !wait > lag then wait := 0. if not trainingEnd then // 訓練データをロード if error > 0.1 then // ニューラルネットワークを訓練する let nw,err = training network network <- nw; error <- err if network.TryCount > network.RestartAfter then // 乱数の具合が悪かったり、ローカルミニマムにハマったりで訓練がなかなか終わらない場合は、最初から訓練しなおしてみる network <- initializeNetwork network else // 訓練おわりやしたー trainingEnd <- true else // ニューラルネットワークの訓練が終了したら、キー入力を受け付けたりライフゲームを開始 operateKeys () updateState gameTime) do // タイトルを設定 this.Window.Title <- gametitle // ゲームループの間隔を設定 (60FPS) this.TargetElapsedTime <- TimeSpan.FromSeconds(1.0 / 60.) // マウスカーソルを表示 this.IsMouseVisible <- true override this.Initialize() = // ゲームウィンドウのサイズを設定 gmanager.PreferredBackBufferWidth <- this.Width gmanager.PreferredBackBufferHeight <- this.Height base.Initialize () /// ウィンドウの幅 member this.Width with get () = cellWidth * width /// ウィンドウの高さ member this.Height with get () = cellHeight * height /// ライフゲームの状態を更新 override this.Update (gameTime:GameTime) = base.Update gameTime if Keyboard.GetState().IsKeyDown(Keys.Escape) then // Escが押されたらおしまい this.Exit() // ライフゲームクラスの状態を更新 update gameTime /// ライフゲームの状態を描画 override this.Draw (gameTime:GameTime) = base.Draw gameTime // テクスチャーデータのサンプリング方法をClampに設定 gmanager.GraphicsDevice.SamplerStates.[1] <- new SamplerState(AddressU = TextureAddressMode.Clamp, AddressV = TextureAddressMode.Clamp, AddressW = TextureAddressMode.Clamp) // 背景を黒で塗りつぶし gmanager.GraphicsDevice.Clear(Color.Black) // ライフゲームクラスの状態を描画 if not trainingEnd then // ニューラルネットワークの訓練が終わるまでは、訓練の進捗を描画 spriteBatch.Force().Begin() spriteBatch.Force().DrawString(font.Force (), String.Format("NeuralNework Training... Try:{0,3:##0}; Error:{1}", network.TryCount, error), Vector2(0.0f,0.0f), Color.White) spriteBatch.Force().End() else // 訓練終了後は、ライフゲームの状態を描画 for x in [0..width-1] do for y in [0..height-1] do let pos = getPos x y if board.[x, y] = 0 then // 死んでるセルは真っ黒くろ助 spriteBatch.Force().Begin() spriteBatch.Force().Draw(textureCell.Force(), pos, Color.Black) spriteBatch.Force().End() else // 生きてるセルは、セルのテクスチャを描画 // テクスチャの描画に使用するエフェクトの設定 let spinningLight = moveInCircle gameTime 5.0 let time = gameTime.TotalGameTime.TotalSeconds let tiltUpAndDown = 0.5f + float32(Math.Cos(time * 0.75)) * 0.1f let lightDirection = new Vector3(spinningLight * tiltUpAndDown / 2.0f, tiltUpAndDown / 2.0f) lightDirection.Normalize() normalmapEffect.Force().Parameters.["LightDirection"].SetValue(lightDirection) gmanager.GraphicsDevice.Textures.[1] <- normalmapTextureCell.Force() // HLSLのエフェクトを使用して、セルのテクスチャを描画 spriteBatch.Force().Begin(SpriteSortMode.Deferred, BlendState.AlphaBlend, null, null, null, normalmapEffect.Force()) spriteBatch.Force().Draw(textureCell.Force(), pos, Color.White) spriteBatch.Force().End()
ライフゲームの生死判定を学習させるための訓練データは、F#で順列(Permutation)と組み合わせ(Combination)。YOU、Listモナドしちゃいなよ。集合モナドもあるよ。で書いた、
組み合わせ(Combination)を用いて全512パターンを作成しています。
セルを表している「はぐれメタル」の描画には、無駄にHLSL(High Level Shader Language)を使用しています。
HLSL
float3 LightDirection; float3 LightColor = 2.0; float3 AmbientColor = 0.1; sampler TextureSampler : register(s0); sampler NormalSampler : register(s1); float4 main(float4 color : COLOR0, float2 texCoord : TEXCOORD0) : COLOR0 { float4 tex = tex2D(TextureSampler, texCoord); float3 normal = tex2D(NormalSampler, texCoord); float lightAmount = max(dot(normal, LightDirection), 0.2); color.rgb *= AmbientColor + lightAmount * LightColor; return tex * color; } technique Normalmap { pass Pass1 { PixelShader = compile ps_2_0 main(); } }
errorが0.1以下になるまで訓練するようにしているので、ローカルミニマムにハマってしまい、なかなか最後まで学習が完了しない。
早く収束させるには、中間層の隠れニューロンの数を調整したり訓練を甘くして学習レベルを下げるとよい。
この実装では運に左右される。ローカルミニマムに陥る問題を避ける方法はいくつかあるようだが、それはまた別のお話。
SkyDriveに、F#でニューラルネットワークなソースコード一式を置いておきます。
SkyDrive - NN.zip
第63回 CLR/H勉強会の資料「とことんF#よぷよ！ F# + XNA ゲームプログラミング入門」を公開します。
「とことんF#よぷよ！ F# + XNA ゲームプログラミング入門」と題してお話してきました。
とことんF#よぷよ！ F# + XNA ゲームプログラミング入門
（前回のエントリにて、「とことんF#よぷよ！」の全ソースコードを公開しています。） View more presentations from zecl1231
拙いトークを、最後までご清聴いただき、どうもありがとうございました。
twitterの#clrh63ハッシュタグのつぶやきを見てうれしい気持ちになりました。お話してよかったです。
CLR/Hはあったかいなあ。スタッフのみなさん、そして参加して頂いたみなさんに感謝です。
そして、スペシャルサンクスの荒ぶるクマー兄者こと@twit_ahfさん、どうもありがとうございました。
はずかしいですが、Ustreamに録画もあります。もしよろしければ。
http://www.ustream.tv/recorded/17886739
マイクロソフトの荒井省三さんにサインを頂きました！やったー！
いげ太さんにも頂きたい！
とことんF#よぷよ！ 第 63 回 CLR/H 勉強会で、F#とXNAを題材に発表します。
F# + XNAでとことんF#よぷよ！してみました
「ダークソウル」で心が折れそうな日々を送っている今日このごろですが、みなさんはいかがお過ごしでしょうか。
F# + XNAで「とことんぷよぷよ」っぽいものを実装してみました（はじめてのXNAゲームプログラミング）。
ただし、意図的、あるいは意図せずに元ネタのそれの仕様とは異なる場合があります。
動画の終盤、PAUSEをしてチート機能を使うことで１９連鎖のデモをしています。
第 63 回 CLR/H 勉強会で、F#とXNAを題材にお話します。
日時 ： 2011/10/15 (土) 13:30〜18:00（開場 13:00）
場所 ： マイクロソフト北海道支店 セミナールーム （札幌市中央区北 5 条西 2 丁目 5 JR タワーオフィスプラザさっぽろ 20F）
http://www.microsoft.com/ja-jp/mscorp/branch/hokkaido.aspx
参加費：500 円（会場費やお菓子代に使用させて頂きます）
【タイトル】
とことんF#よぷよ！ - F# + XNAによるゲームプログラミング入門 -
【概要】
みんな大好き、落ち物パズルゲーム「ぷよぷよ」は今年で 20 周年を迎えました。
ぷよぷよ風落ち物パズルゲームの作り方と、関数型パラダイムを中心としたマルチパラダイム言語 F# による
XNA でのゲーム開発の基本についてお話します。
「ぷよぷよ風落ちゲーを 500 行程度で実装できる。そう、F# + XNA ならね！」
【スピーカー】
わたし
CLR/H 公式サイト
http://clr-h.jp/
また、マイクロソフトのエバンジェリストで、著作に「The root of .NET Framework」や「実践 F# 関数型プログラミング入門」などがある
荒井省三さんが、「DLR + ASync + アルファ」というタイトルで濃いセッションをしてくださいます。ぜひお越しください。
事前に「とことんF＃よぷよ！」のコードを晒してみる
ということで、F#でXNAなコードを勉強会前に晒してしまう大盤振る舞い（！？）
コードは決してうつくしくはありませんが、興味のある方はごらんください。
PuyoPuyo.fs
namespace PuyoPuyoLibrary open System type PuyoColors = | n = 0x00 | r = 0x01 | y = 0x02 | p = 0x03 | g = 0x04 | b = 0x05 type Union = | None = 0b0000 | Top = 0b0001 | Left = 0b0010 | Bottom = 0b0100 | Right = 0b1000 type puyoObj = { position : int * int; pattern : PuyoColors[][]; color1: PuyoColors; color2: PuyoColors; hidden: bool; upside : bool} type PuyoState = { pw : int; ph : int; width : int; height : int gameover : bool; pause : bool ;cheat : bool totalScore : decimal; highScore : decimal; maxLevel : int scoreBase : int; magnifyingPower : int rensa : int; union : int; colors : int; erased : int current : puyoObj; next : puyoObj array field : PuyoColors[,]; checkField : bool[,] falling : bool; allclear : bool etarget : (int * int * PuyoColors) list} module PuyoPuyo = let patterns x y = [| [| enum 0; x; enum 0; |] [| enum 0; y; enum 0; |] [| enum 0; enum 0; enum 0; |] |] let none : PuyoColors [][] = [| [| |] |] let clearCheckField ps = { ps with checkField = Array2D.create ps.width ps.height false } let getLevel erased = erased / 40 |> fun x -> if x >= 999 then 999 else x + 1 let create erased = let rand = new Random(System.DateTime.Now.Millisecond) let create' = fun s e -> enum (rand.Next(s, e)), enum (rand.Next(s, e)) fun () -> (if getLevel erased < 3 then (1,4) ||> create' elif getLevel erased < 5 then (1,5) ||> create' else (1,6) ||> create') ||> fun x y -> { position = (1, 0); pattern = patterns x y; color1 = x; color2 = y; hidden = false; upside = true } let getPuyoObj = let queue = new System.Collections.Generic.Queue<puyoObj>() fun erased -> queue.Count |> function | 0 -> seq {1..3} |> Seq.iter (fun x -> queue.Enqueue ( () |> create erased)) queue.Dequeue(),queue.ToArray() | _ -> queue.Enqueue(() |> create erased) queue.Dequeue(),queue.ToArray() let convert (source : PuyoColors [][]) = (Array.length source, source.GetLength(0)) ||> fun row col -> Array2D.create row col PuyoColors.n |> fun array -> if source = none then array else seq { for i in 0..row - 1 do for j in 0..col - 1 do yield i,j } |> Seq.iter (fun (i,j) -> array.[j,i] <- source.[i].[j]) array type Direction = | Right | Left | Down let move ps direction = ps.current.position ||> fun x y -> direction |> function | Right -> { ps.current with position = x + 1, y } | Left -> { ps.current with position = x - 1, y } | Down -> { ps.current with position = x , y + 1 } let descend ps = ps.current.position ||> fun x y -> if y + 1 < ps.height then { ps.current with position = x, y + 1 } else ps.current let rotate puyo action = convert puyo.pattern |> fun pattern -> let len = Array2D.length1 pattern seq { for i in 0..len - 1 do for j in 0..len - 1 do yield i,j,len,pattern} |> Seq.iter action puyo let avoidance ps exchange (c1,c2) = let (|Insert|_|) c1 c2 ps = ps.current.position ||> fun x y -> let judge c f g= if (c <> PuyoColors.n && (x < 0 || (x >= 0 && (ps.field.[x,y] <> PuyoColors.n || ps.field.[x,y+1] <> PuyoColors.n)))) && (c <> PuyoColors.n && (x+2 > ps.width - 1 || (x+2 <= ps.width - 1 && (ps.field.[x+2,y] <> PuyoColors.n || ps.field.[x+2,y+1] <> PuyoColors.n)))) then f() else g() judge c1 (fun () -> Some ps.current) (fun () -> judge c2 (fun () -> Some ps.current) (fun () -> None)) let (|CollideLeft|_|) c1 c2 ps = ps.current.position ||> fun x y -> if (c1 <> PuyoColors.n || c2 <> PuyoColors.n) && (x < 0 || (x >= 0 && (ps.field.[x,y] <> PuyoColors.n || ps.field.[x,y+1] <> PuyoColors.n ))) then Some ps.current else None let (|CollideRight|_|) c1 c2 ps = ps.current.position ||> fun x y -> if (c1 <> PuyoColors.n || c2 <> PuyoColors.n) && (x+2 > ps.width - 1 || (x+2 <= ps.width - 1 && (ps.field.[x+2,y] <> PuyoColors.n || ps.field.[x+2,y+1] <> PuyoColors.n))) then Some ps.current else None ps |> function | Insert c1 c2 puyo -> puyo | CollideLeft c1 c2 puyo -> move ps Right |> rotate <| exchange | CollideRight c1 c2 puyo -> move ps Left |> rotate <| exchange | _ -> ps.current |> rotate <| exchange let target ps = ps.current.pattern.[2].[1], ps.current.pattern.[0].[1] let rotateR ps = if ps.current.pattern = none then ps.current else (fun (i,j,len,pattern:PuyoColors[,]) -> ps.current.pattern.[i].[j] <- pattern.[i,len - 1 - j]) |> avoidance ps <| target ps let rotateL ps = if ps.current.pattern = none then ps.current else (fun (i,j,len,pattern:PuyoColors[,]) -> ps.current.pattern.[j].[i] <- pattern.[len - 1 - j,i]) |> avoidance ps <| target ps let createState pw ph width height erased = let current,next = getPuyoObj erased { pw = pw; ph = ph; width = width; height = height; gameover = false; pause = false; cheat = false; totalScore = decimal 0; highScore = decimal 0; maxLevel = 0; scoreBase = 0; magnifyingPower = 0; rensa = 0; union = 0; colors = 0; erased = 0; current = current; next = next; field = Array2D.create width height PuyoColors.n checkField = Array2D.create width height false; falling = false; allclear = false; etarget = List.empty } let nextPuyo ps = if not ps.cheat then getPuyoObj ps.erased ||> fun current next -> {ps with current= current; next = next} else { ps with current = { position = (1, 0); pattern = patterns PuyoColors.p PuyoColors.y; color1 = PuyoColors.p; color2 = PuyoColors.y; hidden = false; upside = true }; next = ps.next } let reset ps = nextPuyo { ps with erased = 0 } |> fun ps -> nextPuyo ps |> fun ps -> nextPuyo ps |> fun ps -> { ps with field = Array2D.create ps.width ps.height PuyoColors.n; checkField = Array2D.create ps.width ps.height false; etarget = List.empty gameover = false; pause = false; cheat = false; totalScore = decimal 0; maxLevel = ps.maxLevel; highScore = ps.highScore; scoreBase = 0; magnifyingPower = 0; rensa = 0; union = 0; colors = 0; allclear = false } let cheat ps = Array2D.create ps.width ps.height PuyoColors.n |> fun newfield -> let dic = dict[0,[0;0;0;2;1;1];1,[1;2;0;3;2;3];2,[3;2;3;2;1;1];3,[1;2;3;2;1;3];4,[2;3;2;1;2;3];5,[3;2;1;2;1;3];6,[2;3;2;1;2;1];7,[2;3;2;1;2;1];8,[2;1;1;3;1;3];9,[1;2;3;2;3;3];10,[3;1;2;3;2;1];11,[3;1;2;3;2;1];12,[3;1;2;3;2;1]] for y in 0..ps.height - 1 do dic.[y] |> List.iteri (fun x c -> newfield.[x, y] <- enum c) nextPuyo { ps with field = newfield; cheat = true } let detectCollision puyo field = let result = ref false puyo.pattern |> convert |> Array2D.iteri (fun i j c -> c |> function | PuyoColors.n -> () | _ -> puyo.position ||> fun x y -> (x + i,y + j) ||> fun xi yj -> if xi < 0 || xi >= Array2D.length1 field || yj < 0 || yj >= Array2D.length2 field || field.[xi, yj] <> PuyoColors.n then result := true); !result let getAllclearScore ps = if ps.field = Array2D.create ps.width ps.height PuyoColors.n |> not then decimal 0 else decimal 3600 + decimal (getLevel ps.erased * 5) let getScore ps = let rensaBonus n = dict [1,0;2,8;3,16;4,32;5,64;6,96;7,128;8,160;9,192;10,224;11,256;12,288;13,320;14,352;15,388;16,416;17,448;18,480;19,512] |> fun dic -> if n > 19 then dic.[19] else dic.[n] let unitBounus n = dict [4,0;5,2;6,3;7,4;8,5;9,6;10,7;] |> fun dic -> if n > 10 then 10 else dic.[n] let colursBounus n = dict [0,0;1,0;2,3;3,6;4,12;5,24] |> fun dic -> dic.[n] let a,b,c,d = ps.union * 10,rensaBonus ps.rensa,unitBounus ps.union,colursBounus ps.colors // 基本得点,連鎖ボーナス,連結ボーナス,複色ボーナス b + c + d |> fun x -> if x = 0 then a,1 else a,x let fixed' ps = ps.current.pattern |> convert |> fun c -> seq { for i in 0..Array2D.length1 c - 1 do for j in 0..Array2D.length2 c - 1 do c.[i,j] |> function | PuyoColors.n -> () | _ -> ps.current.position ||> fun x y -> ps.field.[x + i, y + j] <- ps.current.pattern.[j].[i] } |> Seq.iter id { ps with current = {ps.current with hidden = true }; falling = true } let fall ps = seq { for x in 0..ps.width-1 do for y in [ps.height-1 .. -1 .. 0] do if ps.field.[x,y] = PuyoColors.n then for z in (y-1) .. -1 .. 0 do if ps.field.[x,z] > PuyoColors.n then ps.field.[x,z+1] <- ps.field.[x,z] ps.field.[x,z] <- PuyoColors.n yield z } |> Seq.length let erase ps = let erase' x y ps = if ps.field.[x,y] = PuyoColors.n then None else let result, list = ref 1, ref [x,y] let rec search x y result = ps.checkField.[x,y] <- true let search' x y retsult f g predicate = if predicate (f x) (g y) ps && ps.checkField.[f x, g y] <> true && ps.field.[f x, g y] = ps.field.[x,y] then result := !result + 1 list := !list@[f x, g y] search (f x) (g y) result search' x y result (fun x -> x+1) id (fun x y ps -> x < ps.width) search' x y result id (fun y -> y+1) (fun x y ps -> y < ps.height) search' x y result (fun x -> x-1) id (fun x y ps -> x > 0) search' x y result id (fun y -> y-1) (fun x y ps -> y > 0) search x y result if !result >= 4 then List.map (fun (x,y) -> x,y,ps.field.[x,y] )!list |> Some else None seq { for x in 0..ps.width-1 do for y in ps.height-1 .. -1 .. 0 do let ecount = erase' x y (clearCheckField ps) |> function |Some x -> x | _ -> [] yield! ecount } |> Seq.distinct |> Seq.toList |> fun etarget -> let colors = List.map (fun (x,y,_) -> ps.field.[x,y]) etarget |> Seq.distinct |> Seq.toList etarget,List.length etarget, List.length colors, { ps with current = { ps.current with pattern = none } } let getUnion ps x y = if x < 0 || x > ps.width - 1 || y > ps.height - 1 || ps.field.[x,y] = PuyoColors.n then Union.None else let rise ps x y = [y..(ps.height-1)] |> List.exists (fun y -> ps.field.[x,y] = PuyoColors.n) let lrunion n b f add = if b || (ps.field.[f x,y] = ps.field.[x,y] && (y = ps.height - 1 || (y < ps.height - 1 && (rise ps x y |> not && rise ps (f x) y |> not)) || (y < ps.height - 1 && (rise ps x y && rise ps (f x) y )))) |> not then n else add n let left n = lrunion n (x = 0) (fun x -> x - 1) ((+) Union.Left) let right n = lrunion n (x >= ps.width - 1) ((+) 1) ((+) Union.Right) let tbunion n f g c = if f || ps.field.[x,g y] = ps.field.[x,y] |> not then n else n + c let top n = tbunion n (y = 0) (fun y -> y - 1) Union.Top let bottom n = tbunion n (y >= ps.height - 1) (fun y -> y + 1) Union.Bottom Union.None |> (top >> left >> right >> bottom)
PuyoGame.fs
namespace FSharpyopuyo open System open System.Runtime.Serialization open Microsoft.Xna.Framework open Microsoft.Xna.Framework.Audio open Microsoft.Xna.Framework.Graphics open Microsoft.Xna.Framework.Input open Microsoft.Xna.Framework.Storage open PuyoPuyoLibrary [<DataContract>] type SaveGameData = { [<field:DataMember(Name="MaxLevel")>] MaxLevel : int; [<field:DataMember(Name="HighScore")>] HighScore : decimal } type PuyoGame () as this = inherit Game() let gametitle, gmanager, sprite = "とことんF#よぷよ！", new GraphicsDeviceManager(this), lazy new SpriteBatch(this.GraphicsDevice) let mutable ps = PuyoPuyo.createState 32 32 6 13 0 let slowTimelag,fastTimelag, fps = 350.,230.,60. let backgroundTexture,puyoTexture,blinkTexture,gameoverTexture,allclearTexture,carbancleTexture,suketoudaraTexture = ["background";"puyopuyo";"blink";"batanQ";"allclear";"carbuncle";"suketoudara"] |> List.map (fun name -> lazy this.Content.Load<Texture2D>(@"Content\image\" + name)) |> function | a::b::c::d::e::f::g::[] -> a,b,c,d,e,f,g | _ -> invalidArg "tlist" "リストの長さが違うよ。" let font = lazy this.Content.Load<SpriteFont>(@"Content\font\SpriteFont1") let gameSe = ["move";"rotate";"drop";"batanQ";"allclear";"pafu";] |> List.map (fun name -> this.Content.Load<SoundEffect>(@"Content\sound\" + name).CreateInstance() |> fun x -> x.Volume <- 0.3f; lazy x) let chainSe = [1..19] |> List.map (fun i -> this.Content.Load<SoundEffect>(@"Content\sound\chain" + if i > 7 then string 7 else string i).CreateInstance() |> fun x -> x.Volume <- 0.3f; lazy x) let chainVoice = [1..19] |> List.map (fun i -> this.Content.Load<SoundEffect>(@"Content\sound\chainvoice" + if i > 5 then string 5 else string i).CreateInstance() |> fun x -> x.Volume <- 0.3f; lazy x) let bgm = (this.Content.Load<SoundEffect>(@"Content\sound\MorningOfPuyoPuyo").CreateInstance() |> fun x -> x.Volume <- 0.2f; x.IsLooped <- true; lazy x) let soundPlay (se:Lazy<SoundEffectInstance>) = se.Force().Play() let checkPauseKey = let keyWait, pauseKeyDown, pauseTimelag = ref 0., ref false, 700. (fun () -> if not ps.gameover then keyWait := !keyWait + fps if ps.pause && !keyWait > pauseTimelag && Keyboard.GetState().IsKeyDown(Keys.F12) then ps <- PuyoPuyo.cheat ps; if !keyWait > pauseTimelag && Keyboard.GetState().IsKeyDown(Keys.P) && !pauseKeyDown then gameSe.[5] |> soundPlay; bgm |> soundPlay; ps <- { ps with pause = false }; pauseKeyDown := false elif !keyWait > pauseTimelag && Keyboard.GetState().IsKeyDown(Keys.P) && not !pauseKeyDown then gameSe.[5] |> soundPlay; bgm.Force().Stop(); ps <- { ps with pause = true }; pauseKeyDown := true if !keyWait > pauseTimelag then keyWait := 0.) let operateKeys = let keyWait = ref 0. (fun () -> keyWait := !keyWait + fps let operateKey key = if not ps.gameover then key |> function | Keys.Z | Keys.Space | Keys.NumPad8 when !keyWait > slowTimelag -> gameSe.[1] |> soundPlay; Some (PuyoPuyo.rotateL ps) | Keys.X | Keys.Up | Keys.NumPad5 when !keyWait > slowTimelag -> gameSe.[1] |> soundPlay; Some (PuyoPuyo.rotateR ps) | Keys.Right | Keys.NumPad6 when !keyWait > slowTimelag -> gameSe.[0] |> soundPlay; Some (PuyoPuyo.move ps PuyoPuyo.Right) | Keys.Left | Keys.NumPad4 when !keyWait > slowTimelag -> gameSe.[0] |> soundPlay; Some (PuyoPuyo.move ps PuyoPuyo.Left) | Keys.Down | Keys.NumPad2 when !keyWait > fastTimelag -> if ps.current.hidden |> not then ps <- { ps with totalScore = (+) ps.totalScore <| decimal 1 } Some (PuyoPuyo.move ps PuyoPuyo.Down) | Keys.Escape -> this.Exit(); None | _ -> None else key |> function | Keys.Enter -> ps <- PuyoPuyo.reset ps; bgm |> soundPlay; None | Keys.Escape -> this.Exit(); None | _ -> None |> function | Some x -> if not (PuyoPuyo.detectCollision x ps.field) then ps <- { ps with current = x } | None -> () let resetWait () = if !keyWait > slowTimelag then keyWait := 0. Keyboard.GetState().GetPressedKeys() |> Array.toList |> List.sort |> List.rev |> function | [x] -> operateKey x; resetWait () | [x;y] -> operateKey x; operateKey y; resetWait () | [x;y;z] | x::y::z::_ -> operateKey x; operateKey y; operateKey z; resetWait () | _ -> () ) let blink = let blinkWait, blink = ref 0., ref false fun () -> if ps.pause then !blink else blinkWait := !blinkWait + fps if !blinkWait > 5. * fps then blink := not !blink; blinkWait := 0. !blink let saveFilename = "puyosys.sav" let saveStorage (device:StorageDevice) (level:int) score = let result = device.BeginOpenContainer(gametitle, null, null) if result.AsyncWaitHandle.WaitOne() then use container = device.EndOpenContainer(result) result.AsyncWaitHandle.Close() if container <> null then if (container.FileExists(saveFilename)) then container.DeleteFile(saveFilename) use stream = container.CreateFile(saveFilename) let serializer = DataContractSerializer(typeof<SaveGameData>) serializer.WriteObject(stream , { MaxLevel = level; HighScore = score }) let loadStorage (device:StorageDevice) = let result = device.BeginOpenContainer(gametitle, null, null) let level,highscore = ref 1, decimal 0 |> ref if result.AsyncWaitHandle.WaitOne() then use container = device.EndOpenContainer(result) result.AsyncWaitHandle.Close() if container <> null && container.FileExists(saveFilename) then use stream = container.OpenFile(saveFilename, System.IO.FileMode.Open ) let serializer = DataContractSerializer(typeof<SaveGameData>) let data = serializer.ReadObject(stream) :?> SaveGameData level := data.MaxLevel; highscore := data.HighScore !level, !highscore let drawPuyo (c:PuyoColors, x, y, ((i, j) as point)) (location:Vector2) rect hw = let fx,fy = float32 (x+i), float32 (y+j) let lx,ly = float32 location.X, float32 location.Y let draw f = sprite.Force().Draw(puyoTexture.Force(), Vector2(32.f * fx + lx,32.f * fy + ly |> f), Nullable rect, Color.White) if point = (1,1) then let texture = if blink () then blinkTexture.Force() else puyoTexture.Force() sprite.Force().Draw(texture, Vector2(32.f * fx + lx,32.f * fy + ly |> f), Nullable rect, Color.White) c |> function | PuyoColors.n -> () | _ -> if hw && ps.current.upside then (fun x -> x - 16.f) |> draw else draw id let uncoupling c adjustx = Rectangle(0, ps.ph * (int c - 1), ps.pw / adjustx, ps.ph) let drawText (msg:string) (v:Vector2) c = sprite.Force() |> function | x -> font.Force() |> fun font -> [font, msg, Vector2(v.X+3.f,v.Y+3.f), Color.Black; font, msg, v, c ] |> List.iter (fun (font, msg, v, c) -> x.DrawString(font, msg, v, c)) let drawLiteral () = ["NEXT",Vector2(240.f, 34.f),Color.MediumSpringGreen; "LEVEL",Vector2(240.f, 322.f),Color.MediumSpringGreen; "SC.",Vector2(32.f, 420.f),Color.HotPink; "HSC.",Vector2(32.f, 2.f),Color.Orange; "MLV.",Vector2(230.f, 2.f),Color.Orange] |> List.iter (fun (s,v,c) -> drawText s v c) let drawScoreAndLevel () = seq { yield ((PuyoPuyo.getLevel ps.erased |> string).PadLeft(3,'0')), Vector2(255.f, 356.f), Color.HotPink if ps.totalScore < ps.highScore then yield string ps.highScore |> fun s -> s, Vector2(224.f - font.Force().MeasureString(s).X, 2.f), Color.Orange else yield string ps.totalScore |> fun s -> s, Vector2(224.f - font.Force().MeasureString(s).X, 2.f) , Color.Orange if ps.etarget = List.empty then yield string ps.totalScore |> fun s -> s, Vector2(224.f - font.Force().MeasureString(s).X, 420.f), Color.HotPink else yield string ps.scoreBase + "×" + (string ps.magnifyingPower).PadLeft(4,' ') |> fun s -> s, Vector2(224.f - font.Force().MeasureString(s).X, 420.f), Color.SkyBlue if (PuyoPuyo.getLevel ps.erased) < ps.maxLevel then yield (string ps.maxLevel).PadLeft(3,'0') , Vector2(280.f , 2.f), Color.Orange else yield (PuyoPuyo.getLevel ps.erased |> string).PadLeft(3,'0') , Vector2(280.f , 2.f), Color.Orange } |> Seq.iter (fun (s,v,c) -> drawText s v c) let drawField = let gameoverWait = ref 0. (fun location () -> let unit ps x y (c:PuyoColors) adjustx = PuyoPuyo.getUnion ps x y |> fun r -> Convert.ToInt32(r |> int |> string) |> fun x -> Rectangle(ps.pw * x,ps.ph * (int c - 1), ps.pw / adjustx, ps.ph) ps.field |> Array2D.iteri (fun i j c -> if j > 0 then drawPuyo(c, i, j, (0, 0)) location (unit ps i j c 1) false) if ps.gameover then sprite.Force().Draw(gameoverTexture.Force(), Vector2(50.f,400.f - float32 !gameoverWait / 40.f), Color(255, 255, 255, 128)) if !gameoverWait <= 12000. then bgm.Force().Stop() gameSe.[3] |> soundPlay gameoverWait := !gameoverWait + fps * 3. else ["つづける:Enter",10.f;"やめる:Esc",50.f] |> List.iter (fun (msg,y) -> drawText msg <| Vector2(45.f, 160.f + y) <| Color.Gold) else gameoverWait := 0. if ps.current.hidden |> not then ps.current.position ||> fun x y -> (ps.current.pattern) |> PuyoPuyoLibrary.PuyoPuyo.convert |> Array2D.iteri (fun i j c -> if y + j > 0 then drawPuyo(c, x , y, (i, j)) location (uncoupling c 1) true) sprite.Force().Draw(backgroundTexture.Force(), Vector2(0.f,0.f),Nullable(Rectangle(0,0,256,32)), Color.White)) <| Vector2(32.f, 0.f) let drawErase = let animeWait = ref 0. (fun f (location:Vector2) () -> if ps.etarget <> List.empty then animeWait := !animeWait + fps let draw union = List.iter (fun (x,y,c) -> if y > 0 then drawPuyo(c, x, y, (0, 0)) location (Rectangle(ps.pw * union ,ps.ph * (int c - 1), ps.pw, ps.ph)) false) ps.etarget if !animeWait < 780. then draw 16 elif !animeWait < 1560. then draw 17 else animeWait := 0.; f()) <| (fun () -> ps <- { ps with etarget = List.empty }) <| Vector2(32.f, 0.f) let drawAnimation (texture:Lazy<Texture2D>) width hight max vector = let animeWait, counter = ref 0., ref 0 (fun (location:Vector2) () -> animeWait := !animeWait + fps if !animeWait > 780. - (30. * float (PuyoPuyo.getLevel ps.erased + 1)) then animeWait := 0.; if not ps.pause then incr counter sprite.Force().Draw(texture.Force(), location, Nullable (Rectangle(width * !counter,0,width,hight)), Color.White) if !counter = max then counter := 0) <| vector let drawCarbancle = drawAnimation <| carbancleTexture <| 25 <| 25 <| 37 <| Vector2(260.f,388.f) let drawSukesoudara = drawAnimation <| suketoudaraTexture <| 72 <| 54 <| 10 <| Vector2(236.f,228.f) let drawNext () = let drawPuyo' pattern location adjustx = pattern |> PuyoPuyoLibrary.PuyoPuyo.convert |> Array2D.iteri (fun i j c -> drawPuyo (c, 1, j, (0, 0)) location (uncoupling c adjustx) false) Vector2(224.f, 96.f) |> fun location -> [ps.next.[0].pattern, location, 1; ps.next.[1].pattern, (Vector2(location.X + 32.f, location.Y + 32.f)), 2] |> List.iter (fun (p,v,a) -> drawPuyo' p v a) let drawAllClear () = if ps.allclear then sprite.Force().Draw(allclearTexture.Force(), Vector2(45.f,50.f), Color.White) let drawPause () = if ps.pause then drawText "PAUSE" <| Vector2(96.f,150.f) <| Color.Gold let drawRensa = let rensaWait, rensaCount = ref 0., ref 0 (fun () -> if ps.pause |> not then rensaWait := !rensaWait + fps * 1.5 if ps.rensa > 0 && !rensaWait < 25. * fps then (3,7) ||> fun x y -> drawText (string ps.rensa + "れんさ") <| Vector2(32.f * float32 x, 32.f * float32 y - float32(!rensaWait / 40.)) <| Color.HotPink if ps.rensa <> !rensaCount && !rensaWait > 50. * fps then rensaCount := ps.rensa; rensaWait := 0. ) let save () = let save maxLevel highScore = let result = StorageDevice.BeginShowSelector(PlayerIndex.One, null, null) let device = StorageDevice.EndShowSelector(result) saveStorage device maxLevel highScore ps <- { ps with maxLevel = maxLevel; highScore = highScore } let maxlevelAndHighScore () = if PuyoPuyo.getLevel ps.erased > ps.maxLevel then PuyoPuyo.getLevel ps.erased else ps.maxLevel , if ps.totalScore > ps.highScore then ps.totalScore else ps.highScore if PuyoPuyo.getLevel ps.erased > ps.maxLevel || ps.totalScore > ps.highScore then maxlevelAndHighScore () ||> fun maxLevel highScore -> save maxLevel highScore let update = let updateWait, updateTimelag = ref 0., ref (72. * fps + (15. * float (PuyoPuyo.getLevel ps.erased))) let chain = (fun cont -> if ps.etarget = List.empty && PuyoPuyo.fall ps > 0 then ps <- { ps with falling = true } updateTimelag := 24. * fps + (15. * float (PuyoPuyo.getLevel ps.erased + 1)) else PuyoPuyo.erase ps |> function | etarget,union,colors,newps when union <= 0 -> ps <- { newps with rensa = 0; union = union; colors = colors } PuyoPuyo.getAllclearScore ps |> fun z -> if z > decimal 0 then gameSe.[4] |> soundPlay ps <- { ps with totalScore = (z |> fun x -> x + ps.totalScore); allclear = true } ps <- { ps with falling = false } cont () if PuyoPuyo.detectCollision ps.current ps.field then ps <- { ps with gameover = true } ; save() updateTimelag := 72. * fps + (15. * float (PuyoPuyo.getLevel ps.erased)) | etarget,union,colors,newps -> List.iter (fun (x,y,_) -> ps.field.[x,y] <- PuyoColors.n) etarget async { newps.rensa |> (fun x -> if x > 19 then chainVoice.[19] else chainVoice.[x]) |> soundPlay } |> Async.Start async { newps.rensa |> (fun x -> if x > 19 then chainSe.[19] else chainSe.[x]) |> soundPlay } |> Async.Start ps <- { newps with rensa = newps.rensa + 1; union = union; colors = colors; erased = newps.erased + union; cheat = false } let scoreBase,magnifyingPower = PuyoPuyo.getScore ps ps <- { ps with totalScore = decimal (scoreBase * magnifyingPower) + ps.totalScore; allclear = false; etarget = etarget; scoreBase = scoreBase; magnifyingPower = magnifyingPower }) fun () -> updateWait := !updateWait + fps + (15. * float (PuyoPuyo.getLevel ps.erased)) if !updateWait > !updateTimelag then updateWait := 0. let puyo = PuyoPuyo.descend ps if PuyoPuyo.detectCollision puyo ps.field |> not then ps <- { ps with current = puyo } if ps.falling && ps.etarget = List.empty then chain (fun () -> ps <- PuyoPuyo.nextPuyo ps) if !updateWait < 36. * fps then ps <- { ps with current = { ps.current with upside = true } } else ps <- { ps with current = { ps.current with upside = false } } do this.Window.Title <- gametitle (320,448) ||> fun x y -> gmanager.PreferredBackBufferWidth <- x ; gmanager.PreferredBackBufferHeight <- y this.TargetElapsedTime <- TimeSpan.FromSeconds(1.0 / fps) override thi.Initialize() = base.Initialize() |> fun _ -> let result = StorageDevice.BeginShowSelector(PlayerIndex.One, null, null) let device = StorageDevice.EndShowSelector(result) loadStorage device ||> fun maxLevel highScore -> ps <- { ps with maxLevel = maxLevel; highScore = highScore } bgm |> soundPlay override this.Update(gameTime) = checkPauseKey () if ps.pause |> not then base.Update gameTime [operateKeys;update] |> List.iter (fun f -> f ()) if not ps.gameover then if PuyoPuyo.detectCollision (PuyoPuyo.descend ps) ps.field then if not ps.falling then gameSe.[2] |> soundPlay; ps <- PuyoPuyo.fixed' ps elif ps.current.pattern = PuyoPuyo.none && not ps.falling then ps <- PuyoPuyo.nextPuyo ps override this.Draw(gameTime) = base.Draw gameTime |> fun _ -> gmanager.GraphicsDevice.Clear(Color.Black) sprite.Force().Begin () sprite.Force().Draw(backgroundTexture.Force(), Vector2.Zero, Color.White) [drawAllClear;drawField;drawNext;drawSukesoudara;drawCarbancle;drawErase;drawRensa;drawLiteral;drawScoreAndLevel;drawPause] |> List.iter (fun f -> f()) sprite.Force().End () override this.EndRun () = base.EndRun(); save() module Program = [<EntryPoint>] let main (args : string[]) = use game = new PuyoGame() in game.Run(); 0
画像データ、音データに関しましては、動画をごらん頂けばわかるとおり配布することはできません。お察しください。
コードを読み理解するとができれば、どんな画像や音データを用意すれば適切に動作させられるかわかるはず。
なお、コードは読めなくてもまったく問題ありません。それでは、CLR/H勉強会でお会いしましょう。
