二重振り子RK4シミュonHSP(修正版2)

修正版1のRK4で大ポカをやらかしていました…。
(全エネルギーが徐々に減っていたのは誤差なんかじゃなかった…。)
多分これで最後の修正になります。

修正版1のRK4で大ポカをやらかしていました…。
(全エネルギーが徐々に減っていたのは誤差なんかじゃなかった…。)
多分これで最後の修正になります。

#include "hsp3dish.as"
#packopt name "DPRK4"

/* モジュール認識 */
modDetect@mod_simuCfg
modDetect@mod_simu

/* 定数宣言 */
//#define hsproom
#define wsx	640 //("windowSizex") ウィンドウxサイズ
#define wsy	640
#packopt xsize wsx
#packopt ysize wsy
#define frmIntvl	16	//[ms] ("frameInterval") フレーム間隔
#define slfreq		2	//[ms] ("simulationLoopFrequency") シミュレーションループ周期
#define mtr2px	100.0	//[px/meter] ("meterToPixel") メートル→ピクセル 変換係数
#const Oxw	wsx/2	//[px] ("OriginxOnWindow") 物理系原点のウィンドウ上でのx座標
#const Oyw	wsy/2	//[px]
#define dt	0.01	//[s] タイムステップ
#const double hdt dt/2	//[s] ("half dt") dt/2
#define g	9.8	//[m/s^2]
#define σ	1.0	//[kg/m^2] 錘の面密度
#define mmin	0.1	//[kg] 質量の下限
#define mmax	25.0	//[kg] 〃上限

/* 変数初期化 */
	/* エイリアス */
	#define m1	m(0)
	#define m2	m(1)
	#define r1	r(0)
	#define r2	r(1)
	#define l1	l(0)
	#define l2	l(1)
	#define θ1	θ(0)
	#define θ2	θ(1)
	#define r1w	rw(0)
	#define r2w	rw(1)
	#define l1w	lw(0)
	#define l2w	lw(1)
	#define x1	x
	#define x2	x(1)
	#define y1	y
	#define y2	y(1)
	/* 物理系 */
	m = 1.5,1.0	//[kg] m1,m2
	r = sqrt(m1/σ/4/m_pi),sqrt(m2/σ/4/m_pi) //[m] おもり1,2の半径
	l = 1.5,1.0	//[m] l1,l2
	θ = deg2rad(45),deg2rad(90)	//[rad] θ1,θ2
	x = l1*sin(θ1),x+l2*sin(θ2)
	y = l1*cos(θ1),y+l2*cos(θ2)
	/* システム */
	ddim PRESET,5,6

/* 起動 */
*boot
	title "二重振り子シミュレーター"
	exist "save/preset.dat" : if strsize = -1 : initPreset	//プリセットデータが無ければ初期化する
	goto *boot@mod_simuCfg

