Smalltalk-72で遊ぶOOPの原点:「ask」「start」の実装

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

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


ユーザー入力を受け付ける ask とゲームをスタートさせる start

いよいよ仕上げの start です。

まず、Smalltalk-71 では組み込みのプロシージャを想定しているであろう askSmalltalk-72 で用意します。

to ask (disp _ :. !read eval)

すみません。かなり手を抜きました ^^;

この ask はメッセージとして送られてきた続く文字列を表示して、ユーザー入力の結果 readSmalltalk-72 の式として eval してから返します。

これを使って start を実装しましょう。

to start ss pilot sy sx sbut (
    "SSIZE _ 6. 
    "MOVELAG _ "FRAMELAG _ 0. 
    "SPSCALE _ 1.0. "DIRSCALE _ 1.0. "LSCALE _ 1.0. 
    "CLOSE _ SSIZE * 3. 
    "TORPLIFE _ 2000.
    spacewar delete all.
    spacewar schedule keysens.
    stick delete all.
    do ask 'how many will be playing~ ' (
        "pilot _ ask 'pilot''s name str~ '.
        "sy _ stick ask 'two chars (keys) str for stick y-axis~ '.
        "sx _ stick ask 'tow chars (keys) str for stick x-axis~ '.
        "sbut _ stick ask 'one char (key) str for stick button~ '.
        "ss _ spaceship pilot sy sx sbut.
        spacewar schedule ss)
    disp _ 'type ''esc'' to exit...'.
    spacewar run)

"disp _ dispframe 16 480 514 184 string 2000. disp clear
@ erase. disp display.
start

作業用に広げていたターミナルウインドウのサイズを元に戻して( disp ← ... )から、画面を綺麗にして( ☺ erase. disp display.start を実行します。

すると、プレイヤー数、プレイヤー名、推進力操作のキーのペア、操舵のキーのペア、魚雷発射キーをどうするかについて1プレイヤーずつ訊ねられるので、プレイヤー数については整数、それ以外は文字列リテラル'...' )でタイプして do-it \(グリフは )することで入力できます。

全ての入力が終えると escキーで中止できる旨のメッセージを表示してゲームが始まります。

おわりに

当初の甘い計画では 18回くらいでサクッと終わらせて、残りは Smalltalk-72 らしい実装に試みにあてたかったのですが、ままならないものですね…^^;

ともあれ、なんとか start でゲームを開始するところまでこぎ着けられてよかったです。

おそらくオブジェクトのアクティベートのタイミングへの理解が足りていないのが主な理由でしょうが、“原因不明”のエラーとの格闘で無駄に時間を溶かしてしまいました。しかし、おかげでメッセージング のみ によるプログラミングを今まで以上に踏み込んで体験し身につけられたように思います。

一方で、クラスやオブジェクトがクロージャーで実現されていて、メッセージを受け取るために「アクティベート」と称する実行が必要になる Smalltalk-72 がその非効率さ以外にも抱えている構造的な問題点もなんとなくいろいろと見えてきたような気がします。

今後は、前述のとおり今回果たせなかった Smalltalk-72 ならでは版の他に、Squeak や Pharo といった現在の Smalltalk で実装したらどんなふうになるかも試してみたいと思っています。

また、オリジナルのスペースウォー・ゲームの仕様を探して、Smalltalk-71版のコードは何が違うのか、といったあたりも調べてみたいです。

Smalltalk-71 についてはますます謎が深まっただけで終わってしまったような残念な感じではありますが、それでも、なるほど「A Persona Computer for Children of All Ages(あらゆる年齢の『子供たち』のための パーソナルコンピュータ)」 でジミーとベスが遊んでいたのはまさにこのSmalltalk-71で書かれたスペースウォー・ゲームそのものであり、この論文(エッセイ?)にアラン・ケイ氏が掲載しようとしていたのもまさにこの Smalltalk-71版のコードだったのでは!?…という今更ながらの気付きを得ることができました。この予想が当たっているとしたら、読み解くのにかなり労力を費やした身としては、ダニエル・G ・ボブロー氏の助言はしごくまっとうなものだったと強く同意します^^;

