;******************************************************************
;	ＰＩＴ−ＭＡＮ（Ｅｄｉｔモードなし版）
;	Ｏｈ！ＭＺ　１９８５／１１（PIT-MAN2000）より移植
;******************************************************************
; これはＳＴＫにするとかなり重いサンプル。
; 実はオリジナル（Ｃ言語版がある）からだいぶ機能を削った。
; 配列の処理が非常に重いというのがわかった。
; このくらい大規模になるとＳＴＫのソースのみにくさが
; メンテナンスのしにくさになって、あまり良くない。

onbrk ONBREAK	; CTRL-C/BREAKトラップ設定

; キーコード
ESC	var . $1b = VLOCK
CR	var . $0d = VLOCK
SP	var . ' ' = VLOCK
QUIT	var . '!' = VLOCK

/* キャラクター番号 */
AKI	var .	0 = VLOCK	; 空間
HASIGO	var .	1 = VLOCK	; ハシゴ
GOLD	var .	2 = VLOCK	; 金塊
BLOCK	var .	3 = VLOCK	; 土
STONE	var .	4 = VLOCK	; 岩
KABE	var .	5 = VLOCK	; 壁
MAN	var .	6 = VLOCK	; 人

/* 人のポーズ */
TATE	var .	0 = VLOCK	; 基本形
HIDARI	var .	1 = VLOCK	; 左向き
MIGI	var .	2 = VLOCK	; 右向き
GUP	var .	3 = VLOCK	; Give up

( MAN HIDARI + MAN MIGI + MAN GUP + ) ( HMAN MMAN GMAN ). VARS=

/* 人数 */
MENS	var .	5 = VLOCK

/* 面データ定数 */
MX	var .	11 = VLOCK	; マップ横幅
MY	var .	8 = VLOCK	; マップ縦幅
MMAX	var .	50 = VLOCK	; 全面数
MDATA	var . MX MY * MMAX * = VLOCK	; 全面データサイズ

/* フィールド実サイズ */
WX	var . 3 2 * MX * = VLOCK
WY	var . 3 MY * = VLOCK

; ここで変数ハッシュの３重重複によるバグが出た。
; 今まで気づかなかったとは。
;******************************************************************
/* グローバル変数 */

( MDATA ).	men	ARY.B ,
( MX MY ).	scrn	ARY.B ,
( MMAX ).	cflag	ARY.B ,
." H$X*ﾛ\"	smpc	STRINGS , ; マップ表示キャラクターセット
80		space	STRING  , ; 80>MX

( mx my x1 x2 gd clrs ). VARS
style VAR TATE =
wtt VAR ,		/* ウエイト */

;******************************************************************

[N
{ ; メイン
( lv ret ). VARS
	/* 面データ：１面８８バイト＊５０面 */
	/* 面クリアフラグ：５０バイト */
	/*	x=０〜１０：１１ */
	/*	y=０〜７　：８ */
	; ARGC 3 >= IF space . 2 ARGV ELSE "pit.dat" ENDIF
	; 現在のSVARは配列のアドレスを記録出来ないので、上記方法は使えず、
	; データファイル名を変更出来ない。残念。
	"pit.dat" load_map. IF. END
	
	; メイン
	wtt CalcWait. = ; ウエイト算出(1/60s)
	
	0 CURMODE ,
	CLS
	
	lv 0 =
	REPEAT
		lv . play. =. -1 == IF. BREAK ; 中断
		lv MMAX == IF  ; 全面クリア
			( "もう一度最初からやりますか？（Y/N）" 14 ) センタリング表示.
			lv 0 =
		ELSE ; ゲームオーバー
			( "もう一度やりますか？（Y/S/N）" 14 )  センタリング表示.
		ENDIF
		ret getch2. =.
		    CR == IF ret 'Y' = ENDIF
		ret SP == IF ret 'N' = ENDIF
		ret PRINTC
		ret 'S' == IF lv 0 = ENDIF ; 最初から
	ret == 'N' UNTIL
	1 CURMODE ,
}
0 ]N
END

;******************************************************************

load_map:
; マップデータロード
[N
{
( fname ). SVARS=
;
	fname PRINTS
	fp VAR fname "rb" FOPEN =.
	EOF == IF
		"\aマップデータが読めません：" PRINTS
		fname PRINTS CRLF
		1
	ELSE
		men   MDATA fp FREAD , ; 面データ
		cflag  MMAX fp FREAD , ; クリアフラグ
		fp FCLOSE ,
		; クリア済みの面数カウント
		clrs 0 =
		0 MMAX FOR.
			( I? ). cflag @ -> IF clrs . ++ = ENDIF
		NEXT
		0
	ENDIF
}
0 ]N ; -1+1
RETURN

