HSPポータル
サイトマップ お問い合わせ


HSPTV!掲示板


未解決 解決 停止 削除要請

2015
1112
スペースちょっとしたソースコードを投稿するスレ153解決


スペース

リンク

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



KA

リンク

2015/11/12(Thu) 20:09:27|NO.72965

質問

1:「ちょっとした」の意味合いは?
○数千行もあるが内容は大したことの無い「ちょっとした」
○十数行だけど、あると便利な「ちょっとした」
○いつも多用している安定した「ちょっとした」
○わざわざ考えた不安定で不具合の多い「ちょっとした」

2:「ソースコードの議論」なら延々と続けても良い?
多少の修正はしょうが無いとしても、延々と「ああでもないこうでもない」の
議論を繰り返されるのはスレタイに反するのでは?

議論している本人はスレの最後の方だけ見れば良いけど、初めて見る人はスレ
の最初から見ないと意味が分からない。

前のスレでも書きましたが、案の定の後半でしたよ?

この辺をどう考えるのかはスレ主の自由ですが、「投稿する」というスレタイ
なら、本来は「議論も禁止するべき」という個人的意見です。



Snake

リンク

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/



Snake

リンク

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レスを最後にします。



Noap

リンク

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)



y.tack

リンク

2015/11/12(Thu) 21:47:04|NO.72970

僕のとこに載せるのは大歓迎ですw

逆にもう一個 ソレ用にpukiwiki用意した方がいいなら用意しますよーw

HSPwikiより僕んとこの方が良い理由はわかりませんがw



GENKI

リンク

2015/11/13(Fri) 01:21:18|NO.72977

いい感じに議論ばかりのスレに…
「ちょっとしたソースコードを投稿するスレ【議論専用】」ってスレ作っといて、やり取りが一定数超えたら「じゃあ続きはあっちで!」って宣言して議論用スレに移動するようにすればいいと思う。
で、十分議論したら、戻ってきて結果をまとめて報告、とか、バグ修正が終わったスクリを投稿とか。

最初の「やり取りが一定数…」は、レスするときに今何回目とかあと何回とかカウントも書き込んでおくのもいいかも。

>今さらですがこうして一つの掲示板のスレッドに書きこむのは、HSPWikiに一覧をつくるなどしても探しにくく結局使われない気がします。
wikiに載せるにしても、分類整理しないと見つけられないでしょうね。
一覧作成はそのための準備かな。



KA

リンク

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 ;常に1 QTY+= ;項目数 break ;終わり } ;----------------------------------- if SNM>2 {SNM=SNM+2} ;2以上の偶数はとばす if SNM=2 : SNM+= ;2以上の偶数はとばす 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 ;-----------------------------------



Noap

リンク

2015/11/13(Fri) 23:10:44|NO.72996

この投稿を見てくださるかは分かりませんが



このスレッドは「少し便利になるモジュール」の続きとしてスペースさんがつくりました
http://hsp.tv/play/pforum.php?mode=all&num=70762


このスレッドの各スクリプトの一覧
http://quasiquote.org/hspwiki/%e3%81%a1%e3%82%87%e3%81%a3%e3%81%a8%e3%81%97%e3%81%9f%e3%82%bd%e3%83%bc%e3%82%b9%e3%82%b3%e3%83%bc%e3%83%89%e3%82%92%e6%8a%95%e7%a8%bf%e3%81%99%e3%82%8b%e3%82%b9%e3%83%ac


投稿の中に直接記載されているスクリプトはライセンスについての記載がなければパブリックドメインとして扱ってください
投稿の中に直接記載されていない外部リンク(ホームページやブログなど)のスクリプトはそのリンク先のスクリプトのライセンスに従ってください


基本的に議論や長くなりそうな質問、会話はこのリンク先のスレッドにて行ってくださいとのことです
「ちょっとしたソースコードを投稿するスレ【議論専用】」
http://hsp.tv/play/pforum.php?mode=all&num=72980



スレッドの名前に使われている言葉の意味



「ちょっとした」
「わざわざそれのためだけにスレッドを新たにつくるほどのスクリプトではないけどみんなに見てもらいたい」という意味らしいです


「スレ」
スレッドという意味らしいです



Noap

リンク

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



kanamaru

リンク

2015/11/14(Sat) 08:29:28|NO.73007

