はじめに
皆さんは、人生で二番目に入力したプログラムを覚えているでしょうか?
私は覚えています。ポケットコンピュータ『SHARP PC-1246』の取扱説明書に載っていた 「軟着陸ゲーム」 です。ちなみに、最初に入力したのは「追いかけマン」 でした。
「軟着陸ゲーム」の方がリストは短いのに、最初に入力しなかったのは、なにやら小難しい数式が書かれていたからだったと思います。
本記事は、その「軟着陸ゲーム」を Windows アプリケーションにしてみようというものです。アプリケーションの作成には 『Embarcadero Delphi』 を使います。
Delphi のバージョンは 2009 以降を想定していますが、(可能な限り) 古い Delphi へ移植できるように考慮したコードになっています。
- Delphi (Wikipedia)
- Delphi (Embarcadero)
- DocWiki (Embarcadero)
- Delphi Community Edition (Embarcadero) <- 無償版
- OBJECT PASCAL HANDBOOK for 11 ALEXANDRIA (Embarcadero) <- 言語解説 (英語、無償)
「軟着陸ゲーム」
「軟着陸ゲーム (英語名: SOFTLANDING GAME)」 についての説明です。
ルール
自由落下するロケットを逆噴射 (?) して、軟着陸させるゲームです。
H=H_0+V_0t+\frac{1}{2}at^2 \\
V=V_0+at \\
V^2=V_0^2+2aH \\
H_0=500、 V_0=-50、 F_0=200
記号 | 意味 |
---|---|
H | 高度 |
V | 速度 |
a | 重力加速度 |
t | 時間 |
V0 | 初速度 |
H0 | 初高度 |
F0 | 初燃料 |
F | 消費燃料 |
※ 重力は 5m/S2、単位時間 (S) に 5 単位の燃料を消費すると重力を相殺できます。
G=5m/S^2
[操作説明]
- 消費する燃料を
〔0〕
~〔9〕
キーで指定します。 - 高度を下げつつ速度を 0 に近付けます。
- 残燃料に注意しながら噴射を続けます。
- 軟着陸に成功すると残り燃料が表示されます。失敗するとサヨウナラです。
-
「REPLAY (Y/N) ?」 と聞かれますので、再ゲームするには
〔Y〕
、やめるには〔N〕
に続いて〔Enter〕
を押します。
[画面説明]
ビジュアルなゲームだと思った?『PC-1246』は 16桁 1行でグラフィックが使えないポケコンなのよ?
左から、高度, 速度, 残燃料, 消費燃料 です。
バリエーション
「軟着陸ゲーム」にはバリエーションがあるようです。
機種 | 説明 |
---|---|
PC-1250/51/55 版 | オリジナル? |
PC-1245 版 | 16桁表示に合わせた改変 |
PC-1246/47 版 | BEEP 命令が省かれている |
PC-1260/61/62 版 | PC-125x 版と同じ? |
BASIC ソースコード
次のリストは PC-1245 版のものです。
10 "A": WAIT 50: CLEAR : USING : S=-50:A=0:D$=""
20 BEEP 3: PRINT " *** START ***"
30 DATA "JIKAN=",50,"NENRYOU=",400,"KODO=",500
40 RESTORE
50 READ B$,W,B$,F,B$,H
60 WAIT W
70 PRINT USING "####";H;S;F;C
80 IF F<=0 GOTO 170
90 BEEP 1:D$= INKEY$
100 IF D$="" LET C=A: GOTO 130
110 C= VAL D$
120 A=C
130 IF C>F LET C=F
140 F=F-C:X=C-5:H=H+S+X/2:S=S+X
150 IF H>0 GOTO 70
160 IF ( ABS H<5)+( ABS S <5)=2 BEEP 5: PRINT "SEIKO!!": GOTO 180
170 BEEP 3: PRINT "GOOD BY !!": GOTO 190
180 WAIT 150: PRINT USING "#####";"NOKORI F=";F
190 INPUT "REPLAY (Y/N) ?";Z$
200 IF (Z$="Y")+(Z$="N")<>1 GOTO 190
210 IF Z$="Y" GOTO 10
220 END
このゲーム、とても難しい印象があったのですが、PC-1245 版を入力してやってみたら、意外に簡単だったので拍子抜けしてしまいました。ソースコードをよく確認してみたら、それもそのはず、PC-1245 版だけ初期燃料が倍の 400 に設定されているのです。
30 DATA "JIKAN=",50,"NENRYOU=",200,"KODO=",500
あと、何故か PC-1245 版だけリトライの処理の所で INPUT()
が使ってあります。他の機種では INKEY$
が使われています。
190 WAIT 50: PRINT "REPLAY (Y/N)?":Z$=INKEY$
PC-125x 版は、24桁表示で動作するようになっていますので、一部画面表示が異なります。
70 PRINT USING "####";"H:";H; " S:";S;" F:";F;" C:"; STR$ C
Delphi への移植
PC-1245 版の「軟着陸ゲーム」を Delphi へ移植してみます。「追いかけマン」 を作った時のスケルトンを使います。
画面
スケルトンのアーカイブを適当な場所に解凍し、[ファイル | プロジェクトを開く]
でプロジェクトを開きます。
[プロジェクトマネージャ]
の [Pokecom_Skeleton] になっている所を
- マウスでゆっくり 2 回クリック (ポイント&クリック)
-
〔F2〕
キーを押す - マウスで右クリックして
[名前の変更]
を選択
いずれかの方法で編集状態にします。
名前を 「Nanchakuriku」 にします (SoftLanding
でもいいんですよ?)。
・フォームのプロパティ
フォームのキャプションを変更します。
プロパティ | 値 |
---|---|
Caption | 軟着陸ゲーム |
・BASIC ルーチン用ユニット
[プロジェクトマネージャ]
で uPokecomUtils.pas をダブルクリックして開きます。これはゲームを移植するのに必要な BASIC の命令をレコード型のメソッドとして実装したものです。
「追いかけマン」 で作ったスケルトンでは足りない命令を追加しました。次のコードで全置換し、〔Ctrl〕+〔S〕
で上書き保存してください。
unit uPokecomUtils;
interface
uses
System.SysUtils, System.Math;
type
TPcRtn = record
FWait: UInt32;
FNFmt: string;
FNFmtCnt1: Integer;
FNFmtCnt2: Integer;
FNHasPeriod: Boolean;
FNIsExponential: Boolean;
FSFmt: string;
FSFmtCnt: Integer;
FData: array of TVarRec;
FDataIdx: Integer;
function Abs(v: Double): Double; overload;
procedure Data(v: array of const);
procedure &End;
function Int(v: Double): Double;
procedure Random;
procedure Read(var F: Double); overload;
procedure Read(var S: string); overload;
procedure Restore(v: Integer = 0);
function Rnd(v: Double): Double;
function Sgn(v: Double): TValueSign;
function Str(v: Double): String;
procedure Using(Fmt: string = '');
function Val(s: string): Double;
procedure Wait(v: UInt32 = 0); overload;
procedure Wait(v: Double = 0); overload;
end;
implementation
{ TPcRtn }
function TPcRtn.Abs(v: Double): Double;
begin
result := System.Abs(v);
end;
procedure TPcRtn.Data(v: array of const);
var
i, idx: Integer;
begin
idx := Length(FData);
SetLength(FData, Length(FData) + Length(v));
for i := Low(v) to High(v) do
FData[idx + i] := v[i];
end;
procedure TPcRtn.&End;
begin
Abort;
end;
function TPcRtn.Int(v: Double): Double;
begin
result := Trunc(v);
end;
procedure TPcRtn.Random;
begin
Randomize;
end;
procedure TPcRtn.Read(var S: string);
begin
case FData[FDataIdx].VType of
vtChar:
S := String(FData[FDataIdx].VChar);
vtAnsiString:
S := String(PAnsiChar(FData[FDataIdx].VAnsiString));
vtWideChar:
S:= FData[FDataIdx].VWideChar;
vtWideString:
S:= PWideChar(FData[FDataIdx].VWideString);
vtUnicodeString:
S := PWideChar(FData[FDataIdx].VUnicodeString);
vtInteger:
S := IntToStr(FData[FDataIdx].VInteger);
vtInt64:
S := IntToStr(PInt64(FData[FDataIdx].VInt64)^);
vtCurrency:
S := CurrToStr(PCurrency(FData[FDataIdx].VCurrency)^);
vtExtended:
S := FloatToStr(PExtended(FData[FDataIdx].VExtended)^);
else
S := '';
end;
Inc(FDataIdx);
end;
procedure TPcRtn.Read(var F: Double);
begin
case FData[FDataIdx].VType of
vtInteger:
F := FData[FDataIdx].VInteger;
vtInt64:
F := PInt64(FData[FDataIdx].VInt64)^;
vtCurrency:
F := PCurrency(FData[FDataIdx].VCurrency)^;
vtExtended:
F := PExtended(FData[FDataIdx].VExtended)^;
else
F := 0;
end;
Inc(FDataIdx);
end;
procedure TPcRtn.Restore(v: Integer);
begin
FDataIdx := v;
end;
function TPcRtn.Rnd(v: Double): Double;
begin
if v >= 1 then
result := System.Random(Trunc(v)) + 1
else if v < 0 then
result := System.Random // Need Debug
else
result := System.Random;
end;
function TPcRtn.Sgn(v: Double): TValueSign;
begin
result := Sign(v);
end;
function TPcRtn.Str(v: Double): String;
begin
result := FloatToStr(v);
end;
procedure TPcRtn.Using(Fmt: string);
var
i: Integer;
sis, sie, nis, nie: Integer;
procedure SetSie;
begin
if (sis > 0) and (sie = 0) then
sie := i;
end;
procedure SetNie;
begin
if (nis > 0) and (nie = 0) then
nie := i;
end;
begin
nis := 0; nie := 0;
FNFmt := '';
FNFmtCnt1 := 0;
FNFmtCnt2 := 0;
FNHasPeriod := False;
FNIsExponential := False;
sis := 0; sie := 0;
FSFmt := '';
FSFmtCnt := 0;
if Fmt = '' then
Exit;
for i:=1 to Length(Fmt) do
begin
case Fmt[i] of
'#':begin
SetSie;
if nis = 0 then
nis := i;
if nie = 0 then
begin
if FNHasPeriod then
Inc(FNFmtCnt2)
else
Inc(FNFmtCnt1);
end;
end;
'.':begin
SetSie;
FNHasPeriod := True;
end;
'^':begin
SetSie;
SetNie;
FNIsExponential := True;
end;
'&':begin
SetNie;
if sis = 0 then
sis := i;
if sie = 0 then
Inc(FSFmtCnt);
end;
else
SetSie;
end;
end;
if sis > 0 then
FSFmt := StringOfChar('&', FSFmtCnt);
if nis > 0 then
begin
FNFmt := StringOfChar('#', FNFmtCnt1);
if FNHasPeriod then
begin
FNFmt := FNFmt + '.';
FNFmt := FNFmt + StringOfChar('#', FNFmtCnt2);
end;
if FNIsExponential then
FNFmt := FNFmt + '^';
end;
end;
function TPcRtn.Val(s: string): Double;
begin
result := StrToFloatDef(s, 0);
end;
procedure TPcRtn.Wait(v: Double);
begin
FWait := Trunc(v);
end;
procedure TPcRtn.Wait(v: UInt32);
begin
FWait := v;
end;
end.
・ゲーム用スレッド
ゲーム用スレッドの Execute()
メソッドにも足りない内部ルーチンを追加します。[プロジェクトマネージャ]
で frmuGameMain
をダブルクリックして開いてください。
Execute()
メソッドも全置換します。
{$HINTS OFF}
procedure TGameThread.Execute;
{$REGION '/* 内部ルーチン */'}
const
COLUMNS = 16; // 画面の桁数
var
A, B, C, D, E, F, G, H, I, J, K, L, M,
N, O, P, Q, R, S, T, U, V, W, X, Y, Z: Double;
A_, B_, C_, D_, E_, F_, G_, H_, I_, J_, K_, L_, M_,
N_, O_, P_, Q_, R_, S_, T_, U_, V_, W_, X_, Y_, Z_: string;
Rtn: TPcRtn;
procedure Beep(n: Integer);
begin
Synchronize(
procedure
var
i: Integer;
begin
for i := 1 to n do
Winapi.Windows.Beep(4000, 500);
end
);
end; { Beep }
procedure Clear;
begin
Synchronize(
procedure
begin
FEdit.Clear;
FEdit.Repaint;
end
); { Clear }
end;
function Inkey: Char;
begin
if FEdit.Tag = 8 then
result := #$7F
else
result := Char(FEdit.Tag);
FEdit.Tag := 0;
end; { Inkey }
procedure Print(v: array of const); overload;
type
TPCVarType = (pcvtUnknown, pcvtNumeric, pcvtString);
var
T, Tick: Int64;
sw: TStopWatch;
dn: Double;
vs, ds, dmy: string;
i, idx, sLen: Integer;
pcvt: TPCVarType;
begin
for i:=Low(v) to High(v) do
begin
ds := '';
dn := 0;
case v[i].VType of
vtChar, vtAnsiString, vtWideChar, vtWideString, vtUnicodeString:
pcvt := pcvtString;
vtInteger, vtInt64, vtCurrency, vtExtended:
pcvt := pcvtNumeric;
else
pcvt := pcvtUnknown;
end;
case v[i].VType of
vtChar:
ds := String(v[i].VChar);
vtAnsiString:
ds := String(PAnsiChar(v[i].VAnsiString));
vtWideChar:
ds:= v[i].VWideChar;
vtWideString:
ds:= PWideChar(v[i].VWideString);
vtUnicodeString:
ds := PWideChar(v[i].VUnicodeString);
vtInteger:
dn := v[i].VInteger;
vtInt64:
dn := PInt64(v[i].VInt64)^;
vtCurrency:
dn := PCurrency(v[i].VCurrency)^;
vtExtended:
dn := PExtended(v[i].VExtended)^;
else
end;
case v[i].VType of
vtChar, vtAnsiString, vtWideChar, vtWideString, vtUnicodeString:
begin
if Rtn.FSFmtCnt > 0 then
begin
ds := Copy(ds, 1, Rtn.FSFmtCnt);
ds := ds + StringOfChar(' ', Rtn.FSFmtCnt - Length(ds));
end;
vs := vs + ds;
end;
vtInteger, vtInt64, vtCurrency, vtExtended:
begin
if Rtn.FNFmt = '' then
begin
ds := FloatToStr(dn);
if Pos('.', ds) = 0 then
ds := ds + '.';
ds := StringOfChar(' ', COLUMNS - Length(ds)) + ds;
end
else
begin
if Rtn.FNIsExponential then
begin
// not Implement
end
else
begin
dmy := FloatToStr(Int(dn));
dmy := StringOfChar(' ', Rtn.FNFmtCnt1 - Length(dmy)) + dmy;
ds := ds + dmy;
if Rtn.FNHasPeriod then
begin
ds := ds + '.';
if Rtn.FNFmtCnt2 > 0 then
begin
dmy := FloatToStr(Frac(Abs(dn)));
idx := Pos('.', Dmy);
if idx > 0 then
begin
dmy := Copy(Dmy, idx + 1, Rtn.FNFmtCnt2);
dmy := dmy + StringOfChar('0', Rtn.FNFmtCnt2 - Length(dmy));
end;
ds := ds + dmy;
end;
end;
end;
end;
vs := vs + ds;
end;
else
end;
end;
Synchronize(
procedure
begin
FEdit.Clear;
FEdit.Text := vs;
FEdit.Repaint;
end
);
if Rtn.FWait = 0 then
begin
while True do
begin
if Self.Terminated then
Break;
if FEdit.Tag = 13 then
begin
FEdit.Tag := 0;
Break;
end;
end;
Synchronize(
procedure
begin
FEdit.Clear;
FEdit.Repaint;
end
);
end
else
begin
sw := TStopWatch.StartNew;
Tick := sw.ElapsedMilliseconds;
T := 1000 div 64 * Rtn.FWait;
while T > (sw.ElapsedMilliseconds - Tick) do
if Self.Terminated then Break;
end;
end; { Print #1 }
procedure Print(v: string); overload;
begin
Print([v]);
end; { Print #2 }
procedure Print(v: Double); overload;
begin
Print([v]);
end; { Print #3 }
procedure Print_Using(s: string; v: array of const); overload;
begin
Rtn.Using(s);
Print(v);
end; { Print_Using #1 }
procedure Print_Using(s: string; v: string); overload;
begin
Rtn.Using(s);
Print(v);
end; { Print_Using #2 }
procedure Print_Using(s: string; v: Double); overload;
begin
Rtn.Using(s);
Print(v);
end; { Print_Using #3 }
procedure Pause(v: array of const); overload;
var
dWait: UInt32;
begin
dWait := Rtn.FWait;
Rtn.FWait := 54; // 0.85s
Print(v);
Rtn.FWait := dWait;
end; { Pause #1 }
procedure Pause(v: string); overload;
begin
Pause([v]);
end; { Pause #2 }
procedure Pause(v: Double); overload;
begin
Pause([v]);
end; { Pause #3 }
procedure Input(s: string; var v: string); overload;
var
T, Tick: Int64;
sw: TStopWatch;
KeyBuf: string;
c: Char;
dWait: UInt32;
begin
if s <> '' then
begin
dWait := Rtn.FWait;
Rtn.FWait := 1;
Print(s);
Rtn.FWait := dWait;
end;
repeat
C := Inkey;
if not Self.Terminated then
begin
sw := TStopWatch.StartNew;
Tick := sw.ElapsedMilliseconds;
while (sw.ElapsedMilliseconds - Tick) < 100 do
if Self.Terminated then Break;
Synchronize(
procedure
begin
end
);
end;
if C = #$0D then
Break;
if (C >= #$20) and (C <= #$7F) then
begin
if C = #$7F then
KeyBuf := Copy(KeyBuf, 1 , Length(KeyBuf) - 1)
else
KeyBuf := KeyBuf + UpperCase(C);
Synchronize(
procedure
begin
if C = #$7F then
FEdit.Text := Copy(FEdit.Text, 1 , Length(FEdit.Text) - 1)
else
FEdit.Text := FEdit.Text + UpperCase(C);
FEdit.Repaint;
end
);
end;
until Self.Terminated;
v := KeyBuf;
end; { INPUT #1 }
procedure Input(s: string; var v: Double); overload;
var
value: string;
begin
Input(s, value);
v := StrToFloat(value);
end; { INPUT #2 }
procedure Input(var v: string); overload;
begin
Input('', v);
end; { INPUT #3 }
procedure Input(var v: Double); overload;
var
value: string;
begin
Input('', v);
end; { INPUT #4 }
{$ENDREGION}
begin
try
with Rtn do
begin
{ --- ここから --- }
{ --- ここまで --- }
end;
except
end;
end;
{$HINTS ON}
ゲームロジック
ゲームのロジックをゲームスレッドの Execute
メソッド内に記述します。
・ラベルの宣言
goto 用のラベルを事前に宣言しておく必要がありますので、次の場所に追加します。
{$ENDREGION}
label // 追加
10, 70, 130, 170, 180, 190; // 追加
begin
...
・本体
BASIC を Delphi (Pascal) に移植したコードを Execute メソッド内の
{ --- ここから --- }
{ --- ここまで --- }
の間に記述します。
Data(['JIKAN=', 50, 'NENRYOU=', 400, 'KODO=', 500]);
10:Wait(50); Clear; Using; S:=-50; A:=0; D_ := '';
Beep(3); Print(' *** START ***');
Restore;
Read(B_); Read(W); Read(B_); Read(F); Read(B_); Read(H);
Wait(W);
70:Print_Using('####', [H, S, F, C]);
if F <= 0 then goto 170;
Beep(1); D_ := INKEY;
if D_ = #$00 then begin C := A; goto 130 end;
C := Val(D_);
A := C;
130:if C > F then C := F;
F := F - C; X := C - 5; H := H + S + X / 2; S := S + X;
if H > 0 then goto 70;
if (Ord(Abs(H) < 5) + Ord(Abs(S) < 5)) = 2 then begin Beep(5); Print('SEIKO!!'); goto 180 end;
170:Beep(3); Print('GOOD BY !!'); goto 190;
180:Wait(150); Print_Using('#####', ['NOKORI F=', F]);
190:Input('REPLAY (Y/N)?', Z_);
if (Ord(Z_ = 'Y') + Ord(Z_ = 'N')) <> 1 then goto 190;
IF Z_ = 'Y' then goto 10;
&End;
オリジナルの BASIC リストと見比べてみてください。今回はちょっと似ていないトコロもあります。
・解説
READ / DATA / RESTORE 命令
割ととんでもない命令。DATA はプログラム中のどこにでも記述できます。これを READ で読むのですが、実行しなかった行の DATA 文も読めます。つまり、自分で自分のソースコードを読み取り、DATA のある行をデータとして認識している感じです。動的な変数とはまたちょっと違います。
実際の BASIC プログラムでは、読みやすさを考慮してプログラムの先頭や最後にまとめて置かれる事が多かったと思います。
RESTORE は、引数を渡すと、その行番号にある DATA の所にポインタを設定します。次に READ 命令が実行されると、ここから読み取られます。引数のない RESTORE を実行すると一番最初に現れた DATA 命令の所にポインタを設定します。
Delphi での実装ですが、Data()
は TVarRec の動的配列を追加していくメソッドです。なので、DATA 文は先頭に集めておく必要があります。
配列の位置を表すポインタが用意されており、これを Restore()
で移動できます。Delphi はスクリプト言語ではないため、行位置やラベル位置を特定できません。Restore()
で設定できるのは動的配列の要素の位置です (先頭が 0)。
Read()
では動的配列用のポインタが指す要素の位置にあるデータを読み出し、ポインタを 1 つ進めます。Delphi では可変個引数が使えないので、Read(A, B_, C...)
のような指定はできません。必ず一つずつ変数に読み込む必要があります。
USING 命令
書式設定です。以降に現れる PRINT 命令や PAUSE 命令の書式を設定します、が。
PRINT "PI="; USING "###.##"; P
なんて書き方もできてしまいます。これは流石に実現できないので、Using()
と Print_Using()
というメソッドを実装しました。Print_Using('####.##', [A, B, C, D])
のような指定も可能です。
書式は Delphi のものを使ってお茶を濁せばよかったのですが、それでは面白くないのでBASIC のものを実装しました。おかげでコードが長くなってしまいました。指数表記の書式は未実装ですが、まあ使わないよね (w
INPUT 命令
PC-1245 版の「軟着陸ゲーム」を参考にしたばかりに実装するハメになった命令。なかなかに無理のある実装な事には目を瞑って頂きたく。
遊んでみよう!
コンパイルして実行 (〔F9〕
) してみると、次のような画面になります。エディットボックスには普通に文字を入力できますが…
[開始] ボタンを押すとゲームが開始されます。
ゲームオーバーになったらリプレイしないと元の画面に戻ります。
入力されていた文字も元に戻ります。
くれぐれも (以下略)。
バグ発見 (?)
ゲーム中に [x]
で閉じた時にすぐにゲームが終了しないので、ゲームループの中に if Terminated then Exit;
を適宜挿入しましょう。
70:Print_Using('####', [H, S, F, C]);
if Terminated then Exit;
190:Input('REPLAY (Y/N)?', Z_);
if Terminated then Exit;
純粋なコード比較の邪魔になると思ったので、あえてこの部分は抜いておきました。
音ウルサイ
BEEP を抜いてください。
改造して遊ぶ
ソースコードのあるゲームは改造して遊ぶのも楽しいです!
- BASIC でいう 30 行目の 初期燃料の値を 400 から 200 に変更する (僕が昔、PC-1246 で遊んでた設定)。
- 初期燃料の値を下限 200 のランダムにする。
-
Input()
の所をInkey()
で書き直す。
このゲームにはランダム要素が一切ないので、一度クリアできてしまうと次回以降はそんなに難しくないんですよね。そのままでは飽きやすいかも。
おわりに
折角なので、ポケコンゲーム移植用のスケルトンプロジェクトを用意してみました。
ゲームロジック以外は記述されていますので、
- Delphi Community Edition を DL してインストール。
- スケルトンを DL して適当な場所に解凍し、Delphi で
[ファイル | プロジェクトを開く]
で開く。 - ゲームロジックを組み込み。
-
〔F9〕
でコンパイル&実行。
これだけで「軟着陸ゲーム」が動作します。
See also