Fuji Diablog

OpenHSP ver 3.2 の可変長引数対応 strf を HSP 3.1 でも使えるようにするプラグインを作ったよ

2008-05-13T15:19:00+09:00

strf_ex

OpenHSP ver 3.2 の strf は可変長引数対応になって便利なので、HSP 3.1 でも動かせるようにプラグインにしてみました。みんなぜひ使うといいと思うよ！

サンプル

付属しているサンプルとまったく同じものをここに掲載しておきます。

// サンプル
//     strf_ex : OpenHSP ver 3.2 の可変長引数対応 strf を HSP 3.1 でも使えるようにするプラグイン

// ファイル strf_ex.dll と次の 2 文で strf_ex が使えるようになります
#regcmd "hsp3cmdinit", "strf_ex.dll"
#cmd strf_ex 0

//標準の strf を置き換えることもできます
;#undef strf
;#define global strf strf_ex

mes strf_ex("<%s><%d><%f>", "hoge",123, 3.14) //=> <hoge><123><3.140000>

// 型が合わなければ自動的に変換されます
mes strf_ex( "<%s><%d><%f>", 123, 3.14, "hoge" ) //=> <123><3><0.000000>

mes strf_ex( "%%" ) //=> %

a = 0x80000000
mes strf_ex( "<%d><%u><%o><%x>", a, a, a, a ) //=> <-2147483648><2147483648><20000000000><80000000>

mes strf_ex( "%.3s", "hello" ) //=> hel
mes strf_ex( "<%06d>", 123 ) //=> <000123>

// `*' で幅や精度を引数から得る機能はありません！
;mes strf_ex( "<%.*s>", 3, "hello" ) //エラー
;mes strf_ex( "<%0*d>", 6, 123 ) //エラー

// 数が合わない場合もエラー
;mes strf_ex( "%d" ) //エラー
;mes strf_ex( "", 123 ) //エラー

// HSP 3.1 の strf では %s で文字列ポインタから文字列を取り出せました（仕様外）が、
// そうはできなくなりました。

a = "hoge"
mes strf( "<%s>", varptr(a) + 1 ) //=> <oge>
mes strf_ex( "<%s>", varptr(a) + 1 ) //=> <10683521>

// HSP 3.2 からは必ず dupptr をかましてやってください
a = "hoge"
dupptr b, varptr(a) + 1, 1, 2
mes strf_ex( "<%s>", b) //=> <oge>

// なんと3.1では第二引数が文字列だとそれ単体で返ってきてしまいます
// 3.2 ではそんなことはありません
mes strf( "<%s>", "abc") //=> abc
mes strf_ex( "<%s>", "abc") //=> <abc>

// 3.1 の strf は結果が長いと場合によっては異常終了したり、なぞのエラーが出たり、システムエラーが発生したりします
;mes strlen(strf("%05000d",0))
;mes strlen(strf("%06000d",0))
;mes strlen(strf("%07000d",0))
;mes strlen(strf("%08000d",0))

// 3.2 ではそんなことはありません
mes strlen(strf_ex("%05000d",0)) //=> 5000
mes strlen(strf_ex("%06000d",0)) //=> 6000
mes strlen(strf_ex("%07000d",0)) //=> 7000
mes strlen(strf_ex("%08000d",0)) //=> 8000
mes strlen(strf_ex("%0100000d",0)) //=> 100000

// こんなところかな。

HSP の rnd を再現

2008-03-28T13:30:59+09:00

HSP の rnd 関数の実装は以下のようになっています。（ OpenHSP trunc/hsp3/hsp3int.cpp#L493 ）

ival = code_geti();
if ( ival == 0 ) throw HSPERR_DIVIDED_BY_ZERO;
reffunc_intfunc_ivalue = rand()%ival;

C の標準ライブラリの rand の値を引数の値で剰余しているだけですね。

HSP は VC++ でビルドされています。 VC++ の rand の実装は良い乱数・悪い乱数に掲載されています。

ということで、HSP の rnd を再現してみると以下のような感じ。

#module
#defcfunc rnd2 int a
    x = x * 214013 + 2531011
    return ((x>>16)&32767)\a
#deffunc randomize2 int a
    x = a
    return
#global

randomize 12345
randomize2 12345

repeat 10
    mes ""+rnd(1000)+", "+rnd2(1000)
loop

結果も同じですね。

HSP 対応版 kmyacc を公開しました

2008-03-24T19:28:09+09:00

HSP 対応版 kmyacc ダウンロード

Windows 用バイナリアーカイブとソースアーカイブの二つを用意しました。