#module mod_simuCfg	/* シミュレーション設定 */
	#define wsx			wsx@
	#define wsy			wsy@
	#define frmIntvl	frmIntvl@*3
	#define mtr2px		mtr2px@
	#define Oxw			Oxw@
	#define Oyw			Oyw@
	//#define mmin	mmin@
	//#define mmax	mmax@
	#define m		m@
	#define m1		m@
	#define m2		m@(1)
	#define l1		l@
	#define l2		l@(1)
	#define θ1		θ@
	#define θ2		θ@(1)
	#define x1		x@
	#define x2		x@(1)
	#define y1		y@
	#define y2		y@(1)
	#define r		r@
	#define r1		r@
	#define r2		r@(1)
	#define rw		rw@
	#define r1w		rw@
	#define r2w		rw@(1)
	#define l1w		lw@
	#define l2w		lw@(1)
	#define x1w		xw@
	#define x2w		xw@(1)
	#define y1w		yw@
	#define y2w		yw@(1)
	
	#define fontsize	16
	#define sxMS	300	//[px] ("sizexOfMassSlider") 質量調節スライダ(MS)の長さ
	#define syMS	4	//[px] 〃太さ
	#define sxMSK	8	//[px] ("sizexOfMassSliderKnob") MSつまみ(MSK)の横幅
	#define syMSK	14	//[ps] 〃高さ
	#deffunc local modDetect
		return
		
	*boot
		LBTNDWN = 0	//汎用変数初期化
		initUI
		usrRqstStat = 0	//("userRequestStatus") ユーザーからの要求の状態。(0,1,2,3) = (通常,プリセットロード要求,プリセット保存要求,シミュレーション開始要求)
		
	*main	//メインループ
		repeat
			handleMassSlds	//MS管理
			handlePndlmDrg	//おもりドラッグ管理
			reflesh	//画面更新
			if usrRqstStat : break	//ユーザーから新たなアクションの要求があるなら
			await frmIntvl
		loop
		switch usrRqstStat
			case 1
				loadPreset
				initUI
				goto *boot
			case 2
				savePreset
				initUI
				goto *boot
				swbreak
			case 3
				goto *boot@mod_simu
				swbreak
			default
				fatalError
		swend
		stop
	
	*btnIntrpt	/* ボタン割り込みへの対応 */
		usrRqstStat = 1+stat
		return
	
	#deffunc local initUI	/* UI初期化 */
		cls
		font msgothic,fontsize
		/* おもり */
			r1w = r1*mtr2px : r2w = r2*mtr2px	//[px] r1,r2の、ウィンドウ上での長さ
			l1w = l1*mtr2px : l2w = l2*mtr2px	//[px]
			x1w = Oxw+x1*mtr2px : x2w = Oxw+x2*mtr2px	//x1,x2の、ウィンドウ上での位置
			y1w = Oyw+y1*mtr2px : y2w = Oyw+y2*mtr2px
		/* MS */
			MSV = m2MSV(m1),m2MSV(m2)	;MSの値。0.0~1.0。要素0,1はm1,m2のスライダに対応。
			pxMSK = 140-sxMSK/2,pxMSK	;[px] MSつまみの左上x座標。要素0,1はm1,m2のスライダに対応。
			pyMSK = wsy-5-fontsize*2+8+syMS/2-syMSK/2,pyMSK+fontsize	;〃y
		/* 各種ボタン */
			#define sxBtn	180	//("sizexOfButton") ボタンの横幅
			#define syBtn	20
			objsize sxBtn,syBtn
			pos wsx-5-sxBtn,wsy-5-syBtn*3-2*2 : button gosub "プリセット読込",*btnIntrpt
			pos wsx-5-sxBtn,wsy-5-syBtn*2-2 : button gosub "プリセット保存",*btnIntrpt
			pos wsx-5-sxBtn,wsy-5-syBtn : button gosub "シミュレーション開始",*btnIntrpt
		return
	
	#deffunc local handleMassSlds	/* MS管理ルーチン */
		getkey LBTNDWN,1 : if LBTNDWN = 0 : return
		repeat 2	/* MS1,2 */
			if (pxMSK(cnt) <= mousex)&(mousex <= pxMSK(cnt)+sxMSK)&(pyMSK(cnt) <= mousey)&(mousey <= pyMSK(cnt)+syMSK) {	//カーソルがつまみに重なっているなら
				xofst = pxMSK(cnt)-mousex : yofst = pyMSK(cnt)-mousey	//マウスカーソルに対するつまみの相対位置
				lastmx = mousex	//以前のマウスカーソルのx座標
				cnt0 = cnt
				repeat
					getkey LBTNDWN,1 : if LBTNDWN = 0 : break
					if mousex != lastmx {	//マウスカーソルが横に動いたら
						lastmx = mousex
						pxMSK(cnt0) = limit(mousex+xofst, msv2pxMSK(0),msv2pxMSK(1))	//つまみ位置決定
						MSV(cnt0) = pxMSK2msv(pxMSK(cnt0))	//MS値計算
						m(cnt0) = MSV2m(MSV(cnt0))	//質量計算
						r(cnt0) = m2r(m(cnt0)) : rw(cnt0) = r(cnt0)*mtr2px	//半径計算
						reflesh
					}
					await frmIntvl
				loop
			}
		loop
		return
	
	#deffunc local handlePndlmDrg	/* おもりドラッグ管理 */
		getkey LBTNDWN,1 : if LBTNDWN = 0 : return
		/* おもり2 */
			if powf(x2w-mousex,2)+powf(y2w-mousey,2) <= powf(r2w,2) {
				xmofst = x2w-mousex : ymofst = y2w-mousey
				lastmx = mousex : lastmy = mousey
				repeat
					getkey LBTNDWN,1 : if LBTNDWN = 0 : break
					if (mousex != lastmx)|(mousey != lastmy) {
						lastmx = mousex : lastmy = mousey
						x2w = mousex+xmofst : y2w = mousey+ymofst
						calcPndlmPosFromUI
						reflesh	//画面更新
					}
					await frmIntvl
				loop
			}
		/* おもり1 */
			if powf(x1w-mousex,2)+powf(y1w-mousey,2) <= powf(r1w,2) {	//マウスカーソルがおもりに重なっているなら
				xmofst = x1w-mousex : ymofst = y1w-mousey	//マウスカーソルに対するおもりの中心の相対位置
				xRelPw = x2w-x1w : yRelPw = y2w-y1w	//[px] おもり1に対する2の相対位置
				lastmx = mousex : lastmy = mousey	//以前のマウスカーソルの位置
				repeat
					getkey LBTNDWN,1 : if LBTNDWN = 0 : break
					if (mousex != lastmx)|(mousey != lastmy) {	//マウスカーソルが動いたら
						lastmx = mousex : lastmy = mousey
						x1w = mousex+xmofst : y1w = mousey+ymofst
						x2w = x1w+xRelPw : y2w = y1w+yRelPw
						calcPndlmPosFromUI
						reflesh	//画面更新
					}
					await frmIntvl
				loop
			}
		return
	
	#deffunc local calcPndlmPosFromUI	/* ウィンドウ上でのおもりの位置からその他の位置情報をを計算 */
		x1 = double(x1w-Oxw)/mtr2px : y1 = double(y1w-Oyw)/mtr2px
		l1 = sqrt(x1*x1+y1*y1) : l1w = l1*mtr2px
		θ1 = atan(x1,y1)
		x2 = x1+double(x2w-x1w)/mtr2px : y2 = y1+double(y2w-y1w)/mtr2px
		l2 = sqrt(powf(x2-x1,2)+powf(y2-y1,2)) : l2w = l2*mtr2px
		θ2 = atan(x2-x1,y2-y1)
		return
	
	#deffunc local reflesh /* 再描画 */
		redraw 0
			color : boxf
			drawCdntAx	//座標軸
			drawPndlms	//振り子
			drawInfos	//各種情報
			drawMassSlds	//MS
		redraw 1
		return
	
	#deffunc local drawMassSlds /* MS描画*/
		repeat 2
			ytmp = wsy-5-fontsize*(2-cnt)+8
			color 100,100,100
			boxf 140,ytmp, 140+sxMS,ytmp+syMS
			pxMSK(cnt) = msv2pxMSK(MSV(cnt))
			color 200,150,100
			boxf pxMSK(cnt),pyMSK(cnt), pxMSK(cnt)+sxMSK,pyMSK(cnt)+syMSK
		loop
		return
