hspのタグがつけられたコード一覧

HSP みんな遅い遅いって言うから高速動作するstrmid作ったよ

//
// [ Infomation ]
//  Name      : 高速strmid
//  SubName   :
//  Version   : 1.00
//  copyright : GENKI
//
// [ Update history ]
// 2017/09/17 : 1.00 : 完成。
//
// [ Comment ]
//  遅いと指摘され続けてきたstrmid命令の高速動作する互換命令です。
// これまでstrmid命令の代わりにmemcpyを用いて高速化する手法が
// 広く利用されていましたが、当然ながら使いにくくなるという問
// 題を有していました。
//  本モジュールでは内部でmemcpyを用いて高速に動作させつつ、
// 必要な面倒な手続きを省略し、strmidと同じ要領で使用できるよ
// うにしています。
//  使い方は、strmid命令を使用しているスクリプトで本モジュー
// ルをincludeし、strmidをstrmid2に置換するだけで高速に動作す
// るstrmid互換命令を使用できるようになります。
//  なお文字列を右側から取り出す場合は、strmidと同等程度の速
// 度に低下します。
//

;#ifndef __MODULE_NAME__
;#define global __MODULE_NAME__
#module

// ------------------------------------------------------------ //
//
// 関  数  :strmid2
//
// 引  数  :var p1=変数名 : 取り出すもとの文字列が格納されている変数名
//           int p2=-1~   : 取り出し始めのインデックス
//           int p3=0~    : 取り出す文字数
//
// 返り値  :refstr
//           0 : hogehoge
//           1 : hogehoge
//
// 機能説明:
//  strmid命令よりも高速度さする互換命令です。
//  p2に-1を指定した場合は内部でstrmid命令を呼び出します。
//
//  p1で指定した文字列型変数の中から、 p2,p3で指定した条件で文字を取り出したものを返します。
//  p2で取り出し始めるインデックスを指定します。これは、文字列の始まり1文字目を0として、1,2,3...と順番に増えていくものです。1から始まりではないので注意してください。
//  p3で取り出す文字数を指定します。実際に格納されている文字数よりも多く指定した場合は、実際の文字数までが取り出されます。
//  また、p2に-1を指定すると文字列の右からp3で指定した文字数だけ取り出します。
//
//
// ------------------------------------------------------------ //
#defcfunc strmid2 var p_txt, int p_idxStart, int p_lenPickChar
	;--------------------
	;	右から取り出す
	;--------------------
	if p_idxStart<0 {
		;右から取り出す場合は、strlenが遅いのでstrmidを使ったほうが速くなる。
		return strmid(p_txt, p_idxStart, p_lenPickChar)
	}

	;--------------------
	;	引数チェック
	;--------------------
	if p_lenPickChar<=0 {
		return ""
	}

	;--------------------
	;	出力初期化
	;--------------------
	;	出力する文字列
	sdim res_text, p_lenPickChar

	;--------------------
	;	左から取り出す
	;--------------------

	;	取り出す文字数を決定
	;バッファオーバーフロー対策
	i = varsize(p_txt)
	if i - p_idxStart - p_lenPickChar < 0 {
		;	文字数オーバーする場合
		l = i - p_idxStart
	} else {
		l = p_lenPickChar
	}

	;	文字列取り出し
	memcpy res_text, p_txt, l, 0, p_idxStart

	return res_text

#global
;#endif	;__MODULE_NAME__

;-------------------------------------------------------------------------------
;
;	仮実行スクリプト(デバッグ作業用)
;

;#####################################################################
;ここにはデバッグ作業用のスクリプトを記述します。
;ここを有効にするとこのファイル単独での実行が可能になります。
;
;0	:リリースモード 本体側から#includeで連結して動作させる場合です。
;1	:デバッグモード このファイル単品で動作確認が出来ます。
#if 0
	b = "ABCDEF"
	mes b
	mes "- strmid"
	mes strmid(b,-1,3)   ; 右から3文字を取り出す
	mes strmid(b,1,3)    ; 左から2文字目から3文字を取り出す

	mes "- strmid2"
	mes strmid2(b,-1,3)   ; 右から3文字を取り出す
	mes strmid2(b,1,3)    ; 左から2文字目から3文字を取り出す

