DouKaku?beta

Language detail: HSP

Coverage: 22.84%
number of '+' ratings
 contribution for coverage

Unsolved challenges

show all

codes

Feed

Used modules

next >>

Twitterへの投稿 (Nested Flatten)

2時間近くソケット＆HTTPと格闘していましたが、axobj使ったら3行で解決してしまいました。

1
2
3
    axobj xml,"Msxml2.XMLHTTP"
    xml->"open" "POST","http://twitter.com/statuses/update.json","false","ID","パスワード"
    xml->"send" "status=投稿するメッセージ"
シードを固定した乱数 (Nested Flatten) 
組み込みの機能で。

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
#const CONST_SEED 32

*main
    dim pt, 2, 2
    
    repeat
        gosub *LResetPoint
        gosub *LRedraw
        
        wait 120
    loop
    stop
    
*LResetPoint
    dim pt, 2, 2
    
    // 座標4点は固定シード
    randomize CONST_SEED
    repeat length2(pt)
        pt(0, cnt) = rnd(640), rnd(480)
    loop
    
    return
    
*LRedraw
    redraw 2
    color : boxf
    
    // 色は適当シード => 毎回変化する
    randomize
    color rnd(256), rnd(256), rnd(256)
    boxf pt(0, 0), pt(1, 0), pt(0, 1), pt(1, 1)
    
    redraw
    return
出力の一時停止と再開 (Nested Flatten) 
仕様を満たしていませんでしたので、*LOnKey のルーチンを訂正いたします。
1
2
3
4
5
6
7
*LOnKey
    if ( iparam == 'P' ) {
        bOutput = ( bOutput == false )
    } else : if ( iparam == 'Q' ) {
        end
    }
    return

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
#ifndef __UserDefHeader__
 #define true  1
 #define false 0
#endif

*main
    bOutput = true        // 出力するかどうか
    onkey gosub *LOnKey
    
    goto *mainlp
    
*mainlp
    if ( bOutput ) {
        print "a"
    }
    
    wait 100
    goto *mainlp
    
*LOnKey
    if ( iparam == 'Q' ) {
        bOutput = ( bOutput == false )
    }
    return
急勾配の判定 (Nested Flatten)

後ろから反復してみました。

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
#module

#define true  1
#define false 0

#defcfunc IsSteepSlope array arr,  \
    local size, local nowSum, local bResult
    
    size    = length(arr)
    nowSum  = 0
    bResult = true
    
    repeat size, 1
        if ( cnt == 1 || nowSum < arr(size - cnt) ) {
            nowSum += arr(size - cnt)
            
        } else {
            bResult = false
            break
        }
    loop
    
    return bResult
    
#global

    list = 128, 64, 32, 16, 8, 4
    mes IsSteepSlope(list)
    stop
倍数になる13進数 (Nested Flatten) 
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
#ifndef powf
 #include "hspmath.as"
 #define global pow powf
#endif

#module

#define ctype cwhich_int(%1,%2,%3) \
    ( ((%2) * ((%1) != 0)) || ((%3) * ((%1) == 0)) )

//------------------------------------------------
// 数字列を10進数値に変換する
//------------------------------------------------
#defcfunc ChangeRadix_toDigit str _sInput, int fromRadix,  \
    local sInput, local result
    
    if ( fromRadix <= 0 ) { return 0 }
    
    sInput = getpath(_sInput, 16)
    len    = strlen(sInput)
    result = 0
    
    repeat len
        c       = peek(sInput, len - (cnt + 1))
        n       = cwhich_int(c >= 'a', c - 'a' + 10, c - '0')
        result += n * int(powf(fromRadix, cnt))
    loop
    
    return result
    
#global

*main
    // 総当たりで解く
    repeat , 10
        snum = str(cnt)
        
        numOf13rdx = int( ChangeRadix_toDigit(snum, 13) )
        numOf10rdx = cnt
        
        if ( numOf13rdx \ numOf10rdx == 0 ) {
            x = cnt
            break
        }
    loop
    
    dialog "A. x = "+ x
    end
コマンドライン引数の取得 (Nested Flatten)

コマンドライン文字列は dir_cmdline で得られるので、配列変数に格納・羅列する所まで。

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
// No.118 : コマンドライン文字列を取得する