他の言語のプロトタイプを参考にやったら出来ました！ kmyacc 本体をイジる必要があったのは改行周りだけでした。（ HSP では改行が文の終わりだから。 Python 版でも同じように改行周りで特別に処理していた。）

-tオプション（デバッグモード）、-aオプション（reduce時のactionを一つ一つサブルーチンに分けてラベル型配列変数を使って実行）に対応しています。

ActionScriptのyaccを作ったよ - yukobaの日記の画像を見ると ActionScript 版のデバッグモードでは accept 後にツリーを表示しているようですね。 HSP 版でも次期バージョンで対応するかもしれません。→対応しました

kmyacc の作者、各言語のプロトタイプの作者に感謝します。

Ver 1.10 として更新しました。デバッグモード時に下図のようなパーサーツリーのダンプが出来るようになりました。

方法は、まず kmyacc 実行時に-tオプションをつけます。すると、デバッグのためのトレース表示を行うようになります。これだけではツリーのダンプはされません。さらにツリーのダンプを行うには、 yyparse を呼ぶ直前あたりに yyDumpParseTree = 1 というコードを差し込みます。

構文木を使ったサンプル

付属のサンプル（ calc.hspy ）では物足りないと思うので、構文木を使ったサンプルも置いておきます。参考にしてみてください。変数の代入とか、if文とか使えます。

%token kNUMBER kIDENT kEOL kIF kELSE kEND

%right '='
%left '+' '-'
%left '*' '/'

%%

program
    : stmt_list { syntaxtree = $1 }

stmt_list
    : { new_list_node $$ }
    | stmt_list stmt kEOL { yylrec++ : append_list_node $$, $2 }
    | stmt_list kEOL

stmt
    : expr
    | if_stmt

if_stmt
    : kIF expr kEOL stmt_list else_stmt kEND
        {
            new_if_node $$, $2, $4, $5
        }

else_stmt
    : kELSE kEOL stmt_list { $$ = $3 }
    | { new_list_node $$ }

expr
    : expr '+' expr { new_operator_node $$, '+', $1, $3 }
    | expr '-' expr { new_operator_node $$, '-', $1, $3 }
    | expr '*' expr { new_operator_node $$, '*', $1, $3 }
    | expr '/' expr { new_operator_node $$, '/', $1, $3 }
    | '(' expr ')' { $$ = $2 }
    | kNUMBER { new_literal_node $$, $1 }
    | kIDENT { new_varref_node $$, $1 }
    | kIDENT '=' expr { new_assign_node $$, $1, $3 }

%%

#runtime "hsp3cl"

if 0 {
#defcfunc varref str varname
    if vars( "Exists", varname ) {
        return vars( "Item", varname )
    }
    mes "undefined variable `"+varname+"'"
    return 0
#deffunc setvar str varname, int val
    if vars( "Exists", varname ) : vars -> "Remove" varname
    vars -> "Add" varname, val
    return
}

#module m_node type, children, val
#enum TYPE_LITERAL = 1
#enum TYPE_VARREF
#enum TYPE_ASSIGN
#enum TYPE_OPERATOR
#enum TYPE_LIST
#enum TYPE_IF

#define last_node (nodes(length(nodes)-1))

#modfunc init_literal_node int _val
    type = TYPE_LITERAL
    val = _val
    return
#deffunc new_literal_node var ret, int _val
    newmod nodes, m_node
    init_literal_node last_node, _val
    ret = last_node
    return

#modfunc init_varref_node str varname
    type = TYPE_VARREF
    val = varname
    return
#deffunc new_varref_node var ret, str varname
    newmod nodes, m_node
    init_varref_node last_node, varname
    ret = last_node
    return

#modfunc init_assign_node str varname, var expr
    type = TYPE_ASSIGN
    val = varname
    children = expr
    return
#deffunc new_assign_node var ret, str varname, var expr
    newmod nodes, m_node
    init_assign_node last_node, varname, expr
    ret = last_node
    return

#modfunc init_operator_node int operator, var lhs, var rhs
    type = TYPE_OPERATOR
    val = operator
    children = lhs, rhs
    return
#deffunc new_operator_node var ret, int operator, var lhs, var rhs
    newmod nodes, m_node
    init_operator_node last_node, operator, lhs, rhs
    ret = last_node
    return

#modfunc init_list_node
    type = TYPE_LIST
    dimtype children, 5
    val = 0 // appended flag
    return
#deffunc new_list_node var ret
    newmod nodes, m_node
    init_list_node last_node
    ret = last_node
    return
#modfunc append_list_node var append_node
    if val {
        children( length( children ) ) = append_node
    } else {
        children = append_node
    }
    val = 1
    return

