自力型変換（int⇔str）

整数値と文字列を相互に変換します。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

数式の分解

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


関連：インタプリンタ電卓もどき
#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


論理和とビットシフトで掛け算する

ビットシフトを使った掛け算。CASL2などを学んだ方なら動作原理はご存知かと思います。
前回の加算モジュールを利用しています。

関連：http://blog.livedoor.jp/dankogai/archives/50638838.html

#module
#defcfunc add int left_op, int right_op, local left, local right, local tmp
    left = left_op : right = right_op
    while ( left & right )
        tmp = ( left & right ) << 1
        left ^= right
        right = tmp
    wend
    return ( left | right )
#defcfunc multi int left_op, int right_op, local left, local right, local tmp
    left = left_op : right = right_op
    while ( right )
        if ( right & 1 ) : tmp = add( tmp, left )
        left <<= 1
        right >>= 1
    wend
    return tmp
#global
    randomize
    repeat 10
        l = rnd( 9 ) + 1
        r = rnd( 9 ) + 1
        mes strf( "%1d", l ) + " * " + strf( "%1d", r ) + " = " + strf( "%2d", multi( l, r ) )
    loop
    stop

論理積と論理和と排他的論理和で足し算する

ビット演算で足し算を行うスクリプト。
単純で短いスクリプトですが、再帰が必要だったり排他的論理和（XOR）演算を行う必要があったりと少々高度です。やっていることは小学校で習う「筆算」と同じなのですが。

CPU内部の演算は、もしかしたらこうして行われているのかもしれませんね。ちょっと調べてみます。
#module
#defcfunc add int left_op, int right_op
    kuri = ( left_op & right_op ) << 1  // 繰り上がり
    if ( kuri == 0 ) {
        // 繰り上がりがなければ論理和を返す
        return ( left_op | right_op )
    } else {
        // 繰り上がりがある場合は、
        // 繰り上がりと排他的論理和の結果を加算する
        return add( left_op ^ right_op, kuri )
    }
#global
    randomize
    repeat 10
        l = rnd( 99 ) + 1
        r = rnd( 99 ) + 1
        mes strf( "%2d", l ) + " + " + strf( "%2d", r ) + " = " + strf( "%3d", add( l, r ) )
    loop
    stop
再帰ではなくループを使う方法はこちら。

#module
#defcfunc add int left_op, int right_op
    left = left_op : right = right_op
    while ( left & right )
        tmp = ( left & right ) << 1
        left ^= right
        right = tmp
    wend
    return ( left | right )
#global
    randomize
    repeat 10
        l = rnd( 99 ) + 1
        r = rnd( 99 ) + 1
        mes strf( "%2d", l ) + " + " + strf( "%2d", r ) + " = " + strf( "%3d", add( l, r ) )
    loop
    stop

累乗根を求める

ニュートン・ラフソン法を用いて累乗根を求めるモジュール。
もちろん打ち切り誤差が発生します。// ニュートン・ラフソン法でxのn乗根を求める
#include "hspmath.as"
#module
#defcfunc radical_root double x, double n, local x_old, local x_new
    x_new = x
    repeat
        x_old = x_new
        x_new = ( n - 1.0 + x * pow@( x_old, -n ) ) * x_old / n
        if ( absf( x_old - x_new ) < 0.00000000001 ) {
            // ある程度の精度で演算を打ち切る
            break
        }
    loop
    return x_new
#global

    repeat 3
        pos cnt * 220, 0
        up_cnt = cnt + 2
        repeat 15, 2
            mes strf( str( cnt ) + "の" + str( up_cnt ) + "乗根は%1.10f", radical_root( cnt, up_cnt ) )
        loop
    loop
    stop

本家のBBSにあった「xの(1/n)乗がxのn乗根」という考え方を使えば、何と1行で記述できます。#define ctype radical_root( %1, %2 ) expf( logf( %1 ) / ( %2 ) )

逆ポーランド記法の式を解く