#module mod_lexCmdline

#define true  1
#define false 0

#define success 1
#define failure 0

//------------------------------------------------
// コマンドライン文字列を解析し、分解する
//------------------------------------------------
#define global LexCmdline(%1=cmdopt@,%2=-1,%3=dir_cmdline) \
    _LexCmdline %1,%2,%3
#deffunc _LexCmdline array cmdopt, int cntMax, str _cmdline,  \
    local cmdline, local index,  local c,\
    local bInQuote, local cQuote,  local cntOpt, \
    local lenOpt, local iOptBegin
    
    if ( cntMax < 0 ) {
        sdim cmdopt, 320, 10
    } else {
        sdim cmdopt, 320, cntMax
    }
    
    if ( cntMax == 0 ) { return }
    
    cmdline   = _cmdline
    index     = 0
    bInQuote  = false
    cQuote    = 0
    cntOpt    = 0
    lenOpt    = 0
    iOptBegin = -1
    
    // 分解処理
    repeat
        c = peek(cmdline, index)
        
        // 終端文字
        if ( c == 0 ) {
            if ( lenOpt > 0 ) { gosub *LGetOption }
            break
            
        // 引用符発見 ( 引用符は cmdopt に含めない )
        } else : if ( c == '\'' || c == '"' ) {
            // 引用符の開始
            if ( bInQuote == false ) {
            
                if ( iOptBegin < 0 ) { iOptBegin = index + 1 }
                bInQuote = true
                cQuote   = c
                
            // 引用符の終了
            } else : if ( cQuote == c ) {
                
                bInQuote = false
                cQuote   = 0
                
                gosub *LGetOption
                if ( stat == failure ) { break }
                
            // 関係ない文字
            } else {
                lenOpt ++
            }
            
        // 引用符外の空白発見
        } else : if ( c == ' ' && bInQuote == false ) {
            
            if ( lenOpt ) {
                gosub *LGetOption
                if ( stat == failure ) { break }
            } else {
                /* ignore */
            }
            
        // その他の文字
        } else {
            if ( iOptBegin < 0 ) { iOptBegin = index }
            lenOpt ++
        }
        index ++
    loop
    
    return cntOpt
    
*LGetOption
    cmdopt( cntOpt ) = strmid( cmdline, iOptBegin, lenOpt )
    cntOpt ++
    lenOpt    = 0
    iOptBegin = -1
    
    if ( cntMax > 0 && cntOpt == cntMax ) {
        return failure
    }
    return success
    
#global

    LexCmdline //,, "a b c d"
    repeat stat
        mes strf("(%2d) ", cnt) + cmdopt(cnt)
    loop
    stop
設定ファイルから値を取得 (Nested Flatten)

INIファイルを使い、ローマ字を漢字に変換します (林檎、葡萄、蜜柑に対応)。 作成と削除もスクリプト側が行います。

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
#uselib "kernel32.dll"
#func   global WritePrivateProfileString "WritePrivateProfileStringA" sptr,sptr,sptr,sptr
#func   global GetPrivateProfileString   "GetPrivateProfileStringA"   sptr,sptr,sptr,int,int,sptr

#define global SetIniName(%1) sdim INIPATH, 260 : INIPATH = str(%1)
#define global INIPATH _ininame@

#define global WriteIni(%1,%2,%3,%4=INIPATH) WritePrivateProfileString %1,%2,str(%3),%4
#define global WriteStrIni(%1,%2,%3,%4=INIPATH) WriteIni %1,%2,"\""+ (%3) +"\"",%4
#define global WriteIntIni WriteIni

#define global GetIni(%1,%2,%3,%4=64,%5="",%6=INIPATH) GetPrivateProfileString %1,%2,str(%5),varptr(%3),%4,%6

#module

#deffunc __ClearnUp onexit
    gosub *LDestroyTestIniFile@
    return
    
#global

#runtime "hsp3cl"

    SetIniName dir_mydoc +"\\_____test_____.ini"
    sdim sResult
    sdim sInput, 321
    
    gosub *LCreateTestIniFile
    
    goto *LMainLoop
    
