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 では組み込みのプロシージャを想定しているであろう ask を Smalltalk-72 で用意します。
to ask (disp _ :. !read eval)
すみません。かなり手を抜きました ^^;
この ask はメッセージとして送られてきた続く文字列を表示して、ユーザー入力の結果 read を Smalltalk-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 を手軽に扱えることが前提ですが、新しく学ぶ言語や処理系を試すときにこのスペースウォー・ゲームはほどよい規模の題材として使えそうです。今後も大いに活用してゆこうと思います。
付録１：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
付録２： 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
torpedo と torp
魚雷 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 と基本的なところは同じなのですが、
- パイロット名
pilotは無い - 速度
speedと位置locxlocy（Smalltalk-71版ではlocation）、そして方向directionは射出された時点のspaceshipのそれに従う - 推進力
thrustは常に0（つまり、速度speedはそのまま）
という点で異なることが Smalltlak-71版の元コードから読み取れます。
書かれてはいませんが、向き direction も変わらず一定であるべきなので、舵 steer も当然 0 であるべきでしょう。
位置の更新に moveship を、描画用の torp を呼ぶ際に display torp を使っているので、魚雷としては不要なはずの thrust や steer に加え、Smalltalk-72版で追加した直近描画の位置等情報の llocx llocy lldir lthr も宣言と初期化が必要になります。
射出時の初期位置 locx locy は元コードのままだと spaceship と重なっており、これでは crash? が反応してしまうので、direction の方向に SSIZE * 3 ほど移動して現れるように変えています。後述の時限のしくみに倣って、生成直後から一定時間 crash? の実行を行わないというやり方でも良いかもしれませんね。
Smalltalk-71の元のコードでは、画面をまたぐと消滅するようですが、moveship で位置は画面をまたぐように正規化されてしまっており、またいだことを知る方法もないため、Smalltalk-72版では時限を設けて一定時間（グローバル変数 TORPLIFE ）で無効化して消滅することにしました。
時限を迎えたり他のオブジェクトと接触した時の消滅 finish SELF の際には、発射した spaceship の numtorps のデクリメントを行う必要があるのですが、発射した spaceship の numtorps にアクセスできるコンテキストから外れてしまうため spaceship に numtorps をデクリメントする 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? と 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
バシィッ！
（ 魚雷を実装する へ続く ）
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 で始まる制御構造がやっているであろう手続きはおおよそ以下のような理解でよいはずです。
spaceshipに属するインスタンスを関連オブジェクト群から抽出し、その各sについて- 引数
:objectとの（印刷では=で自己判定をしているように見えますが、実際はかすれか誤植で≠による）非自己判定と x、y それぞれについてブローバル変数close（本来なら:closeか？）より接近しているかの判定を行い、それらすべて満たすなら :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メソッドセクションは次の操作を行っています。
ᗉfind ⇒ (……findメッセージシンボル（セレクター）を受け取るとᗉall…… 続きがallトークンがならそれを消費し:☞x.…… 続くトークンをxに評価せずそのままフェッチ☞y _ obset.……yにobsetのインスタンスを生成して代入しobjects do (each is? = x ⇒ (……objectsの各要素のクラス名（each is?で得られる）について、それがxと等しいならy ← each).……yに重複がないことを確認して追加…を繰り返し⇑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 でのオブジェクトの振る舞いの基本である、というようなことをコメントしました。
もちろん、今回の spaceship や stick のインスタンスの使い方は 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
キーの押下の回数をスティックの傾きに代用する
実装をなるべくサボるため^^; 指定したキーの連打の回数でジョイスティックの傾きの度合いを表す仕様にしました。
stickのインスタンスは、アクティベート（ ≒ 参照）されるとスティックの定められた方向 (x軸 or y軸) の傾きを表す数値を返す。- あらかじめ定められたキーの押下をなんらかの方法で知ることで、傾きを表す数値（インスタンス変数
val）を増減させる。
面倒なのでジョイスティックのボタン（発射ボタン）も stick のインスタンスにまとめてしまいます。すみません。
stickのインスタンスは、定められたキーが増減の２キーならスティックを、１キーのみなら発射ボタンとして振る舞う。- 発射ボタンとして振る舞う
stickのインスタンスは、あらかじめ定められたキーの押下をなんらかの方法で知ると、状態を表真偽値（インスタンス変数val）にtrueをセットする。 - アクティベート（ ≒ 参照）されると、
valを返す。同時にvalはfalseにリセットされる。
問題は、「キーの押下をなんらかの方法で知る」というところです。
まず、キーセンサー 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 の場所に生成したインスタンスを保持しておき（スティックの場合は２キーそれぞれに）、これを前述の process 時に逆引きの辞書として使います。該当するキーにアサインされたインスタンスが見つかればそれに handle <キーコード> を送信し、見つからなければ無視します。
メッセージ handle <キーコード> を受け取ったインスタンスは、自分が発射ボタンなら（指定されたキー keys の数が 1 なら）val に true を、そうでない場合は <キーコード> が最初の文字と一致するなら val をデクリメント、そうでなければインクリメントします。
アクティベートされても何もメッセージを受け取らなかったとき（≒ 参照されたとき）は、val が true なら val を false にリセットして 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
かなり根気がいりますが２艇以上でもいけそうです。
@ 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の原点：宇宙船の残像を消す
アラン・ケイの“メッセージングによるプログラミング”という着想に基づき（非同期処理などいろいろ足りていないながらも──）比較的忠実に実装された1970年代の非常に古いSmalltalk-72に実際に触れてみるシリーズ 第2弾です（なお最新のSmalltalkについては Pharo などでお楽しみください！）。
今回は謎言語「Smalltalk-71」で書かれたスペースウォー・ゲームを Smalltalk-72に移植して動かすことを目指します。前回(2019年)を含む他の記事はこちらから→Smalltalk-72で遊ぶOOPの原点 | Advent Calendar 2023 - Qiita
location（point）をやめる
Smalltalk-71のタートルの moveto は x と y が含まれる locationを与えることができるようですが、Smalltalk-72 のタートルにはそういうしくみはないので、せっかく point を定義してもあまりうまみがありません。
見た目を似せようと location に寄せましたが、結果的にあまり見た目が似ないばかりか、なによりいろいろ面倒なので、ここはあきらめて素直に位置情報は x と y のみの locx と locy で表すように変更します。
この変更で影響を受けるのは今のところ spaceship とそこから呼ばれる２つのアクション（ 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 に書き直したコードは並列に動かせるわけではないですし、なにより実機同様このエミュレーターも処理系のスピードが遅くて全力で動いてもらわないといけないという事情もあるため、MOVELAG や FRAMELAG は 0 です。
しかし、もし仮に処理系が十分速く動作するなら、本来であれば FRAMELAG は MOVELAG より大きな値を設定しておくことで、適切な時間間隔で宇宙船の位置が更新され、適切なフレームレートで宇宙船が描画される…というのが想定されているはずです。
そこで、FRAMELAG も意識したコードへの変更も試みておきましょう。
ただ、前回の更新時刻である time だけではフレームレートをうまく表現できないので、新たに ftime を spaceship のインスタンス変数に追加します。
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' を 100、FRAMELAG を 300 で 4フレーム目までは実行したところで escキーで停止して 'FRAMELAGのみ0` に変えて継続した場合の出力例です。 軌道を変えずに描画だけが頻度を上げているのが（ちょっと分かりづらいかも…ですが^^;）確認できます。
display で宇宙船の残像を消してから描く
Smalltalk-71 には記述がないのでどうやっているかは不明なままですが、ともあれ Smalltalk-72 でもなんとかして残像を消す処理を加えます。
前の例のように、描画をしていない間も moveship で刻々と位置情報は更新されているかもしれませんし、speed と steer がゼロでなければ、前回の描画時の情報は、描画のたびに異なります。そこで、描画時の位置等の情報を ldir、'llocx、'llocy、lthu として保持しておくことにします。
スラスター情報 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