KAさん、とりあえず速度を上げられないかいろいろ試してみます。
タイトルバーの文字列って素因数分解の間違いですよね?
確かに素因数分解も因数分解の一つですが。



KA

リンク

2015/11/14(Sat) 20:58:45|NO.73018

>>確かに素因数分解も因数分解の一つですが。
昔、何かのためにちゃちゃっと作ったので適当です。

この手のソフトは案外良く見かけると思います。
内容的には「自然数Nの最大の約数は√Nより大きくは無い」という
処理を組み込んでいるだけの力業です。



Quiet

リンク

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



KA

リンク

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 t,100,20,5 button gosub "OK",*OK stop *OK pos 100,0 t=1.0*t T=t+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 *t/( 273.47 +t )) : TXT( 0)=""+Pws+" [1] -70〜 0 VAISALA 霜点温度用" Pws= 6.1162 *expc( 7.5892 *t/( 240.71 +t )) : TXT( 1)=""+Pws+" [1] -20〜 50 VAISALA" Pws= 6.1078 *expc( 7.5000 *t/( 237.30 +t )) : TXT( 2)=""+Pws+" [1] -40〜 60 VAISALA" Pws= 5.9987 *expc( 7.3313 *t/( 229.10 +t )) : TXT( 3)=""+Pws+" [1] 50〜100 VAISALA" Pws= 5.8493 *expc( 7.2756 *t/( 225.00 +t )) : TXT( 4)=""+Pws+" [1] 100〜150 VAISALA" Pws= 6.2301 *expc( 7.3033 *t/( 230.00 +t )) : TXT( 5)=""+Pws+" [1] 150〜180 VAISALA" Pws= 6.1100 *expc( 9.5000 *t/( 265.50 +t )) : TXT( 6)=""+Pws+" [1] <0 Tetens 霜点温度用" Pws= 6.1100 *expc( 7.5000 *t/( 237.30 +t )) : TXT( 7)=""+Pws+" [1] >0 Tetens" Pws= 6.1100 *expc( 7.5000 *t/( 240.90 +t )) : TXT( 8)=""+Pws+" [1] ??? ???" Pws= 6.1100 *expn( 17.2700 *t/( 237.30 +t )) : TXT( 9)=""+Pws+" [2] ??? FAO" Pws= 6.1100 *expn( 17.5020 *t/( 240.90 +t )) : TXT(10)=""+Pws+" [2] ??? ???" Pws= 6.1121 *expn( 17.5020 *t/( 240.90 +t )) : TXT(11)=""+Pws+" [2] ??? ???" Pws=expc( 8.2030 -( 1735.74 /( 234.00 +t))) : TXT(12)=""+Pws+" [3] ??? Antonie" ;============================================================ ;多項式 ;============================================================ A=0.0 A=T-(4.931358E-01)+(4.609430E-03)*T-(1.374645E-05)*exp(T,2)+(1.274321E-08)*exp(T,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(T,-1)-3.2136709-4.8640239E-02*T+4.1764768E-05*exp(T,2)-1.4452093E-08*exp(T,3)+6.5459673*logn(T) Pws=expn(A) : TXT(14)=""+Pws ; 氷と接する場合(0.01℃以下) A=0.0 A= -5.6745359E+03*exp(T,-1)+1.7873545-9.6778430E-03*T+6.2215701E-07*exp(T,2)+2.0747825E-09*exp(T,3)-9.4840240E-13*exp(T,4)+4.1635019*logn(T) Pws=expn(A) : TXT(15)=""+Pws ;第一科学 ; 水と接する場合(0.01℃以上) A=0.0 A= -6.0969385E+03*exp(T,-1)+1.6635794E+01-2.711193E-02*T+1.673952E-05*exp(T,2)+2.433502*logn(T) Pws=expn(A) : TXT(16)=""+Pws ; 氷と接する場合(0.01℃以下) A=0.0 A= -6.0245282E+03*exp(T,-1)+2.47218998E+01+1.0613863E-02*T-1.3198825E-05*exp(T,2)-4.9382577E-01*logn(T) Pws=expn(A) : TXT(17)=""+Pws ; (蒸気100−374℃) A=0.0 : B=1.0-T/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/T+12.30428868 Pws=expn(A) : TXT(18)=""+Pws ;書名不明(手塚俊一・野路伸治・古杉豊 書) ; 水と接する場合(0.01℃以上) A=0.0 : B=1.0-T/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/T 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



774

リンク

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



GENKI

リンク

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/18(Wed) 16:11:16|NO.73100

>>てれてれさん
わーすごい。
実は前にこういうの作りたかったんですよね。
桜の紙吹雪に最適ですね。
どうでもいいですけどマウスを貫通させるプログラムも追加すると応用の幅が広がりそう。
http://hsp.tv/play/pforum.php?mode=pastwch&num=53280



Snake

リンク

2015/11/18(Wed) 21:09:03|NO.73107

3DSで作っていた,簡単なグラデーションを表示したり,保存できる
「グラフィカル クリエーター」の簡易版を簡単に作ってみました。
http://seatex.webcrow.jp/embed/source/gradesion.hsp



KA

リンク

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



Noap

リンク

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さん
え・・・え?・・・
mjk・・・



Matukin

リンク

2015/11/21(Sat) 20:53:57|NO.73173

今思ったんだけどこのスレッドって何に使うの?
意味ないと思う。
なんか企んでいるの?
教えて。



KA

リンク

2015/11/21(Sat) 23:52:49|NO.73180

>>今思ったんだけどこのスレッドって何に使うの?
いや「何に使う?」じゃなくて、何に使うか使えるかは見た人が
判断するスレです。

>>意味ないと思う。
まあ最終的には流れて埋もれちゃうので・・・・。

>>なんか企んでいるの?
実は国家転覆を企てています。



GENKI

リンク

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


> 意味ないと思う。
すでの私のスクリプトを人に見せたい欲を満足するために役立ちました!
また自分では絶対使うことないだろうなと思って他の方のスクリプトを眺めていますが、それでも何かのきっかけで必要になった時は過去ログからこのスレ検索するんだろうと思います。
どこで何が役に立つかわからないものです。


> なんか企んでいるの?
ここだけの話、世界征服を企てています。



Noap

リンク

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 "解放しました"


朝からちょっと面白いモジュールとそのサンプルをつくったのですがこのスレッドに投稿できるほどのスクリプトかどうか分かりません。
自分の前の投稿を見ていると変なスクリプトを投稿していたりしてはずかしくなりました。

わたしは万が一にでも誰かの目にとまってそして少しでも喜んだり、くすっと笑ってくれたりするのであればいいなと思います。誰かの目にとまるかも分かりませんし、ただの自己満足のスクリプトに過ぎないのかもしれません。でもそういう理由で投稿しています。



Noap

リンク

2015/11/22(Sun) 10:18:50|NO.73188

わざわざGlobalAllocを使っているのは簡略化のためです



Mituki

リンク

2015/11/22(Sun) 17:01:22|NO.73201

>>Snake
そうだねしときました!
フォローしますw



KA

リンク

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

何に使えるかというと、有り無しで管理するフラグデータを圧縮出来るぐらいです。
数値型なら32個の変数が1つに、文字列型なら確保されたバイト数の8倍が使えます。



GENKI

リンク

2015/11/23(Mon) 01:09:33|NO.73209

>>KAさん(NO.73203)
使い方のサンプルがないと使い方がよくわからないです。

こんな感じのこととは違うのかなと…。

;for HSP3 #module ;値bitsをw桁の2進表記の文字列に変換したものを返すモジュール。 #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



KA

リンク

2015/11/23(Mon) 07:25:06|NO.73210

>>こんな感じのこととは違うのかなと…。
ぎゃぎゃ、既出でしたか・・・。

でもバイト単位にしたのはエンディアンを考慮してバイナリレベルの
順番を合わせる目的で、とあるバイナリデータの解析に執念を燃やし
た古き良き時代の副産物です。



kanamaru

リンク

2015/11/23(Mon) 16:26:33|NO.73216

余計ではないと思います。
ただ、色分けを自動にして欲しい。
さらに欲を言うと、任意で、hsファイルやモジュール内で使う画像(たまにある)が投稿できるといい。
hsp用というのでしたら、このぐらいは必要かなと。
wiki系とも言っているので、厳しいかも知れませんが。



Noap

リンク

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 */



Noap

リンク

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



Noap

リンク

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 */



Noap

リンク

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 */



inovia

リンク

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



Noap

リンク

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



Noap

リンク

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



Noap

リンク

2015/11/28(Sat) 18:29:52|NO.73314

そんなに無理しておつくりくださらなくてもいいです

やはりコールバックモジュールは別のスレッドにしたほうがいいでしょうか

http://nopswebpages.webcrow.jp/apps/dialog22.txt
HSP2用モジュールをつくりました
標準のdialog命令より高機能なファイル保存および開くダイアログモジュール
マシン語をスクリプト内に配列として書くことによりモジュール単体で三種類のファイルダイアログを扱えます
はるか昔のダイアログ、普通のダイアログ、左側のツリー(場所バー)がないシンプルなダイアログの三種類を扱えます
拡張子分けがしやすいです

http://nopswebpages.webcrow.jp/apps/dialog2.txt
HSP3にも移植しました



Noap

リンク

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



Noap

リンク

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) */