*LMainLoop
    input  sInput, 320, 1
    getstr sInput, sInput        // 改行を払う
    if ( sInput == "exit" ) { end : end }
    
    gosub *LToKanji
    
    print sResult
    
    wait 10
    goto *LMainLoop
    
*LToKanji
    GetIni "KanjiFromAlphabet", sInput, sResult, 320 - 1, "I don't know."
    return
    
*LCreateTestIniFile
    sData = {"
        [KanjiFromAlphabet]
        ringo=\"林檎\"
        mikan=\"蜜柑\"
        budou=\"葡萄\"
        
    "}
    notesel sData
    notesave INIPATH
    noteunsel
    return
    
*LDestroyTestIniFile
    exist INIPATH
    if ( strsize >= 0 ) {
        delete INIPATH
    }
    return
環境変数の取得 (Nested Flatten) 
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
#include "mod_getenv.as"

#define IDW_MAIN 0
#define true 1
#define false 0

    gosub *LInitialize
    gsel IDW_MAIN, 1
    
*LMainLoop
    gosub *LGetEnvarData
    gosub *LRedraw
    
    wait 8
    goto *LMainLoop
    
*LInitialize
    gosub *LSetVariable
    gosub *LSetWindow
    return
    
*LSetVariable
    sdim sData
    sdim sEnvarName
    sdim sResult
    dim  bNoExists, 2
    bChanged = true
    return
    
*LSetWindow
    screen IDW_MAIN, 320, 240, 2
    title "EnvarReader"
    objmode 2
    pos 10, 10 : mes "環境変数の名前を入力してください："
    pos 30, 30 : input  sEnvarName, 200, 25
    pos 10, 60 : mesbox sResult,    300, 170 : infResult = objinfo(stat, 2), stat
    return
    
*LGetEnvarData
    getenv sData, sEnvarName
    bNoExists(1) = bNoExists(0)
    bNoExists(0) = ( sData == "" )
    
    if ( bNoExists(0) != bNoExists(1) ) {
        bChanged = true
        
        if ( bNoExists(0) ) {
            sResult = "( なし )"
        } else {
            sResult = sData
        }
    }
    
    return
    
*LRedraw
    if ( bChanged == false ) { return }
    
    objenable infResult(1), bNoExists(0) == false
    objprm    infResult(1), sResult
    
    bChanged = false
    return
LL Golf Hole 5 - 最上位の桁を数え上げる (Nested Flatten) 
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
#module

#deffunc CountUpMaxPlace var vIo,  local c
    c = peek(vIo)
    if ( '0' <= c && c <= '8' ) {
        poke vIo, , c + 1
        
    } else : if ( c == '9' ) {
        poke vIo,, '1'
        vIo += "0"
        
    } else {
        vIo = "0"
    }
    return
    
#global

    nMax = 300        // 数える最大値
    
    sdim sBuf, 3200
    sdim sNumber
    repeat
        CountUpMaxPlace sNumber
        sBuf += sNumber +"\n"
        if ( int(sNumber) >= nMax ) {
            break
        }
    loop
    objmode 2
    mesbox sBuf, ginfo(12), ginfo(13)
    stop
LL Golf Hole 6 - 10進数を2進数に基数変換する (Nested Flatten)

明らかに題意とは違いますけれど、短くということで。

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
#module

#defcfunc DigitToBinary int p1,  local sRet, local c
    sdim sRet, 64
    repeat 32
        poke sRet, 31 - cnt, '0' + (( p1 & (1 << cnt) ) != 0)
    loop
    return sRet
    
#global

    mes DigitToBinary(0x80000000)
    mes DigitToBinary(1234567890)
    stop
LL Golf Hole 8 - 横向きのピラミッドを作る (Nested Flatten) 
stop -> end でさらに1byte削れます。
最後の } もいらなかったりします (たぶんバグですが)。
1
2
#runtime"hsp3cl"
input s,9,1:n+s:m=1:if$<=n{*@:s="":repeat i+1:s+"*":loop:mes s:i+m:if i=n{m-2}if$>i{stop}goto*@b}
バイナリクロック (Nested Flatten) 
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
#uselib "user32.dll"
#func   PostMessage   "PostMessageA"   int,int,int,sptr
#cfunc  GetWindowLong "GetWindowLongA" int,int
#func   SetWindowLong "SetWindowLongA" int,int,int

