Smalltalk-72で遊ぶOOPの原点：衝突時（爆撃時）処理の実装

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

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

---

crash? explore flash final の追加と spaceship の修正（spacewar も）

衝突判定と衝突時処理のプロシージャは Smalltalk-71 版ではクエスチョンマークが頭に付く ?crash として定義されています。Smalltalk-72 でもそう組むこともできそうです（ ?アクションを作り、そこに crash メソッドセクションを作る…）が、Smalltalk-72 では is? のようにクエスチョンマークが後の方が自然なので crash? で書きます。ただ、Smalltalk-72 はアルファベット列と記号をひとめとめにしたメッセージシンボル等は使えないので、crash アクションを定義して、? はメッセージトークンとして消費（ ᗉ? ）するというパターンで対処します。（結果、? はあってもなくてもよいことになってしまいますが、そこは気にしない方向で…^^; ）

併せて explore flash finish も定義します。

to crash object other (
    %~. "object _ :#.
    spacewar find all spaceship do (
        "other _ each.
        eq #object #other ? ()
        CLOSE < abs (object locx - other locx) ? ()
        CLOSE < abs (object locy - other locy)? ()
        explore object. explore other))

to explore object (
    :#object.
   @ penup goto object locx object locy.
   flash.
   finish object
)

to flash (
    do 10 (
        @ penup turn 36 go SSIZE * 2. 
        @ pendn triangle SSIZE * rand between 2 5.
        @ penup turn 180 go SSIZE * 2 turn 180))

to finish obj stk (
    :#obj.
    obj release.
    spacewar delete obj)

Smalltlak-71版にコードがある crash? と explore は Smalltalk-72 の評価順を意識した式の順の変更等あるものの、おおむね元コードと同じ内容です。

to ?crash :object
  find all (create spaceship :s)
    if :object ≠ :s
      and |:object:location:x - :s:location:x| < :close
      and |:object:location:y - :s:location:y| < :close
    then explode :s, explode :obj
end to

to explode :object
  penup, moveto :object:location
  flash
  finish :object
end to

例によってコードが省略されている flash については、残像を消すことは考えずに単純にランダムな大きさの三角形を triangle で円形に描く処理だけで済ませています。

finish は create 同様に Smalltalk-71 では組み込みを想定しているのかもしれませんが、ここでは stick のリリースと spacewar からの削除の処理をするアクションにしました。

あとは spaceship に crash? をコールしたり、locx や locy のアクセッサーを追加する修正を加えれば完了です。

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)
    %release ? (
        stick delete thrust.
        stick delete steer.
        stick delete trigger)
    %locx ? (!locx)
    %locy ? (!locy)
    %step ? (
        0 < clock - time + MOVELAG ? (
        "time _ clock.
        moveship.
        crash~ SELF.
        display ship))
    %is ? (ISIT eval)
)

本質ではない＆なんか重くなるだけ…のような気もしますが、spaceship がすべて finish した場合にループを抜けるように spacewar にも少し手を入れました。

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).
            1 = objects vec length ? (done)))
    %find ? (%all. :"x. "y _ obset.
        objects do (each is~ = x ? (y _ each)).
        !y))

うまく衝突するか試してみましょう。航跡が残るように display の残像を消す処理はコメントアウトしてあります。（同前^^;）

"SSIZE _ 6. "MOVELAG _ "FRAMELAG _ 0. "SPSCALE _ 1.0. "DIRSCALE _ 1.0. "LSCALE _ 1.0. "CLOSE _ SSIZE * 3.
@ erase. disp display. disp clear
"s1x _ stick 'jl'. "s1y _ stick 'ki'. "s1but _ stick ','.
"s1 _ spaceship 'Jimmy' s1y s1x s1but.
"s2x _ stick 'ad'. "s2y _ stick 'sw'. "s2but _ stick 'x'.
"s2 _ spaceship 'Beth' s2y s2x s2but.
spacewar delete all.
spacewar schedule keysens
spacewar schedule s1. spacewar schedule s2.
spacewar run

バシィッ！

（ 魚雷を実装する へ続く ）