;KANI Lispで特有なClassに似た連想リストについて
;解説します．

;まずは必要なモジュールを読み込みます．
(load "phbody.lsp")

;まず，ほかのLISP環境ではあまり見られないとおもわれる
;with関数について解説します．

(def lst '((a 23) (b 34)))

(with lst
	(def a (+ 23 a))
	(def b (+ a b))
)

lst

;これを実行すると
;> (def lst '((a 23) (b 34)))
;lst
;
;> (with lst
;	(def a (+ 23 a))
;	(def b (+ a b))
;)
;b
;
;> lst
;((a 46) (b 80))
;
;というような結果が得られます．
;with関数はシンボルをキーとする連想配列をもつシンボルを第1引数と
;して受け取りその連想配列の内容をキーのシンボルに対応した
;ローカル変数に格納し，第2引数以降の引数を評価します．
;そのあとローカル変数の変更を連想配列に反映し，
;第一引数のシンボルに代入します．
;lambdaを持つリストの場合はメンバ関数のように振舞います．

(def lst
	'(
		(a 23)
		(b 34)
		(func 
				(lambda () 
					(def b (+ b a))
					(+ (* a b) a)
				)
		)
	)
)

(with lst
	(func)
)

lst

;これを実行すると
;このような結果が得られます．
;> (def lst
;	'(
;		(a 23)
;		(b 34)
;		(func 
;				(lambda () 
;					(def b (+ b a))
;					(+ (* a b) a)
;				)
;		)
;	)
;)
;lst
;
;> (with lst
;	(func)
;)
;1334
;
;> lst
;((a 23) (b 57) (func (lambda nil (def 'b (+ b a)) (+ (* a b) a))))
;

;・withの互換性について
;Emacs LispなどDynamic ScopeのLISPならばemacswith.lspにあるような形で
;ほぼ同じ動作の物が作れます．
;lambdaが変数に代入されているときはEmacs Lispを含め多くのLISPの処理系では
;funcallを呼ぶ必要があるのでメンバ関数のようなものは次のように書きます．
;(with lst
;	(funcall func)
;)
;
;・withの実行速度
;withでは第2引数以降を評価する前に
;連想リストの内容をすべてローカル変数に代入します．
;そのため何度もメンバーにアクセスする場合は
;Hashなどで毎回メンバーの探索をおこなう手法よりも
;高速に実行されるものと思われます．
;しかし，メンバーにアクセスする回数が少ない場合は
;速度が低下する場合があります．

;・連想リストの継承
;まず基本となるクラスを用意します
;このクラスは抽象的な"歩く物体"とします

(def ClassA
	'(
		(Init	;コンストラクタ
			'(lambda ()
				nil
			)
		)
		(Walk
			'(lambda (v)
				(print "歩く速度")
				(print v)
			)
		)
		(GoAndBack
			'(lambda ()
				(print "一歩進んで二歩下がる")
				(Walk 1)
				(Walk -1)
				(Walk -1)
			)
		)
	)
)

(def InstanceA (PhClass_Create ClassA))

(with InstanceA (GoAndBack))

;これを実行すると次のように出力されます．
;"一歩進んで二歩下がる"
;"歩く速度"
;1
;"歩く速度"
;-1
;"歩く速度"
;-1
;nil
;
;この連想リストの基本構造を継承して新たな動作を加えた
;連想リストを作るには次のようにします

(def ClassB
	(PhClass_Inherit 
		ClassA			;継承もとの連想リスト
		'(
			(GoStrate
				'(lambda ()
					(print "直進")
					(Walk 2)
					(Walk 2)
				)
			)
		)
	)
)

(def InstanceB (PhClass_Create ClassB))

(with InstanceB (GoStrate))

;実行結果はこのようになります
;> (with InstanceB (GoStrate))
;"直進"
;"歩く速度"
;2
;"歩く速度"
;2
;nil
;

;この継承をおこなう際に同じ名前の関数が存在すると
;その関数の動作が新しい関数の動作で上書きされます
;次にWalkをオーバーライドして動作内容を変更してみます．
;

(def ClassC
	(PhClass_Inherit 
		ClassA			;継承もとの連想リスト
		'(
			(Walk		;オーバーライドする
				'(lambda (v)
					(if (> v 0)
						(print "↑")
						(print "↓")
					)
				)
			)
		)
	)
)

(def InstanceC (PhClass_Create ClassC))

(with InstanceC (GoAndBack))