#undef  BITNUM
#define global ctype BITNUM(%1) (1 << (%1))

#define WIN_HEIGHT 30
#define CELLSIZE 10
#define CX_MARGIN 1
#define CY_MARGIN 1

    cx = 60 + CX_MARGIN * 2
    cy = WIN_HEIGHT + CY_MARGIN * 2
    bgscr IDW_MAIN, cx, cy, 2
    SetWindowLong hwnd, -20, ( GetWindowLong(hwnd, -20) | 0x80 )
    
    gsel IDW_MAIN, 2
    onclick gosub *OnMove
    onkey   gosub *OnKeyProc
    
    goto *mainlp
    
*mainlp
    gosub *LCalcData
    gosub *LRedraw
    await 10
    goto *mainlp
    
*LCalcData
    nTime = gettime(4), gettime(5), gettime(6)
    return
    
*LRedraw
    redraw 2
    
    color 192, 192, 192 : boxf
    color
    px1 = CX_MARGIN - 1
    py1 = CY_MARGIN - 1
    px2 = ginfo(12) - CX_MARGIN
    py2 = ginfo(13) - CY_MARGIN
    boxf px1, py1, px2, py2
    
    foreach nTime
        h = (192 / length(nTime)) * cnt
        for i, 0, 6
            if ( nTime(cnt) & BITNUM(5 - i) ) {
                s = 255 - ((255 / 10) * i)
                v = 255 - ((255 / 10) * i)
                hsvcolor h, s, v
            } else {
                color 255, 255, 255
            }
            
            px1 = CX_MARGIN + (  i * CELLSIZE)
            py1 = CY_MARGIN + (cnt * CELLSIZE)
            px2 = CX_MARGIN + ((  i + 1) * CELLSIZE) - 2
            py2 = CY_MARGIN + ((cnt + 1) * CELLSIZE) - 2
            boxf px1, py1, px2, py2
        next
    loop
    
    redraw 1
    return
    
*OnMove
    if ( wparam == 1 ) {
        sendmsg hwnd, 0x00A1, 2, 0
    }
    return
    
*OnKeyProc
    if ( iparam == 27 ) {        // [Esc]
        gosub *LQuit
    }
    return
    
*LQuit
    PostMessage hwnd, 0x0010, 0, 0
    return
起動オプションの解析 (Nested Flatten)

自分なら d と 数字 の間のスペースなんて許可しませんけれど。

エラー時の処理は手抜きです。 d と 数字の間にスペースがあるときの対策も手抜きです。

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
#module mod_LexCmdline

#define true  1
#define false 0

#define success 1
#define failure 0

//------------------------------------------------
// コマンドライン文字列を解析し、分解する
//------------------------------------------------
#define global LexCmdline(%1=cmdopt@,%2=-1,%3=dir_cmdline) _LexCmdline %1,%2,%3
#deffunc _LexCmdline array cmdopt, int cntMax, str _cmdline,  local cmdline, local index, local c, local bInQuote, local cQuote, local cntOpt, local lenOpt, local iOptBegin
    
    if ( cntMax < 0 ) {
        sdim cmdopt, 320, 10
    } else {
        sdim cmdopt, 320, cntMax
    }
    
    if ( cntMax == 0 ) { return }
    
    cmdline   = _cmdline
    index     = 0
    bInQuote  = false
    cQuote    = 0
    cntOpt    = 0
    lenOpt    = 0
    iOptBegin = -1
    
    // 分解処理
    repeat
        c = peek(cmdline, index)
        
        // 終端文字
        if ( c == 0 ) {
            if ( lenOpt ) {
                gosub *LGetOption
            }
            break
            
        // 引用符発見 ( 引用符は cmdopt に含めない )
        } else : if ( c == '\'' || c == '"' ) {
            
            if ( bInQuote == false ) {        // 引用符の開始
            
                if ( iOptBegin < 0 ) { iOptBegin = index + 1 }
                bInQuote = true
                cQuote   = c
                
            } else : if ( cQuote == c ) {    // 引用符の終了
                
                bInQuote = false
                cQuote   = 0
                
                gosub *LGetOption
                if ( stat == failure ) { break }
                
            } else {    // 関係ない文字
                lenOpt ++
                /* */
            }
            
        // 引用符外の空白発見
        } else : if ( c == ' ' && bInQuote == false ) {
            
            if ( lenOpt ) {
                
                gosub *LGetOption
                if ( stat == failure ) { break }
                
            } else {
                /* 無視 */
            }
            
        // その他の文字
        } else {
            if ( iOptBegin < 0 ) { iOptBegin = index }
            lenOpt ++
        }
        
        index ++
    loop
    
    return cntOpt
    