;******************************************************************

play:
; ｐｌａｙモード
; リターン値：MMAX=全面クリア , 0〜49=ゲームオーバー（終った面）, -1=中断
{
( lv ). VARS=
;
( x y hasi m c cc ret ). VARS
( lt1 lt2 ). VARS
	lt1 LTOP =
	m MENS =
	REPEAT
	    lt2 LTOP =
	    gd lv １面分表示. =.
	    ELIF
		BEEP BEEP
		( " ＜＜　この面はデータ異常です　＞＞ " 12 ) センタリング表示.
		-1 play_end GOTO
	    ENDIF
	    m 残り人数表示.
	    hasi 0 =
	    REPEAT
		style TATE != IF
			( mx my MAN ) キャラクター表示.
			style TATE =
		ENDIF
		x2 mx =
		x1 mx =
		x  mx =
		y  my =
		
		; ここの落下判定はＣ言語版と大きく違うところ
		; if (y<MY-1 && scrn[x][y+1]==0 && hasi==0) {
		; Ｃなら前から順に成り立ったところまでしか評価しないのでこれで良いが、
		; STKではすべて評価してしまうのでscrn[x][y+1]でscyn[x][MY]を使ってしまい、
		; そこれは配列領域を越えるのでエラーになる。
		; 回避するにはscrnを[MY+1]で確保するか、以下のようにしてＣとほぼ同じ
		; 評価にするかどちらか。
		0
		y MY -- < hasi 0 == && IF
			( x y ++ ). scrn @ -> ELIF , 1 ENDIF
		ENDIF
		IF	; 下があいてて今ハシゴの上にいない時->落下
			my . ++ =
			9 TWait.
		ELSE	; 落下中でない
			2 TWait.
			KBCLR
			cc GETCH TOUPPER =.
			SWITCH
			; 移動キー
			'8' CASE ; 上
				y 0 == IF 0 CONTINUE ENDIF
				c ( x y -- ). scrn @ -> =
				c AKI != IF
					c HASIGO != hasi 0 == || IF
						0 CONTINUE
					ENDIF
				ENDIF
				my . -- =
				BREAK
			'2' CASE ; 下
				y MY -- == IF 0 CONTINUE ENDIF
				c ( x y ++ ). scrn @ -> =
				c AKI != c HASIGO != &&	IF 0 CONTINUE ENDIF
				my . ++ =
				BREAK
			'6' CASE ; 右
				( x y  1 ) 左右移動. IF 0 CONTINUE ENDIF
				BREAK
			'4' CASE ; 左
				( x y -1 ) 左右移動. IF 0 CONTINUE ENDIF
				BREAK
			
			; 特殊操作
			'+' CASE ; Next
				lv MMAX -- == IF BEEP 0 CONTINUE ENDIF
				( lv ). cflag @ -> ELIF
				    /* 今の面がクリアされていない時は
				       １人を犠牲にして次の面へ行く。
				       ただし、残り１人の時は行けない */
					m 0 == IF BEEP 0 CONTINUE ENDIF
					m . -- =
				ENDIF
				lv . ++ =
				NX GOTO
			'-' CASE ; Back
				lv 0 == IF BEEP 0 CONTINUE ENDIF
				lv . -- =
				NX GOTO
			'=' CASE ; 直接面番号入力
				ret lv 面セレクト. =. ; -1,0〜49
				-1 != IF
					ret 0 >= ret MMAX < && IF
						lv ret =
					ENDIF
				ENDIF
				CLS
				NX GOTO
			'G' CASE ; Give up
				m . -- =.
				0 < IF
					( " ＜ Ｇａｍｅ　Ｏｖｅｒ ＞ " 12 )
					センタリング表示.
					lv play_end GOTO
				ENDIF
				( mx my GMAN ) キャラクター表示.
				40 TWait.
				NX GOTO
			ESC CASE
			QUIT CASE ; 中断
				-1 play_end GOTO
			DEFAULT
				0 CONTINUE
			SEND
		ENDIF
		hasi ( x y mx my hasi ) 人表示. =
		( x1 x2 ) 落下.
	    gd 0 <= UNTIL
	    ; １面クリアー
	    ( " ＜ 面クリアー！！ ＞ " 12 ) センタリング表示.
	    ( lv ). cflag @ . -> ELIF
		1 <- ; cflag[lv]=1
		clrs . ++ = ; クリア面数+1
	    ELSE ,
	    ENDIF
	    c getch2. =.
	    ESC == c QUIT == || IF -1 play_end GOTO ENDIF
	    m MENS = ; 人数を元に戻す
	    lv . ++ =.
	    MMAX >= IF lv 0 = ENDIF
	  NX:
	    lt2 LTOP=
	clrs MMAX >= UNTIL
	( " 《 全面クリアー ！！ 》 " 12 ) センタリング表示.
	MMAX
play_end:
	lt1 LTOP=
}
RETURN

;******************************************************************

人表示:
[N
{
( x y mx my hasi ). VARS=
;
	( x y AKI hasi + ) キャラクター表示. ; 空間 or ハシゴ表示
	hasi 0 =
	( mx my ). scrn @ -> SWITCH
		HASIGO CASE ; ハシゴ
			hasi 1 =
			BREAK
		GOLD CASE ; 金塊
			gd . -- =
			BEEP
			BREAK
	SEND
	( mx my MAN style + ) キャラクター表示.
	style TATE != IF 12 TWait. ENDIF
	hasi
}
-4 ]N ; -5+1
RETURN

;******************************************************************

落下:
; 金塊＆岩落下
[N
{
( x1 x2 ). VARS=
;
( y q c ). VARS
	REPEAT
	    q 0 =
	    x1 x2 FOR ; x
		y MY =
		1 MY FOR.
			y . -- =
			( J? y ). scrn @ -> AKI != IF. CONTINUE
			c ( J? y -- ). scrn @ -> =.
			GOLD == c STONE == || IF
				( J? y      c ) キャラクター表示.
				( J? y -- AKI ) キャラクター表示.
				q 1 =
				7 TWait.
			ENDIF
		NEXT
	    NEXT
	q 1 != UNTIL
}
-2 ]N
RETURN

;******************************************************************

左右移動:
[N
{
( x y hx ). VARS= ; hx=移動方向
;
c VAR ,
f VAR 0 =
	x hx + 0 < x hx + MX -- > || IF
		; 座標的に動けない
		1 左右移動_end GOTO
	ENDIF
	c ( x hx + y ). scrn @ -> =.
	AKI >= c BLOCK <= && IF
		; 移動先が空間／ハシゴ／金塊／土の時はそのまま移動できる
		mx . hx + =
	ELSE ; 岩移動
		; 岩移動はさらにその先も開いていなければならない
		( x hx +     y ). scrn @ -> STONE !=
		( x hx 2 * + y ). scrn @ -> AKI   != ||
		x hx 2 * + 0 < ||
		x hx 2 * + MX -- >
		|| IF
			1 左右移動_end GOTO ; 座標的に動けない時
		ENDIF
		( x hx     + y AKI   ) キャラクター表示.
		( x hx 2 * + y STONE ) キャラクター表示.
		hx 1 == IF ; 右移動
			x1 x  ++ =
			x2 x1 ++ =
			style MIGI =
		ELSE ; 左移動
			x2 x  -- =
			x1 x2 -- =
			style HIDARI =
		ENDIF
	ENDIF
	0
左右移動_end:
}
-2 ]N ; -3+1
RETURN

;******************************************************************

面セレクト:
[N
{
( lv ). VARS=
;
( lv1 lv2 c fend ). VARS
	lv1 lv =
	lv . 10 / 10 * =
	lv2 -1 = ; !=lv1
	REPEAT
		; １０面分表示
		lv map10.
		REPEAT
			lv2 lv1 != IF ; 選択中
				( lv1 1 ) lv_map1.
				lv2 lv1 =
			ENDIF
			fend 0 =
			c GETCH =.
			SWITCH
			'-' CASE ; -10面
				lv1 . 5 - = ; 下と合せて-10
			'8' CASE ; 上
				lv1 . 4 - = ; 下と合せて-5
			'4' CASE ; 左
				lv1 . -- =
				lv1 0 < IF lv1 . MMAX + = ENDIF
				PAGE GOTO ; 同じSWITCH内でのGOTOは自由
			
			'+' CASE ; +10面
				lv1 . 5 + = ; 下と合せて+10
			'2' CASE ; 下
				lv1 . 4 + = ; 下と合せて+5
			'6' CASE ; 右
				lv1 . ++ =
				lv1 MMAX >= IF lv1 . MMAX - = ENDIF
			    PAGE:
				lv1 lv < lv1 lv 10 + >= || IF ; ページが変る
					lv lv1 10 / 10 * =
					fend 1 =
				ENDIF
				BREAK
			SEND
			fend IF. BREAK
			lv1 lv2 != IF ( lv2 0 ) lv_map1. ENDIF
		c ESC == c CR == || UNTIL
	c ESC == c CR == || UNTIL
	c ESC == IF -1 ELSE lv1 ENDIF
}
0 ]N ; -1+1
RETURN

;******************************************************************

lv_map1:
; その面の表示位置を求め表示する
[N
{
( lv mode ). VARS=
;
( bx by lv0 ). VARS
	lv0 lv 10 \ = ; lv0 = 0〜9
	lv0 5 < IF ; 上段
		by 0 =
		bx MX 3 + lv0 * =
	ELSE ; 下段
		by MY 3 + =
		bx MX 3 + lv0 5 - * =
	ENDIF
	( bx by lv mode 100 * + ) map1.
}
-2 ]N
RETURN

;******************************************************************

map10:
; １０面分画面表示
[N
{
( lv ). VARS=
;
( by lt rt ). VARS
	CLS
	rt RTOP =
	lt LTOP =
	0 2 FOR. ; 縦２列
		by I? MY 3 + * =
		0 5 FOR. ; 横５個
			( I? MX 3 + * by lv ) map1.
			lv . ++ =.
			MMAX >= IF map10_end GOTO ENDIF ; 両ループ終了
		NEXT
	NEXT
    map10_end:
	rt RTOP=
	lt LTOP=
}
-1 ]N
RETURN

;******************************************************************

map1:
; １面分画面表示
[N
{
( bx by lv ). VARS=
;
frev VAR 0 =
( col i c ). VARS
	; フィールド表示
	lv 100 >= IF ; Slect中
		frev 8 =
		lv . 100 - =
	ENDIF
	( 0 ).     space @ '+' <-
	( MX ++ ). space @ '+' <-
	1 MX FOR
		( I? ). space @ '-' <-
	NEXT
	( MX 2 + ). space @ 0 <-
	
	3 frev + COLOR ,
	bx by         LOCATE space PRINTS
	bx by MY ++ + LOCATE space PRINTS
	1 MY ++ FOR.
		bx         by I? + LOCATE '|' PRINTC
		bx MX ++ + by I? + LOCATE '|' PRINTC
	NEXT
	( lv ). cflag @ -> IF 14 COLOR , ENDIF
	
	bx 3 + by MY + ++ LOCATE
	"Level:" PRINTS lv ++ 10 ' ' 2 PRINTNF
	
	; マップ表示
	i lv MX * MY * =
	0 MY FOR.
		bx ++ by I? + ++ LOCATE
		( i ). men @
		0 MX FOR.
			col 3 =
			. -> c <> =.
			SWITCH
			GOLD CASE ; 金塊
				col 6 =
				BREAK
			BLOCK CASE ; 土
				col 1 =
				BREAK
			STONE CASE ; 石
				col 2 =
				BREAK
			MAN CASE ; 人（基本形）
				col 7 =
				BREAK
			SEND
			@++
			i . ++ =
			; 表示
			col frev + COLOR ,
			( c ). smpc @ -> PRINTC
		NEXT
		, ; drop adrs
	NEXT
	3 COLOR ,
}
-3 ]N
RETURN

;******************************************************************

コメントクリア:
	13 COLOR
	67 10 LOCATE	"            " PRINTS
	67 11 LOCATE	"            " PRINTS
	COLOR ,
RETURN

;******************************************************************

残り人数表示:
[N
{
( m ). VARS=
	11 COLOR
	68 7 LOCATE	"Ｌｅｆｔ" PRINTS
	70 9 LOCATE
	1 m FOR
		'P' PRINTC
	NEXT
	COLOR ,
}
-1 ]N
RETURN

;******************************************************************

１面分表示:
[N
{
( lv ). VARS=
;
( c gd i ). VARS
mn SVAR ,
	; 画面初期化
	13 COLOR ,
	0 79 WX - FOR.
		( I? ). space @ ' ' <-
	NEXT
	( 79 WX - ). space @ 0 <-
	0 WY FOR.
		WX I? LOCATE
		space PRINTS
	NEXT
	0 WY LOCATE
	mn " [ 2468/+-=/Giveup/ESC ]" =. PRINTS
	mn STRLEN 79 FOR.
		SPC
	NEXT
	
	; レベル表示
	68 1 LOCATE
	( lv ). cflag @ -> IF 10 ELSE 11 ENDIF COLOR ,
	"Ｌｅｖｅｌ" PRINTS
	72 3 LOCATE lv ++ 10 ' ' 2 PRINTNF
	
	; フィールド表示＆人間位置設定＆金塊個数取得
	3 COLOR ,
	gd 0 =
	mx -1 =
	i 0 =
	0 MY FOR. ; y
		0 MX FOR. ; x
			c ( lv MX * MY * i + ). men @ -> =
			i . ++ =
			c GOLD == IF gd . ++ = ENDIF
			c MAN == IF
				mx I? =
				my J? =
			ENDIF
			( I? J? c ) キャラクター表示.
		NEXT
	NEXT
	mx -1 == IF gd 0 = ENDIF ; 人がいない
	gd
}
0 ]N ; -1 + 1
RETURN

;******************************************************************

キャラクター表示:
[N
{
( x y no ). VARS=	; no = キャラクター番号
;
( s1 s2 s3 ). SVARS
col VAR 3 =
frev VAR 0 =
	; 内部ストア
	no MAN <= IF
		( x y ). scrn @ no <-
	ENDIF
	
	; キャラクターセット
	no SWITCH
		AKI CASE ; 空間
			s1 "　　　" =
			s2 "　　　" =
			s3 "　　　" =
			BREAK
		HASIGO CASE ; ハシゴ
			s1 "┣━┫" =
			s2 "┣━┫" =
			s3 "┣━┫" =
			BREAK
		GOLD CASE ; 金塊
			s1 "┏━┓" =
			s2 "┃＄┃" =
			s3 "┗━┛" =
			col 6 =
			BREAK
		BLOCK CASE ; 土
			s1 "※※※" =
			s2 "※※※" =
			s3 "※※※" =
			col 1 =
			BREAK
		STONE CASE ; 岩
			s1 "／￣＼" =
			s2 "□　□" =
			s3 "＼＿／" =
			col 2 =
			BREAK
		KABE CASE ; 壁
			s1 "■■■" =
			s2 "■■■" =
			s3 "■■■" =
			BREAK
		MAN CASE ; 人（基本形）
			s1 "　Ｏ　" =
			s2 "（■）" =
			s3 "／　＼" =
			BREAK
		HMAN CASE ; 人（左）
			s1 "＼Ｏ　" =
			s2 "−■　" =
			s3 "＜　＼" =
			BREAK
		MMAN CASE ; 人（右）
			s1 "　Ｏ／" =
			s2 "　■−" =
			s3 "／　＞" =
			BREAK
		GMAN CASE ; 人（Give up）
			s1 "＼＠／" =
			s2 "　■　" =
			s3 "／　＼" =
			BREAK
	SEND
	; 表示
	x . 6 * = ; 6=strlen(s1,s2,s3)
	y . 3 * = ; s1,s2,s3
	col frev + COLOR ,
	x y     LOCATE	s1 PRINTS
	x y ++  LOCATE	s2 PRINTS
	x y 2 + LOCATE	s3 PRINTS
	3 COLOR ,
}
-3 ]N
RETURN

;******************************************************************
/* 汎用関数 */
;******************************************************************

センタリング表示:
[N
{
( mes ). SVARS=
( y ). VARS=
	6 COLOR
	80 2 / mes STRLEN 2 / - y LOCATE
	mes PRINTS
	COLOR ,
}
-2 ]N
RETURN

;******************************************************************

getch2:
; カーソル ON/OFF , キーボードバッファークリア付きキー入力
[N
	1 CURMODE ,
	KBCLR
	GETCH TOUPPER
	0 CURMODE ,
1 ]N
RETURN

;******************************************************************

CalcWait:
; ウエイト量自動算出
{
( tim tm count ). VARS
	"ウエイト計算中..." PRINTS
	; ０クロックチェック
	tm 0 CLOCK =
	REPEAT
		tim 0 CLOCK =.
	tm != UNTIL
	; カウント開始
	count 0 =
	REPEAT
		count . ++ =
		0 CLOCK
	tim - 8 >= UNTIL
	count ; 8msに必要なカウント数
}
RETURN

;****************************************************************

TWait:
; ウエイト
[N
{
( wt ). VARS=
	0 wt wtt * FOR.
		0 CLOCK ,
	NEXT
}
-1 ]N
RETURN

;****************************************************************

onbrk:
	"BREAKが押されました\n" PRINTS
	END

;****************************************************************
