2007年12月14日金曜日

モジュール内からグローバル空間にあるラベルへ飛ぶ

現在作成中のモジュールで必要になったのでサンプルを作成してみました。oncmdとsendmsgを利用し、モジュールから送信したメッセージをグローバル空間で受信しています。
モジュール外で「ジャンプ先のサブルーチン」を指定できるので、汎用モジュール向きと考えました。モジュール内で定義した命令の実行状況に応じた処理をしたいときなどに利用できるでしょう。

参考:HSPの裏技??:メッセージの送信とポスト

#const global WM_APP 0x8000
#module
#deffunc send_many
    sdim s, 64
    repeat 10
        s = strf("あと%d回メッセージを送信します。", 9-cnt)
        sendmsg hwnd, WM_APP, cnt, s
        wait 10
    loop
    return
#global

    oncmd gosub *get_cmd, WM_APP
    send_many
    stop

*get_cmd
    mes wparam
    dupptr message, lparam, 64, 2
    mes message
    return

2007年12月2日日曜日

相互作用が働く粒子の運動2

前回のスクリプトの改良版。
速度に上限をつけるのではなく、抵抗力による減速を導入することでより物理らしくなっています。ガタガタと動かずにきれいに収束するのも特徴です。

また、粒子の追加および初期化の機能をつけました。

Java移植版
#module member id, x, y, vx, vy
#include "hspmath.as"
// id     ... 個別認識用ID(int)
// x, y   ... 位置(double)
// vx, vy ... 速度(double)
#const  PARTY_DIST  120     // 仲間と保とうとする距離
#const  RADIUS      5       // 描画時の半径

#modinit double _x, double _y
    x = _x : y = _y : vx = 0.0 : vy = 0.0
    id = next_id : next_id++
    return

#deffunc make_member double new_x, double new_y
    newmod members, member, new_x, new_y
    return

// -----------------------------
// ここから各メンバーごとに用いる命令

// IDを返す
#modfunc get_id
    return id

// 位置を返す
#modfunc get_position array v
    v = x, y
    return

// 自分自身の速度の計算
#modfunc calc_speed
    ax = 0.0 : ay = 0.0
    // 仲間との相互作用(一定の距離を保とうとする)
    foreach members
        // 自分自身とは判定を行わない
        get_id members(cnt)
        if id == stat : continue

        // 仲間との距離を計算
        this_member_pos = x, y
        get_position members(cnt), target_member_pos
        dist = distance2(this_member_pos, target_member_pos)    // 対象の仲間との距離(double)

        // 仲間との角度を計算
        theta = atan(y - target_member_pos(1), target_member_pos(0) - x)

        // 距離に応じて加速
        s = absf(dist - PARTY_DIST) * (dist - PARTY_DIST) / 5000
        ax += cos(theta) * s
        ay += sin(theta) * s
    loop

    // 速度の変更(加速・減速)
    vx = 0.9 * (vx + ax)
    vy = 0.9 * (vy - ay)
    return

// 自分自身の移動
#modfunc move
    x = limitf(x + vx, 0, ginfo_winx)
    y = limitf(y + vy, 0, ginfo_winy)
    return

// 自分自身を描画
#modfunc draw
    circle x - RADIUS, y - RADIUS, x + RADIUS, y + RADIUS
    return

// -----------------------------
// ここから外部から呼び出す群れ全体を扱う命令

// 全員の速度を計算
#deffunc calc_all_speed
    foreach members
        calc_speed members(cnt)
    loop
    return

// 全員の移動
#deffunc move_all
    foreach members
        move members(cnt)
    loop
    return

// 全員の描画
#deffunc draw_all
    foreach members
        draw members(cnt)
    loop
    return

// 全員消去
#deffunc kill_all
    if vartype(members) != 5 : return
    foreach members
        delmod members(cnt)
    loop
    return
#global
    next_id@member = 0  // IDの初期化

// -----------------------------
// モジュールここまで

#const NUM_MEMBERS  12  // 群れを構成するメンバーの数(初期値)
    randomize
    onclick goto *flag_onclick
    title "左クリック:粒子の追加 / 右クリック:やりなおし"

*restart
    // すべてのメンバーを削除
    kill_all
    // 群れのメンバーをランダムな位置に発生
    repeat NUM_MEMBERS
        make_member rnd(ginfo_winx), rnd(ginfo_winy)
    loop
    // 色を決定
    color_h = rnd(192)

*main
    calc_all_speed  // 全員の速度を計算
    move_all        // 全員を移動
    redraw 0
        color : boxf : hsvcolor color_h, 255, 255
        draw_all        // 全員を描画
    redraw 1
    wait 3
    goto *main