*LGetOption
    cmdopt( cntOpt ) = strmid( cmdline, iOptBegin, lenOpt )
    cntOpt ++
    lenOpt    = 0
    iOptBegin = -1
    
    if ( cntMax > 0 && cntOpt == cntMax ) {
        return failure
    }
    return success

#global

// こっからメイン

#define PutError(%1) dialog %1 : end 1 : end 1    // 手抜き実装

    cmdline = dir_cmdline
    
    sBool = "OFF", "ON"
    
    sdim    log
    notesel log
    
    gosub *LProcCmdline
    
    noteadd "---- boot-log ----"
    noteadd "cmdline: "+ cmdline
    noteadd "[Option Info]"
    
    if ( bOpt_o == false || cntOptStr == 0 ) {
        PutError "[Error] コマンドラインに不備があります。"
    }
    
    noteadd "o: "+ sBool(bOpt_o)
    noteadd "q: "+ sBool(bOpt_q)
    noteadd "d: "+ nOpt_d
    noteadd ""
    noteadd "[Arguments Info]"
    noteadd "Count: "+ cntOptStr
    foreach optStr
        noteadd "#"+ cnt +": "+ optStr(cnt)
    loop
    noteadd "---- End of Boot Log ----"
    
    noteunsel
    
    objmode 2
    mesbox log, ginfo(12), ginfo(13)
    stop
    
*LProcCmdline
    // コマンドライン解析
    LexCmdline cmdopt, , cmdline
    
    sdim optStr, , 1
    cntOptStr = 0
    
    bOpt_o = false
    bOpt_q = false
    nOpt_d = -1
    
    foreach cmdopt
        dup sOpt, cmdopt(cnt)
        c = peek( cmdopt(cnt) )
        if ( c == 0 ) { continue }
        
        if ( bNext_DCommand ) {
            bNext_DCommand = false
            if ( '0' <= c && c <= '2' ) {
                nOpt_d = c - '0'
            } else {
                PutError "コマンドライン・エラー"
            }
            continue
        }
        
        switch ( c )
            // 文字引数
            case '+':
            case '-':
            case '/':
                repeat strlen(sOpt) - 1, 1
                
                    c = peek( sOpt, cnt )
                    switch ( c )
                        case 'o': bOpt_o = true : swbreak
                        case 'q': bOpt_q = true : swbreak
                        case 'd':
                            c2 = peek( sOpt, cnt + 1 )
                            if ( '0' <= c2 && c2 <= '2' ) {
                                nOpt_d = c2 - '0'
                            } else {
                                bNext_DCommand = true
                            }
                            continue cnt + 2
                            swbreak
                            
                    swend
                loop
                swbreak
                
            // 文字列引数
            default:
                optStr(cntOptStr) = cmdopt(cnt)
                cntOptStr ++
                swbreak
                
        swend
    loop
    
    return
ナベアツ算 (Nested Flatten)
とりあえず、
「x の倍数か x のつく数 ( 0 < x < 10, x は自然数 )」
をナベアツ数といい、この x をナベアツ法数と呼ぶことにしました。 
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
#module mod_nbnumber

#define true  1
#define false 0

// number が nLaw に対するナベアツ数かどうかを調べる
#defcfunc IsNabeatsuNumber int number, int nLaw, local powval
    if ( nLaw <= 0 || nLaw >= 10 || number == 0 && nLaw != 0 ) {
        return false
    }
    
    if ( (number \ nLaw) == 0 ) { return true }        // 倍数か？
    if ( (number \ 10) == nLaw ) { return true }    // 1 桁目は nLaw か？
    
    // 2桁目以降が nLaw か？
    powval = 1
    while ( number > powval )
        powval *= 10
        if ( (number / powval) == nLaw ) { return true }    // i 桁目は nLaw か？
    wend
    return false
    
