./index.html ../index.html

特設！テキストシューティングゲームのつくり方

Introduction

テキストシューティング…それは、魅惑の結晶。 華麗なグラフィックを用意する必要は微塵もなく、その代わりコンソール画面を酷使することで、DirectXやCreateWindowすら用いることなく、最大化までサポートできてしまう手抜きの王道。 ああ、テキストシューティングよ永遠なれ！

これは、二年半前の企画物です。 元ネタは僕が中学生の頃に遡ります…が、思い出話をされても困るでしょうから割愛します。

今回は、もっと簡単にインベーダーモドキを例にして話を進めて行きましょう。 これはAdaで書きました。 Adaだからといって敬遠する必要はありません。 やっていることは、コンソール関係のAPI呼び出しと、至極単純なアルゴリズムだけです。

え？何ですと？テキストシューティングなんてださい？

…いじけてやる。いじけてやる。

ソースはここから。 例によって？ソースコードだけ。各自GNATでビルドして下さい。 Ada05のコンテナライブラリをAda95に持って来たものとWindows API ヘッダーも必要です。

...\akanvader>gnatmake akanvader.adb -O3 -gnatp -gnatn
gcc -c -O3 -gnatp -gnatn akanvader.adb
gcc -c -O3 -gnatp -gnatn game.ads
gcc -c -O3 -gnatp -gnatn game-input.adb
gcc -c -O3 -gnatp -gnatn game-screen.adb
gcc -c -O3 -gnatp -gnatn game-time.adb
gcc -c -O3 -gnatp -gnatn implementation.adb
gcc -c -I./ -O3 -gnatp -gnatn -I- .../windows.adb
gcc -c -I./ -O3 -gnatp -gnatn -I- .../structure.ads
gcc -c -I./ -O3 -gnatp -gnatn -I- .../structure-list.adb
gnatbind -x akanvader.ali
gnatlink akanvader.ali

では、Akanvaderがビルドできることを確認したら、次へ進みましょう。

タイマー

Adaのpackage機能は、超強力です。 ObjectPascalのユニットunitやC++の名前空間namespace、Javaのパッケージpackageに似た側面を持ちながら、より柔軟な配置が可能で、またそれ自体ひとつのオブジェクトのように振る舞います。 さらにgenericを使えば威力倍増なのですが、ここでは手を抜いて、単なるC言語の.h程度の使用にとどめます。 …僕がよくわかって無いから、というのが一番の理由です。

さて、当然Windows APIを使っていく訳ですが、パッケージでもってそれらをラップして、ゲーム本体のコードはAPIを意識せずに書けるようにしましょう。

game-time.ads

with Ada.Calendar;
package Game.Time is

  Step: constant := Duration(1.0 / 60);

  procedure Wait;
  procedure Reset;

end Game.Time;

Durationというのは間隔を示す数値型です。

1.0 / 60 というのは、要するにゲームを60FPSで動作させる意思表示です。 このpackageを汎用にするのであれば、genericにしてこの数値を外から与えられるようにするべきでしょう。 しかしAdaでテキストシューティングを作るなどという奇特な事を何度もするつもりはないので(←おい)、ここに書いちゃってます。

Resetで覚えておく時刻を初期化して、Waitで前回のWaitまたはResetからStepだけ経過するまで待つ…単純な仕様ですね。

でもって実装は当然、time$が変化するまでfor…nextで空回しして一秒で何回ループできるか計測、以後その値を用いてウェイトループGetTickCountやtimeGetTimeで時刻を計測してSleepするわけです。 これが普通のGUIアプリなら、メッセージ処理を放棄してSleepなどちょっと行儀の悪い行為…つかフックを行う.dllにとっては迷惑千万…なのですが、コンソールアプリというのは、コンソールウィンドウはシステムが管理してくれて、その上で別スレッドとして走っているような状態です。 もちろんイベントもやって来ますが(GUIと異なり)一方的に通知してくるだけで応答義務は無いので、何の遠慮も無くSleepできます。

GUIアプリでは…流石にSetTimerは精度が悪すぎるので、timeSetEventか、MsgWaitForMultipleObjects辺りが妥当でしょう。別スレッドを作るのが一番素直です。 (ですよね？→mkmさん)

…とまあ、そういうことなのですが、Adaには時刻取得のための標準ライブラリもありますし、それどころかSleepに相当する言語機能すらあります(流石スレッドを言語機能として持つ言語！)ので、そっちを使いましょう。

game-time.adb

package body Game.Time is

  Pre_Time: Ada.Calendar.Time;

  procedure Wait is
    use type Ada.Calendar.Time;
    T: Ada.Calendar.Time := Ada.Calendar.Clock;
    S: Duration := T - Pre_Time;
  begin
    if Step * 0.9 > S then 
      delay Step - S;
    end if;
    Pre_Time := Pre_Time + Step;
  end Wait;

  procedure Reset is
  begin
    Pre_Time := Ada.Calendar.Clock;
  end Reset;

end Game.Time;

待つかどうかの判定で0.9をかけていますが、あんまり正確にやってしまうと逆に遅れていってしまうので適当に余裕をみている訳です。 なに、1/60秒のさらに1/10なんて、ちょっと前後しても人間にはわかりません。