*flag_onclick
    if iparam == 0 {
        // 左クリックなら、粒子を追加
        make_member mousex, mousey
        goto *main
    } else {
        // それ以外は初期化
        goto *restart
    }

2007年12月1日土曜日

相互作用が働く粒子の運動

HSPコンテスト2007にて株式会社秀和システム章を受賞しました。
おにたまさんから「ある意味ではモジュールの達人」と言っていただけまして、とても嬉しいです。モジュール(変数)は1時期とっても勉強した部分なので……。
モジュール変数の扱いをもっと勉強していきたいですね。

というわけで受賞記念に、得意(?)のモジュールを利用したスクリプトを。
「遠い時はくっつきたがるけど、近い時は離れたがる」という特殊な粒子の運動のシミュレートです。現実では原子がこれにあたります。3次元ですが。

ひとつのモジュール変数でひとつの粒子を表しています。決まった距離を保つために、距離の2乗に従って速度を算出しています。力学のポテンシャルの考え方に近いでしょうか。

粒子数が同じなら、最初の条件が違っても大抵は同じ陣形に収束するのが面白いです。
#module member id, x, y, vx, vy
#include "hspmath.as"
// id     ... 個別認識用ID(int)
// x, y   ... 位置(double)
// vx, vy ... 速度(double)
#const  PARTY_DIST  120     // 仲間と保とうとする距離
#const  MAX_SPEED   4       // 最大スピード
#const  RADIUS      5       // 描画時の半径

#modinit int _x, int _y
    x = _x : y = _y
    id = next_id : next_id++
    return

#deffunc make_member double new_x, double new_y
    newmod members, member, new_x, new_y
    return

// -----------------------------
// ここから各メンバーごとに用いる命令

// IDを返す
#modfunc get_id
    return id

// 位置を返す
#modfunc get_position array v
    v = x, y
    return

// 自分自身の速度の計算
#modfunc calc_speed
    ax = 0.0 : ay = 0.0
    // 仲間との相互作用(一定の距離を保とうとする)
    foreach members
        // 自分自身とは判定を行わない
        get_id members(cnt)
        if id == stat : continue

        // 仲間との距離を計算
        this_member_pos = x, y
        get_position members(cnt), target_member_pos
        dist = distance2(this_member_pos, target_member_pos)    // 対象の仲間との距離(double)

        // 仲間との角度を計算
        theta = atan(y - target_member_pos(1), target_member_pos(0) - x)

        // 距離に応じて加速
        s = (dist - PARTY_DIST) * (dist - PARTY_DIST) * sgn(dist - PARTY_DIST) / 150
        ax += cos(theta) * s
        ay += sin(theta) * s
    loop

    // 速度の変更
    vx += ax : vy -= ay
    // 速度が大きすぎる場合は調節する
    velo = sqrt(vx * vx + vy * vy)
    if absf(velo) > MAX_SPEED {
        velo = limitf(velo, -MAX_SPEED, MAX_SPEED)
        theta = atan(vy, vx)
        vx = cos(theta) * velo
        vy = sin(theta) * velo
    }
    return

// 自分自身の移動
#modfunc move
    x = limitf(x + vx, 0, ginfo_winx)
    y = limitf(y + vy, 0, ginfo_winy)
    return

// 自分自身を描画
#modfunc draw
    circle x - RADIUS, y - RADIUS, x + RADIUS, y + RADIUS
    return

// -----------------------------
// ここから外部から呼び出す群れ全体を扱う命令

// 全員の速度を計算
#deffunc calc_all_speed
    foreach members
        calc_speed members(cnt)
    loop
    return

// 全員の移動
#deffunc move_all
    foreach members
        move members(cnt)
    loop
    return

// 全員の描画
#deffunc draw_all
    foreach members
        draw members(cnt)
    loop
    return

#global
    next_id@member = 0  // IDの初期化

// -----------------------------
// モジュールここまで

#const NUM_MEMBERS  12  // 群れを構成するメンバーの数
    // 群れのメンバーをランダムな位置に発生
    randomize
    repeat NUM_MEMBERS
        make_member rnd(ginfo_winx), rnd(ginfo_winy)
    loop

*main
    calc_all_speed  // 全員の速度を計算
    move_all        // 全員を移動
    redraw 0
        color : boxf : color ,,255
        draw_all        // 全員を描画
    redraw 1
    wait 3
    goto *main

2007年11月29日木曜日

Excelによる円グラフの描画

先ほどアップしたスクリプトは円グラフのサンプルとしては分かりづらかったので、よりシンプルなものを作成しました。