#modfunc init_if_node var cond, var tstmt, var fstmt
    type = TYPE_IF
    children = cond, tstmt, fstmt
    return
#deffunc new_if_node var ret, var cond, var tstmt, var fstmt
    newmod nodes, m_node
    init_if_node last_node, cond, tstmt, fstmt
    ret = last_node
    return

#defcfunc eval_node modvar m_node@
    if type == TYPE_LITERAL {
        return val
    }
    if type == TYPE_VARREF {
        return varref( val )
    }
    if type == TYPE_ASSIGN {
        v = eval_node( children )
        setvar val, v
        return v
    }
    if type == TYPE_OPERATOR {
        l = eval_node( children.0 )
        r = eval_node( children.1 )
        if val == '+' {
            return l + r
        }
        if val == '-' {
            return l - r
        }
        if val == '*' {
            return l * r
        }
        if val == '/' {
            return l / r
        }
    }
    if type == TYPE_LIST {
        result = 0
        foreach children
            result = eval_node( children.cnt )
        loop
        return result
    }
    if type == TYPE_IF {
        if eval_node( children.0 ) {
            return eval_node( children.1 )
        }
        return eval_node( children.2 )
    }
    mes "must not happen" : stop
#global

    newcom vars, "Scripting.Dictionary"
    vars("compareMode") = 0
    
    newcom reserved, "Scripting.Dictionary"
    reserved -> "Add" "if", kIF
    reserved -> "Add" "else", kELSE
    reserved -> "Add" "end", kEND
    
    yyparse
    if vartype( syntaxtree ) == 5 : mes eval_node( syntaxtree )
    ;end stat
    stop

*yylex
    if start == 0 {
        input expr,, 1
        if peek( expr ) == 0 : return 0
        expr_ptr = 0
        start = 1
    }
    char = peek( expr, expr_ptr )
    if char == 10 || char == 13 {
        start = 0
        return kEOL
    }
    if char == ' ' || char == '\t' {
        expr_ptr ++
        goto *yylex
    }
    if char >= '0' && char <= '9' {
        yylval = char - '0'
        expr_ptr ++
        repeat
            char = peek( expr, expr_ptr )
            if char >= '0' && char <= '9' : else : break
            yylval = yylval * 10 + char - '0'
            expr_ptr ++
        loop
        return kNUMBER
    }
    if ( char >= 'a' && char <= 'z' ) || ( char >= 'A' && char <= 'Z' ) || char == '_' {
        yylval = expr_ptr
        repeat
            char = peek( expr, expr_ptr )
            cond   = char >= 'a' && char <= 'z'
            cond ||= char >= 'A' && char <= 'Z'
            cond ||= char == '_'
            cond ||= char >= '0' && char <= '9'
            if cond : else : break
            expr_ptr ++
        loop
        yylval = strmid( expr, yylval, expr_ptr - yylval )
        if reserved( "Exists", yylval ) {
            return reserved( "Item", yylval )
        }
        return kIDENT
    }
    expr_ptr ++
    return char

*yyerror
    mes yyerrmsg
    return

mrefを使わずにstatに値を格納

2008-03-21T06:25:18+09:00

ちょっとした HSP の小技。

gosub *@f : if 0 : *@ : return 123
mes stat ;=> 123

もちろん、ほとんどの場合では素直に mref を使った方がいいでしょう。

文字列の式を計算

2008-02-12T08:00:49+09:00

カッコも演算子の優先度、単行演算子もあります。 Ruby で書いたのを移植しました。文字列の式をトークンの配列に分解→逆ポーランド記法に変換→計算という段階を踏んでいます。

#module calc_token type, val
#modinit int _type, var _val
    type = _type
    val = _val
    return
#defcfunc calc_token_type modvar calc_token@
    return type
#defcfunc calc_token_val modvar calc_token@
    return val
#global

#module calc

#enum TOKEN_TYPE_NONE = 0
#enum TOKEN_TYPE_BINARY_OPERATOR
#enum TOKEN_TYPE_UNARY_OPERATOR
#enum TOKEN_TYPE_NUM
#enum TOKEN_TYPE_LEFT_BRACKETS
#enum TOKEN_TYPE_RIGHT_BRACKETS

#deffunc init_calc
    binary_operators           = "*", "/", "+", "-"
    binary_operators_priority  =   2,   2,   1,   1
    unary_operators            = "+", "-"
    unary_operators_priority   =   5,   3
    return

#defcfunc calc_operate_binary int operator, double a, double b
    switch operator
    case 0
        return a * b
    case 1
        return a / b
    case 2
        return a + b
    case 3
        return a - b
    swend

