;******************************************************************
; しずくデモ
;******************************************************************
; ここでは多くのバグが発見された。
; 簡単そうで、実はシステムをいじめたサンプル。

ONBRK onbreak	; CTRL-C/BREAKトラップ設定

; 画面定数
WX  var . 80 2 / = VLOCK
WY  var . 24 = VLOCK
MAX var	. 75 = VLOCK
LNG var . 5  = VLOCK	; 滴の最大長さ

; 内部キャラクター
WALL var . '#' = VLOCK	; 外壁
BALL var . 'o' = VLOCK	; 滴
TANA var . '=' = VLOCK	; 棚

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

;****************************************************************
; 変数＆ワークエリア

wtt VAR	,		; ウエイト
fmini VAR ,		; ミニモード

( dx dy ). VARS		; 移動方向
clng VAR ,		; 動作中ポインター

( LNG ). drpx ARY.W ,	; 移動ｘ座標バッファー
( LNG ). drpy ARY.W ,	; 移動ｙ座標バッファー

; 仮想ＶＲＡＭ
( WX WY ++ ). tvram ARY.B ,	; +1 for ミニ表示

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

{ ; メイン
( ts c ). VARS
	fmini ARGC 3 >= = ; 何か引数があったらミニモードになる
	
	0 RND , 	; 乱数初期化
	wtt CalcWait. = ; ウエイト算出(8ms)
	REPEAT
		InitScreen. ; 画面初期化
		0 CURMODE , ; カーソルオフ
		Cascades.   ; 滴移動
		1 CURMODE , ; カーソルオン
		IF. BREAK
		40 0 LOCATE
		"もう一度見ますか？ " PRINTS
		c 'Y' =
		ts 1 CLOCK =
		REPEAT ; ２０秒たったら自動的に再開する
			KBHIT IF
				c GETCH TOUPPER =
				BREAK
			ENDIF
		1 CLOCK	ts - 20 >= UNTIL
	c 'Y' != c CR != && UNTIL
}
END

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

InitScreen:
; 初期画面作成
	CLS
	fmini IF
		"   Cascades"
	ELSE
		"　　Ｃａｓｃａｄｅｓ"
	ENDIF
	PRINTS CRLF
	InitTVRAM.
	
	; 外枠作成
	1 WY -- FOR. ; 縦
		( 0 I? WALL ) PrintXY.
		( WX -- I? WALL ) PrintXY.
	NEXT
	0 WX FOR. ; 横
		( I? WY -- WALL ) PrintXY.
	NEXT
	
	; 棚作成
	{ ( x y ). VARS
	0 MAX FOR.
		x WX 2 - RND 1 + = ; 両端を除く
		y WY 3 - RND 2 + = ; 一番上／その次と最下行を除く
		0 4 FOR.
			x I? + WX -- >= IF. BREAK ; x-over
			( x I? + y ) Scrn. SP == IF
				( x I? + y TANA ) PrintXY.
			ENDIF
		NEXT
	NEXT
	}
RETURN

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

CheckDropPoint:
; [N
; 最上行が開いているかどうかを調べる
	1 ; 開いていないの印 
	  ; このように先にリターン値を積めるのもSTKの特徴かな
	1 WX -- FOR.
		( I? 1 ) Scrn. SP == IF
			, ; 先の1を捨てる
			0 ; 開いている
			BREAK
		ENDIF
	NEXT
; 1 ]N
RETURN

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

SetFirstPoint:
; スタートポイント設定（最上行）
; [N
{
x VAR ,
	x WX 2 - RND 1 + =
	WHILE
		( x 1 ) Scrn.
		SP == IF. BREAK
		x . ++ =
		x WX -- == IF
			x 1 =
		ENDIF
	WEND
	clng LNG -- =
	0 clng FOR.
		( I? ). drpx @ 0 <-
		( I? ). drpy @ 0 <-
		; 0=未記録の印
	NEXT
	( clng ). drpx @ x <-
	( clng ). drpy @ 1 <-
	dx 0 =
	dy 1 = ; 下へ
	x
}
; 1 ]N
RETURN

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

Cascades:
; 滴処理
[N
{
( x y c lt ). VARS
	lt LTOP =
	WHILE
		CheckDropPoint. IF. BREAK
		; 初期位置設定
		x SetFirstPoint. =
		y 1 =
		REPEAT
			c INKEY =. 
			ESC == c CR == || IF
				1
				CEND goto
			ENDIF
			; 移動＆表示
			( x y ) Drop.
			clng . EL. BREAK,
			. -- = ; clng--
			x ( clng ). drpx @ -> =
			y ( clng ). drpy @ -> =
		x 0 == y 0 == && UNTIL
	WEND
	; 最上行が開いていなかったら終わり
	0
CEND:
	lt LTOP= ; lstack 補正
}
1 ]N
RETURN

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

