HSP3のスクリプトを垂れ流すブログ

花火ゲーム（やわらかライセンス）2009

2009-06-28T13:35:00.004+09:00

（　゜ワ゜）ノさん原案、eller改造のミニゲーム。

2008年版から若干改良され、コンボ機能が付きました。連続してHANABIを取るとスコアアップ！高機能を目指したスリリングな展開を楽しめます。

/* HANABIGA @ やわらかライセンス by eller 2009/06/28
 * ===============================================
 * HANABIGAからの改造個所：
 *     コンボの導入
 * SAKURAGAからの改造個所：
 *     "さくら" → "たまや"       // "かぎや"でも良い
 *     キャラクタの移動動作変更（ちょい簡単に）
 *     背景色など色合い変更
 *     ゲームオーバー中はキャラクタを生成しないように
 *     キャラクタ接触時にどかーん
 *     ゲームオーバー時にどかーん
 *     redraw 0 と redraw 1 を入れ替え
 *     randomize追加
 *     640 → ginfo_winx など
 */

//#runtime "hsplet3"
#include "hspmath.as"
#packopt name "hanabiga"

#define FRAME_WAIT          16

#define PLAYER_SPEED        3.0
#define PLAYER_SP_REDUCE    0.8

#define CHAR_MAX            256
#define HANABI_MAX          8

#define CHAR_TYPE_NONE      0
#define CHAR_TYPE_SA        1
#define CHAR_TYPE_KU        2
#define CHAR_TYPE_RA        3

#define CHAR_FACE_SA        "た"
#define CHAR_FACE_KU        "ま"
#define CHAR_FACE_RA        "や"
#define CHAR_FACE_HANABI    "・"

#define HANABI_PARTS_NUM    14

#define CHAR_ROT_SP         0.05
#define CHAR_ROT_MOVE       0.8

#define CHAR_SIZE           16.0

#define COMBO_TIME_MAX      60

// 準備
;   screen 0, 480, 320
    title "HANABIGA 2009"
    font "ＭＳ ゴシック" ,16,1
    randomize

    player_x = double(ginfo_winx / 2)
    player_y = double(ginfo_winy / 2)
    player_vx = 0.0
    player_vy = 0.0

    dim char_type,CHAR_MAX
    ddim char_x,CHAR_MAX
    ddim char_y,CHAR_MAX
    ddim char_vx,CHAR_MAX
    ddim char_vy,CHAR_MAX
    dim char_timer,CHAR_MAX

    ddim hanabi_x,HANABI_MAX
    ddim hanabi_y,HANABI_MAX
    dim hanabi_radius,HANABI_MAX
    dim hanabi_life,HANABI_MAX
    dim hanabi_life_max,HANABI_MAX
    dim hanabi_r,HANABI_MAX
    dim hanabi_g,HANABI_MAX
    dim hanabi_b,HANABI_MAX

    buffer 1,640,480
    repeat 40
        color cnt, 0, cnt * 2
        boxf 0 , cnt * ginfo_winy / 40 , ginfo_winx , (cnt + 1) * ginfo_winy / 40
    loop

    gsel 0
    gmode 3,,,64

// メイン処理

repeat
    // INIT
    gosub *initpl
    // タイトル
    repeat
        redraw 0
        gosub *clearscreen
        gosub *movehanabi
        gosub *movechar
        gosub *collision
        if(player_life > 0){
            gosub *moveplayer

            a = 10 - (player_score / 5) \ 10
            if( a < 2 ) : a = 1
            if(player_timer \ a  == 0) : gosub *addchar
        }else{
            gosub *burstall
            color 255, 255, 255
            pos (ginfo_winx - 198)/ 2, (ginfo_winy - 16) / 2
            mes "H A N A B I  O W A T A"

            stick inp
            if(inp & 16) : break
        }

        gosub *showstatus

        redraw 1
        await FRAME_WAIT
    loop
loop




*initpl
    player_x = double(ginfo_winx / 2)
    player_y = double(ginfo_winy / 2)
    player_vx = 0.0
    player_vy = 0.0
    player_life = 1
    player_chain_type = CHAR_TYPE_SA
    player_score = 0
    player_combo = 0

    combo_time = 0

    scroll_vx = 0.01
    scroll_vy = -2.0

    repeat CHAR_MAX
        char_type(cnt) = CHAR_TYPE_NONE
    loop
    return

*clearscreen
    pos 0,0
    gcopy 1,0,0,ginfo_winx, ginfo_winy
    return

*moveplayer
    stick inp,255

    if(inp & 1) : player_vx -= PLAYER_SPEED
    if(inp & 2) : player_vy -= PLAYER_SPEED
    if(inp & 4) : player_vx += PLAYER_SPEED
    if(inp & 8) : player_vy += PLAYER_SPEED
    player_timer++

    player_vx *= PLAYER_SP_REDUCE
    player_vy *= PLAYER_SP_REDUCE

    player_x = limitf(player_x + player_vx, 0.0, ginfo_winx - CHAR_SIZE)
    player_y = limitf(player_y + player_vy, 0.0, ginfo_winy - CHAR_SIZE)
    
    color 255
    pos player_x,player_y
    if( player_chain_type == CHAR_TYPE_SA ){
        mes CHAR_FACE_SA
    } else : if( player_chain_type == CHAR_TYPE_KU ){
        mes CHAR_FACE_KU
    } else : if( player_chain_type == CHAR_TYPE_RA ){
        mes CHAR_FACE_RA
    }

    if (combo_time > 0) : combo_time-- : else : player_combo = 0
    return

*collision
    repeat CHAR_MAX
        if( char_type(cnt) == CHAR_TYPE_NONE ) : continue

        dx = player_x - char_x(cnt)
        dy = player_y - char_y(cnt)
        if( abs(dx) < CHAR_SIZE & abs(dy) < CHAR_SIZE ) {
            if( char_type(cnt) == player_chain_type ){
                player_chain_type++
                if(player_chain_type > CHAR_TYPE_RA){
                    player_chain_type = CHAR_TYPE_SA
                }

                if (combo_time > 0) {
                    player_combo++
                }
                player_score += 10 + player_combo
                combo_time = COMBO_TIME_MAX
            }else{
                player_life--
            }
            char_type(cnt) == CHAR_TYPE_NONE
            x = char_x(cnt)
            y = char_y(cnt)
            gosub *addhanabi
        }
    loop
    return

*movechar
    color 255,128
    repeat CHAR_MAX
        if( char_type(cnt) == CHAR_TYPE_NONE ) : continue

        pos char_x(cnt) , char_y(cnt) 
        char_x(cnt) += char_vx(cnt)
        char_y(cnt) += char_vy(cnt)

        char_timer(cnt)++
        char_x(cnt) += CHAR_ROT_MOVE * sin(double(CHAR_ROT_SP * char_timer(cnt)))
        char_y(cnt) += CHAR_ROT_MOVE ;* cos(double(CHAR_ROT_SP * char_timer(cnt)))

        if( char_y(cnt) < -16.0 ) : char_type(cnt) = CHAR_TYPE_NONE

        if( char_type(cnt) == CHAR_TYPE_SA ){
            mes CHAR_FACE_SA
        } else : if( char_type(cnt) == CHAR_TYPE_KU ){
            mes CHAR_FACE_KU
        } else : if( char_type(cnt) == CHAR_TYPE_RA ){
            mes CHAR_FACE_RA
        }
    loop
    return

*addchar
    repeat CHAR_MAX
        if( char_type(cnt) != CHAR_TYPE_NONE ) : continue

        char_type(cnt) = 1 + rnd(3)
        char_x(cnt) = double(rnd(800) - 80)
        char_y(cnt) = 20.0 + ginfo_winy
        char_vx(cnt) = scroll_vx
        char_vy(cnt) = scroll_vy
        char_timer(cnt) = rnd(256)
        break
    loop
    return

*showstatus
    pos ginfo_winx - 160 , ginfo_winy - 40
    color 255, 255, 255
    mes strf("SCORE : %8d", player_score)
    mes strf("COMBO : %8d", player_combo)
    return


#const HANABI_CST 2.0 * M_PI / HANABI_PARTS_NUM
*movehanabi
    repeat HANABI_MAX
        if( hanabi_life(cnt) <= 0 ) : continue

        hanabi_life(cnt)--
        color hanabi_r(cnt), hanabi_g(cnt), hanabi_b(cnt)
        ; hanabi_y(up_cnt)++
        up_cnt = cnt
        r = cos(M_PI * hanabi_life(cnt) / hanabi_life_max(cnt) / 2.0) * hanabi_radius(cnt)
        repeat HANABI_PARTS_NUM
            pos hanabi_x(up_cnt) + cos(HANABI_CST * cnt) * r, hanabi_y(up_cnt) + sin(HANABI_CST * cnt) * r
            mes CHAR_FACE_HANABI
        loop
    loop
    return

*addhanabi
    result = 0
    repeat HANABI_MAX
        if( hanabi_life(cnt) > 0 ) : continue

        hanabi_x(cnt) = x
        hanabi_y(cnt) = y

        size = 10 + rnd(12)
        hanabi_life_max(cnt) = size
        hanabi_life(cnt)     = size
        hanabi_radius(cnt)   = size * 3

        hsvcolor rnd(192), 255, 255
        hanabi_r(cnt) = ginfo_r
        hanabi_g(cnt) = ginfo_g
        hanabi_b(cnt) = ginfo_b

        result = 1
        break
    loop
    return result

*burstall
    repeat CHAR_MAX
        if( char_type(cnt) = CHAR_TYPE_NONE ) : continue

        x = char_x(cnt)
        y = char_y(cnt)
        gosub *addhanabi
        if stat : char_type(cnt) = CHAR_TYPE_NONE
    loop
    return

Online HSP Document Libraryをワンキーヘルプとして使う

2008-06-07T10:15:00.002+09:00

ちょいネタ。
このスクリプトをから作成できる実行ファイルを既存のhelpman.exeと置き換えることで、Online HSP Document Libraryをワンキーヘルプとして利用できます。
実行ファイルの作成はctrl+F9の「実行ファイル自動作成」を利用してください。

#packopt name "helpman"
#packopt hide 1
    exec "http://www.onionsoft.net/hsp/ref/ohdl.cgi?cmd=hdsrch&arg="+dir_cmdline, 16
    end

自力型変換（int⇔str）

2008-05-17T00:06:00.006+09:00

整数値と文字列を相互に変換します。HSPでは特に気にせず利用できる機能ですが、自力でやると結構面白いものです。

数値の桁数を計算するためにHSPMathのlog10関数を使用。おまけとしてTrim関数がついてます。

2008.05.17 memcpyをなくすことで計量化