kanamaru

リンク

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)



Noap

リンク

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 */



Noap

リンク

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



Noap

リンク

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



Noap

リンク

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



Noap

リンク

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



Noap

リンク

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



Snake

リンク

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



Noap

リンク

2015/12/15(Tue) 21:43:09|NO.73618

callfuncを再現したモジュール
http://nopswebpages.webcrow.jp/apps/calfnc2.txt

ecxレジスタに数字をいれられるcallfuncのようなモジュール
http://nopswebpages.webcrow.jp/apps/calfnc3.txt



774

リンク

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



KA

リンク

2016/1/1(Fri) 07:25:24|NO.73908

>>Noapさん
気持ちは分かりますが、新年早々無意味な投稿は控えた方が良いでしょう。

でもどうやってタイミングを合わせたの?
どこかでテストでもやったのかな?



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



Mula

リンク

2016/1/1(Fri) 16:48:16|NO.73920

>タイミングはたまたまです
嘘はつかない方が良いですよ。



Noap

リンク

2016/1/1(Fri) 18:07:05|NO.73922

ばれましたか。やはり嘘はつけません。確かに実は12時ちょうどの少し前に書きあがってせっかくなので12ちょうどに投稿しようと時計を合わせて待っていました。
便利そうなスクリプトになったと思ったので投稿しました。
今度からは嘘は書きこまないようにします。