なお棒グラフの描画はHSP-NEXTさんにサンプルがあります。
// 参考
// ・日経ソフトウェア 2008年1月号
// ・HSP-NEXT HSPサンプル蔵(COMオブジェクト編)
//      http://hspnext.com/hspkura/hspkura11.htm

    newcom xlApp, "Excel.Application"
    xlApp("Visible") = 1            // ウィンドウを表示
    xlApp("DisplayAlerts") = 0      // 警告メッセージを表示させない
    xlBooks = xlApp("Workbooks")    // Workbooks コレクション取得
    xlBook = xlBooks("Add")         // ワークブックを追加
    xlSheet = xlBook("Worksheets", "sheet1")    // シート取得

    // データの書き込み
    repeat 5
        xlRange = xlSheet("Range", "A" + (cnt + 1))     // 代入先セルの指定
        xlRange("Value") = rnd(70) + 30                 // 値の代入
    loop

    // グラフの作成
    xlCharts = xlApp("Charts")
    xlChart = xlCharts("Add")
    xlChart("ChartType") = 5                // 円グラフ(xlPie = 5)
    xlRange = xlSheet("Range", "A1:A5")     // データの範囲
    xlChart -> "SetSourceData" xlRange, 2   // グラフの元データを指定
    xlChart -> "Location" 2, "sheet1"       // グラフの位置(既存のシートに貼り付け)

    // COMオブジェクト型変数の破棄
    delcom xlRange  : delcom xlChart
    delcom xlCharts : delcom xlSheet
    delcom xlBook   : delcom xlBooks
    delcom xlApp

    stop

拡張子ごとの合計ファイルサイズを求める

任意のフォルダ内にあるファイルのサイズを取得し、拡張子ごとに分類・合計して出力します。
最もサイズの大きいファイルが調べられて、少し楽しいかも知れません。私の場合は素材として保存してあるBMPファイルが最大でした。HSPスクリプトは60MB、ちょっと少ないかも知れません。

// 参考
// ・日経ソフトウェア 2008年1月号
// ・HSP開発wiki COMDictionary
//      http://hspwiki.tm.land.to/?COMDictionary
// ・HSP-NEXT HSPサンプル蔵(COMオブジェクト編)
//      http://hspnext.com/hspkura/hspkura11.htm

#include "hspext.as"
    // Dictionaryの準備
    newcom dc, "Scripting.Dictionary"
    comres comret
    dc("compareMode") = 1   // 大文字・小文字を同一視

    sdim exts, 8, 10        // 拡張子名を代入する配列変数
    ext_num = 0             // 拡張子の種類数

    // 処理開始
    gosub *select_folder    // 検索対象フォルダの指定
    gosub *get_data         // ファイルを検索しデータを作成
    gosub *make_graph       // Excelによるグラフの作成

    // Dicitonaryの破棄
    delcom dc
    end

*select_folder
    target_folder = ""
    selfolder target_folder, ""
    if stat == 1 {
        dialog "フォルダの選択がキャンセルされました。"
        end
    }
    return

*get_data
    mes "データを取得しています..."
    notesel file_list
    sdim file_list, 1024
    sdim folder_names, 256, 10
    sdim file_name, 256
    sdim folder_name, 256
    folder_names(0) = target_folder
    folder_num = 0

    // 選択したフォルダの中にあるファイルをすべて検索
    // 再帰を利用しない方法
    repeat
        chdir folder_names(folder_num)
        // ファイル一覧を取得
        dirlist file_list, "*", 1
        repeat stat
            noteget file_name, cnt
            exist file_name
            if strsize > 0 {
                file_size = strsize
                ext = getpath(file_name, 2) // 拡張子を取り出す
                dc -> "Exists" ext

                if comret {
                    // すでにデータが存在している場合
                    file_size += dc("Item", ext)
                    dc -> "Remove" ext      // Itemプロパティに対する上書きがうまくいかないので、いったん消去
                } else {
                    // まだデータが存在していない場合
                    exts(ext_num) = ext
                    ext_num++
                }
                dc -> "Add" ext, file_size
            }
        loop

        // フォルダー一覧を取得
        dirlist file_list, "*", 5
        folder_num--
        repeat stat
            // カレントフォルダにあるフォルダの名前を
            // ひとつずつfolder_namesへ代入
            folder_num++
            noteget folder_name, cnt
            folder_names(folder_num) = dir_cur + "\\" + folder_name
        loop
        if folder_num < 0 : break
        await 1
    loop
    mes "データ取得が終了しました。"
    return

