2011年5月31日火曜日

"9leap" Game Programming Camp @仙台参戦記:参加を終えて

戦場から帰ってきたら、待っていたのは、PerlでCGI書きだった(久しぶりだったので、CGI.pmの使い方を思い出すのに時間がかかった。いや、年のせいか?)。
EncodeでUTF-8とShift_JISと半角カタカナとiso-2022-jpと銃撃戦をしている間に、この果てしない宇宙のどこかでは、JavaとJavaScriptが戦争になっていた。なんかJava(Script)まで現れていたようだが。

就職活動中の女子大生にJavaとJavaScriptの違いを説明してみる
JavaとJavaScriptの20年戦争

ぼくからは、これを。

Douglas Crockford、「JavaScript: 世界で最も誤解されたプログラミング言語」

今回のキャンプはよかった。自分のコーディングのクセや欠点がすごくよくわかった。そして、考え方も。
食事をする時間を惜しんで、コンビニに走って、甘いモノを買ってきて、口に高速で詰め込んで、コードを書くのは楽しかった。

UEIから来ていた若い人たちも、おもしろかった。9leapのゲームを提供するシステムも、自分で登録してプレイしてみて、改めてすごくうまくできていると思った。才能を感じた。

参加者の人たちも、クセがあってよかった。コーディングするのに熱中していたので、他の人のゲームで遊んだり、あんまり話す余裕がなかったのが残念だ。

週アスプラスには、もう翌日には詳しい記事が載っているし驚いた(合図若松と人口知能は修正してあげて下さい)。
ゼミで学生たちに、週アスの記事を見せて、アトラスXを紹介したら、ウケていた。今度ゼミで作ってみてもいいかもしれない。


今回、若い人たちを育てるのに役に立つといいなという気持ちもあって、ゲームプログラミングキャンプに参加した。

もちろん、中身もすごくおもしろいことばかりだった。いろいろヒントも得られた。

でもね、本気で集中してガンガンやる。しかも、義務とかと一切関係なく。自分の持っているものと、限られた制約の中でいろいろやってみる。とにかくこれがすごく楽しい。

きみもやってみないか?


スタッフ、参加者のみなさんどうもありがとうございました!!


それはともかく、清水社長が風邪をひいたのは、キャンプの会場が寒かったのに、Tシャツ1枚だったからではないか。

2011年5月30日月曜日

"9leap" Game Programming Camp @仙台参戦記:#3

そして、当日がやってきた。前日も、遅くまで、オンライン、オフラインの打ち合わせをしていた。

というわけで、新青森駅始発の新幹線で、仙台へ向かった。今回の大震災で、新幹線は大きなダメージを受けた。復旧したのはやっと連休前。会場には予定通り開始時間直前に到着する。

参加者は、ぼく@akokuboのほか、@shi3z、@9leap、@hidemy、@Shocurry、@ricktsukida、@oldcadie、@sivakichだ。

ブログそのままの調子の清水社長の名講義がはじまる。

ゲームとは何か。
ゲームを作る時に注意すること。
大塚英志の『物語の体操』で解説されている、ウラジミール・プロップの「昔話の形態学」。

『ネットワークゲームデザイナーズメソッド』『ゲームデザイン誇大妄想狂』を読んだときの感覚が蘇る。

講義内容は、@sivakichさんが、週アスにとても詳しい記事を書いているので、そちらを見て欲しい。

Twitterがゲームになる!? 9leap開発キャンプ@仙台レポート

そして、今日のテーマは、Twitter。今回、enchant.jsに、簡単にTwitterから情報を取ってくるAPIがついた。それを使って、プログラムを書こうというわけだ。

なんといいタイミング。ぼくはちょうど前日まで、Twitterを使った研究の提案を作っていたところだった。


それでも、プログラミング部分の講義は、はなかなかハードだ。雰囲気を簡単に紹介して、後はサンプルを読めだ。

いや、これはいい。昔のプログラミング雑誌の感覚だ。

こんなことは、参加者を信頼しないとできない。そして、参加者もその信頼に応えた。今回の参加者は、JavaScriptに慣れていない人が多かった。それでもみんな自分の力でなんとかしようとがんばっていた。

今回、ぼくが決めていたことがある。
一つは、たくさんゲームを作ろう、クソゲーでも構わない。

参加者の一人@Shocurryさんは、たくさんゲームを投稿している。操作性とか、細かいことを言いだせばいろいろ欠点もあるゲームだ。でも、たくさんゲームを作り、それが実にいい味を出している。

本当におもしろいゲームって、こういう1000本ノックの向こうにあるんじゃないかと思う。