#defcfunc calc_operate_unary int operator, double a
    switch operator
    case 0
        return a
    case 1
        return -a
    swend

#deffunc calc_scan_num
    c = char
    if c == '-' : c = peek( expr, i + 1 )
    if c < '0' || c > '9' : return
    type = TOKEN_TYPE_NUM
    size = 1
    find = 1
    repeat
        if i + size >= len : break
        c = peek( expr, i + size )
        if c < '0' || c > '9' : break
        size ++
    loop
    c = peek( expr, i + size )
    if c == '.' {
        c = peek( expr, i + size + 1 )
        if c >= '0' && c <= '9' {
            size ++
            repeat
                if i + size >= len : break
                c = peek( expr, i + size )
                if c < '0' || c > '9' : break
                size ++
            loop
        }
    }
    val = double( strmid( expr, i, size ) )
    return

#deffunc calc_scan_operator array operators
    foreach operators
        dup operator, operators.cnt
        if strmid( expr, i, strlen( operator ) ) == operator {
            size = strlen( operator )
            val = cnt
            find = 1
            break
        }
    loop
    return

#deffunc calc_lex str _expr
    expr = _expr
    dimtype tokens, 5
    prev_type = TOKEN_TYPE_NONE
    i = 0
    len = strlen( expr )
    find = 1
    repeat
        if i >= len : break
        char = peek( expr, i )
        switch char
        case ' ' : case 0x09 : case 0x0a
        case 0x0d : case 0x0c
            i ++
            continue
        swend
        find = 0 : size = 0 : type = TOKEN_TYPE_NONE : val = 0
        switch prev_type
        case TOKEN_TYPE_NONE : case TOKEN_TYPE_LEFT_BRACKETS
        case TOKEN_TYPE_BINARY_OPERATOR : case TOKEN_TYPE_UNARY_OPERATOR
            calc_scan_num
            if find : swbreak
            calc_scan_operator unary_operators
            if find : type = TOKEN_TYPE_UNARY_OPERATOR : swbreak
            if char == '(' {
                type = TOKEN_TYPE_LEFT_BRACKETS
                size = 1
                find = 1
                swbreak
            }
            swbreak
        case TOKEN_TYPE_NUM : case TOKEN_TYPE_RIGHT_BRACKETS
            calc_scan_operator binary_operators
            if find : type = TOKEN_TYPE_BINARY_OPERATOR : swbreak
            if char == ')' {
                type = TOKEN_TYPE_RIGHT_BRACKETS
                size = 1
                find = 1
                swbreak
            }
        swend
        if find == 0 : break
        newmod tokens, calc_token, type, val
        prev_type = type
        i += size
    loop
    if find == 0 {
        error = "構文エラーです"
        return 1
    }
    return 0

#deffunc calc_insert_rpn_tokens
    i = rpn_tokens_size
    repeat
        if i <= rpn_tokens_ptr : break
        rpn_tokens( i ) = rpn_tokens( i - 1 )
        i --
    loop
    rpn_tokens( rpn_tokens_ptr ) = token
    rpn_tokens_size ++
    return

#defcfunc calc_is_token_operator var t
    if calc_token_type( t ) == TOKEN_TYPE_BINARY_OPERATOR : return 1
    if calc_token_type( t ) == TOKEN_TYPE_UNARY_OPERATOR  : return 1
    return 0

#defcfunc calc_operator_token_prioririty var t
    if calc_token_type( t ) == TOKEN_TYPE_BINARY_OPERATOR {
        return binary_operators_priority( calc_token_val( t ) )
    }
    return unary_operators_priority( calc_token_val( t ) )

#defcfunc calc_rop_is_end
    if rs_stack_ptr <= 0 : return 0
    if rs_stack( rs_stack_ptr - 1 ) != brackets_level : return 0

    if rpn_tokens_ptr >= rpn_tokens_size : return 1
    token1 = rpn_tokens( rpn_tokens_ptr )
    if tokens_i + 1 >= length( tokens ) : return 1
    token2 = tokens( tokens_i + 1 )

    if calc_is_token_operator( token1 ) == 0 : return 1
    if calc_is_token_operator( token2 ) == 0 : return 1

    token1p = calc_operator_token_prioririty( token1 )
    token2p = calc_operator_token_prioririty( token2 )

    return token2p <= token1p

#deffunc calc_rop_exit
    while calc_rop_is_end()
        rs_stack_ptr --
        rpn_tokens_ptr ++
    wend
    return