#endif
;#####################################################################

HSP MIDIキーボードの鍵盤入力を取得

; KORGのnanoKEY2でしか動作確認していないのでそこんとこよろしく
; 別にこれ↓やっておく必要ないんだけど渡された数値表示するよりはわかりやすいかと
	sdim code,64,128
	code(0x0)  = "c ","c#","d ","d#","e ","f ","f#","g ","g#","a ","a#","b ","c ","c#","d ","d#"
	code(0x10) = "e ","f ","f#","g ","g#","a ","a#","b ","c ","c#","d ","d#","e ","f ","f#","g "
	code(0x20) = "g#","a ","a#","b ","c ","c#","d ","d#","e ","f ","f#","g ","g#","a ","a#","b "
	code(0x30) = "c ","c#","d ","d#","e ","f ","f#","g ","g#","a ","a#","b ","c ","c#","d ","d#"
	code(0x40) = "e ","f ","f#","g ","g#","a ","a#","b ","c ","c#","d ","d#","e ","f ","f#","g "
	code(0x50) = "g#","a ","a#","b ","c ","c#","d ","d#","e ","f ","f#","g ","g#","a ","a#","b "
	code(0x60) = "c ","c#","d ","d#","e ","f ","f#","g ","g#","a ","a#","b ","c ","c#","d ","d#"
	code(0x70) = "e ","f ","f#","g ","g#","a ","a#","b ","c ","c#","d ","d#","e ","f ","f#","g "
	repeat length(code)
		code(cnt)=code(cnt)+" ("+(cnt/12-3)+")"
	loop

#define CALLBACK_NULL     0x00000000
#define CALLBACK_FUNCTION 0x00030000
#define MMSYSERR_NOERROR 0x0
#define MIM_DATA     0x3C3
#define MIM_ERROR    0x3C5
#define MIM_LONGDATA 0x3C4

	title "MIDIコントローラの入力取得"

#include "hscallbk.as"	;ちょくとさんのコールバックプラグイン
#include "winmm.as"

#uselib ""
#func clbkGetMidi "" int,int,int,int,int

	md_getmax = 24		; 同時認識最大キー数
	dim md_current,md_getmax
	repeat md_getmax
		md_current(cnt)=-1
	loop
	onexit *lEnd
	textMidiInfo = ""	; 画面に表示させる情報
	md_id = 0			; とりあえず0番目のデバイスを選択
	md_hnd = 0			; ハンドル

	; 有効なデバイス数を取得
	midiInGetNumDevs
	md_cnt = stat
	if md_cnt == 0 {
		dialog "接続されていません"
		goto *lEnd
	}

	; デバイスの情報を取得
	dim md_caps,11
	midiInGetDevCaps md_id, varptr(md_caps), 44
	md_caps_mid = md_caps(0) & 0xFF
	md_caps_pid = (md_caps(0)>>8) & 0xFF
	md_caps_ver = md_caps(1)
	sdim md_caps_name,32
	memcpy md_caps_name, md_caps, 32, 0, 8

	; デバイスの情報を表示
	font "meiryo",14
	objmode 2,1
	objsize 100,30
	pos ginfo_winx-110,10
	button gosub "リセット",*lMidiReset
	pos 10, 10
	mes "wMid : "+md_caps_mid
	mes "wPid : "+md_caps_pid
	mes "vDriverVersion : "+strf("%x",md_caps_ver)
	mes "szPname : "+md_caps_name

	; コールバック関数登録
	setcallbk procGetMidi, clbkGetMidi, *lGetMidi

	; 受付開始
	gosub *lMidiOpen

	stop