*make_graph
    mes "グラフを作成しています..."
    newcom xlApp, "Excel.Application"
    xlApp("Visible") = 1            // ウィンドウを表示
    xlApp("DisplayAlerts") = 0      // 警告メッセージを表示させない
    xlBooks = xlApp("Workbooks")    // Workbooks コレクション取得
    xlBook = xlBooks("Add")         // ワークブックを追加
    xlSheet = xlBook("Worksheets", "sheet1")    // シート取得

    // データの書き込み(拡張子ごとのデータ)
    repeat ext_num
        xlRange = xlSheet("Range", "A" + (cnt + 1))         // 代入先セルの指定
        xlRange("Value") = exts(cnt)                        // 値の代入
        xlRange = xlSheet("Range", "B" + (cnt + 1))         // 代入先セルの指定
        xlRange("Value") = dc("Item", exts(cnt))            // 値の代入
    loop
    // データの書き込み(合計値の算出)
    xlRange = xlSheet("Range", "A" + (ext_num + 1))     // 代入先セルの指定
    xlRange("Value") = "合計"                           // 値の代入
    xlRange = xlSheet("Range", "B" + (ext_num + 1))     // 代入先セルの指定
    xlRange("Value") = "=SUM(A1:B" + ext_num + ")"      // 値の代入

    // グラフの作成
    xlCharts = xlApp("Charts")
    xlChart = xlCharts("Add")
    xlChart("ChartType") = 5                        // 円グラフ
    xlRange = xlSheet("Range", "A1:B" + ext_num)    // データの範囲
    xlChart -> "SetSourceData" xlRange, 2           // グラフの元データを指定
    xlChart -> "Location" 2, "sheet1"               // グラフの位置(既存のシートに貼り付け)

    // COMオブジェクト型変数の破棄
    delcom xlRange  : delcom xlChart
    delcom xlCharts : delcom xlSheet
    delcom xlBook   : delcom xlBooks
    delcom xlApp

    mes "グラフを作成しました。"
    return

2007年11月27日火曜日

IEコンポーネントによるRSSリーダー

本家BBSにて、動的にHTMLを記述するスクリプトを見て作成。
IEはあまり好きではないのですが(普段はFxを使用)、ほぼすべての環境で動作する点が長所ですね。
hspailさんのスクリプトをほぼそのまま流用しています(感謝!)が、とても基本的なスクリプトなので著作権は発生しないと考え、無許可で載せています。

ついでにmod_rss.asを利用してみました。mod_rss.as内部ではCOMを利用しています。
#include "mod_rss.as"
//  RSSリーダーサンプル
//  付属サンプル(rssload.hsp)を改造
//  また、HSPTV!のBBSよりhspailさんのスクリプトを参考とさせていただきました。
    title "Loading..."

    url="http://hspwiki.tm.land.to/?cmd=rss&ver=1.0"
    rssload desc, link, url, 15

    if stat == 1 : dialog "取得に失敗しました。" : end
    if stat == 2 : dialog "RSSではありません。" : end

    axobj ie, "Shell.Explorer.2", ginfo_winx, ginfo_winy
    if stat == -1 {
        dialog "ActiveXコントロールの配置に失敗しました。", 1
        end
    }

    title url
    code = {"<html><body>
\t<p>クリックすると別ウィンドウでリンク先を開きます。</p>
\t<ol>\n"}


    foreach desc
        code += "\t<li><a href=\"" + link(cnt) + "\" target=\"_blank\">" + desc(cnt) + "</a></li>\n"
    loop
    code += "\t</ol>\n</body></html>"

    ie -> "Navigate" "about:blank"
    doc = ie("Document")

    doc -> "write" code
    stop

2007年11月11日日曜日

閉塞領域の塗りつぶし

ペイントツールお約束の機能も、APIを使えば簡単に実装できます。
昔はSRPGの経路探索を応用したりしてモジュールを組んでたのですが……今思えば結構無茶してますね。

なおHSP2.61用のスクリプトはCrimson Forestさんにあるようです。
// 参考
// http://msdn.microsoft.com/library/ja/default.asp?url=/library/ja/jpgdi/html/_win32_extfloodfill.asp
#include "gdi32.as"
#module
#const FLOODFILLSURFACE 1
// カレントカラーで(x, y)を含む同色領域を塗りつぶす
// 実際の画面に反映させるには redraw 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

    repeat 5
        hsvcolor 191 * cnt / 5, 255, 255
        boxf rnd(640), rnd(480), rnd(640), rnd(480)
    loop
    onclick gosub *do_fill
    stop
*do_fill
    hsvcolor rnd(192), 255, 255
    fill mousex, mousey
    redraw 1
    return