#global

#module mod_simuCfg_2
	//#define mtr2px	mtr2px@
	//#define Oxw		Oxw@
	//#define Oyw		Oyw@
	#define mmin	mmin@
	#define mmax	mmax@
	//#define θ1		θ@
	//#define θ2		θ@(1)
	//#define l1w		lw@
	//#define l2w		lw@(1)
	
	#define sxMS	sxMS@mod_simuCfg	//[px] ("sizexOfMassSlider") 質量調節スライダ(MS)の長さ
	#define syMS	syMS@mod_simuCfg	//[px] 〃太さ
	#define sxMSK	sxMSK@mod_simuCfg	//[px] ("sizexOfMassSliderKnob") MSつまみ(MSK)の横幅
	#define syMSK	syMSK@mod_simuCfg	//[ps] 〃高さ
	
	#defcfunc m2MSV double m	//質量→MS値
		return (m-mmin)/(mmax-mmin)
	
	#defcfunc MSV2m double msv	//MS値→質量
		return mmin+msv*(mmax-mmin)
	
	#defcfunc msv2pxMSK double msv	//MS値→つまみの左上x座標
		return 140+msv*sxMS-sxMSK/2
	
	#defcfunc pxMSK2msv	double pxMSK//MSつまみの左上座標→MS値
		return double(pxMSK+sxMSK/2-140)/sxMS
#global

#module mod_commonCalc
	#define σ	σ@
	
	#defcfunc m2r double m	//質量→半径
		return sqrt(m/σ/4/m_pi)
#global