; デバイスの入力受け付け開始
*lMidiOpen
	; デバイスを開く
	midiInOpen varptr(md_hnd), md_id, varptr(procGetMidi), 0, CALLBACK_FUNCTION
	textMidiInfo = "\nmidiOpen : "+stat+"\nHndle : "+md_hnd
	if stat != MMSYSERR_NOERROR {
		dialog "midiInエラー"
		goto *lEnd
	}
	; デバイスの使用開始
	midiInStart md_hnd
	gosub *lDrawMidiInfo
	return

; デバイスの入力受け付け停止、情報リセット、閉じる
*lMidiClose
	if md_hnd!=0 {
		midiInStop md_hnd
		midiInReset md_hnd
		midiInClose md_hnd
	}
	return

; 意図的なリセット
; リセット直後に入力があるような状態は避けてください
*lMidiReset
	gosub *lMidiClose
	repeat md_getmax
		md_current(cnt)=-1
	loop
	gosub *lMidiOpen
	return

; 入力情報の表示
; 単純に textMidiInfo に入っている文字を描画するだけ
*lDrawMidiInfo
	redraw 0,0,240,640,480
	color 255,255,255 : boxf 0,240,640,480
	color 0,0,0
	pos  10, 240 : mes "Info : "+textMidiInfo
	pos 200, 240 : mes "現在入力中のキー"
	repeat md_getmax
		if md_current(cnt)!=-1{
			mes ""+code(md_current(cnt))
		}
		if (cnt\8)==7 : pos ginfo_cx+80,260
	loop
	redraw 1,0,240,640,480
	return

; コールバック
;	CALLBACK MidiInProc(
;		HMIDIIN hMidiIn,
;		UINT wMsg,
;		DWORD dwInstance,
;		DWORD dwParam1,
;		DWORD dwParam2
;	)
*lGetMidi
	clbk_md_hnd  = callbkarg(0)
	clbk_md_msg  = callbkarg(1)
	clbk_md_ins  = callbkarg(2)
	clbk_md_prm1 = callbkarg(3)
	clbk_md_prm2 = callbkarg(4)
	textMidiInfo = ""
	if clbk_md_hnd == md_hnd {
		; エラー
		if clbk_md_msg == MIM_ERROR {
			textMidiInfo = "\nエラー"
			textMidiInfo+= "\nParam1 : "   + strf("0x%X",clbk_md_prm1)
			textMidiInfo+= "\nParam2 : "   + strf("0x%X",clbk_md_prm2)
			gosub *lMidiReset
		; 情報取得
		} else:if clbk_md_msg == MIM_DATA {
			textMidiInfo+= "\nMIM_DATA"
			textMidiInfo+= "\nMsg : "      + strf("0x%X",clbk_md_msg)
			textMidiInfo+= "\nInstance : " + clbk_md_ins
			textMidiInfo+= "\nParam1 : "   + strf("0x%X",clbk_md_prm1)
			textMidiInfo+= "\nParam2 : "   + clbk_md_prm2+" ms"
			textMidiInfo+= "\n"

			; この辺はもしかするとデバイスによって異なるかも
			md_get_code  = (clbk_md_prm1>>8) & 0xFF		; 押したキー
			md_get_state = (clbk_md_prm1)>>4 & 0xF		; キーの押下状態
			md_get_gain  = (clbk_md_prm1>>16) & 0xFF	; 押下した強さ

			; 表示用に内容解析
			textMidiInfo+= "\n音 : "+code(md_get_code)
			if md_get_state == 9 {
				textMidiInfo+= "\n押した"
				_flag = 0
				_cur = -1
				repeat md_getmax
					if md_current(cnt)==md_get_code {
						_flag = 1
					} else:if _cur==-1 && md_current(cnt)==-1 {
						_cur = cnt
					}
					if _flag==1 && _cur!=-1 : break
				loop
				if _flag == 0 && _cur!=-1 {
					md_current(_cur) = md_get_code
				}
			} else:if md_get_state == 8 {
				textMidiInfo+= "\n離した"
				repeat md_getmax
					if md_current(cnt)==md_get_code {
						md_current(cnt) = -1
					}
				loop
			}
			textMidiInfo+= "\n強さ : "+strf("%d%%",md_get_gain*100/127)
		}
	}
	gosub *lDrawMidiInfo
	return

