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

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





ダイクストラ法

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

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

 


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





      視界範囲

      ブレゼンハムアルゴリズムを用いて視界(あるいは光)の範囲を描写するアルゴリズムです

      壁があると向こう側は見えなくなります

      画面内でマウスの左クリックをすることでオブジェクトが置かれ、見える範囲を計算します

      右クリックをするとオブジェクトが消去されます

       


      #module
      #defcfunc bresenham array map,int ex,int ey,int sx,int sy
          x=sx:y=sy
          if ex-sx>0{vx=1}else:if ex-sx<0{vx=-1}else{vx=0}
          if ey-sy>0{vy=1}else:if ey-sy<0{vy=-1}else{vy=0}
          ww=abs(ex-sx):hh=abs(ey-sy)
          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}
          flg=1
          repeat
              lh+lv
              e+slen
              if (e>=llen){
                  e-llen
                  sh+sv
              }
              if map(x,y){
                  flg=0
                  break
              }
              if x=ex&y=ey:break
              await
          loop
          return flg
      #global

      csz=16
      mc=640/csz:mr=480/csz
      dim wmap,mc,mr
      repeat 50
          wmap(rnd(mc),rnd(mr))=1
      loop
      dim pmap,mc,mr
      dim bmap,mc,mr
      arealen=9
      buffer 2,csz*3,csz:x=0:celdiv 2,csz,csz
      color 255:boxf x,0,x+csz,y+csz:x+csz    ;ユニット
      color 1:boxf x,0,x+csz,y+csz:x+csz    ;壁
      color ,255:boxf x,0,x+csz,y+csz:x+csz    ;範囲エフェクト
      screen ,mc*csz,mr*csz
      ;ブレゼンハムアルゴリズムを用いて視界の範囲を求める
      repeat
          getkey k1,1
          getkey k2,2
          mux=mousex/csz:muy=mousey/csz
          if k1{
              if pmap(mux,muy)=0&wmap(mux,muy)=0{
                  pmap(mux,muy)=1
                  repeat arealen*2+1,muy-arealen:j=cnt
                      repeat arealen*2+1,mux-arealen:i=cnt
                          if 0<=i&i<mc&0<=j&j<mr{
                              if wmap(i,j)=0&bresenham(wmap,mux,muy,i,j){
                                  bmap(i,j)++
                              }
                          }
                      loop
                  loop
              }
          }
          if k2{
              if pmap(mux,muy)=1{
                  pmap(mux,muy)=0
                  repeat arealen*2+1,muy-arealen:j=cnt
                      repeat arealen*2+1,mux-arealen:i=cnt
                          if 0<=i&i<mc&0<=j&j<mr{
                              if wmap(i,j)=0&bresenham(wmap,mux,muy,i,j){
                                  if bmap(i,j)>0{bmap(i,j)--}
                              }
                          }
                      loop
                  loop
              }
          }
          gosub *draw
          redraw:await 17:redraw 0
      loop
      stop
      ;描写
      *draw
          color 255,255,255:boxf
          
          repeat mr:j=cnt
              repeat mc:i=cnt
                  gmode 3,,,32
                  repeat bmap(i,j)
                      pos i*csz,j*csz
                      celput 2,2
                  loop
                  gmode 2
                  if wmap(i,j){
                      pos i*csz,j*csz
                      celput 2,1
                  }
                  if pmap(i,j){
                      pos i*csz,j*csz
                      celput 2,0
                  }
              loop
          loop
          return

      0
        posted by higashijugem 12:29comments(0)|-|





        アンチエイリアス付きの直線

        Xiaolin Wuの直線アルゴリズムです

        ピクセルのギザギザを目立たなくした線を描写します

         

         

        #module
        #deffunc plot int tx,int ty,double tc
            hsvcolor 0,0,255-tc*255
            pset tx,ty
            return
        #defcfunc floor double x
            if x<0{return double(0+(x-0.999))}
            else{return double(0+x)}
        #defcfunc ipart double x
            return floor(x)
        #defcfunc fpart double x
            return x-floor(x)
        #defcfunc rfpart double x
            return 1.0-fpart(x)
        #defcfunc round double x
            return ipart(x + 0.5)
        #deffunc swap var x,var y
            tmp=x
            x=y
            y=tmp
            return
        #deffunc drawLine double m_x0,double m_y0,double m_x1,double m_y1
            x0=m_x0
            y0=m_y0
            x1=m_x1
            y1=m_y1
            if absf(y1-y0)>absf(x1-x0){
                steep=1
            }else{
                steep=0
            }
            
            if steep{
                swap x0, y0
                swap x1, y1
            }
            if x0>x1{
                swap x0, x1
                swap y0, y1
            }
            
            dx=x1-x0
            dy=y1-y0
            gradient=dy / dx
            if dx=0.0{
                gradient=1.0
            }

            xend=round(x0)
            yend=y0+gradient * (xend-x0)
            xgap=rfpart(x0+0.5)
            xpxl1=xend
            ypxl1=ipart(yend)
            if steep{
                plot ypxl1,   xpxl1, rfpart(yend) * xgap
                plot ypxl1+1, xpxl1,  fpart(yend) * xgap
            }else{
                plot xpxl1, ypxl1  , rfpart(yend) * xgap
                plot xpxl1, ypxl1+1,  fpart(yend) * xgap
            }
            intery=yend+gradient
            
            xend=round(x1)
            yend=y1+gradient * (xend-x1)
            xgap=fpart(x1+0.5)
            xpxl2=xend
            ypxl2=ipart(yend)
            if steep{
                plot ypxl2  , xpxl2, rfpart(yend) * xgap
                plot ypxl2+1, xpxl2,  fpart(yend) * xgap
            }else{
                plot xpxl2, ypxl2,  rfpart(yend) * xgap
                plot xpxl2, ypxl2+1, fpart(yend) * xgap
            }
            
            if steep{
                repeat (xpxl2-1)-(xpxl1+1)+1,xpxl1+1:x=cnt
                    plot ipart(intery)  , x, rfpart(intery)
                    plot ipart(intery)+1, x,  fpart(intery)
                    intery=intery+gradient
                loop
            }else{
                repeat (xpxl2-1)-(xpxl1+1)+1,xpxl1+1:x=cnt
                    plot x, ipart(intery),  rfpart(intery)
                    plot x, ipart(intery)+1, fpart(intery)
                    intery=intery+gradient
                loop
            }
            return
        #global

        buffer 2
        drawLine 0,0,200,440
        color
        line 50,0,250,440

        gsel 0
        gzoom 640,480,2,0,0,160,120

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





          多次元配列の拡張

          整数型、実数型、文字列型の多次元配列を拡張するプログラムです

          要素数を増やしたり次元数を増やすことができます

           


          #module
          #deffunc arrayset array setarr,array getarr,array len
              repeat len(0):cnt0=cnt
                  if len(1)<1:setarr(cnt0)=getarr(cnt0)
                  repeat len(1):cnt1=cnt
                      if len(2)<1:setarr(cnt0,cnt1)=getarr(cnt0,cnt1)
                      repeat len(2):cnt2=cnt
                          if len(3)<1:setarr(cnt0,cnt1,cnt2)=getarr(cnt0,cnt1,cnt2)
                          repeat len(3):cnt3=cnt
                              setarr(cnt0,cnt1,cnt2,cnt3)=getarr(cnt0,cnt1,cnt2,cnt3)
                          loop
                      loop
                  loop
              loop
              return
          ;int,double,strの配列を拡張する、引数は1次元〜4次元の要素数
          #deffunc arr2extension array resarr,int len0,int len1,int len2,int len3
              reslen=length(resarr),length2(resarr),length3(resarr),length4(resarr)
              tmplen=len0,len1,len2,len3
              arraytype=vartype(resarr)
              if arraytype=vartype("int"){
                  dtlen=4
                  dim tmparr,len0,len1,len2,len3
              }else:if arraytype=vartype("double"){
                  dtlen=8
                  ddim tmparr,len0,len1,len2,len3
              }else:if arraytype=vartype("str"){
                  sdim tmparr,varsize(resarr),len0,len1,len2,len3
              }
              if arraytype=vartype("int")|arraytype=vartype("double"){
                  cplen=dtlen:ptlen=dtlen
                  repeat 4
                      if reslen(cnt)>0:cplen*reslen(cnt)
                      if tmplen(cnt)>0:ptlen*tmplen(cnt)
                  loop
                  maxdtlen=ptlen:flg=0
                  repeat 3
                      i=3-cnt
                      if tmplen(i)>0{
                          ptlen/tmplen(i)
                      }
                      if reslen(i)>0{
                          cplen/reslen(i)
                          repeat reslen(i)
                              memcpy tmparr,resarr,cplen,ptlen*cnt,cplen*cnt
                          loop
                      }
                  loop
              }else:if arraytype=vartype("str"){    ;文字列型はmemcpyを使えないので別途処理
                  arrayset tmparr,resarr,reslen
              }
              if arraytype=vartype("int"){
                  dim resarr,len0,len1,len2,len3
                  memcpy resarr,tmparr,maxdtlen
              }else:if arraytype=vartype("double"){
                  ddim resarr,len0,len1,len2,len3
                  memcpy resarr,tmparr,maxdtlen
              }else:if arraytype=vartype("str"){
                  sdim resarr,varsize(tmparr),len0,len1,len2,len3
                  arrayset resarr,tmparr,tmplen
              }
              return
          #global
          dim a,2,2    ;整数型配列
          a(1,1)=1
          arr2extension a,3,3,3
          a(2,2,2)=2
          ddim b,2,2    ;実数型配列
          b(1,1)=1.0
          arr2extension b,3,3,3
          b(2,2,2)=2.0
          sdim c,2,2    ;文字列型配列
          c(1,1)="a"
          arr2extension c,3,3,3
          c(2,2,2)="b"
          ;表示
          repeat 3:k=cnt
              repeat 3:j=cnt
                  repeat 3:i=cnt
                      pos i*20,j*20+k*100
                      mes""+a(i,j,k)
                      pos i*80+100,j*20+k*100
                      mes""+b(i,j,k)
                      pos i*20+400,j*20+k*100
                      if c(i,j,k)=""{mes"_"}else{mes""+c(i,j,k)}
                  loop
              loop
          loop

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





            ゲーム木探索

            オセロを使ったゲーム木探索アルゴリズムです

            相手が三手先まで見て、最もひっくり返せる石の数が多い手を選びます

            黒が自分、白が対戦相手です

             

             

            #const global csz 64
            #const global mc 8
            #const global mr 8
            #module
                ;石が置ける場所をチェック
                #defcfunc putcheck int x,int y,array bdmap,array dlst,int p
                    ref=0
                    d8x=-1,-1,0,1,1,1,0,-1
                    d8y=0,-1,-1,-1,0,1,1,1
                    if p=0{tp=1}else{tp=0}
                    if bdmap(x,y)=-1{
                        repeat length(d8x):d=cnt
                            dlst(d)=0
                            i=x+d8x(d)
                            j=y+d8y(d)
                            if 0<=i&i<mc&0<=j&j<mr{
                                if bdmap(i,j)=tp{
                                    repeat
                                        i+d8x(d)
                                        j+d8y(d)
                                        if 0<=i&i<mc&0<=j&j<mr{
                                            if bdmap(i,j)=p{
                                                dlst(d)=1
                                                ref=1
                                                break
                                            }else:if bdmap(i,j)=-1{
                                                break
                                            }
                                        }else{
                                            break
                                        }
                                        await
                                    loop
                                }
                            }
                        loop
                    }
                    return ref
                ;相手の石を裏返す
                #defcfunc stonechange int x,int y,array bdmap,array dlst,int p
                    d8x=-1,-1,0,1,1,1,0,-1
                    d8y=0,-1,-1,-1,0,1,1,1
                    bdmap(x,y)=p
                    ref=0
                    repeat length(d8x):d=cnt
                        if dlst(d)=0:continue
                        i=x:j=y
                        repeat
                            i+d8x(d)
                            j+d8y(d)
                            if bdmap(i,j)=p{
                                break
                            }else:if bdmap(i,j)=-1{
                                break
                            }
                            bdmap(i,j)=p
                            ref++
                        loop
                    loop
                    return ref
            #global
            dim bdmap,mc,mr
            repeat mr:j=cnt
                repeat mc:i=cnt
                    bdmap(i,j)=-1
                loop
            loop
            bdmap(3,3)=0
            bdmap(4,4)=0
            bdmap(4,3)=1
            bdmap(3,4)=1
            d8x=-1,-1,0,1,1,1,0,-1
            d8y=0,-1,-1,-1,0,1,1,1
            dim dlst,8

            turnflg=0
            buffer 2,mc*csz,mr*csz:color 1:boxf:color ,125
            repeat mr:j=cnt
                y=j*csz+1
                repeat mc:i=cnt
                    x=i*csz+1
                    boxf x,y,x+csz-2,y+csz-2
                loop
            loop

            buffer 3,2*csz,csz:celdiv 3,csz,csz:boxf:x=0:y=0
            color 1:circle x+4,y+4,x+csz-4,y+csz-4:x+csz
            color 255,255,255:circle x+4,y+4,x+csz-4,y+csz-4:x+csz

            screen 0,mc*csz,mr*csz:gmode 2
            repeat
                if turnflg=0{
                    gosub *playerturn
                }else{
                    gosub *opponentturn
                }
                redraw:await 17:redraw 0
            loop

            *playerturn        ;自分ターン
                repeat
                    ok1=k1:getkey k1,1:tk1=k1^ok1&k1:rk1=k1^ok1&ok1
                    if tk1{
                        putx=mousex/csz
                        puty=mousey/csz
                        putflg=putcheck(putx,puty,bdmap,dlst,0)
                        if putflg=1{
                            chgnum=stonechange(putx,puty,bdmap,dlst,0)
                        }
                        if putflg=1{
                            turnflg=1
                        }
                    }
                    gosub *boarddraw
                    redraw:await 17:redraw 0
                    if turnflg=1{
                        break
                    }
                loop
                return
            *opponentturn    ;相手ターン
                bddtlen=mc*mr*4
                dim stbdmap,mc,mr
                dim edbdmap,mc,mr
                dim queue,8,100000
                dim q_bdmap,mc*mr,100000
                dim queuepart,2,3+1:queuepart(0,0)=0,1
                st=0:ed=1:turnflg=0:chkturn=0:turnnum=0
                queue(0,ed)=chgnum,i,j,st,d,turnflg,turnnum
                memcpy q_bdmap,bdmap,bddtlen
                repeat:turnnum=queue(6,st)+1    ;ゲーム木探索
                    if turnnum<=3{
                        if chkturn<turnnum{
                            chkturn=turnnum
                            queuepart(0,chkturn)=ed
                        }
                        memcpy stbdmap,q_bdmap,bddtlen,0,st*bddtlen
                        turnflg=queue(5,st)^1
                        repeat mr:j=cnt
                            repeat mc:i=cnt
                                putflg=putcheck(i,j,stbdmap,dlst,turnflg)
                                if putflg=1{
                                    memcpy edbdmap,stbdmap,bddtlen,0,0
                                    chgnum=stonechange(i,j,edbdmap,dlst,turnflg)
                                    queue(0,ed)=chgnum,i,j,st,d,turnflg,turnnum
                                    
                                    memcpy q_bdmap,edbdmap,bddtlen,ed*bddtlen,0
                                    queuepart(1,chkturn)++
                                    ed++
                                }
                            loop
                        loop
                    }
                    st++
                    if st>=ed:break
                    await
                loop
                if chkturn¥2=1{
                }else:if chkturn>1{
                    chkturn-1
                }
                evalnum=-1:evalid=0

                ;3手先でひっくり返せる数が最も多い手を選ぶ
                repeat queuepart(1,chkturn),queuepart(0,chkturn)
                    if evalnum<queue(0,cnt){
                        evalid=cnt
                        evalnum=queue(0,cnt)
                    }
                loop
                if evalid>0{
                    repeat
                        if queue(3,evalid)=0{
                            break
                        }else{
                            evalid=queue(3,evalid)
                        }
                    loop
                    memcpy bdmap,q_bdmap,bddtlen,0,evalid*bddtlen
                }
                turnflg=0
                return
            *boarddraw    ;盤面表示
                pos 0,0:gcopy 2,,,mc*csz,mr*csz
                repeat mr:j=cnt
                    repeat mc:i=cnt
                        if bdmap(i,j)>=0{
                            pos i*csz,j*csz:celput 3,bdmap(i,j)
                        }
                    loop
                loop
                return

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





              角が丸い四角(線)

              線をひいて、角を丸めた四角形を描写するプログラムです

               


              mcenx=210.0        ;中心X
              mceny=150.0        ;中心Y
              mxlen=94.0        ;縦幅/2
              mylen=124.0        ;横幅/2
              magari=32.0        ;カーブの丸み具合
              fix=0.00001
              dx=-1,-1,1,1
              dy=1,-1,-1,1

              ldir=90:l2dir=ldir+90
              repeat 4
                  sxlen=mxlen-magari
                  sylen=mylen-magari
                  clen=sqrt(powf(sxlen,2)+powf(sylen,2))
                  cdir=atan(sylen*dy(cnt),sxlen*dx(cnt))
                  ccrad=cos(cdir)
                  csrad=sin(cdir)
                  ccenx=ccrad*clen+mcenx
                  cceny=csrad*clen+mceny
                  lx=cos(deg2rad(ldir))*mxlen+mcenx
                  ly=sin(deg2rad(ldir))*mylen+mceny
                  
                  l2crad=cos(deg2rad(l2dir))
                  l2srad=sin(deg2rad(l2dir))
                  line l2crad*sxlen-l2crad*magari+lx+fix,l2srad*sylen-l2srad*magari+ly+fix,lx+fix,ly+fix
                  ddir=ldir+90
                  repeat
                      ldir+5
                      rad=deg2rad(ldir)
                      line cos(rad)*magari+ccenx,sin(rad)*magari+cceny
                      if ldir>=ddir{
                          ldir=ddir
                          break
                      }
                  loop
                  line cos(deg2rad(ldir))*mxlen+mcenx+fix,sin(deg2rad(ldir))*mylen+mceny+fix
                  l2dir+90
              loop

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





                通路生成(一本道)

                穴掘り法で一本道の通路を作成するプログラムです

                 


                randomize
                mc=11:mr=11
                csz=24
                gsel 0
                dim mapdt,mc,mr
                dim dx,4:dx=-1,0,1,0
                dim dy,4:dy=0,-1,0,1
                repeat 4
                    r0=rnd(4):r1=rnd(4)
                    if r0!=r1{
                        tmp=dx(r0):dx(r0)=dx(r1):dx(r1)=tmp
                        tmp=dy(r0):dy(r0)=dy(r1):dy(r1)=tmp
                    }
                loop
                stx=1:sty=1:max=(mc/2)*(mr/2)
                edx=mc-2:edy=mr-2
                mapdt(stx,sty-1)=1
                mapdt(edx,edy+1)=1
                dim stack,4,max
                id=0
                i=stx:j=sty
                ;穴掘り法
                mapdt(i,j)=1
                repeat
                    if stack(3,id)=0{
                        r=rnd(4)
                        stack(2,id)=r
                    }else{
                        if stack(3,id)>=4{
                            stack(3,id)=0
                            id--
                            if id<=0:break
                            ttdir=stack(2,id)
                            mapdt(stack(0,id)+dx(ttdir),stack(1,id)+dy(ttdir))=0
                            mapdt(stack(0,id)+dx(ttdir)*2,stack(1,id)+dy(ttdir)*2)=0
                            i=stack(0,id):j=stack(1,id)
                        }
                        stack(2,id)++:if stack(2,id)>=4{stack(2,id)=0}
                        r=stack(2,id)
                    }
                    ti=i+dx(r)*2
                    tj=j+dy(r)*2
                    stack(3,id)++
                    if 0<=ti&ti<mc&0<=tj&tj<mr{
                        if mapdt(ti,tj)=0{
                            stack(0,id)=i,j,r
                            mapdt(i+dx(r),j+dy(r))=1
                            mapdt(ti,tj)=1
                            i=ti:j=tj:id++
                            if i=edx&j=edy{
                                break
                            }
                        }
                    }
                    await
                loop
                ;描写
                pget 3200:boxf:color
                repeat mr:cj=cnt
                    repeat mc:ci=cnt
                        pos ci*csz,cj*csz
                        if mapdt(ci,cj)=0{
                            mes"■"
                        }
                    loop
                loop

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





                  穴掘り法

                  「穴掘り法」というアルゴリズムを用いて迷路を作成するプログラムです

                   


                  randomize
                  mc=17:mr=17
                  csz=24
                  dim mapdt,mc,mr
                  dim dx,4:dx=-1,0,1,0
                  dim dy,4:dy=0,-1,0,1
                  stx=1:sty=1:max=(mc/2)*(mr/2)
                  dim stack,4,max
                  id=0
                  i=stx:j=sty
                  ;穴掘り法
                  mapdt(i,j)=1
                  repeat
                      if stack(3,id)=0{
                          r=rnd(4)
                      }else{
                          if stack(3,id)>4{
                              stack(3,id)=0
                              id--
                              if id<=0:break
                              i=stack(0,id):j=stack(1,id)
                          }
                          stack(2,id)++:if stack(2,id)>=4{stack(2,id)=0}
                          r=stack(2,id)
                      }
                      ti=i+dx(r)*2
                      tj=j+dy(r)*2
                      flg=0
                      stack(3,id)++
                      if 0<=ti&ti<mc&0<=tj&tj<mr{
                          if mapdt(ti,tj)=0{
                              stack(0,id)=i,j,r
                              mapdt(i+dx(r),j+dy(r))=1
                              mapdt(ti,tj)=1
                              i=ti:j=tj:id++
                          }
                      }
                      await 1
                  loop
                  ;描写
                  pget 3200:boxf:color
                  repeat mr:j=cnt
                      repeat mc:i=cnt
                          pos i*csz,j*csz
                          if mapdt(i,j)=0{
                              mes"■"
                          }
                      loop
                  loop

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





                    波データ

                    研究所の機器とかで見る波形データみたいなものを表示するプログラムです

                    マウスの左右クリックやマウスホイールで、波の形を変えることができます



                    buffer 2
                    gsel 0
                    ceny=240.0
                    rad=deg2rad(0)
                    sp=1
                    hi=100
                    tx=50.0
                    ty=sin(rad)*100+ceny
                    repeat
                    title""+hi+", "+sp
                        muw=mousew
                        getkey k1,1
                        getkey k2,2
                        if muw<0{sp--}
                        else:if muw>0{sp++}
                        if k1{
                            hi+=1
                        }
                        if k2{
                            hi-=1
                        }
                        gsel 2
                        pos 0,0:gcopy 0,,,640,480
                        rad=deg2rad(cnt*sp)
                        x=50.0
                        y=sin(rad)*hi+ceny
                        line x,y,tx+1,ty
                        tx=x:ty=y
                        gsel 0
                        pos 1,0:gcopy 2,0,,640,480
                        redraw:await 17:redraw 0
                    loop

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