#module mod_simu
	#define wsx			wsx@
	#define wsy			wsy@
	#define slfreq		slfreq@
	#define frmIntvl	frmIntvl@
	#define mtr2px		mtr2px@
	#define Oxw			Oxw@
	#define Oyw			Oyw@
	#define dt		dt@
	#define hdt		hdt@
	#define g		g@
	#define m1		m@
	#define m2		m@(1)
	#define l1		l@
	#define l2		l@(1)
	#define θ1		θ@
	#define θ2		θ@(1)
	#define x1		x@
	#define x2		x@(1)
	#define y1		y@
	#define y2		y@(1)
	
	#define fontsize	16
	#define numPtTrack		100		//("numberOfPointsOfTrack") おもり2軌跡点の記録数
	#define TrkSmplngIntvl	dt*2	//[s] ("TrackSamplingInterval") 軌跡サンプリング間隔
	
	#deffunc local modDetect
		return
	
	*boot
		initUI
		usrRqstStat = 0	//("userRequestStatus") ユーザーからの要求の状態。(0,1) = (通常,シミュレーション終了要求)
		simuStat = 1	//("simulationStatus") シミュレーションの状態。(0,1) = (停止,実行)
		η = (m1+m2)/m2
		ω1 = 0.0
		ω2 = 0.0
		x1 = l1*sin(θ1) : y1 = l1*cos(θ1)
		x2 = x1+l2*sin(θ2) : y2 = y1+l2*cos(θ2)
	
		/* おもり2の軌跡点 */
		/*
			おもり2の軌跡点は直近 numPtTRACK 個分を TRACK [numPtTRACK,2] 配列記録する。
			フォーマットはリングバッファと同じ要領。frntTRACK に記録される位置を先頭とし、そこから numPtTRACK 個分描画する。
			古い順に詰まっている。要素 (*,0),(*,1) はそれぞれ然るべき番号の軌跡点のx,y座標。
		*/
		ddim TRACK,numPtTrack,2
		repeat numPtTrack : TRACK(cnt,0) = x2 : TRACK(cnt,1) = y2 : loop
		frntTRACK = 0
		
	*main
		etls = 0.0	//[s] ("elapsedTimeFromLastStep") 前回ステップ計算からの経過時間
		etlts = 0.0 //[s] ("elapsedTimeFromLastTrackSampling") 前回軌跡サンプリングからの経過時間
		etlf = 0.0	//[ms] ("elapsedTimeFromLastFrame") 前回画面更新からの経過時間
		repeat
			if etls >= dt : step : etls = -0.001*slfreq							//ステップ計算
			if etlts >= TrkSmplngIntvl : handleTrack : etlts = -0.001*slfreq	//軌跡サンプリング
			if etlf >= frmIntvl : reflesh : etlf = -slfreq						//画面更新
			if usrRqstStat : break
			await slfreq
			if simuStat {
				etls += 0.001*slfreq
				etlts += 0.001*slfreq
			}
			etlf += slfreq
		loop
		goto *boot@mod_simuCfg
	
	*btnIntrrpt	/* ボタン割り込みへの対応 */
		switch stat
			case 0
				simuStat = 0
				objenable 0,0 : objenable 1,1
				swbreak
			case 1
				simuStat = 1
				objenable 0,1 : objenable 1,0
				swbreak
			case 2
				usrRqstStat = 1
		swend
		return
	
	#deffunc local initUI	/* UI初期化 */
		cls
		font msgothic,fontsize
		/* 各種ボタン */
		#define sxBtn	180
		#define syBtn	20
		objsize sxBtn,syBtn
		pos wsx-sxBtn-5,wsy-5-syBtn*3-2*2 : button gosub "停止",*btnIntrrpt
		pos wsx-sxBtn-5,wsy-5-syBtn*2-2 : button gosub "再開",*btnIntrrpt : objenable 1,0
		pos wsx-sxBtn-5,wsy-5-syBtn : button gosub "シミュレーション終了",*btnIntrrpt
		return
	
	#deffunc local step	/* dt後の状態の計算 */
		ξn = θ1,θ2,ω1,ω2 : k1 = f1(ξn),f2(ξn),f3(ξn),f4(ξn)
		ξn2 = ξn+hdt*k1, ξn(1)+hdt*k1(1), ξn(2)+hdt*k1(2), ξn(3)+hdt*k1(3) : k2 = f1(ξn2),f2(ξn2),f3(ξn2),f4(ξn2)
		ξn3 = ξn+hdt*k2, ξn(1)+hdt*k2(1), ξn(2)+hdt*k2(2), ξn(3)+hdt*k2(3) : k3 = f1(ξn3),f2(ξn3),f3(ξn3),f4(ξn3)
		ξn4 = ξn+dt*k3, ξn(1)+dt*k3(1), ξn(2)+dt*k3(2), ξn(3)+dt*k3(3) : k4 = f1(ξn4),f2(ξn4),f3(ξn4),f4(ξn4)
		θ1 += dt/6*(k1 + 2.0*k2 + 2.0*k3 + k4)
		θ2 += dt/6*(k1(1) + 2.0*k2(1) + 2.0*k3(1) + k4(1))
		ω1 += dt/6*(k1(2) + 2.0*k2(2) + 2.0*k3(2) + k4(2))
		ω2 += dt/6*(k1(3) + 2.0*k2(3) + 2.0*k3(3) + k4(3))
		x1 = l1*sin(θ1) : y1 = l1*cos(θ1)
		x2 = x1+l2*sin(θ2) : y2 = y1+l2*cos(θ2)
		return
	
	#deffunc local reflesh	/* 画面更新 */
		redraw 0
			color : boxf
			drawCdntAx	//座標軸
			drawPndlms	//振り子
			drawTrack	//軌跡
			drawInfos : drawIndo2	//各種情報
		redraw 1
		return
	
	#deffunc local drawIndo2	/* 各種情報の表示 */
		color 200,200,200
		U = calcU() : K = calcK() : E = U+K
		pos 5,wsy-5-fontsize*9 : mes "U = "+strf("%6.2f", U)+" [J]"
		pos 5,wsy-5-fontsize*8 : mes "K = "+strf("%6.2f", K)+" [J]"
		pos 5,wsy-5-fontsize*7 : mes "E = "+strf("%6.2f", E)+" [J]"
		return
	
	#deffunc local handleTrack	/* おもり2の軌跡の管理 */
		TRACK(frntTRACK,0) = x2 : TRACK(frntTRACK,1) = y2
		if frntTRACK = numPtTRACK-1 : frntTRACK = 0 : else : frntTRACK ++
		return
	
	#deffunc local drawTrack	/* おもり2の軌跡の描画 */
		i = frntTRACK
		repeat numPtTrack
			xtmp = Oxw+TRACK(i,0)*mtr2px-3,xtmp+6,xtmp+6,xtmp
			ytmp = Oyw+TRACK(i,1)*mtr2px-3,ytmp,ytmp+6,ytmp+6
			gmode 3, , ,256*cnt/numPtTRACK
			color 50,100,255 : gsquare -1,xtmp,ytmp
			if i = numPtTRACK-1 : i = 0 : else : i ++
		loop
		return
	
	#defcfunc local calcU	/* 全位置エネルギーの計算 */
		return -(m1+m2)*g*l1*cos(θ1) - m2*g*l2*cos(θ2)
	
	#defcfunc local calcK	/* 全運動エネルギーの計算 */
		return 0.5*(m1+m2)*l1*l1*ω1*ω1 + 0.5*m2*l2*l2*ω2*ω2 + m2*l1*l2*ω1*ω2*cos(θ1-θ2)