Noap

リンク

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



Noap

リンク

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



Velgail

リンク

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



Velgail

リンク

2016/1/3(Sun) 21:59:11|NO.73973

補足:memset_int内のaの配列が16要素の理由はキャッシュラインサイズあたりに意図的にぶつけた形です。
ぶっちゃけ大した意味は無いのですが、この程度なら許容される遅延(16要素以下のフィル時)だろうと見積もった程度です。



ue_dai

リンク

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



Velgail

リンク

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の長さ変えたところ時間が伸びただけだった……だめじゃん。



Noap

リンク

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 */



Noap

リンク

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



Noap

リンク

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)



Noap

リンク

2016/1/9(Sat) 18:35:46|NO.74071

変数ポインタからクローン変数を作成するモジュール

http://hsp.tv/play/pforum.php?mode=all&num=72960#74015 のモジュールですが
よく考えるとわざわざ内部関数を呼ばなくてもPvalから直接取得すればいいのでそうするようにしました

このモジュールによりvarptrによるアドレスしか変数の情報がなくてもクローン変数を作成できます
配列の場合でもそのままクローン配列を作成できます

http://nopswebpages.webcrow.jp/apps/duppval.txt



スペース

リンク

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とか改行は非対応..." /****************/



Velgail

リンク

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



kanamaru

リンク

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関数の処理を適切に追加することで、対応できます。



kanamaru

リンク

2016/1/20(Wed) 17:59:41|NO.74212

上記モジュールについて
パブリックドメインとします。
また、モジュールを改良してくれる人がいたら、改良お願いします。
改良してほしい点は、
・上記であげた問題
・変数名が表示されない(というより取得方法がわからない。
 ネットで調べていくつかでてくるのですが、実行してみたところ
 取得できるのが謎の数字となっています。)



zero

リンク

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. 謎の数字…ポインタか何かじゃないですかね。



kanamaru

リンク

2016/1/20(Wed) 22:38:34|NO.74215

ありがとうございます。
明日試してみます。
教えてくれたソースを見て思ったのが、
今思うと、謎の数字って#cmpoptを記述してなかったからかも。



kanamaru

リンク

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 "プラットホームID  :"+OSVERSIONINFO.osver_dwPlatformId mes "CSDバージョン   :["+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 プラットホームID  :2 CSDバージョン   :[] HSPのsysinfo関数   :WindowsNT ver6.2 独自のGetVerString関数:Windows 8 【RtlGetVersion】 メジャー・バージョン :10 マイナー・バージョン :0 ビルド・ナンバー   :10586 プラットホームID  :2 CSDバージョン   :[] 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 //------------------------------------------------------------------------------