// 自力で型変換
//     2008.05.17 計量化
#module
#include "hspmath.as"
// 文字列の始めと終わりにある半角スペースを除去
#defcfunc Trim str s, local target, local target_length, local result
    target = s
    target_length = strlen( target )
    repeat target_length
        start_idx = cnt
        if peek( target, start_idx ) != ' ' : break
    loop
    repeat target_length, 1
        end_idx = target_length - cnt
        if peek( target, end_idx ) != ' ' : break
    loop
    result = strmid( target, start_idx, end_idx + 1 - start_idx )
    return result

#define ctype not_digit(%1) ((%1) < '0' | '9' < (%1))

// 文字列を整数値に変換
#defcfunc str2int str s, local target, local result, local target_length
    result = 0
    target = Trim( s )
    if peek( target ) = '-' : sign = -1 : else : sign = 1
    if peek( target ) = '-' | peek( target ) = '+' {
        target = strmid( target, 1, strlen( target ) - 1 )
    }
    target_length = strlen( target )

    for i, iStart, target_length
        if not_digit( peek( target, i ) ) : _break
        result = result * 10 + peek( target, i ) - '0'
    next
    return result * sign

// 整数値を文字列に変換
#defcfunc int2str int p, local target, local result, local result_length
    if p = 0 : return "0"

    target = abs( p )
    result_length = 1 + log10( target ) + ( p < 0 )
    sdim result, result_length + 1
    repeat 1 + log10( target ), 1
        poke result, result_length - cnt, ( target \ 10 ) + '0'
        target /= 10
    loop
    if p < 0 {
        poke result, 0, '-'
    }
    return result
#global

花火ゲーム（やわらかライセンス）

2008-04-19T11:20:00.002+09:00

（　゜ワ゜）ノさん原案、eller改造のミニゲーム。

このスクリプトはやわらかライセンスのもとで、自由に改造・配布が可能です。

/* HANABIGA @ やわらかライセンス by eller 2008/04/19
 * ===============================================
 * SAKURAGAからの改造個所：
 *     "さくら" → "たまや"       // "かぎや"でも良い
 *     キャラクタの移動動作変更（ちょい簡単に）
 *     背景色など色合い変更
 *     ゲームオーバー中はキャラクタを生成しないように
 *     キャラクタ接触時にどかーん
 *     ゲームオーバー時にどかーん
 *     redraw 0 と redraw 1 を入れ替え
 *     randomize追加
 *     640 → ginfo_winx など
 */

//#runtime "hsplet3"
#include "hspmath.as"
#packopt name "hanabiga"

#define FRAME_WAIT          16

#define PLAYER_SPEED        3.0
#define PLAYER_SP_REDUCE    0.8

#define CHAR_MAX            256
#define HANABI_MAX          8

#define CHAR_TYPE_NONE      0
#define CHAR_TYPE_SA        1
#define CHAR_TYPE_KU        2
#define CHAR_TYPE_RA        3

#define CHAR_FACE_SA        "た"
#define CHAR_FACE_KU        "ま"
#define CHAR_FACE_RA        "や"
#define CHAR_FACE_HANABI    "・"

#define HANABI_PARTS_NUM    14

#define CHAR_ROT_SP         0.05
#define CHAR_ROT_MOVE       0.8

#define CHAR_SIZE           16.0

// 準備
;   screen 0, 480, 320
    title "SAKURAGA 2008"
    font "ＭＳ ゴシック" ,16,1
    randomize

    player_x = double(ginfo_winx / 2)
    player_y = double(ginfo_winy / 2)
    player_vx = 0.0
    player_vy = 0.0

    dim char_type,CHAR_MAX
    ddim char_x,CHAR_MAX
    ddim char_y,CHAR_MAX
    ddim char_vx,CHAR_MAX
    ddim char_vy,CHAR_MAX
    dim char_timer,CHAR_MAX

    ddim hanabi_x,HANABI_MAX
    ddim hanabi_y,HANABI_MAX
    dim hanabi_radius,HANABI_MAX
    dim hanabi_life,HANABI_MAX
    dim hanabi_life_max,HANABI_MAX
    dim hanabi_r,HANABI_MAX
    dim hanabi_g,HANABI_MAX
    dim hanabi_b,HANABI_MAX

    buffer 1,640,480
    repeat 40
        color cnt, 0, cnt * 2
        boxf 0 , cnt * ginfo_winy / 40 , ginfo_winx , (cnt + 1) * ginfo_winy / 40
    loop

    gsel 0
    gmode 3,,,64

// メイン処理

repeat
    // INIT
    gosub *initpl
    // タイトル
    repeat
        redraw 0
        gosub *clearscreen
        gosub *movehanabi
        gosub *movechar
        gosub *collision
        if(player_life > 0){
            gosub *moveplayer

            a = 10 - (player_score / 5) \ 10
            if( a < 2 ) : a = 1
            if(player_timer \ a  == 0) : gosub *addchar
        }else{
            gosub *burstall
            color 255, 255, 255
            pos (ginfo_winx - 198)/ 2, (ginfo_winy - 16) / 2
            mes "H A N A B I  O W A T A"

            stick inp
            if(inp & 16) : break
        }

        gosub *showstatus

        redraw 1
        await FRAME_WAIT
    loop
loop




*initpl
    player_x = double(ginfo_winx / 2)
    player_y = double(ginfo_winy / 2)
    player_vx = 0.0
    player_vy = 0.0
    player_life = 1
    player_chain_type = CHAR_TYPE_SA
    player_score = 0

    scroll_vx = 0.01
    scroll_vy = -2.0

    repeat CHAR_MAX
        char_type(cnt) = CHAR_TYPE_NONE
    loop
    return

*clearscreen
    pos 0,0
    gcopy 1,0,0,ginfo_winx, ginfo_winy
    return

*moveplayer
    stick inp,255

    if(inp & 1) : player_vx -= PLAYER_SPEED
    if(inp & 2) : player_vy -= PLAYER_SPEED
    if(inp & 4) : player_vx += PLAYER_SPEED
    if(inp & 8) : player_vy += PLAYER_SPEED
    player_timer++

    player_vx *= PLAYER_SP_REDUCE
    player_vy *= PLAYER_SP_REDUCE

    player_x = limitf(player_x + player_vx, 0.0, ginfo_winx - CHAR_SIZE)
    player_y = limitf(player_y + player_vy, 0.0, ginfo_winy - CHAR_SIZE)
    
    color 255
    pos player_x,player_y
    if( player_chain_type == CHAR_TYPE_SA ){
        mes CHAR_FACE_SA
    } else : if( player_chain_type == CHAR_TYPE_KU ){
        mes CHAR_FACE_KU
    } else : if( player_chain_type == CHAR_TYPE_RA ){
        mes CHAR_FACE_RA
    }
    return

*collision
    repeat CHAR_MAX
        if( char_type(cnt) == CHAR_TYPE_NONE ) : continue

        dx = player_x - char_x(cnt)
        dy = player_y - char_y(cnt)
        if( abs(dx) < CHAR_SIZE & abs(dy) < CHAR_SIZE ) {
            if( char_type(cnt) == player_chain_type ){
                player_chain_type++
                if(player_chain_type > CHAR_TYPE_RA){
                    player_chain_type = CHAR_TYPE_SA
                }

                player_score++
            }else{
                player_life--
            }
            char_type(cnt) == CHAR_TYPE_NONE
            x = char_x(cnt)
            y = char_y(cnt)
            gosub *addhanabi
        }
    loop
    return

*movechar
    color 255,128
    repeat CHAR_MAX
        if( char_type(cnt) == CHAR_TYPE_NONE ) : continue

        pos char_x(cnt) , char_y(cnt) 
        char_x(cnt) += char_vx(cnt)
        char_y(cnt) += char_vy(cnt)

        char_timer(cnt)++
        char_x(cnt) += CHAR_ROT_MOVE * sin(double(CHAR_ROT_SP * char_timer(cnt)))
        char_y(cnt) += CHAR_ROT_MOVE ;* cos(double(CHAR_ROT_SP * char_timer(cnt)))

        if( char_y(cnt) < -16.0 ) : char_type(cnt) = CHAR_TYPE_NONE

        if( char_type(cnt) == CHAR_TYPE_SA ){
            mes CHAR_FACE_SA
        } else : if( char_type(cnt) == CHAR_TYPE_KU ){
            mes CHAR_FACE_KU
        } else : if( char_type(cnt) == CHAR_TYPE_RA ){
            mes CHAR_FACE_RA
        }
    loop
    return

*addchar
    repeat CHAR_MAX
        if( char_type(cnt) != CHAR_TYPE_NONE ) : continue

        char_type(cnt) = 1 + rnd(3)
        char_x(cnt) = double(rnd(800) - 80)
        char_y(cnt) = 20.0 + ginfo_winy
        char_vx(cnt) = scroll_vx
        char_vy(cnt) = scroll_vy
        char_timer(cnt) = rnd(256)
        break
    loop
    return

*showstatus
    pos ginfo_winx - 120 , ginfo_winy - 20
    color 255, 255, 255
    mes "SCORE : " + player_score
    
    return


#const HANABI_CST 2.0 * M_PI / HANABI_PARTS_NUM
*movehanabi
    repeat HANABI_MAX
        if( hanabi_life(cnt) <= 0 ) : continue

        hanabi_life(cnt)--
        color hanabi_r(cnt), hanabi_g(cnt), hanabi_b(cnt)
        ; hanabi_y(up_cnt)++
        up_cnt = cnt
        r = cos(M_PI * hanabi_life(cnt) / hanabi_life_max(cnt) / 2.0) * hanabi_radius(cnt)
        repeat HANABI_PARTS_NUM
            pos hanabi_x(up_cnt) + cos(HANABI_CST * cnt) * r, hanabi_y(up_cnt) + sin(HANABI_CST * cnt) * r
            mes CHAR_FACE_HANABI
        loop
    loop
    return

*addhanabi
    result = 0
    repeat HANABI_MAX
        if( hanabi_life(cnt) > 0 ) : continue

        hanabi_x(cnt) = x
        hanabi_y(cnt) = y

        size = 10 + rnd(12)
        hanabi_life_max(cnt) = size
        hanabi_life(cnt)     = size
        hanabi_radius(cnt)   = size * 3

        hsvcolor rnd(192), 255, 255
        hanabi_r(cnt) = ginfo_r
        hanabi_g(cnt) = ginfo_g
        hanabi_b(cnt) = ginfo_b

        result = 1
        break
    loop
    return result

*burstall
    repeat CHAR_MAX
        if( char_type(cnt) = CHAR_TYPE_NONE ) : continue

        x = char_x(cnt)
        y = char_y(cnt)
        gosub *addhanabi
        if stat : char_type(cnt) = CHAR_TYPE_NONE
    loop
    return

文字列のセンタリング

2008-03-29T23:17:00.003+09:00