#global

#module mod_simu_2
	#define dt		dt@
	#define hdt		hdt@
	#define g		g@
	#define l1		l@
	#define l2		l@(1)
	#define η		η@mod_simu
	
	#defcfunc f1 array ξ
		return ξ(2)
	
	#defcfunc f2 array ξ
		return ξ(3)
	
	#defcfunc f3 array ξ
		θ1 = ξ : θ2 = ξ(1) : ω1 = ξ(2) : ω2 = ξ(3)
		φ = θ1-θ2 : cosφ = cos(φ)
		return (g*(cosφ*sin(θ2)-η*sin(θ1))-(l1*ω1*ω1*cosφ+l2*ω2*ω2)*sin(φ))/l1/(η-cosφ*cosφ)
	
	#defcfunc f4 array ξ
		θ1 = ξ : θ2 = ξ(1) : ω1 = ξ(2) : ω2 = ξ(3)
		φ = θ1-θ2 : cosφ = cos(φ)
		return (g*η*(cosφ*sin(θ1)-sin(θ2))+(η*l1*ω1*ω1+l2*ω2*ω2*cosφ)*sin(φ))/l2/(η-cosφ*cosφ)
#global

#module mod_commonDraw
	#define wsx	wsx@
	#define wsy	wsy@
	#define Oxw	Oxw@
	#define Oyw	Oyw@
	#define m1		m@
	#define m2		m@(1)
	#define l1		l@
	#define l2		l@(1)
	#define θ1	θ@
	#define θ2	θ@(1)
	#define r1w	rw@
	#define r2w	rw@(1)
	#define l1w	lw@
	#define l2w	lw@(1)
	#deffunc local modDetect
		return
	
	#deffunc drawCdntAx	/* ("drawCoordinateAxis") 座標軸の描画 */
		color 100,100,100
		line -1,Oyw,wsx,Oyw
		line Oxw,-1,Oxw,wsy
		return
	
	#deffunc drawPndlms	/* ("drawPendulums") 振り子の描画 */
		// 注意 hsp3dish では circle で中空円が描けないので一旦塗り潰してから背景色で一回り小さい円を塗り潰して対応する。
		/* おもり1 */
		xtmp = Oxw+l1w*sin(θ1) : ytmp = Oyw+l1w*cos(θ1)
		color 255,255,255 : circle xtmp-r1w,ytmp-r1w, xtmp+r1w,ytmp+r1w, 1
		color : circle xtmp-r1w+1,ytmp-r1w+1, xtmp+r1w-1,ytmp+r1w-1, 1
		color 255,255,255 : line Oxw,Oyw,xtmp,ytmp
		/* おもり2 */
		xtmp2 = xtmp + l2w*sin(θ2) : ytmp2 = ytmp + l2w*cos(θ2)
		color 255,255,255 : circle xtmp2-r2w,ytmp2-r2w, xtmp2+r2w,ytmp2+r2w, 1
		color : circle xtmp2-r2w+1,ytmp2-r2w+1, xtmp2+r2w-1,ytmp2+r2w-1, 1
		color 255,255,255 : line xtmp,ytmp,xtmp2,ytmp2
		return
	
	#deffunc drawInfos	/* 各種情報の表示 */
		/* 注意
			font 設定の影響を受ける。推奨は msgoshic,16 。
		*/
		fontsize = 16
		color 200,200,200
		pos 5,wsy-5-fontsize*6 : mes "l1 = "+strf("%3.2f",l1)+" [m]"
		pos 5,wsy-5-fontsize*5 : mes "l2 = "+strf("%3.2f",l2)+" [m]"
		pos 5,wsy-5-fontsize*4 : mes "θ1 = "+strf("%6.2f",rad2deg(θ1))+" [deg]"
		pos 5,wsy-5-fontsize*3 : mes "θ2 = "+strf("%6.2f",rad2deg(θ2))+" [deg]"
		pos 5,wsy-5-fontsize*2 : mes "m1 = "+strf("%3.2f",m1)+" [kg]"
		pos 5,wsy-5-fontsize : mes "m2 = "+strf("%3.2f",m2)+" [kg]"
		return