#global

#const MAX_VALUE 40

    aho     = "アホ"
    finder  = "人を探してる感じ"
    narcist = "ナルシスト"
    
    sdim buf, 3200
    notesel buf
    repeat MAX_VALUE, 1
        stmp = ""+ cnt +": "
        bool = 0
        
        // アホになる
        if ( IsNabeatsuNumber( cnt, 3 ) ) {
            stmp += aho
            bool  = 1
        }
        
        // 人を探してる感じになる
        if ( cnt \ 8 == 0 ) {
            if ( bool ) { stmp += "＆" }
            stmp += finder
            bool  = 1
        }
        
        // ナルシスト
        if ( cnt \ 5 == 0 ) {
            if ( bool ) { stmp += "＆" }
            stmp += narcist
            bool  = 1
        }
        
        noteadd stmp
    loop
    noteunsel
    mesbox buf, ginfo(12), ginfo(13)
    stop
16進数から10進数の変換 (Nested Flatten)
文字列処理でごり押し。
速度の最適化はしていません。

理論上は無限桁の整数に対応していますが、メモリ・時間の誓約を加味すると……？
わたしのラップトップでは 150 桁まで確認できました。( *LOmake を使用 ) 
  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
// ※負数は扱えない
// ※HSP3.2b2 のみ対応( strf, strtrim )

#module StrCalclator

#define true  1
#define false 0

#define ctype numrg(%1,%2,%3) \
    ( ((%2) <= (%1)) && ((%1) <= (%3)) )

//------------------------------------------------
// 数字 → 数値
//------------------------------------------------
#defcfunc charToNumber int chr
    if ( numrg(chr, '0', '9') ) {
        return chr - '0'
        
    } else : if ( numrg(chr, 'a', 'z') ) {
        return chr - 'a' + 10
        
    } else : if ( numrg(chr, 'A', 'Z') ) {
        return chr - 'A' + 10
    }
    return 0
    
//------------------------------------------------
// 数値 → 数字
//------------------------------------------------
#defcfunc numberToChar int n
    if ( numrg(n, 0, 9) ) {
        return n + '0'
    } else : if ( numrg(n, 10, 36) ) {
        return n + 'A'
    } else {
        return ' '
    }
    
//------------------------------------------------
// 桁を大きい方にそろえる
// 
// @ 足りない分は左側に0で詰めます
//------------------------------------------------
#deffunc Str_toSamePlaces var p1, var p2,  local len, local sResult
    len = strlen(p1), strlen(p2)
    
    if ( len(0) == len(1) ) {
        
    } else : if ( len(0) > len(1) ) {
        p2     = strf("%0"+ len(0) +"s", p2)
        len(1) = len(0)
    } else {
        p1     = strf("%0"+ len(1) +"s", p1)
        len(0) = len(1)
    }
    return len(0)
    
//------------------------------------------------
// 文字列同士の加法
//------------------------------------------------
#defcfunc StrCalc_add str p1, str p2, \
    local sLeft, local sRight, local sResult, \
    local cntRoundUp, local places, local n, local c
    
    sLeft      = p1
    sRight     = p2
    cntRoundUp = 0        // 繰り上がり (適当英単語)
    
    // 桁を大きい方にそろえる
    Str_toSamePlaces sLeft, sRight
    places = stat
    
    sdim sResult, places + 1
    
    // 桁ごとの足し算
    for i, places - 1, -1, -1    // 後ろの桁からの減数ループ
        
        // 桁の数値を得る
        c(0) = peek(sLeft,  i)
        c(1) = peek(sRight, i)
        n(0) = charToNumber(c(0))
        n(1) = charToNumber(c(1))
        
        // 繰り上がりを考慮して足し算する
        n(2)       = n(0) + n(1) + cntRoundUp
        cntRoundUp = 0
        
        // 繰り上がり？
        if ( n(2) >= 10 ) {
            cntRoundUp ++
            n(2)    -= 10
        }
        
        c(2) = numberToChar(n(2))
        
        // 結果に書き込む
        poke sResult, i, c(2)
        
    next
    
    // 最後の繰り上がり
    if ( cntRoundUp ) {
        sResult = strf("%c", numberToChar(cntRoundUp)) + sResult
    }
    
    return sResult
    