どう書く？orgより。
文字列の長さに応じて、ifで分岐しています。もっとスマートに記述できないものでしょうか？

/*
    どう書く?org より
        文字列のセンタリング
        http://ja.doukaku.org/87/
*/

#runtime "hsp3cl"
#module
#defcfunc spaces int len
    if len <= 0 : return ""

    sdim s, len + 1
    repeat len
        poke s, cnt, ' '
    loop
    return s

#defcfunc centered_text str target, int len
    if len <= 0 : return ""

    target_length = strlen(target)
    result = target
    if target_length < len {
        result = spaces((len - target_length)/2) + target + spaces((len - target_length + 1)/2)
    } else : if target_length > len {
        result = strmid(result, (target_length - len)/2, len)
    }
    return result
#global

    s = "*"
    repeat 10
        mes centered_text(s, 15)
        s += " *"
    loop
    stop

追記。
ifによる条件分岐をlimit関数に置き換えました。

/*
    どう書く?org より
        文字列のセンタリング
        http://ja.doukaku.org/87/
*/
#runtime "hsp3cl"

#module
#defcfunc centered_text str _source, int len
    if len <= 0 : return ""
    source = _source

    source_strlen = strlen(source)
    sdim result, len + 1
    memset result, ' ', len
    poke result, limit((len - source_strlen)/2, 0, len/2), strmid(source, limit((source_strlen - len)/2, 0, source_strlen), len)
    return result
#global

    s = "*"
    repeat 10
        mes centered_text(s, 15)
        s += " *"
    loop
    stop

HSP入門者向け講座リンク集更新

2008-03-18T22:48:00.008+09:00

クロノス・クラウンにてHSP入門者向け講座リンク集が更新されました。HSP関連サイトを横断的に検索できるサービスも追加されています。

なお、当ブログは難易度中～高と評価されています。

関連

http://crocro.com/news/20080316183006.html

はてなスターを設置しました

2008-03-06T10:52:00.003+09:00

動作確認用のテスト投稿です。

日数計算・曜日計算

2008-03-01T19:12:00.007+09:00

COMを利用した、日付を扱うモジュールです。

指定した日の曜日を算出する関数と、指定した2つの日の差（日数）を算出する関数を含んでいます。
日数算出は「あと何日あるか」を算出するので、このサンプルプログラムのように「全部で何日か」を計算する場合は1を足す必要があります。

/*
    日付を扱うライブラリになりそうなもの。
    ※ 注意！パラメータチェック＆エラーチェック処理未実装！

    参考：http://tsu.sakura.ne.jp/article/note/eid512.html
*/

#module
// ミリ秒を日に変換
#define ctype cnvMsec2Day(%1) int((%1)/86400000)  // 86400000 = 1000*60*60*24
// javascript数式の計算
#defcfunc jsEval str jsExp
    if vartype(mssc) != vartype("comobj") {
        newcom mssc, "MSScriptControl.ScriptControl"
        comres result
        mssc("Language") = "JScript"
    }
    mssc -> "Eval" jsExp
    return result
// 曜日を返す（0～6）
#defcfunc getDayOf int y, int m, int d
    return int(jsEval("(new Date(" + y + "," + (m - 1) + "," + d + ")).getDay();"))
// 時間差を日数で返す
#defcfunc getSub int y1, int m1, int d1, int y2, int m2, int d2
    return cnvMsec2Day(jsEval("Date.UTC(" + y2 + "," + (m2 - 1) + "," + d2 + ") - Date.UTC(" + y1 + "," + (m1 - 1) + "," + d1 + ");"))
#global

// モジュールここまで
    day = "日", "月", "火", "水", "木", "金", "土"
    mes "今年は" + (1 + getSub( gettime(0), 1, 1, gettime(0), 12, 31 )) + "日間です"
    mes "今日は" + day( getDayOf( gettime(0), gettime(1), gettime(3) ) ) + "曜日です"
    stop

アンドゥや再生ができるペイントツール

2008-02-12T13:49:00.001+09:00

GoFのCommandパターンにヒントを得て作成。
描画した履歴を文字列型配列変数に記録しておき、必要に応じて取り出します。
今回は単純な文字列型配列変数ではなく、スタックのモジュールを用意してみました。

bregexp.dll（bregonig.dll）および月影ともさんのbregexp.hspが必要です。

// 文字列用スタック
#module string_stack stack, max
#modinit
    max = 0
    sdim stack, 32, 10
    return
#deffunc new_sstack array v
    newmod v, string_stack@
    return
#modfunc push str s
    stack(max) = s
    max++
    return
#defcfunc pop modvar string_stack@
    if max == 0 {
        logmes "引数の値が異常です。"
        return ""
    }
    max--
    return stack(max)
#defcfunc get_length modvar string_stack@
    return max
#defcfunc get_last modvar string_stack@
    return stack(max-1)
#defcfunc get_at modvar string_stack@, int index
    if index < 0 || max <= index {
        logmes "引数の値が異常です。"
        return ""
    }
    return stack(index)
#modfunc clear_stack
    max = 0
    return
#global

// 矩形の塗りつぶし
// http://rpen.blogspot.com/2007/11/blog-post.html
#include "gdi32.as"
#module
#const FLOODFILLSURFACE 1
#deffunc fill int x, int y
    current_color = ginfo_r, ginfo_g, ginfo_b
    CreateSolidBrush (ginfo_b << 16) | (ginfo_g << 8) | ginfo_r
    if stat {
        hBrush = stat
    } else {
        dialog "ブラシの生成に失敗しました。プログラムを終了します。", 1
        end
    }
    SelectObject hDC, hBrush
    pget x, y
    ExtFloodFill hdc, x, y, (ginfo_b << 16) | (ginfo_g << 8) | ginfo_r, FLOODFILLSURFACE
    DeleteObject hBrush
    color current_color(0), current_color(1), current_color(2)
    return
#global

// 命令を解析して描画するモジュール
#include "bregexp.hsp"
#module drawer
#define ctype result(%1) int(_result(%1))
#deffunc draw str _cmd
    cmd = _cmd
    BSplit _result, cmd, "m/[ ,]+/"
    switch _result(0)
        case "moveTo" : pos result(1), result(2) : swbreak
        case "lineTo" : line result(1), result(2) : swbreak
        case "color"  : color result(1), result(2), result(3) : swbreak
        case "fill"   : fill result(1), result(2) : redraw 1 : swbreak
        default : logmes "未知の命令です" : swbreak
    swend
    return
#deffunc draw_all array cmds, int wait_time
    redraw 0
    color 255, 255, 255 : boxf
    color
    repeat get_length(cmds)
        draw get_at(cmds, cnt)
        if wait_time {
            redraw 1
            wait wait_time
            redraw 0
        }
    loop
    redraw 1
    return
#global

#define push_and_do(%1,%2) push %1, %2 : draw %2

#define WM_MOUSEMOVE    $00000200
#define WM_LBUTTONDOWN  $00000201
#define WM_LBUTTONUP    $00000202
#define WM_RBUTTONDOWN  $00000204

*init
    title "左ドラッグで線を描画 / 右クリックで塗りつぶし"
    oncmd gosub *onLButtonDown, WM_LBUTTONDOWN
    oncmd gosub *onRButtonDown, WM_RBUTTONDOWN
    oncmd gosub *onLButtonUp, WM_LBUTTONUP
    oncmd gosub *onMouseMove, WM_MOUSEMOVE

    objsize 80
    button gosub "color change", *color_change
    button gosub "redraw slowly", *all_draw_slowly
    button gosub "clear", *clear
    button gosub "undo", *undo
    new_sstack cmds
    stop

// 色の変更
*color_change
    hsvcolor rnd(192), 255, 255
    push_and_do cmds, "color " + ginfo_r + "," + ginfo_g + "," + ginfo_b
    return
// 全消去
*clear
    clear_stack cmds
    draw_all cmds, 0
    return
// アンドゥ
*undo
    tmp = pop(cmds)
    draw_all cmds, 0
    return
// すべて描画
*all_draw
    draw_all cmds, 0
    return
// ゆっくりとすべて描画
*all_draw_slowly
    oncmd 0
    gosub *invalidate_buttons
    draw_all cmds, 4
    gosub *validate_buttons
    oncmd 1
    return
// 左ドラッグ開始
*onLButtonDown
    dragging = 1
    push_and_do cmds, "moveTo " + mousex + "," + mousey
    return
// 左ドラッグ終了
*onLButtonUp
    dragging = 0
    return
// 左ドラッグ中
*onMouseMove
    if dragging {
        push_and_do cmds, "lineTo " + mousex + "," + mousey
    }
    return
// 右クリック
*onRButtonDown
    if dragging == 0 {
        push_and_do cmds, "fill " + mousex + "," + mousey
    }
    return

#include "obj.as"
*invalidate_buttons
    repeat 4
        objgray cnt, 0
    loop
    return
*validate_buttons
    repeat 4
        objgray cnt, 1
    loop
    return

リストビューのソート

2008-02-09T09:36:00.000+09:00

リストビューのアイテムをLVM_SORTITEMSEXメッセージを使ってソートします。ちょくとさんのコールバック関数DLL「hscallbk.dll」が必要です。
リストビューのモジュールとしてもそこそこ利用できるかもしれません。

エクスプローラのように、「ヘッダ部分をクリックすると並び変わる」ようにもできるでしょう。（参考：http://hsp.tv/play/pforum.php?mode=pastwch&num=2749）

LVM_SORTITEMSEXメッセージの日本語情報は意外と少ないので、気が向いたら開発Wikiにフィードバックします。

// 参考資料：
//      リストビューを作成してみる
//          http://yokohama.cool.ne.jp/chokuto/urawaza/listview1.html
//      Windows32 API Constance 検索
//          http://hspnext.com/tool/hsptool04.htm
//      MSDN - LVM_SORTITEMSEX
//          http://msdn2.microsoft.com/ja-jp/library/bb761055(en-us).aspx
#module mod_listview
#include "hscallbk.as"
#uselib ""
#func sort_items "" int, int, int

#define LVM_SETITEM             $00001006
#define LVM_INSERTITEM          $00001007
#define LVM_INSERTCOLUMN        $0000101B
#define LVM_SORTITEMSEX         $00001051
#define LVM_GETITEMTEXTA        $0000102D
#define LVS_REPORT              $00000001
#define WS_EX_NOPARENTNOTIFY    $00000004
#define WS_VISIBLE              $10000000
#define WS_CHILD                $40000000

#deffunc make_listview
    if vartype(proc) != vartype("callback") : gosub *init
    winobj "SysListView32", "ListView", WS_EX_NOPARENTNOTIFY, WS_VISIBLE | WS_CHILD | LVS_REPORT, -1, -1
    return stat
