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

HSP awaitの代わりにsleepで待機する

// 
// [ Infomation ]
//  Name      : asleep命令のサンプル
//  SubName   : 
//  Version   : 
//  copyright : 
// 
// [ Update history ]
// 2013/07/27 : 1.0 : サンプル完成。
// 
// [ Comment ]
// 


#include "kernel32.as"
#include "winmm.as"




#module
// ------------------------------------------------------------ //
//
// 命  令  :一定の時間で待つ
//
// 引  数  :int waittime = 0~ : 待ち時間(1ms単位)
//
// 返り値  :stat
//           Sleep関数で実際に待機させた時間。
//
// 機能説明:プログラムの実行を一定時間だけ中断します。
//           
//           await命令と同様に、前回asleepした時間からの待ち時間を指定します。
//           これにより、描画速度の違いなどから時間が早く過ぎることを防止することができます。
//           リアルタイムで更新される画面などの速度を一定に保つ時に使用します。
//           
//           await 0 の代わりにはなりません。長い時間ループが起こる可能性がある場所には
//           waitかawait命令も入れるようにしてください。
//           
//           await命令と異なりon~系の命令によるジャンプを受けつけません。on~系の命令を使う際は、
//            asleep 16
//            await 0
//           などのようにawait命令を続けて記述してください。
//           
//           awati命令で待機中にon~系でジャンプすると待機が解除されてしまいます。
//           このためイベントが発生するとfps値が上昇する現象が起こります。
//           これに対してasleep命令ではon~系でのジャンプでも待機が解除されることはありません。
//           イベント発生によるfps値上昇を防ぐことができます。
//
// ------------------------------------------------------------ //
#deffunc asleep int waittime
	// 実際に待機する時間を算出
	timeGetTime
	tm = stat
	wt  = waittime - (tm - tm0)
	if wt<0 : wt = 0
	
	// 待機
	Sleep wt
	
	timeGetTime
	tm0 = stat
	return wt

#global

;---------------------------------------------------

#include "d3m.hsp"

#const LOGCNT 50

dim wts, LOGCNT
wtsid = 0

// 1ループにかける時間
waittime = 33	// 30 fps
;waittime = 16	// 60 fps
;waittime = 100

onkey gosub *key
k = 0

 
*main
	redraw 1

	// 待機
	asleep waittime
	wt = stat
	
	await 0
	redraw 0 : color 255, 255, 255 : boxf : color : pos 0,0
 
	frame++
	mes "frame : "+frame
	mes "hit : " + k
	mes "" + d3getfps() + " fps"


	// ウェイト時間表示
	wtsid++
	if wtsid >= LOGCNT : wtsid = 0
	wts(wtsid) = wt
	
	av=0.0
	wtmax=0
	wtmin=1000
	// 実際にSleep関数に指定された待機時間をグラフ表示
	pos 100,0
	repeat LOGCNT
		line ((double(ginfo_winx)-100)/LOGCNT)*cnt + 100, wts(cnt)*1
		av += double(wts(cnt))
		if wtmax < wts(cnt) : wtmax = wts(cnt)
		if wtmin > wts(cnt) : wtmin = wts(cnt)
	loop
	
	// 実際にSleep関数に指定された待機時間
	pos 0,100
	mes "wait時間 = " + wt + " msec"
	mes "wait平均 = " + (av/LOGCNT) + " msec"
	mes "wait max = " + wtmax + " msec"
	mes "wait min = " + wtmin + " msec"
	mes "max - min= " + (wtmax-wtmin) + " msec"

	goto *main

// キー入力イベント
*key
	k++
;	Sleep 5
	return

HSP イベントドリブンではawaitが中断される

onkey gosub *key
k = 0

*main
	redraw 1
	await 1000	;わかりやすいよう極端に長いwait
	redraw 0 : color 255, 255, 255 : boxf : color : pos 0,0

	frame++
	mes "frame : "+frame
	mes "hit : " + k

	goto *main


*key
	k++
	return

HSP うっかり

	sdim test, 64
	repeat 8
		test += "testtest"
	loop
	mes "元の文字列サイズ: " + strlen(test)
	
	// 64バイトコピーしているはずが、表示は65バイトになる
	sdim copy, 64	// sdim copy, 64 + 1 とすべき(NULL文字の分)
	memcpy copy, test, 64, 0, 0
	mes "コピーした文字列サイズ(memcpy): " + strlen(copy)
	
	// こっちは平気
	copy2 = test
	mes "コピーした文字列サイズ(代入): " + strlen(copy2)

HSP 【HSP3】HSPからIHTMLDocument(HTMLパーサー)を使ってみる

