2007年6月30日土曜日

有限オートマトンによる字句解析

有限オートマトンを利用した字句解析。
文字列に対してそれが実数であるか整数であるかを判別し、その結果を返す。



// オートマトンによる字句解析
#module AUTO_MATON
/*
    STATE_FIRST         : 初期状態。          0~9でSTATE_INPUT_INTEGERへ、+-でSTATE_SIGNへ。
    STATE_SIGN          : 符号解析後。        0~9でSTATE_INPUT_INTEGERへ。
    STATE_INPUT_INTEGER : 整数部入力状態。    0~9でSTATE_INPUT_INTEGERへ、.でSTATE_INPUT_FLOATへ。
    STATE_INPUT_FLOAT   : 小数点以下入力状態。0~9でSTATE_INPUT_FLOATへ。
*/

#enum STATE_ERROR = 0
#enum STATE_FIRST
#enum STATE_SIGN
#enum STATE_INPUT_INTEGER
#enum STATE_INPUT_FLOAT

#enum global IS_ERROR = 0
#enum global IS_INTEGER
#enum global IS_FLOAT

// モジュール初期化用命令
#deffunc init
    // 受理集合に属する状態を定義
    dim canAccept, STATE_INPUT_FLOAT + 1
    canAccept(STATE_INPUT_INTEGER) = IS_INTEGER
    canAccept(STATE_INPUT_FLOAT)   = IS_FLOAT
    return

// 文字列が数値か否かを判別する関数
#defcfunc isDigit@AUTO_MATON str sArg, local tmp
    tmp = sArg : tmp = peek(tmp, 0)
    return ('0' <= tmp) & (tmp <= '9')

// 次の状態を返す関数
#defcfunc nextState@AUTO_MATON int nowState, str sArg, local result
    result = STATE_ERROR
    switch nowState
        case STATE_FIRST
            if (sArg == "+") | (sArg == "-") : result = STATE_SIGN
        case STATE_SIGN
            if isDigit(sArg) : result = STATE_INPUT_INTEGER
            swbreak
        case STATE_INPUT_INTEGER
            if isDigit(sArg) : result = STATE_INPUT_INTEGER
            if sArg = "."    : result = STATE_INPUT_FLOAT
            swbreak
        case STATE_INPUT_FLOAT
            if isDigit(sArg) : result = STATE_INPUT_FLOAT
            swbreak
        default
            // エラー
            swbreak
    swend
    return result

// 受理される文字列か否か判定する命令
#defcfunc judge str sArg, local state, local tmp
    state = STATE_FIRST : tmp = sArg
    repeat strlen(sArg)
        state = nextState(state, strmid(tmp, cnt1))
        if state == STATE_ERROR : break
    loop
    return canAccept(state)
#global
    init
// モジュールここまで

// 以下サンプルコード
    sQuestion = "+123""456""-3.14""1e-03""10.""I may be refused."
    repeat length(sQuestion)
        switch judge(sQuestion(cnt))
            case IS_INTEGER
                mes sQuestion(cnt) + "は整数として受理されます。"
                swbreak
            case IS_FLOAT
                mes sQuestion(cnt) + "は実数として受理されます。"
                swbreak
            default
                mes sQuestion(cnt) + "は受理されませんでした。"
                swbreak
        swend
    loop
    stop

2007年6月26日火曜日

VRAM操作モジュール

VRAMの操作(色の取得・点の描画)を行うモジュール。
パレットエントリの理解が曖昧なので、まだベータ版。マジックナンバーも減らせるはず。

※コピー&ペーストの問題はCSSにあったようです。対策を施したので、今回の投稿からはきちんとコピーできるはず。
// VRAM操作モジュール vram.hsp
// 【参考】http://dream.freespace.jp/puma/iroiro/struct/bmscr3.htm
#module VRAM_MODULE vram, bmscr, screenWidth, screenHeight, bitmapWidth, colorMode