; 終了
*lEnd
	gosub *lMidiClose
	end

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 c4hspで作ったstrlen的な処理が標準命令より早い

/*// c4hsp で使ったCのソースコード
int func(unsigned char *str) {
	unsigned char *p = str;
	while ( *( p++ ) );
	return (p - str -1);
}
#define OPT maximum	// disable, small, fast, maximum (不使用, 最小化, 速度, 最大限の最適化)
#define LINE 8
#define VECTORTYPE ()
#define MODULE mod_strlen2
#define FUNC strlen2
*/
// c4hsp で出力した機械語モジュール
#ifndef strlen2
#module mod_strlen2
#uselib "kernel32.dll"
#func VirtualAllocmod_strlen2 "VirtualAlloc" int, int, int, int
#func VirtualFreemod_strlen2 "VirtualFree" int, int, int
#define NULL                   0x00000000
#define PAGE_EXECUTE_READWRITE 0x00000040
#define MEM_COMMIT             0x00001000
#define MEM_RESERVE            0x00002000
#define MEM_DECOMMIT           0x00004000
#define MEM_RELEASE            0x00008000
#deffunc mod_strlen2_destructor onexit
	if(NULL != strlen2_ptr) {
		VirtualFreemod_strlen2 strlen2_ptr, 20, MEM_DECOMMIT
		VirtualFreemod_strlen2 strlen2_ptr, 0, MEM_RELEASE
		strlen2_ptr = NULL
	}
	return
#deffunc mod_strlen2_constructor
	mod_strlen2_destructor
	VirtualAllocmod_strlen2 NULL, 20, MEM_RESERVE, PAGE_EXECUTE_READWRITE
	VirtualAllocmod_strlen2 stat, 20, MEM_COMMIT, PAGE_EXECUTE_READWRITE
	strlen2_ptr    = stat
	dupptr strlen2_bin, stat, 20, vartype("int")
	strlen2_bin(0) = $04244C8B, $108AC18B, $75D28440, $48C12BF9, $000000C3
	return
// マクロだったのを関数化した
#defcfunc strlen2 var s
	prm@mod_strlen2 = varptr(s)
	return callfunc(prm@mod_strlen2, strlen2_ptr@mod_strlen2, 1)
#global
mod_strlen2_constructor
#endif

#include "winmm.as"

	// 適当にテキスト作成
	mes "文字列作成中...\n"
	size = 1024 * 1024 * 100	; 100MB
	sdim a, size + 1
	memset a, 'a', size

	// 計測
	max = 10	; 10 回繰り返す。size * max で 1000MB相当
	mes "strlen 計測中..."
	timeGetTime :time1 = stat
	repeat max
		l1 = strlen(a)
	loop
	timeGetTime	:mes "所要時間:" + (stat - time1) + "ms" + ", 取得値:" + l1 + "byte"

	mes "strlen2 計測中..."
	timeGetTime	:time1 = stat
	repeat max
		l2 = strlen2(a)
	loop
	timeGetTime	:mes "所要時間:" + (stat - time1) + "ms" + ", 取得値:" + l2 + "byte"

HSP 【HSP3】Media Foundationを使用しての動画再生(修正)