#deffunc calc_convert_to_rpn
    ret = 0
    dimtype rpn_tokens, 5
    rpn_tokens_size = 0
    rpn_tokens_ptr = 0
    prev_type = TOKEN_TYPE_NONE
    dim rs_stack
    rs_stack_ptr = 0
    brackets_level = 0

    foreach tokens
        tokens_i = cnt
        dup token, tokens.cnt
        type = calc_token_type( token )
        switch type
        case TOKEN_TYPE_NUM
            calc_insert_rpn_tokens
            rpn_tokens_ptr ++
            if prev_type == TOKEN_TYPE_BINARY_OPERATOR || prev_type == TOKEN_TYPE_UNARY_OPERATOR {
                calc_rop_exit
            }
            swbreak
        case TOKEN_TYPE_BINARY_OPERATOR
        case TOKEN_TYPE_UNARY_OPERATOR
            calc_insert_rpn_tokens
            rs_stack.rs_stack_ptr = brackets_level
            rs_stack_ptr ++
            swbreak
        case TOKEN_TYPE_LEFT_BRACKETS
            brackets_level ++
            swbreak
        case TOKEN_TYPE_RIGHT_BRACKETS
            if brackets_level <= 0 {
                error = "不正な閉じカッコです"
                ret = 1
                break
            }
            brackets_level --
            calc_rop_exit
            swbreak
        default
            error = "不明なトークンです"
            ret = 1
            break
        swend
        prev_type = type
    loop
/*  デバッグ表示
    repeat rpn_tokens_size
        if calc_token_type( rpn_tokens.cnt ) == TOKEN_TYPE_BINARY_OPERATOR {
            mes binary_operators( calc_token_val( rpn_tokens.cnt ) )
        } else : if calc_token_type( rpn_tokens.cnt ) == TOKEN_TYPE_UNARY_OPERATOR {
            mes unary_operators( calc_token_val( rpn_tokens.cnt ) )
        } else {
            mes calc_token_val( rpn_tokens.cnt )
        }
    loop */
    if ret : return ret
    if rpn_tokens_ptr != rpn_tokens_size {
        error = "式が途中で終了しています"
        return 1
    }
    if brackets_level != 0 {
        error = "カッコが閉じられていません"
        return 1
    }
    return 0

#deffunc calculate_rpn var result
    ddim stack, 1
    stack_ptr = 0
    ret = 0
    foreach rpn_tokens
        dup token, rpn_tokens.cnt
        type = calc_token_type( token )
        switch type
        case TOKEN_TYPE_NUM
            stack.stack_ptr = calc_token_val( token )
            stack_ptr ++
            swbreak
        case TOKEN_TYPE_BINARY_OPERATOR
            if stack_ptr < 2 {
                error = "オペランドが足りません"
                ret = 1
                break
            }
            stack_ptr --
            _b = stack.stack_ptr
            stack_ptr --
            _a = stack.stack_ptr
            stack.stack_ptr = calc_operate_binary( calc_token_val( token ), _a, _b )
            stack_ptr ++
            swbreak
        case TOKEN_TYPE_UNARY_OPERATOR
            if stack_ptr < 1 {
                error = "オペランドが足りません"
                ret = 1
                break
            }
            stack( stack_ptr-1 ) = calc_operate_unary( calc_token_val( token ), stack( stack_ptr-1 ) )
            swbreak
        default
            error = "不明なトークンです"
            ret = 1
            break
        swend
    loop
    if ret : return ret
    if stack_ptr != 1 {
        error = "オペランドが足りないか、余っています"
        return 1
    }
    result = stack.0
    return 0

#deffunc calculate str _expr, var result
    calc_lex _expr
    if stat : return stat
    calc_convert_to_rpn
    if stat : return stat
    calculate_rpn result
    return stat

#global
init_calc

exprs = "1+2*(3+4)", "1+--1", " ( 1 + ( 2 + ( 3 ) ) )", "2.5/-1.2", "1+", "((", "()", ""
foreach exprs
    expr = exprs.cnt
    mes expr
    calculate expr, result
    if stat {
        mes "Error: "+error@calc
    } else {
        mes " = " + result
    }
loop

二項演算子のオペランドの _a と _b が逆だったので修正。

d3module Z ソート

2008-02-07T06:28:58+09:00

#include "d3m.hsp"

#module cube