はじめて創った作品が、究極の傑作なんてことは、たぶんまずない。いや、あるのかもしれないが、それはほとんどの人とは縁がない話だ。


というわけで、今回、ぼくは未完成のものも含めて4本のゲームを作った。

1.桃太郎if(完成/未投稿)
2.ELIZA的な何か(未完成)
3.フォロワロワイヤル(完成/投稿)
4.フォロワーさんがころんだ(未完成)


「桃太郎if」は、昔、CやC#で作ったノベルゲームエンジンのサンプルデータのアトラスXへの移植版だ。アトラスXに慣れるために作ってみた。

ノベルゲームエンジンの簡単なものは、プログラミングの初歩の練習にちょうどいい。授業の開発演習で題材にした。

しかも、ノベルゲームツールがあれば、単なるノベルゲームだけではなく、クイズでも何でも意外といろいろなゲームを作ることができるので、作った後もおもしろい。

「桃太郎if」は、2回2分岐する4つのエンディングを持ったゲーム(?)だ。これを作ったことで、アトラスXに慣れることができた。



「桃太郎if」が完成したころに、アトラスXにTwitter連携機能がついた(なんと、キャンプ中に開発されていたのだ。できたてのほやほや機能!)。


そこで、次の「ELIZA的な何か」は、Twitter連携機能を使うつもりで作りはじめた。ELIZAは、ジョセフ・ワイゼンバウムが作った、ロジャーズの来談者中心療法のセラピストっぽい反応をするプログラムだ。ユーザが入力した文章を適当に解析して、おうむ返しをしたり、時折ランダムな反応をしたりする。Emacsを使っている人はM-x doctorで、相当するプログラムを起動できる。

なんだけど、希望する通りのUIを作ろうとすると、アトラスX自体を拡張しないと無理っぽいことがわかった。清水社長のゲームプログラミングで注意すべき「ないものねだりをしない」という話を思い出して、これは今回実装しないことに決めた。いつか作ってみたい。「ELIZA的な何か」のUIについては、スタッフの方にサポートしていただいた、ありがとうございます。


「フォロワロワイヤル」は、プレイヤーにジレンマ的な状況を作りたいと思って作ってみた。要するに、フォロワーから5名選び出して、2人ずつどちらを選ぶかを決めてもらうというものだ。基本はすぐにできた。作りはじめた段階では、アトラスXには重複しないようにフォロワーを抽出する機能がなかった(なんとこの機能もキャンプ中に追加された)ので、これを実装した。
そして、清水社長から、ユーザ名をIDに変え、アイコンを表示した方がわかりやすいとのアドバイスをもらって、作り直した。
これは投稿したので、是非、遊んで欲しい。

「フォロワロワイヤル」


最後の「フォロワーさんがころんだ」は、ゲームに動きを入れたくて、いろいろ考えた結果、「だるまさんがころんだ」をやろうとして作りはじめたものだ。だいたい完成したのだが、デバッグが終わらなかった。

ぼくは、けっこう、プロトタイピング的な方法でコードを書く。取りあえず、簡単なコードを書く。ちょっと機能を付け加えて、動作チェックする。それを繰り返して作っていく。

これは、簡単なものなら、うまくいく。しかし、ある程度以上、複雑なものを作ろうとすると、どこかで設計をしなおして、「とりあえず」で作った部分を整理しないとコードがぐちゃぐちゃになる。

今回はまったのはこれだ。設計しなおす時間が足りなかった。是非、完成させたい。

続く

2011年5月29日日曜日

"9leap" Game Programming Camp @仙台参戦記:#2

"9leap" Game Programming Camp@仙台の日がせまってきた。

今回、準備は何もしていない。

一応、JavaScriptの経験はある。開発もしている。しかし、ぼくが使っているのは、JavaScriptというよりはjQueryだ。

ぼくは、ずっとJavaScriptは邪悪だと思っていた。

JavaScriptが登場した頃、画面に現在時刻を表示したり、えらくセンスのない視覚効果をページに追加するために使われていた。それは、どちらかと言えば、必要ないものだ。

あるいは、フォームの入力値が適正かどうかを検証したり、ショッピングサイトで金額を計算したりするのに使われていた。

これらはもちろんあった方がいい。しかし、JavaScriptでこれらを記述してHTMLに埋め込んでいくと、ものすごくHTMLの可読性が落ちる。また、JavaScriptでDOMの操作を書くのは、はっきり言って、面倒すぎる。

システムをシンプルにしたいなら、ユーザに多少の不便を強いても、サーバ側で全部処理し、JavaScriptは使わないに限る。JavaScriptはユーザの使い勝手を向上させるための必要悪だった。