#modinit int screenID, local selectedScreen
    selectedScreen = ginfo_sel

    gsel screenID
    mref vram,  66
    mref bmscr, 67
    screenWidth  = bmscr(1)
    screenHeight = bmscr(2)
    colorMode    = 3 - bmscr(3) * 2 // FULL = 3, PALETTE = 1
    bitmapWidth  = (screenWidth * colorMode + 3) / 4 * 4
    gsel selectedScreen
    return

#modfunc _outOfScreen@VRAM_MODULE int x, int y
    return (x < 0) | (y < 0) | (screenWidth <= x) | (screenHeight <= y)

#defcfunc outOfScreen@VRAM_MODULE var modVar, int x, int y
    _outOfScreen modVar, x, y
    return stat

#modfunc _index@VRAM_MODULE int x, int y
    return (screenHeight - y - 1) * bitmapWidth + x * colorMode

#defcfunc index@VRAM_MODULE var modVar, int x, int y
    _index modVar, x, y
    return stat

#modfunc getColor int x, int y, local i
    if outOfScreen(thismod, x, y) : return -1
    i = index(thismod, x, y)
    if (colorMode == 1) {
        palcolor peek(vram, i)
    } else {
        color peek(vram, i + 2), peek(vram, i + 1), peek(vram, i)
    }
    return 0

#modfunc drawPoint int x, int y, local i
    if outOfScreen(thismod, x, y) : return -1
    i = index(thismod, x, y)
    if (colorMode == 1) {
        poke vram, i, bmscr(12)
    } else {
        poke vram, i + 2ginfo_r
        poke vram, i + 1ginfo_g
        poke vram, i, ginfo_b
    }
    return 0
#global

;   screen 0, 640, 480, SCREEN_PALETTE
    newmod vramController, VRAM_MODULE, 0

    getColor vramController, 00
    dialog "左上の色は:\n" + str(ginfo_r) + "," +  str(ginfo_g) + "," + str(ginfo_b)

    color 00255
    repeat ginfo_winy / 2
        y = cnt * 2
        repeat ginfo_winx
            drawPoint vramController, cnt, y
        loop
    loop
    redraw 1

2007年6月25日月曜日

塗り絵自動生成

Rubyをいじりつつ「HSPの時はどんなスクリプトからはじめたっけ?」と思い出したものを再現。画像の輪郭を縁取って塗り絵を作るスクリプト。
同じ事をRubyでやるのは(たぶん)大変だし、HSPのグラフィックの使いやすさは高いと思う。最近自分の中では「オブジェクトをあまり使わないGUIアプリならHSP」で固定されつつある。

画像によっては勝手にredraw 1されてしまう模様。未知の不具合?
#const BORDER 30 // 閾値

*loadPicture
    dialog "bmp;*.jpg;*.gif"16
    if stat == 0 : end

    picName = refstr
    picload picName
    picWidth = ginfo_winx
    picHeight = ginfo_winy
    buffer 1, picWidth, picHeight, SCREEN_PALETTE
    repeat 255
        palette cntcntcntcnt0
    loop
    palette 2552552552551
    gcopy 000, picWidth, picHeight

*valueInit
    dim dx, 4 : dim dy, 4
    dx = 01,  0, -1
    dy = 10, -1,  0

*main
    gsel 0
    title "変換中…" : redraw 0
    color 255255255 : boxf
    color
    repeat picHeight
        y = cnt
        repeat picWidth
            x = cnt

            count = 0 : dValue = 0
            gsel 1 : pget x, y
            col = ginfo_r
            repeat 4
                if (0 <= x + dx(cnt))&(x + dx(cnt) < picWidth)&(0 <= y + dy(cnt))&(y + dy(cnt) < picHeight) {
                    pget x + dx(cnt), y + dy(cnt)
                    count++
                    dValue += abs(col - ginfo_r)
                }
            loop
            if (dValue > BORDER * count) {
                gsel 0 : pset x, y
            }

        loop
        await 1
    loop
    gsel 0 : redraw 1
    title "変換終了!"
    stop

2007年6月22日金曜日