#deffunc init_cube
    // 面の座標（4点）のパターン（4つ）
    dim pattern, 4, 4
    pattern.0.0 = 0, 0, 0, 0
    pattern.0.1 = 0, 1, 1, 0
    pattern.0.2 = 1, 1, 0, 0
    pattern.0.3 = 1, 1, 1, 1

    dim association, 3, 6
    // それぞれの面(6)のX,Y,Z(3)について、patternのインデックスを設定する
    // よい変数名がうかばない
    association.0.0 = 0, 1, 2
    association.0.1 = 3, 1, 2
    association.0.2 = 1, 0, 2
    association.0.3 = 1, 3, 2
    association.0.4 = 1, 2, 0
    association.0.5 = 1, 2, 3
    return

#deffunc cube_coordinate int face
    dup xs, pattern( 0, association( 0, face ) )
    dup ys, pattern( 0, association( 1, face ) )
    dup zs, pattern( 0, association( 2, face ) )
    return

#deffunc draw_cube int face
    cube_coordinate face
    d3square xs, ys, zs
    return

#defcfunc face_dist int face
    cube_coordinate face
    dx = 0.25 * ( xs.0 + xs.1 + xs.2 + xs.3 )
    dy = 0.25 * ( ys.0 + ys.1 + ys.2 + ys.3 )
    dz = 0.25 * ( zs.0 + zs.1 + zs.2 + zs.3 )

    // ダサい＞＜
    dx += local_coordinate@.0 - camera@.0
    dy += local_coordinate@.1 - camera@.1
    dz += local_coordinate@.2 - camera@.2

    return d3dist( dx, dy, dz )

#deffunc cube_sorted_faces array faces
    dim faces, 6 // 面番号の配列
    ddim face_dists, 6 // 面のカメラとの距離
    repeat 6
        faces.cnt = cnt
        face_dists.cnt = face_dist( cnt )
    loop

    // バブルソート
    repeat 6
        i = cnt
        repeat 6 - i - 1
            j = cnt
            dup n, faces.j
            dup v, face_dists.j
            if( v < v.1 ) {
                tmp_n = n
                tmp_v = v
                n = n.1
                v = v.1
                n.1 = tmp_n
                v.1 = tmp_v
            }
        loop
    loop
    return

#global
init_cube

    gmode 3,,, 200
    repeat
        redraw 0
        camera = sin(0.01*cnt)*1.5, cos(0.01*cnt)*1.5, 1.0
        d3setcam camera.0, camera.1, camera.2
        local_coordinate = -0.5, -0.5, -0.5
        d3setlocal local_coordinate.0, local_coordinate.1, local_coordinate.2
        color : boxf
        cube_sorted_faces faces
        repeat 6
            i = faces.cnt
            hsvcolor i * 192 / 6, 255, 255
            draw_cube i
        loop
        redraw 1
        await 40
    loop

d3module でマウス座標と重なっているセルを調べる

2008-02-05T08:04:47+09:00

といっても、二次元座標から三次元座標に変換をするわけではありません。書き込んだバッファから pget してどのセルと重なっているか調べるだけです。

#include "d3m.hsp"

#const WINDOW_ID_MAIN 0
#const WINDOW_ID_WORK 1

#const PANEL_SIZE_X 1.0
#const PANEL_SIZE_Y 1.0

#const PANEL_DISTANCE_X PANEL_SIZE_X * 1.1
#const PANEL_DISTANCE_Y PANEL_SIZE_Y * 1.1

#const PANELS_NUM_X 10
#const PANELS_NUM_Y 10

#const PANELS_ALL_SIZE_X PANEL_DISTANCE_X * ( PANELS_NUM_X - 1 ) + PANEL_SIZE_X
#const PANELS_ALL_SIZE_Y PANEL_DISTANCE_Y * ( PANELS_NUM_Y - 1 ) + PANEL_SIZE_Y

#const PANELS_START_X 0.0 - PANELS_ALL_SIZE_X / 2
#const PANELS_START_Y 0.0 - PANELS_ALL_SIZE_Y / 2

    buffer WINDOW_ID_WORK
    screen WINDOW_ID_MAIN

    repeat
        d3setcam sin(0.01*cnt)*10, cos(0.01*cnt)*10, 10
        mx = mousex : my = mousey
        gsel WINDOW_ID_WORK
        cls
        gosub *draw
        pget mx, my
        select_x = ginfo_r : select_y = ginfo_g
        gsel WINDOW_ID_MAIN
        redraw 0
        color 255, 255, 255 : boxf
        gosub *draw
        redraw
        await 40
    loop
    stop


