HSPに投稿されたコード一覧

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

#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

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

#packopt name "expt"

*mkwnds
	#define wsizex 800
	#define wsizey 600
	screen 0, wsizex,wsizey, 0

*init
	#define dt	0.01	;[s] タイムステップ
	#const double hdt dt/2	;[s] dt/2
	#define g	9.8	;[m/s^2]
	#define σ	1.0	;[kg/m^2] 錘の面密度
	#define l1	1.5	;[m]
	#define l2	2.0	;[m]
	#define r1	0.5	;[m] 錘1の半径
	#define r2	0.3	;[m] 〃2
	#const double m1	4.0*m_pi*σ*r1*r1
	#const double m2	4.0*m_pi*σ*r2*r2
		//#const double η		(m1+m2)/m2	;コンパイルエラー
		//↓
		η = (m1+m2)/m2
	θ1 = deg2rad(180)
	θ2 = deg2rad(135)
	ω1 = 0.0
	ω2 = 0.0

	#define mtr2px	100.0	;[px/meter] メートル→ピクセル 変換係数
	#const double wOx	wsizex/2	;[px] 物理系原点のウィンドウ上でのx座標
	#const double wOy	200.0
	#const double l1w	l1*mtr2px	;[px] l1のウィンドウ上での長さ
	#const double l2w	l2*mtr2px	;[px]
	#const double r1w	r1*mtr2px	;[px]
	#const double r2w	r2*mtr2px	;[px]
	#define frmIntvl	16	;[ms] フレーム間隔
	#define mlfreq		2	;[ms] メインループ周期

*main
	etls = 0.0	;[s] 前回ステップ計算からの経過時間
	etlf = 0.0	;[ms] 前回画面更新からの経過時間
	repeat
		if etls >= dt : gosub *step : etls = -0.001*mlfreq
		if etlf >= frmIntvl : gosub *draw : etlf = -mlfreq
		await mlfreq
		etls += 0.001*mlfreq
		etlf += mlfreq
	loop

*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+k2+k3+k4)
	θ2 += dt/6*(k1(1)+k2(1)+k3(1)+k4(1))
	ω1 += dt/6*(k1(2)+k2(2)+k3(2)+k4(2))
	ω2 += dt/6*(k1(3)+k2(3)+k3(3)+k4(3))
	return

#module func
	#define g	g@
	#define l1	l1@
	#define l2	l2@
	#define η	η@

	#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) : cosφ = cos(φ)
		return (g*η*(cosφ*sin(θ1)-sin(θ2))+(η*l1*ω1*ω1+l2*ω2*ω2*cosφ)*sin(φ))/l2/(η-cosφ*cosφ)
#global

*draw	//描画
	redraw 0
		color : boxf
		color 100,100,100
		line -1,wOy, wsizex,wOy : line wOx,-1, wOx,wsizey
		color 255,255,255
		xtmp = wOx+l1w*sin(θ1) : ytmp = wOy+l1w*cos(θ1)
		line wOx,wOy, xtmp,ytmp : circle xtmp-r1w,ytmp-r1w, xtmp+r1w,ytmp+r1w, 0
		xtmp2 = xtmp + l2w*sin(θ2) : ytmp2 = ytmp + l2w*cos(θ2)
		line xtmp,ytmp,xtmp2,ytmp2 : circle xtmp2-r2w,ytmp2-r2w, xtmp2+r2w,ytmp2+r2w, 0
	redraw 1
	return

