|
|
|
2015/11/12(Thu) 18:18:41|NO.72960
前スレは以下です。
http://hsp.tv/play/pforum.php?mode=all&num=70762
ルールは以下の2つです。
・ソースコード以外の議論(著作権・マナー等)や話は行わないでください。
・このスレッドに投稿されたソースコードは著作権に関して記載されていない場合はパブリックドメイン(著作権フリー)とします。
ここからは飽くまでも「お願い」です。
1行あたり最大100byt(半角100文字、全角50文字)程にお願いします。
それ以上だとページのレイアウトが崩れ、見づらくなってしまいます。
ソースコードの長さは300行以上の場合、他のサイトに記載しURLを貼って頂けると、
「めっちゃスクロースしなきゃいけないしこのスレ重すぎ！」という事態を避けることが出来ます。
例えばGoogleDrive、OneDrive等にソースコードを投稿し、一般公開するという方法です。
この方法の場合、バグが後から見つかっても簡単に修正できるという利点もあります。
|
|
|
2015/11/12(Thu) 18:42:19|NO.72962
X軸、Y軸のマウス感度を個別に調整できます。
コメントアウトしている部分を無くせばウィンドウ単位でもできるます。
#include "user32.as"
ウィンドウ名="メモ帳"
X倍率="2.0"
Y倍率="2.0"
pos 5,10:mes "対象ウィンドウ:"
pos 5,40:mes "X制限量:"
pos 5,70:mes "Y制限量:"
pos 130,10:input ウィンドウ名,100,20,100
pos 70,40:input X倍率,50,20,5
pos 70,70:input Y倍率,50,20,5
中心mx=double(ginfo_mx)
中心my=double(ginfo_my)
mxbac=ginfo_mx
mybac=ginfo_my
acwinT=""
gsel 0,2
repeat
/*if cnt\100000=0:{//アクティブウィンドウの検出
GetForegroundWindow
hnd = stat
a = ""
z = 128
GetWindowText hnd, varptr(acwinT), z
}
if instr(acwinT,0,ウィンドウ名)!-1:{
title "制限有効 アクティブウィンドウ:"+acwinT+""*/
mx=ginfo_mx
my=ginfo_my
中心mx+double(mx-中心mx)/limitf(double(X倍率),0.1,20.0)
中心my+double(my-中心my)/limitf(double(Y倍率),0.1,20.0)
mouse_event $1 | $1, int(中心mx-mx), int(中心my-my), 0, 0
/*}else:title "制限無効 アクティブウィンドウ:"+acwinT+""*/
await
loop
|
|
|
2015/11/12(Thu) 20:09:27|NO.72965
質問
１：「ちょっとした」の意味合いは？
○数千行もあるが内容は大したことの無い「ちょっとした」
○十数行だけど、あると便利な「ちょっとした」
○いつも多用している安定した「ちょっとした」
○わざわざ考えた不安定で不具合の多い「ちょっとした」
２：「ソースコードの議論」なら延々と続けても良い？
多少の修正はしょうが無いとしても、延々と「ああでもないこうでもない」の
議論を繰り返されるのはスレタイに反するのでは？
議論している本人はスレの最後の方だけ見れば良いけど、初めて見る人はスレ
の最初から見ないと意味が分からない。
前のスレでも書きましたが、案の定の後半でしたよ？
この辺をどう考えるのかはスレ主の自由ですが、「投稿する」というスレタイ
なら、本来は「議論も禁止するべき」という個人的意見です。
|
|
|
2015/11/12(Thu) 20:16:41|NO.72966
llmod3/console.hspを使わなくてもできる「組み込みコンソール」
HSPで作っている，Donaldowsに実装されているコマンドプロンプトは，wparam
でキー判定をして，そのキー番号の文字列を返しますが，それは大変複雑な仕組みです。
今回のソースでは，キーボードの番号をそのままcnvwtos命令で参照します。
例：キーボード「A」キーは，wparam=65。UnicodeコードでAに変換
A⇒A
という風に，HSP 3.4で実装された機能で簡略化とソースの短縮に効果を発揮しています。
〔ソースコードURL〕 http://seatex.webcrow.jp/embed/source/konsole.hsp
〔ホームページ(工事中ですが)〕 http://seatex.webcrow.jp/
|
|
|
2015/11/12(Thu) 20:24:01|NO.72967
ごめんなさい，UnicodeコードでAに変換 と A⇒A の部分ですが
投稿時に，Unicode文字実体参照コードを＆ampで＆以降を実体参照コードとして認識
されないようにするはずだった部分をAと本当に記述したのでA⇒Aになりました。
|
|
|
2015/11/12(Thu) 20:49:42|NO.72968
>>KAさん
「ちょっとした」は「わざわざスレを立てる程でもない」という意味合いです。
従って数十行~400行位で、あると便利・いつも多用してる・不安定だけどもったいないから公開したい
というようなプログラムが対象です。
ソースコードの議論ですが、確かに書き方が曖昧でしたね。
会話のキャッチボールは合計5レスで収まるように努力してください。
この話に関して私はあと1レスを最後にします。
|
|
|
2015/11/12(Thu) 21:31:15|NO.72969
ソースコード以外の議論になってしまいますが、
今さらですがこうして一つの掲示板のスレッドに書きこむのは、HSPWikiに一覧をつくるなどしても探しにくく結局使われない気がします。わたしがこう書くのはおかしいかもしれませんが、少なくともわたしの場合あまりにも多くて使えません。
y.tackさんのWiki( http://zuzazann.boy.jp/wiki/)のようなところに書きこむのはどうでしょうか。ただy.tackさんのWikiの場合はy.tackさんに迷惑かもしれません。
わたしは管理者でもなんでもなくただのこの掲示板を使わせてもらっているだけですので、こんなことを書きこむのは余計なお世話かもしれません。迷惑であればこの投稿は削除します。
returnをつけ忘れた時に発見したちょっとしたこと
#deffuncの部分に上から入れば、引数のスタックをそのまま処理してくれる
#module
#deffunc hyouji str d
#deffunc dummy int h
dupptr moji,h,1,vartype("str")
mes moji
return
#deffunc hyouji2 int dd,int ddd
#deffunc dummy2 double hh
mes hh
return
#global
hyouji "文字を表示"
a=4.5
hyouji2 lpeek(a,0),lpeek(a,4)
|
|
|
2015/11/12(Thu) 21:47:04|NO.72970
僕のとこに載せるのは大歓迎ですｗ
逆にもう一個 ソレ用にpukiwiki用意した方がいいなら用意しますよーｗ
HSPwikiより僕んとこの方が良い理由はわかりませんがｗ
|
|
|
2015/11/13(Fri) 01:21:18|NO.72977
いい感じに議論ばかりのスレに…
「ちょっとしたソースコードを投稿するスレ【議論専用】」ってスレ作っといて、やり取りが一定数超えたら「じゃあ続きはあっちで！」って宣言して議論用スレに移動するようにすればいいと思う。
で、十分議論したら、戻ってきて結果をまとめて報告、とか、バグ修正が終わったスクリを投稿とか。
最初の「やり取りが一定数…」は、レスするときに今何回目とかあと何回とかカウントも書き込んでおくのもいいかも。
>今さらですがこうして一つの掲示板のスレッドに書きこむのは、HSPWikiに一覧をつくるなどしても探しにくく結局使われない気がします。
wikiに載せるにしても、分類整理しないと見つけられないでしょうね。
一覧作成はそのための準備かな。
|
|
|
2015/11/13(Fri) 16:23:23|NO.72983
昔作った素因数分解のスクリプトです。
数字を入れてリターンするだけ（反応が悪い）。
screen 0,420,75,0
objmode 2,0
title "因数分解"
TEX=""
NUM1=2
pos 0, 0 : input NUM1,100,25,10
pos 110, 5 : mes "入力は 2 から 2,147,483,647 までの整数"
pos 0,25 : mesbox TEX,420,50,0
repeat
wait 10
getkey KY,13
if ky=0 : continue
gosub *main
loop
stop
;-----------------------------------
*main
NUM=NUM1
if (2>NUM)|(NUM>$7FFFFFFF) {dialog "範囲が無効です",0 : return }
dim BNM,100,2 ;除数と乗数の入れ物
SNM=2 ;除数
QTY=0
TEX=""+NUM+" = "
repeat
;-----------------------------------
repeat ;同じ数字で割る
if (NUM\SNM)!0 : break ;割り切れ無い
BNM(QTY,0)=SNM ;割れた数字
BNM(QTY,1)=cnt+1 ;累乗数
NUM=(NUM/SNM) ;割り続ける
loop
if BNM(QTY,1)!0 : QTY+= ;項目数
if NUM=1 : break ;項目数
;-----------------------------------
if (NUM/(SNM+1))<(SNM) {;終了判断
BNM(QTY,0)=NUM ;残りの数字
BNM(QTY,1)=1 ;常に１
QTY+= ;項目数
break ;終わり
}
;-----------------------------------
if SNM>2 {SNM=SNM+2} ;２以上の偶数はとばす
if SNM=2 : SNM+= ;２以上の偶数はとばす
loop
;-----------------------------------
repeat QTY ;結果表示
TEX+=""+BNM(cnt,0)
if BNM(cnt,1)!1 {TEX=TEX+"^"+BNM(cnt,1)}
if (QTY-1)!cnt : TEX+=" * "
loop
;-----------------------------------
objprm 1,TEX
;-----------------------------------
return
;-----------------------------------
| |
|
|
2015/11/13(Fri) 23:16:56|NO.72997
レジストリのサブキーの一覧
#module
#uselib "kernel32.dll"
#cfunc LoadLibrary "LoadLibraryA" str
#cfunc GetProcAddress "GetProcAddress" sptr,str
#func FreeLibrary "FreeLibrary" sptr
#define MAX_PATH 260
#define HKEY_CLASSES_ROOT $80000000
#define HKEY_CURRENT_USER $80000001
#define HKEY_LOCAL_MACHINE $80000002
#define HKEY_USERS $80000003
#define HKEY_PERFORMANCE_DATA $80000004
#define HKEY_CURRENT_CONFIG $80000005
#define HKEY_DYN_DATA $80000006
#define KEY_ENUMERATE_SUB_KEYS $00000008
#define KEY_QUERY_VALUE $00000001
#deffunc getregkeylist array p1, str p2, int p3, local tmp, local regkeyname, local funcarg, local regsubname
#define listvar p1
#define regkeyname2 p2
#define option p3
#define p_advapi32_dll tmp.0
#define p_RegEnumKey tmp.1
#define p_RegOpenKey tmp.2
#define p_RegCloseKey tmp.3
#define p_RegQueryInfoKey tmp.4
#define h_subkey tmp.5
#define h_mainkey tmp.6
#define l_1st_back_slash tmp.7
#define l_subkeyindex tmp.8
#define l_callkekka tmp.9
#define l_kekka tmp.10
#define l_key_name_length tmp.11
dim tmp,12
dim funcarg,12
sdim regkeyname,MAX_PATH,2
l_kekka==-1
p_advapi32_dll=LoadLibrary("advapi32.dll")
if p_advapi32_dll{
regkeyname.0=regkeyname2
l_1st_back_slash=instr(regkeyname.0,,"\\")
if l_1st_back_slash>=0{
memcpy regkeyname.1,regkeyname.0,MAX_PATH-1-l_1st_back_slash,,l_1st_back_slash+1
poke regkeyname.0,l_1st_back_slash,0
}
h_mainkey=0
if regkeyname.0=="HKEY_DYN_DATA" : h_mainkey=HKEY_DYN_DATA
if regkeyname.0=="HKEY_CURRENT_CONFIG" : h_mainkey=HKEY_CURRENT_CONFIG
if regkeyname.0=="HKEY_PERFORMANCE_DATA": h_mainkey=HKEY_PERFORMANCE_DATA
if regkeyname.0=="HKEY_USERS" : h_mainkey=HKEY_USERS
if regkeyname.0=="HKEY_LOCAL_MACHINE" : h_mainkey=HKEY_LOCAL_MACHINE
if regkeyname.0=="HKEY_CURRENT_USER" : h_mainkey=HKEY_CURRENT_USER
if regkeyname.0=="HKEY_CLASSES_ROOT" : h_mainkey=HKEY_CLASSES_ROOT
if h_mainkey{
p_RegCloseKey =GetProcAddress(p_advapi32_dll,"RegCloseKey")
p_RegOpenKey =GetProcAddress(p_advapi32_dll,"RegOpenKeyExA")
p_RegEnumKey =GetProcAddress(p_advapi32_dll,"RegEnumKeyA")
p_RegQueryInfoKey=GetProcAddress(p_advapi32_dll,"RegQueryInfoKeyA")
if (p_RegQueryInfoKey!=0) & (p_RegCloseKey!=0) & (p_RegOpenKey!=0) & (p_RegEnumKey!=0){
funcarg.0=h_mainkey
funcarg.1=varptr(regkeyname.1)
funcarg.2=0
funcarg.3=KEY_ENUMERATE_SUB_KEYS | KEY_QUERY_VALUE
funcarg.4=varptr(h_subkey)
l_callkekka=callfunc(funcarg,p_RegOpenKey,5)
if l_callkekka==0{
funcarg.0=h_subkey
funcarg.1=0
funcarg.2=0
funcarg.3=0
funcarg.4=varptr(l_subkeyindex)//サブキーの数
funcarg.5=varptr(l_key_name_length)//一番名前が長いサブキーの名前の長さ
funcarg.6=0
funcarg.7=0//レジストリエントリーの数
funcarg.8=0//一番名前が長いレジストリエントリー(各値)の名前の長さ
funcarg.9=0
funcarg.10=0
funcarg.11=0
l_callkekka=callfunc(funcarg,p_RegQueryInfoKey,12)
if l_callkekka==0{
l_key_name_length++//NULL終端の分
if (option==2) | (option==3){
sdim regsubname,l_key_name_length
l_subkeyindex=0
funcarg.0=h_subkey
funcarg.2=varptr(regsubname)
funcarg.3=l_key_name_length
while
funcarg.1=l_subkeyindex
memset regsubname,0,l_key_name_length
l_callkekka=callfunc(funcarg,p_RegEnumKey,4)
if l_callkekka: _break
memcpy listvar(l_subkeyindex),regsubname,l_key_name_length
l_subkeyindex++
wend
}
l_kekka=l_subkeyindex
if option==1: l_kekka=l_key_name_length
}
funcarg.0=h_subkey
l_callkekka=callfunc(funcarg,p_RegCloseKey,1)
}
}
}
FreeLibrary p_advapi32_dll
}
return l_kekka
#global
//使用例
#define MAX_PATH 260
sdim applist1
sdim applist2
//HKEY_LOCAL_MACHINE側(全ユーザーに対して登録されている)
//サブキーの個数
getregkeylist applist,"HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Uninstall",0
applist1length=stat
//一番名前の長いサブキーの名前の長さ(NULL終端を含む)
getregkeylist applist,"HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Uninstall",1
applist1subkeylength=stat
//実際に取得
sdim applist1,applist1subkeylength,applist1length
getregkeylist applist1,"HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Uninstall",2
//HKEY_CURRENT_USER側(ログイン中のユーザーに対してだけ登録されている)
getregkeylist applist2,"HKEY_CURRENT_USER\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Uninstall",0
applist2length=stat
getregkeylist applist2,"HKEY_CURRENT_USER\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Uninstall",1
applist2subkeylength=stat
sdim applist2,applist2subkeylength,applist2length
getregkeylist applist2,"HKEY_CURRENT_USER\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Uninstall",2
//とりあえずつなげてリストにしてみる
sdim applist,(applist1length*(applist1subkeylength+2)) + (applist2length*(applist2subkeylength+2))
repeat applist1length
applist+=applist1.cnt+"\n"
loop
repeat applist2length
applist+=applist2.cnt
if cnt<(applist2length-1) : applist+="\n"
loop
cls
mes "ファイルの追加と削除に登録されているソフト情報一覧(順番はばらばら)"
mesbox applist,ginfo_winx,ginfo_winy-ginfo_cy,4
| |
|
|
2015/11/14(Sat) 08:29:28|NO.73007
KAさん、とりあえず速度を上げられないかいろいろ試してみます。
タイトルバーの文字列って素因数分解の間違いですよね？
確かに素因数分解も因数分解の一つですが。
|
|
|
2015/11/14(Sat) 20:58:45|NO.73018
>>確かに素因数分解も因数分解の一つですが。
昔、何かのためにちゃちゃっと作ったので適当です。
この手のソフトは案外良く見かけると思います。
内容的には「自然数Ｎの最大の約数は√Ｎより大きくは無い」という
処理を組み込んでいるだけの力業です。
|
|
|
2015/11/14(Sat) 22:25:07|NO.73021
ショートプログラムで使用した
なんちゃって3Dエンジンです。
ご自由にお使いください...
#module my3d
//my3dcamvec = 0.0 //カメラ向きx
//my3dcamang = 0.0 //カメラ向きy
//my3dcamx = 0.0 //カメラ位置x
//my3dcamy = 0.0 //カメラ位置y
//my3dcamz = 0.0 //カメラ位置z
//my3dx = 0.0 //変換後座標x
//my3dy = 0.0 //変換後座標y
#defcfunc my3dxyzset double set_x,double set_y,double set_z
set_to = sqrt((set_x * set_x) + (set_y * set_y))
set_tr = atan(set_x,set_y) + my3dcamvec
//my3dx = sin(set_tr) * set_to
my3dy = cos(set_tr) * set_to
//set_depth = limitf(1.0 - my3dy/1000,0,100)
set_depth = 1.0 - my3dy/1000
if (set_depth <= 0):return 1
my3dx = sin(set_tr) * set_to / set_depth + 320
my3dy = (set_z + my3dy * my3dcamang) / set_depth + 240
//return ((0 + my3dx+640) / 640) + ((0 + my3dy+480) / 480) - 2
return ((80 + my3dx+800) / 800) + ((60 + my3dy+600) / 600) - 2 //ちょっと画面外でも表示できるようにする
#deffunc my3dsetcam double cam_x , double cam_y , double cam_z , double cam_vec , double cam_ang
my3dcamx = cam_x - sin(-cam_vec) * 1000
my3dcamy = cam_y - cos(-cam_vec) * 1000
my3dcamz = 1.0 * my3dcamz + (cam_z - my3dcamz)/limitf(20-(s@/3),4,20)
my3dcamvec = cam_vec
my3dcamang = 1.0 * my3dcamang + (cam_ang - my3dcamang)/100
return
#deffunc my3dball double bl_x, double bl_y, double bl_z, double bl_r,double bl_o, int bl_no,double bl_depth
if (my3dxyzset(bl_x - my3dcamx,bl_y - my3dcamy,bl_z - my3dcamz) == 0 && bl_o / set_depth > bl_depth){
pos my3dx,my3dy
pset
celput 10,bl_no,bl_o / 32 / set_depth,bl_o / 32 / set_depth,bl_r
}
return
#deffunc my3dpset double bl_x, double bl_y, double bl_z
if (my3dxyzset(bl_x - my3dcamx,bl_y - my3dcamy,bl_z - my3dcamz) == 0){
pset 320 + my3dx,240 + my3dy
}
return
#deffunc my3dtexture array tx_arx, array tx_ary, array tx_arz, int tx_inx, int tx_iny
//表示画像値取得
//tx_intx = tx_inx*64
//tx_inty = tx_iny*64
tx_inx2 = tx_inx,tx_inx + 62,tx_inx + 62,tx_inx
tx_iny2 = tx_iny,tx_iny,tx_iny + 62,tx_iny + 62
//座標取得
tx_c = 0
repeat 4
if (my3dxyzset(tx_arx(cnt) - my3dcamx,tx_ary(cnt) - my3dcamy,tx_arz(cnt) - my3dcamz) == 1):tx_c = 0:break
tx_arx2(cnt) = 320 + my3dx
tx_ary2(cnt) = 240 + my3dy
if ((tx_arx2(cnt)+640)/640 == 1 && (tx_ary2(cnt)+480)/480 == 1):tx_c+
loop
//描画
if tx_c > 0:gsquare 10, tx_arx2, tx_ary2, tx_inx2, tx_iny2
return
#deffunc my3dline int int_x1, int int_y1, int int_z1, int int_x2, int int_y2,int int_z2
tx_c = 0
tx_c += my3dxyzset(int_x1 - my3dcamx,int_y1 - my3dcamy,int_z1 - my3dcamz)
tx = my3dx:ty = my3dy
tx_c += my3dxyzset(int_x2 - my3dcamx,int_y2 - my3dcamy,int_z2 - my3dcamz)
if (tx_c <= 1):line tx,ty,my3dx,my3dy
return
#global
| |
|
|
2015/11/15(Sun) 17:57:13|NO.73038
昔、専門的なちょっとした動機で作ったスクリプトです。
意味が分からない人は、空気の様に読み飛ばして下さい。
;===========================================================
;温度[℃]を入力し、様々な飽和水蒸気圧[hPa]の式を比較する。
;============================================================
#module
#defcfunc expc double B
return expf(B*logf(10))
#defcfunc expn double B
return expf(B)
#defcfunc exp double A,double B
return expf(B*logf(A))
#defcfunc logc double B
return logf(B)/logf(10)
#defcfunc logn double B
return logf(B)
#defcfunc log double A,double B
return logf(B)/logf(A)
#global
sdim TXT,25
input ｔ,100,20,5
button gosub "OK",*OK
stop
*OK
pos 100,0
ｔ=1.0*ｔ
Ｔ=ｔ+273.15
;============================================================
; 近似式
; Pws=A*10^(B*t/(C+t)) Tetens [1]
; Pws=A*EXP(B*t/(C+t)) FAO [2]
; Pws=10^(A-(B/(C+t))) Antonie[3]
;============================================================
; A B C Typ 温度
Pws= 6.1134 *expc( 9.7911 *ｔ/( 273.47 +ｔ )) : TXT( 0)=""+Pws+" [1] -70〜 0 VAISALA 霜点温度用"
Pws= 6.1162 *expc( 7.5892 *ｔ/( 240.71 +ｔ )) : TXT( 1)=""+Pws+" [1] -20〜 50 VAISALA"
Pws= 6.1078 *expc( 7.5000 *ｔ/( 237.30 +ｔ )) : TXT( 2)=""+Pws+" [1] -40〜 60 VAISALA"
Pws= 5.9987 *expc( 7.3313 *ｔ/( 229.10 +ｔ )) : TXT( 3)=""+Pws+" [1] 50〜100 VAISALA"
Pws= 5.8493 *expc( 7.2756 *ｔ/( 225.00 +ｔ )) : TXT( 4)=""+Pws+" [1] 100〜150 VAISALA"
Pws= 6.2301 *expc( 7.3033 *ｔ/( 230.00 +ｔ )) : TXT( 5)=""+Pws+" [1] 150〜180 VAISALA"
Pws= 6.1100 *expc( 9.5000 *ｔ/( 265.50 +ｔ )) : TXT( 6)=""+Pws+" [1] <0 Tetens 霜点温度用"
Pws= 6.1100 *expc( 7.5000 *ｔ/( 237.30 +ｔ )) : TXT( 7)=""+Pws+" [1] >0 Tetens"
Pws= 6.1100 *expc( 7.5000 *ｔ/( 240.90 +ｔ )) : TXT( 8)=""+Pws+" [1] ??? ???"
Pws= 6.1100 *expn( 17.2700 *ｔ/( 237.30 +ｔ )) : TXT( 9)=""+Pws+" [2] ??? FAO"
Pws= 6.1100 *expn( 17.5020 *ｔ/( 240.90 +ｔ )) : TXT(10)=""+Pws+" [2] ??? ???"
Pws= 6.1121 *expn( 17.5020 *ｔ/( 240.90 +ｔ )) : TXT(11)=""+Pws+" [2] ??? ???"
Pws=expc( 8.2030 -( 1735.74 /( 234.00 +ｔ))) : TXT(12)=""+Pws+" [3] ??? Antonie"
;============================================================
;多項式
;============================================================
A=0.0
A=Ｔ-(4.931358E-01)+(4.609430E-03)*Ｔ-(1.374645E-05)*exp(Ｔ,2)+(1.274321E-08)*exp(Ｔ,3)
A=-5.8002206E+03*exp(A,-1)-3.2136709-4.8640239E-02*A+4.1764768E-05*exp(A,2)-1.4452093E-08*exp(A,3)+6.5459673*logn(A)
Pws=expn(A) : TXT(13)=""+Pws
;ウェクスラー - ハイランド(Wexler-Hyland)の式
; 水と接する場合（0.01℃以上）
A=0.0
A= -5.8002206E+03*exp(Ｔ,-1)-3.2136709-4.8640239E-02*Ｔ+4.1764768E-05*exp(Ｔ,2)-1.4452093E-08*exp(Ｔ,3)+6.5459673*logn(Ｔ)
Pws=expn(A) : TXT(14)=""+Pws
; 氷と接する場合（0.01℃以下）
A=0.0
A= -5.6745359E+03*exp(Ｔ,-1)+1.7873545-9.6778430E-03*Ｔ+6.2215701E-07*exp(Ｔ,2)+2.0747825E-09*exp(Ｔ,3)-9.4840240E-13*exp(Ｔ,4)+4.1635019*logn(Ｔ)
Pws=expn(A) : TXT(15)=""+Pws
;第一科学
; 水と接する場合（0.01℃以上）
A=0.0
A= -6.0969385E+03*exp(Ｔ,-1)+1.6635794E+01-2.711193E-02*Ｔ+1.673952E-05*exp(Ｔ,2)+2.433502*logn(Ｔ)
Pws=expn(A) : TXT(16)=""+Pws
; 氷と接する場合（0.01℃以下）
A=0.0
A= -6.0245282E+03*exp(Ｔ,-1)+2.47218998E+01+1.0613863E-02*Ｔ-1.3198825E-05*exp(Ｔ,2)-4.9382577E-01*logn(Ｔ)
Pws=expn(A) : TXT(17)=""+Pws
; （蒸気１００−３７４℃）
A=0.0 : B=1.0-Ｔ/647.096
A= -7.85951783*B+1.84408259*exp(B,1.5)-1.17866497E+01*exp(B,3)+2.26807411E+01*exp(B,3.5)-1.59618719E+01*exp(B,4)+1.80122502E+00*exp(B,7.5)
A= 647.096*A/Ｔ+12.30428868
Pws=expn(A) : TXT(18)=""+Pws
;書名不明（手塚俊一・野路伸治・古杉豊 書）
; 水と接する場合（0.01℃以上）
A=0.0 : B=1.0-Ｔ/647.3
A= -7.6912346*B-2.6080237E+01*exp(B,2)-1.6817065E+02*exp(B,3)+6.4232855E+01*exp(B,4)-1.1896462E+02*exp(B,5)
C=(1.0+4.1671173*B+2.0975068E+01*exp(B,2))*(1.0-B)
D=B/(6.0+expc(9)*exp(B,2))
Pws=221200.0*expf(A/C-D) : TXT(19)=""+Pws
; 氷と接する場合（0.01℃以下）
A=273.15/Ｔ
Pws=expc(-9.09718*(A-1.0)-3.56654*logc(A)+8.76793E-01*(1.0-1.0/A)+logc(0.0060273))*1013.25 : TXT(20)=""+Pws
;---------------------------------
ALL=""
repeat 20
ALL+=TXT(cnt)+"\n"
loop
mesbox ALL,400,400
return
| |
|
|
2015/11/17(Tue) 01:23:31|NO.73076
・ファイルが無くてもエラーにはならない bload・picload
大抵その後の処理で問題が起こりますが、ファイル名・カレントフォルダが判る分修正しやすいかもです。
#module _mod_exist_load
#undef bload
#deffunc bload str p0, var pv, int p1, int p2, local a
exist p0 :if(strsize<0){
dialog strf("ファイルが見つかりません\n\"%s\"\n[%s]",p0,dir_cur),1,"bload" :return 0}
if(p1>0){a=p1}else{a=-1} :bload@hsp p0,pv,a,p2 :return stat
#undef picload
#deffunc picload str p0, int p1
exist p0 :if(strsize<0){
dialog strf("画像ファイルが見つかりません\n\"%s\"\n[%s]",p0,dir_cur),1,"picload" :return 0}
picload@hsp p0,p1 :return strsize
#global
・ウィンドウ内のオブジェクトの存在確認
/***************************************************************
■ ObjCheck( オブジェクトID[-1] ) = 0:無し / 0以外:有り
現在のHSPウィンドウ内に、指定IDのオブジェクトが存在するかを返します。
オブジェクトID省略(-1)時は、ウィンドウ内のオブジェクトの最大数を返します。
但しclrobjによる欠番も含まれる為、現存するオブジェクト数とは限りません。
■ ObjMax = オブジェクト最大数
上ののマクロです。やっぱり現存するオブジェクト数とは限りません。
***************************************************************/
#module _mod_exist_object
;--オブジェクト存在確認(objID) = 0:無し
#define global cType ObjCheck(%1=-1) _ObjCheck(%1)
#defcfunc _ObjCheck int p0, local a, local b
mRef b,67 :If(p0<0){Return b.72} :If(p0>=b.72){Return 0} :DupPtr a,b.71+p0*48+8,4
Return a
#define global ObjMax _ObjCheck(-1)
#global
・デバッグログに配列・バイナリ値を出力
/***************************************************************
■ LogArr 配列変数, 1行の表示数[8], "表示名", 開始要素[0], 表示数[0]
配列変数の各要素の内容をデバッグログに列挙します。
「1行の表示数」には1行当りに表示する要素の最大数を指定します。
整数配列且つ「1行の表示数」が負数の場合、16進数表記となります。
refstrに出力内容を返します。
■ LogBin 変数, "表示名", 開始位置[0], 表示数[0], 1行の表示数[16]
変数の内容を、1byte分ずつ16進数表記でデバッグログに表示します。
「開始位置」「表示数」「1行の表示数」はbyte単位指定です。
refstrに出力内容を返します。
***************************************************************/
#ifdef _debug
#module _mod_debug_log
;--ログに配列出力(<array>, lineNum[<0:hex], "Caption", start, len)
#define global LogArr(%1,%2=8,%3="",%4=0,%5=0) _LogArr %1,%2,%3,%4,%5
#deffunc _LogArr array pa, int p0, str p1, int p2, int p3, local a, local b, local c, local d
a.0=1,Abs(p0),p2,p3,vartype(pa)
Dim d,8 :d.4=Length(pa),Length2(pa),Length3(pa),Length4(pa)
Repeat 2,2 :If(a.cnt<0){a.cnt=0} :Loop
Repeat 4,4 :If(d.cnt){a*=d.cnt} :Loop
If(a.3<1)||((a.2+a.3)>a){a.3=a-a.2}
If(a.1<1){a.1=8} :d=a.2 :If(a.3<1){Return ""}
Repeat 3
If(d(cnt)<d(cnt|4)){Break}
d(cnt+1)=d(cnt)/d(cnt|4) :d(cnt)\=d(cnt|4)
Loop
sDim b,$80,2 :b=p1 :If(a.4==3){If(b==""){b="dbl"} :b.1="%f"}
If(a.4==2){If(b==""){b="str"} :b.1="\"%s\""}
If(a.4==4){If(b==""){b="int"} :If(p0<0){b.1="%p"}else{b.1="%2d"}}
b+="(%2d" :Repeat 3,5 :If(d.cnt){b+=",%2d"} :Loop :b+=") = "
a=0 :b.1+=", " :sDim c,$10000
Repeat a.3
If(d.7){
If(a==0){c+="\n"+StrF(b,d.0,d.1,d.2,d.3)}
c+=StrF(b.1,pa(d.0,d.1,d.2,d.3))
}else{If(d.6){
If(a==0){c+="\n"+StrF(b,d.0,d.1,d.2)}
c+=StrF(b.1,pa(d.0,d.1,d.2))
}else{If(d.5){
If(a==0){c+="\n"+StrF(b,d.0,d.1)}
c+=StrF(b.1,pa(d.0,d.1))
}else{
If(a==0){c+="\n"+StrF(b,d.0)}
c+=StrF(b.1,pa(d.0))}}}
a++ :d++ :If(a>=a.1){a=0}
Repeat 3
If(d(cnt)<d(cnt|4))||(d(cnt|4)==0){Break}
a=0 :d(cnt+1)++ :d(cnt)\=d(cnt|4)
Loop
Loop :LogMes c
Return c
;--ログにバイナリ出力(<var>, "Caption", start, len, FLG[$FF:lineByte $100:LowerCase])
#define global LogBin(%1,%2="BIN",%3=0,%4=0,%5=$10) _LogBin %1,%2,%3,%4,%5
#deffunc _LogBin var pv, str p0, int p1, int p2, int p3, local a, local b, local c
a.0=p1,4,p3&$ff :If(a.2<4){a.2=8}
If(p2){a.1=p2}else{If(vartype(pv)==3){a.1=8}
If(vartype(pv)==2){DupPtr b,varptr(pv)-16,4 :a.1=b-a}}
c=a.0+a.1 :sDim b,$10,2 :b.0="%0"+(8>>((c<$10000)+(c<$100)))," %02"
Repeat 2 :If(p3&$100){b.cnt+="x"}else{b.cnt+="X"} :Loop
b+="|" :sDim c,$10000 :c=StrF("\n---- %s [%d] ----",p0,a.1)
Repeat a.1
If((cnt\a.2)==0){c+="\n"+StrF(b.0,a)}
c+=StrF(b.1,Peek(pv,a)) :a++
Loop
LogMes c
Return c
#global
#else
#define global LogArr(%1=0,%2=0,%3=0,%4=0,%5=0) :
#define global LogBin(%1=0,%2=0,%3=0,%4=0,%5=0) :
#endif
| |
|
|
2015/11/18(Wed) 01:44:20|NO.73094
他スレに投稿したものなので「わざわざスレを立てる程でもない」には合致しないけど、試しに投稿。（こういうのはありだろうかなしだろうかという様子見…。）
正規表現によるメールアドレスのチェックをするスクリプト
http://hsp.tv/play/pforum.php?mode=all&num=73092
タイトル通り文字列がメールアドレスとして使用できる文字列かどうかを判定します。
用途としては、ユーザーに入力してもらったメールアドレスがでたらめでないか、入力ミスではないかをチェックする際などに使用します。
正規表現による検索結果と一致するかどうかだけなので、モジュールにするには大げさかなと。メルアドだけだし。
検索文字列（正規表現）をマクロにして呼び出しやすくするとかすれば多少便利かも。
それにしてもこのスレは気合入ったスクリプト多いですね。
マニュアルと解説をしっかり作って自分のサイトやベクターで公開すればいいのに。
|
|
|
2015/11/18(Wed) 15:24:11|NO.73099
昔作った花吹雪 ESCで終了
#uselib "user32.dll"
#func GetWindowLongA "GetWindowLongA" int , int
#func SetWindowLongA "SetWindowLongA" int , int , int
#func SetLayered "SetLayeredWindowAttributes" int , int , int , int
#func SendMessageA "SendMessageA" int , int , int , int
#func PostMessageA "PostMessageA" int , int , int , int
#func SetCapture "SetCapture" int
#func ReleaseCapture "ReleaseCapture"
amax = 157 //アニメーションフレーム数
randomize
buffer 1,ginfo(20),ginfo(21)
; gradf 0,0,480,480,1,$303030 //背景描画
boxf
buffer 2,32,32*amax
buffer 3,32,32 : gmode 4,,,255
buffer 4,ginfo(20),ginfo(21)
r = 0.0 : r2 = 0.0 //紙吹雪の回転角を初期化
pmax = 400 //紙吹雪の最大数
ddim pr,pmax //紙吹雪の角度
ddim px,pmax //紙吹雪のx座標
ddim py,pmax //紙吹雪のy座標
ddim pq,pmax
ddim padd,pmax
dim pc,pmax
dim pcolor,pmax //紙吹雪の色
dim pa,pmax //紙吹雪のアニメーションID
gsel 2 //紙吹雪のアニメーション作成
color : boxf
repeat amax : cn = cnt
r + 0.2
rx = int(cos(r)*8) : ry = int(sin(r+1.57)*8) : ry2 = int(sin(r)*8)
dx = 8+rx,16+rx,24-rx,16-ry : dy = 16-ry2,0,16+ry2,32
repeat 4
dy(cnt) + cn*32
loop
await 0
color 255,255,255 : gsquare -255,dx,dy
loop
bgscr 0,ginfo(20),ginfo(21),0,0,0
gsel 0,2
gsel 4
*Main
stick key,,0
if key&128 : end
pcn = 0 //紙吹雪のパラメータ設定
repeat pmax
if pcolor(cnt) = 0{
px(cnt) = double( ginfo(0) )
py(cnt) = double( ginfo(1) )
pr(cnt) = double( rnd(628) ) / 100
padd(cnt) = double( rnd(3) ) / 100 + 0.01
pq(cnt) = double( rnd(40) ) / 10 + 0.2
pcolor(cnt) = rnd(15)+1
pa(cnt) = rnd(amax)
pcn++
if pcn = 2 : break //毎フレーム3個ずつ増やす
}
loop
redraw 0
gmode 0
pos 0,0 : gcopy 1,0,0,ginfo(20),ginfo(21)
gmode 2
repeat pmax //紙吹雪描画
if pcolor(cnt) = 0 : continue
pc(cnt)++
gsel 3
//紙吹雪の色を設定
if pcolor(cnt) = 1 : gradf 0,0,32,32,1,$512452,$A349A4
if pcolor(cnt) = 2 : gradf 0,0,32,32,1,$38495F,$7092BE
if pcolor(cnt) = 3 : gradf 0,0,32,32,1,$1E2466,$3D48CC
if pcolor(cnt) = 4 : gradf 0,0,32,32,1,$4C6C75,$99D9EA
if pcolor(cnt) = 5 : gradf 0,0,32,32,1,$005174,$00A2E8
if pcolor(cnt) = 6 : gradf 0,0,32,32,1,$5A730E,$B5E61D
if pcolor(cnt) = 7 : gradf 0,0,32,32,1,$115826,$22B14C
if pcolor(cnt) = 8 : gradf 0,0,32,32,1,$777258,$EFE4B0
if pcolor(cnt) = 9 : gradf 0,0,32,32,1,$7F7900,$FFF200
if pcolor(cnt) = 10 : gradf 0,0,32,32,1,$7F6407,$FFC90E
if pcolor(cnt) = 11 : gradf 0,0,32,32,1,$7F3F13,$FF7F27
if pcolor(cnt) = 12 : gradf 0,0,32,32,1,$7F5764,$FFAEC9
if pcolor(cnt) = 13 : gradf 0,0,32,32,1,$760E12,$ED1C24
if pcolor(cnt) = 14 : gradf 0,0,32,32,1,$7F7F7F,$FEFEFE
if pcolor(cnt) = 15 : gradf 0,0,32,32,1,$645F73,$C8BFE7
color 255,255,255 : gcopy 2,0,pa(cnt)*32,32,32 //一時的に描画
pa(cnt)+rnd(3) : if pa(cnt) >= amax : pa(cnt) = 0 //アニメーション
gsel 4
pos px(cnt),py(cnt)
grotate 3,0,0,pr(cnt),32,32
psp = double(abs(pa(cnt)\(amax/4)-(amax/8)))/4 //速度調整
pr(cnt)+padd(cnt) : py(cnt)+psp+2.5+absf(sin(pr(cnt))) //回転移動
px(cnt)+cos(pr(cnt))*pq(cnt)
if py(cnt) >= ginfo(21) : pcolor(cnt) = 0 ;px(cnt) = double(rnd(480)) : py(cnt) = -32.0 //フレームアウト時の座標初期化
loop
redraw 1
gsel 0
GetWindowLongA hwnd , -20
SetWindowLongA hwnd , -20 , stat | 0x00080000
//黒色(0x000000)を透過
SetLayered hwnd , 0 , 0 , 1
gcopy 4,0,0,ginfo(20),ginfo(21)
gsel 4
await 17
goto *Main
| |
|
|
2015/11/19(Thu) 17:46:48|NO.73122
模様ということで・・・
;======================================
;模様作成サンプル
;======================================
screen 0,640,480
X=ginfo(12) : Y=ginfo(13) : M=X*Y
repeat M
X1=cnt\X : Y1=cnt/X
A=X1+Y1
R1=X1\255 : G1=Y1\255 : B1=A\255
color R1,G1,B1
pset X1,Y1
loop
repeat M
X1=cnt\X : Y1=cnt/X
A=X1+Y1
R1=(A*3)\255 : G1=(A*6)\255 : B1=(A*9)\255
color R1,G1,B1
pset X1,Y1
loop
repeat M
X1=cnt\X : Y1=cnt/X
A=X1+Y1
R1=(A*1)\255 : G1=(A*3)\255 : B1=(A*5)\255
color R1,G1,B1
pset X1,Y1
loop
repeat M
X1=cnt\X : Y1=cnt/X
A=X1+Y1 : B=X1+(Y-Y1)
R1=(A*1)\255 : G1=(A*3)\255 : B1=(A*5)\255
R2=(B*2)\255 : G2=(B*4)\255 : B2=(B*6)\255
color R1^R2,G1^G2,B1^B2
pset X1,Y1
loop
repeat M
X1=cnt\X : Y1=cnt/X
A=X1+Y1 : B=X1+(Y-Y1)
R1=(A*2)\255 : G1=(A*4)\255 : B1=(A*6)\255
R2=(B*2)\255 : G2=(B*4)\255 : B2=(B*6)\255
color R1^R2,G1^G2,B1^B2
pset X1,Y1
loop
repeat M
X1=cnt\X : Y1=cnt/X
A=X1+Y1 : B=X1+(Y-Y1)
R1=(A+X1*1)\255 : G1=(A+X1*2)\255 : B1=(A+X1*3)\255
R2=(B+X1*1)\255 : G2=(B+X1*2)\255 : B2=(B+X1*3)\255
color R1^R2,G1^G2,B1^B2
pset X1,Y1
loop
| |
|
|
2015/11/21(Sat) 16:23:24|NO.73169
今までAPIのアドレスがほしいときは(Windows APIなどすでに読みこんでいるもので)
p_function=GetProcAddress( GetModuleHandle("user32.dll") ,"CreateWindowExA")GetProcAddress( GetModuleHandle("user32.dll") ,"CreateWindowExA")
のようにしていたのですが(LoadLibraryを使っているのは機械的にHSP2から書き換えたもの)
#uselib "user32.dll"
#func CreateWindowEx "CreateWindowExA"
p_function=varptr(CreateWindowEx)
のようにvarptrが関数に対しても使えることを発見しました。
とても驚きました。
|
|
|
2015/11/21(Sat) 20:21:31|NO.73172
>>Noapさん
え・・・え？・・・
ｍｊｋ・・・
|
|
|
2015/11/21(Sat) 20:53:57|NO.73173
今思ったんだけどこのスレッドって何に使うの?
意味ないと思う。
なんか企んでいるの?
教えて。
|
|
|
2015/11/21(Sat) 23:52:49|NO.73180
>>今思ったんだけどこのスレッドって何に使うの?
いや「何に使う？」じゃなくて、何に使うか使えるかは見た人が
判断するスレです。
>>意味ないと思う。
まあ最終的には流れて埋もれちゃうので・・・・。
>>なんか企んでいるの?
実は国家転覆を企てています。
|
|
|
2015/11/22(Sun) 01:08:53|NO.73183
>> NO.73122
psetは万能だけど、速度が出ないので場合によっては使い分け。
x1 = 0,256, 0,0
y1 = 0, 0,256,0
c1 = 0,$ff00ff,$00ffff,0
x2 = 256,256, 0,256
y2 = 0,256,255, 0
c2 = $ff0000,$ffffff,$00ff00
repeat 2
i = cnt
repeat 3
sx = 256*cnt
sy = 256*i
;座標移動
repeat 4
x1s(cnt) = x1(cnt)+sx
y1s(cnt) = y1(cnt)+sy
x2s(cnt) = x2(cnt)+sx
y2s(cnt) = y2(cnt)+sy
loop
;描画
gsquare gsquare_grad, x1s, y1s, c1
gsquare gsquare_grad, x2s, y2s, c2
loop
loop
> 意味ないと思う。
すでの私のスクリプトを人に見せたい欲を満足するために役立ちました！
また自分では絶対使うことないだろうなと思って他の方のスクリプトを眺めていますが、それでも何かのきっかけで必要になった時は過去ログからこのスレ検索するんだろうと思います。
どこで何が役に立つかわからないものです。
> なんか企んでいるの?
ここだけの話、世界征服を企てています。
|
|
|
2015/11/22(Sun) 10:16:12|NO.73187
葡萄色さんすみません
変な説明になってしまいました
伝えたかったのはこういうことです
APIのアドレス取得にこうしていたのが(この場合はわざわざ取得する必要はありませんがサンプルなので)
#uselib "kernel32.dll"
#cfunc GetModuleHandle "GetModuleHandleA" sptr
#cfunc GetProcAddress "GetProcAddress" sptr,sptr
#define GPTR $40
p_dl_kernel32 =GetModuleHandle("kernel32.dll")
p_fn_GlobalAlloc=GetProcAddress( p_dl_kernel32 ,"GlobalAlloc")
p_fn_GlobalFree =GetProcAddress( p_dl_kernel32 ,"GlobalFree")
bufsize=64
funcarg=bufsize, GPTR
p_buf=callfunc(funcarg,p_fn_GlobalAlloc,2)
if p_buf==0 : dialog "メモリ確保失敗",1 : end
dupptr buf,p_buf,bufsize,vartype("str")
buf="GlobalAllocで"+p_buf+"に"+bufsize+"バイトのバッファを確保しました"
mes "buf= "+buf
mes "strlen(buf)= "+strlen(buf)
funcarg=p_buf
funcarg=callfunc(funcarg,p_fn_GlobalFree,1)
if funcarg==0 : mes "解放しました"
こうしてvarptrでも取得できるということが分かりました
#uselib "kernel32.dll"
#cfunc GlobalAlloc "GlobalAlloc" int,int
#func GlobalFree "GlobalFree" sptr
#define GPTR $40
p_fn_GlobalAlloc= varptr(GlobalAlloc)
p_fn_GlobalFree = varptr(GlobalFree)
bufsize=64
funcarg=bufsize, GPTR
p_buf=callfunc(funcarg,p_fn_GlobalAlloc,2)
if p_buf==0 : dialog "メモリ確保失敗",1 : end
dupptr buf,p_buf,bufsize,vartype("str")
buf="GlobalAllocで"+p_buf+"に"+bufsize+"バイトのバッファを確保しました"
mes "buf= "+buf
mes "strlen(buf)= "+strlen(buf)
funcarg=p_buf
funcarg=callfunc(funcarg,p_fn_GlobalFree,1)
if funcarg==0 : mes "解放しました"
朝からちょっと面白いモジュールとそのサンプルをつくったのですがこのスレッドに投稿できるほどのスクリプトかどうか分かりません。
自分の前の投稿を見ていると変なスクリプトを投稿していたりしてはずかしくなりました。
わたしは万が一にでも誰かの目にとまってそして少しでも喜んだり、くすっと笑ってくれたりするのであればいいなと思います。誰かの目にとまるかも分かりませんし、ただの自己満足のスクリプトに過ぎないのかもしれません。でもそういう理由で投稿しています。
| |
|
|
2015/11/22(Sun) 10:18:50|NO.73188
わざわざGlobalAllocを使っているのは簡略化のためです
|
|
|
2015/11/22(Sun) 17:01:22|NO.73201
>>Snake
そうだねしときました！
フォローしますw
|
|
|
2015/11/22(Sun) 17:19:58|NO.73203
変数のビット操作
A 変数
B Aのバイト位置(0-)
C Bのビット位置(0-7)
任意ビットのオン
>> poke A,B,peek(A,B)|int(powf(2,C))
任意ビットのオフ
>> poke A,B,peek(A,B)&(int(powf(2,C))^$FF)
任意ビットの状態
>> D=((peek(A,B)&int(powf(2,C)))<<(7-C))>>7
何に使えるかというと、有り無しで管理するフラグデータを圧縮出来るぐらいです。
数値型なら３２個の変数が１つに、文字列型なら確保されたバイト数の８倍が使えます。
|
|
|
2015/11/23(Mon) 01:09:33|NO.73209
>>KAさん（NO.73203）
使い方のサンプルがないと使い方がよくわからないです。
こんな感じのこととは違うのかなと…。
;for HSP3
#module
;値bitsをw桁の２進表記の文字列に変換したものを返すモジュール。
#defcfunc strbit int bits,int w
if (w<1)|(w>32) : w=32
s=""
repeat w
if bits&(1<<cnt) : s="1"+s : else : s="0"+s
loop
return s
#global
;#################################################
; 10987654321098765432109876543210
A = %00000000000000000000000000000010 ;データを格納する変数
B = 5 ;読み書きするアドレス
mes "B = " + B
mes "10987654321098765432109876543210 : INDEX"
mes strbit(A,32) + " : A"
; 任意のビットをON
A |= 1<<B
mes strbit(A,32) + " : 任意のビットをON"
; 任意のビットをOFF
A = A&(1<<B)^A
mes strbit(A,32) + " : 任意のビットをOFF"
; 任意ビットの状態を取得
mes "0 -> " + (A>>0&1)
mes "1 -> " + (A>>1&1)
mes "2 -> " + (A>>2&1)
mes "3 -> " + (A>>3&1)
mes "4 -> " + (A>>4&1)
mes "5 -> " + (A>>5&1)
参考資料： http://wiki.hsp.moe/%E5%B0%8F%E3%83%AF%E3%82%B6%EF%BC%8F%E3%83%93%E3%83%83%E3%83%88%E6%93%8D%E4%BD%9C.html
|
|
|
2015/11/23(Mon) 07:25:06|NO.73210
>>こんな感じのこととは違うのかなと…。
ぎゃぎゃ、既出でしたか・・・。
でもバイト単位にしたのはエンディアンを考慮してバイナリレベルの
順番を合わせる目的で、とあるバイナリデータの解析に執念を燃やし
た古き良き時代の副産物です。
|
|
|
2015/11/23(Mon) 16:26:33|NO.73216
余計ではないと思います。
ただ、色分けを自動にして欲しい。
さらに欲を言うと、任意で、hsファイルやモジュール内で使う画像(たまにある)が投稿できるといい｡
hsp用というのでしたら、このぐらいは必要かなと。
wiki系とも言っているので、厳しいかも知れませんが。
|
|
|
2015/11/23(Mon) 18:03:12|NO.73222
モジュールの使用例
Cランタイムでクイックソート
//quciksort_by_crt p1,p2
//p1=配列名 Cランタイムのqsortで並び替えたい一次元配列
//p2=0|1(0) p2=0 大きい順 p2=1 小さい順
//C言語のランタイムでクイックソートをします
//HSPでコールバックモジュール(http://nopswebpages.webcrow.jp/apps/ccallfn/)を使います
//HSP3.5 beta 2と3.4で動作確認
//パブリックドメインです
//CC0 1.0でライセンスします(CC0のコモンズ権利証 https://creativecommons.org/publicdomain/zero/1.0/deed.ja)
//モジュールのファイル名に適度書きかえてください
#include "ccallfn.txt"
#module
#uselib "crtdll.dll"
#func qsort "qsort" sptr,int,int,sptr
#deffunc quciksort_by_crt array p1, int opt, local comparea, local compareb, local comparep, local statbak, local hspctx
mref hspctx,68
statbak= wparam, lparam, stat
if p_compare==0: makeclbkfunc p_compare,2, *compare,1 //C言語のランタイムを使うので呼び出し規約はcdeclにする(stdcallの場合は第4パラメータは0にするか省略)
qsort varptr(p1),length(p1),4,p_compare
hspctx(9)=statbak(0)
hspctx(10)=statbak(1)
hspctx(196)=statbak(2)
return
*compare
argclbkfunc comparep
dupptr comparea,comparep.0,4
dupptr compareb,comparep.1,4
if opt{
return comparea-compareb
}else{
return compareb-comparea
}
#global
//サンプル
/*
dim a,20
randomize
repeat length(a)
a.cnt=rnd(20)
mes a.cnt
loop
quciksort_by_crt a,0
pos ginfo_sx/3,0
repeat length(a)
mes a.cnt
loop
quciksort_by_crt a,1
pos ginfo_sx-ginfo_sx/3,0
repeat length(a)
mes a.cnt
loop
stop
*/
| |
|
|
2015/11/24(Tue) 05:22:36|NO.73230
//エディットボックスをサブクラス化して右クリックメニューを置き換える
//HSPでコールバックモジュール(http://nopswebpages.webcrow.jp/apps/ccallfn/)を使います
//HSP3.5 beta 2と3.4で動作確認
//パブリックドメインです
//CC0 1.0でライセンスします(CC0のコモンズ権利証 https://creativecommons.org/publicdomain/zero/1.0/deed.ja)
//モジュールのファイル名に適度書きかえてください
#include "ccallfn.txt"
#uselib "user32.dll"
#cfunc GetWindowLong "GetWindowLongA" sptr,int
#func SetWindowLong "SetWindowLongA" sptr,int,sptr
#cfunc CallWindowProc "CallWindowProcA" sptr,sptr,int,int,int
#cfunc CreatePopupMenu "CreatePopupMenu"
#func AppendMenu "AppendMenuA" sptr,int,sptr,sptr
#func ModifyMenu "ModifyMenuA" sptr,int,int,sptr,sptr
#func DestroyMenu "DestroyMenu" sptr
#func TrackPopupMenu "TrackPopupMenu" sptr,int,int,int,int,int,int
#func CheckMenuItem "CheckMenuItem" sptr,int,int
#func CheckMenuRadioItem "CheckMenuRadioItem" sptr,int,int,int,int
#define GWL_WNDPROC $FFFFFFFC
#define WM_CONTEXTMENU $0000007B
//右メニュー設定
#define MF_POPUP $00000010//サブメニューボタン
#define MF_SEPARATOR $00000800//区切り線
#define MFS_CHECKED $00000008//チェック
#define MF_STRING $00000000//文字
#define MF_DISABLED $00000002//無効表示
#define MF_MENUBARBREAK $00000020//サブメニュー
//右メニュー表示
#define TPM_NONOTIFY $00000080//WM_COMMANDは使わない
#define TPM_RETURNCMD $00000100//stat
#define TPM_RIGHTBUTTON $00000002//右クリックでも選択
dim p_new_inputbox_proc,1
dim callbkarg,4
dim hmesbox
buf="ショートカットメニューが違う\n右クリック\nShift + F10\nアプリケーションキー"
buf2="これのメニューは普通"
schr="a"
dupptr chr,varptr(schr),1
subsubcontextmenu=CreatePopupMenu()
subcontextmenu=CreatePopupMenu()
maincontextmenu=CreatePopupMenu()
//メインメニュー
repeat 5,1
AppendMenu maincontextmenu,MF_STRING,cnt,"ダイアログ"+cnt+"(&"+schr+")"
chr++
loop
AppendMenu maincontextmenu, MF_POPUP, subcontextmenu,"サブメニュー"
//サブメニュー
repeat 5,6
AppendMenu subcontextmenu,MF_STRING,cnt,"ダイアログ"+cnt+"(&"+schr+")"
chr++
loop
AppendMenu subcontextmenu, MF_POPUP, subsubcontextmenu,"サブサブメニュー"
//サブサブメニュー
repeat 5,11
AppendMenu subsubcontextmenu,MF_STRING,cnt,"ダイアログ"+cnt+"(&"+schr+")"
chr++
loop
cls
mesbox buf,ginfo_winx/3,ginfo_winy/3,,0
pos ginfo_winx/3
mesbox buf2,ginfo_winx/3,ginfo_winy/3,,0
hmesbox=objinfo_hwnd(0)
makeclbkfunc p_new_inputbox_proc,4, *inputbox_proc
p_previous_inputbox_proc=GetWindowLong(hmesbox,GWL_WNDPROC)
SetWindowLong hmesbox, GWL_WNDPROC, p_new_inputbox_proc
oncmd gosub *inputbox_contextmenu, WM_CONTEXTMENU
onexit *owari
stop
*owari
DestroyMenu maincontextmenu
end
*inputbox_proc
argclbkfunc callbkarg
if callbkarg.1==WM_CONTEXTMENU{
sendmsg hwnd, WM_CONTEXTMENU, callbkarg.2, callbkarg.3
return 0
}
return CallWindowProc(p_previous_inputbox_proc, callbkarg.0, callbkarg.1, callbkarg.2, callbkarg.3)
*inputbox_contextmenu
if wparam==hmesbox{
TrackPopupMenu maincontextmenu, TPM_NONOTIFY | TPM_RETURNCMD | TPM_RIGHTBUTTON , ginfo_mx, ginfo_my, 0, hwnd, 0
if stat: dialog "ダイアログ"+stat+"を選びました"
}
return 0
| |
|
|
2015/11/25(Wed) 00:37:17|NO.73249
実行ファイルがCUIかGUIか判定するモジュール
//getexesubsys p1
//p1=文字列 情報を取得したいファイル
//p2=0|1(0) p2=0(省略) サブシステムのフラグの値 p2=1 サブシステムのフラグのオフセット
//p2=0の場合の主な返し値
// 2=IMAGE_SUBSYSTEM_WINDOWS_GUI GUIアプリ
// 3=IMAGE_SUBSYSTEM_WINDOWS_CUI CUIアプリ
// 9=IMAGE_SUBSYSTEM_WINDOWS_CE_GUI CEアプリ
//-1= 取得失敗
//p2=1の場合サブシステムのフラグのオフセットが返されます
//返し値=-1 取得失敗
#module
#define IMAGE_NT_SIGNATURE $00004550
#define COFF_HEADER_SIZE 20
#defcfunc getexesubsys str sz_filepath, int mode, local in_tmp, local in_signature_offset
exist sz_filepath
if strsize==-1 : return -1
bload sz_filepath,in_tmp,2, 0
if in_tmp!=$5A4D : return -1
bload sz_filepath,in_signature_offset, 4, $3C //シグネクチャーの位置
bload sz_filepath,in_tmp, 4, in_signature_offset
if in_tmp!=IMAGE_NT_SIGNATURE : return -1
//bload sz_filepath,in_option_header_size, 2, in_signature_offset+20 //オプションヘッダの大きさ
if mode{
in_tmp = in_signature_offset+4+COFF_HEADER_SIZE + 68
}else{
in_tmp=0
bload sz_filepath,in_tmp, 2, in_signature_offset+4+COFF_HEADER_SIZE + 68
}
return in_tmp
#global
//サンプル
/*
in_sub_system= getexesubsys("C:\\hsp34\\runtime\\hsp3cl.hrt", 0)
mes in_sub_system
*/
| |
|
|
2015/11/26(Thu) 18:36:04|NO.73289
先ほどのスクリプトをアップロードしました
http://nopswebpages.webcrow.jp/apps/ccallfn/cntxmn.txt
http://nopswebpages.webcrow.jp/apps/ccallfn/hspclwnd.txt
http://nopswebpages.webcrow.jp/apps/ccallfn/qsortcrt.txt
一覧
http://nopswebpages.webcrow.jp/apps/ccallfn
タートルグラフィックというのがあるらしいので便利そうなのでつくって使ってみました
スクリプトファイル
http://nopswebpages.webcrow.jp/apps/trtlgrp.txt
//HSPで簡易タートルグラフィック
//パブリックドメインです
//CC0 1.0でライセンスします(CC0のコモンズ権利証 https://creativecommons.org/publicdomain/zero/1.0/deed.ja)
//タートルは初期状態では5ひきいます
//タートルは初期状態では右を向いていて黒色です 座標は0,0です
//タートル向きを変えて(線の向きを変更する)
//turn_turtle p1,p2
//p1=0~ : タートルの番号
//p2=0.0~ : 角度(実数型)
//p2>0.0の場合反時計回り p2<0.0の場合時計回りです
//存在しない番号のタートルを指定した場合、statに0が返されます
//statに1が返されます
//タートル走って(線を引く)
//run_turtle p1,p2
//p1=0~ : タートルの番号
//p2=0~ : 線の長さ
//線の先がタートルの新たな座標になります
//p2<0の場合バックします
//存在しない番号のタートルを指定した場合、statに0が返されます
//statに1が返されます
//タートル変身して(オプション設定)
//set_opt_turtle p1,p2,p3
//p1=0~ : タートルの番号
//p2=($000000) : 色(COLORREF構造体)
//p3=0.0~ : 角度(実数型)
//p3>0.0の場合反時計回り p3<0.0の場合時計回りです
//p2=-1の場合run_turtleで線は引かれずタートルの座標だけが移動されます
//存在しない番号のタートルを指定した場合、statに0が返されます
//statに1が返されます
//タートルワープして(座標設定)
//set_pos_turtle p1,p2,p3
//p1=0~ : タートルの番号
//p2=(0) : x座標
//p3=(0) : y座標
//存在しない番号のタートルを指定した場合、statに0が返されます
//statに1が返されます
//タートル教えて(情報の取得)
//val=get_info_turtle(p1,p2)
//p1=0~ : タートルの番号
//p2=0~ : 取得する情報 p2=0 x座標 , p2=1 y座標 , p2=2 色 , p2=3 , 角度
//存在しない番号のタートルを指定した場合、またp2<0 | p2>3の場合 0が返されます
//p2=3の場合実数型で角度が返されます
//タートル消えて(タートルの初期化)
//タートルは初期状態では右を向いていて黒色です 座標は0,0です
//set_num_turtle p1
//p1=1~ : タートルの数
//p1<1の場合 stat=0
//p1>=1の場合 stat=1
//タートルグラフィックモジュール
//-----//-----//-----//-----//-----//-----//-----//-----//-----//-----|-----\\-----\\-----\\-----\\-----\\-----\\-----\\-----\\-----\\-----\\
#module
#define NUM_ELEMENTS_TURTLE 4
//arg_int_info_turtle.0= x座標
//arg_int_info_turtle.1= y座標
//arg_int_info_turtle.2= 色
//arg_int_info_turtle.3= 向き(角度を100倍して管理)
#define ctype ELEM_TURTLE_POS_X(%1) arg_int_info_turtle(%1*NUM_ELEMENTS_TURTLE+0)
#define ctype ELEM_TURTLE_POS_Y(%1) arg_int_info_turtle(%1*NUM_ELEMENTS_TURTLE+1)
#define ctype ELEM_TURTLE_COLOR(%1) arg_int_info_turtle(%1*NUM_ELEMENTS_TURTLE+2)
#define ctype ELEM_TURTLE_DIRCT(%1) arg_int_info_turtle(%1*NUM_ELEMENTS_TURTLE+3)
//角度を何倍して管理するか
#define DIRECTACCUR 100
//座標を何倍して管理するか
#define POSACCUR 1
#define GET_ELEMENT_POSX
#deffunc set_num_turtle int p1_set_num_turtle
#define num_turtle p1_set_num_turtle
if num_turtle<1 : return 0
int_num_turtle=num_turtle-1
dim arg_int_info_turtle , (int_num_turtle+1) * NUM_ELEMENTS_TURTLE
return 1
#undef num_turtle
#defcfunc get_info_turtle int p1_get_info_turtle, int p2_get_info_turtle
#define num_turtle p1_get_info_turtle
#define idx_turtle p2_get_info_turtle
if int_num_turtle<num_turtle | idx_turtle<0 | idx_turtle>=NUM_ELEMENTS_TURTLE : return 0
if idx_turtle==3 : return (0.0+arg_int_info_turtle(num_turtle*NUM_ELEMENTS_TURTLE+idx_turtle))/DIRECTACCUR
return arg_int_info_turtle(num_turtle*NUM_ELEMENTS_TURTLE+idx_turtle)
#undef num_turtle
#undef idx_turtle
#deffunc set_pos_turtle int p1_set_pos_turtle, int p2_set_pos_turtle, int p3_set_pos_turtle
#define num_turtle p1_set_pos_turtle
#define posx_turtle p2_set_pos_turtle
#define posy_turtle p3_set_pos_turtle
if int_num_turtle<num_turtle : return 0
ELEM_TURTLE_POS_X(num_turtle)=posx_turtle*POSACCUR
ELEM_TURTLE_POS_Y(num_turtle)=posy_turtle*POSACCUR
return 1
#undef num_turtle
#undef posx_turtle
#undef posy_turtle
#deffunc set_opt_turtle int p1_set_opt_turtle, int p2_set_opt_turtle, double p3_set_opt_turtle
#define num_turtle p1_set_opt_turtle
#define color_turtle p2_set_opt_turtle
#define dirct_turtle p3_set_opt_turtle
if int_num_turtle<num_turtle : return 0
ELEM_TURTLE_COLOR(num_turtle)=color_turtle
ELEM_TURTLE_DIRCT(num_turtle)=0+(dirct_turtle*DIRECTACCUR)
return 1
#undef num_turtle
#undef color_turtle
#undef dirct_turtle
#deffunc run_turtle int p1_run_turtle, int p2_run_turtle, local tmp
#define num_turtle p1_run_turtle
#define length_turtle p2_run_turtle
if int_num_turtle<num_turtle : return 0
dim tmp,4
tmp.0=POSACCUR*(sin( (0.0+(arg_int_info_turtle(num_turtle*NUM_ELEMENTS_TURTLE+3)/DIRECTACCUR)) *M_PI/180 )* length_turtle)
tmp.1=POSACCUR*(cos( (0.0+(arg_int_info_turtle(num_turtle*NUM_ELEMENTS_TURTLE+3)/DIRECTACCUR)) *M_PI/180 )* length_turtle)
if arg_int_info_turtle(num_turtle*NUM_ELEMENTS_TURTLE+2) != -1{
tmp.2=ginfo_r | ginfo_g<<8 | ginfo_b<<16
tmp.3=ginfo_cx | ginfo_cy<<16
color ELEM_TURTLE_COLOR(num_turtle) & $FF, (ELEM_TURTLE_COLOR(num_turtle)>>8) & $FF, (ELEM_TURTLE_COLOR(num_turtle)>>16) & $FF
line ELEM_TURTLE_POS_X(num_turtle)/POSACCUR, ELEM_TURTLE_POS_Y(num_turtle)/POSACCUR, (ELEM_TURTLE_POS_X(num_turtle)+tmp.1)/POSACCUR, (ELEM_TURTLE_POS_Y(num_turtle)-tmp.0)/POSACCUR
color tmp.2 & $FF, (tmp.2>>8) & $FF, (tmp.2>>16) & $FF
pos tmp.3 & $FFFF, tmp.3>>16
}
ELEM_TURTLE_POS_X(num_turtle)+=tmp.1
ELEM_TURTLE_POS_Y(num_turtle)-=tmp.0
return 1
#undef num_turtle
#undef length_turtle
#deffunc turn_turtle int p1_turn_turtle, double p2_turn_turtle, local tmp
#define num_turtle p1_turn_turtle
#define dirct_turtle p2_turn_turtle
if int_num_turtle<num_turtle : return 0
tmp=ELEM_TURTLE_DIRCT(num_turtle) +(dirct_turtle*DIRECTACCUR)
if tmp<0 : tmp+=(360*DIRECTACCUR)
if tmp>=360*DIRECTACCUR : tmp-=(360*DIRECTACCUR)
ELEM_TURTLE_DIRCT(num_turtle)=tmp
return 1
#undef num_turtle
#undef dirct_turtle
#global
set_num_turtle 5
//タートルグラフィックモジュールおしまい
//-----//-----//-----//-----//-----//-----//-----//-----//-----//-----|-----\\-----\\-----\\-----\\-----\\-----\\-----\\-----\\-----\\-----\\
//サンプル
/*
set_pos_turtle 4,20,420
set_opt_turtle 4,$00FF00,0
set_pos_turtle 3,280,470
set_opt_turtle 3,$0000FF,0
set_pos_turtle 2,60,240
set_opt_turtle 2,$0000FF,36
set_pos_turtle 1,200,300
set_opt_turtle 1,$FF0000,15
set_pos_turtle 0,400,200
set_opt_turtle 0,$00FF00,15
color 255,180,0
mes get_info_turtle(1,3)
repeat 5
run_turtle 2,250
turn_turtle 2,144
loop
repeat 12
run_turtle 1,100
turn_turtle 1,150
loop
repeat 12
run_turtle 0,40
turn_turtle 0,30
loop
set_pos_turtle 2,400,400
set_opt_turtle 2,$FF00FF,180.0/7*2
repeat 7
run_turtle 2,200
turn_turtle 2,180.1-180.0/7 //計算誤差で少しずれるので少し調節
loop
int_level=4
dim arg_int_length_koch, int_level+1
arg_int_length_koch(int_level)= 350
num_turtle_koch=3
gosub *koch_curve
int_max_level=3
int_level=int_max_level
dim arg_int_length_koch, int_level+1
dim arg_int_flag_koch_curve2, int_level+1
arg_int_length_koch(int_level)= 350
num_turtle_koch=4
gosub *koch_curve2
mes "あ"
stop
//コッホ曲線(再帰版)
*koch_curve
if int_level<=0: run_turtle num_turtle_koch,arg_int_length_koch(int_level) : int_level++: return
arg_int_length_koch(int_level-1)=arg_int_length_koch(int_level)/3
int_level--
gosub *koch_curve
turn_turtle num_turtle_koch,60
arg_int_length_koch(int_level-1)=arg_int_length_koch(int_level)/3
int_level--
gosub *koch_curve
turn_turtle num_turtle_koch,-120
arg_int_length_koch(int_level-1)=arg_int_length_koch(int_level)/3
int_level--
gosub *koch_curve
turn_turtle num_turtle_koch,60
arg_int_length_koch(int_level-1)=arg_int_length_koch(int_level)/3
int_level--
gosub *koch_curve
int_level++
return
//コッホ曲線(ループ版)
*koch_curve2
repeat
if int_level<=0: run_turtle num_turtle_koch,arg_int_length_koch(int_level) : int_level++: continue
if arg_int_flag_koch_curve2(int_level)==0{
arg_int_length_koch(int_level-1)=arg_int_length_koch(int_level)/3
arg_int_flag_koch_curve2(int_level)=1
int_level--
continue
}
if arg_int_flag_koch_curve2(int_level)==1 : arg_int_flag_koch_curve2(int_level)==0
if arg_int_flag_koch_curve2(int_level)==0{
turn_turtle num_turtle_koch,60
arg_int_length_koch(int_level-1)=arg_int_length_koch(int_level)/3
arg_int_flag_koch_curve2(int_level)=2
int_level--
continue
}
if arg_int_flag_koch_curve2(int_level)==2 : arg_int_flag_koch_curve2(int_level)==0
if arg_int_flag_koch_curve2(int_level)==0{
turn_turtle num_turtle_koch,-120
arg_int_length_koch(int_level-1)=arg_int_length_koch(int_level)/3
arg_int_flag_koch_curve2(int_level)=3
int_level--
continue
}
if arg_int_flag_koch_curve2(int_level)==3 : arg_int_flag_koch_curve2(int_level)==0
if arg_int_flag_koch_curve2(int_level)==0{
turn_turtle num_turtle_koch,60
arg_int_length_koch(int_level-1)=arg_int_length_koch(int_level)/3
arg_int_flag_koch_curve2(int_level)=4
int_level--
continue
}
if arg_int_flag_koch_curve2(int_level)==4 : arg_int_flag_koch_curve2(int_level)==0
int_level++
if int_level>int_max_level : break
loop
return
*/
| |
|
|
2015/11/26(Thu) 22:43:37|NO.73290
hsp3clランタイムを使用せず、コンソールに文字列を出力するサンプル
※このサンプルでは、ウィンドウID0を非表示にしていますが、
通常のウィンドウと、コンソールウィンドウの両方表示可能なため、
コンソールウィンドウの方をトレースログ的な使い方ができます。
#module
#uselib "kernel32"
#cfunc GetStdHandle "GetStdHandle" int
#func WriteConsoleA "WriteConsoleA" int, str, int, int, int
#define STD_OUTPUT_HANDLE (-11)
#deffunc mes2 str s
if (0 == hOut) {
hOut = GetStdHandle(STD_OUTPUT_HANDLE)
}
WriteConsoleA hOut, s + "\n", strlen(s + "\n"), 0, 0
return
#global
#uselib "kernel32"
#cfunc AttachConsole "AttachConsole" int
#func AllocConsole "AllocConsole"
#func FreeConsole "FreeConsole"
#define ATTACH_PARENT_PROCESS (-1)
#ifdef _debug
// デバッグ実行時のみ、非表示にする
gsel 0, -1
#endif
#packopt hide 1
// CMD.exeから実行されているか？
if 0 == AttachConsole(ATTACH_PARENT_PROCESS) {
// コンソールウィンドウを生成する
AllocConsole
}
// コンソールに文字を出力する
mes2 "こんにちは"
mes2 "Hello! HSP! コンソールAPP"
dialog "OKを押すと終了します"
FreeConsole
end
|
|
|
2015/11/27(Fri) 18:54:24|NO.73292
今くちさんのWiki( http://hspscript.cswiki.jp/)に投稿しようとしたらもうなくなっていて驚きました
確か前くちさんがつくりましたHSPチャットもすぐなくなりましたがWikiもすぐなくなりました
なくすなどはくちさんの自由なのでなくなってもしかたがないですがちょっと残念です
自己プロセスの優先度確認および変更のサンプル
#uselib "kernel32.dll"
#cfunc GetCurrentProcess "GetCurrentProcess"
#func SetPriorityClass "SetPriorityClass" sptr,int
#cfunc GetPriorityClass "GetPriorityClass" sptr
#define REALTIME_PRIORITY_CLASS $00000100 //リアルタイム
#define HIGH_PRIORITY_CLASS $00000080 //高
#define ABOVE_NORMAL_PRIORITY_CLASS $00008000 //通常以上(2000以降で使える)
#define NORMAL_PRIORITY_CLASS $00000020 //通常
#define BELOW_NORMAL_PRIORITY_CLASS $00004000 //通常以下(2000以降で使える)
#define IDLE_PRIORITY_CLASS $00000040 //低
sdim buf,64
dim primary_class,1
h_current_process=GetCurrentProcess()
button gosub "高", *set_priority_class
button gosub "通常以上", *set_priority_class
button gosub "通常", *set_priority_class
button gosub "通常以下", *set_priority_class
button gosub "低", *set_priority_class
int_position=ginfo_cx,ginfo_cy
while
color 255,255,255: boxf: color : pos int_position.0 , int_position.1
primary_class=GetPriorityClass(h_current_process)
switch primary_class
case REALTIME_PRIORITY_CLASS
buf="リアルタイム"
swbreak
case HIGH_PRIORITY_CLASS
buf="高"
swbreak
case ABOVE_NORMAL_PRIORITY_CLASS
buf="通常以上"
swbreak
case NORMAL_PRIORITY_CLASS
buf="通常"
swbreak
case BELOW_NORMAL_PRIORITY_CLASS
buf="通常以下"
swbreak
case IDLE_PRIORITY_CLASS
buf="低"
swbreak
default
buf="不明"
swbreak
swend
mes "このプロセスの優先度="+buf
await 100
wend
*set_priority_class
if stat==0 : primary_class=HIGH_PRIORITY_CLASS
if stat==1 : primary_class=ABOVE_NORMAL_PRIORITY_CLASS
if stat==2 : primary_class=NORMAL_PRIORITY_CLASS
if stat==3 : primary_class=BELOW_NORMAL_PRIORITY_CLASS
if stat==4 : primary_class=IDLE_PRIORITY_CLASS
SetPriorityClass h_current_process, primary_class
return
| |
|
|
2015/11/28(Sat) 06:50:48|NO.73303
8.3形式のファイル名の取得サンプル
#uselib "kernel32.dll"
#func GetShortPathName "GetShortPathNameA" var,var,int
p_fn_GetShortPathName=varptr(GetShortPathName)
str_long_name="D:\\testnametestname.txt"
sdim str_short_name,260
dim arg_int_function_arguments,3
arg_int_function_arguments.0=varptr(str_long_name)
arg_int_function_arguments.1=varptr(str_short_name)
arg_int_function_arguments.2=260
int_dummy=callfunc( arg_int_function_arguments, p_fn_GetShortPathName, 3)
mes int_dummy
mes str_short_name
|
|
|
2015/11/29(Sun) 16:26:28|NO.73335
サイズ可変のウィンドウ
#define WS_THICKFRAME $00040000
#define WS_MAXIMIZEBOX $00010000
#define GWL_STYLE $FFFFFFF0
#define SWP_NOSIZE $00000001
#define SWP_NOZORDER $00000004
#define SWP_NOACTIVATE $00000010
#define SWP_NOMOVE $00000002
#define SWP_NOOWNERZORDER $00000200
#define SWP_FRAMECHANGED $00000020
#define SWP_DRAWFRAME SWP_FRAMECHANGED
#define HTCAPTION $00000002
#define WM_NCLBUTTONDOWN $000000A1
#define WM_MOUSEMOVE $00000200
#define WM_NCCALCSIZE $00000083
#define WM_GETMINMAXINFO $00000024
#define WM_LBUTTONDOWN $00000201
#define WM_SIZE $00000005
#uselib "user32.dll"
#cfunc GetWindowLong "GetWindowLongA" sptr,int
#func SetWindowLong "SetWindowLongA" sptr,int,int
#func SetWindowPos "SetWindowPos" sptr,int,int,int,int,int,int
#func MoveWindow "MoveWindow" sptr,int,int,int,int,int
screen 0,1,1,screen_palette+screen_hide
SetWindowLong hwnd, GWL_STYLE, WS_MAXIMIZEBOX | WS_THICKFRAME | GetWindowLong(hwnd,GWL_STYLE)
//SetWindowPos hwnd,,,,,,SWP_NOZORDER | SWP_NOMOVE | SWP_DRAWFRAME | SWP_NOACTIVATE | SWP_NOSIZE //MoveWindowを使わないならこうしてメッセージを送ること
objsize ginfo_winx,ginfo_winy
button "終わり", *owari
h_button=objinfo_hwnd(0)
oncmd gosub *on_WM_GETMINMAXINFO, WM_GETMINMAXINFO
oncmd gosub *on_WM_SIZE, WM_SIZE
MoveWindow hwnd,ginfo_wx1,ginfo_wy1,300,200,1
gsel 0,1
stop
*owari
end
*on_WM_GETMINMAXINFO
return 0
*on_WM_SIZE
MoveWindow h_button,,,ginfo_winx,ginfo_winy,1
return
| |
|
|
2015/11/30(Mon) 18:35:38|NO.73351
GetProcAddresを再現してみた
難しかったです
参考
http://chokuto.ifdef.jp/lab/reschg/pe_format.html
http://resources.infosecinstitute.com/the-export-directory/
図がわたしは分かりやすかったです
//GetProcAddresを使わずにAPIアドレスを取得
//val=kanuu_namae(p1,p2)
//p1!=0(0) : APIを含むDLLのメモりアドレス
//p2=文字列 : API名
//p1=0 または p2で指定したAPIが存在しない場合 APIアドレスではなく0が返ります
#module
#define COFF_HEADER_SIZE 20
#defcfunc kansuu_namae int funcarg_p_dll_selected_module, str funcarg_str_name_selected_function,\
local int_idx_name_function, local int_idex_p_fn_function, local int_offset_signature,\
local p_relative_virtual_addres_data_dict, local tag_image_export_dictionary, local arr_p_fn_function,\
local arr_p_name_function, local arr_p_name_original_function, local str_name_function
dim int_idx_name_function,1 : dim int_idex_p_fn_function,1
if funcarg_p_dll_selected_module==0:return 0
//シグネクチャの位置
dupptr int_offset_signature, funcarg_p_dll_selected_module+60, 4
//IMAGE_DATA_DIRECTORY_ENTRY_EXPORTからエクスポートの相対アドレス
dupptr p_relative_virtual_addres_data_dict, funcarg_p_dll_selected_module + int_offset_signature+4+COFF_HEADER_SIZE+96, 4
dupptr tag_image_export_dictionary, p_relative_virtual_addres_data_dict + funcarg_p_dll_selected_module, 40
//DLL名
//dupptr str_name_dll, tag_image_export_dictionary.3+funcarg_p_dll_selected_module , 1, vartype("str")
//mes str_name_dll
//関数アドレス表
dupptr arr_p_fn_function, tag_image_export_dictionary.7+funcarg_p_dll_selected_module, 4*tag_image_export_dictionary.5
//関数名表
dupptr arr_p_name_function, tag_image_export_dictionary.8+funcarg_p_dll_selected_module, 4*tag_image_export_dictionary.6
//関数名の番号と関数アドレスの番号の関係表
dupptr arr_p_name_original_function, tag_image_export_dictionary.9+funcarg_p_dll_selected_module, 2*tag_image_export_dictionary.6
int_idx_name_function=-1
repeat tag_image_export_dictionary.6
dupptr str_name_function, arr_p_name_function.cnt+funcarg_p_dll_selected_module, 1,vartype("str")
if str_name_function==funcarg_str_name_selected_function : int_idx_name_function=cnt: break
loop
if int_idx_name_function==-1{
return 0
}else{
int_idex_p_fn_function=wpeek( arr_p_name_original_function, int_idx_name_function*2)
return arr_p_fn_function.int_idex_p_fn_function + funcarg_p_dll_selected_module
}
#global
//サンプル
/*
#uselib "kernel32.dll"
#cfunc GetModuleHandle "GetModuleHandleA" sptr
#define MB_TOPMOST 0x00040000
#define MB_TASKMODAL 0x00002000
#define MB_DEFBUTTON1 0x00000000
#define MB_DEFBUTTON2 0x00000100
#define MB_DEFBUTTON3 0x00000200
#define MB_DEFBUTTON4 0x00000300
#define MB_ICONASTERISK 0x00000040
#define MB_YESNOCANCEL 0x00000003
#define MB_OK 0x00000000
#define IDOK 0x00000001
#define IDCANCEL 0x00000002
#define IDABORT 0x00000003
#define IDRETRY 0x00000004
#define IDIGNORE 0x00000005
#define IDYES 0x00000006
#define IDNO 0x00000007
#define IDTRYAGAIN 0x0000000A
#define IDCONTINUE 0x0000000B
dim str_buffer_calloc_test,4
p_dll_kernel32 = GetModuleHandle("kernel32.dll")
p_fn_LoadLibrary = kansuu_namae(p_dll_kernel32, "LoadLibraryA")
p_fn_FreeLibrary = kansuu_namae(p_dll_kernel32, "FreeLibrary")
print "kernel32.dll="+p_dll_kernel32
print "LoadLibrary="+p_fn_LoadLibrary
print "FreeLibrary="+p_fn_FreeLibrary
str_tmp="crtdll.dll"
function_arguments.0=varptr(str_tmp)
p_dll_crtdll = callfunc(function_arguments, p_fn_LoadLibrary, 1)
p_fn_calloc = kansuu_namae(p_dll_crtdll, "calloc")
p_fn_free = kansuu_namae(p_dll_crtdll, "free")
print "\ncrtdll.dll="+p_dll_crtdll
print "calloc="+p_fn_calloc
print "free="+p_fn_free
function_arguments.1=1
function_arguments.0=32
p_str_buffer_calloc_test=callfunc(function_arguments, p_fn_calloc, 2)
if p_str_buffer_calloc_test{
print "callocで" + function_arguments.0 + "バイト確保=" + p_str_buffer_calloc_test
dupptr str_buffer_calloc_test, p_str_buffer_calloc_test, function_arguments.0, vartype("str")
str_buffer_calloc_test="メモリアクセスのテスト"
print str_buffer_calloc_test
function_arguments.0=p_str_buffer_calloc_test
int_tmp=callfunc(function_arguments, p_fn_free, 1)
}else{
print "callocで" + function_arguments.0 + "バイト確保失敗"
}
function_arguments.0=p_dll_crtdll
int_tmp=callfunc(function_arguments, p_fn_FreeLibrary, 1)
p_dll_user32 = GetModuleHandle("user32.dll")
p_fn_MessageBox= kansuu_namae(p_dll_user32, "MessageBoxA")
print "\nuser32.dll="+p_dll_user32
print "MessageBox="+p_fn_MessageBox
str_tmp="タイトル"
str_tmp2="ダイアログテスト"
function_arguments.3=MB_TOPMOST | MB_TASKMODAL | MB_ICONASTERISK | MB_YESNOCANCEL | MB_DEFBUTTON3
function_arguments.2=varptr(str_tmp)
function_arguments.1=varptr(str_tmp2)
function_arguments.0=hwnd
int_tmp=callfunc( function_arguments, p_fn_MessageBox, 4)
if int_tmp==IDYES : str_tmp2="はいを選択"
if int_tmp==IDNO : str_tmp2="いいえを選択"
if int_tmp==IDCANCEL: str_tmp2="キャンセルを選択"
function_arguments.3= function_arguments.3 ^ MB_DEFBUTTON3 ^ MB_YESNOCANCEL | MB_OK
int_tmp=callfunc( function_arguments, p_fn_MessageBox, 4)
*/
| |
|
|
2015/12/4(Fri) 17:56:25|NO.73400
dir_cmdlineを改造して、
dir_cmdline(n)でn番目のコマンドラインパラメータを取得できるようにしてみました。
クォーテーションの中の半角スペースも区切りとして認識してしまいますが。
#module dircmd
#defcfunc local getcmdline int num
cmd=dir_cmdline
split cmd," ",cmd2
if(length(cmd2)<num+1){
dialog "存在しないコマンドラインパラメータです。",1,"エラー"
end
}
return cmd2(num)
#global
#undef dir_cmdline
#define dir_cmdline getcmdline@dircmd
mes dir_cmdline(0)
|
|
|
2015/12/4(Fri) 18:27:53|NO.73401
//管理者権限で起動しているかの確認 - AllocateAndInitializeSid
#define SECURITY_NULL_SID_AUTHORITY $00000000
#define SECURITY_WORLD_SID_AUTHORITY $00000001
#define SECURITY_LOCAL_SID_AUTHORITY $00000002
#define SECURITY_CREATOR_SID_AUTHORITY $00000003
#define SECURITY_NON_UNIQUE_AUTHORITY $00000004
#define SECURITY_NT_AUTHORITY $00000005
#define SECURITY_RESOURCE_MANAGER_AUTHORITY $00000009
#define SECURITY_LOCAL_SYSTEM_RID $00000012
#define SECURITY_BUILTIN_DOMAIN_RID $00000020
#define DOMAIN_ALIAS_RID_ADMINS $00000220
#define BCM_SETSHIELD $0000160C
#define SEE_MASK_DEFAULT $00000000
#define SEE_MASK_CLASSNAME $00000001
#define SW_SHOW $00000005
#define WinBuiltinAdministratorsSid $0000001A
#define WinBuiltinUsersSid $0000001B
#define WinBuiltinGuestsSid $0000001C
#define WinBuiltinPowerUsersSid $0000001D
#uselib "advapi32.dll"
#func AllocateAndInitializeSid "AllocateAndInitializeSid" sptr,int,int,int,int,int,int,int,int,int,sptr
#func FreeSid "FreeSid" sptr
//#cfunc GetLengthSid "GetLengthSid" sptr
#func CheckTokenMembership "CheckTokenMembership" sptr,sptr,sptr
#uselib "shell32.dll"
#func ShellExecuteEx "ShellExecuteEx" sptr
str_executefile="cmd.exe"
str_performmode="runas"
//SID
dim int_is_member,1
dim p_tag_SID,1
sdim tag_SID_identifier_authority,6
poke tag_SID_identifier_authority,5, SECURITY_NT_AUTHORITY
AllocateAndInitializeSid varptr(tag_SID_identifier_authority), 2, SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS,,,,,,,varptr(p_tag_SID)
//Administrators
// S-1-5-32-544
if stat{
CheckTokenMembership 0, p_tag_SID, varptr(int_is_member)
if int_is_member{
mes "管理者権限です"
}else{
mes "管理者権限でありません"
}
}else{
mes "SID作成失敗"
}
FreeSid p_tag_SID
button:gosub "メモ帳", *run_notepad
sendmsg objinfo_hwnd(0), BCM_SETSHIELD,,1
stop
*run_notepad
dim tag_shell_excute_info,15
tag_shell_excute_info= 4*15, SEE_MASK_DEFAULT, 0, varptr(str_performmode), varptr(str_executefile), 0, 0, SW_SHOW
ShellExecuteEx varptr(tag_shell_excute_info)
return
//分けてみたけど分ける必要はない
//execだとキャンセルしたときにエラーになるのでonerrorを使うかShellExecuteExを使うといいと思う
/*
*run_notepad
if int_is_member{
exec str_executefile
}else{
onerror gosub *dummy
exec str_executefile,,str_performmode
onerror 0
}
return
*dummy
return
*/
| |
|
|
2015/12/4(Fri) 18:28:56|NO.73402
//管理者権限で起動しているかの確認 - 自分でSIDをつくる(非推奨)
#define SECURITY_NULL_SID_AUTHORITY $00000000
#define SECURITY_WORLD_SID_AUTHORITY $00000001
#define SECURITY_LOCAL_SID_AUTHORITY $00000002
#define SECURITY_CREATOR_SID_AUTHORITY $00000003
#define SECURITY_NON_UNIQUE_AUTHORITY $00000004
#define SECURITY_NT_AUTHORITY $00000005
#define SECURITY_RESOURCE_MANAGER_AUTHORITY $00000009
#define SECURITY_LOCAL_SYSTEM_RID $00000012
#define SECURITY_BUILTIN_DOMAIN_RID $00000020
#define DOMAIN_ALIAS_RID_ADMINS $00000220
#define BCM_SETSHIELD $0000160C
#define SEE_MASK_DEFAULT $00000000
#define SEE_MASK_CLASSNAME $00000001
#define SW_SHOW $00000005
#define WinBuiltinAdministratorsSid $0000001A
#define WinBuiltinUsersSid $0000001B
#define WinBuiltinGuestsSid $0000001C
#define WinBuiltinPowerUsersSid $0000001D
#uselib "advapi32.dll"
#func CheckTokenMembership "CheckTokenMembership" sptr,sptr,sptr
#uselib "shell32.dll"
#func ShellExecuteEx "ShellExecuteEx" sptr
str_executefile="cmd.exe"
str_performmode="runas"
//SID
dim int_is_member,1
dim p_tag_SID,1
sdim tag_SID_identifier_authority,6
poke tag_SID_identifier_authority,5, SECURITY_NT_AUTHORITY
//Administrators
// S-1-5-32-544
dim tag_SID,4
poke tag_SID,0,1 //改定番号
poke tag_SID,1,2 //サブ権限値の数
memcpy tag_SID,tag_SID_identifier_authority,6,2
tag_SID.2= SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS //サブ権限値
CheckTokenMembership 0, varptr(tag_SID), varptr(int_is_member)
if int_is_member{
mes "管理者権限です"
}else{
mes "管理者権限でありません"
}
button:gosub "メモ帳", *run_notepad
sendmsg objinfo_hwnd(0), BCM_SETSHIELD,,1
stop
*run_notepad
dim tag_shell_excute_info,15
tag_shell_excute_info= 4*15, SEE_MASK_DEFAULT, 0, varptr(str_performmode), varptr(str_executefile), 0, 0, SW_SHOW
ShellExecuteEx varptr(tag_shell_excute_info)
return
| |
|
|
2015/12/4(Fri) 18:29:43|NO.73403
//管理者権限で起動しているかの確認 - IsUserAnAdmin(非推奨)
#define BCM_SETSHIELD $0000160C
#define SEE_MASK_DEFAULT $00000000
#define SEE_MASK_CLASSNAME $00000001
#define SW_SHOW $00000005
#uselib "shell32.dll"
#func ShellExecuteEx "ShellExecuteEx" sptr
#cfunc IsUserAnAdmin "IsUserAnAdmin"
str_executefile="cmd.exe"
str_performmode="runas"
if IsUserAnAdmin(){
mes "管理者権限です"
}else{
mes "管理者権限でありません"
}
button:gosub "メモ帳", *run_notepad
sendmsg objinfo_hwnd(0), BCM_SETSHIELD,,1
stop
*run_notepad
dim tag_shell_excute_info,15
tag_shell_excute_info= 4*15, SEE_MASK_DEFAULT, 0, varptr(str_performmode), varptr(str_executefile), 0, 0, SW_SHOW
ShellExecuteEx varptr(tag_shell_excute_info)
return
|
|
|
2015/12/4(Fri) 18:30:37|NO.73405
//管理者権限で起動しているかの確認 - CreateWellKnownSid
#define BCM_SETSHIELD $0000160C
#define SEE_MASK_DEFAULT $00000000
#define SEE_MASK_CLASSNAME $00000001
#define SW_SHOW $00000005
#define SECURITY_MAX_SID_SIZE $00000044
#define WinBuiltinAdministratorsSid $0000001A
#define WinBuiltinUsersSid $0000001B
#define WinBuiltinGuestsSid $0000001C
#define WinBuiltinPowerUsersSid $0000001D
#uselib "advapi32.dll"
#func CreateWellKnownSid "CreateWellKnownSid" int,sptr,sptr,sptr
#func CheckTokenMembership "CheckTokenMembership" sptr,sptr,sptr
#uselib "shell32.dll"
#func ShellExecuteEx "ShellExecuteEx" sptr
str_executefile="cmd.exe"
str_performmode="runas"
int_SID_size= SECURITY_MAX_SID_SIZE
sdim tag_SID, SECURITY_MAX_SID_SIZE
CreateWellKnownSid WinBuiltinAdministratorsSid, 0, varptr(tag_SID), varptr(int_SID_size)
CheckTokenMembership 0, varptr(tag_SID), varptr(int_is_member)
if int_is_member{
mes "管理者権限です"
}else{
mes "管理者権限でありません"
}
button:gosub "メモ帳", *run_notepad
sendmsg objinfo_hwnd(0), BCM_SETSHIELD,,1
stop
*run_notepad
dim tag_shell_excute_info,15
tag_shell_excute_info= 4*15, SEE_MASK_DEFAULT, 0, varptr(str_performmode), varptr(str_executefile), 0, 0, SW_SHOW
ShellExecuteEx varptr(tag_shell_excute_info)
return
| |
|
|
2015/12/6(Sun) 20:53:27|NO.73478
#deffuncや#funcや#cfuncなどで定義した命令の引き数を見るサンプル
何かの役に立つかは微妙です
#uselib ""
#func dummy2 "" int,double,str,var
#cfunc dummy "" int,double,str,var,int,wstr,sptr,float,comobj,wstr,wptr,sptr
#module
#deffunc dummy3 int p1, label p2, var p3, array p4
return
#global
#define MPTYPE_LOCALVAR (-1)
#define MPTYPE_ARRAYVAR (-2)
#define MPTYPE_SINGLEVAR (-3)
#define MPTYPE_FLOAT (-4)
#define MPTYPE_LOCALSTRING (-6)
#define MPTYPE_PVARPTR (-10)
#define MPTYPE_IOBJECTVAR (-12)
#define MPTYPE_LOCALWSTR (-13)
#define MPTYPE_FLEXSPTR (-14)
#define MPTYPE_FLEXWPTR (-15)
#define MPTYPE_DNUM 3
#define MPTYPE_INUM 4
#define MPTYPE_LABEL 7
int_tmp=libptr(dummy2)//一度も使っていなかった場合最適化で削除されるから
int_tmp=libptr(dummy3)//一度も使っていなかった場合最適化で削除されるから
p_structdat=libptr(dummy)
dupptr tag_structdat, p_structdat, 28
mref hspctx,68
repeat tag_structdat.2, tag_structdat.1
dupptr tag_structprm, hspctx.209 + cnt*8, 8
int_tmp=tag_structprm.0 & $FFFF
if int_tmp & $8000: int_tmp |= $FFFF0000
switch int_tmp
case MPTYPE_DNUM
mes "double"
swbreak
case MPTYPE_INUM
mes "int"
swbreak
case MPTYPE_LABEL
mes "label"
swbreak
case MPTYPE_LOCALVAR
mes "local"
swbreak
case MPTYPE_ARRAYVAR
mes "array"
swbreak
case MPTYPE_SINGLEVAR
case MPTYPE_PVARPTR
mes "var"
swbreak
case MPTYPE_FLOAT
mes "float"
swbreak
case MPTYPE_LOCALSTRING
mes "str"
swbreak
case MPTYPE_IOBJECTVAR
mes "comobj"
swbreak
case MPTYPE_LOCALWSTR
mes "wstr"
swbreak
case MPTYPE_FLEXSPTR
mes "sptr"
swbreak
case MPTYPE_FLEXWPTR
mes "wptr"
swbreak
default
mes "other"
swend
loop
| |
|
|
2015/12/10(Thu) 23:56:21|NO.73560
自動で全角入力にする
#uselib "imm32.dll"
#cfunc ImmGetContext "ImmGetContext" sptr
#func ImmReleaseContext "ImmReleaseContext" sptr,sptr
#func ImmSetOpenStatus "ImmSetOpenStatus" sptr,int
sdim a,2048
cls
input a,ginfo_winx,,64
h_edit=hwnd//objinfo_hwnd(0)
h_edit_context=ImmGetContext(h_edit)
ImmSetOpenStatus h_edit_context,1
ImmReleaseContext h_edit, h_edit_context
|
|
|
2015/12/14(Mon) 07:46:56|NO.73604
標準命令のみで太線を描写する処理です
角の部分が若干歪んでますが、そこは気にならない人はどうぞ
#module
#deffunc hline int ex,int ey,int sx,int sy,int r
inter=atan(ey-sy,ex-sx)
xinter=sin(inter)*r
yinter=cos(inter)*r
;線の描写
if r<=1{
line ex,ey,sx,sy
}else{
dim xdata,4:xdata=sx+xinter,ex+xinter,ex-xinter,sx-xinter
dim ydata,4:ydata=sy-yinter,ey-yinter,ey+yinter,sy+yinter
gsquare -1,xdata,ydata
}
return
#global
randomize
repeat 19
hsvcolor cnt*10,255,255
ex=rnd(640):ey=rnd(480) ;終点
sx=rnd(640):sy=rnd(480) ;始点
r=rnd(10)+1 ;線の太さ
hline ex,ey,sx,sy,r
loop
|
|
|
2015/12/14(Mon) 21:10:01|NO.73609
Linuxにある，コマンドラインかつより軽量なシンプルなテキストオンリーのブラウザ，w3mが
あります。そんなw3mは，WindowsではMygWinやANSI.sys等を使ってLinux用のソースをコンパイル
する必要があります。しかし，今HSPにある技術を使えばw3mのようなものは作れると思い
30分で作りました。まだ，Yahoo!JAPANや一部のサイトではHTMLコードが直接表示されてしまう
バグがあります。今後改善していきます。
※このソースは，llmod3/console.hspのモジュールの内容を一部改良しています。
そのため，正しく動作しません。(表示が崩れる，エラーが起きるなど)
下のURLから改良したconsole.hspをダウンロードして，HSPディレクトリ→commonフォルダ→llmod3フォルダ→console.hsp
を上書きコピーしてください。
http://seatex.webcrow.jp/embed/source/console.hsp
#include "hspinet.as"
#include "llmod3/llmod3.hsp"
#include "llmod3/console.hsp"
netinit
sdim SiteURL
axobj ie,"InternetExplorer.Application",1,1
gsel 0,-1
console
putz "Text Only Site Viewer ver1.0"
putz "テキストだけのシンプルサイトビューア **Ver1.0**"
putz ""
*Input_SiteURL
putz "閲覧したいサイトのURL>",1
gets SiteURL
if SiteURL="\n" or SiteURL="":putz "Error:入力内容が無効です":goto *Input_SiteURL
*Connect
ie->"Navigate" SiteURL
putz "接続しています。しばらくお待ちください。"
repeat
wait 10
if ie("Busy")=0:break
loop
putz "接続が確立しました。読み込んでいます。"
doc=ie("Document")
repeat
wait 10
if doc("readyState")="complete":break
loop
doc=ie("Document")
body=doc("body")
html=body("innerText")
delcom doc
delcom body
putz html
putz ""
putz ""
sdim SiteURL
goto *Input_SiteURL
| |
|
|
2015/12/15(Tue) 21:43:09|NO.73618
|
|
|
2015/12/23(Wed) 23:51:33|NO.73761
音声ファイルのバイナリから直接情報を取得してみました。
/*** 音声ファイル情報取得用 ************************************
・mmGetInfo( "ファイル名", 情報タイプ ) = ファイル情報
音声ファイルのバイナリデータから情報を取得します。
拡張子「*.wav, *.mid, *.mp3, *.ogg」のみ対応です。
情報タイプの数値で取得する内容を指定します。
0:演奏時間[ms]
1:bps? <midi:最大/最小テンポ[$AAAABBBB]>
2:SampleRate? <midi:CC111[ms]>
3:チャンネル数 <midi:トラック数>
4:"曲名?"
5:"作者名?"
6:"アルバム名?"
7:"コメント?"
「0:演奏時間」はMCI等で取得できる値と微妙にズレます、完全一致は諦めました。
MIDIファイルは累計時間算出してるので時間掛かります。
4〜7の文字列情報は、それっぽいものを取得してるだけです。
見当違いな内容を拾う事もあります。
***************************************************************/
#module _mod_mmmm
Dim iInfoW :sDim sInfoW :Dim iInfoM :sDim sInfoM ;情報保持用
Dim iInfoP :sDim sInfoP :Dim iInfoO :sDim sInfoO
#ifdef __hsp3dish__
#define cType _mmCCC(%1="",%2=3) (%1)
#else
#usecom _IMultiLanguage "{275c23e1-3747-11d0-9fea-00aa003f8646}" "{275c23e2-3747-11d0-9fea-00aa003f8646}"
#comfunc _ML_ConvertString 9 var,int,int,var,var,var,var
;__ConvertCharCode("strUTF?", type) = "strSJIS"
#define cType _mmCCC(%1="",%2=3) __mmCCC(%1,%2)
#defcfunc __mmCCC str p0, int p1, local a, local b
If(p1==0){Return p0} :If(p1>3){Return ""}
If(vartype(_ml)!=6){NewCom _ml,_IMultiLanguage}
a=0,0,StrLen(p0),1200 :If(p1==2){a.3=1201} :If(p1==3){a.3=65001}
sDim b,a.2*2 :b.1=p0 ;CODEPAGE_UNICODE/UNICODE_BE/UTF_8
_ML_ConvertString _ml,a.0,a.3,932,b.1,a.2,b.0,a.1 ;CODEPAGE_S_JIS
_ML_ConvertString _ml,a.0,a.3,932,b.1,a.2,b.0,a.1
Return b.0
#deffunc __mmCCC_Remove onexit ;後片付け
If(vartype(_ml)==6){DelCom _ml} :Return
#endif
;__BigEndian(intBE, byte[4]) = intLE
#define cType _mmMSB(%1=0,%2=4) __mmMSB(%1,%2)
#defcfunc __mmMSB int p0, int p1, local a
a=0,Limit(p1,1,4),p0 :Repeat a.1 :a=(a<<8)|Peek(a.2,cnt) :Loop
Return a
//---- WAVE ----------------------------------------------------
;--WAVE情報取得("file.wav", Type) = Info
#defcfunc _mmGetInfoW str p0, int p1, local a, local b
If(vartype(sInfoW)==2){If((sInfoW.4)==p0){If(p1<4){Return iInfoW(p1)}else{Return sInfoW(p1-4)}}}
Exist p0 :a.6=12,strsize :If(a.7<12){Return ""}
sDim b,$1000,2 :bLoad p0,b,$80
If(lPeek(b,0)!=$46464952)||(lPeek(b,8)!=$45564157){Return ""} ;'RIFF','WAVE'
Dim iInfoW,4 :sDim sInfoW,$200,5
Repeat :If(a.6>=a.7){Break} :bLoad p0,a.2,4,a.6 :bLoad p0,a.3,4,a.6+4
If(a.2==$20746d66){ ;[fmt ] 情報取得
bLoad p0,b,Limit(a.3+8,1,$1000),a.6 :a.4=lPeek(b,16)
iInfoW.1=lPeek(b,16)<<3,lPeek(b,12),wPeek(b,10)}
If(a.2==$61746164){a.5=a.3} ;[data] データサイズ取得
If((a.2|$20202020)==$7473696c){bLoad p0,a.1,4,a.6+8 ;'LIST'
If((a.1|$20202020)==$6f666e69){ ;[LIST.INFO]
a.1=0,Limit(a.3-4,1,$1000) :bLoad p0,b,a.2,a.6+12
Repeat :If(a.1>=a.2){Break} ;タグ?情報取得
a=lPeek(b,a.1)|$20202020 :a.8=lPeek(b,a.1+4) :MemCpy b.1,b,a.8,,a.1+8
If(a==$6d616e69){sInfoW.0=b.1} ;'INAM'
If(a==$74726169){sInfoW.1=b.1} ;'IART'
If(a==$64727069){sInfoW.2=b.1} ;'IPRD'
If(a==$746d6369){sInfoW.3=b.1} ;'ICMT'
a.1+=a.8+8 :*@ :If(Peek(b,a.1)||(a.1>=a.2)){}else{a.1++ :Goto *@b}
Loop}}
a.6+=a.3+8
Loop
If(a.4){iInfoW.0=int(double(a.5)*1000/a.4)} ;dataByte / (Byte/Sec)
sInfoW.4=p0 :If(p1<4){Return iInfoW(p1)}else{Return sInfoW(p1-4)}
Return ""
//---- MIDI ----------------------------------------------------
;__MIDIイベントデルタタイム取得(<buf>, <pos>) = dTime
#defcfunc _mmDeltaTime var p0, var p1, local a
Repeat 4 :a=Peek(p0,p1) :a.1=(a.1<<7)|(a&$7f) :p1++ :If(a>>7){}else{Break} :Loop
Return a.1
;--MIDI情報取得("file.mid", Type) = Info
#defcfunc _mmGetInfoM str p0, int p1, local a, local b, local c, local d
If(vartype(sInfoM)==2){If((sInfoM.4)==p0){If(p1<4){Return iInfoM(p1)}else{Return sInfoM(p1-4)}}}
Exist p0 :a.8=14,strsize :If(a.9<1){Return ""} :sDim b,a.9+4,2 :bLoad p0,b,a.9
If(lPeek(b,0)!=$6468544d)||(lPeek(b,14)!=$6b72544d){Return ""} ;'MThd','MTrk'
Dim iInfoM,4 :sDim sInfoM,$200,5 :Dim d,2,1 :d(0,0)=0,500000
iInfoM.3=_mmMSB(wPeek(b,10),2) :a.6=1,_mmMSB(wPeek(b,12),2) ;トラック数,分解能
Repeat iInfoM.3
*@ :If(a.8>=a.9){Break} :If(lPeek(b,a.8)!=$6b72544d){a.8++ :Goto *@b} ;'MTrk'
a.4=0,_mmMSB(lPeek(b,a.8+4))+a.8+8 :a.8+=8
Repeat :If(a.8>=a.5){Break} :a.3=_mmDeltaTime(b,a.8) :a.4+=a.3
If(a&$80){a.2=a>>4&$f} :a=Peek(b,a.8) ;RunningStatus用
If(a==$ff){a.1=Peek(b,a.8+1) ;<メタイベント>
a.2=Peek(b,a.8+2) :MemCpy b.1,b,a.2,,a.8+3 :Poke b.1,a.2
If(a.1==$03)&&(sInfoM.0==""){sInfoM.0=b.1} ;SequenceName=Title?
If(a.1==$02){sInfoM.1=b.1} :If(a.1==$01){sInfoM.3=b.1} ;:If(a.1==$04){sInfoM.2=b.1}
If(a.1==$51){a.2=_mmMSB(lPeek(b,a.8+3)&$ffffff,3) :d(0,a.6)=a.4,a.2 :a.6++} ;SetTempo
a.8+=Peek(b,a.8+2)+3 :If(a.1==$2f){Break} ;EndOfTrack
}else{a.1=a>>4&$f
If(a.1=$b){If(Peek(b,a.8+1)==111){iInfoM.2=a.4}} ;CC:111
If(a.1==$f){a.8+=Peek(b,a.8+1)+2 :Continue} ;<SysExイベント>
a.8+=2+(($7<a.1)&($c>a.1))|(a.1==$e)-((a.1<$8)&((a.2==$c)|(a.2==$d)))} ;<その他>
Loop :c(cnt)=a.4
Loop :a.0=Length2(d)-1,0,$7fffffff,0,iInfoM.2 :iInfoM.2=0 ;CC:111も時間単位に
Repeat Length(c) :If(a.1<c.cnt){a.1=c.cnt} :Loop :dDim c,2
Repeat Length2(d) :c+=double(a.1-d(0,a))*d(1,a)/a.7 ;テンポ毎の累計時間
If(a.4>d(0,a)){c.1+=double(a.4-d(0,a))*d(1,a)/a.7 :a.4=d(0,a)}
If(a.3<d(1,a)){a.3=d(1,a)} :If(a.2>d(1,a)){a.2=d(1,a)} :a.1=d(0,a) :a--
Loop
iInfoM.0=int(c.0+500)/1000 :iInfoM.2=int(c.1+500)/1000 ;四捨五入で�隻担校�
iInfoM.1=(60000000/a.3)|((60000000/a.2)<<16) ;最大/最小テンポ格納
sInfoM.4=p0 :If(p1<4){Return iInfoM(p1)}else{Return sInfoM(p1-4)}
Return ""
//---- MP3 -----------------------------------------------------
;__MP3ID3v1文字列空白除去(<buf>, start, len) = "text"
#defcfunc _mmCutSpc var pv, int p1, int p2, local a, local b
a=p2-1 :If(a<1){Return ""} :sDim b,p2+4 :MemCpy b,pv,p2,,p1
*@ :If(Peek(b,a)==$20){Poke b,a :a-- :If(a>=0){Goto *@b}} :Return b
;__MP3ID3v2_Syncsafe(intSS) = int
#defcfunc _mmSyncsafe int p0, local a
Repeat 4 :a=(a<<7)|(p0>>(cnt<<3)&$7f) :Loop :Return a
;--MP3情報取得("file.mp3", Type) = Info
#defcfunc _mmGetInfoP str p0, int p1, local a, local b, local c
If(vartype(sInfoP)==2){If((sInfoP.4)==p0){If(p1<4){Return iInfoP(p1)}else{Return sInfoP(p1-4)}}}
Exist p0 :a.7=strsize :If(a.7<1){Return ""}
bLoad p0,a,4 :a&=$ffffff :If(a!=$334449)&&((a&$e0ff)!=$e0ff){Return ""} ;'ID3'v2.x?
Dim iInfoP,4 :sDim sInfoP,$200,5
If(a==$334449){bLoad p0,a.5,4,6 :a.4=10,_mmSyncsafe(a.5)+10 ;'ID3':ID3v2.xタグ
sDim b,a.5+4,2 :bLoad p0,b,a.5 :a.6=wPeek(b,3)
If(Peek(b,5)&$40){a=lPeek(b,10) :If(a.6>3){a=_mmSyncsafe(a)}else{a=_mmMSB(a)} :a.4+=a}
Repeat :If(a.4>=a.5){Break} :a=lPeek(b,a.4) :If(a==0){Break}
If(a.6<3){a&=$ffffff ;v2.2
a.1=_mmMSB(lPeek(b,a.4+3)&$ffffff,3),Peek(b,a.4+6)
If(a==$325454){a=$32544954} :If(a==$315450){a=$31455054}
If(a==$4c4154){a=$424c4154} :If(a==$4d4f43){a=$4d4d4f43}
MemCpy b.1,b,a.1-1,,a.4+7 :Poke b.1,a.1-1 :a.1+=6
}else{a.1=lPeek(b,a.4+4),Peek(b,a.4+10) ;v2.3/2.4
If(a.6>3){a.1=_mmSyncsafe(a.1)}else{a.1=_mmMSB(a.1)}
MemCpy b.1,b,a.1-1,,a.4+11 :Poke b.1,a.1-1 :a.1+=10}
b.1=_mmCCC(b.1,a.2) :a.4+=a.1
If(a==$32544954){sInfoP.0=b.1} :If(a==$31455054){sInfoP.1=b.1} ;'TIT2','TPE1'
If(a==$424c4154){sInfoP.2=b.1} :If(a==$4d4d4f43){sInfoP.3=b.1} ;'TALB','COMM'
Loop}
bLoad p0,a,4,a.5 :a.2=a>>9&15,a>>20&15,a>>18&3
c=11025,12000,8000,0, 0,0,0,0, 22050,24000,16000,0, 44100,48000,32000,0
iInfoP.2=c((a.2&12)+a.4),((a>>30&3)!=3)+1
a.1=a.5+21+(iInfoP.3>1)*15 :bLoad p0,a,4,a.1
If(a==$676e6958){bLoad p0,a,4,a.1+4 :If(a&$1000000){ ;'Xing' 演奏時間@VBR
bLoad p0,a,4,a.1+8 :iInfoP.0=int(double(_mmMSB(a))*1152000/iInfoP.2)}}
If(a.2==15){ ;MPEG1/L1 [bpsテーブル]
c=0, 32, 64, 96,128,160,192,224,256,288,320,352,384,416,448,0
}else{If(a.2==14){ ;MPEG1/L2
c=0, 32, 48, 56, 64, 80, 96,112,128,160,192,224,256,320,384,0
}else{If(a.2==13){ ;MPEG1/L3
c=0, 32, 40, 48, 56, 64, 80, 96,112,128,160,192,224,256,320,0
}else{If(a.2==11){ ;MPEG2/L1
c=0, 32, 48, 56, 64, 80, 96,112,128,144,160,176,192,224,256,0
}else{ ;MPEG2/L2,3 MPEG2.5/L1,2,3
c=0, 8, 16, 24, 32, 40, 48, 56, 64, 80, 96,112,128,144,160,0
}}}}
bLoad p0,a,4,a.7-$80 :a.1=a.7-a.5-((a&$ffffff)==$474154)*$80
If(iInfoP.0==0){iInfoP.0=a.1*8/c(a.3)} ;PlayTime
iInfoP.1=c(a.3)*1000 ;BitRate
bLoad p0,a,4,a.7-$80 :a&=$ffffff :sDim b,$84
If(a==$474154){bLoad p0,b,$80,a.7-$80 ;'TAG':ID3v1タグ
If(sInfoP.0==""){sInfoP.0=_mmCutSpc(b,3,30)}
If(sInfoP.1==""){sInfoP.1=_mmCutSpc(b,33,30)}
If(sInfoP.2==""){sInfoP.2=_mmCutSpc(b,63,30)}
If(sInfoP.3==""){sInfoP.3=_mmCutSpc(b,97,28)}}
sInfoP.4=p0 :If(p1<4){Return iInfoP(p1)}else{Return sInfoP(p1-4)}
Return ""
//---- OGG vorbis ----------------------------------------------
;--OGG情報取得("file.ogg", Type) = Info
#defcfunc _mmGetInfoO str p0, int p1, local a, local b
If(vartype(sInfoO)==2){If((sInfoO.4)==p0){If(p1<4){Return iInfoO(p1)}else{Return sInfoO(p1-4)}}}
Exist p0 :a.8=strsize :If(a.8<1){Return ""} :Dim iInfoO,6 :sDim sInfoO,$200,5 :sDim b,$10100,4
Repeat ;Oggページ探索
*@ :If(a.6>=a.8){Break} :bLoad p0,a,4,a.6 :If(a!=$5367674F){a.6++ :Goto *@b} ;'OggS'
a.4=0 :bLoad p0,a.5,1,a.6+26 :bLoad p0,b.1,a.5,a.6+27 :Poke b.1,a.5 :a.6+=a.5+27
Repeat :a.5=0 :*@ :a=Peek(b.1,a.4) :a.4++ :a.5+=a :If(a==$ff){Goto *@b}
If(a.5==0){Break} :bLoad p0,a,7,a.6 :If(a&1^1){Goto *@f}
If((a.0&$ffffff00)!=$726f7600)||((a.1&$ffffff)!=$736962){Goto *@f} ;'vorbis'
bLoad p0,b,a.5-7,a.6+7 :a.3=0
If((a&$ff)==1){iInfoO.1=lPeek(b,13),lPeek(b,5),Peek(b,4) :a.7|=1 :Goto *@f} ;[識別ヘッダ]
If((a&$ff)==3){a.3+=lPeek(b)+4 :a.2=lPeek(b,a.3) :a.3+4 :a.7|=2 :If(a.2==0){Goto *@f}
Repeat a.2 :a.1=lPeek(b,a.3) ;[コメントヘッダ]
MemCpy b.2,b,a.1,,a.3+4 :Poke b.2,a.1 :a.3+=a.1+4
b.2=_mmCCC(b.2) :a.1=InStr(b.2,,"=") :If(a.1<1){Continue}
b.3=GetPath(StrMid(b.2,0,a.1),16) ;判定用に小文字化
If(b.3=="title"){sInfoO.0=StrMid(b.2,a.1+1,$ffff)}
If(b.3=="artist"){sInfoO.1=StrMid(b.2,a.1+1,$ffff)}
If(b.3=="album"){sInfoO.2=StrMid(b.2,a.1+1,$ffff)}
If(b.3=="comment"){sInfoO.3=StrMid(b.2,a.1+1,$ffff)}
If(b.3=="loopstart"){iInfoO.4=int(StrMid(b.2,a.1+1,$ffff))}
If(b.3=="looplength"){iInfoO.5=int(StrMid(b.2,a.1+1,$ffff))}
Loop}
*@ :a.6+=a.5
Loop :If(a.7==3){Break} ;必要な情報揃ってるなら抜ける
Loop
bLoad p0,b,$10080,a.8-$10080 :a.2=$1007c ;ファイル末尾から最終ページ探し
*@ :If(lPeek(b,a.2)==$5367674f){If(Peek(b,a.2+5)&4){iInfoO=lPeek(b,a.2+6) :a.2=0}}
a.2-- :If(a.2>=0){Goto *@b} ;↑最終Oggページのヘッダから総サンプル数取得
If(iInfoO.5==0){iInfoO.5=iInfoO.0} ;ループ指定タグも一応保持
iInfoO.5+=iInfoO.4 :If(iInfoO.5>iInfoO.0){iInfoO.5=iInfoO.0}
If(iInfoO.2){iInfoO.0=int(double(iInfoO.0)*1000/iInfoO.2)} ;�隻担校�
sInfoO.4=p0 :If(p1<4){Return iInfoO(p1)}else{Return sInfoO(p1-4)}
Return ""
;---------------------------------------------------------------
;--音声ファイル情報取得("file.***", Type) = Info
#defcfunc mmGetInfo str p0, int p1, local a, local b
Exist p0 :a=strsize,p1&7 :If(a<1){If(a.1<4){Return 0}else{Return ""}}
sDim b,$200,2 :b=p0 :b=GetPath(StrMid(b,StrLen(b)-8,8),18)+"."
b.1=".wav." :If(InStr(b.1,,b)>=0){Return _mmGetInfoW(p0,a.1)}
b.1=".mid.midi." :If(InStr(b.1,,b)>=0){Return _mmGetInfoM(p0,a.1)}
b.1=".mp3." :If(InStr(b.1,,b)>=0){Return _mmGetInfoP(p0,a.1)}
b.1=".ogg." :If(InStr(b.1,,b)>=0){If(p1<8){Return _mmGetInfoO(p0,a.1)}
a=_mmGetInfoO(p0,0),((p1-8)&1)|4 :Return iInfoO(a.1)}
Return 1
#global
| |
|
|
2016/1/1(Fri) 07:25:24|NO.73908
>>Noapさん
気持ちは分かりますが、新年早々無意味な投稿は控えた方が良いでしょう。
でもどうやってタイミングを合わせたの？
どこかでテストでもやったのかな？
|
|
|
2016/1/1(Fri) 11:12:10|NO.73911
callfuncなどでサブルーチンを呼び出す実験のスクリプト
メインルーチンとサブルーチンを分けてあります
名前が「書いているとちゅうのスクリプト」になっていたことと
バグがあったのを修正しました
タイミングはたまたまです
#uselib "kernel32.dll"
#func VirtualProtect "VirtualProtect" sptr,int,int,sptr
#define PAGE_EXECUTE_READWRITE $00000040
v_label=*raberu
memcpy p_label,v_label,4
dim tmp,2
mref hspctx,68
dim bin_func_main,24
bin_func_main.0 = $BE56C031, varptr(tmp), $bb530689, varptr(hspctx.47), $85044689
bin_func_main.5 = $511C7EC9, $5102E1C1, $895913ff, $85590446, $890c74c0
bin_func_main.10 = $8C74FF0E, $88448F10, $50f6e2fc, $0c244c8b, $ff08798b
bin_func_main.15 = $078F0471, $15FF37FF, varptr(hspctx.54), $85505858, $ff0374c0
bin_func_main.20 = $A1580453, varptr(hspctx.196), $C9315E5B, $C3900F89
p_bin_func_main=varptr(bin_func_main)
dim bin,7
int_num_args=5
bin.0 = $b9909057, int_num_args, $15ff9066, varptr(p_bin_func_main), $0004c25f, p_label, varptr(int_decision)
VirtualProtect varptr(bin_func_main), 24*4, PAGE_EXECUTE_READWRITE, varptr(tmp)
VirtualProtect varptr(bin), 7*4 , PAGE_EXECUTE_READWRITE, varptr(tmp)
args=3,-5,6,7,8
mes "結果="+callfunc(args,varptr(bin),int_num_args)
mes int_decision
stop
*raberu
mes "個数="+tmp.0
mes "引き数アドレス="+tmp.1
mes "ラベルポインタ="+int_decision
dupptr buf,tmp.1,tmp.0*4
repeat tmp.0
mes "引き数"+cnt+"="+buf.cnt
loop
return 1192
| |
|
|
2016/1/1(Fri) 16:48:16|NO.73920
>タイミングはたまたまです
嘘はつかない方が良いですよ。
|
|
|
2016/1/1(Fri) 18:07:05|NO.73922
ばれましたか。やはり嘘はつけません。確かに実は12時ちょうどの少し前に書きあがってせっかくなので12ちょうどに投稿しようと時計を合わせて待っていました。
便利そうなスクリプトになったと思ったので投稿しました。
今度からは嘘は書きこまないようにします。
|
|
|
2016/1/3(Sun) 12:58:10|NO.73965
//整数型配列の任意の値での初期化
//repeatなどを使うよりは速いと思います
//memset_int p1,p2,p3
//p1=変数 : p3に指定した値でクリアする整数型配列
//p2=0~(0) : いくつ分クリアするか p2<=0の場合クリアされない
//p3=(0) : クリアする値
//|-----|-----|-----|-----|-----|-----|-----|-----|-----|-----|
#ifndef memset_int
#module
#uselib "kernel32.dll"
#func VirtualProtect "VirtualProtect" sptr,int,int,sptr
#define PAGE_EXECUTE_READWRITE $00000040
#uselib ""
#func global memset_int "" var,int,int
#deffunc _register_memset_int_ local p_memset_int, local int_tmp, local int_statbak
int_statbak=stat
bin="UVWj$X$@PTXj,Y)ﾈ_W3x@^V3pDVY]U3hH^VXP9ﾁ~$PXPXPXIUP]U+,7UP]X)ﾅ),7X]1,7FFFF9ﾁuﾞXVX_^]ﾃ"
dupptr p_memset_int, libptr(memset_int)+24, 4
p_memset_int=varptr(bin)
VirtualProtect p_memset_int, strlen(bin), PAGE_EXECUTE_READWRITE, varptr(int_tmp)
return int_statbak
#global
_register_memset_int_
#endif
//|-----|-----|-----|-----|-----|-----|-----|-----|-----|-----|
//動作サンプル
cls
dim buf,8
memset_int buf.1,length(buf)-2,400
repeat length(buf)
mes buf.cnt
loop
pos ginfo_sx/4,0
dim buf,8
memset_int buf.1,0,400
repeat length(buf)
mes buf.cnt
loop
pos ginfo_sx/2,0
dim buf,8
memset_int buf.1,-1,400
repeat length(buf)
mes buf.cnt
loop
pos ginfo_sx/4*3,0
dim buf,8
memset_int buf,length(buf),-1192
repeat length(buf)
mes buf.cnt
loop
| |
|
|
2016/1/3(Sun) 19:51:56|NO.73968
整数配列全体を手軽に任意の値で初期化できるようにしました
//整数型配列全体の任意の値での初期化
//repeatなどを使うよりは速い気がします
//memset_int p1,p2,p3
//p1=変数 : p3に指定した値でクリアする整数型配列
//p2=0~(0) : いくつ分クリアするか p2<=0の場合クリアされない
//p3=(0) : クリアする値
//arrayreset p1,p2,p3
//p1=変数 : p2に指定した値でクリアする整数型配列
//p2=(0) : クリアする値
//p3=0~(0) : 何階層までクリアするか (p3<=0 または p3>=4 または p3を省略した場合 配列全体の初期化がされます)
//|-----|-----|-----|-----|-----|-----|-----|-----|-----|-----|
#ifndef memset_int
#module
#uselib "kernel32.dll"
#func VirtualProtect "VirtualProtect" sptr,int,int,sptr
#define PAGE_EXECUTE_READWRITE $00000040
#uselib ""
#func global memset_int "" var,int,int
#deffunc _register_memset_int_ local p_memset_int, local int_tmp, local int_statbak
int_statbak=stat
bin="UVWj$X$@PTXj,Y)ﾈ_W3x@^V3pDVY]U3hH^VXP9ﾁ~$PXPXPXIUP]U+,7UP]X)ﾅ),7X]1,7FFFF9ﾁuﾞXVX_^]ﾃ"
dupptr p_memset_int, libptr(memset_int)+24, 4
p_memset_int=varptr(bin)
VirtualProtect p_memset_int, strlen(bin), PAGE_EXECUTE_READWRITE, varptr(int_tmp)
return int_statbak
#global
_register_memset_int_
#endif
//|-----|-----|-----|-----|-----|-----|-----|-----|-----|-----|
//|-----|-----|-----|-----|-----|-----|-----|-----|-----|-----|
#module
#deffunc arrayreset array arr_int_p1, int int_value, int int_p3,\
local i,\
local int_level,\
local int_statbak,\
local pval_arr_int_p1,\
local p_pval_arr_int_p1
int_statbak=stat
mref p_pval_arr_int_p1, 0
dupptr pval_arr_int_p1, p_pval_arr_int_p1, 48
int_level=int_p3
if int_level != limit(int_level,1,4) : int_level=4
i=1
repeat int_level,2
if pval_arr_int_p1.cnt: i*=pval_arr_int_p1.cnt
loop
memset_int arr_int_p1, i, int_value
return int_statbak
#global
//|-----|-----|-----|-----|-----|-----|-----|-----|-----|-----|
//使用サンプル
dim int_length,4
dim arr_int_buf,2,3,3
int_length.0=length(arr_int_buf)
int_length.1=length2(arr_int_buf)
int_length.2=length3(arr_int_buf)
int_length.3=length4(arr_int_buf)
arrayreset arr_int_buf, -999, 7
gosub *printarr
pos ginfo_sx/2,0
arrayreset arr_int_buf, 1192, 2
gosub *printarr
stop
*printarr
for i,,int_length.0
if int_length.1{
for j,,int_length.1
if int_length.2{
for k,,int_length.2
if int_length.3{
for l,,int_length.3
print "arr_int_buf."+i+"."+j+"."+k+"."+l+"=" + arr_int_buf.i.j.k.l
next
}else{
print "arr_int_buf."+i+"."+j+"."+k+"=" + arr_int_buf.i.j.k
}
next
}else{
print "arr_int_buf."+i+"."+j+"=" + arr_int_buf.i.j
}
next
}else{
print "arr_int_buf."+i+"=" + arr_int_buf.i
}
next
return
| |
|
|
2016/1/3(Sun) 21:02:19|NO.73971
No.73968を「DLL無し」で作り直してみました。
memset_intの内部コピーを実質再帰的に行うことで、普通のrepeat ~ loopより圧倒的に高速化しています。
#module
#deffunc memset_int array p1,int p2,int p3
ptr=0
if(ptr>=p2):return
a=p3,p3,p3,p3,p3,p3,p3,p3,p3,p3,p3,p3,p3,p3,p3,p3
ptr=64
memcpy p1,a,limit(p2*4,0,ptr),0,0
while (ptr<p2*4)
wait 0
memcpy p1,p1,limit(p2*4-ptr,0,ptr),ptr,0
ptr<<=1
wend
return
//arrayreset p1,p2,p3
//p1=変数 : p2に指定した値でクリアする整数型配列
//p2=(0) : クリアする値
//p3=0~(0) : 何階層までクリアするか (p3<=0 または p3>=4 または p3を省略した場合 配列全体の初期化がされます)
#deffunc arrayreset array arr_int_p1, int int_value, int int_p3,\
local i,\
local int_level,\
local int_statbak,\
local pval_arr_int_p1,\
local p_pval_arr_int_p1
int_statbak=stat
mref p_pval_arr_int_p1, 0
dupptr pval_arr_int_p1, p_pval_arr_int_p1, 48
int_level=int_p3
if int_level != limit(int_level,1,4) : int_level=4
i=1
repeat int_level,2
if pval_arr_int_p1.cnt: i*=pval_arr_int_p1.cnt
loop
memset_int arr_int_p1, i, int_value
return int_statbak
#global
//|-----|-----|-----|-----|-----|-----|-----|-----|-----|-----|
//使用サンプル
dim int_length,4
dim arr_int_buf,2,3,3
int_length.0=length(arr_int_buf)
int_length.1=length2(arr_int_buf)
int_length.2=length3(arr_int_buf)
int_length.3=length4(arr_int_buf)
arrayreset arr_int_buf, -999, 7
gosub *printarr
pos ginfo_sx/2,0
arrayreset arr_int_buf, 1192, 2
gosub *printarr
stop
*printarr
for i,,int_length.0
if int_length.1{
for j,,int_length.1
if int_length.2{
for k,,int_length.2
if int_length.3{
for l,,int_length.3
print "arr_int_buf."+i+"."+j+"."+k+"."+l+"=" + arr_int_buf.i.j.k.l
next
}else{
print "arr_int_buf."+i+"."+j+"."+k+"=" + arr_int_buf.i.j.k
}
next
}else{
print "arr_int_buf."+i+"."+j+"=" + arr_int_buf.i.j
}
next
}else{
print "arr_int_buf."+i+"=" + arr_int_buf.i
}
next
return
| |
|
|
2016/1/3(Sun) 21:59:11|NO.73973
補足：memset_int内のaの配列が16要素の理由はキャッシュラインサイズあたりに意図的にぶつけた形です。
ぶっちゃけ大した意味は無いのですが、この程度なら許容される遅延(16要素以下のフィル時)だろうと見積もった程度です。
|
|
|
2016/1/4(Mon) 18:53:47|NO.73991
簡易ベンチマークモジュールを作りました。
(ラベルを複数回実行して、かかった時間を logmes する)
https://gist.github.com/vain0/5aeda019eb11835987f4
せっかくなので測ってみます。
/* memset_int モジュールは省略 */
#include "benchmark.hsp"
randomize
r = rnd(254) + 1 // [1, 0xFE]
len = 100000
times = 100
dim xs, len
benchmark_logmes *lb_memset_int, "memset_int (large)", 10
len = 8
times = 10000
dim xs, len
benchmark_logmes *lb_memset_int, "memset_int (small)", 10
stop
*lb_memset_int
repeat times
memset_int xs, len, r
loop
return
|
|
|
2016/1/4(Mon) 23:00:16|NO.73995
なんで実行結果貼ってくれなかったんですかやだー
Core i3 / Win7 64bit / MEM:8GB
Noap版memset_int
計測結果: memset_int (large)
平均: 69.000000ms
中央: 69.000000ms
計測結果: memset_int (small)
平均: 1.875000ms
中央: 2.000000ms
私版memset_int
計測結果: memset_int (large)
平均: 3.250000ms
中央: 3.500000ms
計測結果: memset_int (small)
平均: 11.625000ms
中央: 11.000000ms
つまり、私のバージョンでは、small側に改善の余地有り……と。
思ってちょっとaの長さ変えたところ時間が伸びただけだった……だめじゃん。
|
|
|
2016/1/6(Wed) 05:54:07|NO.74015
//変数ポインタからクローン変数を作成するモジュール
//PValポインタから配列の各要素のポインタ取得
//get_ptr_from_pval(p1,p2)
//p1=(0) : PValポインタ
//p2=(0) : 変数内オフセット
//変数ポインタからクローン変数作成
//dupptrpval p1,p2
//p1=変数 : クローン変数にする変数
//p2=(0) : ポインタ
#module
#define SIZE_PVAL_INT 12
#const SIZE_PVAL (SIZE_PVAL_INT*4)
#define SIZE_HSPVARPROC 140
#define HSPVAR_FLAG_STR 2
#define HSPVAR_FLAG_DOUBLE 3
#defcfunc get_ptr_from_pval int p_pval, int int_index_element,\
local hspctx,\
local pval,\
local copy_pval,\
local arr_int_function_arguments,\
local p_hspvarproc, local hspvarproc,\
if (p_pval==0) | (int_index_element<0): return 0
mref hspctx,68
dupptr pval, p_pval, SIZE_PVAL
dim copy_pval, SIZE_PVAL_INT
memcpy copy_pval, pval, SIZE_PVAL
copy_pval.10= int_index_element
//HspFunc_GetProc(変数型)
arr_int_function_arguments= pval.0 & $FFFF
p_hspvarproc=callfunc( arr_int_function_arguments, hspctx.37, 1)
dupptr hspvarproc, p_hspvarproc, SIZE_HSPVARPROC
arr_int_function_arguments= varptr(copy_pval)
return callfunc( arr_int_function_arguments, hspvarproc.7, 1)
#deffunc dupptrpval var v_to_var, int p_from_ptr,\
local pval_tmp,\
local pval_bak,\
local pval_found,\
local pval_v_to_var,\
local pval,\
local hspctx,\
local p_pval_v_to_var,\
local p_pval_found,\
local i, local j,\
local int_size_array
if p_from_ptr==0: return
mref p_pval_v_to_var,0
dupptr pval_v_to_var, p_pval_v_to_var, SIZE_PVAL
mref hspctx,68
dim pval_bak, SIZE_PVAL_INT
for i, hspctx.11, p_pval_v_to_var, SIZE_PVAL
dupptr pval, i, SIZE_PVAL
if pval.0 & $FFFF == HSPVAR_FLAG_STR{
int_size_array=1
for j,2,6
if pval.j: int_size_array*=pval.j
next
//mes "i="+i+" size="+int_size_array
for j,,int_size_array
if p_from_ptr == get_ptr_from_pval(i, j){
p_pval_found= i
_break
}
next
}else{
if p_from_ptr == limit(p_from_ptr, pval.7, pval.7+pval.6){
p_pval_found= i
_break
}
}
if p_pval_found: _break
next
if p_pval_found{
//変数型のコピー
dupptr pval_found, p_pval_found, SIZE_PVAL
dupptr pval, hspctx.207+12, SIZE_PVAL
memcpy pval_bak, pval, SIZE_PVAL
memcpy pval, pval_found, SIZE_PVAL
dup v_to_var, pval_tmp
memcpy pval, pval_bak , SIZE_PVAL
memcpy pval_v_to_var, pval_found, 44 ,4, 4
//dup v_to_var, v_to_var
}
//mes p_pval_found
return
#global
//動作サンプル
/*
dim int_dummy,2,5
sdim buf,200,3,5
mes varptr(buf.1.1)
//mes varptr(buf.4)
buf.0.0="かきくけこ"
buf.1.1="あいうえお"
dupptrpval clonebuf, varptr(buf)
mes "resut="+clonebuf.1.1
dim clonebuf
dim int_dummy,2,5
dim buf,3,5
mes varptr(buf.1.1)
//mes varptr(buf.4)
buf.0.0=999
buf.1.1=100
dupptrpval clonebuf, varptr(buf)
mes "resut="+clonebuf.1.1
mes "resut="+clonebuf.0.0
dim clonebuf,200
*/
| |
|
|
2016/1/6(Wed) 20:34:25|NO.74026
HSPVarProcから四則演算関数を直接使ってみました
何かの役に立つかは分かりません
//HSPVarProcから四則演算関数を直接使うスクリプト
#define HSPVAR_FLAG_DOUBLE 3
#define HSPVAR_FLAG_INT 4
mref hspctx,68
arr_int_function_arguments= HSPVAR_FLAG_INT
p_hspvarproc=callfunc( arr_int_function_arguments, hspctx.37, 1)
dupptr hspvarproc, p_hspvarproc, 140
int_tmp=70,8
//GtI
hspctx.196=int_tmp.0
arr_int_function_arguments= varptr(hspctx.196), varptr(int_tmp.1)
int_result=callfunc( arr_int_function_arguments, hspvarproc.29, 2)
if stat{
mes ""+int_tmp.0+">"+int_tmp.1
}
//LtI
hspctx.196=int_tmp.0
arr_int_function_arguments= varptr(hspctx.196), varptr(int_tmp.1)
int_result=callfunc( arr_int_function_arguments, hspvarproc.30, 2)
if stat{
mes ""+int_tmp.0+"<"+int_tmp.1
}
int_tmp=100,200
//GtEqI
hspctx.196=int_tmp.0
arr_int_function_arguments= varptr(hspctx.196), varptr(int_tmp.1)
int_result=callfunc( arr_int_function_arguments, hspvarproc.31, 2)
if stat{
mes ""+int_tmp.0+">="+int_tmp.1
}
//GtI(2)
hspctx.196=int_tmp.0
arr_int_function_arguments= varptr(hspctx.196), varptr(int_tmp.1)
int_result=callfunc( arr_int_function_arguments, hspvarproc.29, 2)
if stat{
mes ""+int_tmp.0+">"+int_tmp.1
}
//LtI(2)
hspctx.196=int_tmp.0
arr_int_function_arguments= varptr(hspctx.196), varptr(int_tmp.1)
int_result=callfunc( arr_int_function_arguments, hspvarproc.30, 2)
if stat{
mes ""+int_tmp.0+"<"+int_tmp.1
}
//GtEqI(2)
hspctx.196=int_tmp.0
arr_int_function_arguments= varptr(hspctx.196), varptr(int_tmp.1)
int_result=callfunc( arr_int_function_arguments, hspvarproc.31, 2)
if stat{
mes ""+int_tmp.0+">="+int_tmp.1
}
//EqI(2)
hspctx.196=int_tmp.0
arr_int_function_arguments= varptr(hspctx.196), varptr(int_tmp.1)
int_result=callfunc( arr_int_function_arguments, hspvarproc.27, 2)
if stat{
mes ""+int_tmp.0+"=="+int_tmp.1
}
//NeI(2)
hspctx.196=int_tmp.0
arr_int_function_arguments= varptr(hspctx.196), varptr(int_tmp.1)
int_result=callfunc( arr_int_function_arguments, hspvarproc.28, 2)
if stat{
mes ""+int_tmp.0+"!="+int_tmp.1
}
int_tmp=80,80
//GtEqI(2)
hspctx.196=int_tmp.0
arr_int_function_arguments= varptr(hspctx.196), varptr(int_tmp.1)
int_result=callfunc( arr_int_function_arguments, hspvarproc.31, 2)
if stat{
mes ""+int_tmp.0+">="+int_tmp.1
}
//LtEqI(2)
hspctx.196=int_tmp.0
arr_int_function_arguments= varptr(hspctx.196), varptr(int_tmp.1)
int_result=callfunc( arr_int_function_arguments, hspvarproc.32, 2)
if stat{
mes ""+int_tmp.0+"<="+int_tmp.1
}
//EqI(2)
hspctx.196=int_tmp.0
arr_int_function_arguments= varptr(hspctx.196), varptr(int_tmp.1)
int_result=callfunc( arr_int_function_arguments, hspvarproc.27, 2)
if stat{
mes ""+int_tmp.0+"=="+int_tmp.1
}
//NeI(2)
hspctx.196=int_tmp.0
arr_int_function_arguments= varptr(hspctx.196), varptr(int_tmp.1)
int_result=callfunc( arr_int_function_arguments, hspvarproc.28, 2)
if stat{
mes ""+int_tmp.0+"!="+int_tmp.1
}
int_tmp=64,3
//RrI
hspctx.196=int_tmp.0
arr_int_function_arguments= varptr(hspctx.196), varptr(int_tmp.1)
int_result=callfunc( arr_int_function_arguments, hspvarproc.33, 2)
mes ""+int_tmp.0+">>"+int_tmp.1+"="+stat
//LrI
hspctx.196=int_tmp.0
arr_int_function_arguments= varptr(hspctx.196), varptr(int_tmp.1)
int_result=callfunc( arr_int_function_arguments, hspvarproc.34, 2)
mes ""+int_tmp.0+"<<"+int_tmp.1+"="+stat
//AddI
hspctx.196=int_tmp.0
arr_int_function_arguments= varptr(hspctx.196), varptr(int_tmp.1)
int_result=callfunc( arr_int_function_arguments, hspvarproc.19, 2)
mes ""+int_tmp.0+"+"+int_tmp.1+"="+stat
//SubI
hspctx.196=int_tmp.0
arr_int_function_arguments= varptr(hspctx.196), varptr(int_tmp.1)
int_result=callfunc( arr_int_function_arguments, hspvarproc.20, 2)
mes ""+int_tmp.0+"-"+int_tmp.1+"="+stat
//MulI
hspctx.196=int_tmp.0
arr_int_function_arguments= varptr(hspctx.196), varptr(int_tmp.1)
int_result=callfunc( arr_int_function_arguments, hspvarproc.21, 2)
mes ""+int_tmp.0+"*"+int_tmp.1+"="+stat
//DivI
hspctx.196=int_tmp.0
arr_int_function_arguments= varptr(hspctx.196), varptr(int_tmp.1)
int_result=callfunc( arr_int_function_arguments, hspvarproc.22, 2)
mes ""+int_tmp.0+"/"+int_tmp.1+"="+stat
//ModI
hspctx.196=int_tmp.0
arr_int_function_arguments= varptr(hspctx.196), varptr(int_tmp.1)
int_result=callfunc( arr_int_function_arguments, hspvarproc.23, 2)
mes ""+int_tmp.0+"\\"+int_tmp.1+"="+stat
| |
|
|
2016/1/8(Fri) 22:23:55|NO.74059
//エディトボックスに入力説明(プロンプト)を表示するスクリプト
//モジュールにする意味はあまりありませんでした
#module
#define EM_SETCUEBANNER $00001501
#uselib "user32.dll"
#func SendMessageW "SendMessageW" int,int,wptr,wptr
#deffunc prompt_inputbox int int_id_object, str str_tip, int int_option_behavor
SendMessageW objinfo_hwnd(int_id_object), EM_SETCUEBANNER, int_option_behavor, str_tip
return
#global
#define EM_SETCUEBANNER $00001501
#define WA_INACTIVE $00000000
#define WM_ACTIVATE $00000006
sdim buf,512
input buf,ginfo_sx/2,,511
input buf,ginfo_sx/2,,511
input buf,ginfo_sx/2,,511
prompt_inputbox 0, "説明", 1
//prompt_inputbox 1, "説明", 0
cnvstow buf,"説明"
sendmsg objinfo_hwnd(1), EM_SETCUEBANNER, 0 , varptr(buf)
|
|
|
2016/1/10(Sun) 17:18:43|NO.74086
ふりがなをつけるサンプル。
#module 文字列加工
#defcfunc cat str str1 ,str str2 ,str str3,int ct
ct2=ct
開始文字数 = strlen(str1)
終了文字数 = strlen(str3)
開始=str1
文字列=str2
終了=str3
開始in=0
終了in=0
repeat ct2+1
開始in = instr(文字列,開始in,開始)+開始文字数+開始in
loop
終了in = instr(文字列,開始in,終了)+開始in
最終=strmid(文字列,開始in,終了in-開始in)
return 最終
#defcfunc Cstrrep str str1 ,str str2 ,str str3,str str4//p1 開始ユニーク文字 p2 置換対象の文章 p3 終了ユニーク文字 p4 置換する文字列
開始文字数 = strlen(str1)
全体文字数 = strlen(str2)
終了文字数 = strlen(str3)
置換文字数 = strlen(str4)
開始=str1
最終=""
文字列=str2
終了=str3
開始in=0
置換後=str4
Index=0
repeat
開始in2 = instr(文字列,Index,開始)
開始in = Index + 開始in2
if 開始in2!-1:{
終了in = instr(文字列,開始in,終了)+開始in
if 終了in!-1:{
文字列=""+strmid(文字列,0,開始in)+""+置換後+""+strmid(文字列,終了in+終了文字数,全体文字数)+""
}else:break
}else:break
Index + 開始in2 + 置換文字数
//Dialog ""+開始in2+","+置換文字数+","+Index+""
loop
return 文字列
#defcfunc Cinstr str str1,int int2,str str3
文字列 = str1
Index = int2
検索文字列 = str3
検索文字数 = strlen(str3)
ヒット数=0
repeat
開始in2 = instr(文字列,Index,検索文字列)
//Dialog ""+開始in2+","+Index+""
開始in = Index + 開始in2
if 開始in2!-1:ヒット数+1:else:break
Index + 開始in2 + 検索文字数
loop
return ヒット数
#global
Screen 0,1900,500
posy=50
a="{+東京特許許可局,とうきょうとっきょきょかきょく+}は実は存在しない。{+生麦生米生卵,なまむぎなまごめなまたまご+}も早口言葉の定番。"
repeat
最初in=0
最後in=0
pos 0,0
fontsize=double(mousex)/1.0
font "メイリオ",int(fontsize+0.5)
redraw 0
Color 255,255,255:boxf:Color 0,0,0
ルビ数=Cinstr(a,0,"{+")//ルビがいくつあるかを調べる
dim 主文章pos,ルビ数
dim 主文章size,ルビ数
最初in = instr(a,0,"{+")
pos ,posy:mes strmid(a,0,最初in)//0~最初のルビまでを描画
repeat ルビ数//ルビの主漢字を描画
pos ginfo_cx+ginfo_mesx,posy:mes cat("{+",a,",",cnt)
主文章pos.cnt=ginfo_cx
主文章size.cnt=ginfo_mesx
if (ルビ数-1)!cnt:{//ルビの間の通常の文章を描画。ただし、最後のルビの後は別に描画。
pos ginfo_cx+ginfo_mesx,posy:mes cat("+}",a,"{+",cnt)
}
loop
repeat ルビ数//最後のルビの終わりを検索
最後in + instr(a,最後in,"+}")+2
loop
pos ginfo_cx+ginfo_mesx,posy:mes strmid(a,最後in,strlen(a)-最後in)//さっき検索した位置から最後までを調べる
repeat ルビ数//ルビを描画。
font "メイリオ",fontsize:pos ginfo_winx,ginfo_winy:mes cat(",",a,"+}",cnt)//画面外に主漢字と同じサイズで描画し縮小サイズを計算。必ずフォントサイズを毎回指定すること！
縮小倍率=(double(ginfo_mesx)/double(主文章size.cnt))
font "メイリオ",fontsize/縮小倍率
pos 主文章pos.cnt,posy-((double(ginfo_mesy)/縮小倍率)*0.5):mes cat(",",a,"+}",cnt)
loop
redraw 1
await
loop
| |
|
|
2016/1/11(Mon) 21:19:42|NO.74100
昔のサンプル・フォルダから投稿しやすいものを見つけてみました。
//--------------------------------------
// 縁取り文字列のサンプル
//--------------------------------------
*Main
font MSGOTHIC,50,1
color $00,$00,$00:boxf
n=3
EdgePuts 100,100,n,$FFFFFF,$FF0000,"あいうえお"
EdgePuts 100,150,n,$FFFFFF,$00CC00,"かきくけこ"
EdgePuts 100,200,n,$FFFFFF,$0000FF,"さしすせそ"
EdgePuts 100,250,n,$FFFFFF,$FF00FF,"たちつてと"
EdgePuts 100,300,n,$FFFFFF,$FFCC00,"なにぬねの"
EdgePuts 100,350,n,$FFFFFF,$00CCFF,"はひふへほ"
stop
//--------------------------------------
// 縁取り文字
//--------------------------------------
#deffunc EdgePuts int _cx_,int _cy_,int _dot_,int _c1_,int _c2_,str _msg_
r=((_c1_>>8*2) & $FF)
g=((_c1_>>8*1) & $FF)
b=((_c1_>>8*0) & $FF)
color r,g,b
i=(_dot_*2+1)
repeat i:y=cnt
repeat i:x=cnt
pos (_cx_+x),(_cy_+y)
mes _msg_
loop
loop
r=((_c2_>>8*2) & $FF)
g=((_c2_>>8*1) & $FF)
b=((_c2_>>8*0) & $FF)
color r,g,b
pos(_cx_+_dot_),(_cy_+_dot_)
mes _msg_
return
//------------------------------------------------------------------------------
// End of sample48.hsp
//------------------------------------------------------------------------------
| |
|
|
2016/1/13(Wed) 20:12:41|NO.74118
座標を中心に文字列を表示する命令と
座標を左下に文字列を表示する命令。
フォントによってはうまくいかないかも...
#module
#deffunc cmes str p1 ;座標を中心に文字列を書く
s1 = ginfo(22) ;現在の座標(x)
s2 = ginfo(23) ;現在の座標(y)
s3 = ginfo_sx ;画面外のX座標
s4 = ginfo_sy ;画面外のY座標
pos s3,s4:mes p1 ;文字サイズ取得用に表示
s5 = ginfo(14)/2 ;表示(x)
s6 = ginfo(15)/2 ;表示(y)
pos s1-s5,s2-s6:mes p1 ;メイン表示
pos s1,s2+(s6*2)+4 ;座標をずらす
return
#deffunc lfmes str p1 ;座標を左下に文字列を書く
s1 = ginfo(22) ;現在の座標(x)
s2 = ginfo(23) ;現在の座標(y)
s3 = ginfo_sx ;画面外のX座標
s4 = ginfo_sy ;画面外のY座標
pos s3,s4:mes p1 ;取得用表示
s5 = ginfo(14) ;表示(x)
s6 = ginfo(15) ;表示(y)
pos s1-s5,s2-s6:mes p1 ;メイン表示
pos s1,s2-s6 ;座標をずらす
return
#global
/* 動作サンプル */
screen 0,640,480
pos 320,120
cmes "座標を中心に文字列を表示する"
cmes "Tabとか改行は非対応..."
pos 640,480
lfmes "座標が下にくるように..."
lfmes "続けて書くとこうなる"
lfmes "これもTabとか改行は非対応..."
/****************/
|
|
|
2016/1/15(Fri) 04:34:02|NO.74127
深夜テンションによるエニグマ風暗号モジュール「エニグルマ」。
HSPの擬似乱数というゴミを使っているため、実用しないべき。(MTならともかく)
ギア噛合により、置換ギアが一応最大10^36周期で回るようにはなっている。
なので、乱数生成器とシードに拘れば、そこそこ行けるかも知れない。が保証ナシ
他にもハッシュ生成がダメダメだったりといろいろ手抜きですよ。
//Enigruma暗号モジュール
//エニグマ(Enigma)を参考になんとなくで作成。
#include "hspinet.as"
#module rotor f,fi
#modinit
dim f,256
dim fi,256
for i,0,256
f(i)=i
fi(i)=i
next
repeat 500+rnd(1000)//ローターの結線交換
wait 0
a=rnd(256):b=rnd(256)
fa=f(a):fb=f(b)
tmp=fi(fa): fi(fa)=fi(fb):fi(fb)=tmp
f(a)=fb:f(b)=fa
loop
return
#modcfunc rotor_crypt int x
return f(x)
#modcfunc rotor_decrypt int x
return fi(x)
#modfunc rotor_step
repeat 256//1ステップ回す
wait 0
a=cnt:b=(cnt+1)\256
fa=f(a):fb=f(b)
tmp=fi(fa): fi(fa)=fi(fb):fi(fb)=tmp
f(a)=fb:f(b)=fa
loop
return
#global
#module reflector f
#modinit
dim f,256
dim fi,256
for i,0,256
f(i)=i
next
repeat 50000+rnd(10000)//反射板の結線交換
wait 0
a=rnd(256):b=rnd(256)
fa=f(a):fb=f(b)
if(fa==a)^(fb==b){
if(fa==a){
f(a)=fb:f(fb)=a:f(b)=b
}else{
f(b)=fa:f(fa)=b:f(a)=a
}
}else{
f(fa)=b:f(fb)=a
f(a)=fb:f(b)=fa
}
loop
return
#modcfunc reflector_crypt int x
return f(x)
#global
#module enigruma r,hash,latch,gear,ref
#modinit int num
gear=limit(num,4,25)
prime=1,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97
dim latch,gear
repeat gear
newmod r,rotor
latch(cnt)=rnd(prime(cnt))
loop
newmod ref,reflector
dim hash,16
return
#define global sethash(%1,%2,%3=-1) _sethash %1,%2,%3
#modfunc _sethash str inp,int len,local long,local in
in=inp
long=len:if(long==-1):long=strlen(in)
varmd5@ md5,in,long//本当はsaltを混ぜてごちゃごちゃさせるべき
hl=int("$"+strmid(md5,0,8)),int("$"+strmid(md5,8,8)),int("$"+strmid(md5,16,8)),int("$"+strmid(md5,24,8))
repeat 16
hash(cnt)=peek(hl,cnt)
for i,0,cnt
if(hash(i)==hash(cnt)){
hash(cnt)=(hash(cnt)+1)\256
i=-1
_continue
}
next
loop
return
#modcfunc _encrypt_base64 str in, int len,local long
if(len==-1):long=strlen(in):else:long=len
buf=_crypt(thismod,in,long)
b64encode@ b64,buf,long
return b64
#modcfunc _decrypt_base64 str ins,local long,local in
in=ins
long=strlen(in)/4*3
if(instr(in,0,"=")!=-1):long-=strlen(in)-instr(in,0,"=")
b64decode@ b64,in
return _crypt(thismod,b64,long)
#modcfunc _crypt str ins,int len,local long,local in
in=ins
long=len
sdim out,long
for i,0,long
tmp=peek(in,i)
for j,0,16//入力読み替え
if(tmp==hash(j)){
if j&1:tmp=hash(j-1):else:tmp=hash(j+1)
_break
}
next
for j,0,gear//入力ギア集
tmp=rotor_crypt(r(j),tmp)
next
tmp=reflector_crypt(ref,tmp)
for j,gear-1,-1,-1//出力ギア集
tmp=rotor_decrypt(r(j),tmp)
latch(j)=(latch(j)+1)\prime(j)
if(latch(j)==0):rotor_step(r(j))
next
for j,0,16//出力読み替え
if(tmp==hash(j)){
if j&1:tmp=hash(j-1):else:tmp=hash(j+1)
_break
}
next
poke out,i,tmp
next
return out
#define global ctype encrypt_base64(%1,%2,%3=-1) _encrypt_base64(%1,%2,%3)
#define global ctype decrypt_base64(%1,%2)_decrypt_base64(%1,%2)
#global
password="password"
text="エニグルマ/テスト"
randomize
seed=(rnd(256)<<24)+(rnd(256)<<16)+(rnd(256)<<8)+rnd(256)
randomize seed
newmod enc,enigruma,25
sethash enc,password
//同じ処理でデコードオブジェクトを作る
randomize seed
newmod dec,enigruma,25
sethash dec,password
//ちなみにdec=encで作ったつもりになっても、同じオブジェクトを示すため、なんの意味もない。ダメな奴
s=encrypt_base64(enc,text)
mes s
p=decrypt_base64(dec,s)
mes p
| |
|
|
2016/1/20(Wed) 17:56:09|NO.74211
phpには、var_dumpという関数があります。
それのhsp版を作ってみました。
#module
#defcfunc arraysize array a
if(length4(a)>0):return 4
if(length3(a)>0):return 3
if(length2(a)>0):return 2
if(length(a)>1):return 1
return 0
#defcfunc get_pval var v
#deffunc get_pval_0 int pval
return pval
#defcfunc getvarsize var varget, local varsizinf, local varsizeptr, local hspctxstrr, local pvaladr, local pvala
if vartype(varget)==vartype("str"){
varsizeptr=varptr(varget)
dupptr varsizinf,varsizeptr-16,4
return varsizinf
}
mref hspctxstrr,68
dupptr pvaladr,hspctxstrr.207,4
dupptr pvala,pvaladr,48,vartype("str")
return lpeek(pvala,24)
#defcfunc getvar var v2
if(vartype(v2)=vartype("str")):return "\""+v2+"\""
if(vartype(v2)=vartype("int")):return str(v2)
if(vartype(v2)=vartype("double")):return str(v2)
dupptr v3,varptr(v2),getvarsize(v2),vartype("str")
return "\""+v3+"\""
#deffunc init
screen 32
title "var_dump 結果リポート"
objsize 640,480
sdim s,1000000
mesbox s,,,4
sstat=stat
sdim type,6
type(vartype("str"))="str"
type(vartype("int"))="int"
type(vartype("double"))="double"
type(vartype("label"))="label"
type(vartype("comobj"))="comobj"
type(vartype("struct"))="struct"
return
#deffunc var_dump array a
msg=""
msg+="変数型:"+type(vartype(a))+"\n"
msg+="配列:("+length(a)+","+length2(a)+","+length3(a)+","+length4(a)+")\n"
repeat length(a)
a1=cnt
if(arraysize(a)=0):msg+=getvar(a)
if(arraysize(a)=1):msg="("+cnt+"):"+getvar(a(a1))+"\n"
if(arraysize(a)=2):msg+="("+cnt+"){\n"
if(arraysize(a)=3):msg+="("+cnt+"){\n"
if(arraysize(a)=4):msg+="("+cnt+"){\n"
repeat length2(a)
a2=cnt
if(arraysize(a)=2):msg+="\t("+cnt+"):"+getvar(a(a1,a2))+"\n"
if(arraysize(a)=3):msg+="\t("+cnt+"){\n"
if(arraysize(a)=4):msg+="\t("+cnt+"){\n"
repeat length3(a)
a3=cnt
if(arraysize(a)=3):msg+="\t\t("+cnt+"):"+getvar(a(a1,a2,a3))+"\n"
if(arraysize(a)=4):msg+="\t\t("+cnt+"){\n"
repeat length4(a)
a4=cnt
if(arraysize(a)=4):msg+="\t\t\t("+cnt+"):"+getvar(a(a1,a2,a3,a4))+"\n"
await 1
loop
if(arraysize(a)=4):msg+="\t\t}\n"
loop
if(arraysize(a)=3):msg+="\t}\n"
if(arraysize(a)=4):msg+="\t}\n"
loop
if(arraysize(a)>1):msg+="}\n"
loop
objprm sstat,msg
return
#global
init
この命令は現状問題があります。
・一次元配列だと表示がおかしい
(・具体的には、変数型、配列の要素数が表示されない
・なんか二つ目しか表示しない)
・str、int、doubleしかほとんど対応していない。
ちなみにプラグインで変数型を追加した時に、
その型も表示したいときは、
type配列とgetvar関数の処理を適切に追加することで、対応できます。
| |
|
|
2016/1/20(Wed) 17:59:41|NO.74212
上記モジュールについて
パブリックドメインとします。
また、モジュールを改良してくれる人がいたら、改良お願いします。
改良してほしい点は、
・上記であげた問題
・変数名が表示されない（というより取得方法がわからない。
ネットで調べていくつかでてくるのですが、実行してみたところ
取得できるのが謎の数字となっています。）
|
|
|
2016/1/20(Wed) 22:30:37|NO.74214
>>kanamaruさん
モジュールの改良ではないですが、変数名は以下のスクリプトで取得できました。
// デバッグ時以外での変数名情報の出力を有効にする
#cmpopt varname 1
// 変数名取得モジュール
#module VarName
#uselib ""
#cfunc _varname "" int
#defcfunc getPval var
mref pval, 0
return pval
#deffunc local init
mref ctx, 68
pvalHead = lpeek(ctx, 44)
dupptr exinfo, lpeek(ctx, 876), 196
dupptr sd, libptr(_varname), 28
lpoke sd, 24, lpeek(exinfo, 188)
return
#defcfunc getVarName array _var
id = (getPval(_var) - pvalHead) / 48
p = _varname(id)
dupptr name, p, 100, 2
return name
#global
init@VarName
#module mod
#global
myVariable@mod = 0
mes getVarName(myVariable@mod)
P.S. 謎の数字…ポインタか何かじゃないですかね。
|
|
|
2016/1/20(Wed) 22:38:34|NO.74215
ありがとうございます。
明日試してみます。
教えてくれたソースを見て思ったのが、
今思うと、謎の数字って#cmpoptを記述してなかったからかも。
|
|
|
2016/1/21(Thu) 08:14:53|NO.74218
zeroさんが教えてくれたソースを組み込み、
他にも、表示する情報を増やしてみました。
（デバッグウィンドウで表示される変数情報すべてに対応しました。
デバッグウィンドウでは、配列の表示は途中で切られるので、
デバッグウィンドウ代わりにも使えるようになったと思います。）
#module
#uselib ""
#cfunc _varname "" int
#defcfunc arraysize array a
if(length4(a)>0):return 4
if(length3(a)>0):return 3
if(length2(a)>0):return 2
if(length(a)>1):return 1
return 0
#defcfunc get_pval var v
#deffunc get_pval_0 int pval
return pval
#defcfunc getvarsize var varget, local varsizinf, local varsizeptr, local hspctxstrr, local pvaladr, local pvala
if vartype(varget)==vartype("str"){
varsizeptr=varptr(varget)
dupptr varsizinf,varsizeptr-16,4
return varsizinf
}
mref hspctxstrr,68
dupptr pvaladr,hspctxstrr.207,4
dupptr pvala,pvaladr,48,vartype("str")
return lpeek(pvala,24)
#defcfunc getvar var v2
if(vartype(v2)=vartype("str")):return "\""+v2+"\""
if(vartype(v2)=vartype("int")):return str(v2)
if(vartype(v2)=vartype("double")):return str(v2)
dupptr v3,varptr(v2),getvarsize(v2),vartype("str")
return "\""+v3+"\""
#deffunc init
screen 32
title "var_dump 結果リポート"
objsize 640,480
sdim s,1000000
mesbox s,,,4
sstat=stat
mref ctx, 68
pvalHead = lpeek(ctx, 44)
dupptr exinfo, lpeek(ctx, 876), 196
dupptr sd, libptr(_varname), 28
lpoke sd, 24, lpeek(exinfo, 188)
return
return
#defcfunc varname array _var
id = (get_pval(_var) - pvalHead) / 48
p = _varname(id)
dupptr name, p, 100, 2
return name
#deffunc var_dump array a
msg=""
sdim type,6
type(vartype("str"))="str"
type(vartype("int"))="int"
type(vartype("double"))="double"
type(vartype("label"))="label"
type(vartype("comobj"))="comobj"
type(vartype("struct"))="struct"
msg+="変数名:"+varname(a)+"\n"
msg+="変数型:"+type(vartype(a))+"\n"
msg+="配列:("+length(a)+","+length2(a)+","+length3(a)+","+length4(a)+")\n"
dupptr pval,get_pval(a),48,vartype("int")
msg+="モード:"+pval.1+"\n"
msg+="使用サイズ:"+pval.6+"\n"
msg+="バッファサイズ:"+getvarsize(a)+"\n"
repeat length(a)
a1=cnt
if(arraysize(a)=0):msg+=getvar(a)
if(arraysize(a)=1):msg="("+cnt+"):"+getvar(a(a1))+"\n"
if(arraysize(a)=2):msg+="("+cnt+"){\n"
if(arraysize(a)=3):msg+="("+cnt+"){\n"
if(arraysize(a)=4):msg+="("+cnt+"){\n"
repeat length2(a)
a2=cnt
if(arraysize(a)=2):msg+="\t("+cnt+"):"+getvar(a(a1,a2))+"\n"
if(arraysize(a)=3):msg+="\t("+cnt+"){\n"
if(arraysize(a)=4):msg+="\t("+cnt+"){\n"
repeat length3(a)
a3=cnt
if(arraysize(a)=3):msg+="\t\t("+cnt+"):"+getvar(a(a1,a2,a3))+"\n"
if(arraysize(a)=4):msg+="\t\t("+cnt+"){\n"
repeat length4(a)
a4=cnt
if(arraysize(a)=4):msg+="\t\t\t("+cnt+"):"+getvar(a(a1,a2,a3,a4))+"\n"
await 1
loop
if(arraysize(a)=4):msg+="\t\t}\n"
loop
if(arraysize(a)=3):msg+="\t}\n"
if(arraysize(a)=4):msg+="\t}\n"
loop
if(arraysize(a)>1):msg+="}\n"
loop
objprm sstat,msg
return
#global
init
引き続き、改良してくれる人がいたら改良お願いします。
| |
|
|
2016/1/22(Fri) 05:44:00|NO.74224
・Windows 8.1 と 10 を識別するには？
http://hsp.tv/play/pforum.php?mode=pastwch&num=70416
去年話題になったOSバージョンの取得サンプルを作ってみた。
//------------------------------------------------------------------------------
// OSバージョンの取得 by 科学太郎
//==============================================================================
// @URL(http://msdn.microsoft.com/ja-jp/library/cc429835.aspx)→GetVersionEx
// @URL(https://msdn.microsoft.com/en-us/library/windows/hardware/ff561910.aspx)→RtlGetVersion
// @URL(https://msdn.microsoft.com/ja-jp/library/windows/desktop/ms724833.aspx)→OSVERSIONINFOEX
//------------------------------------------------------------------------------
#include "Kernel32.as"
//--------------------------------------
// 命令登録(RtlGetVersion)
//--------------------------------------
#uselib "NTDLL.dll"
#func global RtlGetVersion "RtlGetVersion" sptr
//--------------------------------------
// 記号定数(API定数)
//--------------------------------------
#const global VER_PLATFORM_WIN32s $00000000
#const global VER_PLATFORM_WIN32_WINDOWS $00000001
#const global VER_PLATFORM_WIN32_NT $00000002
//--------------------------------------
// 列挙定数(OSVERSIONINFO)
//--------------------------------------
#enum osver_dwOSVersionInfoSize=0
#enum osver_dwMajorVersion
#enum osver_dwMinorVersion
#enum osver_dwBuildNumber
#enum osver_dwPlatformId
#enum osver_szCSDVersion
#enum DIM_OSVERSIONINFO=(osver_szCSDVersion+128/4)
#enum SIZE_OSVERSIONINFO=(DIM_OSVERSIONINFO*4)
//--------------------------------------
// メイン部
//--------------------------------------
*Init
dim OSVERSIONINFO,DIM_OSVERSIONINFO
*Main
screen 0,640,480,SCREEN_NORMAL
syscolor 15:boxf:color:title "OSバージョンの取得"
;GetVersionEx
OSVERSIONINFO=SIZE_OSVERSIONINFO
GetVersionEx varptr(OSVERSIONINFO)
DrawOSVERSIONINFO "【GetVersionEx】"
;RtlGetVersion
OSVERSIONINFO=SIZE_OSVERSIONINFO
RtlGetVersion varptr(OSVERSIONINFO)
DrawOSVERSIONINFO "【RtlGetVersion】"
stop
//--------------------------------------
// 構造体のデータを描画
//--------------------------------------
#deffunc DrawOSVERSIONINFO str _msg_,\
local szCSDVersion
getstr szCSDVersion,OSVERSIONINFO,(osver_szCSDVersion*4)
mes _msg_
; mes "構造体のサイズ ："+OSVERSIONINFO.osver_dwOSVersionInfoSize
mes "メジャー・バージョン ："+OSVERSIONINFO.osver_dwMajorVersion
mes "マイナー・バージョン ："+OSVERSIONINFO.osver_dwMinorVersion
mes "ビルド・ナンバー ："+OSVERSIONINFO.osver_dwBuildNumber
mes "プラットホームＩＤ ："+OSVERSIONINFO.osver_dwPlatformId
mes "ＣＳＤバージョン ：["+szCSDVersion+"]"
mes "HSPのsysinfo関数 ："+sysinfo(0)
mes "独自のGetVerString関数："+GetVerString()
mes ""
return
//--------------------------------------
// バージョン文字列の作成
//--------------------------------------
#defcfunc GetVerString
n=(OSVERSIONINFO.osver_dwMinorVersion):if(n<10):n*=10
n=(OSVERSIONINFO.osver_dwMajorVersion*100+n)
;Windows NT系OS
if(OSVERSIONINFO.osver_dwPlatformId==VER_PLATFORM_WIN32_NT){
if(n==1000):return"Windows 10"
if(n== 630):return"Windows 8.1"
if(n== 620):return"Windows 8"
if(n== 610):return"Windows 7"
if(n== 600):return"Windows Vista"
if(n== 520):return"Windows XP(x64)"
if(n== 510):return"Windows XP"
if(n== 500):return"Windows 2000"
if(n== 400):return"Windows NT 4.0"
if(n== 351):return"Windows NT 3.51"
if(n== 350):return"Windows NT 3.5"
if(n== 310):return"Windows NT 3.1"
}
;Windows 9x系OS
if(OSVERSIONINFO.osver_dwPlatformId==VER_PLATFORM_WIN32_WINDOWS){
if(n== 490):return"Windows Me"
if(n== 410):return"Windows 98"
if(n== 400):return"Windows 95"
}
;Windows 3.1系OS
if(OSVERSIONINFO.osver_dwPlatformId==VER_PLATFORM_WIN32s){
return"Windows 3.1"
}
return"(不明)"
//------------------------------------------------------------------------------
// End of sample111.hsp
//------------------------------------------------------------------------------
これを実行すると次のようになります。
【GetVersionEx】
メジャー・バージョン ：6
マイナー・バージョン ：2
ビルド・ナンバー ：9200
プラットホームＩＤ ：2
ＣＳＤバージョン ：[]
HSPのsysinfo関数 ：WindowsNT ver6.2
独自のGetVerString関数：Windows 8
【RtlGetVersion】
メジャー・バージョン ：10
マイナー・バージョン ：0
ビルド・ナンバー ：10586
プラットホームＩＤ ：2
ＣＳＤバージョン ：[]
HSPのsysinfo関数 ：WindowsNT ver6.2
独自のGetVerString関数：Windows 10
なお、私の環境は現在「Windows 10」です。
| |
|
|
2016/1/23(Sat) 02:25:48|NO.74242
システム情報の取得(sysinfo)関数が4GB以上のメモリに対応してないので
4GB以上のメモリを取得して使用率を求めます。
//------------------------------------------------------------------------------
// メモリの取得サンプル(2) by 科学太郎
//------------------------------------------------------------------------------
#include "Kernel32.as"
//--------------------------------------
// 列挙定数(MEMORYSTATUSEX)
//--------------------------------------
#enum msex_dwLength=0 ;構造体のサイズ
#enum msex_dwMemoryLoad ;メモリの使用率(%)
#enum msex_ullTotalPhysLo ;物理メモリの搭載容量
#enum msex_ullTotalPhysHi ;
#enum msex_ullAvailPhysLo ;物理メモリの空き容量
#enum msex_ullAvailPhysHi ;
#enum msex_ullTotalPageFileLo ;ページングの搭載容量
#enum msex_ullTotalPageFileHi ;
#enum msex_ullAvailPageFileLo ;ページングの空き容量
#enum msex_ullAvailPageFileHi ;
#enum msex_ullTotalVirtualLo ;仮想メモリの搭載容量
#enum msex_ullTotalVirtualHi ;
#enum msex_ullAvailVirtualLo ;仮想メモリの空き容量
#enum msex_ullAvailVirtualHi ;
#enum msex_ullAvailExtendedVirtualLo ;仮想メモリの拡張空き容量
#enum msex_ullAvailExtendedVirtualHi ;
#enum DIM_MEMORYSTATUSEX
#enum SIZE_MEMORYSTATUSEX=(DIM_MEMORYSTATUSEX*4)
//--------------------------------------
// メイン部
//--------------------------------------
*Init
nMEM=0
nVRM=0
nSWP=0
dbAvail=0.0
dbTotal=0.0
*Main
dim msex,DIM_MEMORYSTATUSEX:msex=SIZE_MEMORYSTATUSEX
title "メモリの取得サンプル(2)"
font MSGOTHIC,12
repeat
GlobalMemoryStatusEx varptr(msex)
redraw 0
syscolor 15:boxf:color:pos 0,0
;物理メモリの使用率
dbTotal=GetDouble(msex.msex_ullTotalPhysLo,msex.msex_ullTotalPhysHi)
dbAvail=GetDouble(msex.msex_ullAvailPhysLo,msex.msex_ullAvailPhysHi)
nMEM=int((dbTotal-dbAvail)*100.0/dbTotal+0.5)
;仮想メモリの使用率
dbTotal=GetDouble(msex.msex_ullTotalVirtualLo,msex.msex_ullTotalVirtualHi)
dbAvail=GetDouble(msex.msex_ullAvailVirtualLo,msex.msex_ullAvailVirtualHi)
nVRM=int((dbTotal-dbAvail)*100.0/dbTotal+0.5)
;ページングの使用率
dbTotal=GetDouble(msex.msex_ullTotalPageFileLo,msex.msex_ullTotalPageFileHi)
dbAvail=GetDouble(msex.msex_ullAvailPageFileLo,msex.msex_ullAvailPageFileHi)
nSWP=int((dbTotal-dbAvail)*100.0/dbTotal+0.5)
;結果報告
mes strf("物理メモリ：%3d %%",nMEM)
mes strf("仮想メモリ：%3d %%",nVRM)
mes strf("ページング：%3d %%",nSWP)
redraw 1
await 1000
loop
stop
//--------------------------------------
// 整数型からdouble型を取得
//--------------------------------------
#defcfunc GetDouble int _p1_,int _p2_,\
local p1,\
local p2
if(_p1_<0):p1=(4294967296.0+_p1_):else:p1=double(_p1_) ;下位32ビット
if(_p2_<0):p2=(4294967296.0+_p2_):else:p2=double(_p2_) ;上位32ビット
return(p2*4294967296.0+p1)
//------------------------------------------------------------------------------
// End of sample112b.hsp
//------------------------------------------------------------------------------
| |
|
|
2016/2/1(Mon) 18:41:57|NO.74404
NO.74214で投稿した、変数名取得のスクリプトに誤りがありました。
修正後のスクリプトを以下に示します。
関数名などは変わっていませんので、モジュールを差し替えるだけで大丈夫です。
// デバッグ時以外での変数名情報の出力を有効にする
#cmpopt varname 1
// 変数名取得モジュール
#module VarName
#uselib ""
#cfunc _varname "" int
#uselib "kernel32.dll"
#func lstrcpy "lstrcpy" sptr,sptr
#defcfunc getPval var
mref pval, 0
return pval
#deffunc local init
mref ctx, 68
pvalHead = lpeek(ctx, 44)
dupptr exinfo, lpeek(ctx, 876), 196
dupptr sd, libptr(_varname), 28
lpoke sd, 24, lpeek(exinfo, 188)
return
#defcfunc getVarName array _var
id = (getPval(_var) - pvalHead) / 48
p = _varname(id)
sdim name, 100
lstrcpy varptr(name), p
return name
#global
init@VarName
|
|
|
2016/2/5(Fri) 06:39:38|NO.74455
|
|
|
2016/2/8(Mon) 14:06:54|NO.74515
ビープ音でアフターバーナー2のBGM,AFTER BURNER の一部を演奏するプログラムです。
cls 0
mes "アフターバーナー2 After Burner 音量注意！"
#const ド 440
#const レ 494
#const ミ 554
#const ファ 587
#const ソ 659
#const ラ 740
#const シ 830
#const ド_ 880
hz = ド , レ , ミ , ファ , ソ , ラ// , シ , ド_
#const WAITING 100
#include "Kernel32.as"
repeat 1 , 0
Beep hz(5-cnt) , 200
Sleep WAITING
wait 20
loop
repeat 1 , 0
Beep hz(5-cnt) , 200
Sleep WAITING
wait 20
loop
repeat 1 , 0
Beep hz(5-cnt) , 200
Sleep WAITING
wait 35
loop
repeat 1 , 0
Beep hz(4-cnt),200
Sleep WAITING
Beep hz(4-cnt),200
Sleep WAITING
loop
repeat 1 , 0
Beep hz(5-cnt) , 200
Sleep WAITING
loop
wait 20
repeat 1 , 0
Beep hz(5-cnt) , 200
Sleep WAITING
loop
wait 20
repeat 1 , 0
Beep hz(5-cnt) , 200
Sleep WAITING
loop
wait 20
repeat 1 , 0
Beep hz(5-cnt) , 200
Sleep WAITING
loop
wait 35
repeat 1 , 0
Beep hz(5-cnt) , 200
Sleep WAITING
Beep hz(5-cnt) , 200
Sleep WAITING
loop
repeat 1,0
beep hz(4-cnt),200
Sleep WAITING
loop
wait 20
repeat 1 , 0
Beep hz(4-cnt) , 200
Sleep WAITING
loop
wait 20
repeat 1 , 0
Beep hz(4-cnt) , 200
Sleep WAITING
loop
wait 20
repeat 1 , 0
Beep hz(4-cnt) , 200
Sleep WAITING
loop
wait 35
repeat 1 , 0
Beep hz(3-cnt) , 200
Sleep WAITING
Beep hz(3-cnt) , 200
Sleep WAITING
loop
repeat 1,0
beep hz(4-cnt),200
Sleep WAITING
loop
wait 20
repeat 1 , 0
Beep hz(4-cnt) , 200
Sleep WAITING
loop
wait 20
repeat 1 , 0
Beep hz(4-cnt) , 200
Sleep WAITING
loop
wait 20
repeat 1 , 0
Beep hz(4-cnt) , 200
Sleep WAITING
loop
wait 35
repeat 1 , 0
Beep hz(4-cnt),200
Sleep WAITING
Beep hz(4-cnt),200
Sleep WAITING
wait 10
| |
|
|
2016/2/9(Tue) 05:51:56|NO.74526
名前はもうある様、
曲の著作権?は大丈夫なのでしょうか。
「AFTER BURNER」で検索したところゲームの音楽らしくパブリックドメイン等ではないため勝手に掲示板に投稿するのはよくない気がします。
名前はもうある様が著作権者等であればすみません。
私は法律のことはさっぱりなのとこのスレッドの話題とは違うので返答は別のスレッドで別の人にお願いします。
HSPPRINT(瓶詰堂版)互換モジュール
瓶詰堂( http://www.binzume.net/)のHSPPRINTプラグインの互換モジュールです
なんとなく「HSPPRINT」で検索して見つけたのでかきました
http://nopswebpages.webcrow.jp/apps/hspprin2/
|
|
|
2016/2/12(Fri) 18:01:48|NO.74579
ひらがな、カタカナ、漢字だけを変数に1文字ずつ出力するプログラム。
ウィンドウサイズが大きいので注意。
//文字コード表
//http://charset.7jp.net/sjis.html
sdim 文字,2,4200
Screen 0,4800,550
repeat 82//ひらがな
poke 文字.ct,0,130
poke 文字.ct,1,160+cnt
pos cnt*25,0:mes 文字.ct
ct+1
loop
repeat 87//カタカナ
poke 文字.ct,0,131
poke 文字.ct,1,64+cnt
pos cnt*25,25:mes 文字.ct
ct+1
loop
repeat 94//漢字 例外01
poke 文字.ct,0,136
poke 文字.ct,1,159+cnt
pos cnt*25,50:mes 文字.ct
ct+1
loop
repeat 23//漢字
ct2=cnt
//9873〜989eだけ漢字が無いのでそこを除外。
//もっと効率よく書けそう？ifにどう書けばいいのか思い浮かばなかった・・・
if (137+ct2)!152:{
repeat 189
if (64+cnt)!127:{
poke 文字.ct,0,137+ct2
poke 文字.ct,1,64+cnt
pos cnt*25,75+ct2*20:mes 文字.ct
ct+1
}
loop
}else:{
repeat 189
if (64+cnt)<115 or (64+cnt)>158{
poke 文字.ct,0,137+ct2
poke 文字.ct,1,64+cnt
pos cnt*25,75+ct2*20:mes 文字.ct
ct+1
}
loop
}
loop
|
|
|
2016/2/13(Sat) 01:35:24|NO.74587
> 9873〜989eだけ漢字が無いのでそこを除外。
> もっと効率よく書けそう？ifにどう書けばいいのか思い浮かばなかった・・・
ちょっとサンプルを作ってみました。
//------------------------------------------------------------------------------
// タイトル：ひらがな、カタカナ、漢字だけを変数に1文字ずつ出力するプログラム
//==============================================================================
// 投稿番号：No74579
// 作成者名：科学太郎
//------------------------------------------------------------------------------
// @URL(http://hsp.tv/play/pforum.php?mode=all&num=72960)→「ちょっとしたソースコードを投稿するスレ」
// @URL(http://charset.7jp.net/sjis.html)→「文字コード表 シフトJIS(Shift_JIS)」
//------------------------------------------------------------------------------
//--------------------------------------
// メイン部
//--------------------------------------
*Init
dim 文字数
sdim 文字,3,1
*Main
screen 0,640,480,SCREEN_NORMAL
title "ひらがな、カタカナ、漢字だけを変数に1文字ずつ出力するプログラム by 科学太郎"
;ひらがな(83種)
repeat(0xF1-0x9F+1),0x9F
if(cnt==0x7F):continue
poke 文字(文字数),0,0x82
poke 文字(文字数),1,cnt
文字数++
loop
;カタカナ(86種)
repeat(0x96-0x40+1),0x40
if(cnt==0x7F):continue
poke 文字(文字数),0,0x83
poke 文字(文字数),1,cnt
文字数++
loop
;漢字(94種)
repeat(0xFC-0x9F+1),0x9F
if(cnt==0x7F):continue
poke 文字(文字数),0,0x88
poke 文字(文字数),1,cnt
文字数++
loop
;漢字(188×23種)…0x9873〜0x989Eも排除(43個)
repeat(0x9F-0x89+1),0x89:hi=cnt
repeat(0xFC-0x40+1),0x40:lo=cnt
if(lo==0x7F):continue
if(hi==0x98)and(0x73<=lo)and(lo<=0x9E):continue
poke 文字(文字数),0,hi
poke 文字(文字数),1,lo
文字数++
loop
loop
;漢字(188×11種)…0xEAA5〜0xEAFCも排除(88個)
repeat(0xEA-0xE0+1),0xE0:hi=cnt
repeat(0xFC-0x40+1),0x40:lo=cnt
if(lo==0x7F):continue
if(hi==0xEA)and(0xA5<=lo)and(lo<=0xFC):continue;breakでもOK!
poke 文字(文字数),0,hi
poke 文字(文字数),1,lo
文字数++
loop
loop
;漢字(188×2種)…0xEEED〜0xEEEEも排除(2個)
repeat(0xEE-0xED+1),0xED:hi=cnt
repeat(0xFC-0x40+1),0x40:lo=cnt
if(lo==0x7F):continue
if(hi==0xEE)and(0xED<=lo)and(lo<=0xEE):continue
poke 文字(文字数),0,hi
poke 文字(文字数),1,lo
文字数++
loop
loop
;文字列への出力(6898個)
sdim sBuff
mesbox sBuff,ginfo_winX,ginfo_winY,5
foreach 文字
sBuff+=文字.cnt
if(cnt+1)\38==0:sBuff+="\n":else:sBuff+=" "
loop
objprm 0,sBuff
title "文字数："+length(文字)+"個"
stop
//------------------------------------------------------------------------------
// End of No74579.hsp
//------------------------------------------------------------------------------
もう一つ、おまけにテーブル作成タイプを作ってみました。
どっちが良いかな？
//------------------------------------------------------------------------------
// タイトル：ひらがな、カタカナ、漢字だけを変数に1文字ずつ出力するプログラム
//==============================================================================
// 投稿番号：No74579
// 作成者名：科学太郎
//------------------------------------------------------------------------------
// @URL(http://hsp.tv/play/pforum.php?mode=all&num=72960)→「ちょっとしたソースコードを投稿するスレ」
// @URL(http://charset.7jp.net/sjis.html)→「文字コード表 シフトJIS(Shift_JIS)」
//------------------------------------------------------------------------------
//--------------------------------------
// マクロ命令
//--------------------------------------
#define SetTable1(%1,%2) テーブル1((%2/32),(%1-0x81))|=1<<(%2\32)
#define SetTable2(%1,%2) テーブル2((%2/32),(%1-0xE0))|=1<<(%2\32)
//--------------------------------------
// メイン部
//--------------------------------------
*Init
dim テーブル1,(256/32),(0x9F-0x81+1);0x8100〜0x9FFF(8×31＝248)
dim テーブル2,(256/32),(0xEF-0xE0+1);0xE000〜0xEFFF(8×16＝128)
dim 文字数
sdim 文字,3,1
*Main
screen 0,640,480,SCREEN_NORMAL
title "ひらがな、カタカナ、漢字だけを変数に1文字ずつ出力するプログラム by 科学太郎"
SetTableKanji
OutTableKanji
MsgTableKanji
LogTableKanji
stop
//--------------------------------------
// 列挙文字のテーブル・セット
//--------------------------------------
#deffunc SetTableKanji\
local hi,\
local lo
;ひらがな(83種)
repeat(0xF1-0x9F+1),0x9F
if(cnt==0x7F):continue
SetTable1 0x82,cnt
loop
;カタカナ(86種)
repeat(0x96-0x40+1),0x40
if(cnt==0x7F):continue
SetTable1 0x83,cnt
loop
;漢字(94種)
repeat(0xFC-0x9F+1),0x9F
if(cnt==0x7F):continue
SetTable1 0x88,cnt
loop
;漢字(188×23種)…0x9873〜0x989Eも排除(43個)
repeat(0x9F-0x89+1),0x89:hi=cnt
repeat(0xFC-0x40+1),0x40:lo=cnt
if(lo==0x7F):continue
if(hi==0x98)and(0x73<=lo)and(lo<=0x9E):continue
SetTable1 hi,lo
loop
loop
;漢字(188×11種)…0xEAA5〜0xEAFCも排除(88個)
repeat(0xEA-0xE0+1),0xE0:hi=cnt
repeat(0xFC-0x40+1),0x40:lo=cnt
if(lo==0x7F):continue
if(hi==0xEA)and(0xA5<=lo)and(lo<=0xFC):continue
SetTable2 hi,lo
loop
loop
;漢字(188×2種)…0xEEED〜0xEEEEも排除(2個)
repeat(0xEE-0xED+1),0xED:hi=cnt
repeat(0xFC-0x40+1),0x40:lo=cnt
if(lo==0x7F):continue
if(hi==0xEE)and(0xED<=lo)and(lo<=0xEE):continue
SetTable2 hi,lo
loop
loop
return
//--------------------------------------
// テーブル内の文字を出力
//--------------------------------------
#deffunc OutTableKanji\
local hi,\
local lo
;テーブル1(0x8100〜0x9FFF)
repeat length2(テーブル1):hi=cnt
repeat length (テーブル1):lo=cnt
OutTableKanjiSub テーブル1(lo,hi),(0x81+hi),(32*lo)
loop
loop
;テーブル2(0xE000〜0xEFFF)
repeat length2(テーブル2):hi=cnt
repeat length (テーブル2):lo=cnt
OutTableKanjiSub テーブル2(lo,hi),(0xE0+hi),(32*lo)
loop
loop
return
//--------------------------------------
// 32ビット・データの文字を出力
//--------------------------------------
#deffunc OutTableKanjiSub int _data_,int _hi_,int _lo_
repeat 32
if(_data_)&(1<<cnt){
poke 文字(文字数),0,(_hi_)
poke 文字(文字数),1,(_lo_)+cnt
文字数++
}
loop
return
//--------------------------------------
// メッセージボックスに出力
//--------------------------------------
#deffunc MsgTableKanji
;文字列への出力(6898個)
sdim sBuff
mesbox sBuff,ginfo_winX,ginfo_winY,5
foreach 文字
sBuff+=文字.cnt
if(cnt+1)\38==0:sBuff+="\n":else:sBuff+=" "
loop
objprm 0,sBuff
title "文字数："+length(文字)+"個"
return
//--------------------------------------
// テーブルのログ出力
//--------------------------------------
#deffunc LogTableKanji\
local hi,\
local lo,\
local msg,\
local data
;テーブル1(0x8100〜0x9FFF)
repeat length2(テーブル1):hi=cnt:sdim msg
repeat length (テーブル1):lo=cnt:data=テーブル1(lo,hi)
repeat 32
if(data)&(1<<cnt):msg+="1":else:msg+="0"
loop
loop:logmes msg
loop
;テーブル2(0xE000〜0xEFFF)
repeat length2(テーブル2):hi=cnt:sdim msg
repeat length (テーブル2):lo=cnt:data=テーブル2(lo,hi)
repeat 32
if(data)&(1<<cnt):msg+="1":else:msg+="0"
loop
loop:logmes msg
loop
return
//------------------------------------------------------------------------------
// End of No74579.hsp
//------------------------------------------------------------------------------
| |
|
|
2016/2/13(Sat) 06:06:31|NO.74588
スペース氏・・・「ミ」と「ム」の間にゴミが有る。
科学太郎氏・・・最後に記号が付いている。
|
|
|
2016/2/13(Sat) 11:28:34|NO.74589
> 科学太郎氏・・・最後に記号が付いている。
あっ。そうでした。漢字でしたね。
//------------------------------------------------------------------------------
// タイトル：ひらがな、カタカナ、漢字だけを変数に1文字ずつ出力するプログラム
//==============================================================================
// 投稿番号：No74579
// 作成者名：科学太郎
//------------------------------------------------------------------------------
// @URL(http://hsp.tv/play/pforum.php?mode=all&num=72960)→「ちょっとしたソースコードを投稿するスレ」
// @URL(http://charset.7jp.net/sjis.html)→「文字コード表 シフトJIS(Shift_JIS)」
//------------------------------------------------------------------------------
//--------------------------------------
// 記号定数
//--------------------------------------
#const SW_DIGIT %00000001
#const SW_UPPER %00000010
#const SW_LOWER %00000100
#const SW_HIRA %00001000
#const SW_KANA %00010000
#const SW_KANJI %00100000
//--------------------------------------
// メイン部
//--------------------------------------
*Init
dim 文字数
sdim 文字,3,1
*Main
screen 0,640,480,SCREEN_NORMAL
title "ひらがな、カタカナ、漢字だけを変数に1文字ずつ出力するプログラム by 科学太郎"
MakeEnumKanji(SW_HIRA|SW_KANA|SW_KANJI)
;文字列への出力(6884個)
sdim sBuff
mesbox sBuff,ginfo_winX,ginfo_winY,5
foreach 文字
sBuff+=文字(cnt)
if(cnt+1)\38==0:sBuff+="\n":else:sBuff+=" "
loop
objprm 0,sBuff
title "文字数："+length(文字)+"個"
stop
//--------------------------------------
// 列挙文字タイプの作成
//--------------------------------------
#deffunc MakeEnumKanji int _sw_,\
local hi,\
local lo
repeat(0xEF-0x81+1),0x81:hi=cnt
repeat(0xFC-0x40+1),0x40:lo=cnt
if(lo==0x7F):continue
;数字(10種)
if(_sw_ & SW_DIGIT){
if(hi==0x82)and(0x4F<=lo)and(lo<=0x58){
poke 文字(文字数),0,hi
poke 文字(文字数),1,lo
文字数++
}
}
;大文字(26種)
if(_sw_ & SW_UPPER){
if(hi==0x82)and(0x60<=lo)and(lo<=0x79){
poke 文字(文字数),0,hi
poke 文字(文字数),1,lo
文字数++
}
}
;小文字(26種)
if(_sw_ & SW_LOWER){
if(hi==0x82)and(0x81<=lo)and(lo<=0x9A){
poke 文字(文字数),0,hi
poke 文字(文字数),1,lo
文字数++
}
}
;ひらがな(83種)
if(_sw_ & SW_HIRA){
if(hi==0x82)and(0x9F<=lo)and(lo<=0xF1){
poke 文字(文字数),0,hi
poke 文字(文字数),1,lo
文字数++
}
}
;カタカナ(86種)
if(_sw_ & SW_KANA){
if(hi==0x83)and(0x40<=lo)and(lo<=0x96){
poke 文字(文字数),0,hi
poke 文字(文字数),1,lo
文字数++
}
}
;漢字(6715種)
if(_sw_ & SW_KANJI){
;漢字(94種)
if(hi==0x88)and(lo>=0x9F){
poke 文字(文字数),0,hi
poke 文字(文字数),1,lo
文字数++
}
;漢字(188×23種)…0x9873〜0x989Eも排除(43個)
if(0x89<=hi)and(hi<=0x9F){
if(hi==0x98)and(0x73<=lo)and(lo<=0x9E):continue
poke 文字(文字数),0,hi
poke 文字(文字数),1,lo
文字数++
}
;漢字(188×11種)…0xEAA5〜0xEAFCも排除(88個)
if(0xE0<=hi)and(hi<=0xEA){
if(hi==0xEA)and(lo>=0xA5):continue
poke 文字(文字数),0,hi
poke 文字(文字数),1,lo
文字数++
}
;漢字(188×2種)…0xEEED〜0xEEFCも排除(16個)
if(0xED<=hi)and(hi<=0xEE){
if(hi==0xEE)and(lo>=0xED):continue
poke 文字(文字数),0,hi
poke 文字(文字数),1,lo
文字数++
}
}
loop
loop
return
//------------------------------------------------------------------------------
// End of No74579.hsp
//------------------------------------------------------------------------------
↑
改良しやすいタイプです。
| |
|
|
2016/2/13(Sat) 11:44:55|NO.74590
追記。
> sdim sBuff
> mesbox sBuff,ginfo_winX,ginfo_winY,5
↓
> sdim sBuff,0x7FFF
> mesbox sBuff,ginfo_winX,ginfo_winY,5
このようにしないとエディットボックスに文字が入力できないので要注意。
|
|
|
2016/2/13(Sat) 12:01:04|NO.74591
本当にちょっとしたスクリプトです
・論理式用関数
a=1
b=2
mes a&b
a=1
b=2
mes a&&b
aa=bl_r(1)
bb=bl_r(2)
mes aa&bb
stop
#module
#defcfunc bl_r int p //returnがboolってことで
if p==0:return 0
return 1
#global
自分 条件式の&&とか上手く理解できなくてですね
|
|
|
2016/2/13(Sat) 19:22:35|NO.74597
> 自分 条件式の&&とか上手く理解できなくてですね
HSPは論理積、論理和、排他論理和は使えないので次のようにすると便利かも。
//--------------------------------------
// マクロ関数(論理式判定)
//--------------------------------------
#define ctype LogicOR(%1,%2) ((%1)!0) or((%2)!0)
#define ctype LogicAND(%1,%2) ((%1)!0)and((%2)!0)
#define ctype LogicXOR(%1,%2) ((%1)!0)xor((%2)!0)
//--------------------------------------
// サンプル(使い方)
//--------------------------------------
a=1
b=2
c=0
mes LogicOR(a,b)
mes LogicAND(a,b)
mes LogicXOR(a,b)
mes LogicXOR(a,c)
stop
|
|
|
2016/2/13(Sat) 19:44:23|NO.74598
サムネイルのアルゴリズムです。
//------------------------------------------------------------------------------
// サムネイルのアルゴリズム by 科学太郎
//------------------------------------------------------------------------------
//--------------------------------------
// 列挙定数(ウインドウID)
//--------------------------------------
#enum WID_MAIN=0
#enum WID_IMAGE
//--------------------------------------
// メイン部
//--------------------------------------
*Init
sFname=dir_exe+"\\hsptv\\bg05.jpg"
sFname=dir_exe+"\\hsptv\\sozai5.jpg"
buffer WID_IMAGE:picload sFname
ImageX=ginfo_winX
ImageY=ginfo_winY
ThumbX=100
ThumbY=100
*Main
screen WID_MAIN,1200,900,SCREEN_NORMAL
x=(ginfo_dispX-ginfo_sizeX)/2
y=(ginfo_dispY-ginfo_sizeY)/2
width,,x,y
color $66,$33,$00:boxf
color $FF,$FF,$FF:title "サムネイルのアルゴリズム"
;描画
title strf("サムネイルのアルゴリズム⇒%s(%d×%d)",sFname,ImageX,ImageY)
x=0
y=0
pos x,y:x+=(ImageX+10):gcopy WID_IMAGE,0,0,ImageX,ImageY ;原寸
pos x,y:y+=(ThumbY+10):gzoom ThumbX,ThumbY,WID_IMAGE,0,0,ImageX,ImageY,1 ;縮小
pos x,y:y+=(ThumbY+10):DrawThumb1 ;サムネイル(1)
pos x,y:y+=(ThumbY+10):DrawThumb2 ;サムネイル(2)
pos x,y:y+=(100+10):DrawThumb3 WID_IMAGE,100 ;サムネイル(3)
pos x,y:y+=(200+10):DrawThumb3 WID_IMAGE,200 ;サムネイル(3)
pos x,y:y+=(255+10):DrawThumb3 WID_IMAGE,255 ;サムネイル(3)
stop
//--------------------------------------
// サムネイルのテスト(1)
//--------------------------------------
#deffunc DrawThumb1\
local cx,\
local cy,\
local sx,\
local sy,\
local db
;サムネイル(横長)
if(ImageX>ImageY){
db=double(ImageX)/double(ImageY)
sx=int(double(ThumbX))
sy=int(double(ThumbX)/db)
};サムネイル(縦長)
else{
db=double(ImageY)/double(ImageX)
sx=int(double(ThumbY)/db)
sy=int(double(ThumbY))
}
cx=ginfo_cx+(ThumbX-sx)/2
cy=ginfo_cy+(ThumbY-sy)/2
pos cx,cy:gzoom sx,sy,WID_IMAGE,0,0,ImageX,ImageY,1
return
//--------------------------------------
// サムネイルのテスト(2)
//--------------------------------------
#deffunc DrawThumb2\
local cx,\
local cy,\
local sx,\
local sy
;サムネイル(横長)
if(ImageX>ImageY){
sx=(ThumbX)
sy=(ThumbX*ImageY/ImageX)
};サムネイル(縦長)
else{
sx=(ThumbY*ImageX/ImageY)
sy=(ThumbY)
}
cx=ginfo_cx+(ThumbX-sx)/2
cy=ginfo_cy+(ThumbY-sy)/2
pos cx,cy:gzoom sx,sy,WID_IMAGE,0,0,ImageX,ImageY,1
return
//--------------------------------------
// サムネイルのテスト(3)
//--------------------------------------
#deffunc DrawThumb3 int _id_,int _size_,\
local ix,\
local iy,\
local tx,\
local ty,\
local cx,\
local cy,\
local sx,\
local sy,\
local id
;画像サイズ
id=ginfo_sel:gsel _id_
ix=ginfo_winX ;ImageX
iy=ginfo_winY ;ImageY
tx=_size_ ;ThumbX
ty=_size_ ;ThumbY
gsel id
;サムネイル(横長)
if(ix>iy){
sx=(tx)
sy=(tx*iy/ix)
};サムネイル(縦長)
else{
sx=(ty*ix/iy)
sy=(ty)
}
cx=ginfo_cx+(tx-sx)/2
cy=ginfo_cy+(ty-sy)/2
pos cx,cy:gzoom sx,sy,_id_,0,0,ix,iy,1
return
//------------------------------------------------------------------------------
// End of sample128.hsp
//------------------------------------------------------------------------------
| |
|
|
2016/2/13(Sat) 19:58:39|NO.74599
チェック模様の描画アルゴリズムです。
//--------------------------------------
// サンプル(使い方)
//--------------------------------------
DrawCheck 16
stop
//--------------------------------------
// チェック模様の描画
//--------------------------------------
#deffunc DrawCheck int _dot_,\
local cx,\
local cy,\
local ex,\
local ey
repeat(ginfo_sy/_dot_)+1:y=cnt
repeat(ginfo_sx/_dot_)+1:x=cnt
cx=(x*_dot_)
cy=(y*_dot_)
ex=(cx+_dot_-1)
ey=(cy+_dot_-1)
if(x&1)^(y&1):color$CC,$FF,$FF:else:color$AA,$EE,$EE
boxf cx,cy,ex,ey
loop
loop
return
|
|
|
2016/2/13(Sat) 22:37:29|NO.74600
>>KAさん
まじだ！全然気づかなかった。
ありがとうございますｍ（＿＿）ｍ
|
|
|
2016/2/14(Sun) 10:18:37|NO.74606
チェック模様という模様があるのですか。きれいな模様です。
点をたくさん打って円周率を求めました
//円周率を求めるスクリプト
//名前は覚えていません
//結果は3ほどなのでたぶん考え方はあっているはずです
//四角形の中に点をたくさん置いて四分の一の円の中にある数で円周率を出す
//pi*1*1/4 : 1*1 縦横が1の四角形
#const NUM_LARGE $7FFF
#const SQUARED_NUM_LARGE (NUM_LARGE*NUM_LARGE)
#const NUM_DOTS 1000
int_pi = 0
randomize
repeat NUM_DOTS
int_x=rnd(NUM_LARGE+1)
int_y=rnd(NUM_LARGE+1)
// 三平方の定理
// 横*横 + 縦*縦 = 斜め*斜め
//円の半径 (NUM_LARGE) 内の点
if int_x*int_x + int_y*int_y < SQUARED_NUM_LARGE : int_pi++
loop
mes "点の数:"+ NUM_DOTS +"\n円周率="+((0.0+int_pi*4)/NUM_DOTS)
|
|
|
2016/2/17(Wed) 18:54:41|NO.74642
|
|
|
2016/2/17(Wed) 20:46:24|NO.74643
>NO.74606
どうでもいいですが、モンテカルロ法ですね。
結構な回数を試さないとなかなか近づかなかったと思います。
|
|
|
2016/2/19(Fri) 05:46:26|NO.74649
モンテカルロ法というのですか。教えていただきありがとうございます。
|
|
|
2016/2/25(Thu) 18:49:49|NO.74700
３項演算子みたいな動作をする関数です。
#module
#define global ctype sankou(%1,%2,%3) sankou2((%1),%2,%3)
#defcfunc sankou2 int i,int i2,int i3
if(i):return i2
return i3
#global
mes ""+sankou(a=0,1,0)
a=5
mes ""+sankou(a=0,1,0)
|
|
|
2016/2/26(Fri) 07:48:06|NO.74710
別のスレッドで投稿した、
以前投稿したものの、アップデート版です。
以前と違い、""の中の半角スペースは無視されます。
#module dircmd
#uselib "msvcrt"
#func __getmainargs "__getmainargs" int, int, int, int, int
#defcfunc getCommandLines
sdim result : notesel result
argc = 0 : argv = 0 : enpv = 0 : si = 0
__getmainargs varptr(argc), varptr(argv), varptr(enpv), 0, varptr(si)
if stat == 0 {
#ifdef _debug
start = 2
#else
start = 1
#endif
max = argc - start
if 0 < max && argv != 0 {
repeat max, start
dupptr ptr, argv + (4 * cnt), 4, 4
if ptr == 0 : continue
dupptr s, ptr, 1, 2
noteadd s
loop
}
}
noteunsel
return result
#defcfunc local getcmdline int num
re = getCommandLines()
split re,"\n",cmd2
if(length(cmd2)<num+1){
dialog "存在しないコマンドラインパラメータです。",1,"エラー"
end
}
return cmd2(num)
#global
#undef dir_cmdline
#define dir_cmdline getcmdline@dircmd
mes dir_cmdline(0)
|
|
|
2016/3/6(Sun) 22:33:32|NO.74804
やっぱ書く人が書けば短く、わかりやすいプログラムになるんですね。
なるほど、配列として取得できるようにしたのですか。
確かにそっちの方が便利かも。
|
|
|
2016/3/7(Mon) 00:16:46|NO.74805
すみません
複数回呼ぶということをまったく考えていなかったのでメモリーリークをおこすバグがありました
なので__GetMainArgsは何度も呼ばないよう修正しました
それとkanamaruさんのスクリプトはよく見ていませんでしたがkanamaruさんのもメモリーリークをおこすので注意してください
|
|
|
2016/3/7(Mon) 00:43:00|NO.74807
起動オプションの切り分け（"対応済）を正規表現を使って実装してみました。ちょっと作りたくなってしまったので。
うん。でもやっぱり__getmainargs使ったほうがいいですね。(´・ω・｀)
#include "mod_regexp.as"
#module
;引数を配列で取得
#defcfunc dir_cmdline_argv int num
cmdline = dir_cmdline
if strmid(cmdline,0,1) ! " " : cmdline = " " + cmdline
;切り出し
matches b, cmdline, "\\s+(\"(?:\\\\\"|[^\"])*\"?|[^\"]\\S*)"
repeat stat
;先頭のスペースを削除
b(cnt) = strtrim(b(cnt), 0, ' ')
loop
argc = length(b)
if b(0) = "" : argc = 0
return b(num)
;引数の数
#defcfunc _dir_cmdline_argc
return argc
#global
#undef dir_cmdline
#define dir_cmdline dir_cmdline_argv
#define dir_cmdline_argc _dir_cmdline_argc()
;実行テスト
n = dir_cmdline(0) ;dir_cmdline_argcの前に1回実行が必要
repeat dir_cmdline_argc
mes dir_cmdline(cnt)
loop
参考資料：
正規表現を使ったコマンドラインのパース
http://d.hatena.ne.jp/naga_sawa/20110311/1299804955
|
|
|
2016/3/10(Thu) 17:01:32|NO.74847
簡易csv読み込みモジュールです。
文字列は""で囲われていても、囲われていなくてもかまいません
(厳密なcsvだと囲わないかな？)
""の中の,も区切りになってしまうので、あくまでも簡易的な読み込みに使ってください。
#module hspcsv
#define global CSV_ID_MAX 30
#define global CSV_XMAX 30
#define global CSV_YMAX 30
/*
*csvinit モジュールを初期化します。
*モジュールを使う前に必ず実行する必要があります。
*/
#deffunc csvinit
sdim csv,CSV_ID_MAX,CSV_XMAX,CSV_YMAX
return
/*
*csvloadByStr(p1,p2)
*p1 csvid
*p2 読み込むcsv
*文字列で指定したcsvを読み込みます。
*/
#deffunc csvloadByStr int id,str s
csvs=s
split csvs,"\n",cline
repeat
rx=cnt
if(rx >= length(cline)):break
split cline(rx),",",ctoken
repeat
ry=cnt
if(ry >= length(ctoken)):break
csv(id,rx,ry)=ctoken(ry)
await 1
loop
loop
return
/*
*csvloadByFile(p1,p2)
*p1 csvid
*p2 読み込むcsvファイル
*csvファイルを読み込みます。
*/
#deffunc csvloadByFile int id,str name
notesel in
noteload name
noteunsel
csvloadByStr id,in
return
/*
*csvgets(p1,p2,p3)
*p1 csvid
*p2 カンマ区切りの左から何番目か
*p3 どの行か
*文字列で取得します。
*/
#defcfunc csvgets int id,int x,int y
re = csv(id,x,y)
return strtrim(re,0,'\"')
/*
*csvgeti(p1,p2,p3)
*p1 csvid
*p2 カンマ区切りの左から何番目か
*p3 どの行か
*整数で取得します。
*/
#defcfunc csvgeti int id,int x,int y
re = csv(id,x,y)
if(re!"0")and(int(re)!0):return int(re)
if(re="0"):return 0
return -1
/*
*csvgetd(p1,p2,p3)
*p1 csvid
*p2 カンマ区切りの左から何番目か
*p3 どの行か
*実数で取得します。
*/
#defcfunc csvgetd int id,int x,int y
re = csv(id,x,y)
if(re!"0.0")and(double(re)!0.0):return double(re)
if(re="0.0"):return 0.0
if(re!-1):return double(re)
return -1
/*
*csvgetb(p1,p2,p3)
*p1 csvid
*p2 カンマ区切りの左から何番目か
*p3 どの行か
*trueかfalseかの文字列で取得します。
*/
#defcfunc csvgetb int id,int x,int y
re = csvgets(id,x,y)
if(re="true"):return "true"
if(re="false"):return "false"
re = csvgeti(id,x,y)
if(re):return "true"
if(re=0):return "false"
return "false"
#global
| |
|
|
2016/3/10(Thu) 17:03:30|NO.74848
補足で、今投稿したモジュールのサンプルがほしかったら言ってください。
|
|
|
2016/3/14(Mon) 16:46:28|NO.74918
前投稿したモジュールに命令の追加です。
前回まではcsvの読み込みしかできなかったのですが、
今回の追加で、書き込みができるようになりました。
差分だけ公開します。
#globalの前に追加で大丈夫です。
#deffunc csvsets int id,int x,int y,str s
csv(id,x,y)=s
return
#deffunc csvseti int id,int x,int y,int i
csv(id,x,y)=str(i)
return
#deffunc csvsetd int id,int x,int y,double d
csv(id,x,y)=str(d)
return
#deffunc csvsetb int id,int x,int y,str s
csv(id,x,y)=s
return
#defcfunc csvget int id,int x,int y
re = ""
repeat x
px=cnt
repeat y
py=cnt
re+=csv(id,px,py)
if(cnt!length3(csv)-1):re+=","
await 1
loop
if(cnt!length2(csv)-1):re+="\n"
loop
return re
#deffunc csvsave int id,int x,int y,str filename
re = csvget(id,x,y)
notesel
notesave filename
noteunsel
return
|
|
|
2016/3/16(Wed) 05:46:21|NO.74928
|
|
|
2016/3/21(Mon) 16:28:19|NO.75013
思いついたのでかきました
何かの役にたつかはわかりません
// ユーザー定義命令のラベルポインタを使うスクリプト
#module
#deffunc test3
return
#deffunc test2
return
#deffunc test
mes "helloworld"
return
#deffunc test4
return
#global
#const SIZE_BYTE_STRUCTDAT 28
// ダミー命令
test2 : test3 : test4
mref hspctx, 68
dimtype label_dummy, vartype("label"), 1
dupptr structdat_test, libptr(test), SIZE_BYTE_STRUCTDAT
dupptr cln_int_offset_label, hspctx(5) + structdat_test(5)*4, 4 //otindex
mes "ラベルインデックス=" + structdat_test(5)
// ただ呼び出すだけなので パラメータは積まない
lpoke label_dummy, 0, hspctx(2) + cln_int_offset_label*2 // unsigned short
gosub label_dummy
|
|
|
2016/3/21(Mon) 20:58:16|NO.75015
「short型をlong型に変換するマクロ」
使用例としてマウスホイールを検出すサンプルです。
#define WM_MOUSEWHEEL 0x020A ;マウス ホイールが回転された
;マクロ
#define ctype short2long(%1) ((((%1) & $8000)!0)*$ffff0000 | (%1))
#define ctype GET_X_LPARAM(%1) (%1 & $0000FFFF)
#define ctype GET_Y_LPARAM(%1) (%1>>16 & $0000FFFF)
#define ctype GET_WHEEL_DELTA_WPARAM(%1) short2long(%1>>16 & $0000FFFF)
#define ctype GET_KEYSTATE_WPARAM(%1) (%1 & $0000FFFF)
; メッセージ処理
oncmd gosub *On_WM_MOUSEWHEEL, WM_MOUSEWHEEL
stop
; メッセージ処理
*On_WM_MOUSEWHEEL
mes "( " + GET_X_LPARAM(lParam) + ", " + GET_Y_LPARAM(lParam) + " )" + GET_WHEEL_DELTA_WPARAM(wParam) + " " + GET_KEYSTATE_WPARAM(wParam)
return
|
|
|
2016/3/24(Thu) 05:55:16|NO.75055
DLL呼び出しなしでWinAPIを呼び出すスクリプトです
Messageboxを#uselib、#func等を使わず呼び出します
// DLL呼び出しなしでWinAPIを呼び出すスクリプト
// インポートセクションからモジュールハンドルの取得とエクスポートセクションから関数アドレスの取得モジュール を 使用します
#include "impexp.txt"
sdim str_buf, 256, 2
dim arr_int_args, 4
p_dll_kernel32 = get_handle_dll_import_table( "kernel32.dll", hinstance)
p_loadlibrary = get_address_func_export_table( "LoadLibraryA" , p_dll_kernel32)
p_freelibrary = get_address_func_export_table( "FreeLibrary" , p_dll_kernel32)
p_heapalloc = get_address_func_export_table( "HeapAlloc" , p_dll_kernel32)
str_buf(0) = "user32.dll" : arr_int_args = varptr(str_buf(0))
p_dll_user32 = callfunc( arr_int_args, p_loadlibrary, 1)
p_messagebox = get_address_func_export_table( "MessageBoxA" , p_dll_user32)
str_buf = "MessageBox呼び出し\nHeapAlloc=" + strf("0x%8.8X", p_heapalloc), "テスト"
arr_int_args = hwnd, varptr(str_buf(0)), varptr(str_buf(1)), 0
int_tmp = callfunc( arr_int_args, p_messagebox, 4)
arr_int_args = p_dll_user32
int_tmp = callfunc( arr_int_args, p_freelibrary, 1)
|
|
|
2016/3/24(Thu) 05:57:44|NO.75056
x86では算術シフトなのでこれだけでもword型をdword型に変換できると思います。
マニュアルでは算術シフトか論理シフトなのか未定義なのでx86以外の環境ではわかりません。
#define ctype short2long(%1) ((%1 <<16) >> 16)
i = 0 : wpoke i, 0, 500
j = 0 : wpoke j, 0, -200
mes i
mes short2long(i)
mes j
mes short2long(j)
|
|
|
2016/3/25(Fri) 01:22:07|NO.75063
> #define ctype short2long(%1) ((%1 <<16) >> 16)
凄くシンプル！
恥ずかしながら「算術シフト」って初めて知りました。これは便利。
しかしどっちで動作しているのか明記されていないのは怖いですね。
今度から右シフト使う時は注意するようにしようっと。
|
|
|
2016/3/25(Fri) 01:37:10|NO.75064
あ、これ%1はカッコで括らないと意図しない動作をすることがりますね。
#define ctype short2long(%1) (((%1) <<16) >> 16)
例：
#define ctype short2long(%1) ((%1 <<16) >> 16)
mes short2long($01230000>>16 & $0000FFFF)
#define ctype short2long2(%1) (((%1) <<16) >> 16)
mes short2long2($01230000>>16 & $0000FFFF)
|
|
|
2016/3/25(Fri) 10:48:11|NO.75066
シフト演算と聞いて, ビット関連を少し
#module __BIT__
// 真偽に変換
#define global ctype boolean(%1) (0 != (%1))
// ビット取得(数値)
#define global ctype bGet(%1, %2) boolean( (%1) & ( 1<<(%2) ) )
// ビットセット false
#define global sFalse(%1, %2) (%1) &= 0xFFFFFFFF ^ ( 1<<(%2) )
// ビットセット true
#define global sTrue(%1, %2) (%1) |= ( 1<<(%2) )
// ビット取得(数値配列)
#define global ctype abGet(%1, %2) bGet( %1( (%2)/32 ), (%2)\32 )
// ビットセット false
#define global asFalse(%1, %2) %1( (%2)/32 ) &= 0xFFFFFFFF ^ ( 1<<((%2)\32) )
// ビットセット true
#define global asTrue(%1, %2) %1( (%2)/32 ) |= ( 1<<((%2)\32) )
// 右への論理シフト
#define global ctype rshift(%1, %2) ( (%1)>>(%2) & ( ( 2<<(31-(%2)) )-1 ) )
// 連続True代入
#deffunc continuationTrueBit array a, int size, int index
if size <= 0 :return
left = limit(32-index\32-size, 0, 32)
mask = rshift((-1 << index\32) << left, left )
a(index/32) |= mask
if index/32 != (index+size)/32 {
rest = 32*(index/32+1)-index
continuationTrueBit a, size-rest, index+rest
}
return
// 連続False代入
#deffunc continuationFalseBit array a, int size, int index
if size <= 0 :return
left = limit(32-index\32-size, 0, 32)
mask = -1 ^ rshift((-1 << index\32) << left, left )
a(index/32) &= mask
if index/32 != (index+size)/32 {
rest = 32*(index/32+1)-index
continuationFalseBit a, size-rest, index+rest
}
return
#global
/* sample */
continuationTrueBit a, 32, 0 // 32bit true は signed int だと -1
mes a
drawBit a, 10
continuationFalseBit a, 32-4, 4 // 左から 4 bit true は 1+2+4+8
mes a
drawBit a, 10
stop
#deffunc drawBit array v, int s
cx = ginfo_cx
cy = ginfo_cy
repeat length(v)
y = cnt*s+cy
for i, 0, 32, 1
x = i*s+cx+ i/8*s
if abGet(v, cnt*32+i) {
boxf x, y, x+s, y+s
} else {
boxf x, y, x+s, y+s, 0
}
next
loop
pos cx, cy+s*length(v)
return
/* /sample */
| |
|
|
2016/3/25(Fri) 20:37:04|NO.75070
GENKIさんしてきしていただきありがとうございます。
論理シフトマクロと算術シフトマクロとshort型のlong型への変換マクロです。
GENKIさんのしてきをうけてパラメータにかっこをつけました。
// 論理シフトマクロ
#define ctype unsignedrightshift(%1,%2) \
(\
((%1) >> (%2)) \
&\
( (-1 << (32 - (%2))) ^ -1) \
)
// 算術シフトマクロ
#define ctype signedrightshift(%1,%2) \
(\
((%1) >> (%2)) \
|\
(\
(-( ((%1) >> 31) & 1)) \
<< \
(32 - (%2)) \
)\
)
// わたしなりにGENKIさんのを分かりやすくしたマクロです
#define ctype short2long(%1) (((%1) >> 15 & 1 ) * $FFFF0000 | (%1))
// 計算する
mes %00000000000000000000000011001000 // 200
// 200 を右に2つぶん論理シフト
mes %00000000000000000000000000110010
mes unsignedrightshift(200, 2)
// 200 を右に2つぶん論理シフト
mes %00000000000000000000000000110010
mes signedrightshift(200, 2)
mes %11111111111111111111111100111000 // -200
// -200 を右に2つぶん論理シフト
mes %00111111111111111111111111001110
mes unsignedrightshift(-200, 2)
// -200 を右に2つぶん算術シフト
mes %11111111111111111111111111001110
mes signedrightshift(-200, 2)
// HSP マニュアルでは未定義 VCでコンパイルされているので HSP 3.5 beta3 では算術シフトのはず
mes -200 >> 2
int_tmp= 0: wpoke int_tmp, 0, -200
mes short2long(int_tmp)
// わたしはshort型からlong型への変換はいつもこうしています
if int_tmp & $8000: int_tmp|= $FFFF0000
mes int_tmp
| |
|
|
2016/3/25(Fri) 23:58:05|NO.75074
あ、やらかしてしまったｗ
上記の sample の drawBit の boxf の5番目ってそういえば標準でサポートされてなくて、
動かせないですよね、ごめんなさい。
ついでにいろいろ乗せときます、、、
http://bassclef.s1.adexd.net/contents/hspdef.zip
に入ってる ud_draw.as の Line:53,63 に boxf 拡張版書いてます。
(INT_MAX とかは ud_calc.as に書いてます)
たぶん ud_draw.as を include するだけでは実行できないと思いますし
自作DLLとか、初期命令とかもたくさん書き換えているので
ほしいものだけ抜き出して勝手に新しくファイル作ってくださっても構いません
(粗大ごみ不法投棄してすみませんでしたｗ)
|
|
|
2016/4/15(Fri) 18:26:25|NO.75227
hspで連想配列を使えるようにするためのモジュールです。
すでにこの掲示板でも公開されてますが、hsp開発wikiで見つけたのを利用して、
さらに短く、そして、標準命令のみで作ってみました。
参考URL： http://wiki.hsp.moe/COMDictionary.html
#module hspassoc
#deffunc adim var v,int i
newcom v , "Scripting.Dictionary"
comres res
v("compareMode")=i
return
#deffunc addss var v,str s,str s2
if(iskey(v,s)){
dialog "該当するキーはすでに存在します",1,"エラー"
}else{
v->"add" s,s2
}
return
#deffunc addi var v,str s,int i
if(iskey(v,s)){
dialog "該当するキーはすでに存在します",1,"エラー"
}else{
v->"add" s,i
}
return
#deffunc addd var v,double d
if(iskey(v,s)){
dialog "該当するキーはすでに存在します",1,"エラー"
}else{
v->"add" s,d
}
return
#defcfunc iskey var v,str s
v->"Exists" s
return res
#defcfunc gets var v,str s
if(iskey(v,s)){
return v("item",s)
}else{
dialog "該当するキーが存在しません",1,"エラー"
end
}
#deffunc geti var v,str s
return int(gets(v,s))
#deffunc getd var v,str s
return double(gets(v,s))
#defcfunc alength var v
return v("count")
#global
何かバグを見つけましたら、報告してください。
|
|
|
2016/4/20(Wed) 10:37:02|NO.75275
範囲選択を簡単に実装するモジュール。
左上、右上、左下、右下、どこから範囲選択を開始してもboxf等で指定しやすいように変換します。
思ったより短く出来たのでモジュールにする必要が無かった気が・・・まぁ見やすさ重視ってことで・・・
#module
#deffunc RevisionPos double p1,double p2,double p3,double p4;適正化。リビジョンであってるのだろうか。
if p1>=p3:rPos.0=p3:rPos.2=p1:else:rPos.0=p1:rPos.2=p3
if p2>=p4:rPos.1=p4:rPos.3=p2:else:rPos.1=p2:rPos.3=p4
return
#defcfunc RevPos int p1;座標の取得。左上x、左上y、右下x、右下yの順番。
return rPos.p1
#global
repeat
getkey k,1
if k=1&kbac=0:開始x=mousex:開始y=mousey
if k=1:終了x=mousex:終了y=mousey
RevisionPos 開始x,開始y,終了x,終了y;座標を指定する。
Color 255,255,255:boxf:Color 0,0,0:boxf RevPos(0),RevPos(1),RevPos(2),RevPos(3);修正後の値はRevPosで取得。
kbac=k
await 17-(cnt\3=0)
loop
|
|
|
2016/4/21(Thu) 23:57:32|NO.75287
個人的な好みですが、この情報量なら配列で管理したほうが分かりやすくて好きです。
#uselib "user32.dll"
#func ScreenToClient "ScreenToClient" int, var
#enum BAK_RECT = 0
#enum CUR_RECT
#enum POS_X = 0
#enum POS_Y
dim rect, 2, 2
repeat
getkey k
if k & (ginfo_act >= 0) {
// color 255, 255, 255 : boxf rect(POS_X, BAK_RECT), rect(POS_Y, BAK_RECT), rect(POS_X, CUR_RECT), rect(POS_Y, CUR_RECT)
rect(0, CUR_RECT) = ginfo_mx, ginfo_my
ScreenToClient hwnd, rect(0, CUR_RECT)
rect(0, kbak) = rect(POS_X, CUR_RECT), rect(POS_Y, CUR_RECT)
redraw 2
color 255, 255, 255
boxf
color 255, 36, 0
boxf rect(POS_X, BAK_RECT), rect(POS_Y, BAK_RECT), rect(POS_X, CUR_RECT), rect(POS_Y, CUR_RECT)
redraw 1
}
kbak=k
await 25
loop
|
|
|
2016/4/22(Fri) 19:01:10|NO.75292
>>75288 （総当たりについて） で作ったC++からのベタ移植コードをこちらに公開。
総当たり＋総組合せの二つに増やしてモジュール化しました。
まず、ソート済みのデータがあります（昇順ソート）
data=1,2,3,4,5,6 等
これを次の関数に入れると、
next_permutation(data)
初期状態に戻るときを除いて返値が1になる（ので、whileとか使おう)
next_combination(data,r)
でコンビネーションがとれる。nCrのrを追加で指定するといいです。
あとは、サンプル見て頑張ってください。
#ソースコードのライセンスは不明。C++のライブラリのライセンスって……なんだっけ？
#参考文献： http://cpprefjp.github.io/reference/algorithm/next_permutation.html など
#module
#deffunc swap var a,var b
tmp=a
a=b
b=tmp
return
#define global reverse(%1) __reverse %1,0,length(%1)
#deffunc __reverse array data,int first,int last
repeat (last-first)/2
swap data(first+cnt),data(last-cnt-1)
wait 0
loop
return
#defcfunc next_permutation array data,local i,local j,local ii
if(length(data)<=1){
return 0;
}
i==length(data)
i--
repeat
ii=i
i--
if(data(i)<data(ii)){
j=length(data)
do
j--
until(data(i)<data(j))
swap data(i),data(j)
__reverse data,ii,length(data)
return 1
}
if(i==0){
reverse data
return 0
}
wait 0
loop
return 0
#defcfunc next_combination array data,int num,local m1,local m2,local result,local first1,local last1,local first2,local last2
first1=0
last1=num
first2=num
last2=length(data)
if ((first1==last1)||(first2==last2)){
return 0;
}
m1=last1
m2=last2-1
do
m1--
wait 0
until (((m1==first1)||((data(m1)<data(m2)))))
result=((m1==first1)&&(1!((data(m1)<data(first2)))))
if(1!result){
while((first2!=m2)&&(1!(data(m1)<data(first2))))
first2++
wait 0
wend
first1=m1
swap data(first1),data(first2)
first1++
first2++
}
if((first1!=last1)&&(first2!=last2)){
m1=last1
m2=first2
while((m1!=first1)&&(m2!=last2))
m1--
swap data(m1),data(m2)
m2++
wait 0
wend
__reverse data,first1,m1
__reverse data,first1,last1
__reverse data,m2,last2
__reverse data,first2,last2
}
return 1!result
#global
a=1,2,3,4
do
mes strf("%d,%d,%d,%d",a(0),a(1),a(2),a(3))
until (0==next_permutation(a))
a=1,2,3,4,5,6
pos 200,0
do
mes strf("%d,%d,%d,%d",a(0),a(1),a(2),a(3))
until (0==next_combination(a,4))
| |
|
|
2016/4/24(Sun) 03:40:38|NO.75301
気力が続いて深夜テンション入った結果がメルセンヌツイスター乱数（mt19937ar）移植実装。
が、その前の前提用に、
「論理右シフトマクロ」
#define global ctype lshiftr(%1,%2=0) (((%1)>>%2)&(0xFFFFFFFF^(0x80000000>>(%2-1))))
そして、「符号なし整数の実数化」として
#defcfunc ul2dbl int p1,local dbl
dbl=0.0
dbl+=p1&0x7fffffff
dbl*=(lshiftr(p1,31)+1)
return dbl
を一旦投稿します。（今回のソース等、このスレッド系統に投稿したソースは、元ソースの翻訳等でない限り
「遡及的に」パブリックドメイン等の最も自由なライセンスとします。もうなってるはずだけど、念のため）
|
|
|
2016/4/24(Sun) 03:44:35|NO.75302
そして、前提条件を満たしたので、お待ちかね？ メルセンヌツイスタ乱数の移植版の公開。
元ソース： http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/MT2002/CODES/mt19937ar.c
移植後：
#define global ctype lshiftr(%1,%2=0) (((%1)>>%2)&(0xFFFFFFFF^(0x80000000>>(%2-1))))
#define global printf mes strf
#runtime "hsp3cl"
#module
#define N 624
#define M 397
#define MATRIX_A 0x9908b0df
#define UPPER_MASK 0x80000000
#define LOWER_MASK 0x7FFFFFFF
#deffunc init
dim mt,N
mti=N+1
return
#deffunc init_genrand int s
mt(0)=s
for mti,1,N
mt(mti)=(1812433253*(mt(mti-1)^(lshiftr(mt(mti-1),30)))+mti)
next
return
#deffunc init_by_array array init_key,local key_length,local i,local j,local k
key_length=length(init_key)
init_genrand 19650218
i=1
j=0
k=0
if(N>key_length){
k=N
}else{
k=key_length
}
for k,k,0,-1
mt(i)=(mt(i)^((mt(i-1)^(lshiftr(mt(i-1),30)))*1664525))+init_key(j)+j
i++
j++
if(i>=N){
mt(0)=mt(N-1)
i=1
}
if(j>=key_length){
j=0
}
next
for k,N-1,0,-1
mt(i)=(mt(i)^((mt(i-1)^(lshiftr(mt(i-1),30)))*1566083941))-i
i++
if(i>=N){
mt(0)=mt(N-1)
i=1
}
next
mt(0)=0x800000000
return
#defcfunc genrand_int32 local y,local kk
if(ifdefmag01==0){
ifdefmag01=1
mag01=0,MATRIX_A
}
if(mti>=N){
if(mti==N+1){
init_genrand(5489)
}
for kk,0,N-M
y=(mt(kk)&UPPER_MASK)|(mt(kk+1)&LOWER_MASK)
mt(kk)=mt(kk+M)^(lshiftr(y,1))^mag01(y&1)
next
for kk,kk,N-1
y=(mt(kk)&UPPER_MASK)|(mt(kk+1)&LOWER_MASK)
mt(kk)=mt(kk+M-N)^(lshiftr(y,1))^mag01(y&1)
next
y=(mt(N-1)&UPPER_MASK)|(mt(0)&LOWER_MASK)
mt(N-1)=mt(M-1)^(lshiftr(y,1))^mag01(y&1)
mti=0
}
y=mt(mti)
mti++
y^=lshiftr(y,11)
y^=(y<<7)&0x9d2c5680
y^=(y<<15)&0xefc60000
y^=lshiftr(y,18)
return y
#define global ctype genrand_int31 (lshiftr(genrand_int32(),1))
#define global ctype genrand_real1 ((1.0/4294967295.0)*ul2dbl(genrand_int32()))
#define global ctype genrand_real2 ((1.0/4294967296.0)*ul2dbl(genrand_int32()))
#define global ctype genrand_real3 ((1.0/4294967296.0)*(0.5+ul2dbl(genrand_int32())))
#define global ctype genrand_res53 ((67108864.0*lshiftr(genrand_int32(),5)+lshiftr(genrand_int32(),6))*(1.0/90071992547490992.0))
#defcfunc ul2dbl int p1,local dbl
dbl=0.0
dbl+=p1&0x7fffffff
dbl*=(lshiftr(p1,31)+1)
return dbl
#global
init
initial=0x123,0x234,0x345,0x456
init_by_array(initial)
printf("1000 outputs of genrand_int32()");
for i,0,1000/5
printf("%10u %10u %10u %10u %10u",genrand_int32(),genrand_int32(),genrand_int32(),genrand_int32(),genrand_int32())
next
printf("\n1000 outputs of genrand_real2()");
for i,0,1000
printf("%10.8f %10.8f %10.8f %10.8f %10.8f",genrand_real2(),genrand_real2(),genrand_real2(),genrand_real2(),genrand_real2())
next
ライセンス等のコメントは記載がわからないので見送り。さて、ライセンスの条項は？ というと、
これもまた不明。（C++11でメルセンヌツイスタあるんだけど、あれライセンス表記必要ないし…？）
作者の希望ライセンスはPD。ただし、原作者のお言葉によってはBSDになりうると認識してください。
注意：なんかバグってる可能性あり。出力結果が一部本家と異なる。なんでかはわからなかった。解析して訂正してください。
| |
|
|
2016/5/21(Sat) 16:56:17|NO.75543
他のウィンドウのIMEのON/OFFを取得する
#define WM_IME_CONTROL 0x283
#define WM_SIZE 0x005
#uselib "User32.dll"
#cfunc SendMessageA "SendMessageA" int,int,int,int
#cfunc WindowFromPoint "WindowFromPoint" int,int
#uselib "imm32.dll"
#cfunc ImmGetDefaultIMEWnd "ImmGetDefaultIMEWnd" int
screen 0,200,50
buf = "OFF","ON"
repeat
hwnd_underMouse = WindowFromPoint(ginfo_mx,ginfo_my)
hwnd_defaultIME = ImmGetDefaultIMEWnd(hwnd_underMouse)
statIME = SendMessageA(hwnd_defaultIME, WM_IME_CONTROL, WM_SIZE, 0)
color 255,255,255 : boxf
color : pos 0,0 : mes "hwnd = "+hwnd_underMouse+"\nIME : "+buf(statIME)+""
await 100
loop
|
|
|
2016/5/27(Fri) 18:37:50|NO.75619
既出かもしれませんが、
return命令の代わりに使う、refstr,stat,refdvalに同時に値を入れる命令です。
#module
#deffunc local statreturn int i
return i
#deffunc local dvalreturn double d
return d
#deffunc exreturn2 str s,int i2,double d2
statreturn i2
dvalreturn d2
return s
#define global exreturn(%1="",%2=0,%3=0.0) exreturn2 %1,%2,%3:return
#global
|
|
|
2016/6/3(Fri) 21:12:32|NO.75693
ちょっとレベル低いかもしれませんが・・・
RGB変換・再変換マクロ
#define global ctype RGB(%1,%2,%3) (%1 | %2 << 8 | %3 << 16)
#define global ctype RevR(%1) (%1 ^ (RevG(%1) << 8) ^ (RevB(%1) << 16))
#define global ctype RevG(%1) ((%1 >> 8) ^ (RevB(%1) << 8))
#define global ctype RevB(%1) (%1 >> 16)
#define global RGBcolor(%1) color RevR(%1), RevG(%1), RevB(%1)
#defineとかで色を定義するとき便利かも
#define BOX_COLOR RGB(50, 100, 150)
RGBcolor BOX_COLOR
boxf
|
|
|
2016/6/4(Sat) 02:17:19|NO.75695
>> NO.75693
これ便利かも。Artlet2DのARGBみたいなやつですね。
しかしこれHTMLなどで用いられる方法と比べるとRとBが逆じゃないでしょうか。
#define global ctype RGB(%1,%2,%3) (((%1)&$FF) <<16 | ((%2)&$FF) << 8 | ((%3)&$FF))
#define global ctype RevR(%1) (((%1) >> 16) & $FF)
#define global ctype RevG(%1) (((%1) >> 8) & $FF)
#define global ctype RevB(%1) ((%1) & $FF)
#define global RGBcolor(%1) color RevR(%1), RevG(%1), RevB(%1)
a = rgb($12,$34,$56) ;R,G,B (a = 0x123456 ←0xRRGGBB)
mes strf("0x%02X", a)
mes strf("0x%02X", RevR(a))
mes strf("0x%02X", RevG(a))
mes strf("0x%02X", RevB(a))
ユーザーが無茶な使い方するかもしれないので、カッコと&$FFはつけておくと安心です。
|
|
|
2016/6/4(Sat) 06:48:28|NO.75699
WinAPIでは、BBGGRR形式だと思います
wingdi.hより抜粋
#define RGB(r,g,b) ((COLORREF)(((BYTE)(r)|((WORD)((BYTE)(g))<<8))|(((DWORD)(BYTE)(b))<<16)))
|
|
|
2016/6/5(Sun) 00:07:37|NO.75717
なるほどーこれがリトルエンディアン…これまで目をそらして生きてきたのですがいつまでもそういう訳にはいかないか。
WinAPIで使われてるならBBGGRR形式じゃないとまずいですね。
こうかな
#define global ctype RGB(%1,%2,%3) (((%3)&$FF) <<16 | ((%2)&$FF) << 8 | ((%1)&$FF))
#define global ctype RevR(%1) ((%1) & $FF)
#define global ctype RevG(%1) (((%1) >> 8) & $FF)
#define global ctype RevB(%1) (((%1) >> 16) & $FF)
#define global RGBcolor(%1) color RevR(%1), RevG(%1), RevB(%1)
#define global ctype RGBnum(%1) ((((%1) >> 16) & $0000FF)|((%1) & $00FF00)|(((%1) << 16) & $FF0000))
a = RGB($12,$34,$56) ;R,G,B (#123456)
mes strf("0x%06X", a)
mes strf("0x%02X", RevR(a))
mes strf("0x%02X", RevG(a))
mes strf("0x%02X", RevB(a))
a = RGBnum(0x123456) ;R,G,B (#123456)
mes strf("0x%06X", a)
mes strf("0x%02X", RevR(a))
mes strf("0x%02X", RevG(a))
mes strf("0x%02X", RevB(a))
とさり気なく余計なものも混ぜてみる。
|
|
|
2016/6/5(Sun) 01:02:18|NO.75718
HSPではMSBを取得するのにどの方法早いかを調べてみました。
いろいろな方法がありますが、HSPでは素直にlogf関数を使うのが一番いいみたいですね。
#module
#defcfunc MSB1 int w
if w < 0: return 32
y = -(w >> 16)
m = (y >> 16) & 16
n = 16 - m
x = w >> m
y = x - 0x100
m = (y >> 16) & 8
n + m
x << m
y = x - 0x1000
m = (y >> 16) & 4
n + m
x << m
y = x - 0x4000
m = (y >> 16) & 2
n + m
x << m
y = x >> 14
m = y & (-1^(y >> 1))
return 30 - n + m
#defcfunc MSB2 int w
y = w | (w >> 1)
y |= (y >> 2)
y |= (y >> 4)
y |= (y >> 8)
y |= (y >> 16)
y = (y & 0x55555555) + ((y >> 1) & 0x55555555)
y = (y & 0x33333333) + ((y >> 2) & 0x33333333)
y = (y & 0x0f0f0f0f) + ((y >> 4) & 0x0f0f0f0f)
y = (y & 0x00ff00ff) + ((y >> 8) & 0x00ff00ff)
return (y & 0x0000ffff) + ((y >> 16) & 0x0000ffff)
#defcfunc MSB3 int w
if w < 0: return 32
y = 0.5 + w
return (lpeek(y, 4) >> 20) - 1022
#defcfunc MSB4 int w
if w <= 0: return (w < 0) * 32
return 1 + logf(w) / 0.6931471
#global
#include "d3m.hsp"
#const 処理回数 100000
mes "関数整合性チェック中"
for i, -1000, 100000
if MSB1(i) ! MSB2(i): end
if MSB3(i) ! MSB4(i): end
if MSB1(i) ! MSB3(i): end
next
mes "空ループ計測中"
wait 10
wait 15: looptime -= d3timer(): repeat 処理回数: loop: looptime += d3timer()
wait 15: looptime -= d3timer(): repeat 処理回数: loop: looptime += d3timer()
wait 15: looptime -= d3timer(): repeat 処理回数: loop: looptime += d3timer()
wait 15: looptime -= d3timer(): repeat 処理回数: loop: looptime += d3timer()
wait 15: looptime -= d3timer(): repeat 処理回数: loop: looptime += d3timer()
looptime / 5
mes "処理１計測中"
wait 40
av1 = -d3timer()
repeat 処理回数
//処理内容１//
a = MSB1(cnt)
//////////////
loop
av1 += d3timer() - looptime
mes "処理２計測中"
wait 40
av2 = -d3timer()
repeat 処理回数
//処理内容２//
a = MSB2(cnt)
//////////////
loop
av2 += d3timer() - looptime
mes "処理３計測中"
wait 40
av3 = -d3timer()
repeat 処理回数
//処理内容２//
a = MSB3(cnt)
//////////////
loop
av3 += d3timer() - looptime
mes "処理４計測中"
wait 40
av4 = -d3timer()
repeat 処理回数
//処理内容２//
a = MSB4(cnt)
//////////////
loop
av4 += d3timer() - looptime
mes "計測終了\n一回の処理あたり平均"
mes "" + double(av1) / 処理回数 + "ms"
mes "" + double(av2) / 処理回数 + "ms"
mes "" + double(av3) / 処理回数 + "ms"
mes "" + double(av4) / 処理回数 + "ms"
| |
|
|
2016/6/12(Sun) 03:51:17|NO.75847
SQLite3……というより、SQLeleのDBを簡単に作れるようにするサポートモジュール
単にCSV<==>DBを行えるモジュール関数です。
#include "sqlele.hsp"
#module
#deffunc csv2sql str filename,str dbfilename,local csv,local filesize,local i,local buf,\
local buf2,local list,local list2,local tmparr
exist filename
if(strsize==-1):dialog "CSVファイルがありません",1,"警告":return
notesel csv
noteload filename
sql_open dbfilename
sql_q "select count(*) from sqlite_master where type='table' and name='"+getpath(filename,9)+"';"
if(tmparr(0,0)=="1"){
sql_q "drop table "+getpath(filename,9)+";"
}
noteget buf,0
split buf,",",list
noteget buf,1
split buf,",",list2
buf="create table "+getpath(filename,9)+"("
foreach list
buf+=list(cnt)+" "+list2(cnt)+","
loop
buf=strmid(buf,0,strlen(buf)-1)
buf+=");"
sql_q buf
for i,2,notemax
noteget buf,i
split buf,",",list
buf="insert into "+getpath(filename,9)+" values("
foreach list
buf+="\""+list(cnt)+"\","
loop
buf=strmid(buf,0,strlen(buf)-1)
buf+=");"
sql_q buf
wait 0
next
return
#deffunc sql2csv str dbfilename,local csv,local filesize,local i,local j,local buf,\
local buf2,local list,local tmparr//,local list2
exist dbfilename
if(strsize==-1):dialog "DBファイルがありません",1,"警告":return
notesel csv
sql_open dbfilename
sql_q "select name from sqlite_master where type='table' order by name;"
sdim list2,1024,length2(tmparr)-1
foreach list2
list2(cnt)=tmparr(0,cnt)
loop
foreach list2
csv=""
sql_q "PRAGMA table_info('"+list2(cnt)+"');"
for j,1,3
buf=""
for i,0,length2(tmparr)-1
buf+=tmparr(j,i)+","
next
buf=strmid(buf,0,strlen(buf)-1)
noteadd buf
next
sql_q "select * from "+list2(cnt)+";"
for i,0,length2(tmparr)-1
buf=""
for j,0,length(tmparr)
buf+=tmparr(j,i)+","
next
buf=strmid(buf,0,strlen(buf)-1)
noteadd buf
next
notesave getpath(dbfilename,9)+"__"+list2(cnt)+".csv"
loop
return
#global
バイナリーデータが叩きこまれたら挙動が怪しいとかそういう話もありますが…… 勘弁して下さいっ
| |
|
|
2016/6/12(Sun) 05:11:33|NO.75848
>>NO.75847
よく考えたら投げっぷりが半端ない……
CSVファイルのフォーマット指定はこれです。ものぐさなので、ちゃんとしたパーサーしてません。
カラム名1,カラム名2,...
型名1,型名2,...
データ1-1,データ1-2,...
データ2-1,データ2-2,...
...
間違ってデータの中に","を含めると結果がぶっ壊れるので注意。
逆にDB側のデータの中に","がある場合、「出力結果が」壊れるので注意。（壊れるというか、意図通りにならない？
|
|
|
2016/6/19(Sun) 20:33:35|NO.75912
|
|
|
2016/6/19(Sun) 23:59:07|NO.75916
|
|
|
2016/6/22(Wed) 22:00:40|NO.75954
|
|
|
2016/10/7(Fri) 20:50:56|NO.77060
hspinetプラグインのJSONパース機能では少し使いづらかったりする部分があるので
IEを利用して、javascriptによるJSONパースモジュールを自作しました。
このサンプルには、TwitterAPIを利用する例です。
jsonget命令は、jsondataにJSON文字列を指定して、addrにアクセスしたい階層を.で区切った
ものを指定します。（例：stat->aaaの場合、addrには、stat.aaaとする）
そして、outには出力する変数を指定します。
jsonget2は関数版ですので同じです。
#module user
#deffunc jsonget str jsondata,str addr,var out
axobj js,"Shell.Explorer.2",0,0
js->"write" "<script>var jsond = "+jsondata+";document.write(jsond."+addr
jdoc = js("Document")
outa = jdoc("body")
out = outa("innerHTML")
delcom js
return
#defcfunc jsonget2 str jsondata,str addr
axobj js,"Shell.Explorer.2",0,0
js->"Navigate" "about:blank"
jsx=js("Document")
jsx->"write" "<script>var jsond = "+jsondata+";document.write(jsond."+addr+")</script>"
jdoc = js("Document")
outa = jdoc("body")
out = outa("innerHTML")
delcom js
return out
#global
#include "hspinet.as"
netinit
neturl "https://api.twitter.com/1.1/statuses/"
netrequest_get "update.json"
repeat
netexec r
if r:break
wait 1
loop
netgetv buf
res = jsonget2(buf,"errors[0].code")
mes res
| |
|
|
2016/11/19(Sat) 20:09:17|NO.77347
gosubを隠蔽して引数や戻り値っぽいものを渡せるようにする何か。
//main.hsp
#runtime "hsp3cl"
#include "gofunc.as"
#cmpopt ppout 1
#module Program
function(hoge,a,b,c,d,e)
ints a,b,c,d,e
resolve a+b+c+d+e
end_function
def(huga,a,b,c,d,e)
mes a+b+c+d+e
endf
#deffunc main
fl=*hoge
mes call(fl,1,2,3,4,5)
subcall *huga,1,2,3,4,5
return
#global
main
//gofunc.as
#module gofunc
#define join(%1,%2) %2="":foreach %1:if cnt!=0:{%2+="$ParamS$"}%2+=%1(cnt):loop
//命令・関数呼び出し
#define global call funcall
#define global ctype funcall(%1,%2="",%3="",%4="",%5="",%6="",%7="",%8="",%9="",%10="",%11="") \
(callf@gofunc(%1,str(%2),str(%3),str(%4),str(%5),str(%6),str(%7),str(%8),str(%9),str(%10),str(%11)))
#define global subcall(%1,%2="",%3="",%4="",%5="",%6="",%7="",%8="",%9="",%10="",%11="") \
%tfunc %i=%1:%i%o0=callf@gofunc(%o,str(%2),str(%3),str(%4),str(%5),str(%6),str(%7),str(%8),str(%9),str(%10),str(%11))
#defcfunc local callf var flabel,str p1,str p2,str p3,str p4,str p5,str p6,str p7,str p8,str p9,str p10
args@gofunc=p1,p2,p3,p4,p5
join args@gofunc,argstr@gofunc
gosub flabel
return result
//関数定義
#define global ctype fn(%1) Function_%1
#define global ctype function(%1=nul@gofunc, \
%2=nul@gofunc,%3=nul@gofunc,%4=nul@gofunc,%5=nul@gofunc,%6=nul@gofunc, \
%7=nul@gofunc,%8=nul@gofunc,%9=nul@gofunc,%10=nul@gofunc,%11=nul@gofunc) \
*%1: split argstr@gofunc,"$ParamS$",%2,%3,%4,%5,%6,%7,%8,%9,%10,%11
#define global resolve(%1) result@gofunc=%1:return
#define global end_function return
//関数別名
#define global ⇒ function
#define global ＝＞ function
#define global def function
#define global defn function
#define global defun function
#define global lambda function
#define global delegate function
#define global sub function
#define global endf end_function
#define global end_sub end_function
//型変換
#define global ints(%1=nul@gofunc,%2=nul@gofunc,%3=nul@gofunc,%4=nul@gofunc,%5=nul@gofunc, \
%6=nul@gofunc,%7=nul@gofunc,%8=nul@gofunc,%9=nul@gofunc,%10=nul@gofunc) \
ints@gofunc %1,%2,%3,%4,%5,%6,%7,%8,%9,%10
#deffunc local ints var p1,var p2,var p3,var p4,var p5,var p6,var p7,var p8,var p9,var p10
p1=int(p1):p2=int(p2):p3=int(p5):p4=int(p4):p5=int(p5)
p6=int(p6):p7=int(p7):p8=int(p8):p9=int(p9):p10=int(p10)
return
#define global doubles(%1=nul@gofunc,%2=nul@gofunc,%3=nul@gofunc,%4=nul@gofunc,%5=nul@gofunc, \
%6=nul@gofunc,%7=nul@gofunc,%8=nul@gofunc,%9=nul@gofunc,%10=nul@gofunc) \
doubles@gofunc %1,%2,%3,%4,%5,%6,%7,%8,%9,%10
#deffunc doubles var p1,var p2,var p3,var p4,var p5,var p6,var p7,var p8,var p9,var p10
p1=double(p1):p2=double(p2):p3=double(p5):p4=double(p4):p5=double(p5)
p6=double(p6):p7=double(p7):p8=double(p8):p9=double(p9):p10=double(p10)
return
#global
| |
|
|
2016/12/10(Sat) 04:05:11|NO.77537
日付と時刻を整形して返すモジュールです
GetTimeFormatとかDate〜とかwin32APIにありますが微妙に使いにくかったので車輪の再発明しました…
#module "DateAndTimeFormat_Mod"
#uselib "kernel32.dll"
#func GetLocalTime "GetLocalTime" int
#deffunc DateAndTimeFormat_Init
dim localTime, 4
eMonthFullArr = "January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December" //MMMM
eMonthAbbreviationsArr = "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" //MMM
eDayOfWeekFullArr = "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday" //edddd
eDayOfWeekAbbreviationsArr = "Sun", "Mon", "Tues", "Wed", "Thurs", "Fri", "Sat" //eddd
jDayOfWeekFullArr = "日曜日", "月曜日", "火曜日", "水曜日", "木曜日", "金曜日", "土曜日" //jdddd
jDayOfWeekAbbreviationsArr = "日", "月", "火", "水", "木", "金", "土" //jddd
eTimeDivision = "AM","PM" //ett
jTimeDivision = "午前","午後" //jtt
return
//DateAndTimeFormat 戻り地が0なら成功 -1は不一致 -2は使えない文字
#deffunc DateAndTimeFormat str _st, var st
sdim st
st = _st
GetLocalTime varptr(localTime)
year4 = ""+ wpeek(localTime(0), 0) //yyyy
year2 = strf("%02d", wpeek(localTime(0), 0)\100) //yy
year1 = ""+ wpeek(localTime(0), 0) \ 100 //y
month2 = strf("%02d", wpeek(localTime(0), 2)) //MM
month1 = ""+ wpeek(localTime(0), 2) //M
mouhtNum = wpeek(localTime(0), 2) -1
dayOfWeekNum = wpeek(localTime(1), 0)
timeDivisionNum = wpeek(localTime(2), 0) / 12
day2 = strf("%02d", wpeek(localTime(1), 2)) //dd
day1 = ""+ wpeek(localTime(1), 2) //d
hour242 = strf("%02d", wpeek(localTime(2), 0)) //HH
hour241 = ""+ wpeek(localTime(2), 0) //H
hour122 = strf("%02d", wpeek(localTime(2), 0) \ 12) //hh
hour121 = ""+ wpeek(localTime(2), 0) \ 12 //h
min2 = strf("%02d", wpeek(localTime(2), 2)) //mm
min1 = ""+ wpeek(localTime(2), 2) //m
sec2 = strf("%02d", wpeek(localTime(3), 0)) //ss
sec1 = ""+ wpeek(localTime(3), 0) //s
msec = strf("%03d", wpeek(localTime(3), 2)) //ms
strrep st, "<yyyy>", year4
strrep st, "<yy>", year2
strrep st, "<y>", year1
strrep st, "<MMMM>", eMonthFullArr(mouhtNum)
strrep st, "<MMM>", eMonthAbbreviationsArr(mouhtNum)
strrep st, "<MM>", month2
strrep st, "<M>", month1
strrep st, "<edddd>", eDayOfWeekFullArr(dayOfWeekNum)
strrep st, "<eddd>", eDayOfWeekAbbreviationsArr(dayOfWeekNum)
strrep st, "<jdddd>", jDayOfWeekFullArr(dayOfWeekNum)
strrep st, "<jddd>", jDayOfWeekAbbreviationsArr(dayOfWeekNum)
strrep st, "<dd>", day2
strrep st, "<d>", day1
strrep st, "<hh>", hour122
strrep st, "<h>", hour121
strrep st, "<ett>", eTimeDivision(timeDivisionNum)
strrep st, "<jtt>", jTimeDivision(timeDivisionNum)
strrep st, "<HH>",hour242
strrep st, "<H>", hour241
strrep st, "<mm>", min2
strrep st, "<m>", min1
strrep st, "<ss>", sec2
strrep st, "<s>", sec1
strrep st, "<ms>", msec
strrep st, "<", ""
if stat != 0: return -1
strrep st, ">", ""
if stat != 0: return -1
strrep st, "\\", ""
if stat != 0: return -2
strrep st, "/", ""
if stat != 0: return -2
strrep st, ":", ""
if stat != 0: return -2
strrep st, "*", ""
if stat != 0: return -2
strrep st, "?", ""
if stat != 0: return -2
strrep st, "!", ""
if stat != 0: return -2
strrep st, "\"", ""
if stat != 0: return -2
strrep st, "|", ""
if stat != 0: return -2
return 0
#global
#if 0 //1にすればサンプルが有効になります
DateAndTimeFormat_Init
st = "年 <yyyy>-<yy>-<y>\n"
st += "月 <MMMM>-<MMM>-<MM>-<M>\n"
st += "曜日 <edddd>-<jdddd>-<eddd>-<jddd>\n"
st += "日 <dd>-<d>\n"
st += "午前/午後 <ett>-<jtt>\n"
st += "12時間 <hh>-<h>\n"
st += "24時間 <HH>-<H>\n"
st += "分 <mm>-<m>\n"
st += "秒 <ss>-<s>\n"
st += "ミリ秒 <ms>"
DateAndTimeFormat st, st
mes st
mes stat
stop
#endif
| |
|
|
2017/1/29(Sun) 21:06:49|NO.78096
匿名ラベル（どっかから持ってきたやつ。どこだったか忘れました。すみません）と
無名関数（call.as が必要です http://prograpark.ninja-web.net/CollectField/#call）
使い道ないと思うけどJavaScriptっぽくかけるのがかっこいいので。
#include "call.as"
#define global label %tlabelt *%i : if 0 : *%o
#ifdef IG_IMPORT_HEADER_CALL_AS
#define global ctype function(%1=arg1,%2=arg2,%3=arg3,%4=arg4,%5=arg5,%6=arg6,%7=arg7,%8=arg8,%9=arg9) \
%tfunct *%i : if 0 : *%o : \
call_alias %1, 0 : \
call_alias %2, 1 : \
call_alias %3, 2 : \
call_alias %4, 3 : \
call_alias %5, 4 : \
call_alias %6, 5 : \
call_alias %7, 6 : \
call_alias %8, 7 : \
call_alias %9, 8
#endif
main = label {
start_end = label {
if flag == 0 {
mes "START"
} else : if flag == 1 {
mes "END"
}
flag++
return
}
multiply = function(a, b) {
return a * b
}
#define ctype add(%1, %2) call(_add, %1, %2) //call使わずに関数っぽく呼び出せる
_add = function(a, b) {
return a + b
}
#define sleep(%1, %2) call _sleep, %1, %2 //call使わずに命令っぽく呼び出せる
_sleep = function(f, t) {
wait t * 100
call f, t
return
}
finished_wait = function(elapsed) {
mes "waited for " + elapsed + " seconds."
return
}
gosub start_end //普通のラベルと同じ
button gosub "yay?", label { mes "yay!" : return } //匿名ラベル
mes call(multiply, 3, 4) //呼び出しはcallを使う
mes add(5, 2) //マクロで定義されたやつ
sleep finished_wait, 2 //コールバックも可能（実際はラベル型変数）
call function() { mes "bye..." : return } //意味ないけど即時関数
gosub start_end
return
}
gosub main
| |
|
|
2017/2/8(Wed) 06:44:32|NO.78180
変数に0を代入する時、どの方法がいいのか調べてみました。
lpokeが速くてコードサイズも少なくてお得という結果になりました。
ソースにミスがあったのでいったん削除して再投稿しました。
#include "d3m.hsp"
N = 500000
wait 80:t = -d3timer():repeat N
a = 0 ; 普通に0を代入
loop:mes "" + (t + d3timer()) + "ms":wait 50:t = -d3timer():repeat N
dim a ; むしろ初期化してしまう
loop:mes "" + (t + d3timer()) + "ms":wait 50:t = -d3timer():repeat N
lpoke a ; lpokeで書き込む
loop:mes "" + (t + d3timer()) + "ms"
|
|
|
2017/2/22(Wed) 09:12:10|NO.78299
NO.78180の記事が、ミスリードになりそうな気がしたので
配列での0初期化を書いてみました。
#include "d3m.hsp"
N = 500000
dim a, N
wait 80
; 普通に0を代入
t = -d3timer()
repeat N
a(cnt) = 0
loop
mes "" + (t + d3timer()) + "ms"
wait 50
; むしろ初期化してしまう
t = -d3timer()
dim a, N
mes "" + (t + d3timer()) + "ms"
wait 50
; lpokeで書き込む
t = -d3timer()
repeat N
lpoke a(cnt)
loop
mes "" + (t + d3timer()) + "ms"
個別の変数ではlpokeが速いのですが
配列の場合dimで確保および初期化するのが一番速いです。
|
|
|
2017/2/28(Tue) 14:29:40|NO.78335
こんなんでも良いでしょうか？ 年・月・日を引数にして曜日を返す関数。
#module
#defcfunc day2week int _dw_y,int _dw_m,int dw_d //ツェラーの公式を用い、年月日からその日の曜日を返す。
//(0が日曜日で、6が土曜日)
//wikipediaの「ツェラーの公式」に準拠。
//西暦4年3月1日より前の日には対応しない(強制的に0を返す)
dw_y=_dw_y
dw_m=limit(_dw_m,1,12)
if dw_m<=2 : dw_m=dw_m+12 : dw_y-- //1月か2月の場合は、前年の13月or14月として扱う
if dw_y<4 : return 0
dw_c=int(dw_y/100)
if dw_y<1582 {
//ユリウス暦
dw_g=dw_c*6+5
} else {
//グレゴリオ暦
dw_g=dw_c*5+int(dw_c/4)
}
return (((dw_d+int(26*(dw_m+1)/10)+(dw_y\100)+int((dw_y\100)/4)+dw_g+5)\7)+1)\7
#global
|
|
|
2017/2/28(Tue) 14:41:56|NO.78336
配列変数の初期化で速度とか気にしたこと無かったので為になります。
>>年・月・日を引数にして曜日を返す関数
こういうのって作るとなるとごちゃごちゃしてて難しいのであると便利ですね。
ちょっとマニアックですがffmpegで出力されたSSIMを解析するソースコード。
;ffmpeg -i "tes1.mp4" -i "tes2.mp4" -filter_complex ssim=stats.txt -an -f null -
;こんなコマンドで出力したSSIMのリストを解析する。
#include "hspext.as"
button gosub"読み込み",*読み込み
stop
*読み込み
notesel data
noteload "stats.txt";ここにSSIMのリストを指定する
SSIM合計=0.0
SSIM最高=0.0
SSIM最低=1.0
split data,"\n",一時
repeat notemax
in=instr(一時.cnt,0,"All:")+4
SSIM.cnt=double(strmid(一時.cnt,in,8))
SSIM合計+SSIM.cnt
if SSIM.cnt>=SSIM最高:SSIM最高=SSIM.cnt
if SSIM.cnt<=SSIM最低:SSIM最低=SSIM.cnt
await
loop
SSIM平均=SSIM合計/notemax
title "SSIM最高:"+SSIM最高+" SSIM平均:"+SSIM平均+" SSIM最低:"+SSIM最低+""
clipset "SSIM最高:"+SSIM最高+" SSIM平均:"+SSIM平均+" SSIM最低:"+SSIM最低+""
return
|
|
|
2017/3/1(Wed) 00:06:20|NO.78340
> 年・月・日を引数にして曜日を返す関数。
便乗宣伝！
修正ユリウス日換算モジュール http://mclab.uunyan.com/dl/dl46.htm
無駄に紀元前4000年ぐらいでも曜日出せます。
宣伝だけはあんまりかと思うので、日付計算に必要なのを…。
負数を用いた乗除の結果を、Ruby、Python、Common Lispなどと同じになるようにするマクロ。
#define ctype mod(%1,%2) (((%1)-(int((%1)/(%2))-1)*(%2)) \ (%2))
例えば -5\3=-2 ですが、mod(-5,3)=1 になります。
あとは床関数が必要ですが、これはfloor関数がすでにあります。
|
|
|
2017/3/4(Sat) 12:52:12|NO.78359
floorを使わない負の方向へ丸め
a = 12.34
a = a - (a \ 1) + (int(a) >> 31)
mes a
a = -12.34
a = a - (a \ 1) + (int(a) >> 31)
mes a
大丈夫だと思うけど、完全に検証していないので
修正ツッコミがあったら、よろしく。
|
|
|
2017/3/4(Sat) 14:51:45|NO.78360
floorを使わない負の方向へ丸めその２
ネットで調べたら、こういうアルゴリズムもあるみたい。
#define ctype myfloor(%1) 0 | %1 + (int(%1) >> 31)
mes myfloor(12.34)
mes myfloor(-12.34)
|
|
|
2017/3/27(Mon) 12:25:46|NO.78678
高階関数みたいな
LINQのパクリみたいな
#module array_functional
#define global ctype filter(%1,%2,%3=elem,%4=temp) %ttag_filter temp_lab = *%i : _filter %1, %2, %3, %4, temp_lab : if 0 : *%o
#deffunc _filter array ref_newarr, array arr, var ref_elem, var ref_index, var lab, local index
arr_type = vartype(arr(0))
dimtype newarr, arr_type
foreach arr
ref_index = cnt
ref_elem = arr(cnt)
gosub lab
if stat {
newarr(index) = arr(cnt)
index++
}
loop
dimtype ref_newarr, arr_type, index
repeat index
ref_newarr(cnt) = newarr(cnt)
loop
return index
#define _select_vartype vartype(arr_first_elem@array_functional)
#define global ctype select(%1,%2,%3=elem,%4=temp,%5=_select_vartype@array_functional) %ttag_select temp_lab = *%i : arr_first_elem@array_functional = %2(0) : \
_select %1, %2, %3, %4, %5, temp_lab : if 0 : *%o
#deffunc _select array ref_newarr, array arr, var ref_elem, var ref_index, int _type, var lab, local new_elem
arr_len = length(arr)
// ref_newarrとarrが同じ参照を持っていた場合
// ・ref_newarrを初期化するとarrも初期化されてしまう
// ・ref_newarrとarrの型が異なると代入ができない。
// そのため、いちどnewarrに結果を代入して、それをref_newarrにコピーする
dimtype newarr, _type, arr_len
foreach arr
ref_index = cnt
ref_elem = arr(cnt)
gosub lab
if _type == vartype("int") {
new_elem = stat
} else : if _type == vartype("str") {
new_elem = refstr
} else : if _type == vartype("double") {
new_elem = refdval
} else {
assert
}
newarr(cnt) = new_elem
loop
dimtype ref_newarr, _type, arr_len
foreach newarr
ref_newarr(cnt) = newarr(cnt)
loop
return arr_len
#defcfunc local aggregate_get_default_value var v
on vartype(v) goto *dv_unknown, *dv_unknown, *dv_string, *dv_double, *dv_int, *dv_unknown, *dv_unknown
*dv_unknown
return 0 //初期値なしの場合は0を返す
*dv_string
return ""
*dv_double
return 0.0
*dv_int
return 0
#define _aggregate_defval aggregate_get_default_value@array_functional(arr_first_elem@array_functional)
#define _aggregate_vartype vartype(aggregate_midway@array_functional)
#define global ctype aggregate(%1,%2,%3,%4=elem,%5=_aggregate_defval@array_functional,%6=_aggregate_vartype@array_functional) %ttag_aggregate temp_lab = *%i : \
arr_first_elem@array_functional = %2(0) : temp = %5 : aggregate_midway@array_functional = temp: \
_aggregate %1, %2, %3, %4, temp, %6, temp_lab : if 0 : *%o
#deffunc _aggregate var ref_result, array arr, var ref_midway, var ref_elem, var initvalue, int _type, var lab
ref_midway = initvalue
foreach arr
ref_elem = arr(cnt)
gosub lab
if _type == vartype("int") {
res = stat
} else : if _type == vartype("str") {
res = refstr
} else : if _type == vartype("double") {
res = refdval
} else {
assert
}
ref_midway = res
loop
ref_result = ref_midway
return
#global
filter(newarray, array, element, index) { ... return 条件式 }
配列をフィルタする。
newarray : 新しい配列
array : 元の配列 元の配列と新しい配列は同じでもOK
element : 条件式で配列の要素が代入される デフォルトでelem
index : 条件式で配列のインデックスが代入される 省略可 cntにも常に代入される
条件式 : 配列の要素数だけ評価される。その要素を通すか通さないか。1か0（trueかfalse）
select(newarray, array, element, index, type) { ... return 値 }
写像(map) 元の配列から新しい配列を作成
newarray : 新しい配列
array : 元の配列 元の配列と新しい配列は同じでもOK 型が異なってもOK
element : 条件式で配列の要素が代入される デフォルトでelem
index : 条件式で配列のインデックスが代入される 省略可 cntにも常に代入される
type : ＜値＞の型。つまり新しい配列の型。デフォルトでは<array>の型
値 : 配列の要素数だけ評価される。新しい配列の要素。
aggregate(result, array, それまでの結果, element, initial_value, type) { ... return 値 }
畳みこみ(fold) （配列の要素を一つ取り出して値を返す）を繰り返す。お会計みたいな。
result : 新しい値
array : 元の配列 新しい値と型が異なってもOK
それまでの結果 : ひとつ前の＜値＞ 一番最初だったら<initial_value>
element : 条件式で配列の要素が代入される デフォルトでelem
initial_value : ＜それまでの結果＞の初期値 デフォルトでは<type>のデフォルトの値
type : ＜値＞の型。つまり新しい値の型。デフォルトでは<array>の型
LINQの説明はここがわかりやすい
http://yohshiy.blog.fc2.com/blog-entry-274.html
サンプル
goto *@f
#define prnt(%1, %2="") _prnt %1, %2
#deffunc _prnt array arr, str init_str
s = init_str
foreach arr : s = s + arr(cnt) + ", " : loop
mes strmid(s, 0, strlen(s) - 2)
return
*@
x = "Hi", "Hello", "こんにちは", "oyeaah", "bye", "Alohaha"
prnt x, "=> "
select(len, x, , , vartype("int")) {
return strlen(elem)
} // len: 元のx(文字列の配列)の文字数の配列
prnt len, "長さ: "
filter(filtered_x, x, elem) { return strlen(elem) >= 6 }
prnt filtered_x, "長さ６以上の文字列: "
mes "----------------------------"
x = 3, -12, 59, 46, 59, 38, -7, 93, -22, 3, 1, 46, 22, 46
prnt x, "=> "
select(ax, x) { return elem * 2 }
prnt ax, "すべて二倍: "
filter(bx, x) { return elem \ 2 == 0 }
prnt bx, "偶数: "
aggregate(res, x, sum) { return sum + elem }
mes "合計: " + res
aggregate(res, x, min, m, "novalue", vartype("int")) {
if m < min || min == "novalue" {
return m
} else {
return min
}
}
mes "最小値: " + res
#module
#defcfunc array_find_first_int array arr, int val
index = -1
foreach arr
if arr(cnt) == val : index = cnt : break
loop
return index
#global
filter(new_x, x, , index) { return array_find_first_int(x, elem) == index }
prnt new_x, "重複消去: "
かっこいい
少しは役に立つかも
| |
|
|
2017/3/29(Wed) 05:52:53|NO.78707
ふと obaq の質問のスレを眺めると、オブジェクトが凸形状であることを前提とされているとか書いてある。
考えてみれば、凸形状であれば衝突判定がチョー簡単になるからか。
2次元の凸集合の性質から
「点Pが凸集合Sの内部(閉包)にある ⇔ 全ての辺について「辺ベクトル」から「辺の始点→Pベクトル」への外積のz成分が正(0以上)」
であることが容易に証明できる(Sの任意の内点は必ず各辺ベクトルの左側にある)。
#module
#define TRUE 1
#define FALSE 0
#defcfunc is_point_in_region double x_, double y_, int nvtx_, array xarray_, array yarray_
/*
点Pが凸領域Sの閉包にあるかどうか調べる
x_,y_ : Pの座標
nvtx_ : Sの頂点数
xarray_, yarray_ : Sの頂点リスト。左回り(通常のデカルト座標系に於いてのこと。HSPの画面上では右回りであることに注意！)に一筆書きで格納せよ
戻り値 : (TRUE(1),FALSE(0))=(含まれる,ない)
*/
assert (nvtx_>=1)
assert ((length(xarray_)>=nvtx_)&&(length(yarray_)>=nvtx_))
return_code=TRUE
repeat nvtx_
i=cnt : j=(cnt+1)\nvtx_
#define vx double(xarray_(j)-xarray_(i))
#define vy double(yarray_(j)-yarray_(i))
#define wx (x_-xarray_(i))
#define wy (y_-yarray_(i))
if (vx*wy-vy*wx < 0.0) {return_code=FALSE : break}
loop
return return_code
#global
/*---------- 以下サンプル ----------*/
#define APP_NAME "convex_set"
#define SX_MAIN 640
#define SY_MAIN 480
#define WID_MAIN 0
*init
screen WID_MAIN, SX_MAIN, SY_MAIN
title APP_NAME
//領域定義
xarray_region = 200, 400, 580, 620, 550, 320, 50, 20, 100
yarray_region = 80, 100, 200, 280, 430, 460, 400, 200, 100
num_vertex=length(xarray_region) //頂点数
*main
repeat
gosub *paint
await 32
loop
*paint
redraw 0
color 0,0,0 : boxf //背景色
if (is_point_in_region(mousex, mousey, num_vertex, xarray_region, yarray_region)) { //カーソルが領域に入っているか？
color 255,128,64
} else {color 64,128,255}
repeat num_vertex-2, 1 //領域表示
i=cnt : j=(cnt+1)\num_vertex
xx_dst = xarray_region(0), xarray_region(i), xarray_region(j), xarray_region(0)
yy_dst = yarray_region(0), yarray_region(i), yarray_region(j), yarray_region(0)
gsquare -1, xx_dst, yy_dst
loop
color 255,0,0 : circle mousex-10,mousey-10, mousex+10,mousey+10 //カーソル表示
redraw 1
return
| |
|
|
2017/4/4(Tue) 21:43:51|NO.78903
ボタンを押すゲームを作ってみました。
#uselib "user32.dll"
#func MoveWindow "MoveWindow" int,int,int,int,int,int
randomize
objsize 100,100:pos rnd(540),rnd(380)
button gosub "",*push
obj=objinfo(stat, 2)
title "ボタンを押した回数 0回"
stop
*push
pushed++
title "ボタンを押した回数 "+pushed+"回"
MoveWindow obj,rnd(540),rnd(380),100,100, 1
return
|
|
ちょっとしたソースコードを投稿するスレ