;> (with InstanceC (GoAndBack))
;"一歩進んで二歩下がる"
;"↑"
;"↓"
;"↓"
;nil
;
;ここでは単に表示の仕方を変えただけですが
;物体の動作内容を書くうえで便利な場合があります．
;たとえば地上を移動する歩行ロボットと車があったとします．
;これらの動作，たとえば迷路を抜けるときの移動の手順や，
;ユーザが直接操作を与える場合
;ロボットの細かい動作まで直接記述してしまうとロボットと車で
;別々の動作を記述することになってしまいます．
;これらを単に地上を移動するものとして抽象化して考えて見ます．
;単に地上を移動するもの共通の動作としてはWalkとTurnなどがあるものとします．
;そうすると，歩行ロボットと車それぞれにおいてWalkやTurnなどの関数をオーバーライドすれば
;WalkやTurnなどを使って大まかな行動を記述するだけで
;ロボットにも車にも共通のプログラムを書くことができます．


;上書きされる関数や変数を呼ぶには
;inheritedを使用します

(def ClassC
	(PhClass_Inherit 
		ClassA			;継承もとの連想リスト
		'(
			(Walk		;オーバーライドする
				'(lambda (v)
					(inherited v)		;隠された関数を呼ぶ
					(if (> v 0)
						(print "↑")
						(print "↓")
					)
				)
			)
		)
	)
)

(def InstanceC (PhClass_Create ClassC))

(with InstanceC (GoAndBack))

;
;次にphbody.lspで宣言されているPhBodyClassをもとに
;物体に連想リストを割り当てる例を示します．
;

;床の形状ファイルの読み込み
(def floor (LoadXPhBody "road.x"))
(PhSetUpForFixedObject floor)
(SetXPhBodyMat floor '((1 0 0) (0 1 0) (0 0 1) (0 -5 0)))
(SetXPhVertexTransformMat floor '((5 0 0) (0 5 0) (0 0 5) (0 0 0)))
(XPhBodySetVisualMaterial floor '((1 1 1 1) (0.5 0.5 0.5 0.5) (0 0 0 0) 0))

;カメラなどを用意
(load "RotationalCamera.lsp")
(load "MousePicker.lsp")
;静止摩擦係数の設定
(SetCollisionStaticFrictionCoeff 0.2)
;動摩擦係数の設定
(SetCollisionDynamicFrictionCoeff 0.1)

;phbody.lspで宣言されているPhBodyClassを継承して
;クラスを作成します

(def TestClass
	(PhClass_Inherit PhBodyClass
		'(
			(body nil)		;物体を保持する変数
			(DebugMode t)	;デバッグ出力をおこなう
			(Init			;コンストラクタ
				'(lambda ()
					(inherited)		;継承もとの値を呼びます
									;この場合はPhBodyClassのInitを呼びます
				)
			)

			(MakeBody
				'(lambda ()
					(LoadXPhBody "lbox.x")	;物体を読み込みます
				)
			)

			(count 0)	;繰り返し回数などを保持するカウンター

			(WalkTurn
				'(lambda (v w)
					(let*
						(
							(Mat (GetXPhBodyMat this))
							(za (select Mat 2))
						)
						;(AddDebugString (PrintString za))
						(XPhBodyAddLinearForce this (VMul za (* 10 (- v (VDot (XPhBodyGetVelocity this) za)))))
							;目的速度に近づく力を与える
						(XPhBodyAddAngularForce this (VMul '(0 1 0) (* 10 (- w (VDot (XPhBodyGetAVelocity this) '(0 1 0))))))
							;目的角速度に近づくトルクを与える
					)
				)
			)

			(States		;状態を設定する
				(WalkTurn 1.0 0.0)	;前進する
			)

		)
	)
)

(def Walker 
		(PhBodyClass_MakeBody TestClass)
				;MakeBodyを呼んでインスタンスを作成し
				;クラスに物体を割り当てた上で物体オブジェクトを返す
)

;Statesに与えた命令を実行しつづけるので
;箱は単純に前に進みます．
;
;メンバー関数のSetStateを呼ぶことで
;ステップごとに実行する命令を設定することができます．
;ために床の端まで来たら後ろに戻って方向転換して
;すすむような動作の例を示します．