KEMURIのインタプリタ 改訂版

KEMURIのインタプリンタ改訂版。
前回のバグの原因は仕様の勘違いでした。これで正常に動作するように。

// HSPで記述されたKEMURIのインタープリタ 改訂版
#runtime "hsp3cl"

// エラーコードの定義
#enum ERROR_NO_ERROR = 0
#enum ERROR_UNKNOWN_COMMAND
#enum ERROR_STACK_EMPTY

    goto *start

// スタック用命令をグローバル空間にて定義
#deffunc push int arg1
    if count >= 0 {
        stack(count) = arg1
        count++
    }
    return

#defcfunc pop
    count--
    if count < 0 {
        error = ERROR_STACK_EMPTY
        return 0
    }
    return stack(count)

// 処理の開始
*start
    mes "KEMURI インタープリタ v1.0"
    mes "=========================="
    mes "コマンドを入力してください"
    dim stack, 16
    gosub *get
    gosub *exe
    gosub *show
    end

// コマンドを取得する
*get
    command = ""
    input command, 01
    getstr command, command // 改行コードを取り除く
    return

// コマンドを解析し、実行
*exe
    error = ERROR_NO_ERROR
    repeat strlen(command)
        switch peek(command, cnt)
        case '^'
            x = pop() : y = pop()
            push x ^ y
            swbreak
        case '~'
            x = pop()
            push $FF ^ x
            swbreak
        case '"'
            x = pop()
            push x : push x
            swbreak
        case '\''
            x = pop() : y = pop() : z = pop()
            push x : push z : push y
            swbreak
        case '`'
            s = "Hello, world!"
            repeat strlen(s), 1
                push(peek(s, strlen(s) - cnt))
            loop
            swbreak
        case '|'
            sdim s, count + 1
            repeat count
                x = pop() & $FF
                poke s, cnt, x
            loop
            mes s
            swbreak
        default
            error = ERROR_UNKNOWN_COMMAND
            swbreak
        swend
        if error != ERROR_NO_ERROR {
            errorPos = cnt
            break
        }
    loop
    return

// 結果やエラーの表示
*show
    if error == ERROR_NO_ERROR {
        mes "処理が正常に終了しました"
    } else {
        switch error
        case ERROR_UNKNOWN_COMMAND
            mes "エラー:規定されていないコードが見つかりました"
            mes "利用できるのは\" ' ` ~ ^ |の6つのみです"
            swbreak
        case ERROR_STACK_EMPTY
            mes "エラー:空のスタックから取り出そうとしました"
            swbreak
        default
            mes "エラー:未知のエラーが発生しました"
            swbreak
        swend

        mes "エラー発生箇所:" + (errorPos + 1) + "文字目の" + strmid(command, errorPos, 1)
    }
    return

2007年6月21日木曜日

画像の完全一致検索


本家BBSにてHSPCVプラグインのcvmatchが話題になっていたので、標準命令(VRAM操作)で強引に検索するモジュールを作成。思ってたよりは高速でした。

なかなか良い変数名が思いつかず苦戦。

// VRAMを使って画像を探すモジュール(^-^;
// 速度向上のために条件分岐を減らすため、フルカラーモード専用。
// 参考:http://hspwiki.tm.land.to/?%BE%AE%A5%EF%A5%B6%2FVRAM%A4%F2%C4%BE%C0%DC%C1%E0%BA%EE%A4%B7%A4%C6%A4%DF%A4%EB
#module PicMatchModule
#const global SUCCESS 0
#const global FAILURE 1