zero

リンク

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



Noap

リンク

2016/2/5(Fri) 05:55:04|NO.74454

HSPPRINTの互換モジュールを作り直しました
元のモジュールは破棄して一から作り直しました

http://nopswebpages.webcrow.jp/apps/hspprint/



Noap

リンク

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



Noap

リンク

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 //------------------------------------------------------------------------------



KA

リンク

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

このようにしないとエディットボックスに文字が入力できないので要注意。



Y_repeat(旧y.tack)

リンク

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さん
まじだ!全然気づかなかった。
ありがとうございますm(__)m



Noap

リンク

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)



Noap

リンク

2016/2/17(Wed) 18:54:41|NO.74642

URLをプロトコル名とドメイン名とポート番号とドキュメントパスに分けるだけのモジュール

http://nopswebpages.webcrow.jp/apps/garbage/parsurl.txt



cats

リンク

2016/2/17(Wed) 20:46:24|NO.74643

>NO.74606
どうでもいいですが、モンテカルロ法ですね。
結構な回数を試さないとなかなか近づかなかったと思います。



Noap

リンク

2016/2/19(Fri) 05:46:26|NO.74649

モンテカルロ法というのですか。教えていただきありがとうございます。



kanamaru

リンク

2016/2/25(Thu) 18:49:49|NO.74700

3項演算子みたいな動作をする関数です。

#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)



kanamaru

リンク

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)



Noap

リンク

2016/3/6(Sun) 22:00:32|NO.74802

最初から配列で取得できたほうが便利そうなのでわたしもかいてみました

コマンドラインパラメータリストを取得するモジュール
http://nopswebpages.webcrow.jp/apps/garbage/gcmdargs.txt



kanamaru

リンク

2016/3/6(Sun) 22:33:32|NO.74804

やっぱ書く人が書けば短く、わかりやすいプログラムになるんですね。
なるほど、配列として取得できるようにしたのですか。
確かにそっちの方が便利かも。



Noap

リンク

2016/3/7(Mon) 00:16:46|NO.74805

すみません
複数回呼ぶということをまったく考えていなかったのでメモリーリークをおこすバグがありました
なので__GetMainArgsは何度も呼ばないよう修正しました
それとkanamaruさんのスクリプトはよく見ていませんでしたがkanamaruさんのもメモリーリークをおこすので注意してください



GENKI

リンク

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



Noap

リンク

2016/3/8(Tue) 21:24:05|NO.74827

正規表現は難しくてよくわからないです
標準命令だけで起動オプションの取得をかきました
__GetMainArgsの動作をまねました

標準命令だけでコマンドラインパラメータリストを取得するモジュール
http://nopswebpages.webcrow.jp/apps/garbage/hcmdargs.txt



kanamaru

リンク

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



kanamaru

リンク

2016/3/10(Thu) 17:03:30|NO.74848

補足で、今投稿したモジュールのサンプルがほしかったら言ってください。



kanamaru

リンク

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



Noap

リンク

2016/3/16(Wed) 05:46:21|NO.74928

hscallbk.dll互換モジュール

http://nopswebpages.webcrow.jp/apps/hscallbk/



Noap

リンク

2016/3/16(Wed) 06:22:03|NO.74929

hspclでウィンドウ表示

hscallbk.dllプラグインとhscallbk.dll互換モジュールのどちらも使えるはずです

http://nopswebpages.webcrow.jp/apps/hscallbk/hspclwnd.txt



Noap

リンク

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



GENKI

リンク

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



Noap

リンク

2016/3/24(Thu) 05:43:26|NO.75053

インポートセクションからモジュールハンドルの取得とエクスポートセクションから関数アドレスの取得モジュール

インポートセクションから使用しているDLLのハンドルや、エクスポートセクションから関数アドレスを取得するためのモジュールです。

http://nopswebpages.webcrow.jp/apps/garbage/impexp.txt



Noap

リンク

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)



Noap

リンク

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)



GENKI

リンク

2016/3/25(Fri) 01:22:07|NO.75063

> #define ctype short2long(%1) ((%1 <<16) >> 16)