#define IID_IMFPMediaPlayer "{A714590A-58AF-430a-85BF-44F5EC838D85}"
#usecom IMFPMediaPlayer IID_IMFPMediaPlayer "{}"
#comfunc IMFPMediaPlayer_Play 3
#comfunc IMFPMediaPlayer_Pause 4
#comfunc IMFPMediaPlayer_Stop 5
#comfunc IMFPMediaPlayer_FrameStep 6
#comfunc IMFPMediaPlayer_SetRate 10 float
#comfunc IMFPMediaPlayer_Shutdown 38
newcom iMFPlayer,IMFPMediaPlayer
#uselib "Mfplay"
#func MFPCreateMediaPlayer "MFPCreateMediaPlayer" wstr,int,int,int,int,var
#uselib "Mfplat"
#func MFStartup "MFStartup" int,int
#func MFShutdown "MFShutdown"
#define MFSTARTUP_NOSOCKET 0x1
#define MFSTARTUP_LITE (MFSTARTUP_NOSOCKET)
#define MFSTARTUP_FULL 0

	screen 0,800,800
	title "Media Foundation (1.3倍速再生サンプル)"
	LOADED=0
	onexit *lEnd
	objsize 100,24
	pos ginfo_winx-500,0
	button gosub "Load",*lFileLoad
	pos ginfo_winx-400,0
	button gosub "Play",*lPlay
	pos ginfo_winx-300,0
	button gosub "Pause",*lPause
	pos ginfo_winx-200,0
	button gosub "Stop",*lStop
	pos ginfo_winx-100,0
	button gosub "Step",*lStep
	gosub *lFileLoad
	stop
*lFileLoad
	dialog "mp4;*.avi;*.mpg;*.mpeg",16
	if stat=0{
		if LOADED{
			return
		}else{
			stop
		}
	}
	file=refstr
	gosub *lLoad
	IMFPMediaPlayer_SetRate iMFPlayer,1.3	;1.3倍速再生
	return
*lLoad
	if LOADED{
		gosub *lRelease
	}
	MFStartup
	MFPCreateMediaPlayer file, 1,0,0,hwnd,iMFPlayer
	;                         ↑0にすると自動再生しない
	LOADED=1
	return
*lRelease
	gosub *lStop
	IMFPMediaPlayer_Shutdown iMFPlayer
	MFShutdown
	return
*lPlay
	if LOADED : IMFPMediaPlayer_Play iMFPlayer
	return
*lPause
	if LOADED : IMFPMediaPlayer_Pause iMFPlayer
	return
*lStop
	if LOADED : IMFPMediaPlayer_Stop iMFPlayer
	return
*lStep
	if LOADED : IMFPMediaPlayer_FrameStep iMFPlayer
	return
*lEnd
	if LOADED{
		gosub *lRelease
	}
	mes "MFShutdown:"+stat
	end

JavaScript HSP3コンパイラfor EmEditorマクロ

//
// HSP3 コンパイラ for EmEditor マクロ
//
// compilerName にHSP3スクリプトエディタのパスを指定して使用してください。
//
var compilerName = "C:\\hsp332\\hsed3.exe";

// フルパスファイル名
strName = document.FullName;
// 拡張子名
ExtName = document.Name.replace(/^.*\./ , "").toUpperCase();

// 拡張子がHSPのものである場合、コンパイル実行
if ((ExtName == "HSP") || (ExtName == "AS")) {

	// 編集中のファイルのパスを取得
	document.CopyFullName();

	// HSP3スクリプトエディタを起動
	WshShell = new ActiveXObject( "WScript.Shell" );
	WshShell.Run( compilerName );
	// 「外部ファイル実行」を使ってコンパイル
	Sleep( 1000 );
	WshShell.SendKeys( "{F10}" );
	Sleep( 10 );
	WshShell.SendKeys( "^V" );
	Sleep( 10 );
	WshShell.SendKeys( "{TAB}" );
	Sleep( 10 );
	WshShell.SendKeys( "{-}" );	// 「オブジェクトファイルのみ作成」をOFF
	Sleep( 10 );
	WshShell.SendKeys( "{ENTER}" );
}

HSP HSPでAeroGlassに描画してみる(オブジェクト編)

#include "user32.as"
#define GWL_WNDPROC -4
#define WM_CREATE 0x1
#define WM_DESTROY 0x2

#uselib "uxtheme"
#cfunc BeginBufferedPaint "BeginBufferedPaint" int,int,int,int,int
#func EndBufferedPaint "EndBufferedPaint" int,int
#func BufferedPaintSetAlpha "BufferedPaintSetAlpha" int,int,int
#func BufferedPaintRenderAnimation "BufferedPaintRenderAnimation" int,int
#define BPBF_TOPDOWNDIB 2