//------------------------------------------------
// 文字列同士の乗法
//------------------------------------------------
#defcfunc StrCalc_mul str p1, str p2,  \
    local sLeft, local sRight, local sMiddle, local sResult, \
    local cntRoundUp, local places, local n, local c
    
    sLeft      = p1
    sRight     = p2
    places     = strlen(sLeft), strlen(sRight)
    
    sdim sResult, places * 2
    sdim sMiddle, places + 1, places    // 途中式
    
    // 右辺の桁ごとにループ
    repeat places(1)
        c(1) = peek(sRight, places(1) - cnt - 1)
        n(1) = charToNumber(c(1))
        
        if ( n(1) == 0 ) {
            sMiddle(cnt) = "0"
            continue
        }
        
        cntRoundUp = 0        // 繰り上がり (適当英単語)
        
        // 桁ごとのかけ算
        for i, places(0) - 1, -1, -1            // 後ろの桁からの減数ループ
            
            // 桁の数値を得る
            c(0) = peek(sLeft,  i)
            n(0) = charToNumber(c(0))
            
            // 繰り上がりを考慮してかけ算する
            n(2)       = n(0) * n(1) + cntRoundUp
            cntRoundUp = 0
            repeat
                if ( n(2) >= 10 ) {
                    cntRoundUp ++
                    n(2)    -= 10
                } else {
                    break
                }
            loop
            
            c(2) = numberToChar(n(2))
            
            // 途中式に書き込む
            poke sMiddle(cnt), i, c(2)
            
        next
        
        // 最後の繰り上がり
        if ( cntRoundUp ) {
            sMiddle(cnt) = strf("%c%s", numberToChar(cntRoundUp), sMiddle(cnt))
        }
        
        // 後ろ側に 0 を並べて桁揃え
        sMiddle(cnt) += strf("%0"+ cnt +"s", "")
        
    loop
    
    // 途中式をすべて足し合わせる
    repeat places(1)
        sResult = StrCalc_add(sResult, sMiddle(cnt))
    loop
    
    return sResult
    
//------------------------------------------------
// 文字列の累乗
//------------------------------------------------
#defcfunc StrCalc_pow str p1, int p2,  local sResult
    sdim sResult
    sResult = "1"
    
    repeat p2
        sResult = StrCalc_mul(sResult, p1)
    loop
    return sResult
    
//------------------------------------------------
// 10進数以外の基数の文字列を10進数文字列に変換
// 
// @ 2 ～ 32 進数まで保証
// @ 負数は扱えない
//------------------------------------------------
#defcfunc StrCalc_toDigit str p1, int fromRadix, \
    local sFromRadix, local sInput, local sDigit
    if ( fromRadix <= 0 )  { return "" }        // エラー
    if ( fromRadix == 10 ) { return p1 }        // 変換する必要なし
    
    sdim sInput,  320
    sdim sDigit,  320
    sFromRadix = str(fromRadix)
    
    // 小文字にする
    sInput = p1
    places = strlen(sInput)
    
    // 十進数に直す
    repeat places
        c      = peek(sInput, places - (cnt + 1))
        stmp   = StrCalc_mul( str( charToNumber(c) ), StrCalc_pow(sFromRadix, cnt) )
        sDigit = StrCalc_add( sDigit, stmp )
    loop
    
    return sDigit
    
#global
    
*main
    sLeft   = "12437308CCB6",   "2C9C1227FC6520B",    "ff"
    sResult = "20080902065334", "200904012311450123", "255"
    
    repeat 3
        mes "#"+ cnt +"\n解答："+ StrCalc_toDigit(sLeft(cnt), 16) +"\n正答："+ sResult(cnt)
        mes
    loop
    
    stop
    
// おまけ
*LOmake
    n = 15                // 入力する16進数の桁数の10分の1
    sdim sHex, 1024
    repeat n
        sHex += "1234567890"
    loop
    
    sDig = StrCalc_toDigit(sHex, 16)
    logmes sDig
    stop
漢数字で九九の表 (Nested Flatten)

