Smalltalk-72で遊ぶOOPの原点：「find all」の実装

See More

アラン・ケイの“メッセージングによるプログラミング”という着想に基づき（非同期処理などいろいろ足りていないながらも──）比較的忠実に実装された1970年代の非常に古いSmalltalk-72に実際に触れてみるシリーズ 第2弾です（なお最新のSmalltalkについては Pharo などでお楽しみください！）。

今回は謎言語「Smalltalk-71」で書かれたスペースウォー・ゲームを Smalltalk-72に移植して動かすことを目指します。前回(2019年)を含む他の記事はこちらから→Smalltalk-72で遊ぶOOPの原点 | Advent Calendar 2023 - Qiita

---

衝突処理 ?crash の準備

Smalltalk-71版のコードで ?crash は衝突判定と衝突時の処理を行っているプロシージャです。

あいかわらず謎のままの create が絡んだり明らかな誤りが見受けられるものの、ここで find all で始まる制御構造がやっているであろう手続きはおおよそ以下のような理解でよいはずです。

1. spaceship に属するインスタンスを関連オブジェクト群から抽出し、その各 s について
2. 引数 :objectとの（印刷では = で自己判定をしているように見えますが、実際はかすれか誤植で ≠ による）非自己判定と x、y それぞれについてブローバル変数 close（本来なら :close か？）より接近しているかの判定を行い、それらすべて満たすなら
3. :s と :object（:obj はタイプミス）の双方を爆発 explore させる

それでは、?crash などの衝突処理や描画の実装に先立ち、ここではまずキーとなる find all を実装します。

今書いている Smalltalk-72 版では、簡易スケジューラである spasewarアクションが、この宇宙空間で移動するすべてのオブジェクトをそのクラス変数である objects の要素として持つことで把握しています。そこで、この spacewarアクションのメソッドとして find all（ findメソッドセクション）を実装し、spacewar find all spaceship do ( ... ) のように呼び出すのがよそうです。

to spacewar x y : : objects (
    (null objects ? ("objects _ obset))
    %schedule ? (objects _ :#)
    %delete ? (%all ? ("objects _ nil) objects delete :#)
    %run ? (repeat (objects do (null each ? () each step)))
    %find ? (%all. :"x. "y _ obset.
        objects do (each is~ = x ? (y _ each)).
        !y))

あとこのタイミングで、後に生じる原因不明の不具合の回避のために runセクションに nil チェックとその排除処理（ null each ⇒ () ）を予防的に追加させてください。^^;

新たに追加された findメソッドセクションは次の操作を行っています。

1. ᗉfind ⇒ (　……　find メッセージシンボル（セレクター）を受け取ると
2. á—‰all　……　続きが all トークンがならそれを消費し
3. :☞x.　……　続くトークンを x に評価せずそのままフェッチ
4. ☞y _ obset.　……　y に obset のインスタンスを生成して代入し
5. objects do (each is? = x ⇒ (　……　objects の各要素のクラス名（ each is? で得られる）について、それが x と等しいなら
6. y ← each).　……　y に重複がないことを確認して追加…を繰り返し
7. ⇑y)　……　y を返す

obset のインスタンスが返るので、これに改めて do ( ... ) を送れば、各要素について処理も行えるという寸法です。

本来であれば、すべての objects の要素はメッセージ is? に応答可能であるべきなのではありますが、Smalltalk-71版のコードで登場する2つの find all はいずれも宇宙船の抽出（ create spaceship :<変数名> ）にしか利用されていないのと、Smalltalk-72 の is? にはそれに応答しないオブジェクトに対してもエラーにはせずに untyped と返してくる カラクリが仕込まれている ことを鑑みて、最低限、spaceshipクラスだけに isメソッドセクションを追加しておくだけで大丈夫そうです。

to spaceship : pilot thrust steer trigger numtorps locx locy speed direction time ftime llocx llocy ldir lthr (
    isnew ? (:pilot. "lthr _ :#thrust. :#steer :#trigger. 
        "numtorps _ "speed _ 0.
        "direction _ "ldir _ 0 + rand * 360.
        "locx _ "llocx _ rand between 50 462.
        "locy _ "llocy _ rand between 50 462.
        "time _ "ftime _ clock)
    %step ? (
        0 < clock - time + MOVELAG ? (
        "time _ clock.
        moveship.
        display ship))
    %is ? (ISIT eval)
)

"s1 _ spaceship 'Jimmy' 0 0 false.
s1 is~
"s2 _ spaceship 'Beth' 0 0 false.
spacewar delete all.
(spacewar find all spaceship) vec length
spacewar schedule s1. spacewar schedule s2. spacewar schedule keysens.
(spacewar find all spaceship) vec length
(spacewar find all spaceship) do (each is~ print. sp).

（ 衝突時（爆撃時）処理の実装 へ続く ）