#global

#module mod_loadPreset
	#define wsx			wsx@
	#define wsy			wsy@
	#define frmIntvl	frmIntvl@*3
	#define mtr2px		mtr2px@
	#define fontsize	16
	#define PRESET		PRESET@
	#define σ	σ@
	#define m	m@
	#define m1	m@
	#define m2	m@(1)
	#define l	l@
	#define l1	l@
	#define l2	l@(1)
	#define θ	θ@
	#define θ1	θ@
	#define θ2	θ@(1)
	#define x1	x@
	#define x2	x@(1)
	#define y1	y@
	#define y2	y@(1)
	#define r1	r@
	#define r2	r@(1)
	#define r1w	rw@
	#define r2w	rw@(1)
	#define l1w	lw@
	#define l2w	lw@(1)
	
	#deffunc loadPreset
		/*
			プリセットからロードする処理をUIも含めて担当する。
			戻り値 : (-1,other) : (ロードせず,ロードされたプリセット番号)
	
			ウィンドウは cls されることに注意
		*/
	
		*boot
			/* 未初期化変数警告回避 */
			idSelPs = 0
			
			/* 直前の設定をバックアップ */
			mbak = m1,m2
			lbak = l1,l2
			θbak = θ1,θ2
			
			loadPresetFile
			initUI
			usrRqstStat = 0	//("userRequestStatus") ユーザーからの要求の状態。(0,1,2) = (通常,選択プリセット読込要求,読込キャンセル要求)
		
		*main
			repeat
				reflesh	//画面更新
				if usrRqstStat : break	//ユーザーから新たなアクションの要求があるなら
				await frmIntvl
			loop
			switch usrRqstStat
				case 1
					return idSelPs
				case 2	/* キャンセル */
					/* 設定復元 */
					m = mbak,mbak(1)
					l = lbak,lbak(1)
					θ = θbak,θbak(1)
					r1 = sqrt(m1/σ/4/m_pi) : r2 = sqrt(m2/σ/4/m_pi)
					x1 = l1*sin(θ1) : y1 = l1*cos(θ1)
					x2 = x1+l2*sin(θ2) : y2 = y1+l2*cos(θ2)
					return -1
			swend
	
		*PsBtnIntrrpt	/* プリセットボタン割り込みへの応答 */
			idSelPs = stat
			l1 = PRESET(stat,0) : l2 = PRESET(stat,1)
			m1 = PRESET(stat,2) : m2 = PRESET(stat,3)
			r1 = sqrt(m1/σ/4/m_pi) : r2 = sqrt(m2/σ/4/m_pi)
			θ1 = PRESET(stat,4) : θ2 = PRESET(stat,5)
			x1 = l1*sin(θ1) : y1 = l1*cos(θ1)
			x2 = x1+l2*sin(θ2) : y2 = y1+l2*cos(θ2)
			r1w = r1*mtr2px : r2w = r2*mtr2px
			l1w = l1*mtr2px : l2w = l2*mtr2px
			return
	
		*ActBtnIntrpt	/* アクションボタン割り込みへの対応 */
			usrRqstStat = stat-4
			return
			
	#deffunc local initUI	/* UI初期化 */
		cls
		font msgothic,fontsize
		
		/* プリセットボタン */
		#define sxPsBtn	50	//("sizexOfPresetButton") プリセットボタンの横幅
		#define syPsBtn	30
		objsize sxPsBtn,syPsBtn
		numVPs = 5	//("numberOfValidPreset") 有効なプリセットの個数
		repeat 5
			pos 200+(sxPsBtn+5)*cnt,wsy-syPsBtn-5 : button gosub ""+cnt+"",*PsBtnIntrrpt
			if PRESET(cnt,0) <= 0 : objenable cnt,0 : numVPs --	//プリセットが記録されていないならボタンを無効化
		loop
	
		/* アクションボタン */
		#define sxActBtn	100
		#define syActBtn	20
		objsize sxActBtn,syActBtn
		pos wsx-sxActBtn-5,wsy-(syActBtn+5)*2 : button gosub "読込",*ActBtnIntrpt
		if numVPs = 0 : objenable stat,0
		pos wsx-sxActBtn-5,wsy-syActBtn-5 : button gosub "キャンセル",*ActBtnIntrpt
	
		/* 初期選択 */
		if numVPs {
			repeat 5	/* 最初に見つかった有効なプリセットを選択する */
				if PRESET(cnt,0) > 0 {
					idSelPs = cnt	//選択されているプリセット番号
					l1 = PRESET(cnt,0) : l2 = PRESET(cnt,1)
					m1 = PRESET(cnt,2) : m2 = PRESET(cnt,3)
					r1 = sqrt(m1/σ/4/m_pi) : r2 = sqrt(m2/σ/4/m_pi)
					θ1 = PRESET(cnt,4) : θ2 = PRESET(cnt,5)
					x1 = l1*sin(θ1) : y1 = l1*cos(θ1)
					x2 = x1+l2*sin(θ2) : y2 = y1+l2*cos(θ2)
					r1w = r1*mtr2px : r2w = r2*mtr2px
					l1w = l1*mtr2px : l2w = l2*mtr2px
					break
				}
			loop
		}
		return
	
	#deffunc local reflesh /* 画面更新 */
		redraw 0
			color : boxf
			drawCdntAx	//座標軸
			drawInfos2	//各種情報
			if numVPs {
				drawPndlms	//振り子
				drawInfos	//各種情報
			}
		redraw 1
		return
	
	#deffunc local drawInfos2	/* 各種情報表示 */
		color 200,200,200
		pos 200,wsy-syPsBtn*2-15 : mes "プリセットを選択してください"
		if numVPs {
			color 200,150,100
			pos 200+(sxPsBtn+5)*idSelPs+(sxPsBtn-fontsize)/2,wsy-syPsBtn*2+5 : mes "▼"
		}
		return
	
	#deffunc loadPresetFile
		/*
			プリセットデータをファイルから読み込んでシステムに反映する。
			戻り値 (0,1) : (成功,失敗)
		*/
		exist "save/preset.dat"
		if strsize  = -1 : return 1
		bload "save/preset.dat", PRESET
		return 0