#deffunc picMatch var xMatched, var yMatched, int idTarget, int idSource, local iResult, local targetVRAM, local sourceVRAM
    xMatched = -1 : yMatched = -1 : iResult = 0

    // ウィンドウサイズの取得
    gsel idSource : sourceWinx = ginfo_winx : sourceWiny = ginfo_winy
    gsel idTarget : targetWinx = ginfo_winx : targetWiny = ginfo_winy
    if (targetWinx < sourceWinx) | (targetWiny < sourceWiny) {
        // 画像サイズが大きすぎる
        return FAILURE
    }

    gsel idSource : mref sourceVRAM, 66
    gsel idTarget : mref targetVRAM, 66
    sourceWidth = (sourceWinx * 3 + 3) & 0xfffffffc         // VRAM1行あたりのバイト数
    targetWidth = (targetWinx * 3 + 3) & 0xfffffffc

    repeat targetWiny - sourceWiny + 1
        y = cnt                         // 検索開始位置左上Y座標
        repeat targetWinx - sourceWinx + 1
            x = cnt                     // 検索開始位置左上X座標
            iResult = SUCCESS
            repeat sourceWiny
                ty = cnt                // 調査対象座標をyから見た時の相対的なY座標
                repeat sourceWinx
                    tx = cnt            // 調査対象座標をxから見た時の相対的なX座標

                    index = (targetWiny - y - ty - 1) * targetWidth + (x + tx) * 3
                    colorTarget = (peek(targetVRAM, index + 2) << 16) | (peek(targetVRAM, index + 1) << 8) | peek(targetVRAM, index)

                    index = (sourceWiny - ty - 1) * sourceWidth + tx * 3
                    colorSource = (peek(sourceVRAM, index + 2) << 16) | (peek(sourceVRAM, index + 1) << 8) | peek(sourceVRAM, index)

                    if(colorTarget != colorSource) {
                        iResult = FAILURE
                        break
                    }
                loop
                if iResult == FAILURE : break
            loop
            if (iResult == SUCCESS) {   // マッチした
                xMatched = x : yMatched = y
                break
            }
            await 1
        loop
        if (iResult == SUCCESS) : break
    loop
    return iResult
#global

// 以下、サンプルスクリプト
    randomize
    screen 024040                   // 横幅は4の倍数でなくともよい
    mes "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    pos 020
    serch = "A"
    input serch, 160201
    pos 16020 : objsize 8020
    button gosub "検索"*serchStart
    title "検索する文字を入力してください"
    stop

*serchStart
    if serch == "" : return
    gsel 0
    color 255255255 : boxf
    color : pos 00
    mes "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    pos ginfo_winx : mes serch
    mesx = ginfo_mesx : mesy = ginfo_mesy
    buffer 1, mesx, mesy : cls 0
    pos 00 : mes serch
    gsel 0
    title "検索中..."
    picMatch x, y, 01
    if (stat == SUCCESS) {
        gsel 0 : color 255
        line x + mesx, y, x, y
        line x + mesx, y + mesy
        line x, y + mesy
        line x, y
        dialog "Match!:" + x + "," + y
    } else {
        gsel 0
        dialog "Not Match."
    }
    title "検索する文字を入力してください"
    return

2007年6月14日木曜日

KEMURIのインタプリタ

プログラミング言語KEMURIのインタープリタ。
言語をつくる基本はこんな単純なものなのでしょうね…。

エラー報告を詳しくした関係で100行オーバー。
西尾泰和さんによるPythonによる実装はこちら

どうやら正常に動作していないようです。ただいま原因解明中。// HSPで記述されたKEMURIのインタープリタ
#runtime "hsp3cl"

// エラーコードの定義
#enum ERROR_NO_ERROR = 0
#enum ERROR_UNKNOWN_COMMAND
#enum ERROR_STACK_EMPTY

    goto *start

// スタック用命令をグローバル空間にて定義
#deffunc push int arg1
    if count >= 0 {
        stack(count) = arg1
        count++
    }
    return

#defcfunc pop
    count--
    if count < 0 {
        error = ERROR_STACK_EMPTY
        return 0
    }
    return stack(count)

// 処理の開始
*start
    mes "KEMURI インタープリタ v1.0"
    mes "=========================="
    mes "コマンドを入力してください"
    dim stack, 16
    gosub *get
    gosub *exe
    gosub *show
    end