(def TestClass2
	(PhClass_Inherit TestClass
		'(
			(BottomCheck
				'(lambda ()
					(let*
						(
							(Mat (GetXPhBodyMat this))
							(za (select Mat 2))
							(la (select Mat 3))
							(sp (VAdd la (VMul za 2)))
							(ep (VAdd sp '(0 -2 0)))
						)

						(XPhDrawLine '(255 0 0 255) sp ep)
						
						;線と物体の交差判定
						(XPhRayPickNCBody this '(0 -2 0) sp)
					)
				)
			)

			(GoForward
				'(lambda ()
					(if (BottomCheck)
						(WalkTurn 1.0 0.0)	;前進する
						(progn	;複文
							(SetState '(GoBackward))	;後ろに下がる状態へ遷移
							(def count 20)				;後ろに下がるステップ数
						)
					)
				)
			)

			(GoBackward
				'(lambda ()
					(if (> count 0)
						(progn	;複文
							(WalkTurn -1.0 0.0)		;後ろに下がる
							(def count (- count 1))
						)
						(progn	;複文
							(SetState '(Rotate))	;旋回状態へ遷移
							(def count 20)			;後ろに下がるステップ数
						)
					)
				)
			)

			(Rotate
				'(lambda ()
					(if (> count 0)
						(progn	;複文
							(WalkTurn 0.0 1.0)		;旋回
							(def count (- count 1))
						)
						(SetState '(GoForward))	;全身状態へ遷移
					)
				)
			)

			(States		;初期状態を設定する
				(GoForward)
			)
		)
	)
)

(def Walker 
		(PhBodyClass_MakeBody TestClass2)
				;MakeBodyを呼んでインスタンスを作成し
				;クラスに物体を割り当てた上で物体オブジェクトを返す
)

;赤い線は床があるかどうかを調べるために
;交差判定をおこなう線をあらわしている．
;

;物体の動作の記述をおこなううえでは
;・4秒間前進
;     ↓
;・5秒間旋回
;     ↓
;・4秒間後退
;     ↓
;・3秒間停止
;     ↓
;・繰り返し
;のようにシーケンスを書き下すのも
;手軽な書き方なので便利です．
;そのような書き方をする場合はPhBodyClassでは
;次のように書きます

(def TestClass3
	(PhClass_Inherit TestClass2
		'(
			(States		;シーケンスを設定する
				(
					(Start '(TimerNext 4.0 '(WalkTurn 1.0 0.0)))	;4秒間前進
					(nil '(TimerNext 5.0 '(WalkTurn 0.0 1.0)))		;5秒間旋回
					(nil '(TimerNext 4.0 '(WalkTurn -1.0 0.0)))		;4秒間後退
					(nil '(TimerNext 3.0 '(WalkTurn 0.0 0.0)))		;3秒間停止
					(nil '(GoLabel 'Start))		;繰り返し
				)
			)
		)
	)
)

(def Walker 
		(PhBodyClass_MakeBody TestClass3)
)

(XPhBodyGetFuncResult Walker)

;シーケンスの記述の仕方ですが
;(ラベル 条件付命令)というような形となっております
;最初の命令の場合は
;(Start '(TimerNext 4.0 '(WalkTurn 1.0 0.0)))	;4秒間前進
;Startがラベルで'(TimerNext 4.0 '(WalkTurn 1.0 0.0))が条件付命令となっております．
;条件付命令の返す値がtのときは次の命令へ移行します．
;TimerNextは
;(TimerNext 時間 命令)
;という形で与えられる関数で
;時間は命令を実行し続ける時間を表します．

;さらに状態遷移を付け加えることもできます．

(def TestClass4
	(PhClass_Inherit TestClass2
		'(
			(State0
				(	;状態0
					(nil '(TimerNext 4.0 '(WalkTurn 1.0 0.0)))	;4秒間前進
					(nil '(SetState State1))		;状態1に遷移
				)
			)

			(State1
				(
					(nil '(TimerNext 4.0 '(WalkTurn -1.0 0.0)))		;4秒間後退
					(nil '(SetState State0))
				)
			)

			(States		;初期のスケジュールを設定する
				(
					(Start '(TimerNext 1.0 '(WalkTurn 1.0 0.0)))	;1秒間前進
					(nil '(TimerNext 2.0 '(WalkTurn 0.0 1.0)))		;2秒間旋回
					(nil '(TimerNext 1.0 '(WalkTurn -1.0 0.0)))		;1秒間後退
					(nil '(TimerNext 1.0 '(WalkTurn 0.0 0.0)))		;1秒間停止
					(nil '(SetState State0))
				)
			)
		)
	)
)

(def Walker 
		(PhBodyClass_MakeBody TestClass4)
)

(XPhBodyGetFuncResult Walker)