凄くシンプル!
恥ずかしながら「算術シフト」って初めて知りました。これは便利。
しかしどっちで動作しているのか明記されていないのは怖いですね。
今度から右シフト使う時は注意するようにしようっと。



GENKI

リンク

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)



Humi/bass_clef_

リンク

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 */



Noap

リンク

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



Humi/bass_clef_

リンク

2016/3/25(Fri) 23:58:05|NO.75074

あ、やらかしてしまったw
上記の 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とか、初期命令とかもたくさん書き換えているので
ほしいものだけ抜き出して勝手に新しくファイル作ってくださっても構いません
(粗大ごみ不法投棄してすみませんでしたw)



四葉

リンク

2016/3/28(Mon) 11:41:22|NO.75101

HSPコンテストなどに参加させていただきました
3Dアクションゲーム「ELECTRIC SHEEP」のソースを公開いたしました。
よろしければご利用ください。

http://yotsubacreation.up.seesaa.net/image/ESsource.zip

上記からダウンロードできない場合はこちらからどうぞ。

http://yotsubacreation.seesaa.net/article/435779988.html

*手違いで記事を消してしまいましたので、アドレスを修正後、
再投稿させていただきました。



kanamaru

リンク

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



Noap

リンク

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



Velgail

リンク

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))



Velgail

リンク

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
を一旦投稿します。(今回のソース等、このスレッド系統に投稿したソースは、元ソースの翻訳等でない限り
「遡及的に」パブリックドメイン等の最も自由なライセンスとします。もうなってるはずだけど、念のため)



Velgail

リンク

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になりうると認識してください。

注意:なんかバグってる可能性あり。出力結果が一部本家と異なる。なんでかはわからなかった。解析して訂正してください。



motchy

リンク

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



kanamaru

リンク

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



GENKI

リンク

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)))



GENKI

リンク

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))
とさり気なく余計なものも混ぜてみる。



same

リンク

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 "処理1計測中" wait 40 av1 = -d3timer() repeat 処理回数 //処理内容1// a = MSB1(cnt) ////////////// loop av1 += d3timer() - looptime mes "処理2計測中" wait 40 av2 = -d3timer() repeat 処理回数 //処理内容2// a = MSB2(cnt) ////////////// loop av2 += d3timer() - looptime mes "処理3計測中" wait 40 av3 = -d3timer() repeat 処理回数 //処理内容2// a = MSB3(cnt) ////////////// loop av3 += d3timer() - looptime mes "処理4計測中" wait 40 av4 = -d3timer() repeat 処理回数 //処理内容2// 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"



Velgail

リンク

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
バイナリーデータが叩きこまれたら挙動が怪しいとかそういう話もありますが…… 勘弁して下さいっ



Velgail

リンク

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側のデータの中に","がある場合、「出力結果が」壊れるので注意。(壊れるというか、意図通りにならない?



K-s

リンク

2016/6/19(Sun) 20:33:35|NO.75912

マルチディスプレイが気になったのでスクリプト書いてみました。
マルチディスプレイの人どれくらい居るんでしょう。

マルチディスプレイで解像度などの情報を取得する
http://uchitsukushi2.hatenablog.jp/entry/2016/06/18/193319

特定のディスプレイの解像度を変更する
http://uchitsukushi2.hatenablog.jp/entry/2016/06/19/192459



GENKI

リンク

2016/6/19(Sun) 23:59:07|NO.75916

> CSVファイルのフォーマット指定はこれです。ものぐさなので、ちゃんとしたパーサーしてません。

こんなのあるので参考にどうぞ。

HSP開発wiki - String/CSV形式データの読み込み
http://wiki.hsp.moe/String%EF%BC%8FCSV%E5%BD%A2%E5%BC%8F%E3%83%87%E3%83%BC%E3%82%BF%E3%81%AE%E8%AA%AD%E3%81%BF%E8%BE%BC%E3%81%BF.html



jsAster

リンク

2016/6/22(Wed) 22:00:40|NO.75954




SquidSky

リンク

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



YOS G-spec

リンク

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



kanahiron

リンク

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



pici

リンク

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



GENKI

リンク

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を使わない負の方向へ丸めその2
ネットで調べたら、こういうアルゴリズムもあるみたい。

#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, "長さ6以上の文字列: " 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, "重複消去: "
かっこいい
少しは役に立つかも



motchy

リンク

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



Yuuki

リンク

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



ONION software Copyright 1997-2018(c) All rights reserved.