逆ポーランド記法の式を解く。整数の四則演算(+-*/)のみ対応。
数値は1ケタ限定だが、容易に拡張できると思われる。

エラー報告を比較的丁寧にやっているため、標準エラーは出現しないはず。

関連：

• インタプリタ電卓もどき

#module
#enum global NO_ERROR = 0
#enum global ERROR_DIVIDE_BY_ZERO
#enum global ERROR_NO_OPERAND
#enum global ERROR_UNKNOWN_CHARCTER
// モジュールで利用するためのスタック
#deffunc _put int p1
    stack(count) = p1
    count++
    return

#defcfunc _get
    if count > 0 {
        count--
    } else {
        // なにもないスタックから取り出そうとした → エラー
        iStat = ERROR_NO_OPERAND
    }
    return stack(count)

#deffunc calc var ans, str p1, local sExp, local iTmp
    sExp = p1
    iStat = NO_ERROR
    count = 0
    repeat strlen(sExp)
        i = peek(sExp, cnt)
        switch i
            case '0':case '1':case '2':case '3':case '4'
            case '5':case '6':case '7':case '8':case '9'
                // 数値の場合はスタックに積む
                _put i - '0'
                swbreak
            // 以下、オペランドの場合はスタックから2つ取り出して演算する
            case '+'
                _put _get() + _get()
                swbreak
            case '-'
                iTmp = _get()
                _put _get() - iTmp
                swbreak
            case '*'
                _put _get() * _get()
                swbreak
            case '/'
                iTmp = _get()
                if iTmp == 0 {
                    // 0で割ろうとした → エラー
                    iStat = ERROR_DIVIDE_BY_ZERO
                } else {
                    _put _get() / iTmp
                }
                swbreak
            default
                // 規定されていない文字 → エラー
                iStat = ERROR_UNKNOWN_CHARCTER
                swbreak
        swend
        if iStat != NO_ERROR : break
    loop
    if iStat == NO_ERROR : ans = _get()
    return iStat
#global

    question = "12+5*", "10/", "123*1+-2/", "12~", "1+1"
    repeat length(question)
        calc answer, question(cnt)
        switch stat
            case NO_ERROR
                mes question(cnt) + " = " + answer
                swbreak

            case ERROR_DIVIDE_BY_ZERO
                mes question(cnt) + " = エラー:0で除算しました"
                swbreak

            case ERROR_NO_OPERAND
                mes question(cnt) + " = エラー:オペランドが不足しています"
                swbreak

            case ERROR_UNKNOWN_CHARCTER
                mes question(cnt) + " = エラー:規定されていない文字が含まれています"
                swbreak

            default
                mes question(cnt) + " = エラー:規定されていないエラーです"
                swbreak
        swend
    loop

シェルピンスキーのギャスケット

シェルピンスキーのギャスケットを再帰を利用して描画。
そのままではつまらないので3D表示に。

#include "d3m.hsp"
#module Gasket
#deffunc drawGasket double x1, double y1, double x2, double y2, double x3, double y3, int count
    // X-Y平面上にシェルピンスキーのギャスケットを描く
    if count {
        drawGasket x1, y1, (x1 + x2)/2, (y1 + y2)/2, (x1 + x3)/2, (y1 + y3)/2, count - 1
        drawGasket x2, y2, (x1 + x2)/2, (y1 + y2)/2, (x2 + x3)/2, (y2 + y3)/2, count - 1
        drawGasket x3, y3, (x1 + x3)/2, (y1 + y3)/2, (x2 + x3)/2, (y2 + y3)/2, count - 1
    } else {
        d3initlineto
        d3lineto x1, y1, 0
        d3lineto x2, y2, 0
        d3lineto x3, y3, 0
        d3lineto x1, y1, 0
    }
return
#global
    redraw 0
    d3setcam -30, -40, 90, 50, 43, 0
    color : boxf
    color 0, 128
    drawGasket 0, 0, 100, 0, cos(3.14/3) * 100, sin(3.14/3) * 100, 4
    redraw 1
    stop