#uselib "dwmapi"
#func DwmExtendFrameIntoClientArea "DwmExtendFrameIntoClientArea" int,int

#include "hscallbk.as"
#uselib ""
#func CallNew "" int,int,int,int

	;-- いつもの
	screen 0,580,160
	r=0,0,80,0
	DwmExtendFrameIntoClientArea hwnd,varptr(r)
	cls 4

	;-- コールバック関数
	setcallbk ProcNew, CallNew, *lCallNewWindowProc

	objx=200
	objy=50
	objsize objx,objy
	objmode 2,1 : font "meiryo",24,1+16	;-- みんな大好きメイリオ

	pos  10,10 : button gosub "透けるボタン",*lButton

	;-- ボタンのサブクラス化
	pos 310,10 : button gosub "透けないボタン",*lButton
	hButton=objinfo(stat,2)
	GetWindowLong hButton,GWL_WNDPROC
	dButtonProc=stat
	SetWindowLong hButton,GWL_WNDPROC,varptr(ProcNew)

	stop

*lButton
	dialog "Push"
	return
*lCallNewWindowProc
	if callbkarg(0)=hButton{	;--該当ボタン
		;-- WM_PAINT以外は通常通りの動作をする
		CallWindowProc dButtonProc,callbkarg(0),callbkarg(1),callbkarg(2),callbkarg(3)
		ret=stat
		if callbkarg(1)=0xf{	;--WM_PAINT
			r=5,5,objx-5,objy-5	;-- ボタンの角が円いので少し小さめにしておかないと余計な部分まで不透明になる
								;   ……はずなのだが、HSPのボタンはなぜか下地が見えちゃってるので意味なし
			pp=16,0,0,0
			mhdc=0
			GetWindowDC hButton
			dcButton=stat
			pb=BeginBufferedPaint(dcButton,varptr(r),BPBF_TOPDOWNDIB,varptr(pp),varptr(mhdc))
			if pb!0{
				CallWindowProc dButtonProc,callbkarg(0),callbkarg(1),mhdc,callbkarg(3)
				ret=stat
				BufferedPaintSetAlpha pb,varptr(r),255
				EndBufferedPaint pb,1
			}
			ReleaseDC hButton,dcButton
		}
	}
	return ret

HSP HSPでAeroGlassに描画してみる

#include "a2d.hsp"

#module
#uselib "user32"
#func GetDC "GetDC" int
#func ReleaseDC "ReleaseDC" int,int
#deffunc alSetAeroGlass
	alReleaseAeroGlass
	wid=ginfo_sel
	GetDC hwnd
	dc=stat
	return dc
#deffunc alReleaseAeroGlass onexit
	old_wid=ginfo_sel
	if dc:gsel wid:ReleaseDC hwnd,dc:gsel old_wid
	return 0
#deffunc _alCopyImageToAeroGlass int p1, int x, int y, int w, int h
	if imgValidArr@a2d(p1) {
		; 実スクリーンの Graphics 作成
		gsel wid
		GdipCreateFromHDC@a2d dc, varptr(tmpGraphics)

		if tmpGraphics {
			GdipSetCompositingMode@a2d tmpGraphics, 1
			GdipDrawImageRectRectI@a2d tmpGraphics, imgImageArr@a2d(p1), x, y, w,h, x, y, w,h, UnitPixel@a2d, pImageAttr@a2d, 0, 0
			GdipDeleteGraphics@a2d tmpGraphics	; tmpGraphics を削除
			tmpGraphics = 0
			return 0
		}
	}
	return -1
#global
#define alCopyImageToAeroGlass(%1,%2=ginfo_cx,%3=ginfo_cy,%4=ginfo_winx,%5=ginfo_winy) _alCopyImageToAeroGlass %1,%2,%3,%4,%5