更に、デバッグしようにも、alertを使って、小ウィンドウに値を表示するだけという、信じられないくらいローテクな開発環境しかなかった。

おまけに、ブラウザによって、JavaScriptエンジンの挙動が異なり、開発はとても気がめいる。

しかしそれは過去の話だ。

FireBug、SafariのWebインスペクタに、Chromeのデベロッパーツール。JavaScriptが動的に追加したDOMの様子も確認できれば、普通のデバッガもついている。

各ブラウザ搭載のJavaScriptエンジンも、信じられないくらい高速化した。

そして、jQueryライブラリ。JavaScriptで書くと面倒なDOM操作、アニメーション、Ajaxが信じられないくらい美しく、簡単に書ける。おまけに、ブラウザ間の差異も吸収してくれる。

今や、JavaScriptというよりは、jQueryを使ってプログラムを書かない理由は何もないのだ。

そして、HTML5とCSS3だ。これらは、JavaScriptの使用が前提となっている。

今、Webで何かをはじめようとするなら、HTML5、CSS3、JavaScriptを使うべきだ。

しかし、JavaScriptは、一見、CやJavaに似ているが、かなり設計思想は異なっている。JavaScriptの本を読んでみるといい。CやJavaしか知らないプログラマには、見慣れない単語が出てくる。実は、JavaScriptは、関数型言語で、独特な変数のスコープ、関数の引数に関数を指定できたり、関数の戻り値に関数を指定できたりする(Cでも関数ポインタを使えば同じようなことはできるが)。

ぼくは、はっきり言って、C、Java、PHPのプログラマで、まだ生JavaScriptはうまく使いこなせていない。果たして大丈夫なのか?

そのとき、清水社長のこの記事を読んだ。

グッバイIVS 日本最強プレゼンバトル体験記

いろいろな意味でふっきれた。

続く

"9leap" Game Programming Camp @仙台参戦記:#1

ユビキタスエンターテイメント(UEI)の清水社長が、今、最も力を入れている活動の1つが、ARCだ。若い学生たちの熱いグループで、最先端の技術に取り組んでいる。

そのARCが開発したスマートフォン向けのゲームライブラリがenchant.js。enchant.jsで作ったゲームを投稿できるサイトが9leapで、今、毎日のようにゲームが投稿され、しかもプレイされている。若い学生たちを対象としたゲームコンテストも開催された。

今回、9leap主催のゲームプログラミングキャンプが、仙台であるという。しかし、驚いたことに、参加者が少ないという。東京で開催したときは、20人の定員に50人も応募したという、イベントなのにだ。もう、若くない自分が参加するのは、どうかと思っていたが、それならもう、これは参戦するしかないだろう。

ぼくは、もう若くない。43才だ。大学でWebやCGを教えている。

若い連中は言う。ゲームを作りたいと。でも、実際に作る者はほとんどいない。

当たり前だ。ちまちま、CやJavaの本を読んでも、コマンドラインで数字や文字を入れて、大しておもしろくもない処理をするようなサンプルしか載っていない。

いや、もちろん、これは基本で重要だ。

基本ができずに、ゲームなんか作れるわけがない。でも、その基本ができても、ゲームまでは随分距離がある。普通のCやJavaの教科書を理解しても、いきなりVisual C++でゲームが作れるわけじゃない。そこには大きな壁がある。

もったいない。

昔はもっと人生は簡単だった。

ベーシックやマシン語で書かれたゲームのプログラムが、雑誌には載っていた。そのクソ長いコードを根性で打ち込んで、テープレコーダのテープに保存してやれば、ゲームは動いた。そう、USBメモリでも、CDでもない、フロッピーですらない、テープだ。書き込むにも読み出すにも何分も何十分もかかった。

でも、コードは単純だった。いや、もちろんすごいコードもあったが。

根性さえあれば、ゲームは作れる時代だった。

プログラムの基本は、順番に命令を実行する逐次処理、変数の値などにより処理を変える条件分岐、そしてくり返しの3つだ。この3つさえ分かれば、原理的にはどんなプログラムでも書ける。他の機能は、プログラムを簡単に書けるようにするために用意されている機能と言ってもいい。

簡単なゲームを作れば、この3つの基本がわかるし、応用だってできるようになる。メキメキとプログラミング技術が上がること間違いなしだ。しかもおもしろい。

かつて存在した、そんなプログラマを目指す若者の黄金時代を、この21世紀にもたらそうというのが、9leapだ。

今やるなら、スマートフォンのゲームだ。HTML5だ。間違いない。