// コマンドを取得する
*get
    command = ""
    input command, 01
    getstr command, command // 改行コードを取り除く
    return

// コマンドを解析し、実行
*exe
    error = 0
    repeat strlen(command)
        switch peek(command, cnt)
        case '^'
            push pop()^pop()
            swbreak
        case '~'
            push $ff - pop()
            swbreak
        case '"'
            tmp = pop()
            push tmp : push tmp
            swbreak
        case 39 ; 'の文字コード
            z = pop() : y = pop() : x = pop()
            push y : push x : push z
            swbreak
        case '`'
            push 'H' : push 'e' : push 'l' : push 'l' : push 'o' : push ',' : push ' '
            push 'W' : push 'o' : push 'r' : push 'l' : push 'd' : push '!'
            swbreak
        case '|'
            sdim message, count + 1
            repeat count
                poke message, count-1pop()
            loop
            mes message
            swbreak
        default
            error = ERROR_UNKNOWN_COMMAND
            swbreak
        swend
        if error {
            errorPos = cnt
            break
        }
    loop
    return

// 結果やエラーの表示
*show
    switch error
    case ERROR_NO_ERROR
        mes "処理が正常に終了しました"
        swbreak
    case ERROR_UNKNOWN_COMMAND
        mes "エラー:規定されていないコードが見つかりました"
        mes "利用できるのは\" ' ` ~ ^ |の6つのみです"
        swbreak
    case ERROR_STACK_EMPTY
        mes "エラー:空のスタックから取り出そうとしました"
        swbreak
    default
        mes "エラー:未知のエラーが発生しました"
        swbreak
    swend
    if error != ERROR_NO_ERROR {
        mes "エラー発生箇所:" + errorPos + "文字目の" + strmid(command, errorPos, 1)
    }
    return

2007年6月11日月曜日

AHTファイル(2)

oncmd命令の記述を補助するかんたん入力。
よく利用されるメッセージは網羅できたか?

#aht class  "hsp3"
#aht name "oncmd自動記述"
#aht author "eller"
#aht ver "1.0"
#aht exp "oncmdの記述を補佐します。"

#define ジャンプの種類 "goto" ;; combox,pure,prm="goto\ngosub",opt="goto\ngosub"
#define ラベル名 "oncmdFlag" ;; str, pure, help="*は不要"
#define メッセージID "" ;; combox,pure,help="ジャンプする条件",prm="0x0001 // ウィンドウが作成された(WM_CREATE)\n0x0002 // ウィンドウが破棄されようとしている(WM_DESTROY)\n0x0003 // ウィンドウの移動(WM_MOVE)\n0x0005 // ウィンドウサイズ変更(WM_SIZE)\n0x0006 // ウィンドウのアクティブ化・非アクティブ化(WM_ACTIVATE)\n0x004E // コモンコントロールからの通知(WM_NOTIFY)\n0x0111 // メニューアイテムの選択・コントロールからの通知(WM_COMMAND)\n0x0100 // 非システムキーが押された(WM_KEYDOWN)\n0x0101 // 押されていた非システムキーが離された(WM_KEYUP)\n0x0102 // キーボードからの文字入力(WM_CHAR)\n0x0233 // ファイルがドロップされた(WM_DROPFILES)\n0x0201 // マウス左ボタンを押し下げ(WM_LBUTTONDOWN)\n0x0202 // マウス左ボタンを離した(WM_LBUTTONUP)\n0x0203 // マウス左ボタンをダブルクリック(WM_LBUTTONDBLCLK)\n0x0204 // マウス右ボタンを押し下げ(WM_RBUTTONDOWN)\n0x0205 // マウス右ボタンを離した(WM_RBUTTONUP)\n0x0206 // マウス右ボタンをダブルクリック(WM_RBUTTONDBLCLK)\n0x0207 // マウス中央ボタンを押し下げ(WM_MBUTTONDOWN)\n0x0208 // マウス中央ボタンを離した(WM_MBUTTONUP)\n0x0209 // マウス中央ボタンをダブルクリック(WM_MBUTTONDBLCLK)\n0x0112 // システムメニューが操作された(WM_SYSCOMMAND)",opt="ウィンドウが作成された\nウィンドウが破棄されようとしている\nウィンドウの移動\nウィンドウサイズ変更\nウィンドウのアクティブ化・非アクティブ化\nコモンコントロールからの通知\nメニューアイテムの選択・コントロールからの通知\n非システムキーが押された\n押されていた非システムキーが離された\nキーボードからの文字入力\nファイルがドロップされた\nマウス左ボタンを押し下げ\nマウス左ボタンを離した\nマウス左ボタンをダブルクリック\nマウス右ボタンを押し下げ\nマウス右ボタンを離した\nマウス右ボタンをダブルクリック\nマウス中央ボタンを押し下げ\nマウス中央ボタンを離した\nマウス中央ボタンをダブルクリック\nシステムメニューが操作された"