あと非常に気になった点として、これはオリジナルの当ゲームの仕様がどうだったか次第で意見が分かれるところではありますが、このゲームでは向きの操舵が慣性に従っていないところがずっと引っかかりました。速度と同様に宇宙船の向きを制御するそれ用のスラスターを用意し、加速・減速を意識した姿勢制御がしたいところです。

グラフィック出力やキー入力などの IO を手軽に扱えることが前提ですが、新しく学ぶ言語や処理系を試すときにこのスペースウォー・ゲームはほどよい規模の題材として使えそうです。今後も大いに活用してゆこうと思います。

付録1:Smalltalk-71 のコードを極力修正したバージョン

Smalltalk-72 への移植を通じて、意味が通りにくい部分について恐らくこうなのではないかと修正を試みた Smalltalk-71版のコードです。

to ship :size
  penup, left 180, forward 2 * :size, right 90
  forward 1 * :size, right 90
  pendown, forward 4 * :size, right 30, forward 2 * :size
  right 120, forward 2 * :size
  right 30, forward 4 * :size
  right 30, forward 2 * :size
  right 120, forward 2 * :size
  left 150, forward :size * 2 * sqrt 3.
  left 150, forward :size * 2
  right 120, forward :size * 2
  left 150, forward :size * 2 * sqrt 3
  penup, left 90, forward :size, right 90, forward 2 * :size
end to

to flame :size
  penup, left 180, forward 2 + sqrt 3, pendown
  triangle :size, forward .5 * :size
  triangle 1.5 * :size, forward 5 * :size
  triangle 2 * :size, forward .5 * :size
  triangle 1 * :size, forward .5 * :size
  etc.
end to

to flash
  etc.
end to

to retro
  etc.
end to

to torp
  etc.
end to

to spaceship :pilot :thrust :steer :trigger
use :numtorps :location:(:x :y) :speed :direction
  repeat
    moveship
    if :trigger and :numtorps < 3
    then create torpedo :speed :direction :location .
    ?crash :self
    display ship
    pause until clock = :time + :movelag
end to

to moveship
  make :speed be :speed + (:spscale * :thrust)
  make :direction be :direction + (:dirscale * :steer) rem 360
  make :location:x be :location:x + (:lscale * :speed * cos :direction) rem 1024
  make :location:y be :location:y + (:lscale * :speed * sin :direction) rem 1024
end to

to display ":obj
  penup, moveto :location, turn :direction
  create :obj :size
  if :thrust > 0 then create flame :size
  if :thrust < 0 then create retro flame :size
  pause until clock = :time + :framelag
end to

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

to torpedo :speed :direction :location
  use :thrust 0
  bump :numtorps
  moveship
  if not (0 < :location:x < 1024 and 0 < :location:y < 1024)
  then ?bump :numtorps, finish :self
end to

to start
  repeat ask "how many will be playing?" times
    create spaceship ask "pilot's name?"
      stick.(make :sn be ask “stick number?”).y
      stick.:sn.x
      stick.:sn.but
  end repeat
  if (make :char be ask) = “s” then done
  find all (create spaceship :x)
    start :x
end to

*start
how many will be playing?
*2
pilot's name?
*Jimmy
stick number?
*2
pilot's name?
*Bill
stick number?
*3

付録2: Smalltalk-72版 全コード(Smalltalk-72エミュレータのSnippetsウインドウへのコピペと二回クリックによるターミナルへの転送用)

"disp _ dispframe 16 480 8 670 string 2000. disp clear

to ship size (
    @ penup turn 180 go 2 * :size turn 90
        go 1 * size turn 90
        pendn go 4 * size turn 30 go 2 * size
        turn 120 go 2 * size
        turn 30 go 4 * size
        turn 30 go 2 * size
        turn 120 go 2 * size
        turn `150 go (sqrt 3) * 2 * size
        turn `150 go 2 * size
        turn 120 go 2 * size
        turn `150 go (sqrt 3) * 2 * size
        penup turn `90 go 1 * size turn 90 go 2 * size)

to triangle size (
    @ pendn turn 90 go 0.5 * :size
        turn `120 go size
        turn `120 go size
        turn `120 go 0.5 * size turn `90
        penup)