Drop:
; 移動＆表示
[N
{
( x y ). VARS=
( r l ). VARS
	WHILE
		; 表示
		( x y BALL ) PrintXY.
		wtt TWait. ; ウエイト
		
		; 下が開いている？
		( x y ++ ) Scrn. SP == IF
			; 無条件に下に落ちる
			dx 0 =
			dy 1 =
			x ( x y ) Move. y <> = = ; x=Move(x,&y);
			CONTINUE
		ENDIF
		
		; 下は開いていない
		; 移動先チェック
		( x dx + y dy + ) Scrn. SP == IF
			; 前回決めた方向で移動可能
			x ( x y ) Move. y <> = = ; x=Move(x,&y);
			CONTINUE
		ENDIF
		
		; 前回決めた方向の移動先に移動できない時
		dy 1 == IF ; 下に落ちるはずだった時
			; 左右チェック
			r ( x ++ y ) Scrn. SP == = ; 右
			l ( x -- y ) Scrn. SP == = ; 左
			
			; 動けるなら左右移動に変更
			dx 0 =
			r IF ; 右が開いている
				dx 1 =
			ENDIF
			l IF ; 左が開いている
				dx -1 =
				r IF ; 右も開いている
					; 左右どちらかを選ぶ
					2 RND 1 == IF
						dx 1 =
					ENDIF
				ENDIF
			ENDIF
			dx IF ; 動ける時
				dy 0 =
				x ( x y ) Move. y <> = = ; x=Move(x,&y);
				CONTINUE
			ENDIF
		ENDIF
		BREAK
	WEND
}
-2 ]N
RETURN

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

Move:
; 移動＆消し
[N
{
( x y ). VARS=
	( 0 ). drpy @ -> IF
		(
		( 0 ). drpx @ ->
		( 0 ). drpy @ ->
		SP
		) PrintXY. ; 前の場所を消す
	ENDIF
	x . dx + =
	y . dy + =
	clng 1 >= IF
		1 clng FOR
			; ここの記述はSTKならではなので注目
			; 普通なら何がなんだかわからないところ
			; drpx[i-1]=drpx[i];
			( I? ). drpx @	; drpx[i]計算
			. -> 		; c=drpx[i] : adrs(1) c(0)
			<>		; c(1) adrs(0)
			@--		; adrs-1 = [i-1]
			<>		; adrs-1(1) c(0)
			<-		; 代入
			; drpy[i-1]=drpy[i];
			( I? ). drpy @ . ->
			<> @-- <> <-
		NEXT
	ENDIF
	( clng ). drpx @ x <-
	( clng ). drpy @ y <-
	x y ; リターン値
}
0 ]N ; +2-2
RETURN

;****************************************************************
; 仮想ＶＲＡＭシステム
;****************************************************************

PrintXY:
; 文字表示
{
( x y c ). VARS=
cc VAR ,
	; 仮想ＶＲＡＭに出力
	( x y ). tvram @ c <- ; tvram[y][x]=c;
	fmini IF ; ミニ表示
		y 1 & IF ; 上と合成
			cc ( x y -- ). tvram @ -> =
		ELSE	 ; 下と合成
			cc c =
			c ( x y ++ ). tvram @ -> =
		ENDIF
		; 合成
		;   上        下
		cc SP != c SP != && IF c ':' = ENDIF
		cc SP != c SP == && IF c $27 = ENDIF ; $27='
		cc SP == c SP != && IF c '.' = ENDIF
		; cc==SP && c==SP -> c=SP
		x y 2 / ++ LOCATE
		c PRINTC
	ELSE
		; 座標変換
		x 2 * y LOCATE
		
		; キャラクター変換
		c SWITCH
			SP   CASE '　' PRINTC BREAK ; 消す
			BALL CASE '●' PRINTC BREAK ; ●:しずく
			WALL CASE '■' PRINTC BREAK ; ■:外壁
			TANA CASE '□' PRINTC BREAK ; □:棚
		SEND
	ENDIF
}
RETURN

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

Scrn:
; 仮想テキストＶＲＡＭを読み出す
{
( x y ). VARS=
	( x y ). tvram @ ->
}
RETURN

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

InitTVRAM:
; 仮想テキストＶＲＡＭ初期化
	0 WY FOR.
		0 WX FOR.
			( I? J? ). tvram @ SP <-
		NEXT
	NEXT
RETURN

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

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

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

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

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

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

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