*init
    setcallbk proc, sort_items, *sort_flag
    sdim name, 64, 2
    dim lvcolumn, 8
    dim lvitem, 6
    lvcolumn.0 = 0x000F
    lvcolumn.2 = 100
    lvitem.0 = 0x0001
    lvitem.6 = 64
    return

#deffunc add_column int id_list, str column_name, int index
    if(index < 0 | id_list < 0) {
        logmes "パラメータが不正です。"
        return -1
    }
    name = column_name
    lvcolumn.3 = varptr(name)
    sendmsg objinfo_hwnd(id_list), LVM_INSERTCOLUMN, index, varptr(lvcolumn)
    return stat

#deffunc add_item int id_list, array item, int index
    if(index < 0 | id_list < 0) {
        logmes "パラメータが不正です。"
        return -1
    }
    if vartype(item) != vartype("str") {
        logmes "配列変数の型が不正です。文字列型の変数を渡してください。"
        return -1
    }
    // アイテムの作成
    lvitem.1 = index
    lvitem.2 = 0
    lvitem.5 = varptr(item)
    sendmsg objinfo_hwnd(id_list), LVM_INSERTITEM, 0, varptr(lvitem)

    // サブアイテムの作成
    repeat length(item) - 1, 1
        lvitem.2 = cnt
        lvitem.5 = varptr(item(cnt))
        sendmsg objinfo_hwnd(id_list), LVM_SETITEM, 0, varptr(lvitem)
    loop
    return stat

#deffunc sort int id_list, int column, int vtype, int sortmode
    if(column < 0 | id_list < 0 | vtype < 0) {
        logmes "パラメータが不正です。"
        return -1
    }
    lvitem.2 = column
    var_type = vtype
    sendmsg objinfo_hwnd(id_list), LVM_SORTITEMSEX, sortmode, varptr(proc)
    return

#defcfunc local compareAsInt int id_list, int index1, int index2, int sortmode
    gosub *startCompare
    return int(name(sortmode & 1)) - int(name((sortmode & 1) ^ 1))

#defcfunc local compareAsStr int id_list, int index1, int index2, int sortmode
    gosub *startCompare
    return name(sortmode & 1) ! name((sortmode & 1) ^ 1)
    return

*startCompare
    lvitem.5 = varptr(name(0))
    sendmsg objinfo_hwnd(id_list), LVM_GETITEMTEXTA, index1, varptr(lvitem)
    lvitem.5 = varptr(name(1))
    sendmsg objinfo_hwnd(id_list), LVM_GETITEMTEXTA, index2, varptr(lvitem)
    return

// サブアイテム（ファイルサイズ）でソート
// 第3引数が0なら昇順、1なら降順
*sort_flag
    if var_type == vartype("int") {
        return compareAsInt@mod_listview(id_list, callbkarg(0), callbkarg(1), callbkarg(2))
    } else : if var_type == vartype("str") {
        return compareAsStr@mod_listview(id_list, callbkarg(0), callbkarg(1), callbkarg(2))
    }
    return 0

#global // end of mod_listview


// 疑似的な「ファイル」の数
#define NUM_FILES   10

    randomize
    gosub *createGuiObjects
    stop

// ボタンクリックによって呼び出されるサブルーチン
*sort_asc_by_name
    sort id_list, 0, vartype("str"), 0
    return
*sort_desc_by_name
    sort id_list, 0, vartype("str"), 1
    return
*sort_asc_by_size
    sort id_list, 1, vartype("int"), 0
    return
*sort_desc_by_size
    sort id_list, 1, vartype("int"), 1
    return

// ボタンとリストビューの作成
*createGuiObjects
    // ボタンを作成
    objsize ginfo_winx / 4, 32
    pos 0, 0 : button gosub "ファイル名で昇順にソート", *sort_asc_by_name
    pos ginfo_winx / 4, 0 : button gosub "ファイル名で降順にソート", *sort_desc_by_name
    pos ginfo_winx / 2, 0 : button gosub "ファイルサイズで昇順にソート", *sort_asc_by_size
    pos ginfo_winx * 3 / 4, 0 : button gosub "ファイルサイズで降順にソート", *sort_desc_by_size

    // リストビューコントロール作成
    pos 0, 32 : objsize ginfo_winx, ginfo_winy - 32
    make_listview : id_list = stat

    // カラムを追加
    column_name = "ファイル名", "ファイルサイズ"
    repeat 2
        add_column id_list, column_name(cnt), cnt
        if stat == -1 {
            dialog "カラムの追加に失敗", 1
            end
        }
    loop

    // アイテム・サブアイテムの追加
    sdim item_name, 64, 2
    repeat NUM_FILES
        item_name = "ファイル" + cnt, "" + rnd(1000) + " KB"
        add_item id_list, item_name, cnt
        if stat == -1 {
            dialog "アイテムの追加に失敗", 1
            end
        }
    loop
    return

正規表現でHTMLの見出しを抽出する

2008-02-05T09:44:00.002+09:00

bregonig.dllを使いたくて「ヘッダファイル作ろうかなー」と考えていたら既に月影ともさん（と猫太さん）が作成されていました。
COMによる正規表現は何かと不便なので、今後重宝しそうです。
リンク先を変更。[08/05/03]

// つーさのくーかん「物置 > HSP3 > BREGEXP.hsp」
// http://tu-sa.net/0360

#runtime "hsp3cl"
#include "bregexp.hsp"
    dialog "htm;*.html", 16, "見出しを抽出するHTMLファイル"
    if stat == 0 : end

    notesel file
    noteload refstr
    position = 0
    margin_left = "-", "--", "---", "----", "-----", "------"
    repeat
        result = BMatch(file, position, "m#<[hH]([1-6])[^>]*>(.*)</[hH]\\1>#k")
        if result == -1 : break

        mes margin_left(int(BMGetStr(1))-1) + BMGetStr(2)
        position += BMGetNextPos()
    loop
    stop

サイトのサムネイルを表示する

2008-01-28T08:59:00.000+09:00

サイトのサムネイルを作成・表示するAPI「ThumbnailAPI」を利用します。
ネットの接続などはスクリプトから明示的には行っていません。imgload命令の内部で使用しているCOMが自動で行ってくれているようです。

#include "mod_img.as"
    imgload "http://img.simpleapi.net/small/http://www.forest.impress.co.jp/"
    stop

複数行文字列の行数を取得する（2）

2008-01-24T05:37:00.000+09:00

FUJIさんのご指摘を受けて、HSP標準のnotemaxとほぼ同等の動作をするモジュール。

参考：複数行文字列の行数を取得する

// 行数取得モジュール
// 変数の型チェックは行っていないので注意
#module
// instr()を利用した行数の取得
#defcfunc get_lines_num1 var p1
    result = 0
    repeat strlen(p1)
        result++
        ins = instr(p1, cnt, "\n")
        if ins == -1 : break
        continue cnt + ins + 2
    loop
    return result
// 正規表現を利用した行数の取得
#defcfunc get_lines_num2 var p1
    if vartype(com_regexp) != vartype("comobj") {
        // comオブジェクト型変数の初期化
        newcom com_regexp, "VBScript.RegExp"
        comres com_result
        com_regexp("Pattern") = "\\r\\n"
        com_regexp("Global") = 1
    }
    com_regexp->"Execute" p1
    result = com_result("Count") + 1    // 行数 = 改行の個数 + 1
    s = strmid(p1, -1, 2)
    if s == "\n" | s == "" : result--   // 最後が空行ならその行をカウントしない
    return result
// notemaxを利用した行数の取得
#defcfunc get_lines_num3 var p1
    notesel p1
    result = notemax
    noteunsel
    return result
#global
    sdim s, 32, 3
    s(0) = "Hot\nSoup\nProcessor"
    s(1) = "sample\nstrings\n"
    s(2) = ""
    foreach s
        mes get_lines_num1(s(cnt))
        mes get_lines_num2(s(cnt))
        mes get_lines_num3(s(cnt))
        mes "***"
    loop
    stop

複数行文字列の行数を取得する

2008-01-23T22:57:00.000+09:00

notemaxのように複数行文字列の行数を取得します。
正規表現版はパターンを"(\\r\\n)+"に変更することで、空行を無視するようにもできます。

#module
// instr()を利用した行数の取得
#defcfunc get_lines_num var p1
    result = 0
    repeat
        result++
        ins = instr(p1, cnt, "\n")
        if ins == -1 : break
        continue cnt + ins + 2
    loop
    return result
// 正規表現を利用した行数の取得
#defcfunc get_lines_num2 var p1
    if vartype(com_regexp) != vartype("comobj") {
        // comオブジェクト型変数の初期化
        newcom com_regexp, "VBScript.RegExp"
        comres com_result
        com_regexp("Pattern") = "\\r\\n"
        com_regexp("Global") = 1
    }
    com_regexp->"Execute" p1
    return com_result("Count") + 1      // 行数 = 改行の個数 + 1
#global

    s = "Hot\nSoup\nProcessor\n\n"
    mes get_lines_num(s)
    mes get_lines_num2(s)
    stop

「ふっかつのじゅもん」っぽい暗号

2008-01-17T12:42:00.000+09:00

昔のゲームに出てきそうなひらがな（64種）による暗号です。
ひらがな1文字（16ビット）で6ビットの情報が表現できますので、情報量は16/6=約2.7倍になります。妙にビット演算が多いので、単純な目的の割に複雑なスクリプトになっています。

カタカナも取り入れれば7ビットの情報が表現できるはずです。また、~~半角カタカナを使えば情報量を8/6=約1.3倍に抑えられます~~半角カタカナは濁点・半濁点の表現に1ビット要するので一概には言えません。
復元時にinstrによる線形検索を行っているなど、速度上の課題はまだまだあるでしょう。

// 文字列型暗号作成スクリプト

// 参考：テキストボックスの編集監視
//      http://lhsp.s206.xrea.com/hsp_object2.html#4

#define ctype HIWORD(%1) (%1 >> 16 & 0xFFFF)
#module
#include "hspmath.as"
#const SPELL_KEY 0
// モジュールの初期化
#deffunc init_spell
    // 文字列型暗号の素 64文字
    sdim base, 64 * 2 + 1
    base  = "あいうえおかきくけこがぎぐげごさしすせそざじずぜぞ"    // 25文字
    base += "たちつてとだぢづでどなにぬねのはひふへほばびぶべぼ"    // 25 + 25 = 50文字
    base += "まみむめもやゆよらりるれろん"                          // 50 + 14 = 64文字
    return

// 指定した位置（ビット）から6ビットを取り出すマクロ
// バッファオーバーフローに注意
#define ctype peek6(%1, %2=0) ((((peek(%1, (%2) / 8) << 8) | peek(%1, 1 + (%2) / 8)) >> (10 - (%2) \ 8)) & 0x3F)