しかも、さまざまな環境の差異を吸収してくれるライブラリが用意され、PCとエディタとブラウザがあれば、開発できてしまう。

ぼくもHTML5とCSS3とJavaScriptでシステムを作っている。Googleストリートビューのようなコンテンツを自分で簡単に作れるOctPhotoVRだ。これは、研究室の学生が青森老舗のデパート中三の店舗案内を作るのに使ったり、5月の中旬に開催した青森県立美術館でVRマップを作るワークショップにも使った。

これを開発していて、今、とにかく面倒なのが、さまざまな環境の差異だ。

そんな面倒な部分をライブラリが吸収してくれるというのだ。

これはすごい。

もう、参戦するしかない。そうだろう?

続く

2011年5月24日火曜日

HTML5のcanvasのtransformを理解する1

HTML5のcanvasのリファレンスを見ると、transform()メソッドのところ http://www.html5.jp/canvas/ref/method/transform.html には次のように書かれている。

context . transform(m11, m12, m21, m22, dx, dy)
下記の通りに引数に指定されたマトリックスを適用して、変換マトリックスを変更します。

それで変換マトリックスは、というと以下のように書かれている。

|m11 m12 dx|
|m21 m22 dy|
| 0 0 1|

これはちょっと言葉が足りない。具体的には、変換前の座標を(x, y)、変換後の座標を(x', y')とすると、以下のような変換になるよという意味だ。

|x'| |m11 m12 dx| |x|
|y'| = |m21 m22 dy| |y|
| 1| | 0 0 1| |1|

これは、同次(斉次)座標で書かれているため、見慣れていない人にはわかりにくいかもしれない。

でも、単に行列のかけ算をやってやると、以下のようになる。

x' = m11*x + m12*y + dx
y' = m21*x + m22*y + dy

つまり、(dx, dy)が並行移動で、m11からm22までが、原点を中心とした回転や拡大縮小(ただし縦横は独立に指定可能)だ。
なんで、これで並行移動や回転や拡大縮小になるのかという話は、次回以降に書く(予定)。

これを数学的にきれいに書いたのが、最初の同次座標による表現である。

この変換は、アフィン変換と呼ばれ、並行移動、回転、拡大縮小を組み合わせた変形だ。
わかりやすく言えば、正方形を並行四辺形に変形できる。
HTML5のcanvasのリファレンスのtransform()メソッドのところ http://www.html5.jp/canvas/ref/method/transform.html には、時計の画像を変形したサンプルが載っているが、まさにそんな感じだ。

じゃ、これで、並行移動するにはどうしたらいいのとか、そういう話は次回以降。

2011年5月20日金曜日

HTML5とかCSS3にブラウザが対応しているか調べる一番簡単な方法

HTML5とかCSS3にブラウザが対応しているかを知りたいとき、一番簡単なのは、JavaScriptで書かれたModernizrを使うこと。
http://www.modernizr.com/

トップページにアクセスするだけで、そのときに使っているブラウザの対応状況が一目瞭然。

また、ダウンロードすれば、自分のJavaScriptプログラムでもチェックできるようになる。しかも、ダウンロードするときには、チェックしたい機能だけ選んでダウンロードすることもできるという、至れり尽くせりなライブラリ。

jQueryのjQuery.browser(ver. 1.3以降はサポート対象外)とか、jQuery.supportでブラウザを判別するという手もある。でも、今は、その機能が使えなくても、将来、使えるようになるかもしれない。で、一々、ブラウザがアップデートするたびに、チェックするのはたまらない。

チェック結果は、Modernizr.属性値にtrue、falseで入っている。

とりあえず、試して見るには、Modernizrを読み込むように指定したHTMLを表示して、FireBugとかのコンソールでconsole.log(Modernizr);してみればいい。

CSS3の3D表示機能が、実はSafariでも使えないことがある件

みなさん、CSS3の3D表示機能使ってます?

AppleのHTML5のページ http://www.apple.com/html5/ を見たら、もう使うしかないって感じになりますよね。

え? このページ見れない?

いや、それは、ほら、ブラウザにSafariを使っていただかないと…、Appleのサイトだし。

え? Safariでも見れないって? こんなメッセージが出ちゃう?



「このデモを見るには、Safariをダウンロードする必要があると思うよ!

このデモはSafariでサポートされている最新のWeb標準でデザインされてるよ。このデモを体験したかったら、とにかくSafariをダウンロードだよ。MacとPC用が無料だし、数分しかかからないよ!」

っていうから、Safariをダウンロードしたのに見れなかったって?

いや、もしかして、Windows使いですか?

…ああ、しかも、グラフィックボードは安いやつ?