インタプリンタ電卓もどき

文字列で四則演算を行うプログラム。
動作はするが、ロジックはあまりきれいではない。時間をおいて作り直したい。

// コマンドライン電卓
#runtime "hsp3cl"
#module
// 文字列置換命令
//   v1 : 置換する文字型変数
//   s1 : 置換する文字列
//   i1 : 開始インデックス
//   i2 : 消去する文字列の数
#deffunc replace var v1, str s1, int i1, int i2, local s
    sdim s, 20
    if i1 : memcpy s, v1, i1, 0, 0
    s += s1
    memcpy s, v1, strlen(v1) - i1 - i2, i1 + strlen(s1), i1 + i2
    v1 = s
    return

#deffunc doCalc var s1, int i1, local target, local right, local r, local left, local l, local type, local i
    target = s1
    type = peek(target, i1)
    result = ""
    left = 0
    right = 0
    l = 0
    r = 0
    repeat i1
        i = peek(target, i1 - cnt - 1) - '0'
        if (0 <= i)&(i <= 9) {
            repeat cnt
                i *= 10
            loop
            left += i
            l++
        } else {
            break
        }
    loop
    repeat strlen(target) - i1 - 1
        i = peek(target, i1 + cnt + 1) - '0'
        if (0 <= i)&(i <= 9) {
            r++
            right = right * 10 + i
        } else {
            break
        }
    loop

    if type != '-' {
        if (l == 0)|(r == 0) {
            error = "数式が不正です"
            return 0
        }
    }
    switch type
    case '+'
        result = str(left + right)
        swbreak
    case '-'
        if r == 0 {
            error = "数式が不正です"
            return 0
        }
        if l == 0 {
            result = "noExchange"
        } else {
            result = str(left - right)
        }
        swbreak
    case '*'
        result = str(left * right)
        swbreak
    case '/'
        if right {
            result = str(left / right)
        } else {
            error = "ゼロでは除算できません"
        }
        swbreak
    default
        error = "数式が不正です"
        swbreak
    swend
    if error != "" : return 0
    if result == "noExchange" : return 1
    replace s1, result, i1 - l, l+1+r
    return 0

// 内部で再帰的に用いる命令
// 括弧を判別して括弧内を対象に自らを呼び出す
#defcfunc subCalc str s1, local cmd, local i, local l, local s
    cmd = s1
    repeat
        i = instr(cmd, 0, "(")
        if i >= 0 {
            l = instr(cmd, i+1, ")")
            s = strmid(cmd, i + 1, l)
            replace cmd, subCalc(s), i, l + 2 // ( と ) の分で+2
        } else {
            break
        }
    loop
    // 括弧がない場合
    // *, /を計算
    repeat
        i = instr(cmd, 0, "*")
        l = instr(cmd, 0, "/")
        if (i == -1)&(l == -1) : break
        if (i == -1)&(0 <= l) : i = l
        if 0 <= i {
            if (0 <= l)&(l < i) : i = l            // i にはiとlのうち小さい方が格納される
        }
        doCalc cmd, i       // インデックスiにある演算子で演算を行う
        if error != "" : break
    loop

    if error != "" : return error

    // +, -を計算
    k = 0
    repeat
        i = instr(cmd, k, "+")
        l = instr(cmd, k, "-")
        if (i == -1)&(l == -1) : break
        if (i == -1) : i = l
        if (0 <= l)&(0 <= i)&(l < i) : i = l
        i += k
        doCalc cmd, i       // インデックスiにある演算子で演算を行う
        if stat : k = i + 1
        if error != "" : break
    loop
    if error != "" : return error
    return cmd

