ゲームを作りたい人のための ソースコード集

私がその日作った短めのソースを簡単な解説とともに載せていきます
ゲーム制作初心者にとって参考になるかもしれないソースが多いです





ひし形模様

中心から順番に、菱形上に点を打っていくプログラムです

 

#module
#deffunc patternset int cx,int cy,int num
    pset cx,cy
    len=4
    id=-1
    inter=2
    repeat num
        if id<0{
            id=len-1
            border=len/2
            xid=len/4*inter
            yid=0
            len+4
        }
        
        pset cx+xid,cy+yid
        
        if id>=border{
            xid-inter
        }else{
            xid+inter
        }
        if id>=border+border/2|id<border-border/2{
            yid+inter
        }else{
            yid-inter
        }
        id--
    loop
    return
#global

redraw 0
patternset 320,240,10000
redraw

0
    posted by higashijugem 11:07comments(0)|-|





    計算式の分割

    文字列で書かれた計算式を、数字や記号ごとに分割して表示します。


    #include"mod_regexp.as"
    formula="1+2-33.3*(8/4)"
    matches calckeys,formula,"([0-9]|¥¥.)+|¥¥+|-|¥¥*|¥¥/|¥¥(|¥¥)"
    foreach calckeys
        mes""+calckeys(cnt)
    loop

    0
      posted by higashijugem 09:46comments(0)|-|





      アンチエイリアス付きの円

      境界面が滑らかな円を描写します。

      真円しか描けないなど実用性は低いですが、こういうやり方もあるということで。

       

      #module
      ;中心座標X、中心座標Y、半径、描画モード(0=線,1=塗りつぶし)
      #deffunc circle_anti int cx,int cy,int cr,int lnflg
          actid=ginfo(2)
          clr_r=ginfo(16)
          clr_g=ginfo(17)
          clr_b=ginfo(18)
          tmpid=ginfo(25)
          buffer tmpid,cr*2+1,cr*2+1
          color:boxf
          color clr_r,clr_g,clr_b
          if lnflg{
              line cr,cr,cr*cr,cr
          }else{
              pset cr*2,cr
          }
          repeat cos(deg2rad(45))*cr+((cr+1)¥2),1:y=cnt
              x=sqrt(cr*cr-y*y)
              d=(x-int(x))
              tclr_r=int(d*clr_r)
              tclr_g=int(d*clr_g)
              tclr_b=int(d*clr_b)
              color tclr_r,tclr_g,tclr_b
              pset cr+x+1,cr+y
              if lnflg{
                  color clr_r,clr_g,clr_b
                  line cr,cr+y,cr+x,cr+y
              }else{
                  tclr_r=int((1.0-d)*clr_r)
                  tclr_g=int((1.0-d)*clr_g)
                  tclr_b=int((1.0-d)*clr_b)
                  color tclr_r,tclr_g,tclr_b
                  pset cr+x,cr+y
              }
          loop
          
          gmode 2,cr*2+1,cr*2+1
          pos cr,cr
          grotate tmpid,1,1,M_PI/2
          grotate tmpid,1,1,M_PI
          tmpid2=ginfo(25)
          buffer tmpid2,cr*2+1,cr*2+1
          gmode 2,cr*2+1,cr*2+1
          pos cr*2,0
          gzoom -(cr*2+1),cr*2+1,tmpid,0,0,cr*2+1,cr*2+1
          gsel tmpid
          pos 0,0
          gcopy tmpid2,0,0,cr*2+1,cr*2+1
          
          gsel actid
          pos cx-cr,cy-cr:gcopy tmpid,0,0,cr*2+1,cr*2+1
          return
      #global

      color:boxf
      color 255,255,255
      ;通常の円
      circle 200-100,240-100,200+100,240+100,1
      ;アンチエイリアス付きの円
      circle_anti 460,240,100,1

      0
        posted by higashijugem 20:05comments(0)|-|





        バッファオーバーフロー対策

        バッファに値を格納するとき、格納位置がバッファ長を超えるとエラーになります

        以下はエラー時にバッファ長を再確保することで、途中終了せずに正常に処理させるプログラムです

         

        pos ginfo_winx,ginfo_winy:mes"a"
        charlen=ginfo(14)
        sdim test,64        ;文字列型変数作成
        onerror gosub *error    ;エラー時に実行するイベント
        poke test,70,"a"    ;エラー発生
        repeat 70            ;メモリブロックが再確保されたことを確認
            poke test,cnt,"a"
        loop
        pos 0,0:mes""+test
        repeat 7,1
            lx=charlen*(cnt*10-1)
            pos lx,20:mes"^"
            pos lx,30:mes""+(cnt*10)
        loop
        stop
        *error
            err_str="#Error "+wparam+" in line "+lparam+" (???)¥n"
            err_str+="-->バッファオーバーフローが発生しました"
            dialog""+err_str,1,"Error"
            memexpand test,varsize(test)*2    ;変数の長さを倍にする
            return

        0
          posted by higashijugem 14:08comments(0)|-|





          障害物に引っかかるオブジェクト

          画面上のキャラクター(赤いマス)はマウス(目標マス)に追従しますが、

          キャラクターと目標の間に壁(黒いマス)がある場合、キャラクターは壁の向こう側に置いてけぼりにされます

          ブレゼンハムアルゴリズムを用いることで実装しました


          #module
          #defcfunc bresenham array map,var gx,var gy,var px,var py
              bool=0
              if gx=px&gy=py:return bool
              ;ブレゼンハム(初期設定)
              x=px:y=py
              if gx-px>0{vx=1}else:if gx-px<0{vx=-1}else{vx=0}
              if gy-py>0{vy=1}else:if gy-py<0{vy=-1}else{vy=0}
              ww=abs(gx-px):hh=abs(gy-py)
              if ww>hh{dup llen,ww:dup slen,hh:dup lh,x:dup sh,y:dup lv,vx:dup sv,vy:e=ww/2}
              else{dup llen,hh:dup slen,ww:dup lh,y:dup sh,x:dup lv,vy:dup sv,vx:e=hh/2}
              ;ブレゼンハム(処理)
              repeat
                  if (e>=llen){
                      e-llen
                      sh+sv
                  }else{
                      e+slen
                      lh+lv
                  }
                  await
                  if map(x,y)=1:break
                  if x=gx&y=gy{
                      bool=1
                      break
                  }
              loop
              return bool
          #global

          randomize
          ;マップチップ生成
          csz=32
          mc=24:mr=16
          buffer 2,csz*4,csz:celdiv 2,csz,csz
          x=0
          color 255,255,255
          boxf x,0,x+csz,csz:x+csz
          color 1
          boxf x,0,x+csz,csz:x+csz
          color 255
          boxf x,0,x+csz,csz:x+csz
          color ,,255
          boxf x,0,x+csz,csz
          color
          boxf x+4,4,x+csz-5,csz-5
          ;壁生成
          dim map,mc,mr
          buffer 3,mc*csz,mr*csz
          repeat 20
              if rnd(2){
                  sx=rnd(mc)
                  ex=sx
                  sy=rnd(mr)
                  ey=rnd(mr)
              }else{
                  sx=rnd(mc)
                  ex=rnd(mc)
                  sy=rnd(mr)
                  ey=sy
              }
              if ex-sx>=0{
                  xdir=1
              }else{
                  xdir=-1
              }
              if ey-sy>=0{
                  ydir=1
              }else{
                  ydir=-1
              }
              j=sy:i=sx
              repeat abs(ey-sy)/2+1
                  repeat abs(ex-sx)/2+1
                      map(i,j)=1
                      i+xdir
                  loop
                  i=sx:j+ydir
              loop
          loop
          flg=0
          repeat mr:j=cnt
              repeat mc:i=cnt
                  if flg=0&map(i,j)=0{
                      objx=i:objy=j:flg=1
                  }
                  pos i*csz,j*csz:celput 2,map(i,j)
              loop
          loop
          ;処理開始
          screen 0,mc*csz,mr*csz
          gmode 2
          repeat
              pos 0,0:gcopy 3,,,mc*csz,mr*csz
              if 0<=mousex&mousex<ginfo_winx&0<=mousey&mousey<ginfo_winy{
                  mpx=mousex/csz:mpy=mousey/csz
                  pos objx*csz,objy*csz:celput 2,2
                  pos mpx*csz,mpy*csz:celput 2,3
                  flg=bresenham(map,mpx,mpy,objx,objy)
                  if flg{
                      objx=mpx:objy=mpy
                  }
              }
              redraw:await 17:redraw 0
          loop

          0
            posted by higashijugem 16:45comments(0)|-|





            文字列の数値判定

            文字列型変数は「int」関数を使うことで数字に変換することが出来ますが

            半角英字などを変換した場合「0」という数値が返されます

            そのため元の文字が"0"という文字だったのか、それ以外の文字だったのは判別がつきません

            以下のコードは、変換前の文字列を調べてその文字列が数値だったかどうかを判定するプログラムです


            #module
            #defcfunc str_num str p1
                tp1=p1
                numflg=0
                dblflg=0
                repeat strlen(tp1)
                    code=peek(tp1,cnt)
                    if ((code>=129)&(code<=159))|((code>=224)&(code<=252)){    ;2byte文字
                        break
                    }else:if code=43|code=45{    ;+or-
                    }else:if code=46{    ;.
                        dblflg=1
                    }else:if code<48|57<code{    ;半角文字    
                        break
                    }else{
                        numflg=1
                    }
                loop
                mref _stat,64
                _stat = numflg
                if dblflg{
                    return double(tp1)
                }else{
                    return int(tp1)
                }
            #deffunc check str p1
                ans=str_num(p1)
                if stat{
                    mes""+p1+"¥t->¥t"+ans+"¥t数値"
                }else{
                    mes""+p1+"¥t->¥t¥t数値ではない"
                }
                return
            #global
            check("012")
            check("-12")
            check("-12a3")
            check("-a3")
            check("a3")
            check(".12")
            check(".a12")
            check("-.a12")

            0
              posted by higashijugem 22:34comments(0)|-|





              六角形を隙間なく並べる

              六角形を均等に積み重ねて配置するプログラムです

               

               

              ;Win32 APIを用いて六角形を作成
              #define global NULL_BRUSH    $00000005
              #define global DC_BRUSH        $00000012
              #define global DC_PEN        $00000013
              #uselib "gdi32"
              # func global _Polygon          "Polygon" sptr,sptr,sptr
              # func global SetDCPenColor     "SetDCPenColor" sptr,sptr
              # func global SetDCBrushColor   "SetDCBrushColor" sptr,sptr
              #cfunc global SelectObject      "SelectObject" sptr,sptr
              # func global CreateSolidBrush  "CreateSolidBrush" sptr
              # func global DeleteObject      "DeleteObject" sptr
              #cfunc global GetStockObject    "GetStockObject" sptr
              #uselib "user32"
              # func global InvalidateRect    "InvalidateRect" sptr,sptr,sptr
              #module
              #deffunc SetDraw int flg,int col,int col2
                  SetDCPenColor hdc,col
                  SetDCBrushColor hdc,col2
                  hPen=SelectObject(hDC,GetStockObject(DC_PEN))
                  if flg=0{
                      hBrush=SelectObject(hDC,GetStockObject(NULL_BRUSH))
                  }else{
                      hBrush=SelectObject(hDC,GetStockObject(DC_BRUSH))
                  }
                  return
              #deffunc Polygon array nleft,int ntop,int col,int col2,int flg
                  SetDraw flg,col,col2
                  _Polygon hdc,varptr(nleft),ntop
                  dim rect,2
                  rp.0=varptr(nleft),ntop
                  InvalidateRect hwnd,varptr(rp),0
                  return
              #global
              randomize
              ;マス作成
              mcsz=48
              m2csz=mcsz+2    ;少し大きめにしないと境目が目立ってしまう
              m2cszh=m2csz/2
              buffer 2,m2csz*3,m2csz:celdiv 2,m2csz,m2csz
              boxf
              dim a,12
              x=m2cszh
              col=$ff
              repeat 3
                  deg=0
                  repeat 6:i=cnt
                      rad=deg2rad(deg)
                      a(i*2)=0+cos(rad)*m2cszh+x,0+sin(rad)*m2cszh+m2cszh
                      deg+60
                  loop
                  Polygon a,6,$000001,col,1
                  col<<8
                  x+m2csz
              loop
              redraw
              ;描写
              screen:gmode 2
              mc=10:mr=10
              hexw=mcsz/4*3
              hexh=sqrt(3)*mcsz/2    ;六角形の幅
              x=0:y=0
              repeat mr:j=cnt
                  repeat mc:i=cnt
                      tx=x:ty=y
                      if i¥2=1{
                          ty+=hexh/2
                      }
                      pos tx,ty
                      celput 2,rnd(3)
                      x+=hexw
                  loop
                  x=0
                  y+=hexh
              loop

              0
                posted by higashijugem 23:48comments(0)|-|





                色判定プログラム

                指定の色を判定して、赤っぽい色なら「Red」、青っぽい色なら「Blue」という風に

                色の名前を表示するプログラムです

                取得した色をHSVモデルに変換し、どの色に属するかを調べます


                cx=double(ginfo(26))/2.0    ;中心の座標X
                cy=double(ginfo(27))/2.0    ;中心の座標Y
                outr=150.0            ;外側の半径
                ntrad=deg2rad(1)
                ntc_h=192.0/360
                ntc_s=255.0/outr
                setc_v=255.0
                ddim harea,6
                ntharea=192.0/6
                stharea=ntharea/2
                repeat 6        ;色判定エリア
                    harea(cnt)=stharea
                    stharea+ntharea
                loop
                color:boxf
                redraw 0
                gosub *hsvcircledraw
                redraw
                oncmd gosub *mousewheel, $20A    ;マウスホイールで明度(V)を変更
                oncmd gosub *mousemove, $200    ;カーソル移動で座標の色を調べる
                stop
                *mousemove
                    oncmd 0
                    redraw 0
                    gosub *hsvget
                    gosub *hsvcheck
                    redraw
                    oncmd 1
                    return
                *mousewheel
                    tmousew=0f+(wparam >> 16 & $ffffffff)
                    oncmd 0
                    redraw 0
                    setc_v=limitf(setc_v+(tmousew/2),0,255)
                    gosub *hsvcircledraw
                    gosub *hsvget
                    gosub *hsvcheck
                    redraw
                    oncmd 1
                    return
                *hsvget    ;RGB->HSV
                    pget mousex,mousey
                    dim rgbdt,3:rgbdt=ginfo(16),ginfo(17),ginfo(18)
                    ;V値
                    max=0:min=255
                    repeat 3
                        if max<rgbdt(cnt){max=rgbdt(cnt)}
                        if min>rgbdt(cnt){min=rgbdt(cnt)}
                    loop
                    v=max
                    ;S値
                    if v{ s=255.0*(v-min)/v }
                    else{ s=0.0 }
                    ;H値
                    if v=rgbdt(0){
                        if v-min{ h=32.0*(rgbdt(1)-rgbdt(2))/(v-min) }
                        else{ h=32.0*(rgbdt(1)-rgbdt(2)) }
                    }else:if v=rgbdt(1){
                        if v-min{ h=32.0*(2.0+double(rgbdt(2)-rgbdt(0))/(v-min)) }
                        else{ h=32.0*(2.0+double(rgbdt(2)-rgbdt(0))) }
                    }else{
                        if v-min{ h=32.0*(4.0+double(rgbdt(0)-rgbdt(1))/(v-min)) }
                        else{ h=32.0*(4.0+double(rgbdt(0)-rgbdt(1)))}
                    }
                    if h<0.0:h+192.0
                    hsvcolor h,s,v
                    boxf 30,30,130,130
                    return
                *hsvcheck    ;色判定
                    repeat 6
                        flg=0
                        if cnt=0{
                            if harea(length(harea)-1)<h|h<=harea(cnt){ flg=1 }
                        }else{
                            if harea(cnt-1)<h&h<harea(cnt){ flg=1}
                        }
                        if flg=1{
                            c_hid=cnt
                            break
                        }
                    loop
                    color 255,255,255 : boxf 150,30,250,60 : color
                    pos 160,35
                    if s<100{
                        if v<128{
                            mes"Black"
                        }else{
                            mes"White"
                        }
                    }else{
                        switch c_hid
                        case 0 : mes"Red" : swbreak
                        case 1 : mes"Yellow" : swbreak
                        case 2 : mes"Green" : swbreak
                        case 3 : mes"Cyan" : swbreak
                        case 4 : mes"Blue" : swbreak
                        case 5 : mes"Magenta" : swbreak
                        swend
                    }
                    return
                *hsvcircledraw    ;HSV円描写
                    r2=outr : r1=r2-1.0
                    c_h=0.0 : c_s=255.0 : c_v=255.0
                    rad0=0.0 : rad1=ntrad
                    ntc_v=(255.0-setc_v)/outr
                    repeat r2
                        repeat 360
                            p1x=cx+r1*cos(rad0) : p1y=cy+r1*sin(rad0)
                            p2x=cx+r2*cos(rad0) : p2y=cy+r2*sin(rad0)
                            p4x=cx+r1*cos(rad1) : p4y=cy+r1*sin(rad1)
                            p3x=cx+r2*cos(rad1) : p3y=cy+r2*sin(rad1)
                            x=int(p1x),int(p2x),int(p3x),int(p4x)
                            y=int(p1y),int(p2y),int(p3y),int(p4y)
                            ;四角形描写
                            hsvcolor int(c_h),int(c_s),int(c_v)
                            gsquare -1,x,y
                            rad0=rad1 : rad1+ntrad : c_h+ntc_h
                        loop
                        r2-1.0 : r1-1.0
                        c_s-ntc_s : c_v-ntc_v
                    loop
                    return

                0
                  posted by higashijugem 22:49comments(0)|-|





                  整数と実数の比較

                  整数と実数をそれぞれ比べて、同じ値かどうかを確認するソースコードです


                  h_i=11
                  h_d=11.25
                  if double(h_i)-double(h_d)=0{
                      mes"同じ数字"
                  }else{
                      mes"異なる数字"
                  }

                  0
                    posted by higashijugem 19:19comments(0)|-|





                    文字列の重複チェック

                    文字列配列の中を調べ、同じ文字列の位置を取得するプログラムです

                    第一引数:検索結果(重複文字列の位置)を格納する配列

                    第二引数:検索する文字列配列

                    第三引数:初めから数えて指定した要素番号の値が何回繰り返されたか調べる

                    第四引数:指定した数を検索(10を指定すると要素番号0〜9まで検索)

                    戻り値:繰り返された回数を返す

                     

                    #module
                    #defcfunc duplicatenum array resarr,array arr,int uid,int max
                        if uid>=max|uid>=length(arr)|uid>=length(resarr){dialog"第2引数が大きすぎます":return -1}
                        memset resarr,length(resarr)*4,0
                        my=arr(uid)
                        setid=0:ordid=0
                        repeat max:chkid=cnt
                            if my!=arr(chkid):continue
                            if setid=1{
                                resarr(0)=bfid
                            }
                            if setid>=1{
                                resarr(setid)=chkid
                            }
                            setid++:bfid=chkid
                            if uid=chkid{
                                ordid=setid
                            }
                        loop
                        return ordid
                    #global
                    randomize
                    len=20
                    sdim arr,len
                    repeat len
                        r=rnd(3)
                        if r=0{
                            arr(cnt)="「番号」"
                        }else:if r=1{
                            arr(cnt)="「ID」"
                        }else{
                            arr(cnt)="「No.」"
                        }
                    loop
                    dim resarr,len
                    repeat len
                        num=duplicatenum(resarr,arr,cnt,len)
                        y=cnt*20
                        pos 0,y:mes""+cnt+". "+arr(cnt)
                        pos 120,y:mes""+num+"番目¥t¥t"
                        if num>1{
                            pos 200,y:mes"重複あり"
                        }
                        repeat num
                            pos 300+cnt*20,y:mes""+resarr(cnt)
                        loop
                    loop

                    0
                      posted by higashijugem 20:32comments(0)|-|





                      二次元配列(文字列型)の並べ替え

                      2次元文字列型配列をソートするプログラムです

                      keyの値を指定することで、指定された一次元要素番号を基準に並べ替えます

                       

                      #module
                      ;二次元文字列配列並べ替え(対象配列変数名、基準となる要素番号、並び順)
                      #deffunc sortstr2 array arr,int key,int order
                          len1=length(arr):if len1<=key{key=len1-1}
                          len2=length2(arr)
                          sdim tmp,varsize(arr),len2
                          sdim toarr,varsize(arr),len1,len2
                          repeat len2
                              tmp(cnt)=arr(key,cnt)
                          loop
                          sortstr tmp,order    ;配列変数を文字列でソート
                          repeat len2:j=cnt
                              sortget n,j    ;ソート元のインデックスを取得
                              repeat len1:i=cnt
                                  toarr(i,j)=arr(i,n)
                              loop
                          loop
                          ;元の配列に並び替えた結果を代入
                          repeat len2:j=cnt
                              repeat len1:i=cnt
                                  arr(i,j)=toarr(i,j)
                              loop
                          loop
                          return
                      #global
                      ;文字列配列作成
                      randomize
                      sdim a,,3,10
                      repeat 10:j=cnt
                          repeat 3:i=cnt
                              pt=0
                              repeat 10    ;一要素の最大文字数
                                  if rnd(2){
                                      if i{
                                          poke a(i,j),pt,rnd(122-96)+97
                                      }else{
                                          poke a(i,j),pt,rnd(90-64)+65
                                      }
                                      pt++
                                  }
                              loop
                          loop
                          mes""+a(0,j)+"¥t"+a(1,j)+"¥t"+a(2,j)
                      loop
                      ;並べ替え後
                      pos 320,0
                      sortstr2 a,0,1
                      repeat 10:j=cnt
                          mes""+a(0,j)+"¥t"+a(1,j)+"¥t"+a(2,j)
                      loop

                      0
                        posted by higashijugem 16:59comments(0)|-|





                        文字数を指定してバイト数を取得

                        HSPには、文字列の長さをバイト単位で取得したり(strlen)、

                        バイト数を指定して文字列を取得する関数(memcpy)があります

                        しかし文字数を指定し、それが何バイト分になるかを確認する関数はありません

                         

                        以下のプログラムは、1バイト文字と2バイト文字が混ざった文字列を元に

                        指定の文字数のバイト数がいくつになるかを求めています

                        #define global ctype peekget(%1="",%2=0,%3=0) _peekget(%1,%2,%3)
                        #module
                        #defcfunc _peekget var p1,int p2,int p3
                            if p2<0:return 0
                            id=0
                            add=1
                            repeat p2,p3
                                code=peek(p1,id+p3)
                                if ((code>=129)&(code<=159))|((code>=224)&(code<=252)){
                                    id+add

                                }else:if code=0{
                                    break
                                }
                                id+add
                            loop
                            return id
                        #global
                        title"5文字ずつ表示"
                        text="ハンカクとゼンカクの文字数のbyte数を数える"
                        mes""+text+"¥n"
                        sdim val
                        id=0
                        repeat 5
                            len=peekget(text,5,id)    ;指定文字数のバイト数を取得(開始位置はバイトで指定)
                            memcpy val,text,len,0,id
                            poke val,len
                            mes""+val+"¥t"+len
                            id+=len
                        loop

                        0
                          posted by higashijugem 23:54comments(0)|-|





                          ウィザードリィ風3D視点

                          3DダンジョンRPGの視点を再現したプログラムです

                          十字キーで移動、旋回ができます

                           

                          #const c_parts 15
                          #enum e_empty=0
                          #enum e_wl
                          gw=640:gh=480
                          gwh=gw/2:ghh=gh/2
                          buffer 2,gw,gh
                          buffer 3,gw,gh
                          ;迷路作成
                          randomize
                          mc=5:mr=5
                          dim mapdt,mc,mr
                          repeat mr:j=cnt
                              repeat mc:i=cnt
                                  mapdt(i,j)=e_wl
                              loop
                          loop
                          dim dx,4:dx=-1,0,1,0
                          dim dy,4:dy=0,-1,0,1
                          mapdt(0,0)=1,1,1,1,1
                          mapdt(0,1)=1,0,0,0,1
                          mapdt(0,2)=1,1,0,1,1
                          mapdt(0,3)=1,0,0,0,1
                          mapdt(0,4)=1,1,1,1,1
                          ;壁データ作成
                          cx=gw/2:cy=gh/2
                          wldir=40
                          wlpt0=550
                          wlpt1=wlpt0-250
                          wlpt2=wlpt1-150
                          wlpt3=wlpt2-100
                          ddim wllndtx,4,c_parts
                          ddim wllndty,4,c_parts
                          lurad=deg2rad(180-wldir)
                          lbrad=deg2rad(180+wldir)
                          lurad2=lurad
                          lbrad2=lbrad
                          rurad=deg2rad(wldir)
                          rbrad=deg2rad(-wldir)
                          rurad2=rurad
                          rbrad2=rbrad
                          ;左壁大
                          wllndtx(0,0)=cos(lurad)*wlpt1+cx,cos(lurad)*wlpt0+cx,cos(lbrad)*wlpt0+cx,cos(lbrad)*wlpt1+cx
                          wllndty(0,0)=sin(lurad)*wlpt1+cy,sin(lurad)*wlpt0+cy,sin(lbrad)*wlpt0+cy,sin(lbrad)*wlpt1+cy
                          ;右壁大
                          wllndtx(0,1)=cos(rurad)*wlpt1+cx,cos(rurad)*wlpt0+cx,cos(rbrad)*wlpt0+cx,cos(rbrad)*wlpt1+cx
                          wllndty(0,1)=sin(rurad)*wlpt1+cy,sin(rurad)*wlpt0+cy,sin(rbrad)*wlpt0+cy,sin(rbrad)*wlpt1+cy
                          ;正面大
                          wllndtx(0,2)=cos(lurad)*wlpt1+cx,cos(rurad)*wlpt1+cx,cos(rbrad)*wlpt1+cx,cos(lbrad)*wlpt1+cx
                          wllndty(0,2)=sin(lurad)*wlpt1+cy,sin(rurad)*wlpt1+cy,sin(rbrad)*wlpt1+cy,sin(lbrad)*wlpt1+cy
                          ;左壁中
                          wllndtx(0,3)=cos(lurad)*wlpt2+cx,cos(lurad)*wlpt1+cx,cos(lbrad)*wlpt1+cx,cos(lbrad)*wlpt2+cx
                          wllndty(0,3)=sin(lurad)*wlpt2+cy,sin(lurad)*wlpt1+cy,sin(lbrad)*wlpt1+cy,sin(lbrad)*wlpt2+cy
                          ;右壁中
                          wllndtx(0,4)=cos(rurad)*wlpt2+cx,cos(rurad)*wlpt1+cx,cos(rbrad)*wlpt1+cx,cos(rbrad)*wlpt2+cx
                          wllndty(0,4)=sin(rurad)*wlpt2+cy,sin(rurad)*wlpt1+cy,sin(rbrad)*wlpt1+cy,sin(rbrad)*wlpt2+cy
                          ;正面中
                          wllndtx(0,5)=cos(lurad)*wlpt2+cx,cos(rurad)*wlpt2+cx,cos(rbrad)*wlpt2+cx,cos(lbrad)*wlpt2+cx
                          wllndty(0,5)=sin(lurad)*wlpt2+cy,sin(rurad)*wlpt2+cy,sin(rbrad)*wlpt2+cy,sin(lbrad)*wlpt2+cy
                          ;左壁小
                          wllndtx(0,6)=cos(lurad)*wlpt3+cx,cos(lurad)*wlpt2+cx,cos(lbrad)*wlpt2+cx,cos(lbrad)*wlpt3+cx
                          wllndty(0,6)=sin(lurad)*wlpt3+cy,sin(lurad)*wlpt2+cy,sin(lbrad)*wlpt2+cy,sin(lbrad)*wlpt3+cy
                          ;右壁小
                          wllndtx(0,7)=cos(rurad)*wlpt3+cx,cos(rurad)*wlpt2+cx,cos(rbrad)*wlpt2+cx,cos(rbrad)*wlpt3+cx
                          wllndty(0,7)=sin(rurad)*wlpt3+cy,sin(rurad)*wlpt2+cy,sin(rbrad)*wlpt2+cy,sin(rbrad)*wlpt3+cy
                          ;正面小
                          wllndtx(0,8)=cos(lurad)*wlpt3+cx,cos(rurad)*wlpt3+cx,cos(rbrad)*wlpt3+cx,cos(lbrad)*wlpt3+cx
                          wllndty(0,8)=sin(lurad)*wlpt3+cy,sin(rurad)*wlpt3+cy,sin(rbrad)*wlpt3+cy,sin(lbrad)*wlpt3+cy
                          ;左側奥
                          wllndtx(0,9)=cos(lurad)*wlpt2+cx,cos(lurad2)*wlpt3+cx,cos(lbrad2)*wlpt3+cx,cos(lbrad)*wlpt2+cx
                          wllndty(0,9)=sin(lurad)*wlpt3+cy,sin(lurad2)*wlpt3+cy,sin(lbrad2)*wlpt3+cy,sin(lbrad)*wlpt3+cy
                          ;右側奥
                          wllndtx(0,10)=cos(rurad2)*wlpt3+cx,cos(rurad)*wlpt2+cx,cos(rbrad)*wlpt2+cx,cos(rbrad2)*wlpt3+cx
                          wllndty(0,10)=sin(rurad2)*wlpt3+cy,sin(rurad)*wlpt3+cy,sin(rbrad)*wlpt3+cy,sin(rbrad2)*wlpt3+cy
                          ;左側小
                          wllndtx(0,11)=cos(lurad)*wlpt1+cx,cos(lurad2)*wlpt2+cx,cos(lbrad2)*wlpt2+cx,cos(lbrad)*wlpt1+cx
                          wllndty(0,11)=sin(lurad)*wlpt2+cy,sin(lurad2)*wlpt2+cy,sin(lbrad2)*wlpt2+cy,sin(lbrad)*wlpt2+cy
                          ;右側小
                          wllndtx(0,12)=cos(rurad2)*wlpt2+cx,cos(rurad)*wlpt1+cx,cos(rbrad)*wlpt1+cx,cos(rbrad2)*wlpt2+cx
                          wllndty(0,12)=sin(rurad2)*wlpt2+cy,sin(rurad)*wlpt2+cy,sin(rbrad)*wlpt2+cy,sin(rbrad2)*wlpt2+cy
                          ;左側中
                          wllndtx(0,13)=cos(lurad)*wlpt0+cx,cos(lurad2)*wlpt1+cx,cos(lbrad2)*wlpt1+cx,cos(lbrad)*wlpt0+cx
                          wllndty(0,13)=sin(lurad)*wlpt1+cy,sin(lurad2)*wlpt1+cy,sin(lbrad2)*wlpt1+cy,sin(lbrad)*wlpt1+cy
                          ;右側中
                          wllndtx(0,14)=cos(rurad2)*wlpt1+cx,cos(rurad)*wlpt0+cx,cos(rbrad)*wlpt0+cx,cos(rbrad2)*wlpt1+cx
                          wllndty(0,14)=sin(rurad2)*wlpt1+cy,sin(rurad)*wlpt1+cy,sin(rbrad)*wlpt1+cy,sin(rbrad2)*wlpt1+cy
                          ;チェックマスデータ作成
                          dim chkdx,c_parts
                          dim chkdy,c_parts
                          dim patternx,c_parts,4
                          dim patterny,c_parts,4
                          patternx(0,0)=0,0,-1,-1,-1,-2,-2,-2,-3,-3,-3
                          patterny(0,0)=1,-1,0,1,-1,0,1,-1,0,1,-1
                          patternx(0,1)=-1,1,0,-1,1,0,-1,1,0,-1,1
                          patterny(0,1)=0,0,-1,-1,-1,-2,-2,-2,-3,-3,-3
                          patternx(0,2)=0,0,1,1,1,2,2,2,3,3,3
                          patterny(0,2)=-1,1,0,-1,1,0,-1,1,0,-1,1
                          patternx(0,3)=1,-1,0,1,-1,0,1,-1,0,1,-1
                          patterny(0,3)=0,0,1,1,1,2,2,2,3,3,3
                          repeat 4
                              patternx(11,cnt)=patternx(6,cnt),patternx(7,cnt),patternx(3,cnt),patternx(4,cnt)
                              patterny(11,cnt)=patterny(6,cnt),patterny(7,cnt),patterny(3,cnt),patterny(4,cnt)
                          loop
                          ;処理開始
                          gsel 0
                          startx=1:starty=1:startdir=2
                          plrx=startx:plry=starty:plrdir=startdir
                          oncmd gosub *on_keydown,0x0100
                          gosub *mazedraw
                          stop
                          *on_keydown
                              oncmd 0
                              tplrx=plrx
                              tplry=plry
                              if wparam=37{    ;左旋回
                                  plrdir=(plrdir-1)&3
                                  sceneid=0
                              }else:if wparam=38{    ;前進
                                  tplrx=plrx+dx(plrdir)
                                  tplry=plry+dy(plrdir)
                                  sceneid=1
                              }else:if wparam=39{    ;右旋回
                                  plrdir=(plrdir+1)&3
                                  sceneid=2
                              }else:if wparam=40{    ;後退
                                  tplrx=plrx-dx(plrdir)
                                  tplry=plry-dy(plrdir)
                                  sceneid=3
                              }
                              if mapdt(tplrx,tplry)=0{
                                  plrx=tplrx
                                  plry=tplry
                                  gosub *mazedraw
                              }
                              oncmd 1
                              return
                          *mazedraw
                              redraw 0:color:boxf:color 255,255,255
                              memcpy chkdx,patternx,c_parts*4,0,plrdir*c_parts*4
                              memcpy chkdy,patterny,c_parts*4,0,plrdir*c_parts*4
                              dim chkflg,c_parts
                              repeat c_parts
                                  chkdx(cnt)+plrx
                                  chkdy(cnt)+plry
                                  x=chkdx(cnt):y=chkdy(cnt)
                                  if 0<=x&x<mc&0<=y&y<mr{
                                      chkflg(cnt)=mapdt(chkdx(cnt),chkdy(cnt))
                                  }else{
                                      chkflg(cnt)=e_wl
                                  }
                              loop
                              if chkflg(2)=e_wl{
                                  repeat 10,3
                                      chkflg(cnt)=e_empty
                                  loop
                              }else{
                                  if chkflg(5)=e_wl{
                                      repeat 5,6
                                          chkflg(cnt)=e_empty
                                      loop
                                  }else{
                                      repeat 2,6
                                          if chkflg(cnt)=e_wl:chkflg(cnt+3)=0
                                      loop
                                  }
                                  repeat 2,3
                                      if chkflg(cnt)=e_wl:chkflg(cnt+8)=0
                                  loop
                              }
                              repeat 2
                                  if chkflg(cnt)=e_wl:chkflg(cnt+13)=0
                              loop
                              repeat c_parts:id=cnt
                                  if chkflg(id)=e_wl{
                                      pos wllndtx(3,id),wllndty(3,id)
                                      repeat 4,0
                                          line wllndtx(cnt,id),wllndty(cnt,id)
                                      loop
                                  }
                              loop
                              redraw
                              return

                           

                           

                          参考資料:http://hp.vector.co.jp/authors/VA054130/%E8%BF%B7%E8%B7%AF%E6%8F%8F%E7%94%BB%E3%82%A2%E3%83%AB%E3%82%B4%E3%83%AA%E3%82%BA%E3%83%A0%EF%BC%92.txt

                          0
                            posted by higashijugem 13:09comments(0)|-|





                            うそつきクイズ

                            「うそつきクイズ」とは論理パズルの一種で、発言内容から誰が嘘つきかを当てる問題です

                            このプログラムはその論理パズルを自動で作ります

                            上二行の数字を書き換えることで出てくるキャラクターの人数を変えられます


                            #define membermax 3    ;総数
                            #define fakenum 1    ;嘘つき人数
                            randomize
                            ;発言内容は誰を対象とするか
                            dim taisyou,membermax
                            repeat membermax
                                val=rnd(cnt+1)
                                taisyou.cnt=taisyou.val
                                taisyou.val=cnt
                            loop
                            repeat membermax
                                if taisyou(cnt)=cnt{
                                    id=cnt
                                    repeat membermax
                                        if id!=cnt{
                                            tmp=taisyou(cnt)
                                            taisyou(cnt)=taisyou(id)
                                            taisyou(id)=tmp
                                            break
                                        }
                                    loop
                                }
                            loop
                            ;誰を嘘つきにするか
                            dim usotsuki,membermax
                            repeat membermax
                                val=rnd(cnt+1)
                                usotsuki.cnt=usotsuki.val
                                usotsuki.val=cnt
                            loop
                            dim usohonto,membermax
                            repeat fakenum
                                usohonto(usotsuki(cnt))=1
                            loop
                            ;メンバーの名前
                            sdim namelist,membermax
                            repeat membermax
                                namelist(cnt)=strf("%c",cnt+65)
                            loop
                            ;処理開始
                            title"うそつきの人数:"+fakenum
                            repeat membermax
                                name=namelist(taisyou(cnt))
                                if usohonto(cnt){
                                    if usohonto(taisyou(cnt)){
                                        mes""+namelist(cnt)+" 「 "+name+" は正直」"
                                    }else{
                                        mes""+namelist(cnt)+" 「 "+name+" はうそつき」"
                                    }
                                }else{
                                    if usohonto(taisyou(cnt)){
                                        mes""+namelist(cnt)+" 「 "+name+" はうそつき」"
                                    }else{
                                        mes""+namelist(cnt)+" 「 "+name+" は正直」"
                                    }
                                }
                            loop
                            pos 320,0
                            button gosub "答え",*kotae
                            stop
                            *kotae
                                repeat membermax
                                    if usohonto(cnt){
                                        mes"うそつきは"+namelist(cnt)
                                    }
                                loop
                                return

                            0
                              posted by higashijugem 20:09comments(0)|-|





                              マーブリング

                              こちらのサイトに「マーブリング」という表現技法を再現したプログラムがあったので、HSPでも実装してみました

                              ソースコードはこちらのサイトをパクら参考にさせていただきました

                              処理が重すぎたり、もっとキャンパスをでかくしたい場合はgwとghのサイズを変更してみてください

                               

                              VRAMを利用したりマシン語を用いたりすれば動作がさらに軽くなります

                              もっと軽快にしたい方は挑戦してみてください


                              randomize
                              gw=250:gh=250
                              screen 0,gw,gh,1
                              oncmd gosub *on_EXITSIZEMOVE, 0x0232
                              oncmd gosub *on_KEYDOWN, 0x0100
                              winx=ginfo(4):winy=ginfo(5)
                              ;パレットカラー設定
                              colmax=10
                              repeat colmax-1,1
                                  hsvcolor (cnt-1)*19,255,255
                                  palette cnt,ginfo_r,ginfo_g,ginfo_b
                              loop
                              palette 0,255,255,255,1
                              ;処理開始
                              dim board,gw,gh
                              dim tboard,gw,gh
                              tr=10.0
                              ncl=1
                              repeat
                                  getkey k1,1
                                  getkey k2,2
                                  muw=mousew
                                  if k1{    ;左クリックで滴下
                                      if k1flg=0{
                                          ;ncl=rnd(colmax-1)+1    ;色をランダム指定する場合はコメント解除
                                          r=tr
                                          k1flg=1
                                      }
                                      if x!=mousex|y!=mousey{
                                          r=tr
                                      }
                                      x=mousex:y=mousey
                                      gosub *drawcircle
                                      r+=1.0
                                  }else{
                                      r=tr
                                      k1flg=0
                                  }
                                  if k2{    ;右クリックしたままドラッグで引っ張り
                                      if k2flg=0{
                                          x=mousex:y=mousey
                                      }
                                      k2flg=1
                                  }else{
                                      if k2flg{
                                          tx=mousex:ty=mousey
                                          if tx!=x|ty!=y{
                                              theta=atan(ty-y,tx-x)
                                              ex=cos(theta)
                                              ey=sin(theta)
                                              rx=cos(theta+M_PI/2)
                                              ry=sin(theta+M_PI/2)
                                              alpha=sqrt(powf(ty-y,2)+powf(tx-x,2))
                                              beta=sqrt(alpha)
                                              gosub *drawline
                                              k2flg=0
                                          }
                                      }
                                  }
                                  if muw!=0{    ;マウスホイールを動かすと攪拌
                                      x=mousex:y=mousey
                                      r=0f+rnd(100)
                                      if muw>0{
                                          alpha=0f+muw
                                      }else{
                                          alpha=-0f+muw
                                      }
                                      beta=10.0
                                      gosub *drawspiral
                                  }
                                  redraw:wait:redraw 0
                              loop
                              *on_KEYDOWN
                                  if 48<=wparam&wparam<=57{    ;テンキーで描写する色を変更
                                      ncl=wparam-48
                                  }
                                  return
                              *on_EXITSIZEMOVE
                                  if winx!=ginfo(4)|winy!=ginfo(5){    ;ウィンドウを動かすと波打つ
                                      A=sqrt(powf(winx-ginfo(4),2)+powf(winy-ginfo(5),2))/50
                                      t=atan(ginfo(5)-winy,ginfo(4)-winx)
                                      fai=deg2rad(rnd(180))
                                      omega=0.5
                                      gosub *drawwave
                                  }
                                  winx=ginfo(4):winy=ginfo(5)
                                  return
                              *drawcircle
                                  memcpy tboard,board,gw*gh*4
                                  repeat gh:j=cnt
                                      repeat gw:i=cnt
                                          if powf(i-x,2)+powf(j-y,2)<=powf(r,2){
                                              board(i,j)=ncl
                                          }else{
                                              tmp=sqrt(1.0-powf(r,2)/(powf(i-x,2)+powf(j-y,2)))
                                              fx=0+(0.5+tmp*(i-x)+x)
                                              fy=0+(0.5+tmp*(j-y)+y)
                                              if 0<=fx&fx<gw&0<=fy&fy<gh{
                                                  board(i,j)=tboard(fx,fy)
                                              }
                                          }
                                          palcolor board(i,j)
                                          pset i,j
                                      loop
                                  loop
                                  return
                              *drawline
                                  memcpy tboard,board,gw*gh*4
                                  repeat gh:j=cnt
                                      repeat gw:i=cnt
                                          tmp=alpha*beta/(beta+absf(rx*(i-x)+ry*(j-y)))
                                          fx=0+((0.5+i)-tmp*ex)
                                          fy=0+((0.5+j)-tmp*ey)
                                          if 0<=fx&fx<gw&0<=fy&fy<gh{
                                              board(i,j)=tboard(fx,fy)
                                          }
                                          palcolor board(i,j)
                                          pset i,j
                                      loop
                                  loop
                                  return
                              *drawspiral
                                  memcpy tboard,board,gw*gh*4
                                  repeat gh:j=cnt
                                      repeat gw:i=cnt
                                          len=powf(i-x,2)+powf(j-y,2)
                                          if len>0{
                                              d=absf(sqrt(len)-r)
                                              theta=alpha*beta/((d+beta)*(sqrt(len)))
                                              fx=0+((cos(theta)*(i-x)+x+sin(theta)*(j-y))+0.5)
                                              fy=0+(((-sin(theta))*(i-x)+y+cos(theta)*(j-y))+0.5)
                                              if 0<=fx&fx<gw&0<=fy&fy<gh{
                                                  board(i,j)=tboard(fx,fy)
                                              }
                                          }
                                          palcolor board(i,j)
                                          pset i,j
                                      loop
                                  loop
                                  return
                              *drawwave
                                  memcpy tboard,board,gw*gh*4
                                  repeat gh:j=cnt
                                      repeat gw:i=cnt
                                          theta=omega*(sin(t)*i-cos(t)*j)+fai
                                          fx=0+((0f+i)-A*sin(theta)*cos(t)+0.5)
                                          fy=0+((0f+j)-A*sin(theta)*sin(t)+0.5)
                                          if 0<=fx&fx<gw&0<=fy&fy<gh{
                                              board(i,j)=tboard(fx,fy)
                                          }
                                          palcolor board(i,j)
                                          pset i,j
                                      loop
                                  loop
                                  return

                              0
                                posted by higashijugem 11:55comments(0)|-|





                                ウィンドウの移動を検知

                                ウィンドウ自体を移動させたとき、移動前と移動後でどのくらい座標が変化したかを取得するプログラムです


                                #define WM_EXITSIZEMOVE 0x0232    
                                oncmd gosub *on_EXITSIZEMOVE, WM_EXITSIZEMOVE
                                winx=ginfo(4):winy=ginfo(5)
                                stop
                                *on_EXITSIZEMOVE
                                    if winx!=ginfo(4)|winy!=ginfo(5){
                                        mes"winx = "+(ginfo(4)-winx)+", winy = "+(ginfo(5)-winy)
                                    }
                                    winx=ginfo(4):winy=ginfo(5)
                                    return

                                0
                                  posted by higashijugem 10:40comments(0)|-|





                                  吹き出し

                                  キャラクターの吹き出しを描写するプログラムです

                                  端に近い位置のキャラの吹き出しは、見切れないよう描写位置を調整しています


                                  randomize
                                  ;キャラクター
                                  chcsz=64
                                  buffer 2,chcsz,chcsz:celdiv 2,chcsz,chcsz,chcsz/2,chcsz/2
                                  color:boxf:color 255
                                  circle chcsz/4,0,chcsz-chcsz/4,chcsz/2
                                  xzh=chcsz/2,chcsz/2,chcsz,0
                                  yzh=chcsz/4,chcsz/4,chcsz,chcsz
                                  gsquare -1,xzh,yzh
                                  ;初期設定
                                  charamax=8
                                  dim charadt,4,charamax
                                  gsel
                                  gmode 2
                                  repeat charamax
                                      cenx=rnd(560)+40
                                      ceny=rnd(400)+40
                                      charadt(0,cnt)=cenx-chcsz/2,ceny-chcsz/2,cenx+chcsz/2,ceny+chcsz/2
                                  loop
                                  repeat charamax
                                      pos charadt(0,cnt)+chcsz/2,charadt(1,cnt)+chcsz/2
                                      celput 2,0
                                  loop
                                  ;背景
                                  buffer 3,640,480
                                  pos 0,0:gcopy 0,,,640,480
                                  gsel 0
                                  ;処理開始
                                  oncmd gosub *mousemove, $200
                                  stop
                                  *mousemove
                                      pos 0,0:gcopy 3,,,640,480
                                      mux=mousex:muy=mousey
                                      putid=-1
                                      repeat charamax
                                          ltx=charadt(0,cnt)
                                          lty=charadt(1,cnt)
                                          rbx=charadt(2,cnt)
                                          rby=charadt(3,cnt)
                                          if ltx<=mux&mux<=rbx&lty<=muy&muy<=rby{
                                              putid=cnt
                                              break
                                          }
                                          await
                                      loop
                                      title""+putid
                                      if putid>=0{
                                          gosub *fukidasi
                                      }
                                      return
                                  *fukidasi
                                      x=ltx-80:y=lty-50
                                      xdir=0:ydir=0
                                      if ltx<=120{x=rbx:xdir=1}
                                      if lty<=120{y=rby:ydir=1}
                                      color ,,255
                                      boxf x,y,x+80,y+50
                                      if xdir{
                                          xzh=rbx,rbx-20,rbx-20,rbx
                                      }else{
                                          xzh=ltx,ltx+20,ltx+20,ltx
                                      }
                                      if ydir{
                                          yzh=rby+20,rby-10,rby-10,rby
                                      }else{
                                          yzh=lty-20,lty+10,lty+10,lty
                                      }
                                      gsquare -1,xzh,yzh
                                      return

                                  0
                                    posted by higashijugem 22:59comments(0)|-|





                                    Split改良版

                                    Splitを用いて文字列を分割するとき、区切り用の文字は一度に一種類しか指定できません

                                    この問題(?)に対処するため、正規表現を用いることで複数の区切り文字を指定できる関数を作成しました

                                     

                                    8/22  2バイト文字に対応

                                     

                                    ;正規表現モジュール
                                    #define global ctype twobytenum(%1="",%2=0,%3=0) _twobytenum(%1,%2,%3)
                                    #ifndef __mod_regexp_r
                                    #define __mod_regexp_r
                                    #module
                                    #deffunc _startregexp_r
                                        newcom oReg,"VBScript.RegExp"
                                        return
                                    #deffunc matches_r array retvar,array resindex,var target,str Pattern,int IgnoreCase,int Global,int Multiline
                                        oReg("IgnoreCase") = (IgnoreCase==0)
                                        oReg("Global") = (Global==0)
                                        oReg("Multiline") = (Multiline==0)
                                        oReg("Pattern") = Pattern
                                        comres oMatches
                                        oReg->"Execute" target
                                        if stat<0:sdim retvar,1,1:return 0
                                        num1=oMatches("count")
                                        if num1==0:sdim retvar,1,1:    delcom oMatches:return 0
                                        oMatch=oMatches("item",0)
                                        sdim retvar,64,num1,num2+1
                                        dim resindex,num1,num2+1
                                        id=0
                                        plus=0
                                        for i,0,num1,1
                                            oMatch=oMatches("item",i)
                                            retvar.i=oMatch("value")
                                            resindex.i=oMatch("FirstIndex")+plus
                                            plus=twobytenum(target,resindex.i,id)
                                            resindex.i+=plus
                                        next
                                        variant=0
                                        delcom oMatch
                                        delcom oMatches
                                        return num1
                                        return
                                    #defcfunc _twobytenum var p1,int p2,int p3
                                        if p2<0:return 0
                                        id=0
                                        add=1
                                        two=0
                                        repeat p2,p3
                                            code=peek(p1,id+p3)
                                            if ((code>=129)&(code<=159))|((code>=224)&(code<=252)){
                                                id+add
                                                two++
                                            }
                                            id+add
                                        loop
                                        return two
                                    #global
                                    _startregexp_r
                                    #endif
                                    ;正規表現対応split
                                    #module
                                    #deffunc splitr var sentence,str symbol,array clause
                                        sdim clause
                                        sdim punctuation
                                        dim index
                                        matches_r punctuation,index,sentence,symbol
                                        matchnum=stat
                                        cid=0:sid=0
                                        repeat matchnum
                                            memcpy clause(cid),sentence,index(cnt)-sid,0,sid
                                            clause(cid)=str(clause(cid))
                                            cid++:sid=index(cnt)+strlen(punctuation(cnt))
                                        loop
                                        memcpy clause(cid),sentence,strlen(sentence)-sid,0,sid
                                        mref _stat,64
                                        _stat = matchnum+1
                                        return
                                    #global
                                    ;処理開始
                                    sentence="aaa,いいい-ccc/ddd"
                                    splitr sentence,"[,-/]",clause
                                    repeat stat
                                        mes""+clause(cnt)
                                    loop

                                    0
                                      posted by higashijugem 22:13comments(0)|-|





                                      文字列読み込み(巨大テキストファイル用)

                                      こちらの記事を参考に「noteget」の代わりに「instr & memcpy」でサイズが大きいテキストファイルを読み込むプログラムを作成しました

                                      処理時間を計測し、どのくらい早くなったかを比較しています

                                      また、複数の種類の改行コードにも対応させました

                                       

                                      #include "mod_regexp.as"
                                      sdim filestr
                                      sdim tfilestr
                                      sdim linestr,1000    ;一行につき千文字まで取得可能
                                      ;処理時間を計測するのに必要な諸々の設定
                                      #uselib "kernel32"
                                      #func QueryPFreq "QueryPerformanceFrequency" var
                                      #func QueryPCount "QueryPerformanceCounter" var
                                      dim lgint,4    ;LARGE_INTEGER構造体
                                      #define _start QueryPFreq nFreq : QueryPCount nBefore
                                      #define _goal QueryPCount lgint(2) : dwTime=strf("%%.3fmSec",1000.*(lgint(2)-nBefore)/nFreq)
                                      ;テキストファイル読み込み
                                      dialog "",16
                                      if stat{
                                          filedir=refstr
                                          chdir getpath(filedir,32)
                                          exist filedir
                                          filesize=strsize
                                          if filesize<0:end
                                          filename=getpath(filedir,1+8+2)
                                          notesel filestr
                                          noteload filedir
                                      }else{
                                          end
                                      }
                                      ;改行コードの取得
                                      lf=strf("%c",10)
                                      cr=strf("%c",13)
                                      crlf=cr+lf
                                      newlinecode=""
                                      newlineln=0
                                      if instr(filestr,0,crlf)>=0{
                                          newlinecode=crlf
                                          newlineln=2
                                      }else:if instr(filestr,0,cr)>=0{
                                          newlinecode=cr
                                          newlineln=1
                                      }else:if instr(filestr,0,lf)>=0{
                                          newlinecode=lf
                                          newlineln=1
                                      }
                                      ;noteget の処理時間
                                      _start    ;計測開始
                                      id=0
                                      lineln=0
                                      tfilestr=""
                                      nmax=notemax
                                      repeat nmax
                                          noteget linestr,cnt
                                          gosub *lineprocess
                                      loop
                                      _goal    ;計測終了
                                      pos 0:mes"noteget の処理時間 :"+dwTime
                                      ;instr & memcpy の処理時間
                                      _start    ;計測開始
                                      id=0
                                      lineln=0
                                      tfilestr=""
                                      repeat
                                          lineln=instr(filestr,id,newlinecode)
                                          if lineln<0{
                                              if id<filesize{
                                                  lineln=filesize-id
                                                  bkflg=1
                                              }else{
                                                  break
                                              }
                                          }
                                          memset linestr,0,1000    ;初期化しないと出力結果がおかしくなる
                                          memcpy linestr,filestr,lineln,0,id
                                          gosub *lineprocess
                                          if bkflg:break
                                          id+=lineln+newlineln
                                      loop
                                      _goal    ;計測終了
                                      filestr=tfilestr
                                      notesave "t_"+filename    ;変換ファイル出力
                                      pos 0:mes"instr & memcpy の処理時間:"+dwTime
                                      noteunsel
                                      stop

                                      ;取得行処理
                                      *lineprocess
                                          ;置換処理(a->b, あ->い)
                                          linestr=replace(linestr,"a","b")
                                          linestr=replace(linestr,"あ","い")
                                          tfilestr+=linestr+newlinecode    ;変換行を代入
                                          return

                                      0
                                        posted by higashijugem 15:37comments(0)|-|





                                        リアルタイムでテキストファイルの行数を取得

                                        テキストファイルをプログラム上で操作する場合「repeat notemax 〜 loop」とすると、すべての行に対して処理が行えます

                                        しかし、処理の途中で「noteadd」などを使用すると行数が変わってしまい、終わりの数行が編集できない場合があります

                                        このプログラムではテキストの行数をループ中でも取得することで、上記の問題点に対処できるようにしました


                                        a="aa¥nbb¥n¥ncc¥n"
                                        notesel a
                                        repeat
                                            nmax=notemax
                                            if nmax<=cnt:break
                                            if cnt=2|cnt=4{
                                                noteadd "add",cnt,0
                                            }
                                            noteget b,cnt
                                            mes b
                                        loop

                                        0
                                          posted by higashijugem 07:42comments(0)|-|





                                          タブ区切りを揃える

                                          横並びの単語を一定数のtabで区切ると、右側の単語が揃わずバラバラになることがあります

                                          このプログラムはそれを解消するプログラムです

                                          左側に変換元の文字列を入れてボタンを押すと、右側に変換された文字列が表示されます

                                           

                                          bfstr={"

                                          Programming		Language
                                          HSP				Script
                                          Hello		World
                                          

                                          "}

                                          ;変換前
                                          pos 0,0:mesbox bfstr,320,400
                                          afstr=""
                                          ;変換後
                                          pos 320,0:mesbox afstr,320,400:stat_afstr=stat:hwnd_afstr = objinfo(stat_afstr, 2)
                                          pos 320,400:objsize 320,50:button gosub "Arrangement",*arrangement
                                          sdim lstdt,,10,10000:lstlid=0
                                          sdim bfstrline,,10000
                                          sdim bfstrcell,,10
                                          tablen=8    ;タブの幅
                                          bfstrsize=strlen(bfstr)
                                          stop
                                          *arrangement
                                              chksize=0
                                              split bfstr,"¥n",bfstrline
                                              ;一行ごとにタブで区切られた文節を取得
                                              repeat length(bfstrline):lcnt=cnt
                                                  repeat length(bfstrcell)
                                                      bfstrcell(cnt)=""
                                                  loop
                                                  chksize+(strlen(bfstrline(cnt))+2)
                                                  split bfstrline(cnt),"¥t",bfstrcell
                                                  id=0
                                                  repeat length(bfstrcell)
                                                      if bfstrcell(cnt)!=""{
                                                          lstdt(id,lcnt)=bfstrcell(cnt)
                                                          id++
                                                      }
                                                  loop
                                                  if chksize>bfstrsize:break
                                                  lstlid++
                                              loop
                                              ;文節の最大長を取得
                                              max=0
                                              repeat lstlid
                                                  if max<strlen(lstdt(0,cnt)){
                                                      max=strlen(lstdt(0,cnt))
                                                  }
                                              loop
                                              ;一行ごとに右側が揃うタブ数を計算して追加
                                              rightid=(max/tablen+1)*tablen
                                              repeat lstlid:lcnt=cnt
                                                  trid=0
                                                  repeat length(lstdt)-1
                                                      if lstdt(cnt,lcnt)!=""{
                                                          afstr+=lstdt(cnt,lcnt)
                                                          if lstdt(cnt+1,lcnt)!=""{
                                                              lpnum=(rightid-strlen(lstdt(cnt,lcnt)))/tablen+1
                                                              repeat lpnum
                                                                  afstr+="¥t"
                                                              loop
                                                          }
                                                      }
                                                  loop
                                                  afstr+"¥n"
                                              loop
                                              objprm stat_afstr,afstr
                                              sendmsg hwnd_afstr, $B1, , -1    ;EM_SETSEL (文字列の全選択)
                                              sendmsg hwnd_afstr, $0301        ;WM_COPY (クリップボードに転送)
                                              return

                                           

                                           

                                          0
                                            posted by higashijugem 22:36comments(0)|-|





                                            バッチファイル

                                            コマンドプロンプト上で実行させるバッチファイルを作成し、動かすプログラムです

                                             

                                             

                                            dircur=dir_cur
                                            resfile=dircur+"¥¥result.txt"    ;出力先ファイル
                                            batfile=dircur+"¥¥command.bat"    ;実行バッチファイル
                                            hs=""
                                            notesel hs
                                            hs="cd "+dircur+"¥n"
                                            ;標準出力と標準エラー出力を両方ともファイルへ出力する
                                            ;コマンド > ファイル名 2>&1
                                            hs+="ipconfig /all > "+resfile+" 2>&1"
                                            notesave batfile
                                            ;バッチファイルが作成されたかチェック
                                            mes"作成中・・・"
                                            repeat
                                                exist batfile
                                                if strsize>=0{
                                                    break
                                                }
                                                wait 1
                                            loop
                                            exec "cmd /c "+batfile    ;Windowsのファイルを実行
                                            mes"バッチファイル¥n "+batfile
                                            mes"保存先¥n "+resfile

                                            0
                                              posted by higashijugem 23:06comments(0)|-|





                                              コントロール自動サイズ調整

                                              コントロール(サンプルではリッチエディットコントロール)のサイズをウィンドウの大きさに合わせるプログラムです

                                              ウィンドウのサイズが変わる度にWM_COMMANDメッセージを通知し、MoveWindow関数を利用してサイズを変更しています

                                               


                                              #uselib "kernel32"
                                              #cfunc LoadLibrary "LoadLibraryA" str
                                              #func FreeLibrary "FreeLibrary" int
                                              #uselib "user32"
                                              #func GetWindowLong "GetWindowLongA" int,int
                                              #func SetWindowLong "SetWindowLongA" int, int, int
                                              #func MoveWindow "MoveWindow" int, int, int, int, int, int
                                              ;ウィンドウ
                                              screen 0, ginfo(20), ginfo(21), 0, , , 640, 480
                                              ;最大化、サイズ変更に対応
                                              GetWindowLong hwnd, -16
                                              SetWindowLong hwnd, -16, stat | $10000 | $40000
                                              ;リッチエディットコントロール
                                              hModRichEd32 = LoadLibrary("Riched20.dll") ;DLL読み込み&初期化
                                              pos 0,0:winobj "RichEdit20A", "", 0, 0x50b000c4 , 0, 0, 1, 10000
                                              stat_re=stat:hwnd_re = objinfo_hwnd(stat_re)
                                              ;WM_COMMANDメッセージ
                                              oncmd gosub *command, $111
                                              ;終了処理
                                              onexit gosub *exit
                                              stop
                                              *command
                                                  MoveWindow hwnd_re, 0,0,ginfo(12),ginfo(13), 1
                                                  return
                                              *exit
                                                  FreeLibrary hModRichEd32 ;DLLの開放
                                                  end

                                              0
                                                posted by higashijugem 20:03comments(0)|-|





                                                aのn乗を任意の数で割った余り(繰り返し自乗法)

                                                繰り返し自乗法を用いて余りを求めるプログラムです

                                                再帰関数を用いて実装されています

                                                 

                                                 

                                                #module
                                                #defcfunc repeatsquaring double n, double p, double m
                                                    if p=0:return 1
                                                    if p¥2=0{
                                                        t=repeatsquaring(n, p/2, m)
                                                        return t*t¥m
                                                    }
                                                    return n*repeatsquaring(n, p-1, m)
                                                #global
                                                n=13    ;乗数
                                                p=300    ;指数
                                                m=33    ;除数
                                                mes""+n+" の "+p+" 乗≡ "+strf("%d",repeatsquaring(n,p,m))+" (mod "+m+" )"
                                                ;確認用
                                                ans=1
                                                repeat p
                                                    ans*n
                                                    ans¥m
                                                loop
                                                mes""+n+" の "+p+" 乗≡ "+ans+" (mod "+m+" )"

                                                0
                                                  posted by higashijugem 22:11comments(0)|-|





                                                  aのn乗を素数で割った余り(周期性)

                                                  aのn乗を素数で割った余りを求めるプログラムです

                                                  以下の記事の「周期性を使う方法」を参考にさせていただきました

                                                  「3の100乗を19で割ったあまりは?」を4通りの方法で計算する

                                                   


                                                  a=3        ;乗数
                                                  n=100    ;指数
                                                  p=19    ;除数
                                                  t=1        ;剰余
                                                  dim mlst,p
                                                  repeat p-1    ;周期性リスト
                                                      if cnt>=n:break
                                                      t*a
                                                      if t>p{
                                                          t¥p
                                                      }
                                                      mlst(cnt)=t
                                                      mes""+a+" の "+(cnt+1)+" 乗≡ "+t+" (mod "+p+" )"
                                                  loop
                                                  mes"・¥n・¥n・¥n"
                                                  pos 300,0
                                                  if p>n{
                                                      tt=n-1
                                                  }else{
                                                      tt=n¥(p-1)-1
                                                  }
                                                  mes""+a+" の "+n+" 乗≡ "+mlst(tt)+" (mod "+p+" )"

                                                  0
                                                    posted by higashijugem 11:21comments(0)|-|





                                                    弾幕

                                                    SLG(シューティングゲーム)のような弾幕を再現したプログラムです

                                                    クリックすることで弾幕のパターンが切り替わります

                                                     

                                                     

                                                    #include "hgimg3.as"
                                                    hgsetreq SYSREQ_MAXOBJ,10000    ;オブジェクト最大数変更
                                                    hgini

                                                    #const patnum 1
                                                    #const csz 16

                                                    oncmd gosub *wm_lbuttondown, $0201
                                                    oncmd gosub *wm_lbuttonup, $0202

                                                    buffer 2,csz,csz*patnum
                                                    ;アニメーション画像作成
                                                    boxf
                                                    x=0:y=0:deg=0
                                                    color 255,255,255:circle 0,0,csz-1,csz-1
                                                    setuv 0,0,csz-1,csz-1    ;登録テクスチャUV座標を指定
                                                    addspr sp0,1    ;2Dスプライトモデルを作成
                                                    settex csz,csz,0,-1    ;テクスチャを登録
                                                    ;イベント作成
                                                    newevent evid    ;イベントリストを作成
                                                    event_prmon evid,PRMSET_MODE,OBJ_MOVE|OBJ_XFRONT    ;パラメータービット設定イベントを追加
                                                    event_wait evid,1    ;ウェイト
                                                    event_jump  evid,0    ;イベントの最初に戻る
                                                    ;処理開始
                                                    screen 0
                                                    dim objiddt,1000:objfcsid=0
                                                    repeat length(objiddt)
                                                        regobj objiddt(cnt),sp0    ;オブジェクトの登録
                                                        setpos objiddt(cnt),-400,0
                                                    loop
                                                    spd=4
                                                    *main
                                                        hgdraw:hgsync 17
                                                        title"パターン:"+(flg+1)
                                                        if wparam>0{
                                                            gosub *mouseclick
                                                        }
                                                        goto *main
                                                    *wm_lbuttondown    ;マウスボタンを押す
                                                        time=0
                                                        return
                                                    *wm_lbuttonup    ;マウスボタンを離す
                                                        flg++
                                                        if flg>2:flg=0
                                                        return
                                                    *mouseclick
                                                        if flg=0{
                                                            if time{
                                                                time--
                                                            }else{
                                                                repeat 18
                                                                    rad=deg2rad(cnt*20)
                                                                    setevent objiddt(objfcsid),evid,0
                                                                    setpos objiddt(objfcsid),0,0
                                                                    setdir objiddt(objfcsid),cos(rad)*spd,sin(rad)*spd,0
                                                                    objfcsid++
                                                                    if objfcsid>=length(objiddt):objfcsid=0
                                                                loop
                                                                time=20
                                                            }
                                                        }else:if flg=1{
                                                            if time{
                                                                time--
                                                            }else{

                                                                rad=deg2rad(c1*10)
                                                                setevent objiddt(objfcsid),evid,0
                                                                setpos objiddt(objfcsid),0,0
                                                                setdir objiddt(objfcsid),cos(rad)*spd,sin(rad)*spd,0
                                                                objfcsid++
                                                                if objfcsid>=length(objiddt):objfcsid=0
                                                                rad=deg2rad(c1*10+180)
                                                                setevent objiddt(objfcsid),evid,0
                                                                setpos objiddt(objfcsid),0,0
                                                                setdir objiddt(objfcsid),cos(rad)*spd,sin(rad)*spd,0
                                                                objfcsid++
                                                                if objfcsid>=length(objiddt):objfcsid=0
                                                                c1++
                                                            }
                                                        }else:if flg=2{
                                                            if time{
                                                                time--
                                                            }else{
                                                                repeat 18
                                                                    rad=deg2rad(cnt*20+c1)
                                                                    setevent objiddt(objfcsid),evid,0
                                                                    setpos objiddt(objfcsid),0,0
                                                                    setdir objiddt(objfcsid),cos(rad)*spd,sin(rad)*spd,0
                                                                    objfcsid++
                                                                    if objfcsid>=length(objiddt):objfcsid=0
                                                                loop
                                                                time=6:c1+10
                                                            }
                                                        }
                                                        return

                                                    0
                                                      posted by higashijugem 13:47comments(0)|-|





                                                      リッチエディットコントロール

                                                      リッチエディットコントロール(リッチエディタ、リッチテキストエディタなど)を作成、表示するプログラムです

                                                       


                                                      #include "kernel32.as"
                                                      #const style    0x50b000c4 
                                                      /*
                                                      ES_MULTILINE    0x00000004
                                                      ES_AUTOVSCROLL    0x00000040
                                                      ES_AUTOHSCROLL    0x00000080
                                                      WS_HSCROLL        0x00100000
                                                      WS_VSCROLL        0x00200000
                                                      WS_BORDER        0x00800000
                                                      WS_VISIBLE        0x10000000
                                                      WS_CHILD        0x40000000
                                                      */
                                                      onexit *exit
                                                      Loadlibrary "RICHED20.DLL"    ;DLLを読み込む
                                                      plib=stat
                                                      pos 0,0
                                                      winobj "RichEdit20A","",0,style,ginfo_winx,ginfo_winy
                                                      stop
                                                      *exit
                                                          FreeLibrary plib    ;読み込んだDLLを介抱
                                                          end

                                                      0
                                                        posted by higashijugem 22:26comments(0)|-|





                                                        VRAM操作

                                                        VRAMの値を書き換えて矩形を描写するプログラムです

                                                        領域の幅が4の倍数でない場合や範囲外を指定した場合でも、正常に表示されます

                                                         

                                                        #module
                                                        #deffunc areacheck var p,var l,var te,int ge
                                                            if l<0{
                                                                p=p+l
                                                                l=l*(-1)
                                                            }
                                                            te=l+p
                                                            if te<0{
                                                                te=0
                                                            }else:if te>ge{
                                                                te=ge
                                                            }
                                                            if p<0{
                                                                p=0
                                                            }
                                                            return
                                                        #global
                                                        #module
                                                        #deffunc vramset array vram,int tx,int ty,int tw,int th,int tc,int tgw,int tgh
                                                            x=tx:y=ty:w=tw:h=th:c=tc:gw=tgw:gh=tgh
                                                            r=c&0xff
                                                            g=(c>>8)&0xff
                                                            b=(c>>16)&0xff
                                                            areacheck x,w,tew,gw
                                                            areacheck y,h,teh,gh
                                                            if (gw*3)¥4!=0{
                                                                fx=1
                                                                ix=1-((gw*3)¥4)
                                                            }else{
                                                                fx=0:ix=0
                                                            }
                                                            ;横一行分のデータ作成
                                                            sdim wdata,(tew-x)*3
                                                            repeat tew-x
                                                                index=cnt*3
                                                                poke wdata,index,r
                                                                poke wdata,index+1,g
                                                                poke wdata,index+2,b
                                                            loop
                                                            ;四角形描写
                                                            j=y
                                                            w=(tew-x)*3
                                                            repeat
                                                                if j>=teh:break
                                                                tj=(gh-j-1)
                                                                sfx=fx*tj
                                                                six=ix*tj
                                                                i=x+sfx
                                                                index=(tj*gw+i)*3+six
                                                                memcpy vram,wdata,w,index,0
                                                                j++
                                                            loop
                                                            return
                                                        #global
                                                        boxf
                                                        mref vram,66
                                                        vramset vram,50,50,100,100,$ffffff,ginfo(12),ginfo(13)
                                                        redraw

                                                        0
                                                          posted by higashijugem 07:36comments(0)|-|





                                                          判別分析法

                                                          大津の手法」と呼ばれる二値化の画像フィルタ処理です

                                                          以下のサイトに詳しい情報が載っています

                                                          http://imagingsolution.blog.fc2.com/blog-entry-113.html

                                                           

                                                          HSPにはOpenCVを利用した拡張プラグインがデフォルトで入っているので

                                                          それを用いて処理を行っています

                                                           


                                                          #const gmw 640
                                                          #const gmh 480
                                                          #include "hspcv.as"
                                                          randomize
                                                          screen 2:title"入力画像"
                                                          repeat 10
                                                              repeat 4:col(cnt)=0:loop
                                                              repeat 2:col(rnd(4))=0xffffff:loop
                                                              repeat 4
                                                                  x(cnt)=rnd(gmw),rnd(gmw),rnd(gmw),rnd(gmw)
                                                                  y(cnt)=rnd(gmh),rnd(gmh),rnd(gmh),rnd(gmh)
                                                              loop
                                                              gsquare -257,x,y,col
                                                          loop
                                                          gsel 0:title"出力画像"
                                                          wait 100
                                                          ;2値化処理
                                                          cvbuffer 0,gmw,gmh
                                                          gsel 2
                                                          cvputimg 0
                                                          cvthreshold CV_THRESH_OTSU,,255,0    ;判別分析法
                                                          gsel 0,1
                                                          cvgetimg 0

                                                          0
                                                            posted by higashijugem 22:16comments(0)|-|





                                                            キャラクターアニメーション(DirectX)

                                                            HSPの拡張プラグイン「hgimg3」を用いて作成した、ただ歩き回るだけのオブジェクトです

                                                            マウスの左ボタンを押すことでオブジェクトの数を増やすことができます

                                                             

                                                             

                                                            #include "hgimg3.as"
                                                            hgini

                                                            #const patnum 16
                                                            #const csz 32

                                                            oncmd gosub *wm_lbuttondown, $201    ;マウスの左クリックされた時

                                                            buffer 2,csz,csz*patnum
                                                            ;アニメーション画像作成
                                                            boxf
                                                            x=0:y=0:deg=0
                                                            repeat patnum
                                                                color 255,,255:circle x+1,y+9,x+csz-1,y+csz-9
                                                                color ,,255:circle x+7,y+7,x+csz-7,y+csz-7
                                                                rad=deg2rad(deg)
                                                                color 255
                                                                circle 0,y+csz/2-sin(rad)*16,4,y+csz/2+sin(rad)*4
                                                                circle csz-5,y+csz/2+sin(rad)*16,csz,y+csz/2-sin(rad)*4
                                                                y+csz:deg+(360/16)
                                                            loop
                                                            setuv 0,0,csz-1,csz-1    ;登録テクスチャUV座標を指定
                                                            addspr sp0,1    ;2Dスプライトモデルを作成
                                                            settex csz,csz,0,-1    ;テクスチャを登録
                                                            ;イベント作成
                                                            newevent evid    ;イベントリストを作成
                                                            repeat patnum
                                                                event_uv evid,0,cnt*csz    ;UV設定イベントを追加
                                                                event_prmon evid,PRMSET_MODE,OBJ_MOVE|OBJ_XFRONT    ;パラメータービット設定イベントを追加
                                                                event_wait evid,1    ;ウェイト
                                                            loop
                                                            event_jump  evid,0    ;イベントの最初に戻る
                                                            ;処理開始
                                                            screen 0
                                                            dim objiddt,1000:objfcsid=0
                                                            gosub *wm_lbuttondown
                                                            *main
                                                                hgdraw:hgsync 17
                                                                repeat objfcsid
                                                                    getposi objiddt(cnt),x,y,z
                                                                    if x<=-128&y<=-128{
                                                                        setpos objiddt(cnt),-128,-128        ;再配置
                                                                        setdir objiddt(cnt),(0.01*rnd(20)+0.9),0,0    ;移動量設定
                                                                        setang objiddt(cnt),0,0,deg2rad(90)    ;画像回転
                                                                    }else:if x>=128&y<=-128{
                                                                        setpos objiddt(cnt),128,-128
                                                                        setdir objiddt(cnt),0,(0.01*rnd(20)+0.9),0
                                                                        setang objiddt(cnt),0,0,deg2rad(180)
                                                                    }else:if x>=128&y>=128{
                                                                        setpos objiddt(cnt),128,128
                                                                        setdir objiddt(cnt),-(0.01*rnd(20)+0.9),0,0
                                                                        setang objiddt(cnt),0,0,deg2rad(270)
                                                                    }else:if x<=-128&y>=128{
                                                                        setpos objiddt(cnt),-128,128
                                                                        setdir objiddt(cnt),0,-(0.01*rnd(20)+0.9),0
                                                                        setang objiddt(cnt),0,0,deg2rad(0)
                                                                    }
                                                                loop
                                                                goto *main
                                                            *wm_lbuttondown    ;マウスを左クリックでオブジェクト生成
                                                                if objfcsid<length(objiddt){
                                                                    regobj objiddt(objfcsid),sp0    ;オブジェクトの登録
                                                                    setevent objiddt(objfcsid),evid ;イベントセット
                                                                    setpos objiddt(objfcsid),-csz*4,csz*4
                                                                    setdir objiddt(objfcsid),0,-(0.01*rnd(20)+0.9),0
                                                                    objfcsid++
                                                                }
                                                                return

                                                            0
                                                              posted by higashijugem 23:18comments(0)|-|