#ahtmes "\n// created by [oncmd自動記述.aht]"
#ahtmes "\toncmd " + ジャンプの種類 + " *" + ラベル名 + ", " + メッセージID + "\n"

2007年6月8日金曜日

ワープゾーン

d3moduleによるワープゾーンっぽい表現。

これは半年近く前に書いたスクリプトなのですが、今思うとlength()関数を使うべき箇所や悪い変数名が散見されます。
#include "d3m.hsp"
    randomize
    repeat 50
        t(cnt) = 0.02*rnd(314)
        y(cnt) = rnd(500)
    loop
    screen 0480320
    d3setcam 00007000

*main
    redraw 0
    color : boxf
    color 191,191
    repeat 50
        d3initlineto
        d3ribbonto cos(t(cnt))*100, y(cnt), sin(t(cnt))*100cos(t(cnt) + 0.05)*100, y(cnt), sin(t(cnt) + 0.05)*100
        d3ribbonto cos(t(cnt))*100, y(cnt) + 200sin(t(cnt))*100cos(t(cnt) + 0.05)*100, y(cnt) + 200sin(t(cnt) + 0.05)*100
        y(cnt) -= 20
        if y(cnt) < 0 {
            t(cnt) = 0.02*rnd(314)
            y(cnt) = rnd(700) + 200
        }
    loop
    redraw
    wait 2
    goto *main

2007年6月7日木曜日

stick命令をgetkey命令で実装する

HSP掲示板で以前話題になっていたのを思い出し、作成。
ビット演算さえ理解できれば案外簡単。

#constで定数をすべて定義しているけれど、やりすぎだったかも知れません。// stickをgetkeyで実装する [stick.hsp]
#undef stick
#module mdl_stick

// getkeyキーコード
#const GETKEY_LEFT          37
#const GETKEY_UP            38
#const GETKEY_RIGHT         39
#const GETKEY_DOWN          40
#const GETKEY_SPACE         32
#const GETKEY_ENTER         13
#const GETKEY_CTRL          17
#const GETKEY_ESC           27
#const GETKEY_LEFTCLICK      1
#const GETKEY_RIGHTCLICK     2
#const GETKEY_TAB            9

#deffunc _initStick
    dim KEY_CODE, 11
    KEY_CODE( 0 ) = GETKEY_TABGETKEY_RIGHTCLICKGETKEY_LEFTCLICK
    KEY_CODE( 3 ) = GETKEY_ESCGETKEY_CTRLGETKEY_ENTER
    KEY_CODE( 6 ) = GETKEY_SPACEGETKEY_DOWNGETKEY_RIGHT
    KEY_CODE( 9 ) = GETKEY_UPGETKEY_LEFT
    return

#deffunc _stick var vTarget, int NO_TRIGGER, int CHECK_MODE, local tmp
    vTarget = 0
    repeat length( KEY_CODE )
        getkey tmp, KEY_CODE( cnt )
        vTarget = vTarget << 1 | tmp
    loop
    if ( CHECK_MODE == 1 ) & ( ginfo_act == -1 ){
        // HSPウィンドウがアクティブでない
        prev = vTarget
        vTarget = 0
    } else {
        tmp = vTarget
        vTarget &= ( -1 ^ prev ) | NO_TRIGGER
        prev = tmp
    }
    return