// 外部から呼び出す命令 整数の数式を文字列として渡す
#deffunc calc str s1
    error = ""
    // 括弧の個数を調べる
    lt = 0 : gt = 0
    cmd = s1
    repeat strlen(cmd)
        tmp = peek(cmd, cnt)
        if tmp == '(' : lt++
        if tmp == ')' : gt++
    loop
    if lt != gt : error = "正しい数式ではありません"
    if error != "" : return error

    mes "Q:"+cmd
    return subCalc(s1)
#global

    calc "10*10+8/2*3"
    mes "  = " + refstr

リサージュ曲線を描画する

リサージュ曲線を描画するスクリプト。

#const RADIUS 200
#const PI     3.14159
    a = 3
    b = 2
    posCenterX = double(RADIUS + 50)
    posCenterY = double(RADIUS + 50)
    screen 0, posCenterX * 2, posCenterY * 2
    i = 0.0
    pos posCenterX + RADIUS, posCenterY
    while i <= PI * 2
        line posCenterX + cos(i * a) * RADIUS, posCenterY - sin(i * b) * RADIUS
        i += 0.01
        ; await 1
    wend
    title "finish"
    stop

最大公約数と最大公倍数を求める

// 最大公約数(GCD)と最小公倍数(LCM)を求めるユーザー定義関数

#module GetGCDandLCM
#defcfunc _gcd int high, int low, local tmp
    tmp = high \ low
    if tmp {
        return _gcd(low, tmp)
    } else {
        return low
    }

#defcfunc gcd int i1, int i2
    if i1 > i2 {
        return _gcd(i1, i2)
    } else {
        return _gcd(i2, i1)
    }

#defcfunc lcm int i1, int i2
    return i1 * i2 / gcd(i1, i2)
#global

// 以下サンプル
#runtime "hsp3cl"
    mes "最大公約数と最小公倍数を求める整数を２つ入力してください..."
    repeat 2
        repeat
            input tmp, , 1
            if int(tmp) > 0 : break
            mes "1以上の整数値を入力してください..."
        loop
        num(cnt) = int(tmp)
    loop

    mes "GCD(" + num(0) + ", " + num(1) + ") = " + gcd(num(0), num(1))
    mes "LCM(" + num(0) + ", " + num(1) + ") = " + lcm(num(0), num(1))
    stop

ベジェ曲線

ベジェ曲線を描画する。
2つ目以降のベジェ曲線は、1つ前のベジェ曲線の終点を始点とする。

参考

• http://musashi.or.tv/fontguide_doc3.htm

// 3次のベジェ曲線 for HSP3

#module Bezier
// 3次のベジェ曲線を描画
// (x1, y1)と(x4, y4)が端点、(x2, y2)と(x3, y3)が方向点
#deffunc bzArgo int x1, int y1, int x2, int y2, int x3, int y3, int x4, int y4, local t, local k, local lx, local ly
    pos x1, y1
    repeat 100, 1
        t = double(cnt)/100
        k = 1.0 - t
        lx = k * k * k * x1 + 3.0 * k * k * t * x2 + 3.0 * k * t * t * x3 + t * t * t * x4
        ly = k * k * k * y1 + 3.0 * k * k * t * y2 + 3.0 * k * t * t * y3 + t * t * t * y4
        line lx, ly
    loop
    return

// 制御点を4つづつ区切り、bzArgoに渡す
#deffunc bzDrawLine
    repeat (count - 1)/3
        bzArgo x(cnt*3), y(cnt*3), x(cnt*3 + 1), y(cnt*3 + 1), x(cnt*3 + 2), y(cnt*3 + 2), x(cnt*3 + 3), y(cnt*3 + 3)
    loop
    return

// 点を描画
#deffunc bzDrawPoint
    repeat count
        circle x(cnt) - 2, y(cnt) - 2, x(cnt) + 2, y(cnt) + 2
    loop
    return

// 点を追加
#deffunc bzAdd int x1, int y1
    x(count) = x1 : y(count) = y1
    count++
    return count

#deffunc bzClear
    count = 0
    dim x, 1 : dim y, 1
    cls 4
    return