…いや、なんか、こんな記事があってですね。

「Safari 4:Top Sites および Cover Flow 機能に必要な互換性のあるグラフィックカード」
http://support.apple.com/kb/HT3410?viewlocale=ja_JP

Safari 4でTop SitesとかCover Flowを使うには、Windowsの場合、「DirectX 9.0 以降」「32MB 以上 (64MB 以上を推奨) のビデオ RAM を搭載した DirectX 9.0 互換のビデオカード」が必要だって書いてあるよ。

このTop Sitesとか、Cover FlowにはCSSの3D表示機能が使われているんだけど、それがどうやら、このスペックを満たさないと動かないらしい。

ついでに、Safari 5のダウンロードページを見ると…
http://www.apple.com/jp/safari/download/
(Macの人はSafari for Windowsのダウンロードという左下のリンクをクリック)

・Windows XP SP2、Vistaまたは7を搭載したPC
・Pentium 500-MHz以上のプロセッサが必要
・256MBのメモリ
・Top SitesとCover Flowを使うには、64MBのVRAMを搭載したDirectX 9.0対応ビデオカードが必要

ということで、VRAMの必要容量が64MBに増えている。

ちなみに上のSafari 4の方のページを見ると、MacでもQuartz Extremeに対応してないとダメって書いてある。

結構、これ、知らないとはまる。はまりまくった。

2011年5月8日日曜日

Racket、tinyscheme、Gaucheでローカル変数、ローカル関数を使ってみたメモ

やりたいこと:
GimpのScript-Fuでなるべくグローバル関数やグローバル変数を使わないで処理を行ないたいということ(他のスクリプトとバッティングするとイヤなので)。
で、ローカル関数は再帰的に呼び出したい場合がけっこうある。

開発環境:
GimpのScript-Fuを開発するのに、RacketやEmacsを使っている。

