DouKaku? Language detail: HSP

HSP2.xxでは動かない…かもしれません。

#include "hspext.as"
clipset "テスト"
sdim clip,3
clipget clip
mes clip

ミリ秒まで含んだ時刻文字列 (Nested Flatten)

HSP 3.2 では strf で複数引数に対応します。
3.0、3.1では面倒ですが一つ一つ strf 関数を使った結果を連結していきます。

; 3.0, 3.1
mes strf("%04d",gettime(0))+strf("%02d",gettime(1))+strf("%02d",gettime(3))+strf("%02d",gettime(4))+strf("%02d",gettime(5))+strf("%02d",gettime(6))+"."+strf("%03d",gettime(7))
; 3.2
mes strf("%04d%02d%02d%02d%02d%02d.%03d", gettime(0), gettime(1), gettime(3), gettime(4), gettime(5), gettime(6), gettime(7))

Hello, world! (Nested Flatten)

HSPによる別解です。

#uselib "user32.dll"
#func MessageBoxA "MessageBoxA" sptr, sptr, sptr, sptr
outString="Hello World!"
capString="Win32HSP"
MessageBoxA hwnd, outString, capString, 0x0
stop

文字列のセンタリング (Nested Flatten)

より単純なスクリプトです。まず指定された長さの半角スペース列を用意し、次に文字列をpokeで書きこんでいます。

#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

対象文字列の長さによって分岐しています。露骨すぎてスマートとは言えないでしょう。

#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

ポリゴンを表示するプログラム (Nested Flatten)

HSP 3.1以降に標準添付のライブラリ d3module を使って。

#include "d3m.hsp"
    
    xs = -1, 1, 1,-1
    ys = -1,-1, 1, 1
    
    repeat
        redraw 0
        color 255, 255, 255 : boxf
        d3setcam 1500, 0, 500
        color
        d3initlineto
        rad = 0.05 * cnt
        repeat 5
            x = xs(cnt\4) * 500
            y = ys(cnt\4) * 500
            d3rotate x, y, x, y, rad
            d3lineto x, y, 0
            d3line x, y, 0, 0, 0, 700
            d3line x, y, 0, 0, 0, -700
        loop
        redraw
        await 40
    loop

自由意志をプログラムする (Nested Flatten)

自由意志をプログラムしたプログラムを作ってください。

自由とは何でしょう？
意志とは何でしょう？

三つの四角の内、自由意志を持った四角はあるでしょうか？

    WinSizeX = 600 : WinSizeY = 480
    screen 0, WinSizeX, WinSizeY, 0, (ginfo_dispx - WinSizeX) / 2, (ginfo_dispy - WinSizeY) / 2
    title "" : font "", 40 : randomize

    #const NUM 3
    #const SIZEX 100
    #const SIZEY 100

    dim Number, NUM : GoNum = 0
    dim PosX, NUM : dim PosY, NUM
    PosXIdx = (ginfo_winx - SIZEX * (NUM * 2 - 1)) / 2


*main

    //数値を決める

        NowSec = gettime(6)

        if NowSec ! PreSec {    //1秒毎の処理

            if GoNum = 0 : Number(GoNum) = Number(1) * 2
            if GoNum = 1 : Number(GoNum) = rnd(100)
            if GoNum = 2 : Number(GoNum) = rnd(10) * 10

            GoNum ++ : if GoNum = NUM : GoNum = 0

        }

        PreSec = gettime(6)


    //描画

        redraw 0

        color 255, 0, 128
        repeat NUM
            _cnt = cnt * 2
            PosX(cnt) = _cnt * SIZEX + PosXIdx : PosY(cnt) = (ginfo_winy - SIZEY) / 2
            boxf PosX(cnt), PosY(cnt), PosX(cnt) + SIZEX, PosY(cnt) + SIZEY
        loop

        color 255, 255, 128
        repeat NUM
            pos PosX(cnt) + 30, PosY(cnt) + 30 : mes Number(cnt)
        loop

        redraw 1


    await : goto *main

文字変換表に基く文字列の変換 (Nested Flatten)

前から HSPの黒魔術であるVRAMでテキスト処理をする方法をどう書く？orgのお題で使えないかなーと思っていたのですが、ようやく使うときがきました。

#module
#defcfunc tr str _text, str _tr1, str _tr2
    text = _text
    len = strlen( text )
    osel = ginfo_sel
    buffer 29, len, 1, 1
    mref vram, 66
    memcpy vram, text, len
    tr1 = _tr1 : tr2 = _tr2
    tr_len = strlen( tr1 )
    repeat tr_len
        c = peek(tr1, cnt)
        palette peek(tr2,cnt), c, c, c, cnt==(tr_len-1)
    loop
    buffer 30, len, 1, 1
    repeat 256
        palette cnt, cnt, cnt, cnt, cnt==255
    loop
    gmode 0, len, 1
    gcopy 29
    mref vram, 66
    memcpy text, vram, len
    gsel osel
    return text