to flame size (
    @ penup turn 180 go ((sqrt 3) + 2) * :size pendn.
    triangle size. @ go 0.5 * size.
    triangle 1.5 * size. @ go 0.5 * size.
    triangle 2 * size. @ go 0.5 * size.
    triangle size. @ go size.
    @ penup turn 180 go ((sqrt 3) + 2.5 + 2) * size)

to abs x y (0 > :x ? (!-x) !x)

to sqrt x y z (
    0.0 > :x ? (error)
    0.0 = x ? (!0)
    "y _ 1.0 * x.
    "z _ 1.0e`8 * x.
    repeat (z > y - "y _ y - ((y * y) - x) / y * 2 ? (done)).
    x is float ? (!y)
    z > abs y - "x _ 1 * y + z ? (!x) !y)

"PI _  3.14159265

to nfact acc n m (
    7 < :m ? (error "(16 bit signed int overflow))
    "acc _ 1. for n to m do ("acc _ acc * n) !acc)

to sin acc x n m (
    "x _ (:) mod 360.
    (180 < x ? ("x _ x - 360))
    (90 < x ? ("x _ 180 - x)
    `90 > x ? ("x _ `180 - x))
    "x _ (PI / 180) * x.
    "acc _ 0.0.
       for n _ 0 to 3 do (
        "m _ 1 + 2 * n.
        "acc _ acc + ((`1.0 ipow n) * (x ipow m) / nfact m))
    !acc)

to cos (!sin 90 + :)

to retro (@ turn 180)

to rand low high : : n (
   (%seed ? (:n))
   (null n ? ("n _ 12345))
   "n _ n &- n &/ 7.
   "n _ n &- n &/ `9.
   "n _ n &- n &/ 8.
   %between ? (:low. :high. !low + n mod high + 1 - low)
   !(32768.0 + n) / 65535.0)

to clock (!mem 280)

PUT vector "each nil
addto vector "(%do ? (:#y. for x to SELF length ("each _ SELF[x]. y eval)))

to t each (ev)
t
to each (!vec[i])
PUT obset "each #each
done

addto obset "(%do ? (:#input. for i to end (input eval))

to moveship (
    "speed _ speed + SPSCALE * thrust.
    "direction _ (direction + DIRSCALE * steer) mod 360.
    "locx _ (locx + (cos direction) * LSCALE * speed) mod 512.
    "locy _ (locy + (sin direction) * LSCALE * speed) mod 512)

to stick x y i kcode : keys val : kmap (
    %delete ? (%all ? ("kmap _ nil)
        :#x.
        for i to 256 do ("y _ kmap[i]. eq #x #y ? (kmap[i] _ nil)). )
    (null kmap ? ("kmap _ vector 256))
    %process ? ("x _ kmap[1+:kcode].
        null #x ? (!false)
        x handle kcode. )
    isnew ? (
        (1 = :keys length ? ("val _ false) "val _ 0).
        for i to keys length do (kmap[1+keys[i]] _ #SELF))
    %print ? (disp _ '(stick '. disp _ 39. disp _ keys. disp _ 39. disp _ ') ')
    %handle ? (
        :kcode.
        1 = keys length ? ("val _ true)
        1 = keys[1 to 2] find first kcode ? ("val _ val - 1) "val _ val + 1)
    eq val true ? ("val _ false. !true)
    !val
)

to keysens (
    %step ? (repeat (kbck ? (stick process kbd) done))
    #keysens)

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))

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)

to torp size (
    @ penup turn 180 go :size turn 90
        go 0.5 * size turn 90
        pendn go 2 * size turn 30 go size
        turn 120 go size
        turn 30 go 2 * size
        turn 30 go size
        turn 120 go size
        penup turn 120 go 0.5 * size turn `90 go size)

to torpedo : thrust steer locx locy speed direction time
        ftime llocx llocy ldir lthr launcher endlife (
    isnew ? (:launcher. :speed. :locx. :locy. "ldir _ :direction.
        "locx _ "llocx _ locx + (cos direction) * SSIZE * 10.
        "locy _ "llocy _ locy + (sin direction) * SSIZE * 10.
        launcher bumptorps.
        "thrust _ "lthr _ "steer _ 0. 
        "time _ "ftime _ clock.
        "endlife _ clock + TORPLIFE)
    %release ? (
        stick delete thrust.
        stick delete steer.
        stick delete trigger)
    %locx ? (!locx)
    %locy ? (!locy)
    %step ? (
        0 < clock - time + MOVELAG ? (
            "time _ clock.
            0 < clock - endlife ? (
                launcher debumptorps.
                display torp erase.
                finish SELF)
            moveship.
            crash~ SELF.
            display torp))
    %is ? (ISIT eval)
)

to display obj (
    :#obj.
    0 < clock - ftime + FRAMELAG ? (
        "ftime _ clock.
        @ penup goto llocx llocy up turn ldir + 90 pendn white.
        obj SSIZE.
        (0 < lthr ? (flame SSIZE)
        0 > lthr ? (retro flame SSIZE)).
        @ penup goto locx locy up turn direction + 90 pendn black.
        %erase ? ()
        obj SSIZE.
        (0 < thrust ? (flame SSIZE)
        0 > thrust ? (retro flame SSIZE))
        "llocx _ locx. "llocy _ locy. "ldir _ direction ."lthr _ thrust))

to spaceship newtorp : 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.
            (trigger ? (3 > numtorps ? (
                "newtorp _ torpedo SELF speed locx locy direction.
                spacewar schedule newtorp))
            moveship.
            crash~ SELF.
            display ship)))
    %is ? (ISIT eval)
    %bumptorps ? ("numtorps _ numtorps + 1)
    %debumptorps ? ("numtorps _ numtorps - 1)
)

to ask (disp _ :. !read eval)

to start ss pilot sy sx sbut (
    "SSIZE _ 6. 
    "MOVELAG _ "FRAMELAG _ 0. 
    "SPSCALE _ 1.0. "DIRSCALE _ 1.0. "LSCALE _ 1.0. 
    "CLOSE _ SSIZE * 3. 
    "TORPLIFE _ 2000.
    spacewar delete all.
    spacewar schedule keysens.
    stick delete all.
    do ask 'how many will be playing~ ' (
        "pilot _ ask 'pilot''s name str~ '.
        "sy _ stick ask 'two chars (keys) str for stick y-axis~ '.
        "sx _ stick ask 'tow chars (keys) str for stick x-axis~ '.
        "sbut _ stick ask 'one char (key) str for stick button~ '.
        "ss _ spaceship pilot sy sx sbut.
        spacewar schedule ss)
    disp _ 'type ''esc'' to exit...'.
    spacewar run)

"disp _ dispframe 16 480 514 184 string 2000. disp clear
@ erase. disp display.
start

Smalltalk-72で遊ぶOOPの原点:魚雷を実装する

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

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


torpedotorp

魚雷 torpedo とその描画用プロシージャの torp は、宇宙船 spaceship に対する ship のペアと同じ関係にあります。

継承があれば torpedo はきっと spaceship との共通部分を抽象クラス化してそれを継承して作ると少し楽ができそう(Smalltalk-72版ではコードが膨れ上がったので…)ですが、Smalltalk-72 同様に Smalltalk-71 にも継承機構は想定されていなかったようで、一部重複するコードで実装する必要があります。

まず描画用の torp ですが、これは例によって省略されているので、ship から尾翼を省いて少し小さめにした処理で済ませました。

to torp size (
    @ penup turn 180 go :size turn 90
        go 0.5 * size turn 90
        pendn go 2 * size turn 30 go size
        turn 120 go size
        turn 30 go 2 * size
        turn 30 go size
        turn 120 go size
        penup turn 120 go 0.5 * size turn `90 go size)

魚雷 torpedo は、前述のとおり spaceship と基本的なところは同じなのですが、

  1. パイロット名 pilot は無い
  2. 速度 speed と位置 locx locySmalltalk-71版では location )、そして方向 direction は射出された時点の spaceship のそれに従う
  3. 推進力 thrust は常に 0(つまり、速度 speed はそのまま)

という点で異なることが Smalltlak-71版の元コードから読み取れます。

書かれてはいませんが、向き direction も変わらず一定であるべきなので、舵 steer も当然 0 であるべきでしょう。

位置の更新に moveship を、描画用の torp を呼ぶ際に display torp を使っているので、魚雷としては不要なはずの thruststeer に加え、Smalltalk-72版で追加した直近描画の位置等情報の llocx llocy lldir lthr も宣言と初期化が必要になります。

射出時の初期位置 locx locy は元コードのままだと spaceship と重なっており、これでは crash? が反応してしまうので、direction の方向に SSIZE * 3 ほど移動して現れるように変えています。後述の時限のしくみに倣って、生成直後から一定時間 crash? の実行を行わないというやり方でも良いかもしれませんね。

Smalltalk-71の元のコードでは、画面をまたぐと消滅するようですが、moveship で位置は画面をまたぐように正規化されてしまっており、またいだことを知る方法もないため、Smalltalk-72版では時限を設けて一定時間(グローバル変数 TORPLIFE )で無効化して消滅することにしました。

時限を迎えたり他のオブジェクトと接触した時の消滅 finish SELF の際には、発射した spaceshipnumtorps のデクリメントを行う必要があるのですが、発射した spaceshipnumtorps にアクセスできるコンテキストから外れてしまうため spaceshipnumtorps をデクリメントする debumptorps(と、必要ないですがインクリメントする bumptorps も)用意しこれをコールしています。なお torpedo インスンタス生成時に、それを射出した spaceship(自身)を launcher として渡すような変更も加えています。

魚雷が時限を迎えて消滅するときのために、display アクションに消去だけする erase オプションも用意しました。

to torpedo : thrust steer locx locy speed direction time
        ftime llocx llocy ldir lthr launcher endlife (
    isnew ? (:launcher. :speed. :locx. :locy. "ldir _ :direction.
        "locx _ "llocx _ locx + (cos direction) * SSIZE * 10.
        "locy _ "llocy _ locy + (sin direction) * SSIZE * 10.
        launcher bumptorps.
        "thrust _ "lthru _ "steer _ 0. 
        "time _ "ftime _ clock.
        "endlife _ clock + TORPLIFE)
    %release ? (
        stick delete thrust.
        stick delete steer.
        stick delete trigger)
    %locx ? (!locx)
    %locy ? (!locy)
    %step ? (
        0 < clock - time + MOVELAG ? (
            "time _ clock.
            0 < clock - endlife ? (
                launcher debumptorps.
                display torp erase.
                finish SELF)
            moveship.
            crash~ SELF.
            display torp))
    %is ? (ISIT eval)
)

to display obj (
    :#obj.
    0 < clock - ftime + FRAMELAG ? (
        "ftime _ clock.
        @ penup goto llocx llocy up turn ldir + 90 pendn white.
        obj SSIZE.
        (0 < lthr ? (flame SSIZE)
        0 > lthr ? (retro flame SSIZE)).
        @ penup goto locx locy up turn direction + 90 pendn black.
        %erase ? ()
        obj SSIZE.
        (0 < thrust ? (flame SSIZE)
        0 > thrust ? (retro flame SSIZE))
        "llocx _ locx. "llocy _ locy. "ldir _ direction ."lthr _ thrust))

to spaceship newtorp : 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.
            (trigger ? (3 > numtorps ? (
                "newtorp _ torpedo SELF speed locx locy direction.
                spacewar schedule newtorp))
            moveship.
            crash~ SELF.
            display ship)))
    %is ? (ISIT eval)
    %bumptorps ? ("numtorps _ numtorps + 1)
    %debumptorps ? ("numtorps _ numtorps - 1)
)

こちらが、停止している宇宙船(敵)対して魚雷を発射、一発外して二発目で当てたときの様子です。しつこいようですが^^; 航跡が残るように display の残像を消す処理はコメントアウトしてあります。

「ask」「start」の実装 へ続く )

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?exploreSmalltalk-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 で円形に描く処理だけで済ませています。

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

あとは spaceshipcrash? をコールしたり、locxlocy のアクセッサーを追加する修正を加えれば完了です。

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

バシィッ!

魚雷を実装する へ続く )

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

アラン・ケイの“メッセージングによるプログラミング”という着想に基づき(非同期処理などいろいろ足りていないながらも──)比較的忠実に実装された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 allfindメソッドセクション)を実装し、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. …… yobsetインスタンスを生成して代入し
  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).

衝突時(爆撃時)処理の実装 へ続く )

Smalltalk-72で遊ぶOOPの原点:スケジュールされたオブジェクトのアクティベートに「step」メッセージを使用する

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

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


愚痴

前回、オブジェクトがアクティベートされただけで、メッセージが送られてこなかったり、あるいは知っているメッセージを受け取らなかった場合に何もしないのが Smalltalk-72 でのオブジェクトの振る舞いの基本である、というようなことをコメントしました。

もちろん、今回の spaceshipstickインスタンスの使い方は Smalltalk-72 のオブジェクトとしてはいろいろ問題ことはわかっていたのですが、元の Smalltalk-71 の記述に寄せたり、明示的にメッセージを送らずともプロシージャのように振る舞うオブジェクトもカッコイイかなぁ…などと軽く考えたのが運の尽きでした。

果たして次から次へ問題が噴出し、回避策を見いだせないかとただでさえ少ない時間を溶かしつづけ、未だにクリスマスに到達できないまま現在に至っております^^:

たとえば、spacewar schedule <spaceshipのインスタンス> とした場合、画面になぜか宇宙船が二度ほど描かれてしまいますよね。これなんかは obset がこの種の定形外のオブジェクトを扱えない(具体的には参照をうまく扱えていない)のが原因のひとつだったりします。

なんなわけで、だんだんつらくなってきたので一部仕様を変更して、標記通り、スケジューラ spacewar に登録するオブジェクトについては、アクティベートだけでなく、stepメッセージを受け取った場合だけ処理をするように変更します。すみません。

なお、spacewar に絡まない stick まで手を入れるとなるとかえって大変になりそうなので、これはそのままにします。どうぞあしからず。

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

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))
)

to keysens (%step ? (repeat (kbck ? (stick process kbd) done)). #keysens)

「find all」の実装 へ続く )

Smalltalk-72で遊ぶOOPの原点:ジョイスティックの動きをキー押下で(雑に)真似る「stick」

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

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


キーの押下の回数をスティックの傾きに代用する

実装をなるべくサボるため^^; 指定したキーの連打の回数でジョイスティックの傾きの度合いを表す仕様にしました。

  1. stickインスタンスは、アクティベート( ≒ 参照)されるとスティックの定められた方向 (x軸 or y軸) の傾きを表す数値を返す。
  2. あらかじめ定められたキーの押下をなんらかの方法で知ることで、傾きを表す数値(インスタンス変数 val )を増減させる。

面倒なのでジョイスティックのボタン(発射ボタン)も stickインスタンスにまとめてしまいます。すみません。

  1. stickインスタンスは、定められたキーが増減の2キーならスティックを、1キーのみなら発射ボタンとして振る舞う。
  2. 発射ボタンとして振る舞う stickインスタンスは、あらかじめ定められたキーの押下をなんらかの方法で知ると、状態を表真偽値(インスタンス変数 val )にtrueをセットする。
  3. アクティベート( ≒ 参照)されると、val を返す。同時に valfalse にリセットされる。

問題は、「キーの押下をなんらかの方法で知る」というところです。

まず、キーセンサー keysens アクションを用意します。ゲーム中にプレイヤーがキーを押下するとそれぞ stickクラスに知らせ( stick process kbd )あとは stick 側で良きに計らってもらうことにします。

to keysens (repeat (kbck ? (stick process kbd) done). #keysens)

なおこの keysensアクションは spaceshipインスタンスと同様にあらかじめ spacewar に登録しておくことで、ゲーム中に繰り返し呼ばれるようにしておきます。

Smalltalk-72では、インスタンス(そしてインスタンスを返すインスタンス生成能を持つ普通のクラス)はメソッド途中でリターン( )アクションへのメッセージ式で処理の中断と返り値を明示しない限りインスタンス自身(SELF)を返しますが、関数的に用いられるアクションは最後に評価した値(なければ nil )を返します。そのため、この spacewar への登録とその後のハンドリングに備えて、メソッドの終わりに自身の参照 #keysens を追加しています。

さて。クラス stick には kmap というクラス変数(256要素の配列 vector 256)を持たせます。そして stickインスタンス生成の際に指定されたキーのコード + 1 の場所に生成したインスタンスを保持しておき(スティックの場合は2キーそれぞれに)、これを前述の process 時に逆引きの辞書として使います。該当するキーにアサインされたインスタンスが見つかればそれに handle <キーコード> を送信し、見つからなければ無視します。

メッセージ handle <キーコード> を受け取ったインスタンスは、自分が発射ボタンなら(指定されたキー keys の数が 1 なら)valtrue を、そうでない場合は <キーコード> が最初の文字と一致するなら val をデクリメント、そうでなければインクリメントします。

アクティベートされても何もメッセージを受け取らなかったとき(≒ 参照されたとき)は、valtrue なら valfalse にリセットして true を、そうでなければ(つまり、false時の発射ボタンやスティックなら) val をそのまま返します。

今更ですが念のための注意として、spaceship もそうなのですが、 ただアクティベートされただけで何か処理をする(特に値を返す)ようなインスタンスの書き方や使い方は、Smalltalk-72 ではあまり想定されていないらしく、いろいろと問題を引き起こします。あくまで Smalltalk-71 の元のコードの見た目に寄せるためだけの遊びの一環としてとらえていただければさいわいです。

to stick x y i kcode : keys val : kmap (
    %delete ? (%all ? ("kmap _ nil)
        :#x.
        for i to 256 do ("y _ kmap[i]. eq #x #y ? (kmap[i] _ nil)). )
    (null kmap ? ("kmap _ vector 256))
    %process ? ("x _ kmap[1+:kcode].
        null #x ? (!false)
        x handle kcode. )
    isnew ? (
        (1 = :keys length ? ("val _ false) "val _ 0).
        for i to keys length do (kmap[1+keys[i]] _ #SELF))
    %print ? (disp _ '(stick '. disp _ 39. disp _ keys. disp _ 39. disp _ ') ')
    %handle ? (
        :kcode.
        1 = keys length ? ("val _ true)
        1 = keys[1 to 2] find first kcode ? ("val _ val - 1) "val _ val + 1)
    eq val true ? ("val _ false. !true)
    !val
)

こちらのコードで宇宙船がキーで操作できることを確認しましょう。航跡が残るように display の残像を消す処理はコメントアウトしてあります。(残像を消す処理を入れたのは早すぎましたね…^^;)

"SSIZE _ 6. "MOVELAG _ "FRAMELAG _ 0. "SPSCALE _ 1.0. "DIRSCALE _ 1.0. "LSCALE _ 1.0.
@ erase. disp display. disp clear
"s1x _ stick 'jl'. "s1y _ stick 'ki'. "s1but _ stick ','.
"s1 _ spaceship 'Jimmy' s1y s1x s1but.
spacewar delete all.
spacewar schedule keysens
spacewar schedule s1.
spacewar run

かなり根気がいりますが2艇以上でもいけそうです。

@ 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

スケジュールされたオブジェクトのアクティベートに「step」メッセージを使用する へ続く )

Smalltalk-72で遊ぶOOPの原点:宇宙船の残像を消す

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

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


locationpoint)をやめる

Smalltalk-71のタートルの movetoxy が含まれる locationを与えることができるようですが、Smalltalk-72 のタートルにはそういうしくみはないので、せっかく point を定義してもあまりうまみがありません。

見た目を似せようと location に寄せましたが、結果的にあまり見た目が似ないばかりか、なによりいろいろ面倒なので、ここはあきらめて素直に位置情報は xy のみの locxlocy で表すように変更します。

この変更で影響を受けるのは今のところ spaceship とそこから呼ばれる2つのアクション( moveship および display )です。

to spaceship : pilot thrust steer trigger numtorps locx locy speed direction time (
    isnew ? (:pilot. :#thrust. :#steer :#trigger. 
        "numtorps _ "speed  _ 0.
        "direction _ 0 + rand * 360.
        "locx _ rand between 50 462. "locy _ rand between 50 462.
        "time _ clock)
    0 < clock - time + MOVELAG ? (
        "time _ clock.
        moveship.
        display ship)
)

to moveship (
    "speed _ speed + SPSCALE * thrust.
    "direction _ (direction + DIRSCALE * steer) mod 360.
    "locx _ (locx + (cos direction) * LSCALE * speed) mod 512.
    "locy _ (locy + (sin direction) * LSCALE * speed) mod 512)

to display obj (
    :#obj.
    @ penup goto locx locy up turn direction + 90 pendn.
    obj SSIZE.
    (0 < thrust ? (flame SSIZE)
    0 > thrust ? (retro flame SSIZE)))

ついでに、direction の初期値を乱数にするのと、MAVELAG の二重足しのミスをこの機に修正しました。^^;

フレームレートを意識した display に修正

Smalltalk-71 版でそれが想定されているのとは違い、Smalltalk-72 に書き直したコードは並列に動かせるわけではないですし、なにより実機同様このエミュレーターも処理系のスピードが遅くて全力で動いてもらわないといけないという事情もあるため、MOVELAGFRAMELAG0 です。

しかし、もし仮に処理系が十分速く動作するなら、本来であれば FRAMELAGMOVELAG より大きな値を設定しておくことで、適切な時間間隔で宇宙船の位置が更新され、適切なフレームレートで宇宙船が描画される…というのが想定されているはずです。

そこで、FRAMELAG も意識したコードへの変更も試みておきましょう。

ただ、前回の更新時刻である time だけではフレームレートをうまく表現できないので、新たに ftimespaceshipインスタンス変数に追加します。

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

to display obj (
    :#obj.
    0 < clock - ftime + FRAMELAG ? (
        "ftime _ clock.
        @ penup goto locx locy up turn direction + 90 pendn.
        obj SSIZE.
        (0 < thrust ? (flame SSIZE)
        0 > thrust ? (retro flame SSIZE))))

@ erase. disp display. disp clear
"SSIZE _ 6. "MOVELAG _ 100. "FRAMELAG _ 300. "SPSCALE _ 1.0. "DIRSCALE _ 1.0. "LSCALE _ 1.0.
spacewar delete all. "s1 _ spaceship 'Jimmy' 2 15 false. spacewar schedule s1
spacewar run
"FRAMELAG _ 0. spacewar run

次図は 'MOVELAG' を 100FRAMELAG300 で 4フレーム目までは実行したところで escキーで停止して 'FRAMELAGのみ0` に変えて継続した場合の出力例です。 軌道を変えずに描画だけが頻度を上げているのが(ちょっと分かりづらいかも…ですが^^;)確認できます。

display で宇宙船の残像を消してから描く

Smalltalk-71 には記述がないのでどうやっているかは不明なままですが、ともあれ Smalltalk-72 でもなんとかして残像を消す処理を加えます。

前の例のように、描画をしていない間も moveship で刻々と位置情報は更新されているかもしれませんし、speedsteer がゼロでなければ、前回の描画時の情報は、描画のたびに異なります。そこで、描画時の位置等の情報を ldir、'llocx、'llocylthu として保持しておくことにします。

スラスター情報 lthr は本体の描画には不要なのですが、スラスター火炎を描く方向(位置)を決めるのに使われているのでこれも必要です。また、isnew の非偽時処理セクション(コンストラクタ)での初期化も加えます。

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)
    0 < clock - time + MOVELAG ? (
        "time _ clock.
        moveship.
        display ship)
)

display では、まず前回位置等情報を使って、かつ、白( ☺ white )で描画して残像を消す処理を追加します。また、改めて黒( ☺ black )で現在の位置等情報を使って描画し、その後、前回位置等情報を更新します。

to display obj (
    :#obj.
    0 < clock - ftime + FRAMELAG ? (
        "ftime _ clock.
        @ penup goto llocx llocy up turn ldir + 90 pendn white.
        obj SSIZE.
        (0 < lthr ? (flame SSIZE)
        0 > lthr ? (retro flame SSIZE)).
        @ penup goto locx locy up turn direction + 90 pendn black.
        obj SSIZE.
        (0 < thrust ? (flame SSIZE)
        0 > thrust ? (retro flame SSIZE))
        "llocx _ locx. "llocy _ locy. "ldir _ direction ."lthr _ thrust))

"SSIZE _ 6. "MOVELAG _ "FRAMELAG _ 0. "SPSCALE _ 1.0. "DIRSCALE _ 1.0. "LSCALE _ 1.0.
@ erase. disp display. disp clear
spacewar delete all.
"s1 _ spaceship 'Jimmy' 5 30 false. spacewar schedule s1.
"s2 _ spaceship 'Beth' `5 `20 false. spacewar schedule s2.
spacewar run

ジョイスティックの動きをキー押下で(雑に)真似る「stick」 へ続く)