#uselib "dwmapi"
#func DwmIsCompositionEnabled "DwmIsCompositionEnabled" int
#func DwmExtendFrameIntoClientArea "DwmExtendFrameIntoClientArea" int,int
	aerorect=-1,0,0,0
	wx=640 : wy=480
	screen 0,wx,wy,2
	cls 4 : gsel 0,1
	gosub *lAeroChk
	oncmd gosub *lAeroChk,0x031E	;Aeroの状態が変わった時
	oncmd gosub *lWRedraw,0x3		;画面外に行った時に消えるので描画しなおす(高負荷なので工夫して)
	alSetAeroGlass
	alCreateImage 0,wx,wy
	repeat 10
	_y=cnt
	repeat 10
	_x=cnt
	alHsvColor ((_y*10+_x)*2)\192,255,100+_y*15,200-_x*15
	alFillRect _x*(wx/10)+1,_y*(wy/10)+1,(wx/10)-1,(wy/10)-1
	loop
	loop
	alFont "meiryo",60 : alColor 0,0,0,255
	alDrawText "そしてこの\n黒文字である\n透けていないでしょ?",0,0,wx,wy,1,1
	repeat
	gosub *lWRedraw
	wait 5	;最小化からの復帰時の再描画がうまくいかないのでとりあえずループ監視
	loop
	stop

*lWRedraw
	// 再描画(Aero環境の場合、画面外にウインドウが行くと再描画が必要)
	if aero{
		alCopyImageToAeroGlass 0
	}else{
		alCopyImageToScreen 0,0
		redraw
	}
	return

*lAeroChk
	DwmIsCompositionEnabled varptr(aero)
	if aero!0{
		color 0,0,0 : boxf
		DwmExtendFrameIntoClientArea hwnd,varptr(aerorect)
		wait 1	;何故かgselでウインドウ表示後ウエイトを入れないと中身が表示されない
				;(生成時のアニメーション中だとだめ?最小化から復帰アニメーション中もだめっぽい)
	}else{
		color 0,0,0 : boxf
	}
	gosub *lWRedraw
	return

HSP Unicodeのやつデコーダ

#include "user32.as"
#include "hspinet.as"
#include "mod_regexp.as"
font "Meiryo",13

;buf=0x3042,0x3044,0x3046,0x3048,0x304a,0x304b,0x304d,0x304f,0x3051,0x3053

netinit
neturl "http://api.twitter.com/1/statuses/show/"

netrequest_get "219126197236408321.json"

repeat
netexec res
if res : break
await 50
loop

netgetv buf

jsonopen pointer,buf
jsonnkf "Ws"

jsongets text,"text",pointer
jsonout text2,pointer

jsonclose

//JSON→平文変換
mes text

//JSONから\u****形式を取り出す
split buf,"\"text\":\"",a,b
split b,"\"",textjson,c

mes "------------------------------------------------------"
mes textjson
mes "------------------------------------------------------"

val = replace(""+textjson,"^\\\\u","0x")
val = replace(""+val,"\\\\u",",0x")
val = replace(""+val,"0x", "$")
objsize 550,30
input val
split val, ",", val_ary
sdim val_int, length(val_ary)*2+1
foreach val_ary
	wpoke val_int, 2*cnt, int(val_ary(cnt))
loop
;val=0x3042,0x3044,0x3046,0x3048,0x304a,0x304b,0x304d,0x304f,0x3051,0x3053

//JSON→DrawTextWで描画(?)
rc=0,150,400,300
DrawTextW hdc,varptr(val_int),-1,varptr(rc),0
redraw 1

HSP [HSP]UACシールドボタン

	#define BCM_FIRST 0x1600
	#define BCM_SETSHIELD 0x1600+0x000C
	objsize 100,35
	pos 10,10:button"Test",*owari
	sendmsg objinfo_hwnd(0),BCM_SETSHIELD,0,1	//lParam=True
	//ButtonオブジェクトにBCM_SETSHIELDを送り、lParamにTrue。
	//lParamをFalseにすることによってシールドマークが消去できる
	stop
*owari
	end
Total Pages: 1 / 212

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

タグ

最近投稿されたコード