#global

mes tr( "Hello world!!", "ABCDEFGHIJKLMNOPQRSTUVWXYZ", "abcdefghijklmnopqrstuvwxyz" )

フォルダパス一覧のツリー構造への変換 (Nested Flatten)

モジュール変数をツリー構造に使用しています。

see: モジュール変数でツリー ( Fuji Diablog )

#module m_tree children, content

#modinit str _content
#define global new_tree( %1, %2 = "" ) newmod %1, m_tree, %2
    content = _content
    dimtype children, 5, 1
    return

#defcfunc get_tree_content modvar m_tree@
    return content

#modfunc get_tree_child str _content, var result
    f = -1
    foreach children
        if get_tree_content( children.cnt ) != _content : continue
        f = cnt
        break
    loop
    if f >= 0 : result = children.f : return
    new_tree children, _content
    result = children( length(children) - 1 )
    return

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

#global

paths = {"
    abc\\def
    abc\\def\\gh
    abc\\def\\ij
    abc\\jk\\lm
    de"}

new_tree tree, "ROOT"
paths_index = 0
repeat
    getstr path, paths, paths_index
    if strsize == 0 : break
    paths_index += strsize
    t = tree
    path_index = 0
    repeat
        getstr v, path, path_index, '\\'
        if strsize == 0 : break
        path_index += strsize
        get_tree_child t, v, t
    loop
loop

show_tree tree

JPEGをGETして色反転して保存 (Nested Flatten)

> これじゃあまりにアレなので、後ほどIImgCtxとhspcvを使ったきちんとしたのも投稿したいです。
というわけで投稿。

#include "hspcv.as"
#define IID_IImgCtx   "{3050f3d7-98b5-11cf-bb82-00aa00bdce0b}"
#define CLSID_IImgCtx "{3050f3d6-98b5-11cf-bb82-00aa00bdce0b}"

#usecom  ImgCtx IID_IImgCtx CLSID_IImgCtx
#comfunc IImgCtx_Load 3 wstr,int
#comfunc IImgCtx_GetStateInfo 8 var,var,int
#comfunc IImgCtx_StretchBlt 12 int,int,int,int,int,int,int,int,int,int

    load_url = "http://www.example.com/examle.jpg"
    save_file_name = "save.jpg"

    newcom pImage, ImgCtx
    IImgCtx_Load pImage, load_url, 0
    dim size, 4
    repeat
        IImgCtx_GetStateInfo pImage, flg, size, 1
        if ( flg & 0x00200000 )==0 : break
        wait 4
    loop
    IImgCtx_GetStateInfo pImage, flg, size, 0
    buffer 1, size(0), size(1)
    IImgCtx_StretchBlt pImage, hdc, 0, 0, size(0), size(1), 0, 0, size(0), size(1), 0xCC0020
    delcom pImage

    cvbuffer 0, size(0), size(1)
    cvputimg 0
    cvxors
    cvsave save_file_name, 0

ローカルのJPEGファイルを読み込んで色反転して表示するだけなら、なんのプラグインやモジュールも使わずに出来るのになーとか思いましたが。
mod_imgとbmpsaveを使ってみました＞＜
画像サイズが幅が640px、高さが480pxより大きいときっと切れてしまうと思います。
保存はBMPでしかできません＞＜
これじゃあまりにアレなので、後ほどIImgCtxとhspcvを使ったきちんとしたのも投稿したいです。

#include "mod_img.as"
buffer 2
imgload "http://www.example.com/example.jpg"
w=size@mod_imgctx:h=size@mod_imgctx.1
buffer 1,w,h
gmode 6,w,h,256
gcopy 2
dialog "bmp",17
if stat:bmpsave refstr

コマンドライン引数の取得 (Nested Flatten)

dirinfo関数で取得できます。専用のマクロdir_cmdlineも用意されています。

1	mes dir_cmdline // = mes dirinfo(4)

２進数の記述 (Nested Flatten)

HSP にはソース中に２進数を定数として書く方法として '0b' や '%' のプレフィックスがあります。

1 2	mes 0b01101001 mes %01101001

重複無し乱数 (Nested Flatten)

#module
#deffunc bingo int n
    dim dest, n
    repeat n
        dest.cnt = cnt+1
    loop
    repeat n
        r = rnd( n - cnt ) + cnt
        tmp = dest.r
        dest.r = dest.cnt
        dest.cnt = tmp
    loop
    buf = ""
    repeat n
        if ( cnt > 0 ) {
            buf += " "
        }
        buf += str( dest.cnt )
    loop
    mes buf
    return
#global
randomize
bingo 10
bingo 3
bingo 3
bingo 10

文字列の均等分割 (Nested Flatten)

ジュースを複数のグラスに注ぎ分ける時と同じような考え方です。
投稿間際に確認したところ、ところてん さんと同じ手法のようですね。

// 入力される値が2byte文字のみと仮定
#module
#deffunc divid str _target, int num
    if (num <= 0) : return

    target = _target
    dim result, num
    count = 0
    repeat strlen(target) >> 1
        result(count) += 2
        count++
        if(count == num) : count = 0
    loop
    count = 0
    repeat num
        mes strmid(target, count, result(cnt))
        count += result(cnt)
    loop
    return
#global
    sample = "ゆめよりもはかなき世のなかをなげきわびつゝあかしくらすほどに四月十よひにもなりぬれば木のしたくらがりもてゆく"
    divid sample, 4
    divid sample, 5
    divid sample, 6

変形Fizz-Buzz問題 (Nested Flatten)

安直。
#defcfuncの使い方にはまった。
（#module/#globalにはさむ）

#module
#defcfunc message int n
    msg = ""
    if n \ 3 == 0 : msg += "Fizz"
    if n \ 5 == 0 : msg += "Buzz"
    if strlen(msg) == 0 : msg += "hoge"
    return str(n) + ":" + msg
#global

repeat 20
    mes message(1 + cnt)
loop

ダブル完全数 (Nested Flatten)

どう書く？org 1108 ocean: ICPCチックですね。動的計画法風に・・...(ダブル完全数) - 投稿の詳細やどう書く？org 1133 JDO: 素数を求めるアルゴリズム「エラストテネス...(ダブル完全数) - 投稿の詳細で使われているアルゴリズムを使いました。

#runtime "hsp3cl"
#const N 10000

    dim sum, N+1
    measure = 1
    repeat
        if measure > N/2 : break
        i = measure * 2
        repeat
            if i > N : break
            sum.i += measure
            i += measure
        loop
        measure ++
    loop

    i = 1
    repeat
        if i > N : break
        if sum.i == i * 2 : mes i
        i ++
    loop
    mes "以上"

倍数になる13進数 (Nested Flatten)

#module
#defcfunc convert int x
    val = str( x )
    result = 0
    repeat strlen( val )
        result *= 13
        result += peek( val, cnt ) - '0'
    loop
    return result
#global

    repeat , 10
        if ( convert( cnt ) == ( cnt * 2 ) ) {
            dialog str( cnt )
            break
        }
    loop

Hello, world!その２ (Nested Flatten)

HSP では文字列以外の大文字小文字の区別がないので、区別しないでやってみました。”いかれ具合”は高いと思います。小さなウィンドウが 34 個出ますので、実行するときは気をつけてください。

_0(   0 ) =  31,  13,  11,  73,  38,  44,  48,   8,  78,  16,  11,  69
_0(  12 ) = 111,  51,  37,   9, 138,  35,  10,  22, 112,  28,  32,  11
_0(  24 ) = 108,  33,  10,  46, 110,  74,  30,  10, 161,  10,   9,  74
_0(  36 ) = 193,   9,   9,  72, 228,  32,  27,   9, 249,  37,  12,  39
_0(  48 ) = 225,  76,  31,  10, 221,  36,  10,  44, 273,  77,  15,  11
_0(  60 ) = 280,  84,   7,  14, 335,  44,   9,  40, 359,  33,  12,  51
_0(  72 ) = 338,  80,  53,   9, 383,  47,  14,  45, 412,  36,  31,   8
_0(  84 ) = 438,  39,   9,  43, 412,  78,  29,   7, 405,  41,  12,  40
_0(  96 ) = 461,  34,   9,  53, 464,  44,  29,  10, 503,  10,   8,  73
_0( 108 ) = 564,  10,  10,  78, 540,  40,  28,   9, 532,  45,  11,  39
_0( 120 ) = 536,  76,  32,  10, 592,  13,  12,  52, 591,  75,  14,  12

_1 = 0
do
    bgscr _1 + 1, _0( _1 + 2 ), _0( _1 + 3 ), 0, _0( _1 + 0 ), _0( _1 + 1 )
    _1 += 4
until _1 > 128

ウィンドウの表示 (Nested Flatten)

ふざけんなHSPの恥さらしめ。
設問をちゃんと読め。

1	title "こんにちは、GUI！": width 100,75, (ginfo_dispx-100)/2, (ginfo_dispy-75)/2

DouKaku?

Language detail: HSP

Unsolved challenges

codes

Index

Feed

Other

Link

Pathtraq