#define IID_IHTMLDocument "{626FC520-A41E-11CF-A731-00A0C9082637}"
#define IID_IHTMLDocument2 "{332C4425-26CB-11D0-B483-00C04FD90119}"
#define IID_IHTMLDocument3 "{3050f485-98b5-11cf-bb82-00aa00bdce0b}"
#define IID_IHTMLDocument4 "{3050f69a-98b5-11cf-bb82-00aa00bdce0b}"
#define CLSID_HTMLDocument "{25336920-03F9-11CF-8FD0-00AA00686F13}"
#usecom IHTMLDocument IID_IHTMLDocument CLSID_HTMLDocument
#usecom IHTMLDocument2 IID_IHTMLDocument2 CLSID_HTMLDocument
#usecom IHTMLDocument3 IID_IHTMLDocument3 CLSID_HTMLDocument
#usecom IHTMLDocument4 IID_IHTMLDocument4 CLSID_HTMLDocument
#comfunc IHTMLDocument4_createDocumentFromUrl 8 int, int, int
#uselib "urlmon"
#func CreateURLMoniker "CreateURLMoniker" int, wstr, int
#uselib "ole32"
#func CreateBindCtx "CreateBindCtx" int, int
#define IID_IMoniker "{0000000f-0000-0000-C000-000000000046}"
#define IID_IBindCtx "{0000000e-0000-0000-C000-000000000046}"
#define IID_IPersistMoniker "{79eac9c9-baf9-11ce-8c82-00aa004ba90b}"
#define STGM_READ 0x00000000
#define STGM_READWRITE 0x00000002
#usecom IPersistMoniker IID_IPersistMoniker
#comfunc IPersistMoniker_Load 5 int, int, int, int
#comfunc IPersistMoniker_Release 2
#usecom IMoniker IID_IMoniker
#comfunc IMoniker_Release 2
#usecom IBindCtx IID_IBindCtx
#comfunc IBindCtx_Release 2

	// http://eternalwindows.jp/browser/mshtml/mshtml01.html
	
	url = "http://hsp.tv/"
	
	newcom pDoc, IHTMLDocument2
	
	ppMoniker = 0
	CreateURLMoniker 0, url, varptr(ppMoniker)
	newcom pMoniker, IID_IMoniker, -1, ppMoniker
	
	ppBindCtx = 0
	CreateBindCtx 0, varptr(ppBindCtx)
	newcom pBindCtx, IID_IBindCtx, -1, ppBindCtx
	
	querycom pPersistMoniker, pDoc, IPersistMoniker
	IPersistMoniker_Load pPersistMoniker, 0, ppMoniker, ppBindCtx, STGM_READWRITE
	delcom pPersistMoniker
	delcom pBindCtx
	delcom pMoniker
	
	// 準備が完了するまで待つ
	repeat 
		if pDoc("readyState") == "complete" : break
		wait 10
	loop
	
	pBody = pDoc("body")
	mes pBody("innerHTML")

HSP 同じラベル名を使う

#module
#define WM_LBUTTONDOWN	$00000201	;マウス左ボタン押下

#deffunc m_setup
	oncmd gosub *On_WM_LBUTTONDOWN,  WM_LBUTTONDOWN	;マウス左ボタン押下
	return

*On_WM_LBUTTONDOWN
	mes "click !"
	return

#global
;----
m_setup
gosub *On_WM_LBUTTONDOWN
stop

;モジュールの外なので同じラベル名が使用出来る!
*On_WM_LBUTTONDOWN
	mes "hogehoge"
	return

HSP (しょぼいカレンダー)番組名から、番組名とTIDを取得するサンプル

#include "encode.as"
#uselib "urlmon.dll"
#func URLDownload "URLDownloadToFileA"int,str,str,int,int
#uselib "wininet.dll"
#func DeleteUrlCacheEntry "DeleteUrlCacheEntryA" str
#include "user32.as"
#include "gdi32.as"
#include "kernel32.as"

#define DT_WORDBREAK		0x00000010
#define DT_EDITCONTROL		0x00002000
#module
// TsubuyakiSoup.as から抜き出し
#defcfunc form_encode str p1, int p2
/*
09 az AZ - . _ ~
はそのまま出力
*/
fe_str = p1
fe_p1Long = strlen(p1)
sdim fe_val, fe_p1Long*3
repeat fe_p1Long
	fe_flag = 0
	fe_tmp = peek(fe_str, cnt)
	if (('0' <= fe_tmp)&('9' >= fe_tmp)) | (('A' <= fe_tmp)&('Z' >= fe_tmp)) | (('a' <= fe_tmp)&('z' >= fe_tmp)) | (fe_tmp = '-') | (fe_tmp = '.') | (fe_tmp = '_') | (fe_tmp = '~') :{
		poke fe_val, strlen(fe_val), fe_tmp
	} else {
		if fe_tmp = ' ' {
			if p2 = 0 : fe_val += "&"
			if p2 = 1 : fe_val += "%20"	//空白処理
		} else {
			fe_val += "%" + strf("%02X",fe_tmp)
		}
	}