Ada.Calenderとかうざいです。この手のうざい表記はこれからも出て来ます。 要するにC++でusing namespace ～を書いていない状態なわけです。 もちろんAdaもその能力はありますが、だらだら書くのがAda風らしいので、やってません(w *1
C++のusing namespace std;は、Adaではuse std;となります。 (いやもちろんAdaにstdなんて名前のパッケージは無いのですけど)
use typeというのは、ちょっと違って、他のパッケージで宣言された型について演算子を使うぞという宣言です。 これをしないと、代入や関数の引き数に渡すことだけが可能な、持ち運び専用ブラックボックス的扱いになります。 Adaでは、クラスでも何でもない単なる数値型ですら情報隠蔽の対象だったりするのです。
…実は演算子も関数の一種なので、use typeは正確に言えば、演算子を演算子表記法で使うための宣言なのですが。演算子を関数呼び出し風の表記法で呼ぶ時は不要です。
もちろんuse Ada.Calender;してしまえば、use typeとかも一切不要です。

画面バッファ

9x系のDOS窓は、DOS窓です。 仮想86モードと呼ばれるCPUの機能の下で、MS-DOSが動いております。 これはWindows3.1エンハンスドモードから(あやふやな記憶なのに信じないように)で、擬似マルチタスクだったWindows3.1も、DOS窓の中身だけは本物のマルチタスクしてました。

そんなわけで、9xでは、command.comなわけです。 文字通りのDOS窓なのです。

NT系では、多分推測ですが、cmd.exeはふつーのexeで、ふつーのウィンドウを出してるだけじゃないでしょうかねえ…。 その上でDOSアプリが起動された時だけ、仮想86モードに切り替えているのかな？ あと、フルスクリーン時は、ディスプレイモードをテキストモードに切り替えるとか。 スクロールバーが現れたり消えたりしているのを見てると、そんな風に思えますね。 *2 とにかくNT系では、コマンドプロンプトの画面がスクロールできる！便利！これは事実です。

何が言いたいかといいますと、NT系では、コンソール窓の大きさが不定な訳です。

普通は便利なのですが、ゲームでは、画面サイズを固定しないとなりません。 9x系や、フルスクリーン時を考えると、80×25決め打ちが一番いいでしょう。 *3 というわけで、最初はSCREEN 3: CONSOLE 0,25コンソール窓を80x25に設定します。

そして描画、となるわけですが… いきなりexeが起動された場合だけを考えるなら、問答無用で黒い画面へ自在に上書きしてしまっていいのですが、コマンドプロンプトが既に開かれていて、その上でexe名がタイプされ起動された時のことを考えてみましょう。
ゲームが終わったら、表示内容が元に戻った方がかっこよくないですか？ "C:\>xxxx" ENTER ! その次の行に、"Loading ...50%" とか表示、数字があがっていく…100%！ おもむろに画面が切り替わりタイトルへ！ ゲームが終了すれば、起動前の画面に戻り、"GOOD BYE"とか表示された次の行に、"C:\>"が…。

…無理に理解してくれなくていいです。ぐすん。

事実として、コンソールアプリは、画面バッファを複数持てて、切り替えて使えます。 バッファをふたつ持って、毎フレーム交換すれば、ダブルバッファリングみたいな真似も可能です。

…ですが、バッファの切り替えよりは、所詮80×25の世界、メモリ上に次フレームの内容を全部用意して、一括で描いてしまった方が高速だったりします。 なので、ここでは、終了時、起動前の画面に復帰するというロマンのためだけに、画面バッファを使います。

game-screen.ads

with System;
with Windows;
package Game.Screen is

  subtype Handle is Windows.HANDLE;

  Input: constant HANDLE := Windows.GetStdHandle(Windows.STD_INPUT_HANDLE);
  Output: constant HANDLE := Windows.GetStdHandle(Windows.STD_OUTPUT_HANDLE);

  procedure Set_Title(Text: in String);
  procedure Set_Window_Size_80x25;
  
  function New_Screen return Handle;
  procedure Present(Screen: Handle);
  procedure Dispose(Screen: Handle);
  
  -- ...
  -- 描画、イベント処理は今回は触れない
  -- ...
  
end Game.Screen;

今、しまった！と思いました。game-screen.adsでは、「メモリ上に次フレームの内容を全部用意して」のためのバッファにScreen_Bufferという名前を使い、Windows APIとして用意されている画面バッファは、単にScreenって名前にしていました。 「三日前のコードは他人のコード」の格言ピタリです。 なので、そういう風に読んでください。お願いします。

で、定義について説明を加えますと、Handleは、このパッケージを使う側がwith Windows;と書かなくても利用できるように、エイリアス定義を行っています。 Windows APIはゲーム本体のルーチンからは隠す方針ですから。

Input, Outputは、標準入出力のハンドルを保存しています。

Set_Titleは、コンソール窓のタイトルです。 Set_Window_Size_80x25は、前述のサイズ変更です。

で、New_Screen, Present, Disposeが本題です。 それぞれ、画面バッファの作成、表示、破棄です。 Adaはオーバーロードが使えますので、いちいちPresent_ScreenとかDispose_Screenなどは普通書きません。それに、タイマーのところで書きましたように、useを書かない限りは、使う方では、Game.Screen.Presentのように書くことになりますから。 New_ScreenだけScreenを付けている理由は、newが予約語だからです。 AdaはC++と違い、返り値型だけのオーバーロードも可能で、きちんと扱ってくれますので、例えばCreateとか他と被りまくる名前でも何の問題もありません。 まあ、Handle型は画面バッファだけではなく、ファイルとかイベントとか色々あるので、明示しとくのが吉とでも思ったのでしょう。三日前の僕は。(覚えて無いもん)

さて、画面バッファの作成と、窓サイズの変更では、窓サイズの変更が先です。 つまり、Set_Window_Size_80x25を、New_Screenより先に実行します。 現在の窓サイズよりも小さい画面バッファを作れません。 よって、ユーザーがコマンドプロンプトを広げていたりする場合(難しいことは何も無く窓の端をドラッグすればすぐできます)、New_Screenを先に実行するとエラーになります。

…なんてことも意識しながら、実装を見てみましょう。

game-screen.adb

package body Game.Screen is

  procedure Set_Title(Text: in String) is
  begin
    Windows.SetConsoleTitle(Windows.Addr(Text & Windows.Nul));
  end;

  procedure Set_Window_Size_80x25 is
    Window_Rect: aliased constant Windows.SMALL_RECT := (0, 0, 79, 24);
  begin
    Windows.SetConsoleWindowInfo(Output, 
      Windows.BOOL_TRUE, Window_Rect'Unchecked_Access);
  end;

  function New_Screen return Windows.HANDLE is
    use type Windows.COORD;
    Cursor_Info: aliased constant Windows.CONSOLE_CURSOR_INFO := 
      (Size => 100, Visible => Windows.BOOL_FALSE);
    Result: Windows.HANDLE;
    Size: aliased constant Windows.COORD := (X => 80, Y => 25);
  begin
    Result := Windows.CreateConsoleScreenBuffer(
      Windows.GENERIC_READ or Windows.GENERIC_WRITE, 
      0, null, Windows.CONSOLE_TEXTMODE_BUFFER, System.Null_Address);
    Windows.SetConsoleCursorInfo(Result, Cursor_Info'Unchecked_Access);
    Windows.SetConsoleScreenBufferSize(Result, +Size);
    return Result;
  end;

  procedure Present(Screen: Handle) is
  begin
    Windows.SetConsoleActiveScreenBuffer(Screen);
  end;

  procedure Dispose(Screen: Handle) is
  begin
    Windows.CloseHandle(Screen);
  end;

  -- ...
  -- 描画、イベント処理は今回は触れない
  -- ...

end Game.Screen;

SetConsoleCursorInfoでカーソルサイズを0にできないとか、つまらんノウハウも含まれています。

それよりも、Ada風の命名規則(Abc_Def)と、Windows APIの命名規則(定数はABC_DEF、関数はAbcDef)が混じって奇妙なコードになっている方に注目。 Unchecked_Accessとかがやたら使われていたり、AdaとWindows APIは相性が悪いのです。 ゲーム本体のコードからWindows APIを隠したがっている理由がおわかりになりましたでしょうか。

顕著なのは、COORDを関数に渡すところの+でしょう。 COORDは、Windows APIでは珍しく、関数に値渡しされる構造体です。 「僕の」windows.adsを見ていただけたらわかりますが、16ビット整数ふたつの組であるCOORD構造体をひとつの32ビット整数にキャストして渡しています。 キャストを、単に目立たないようにfunction "+"(operator +)にしてるだけです。 詰まるところAdaはrecord(構造体)を値渡しできないのですね…いや、文法上はできます。できますが、GNATの実装では、効率化のため参照渡しになっちゃうようです。 僕以外のAda用Windows APIヘッダーでは、これが考慮されておらず、結果意味不明にバグります。

Delphiのヘルプによると、サイズが32以下のrecordは値渡し、それ以上は参照渡しされるようです。 効率化の観点からは賢い実装ですよね。 レジスタに収まるものをわざわざ参照渡しにすると却って効率が落ちます。 というわけでDelphiはこの点GNATより賢いようです。
わかってます。わかってます。この問題に対する真理はそんなつまらんことではなく、世界中で僕以外誰一人としてAdaを用いてWindows上でコンソールAPIを活用するプログラムを一度も作ったことが無い、という驚愕の事実だということぐらい…。

やった！先駆者だ！(違

…これは何処へ報告すればいいのでしょうか？ Ada用Win32 Bindingに報告するとして、Last Updateが1996年のところへ報告して直るものなのでしょうか？ でもGNATの開発元へ報告するのは筋違いな気がする。 呼び出し規約がそうなっているだけの話で、少なくともバグじゃないし。

画面描きかえ

引き続きgame-screenを見ていきます。

テキストゲームでは、カーソルを当てにせず、任意の位置にテキストを描く関数が必要です。 (さもなくば、画面右下に描画した時、自動復帰改行でスクロールされてしまいます)

PC-98なら当然テキストRAMに直書きするところですが、IBM互換機で尚且つWindowsなので、APIを使います。

game-screen.ads

with System;
with Windows;
package Game.Screen is

  -- ....
  -- 説明済み
  -- ....

  procedure Clear(Screen: Handle);
  procedure Write(Screen: Handle; X, Y: Integer; 
    Text: in String; Attribute: Windows.WORD);

  type Screen_Buffer is array(0..24, 0..79) of aliased Windows.CHAR_INFO;
  procedure Clear(Buffer: in out Screen_Buffer);
  procedure Write(Buffer: in out Screen_Buffer; X, Y: Integer; 
    Text: in String; Attribute: Windows.WORD);
  procedure Write_All(Screen: Handle; Buffer: Screen_Buffer);

  -- ....
  -- また次回
  -- ....

end Game.Screen;

前回説明しましたように、画面バッファを複数用意してダブルバッファリングを行うよりも、メモリ上に次のシーンを全部描いて全てを一度に書き換える方が高速です。 なので、上ふたつは説明しません。(ダブルバッファリング使用時の名残)

game-screen.adb

package body Game.Screen is

  -- ....
  -- 説明済み
  -- ....

  procedure Clear(Screen: Handle) is
    use type Windows.COORD;
    Size: constant Windows.COORD := (X => 80, Y => 25);
    Start: constant Windows.COORD := (X => 0, Y => 0);
    Image: array(0 .. 80 * 25 - 1) of aliased Windows.CHAR_INFO;
    R: aliased Windows.SMALL_RECT;
  begin
    for I in Image'Range loop
      Image(I).Char.AsciiChar := Windows.AChar'Val(32);
      Image(I).Attributes := 0;
    end loop;
    R.Left   :=  0;
    R.Top    :=  0;
    R.Right  := 79;
    R.Bottom := 24;
    Windows.WriteConsoleOutput(Screen, 
      Image(0)'Unchecked_Access, +Size, +Start, R'Unchecked_Access);
  end;

  procedure Write(Screen: Handle; X, Y: Integer; 
    Text: in String; Attribute: Windows.WORD) is
    use type Windows.UINT;
    use type Windows.COORD;
    L: Integer := Integer(Windows.UINT(Text'Length) and 16#ff#);
    Buffer: aliased array(0 .. 16#ff#) of aliased Windows.CHAR_INFO;
    Size: aliased Windows.COORD;
    R: aliased Windows.SMALL_RECT;
    Zero: constant Windows.COORD := (X | Y => 0);
  begin
    for I in 0 .. L - 1 loop
      Buffer(I).Char.AsciiChar := Windows.AChar(Text(Text'First + I));
      Buffer(I).Attributes := Attribute;
    end loop;

    Size.X := Windows.SHORT(L);
    Size.Y := 1;

    R.Left   := Windows.SHORT(X);
    R.Top    := Windows.SHORT(Y);
    R.Right  := Windows.SHORT(X + L - 1);
    R.Bottom := Windows.SHORT(Y);

    Windows.WriteConsoleOutput(Screen, 
      Buffer(0)'Unchecked_Access, +Size, +Zero, R'Unchecked_Access);
  end;

  procedure Clear(Buffer: in out Screen_Buffer) is
    White_Space: constant Windows.CHAR_INFO := (
      Char => (Kind => Windows.Ascii, AsciiChar => ' '), Attributes => 0);
  begin
    for Y in Buffer'Range(1) loop
      for X in Buffer'Range(2) loop
        Buffer(Y, X) := White_Space;
      end loop;
    end loop;
  end;
  
  procedure Write(Buffer: in out Screen_Buffer; 
    X, Y: Integer; Text: in String; Attribute: Windows.WORD) is
    use type Windows.BOOL;
    type T is (Single, Lead, Trail);
    Pos: T;
  begin
    if Y in Buffer'Range(1) then
      Pos := Single;
      for I in Buffer'Range(2) loop
        if Pos = Lead then
          Pos := Trail;
        elsif +Windows.IsDBCSLeadByte(Buffer(Y, I).Char.AsciiChar) then
          Pos := Lead;
        else
          Pos := Single;
        end if;
        if I in X .. X + Text'Length - 1 then
          Buffer(Y, I) := (
            Char       => (
              Kind      => Windows.Ascii, 
              AsciiChar => Windows.AChar(Text(I - X + Text'First))), 
            Attributes => Attribute);
          if I = X and Pos = Trail then
            Buffer(Y, I - 1).Char.AsciiChar := ' ';
          elsif I = X + Text'Length - 1 and Pos = Lead then
            Buffer(Y, I + 1).Char.AsciiChar := ' ';
          end if;
        end if;
      end loop;
    end if;
  end;
  
  procedure Write_All(Screen: Handle; Buffer: Screen_Buffer) is
    use type Windows.COORD;
    Size: constant Windows.COORD := (X => 80, Y => 25);
    Start: constant Windows.COORD := (X => 0, Y => 0);
    R: aliased Windows.SMALL_RECT := (Left => 0, Top => 0,
      Right => 79, Bottom => 24);
  begin
    Windows.WriteConsoleOutput(Screen, 
      Buffer(0, 0)'Unchecked_Access, +Size, +Start, R'Unchecked_Access);
  end;

  -- ....
  -- また次回
  -- ....

end Game.Screen;

世の中にはW版APIもありますが、テキスト画面では断然SHIFT-JISです。 可変ピッチのフォントが当たり前なTextOut等では、SHIFT-JISはありがたみが全くなく、逆に文字列の先頭から解析しないと2バイト目を巻き込む問題が発生します。 しかし、SHIFT-JISには、バイト数=文字幅という、他のコード体系には無いテキスト画面上での絶大なメリットがあります。

ただ、断っておきますが、このままのWriteですと、全角文字が半分だけ端からはみ出るような描画をすると化けます。 インベーダーモドキではそのような描画は不要なので対処してませんが、汎用的に使うなら対処しないといけない部分ではあるでしょう。
上の方の、画面バッファに直接描く方のWriteは、APIが良きに計らってくれますので何も考えなくていいです。

ついでに、C++で言うところのunionを、その場で値を作って代入で来てしまうAdaの柔軟な構文にも注目してもらって、今回は手抜き気味におしまい。

イベント処理

さあ、いよいよpackage Game.Screenの最後です。

game-screen.ads

with System;
with Windows;
package Game.Screen is

  -- ....
  -- 説明済み
  -- ....

  subtype Event is Windows.INPUT_RECORD;

  function Has_Events(Input: in HANDLE) return Boolean;
  function Get_Event(Input: in HANDLE) return Event;
  function Is_Lost_Focus(Message: in Event) return Boolean;
  function Is_Escape_Press(Message: in Event) return Boolean;

end Game.Screen;

…正直、package Game.Inputに入れた方が良さげな内容ではあります。 でも、使っているのがコンソールAPIなので…(設計が実装に依存してしまうだめな例)

それぞれ、上から、GUIプログラムのPeekMessageでメッセージが来ているかどうか確認、GetMessageでメッセージを取り出す、WM_ACTIVATE/WA_INACTIVEか判定、WM_KEYDOWN/VK_ESCAPEか判定、です。
(酷い説明ですね)

コンソールプログラムの場合、前述したようにやってくるイベントは全部無視してOKなのですが、フォーカスを失った時にポーズぐらいは窓で動くシューティングゲームの礼儀として実装したいので、一応処理します。 [Esc]キーで再開のつもりです。

game-screen.adb

package body Game.Screen is

  -- ....
  -- 説明済み
  -- ....

  function Has_Events(Input: HANDLE) return Boolean is
    use type Windows.BOOL;
    use type Windows.DWORD;
    Count: aliased Windows.DWORD;
  begin
    return +Windows.GetNumberOfConsoleInputEvents(Input, Count'Unchecked_Access)
      and then Count > 0;
  end;

  function Get_Event(Input: HANDLE) return Windows.INPUT_RECORD is
    Dummy: Windows.BOOL;
    Result: aliased Windows.INPUT_RECORD;
    Read: aliased Windows.DWORD;
  begin
    Dummy := Windows.ReadConsoleInput
      (Input, Result'Unchecked_Access, 1, Read'Unchecked_Access);
    return Result;
  end;

  function Is_Lost_Focus(Message: in Event) return Boolean is
    use type Windows.BOOL;
    use type Windows.WORD;
  begin
    return Message.EventType = Windows.FOCUS_EVENT and then
      not Message.Event.FocusEvent.SetFocus;
  end;
  
  function Is_Escape_Press(Message: in Event) return Boolean is
    use type Windows.WORD;
    use type Windows.BOOL;
  begin
    return Message.EventType = Windows.KEY_EVENT and then
      +Message.Event.KeyEvent.KeyDown and then
      Message.Event.KeyEvent.VirtualKeyCode = Windows.VK_ESCAPE;
  end;

end Game.Screen;

and thenというのは、左の条件式がFalseだったら右を評価せずにFalseを返す演算子です。

後は普通にAPIの薄いラッパーです。 説明するようなことは無いですね。

入力

game-input.ads

with Windows;
package Game.Input is

  type Key is (Left, Right, Shoot);

  type State is array(Key) of Boolean;
  pragma pack(State);

  function Get_State return State;

end Game.Input;

game-input.adb

package body Game.Input is

  function Get_State return State is
    use type Windows.WORD;
    Result: State;
  begin
    Result(Left) := (Windows.GetKeyState(Windows.VK_LEFT) and 16#80#) /= 0;
    Result(Right) := (Windows.GetKeyState(Windows.VK_RIGHT) and 16#80#) /= 0;
    Result(Shoot) := (Windows.GetKeyState(Windows.AChar'Pos('Z')) and 16#80#) /= 0;
    return Result;
  end;

end Game.Input;

芸、特に無し。

あえて言うならpragma packで、配列をPascalの集合モドキにできるぐらい。

WM_KEYDOWN(違)だと遅れるのでGetKeyState*4なわけです。 ただ、名前入力のようなシーンでは、イベント処理の方がいいかも。

とりあえずこれで、Windows APIのラッピングは終わりです。

キャラクタを継承で動かす

さて、敵や弾の種類が少なければべた書きでいいのですが、種類が多くなってくると、それら全てを統一的に動かしたくなってきます。 そのような時は、当然継承を使えばいいのです。 mkmさんがクラス無しを明言しているのに、僕が継承を使っていいのか？という倫理的問題(←何がだ)もあるのですが、Adaではclassと書かずに構文上はrecordを継承しますから*5という意味不明な言い訳で、継承を使ってしまいましょう。

implementation.ads

with Ada.Finalization;
with Ada.Unchecked_Deallocation;
with Ada.Numerics.Discrete_Random;
with Ada.Containers.Doubly_Linked_Lists; -- External
with Game.Screen; -- Akanvader
package Implementation is

  type Base is new Ada.Finalization.Limited_Controlled with null record;
  type Base_Access is access all Base;
  procedure Dispose is new Ada.Unchecked_Deallocation(Base, Base_Access);

  type Point is 
    record
      X, Y: Integer;
    end record;

  type Direction is (Left, Right);

  type Actor is abstract new Base with 
    record
      Location: Point;
      Width, Height: Natural;
      Deleted: Boolean := False;
    end record;

  type Actor_Access is access all Actor'Class;
  package Actor_List is new Ada.Containers.Doubly_Linked_Lists(Actor_Access);

  procedure Advance(Object: access Actor; List: in out Actor_List.List) is abstract;
  procedure Draw(Object: in out Actor; Screen: in out Game.Screen.Screen_Buffer) is abstract;
  procedure Collide(Object: in out Actor; Other: Actor_Access) is abstract;

  procedure Test_Hit(List: in out Actor_List.List; It: access Actor'Class);

  -- ....
  -- 具体的な自機とか敵とかは次回
  -- ....

end Implementation;

Adaでは、仮想関数も、普通の関数のようにオブジェクトを引数として取る形で書きます。 違和感バリバリなのですが、これも要するに慣れの問題でしかありません。 なお、この構文であれば当然期待されるダブルディスパッチは、残念ながらできません。多態の対象は最初の引数に固定されていて、機能的にはC++の仮想関数と同じです。

Limited_Controlledは、コンストラクタ/デストラクタを自動的に呼んでもらえる特殊な型です。 ここから派生することで、コンストラクタ/デストラクタの自動呼び出しを実現できます。 LimitedじゃないControlled型も存在していて、そちらは代入演算子も定義できます。シューティングゲームで自機や弾をコピー(ポインタでは無く中身まる毎)することはまず無いので、Limitedの方を使います。 なお、Controlled型(の派生)は、一番外側でしか定義できません。関数内で定義できないので、こうやって別途package Implementationなるものを作っているわけです。 (でなければ大した量があるわけでなし、ファイルを分けずに書いてます)

Base、Actorと二回継承しているのも説明が必要ですね。 Unchecked_Deallocationというgeneric(総称、C++で言うtemplate)を実体化することで、delete演算子に相当する関数となるわけですが、genericの引数にabstract型(C++で言う純粋仮想間数を持つクラス)が渡せないのです。 なので、まずabstractじゃないBaseを作り、それに対してUnchecked_DeallocationをDisposeとして実体化、さらにBaseから派生してabstractなActorを作っています。 この制限は正直外して欲しいです。

後は、Actorのクラスワイド型(Actor'Class)へのポインタのリスト、abstractな、1フレーム進めるAdvance、描画するDraw、衝突時に呼ばれるCollide、といったActorのメソッド郡、衝突判定を行うTest_Hitとなっています。

クラスワイド型は、ある型の、多態を行うモードと言いましょうか。 Adaのオブジェクトは、生の型のままでは多態を行わず、クラスワイド型として扱われた時に多態を行います。暗黙的に相互に渡せる他、明示的な型変換もできます。使い分けるのはメンドイです。 で、access all Actor'Classで、Actor(から派生した一連の型)をクラスワイド型として扱うポインタ、となるわけです。

Adaの構文説明にばかりなってしまって申し訳ない。 でも既にAPIの部分は終えてしまいましたから。

あ、そうそう。Deletedの存在理由を説明しておかないといけません。 AとBが衝突ということになったら、それぞれに対してCollideを呼ぶわけですが、最初に呼んだ側(A)に自殺されてしまったら or Otherとして渡したBを解放されてしまったら、Bでアクセス違反が起きてしまいます。 なので、Actorを消す場合は、一旦DeletedをTrueにして、実際の解放は少し後にします。

implementation.adb

package body Implementation is

  procedure Test_Hit(List: in out Actor_List.List; It: access Actor'Class) is
    use Actor_List;
    I: Cursor;
    Other: Actor_Access;
  begin
    I := First(List);
    Enum_Loop: while Has_Element(I) loop
      Other := Element(I);
      if not Other.Deleted and Other /= Actor_Access(It) then
        if Other.Location.X + Other.Width > It.Location.X and
          Other.Location.X < It.Location.X + It.Width and
          Other.Location.Y + Other.Height > It.Location.Y and
          Other.Location.Y < It.Location.Y + It.Height 
        then
          Collide(It.all, Other);
          Collide(Other.all, Actor_Access(It));
          if It.Deleted then
            exit Enum_Loop;
          end if;
        end if;
      end if;
      I := Next(I);
    end loop Enum_Loop;
  end Test_Hit;

  -- ....
  -- 具体的な自機とか敵とかは次回
  -- ....

end Implementation;

上で挙げた定義は、ほとんど総称の実体化と純粋仮想関数なので、今回実装はTest_Hitのみです。 *6

コンテナ関連は総称で調達、楽でいいですね。

俳優たち

ソース全掲って大変だなー。

implementation.ads

with Ada.Finalization;
with Ada.Unchecked_Deallocation;
with Ada.Numerics.Discrete_Random;
with Ada.Containers.Doubly_Linked_Lists; -- External
with Game.Screen; -- Akanvader
package Implementation is

  -- ....
  -- 済
  -- ....

  type Fighter is new Actor with 
    record
      Shooting_Interval: Natural;
      Last_Moved: Direction;
    end record;

  procedure Initialize(Object: in out Fighter);
  procedure Advance(Object: access Fighter; List: in out Actor_List.List);
  procedure Draw(Object: in out Fighter; Screen: in out Game.Screen.Screen_Buffer);
  procedure Collide(Object: in out Fighter; Other: Actor_Access);
  procedure Move(Object: in out Fighter; Way: Direction);
  function Shooting_Location(Object: in Fighter) return Point;

  type Fighter_Access is access Fighter;

  subtype Enemy_Shooting_Probability is Natural range 0..199;
  package Random is new Ada.Numerics.Discrete_Random(Enemy_Shooting_Probability);
  Seed: Random.Generator;

  type Enemy is new Actor with
    record
      Way: Direction;
      Way_Step: Integer;
      Way_Length: Integer;
      Interval: Natural;
    end record;

  procedure Initialize(Object: in out Enemy);
  procedure Advance(Object: access Enemy; List: in out Actor_List.List);
  procedure Draw(Object: in out Enemy; Screen: in out Game.Screen.Screen_Buffer);
  procedure Collide(Object: in out Enemy; Other: Actor_Access);

  type Enemy_Access is access Enemy;

  type Shot is abstract new Actor with 
    record
      Interval: Natural;
    end record;

  procedure Initialize(Object: in out Shot);
  procedure Draw(Object: in out Shot; Screen: in out Game.Screen.Screen_Buffer);
  procedure Collide(Object: in out Shot; Other: Actor_Access);

  type Shot_Access is access Shot'Class;

  type Fighter_Shot is new Shot with null record;

  procedure Advance(Object: access Fighter_Shot; List: in out Actor_List.List);

  type Enemy_Shot is new Shot with null record;

  procedure Advance(Object: access Enemy_Shot; List: in out Actor_List.List);

  type Shield is new Actor with
    record
      Life: Natural;
    end record;

  procedure Initialize(Object: in out Shield);
  procedure Advance(Object: access Shield; List: in out Actor_List.List);
  procedure Draw(Object: in out Shield; Screen: in out Game.Screen.Screen_Buffer);
  procedure Collide(Object: in out Shield; Other: Actor_Access);

  type Shield_Access is access Shield;

end Implementation;

implementation.adb

package body Implementation is

  -- ....
  -- 済
  -- ....

  -- Fighter

  procedure Initialize(Object: in out Fighter) is
  begin
    Object.Location.X := 39;
    Object.Location.Y := 22;
    Object.Width := 2;
    Object.Height := 1;
    Object.Shooting_Interval := 0;
  end;
  
  procedure Advance(Object: access Fighter; List: in out Actor_List.List) is
  begin
    if Object.Shooting_Interval > 0 then
      Object.Shooting_Interval := Object.Shooting_Interval - 1;
    end if;
  end;

  procedure Draw(Object: in out Fighter;
    Screen: in out Game.Screen.Screen_Buffer) is
  begin
    Game.Screen.Write(Screen, Object.Location.X, Object.Location.Y, "▲", 9);
  end;

  procedure Collide(Object: in out Fighter; Other: Actor_Access) is
  begin
    if (Other.all in Enemy'Class) or (Other.all in Enemy_Shot'Class) then
      Object.Deleted := True;
    end if;
  end;

  procedure Move(Object: in out Fighter; Way: Direction) is
  begin
    case Way is
    when Left =>
      if Object.Location.X > 0 then
        Object.Location.X := Object.Location.X - 1;
      end if;
    when Right =>
      if Object.Location.X < 78 then
        Object.Location.X := Object.Location.X + 1;
      end if;
    end case;
    Object.Last_Moved := Way;
  end;
  
  function Shooting_Location(Object: in Fighter) return Point is
    Result: Point;
  begin
    Result.X := Object.Location.X;
    if Object.Last_Moved = Left then
      Result.X := Result.X + 1;
    end if;
    Result.Y := Object.Location.Y;
    return Result;
  end;

  -- Enemy

  procedure Initialize(Object: in out Enemy) is
  begin
    Object.Width := 2;
    Object.Height := 1;
    Object.Interval := 0;
  end;
  
  procedure Advance(Object: access Enemy; List: in out Actor_List.List) is
  begin
    if Object.Interval > 0 then
      Object.Interval := Object.Interval - 1;
    else
      Object.Interval := 4;
      
      if Object.Way_Step = 0 then
        Object.Way_Step := Object.Way_Length;
        if Object.Way = Left then 
          Object.Way := Right;
        else
          Object.Way := Left;
        end if;
        Object.Location.Y := Object.Location.Y + 1;
      else
        Object.Way_Step := Object.Way_Step - 1;
        case Object.Way is
        when Left =>
          Object.Location.X := Object.Location.X - 1;
        when Right =>
          Object.Location.X := Object.Location.X + 1;
        end case;
      end if;
      
      Test_Hit(List, Object);
    end if;
    
    if Random.Random(Seed) = 0 then
      declare
        S: Shot_Access := new Enemy_Shot;
      begin
        S.Location := Object.Location;
        if Object.Way = Left then
          S.Location.X := S.Location.X + 1;
        end if;
        Actor_List.Push_Last(List, Actor_Access(S));
      end;
    end if;
  end;
  
  procedure Draw(Object: in out Enemy;
    Screen: in out Game.Screen.Screen_Buffer) is
  begin
    Game.Screen.Write(Screen, Object.Location.X, Object.Location.Y, "■", 10);
  end;

  procedure Collide(Object: in out Enemy; Other: Actor_Access) is
  begin
    if Other.all in Fighter_Shot'Class then
      Object.Deleted := True;
    end if;
  end;
  
  -- Shot

  procedure Initialize(Object: in out Shot) is
  begin
    Object.Width := 1;
    Object.Height := 1;
    Object.Interval := 2;
  end;
  
  procedure Draw(Object: in out Shot;
     Screen: in out Game.Screen.Screen_Buffer) is
  begin
    Game.Screen.Write(Screen, Object.Location.X, Object.Location.Y, "|", 15);
  end;

  procedure Collide(Object: in out Shot; Other: Actor_Access) is
  begin
    if Other.all not in Shot'Class then
      Object.Deleted := True;
    end if;
  end;

  -- Fighter_Shot

  procedure Advance(Object: access Fighter_Shot; List:
    in out Actor_List.List) is
  begin
    if Object.Interval > 0 then
      Object.Interval := Object.Interval - 1;
    else
      Object.Interval := 2;
      Object.Location.Y := Object.Location.Y - 1;
      if Object.Location.Y < 0 then
        Object.Deleted := True;
      end if;
      Test_Hit(List, Object);
    end if;
  end;
  
  -- Enemy_Shot

  procedure Advance(Object: access Enemy_Shot; List: in out Actor_List.List) is
  begin
    if Object.Interval > 0 then
      Object.Interval := Object.Interval - 1;
    else
      Object.Interval := 2;
      Object.Location.Y := Object.Location.Y + 1;
      if Object.Location.Y > 24 then
        Object.Deleted := True;
      end if;
      Test_Hit(List, Object);
    end if;
  end;

  -- Shield

  procedure Initialize(Object: in out Shield) is
  begin
    Object.Width := 2;
    Object.Height := 1;
    Object.Life := 2;
  end;
  
  procedure Advance(Object: access Shield; List: in out Actor_List.List) is
  begin
    null;
  end;
  
  procedure Draw(Object: in out Shield;
    Screen: in out Game.Screen.Screen_Buffer) is
    S: array(1..2) of String(1..2) := ("◆", "  ");
  begin
    Game.Screen.Write(Screen,
      Object.Location.X, Object.Location.Y, S(Object.Life), 16#60#);
  end;

  procedure Collide(Object: in out Shield; Other: Actor_Access) is
  begin
    Object.Life := Object.Life - 1;
    if Object.Life = 0 then
      Object.Deleted := True;
    end if;
  end;

begin
  Random.Reset(Seed);
end Implementation;

自動連射の時に間隔を空けるテクニックなどは、mkmさんのテキストじゃないシューティングゲームの作り方を参照。こんなものテキストかそうでないかなんて関係無いです。

正直、座標系が荒いだけで、普通のシューティングゲームの作り方と大差無いので、ソースを長々と載せた割には取り立てて説明することは無かったりします。

総仕上げ

さあ、いよいよ、今まで作ってきた部品をまとめあげる時です。 …って、説明の都合上ソースファイル別に説明してきましたが、実際にはこのメインルーチンを先に作っているのですけどね。

akanvader.adb

with Ada.Text_IO;
with Game.Time;
with Game.Screen;
with Game.Input;
with Implementation;
procedure Akanvader is
  pragma Linker_Options("-s");
  use Implementation;
  Actors: Actor_List.List;
  Fighter: Fighter_Access;
  Game_Screen: Game.Screen.Handle;
  Back_Buffer: Game.Screen.Screen_Buffer;
  Paused: Boolean;
begin
  Ada.Text_IO.Put("Akanvader...");

  Game.Screen.Set_Title("Akanvader");
  Game.Screen.Set_Window_Size_80x25;

  Game_Screen := Game.Screen.New_Screen;

  Paused := False;

  Fighter := new Implementation.Fighter;
  Actor_List.Append(Actors, Actor_Access(Fighter));

  for Y in 0..5 loop
    for X in 0..7 loop
      declare
        Enemy: Enemy_Access := new Implementation.Enemy;
      begin
        Enemy.Location.X := X * 4;
        Enemy.Location.Y := Y * 2;
        Enemy.Way := Right;
        Enemy.Way_Length := 80 - 8 * 4 + 2;
        Enemy.Way_Step := Enemy.Way_Length;
        Actor_List.Append(Actors, Actor_Access(Enemy));
      end;
    end loop;
  end loop;
  
  for X in 0..3 loop
    declare
      BX: constant := (20 - 6) / 2;
    begin
      declare
        S: Shield_Access := new Shield;
      begin
        S.Location := (X => X * 20 + BX, Y => 19);
        Actor_List.Append(Actors, Actor_Access(S));
      end;
      declare
        S: Shield_Access := new Shield;
      begin
        S.Location := (X => X * 20 + BX, Y => 20);
        Actor_List.Append(Actors, Actor_Access(S));
      end;
      declare
        S: Shield_Access := new Shield;
      begin
        S.Location := (X => X * 20 + BX + 2, Y => 19);
        Actor_List.Append(Actors, Actor_Access(S));
      end;
      declare
        S: Shield_Access := new Shield;
      begin
        S.Location := (X => X * 20 + BX + 4, Y => 19);
        Actor_List.Append(Actors, Actor_Access(S));
      end;
      declare
        S: Shield_Access := new Shield;
      begin
        S.Location := (X => X * 20 + BX + 4, Y => 20);
        Actor_List.Append(Actors, Actor_Access(S));
      end;
    end;
  end loop;
  
  delay 0.5;
  Ada.Text_IO.Put("Setup!!");
  Ada.Text_IO.New_Line;
  delay 0.5;

  Game.Screen.Present(Game_Screen);
  Game.Time.Reset;
  Game_Loop: loop
    if Game.Screen.Has_Events(Game.Screen.Input) then
      declare
        Message : Game.Screen.Event;
      begin
        Message := Game.Screen.Get_Event(Game.Screen.Input);
        if Game.Screen.Is_Lost_Focus(Message) then
          Paused := True;
        elsif Game.Screen.Is_Escape_Press(Message) then
          Paused := not Paused;
          Game.Time.Reset;
        end if;
      end;
    elsif not Paused then
      declare
        State: Game.Input.State := Game.Input.Get_State;
      begin
        if State(Game.Input.Left) then
          Move(Fighter.all, Left);
          Test_Hit(Actors, Actor_Access(Fighter));
        end if;
        if State(Game.Input.Right) then
          Move(Fighter.all, Right);
          Test_Hit(Actors, Actor_Access(Fighter));
        end if;
        if State(Game.Input.Shoot) then
          if Fighter.Shooting_Interval = 0 then
            declare
              Shot: Shot_Access := new Fighter_Shot;
            begin
              Shot.Location := Shooting_Location(Fighter.all);
              Actor_List.Append(Actors, Actor_Access(Shot));
              Fighter.Shooting_Interval := 30;
            end;
          end if;
        else
          Fighter.Shooting_Interval := 0;
        end if;
      end;
      declare
        use Actor_List;
        I: Cursor := First(Actors);
      begin
        while Has_Element(I) loop
          Advance(Element(I), Actors);
          I := Next(I);
        end loop;
      end;
      Game.Screen.Clear(Back_Buffer);
      declare
        use Actor_List;
        I, Next: Cursor := First(Actors);
        Actor: Actor_Access;
        Base: Base_Access;
      begin
        while Has_Element(I) loop
          Next := Actor_List.Next(I);
          Actor := Element(I);
          if Actor.Deleted then
            if Actor.all in Implementation.Fighter'Class then
              exit Game_Loop;
            else
              Delete(Actors, I);
              Base := Base_Access(Actor);
              Actor := null;
              Dispose(Base);
            end if;
          else
            Draw(Actor.all, Back_Buffer);
          end if;
          I := Next;
        end loop;
      end;
      Game.Time.Wait;
      Game.Screen.Write_All(Game_Screen, Back_Buffer);
    end if;
  end loop Game_Loop;

  Game.Screen.Present(Game.Screen.Output);
  Game.Screen.Dispose(Game_Screen);
  
  Ada.Text_IO.Put("Game Over!!");
  Ada.Text_IO.New_Line;
end Akanvader;

説明は個々のところでしてきましたので、ソースファイルを載せておしまい。

お付き合いいただきありがとうございました。 説明不足のところも多いでしょうから(後半は特に)、質問は遠慮無くどうぞ。 その都度本文に反映させていただきます。

*1 当然入力はクリップボード履歴ツールに頼りっきり。CLCL使ってます。

*2 信じないように。また、正しい情報をご存じの方は教えていただければ幸いです。

*3 もちろん9x系なんてものは失われたOSですので、フルスクリーンでも動くようにするため、理由はそれだけでいいです。

*4 GetKeyStateの戻り値はSHORTなので、最上位ビットは16#8000#なのですが、16#80#で動いちゃうのですよね…激しく未定義っぽい。しかし僕は16#80#に慣れてしまったのです。ああ、慣れとは悲劇です。 そんなわけで皆さんは16#8000#をお使いください。

*5 classという予約語は無くても'Classという属性は存在して、使わざるを得ないので、言い訳にすらなっていないのですが。

*6 この衝突判定をmkmさんに訊いてしまったなんてことは恥ずかしい過去です。 脳味噌がどういう状態だったのだろう。