#global

#module mod_savePreset
	#define wsx			wsx@
	#define wsy			wsy@
	#define frmIntvl	frmIntvl@*3
	#define mtr2px		mtr2px@
	#define fontsize	16
	#define PRESET		PRESET@
	#define σ	σ@
	#define m	m@
	#define m1	m@
	#define m2	m@(1)
	#define l	l@
	#define l1	l@
	#define l2	l@(1)
	#define θ	θ@
	#define θ1	θ@
	#define θ2	θ@(1)
	#define x1	x@
	#define x2	x@(1)
	#define y1	y@
	#define y2	y@(1)
	#define r1	r@
	#define r2	r@(1)
	#define r1w	rw@
	#define r2w	rw@(1)
	#define l1w	lw@
	#define l2w	lw@(1)
	
	#deffunc savePreset
		/*
			プリセットにセーブする処理をUIも含めて担当する。
			戻り値 : (-1,other) : (セーブせず,セーブ先プリセット番号)
	
			ウィンドウは cls されることに注意
		*/
		
		*boot
			/* 未初期化変数警告回避 */
			idSelPs = 0
			
			/* 直前の設定をバックアップ */
			mbak = m1,m2
			lbak = l1,l2
			θbak = θ1,θ2
	
			loadPresetFile
			initUI
			usrRqstStat = 0	//("userRequestStatus") ユーザーからの要求の状態。(0,1,2) = (通常,選択プリセットへ保存要求,保存キャンセル要求)
			
		*main
			repeat
				reflesh	//画面更新
				if usrRqstStat : break	//ユーザーから新たなアクションの要求があるなら
				await frmIntvl
			loop
			
			/* 設定復元 */
			m = mbak,mbak(1)
			l = lbak,lbak(1)
			θ = θbak,θbak(1)
			r1 = sqrt(m1/σ/4/m_pi) : r2 = sqrt(m2/σ/4/m_pi)
			x1 = l1*sin(θ1) : y1 = l1*cos(θ1)
			x2 = x1+l2*sin(θ2) : y2 = y1+l2*cos(θ2)
			
			switch usrRqstStat
				case 1
					savePresetFile idSelPs
					return idSelPs
				case 2	//キャンセル
					return -1
			swend
			stop
	
		*PsBtnIntrrpt	/* プリセットボタン割り込みへの応答 */
			idSelPs = stat
			if PRESET(idSelPs,0) > 0 {	//選択プリセットのデータが有効なら
				l1 = PRESET(idSelPs,0) : l2 = PRESET(idSelPs,1)
				m1 = PRESET(idSelPs,2) : m2 = PRESET(idSelPs,3)
				r1 = sqrt(m1/σ/4/m_pi) : r2 = sqrt(m2/σ/4/m_pi)
				θ1 = PRESET(idSelPs,4) : θ2 = PRESET(idSelPs,5)
				x1 = l1*sin(θ1) : y1 = l1*cos(θ1)
				x2 = x1+l2*sin(θ2) : y2 = y1+l2*cos(θ2)
				r1w = r1*mtr2px : r2w = r2*mtr2px
				l1w = l1*mtr2px : l2w = l2*mtr2px
			}
			return
	
		*ActBtnIntrpt	/* アクションボタン割り込みへの対応 */
			usrRqstStat = stat-4
			return
	
	#deffunc local initUI	/* UI初期化 */
		cls
		font msgothic,fontsize

		/* プリセットボタン */
		#define sxPsBtn	50	//("sizexOfPresetButton") プリセットボタンの横幅
		#define syPsBtn	30
		objsize sxPsBtn,syPsBtn
		repeat 5 : pos 200+(sxPsBtn+5)*cnt,wsy-syPsBtn-5 : button gosub ""+cnt+"",*PsBtnIntrrpt : loop
		idSelPs = 0	//選択プリセット番号

		/* アクションボタン */
		#define sxActBtn	100
		#define syActBtn	20
		objsize sxActBtn,syActBtn
		pos wsx-sxActBtn-5,wsy-(syActBtn+5)*2 : button gosub "保存",*ActBtnIntrpt
		pos wsx-sxActBtn-5,wsy-syActBtn-5 : button gosub "キャンセル",*ActBtnIntrpt
	return

	#deffunc local reflesh /* 画面更新 */
		redraw 0
			color : boxf
			drawInfos2
			drawCdntAx	//座標軸
			if PRESET(idSelPs,0) > 0 {	//選択プリセットが有効なら
				drawPndlms	//振り子
				drawInfos	//各種情報
			}
		redraw 1
		return

	#deffunc local drawInfos2	/* 各種情報表示 */
		color 200,200,200
		pos 200,wsy-syPsBtn*2-15 : mes "プリセットを選択してください"
		color 200,150,100
		pos 200+(sxPsBtn+5)*idSelPs+(sxPsBtn-fontsize)/2,wsy-syPsBtn*2+5 : mes "▼"
		return
	
	#deffunc savePresetFile int i
		/*
			選択プリセットに現在の設定を書き込んでファイルに保存する。
			i : 選択プリセット番号
		*/
		PRESET(i,0) = l1 : PRESET(i,1) = l2
		PRESET(i,2) = m1 : PRESET(i,3) = m2
		PRESET(i,4) = θ1 : PRESET(i,5) = θ2
		bsave "save/preset.dat",PRESET
		#ifdef hsproom
		devcontrol "syncfs"
		#endif
		return