// 指定した位置（ビット）から6ビット書き込む命令
// バッファオーバーフローに注意
#deffunc poke6 var target, int index, int value
    i  = (peek(target, index / 8) << 8) | peek(target, index / 8 + 1)
    i ^= peek6(target, index) << (10 - (index \ 8))
    i |= (value & 0x3F) << (10 - (index \ 8))
    poke target, index / 8, (i >> 8) & 0xFF
    poke target, index / 8 + 1, i & 0xFF
    return

// パスワードから通常の文字列データへ変換
#deffunc spell2str var result, str _before
    before = _before
    len = strlen(before)
    randomize SPELL_KEY
    repeat len / 2
        code = (instr(base, 0, strmid(before, cnt * 2, 2)) / 2) ^ rnd(0x40)
        poke6 result, cnt * 6, code
    loop
    poke result, int(ceil(8.0 * len / 6.0)), 0
    return

// 通常の文字列データからパスワードに変換
#deffunc str2spell var result, str _before
    before = _before
    randomize SPELL_KEY
    // 対象となる文字列から6ビットずつ切りだし、ひらがなに変換
    for i, 0, strlen(before) * 8, 6
        // XOR演算によって より暗号っぽく
        wpoke result, i / 3, wpeek(base, (peek6(before, i) ^ rnd(0x40)) * 2)
    next
    poke result, i / 3, 0
    return
#global
    init_spell


    screen 0, 240, 200
    // 元の文字を代入する文字列型変数
    sdim before, 512
    // 文字列型暗号が代入される文字列型変数
    sdim result, 1536
    // テキストボックス作成
    mesbox before, ginfo_winx, ginfo_winy / 2, , 250
    hInput = objinfo_hwnd(stat)
    mesbox result, ginfo_winx, ginfo_winy / 2
    idResult = stat
    sendmsg objinfo_hwnd(idResult), $CF, 1  // 編集無効

    oncmd gosub *command, 0x0111            // WM_COMMAND
    stop

// テキストボックスの編集を監視する
*command
    if lparam == hInput {
        if HIWORD (wparam) = 0x300 {
            // 編集された場合は文字列型暗号を作って表示
            str2spell result, before
            objprm idResult, result
/*          // この行の"/*"を消すとタイトルに復元した文字列を表示
            sdim s, 512
            spell2str s, result
            title s
//*/
        }
    }
    return

数式の分解

2008-01-13T08:34:00.000+09:00

正規表現を使って数式を分解し、文字列型配列変数に代入します。
日本語が使えないのが難点です。

関連：インタプリンタ電卓もどき

#runtime "hsp3cl"
#module
// 正規表現を利用した数式の分解
// 英数字およびアンダースコア・半角丸かっこと各種演算子のみ使用可能（日本語は無視）
#deffunc split_calc array result, str exp
    newcom oReg, "VBScript.RegExp"
    comres oMatches
    oReg("Global") = 1

    oReg("Pattern") = "[0-9\\.]+|\\+|-|\\*|/|%|=|\\w*\\(|\\)|\\w+"
    oReg -> "Execute" exp

    sdim result, 16, oMatches("Count")
    bracket_l = 0 : bracket_r = 0
    repeat oMatches("Count")
        oMatch = oMatches("Item", cnt)
        result(cnt) = oMatch("Value")
        s = strmid(result(cnt), -1, 1)
        if s == "(" : bracket_l++ : else : if s == ")" : bracket_r++
    loop
    return bracket_l != bracket_r
#global

    exp = "s(r) = r * r * 3.14"
    mes exp + "\n"

    // 数式を分解
    split_calc result, exp
    if stat : mes "括弧の数が不正です。"

    // 結果の表示
    foreach result
        mes result(cnt)
    loop
    stop

Googleマップを利用する

2008-01-12T09:06:00.000+09:00

経度と緯度を指定して、付近の地図を表示します。

// 経度と緯度を指定して、GoogleMapを表示する
#const COMBOX_HEIGHT 20
    axobj ie, "Shell.Explorer.2", ginfo_winx, ginfo_winy - COMBOX_HEIGHT
    if stat == -1 {
        dialog "ActiveXコントロールの配置に失敗しました。", 1
        end
    }

    sdim places, 60
    places = "札幌ドーム\n東京ドーム\n原爆ドーム"
    // 緯度と経度…Geocodingにて検索
    ll(0, 0) = 43.014605, 141.410877    // 札幌ドーム
    ll(0, 1) = 35.705637, 139.751892    // 東京ドーム
    ll(0, 2) = 34.395483, 132.453592    // 原爆ドーム

    objsize ginfo_winx, COMBOX_HEIGHT
    combox selected, 100, places
    hcombox = objinfo_hwnd(stat)

    oncmd gosub *on_selected, 0x0111
    gosub *jump
    stop

// 指定場所へのジャンプ
*jump
    url = "http://maps.google.co.jp/?ie=UTF8&z=17&om=1&ll=" + ll(0, selected) + "," + ll(1, selected) + "&output=embed&s=AARTsJqzARj-Z8VnW5pkPMLMmZbqrJcYpw"
    ie -> "Navigate" url
    return

// コンボボックスが変更された場合にジャンプ
*on_selected
    if (lparam == hcombox)&(wparam & 0x10000 != 0) {
        gosub *jump
    }
    return

Footy2の「イベントの監視」機能を利用する

2008-01-08T11:20:00.000+09:00

hscallbk.dllを利用したイベントの監視。
ステータスバーに捕まえたイベントを報告します。

切り取りやアンドゥなどのショートカットキー（ctrl+A,C,V,X,Y,Z）をonkeyで実装しています。

#include "Footy2.as"
#include "hscallbk.as"
#include "user32.as"
#func Focus             ""  int, int, int, int
#func MoveCaret         ""  int, int, int, int
#func TextModified      ""  int, int, int
#func InsertModeChanged ""  int, int, int

*init
    gosub *createGUIObjects
    gosub *setCallBackFunctions
    onkey gosub *onPushKey
    stop

*createGUIObjects
    // ステータスバー作成
    // 参考：http://lhsp.s206.xrea.com/hsp_object8.html
    // 　　：http://yokohama.cool.ne.jp/chokuto/urawaza/statusbar.html
    winobj "msctls_statusbar32", "ready", , $50000000
    statusbar_id = stat
    if statusbar_id == -1 {
        dialog "ウィンドウオブジェクトが正常に生成されませんでした", 1
        end
    }
    // ステータスバーの高さを取得
    dim rect, 4
    GetWindowRect objinfo_hwnd(statusbar_id), varptr(rect)
    if stat == 0 {
        dialog "ステータスバーの座標取得に失敗しました", 1
        end
    }
    statusbar_height = rect(3) - rect(1)

    // Footyエディタコントロール設置
    Footy2Create hwnd, 0, 0, ginfo_winx, ginfo_winy - statusbar_height, 0
    footy_id = stat
    if footy_id < 0 {
        dialog "Error : type " + stat, 1
        end
    }
    return

// コールバック関数の登録
*setCallBackFunctions
    setcallbk proc_Focus, Focus, *onFocus
    setcallbk proc_MoveCaret, MoveCaret, *onMoveCaret
    setcallbk proc_TextModified, TextModified, *onTextModified
    setcallbk proc_InsertModeChanged, InsertModeChanged, *onInsertModeChanged
    Footy2SetFuncFocus footy_id, varptr(proc_Focus), 0
    Footy2SetFuncMoveCaret footy_id, varptr(proc_MoveCaret), 0
    Footy2SetFuncTextModified footy_id, varptr(proc_TextModified), 0
    Footy2SetFuncInsertModeChanged footy_id, varptr(proc_InsertModeChanged), 0
    return

// フォーカスを得た/失った
*onFocus
    if callbkarg(3) & $FF {
        message = "Footyコントロールがフォーカスを得ました"
    } else {
        message = "Footyコントロールがフォーカスを失いました"
    }
    sendmsg objinfo_hwnd(statusbar_id), $401, 0, message
    return

// キャレットが移動した
*onMoveCaret
    sendmsg objinfo_hwnd(statusbar_id), $401, 0, "キャレット位置が変更されました（" + callbkarg(2) + ":" + callbkarg(3) + "）"
    return

// テキストが編集された
*onTextModified
    switch callbkarg(2)
        case MODIFIED_CAUSE_CHAR
            message = "文字が入力されました（IMEオフ）"
            swbreak
        case MODIFIED_CAUSE_IME
            message = "文字が入力されました（IMEオン）"
            swbreak
        case MODIFIED_CAUSE_DELETE
            message = "Deleteキーが押されました"
            swbreak
        case MODIFIED_CAUSE_BACKSPACE
            message = "BackSpaceキーが押されました"
            swbreak
        case MODIFIED_CAUSE_ENTER
            message = "Enterキーが押されました"
            swbreak
        case MODIFIED_CAUSE_UNDO
            message = "元に戻す処理が実行されました"
            swbreak
        case MODIFIED_CAUSE_REDO
            message = "やり直し処理が実行されました"
            swbreak
        case MODIFIED_CAUSE_CUT
            message = "切り取り処理が行われました"
            swbreak
        case MODIFIED_CAUSE_PASTE
            message = "貼り付け処理が行われました"
            swbreak
        case MODIFIED_CAUSE_INDENT
            message = "インデント処理が行われました"
            swbreak
        case MODIFIED_CAUSE_UNINDENT
            message = "逆インデント処理が行われました"
            swbreak
        case MODIFIED_CAUSE_TAB
            message = "タブキーが押されました"
            swbreak
        default
            message = "テキストが編集されました（UNKNOWN）"
            swbreak
    swend
    sendmsg objinfo_hwnd(statusbar_id), $401, 0, message
    return

// 挿入/上書モードの変更
*onInsertModeChanged
    if callbkarg(2) & $FF {
        message = "挿入モードに変更されました"
    } else {
        message = "上書モードに変更されました"
    }
    sendmsg objinfo_hwnd(statusbar_id), $401, 0, message
    return

// ショートカットキー
*onPushKey
    keycode = iparam
    getkey ctrl, 17
    if ctrl {
        switch keycode
            case 'A'
                Footy2SelectAll footy_id
                swbreak
            case 'C'
                Footy2Copy footy_id
                swbreak
            case 'V'
                Footy2Paste footy_id
                swbreak
            case 'X'
                Footy2Cut footy_id
                swbreak
            case 'Y'
                Footy2Redo footy_id
                swbreak
            case 'Z'
                Footy2Undo footy_id
                swbreak
        swend
    }
    return

アクセラレータキーを利用したスクリプトがこちら。
ウィンドウの最大化にも対応しています。

// アクセラレータキーを使用
// Footy2付属のC++サンプルとほぼ同等
#include "Footy2.as"
#include "hscallbk.as"
#include "user32.as"
#func Focus             ""  int, int, int, int
#func MoveCaret         ""  int, int, int, int
#func TextModified      ""  int, int, int
#func InsertModeChanged ""  int, int, int