loop
return fe_val
#deffunc mesWptr int ptr
	// ウニコードで描画する
	rect = ginfo_cx, ginfo_cy, ginfo_winx, ginfo_winy
	DrawTextW hdc, ptr, -1, varptr(rect), 0
	// redraw の現在フラグ取得
	mref BMSCR, 96 + ginfo(3)
	redraw (BMSCR(19)!=1)
	// 書いた分だけカレントポジションを移動する
	lstrlenW ptr
	GetTextExtentPoint32W hdc, ptr, stat, varptr(rect)
	pos ginfo(22), ginfo(23) + rect(1) 
return
#global


// 検索用名前
input_name = "くじびき"
;input_name = "ニャル子"

// UTF-8に返還する必要あり
sdim utf8, 1024
sjis2utf8n utf8, input_name
url = "http://cal.syoboi.jp/json?Req=TitleSearch&Search="+form_encode(utf8, 1)+"&Limit=15"

URLDownload 0, url, "tmp.json", 0, 0

notesel buf
noteload "tmp.json"

newcom mssc, "MSScriptControl.ScriptControl"
mssc("Language") = "JScript"
/*
js = {"function getTID(p1){
	var json = eval("("+p1+")");
	var res = "";
	for(var key in json.Titles){
		res += key.replace(/[\\n\\r]/g,"")+"\\r\\n";
		res += json.Titles[key].Title+"\\r\\n";
	}
	return res;
}"}
*/
js = {"function getTID(p1){
	var json = eval("("+p1+")");
	var res = "";
	var list = new Array();
	var i = 0;
	for(var key in json.Titles){
		list[i] = { tid: parseInt(key, 10) , title: json.Titles[key].Title };
		i++;
	}
	return list;
}"}
	
mssc->"addCode" js

comres res
mssc->"Run" "getTID", buf

repeat res("length")
	pArray = res(""+cnt+"")
	// unicodeのまま取得する必要があるので、.を使う。
	// ないとSJISに変換されて、ハートなどが文字化ける
	pTitle = pArray(".title")
	mes "TID: "+pArray("tid")
	// ユニコード 対応の為
	mesWptr pTitle("bstrptr")	// unicode で格納された文字列のポインタ
loop

HSP HSPでMecab(形態素解析エンジン)を使ってみるサンプル

#uselib "libmecab.dll"
#cfunc global mecab_new "mecab_new" int, str
#cfunc global mecab_new2 "mecab_new2" str
#cfunc global mecab_sparse_tostr "mecab_sparse_tostr" int, str
#func global mecab_destroy "mecab_destroy" int
#cfunc global mecab_strerror "mecab_strerror" int
#module mecab
#defcfunc MecabParse str _in
	if (p_mecab_t != 0){
		mecab_destroy p_mecab_t
		p_mecab_t = 0
	}
	p_mecab_t = mecab_new2("");"--userdic=wikipedia.dic"
	if p_mecab_t == 0{
		dupptr e, mecab_strerror(0), 4096, 2
		dialog e : end
	}
	p_result = mecab_sparse_tostr(p_mecab_t, _in)
return p_result
#deffunc GetMecabResult int _ptr, array _res, array _pos, array _read
	if _ptr == 0 : return 0
	dupptr st_result, _ptr, 4096, 2
	LF = "" : poke LF, 0, 0x0A	// LF(Unix)
	sdim res : sdim _res, 256: sdim _pos, 64 : sdim _read, 256 : i = 0
	split st_result, LF, res
	repeat length(res)
		split res(cnt), "\t", res2
		if res2(0) == "EOS" : i = cnt : break
		_res.cnt = "" + res2(0)
		sdim res3, 256, 9
		split res2(1), ",", res3 
		_pos.cnt = "" + res3.0
		_read.cnt = "" + res3.7
	loop
return i
#deffunc MecabClose int _ptr
	mecab_destroy _ptr
return
#global

GetMecabResult MecabParse("花子さんがトイレで雑談してたよ!"), w, p, r

repeat stat
	mes w(cnt) + "\t" + p(cnt) + "\t" + r(cnt)
loop

HSP dupptr 失敗