せこい気がする。

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
#define ZERO $
#define ONE     length(a)
#define NINE (length(kanji) - ONE)
#define TEN   length(kanji)

    kanji = "○", "一", "二", "三", "四", "五", "六", "七", "八", "九"
    sdim buf
    
    buf = "　　"
    repeat NINE, ONE
        buf += " | 　"+ kanji(cnt)
    loop
    buf += "\n ―――――――――――――――――――――――――――――――――\n"
    
    repeat NINE, ONE
        x     = cnt
        sline = kanji(cnt)
        
        repeat NINE, ONE
            y   = cnt
            num = x * y
            r   = kanji(num \ TEN)
            l   = kanji(num / TEN)    // 十の位
            if ( l == kanji(ZERO) ) {
                l = "　"
            }
            sline += " | "+ l + r
        loop
        buf += "　"+ sline +"\n"
    loop
    mes buf
    stop
'('と')'の対応 (Nested Flatten) 
HSPのバグを使っています。( 丸括弧を使わない関数呼び出し )
Shift_JIS にのみ対応。

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
#const CHARCODE_LEFT  40    // '('
#const CHARCODE_RIGHT 41    // ')'

    sdim buf
    mesbox buf, ginfo_winx, ginfo_winy - 30
    button gosub "Check!", *OnBtn_Check
    stop
    
*OnBtn_Check
    cntLeft  = 0
    cntRight = 0
    balance  = 0
    bSuccess = 1
    repeat
        c = peek.buf.cnt
        if c == 0 : break
        if 0x81 <= c && c <= 0x9F || 0xE0 <= c && c <= 0xFC {
            continue cnt + 2    // 全角
        }
        if c == CHARCODE_LEFT  { cntLeft  ++ : balance ++ }
        if c == CHARCODE_RIGHT { cntRight ++ : balance -- }
        if balance < 0 { bSuccess = 0 : break }
    loop
    if cntLeft != cntRight || balance != 0 : bSuccess = 0
    
    if bSuccess {
        dialog "丸括弧の対応：ＯＫ！"
    } else {
        dialog "丸括弧の対応：ＯＵＴ！"
    }
    
    stop
疑似並行処理 (Nested Flatten) 
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
    randomize
    sdim buf
    cntAlph = 0
    cntDig  = 0
    
    repeat 26
        buf += cntDig
        buf += strf("%c", 'A'+ cntAlph)
        cntDig  ++
        cntAlph ++
    loop
    mes buf
例外処理 (Nested Flatten)

HSPには例外処理機構が無いので、マクロで実装します。

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
#define global try %tExcepHandling %i0 %i0 %i0 %i0 if (1)
#define global end_try %tExcepHandling *%p1 : %o0 %o0 %o0 %o0
#define global catch_list %tExcepHandling \
    if (0) : *%p : %p3 = 0
#define global TEMP_CATCH(%1,%2) %tExcepHandling \
    if ( %p3 ) { goto *%p1 } else { %p3 = 1 }\
    } if (%1) { %2 = THREW_VALUE
#define global ctype catch(%1,%2=THREW_VALUE) %tExcepHandling \
    TEMP_CATCH ( vartype(THREW_VALUE) == vartype("%1") ), %2
#define global ctype finally(%1=THREW_VALUE) %tExcepHandling \
TEMP_CATCH 1, %1
#define global throw(%1) %tExcepHandling \
THREW_VALUE = %1 : goto *%p
#define global try_break %tExcepHandling goto *%p1
#define global THREW_VALUE %tExcepHandling %p2

// サンプル・スクリプト
#if 1
    randomize
    repeat
        wait 50
        try {
            // メイン処理、この中でしか throw できない。
            switch ( rnd(3) )
                case 0 : throw 2147483647 : swbreak
                case 1 : throw "Hello, world!" : swbreak
                case 2 : throw 3.141592 : swbreak
            swend
            
        } catch_list {
            // throw されたらここに来る。
            catch (int, x)
                mes "int\t: "+ x
                
            catch(str)
                mes "str\t: \""+ THREW_VALUE +"\""
                
            finally()
                mes "final\t: "+ THREW_VALUE
        } end_try
        // catch_list を抜けるとここに来る
    loop
    stop
#endif
next >>

Index

Feed

Other

Link

Pathtraq

loading...
Creative Commons License このサイトの内容は、 クリエイティブ・コモンズ・ライセンスの下でライセンスされています。 [詳細]