#const FVIRTKEY         0x0001
#const FNOINVERT        0x0002
#const FSHIFT           0x0004
#const FCONTROL         0x0008
#const FALT             0x0010

#const WM_SIZE          0x0005
#const WM_COMMAND       0x0111

#enum IDM_UNDO = 1
#enum IDM_REDO
#enum IDM_CUT
#enum IDM_COPY
#enum IDM_PASTE
#enum IDM_SELECTALL

// 初期化作業
*init
    gosub *createGUIObjects
    gosub *createAccelTable
    gosub *setCallBackFunctions
    oncmd gosub *on_resize, WM_SIZE
    oncmd gosub *on_command, WM_COMMAND
    onexit goto *on_exit
    dim msg, 7
    Footy2SetFocus footy_id

// メッセージループ
*msg_loop
    GetMessage varptr(msg), 0, 0, 0
    ret = stat
    if (ret == 0)|(ret == -1) {
        goto *on_exit
    }
    TranslateAccelerator hwnd, haccel, varptr(msg)
    if stat == 0 {
        TranslateMessage varptr(msg)
        DispatchMessage  varptr(msg)
    }
    goto *msg_loop

#define WS_MAXIMIZEBOX  0x00010000
#define WS_SIZEBOX      0x00040000
*createGUIObjects
    // ウィンドウ初期化
    screen 0, ginfo_dispx, ginfo_dispy
    GetWindowLong hwnd, -16
    SetWindowLong hwnd, -16, stat | WS_MAXIMIZEBOX | WS_SIZEBOX
    title "Footy2サンプル on Footy2 ver." + GetFooty2Ver()
    width 640, 480

    // ステータスバー作成
    // 参考：http://lhsp.s206.xrea.com/hsp_object8.html
    // 　　：http://yokohama.cool.ne.jp/chokuto/urawaza/statusbar.html
    winobj "msctls_statusbar32", "ready", , $50000000
    statusbar_id = stat
    if statusbar_id == -1 {
        dialog "ウィンドウオブジェクトが正常に生成されませんでした", 1
        end
    }

    // ステータスバーの高さを取得
    dim rect, 4
    GetWindowRect objinfo_hwnd(statusbar_id), varptr(rect)
    if stat == 0 {
        dialog "ステータスバーの座標取得に失敗しました", 1
        end
    }
    statusbar_height = rect(3) - rect(1)

    // Footyエディタコントロール設置
    Footy2Create hwnd, 0, 0, ginfo_winx, ginfo_winy - statusbar_height, 0
    footy_id = stat
    if footy_id < 0 {
        dialog "Error : type " + stat, 1
        end
    }
    return

// アクセラレータテーブルの作成
// 参考：「アクセラレータ - HSP開発wiki」
// 　　　http://hspdev-wiki.net/?%A5%A2%A5%AF%A5%BB%A5%E9%A5%EC%A1%BC%A5%BF
*createAccelTable
    sdim accel, 6*6

    key = 'Z', 'Y', 'X', 'C', 'V', 'A'
    repeat 6
        poke accel,  cnt*6+0, FCONTROL | FVIRTKEY
        wpoke accel, cnt*6+2, key(cnt)
        wpoke accel, cnt*6+4, cnt+1
    loop

    CreateAcceleratorTable varptr(accel), 6
    haccel = stat
    if haccel == 0 {
        dialog "アクセラレータテーブル作成に失敗しました", 1
    }
    return

// コールバック関数の登録
*setCallBackFunctions
    setcallbk proc_Focus, Focus, *onFocus
    setcallbk proc_MoveCaret, MoveCaret, *onMoveCaret
    setcallbk proc_TextModified, TextModified, *onTextModified
    setcallbk proc_InsertModeChanged, InsertModeChanged, *onInsertModeChanged
    Footy2SetFuncFocus footy_id, varptr(proc_Focus), 0
    Footy2SetFuncMoveCaret footy_id, varptr(proc_MoveCaret), 0
    Footy2SetFuncTextModified footy_id, varptr(proc_TextModified), 0
    Footy2SetFuncInsertModeChanged footy_id, varptr(proc_InsertModeChanged), 0
    return

// フォーカスを得た/失った
*onFocus
    if callbkarg(3) & $FF {
        message = "Footyコントロールがフォーカスを得ました"
    } else {
        message = "Footyコントロールがフォーカスを失いました"
    }
    sendmsg objinfo_hwnd(statusbar_id), $401, 0, message
    return

// キャレットが移動した
*onMoveCaret
    sendmsg objinfo_hwnd(statusbar_id), $401, 0, "キャレット位置が変更されました（" + callbkarg(2) + ":" + callbkarg(3) + "）"
    return

// テキストが編集された
*onTextModified
    switch callbkarg(2)
        case MODIFIED_CAUSE_CHAR
            message = "文字が入力されました（IMEオフ）"
            swbreak
        case MODIFIED_CAUSE_IME
            message = "文字が入力されました（IMEオン）"
            swbreak
        case MODIFIED_CAUSE_DELETE
            message = "Deleteキーが押されました"
            swbreak
        case MODIFIED_CAUSE_BACKSPACE
            message = "BackSpaceキーが押されました"
            swbreak
        case MODIFIED_CAUSE_ENTER
            message = "Enterキーが押されました"
            swbreak
        case MODIFIED_CAUSE_UNDO
            message = "元に戻す処理が実行されました"
            swbreak
        case MODIFIED_CAUSE_REDO
            message = "やり直し処理が実行されました"
            swbreak
        case MODIFIED_CAUSE_CUT
            message = "切り取り処理が行われました"
            swbreak
        case MODIFIED_CAUSE_PASTE
            message = "貼り付け処理が行われました"
            swbreak
        case MODIFIED_CAUSE_INDENT
            message = "インデント処理が行われました"
            swbreak
        case MODIFIED_CAUSE_UNINDENT
            message = "逆インデント処理が行われました"
            swbreak
        case MODIFIED_CAUSE_TAB
            message = "タブキーが押されました"
            swbreak
        default
            message = "テキストが編集されました（UNKNOWN）"
            swbreak
    swend
    sendmsg objinfo_hwnd(statusbar_id), $401, 0, message
    return

// 挿入/上書モードの変更
*onInsertModeChanged
    if callbkarg(2) & $FF {
        message = "挿入モードに変更されました"
    } else {
        message = "上書モードに変更されました"
    }
    sendmsg objinfo_hwnd(statusbar_id), $401, 0, message
    return

// WM_COMMANDメッセージを受け取った
*on_command
    switch wparam & $FFFF
        case IDM_UNDO
            Footy2Undo footy_id
            swbreak
        case IDM_REDO
            Footy2Redo footy_id
            swbreak
        case IDM_CUT
            Footy2Cut footy_id
            swbreak
        case IDM_COPY
            Footy2Copy footy_id
            swbreak
        case IDM_PASTE
            Footy2Paste footy_id
            swbreak
        case IDM_SELECTALL
            Footy2SelectAll footy_id
            swbreak
    swend
    return

// WM_SIZEメッセージを受け取った
#const  SIZE_RESTORED   0
#const  SIZE_MAXIMIZED  2
*on_resize
    if (wparam == SIZE_RESTORED) | (wparam == SIZE_MAXIMIZED) {
        Footy2Move footy_id, 0, 0, ginfo_winx, ginfo_winy - statusbar_height
        sendmsg objinfo_hwnd(id_statusbar), WM_SIZE, SIZE_RESTORED, 0
    }
    return 0

// アクセラレータテーブルの削除
*destroyAccelTable
    if haccel != 0 {
        DestroyAcceleratorTable haccel
    }
    return

// 終了時処理
*on_exit
    gosub *destroyAccelTable
    end

Footy2.as正式版を公開しました

2008-01-08T10:21:00.000+09:00

すべての命令・関数・マクロと定数を記述したHSP3向けヘッダファイルをFooty2のプロジェクトページからダウンロードできます。（コールバック関数の利用はhscallbk.dllが必要です）

リポジトリブラウザ→trunk→HSPとリンクを辿ってダウンロードしてください。

APIを利用して英語を日本語に翻訳するモジュール

2008-01-07T09:47:00.000+09:00

英語を日本語に翻訳します。
ネットに接続するため、少し時間がかかります。

// 英語->日本語変換サンプル
// 翻訳APIを使用
//     http://muumoo.jp/news/2007/05/09/0translationapi.html
// 参考：mod_rss.as

#module mod_translate
#deffunc rss2load_init@mod_translate
    newcom oDom,"Microsoft.XMLDOM"
    oDom("async") = "FALSE"
    comres elm_desc
    return

#deffunc rss2load@mod_translate array desc, str url, int p_max
    oDom->"load" url
    oRoot = oDom("documentElement")
    if varuse(oRoot) == 0 : return 1
    if oRoot("tagName") != "rss" : return 2

    maxnum = p_max
    if maxnum <= 0 : maxnum = 5

    oDom->"getElementsByTagName" "description"
    max = limit(elm_desc("length"), 1, maxnum)

    sdim desc, 64, max
    repeat max
        node = elm_desc("item", cnt)
        node2 = node("firstChild")
        desc(cnt) = node2("nodeValue")
    loop

    return 0

#deffunc rss2load_clean onexit
    if vartype(oRoot) == vartype("comobj") {
        delcom node : delcom node2 : delcom oRoot
    }
    delcom elm_desc : delcom oDom
    return

// 英文を和訳します。変換に成功するとstatに0が代入され、第1引数の変数に変換結果が代入されます。
// 変換に失敗するとstatに1が代入されます。
#deffunc eng2jp var result, str before, local after
    rss2load after, "http://pipes.yahoo.com/poolmmjp/ej_translation_api?_render=rss&text=" + before
    if (stat == 0)&(length(after) == 2) {
        // after(0)にはAPIの説明が代入されている
        result = after(1)
        return 0
    } else {
        return 1
    }
#global
    rss2load_init@mod_translate
// モジュールここまで

    target = "Good morning! How are you today?", "I'm fine, thank you. And you?", "So so."
    foreach target
        mes target(cnt)
        eng2jp result, target(cnt)
        if stat == 0 : mes "-> " + result
    loop
    stop

ツリービュー2

2008-01-05T09:45:00.000+09:00

Fujiさんのブログにあるモジュール変数でツリーを利用したスクリプト。
このモジュールで作成したツリーを渡すことで、ツリービューを作成するモジュールです。

ツリー作成モジュールは上記ブログからの引用（一部削除）です。

// 参考
//   http://yokohama.cool.ne.jp/chokuto/urawaza/treeview1.html
//   http://www.fujidig.com/2007/12/modvar-tree.html

#module m_tree children, content
#modfunc set_tree_content str _content
    content = _content
    return