#define global stick%1%2=0%3=1 ) _stick %1%2%3
#global
    _initStick       // 配列の初期化

2007年6月6日水曜日

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

逆ポーランド記法の式を解く。整数の四則演算(+-*/)のみ対応。
数値は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

2007年6月5日火曜日

文字列の置換

HSP開発Wikiに投稿したものと同じもの。
非常に大きな文字列を扱うことを想定しているため、ちっさい文字列を置換したい時は非効率です(メモリを余計に消費します)。
定数FIRST_SIZEの値を小さくするなどして改造すればOK。

利用したい方はHSP開発Wikiからダウンロードしてください。
HSP開発Wiki/Module/文字列の置換

メモリ操作に関する知識は書籍「プログラミングでメシが食えるか!?」(秀和システム)にて学ばせて頂きました。
// 置換モジュール (HSP開発Wiki) 2007/06/05      ver1.3
#module modReplace
// 【変数の説明】
//    var sTarget       置き換えしたい文字列型変数
//    str sBefore       検索する文字列が格納された変数
//    str sAfter        置換後の文字列が格納された変数
//    str sResult       一時的に置換結果を代入する変数
//    int iIndex        sResultの文字列の長さ
//    int iIns          instrの実行結果が格納される変数
//    int iStat         検索して見つかった文字列の数
//    int iNowSize      sResultとして確保されているメモリサイズ
//    int iTargetLen    sTargetの文字列の長さ(毎回調べるのは効率が悪い)
//    int iAfterLen     sAfterの文字列の長さ (      〃      )
//    int iBeforeLen    sBeforeの文字列の長さ(      〃      )
#const FIRST_SIZE       64000   // はじめに確保するsResultの長さ
#const EXPAND_SIZE      32000   // memexpand命令で拡張する長さの単位
 
// メモリ再確保の判断及び実行のための命令(モジュール内部で使用)
#deffunc _expand var sTarget, var iNowSize, int iIndex, int iPlusSize
    if (iNowSize <= iIndex + iPlusSize) {
        iNowSize += EXPAND_SIZE * (1 + iPlusSize / EXPAND_SIZE)
        memexpand sTarget, iNowSize
    }
    return
 
// 文字列内の対象文字列全てを置換する命令
#deffunc replace var sTarget, str sBefore, str sAfter, local sResult, local iIndex, local iIns, \
    local iStat, local iTargetLen, local iAfterLen, local iBeforeLen, local iNowSize
 
    sdim sResult, FIRST_SIZE
    iTargetLen = strlen(sTarget)
    iAfterLen  = strlen(sAfter)
    iBeforeLen = strlen(sBefore)
    iNowSize   = FIRST_SIZE
    iStat  = 0
    iIndex = 0
 
    repeat iTargetLen       // 検索・置換の開始
        iIns = instr(sTarget, cnt, sBefore)
        if (iIns < 0) {         // もう見つからないので、まだsResultに追加していない分を追加してbreak
            _expand sResult, iNowSize, iIndex, iTargetLen - cnt // オーバーフローを避けるため、メモリを再確保
            poke sResult, iIndex, strmid(sTarget, cnt, iTargetLen - cnt)
            iIndex += iTargetLen - cnt
            break
        } else {                // 見つかったので、置換して続行
            _expand sResult, iNowSize, iIndex, iIns + iAfterLen // オーバーフローを避けるため、メモリを再確保
            poke sResult, iIndex, strmid(sTarget, cnt, iIns) + sAfter
            iIndex += iIns + iAfterLen
            iStat++
            continue cnt + iIns + iBeforeLen
        }
    loop
 
    sdim sTarget, iIndex + 1
    memcpy sTarget, sResult, iIndex
    return iStat            // おまけ。置換した個数をシステム変数statに代入。
#global