*draw
    repeat PANELS_NUM_Y
        y = cnt
        py = PANEL_DISTANCE_Y * y + PANELS_START_Y
        repeat PANELS_NUM_X
            x = cnt
            px = PANEL_DISTANCE_X * x + PANELS_START_X
            pxs = px, px + PANEL_SIZE_X, px + PANEL_SIZE_X, px
            pys = py, py, py + PANEL_SIZE_Y, py + PANEL_SIZE_Y
            pzs = 0, 0, 0, 0
            if ginfo_sel == WINDOW_ID_WORK {
                color x, y
            } else {
                color
                if select_x == x && select_y == y {
                    color 255
                }
            }
            d3square pxs, pys, pzs
        loop
    loop
    return

簡単にスペースの連続した文字列を得る

2008-02-02T19:30:57+09:00

mes "["+strf("%10.0d", 0 )+"]"

10 のところを変更すれば任意のサイズにできるよ。

memset を使うのに比べて変数が不要な分、簡単。

HSP の文字列リテラルを表す正規表現

2008-02-01T06:11:09+09:00

文字列リテラル: /"[^\\"]*(\\.[^\\"]*)*("|$)/
複数行文字列リテラル: /\{"[^\\"]*(("(?!\})|\\.)[^\\"]*)*"\}/m
文字コードリテラル: /'[^\\']*(\\.[^\\']*)*('|$)/

少し前は文字列リテラルを表す正規表現ってどう書けばいいのかぜんぜん分からなかったんだけれど、今だとぜんぜん普通に書けた。

ところで、文字列リテラル中にダブルクォートが3つ以上入る場合、複数行文字列リテラルを使った方がスクリプトの文字数が短くなる。

mes "\""
mes {"""}

mes "\"\""
mes {""""}

mes "\"\"\""
mes {"""""}

というわけで、たとえ 1 行でもダブルクォートのたくさん入った文字列を使う場合は複数行文字列リテラルを使おう。

文字列リテラル正規表現でググってみました。

refluxflow::memo: 文字列リテラルにマッチする正規表現

そっか。もう少し短くかけたね。

文字列リテラル: /"([^\\"]|\\.)*("|$)/
複数行文字列リテラル: /\{"([^\\"]|\\.|"(?!\}))*"\}/m
文字コードリテラル: /'([^\\']|\\.)*('|$)/

複数行文字列リテラルは /\{"([^\\"]|\\.|")*?"\}/m でもいいか。

巨大な実数を str に渡したり、 mes で表示しようとすると落ちる。

2008-01-31T22:37:03+09:00

mes 1e100 // 落ちる

これで HSP が落ちる。

a = str(1e100) // 落ちる

str に渡しても落ちる。

#runtime "hsp3cl"
mes 1e100 // 落ちない
a = str(1e100) // 落ちない

両方ともランタイムが hsp3cl なら落ちない。

環境は Windows XP Home SP2 / HSP3.1

OpenHSP のソースコードを追っかけてみた。

hspvar_str.cpp

static char conv[64];

という固定長の配列に書き込んでいたので、これを超えるとバッファオーバーフローが発生するというわけですねー。

同じような原因で、a=strf("%5000d", 0 )で終了時に「問題が発生したため、hsp3.exe を終了します。ご不便をおかけして申し訳ありません。」というエラーが出たり。

数値表記のアンダースコア

2008-01-31T21:25:37+09:00

へええ、 16 進表記や 2 進表記では Perl や Ruby みたいにアンダースコアをつけることができるんですね。

だから、以下のような Perl みたいなスクリプトが HSP でもコンパイルできます。

#!/usr/bin/perl
print( $_ );

#!/usr/bin/perl は不明なプリプロセッサ命令として無視されているんだと思います。

そして、 $ や % の後ろには何もついていなくても OK なんですね。

mes 0x //=> 0

mes 0e //=> 0
mes 0e+

指数表記の e の後ろも省略できるんだあ。

さらに少し遊んでみる。

mes %^(%*`!%--$>@&(_<<$))+%|@

宇宙人からの暗号か何か？顔文字みたいなのも作れるかな。（全角文字使えばそんなの簡単に作れるとか言わない！）

他に、あらかじめ

#define my(%1)if$

しておいて、

my $cafe = "hello";
print( $cafe );

とか。

HDL で使われている文字列連結

2008-01-26T14:31:30+09:00

HSP Document Library のソースを読んでみました。

hdl.hsp（バージョン 1.0 ） 1234 行目、 1305 行目と 1446 行目あたりで以下のように文字列の連結を行っていました。

tmp = "" ; accelerator ▽
repeat count
    ( 略 )
    tmp += ( 略 )
    if 1000000\(cnt+1)=0 : buf += tmp:tmp="" ; accelerator
    sql_next
loop
buf += tmp ; accelerator △

これって tmp という変数を使わずに直接 buf に連結しても多分大丈夫だと思うんですが、こうした方が高速なのでしょう。文字列を連結するときには先頭から文字列の終端を探すことになるので、長い文字列だと時間がかかります。連結する文字列をまとめてから連結することで、長い文字列に連結する回数が減って高速になる、ということです。

実験１

本当に速くなるのか試しに実験。

コード

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

#const trial_times 2000

    proc = *a, *b
    repeat 5, 1
        trial_strlen = cnt * cnt * cnt * 1000
        mes strf("文字列長（%dbytes）の場合：", trial_strlen)
        foreach proc
            sdim buf, trial_strlen + 1
            memset buf, 'a', trial_strlen
            time = timeGetTime()
            gosub proc.cnt
            time = timeGetTime() - time
            mes strf(" %c : ", 'a'+cnt) + strf( "%d[msec]", time )
            await
        loop
        mes
    loop
    stop

*a
    repeat trial_times
        buf += "sample string"
    loop
    return

*b
    tmp = ""
    repeat trial_times
        tmp += "sample string"
        if 1000000\(cnt+1)=0 : buf += tmp:tmp=""
    loop
    buf += tmp
    return

結果

文字列長（1000bytes）の場合：
 a : 35[msec]
 b : 6[msec]

文字列長（8000bytes）の場合：
 a : 62[msec]
 b : 6[msec]

文字列長（27000bytes）の場合：
 a : 125[msec]
 b : 9[msec]

文字列長（64000bytes）の場合：
 a : 215[msec]
 b : 10[msec]

文字列長（125000bytes）の場合：
 a : 329[msec]
 b : 14[msec]

なかなか速くなっているようで驚き。

実験２

HSP3のスクリプトを垂れ流すブログ: 高速な文字列の結合（連結）のスクリプトに以下を追加して試してみました。

コード

    mes "\ntmp使用版計測開始……"
    string = ""
    tmp = ""
    time_start = timeGetTime()
    repeat TRIAL_TIME
        tmp += "sample string\n"
        if 1000000\(cnt+1)=0 : string += tmp:tmp=""
    loop
    string += tmp
    time(3) = timeGetTime() - time_start
    mes strf("tmpを使用：%d[ms]", time(3))
    mes "tmp使用版計測終了。"

結果

独自命令版計測中……
独自命令を使用：88[ms]
独自命令版計測終了。

+=使用版計測開始……
標準の+=を使用：1020[ms]
+=使用版計測終了。

noteadd使用版計測開始……
noteaddを使用：3306[ms]
noteadd使用版計測終了。

tmp使用版計測開始……
tmpを使用：123[ms]
tmp使用版計測終了。

poke を使うのよりやや遅いくらいです。 += を使うのでも工夫すれば速くなるのですね。

計測した環境は Windows XP Home SP2 / Pentium 4 CPU 2.40GHz / 512 MB RAM です。

参考

Atom が Invalid だったのを修正

2008-01-19T22:31:41+09:00

jidilog に移行してから Atom の更新が Feed リーダー（ LDR ）に反映されないなー、なんでだろー。って思って W3C Feed Validator にかけてみると link 要素が間違っていたみたい。

<link rel="alternate" type="text/html" href="http://www.fujidig.com/2008/01/black-and-pink-style.html" />

こんな風にしないといけないところを、

<link>http://www.fujidig.com/2008/01/black-and-pink-style.html</link>

こんな感じになっていた。（多分 RSS を吐くコードをコピペした後に修正し忘れ）

すぐに修正して Valid にしました。これで直るはずだと思うけど...直りました

ついでに RSS ・ Atom でカテゴリの出力もうまくいっていないことを発見したのでそれも修正。（カテゴリ ID を使ってカテゴリを探さないといけないのに、エントリ ID で探していたのが原因）

黒とピンクのスタイル

2008-01-15T22:15:31+09:00

前回の白背景に青緑のスタイルから主に配色をいじって、 CSS を作りました。今まで自分があまりやったことのない配色ということで黒背景とピンク。

body に左マージンをとって、見出しをネガティブマージンではみだしたりとかもしてみました。

前回のスタイルは代替スタイルシートにしています。

あまりピンクって感じではなかったので明るいピンクを背景色にしたのも作りました。見出しのはみ出している部分に左ボーダーを使って透けているように見せかけたり。今回のこの二つのスタイルでは、文書の最後のナビゲーションとインフォメーションが本文じゃないんだよってことが分かるようにできたと思います。

HSP のオープンソースプロジェクトが始まってるー

2008-01-15T17:35:18+09:00

OpenHSP - Trac

わー、すごい。わくわくしちゃう。私も参加してみたくなりました＞＜