#defcfunc getaptr@m_tree var p1, local hspctx, local vptr
    mref hspctx, 68
    dupptr vptr, hspctx.207, 8, 4
    return vptr.1

#modinit str _content
    set_tree_content thismod, _content
    dimtype children, 5, 1
    return getaptr( thismod )

#deffunc _new_tree array tree, str _content
#define global new_tree( %1, %2 = "" ) _new_tree %1,%2
    newmod tree, m_tree, _content
    return stat

#defcfunc get_tree_content modvar m_tree@
    return content

#defcfunc get_tree_num_children modvar m_tree@
    return length( children )

#modfunc get_tree_child int index, var result
    if( index < 0 || index >= length( children ) ) : return 1
    if( varuse( children.index ) == 0 ) : return 1
    result = children.index
    return 0

#modfunc add_tree_child var child
    new_tree children
    children.stat = child
    return

#modfunc _show_tree str indent
#define global show_tree( %1, %2 = "" ) _show_tree %1, %2
    mes indent + content
    foreach children
        if( varuse( children.cnt ) ) {
          show_tree children.cnt, indent + "  "
        }
    loop
    return

#global
// ここまで引用

#include "user32.as"
#include "comctl32.as"
#module m_treeview h_treeview
#const  TVIF_TEXT       0x00000001
#const  TVI_LAST        0xFFFF0002
#const  TVM_INSERTITEM  0x00001100

// ノードを再帰的に追加
#modfunc add_node@m_treeview var _node, int h_parent, local node, local h_node
    node = _node : dim tvins, 12
    bufText = get_tree_content(node)
    tvins = h_parent, TVI_LAST, TVIF_TEXT
    tvins(6) = varptr(bufText), strlen(bufText)
    sendmsg h_treeview, TVM_INSERTITEM, 0, varptr(tvins)
    h_node = stat

    // 子ノードの追加
    repeat get_tree_num_children(node)
        get_tree_child node, cnt, child
        if stat : continue
        add_node@m_treeview thismod, child, h_node
    loop
    return h_node

// ツリービューの作成
// statにはツリービューのハンドルが返る
#define global make_treeview(%1, %2, %3, %4) newmod %1, m_treeview, %2, %3, %4
#modinit var root, int _width, int _height
    // コモンコントロールライブラリ初期化（無くても動作する？）
    initCCEx = 8, 0x00000002
    InitCommonControlsEx varptr(initCCEx)
    if stat == 0 : return -1

    // コントロールの作成
    style = 0x40000000 | 0x10000000 | 0x0001 | 0x0002 | 0x0200
    CreateWindowEx 0, "SysTreeView32", "", style, ginfo_cx, ginfo_cy, _width, _height, hwnd, 0, 0, 0
    h_treeview = stat
    if h_treeview == 0 : return -1

    add_node@m_treeview thismod, root, 0
    return h_treeview
#global

    // ツリーの作成（引用）
    new_tree tree, "root"

        new_tree tree_1, "1"
        add_tree_child tree, tree_1

        new_tree tree_2, "2"
        add_tree_child tree, tree_2

            new_tree tree_2_1, "2-1"
            add_tree_child tree_2, tree_2_1

                new_tree tree_2_1_1, "2-1-1"
                add_tree_child tree_2_1, tree_2_1_1

            new_tree tree_2_2, "2-2"
            add_tree_child tree_2, tree_2_2

    // ツリービューを作成
    cls 1
    make_treeview treeview, tree, 100, ginfo_winy
    if stat == -1 {
        dialog "ツリービューの作成に失敗しました。", 1
        end
    }
    // ツリーを表示
    pos 100, 0
    show_tree tree

    stop

IEコンポのジャンプ先ＵＲＬを取得する

2008-01-03T10:19:00.000+09:00

HHXソースコード解析によるスクリプト。
リンクをクリックしたときにそのジャンプ先URLを取得します。HHXではこのURLを解析して様々な処理を行っています。

広告による読み込み（Javascript）に対しても反応してしまうようです。

// 他のファイルにジャンプする時いちいち確認するブラウザのサンプル
// 主にhhx.hspから引用
#include "user32.as"
// ie event
#define DIID_DWebBrowserEvents2     "{34A715A0-6587-11D0-924A-0020AFC7AC4D}"
// exdispid.h
#define DISPID_BEFORENAVIGATE2      250   // hyperlink clicked on

#packopt hide 1
    // ウィンドウ最大化を可能にする
    // 参考 -> http://lhsp.s206.xrea.com/hsp_window.html
    screen 0, ginfo_dispx, ginfo_dispy, screen_hide
    GetWindowLong hwnd, -16
    SetWindowLong hwnd, -16, stat | $10000 | $40000

    // ActiveXコントロール（IEコンポーネント）の配置
    axobj ieBrowser, "Shell.Explorer.2"
    idIE = stat
    if idIE == -1 {
        dialog "ActiveXコントロールの配置に失敗しました。", 1
        end
    }

    ieBrowser->"Navigate" "http://www.yahoo.co.jp/"

    // 割り込み設定
    comevent ieEvent, ieBrowser, DIID_DWebBrowserEvents2, *event_ie
    oncmd gosub *event_resize, 0x0005
    onexit goto *exit

    width 640, 480
    gsel 0, 1
    stop

// COMイベント発生時のジャンプ先
*event_ie
    if comevdisp(ieEvent) == DISPID_BEFORENAVIGATE2 {
        // URLを取得
        comevarg newurl, ieEvent, 1, 1
        dialog newurl + "\nを開こうとしています。開きますか？", 2
        if stat == 7 {
            // 「いいえ」の場合はNAVIGATEをキャンセル
            comevarg Cancel, ieEvent, 6, 2
            Cancel("val") = 1
            delcom Cancel
        }
    }
    return

// ウィンドウのリサイズ
*event_resize
    MoveWindow objinfo(idIE, 2), 0, 0, ginfo_winx, ginfo_winy, 1
    return

// プログラムの終了処理
*exit
    oncmd 0 : onexit 0
    delcom ieEvent
    delcom ieBrowser
    end

RPG風メッセージウィンドウの描画

2008-01-02T11:55:00.001+09:00

ツクールなどでよくありそうなデザインのウィンドウを描画します。三角関数とhsvcolorを組み合わせることで、きれいなグラデーションが表現できます。
白と黒の線で囲むことで、どんな背景でもある程度の見易さを確保するよう努めています。

#module
#include "hspmath.as"
#deffunc line_box int x, int y, int _w, int _h, local w, local h
    w = _w - 1 : h = _h - 1
    line x+w, y, x, y : line x+w, y+h
    line x, y+h : line x, y
    return
#deffunc draw_win int x, int y, int _w, int _h, local w, local h
    w = _w - 1 : h = _h - 1
    repeat 10
        angle = M_PI * cnt/20, M_PI * (1+cnt)/20
        hsvcolor 130, 255, 255-2*cnt*cnt
        boxf x+sin(angle)*w, y, x+sin(angle(1))*w, y+h
    loop
    color : line_box x, y, _w, _h
    color 255, 255, 255 : line_box x+1, y+1, _w-2, _h-2
    return
#global
    redraw 0
    draw_win 0, 0, 240, 200
    redraw 1
    stop

lstrlenAとstrlenの速度比較

2008-01-02T08:01:00.000+09:00

今回の条件ではlstrlenAよりもstrlenの方が高速な模様。

※別の書き方ではlstrlenAの方が速くなります。むしろそちらの書き方の方が普通と考えられます。m(_ _;)m

// lstrlenAとstrlenの速度比較

#uselib "kernel32.dll"
#cfunc lstrlenA "lstrlenA" sptr

#uselib "winmm.dll"
#cfunc timeGetTime "timeGetTime"

#const trial_times 1000

    font msgothic, 14
    repeat 3, 1
        trial_strlen = cnt * cnt * cnt * 1000
        sdim trial_string, trial_strlen + 1
        memset trial_string, 'a', trial_strlen

        // lstrlenAの速度計測
        time(0) = timeGetTime()
        repeat trial_times
            tmp = strlen(trial_string)
        loop
        time(0) = timeGetTime() - time(0)

        // strlenの速度計測
        time(1) = timeGetTime()
        repeat trial_times
            tmp = lstrlenA(trial_string)
        loop
        time(1) = timeGetTime() - time(1)

        mes strf("文字列長（%dbytes）の場合：", trial_strlen)
        mes strf("　strlen  ：%d[msec]", time(0))
        mes strf("　lstrlenA：%d[msec]", time(1))
        mes ""
    loop
    stop

レジストリを読み出す（advapi32）

2007-12-28T16:52:00.000+09:00

advapi32を利用したレジストリ読み出し。HSP3標準エディタの「起動時のカレントディレクトリ」を読み出します。

事前にデータの大きさを知ることができる分、hspextよりも便利かもしれません。
ここでは利用していませんが、エラーの原因を詳しく追及することもできます。

// 参考（というか丸写し）
//   ちょくとのページ：レジストリに保存してみる
//   http://yokohama.cool.ne.jp/chokuto/urawaza/registry.html

#uselib "advapi32.dll"
#func global RegCloseKey "RegCloseKey" sptr
#func global RegOpenKeyExA "RegOpenKeyExA" sptr,sptr,sptr,sptr,sptr
#func global RegQueryValueExA "RegQueryValueExA" sptr,sptr,sptr,sptr,sptr,sptr

#const  HKEY_CURRENT_USER   0x80000001
#const  KEY_QUERY_VALUE     0x0001

    // レジストリキーをオープン
    name = "Software\\OnionSoftware\\hsed3"
    RegOpenKeyExA HKEY_CURRENT_USER, name, 0, KEY_QUERY_VALUE, varptr(hkey)
    if stat != 0 {
        dialog "キーをオープンできません。", 1
        end
    }

    // データのサイズを取得
    RegQueryValueExA hkey, "startdir", 0, 0, 0, varptr(size) 
    if stat != 0 {
        mes "データサイズを取得できませんでした。"
    } else {
        mes strf("データサイズは%dバイトです。", size)

        // 文字列データを取得
        sdim result, size
        RegQueryValueExA hkey, "startdir", 0, 0, varptr(result), varptr(size) 
        if stat != 0 {
            mes "データを取得できませんでした。"
        } else {
            mes result
        }
    }

    // レジストリキーのハンドルをクローズ
    RegCloseKey hkey
    stop

レジストリを読み出す（hspext）

レジストリを読み出す（hspext）

2007-12-28T16:19:00.000+09:00

レジストリを読み出すスクリプト。
HSP3標準エディタの「起動時のカレントディレクトリ」を読み出します。