Racketは、IDEとして便利だが、Gimpを直接呼べない(方法を知らないだけ?)
Emacsは、script-fu-shell.rb(http://haraita9283.blog98.fc2.com/blog-entry-323.html)を使うと、Gimpと対話的に開発ができる。
で、Gimpでは、tinyschemeを内部的に使っている。
また、Schemeの勉強をするのにGaucheを使っている。

課題:
Schemeの処理系(Racket、tinyscheme、Gauche)によって、挙動が異なるところがあり、今回、けっこうはまった。

対応のメモ:
Racket、tinyscheme、Gaucheで、ローカル変数とローカル関数を使うのに、以下のようにしてみた。
Scheme初心者なので間違っているかもしれないが、とりあえずメモ。

1.ローカル変数とローカル関数の宣言にはletrecの変数の束縛部を使う。
ローカル関数を再帰的に使うにはletrecを使う必要がある。
ローカル変数を宣言するのに、letrecの式の実行部でdefineを使い、順番に参照させるとうまくいかない処理系がある。

2.ローカル変数の値の初期化は、letrecの式の実行部でset!を使う。
厳密には値を初期化とは言わないと思う。
letrecの変数の束縛部では、変数に順番に代入ができない。
そこで、letrecの変数の束縛部ではとりあえず#fとかの値を束縛させておく。
letrecの式の実行部でset!を使って、値を設定していく。

3.set-car!やset-cdr!は使わない。
set-car!などの挙動が処理系によって異なる。
consを使って、リストを組み立て直し、set!で設定する。セルを無駄遣いしているかも。

具体例:

(define グローバル関数名
(lambda (引数1 引数2 ...)
(letrec
(
;; ローカル変数やローカル関数の束縛部
(ローカル変数名 #f)
(ローカル変数名 #f)
...
(ローカル関数名
(lambda (引数1 引数2 ...)
ローカル関数の処理内容))
(ローカル関数名
(lambda (引数1 引数2 ...)
ローカル関数の処理内容))
...
)
;; グローバル関数の式の実行部
(set! ローカル変数1 設定したい内容)
(set! ローカル変数2 設定したい内容)
...
グローバル関数の処理内容)))

Scheme処理系によって挙動が違う

Scheme処理系によって、ネストされたdefine、set-car!、etc.の挙動が異なるので注意が必要。

例1

(define ex1
(lambda ()
(let* ((x 1) (y x) (z y))
(display (list x y z)))))


Racket: (1 1 1)
tinyscheme: (1 1 1)#t
Gauche: (1 1 1)#

例2

(define ex2
(lambda ()
(define x 1)
(define y x)
(define z y)
(display (list x y z))))


Racket: (1 # #)
tinyscheme: (1 1 1)#t
Gauche: (1 1 1)#

例3

(define ex3
(lambda ()
(letrec
(
(x '(() ()))
)
(set-car! x (cons 1 (car x)))
x
)))

Racket:
>(ex3)
((1) ())
>(ex3)
((1 1) ())

tinyscheme:
>(ex3)
((1) ())
>(ex3)
((1 1) ())

Gauche:
>(ex3)
((1) ())
>(ex3)
((1) ())

2011年5月4日水曜日

パノラマ画像を8枚に切り出すScript-Fu

パノラマ合成した画像を8枚に分割するScriput-Fu。

Gimpで切り出したい画像ファイルを開く。
出力画像のサイズと出力フォルダを起動時に指定する。
北から時計回りに0.jpg、1.jpg、...、7.jpgという名前で、指定したフォルダに保存される。
北の方角を垂直方向のガイドを引いて指定する。
垂直方向のガイドを引かなければ、画像の中心を北と看做す。
垂直方向のガイドが複数引かれていれば、一番左側の垂直方向のガイドの位置を北と看做す。

※グローバル変数を使わないように修正(5/8)


;; パノラマ画像を8枚に分割する
;; 北の方向は、垂直方向ガイドの位置で指定する
;; 垂直方向ガイドがない場合、画像の中心を北と看做す
;; 垂直方向ガイドが複数引かれている場合、一番左側の垂直方向ガイドの位置を北と看做す
;; 指定されたフォルダに画像を保存する

;; メインプロシージャのシステムへの登録
(script-fu-register
;; 登録名
"script-fu-slice-panorama"
;; メニューへの登録位置
"<Image>/Filters/パノラマ画像を切り出し"
;; 説明
"パノラマ画像を8枚に分割して切り出す"
;; 作者
"Atsushi Kokubo"
;; 著作権表示
"kokubo@aomori-u.ac.jp"
;; 制作年月日
"May. 08, 2011"
;; 対象の画像の種類
"*"
SF-IMAGE "入力画像" 0
SF-DRAWABLE "入力ドロワブル" 0
SF-VALUE "出力画像の横幅" "1024"
SF-VALUE "出力画像の高さ" "1024"
SF-DIRNAME "出力先フォルダ" "output-dirname"
)

;; メインプロシージャの定義
(define script-fu-slice-panorama
(lambda (image drawable output-image-width output-image-height output-dirname)
(letrec
(
(debug-mode #f)
(panorama-image-width #f)
(panorama-image-height #f)
(guide-list #f)
(leftmost-guide #f)
(border-list #f)
(border-pair-list #f)
;; デバッグ情報の表示
(debug-print
(lambda (debug-mode s)
(cond
((= debug-mode TRUE) (gimp-message s)))))

;; 画像サイズの変更
(resize-image
(lambda (image panorama-image-width panorama-image-height)
(cond
((not (and (= panorama-image-width (car (gimp-image-width image)))
(= panorama-image-height (car (gimp-image-height image)))))
(gimp-image-scale image panorama-image-width panorama-image-height)
(gimp-displays-flush)))))

;; すべてのガイドを見つける
(get-all-guide
(lambda (image)
(cond
((null? image) #f)
(else
(letrec
(
(guide #f)
(guide-list #f)
;; 与えられたガイドをガイドリストに追加
(add-guide-list
(lambda (image guide-list guide)
(letrec
(
(v-list #f)
(h-list #f)
(orientation #f)
(position #f)
;; ガイドを挿入ソートするための補助関数
(insert
(lambda (n snlat)
(cond
((or (null? snlat) (< n (car snlat))) (cons n snlat))
(else (cons (car snlat) (insert n (cdr snlat)))))))
)
(set! v-list (car guide-list))
(set! h-list (cadr guide-list))
(set! orientation (car (gimp-image-get-guide-orientation image guide)))
(set! position (car (gimp-image-get-guide-position image guide)))
(cond
((= orientation ORIENTATION-VERTICAL)
(set! guide-list (build (insert position v-list) h-list)))
(else
(set! guide-list (build v-list (insert position h-list)))))
guide-list
)))
;; 次のガイドを検出し、ガイドリストに追加する
(main
(lambda (image guide-list guide)
(cond
((= guide 0) guide-list)
(else
(set! guide-list (add-guide-list image guide-list guide))
(main image guide-list (car (gimp-image-find-next-guide image guide)))))))
)
;; ガイドの初期化
(set! guide (car (gimp-image-find-next-guide image 0)))
;; ガイドリストの初期化
(set! guide-list '(() ()))
(main image guide-list guide))))))

;; ガイドリストのプリント
(guide-list-print
(lambda (debug-mode guide-list)
(letrec
(
(v-list #f)
(h-list #f)
(nlat->string
(lambda (nlat)
(cond ((null? nlat) "")
(else (string-append (number->string (car nlat))
" " (nlat->string (cdr nlat)))))))
)
(set! v-list (first guide-list))
(set! h-list (second guide-list))
(debug-print debug-mode (string-append "((" (nlat->string v-list)
") (" (nlat->string h-list) "))")))))

;; 最も左側のガイドを取り出す。垂直のガイドがなければ真ん中
(get-leftmost-guide
(lambda (guide-list panorama-image-width)
(cond
((null? (car guide-list)) (quotient panorama-image-width 2))
(else (caar guide-list)))))

;; ガイドの位置から、境界線のリストを作る
(get-border-list
(lambda (x0 panorama-image-width)
(letrec (
;; n番目のxを求める(x_n = (2*n-1)*panorama-image-width/16)
(nth-x
(lambda (n)
(+ x0 (quotient (* (- (* 2 n) 1) panorama-image-width) 16))))
;; 0から、panorama-image-widthまでの間の値に変換する
(norm
(lambda (x)
(cond
((< x 0) (- (+ x panorama-image-width) 1))
((> x panorama-image-width) (remainder x panorama-image-width))
(else x))))
(main
(lambda (n)
(cond
((= n 8) '())
(else (cons (norm (nth-x n)) (main (+ n 1)))))))
)
(main 0))))

;; 境界線リストのプリント
(print-lat
(lambda (debug-mode lat)
(letrec (
;; アトムのリストを文字列に
(lat->string
(lambda (lat)
(cond
((null? lat) "")
(else (string-append (number->string (car lat))
" " (lat->string (cdr lat)))))))
)
(cond
((null? lat) #f)
(else (debug-print debug-mode (string-append "(" (lat->string lat) ")")))))))

;; 境界線のペアのリストを作る
(get-border-pair-list
(lambda (lat)
(cond
((< (length lat) 2) #f)
(else
(letrec (
(first-border #f)
(main
(lambda (first-border lat)
(cond
((null? (cdr lat))
(cons (build (car lat) (- first-border 1)) '()))
(else
(cons (build (car lat) (cadr lat)) (main first-border (cdr lat)))))))
)
(set! first-border (car lat))
(main first-border lat))))))

;; ペアのリストのプリント
(print-pair-list
(lambda (debug-mode pair-list)
(letrec
(
;; ペアのリストを文字列に変換
(pair-list->string
(lambda (pair-list)
(cond
((null? pair-list) "")
(else (string-append "(" (number->string (caar pair-list))
" " (number->string (cadar pair-list)) ") "
(pair-list->string (cdr pair-list)))))))
)
(cond
((null? pair-list) #f)
(else (debug-print debug-mode (string-append "(" (pair-list->string pair-list) ")")))))))

;; 与えられた境界線ペアのリストからスライスを作って保存
(create-and-save-slices
(lambda (debug-mode image drawable output-dirname border-pair-list)
(letrec
(
;; 与えられた境界線のペアからスライスを作って保存
(create-and-save-slice
(lambda (debug-mode image drawable output-dirname border-pair num)
(letrec
(
(x1 #f)
(x2 #f)
(panorama-image-height #f)
(panorama-image-width #f)
(output-image-width #f)
(tmp-image #f)
(tmp-layer #f)
(tmp-drawable #f)
(filename #f)
(quality #f)
(smoothing #f)
(optimize #f)
(progressive #f)
(comment #f)
(subsmp #f)
(baseline #f)
(restart #f)
(dct #f)
;; 指定したxの範囲をコピーして、指定したxのオフセットにコピー
(copy-paste-region
(lambda (src-image src-drawable dst-drawable src-x-from src-x-to offset-x)
(let* (
(height #f)
(tmp-floating-sel #f)
)
(set! height (car (gimp-image-height src-image)))
;; 選択領域を解除
(gimp-selection-none src-image)
;; 範囲を選択
(gimp-rect-select src-image src-x-from 0 src-x-to height CHANNEL-OP-ADD 0 0)
;; 選択範囲をコピー
(gimp-edit-copy src-drawable)
;; 一時ドロワブルに貼付け
(set! tmp-floating-sel (car (gimp-edit-paste dst-drawable TRUE)))
;; 貼付ける位置を指定
(gimp-layer-set-offsets tmp-floating-sel offset-x 0)
;; フローティング領域を固定
(gimp-floating-sel-anchor tmp-floating-sel)
;; 選択領域を解除
(gimp-selection-none src-image))))

)
;; 変数の初期化
(set! x1 (first border-pair))
(set! x2 (second border-pair))

(set! panorama-image-height (car (gimp-image-height image)))
(set! panorama-image-width (car (gimp-image-width image)))
(set! output-image-width (quotient (car (gimp-image-width image)) 8))

;; JPEG保存のパラメータの指定
(set! filename (string-append output-dirname "/" (number->string num) ".jpg"))
(set! quality 0.85)
(set! smoothing 0.0)
(set! optimize 1)
(set! progressive 1)
(set! comment (string-append output-dirname "/" (number->string num) ".jpg"))
(set! subsmp 0)
(set! baseline 1)
(set! restart 0)
(set! dct 0)
(cond
((and (= (length border-pair) 2) (number? x1) (number? x2))
;; 一時イメージを作成
(set! tmp-image (car (gimp-image-new
output-image-width panorama-image-height RGB)))
(debug-print debug-mode (string-append "tmp-image: " (number->string tmp-image)))
;; 一時レイヤーを作成
(set! tmp-layer (car (gimp-layer-new tmp-image
output-image-width panorama-image-height
RGB-IMAGE "Tmp Layer" 100 NORMAL-MODE)))
(debug-print debug-mode (string-append "tmp-layer: " (number->string tmp-layer)))
;; 一時レイヤーを一時イメージに追加
(gimp-image-add-layer tmp-image tmp-layer -1)
;; 現在のドロワブルを取得
(set! tmp-drawable (car (gimp-image-get-active-drawable tmp-image)))
(debug-print debug-mode (string-append "tmp-drawable: " (number->string tmp-drawable)))
(cond
((< x1 x2)
(copy-paste-region image drawable tmp-drawable
x1 (- x2 x1) 0))
(else
(copy-paste-region image drawable tmp-drawable
x1 panorama-image-width 0)
(copy-paste-region image drawable tmp-drawable
0 x2 (- panorama-image-width x1))
))
;; 表示レイヤーを統合
(gimp-image-flatten tmp-image)
;(gimp-display-new tmp-image)
;; 現在のドロワブルを取得
(set! tmp-drawable (car (gimp-image-get-active-drawable tmp-image)))
;; ファイルに保存
(file-jpeg-save RUN-NONINTERACTIVE tmp-image tmp-drawable
filename filename
quality smoothing optimize progressive
comment subsmp baseline restart dct)
;; 一時イメージを削除
(gimp-image-delete tmp-image)
))
)))

(main
(lambda (border-pair-list num)
(cond
((null? border-pair-list) #t)
(else
(create-and-save-slice debug-mode image drawable
output-dirname (car border-pair-list) num)
(main (cdr border-pair-list) (+ num 1))))))
)
(main border-pair-list 0))))

;; ペアの第一要素
(first
(lambda (p)
(car p)))

;; ペアの第二要素
(second
(lambda (p)
(cadr p)))

;; ペアを作る
(build
(lambda (a1 a2)
(cons a1 (cons a2 (quote ())))))

;; パスからファイル名を取り出す
(path->basename
(lambda (path)
(substring path (+ (last-index-of #\/ path) 1) (string-length path))))

;; パスからディレクトリを取り出す
(path->dirname
(lambda (path)
(substring path 0 (last-index-of #\/ path))))

;; 与えられた文字の文字のリスト中の最後の出現位置
(last-index-of
(lambda (c s)
(letrec
(
(length (string-length s))
(index -1)
(n 0)
(main
(lambda (n)
(cond
((= n length) index)
((char=? c (string-ref s n))
(set! index n)
(main (+ n 1)))
(else (main (+ n 1))))))
)
(main n))))
)
;; 手続き本体
;; デバッグモードの指定
(set! debug-mode FALSE)
;; 出力パノラマ画像のサイズ
(set! panorama-image-width (* 8 output-image-width))
(set! panorama-image-height output-image-height)

(debug-print debug-mode (string-append "output-dirname: " output-dirname))
(debug-print debug-mode (string-append "image: " (number->string image)))
(debug-print debug-mode (string-append "drawable: " (number->string drawable)))

(resize-image image panorama-image-width panorama-image-height)
(set! guide-list (get-all-guide image))
(guide-list-print debug-mode guide-list)
(set! leftmost-guide (get-leftmost-guide guide-list panorama-image-width))
(set! border-list (get-border-list leftmost-guide panorama-image-width))
(print-lat debug-mode border-list)
(set! border-pair-list (get-border-pair-list border-list))
(print-pair-list debug-mode border-pair-list)
(create-and-save-slices debug-mode image drawable output-dirname border-pair-list)
(gimp-displays-flush)
)))