#global

    bzClear
    onclick *addPoint
    stop

// 左クリックで制御点を追加、右クリックで制御点を削除
*addPoint
    if iparam == 0 {
        bzAdd lparam & $FFFF, lparam >> 16

        redraw 0
        color : boxf
        color 255
        bzDrawPoint
        color 255, 255, 255
        bzDrawLine
        redraw
    } else {
        if iparam == 3 : bzClear
    }
    stop

素数を任意の個数だけ出力

素数を任意の個数だけ出力するスクリプト。
検索を開始する数値を指定可能。
ちょっぴりフールプルーフ。
#runtime "hsp3cl"
#module
#defcfunc prime int num
    result = 1
    repeat (num + 1)/2 - 1, 2
        if (num \ cnt) == 0 : result = 0 : break
    loop
    return result
#global

    repeat
        mes "素数をいくつ出力しますか？"
        input many, , 1
        if int(many) > 0 : break
        mes "1以上の整数値を入力してください..."
    loop

    repeat
        mes "いくつから調べ始めますか？"
        input start, , 1
        if int(start) > 1 : break
        mes "2以上の整数値を入力してください..."
    loop

    many = int(many)
    mes str(many) + "個の素数を出力します..."
    i = 0
    repeat -1, int(start)
        if prime(cnt) {
            mes cnt
            i++
            if i == many : break
        }
    loop
    mes "終了しました。"
    end

2次のBスプライン関数による曲線

2次のBスプライン関数を描画する。

// 2次のBスプライン関数 for HSP3

#module BSpline
// 2次のBスプライン関数を描画
// (x1, y1)と(x3, y3)がオンカーブ点、(x2, y2)がオフカーブ点
#deffunc bsArgo int x1, int y1, int x2, int y2, int x3, int y3, local k, local t
    pos x1, y1
    repeat 100, 1
        t = double(cnt)/100
        k = 1.0 - t
        line k * k * x1 + 2.0 * t * k * x2 + t * t * x3, k * k * y1 + 2.0 * t * k * y2 + t * t * y3
    loop
    return

// オンカーブ点を算出し、bsArgoへ渡す
#deffunc bsDrawLine local xCurrent, local yCurrent
    if count > 3 {
        bsArgo x(0), y(0), x(1), y(1), (x(1) + x(2))/2, (y(1) + y(2))/2
        xCurrent = (x(1) + x(2))/2 : yCurrent = (y(1) + y(2))/2
        repeat count - 4, 2
            xNext = (x(cnt) + x(cnt + 1))/2 : yNext =  (y(cnt) + y(cnt + 1))/2
            bsArgo xCurrent, yCurrent, x(cnt), y(cnt), xNext, yNext
            xCurrent = xNext : yCurrent = yNext
        loop
        bsArgo xCurrent, yCurrent, x(count - 2), y(count - 2), x(count - 1), y(count - 1)
    } else {
        if count == 3 : bsArgo x(0), y(0), x(1), y(1), x(2), y(2)
    }
    return

// 点を描画
#deffunc bsDrawPoint
    repeat count
        circle x(cnt) - 2, y(cnt) - 2, x(cnt) + 2, y(cnt) + 2
    loop
    return

// 点を追加  最初と最後がオンカーブ点、それ以外はオフカーブ点になる
#deffunc bsAdd int x1, int y1
    x(count) = x1 : y(count) = y1
    count++
    return count

#deffunc bsClear
    count = 0
    dim x, 1 : dim y, 1
    cls 4
    return
#global

    bsClear
    onclick *addPoint
    stop

// 左クリックで制御点を追加、右クリックで制御点を削除
*addPoint
    if iparam == 0 {
        bsAdd lparam & $FFFF, lparam >> 16

        redraw 0
        color : boxf
        color 255
        bsDrawPoint
        color 255, 255, 255
        bsDrawLine
        redraw
    } else {
        if iparam == 3 : bsClear
    }
    stop