#module
#defcfunc sizeOfType int vt
  assert (1 <= vt && vt <= 4) // ← コメントアウトするとエラーにならない
  return 4
#global

  v = 1
  dupptr r, varptr(v), sizeOfType(vartype(v))
  // r が正常に作成されない
  mes r //→ システムエラー(1)

HSP 【HSP3】Bingの日替わり背景のURLを取得するサンプル

#uselib "urlmon.dll"
#func URLDownload "URLDownloadToFileA"int,str,str,int,int

	axobj ie, "Shell.Explorer.2", 0, 0
	ie->"Navigate" "http://www.bing.com/"
	
	repeat
		wait 1
		if ie("Busy") == 0 : break
	loop
	pDoc = ie("Document")
	repeat
		wait 1
		if pDoc("readyState") == "complete" : break
	loop
	
	comres pDiv
	pDoc->"getElementById" "bgDiv"
	
	if varuse(pDiv) == 0 : dialog "仕様変更?" : end

// 手抜き(無限ループする可能性あり)
*check
	pStyle = pDiv("style")
	url = pStyle("background-image")
	
	if url == "" {
		wait 10
		goto *check
	}
	
	// ぽいっとな
	delcom pStyle
	delcom pDiv
	delcom pDoc
	delcom ie
	
	// 手抜き文字列除去
	url = strtrim(url, 0, 'u')
	url = strtrim(url, 0, 'r')
	url = strtrim(url, 0, 'l')
	url = strtrim(url, 0, '(')
	url = strtrim(url, 0, ')')

	dialog url
	
	// ダウンロードして表示してみる
	exist "tmp.jpg"
	if strsize != -1 : delete "tmp.jpg"
	URLDownload 0, url, "tmp.jpg", 0, 0
	exist "tmp.jpg"
	if strsize == -1{
		dialog "仕様変更?" : end
	}else{
		cls
		picload "tmp.jpg"
	}

HSP 【HSP3】Ping送信 v2

#module 
#uselib "ws2_32.dll"
#cfunc WSAStartup "WSAStartup" int, sptr
#func WSACleanup "WSACleanup"
#cfunc inet_addr "inet_addr" str
#cfunc gethostbyname "gethostbyname" str
#uselib "icmp.dll"
#cfunc IcmpCreateFile "IcmpCreateFile"
#cfunc IcmpSendEcho "IcmpSendEcho" int, int, str, int, int, var, int, int
#func IcmpCloseHandle "IcmpCloseHandle" int
#deffunc InitPing
	sdim WSAData, 400
	if WSAStartup(0x0101, varptr(WSAData)) != 0{
		return -1
	}
	SetPingSendData "ICMP SEND DATA"
return 0
#deffunc ExitPing onexit 
	WSACleanup
return
#deffunc SetPingSendData str data
	send_data = data
	recv_size = 28 + strlen(send_data) + 1
return 0
#defcfunc GetAddr str addr
	int_addr = 0
	int_addr = inet_addr(addr)
	if int_addr != 0{
		ret = gethostbyname(addr)
		if ret != 0{
			dupptr tmp, ret + 12, 4
			dupptr ret, tmp, 4
			dupptr int_addr, ret, 4
		}else{
			return 0
		}
	}
return int_addr
#deffunc Ping var ms, int _int_addr, int timeout
	dim recv_data, (recv_size / 4) + 1
	hIcmp = IcmpCreateFile()
	ret = IcmpSendEcho(hIcmp, _int_addr, send_data, strlen(send_data), 0, recv_data, recv_size, timeout)
	if (ret != 0) {
		ms = recv_data.2
	}else{
		return -1
	}
	IcmpCloseHandle hIcmp
return 0
#global
	// IPv6には非対応です
	
	// 初期化
	InitPing

	// xn--n8j3azcmra9bymod5gnkxgnr.com -> こんなアドレスないってばよ.com
	ping_addr_list.0 = "127.0.0.1", "www.google.co.jp", "www.yahoo.co.jp"
	ping_addr_list.3 = "www.microsoft.com", "329.932.129.848", "::1"
	ping_addr_list.6 = "xn--n8j3azcmra9bymod5gnkxgnr.com"
	
	repeat length(ping_addr_list)
		mes ping_addr_list(cnt) + " に ping を送信しています..."
		// ping してみる
		Ping time, GetAddr(ping_addr_list(cnt)), 1000	// タイムアウト1秒
		if stat != -1{
			mes "-> " + time + " ms"
		}else{
			mes "-> ping 失敗"
		}
		mes "------------------------------------------"
	loop
Total Pages: 10 / 23« 先頭...8910111220...最後 »

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

タグ

最近投稿されたコード