#include "hspext.as"
#const HKEY_CURRENT_USER 0

    // HSP3標準スクリプトエディタの設定を指定する
    regkey HKEY_CURRENT_USER, "Software\\OnionSoftware\\hsed3", 0
    if stat != 0 {
        dialog "何らかのエラーが発生しました。", 1
        end
    }

    // 起動時のカレントディレクトリを取得
    sdim result, 256
    getreg result, "startdir", 1, 256
    if stat != 0 {
        dialog "何らかのエラーが発生しました。", 1
        end
    }

    // 結果を表示
    mes result

    stop

レジストリを読み出す（advapi32）

文字列の分割と結合

2007-12-26T20:55:00.000+09:00

ActionScript3(AS3)にあるメソッド、split(文字列の分割)とjoin(文字型配列変数の結合)をHSP標準の文字列操作命令で実装。
splitの方は正規表現で何とかできそうな気がしますが……VBScriptのRegExpにはsplitメソッドが備わっていないようなので、少し難しいのでしょうか。ただいま調査中です。

区切り文字の数が多く、さらに区切り文字で終わる文字列をsplitできなかった不具合を修正。

#module
// 文字列の分割
#deffunc split array arr, str target, str devider
    if devider = "" {
        // 分割する目印は空文字であってはならない
        return 1
    }

    dim part_strlen, 10             // 分割結果の長さ
    part_strlen_max = 0             // 分割結果の長さの最大値
    parts_num = 1                   // 分割結果の数
    _target = target                // instr,strmidを使うために変数に代入する
    target_strlen = strlen(target)  // 分割する文字列の長さ
    devider_strlen = strlen(devider)// 分割する目印の長さ

    // いくつに分割できるか調べる
    repeat
        ins = instr(_target, cnt, devider)
        if ins == -1 {
            part_strlen(parts_num - 1) = target_strlen - cnt
            if part_strlen_max < part_strlen(parts_num - 1) {
                part_strlen_max = part_strlen(parts_num - 1)
            }
            break
        } else {
            part_strlen(parts_num - 1) = ins
            if part_strlen_max < ins {
                part_strlen_max = ins
            }
            parts_num++
            continue cnt + ins + devider_strlen
        }
    loop

    // 分割結果代入用の配列を確保
    sdim arr, part_strlen_max + 1, parts_num

    // 分割の開始
    position = 0
    foreach arr
        arr(cnt) = strmid(_target, position, part_strlen(cnt))
        position += part_strlen(cnt) + devider_strlen
    loop
    return 0

// 文字列の結合
#deffunc join var result, array target, str connecter
    if vartype(target) != 2 {
        // 結合する配列変数は文字列型でなければならない
        return 1
    }

    connecter_strlen = strlen(connecter)
    // 連結結果の長さを調べる
    result_strlen = connecter_strlen * (length(target) - 1)
    repeat length(target)
        target_strlen(cnt) = strlen(target(cnt))
        result_length += target_strlen(cnt)
    loop

    // 連結結果代入用の変数を確保
    sdim result, result_length + 1

    // 連結の開始
    position = 0
    foreach target
        if cnt {
            poke result, position, connecter
            position += connecter_strlen
        }
        poke result, position, target(cnt)
        position += target_strlen(cnt)
    loop
    return 0

// ちょっと遠回りな置換
#deffunc replace var target, str before, str after
    split tmparr, target, before
    if stat : return stat
    join target, tmparr, after
    return stat
#global

// サンプルスクリプト
    font msgothic, 14
    s = "Hot Soup Processor"
    mes s

    mes "\n半角スペースで分割"
    split arr, s, " "
    foreach arr
        mes "{"+cnt+"}:"+arr(cnt)
    loop

    mes "\nエクスクラメーションマークで結合"
    join result, arr, "!"
    mes result

    mes "\nsplitとjoinを組み合わせで置換"
    replace s, " ", "!"
    mes s
    stop

正規表現を利用したURL＆メールアドレスのタグ付け

2007-12-25T22:57:00.000+09:00

テキストに含まれるURLやメールアドレスにリンクタグ（aタグ）をつけます。
当初は1バイトずつ切りだして判定する方法を利用していたのですが、分かりづらい上に作りにくかったので正規表現を利用したものに切り替えました。ロジックを書かなくて済む分、かなりシンプルなスクリプトになっています。独自のWikiやBBSなどに利用できるかもしれません。

// 正規表現を利用したURL＆メルアドのタグ付け
#module
// 置換処理のメイン部分
#deffunc do_cnv str before, var after, str pattern, str replace
    newcom regexp, "VBScript.RegExp"
    comres after
    regexp("Pattern") = pattern
    regexp("Global") = 1
    regexp -> "Replace" before, replace
    delcom regexp
    return

// URLのタグ付け
#defcfunc add_link str before
    do_cnv before, after, "(http://[-/.~_#0-9a-zA-Z]+)", "<a href=\"$1\">$1</a>"
    return after

// メールアドレスのタグ付け
#defcfunc add_mailto str before
    do_cnv before, after, "([-/.~_0-9a-zA-Z]+@[-.~_0-9a-zA-Z]+)", "<a href=\"mailto:$1\">$1</a>"
    return after
#global

// URLにリンク（日本語ドメイン非対応）
    before = {"文字列中のURL（URI）にリンクします
HSPTV!（http://hsp.tv/）
HSP開発wiki（http://hspdev-wiki.net/）
http://だけではリンクされません"}
    after1 = add_link(before)
    mesbox after1, ginfo_winx, ginfo_winy / 2

// メールアドレスにリンク
    before = {"文字列中のメールアドレスにリンクします
例えばsample2007@yaboo.co.jpとか！"}
    after2 = add_mailto(before)
    mesbox after2, ginfo_winx, ginfo_winy / 2
    stop

3D画像ビューアサンプル

2007-12-20T08:11:00.000+09:00

Flashなどでありそうな3Dの画像ビューア。のサンプル。
マウスのホイールに連動して回転します。

#include "d3m.hsp"
#include "hspmath.as"
#const TILE_NUM 16
#const SHIFT_TURN 5
#const BUFFER_WIDTH 200
#const BUFFER_HEIGHT 200

    // タイルを表示するための配列変数
    tile_x = 100, 300, 300, 100
    tile_y =   0,   0,   0,   0
    tile_z = 200, 200,   0,   0

    // タイル用のバッファを作成
    repeat TILE_NUM, 1
        buffer cnt, BUFFER_WIDTH, BUFFER_HEIGHT
        color , 255 : boxf
        color 255, 255, 255
        font msgothic, 32, font_bold
        mes cnt
    loop

    // メイン画面の初期化・カメラ設定
    screen 0, 240, 200, screen_normal
    title "ホイールで回転"
    d3setcam -250,-300,100, 250,0,100

    // 各種初期化作業
    gmode GMODE_ALPHA, , , 128
    theta_shift = 0.0                   // タイルの回転量
    theta_add = 0.0                     // タイルの角速度
    moving = 0                          // 回転中フラグ
    need_to_draw = 1                    // 描画フラグ

// ★メインループ
*main
    gosub *move
    gosub *draw
    wait 5
    goto *main

// 移動計算
*move
    mw = mousew
    if moving > 0 {
        // 移動中
        moving--
        theta_shift += theta_add
    } else : if mw != 0 {
        // 静止中かつホイールが動いたとき
        moving = SHIFT_TURN             // SHIFT_TURN回動く
        need_to_draw = 1                // 描画フラグON

        // 角速度を決定
        theta_add = M_PI * 2.0 * sgn(mw) / SHIFT_TURN / TILE_NUM
    }
    return

// 描画処理
*draw
    if need_to_draw == 0 : return
    if moving == 0 : need_to_draw = 0

    redraw 0
    color : boxf

    vect_x = cos(theta_shift)
    vect_y = sin(theta_shift)
    // 2.0 * M_PI / TILE_NUMだけ角度（位置）を変えながら、タイルをTILE_NUM個描画
    repeat TILE_NUM
        d3rotate vect_x, vect_y, vect_x, vect_y, 2.0 * M_PI / TILE_NUM
        d3setlocal 0,0,0, vect_x,vect_y,0, -vect_y,vect_x,0, 0,0,1
        d3texture tile_x, tile_y, tile_z, cnt + 1, 0, 0, BUFFER_WIDTH, BUFFER_HEIGHT, 1
    loop

    redraw 1
    return

高速な文字列の結合（連結）

2007-12-16T10:46:00.000+09:00

pokeとmemexpandを利用した文字列の結合（連結）。
HSP標準の+=やnoteaddよりも高速に実行することができます。

このモジュール最大の利点は、memexpandによる変数の自動拡張にあります。(X)HTMLコンバータのように出力結果の大きさが分からないスクリプトで重宝するでしょう。
サンプルスクリプトのように決まった文字列を結合（連結）し続ける場合（リフレイン）、この命令よりもFujiさんのブログの記事で紹介されている方法の方がより高速です。

先日の(X)HTML変換スクリプトの他、開発wikiの置換モジュールでも似たような処理が使われています。

#module
#const EXPAND_SIZE 1024
// 文字列の初期値を設定する
#deffunc set_string str str_to_set
    string_length = strlen(str_to_set)
;   string_size = EXPAND_SIZE * (1 + string_length / EXPAND_SIZE)
    string_size = 64            // 測定のために公平化
    sdim string, string_size
    poke string, 0, str_to_set
    return

// 文字列を返す
#deffunc get_string var target
    target = string
    return

// 文字列の長さを返す
#defcfunc get_string_length
    return string_length

// 文字列を連結する
#deffunc add_string str str_to_add
    len = strlen(str_to_add)
    if string_size <= string_length + len {
        string_size += EXPAND_SIZE
        memexpand string, string_size
    }
    poke string, string_length, str_to_add
    string_length += len
    return
#global

#const TRIAL_TIME 10000
#uselib "winmm.dll"
    #cfunc timeGetTime "timeGetTime"

    mes "充分なサイズを確保せずに文字列の結合（連結）を実行。"

    mes "独自命令版計測中……"
    set_string ""
    time_start = timeGetTime()
    repeat TRIAL_TIME
        add_string "sample string\n"
    loop
    time(0) = timeGetTime() - time_start
    mes strf("独自命令を使用：%d[ms]", time(0))
    mes "独自命令版計測終了。\n"

    mes "+=使用版計測開始……"
    string = ""
    time_start = timeGetTime()
    repeat TRIAL_TIME
        string += "sample string\n"
    loop
    time(1) = timeGetTime() - time_start
    mes strf("標準の+=を使用：%d[ms]", time(1))
    mes "+=使用版計測終了。\n"

    mes "noteadd使用版計測開始……"
    notesel string
    sdim string, 64
    time_start = timeGetTime()
    repeat TRIAL_TIME
        noteadd "sample string"
    loop
    time(2) = timeGetTime() - time_start
    mes strf("noteaddを使用：%d[ms]", time(2))
    mes "noteadd使用版計測終了。"
    stop