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

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





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

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

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

 

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)|-|





                                                        文字列の計算式

                                                        テキストボックスに数式を入力し、その数式を計算して解答を求めるプログラムです

                                                        実数の計算も行えます

                                                        2019/3/2 バグを見つけたので修正しました

                                                         


                                                        calctext="(2+3*4+(10-5))"
                                                        pos 20,20:input calctext,240,24
                                                        pos 300,20:button goto "=",*calc
                                                        pos 370,20:input answertext,70,24:objid=stat
                                                        pos 20,50
                                                        mes"※使用可能な文字は「.0123456789+-*/()」です"
                                                        mes"※半角文字で入力してください"
                                                        mes"※「=」を押すと結果が表示されます"
                                                        stop
                                                        *calc
                                                            sdim fmldt,,100
                                                            dim symdt,100
                                                            id=0:dtid=0
                                                            errflg=0
                                                            blocknum=0
                                                            repeat
                                                                val=peek(calctext,id)
                                                                numstr=strmid(calctext,id,1)
                                                                if val=46|(48<=val&val<=57){    ;.0〜9
                                                                    repeat
                                                                        tval=peek(calctext,id)
                                                                        tnumstr=strmid(calctext,id,1)
                                                                        if tval=46|(48<=tval&tval<=57){
                                                                            fmldt(dtid)+=tnumstr
                                                                            id++
                                                                        }else{
                                                                            id--
                                                                            break
                                                                        }
                                                                        await
                                                                    loop
                                                                    if dtid>=2{
                                                                        repeat
                                                                            if dtid-1<0:break
                                                                            if symdt(dtid-1)=1{
                                                                                gosub *calcprogram
                                                                                if errflg:break
                                                                            }else{
                                                                                break
                                                                            }
                                                                        loop
                                                                    }
                                                                }else:if val=41{    ;)
                                                                    if blocknum>=1{
                                                                        dtid--
                                                                        if symdt(dtid-1)=2{
                                                                            fmldt(dtid-1)=fmldt(dtid)
                                                                            fmldt(dtid)=""
                                                                            symdt(dtid-1)=0
                                                                            dtid--
                                                                        }else{
                                                                            repeat
                                                                                gosub *calcprogram
                                                                                if errflg:break
                                                                                if symdt(dtid-1)=2{
                                                                                    fmldt(dtid-1)=fmldt(dtid)
                                                                                    fmldt(dtid)=""
                                                                                    symdt(dtid-1)=0
                                                                                    dtid--
                                                                                    break
                                                                                }
                                                                                await
                                                                            loop
                                                                        }
                                                                        if dtid>=2{
                                                                            repeat
                                                                                if dtid-1<0:break
                                                                                if symdt(dtid-1)=1{
                                                                                    gosub *calcprogram
                                                                                    if errflg:break
                                                                                }else{
                                                                                    break
                                                                                }
                                                                            loop
                                                                        }
                                                                    }else{
                                                                        errflg=1
                                                                    }
                                                                    blocknum--
                                                                }else:if val=40{    ;(
                                                                    fmldt(dtid)=numstr
                                                                    symdt(dtid)=2
                                                                    blocknum++
                                                                }else:if val=42|val=47{    ;*/^
                                                                    fmldt(dtid)=numstr
                                                                    symdt(dtid)=1
                                                                }else:if val=43|val=45{    ;-+
                                                                    fmldt(dtid)=numstr
                                                                }else{    ;式の終わり
                                                                    dtid--
                                                                    repeat
                                                                        gosub *calcprogram
                                                                        if errflg:break
                                                                        if dtid<=0:break
                                                                        await
                                                                    loop
                                                                    break
                                                                }
                                                                id++:dtid++
                                                                if errflg:break
                                                                await
                                                            loop
                                                            answertext=double(fmldt(0))    ;答え
                                                            objprm objid,answertext
                                                            if errflg{
                                                                dialog"式が正しくありません"
                                                            }
                                                            stop
                                                        *calcprogram    ;計算処理
                                                            if dtid=0{
                                                                return
                                                            }else:if dtid=1{
                                                                errflg=1
                                                                return
                                                            }
                                                            num1=double(fmldt(dtid))
                                                            ope=fmldt(dtid-1)
                                                            num2=double(fmldt(dtid-2))
                                                            if ope="+"{
                                                                set=num2+num1
                                                            }else:if ope="-"{
                                                                set=num2-num1
                                                            }else:if ope="*"{
                                                                set=num2*num1
                                                            }else:if ope="/"{
                                                                set=num2/num1
                                                            }else{
                                                                errflg=1
                                                            }
                                                            fmldt(dtid)=""
                                                            fmldt(dtid-1)=""
                                                            fmldt(dtid-2)=str(set)
                                                            symdt(dtid)=0
                                                            symdt(dtid-1)=0
                                                            symdt(dtid-2)=0
                                                            dtid-2
                                                            return

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





                                                          ダイクストラ法

                                                          ダイクストラアルゴリズムのソースコードです

                                                          任意の地点と始点の最短経路を求めます

                                                           


                                                          #module
                                                          #deffunc dijkstra array rootflg,array invcost,int sourid
                                                              sum=length(invcost)
                                                              ddim rootcost,sum
                                                              sid=0:eid=0
                                                              dim confflg,sum
                                                              dim stack,sum*sum
                                                              repeat sum*sum
                                                                  stack(cnt)=-1
                                                              loop
                                                              stack(sid)=sourid
                                                              repeat
                                                                  num=sid
                                                                  cost=990999.0
                                                                  repeat eid-sid,sid
                                                                      if cost>rootcost(stack(cnt)){
                                                                          cost=rootcost(stack(cnt))
                                                                          num=cnt
                                                                      }
                                                                  loop
                                                                  if num!=sid{
                                                                      tmp=stack(num)
                                                                      stack(num)=stack(sid)
                                                                      stack(sid)=tmp
                                                                  }
                                                                  chkid=stack(sid)
                                                                  confflg(chkid)=1
                                                                  dis=rootcost(chkid)
                                                                  repeat sum
                                                                      icost=invcost(cnt,chkid)
                                                                      if confflg(cnt)=0&icost>0{
                                                                          if (rootcost(cnt)<=0|rootcost(cnt)>dis+icost){
                                                                              rootcost(cnt)=dis+icost
                                                                              rootflg(cnt)=chkid
                                                                              eid++
                                                                              stack(eid)=cnt
                                                                          }
                                                                      }
                                                                  loop
                                                                  sid++
                                                                  if sid>eid{break}
                                                              loop
                                                              return
                                                          #global
                                                          ;画像作成
                                                          csz=32
                                                          buffer 2,csz*2,csz:celdiv 2,csz,csz,csz/2,csz/2:x=0
                                                          color:boxf
                                                          color 255:circle x,0,x+csz-1,csz-1:x+csz
                                                          color 255,255:circle x,0,x+csz-1,csz-1:x+csz
                                                          ;処理開始
                                                          randomize
                                                          gsel 0:gmode 2
                                                          sum=10
                                                          ddim unitinvcost,sum,sum    ;オブジェクト間の距離(最大:200)
                                                          dim unitrootflg,sum            ;接続情報
                                                          ;オブジェクト配置
                                                          repeat sum:i=cnt
                                                              unitrootflg(i)=-1
                                                          loop
                                                          dim unitdt,4,sum
                                                          repeat sum
                                                              if cnt=0{
                                                                  unitdt(0,cnt)=1,ginfo_winx/2,ginfo_winy/2,0
                                                              }else{
                                                                  unitdt(0,cnt)=1,rnd(ginfo_winx),rnd(ginfo_winy),1
                                                              }
                                                          loop
                                                          ;経路情報
                                                          repeat sum:ct0=cnt
                                                              repeat sum:ct1=cnt
                                                                  if unitdt(0,ct1)&ct0!=ct1{
                                                                      cost=sqrt(powf(unitdt(1,ct0)-unitdt(1,ct1),2)+powf(unitdt(2,ct0)-unitdt(2,ct1),2))
                                                                      if cost<200{
                                                                          unitinvcost(ct0,ct1)=cost
                                                                          unitinvcost(ct1,ct0)=cost
                                                                      }
                                                                  }
                                                              loop
                                                          loop
                                                          ;ダイクストラ経路探索
                                                          dijkstra unitrootflg,unitinvcost,0
                                                          ;表示
                                                          buf=""
                                                          repeat sum:i=cnt
                                                              buf+", ["+cnt+"]="+unitrootflg(i)
                                                          loop
                                                          title""+buf
                                                          color:boxf
                                                          gosub *drawunitline
                                                          gosub *drawunitobj
                                                          redraw
                                                          stop
                                                          *drawunitobj
                                                              color
                                                              repeat sum
                                                                  if unitdt(0,cnt){
                                                                      pos unitdt(1,cnt),unitdt(2,cnt):celput 2,unitdt(3,cnt)
                                                                      pos unitdt(1,cnt)-5,unitdt(2,cnt)-10:mes""+cnt
                                                                  }
                                                              loop
                                                              return
                                                          *drawunitline
                                                              color 255,255,255
                                                              repeat sum:ct0=cnt
                                                                  repeat sum:ct1=cnt
                                                                      if unitinvcost(ct0,ct1)>0{
                                                                          line unitdt(1,ct0),unitdt(2,ct0),unitdt(1,ct1),unitdt(2,ct1)
                                                                      }
                                                                  loop
                                                              loop
                                                              return

                                                           

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





                                                            HEXマップ

                                                            ヘクス(ヘックス)マップという六角形のマスで埋め尽くしたボードを表示するプログラムです

                                                             

                                                             

                                                            ;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

                                                            ;マス作成
                                                            csz=32
                                                            cszh=csz/2
                                                            buffer 2,csz*2,csz:celdiv 2,csz,csz
                                                            boxf
                                                            dim a,12
                                                            x=cszh
                                                            deg=0
                                                            repeat 6:i=cnt
                                                                rad=deg2rad(deg)
                                                                a(i*2)=0+cos(rad)*cszh+x,0+sin(rad)*cszh+cszh
                                                                deg+60
                                                            loop
                                                            Polygon a,6,$000001,$00ff00,1
                                                            x+csz
                                                            deg=0
                                                            repeat 6:i=cnt
                                                                rad=deg2rad(deg)
                                                                a(i*2)=0+cos(rad)*cszh+x,0+sin(rad)*cszh+cszh
                                                                deg+60
                                                            loop
                                                            Polygon a,6,$000001,$0000ff,1
                                                            ;描写
                                                            screen:gmode 2
                                                            mcsz=24
                                                            mc=10:mr=10
                                                            dim map,mc,mr
                                                            map(4,4)=1
                                                            repeat mr:j=cnt
                                                                repeat mc:i=cnt
                                                                    x=i*mcsz:y=j*mcsz
                                                                    if i¥2=1{
                                                                        y+=mcsz/2
                                                                    }
                                                                    pos x,y
                                                                    if map(i,j)=0{
                                                                        celput 2,0
                                                                    }else{
                                                                        celput 2,1
                                                                    }
                                                                loop
                                                            loop

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