#global

#module mod_initPreset
	#define PRESET	@PRESET@
	
	#deffunc initPreset	/* プリセットデータを初期化してファイルに保存 */
		ddim PRESET,5,6
		PRESET(0,0) = 1.3 : PRESET(0,1) = 2.05 : PRESET(0,2) = 0.68 : PRESET(0,3) = 1.26 : PRESET(0,4) = 0.115715 : PRESET(0,5) = 2.953097
		PRESET(1,0) = 0.86 : PRESET(1,1) = 1.8 : PRESET(1,2) = 2.01 : PRESET(1,3) = 0.10 : PRESET(1,4) = -2.09148 : PRESET(1,5) = 1.82928
		PRESET(3,0) = 2.5 : PRESET(3,1) = 1.5 : PRESET(3,2) = 1.0 : PRESET(3,3) = 3.0 : PRESET(3,4) = 1.570796 : PRESET(3,5) = -2.356194
		PRESET(4,0) = 0.7 : PRESET(4,1) = 2.67 : PRESET(4,2) = 1.0 : PRESET(4,3) = 3.0 : PRESET(4,4) = 0.393746 : PRESET(4,5) = -1.99275
		bsave "save/preset.dat",PRESET
		#ifdef hsproom
		devcontrol "syncfs"
		#endif
		return
#global

#module mod_fatalError
	#deffunc fatalError
		dialog "A fatal error occured.\nThis program will end on closing this window."
		end
#global