HSP 【HSP3】DXライブラリのDxDLL.cs(C#)をHSPのasに変換するアレ(手抜き)Ver.3(2015/08/10)

#module
// 指定オフセットから右から検索していき見つけた位置を返す。(1byteのみ)
#defcfunc searchR1 str _in, int ps, int sh
	idx = -1
	in = _in
	max = strlen(in)
	repeat max, ps
		if peek(in, max-cnt) == sh : idx = max-cnt : break
	loop
return idx
// instr 右から検索版
#defcfunc instrl var s1, str s2
ind = 0
repeat
	res = instr(s1, ind, s2)
	if res == -1 : break
	ind += res + 1
loop
return ind-1
#defcfunc GetMacroName str _tmp, var macro, var const
	sdim tmp, 1024
	tmp = _tmp
	sdim macro, 128
	sdim const, 128
	flag = 0
	if instr(tmp, 0, "public const int ") != -1{
		flag = 1
		sdim res, 128
		split tmp, " ", res
		;markpos = -1
		repeat length(res)
			if res(cnt) == "="{
				tmpcnt = cnt
				// スペースの可能性を考慮して検索(マクロ名を取得)
				repeat tmpcnt
					tmpcnt--
					if res(tmpcnt) != ""{
						macro = res(tmpcnt)
						break
					}
				loop
				// スペースの場合があるので連結処理をする(定数値を取得)
				tmpcnt = cnt + 1	// 足しておく
				sdim tmpconst, 128
				repeat length(res)-tmpcnt, tmpcnt
					tmpconst += res(cnt)+" "
				loop
				// セミコロンを除去
				tmpconst = strtrim(tmpconst, 0, ' ')
				const = strtrim(tmpconst, 0, ';')
						//
			}
		loop
	}
return flag
// 戻り値の型を取得します。とれないときは空。
#defcfunc GetFuncReturn str _lineTmp, str _funcName
	sdim lineTmp, 1024
	lineTmp = _lineTmp
	if instr(lineTmp, 0, "extern") != -1{
		_posFuncName = instr(lineTmp, 0, _funcName)
		if _posFuncName != -1{
			_trimedFuncLine = strmid(lineTmp, 0, _posFuncName)
			strrep _trimedFuncLine, "extern unsafe static ", ""
			strrep _trimedFuncLine, "extern static ", ""
			strrep _trimedFuncLine, "\t", ""
			_trimedFuncLine = strtrim(_trimedFuncLine, 0, ' ')
			return _trimedFuncLine
		}
	}
return ""
#defcfunc GetFuncName str _tmp, var _fnc, array _arg, var _retType
	sdim tmp, 1024
	tmp = _tmp
	sdim _arg, 256 : sdim _fnc, 128
	num = -1
	if instr(tmp, 0, "extern") != -1{
		num = 0
		ks = instr(tmp, 0, "(")
		ke = instrl(tmp, ")")
		if ks != -1 | ke != -1{
			args = strmid(tmp, ks+1, ke-ks-1)
			tmp2 = strmid(tmp, 0, ks)
			tmp2 = strtrim(tmp2, 0, ' ')
			ps = searchR1(tmp2, 0, ' ')
			if ps != -1 {
				// 関数名を取得
				tmp3 = strmid(tmp2, ps, strlen(tmp2))
				_fnc = strtrim(tmp3, 0, ' ')

				// 末尾が_x64の場合(対象外として-1を返す)
				if "_x64" == strmid(_fnc, -1, strlen("_x64")){
					return -1
				}

				// 末尾が_x86の場合(取り除きます)
				if "_x86" == strmid(_fnc, -1, strlen("_x86")){
					_fnc = strmid(_fnc, 0, strlen(_fnc) - strlen("_x86"))
				}

				// 戻り値の型を取得
				_retType = GetFuncReturn(tmp, _fnc)

				// 引き続き引数を取得
				// 引数がないケースを取得
				cargs = args
				cargs = strtrim(cargs, 3, ' ')
				cargs = strtrim(cargs, 3, '\t')
				if cargs == "" : num = 0 : return num
				// 引数ありのケース
				sdim tmp2
				split args, ",", tmp2
				num = stat
				repeat num
					tmp3 = tmp2(cnt)
					tmp3 = strtrim(tmp3, 3, '\t')
					tmp3 = strtrim(tmp3, 0, ' ')
					ps = searchR1(tmp3, 0, ' ')
					if ps != -1{
						tmp4 = strmid(tmp3, 0, ps)
						tmp4 = strtrim(tmp4, 0, ' ')
						_arg(cnt) = tmp4
					}
				loop
			}
		}
	}
return num
#global

	dialog "cs",16
	if stat == 0 : end
	fname = refstr

	notesel buf
	noteload fname

	sdim def, 1024*512
	sdim fncs, 1024*512

	repeat notemax
		noteget tmp, cnt
		if GetMacroName(tmp, macro, const){
			def += "#define global "+ macro +" "+ const +"\n"
		}
		num = GetFuncName(tmp, fnc, arg, ret)
		if num != -1{
			sdim outargs
			repeat num
				// 引数で使われているものだけピックアップしているので構造体は全部ではない。
				if arg(cnt) == "int" || arg(cnt) == "ulong" || arg(cnt) == "uint" || arg(cnt) == "char"{
					outargs += "int"
				}else:if arg(cnt) == "System.Text.StringBuilder" || arg(cnt) == "string"{
					outargs += "str"
				}else:if arg(cnt) == "double"{
					outargs += "double"
				}else:if arg(cnt) == "float"{
					outargs += "float"
				}else:if arg(cnt) == "VECTOR"{
					outargs += "float,float,float"
				}else:if arg(cnt) == "VECTOR_D"{
					outargs += "double,double,double"
				}else:if arg(cnt) == "UV"{
					outargs += "float,float"
				}else:if arg(cnt) == "COLOR_F" || arg(cnt) == "FLOAT4"{
					outargs += "float,float,float,float"
				}else:if arg(cnt) == "COLOR_U8"{
					outargs += "int"
				}else:if arg(cnt) == "IPDATA" || arg(cnt) == "IPDATA_IPv6"{
					outargs += "int"
				}else:if arg(cnt) == "RECT" || arg(cnt) == "INT4"{	// ポインタとかは "RECT *" といった感じに来ます。
					outargs += "int,int,int,int"
				}else:if arg(cnt) == "MATRIX"{
					outargs += "float,float,float,float,float,float,float,float,float,float,float,float,float,float,float,float"
				}else:if arg(cnt) == "MATRIX_D"{
					outargs += "double,double,double,double,double,double,double,double,double,double,double,double,double,double,double,double"
				}else:if arg(cnt) == "MV1_COLL_RESULT_POLY"{
					outargs += "int,float,float,float,int,int,int,float,float,float,float,float,float,float,float,float,float,float,float"
				}else:if arg(cnt) == "MV1_REF_POLYGON"{
					outargs += "int,int,int,int,int,float,float,float,float,float,float"
				}else:if arg(cnt) == "MV1_REF_VERTEX"{
					outargs += "float,float,float,float,float,float"
				}else:if arg(cnt) == "MATERIALPARAM"{
					outargs += "float,float,float,float,float,float,float,float,float,float,float,float,float,float,float,float,float"
				}else:if arg(cnt) == "HITRESULT_LINE"{
					outargs += "int,float,float,float"
				}else:if arg(cnt) == "MV1_COLL_RESULT_POLY_DIM"{
					outargs += "int,int"
				}else:if arg(cnt) == "System.IntPtr"{
					outargs += "sptr"
				}else:if arg(cnt) == "void"{
					outargs += ""
				}else{
					// out~、*は気にしない
					// logmes arg(cnt)
					outargs += "sptr"
				}
				// 最後以外は , をつける
				if cnt != num - 1 : outargs += ","
			loop

			// 戻り値の型をチェックします(構造体のもの)
			retTypeStruct = 0
			if ((ret == "COLOR_F") || (ret == "COLOR_U8") || (ret == "DISPLAYMODEDATA") || (ret == "DOUBLE4") || (ret == "FLOAT4") || (ret == "HITRESULT_LINE") || (ret == "MATRIX") || (ret == "MATRIX_D") || 	(ret == "MV1_COLL_RESULT_POLY") ||(ret == "MV1_COLL_RESULT_POLY_DIM") || (ret == "VECTOR") ||(ret == "VECTOR_D")){
				retTypeStruct = 1
		 	}

		 	if retTypeStruct == 1{
				fncs += "// 戻り値が構造体です(" + ret +")\n// 第一引数に戻り値を返却します。パラメタは第二引数以降にずれます。\n"
				outargs = "var," + outargs
			}

			// 接頭辞の dx_ を外す(手抜き)
			split fnc, "dx_", fnc2
			fncs += "#func global "+ fnc2(1) +" \""+ fnc +"\" "+outargs+"\n"
		}
	loop

	def2 = {"// VECTOR => float, float, float
#define global ctype VGet(%1,%2,%3) %1, %2, %3
#define global ctype VAdd(%1,%2,%3,%4,%5,%6) %1+%4, %2+%5, %3+%6
#define global ctype VSub(%1,%2,%3,%4,%5,%6) %1-%4, %2-%5, %3-%6
#define global ctype VDot(%1,%2,%3,%4,%5,%6) %1*%4+%2*%5+%3*%6
#define global ctype VCross(%1,%2,%3,%4,%5,%6) %2*%6-%3*%5, %3*%4-%1*%6, %1*%5-%2*%4
#define global ctype VScale(%1,%2,%3,%4) %1*%4, %2*%4, %3*%4
#define global ctype VSquareSize(%1,%2,%3) %1*%1+%2*%2+%3*%3
// 行列だからdimの方が良いのか…(MATRIX 4x4)
#define global ctype VTransform(%1,%2,%3, %4,%5,%6,%7, %8,%9,%10,%11, %12,%13,%14,%15, %16,%17,%18,%19) %1*%4 + %2*%8 + %3*%12 + %16, %1*%5 + %2*%9 + %3*%13 + %17, %1*%6 + %2*%10 + %3*%14 + %18
#define global ctype VTransformSR(%1,%2,%3, %4,%5,%6,%7, %8,%9,%10,%11, %12,%13,%14,%15, %16,%17,%18,%19) %1*%4 + %2*%8 + %3*%12, %1*%5 + %2*%9 + %3*%13, %1*%6 + %2*%10 + %3*%14
// VConvFtoD, VConvDtoF未実装
#define global VGetD VGet
#define global VAddD VAdd
#define global VSubD VSub
#define global VDotD VDot
#define global VCrossD VCross
#define global VScaleD VScale
#define global VSquareSizeD VSquareSize
#define global VTransformD VTransform
#define global VTransformSRD VTransformSR
"}

	sdim outbuf, 1024*5120
	notesel outbuf
	noteadd "// "
	noteadd "// DxLib for HSP " + strf("(%04d/%02d/%02d)", gettime(0), gettime(1), gettime(3))
	noteadd "// http://hsp.moe/"
	noteadd "// https://twitter.com/hk1v"
	noteadd "// by inovia."
	noteadd "// "
	noteadd "// 【本モジュールを利用するにはC#版に付属しているDxLib.dllが必要です】"
	noteadd "// http://homepage2.nifty.com/natupaji/DxLib/dxdload.html"
	noteadd "// "
	noteadd "// ※本モジュールをスムーズに使用するには、構造体に対する理解が必要です。"
	noteadd "// また、C言語で書いてあるソースがそれとなく分かるぐらいの知識が必要です。"
	noteadd "// (世の中にあるDxLibのサンプルコードのほとんどがC/C++/C#なので)"
	noteadd "// HSPの知識だけですと、かなりきついと思います。"
	noteadd "// 推奨レベル:★★★★☆(Lv.4) 当社比...?"
	noteadd "// "
	noteadd "// 【旧バージョンのDxLib.as】"
	noteadd "// http://hsp.moe/download/DxLib_old.as"
	noteadd "// 【TIPS】"
	noteadd "// 構造体が戻り値の場合、HSPがクラッシュする問題(解決方法)"
	noteadd "// http://codetter.com/?p=1192"
	noteadd "// DxLib関連のサンプル(HSP用)"
	noteadd "// http://codetter.com/?extag=dxlib"
	noteadd "// HSPとDxLibで2D描画の基礎ら辺とか(えくー氏)"
	noteadd "// http://fe0km.blog.fc2.com/blog-entry-53.html"
	noteadd "// hspからDXlibの利用方法について"
	noteadd "// http://hsp.tv/play/pforum.php?mode=all&num=70321"
	noteadd "#ifndef __DXLIB__"
	noteadd "#define __DXLIB__"
	noteadd "// 定義ファイルのバージョン(=作成時のDxLibのバージョン+連番4桁数字)"
	noteadd "#define DEFINE_DXLIB_VERSION \"3.14f0000\""
	noteadd "#uselib \"DxLib.dll\""
	noteadd fncs
	noteadd def
	noteadd def2
	noteadd "#endif"
	notesave "DxLib.as"

	end

HSP 【HSP3】構造体を戻り値とするDXライブラリの関数をHSPで呼び出すテスト

// http://sprocket.babyblue.jp/html/hsp_koneta3.htm
#module
#defcfunc todouble int p1
	temp = 0.0
	lpoke temp, 4, (p1 & 0x80000000) | (((p1 & 0x7fffffff) >> 3) + ((p1 & 0x7fffffff) ! 0) * 0x38000000)
	lpoke temp, 0, p1 << 29
return temp
#global
;
#runtime "hsp3cl"
#include "DxLib.as"
;
// 【参考】元の形式
; #func global ConvWorldPosToScreenPos "dx_ConvWorldPosToScreenPos" float,float,float
;
// 第一引数に戻り値を格納するポインタを指定する(そのため、引数が1つずれます)
#func global _ConvWorldPosToScreenPos "dx_ConvWorldPosToScreenPos" var,float,float,float
;
	ChangeWindowMode TRUE			// ウィンドウモードになる
	SetDoubleStartValidFlag TRUE	// 多重起動を許可
;
	DxLib_Init
;
	px = 0.0f
	py = 0.0f
	pz = 100.0f
;
	; 戻り値を格納するVECTOR構造体(12bytes)
	dim VECTOR, 3
	_ConvWorldPosToScreenPos VECTOR, VGet(px, py, pz)
;
	; ポインタ(同じ値を指します)
	mes "ptr:" + stat
	mes "ptr:" + varptr(VECTOR)
;
	; 結果
	mes todouble(vector.0)
	mes todouble(vector.1)
	mes todouble(vector.2)
;

HSP 二重振り子RK4シミュonHSP

#packopt name "expt"

*mkwnds
	#define wsizex 800
	#define wsizey 600
	screen 0, wsizex,wsizey, 0

*init
	#define dt	0.01	;[s] タイムステップ
	#const double hdt dt/2	;[s] dt/2
	#define g	9.8	;[m/s^2]
	#define σ	1.0	;[kg/m^2] 錘の面密度
	#define l1	2.5	;[m]
	#define l2	1.5	;[m]
	#define r1	0.5	;[m] 錘1の半径
	#define r2	0.3	;[m] 〃2
	#const double m1	4.0*m_pi*σ*r1*r1
	#const double m2	4.0*m_pi*σ*r2*r2
		//#const double η		(m1+m2)/m2	;コンパイルエラー
		//↓
		η = (m1+m2)/m2
	θ1 = deg2rad(135)
	θ2 = deg2rad(180)
	ω1 = 0.0
	ω2 = 0.0

	#define mtr2px	100.0	;[px/meter] メートル→ピクセル 変換係数
	#const double wOx	wsizex/2	;[px] 物理系原点のウィンドウ上でのx座標
	#const double wOy	200.0
	#const double l1w	l1*mtr2px	;[px] l1のウィンドウ上での長さ
	#const double l2w	l2*mtr2px	;[px]
	#const double r1w	r1*mtr2px	;[px]
	#const double r2w	r2*mtr2px	;[px]
	#define frmIntvl	16	;[ms] フレーム間隔

*main
	etlf = frmIntvl	;[ms] 前回画面更新からの経過時間
	repeat
		gosub *step
		if etlf >= frmIntvl : gosub *draw : etlf = -dt*1000
		await dt*1000 : etlf += dt*1000
	loop

*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(2)+dt*k3(3) : k4 = f1(ξn4),f2(ξn4),f3(ξn4),f4(ξn4)
	θ1 += dt/6*(k1+k2+k3+k4)
	θ2 += dt/6*(k1(1)+k2(1)+k3(1)+k4(1))
	ω1 += dt/6*(k1(2)+k2(2)+k3(2)+k4(2))
	ω2 += dt/6*(k1(3)+k2(3)+k3(3)+k4(3))
	return

#module func
	#define g	g@
	#define l1	l1@
	#define l2	l2@
	#define η	η@

	#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) : cosφ = cos(φ)
		return (g*η*(cosφ*sin(θ1)-sin(θ2))+(η*l1*ω1*ω1+l2*ω2*ω2*cosφ)*sin(φ))/l2/(η-cosφ*cosφ)
#global

*draw	//描画
	redraw 0
		color : boxf
		color 100,100,100
		line -1,wOy, wsizex,wOy : line wOx,-1, wOx,wsizey
		color 255,255,255
		xtmp = wOx+l1w*sin(θ1) : ytmp = wOy+l1w*cos(θ1)
		line wOx,wOy, xtmp,ytmp : circle xtmp-r1w,ytmp-r1w, xtmp+r1w,ytmp+r1w, 0
		xtmp2 = xtmp + l2w*sin(θ2) : ytmp2 = ytmp + l2w*cos(θ2)
		line xtmp,ytmp,xtmp2,ytmp2 : circle xtmp2-r2w,ytmp2-r2w, xtmp2+r2w,ytmp2+r2w, 0
	redraw 1
	return

HSP 任意の型の引数を任意の数だけ取る関数(可変長引数を取る関数)の実装

//-----------------------------------------------------------------------------------------
// 可変長引数(笑)                                                                       |
//                                                                       2015/07/04  Flat |
//-----------------------------------------------------------------------------------------

/*
■特徴
    コードセグメントを直に読みます
    ですので無限に引数を付けられます
    更にあらゆる型の引数を受け付けます
    言い換えれば型の自動変換がありません

    尤も、あらゆる型を受け付けられてもその型の処理ができなければ意味がありませんがね!

■使用できる型
    現在対応している型は
      ・空引数
      ・ユーザー定義命令・関数
      ・変数、配列(※)
      ・その他HSPの変数に格納できる全ての型
    となります
    vfunc関数を編集すれば他の型にも対応可能です

    ※配列は正常に動作しないことがあります(文字列型など)
      おそらくHSPのバグまたは仕様なので、ランタイムの方を編集してください

■注意
    ・vfuncから呼び出された関数の中でvfuncを呼び出すとreturn時に死にます
      これはvfuncから他の関数を呼び出す際に定義情報を無理矢理書き換えている関係です
      根本的な解決策は現在見つかっていません…

    ・関数内からvfuncを呼び出す際、引数に関数の引数(ローカル変数含む)は使えません
      これは引数の評価処理がvfunc内部で行われているためで、根本的な解決策は(略)

■その他
    vfuncは命令形式の呼び出しですが、少し書き換えるだけで関数形式の呼び出しにできます
    つまり、今まで夢だった関数へのラベル渡しもできます

■使い方
    使い方はサンプルを見たほうが早いので、ここでは割愛します
*/

// 引数格納庫
// タイプが-1のときは引数の変数をクローンする
#module ParameterStore m_type, m_var
#modinit int p_type, array p_var
	m_type = p_type
	if m_type == -1 {
		dup m_var, p_var
	} else {
		m_var = p_var
	}
	return

#modcfunc gettype
	return m_type

#modcfunc getparam
	return m_var

#modfunc  dupparam var p_var
	dup p_var, m_var
	return
#global

// 可変長引数モジュール
#module Variadic
// PVal取得関数
// http://d.hatena.ne.jp/chaperatta/20081012/1223803468
#defcfunc local getpval var
#deffunc local _getpval int p_pval
	return p_pval

// コールバック用ダミー関数
#deffunc local callback
	return

// 可変長引数で任意の関数を呼び出す関数
// vfunc 呼び出す関数, 引数1, 引数2, 引数3, …
#deffunc vfunc \
local param, local param_index, local param_num, \
local hspctx, local hsphed, local mcs, local cs, local callback_st, \
local pcs, local old_pcs, local code_num, \
local info, local is48, local ex0, local ex1, local ex2, local type, local code, \
local params, local size, local label, local vtype, local bytecode, local func_st, \
local flag, local t_offset, local t_type, local t_code, \
local func

	// ローカル変数paramのインデックスを取得
	// 次がparamの参照となるようなラベルを作成
	newlab label, 0
	param = 0
	// その場所のコードを取得
	dupptr cs, lpeek(label, 0), 6, 2
	// インデックス(=Code)を取得
	if wpeek(cs, 0) & 0x8000 {
		param_index = lpeek(cs, 2)
	} else {
		param_index = wpeek(cs, 2)
	}

	// CSを取得
	// HSPCTX取得
	mref hspctx, 68
	// HSPHED取得
	dupptr hsphed, hspctx(0), 96, 4
	// 関数呼び出し元のCSポインタ取得
	dupptr mcs, hspctx(207) - 16, 4
	// CSポインタからCSを取得
	dupptr cs, mcs, hsphed(5) - (hspctx(2) - mcs)

	// CSをなめる
	// http://codetter.com/?p=1165 からパクった
	pcs       = 0
	old_pcs   = 0
	param_num = 0
	code_num  = 0
	repeat
		// ExやType等取得
		info = wpeek(cs, pcs)
		is48 = info & 0x8000
		ex2  = info & 0x4000
		ex1  = info & 0x2000
		ex0  = info & 0x1000
		type = info & 0x0FFF

		// 引数の区切り
		if ex1 | ex2 {
			// 引数のコードサイズ
			size = pcs - old_pcs

			// 例外処理
			vtype = 0
			switch wpeek(cs, old_pcs) & 0x0FFF
				// 空引数
				case 0
					if wpeek(cs, old_pcs) & 0x8000 {
						t_code = lpeek(cs, old_pcs + 2)
					} else {
						t_code = wpeek(cs, old_pcs + 2)
					}
					if t_code != 0x3F : swbreak

					// とりあえず0にでもしておく
					param = 0
					// vtypeセット
					vtype = -3
					swbreak

				// 変数及び配列の要素
				case 1/*TYPE_VAR*/
					flag = 0
					if code_num == 1 {
						// 変数
						flag = 1
					} else : if code_num >= 4 {
						// 配列の要素?
						// TYPE_VARの直後が'('で末尾が')'なら配列の要素とみなす
						// a(3) * a(2) などはコンパイル後 a(3) a(2) * となるので問題はなさそう
						flag = 1
						t_offset = old_pcs
						repeat code_num
							t_type = wpeek(cs, t_offset) & 0x0FFF

							if wpeek(cs, t_offset) & 0x8000 {
								t_code = lpeek(cs, t_offset + 2)
								t_offset += 6
							} else {
								t_code = wpeek(cs, t_offset + 2)
								t_offset += 4
							}

							if type == 11/*TYPE_CMPCMD*/ {
								t_offset += 2
							}

							switch cnt
								// 先頭のチェック
								case 1
									if t_type ==  0x000 : swbreak
									if t_code == 0x0028 : swbreak

									flag = 0
									break

								// 末尾のチェック
								case code_num - 1
									if t_type ==  0x000 : swbreak
									if t_code == 0x0029 : swbreak

									flag = 0
									break
							swend
						loop
					}
					if flag {
						// バイトコードの生成
						sdim bytecode, size + 18
						wpoke bytecode, 0, 0x200F					// dup
						wpoke bytecode, 2, 0x000E
						wpoke bytecode, 4, 0x8005					// param
						lpoke bytecode, 6, param_index
						memcpy bytecode, cs, size, 10, old_pcs		// 変数、配列の要素
						wpoke bytecode, size + 10, 0x200F			// return
						wpoke bytecode, size + 12, 0x0002
						wpoke bytecode, size + 14, 0x200F			// return(なんでもいいので何かひとつ必要)
						wpoke bytecode, size + 16, 0x0002

						// 先頭のEx2フラグを立てる
						wpoke bytecode, 10, wpeek(bytecode, 10) | 0x4000

						// バイトコード呼び出し
						newlab label, 0
						lpoke label, 0, varptr(bytecode)
						gosub label

						// vtypeセット
						vtype = -1
					}
					swbreak

				// ユーザー定義関数
				case 12/*TYPE_MODCMD*/
					if code_num != 1 : swbreak

					// バイトコードの生成
					sdim bytecode, size + 20
					wpoke bytecode,  0, 0x200F					// return
					wpoke bytecode,  2, 0x0002
					wpoke bytecode,  4, 0x0011					// libptr
					wpoke bytecode,  6, 0x0103
					wpoke bytecode,  8, 0x0000					// (
					wpoke bytecode, 10, 0x0028
					memcpy bytecode, cs, size, 12, old_pcs		// 関数
					wpoke bytecode, size + 12, 0x0000			// )
					wpoke bytecode, size + 14, 0x0029
					wpoke bytecode, size + 16, 0x200F			// return(なんでもいいので何かひとつ必要)
					wpoke bytecode, size + 18, 0x0002

					// 先頭のEx2フラグを下ろす
					wpoke bytecode, 12, wpeek(bytecode, 12) & 0xBFFF

					// バイトコード呼び出し
					newlab label, 0
					lpoke label, 0, varptr(bytecode)
					gosub label

					// param、vtypeセット
					param = stat
					vtype = -2
					swbreak
			swend

			if vtype == 0 {
				// バイトコードの生成
				sdim bytecode, size + 18
				wpoke bytecode, 0, 0xA005					// param
				lpoke bytecode, 2, param_index
				wpoke bytecode, 6, 0x0000					// =
				wpoke bytecode, 8, 0x0008
				memcpy bytecode, cs, size, 10, old_pcs		// 引数
				wpoke bytecode, size + 10, 0x200F			// return
				wpoke bytecode, size + 12, 0x0002
				wpoke bytecode, size + 14, 0x200F			// return(なんでもいいので何かひとつ必要)
				wpoke bytecode, size + 16, 0x0002

				// 先頭のEx2フラグを下ろす
				wpoke bytecode, 10, wpeek(bytecode, 10) & 0xBFFF

				// バイトコード呼び出し
				newlab label, 0
				lpoke label, 0, varptr(bytecode)
				gosub label

				// vtypeセット
				vtype = vartype(param)
			}

			// 処理
			if param_num < 1 {
				// vfuncが使用する引数
				switch param_num
					// 最初の引数(呼び出す関数)
					case 0
						if (vtype != -2) && (vartype(param) != 4) {
							// エラーを引き起こす
							_errorfunc@Variadic 123
						}
						func = param
						swbreak
				swend
			} else {
				// ユーザー定義関数に渡す引数
				newmod params, ParameterStore, vtype, param
			}

			// paramクリア
			dim param

			// 情報更新
			code_num = 0
			old_pcs  = pcs
			param_num++
		}

		// 引数終了
		if ex1 {
			break
		}

		// ポインタを進める
		pcs += 2

		// Code取得
		if is48 {
			code = lpeek(cs, pcs)
			pcs += 4
		} else {
			code = wpeek(cs, pcs)
			pcs += 2
		}

		// TYPE_CMPCMDのときはジャンプ先が記録されている
		// 一応書いておいたが、不要かもしれない
		if type == 11/*TYPE_CMPCMD*/ {
			pcs += 2
		}

		// デバッグ用
		;mes strf("%08X %d %d %d %d %4d %08X", pcs, is48!=0, ex0!=0, ex1!=0, ex2!=0, type, code)

		// コード数更新(あとで使用する)
		code_num++
	loop

	// 引数不足のチェック
	if param_num < 1 {
		// エラーを引き起こす
		_errorfunc@Variadic
		return
	}

	// callbackを弄る
	dupptr callback_st, libptr(callback@Variadic), 28, 2
	dupptr func_st, func, 28, 2
	memcpy callback_st, func_st, 28

	// callback呼び出し
	callback@Variadic params

	// 引数解放
	foreach params
		delmod params(cnt)
	loop

	// 戻り先を修正
	mcs += pcs
	return

#deffunc local _errorfunc str a
	return
#global

// 以下サンプル、#if 0を#if 1にして動作
#if 0
// テスト関数
#module
#deffunc testfunc array p_params, \
local type, local var
	mes strf("NUM OF PARAMS: %d", length(p_params))
	foreach p_params
		// 引数の種類を取得
		type = gettype(p_params(cnt))

		// 引数を変数にクローン
		dupparam p_params(cnt), var

		// 表示してみる
		switch type
			case -3
				mes strf("TYPE: EMPTY")
				swbreak

			case -2
				mes strf("TYPE: FUNCTION,  PTR TO STRUCTDAT: %08X", var)
				swbreak

			case -1
				if length(var) > 1 {
					mes strf("TYPE: ARRAY[%d],  DATA[0]:          %s", length(var), str(var(0)))
				} else {
					mes strf("TYPE: VARIABLE,  DATA:             %s", str(var))
				}
				swbreak

			case 1
				mes strf("TYPE: LABEL,     DESTINATION:      %08X", lpeek(var, 0))
				swbreak

			case 2
				mes strf("TYPE: STRING,    DATA:             %s", var)
				swbreak

			case 3
				mes strf("TYPE: DOUBLE,    DATA:             %g", var)
				swbreak

			case 4
				mes strf("TYPE: INTEGER,   DATA:             %d", var)
				swbreak

			default
				mes strf("TYPE: %d", var)
				swbreak
		swend
	loop
	return
#global

*label
	abc = "a", "b", "c"
	def = 1, 2, 3, 4

	vfunc testfunc, 2, "xyz", 3.14, *label, 4 * 5, "3" + 4, 4.6
	mes

	vfunc testfunc, abc, def, abc(1), def(2), testfunc
	mes

	vfunc testfunc, , , , 5
	mes
#endif

HSP モジュール配列の自動拡張

// モジュール配列の自動拡張のテスト

#module
#deffunc func var p
	return
#global

#module testmod q
#modinit int r
	q = r
	mes "### newmod " + q
	return

#modterm
	mes "### delmod " + q
	return
#global

	// 実験用に5つほど作成
	newmod test, testmod, 0
	newmod test, testmod, 1
	newmod test, testmod, 2
	newmod test, testmod, 3
	newmod test, testmod, 4

	// 初期状態の要素数を確認
	mes "length(test) = " + length(test)

	// 領域外の添字の要素に対してdelmod
	mes
	mes "delmod test(123)"
	delmod test(123)
	mes "length(test) = " + length(test)

	// 領域外の添字の要素に対してvaruse
	mes
	mes "varuse(test(234)) = " + varuse(test(234))
	mes "length(test) = " + length(test)

	// ユーザー定義関数に領域外の添字の要素を渡す
	mes
	mes "func test(345)"
	func test(345)
	mes "length(test) = " + length(test)

	// 領域外の添字の要素に対してvarptr
	mes
	mes "varptr(test(456)) = " + varptr(test(456))
	mes "length(test) = " + length(test)

	// 適当な変数を領域外の添字の要素のクローンにする
	mes
	mes "dup a, test(567)"
	dup a, test(567)
	mes "length(test) = " + length(test)

	// 適当な変数に領域外の添字の要素を代入する
	mes
	mes "b = test(678)"
	b = test(678)
	mes "length(test) = " + length(test)
	// これはエラー
	

HSP 配列の自動拡張

// 配列の自動拡張のテスト

#module
#deffunc func var p
	return
#global

	// 実験用に5つほど作成
	dim test, 5

	// 初期状態の要素数を確認
	mes "length(test) = " + length(test)

	// ユーザー定義関数に領域外の添字の要素を渡す
	mes
	mes "func test(123)"
	func test(123)
	mes "length(test) = " + length(test)

	// 領域外の添字の要素に対してvarptr
	mes
	mes "varptr(test(234)) = " + varptr(test(234))
	mes "length(test) = " + length(test)

	// 適当な変数を領域外の添字の要素のクローンにする
	mes
	mes "dup a, test(345)"
	dup a, test(345)
	mes "length(test) = " + length(test)

	// 適当な変数に領域外の添字の要素を代入する
	mes
	mes "b = test(456)"
	b = test(456)
	mes "length(test) = " + length(test)
	// これはエラー
	

HSP HSPで例外(マクロ)

#define global try %tException %i=0:%i=0:if'%i'
#define global finally %tException if 1
#define global ctype catch(%1) %tException *%o:%1=%o:if %o
#define global throw(%1) %tException %p1=%1:%p2=1:goto*%p0

	mes "--------------------"

	try {
		mes "--try1"
		throw 1234567
		// throw "Test"
	} catch(e) {
		mes "--catch1 " + e
	} finally {
		mes "--finally1"
	}

	mes "--------------------"

	try {
		mes "--try2"
		// throw 1234567
		throw "Test"
	} catch(e) {
		mes "--catch2 " + e
	} finally {
		mes "--finally2"
	}

	mes "--------------------"

	try {
		mes "--try3"
		// throw 1234567
		// throw "Test"
	} catch(e) {
		mes "--catch3 " + e
	} finally {
		mes "--finally3"
	}

	mes "--------------------"

	try {
		mes "--try4"
		throw 1.234567
	} catch(e) {
		mes "--catch4 " + e
	}

	mes "--------------------"

	try {
		mes "--try5"
	} catch(e) {
		mes "--catch5 " + e
	}

	mes "--------------------"

	stop

HSP キュー

// データを保存するだけのモジュール
// 各種データをモジュール変数として扱う用
#module DataContainer m_data, m_size, m_rsize
#modinit var p_data, int p_size, \
local index
	if p_size < 0 {
		delmod thismod
		return -1
	}
	m_size = p_size
	if m_size > 0 {
		dimtype m_data, vartype(p_data), m_size
		switch vartype(p_data)
			case vartype("int")    : m_rsize = m_size << 2 : swbreak
			case vartype("str")    : m_rsize = m_size      : swbreak
			case vartype("double") : m_rsize = m_size << 3 : swbreak
			case vartype("label")  : m_rsize = m_size << 2 : swbreak	// TODO: 64Bit版
			case vartype("struct") : delmod thismod : return -1			// 未実装
			default                : delmod thismod : return -1			// 実装する気ナシ
		swend
		memcpy m_data, p_data, m_rsize
	} else {
		dimtype m_data, vartype(p_data), 1
		m_rsize = 0
	}
	mref index, 2
	return index

// 格納されたデータを取得
#modfunc  local GetData var p_data
	if m_size > 0 {
		dimtype p_data, vartype(m_data), m_size
		memcpy p_data, m_data, m_rsize
	} else {
		dimtype p_data, vartype(m_data), 1
	}
	return

// 格納されたデータのサイズを取得
#modcfunc local GetSize
	return m_size

// 格納されたデータの実サイズを取得
#modcfunc local GetRealSize
	return m_rsize
#global

// キューのモジュール
#module Queue m_data, m_index, m_num
#modinit \
local index
	dimtype m_data, vartype("struct"), 1
	dim m_index, 1
	dim m_num
	mref index, 2
	return index

// キューにデータを追加
// Enqueue@Queue [VAR]モジュール変数, [VAR]追加するデータ, [INT]データの大きさ
// 戻り値:正常終了だと1、処理に失敗すると0
#modfunc  local Enqueue var p_data, int p_size
	newmod m_data, DataContainer, p_data, p_size
	if stat < 0 : return 0
	m_index(m_num) = stat
	m_num++
	return 1

// キューからデータを取得
// Dequeue@Queue [VAR]モジュール変数, [VAR]出力先変数
// 戻り値:正常終了だと1、処理に失敗すると0
#modfunc  local Dequeue var p_data
	if m_num <= 0 : return 0
	GetData@DataContainer m_data(m_index(0)), p_data
	m_num--
	memcpy m_index, m_index, m_num << 2, 0, 4
	return 1

// キューのデータ数を取得
// RET = GetDataNum@Queue([VAR]モジュール変数)
// 戻り値:データ数
#modcfunc local GetDataNum
	return m_num

// 次のデータのサイズを取得
// RET = GetNextDataSize@Queue([VAR]モジュール変数)
// 戻り値:データサイズ、ただしデータがないときは-1
#modcfunc local GetNextDataSize
	if m_num <= 0 : return -1
	return GetSize@DataContainer(m_data(m_index(0)))
#global

// 以下サンプル、#if 0を#if 1にして動作
#if 0
	newmod mod, Queue
	sdim text

	objsize 60, 20
	pos   0, 0 : input text, 200, 20
	pos 200, 0 : button "Enqueue",  *enqueue
	pos 260, 0 : button "Dequeue",  *dequeue
	pos 320, 0 : button "Count",    *count
	pos 380, 0 : button "Get Size", *getsize
	pos 10, 30
	stop

*enqueue
	if text == "" {
		mes "No Data Specified"
		stop
	}
	Enqueue@Queue mod, text, strlen(text)
	mes "Enqueued ["+text+"]"
	objprm 0, ""
	sdim text
	stop

*dequeue
	sdim data
	Dequeue@Queue mod, data
	if stat {
		mes "Dequeued ["+data+"]"
	} else {
		mes "No Data in Queue"
	}
	stop

*count
	mes "There are "+GetDataNum@Queue(mod)+" Data in Queue"
	stop

*getsize
	size = GetNextDataSize@Queue(mod)
	if size >= 0 {
		mes "Next Data is "+size+" Bytes Long"
	} else {
		mes "No Data in Queue"
	}
	stop
#endif
Total Pages: 2 / 22123451020...最後 »

よく投稿されているコード

タグ

最近投稿されたコード