win16 apiを叩きたい。 その6

# 概要
win16 apiを叩きたい。
pc98エミュレーターに、ms-dos入れて、windows3.1入れて、turbo pascal入れて、窓を表示する。
テトリス見つけたので、やってみた。
私の環境では、break;が無い。（どうすんだい。）

# サンプルコード

```

Program TetrisW;
Uses WinCrt, WinTypes, WinProcs;
Const
	kbNoKey = 0;
	kbEsc = $011B;
	kbUp = $4800;
	kbLeft = $4B00;
	kbKeypad5 = $4CF0;
	kbRight = $4D00;
	kbDn = $5000;
Type
	TetrisGame = Record
	Mode: (tmNone,tmStart,tmPlay,tmGameOver);
	Level: Byte;
	Score: LongInt; 
	Bar, SLevel: Word;
	Tbl: Array[0..20, 0..9] of Boolean;
	Form, _Move, X, Y, Sleep: Byte;
	Touch, Ok: Boolean;
	SleepDelay: Byte;
	FBar: Word;
	UpDate: Boolean;
End;
Function TetrisInit(Var Q: TetrisGame): Boolean; Forward;
Procedure TetrisStart(Var Q: TetrisGame); Forward;
Procedure TetrisRefresh(Var Q: TetrisGame); Forward;
Function TetrisPlay(Var Q: TetrisGame): Word; Forward;
Const
	HomeX = 15;
	HomeY = 2;
Procedure Delay(Millisecond: Integer);
Var
	EndTime: LongInt;
Begin
	EndTime := GetTickCount + (Millisecond);
	Repeat
	Until GetTickCount >= EndTime;
End;
Procedure WaitRetrace; 
Begin
	Delay(1000 div 60);
End;
Procedure MoveRight(Var Source; Var Dest; Len: LongInt);
Begin
	Move(Source, Dest, Len);
End;
Procedure TextAttr(Attr: Byte);
Begin
End;
Procedure BarSpcHor(X1, Y, X2: Byte);
Var
	I: Byte;
Begin
	GotoXY(X1, Y);
	For I := X1 to X2 do 
	Begin
		Write(' ');
	End;
End;
Function TetrisInit(Var Q: TetrisGame): Boolean;
Begin
	FillChar(Q, SizeOf(Q), 0);
	Q.Level := 1;
	Q.Mode := tmStart;
End;
Procedure TetrisStart(Var Q: TetrisGame);
Var
	I: Byte;
Begin
	FillChar(Q.Tbl, SizeOf(Q.Tbl), 0);
	FillChar(Q.Tbl[20], SizeOf(Q.Tbl[20]), Byte(True));
	Q.Score := 0;
	Q.Bar := 0;
	Q.SleepDelay := 25;
	Q.Level := Q.SLevel;
	For I := 0to(Q.SLevel) do 
		If Q.SleepDelay > 6 Then 
			Dec(Q.SleepDelay, 2);
	Q.FBar := Q.Level shl 4;
	Q.Mode := tmStart;
End;
Procedure TetrisRefresh(Var Q: TetrisGame);
Var
	I, J: Byte;
Begin
	ClrScr;
	GotoXY(3, 2);
	Write('Niveau:');
	GotoXY(4, 3);
	Write(Q.Level);
	GotoXY(3, 5);
	Write('Pointage:');
	GotoXY(4, 6);
	Write('0');
	GotoXY(3, 8);
	Write('Ligne:');
	GotoXY(4, 9);
	Write(Q.Bar);
	For J := 0 to 19 do 
	Begin
		GotoXY(HomeX - 1, HomeY + J);
		Write('|');
		GotoXY(HomeX + 10, HomeY + J);
		Write('|');
	End;
	GotoXY(HomeX - 1, HomeY + 20);
	Write('+----------+');
	If (Q.Mode) in[tmPlay, tmGameOver] Then 
	Begin
		For J := 0 to 19 do 
			For I := 0 to 9 do 
				If Q.Tbl[J, I] Then 
				Begin
					GotoXY(HomeX + I, HomeY + J);
					Write('*');
				End;
	End;
End;
Function TetrisPlay(Var Q: TetrisGame): Word;
Label _Exit;
Const
	BlkHeight: Array[0..6, 0..3] of Byte = ((4,1,4,1), { Barre }
						(2,2,2,2), { Boîte }
						(3,2,3,2), { V }
						(3,2,3,2), { L gauche }
						(3,2,3,2), { L droite }
						(3,2,3,2), { Serpent romain }
						(3,2,3,2));{ Serpent arabe }
	BlkLength: Array[0..6, 0..3] of Byte = ( {Largeur des objets:}
						(1,4,1,4), { Barre }
						(2,2,2,2), { Boîte }
						(2,3,2,3), { V }
						(2,3,2,3), { L gauche }
						(2,3,2,3), { L droite }
						(2,3,2,3), { Serpent romain }
						(2,3,2,3));{ Serpent arabe }
	BlkFormat: Array[0..6, 0..3, 0..3] of Record X, Y: Byte; End = (
						(((X:0;Y:0),(X:0;Y:1),(X:0;Y:2),(X:0;Y:3)),		{ þþþþ }
						((X:0;Y:0),(X:1;Y:0),(X:2;Y:0),(X:3;Y:0)),
						((X:0;Y:0),(X:0;Y:1),(X:0;Y:2),(X:0;Y:3)),
						((X:0;Y:0),(X:1;Y:0),(X:2;Y:0),(X:3;Y:0))),
						(((X:0;Y:0),(X:1;Y:0),(X:0;Y:1),(X:1;Y:1)),		{ þþ }
						((X:0;Y:0),(X:1;Y:0),(X:0;Y:1),(X:1;Y:1)),		{ þþ }
						((X:0;Y:0),(X:1;Y:0),(X:0;Y:1),(X:1;Y:1)),
						((X:0;Y:0),(X:1;Y:0),(X:0;Y:1),(X:1;Y:1))),
						(((X:1;Y:0),(X:0;Y:1),(X:1;Y:1),(X:1;Y:2)),		{ þþþ }
						((X:1;Y:0),(X:0;Y:1),(X:1;Y:1),(X:2;Y:1)),		{ þ }
						((X:0;Y:0),(X:0;Y:1),(X:1;Y:1),(X:0;Y:2)),
						((X:0;Y:0),(X:1;Y:0),(X:2;Y:0),(X:1;Y:1))),
						(((X:0;Y:0),(X:0;Y:1),(X:0;Y:2),(X:1;Y:2)),
						((X:0;Y:1),(X:1;Y:1),(X:2;Y:1),(X:2;Y:0)),		{ þ }
						((X:0;Y:0),(X:1;Y:0),(X:1;Y:1),(X:1;Y:2)),		{ þ }
						((X:0;Y:0),(X:1;Y:0),(X:2;Y:0),(X:0;Y:1))),	{ þþ }
						(((X:1;Y:0),(X:1;Y:1),(X:1;Y:2),(X:0;Y:2)),
						((X:0;Y:1),(X:1;Y:1),(X:2;Y:1),(X:0;Y:0)),		{ þ }
						((X:1;Y:0),(X:0;Y:0),(X:0;Y:1),(X:0;Y:2)),		{ þ }
						((X:0;Y:0),(X:1;Y:0),(X:2;Y:0),(X:2;Y:1))),	{ þþ }
						(((X:0;Y:0),(X:0;Y:1),(X:1;Y:1),(X:1;Y:2)),
						((X:1;Y:0),(X:2;Y:0),(X:0;Y:1),(X:1;Y:1)),
						((X:0;Y:0),(X:0;Y:1),(X:1;Y:1),(X:1;Y:2)),
						((X:1;Y:0),(X:2;Y:0),(X:0;Y:1),(X:1;Y:1))),
						(((X:1;Y:0),(X:0;Y:1),(X:1;Y:1),(X:0;Y:2)),
						((X:0;Y:0),(X:1;Y:0),(X:1;Y:1),(X:2;Y:1)),
						((X:1;Y:0),(X:0;Y:1),(X:1;Y:1),(X:0;Y:2)),		{þþ }
						((X:0;Y:0),(X:1;Y:0),(X:1;Y:1),(X:2;Y:1)))); { þþ }
Var
	I, J, H, XT: Byte;
	XJ, YJ, K: Word;
	Touch, Ok, NoAction: Boolean;
Procedure PutForm(Clr: Boolean);
Var
	Character: Char;
	I, Attr, X, Y: Byte;
Begin
	X := HomeX + Q.X;
	Y := HomeY + Q.Y;
	If (Clr) Then 
	Begin
		Character := ' ';
		Attr := 7;
	End
		Else
	Begin
		Character := '*';
		Attr := $71 + Q.Form;
	End;
	For I := 0 to 3 do 
	Begin
		GotoXY(HomeX + Q.X + BlkFormat[Q.Form, Q._Move, I].X, HomeY + Q.Y + BlkFormat[Q.Form, Q._Move, I].Y);
		TextAttr(Attr);
		Write(Character);
		TextAttr(7);
	End;
End;
Procedure Init;
Begin
	Q.Form := Random(6);
	If Q.Form = 5 Then 
		Inc(Q.Form, Random(2));
	Q.X := 5;
	Q.Y := 0;
	Q._Move := 0;
	Q.Sleep := 0;
	PutForm(False);
End;
Function UpDateData: Boolean;
Var
	H, I, J, JK: Byte;
	Bonus: Byte;
	LnChk: Boolean;
Begin
	UpDateData := True;
	Q.Sleep := 0;
	PutForm(False);
	Touch := False;
	Ok := False;
	PutForm(True);
	Inc(Q.Y);
	For I := 0to 3do 
	Begin
		Touch := Touch or Q.Tbl[Q.Y + BlkFormat[Q.Form, Q._Move, I].Y, Q.X + BlkFormat[Q.Form, Q._Move, I].X];
	End;
	If (Touch) Then 
		Dec(Q.Y);
	PutForm(False);
	If (Touch) Then 
	Begin
		While(Q.Sleep > Q.SleepDelay) do 
			Dec(Q.Sleep);
		Q.Sleep := 0;
		Ok := True;
		For I := 0 to 3 do
		 	Q.Tbl[Q.Y + BlkFormat[Q.Form, Q._Move, I].Y, Q.X + BlkFormat[Q.Form, Q._Move, I].X] := True;
		If Q.Level > 7 Then 
		Begin
			Inc(Q.Score, LongInt(5) * Q.Level);
			GotoXY(4, 6);
			Write(Q.Score);
		End;
		Bonus := 0;
		For J := 0 to 19 do 
		Begin
			Touch := True;
			For I := 0 to 9 do 
				Touch := Touch and Q.Tbl[J, I];
			If (Touch) Then 
				Inc(Bonus);
		End;
		If Bonus > 0 Then 
			Dec(Bonus);
		Touch := False;
		For JK := 0 to 7 do 
		Begin
			For J := 0 to 19 do 
			Begin
				LnChk := True;
				For I := 0 to 9 do 
					LnChk := LnChk and Q.Tbl[J, I];
				If (LnChk) Then 
				Begin
					If Not(Touch) Then 
					Begin
						Touch := True;
					End;
					If JK and 1 = 0 Then 
						TextAttr($FF)
					Else 
						TextAttr(7);
					BarSpcHor(HomeX, HomeY + J, HomeX + 9);
				End;
			End;
		End;
		For J := 0 to 19 do 
		Begin
			Touch := True;
			For I := 0 to 9 do 
				Touch := Touch and Q.Tbl[J, I];
			If (Touch) Then 
				Begin
			MoveRight(Q.Tbl[0, 0], Q.Tbl[1, 0], 10 * J);
			FillChar(Q.Tbl[0, 0], 10, 0);
			TetrisRefresh(Q);
			Inc(Q.Score, LongInt(5) + (Bonus * 4) * (Q.Level + 1) + 10 * Q.Level); 
			Inc(Q.Bar);
			GotoXY(4, 6);
			Write(Q.Score);
			GotoXY(4, 9);
			Write(Q.Bar);
			I := (Q.Bar + Q.FBar) shr 4;
			If (Q.Level <> I) Then 
			Begin
				Q.Level := I;
				GotoXY(4, 3);
				Write(Q.Level + 1);
				If Q.SleepDelay > 6 Then 
					Dec(Q.SleepDelay, 2);
			End;
		End;
		End;
		If Q.Y <= 1 Then 
		Begin
			UpDateData := False;
		Exit;
		End;
		Init;
	End;
End;
Function GameOver: Word;
Begin
	GotoXY(10, 7);
	Write('Partie Terminer');
	If (Q.UpDate) Then 
	Begin
		Q.UpDate := False;
	End;
	GameOver:= kbEsc;
End;
Begin
	TetrisRefresh(Q);
	K := 0;
	Repeat
	Case(Q.Mode) of
	tmStart:
	Begin
		TetrisStart(Q);
		TetrisRefresh(Q);
		Init;
		Q.Mode := tmPlay;
		Q.UpDate := True;
		End;
		tmPlay:
		Repeat
		Begin
			Repeat
			If (Q.Sleep > Q.SleepDelay) Then 
				If Not(UpDateData) Then 
				Begin
					Q.Mode := tmGameOver;
					Goto _Exit;
				End;
			WaitRetrace;
			Inc(Q.Sleep);
			Until KeyPressed;
			K := Byte(ReadKey);
			If K = 0 Then 
				K := K or (Byte(ReadKey) shl 8);
		End;
		If Chr(K) = '2' Then 
			K := kbDn;
		If Chr(K) = '4' Then 
			K := kbLeft;
		If Chr(K) = '6' Then 
			K := kbRight;
		NoAction := False;
		Case(K) of
		kbLeft:
			If Q.X > 0 Then 
			Begin
				Touch := False;
				For I := 0 to 3 do 
					Touch := Touch or Q.Tbl[Q.Y + BlkFormat[Q.Form, Q._Move, I].Y, Q.X + BlkFormat[Q.Form, Q._Move, I].X - 1];
				If Not(Touch)Then 
				Begin
					PutForm(True);
					Dec(Q.X);
					PutForm(False);
				End;
			End;
			kbRight:
				If Q.X + BlkLength[Q.Form, Q._Move] - 1 < 9 Then 
				Begin
					Touch := False;
					For I := 0 to 3 do 
						Touch := Touch or Q.Tbl[Q.Y + BlkFormat[Q.Form, Q._Move, I].Y, Q.X + BlkFormat[Q.Form, Q._Move,I].X + 1];
					If Not(Touch) Then 
					Begin
						PutForm(True);
						Inc(Q.X);
						PutForm(False);
					End;
				End;
			kbDn:
				While (True) do 
				Begin
					If Not(UpDateData)Then 
					Begin
						Q.Mode := tmGameOver;
						Goto _Exit;
					End;
				{	If (Ok) Then 
						Break;}
				End;
			Else NoAction := True;
		End;
		If (NoAction) Then 
		Begin
			If (K = kbKeyPad5) or (Char(K) in [' ', '5']) Then 
			Begin
				Touch := False;
				For I := 0 to 3 do 
				Begin
					XT := Q.X + BlkFormat[Q.Form, (Q._Move + 1) and 3, I].X; 
					Touch := Touch or (XT > 9);
					Touch := Touch or Q.Tbl[Q.Y + BlkFormat[Q.Form, (Q._Move + 1) and 3, I].Y, XT];
				End;
				If Not(Touch) Then 
				Begin
					PutForm(True);
					Q._Move := (Q._Move + 1) and 3;
					PutForm(False)
				End
				Else
			Begin
				Touch := False;
				For I := 0 to 3 do 
				Begin
					XT := Q.X;
					If XT > 0 Then 
						Dec(XT);
					Inc(XT, BlkFormat[Q.Form, (Q._Move + 1) and 3, I].X); 
					Touch := Touch or (XT > 9);
					Touch := Touch or Q.Tbl[Q.Y + BlkFormat[Q.Form, (Q._Move + 1) and 3, I].Y, XT];
				End;
				If Not(Touch) Then 
				Begin
					PutForm(True);
					Dec(Q.X); 
					Q._Move := (Q._Move + 1) and 3;
					PutForm(False);
				End;
			End;
		End
		Else
		{	Break;}
		End;
		Until(K = kbEsc) or (Chr(K) = 'Q');
		tmGameOver:K := GameOver;
	End;
_Exit:
	{If K <> 0 Then 
		Break;}
	Until False;
	TetrisPlay := K;
End;
Var
	Game: TetrisGame;
BEGIN
	TetrisInit(Game);
	TetrisPlay(Game);
END.
```


以上。