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

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





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

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

 


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





                視界範囲

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

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

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

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

                 


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





                                一日ゲームNo.19「迷路RPG」

                                一日ゲーム第十九弾

                                 

                                アクションRPGです

                                マウスクリックで自キャラ(赤)を移動させ、敵キャラ(青)と接触することで戦闘を行います

                                敵を倒すとレベルが上がります

                                最終的にボスを倒すとゲームクリアーです

                                草や岩を踏むと時々体力が回復します

                                 

                                ダウンロード

                                 

                                 

                                ソースコード

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





                                  左右対称の線

                                  画面の真ん中を軸に、複数の線を鏡のように左右対称に描写するプログラムです

                                  白い線の角をドラッグすることで線を動かせます

                                   


                                  ;片側の線データ
                                  dim lndt,4,2
                                  cenx=320
                                  lndt(0,0)=200,240,cenx,80
                                  lndt(0,1)=cenx,400,200,240
                                  repeat
                                      color:boxf:color 255,255,255
                                      mux=mousex:muy=mousey
                                      ok1=k1:getkey k1,1:tk1=k1^ok1&k1:rk1=k1^ok1&ok1
                                      if tk1{    ;角をクリックで線を動かせる
                                          pushct=-1
                                          repeat 2
                                              dis=sqrt(powf(lndt(2,cnt)-mux,2)+powf(lndt(3,cnt)-muy,2))
                                              if dis<=10{
                                                  pushct=cnt
                                                  break
                                              }
                                          loop
                                          if pushct<0{
                                              dis=sqrt(powf(lndt(0,length2(lndt)-1)-mux,2)+powf(lndt(1,length2(lndt)-1)-muy,2))
                                              if dis<=10{
                                                  pushct=length2(lndt)
                                              }
                                          }
                                      }
                                      if k1{
                                          if 0=pushct{
                                              lndt(3,pushct)=muy
                                          }else:if pushct=length2(lndt){
                                              lndt(1,pushct-1)=muy
                                          }else:if 0<pushct&pushct<length2(lndt){
                                              lndt(0,pushct-1)=mux:lndt(1,pushct-1)=muy
                                              lndt(2,pushct)=mux:lndt(3,pushct)=muy
                                          }
                                      }
                                      if rk1{
                                          pushct=-1
                                      }
                                      ;左右対称に描写
                                      repeat length2(lndt)
                                          ex=lndt(0,cnt):ey=lndt(1,cnt)
                                          sx=lndt(2,cnt):sy=lndt(3,cnt)
                                          color 255,255,255
                                          line ex,ey,sx,sy
                                          ex=(cenx-lndt(0,cnt))+cenx:ey=lndt(1,cnt)
                                          sx=(cenx-lndt(2,cnt))+cenx:sy=lndt(3,cnt)
                                          color 255
                                          line ex,ey,sx,sy
                                      loop
                                      redraw:await 17:redraw 0
                                  loop

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





                                    徐々に線引き

                                    時間経過とともに線が引かれるようにするプログラムです

                                    vnumの値を変えることで描写速度を変更できます

                                     

                                     

                                    randomize
                                    ddim lndt,4,20
                                    deg=0:sum=0
                                    repeat
                                        x=cos(deg2rad(deg))*(rnd(151)+50)+320
                                        y=sin(deg2rad(deg))*(rnd(151)+50)+240
                                        deg+=rnd(20)+20
                                        sum++
                                        if deg>=360{
                                            lndt(0,cnt)=x,y
                                            lndt(2,0)=x,y
                                            break
                                        }else{
                                            lndt(0,cnt)=x,y
                                            lndt(2,cnt+1)=x,y
                                        }
                                    loop
                                    ;描写
                                    vnum=30
                                    repeat sum
                                        ex=0f+lndt(0,cnt):ey=0f+lndt(1,cnt)
                                        sx=0f+lndt(2,cnt):sy=0f+lndt(3,cnt)
                                        vx=(ex-sx)/vnum
                                        vy=(ey-sy)/vnum
                                        pos sx,sy
                                        repeat vnum,1
                                            line sx+vx*cnt,sy+vy*cnt
                                            redraw:await 17:redraw 0
                                        loop
                                    loop

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





                                      多角形の内部の反射処理

                                      図形の内部にバウンドするボール(オブジェクト)を置き、それらを跳ね回らせるプログラムです

                                      マウスホイールを動かすことでボールが動く速度を変えることができます

                                       

                                      #include"hgimg3.as"
                                      randomize
                                      ddim bldt,4    ;ボールデータ
                                      bldt(0)=320.0,240.0,30.0,deg2rad(rnd(360)
                                      ddim wldt,5,4    ;壁データ
                                      wldt(0,0)=500,100,100,50
                                      wldt(0,1)=600,300,500,100
                                      wldt(0,2)=300,400,600,300
                                      wldt(0,3)=50,250,300,400
                                      wldt(0,4)=100,50,50,250
                                      repeat
                                          color:boxf:color 255,255,255
                                          tmuw=mousew
                                          if tmuw<0{    ;速度変更
                                              bldt(2)=limitf(bldt(2)-5,0,100)
                                          }else:if tmuw>0{
                                              bldt(2)=limitf(bldt(2)+5,0,100)
                                          }
                                          repeat length2(wldt)
                                              line wldt(0,cnt),wldt(1,cnt),wldt(2,cnt),wldt(3,cnt)
                                          loop
                                          tspd=bldt(2)
                                          pos bldt(0),bldt(1)
                                          hh0=bldt(0):hh1=bldt(1):hh2=bldt(2):hh3=bldt(3)
                                          repeat
                                              ;線分交差判定
                                              tblx=bldt(0)+(cos(bldt(3))*tspd)
                                              tbly=bldt(1)+(sin(bldt(3))*tspd)
                                              csflg=0:wlflg=0
                                              repeat length2(wldt)+1:wlct=cnt:if wlct>=length2(wldt){wlct=0}
                                                  wex=0f+wldt(0,wlct):wey=0f+wldt(1,wlct):wsx=0f+wldt(2,wlct):wsy=0f+wldt(3,wlct)
                                                  bsx=bldt(0):bsy=bldt(1):bex=tblx:bey=tbly
                                                  d=(wex-wsx)*(bey-bsy)-(wey-wsy)*(bex-bsx)
                                                  if d<-0.00001|0.00001<d{
                                                      u=((bsx-wsx)*(bey-bsy)-(bsy-wsy)*(bex-bsx))/d
                                                      v=((bsx-wsx)*(wey-wsy)-(bsy-wsy)*(wex-wsx))/d
                                                      if (u>=0.0&u<=1.0)&(v>=0.0&v<=1.0){
                                                          ;壁とボールの軌道の交点
                                                          crsx=0f+wsx+u*(wex-wsx)
                                                          crsy=0f+wsy+u*(wey-wsy)
                                                          ;壁同士の境目に来た場合、位置調整
                                                          wrad=atan(wey-wsy,wex-wsx)
                                                          if sqrt(powf(crsx-wex,2)+powf(crsy-wey,2))<=1{
                                                              crsx-=cos(wrad):crsy-=sin(wrad)
                                                              twlct=wlct+1:if twlct>=length2(wldt){twlct=0}
                                                              wnrad=atan(wldt(3,twlct)-wldt(1,twlct),wldt(2,twlct)-wldt(0,twlct))
                                                              crsx-=cos(wnrad):crsy-=sin(wnrad)
                                                          }else:if sqrt(powf(crsx-wsx,2)+powf(crsy-wsy,2))<=1{
                                                              crsx+=cos(wrad):crsy+=sin(wrad)
                                                              twlct=wlct-1:if twlct<0{twlct=length2(wldt)-1}
                                                              wnrad=atan(wldt(3,twlct)-wldt(1,twlct),wldt(2,twlct)-wldt(0,twlct))
                                                              crsx+=cos(wnrad):crsy+=sin(wnrad)
                                                          }
                                                          ;反射ベクトル計算
                                                          ndir=-atan(wex-wsx,wey-wsy)
                                                          fx=cos(bldt(3)):fy=sin(bldt(3))
                                                          nx=cos(ndir):ny=sin(ndir)
                                                          dot=(-fx)*nx+(-fy)*ny
                                                          rx=fx+2.0*dot*nx
                                                          ry=fy+2.0*dot*ny
                                                          bldt(3)=atan(ry,rx)
                                                          ;反射後のボールの位置
                                                          exspd=sqrt(powf(tblx-crsx,2)+powf(tbly-crsy,2))
                                                          if exspd<1{exspd=1.0}
                                                          tblx=crsx+cos(bldt(3))*exspd
                                                          tbly=crsy+sin(bldt(3))*exspd
                                                          csflg=1
                                                      }
                                                  }
                                              loop
                                              if csflg{
                                                  bldt(0)=crsx+cos(bldt(3))
                                                  bldt(1)=crsy+sin(bldt(3))
                                                  line bldt(0),bldt(1)
                                                  tspd=exspd
                                              }else{
                                                  bldt(0)=tblx
                                                  bldt(1)=tbly
                                                  break
                                              }
                                              await
                                          loop
                                          ;描写
                                          tx=bldt(0):ty=bldt(1)
                                          line bldt(0),bldt(1)
                                          circle tx-10,ty-10,tx+10,ty+10
                                          redraw:await 17:redraw 0
                                      loop

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





                                        2直線と平行のベクトル

                                        二つの線分に対して平行の線を求めるプログラムです

                                        マウスドラッグで線を動かすことで、常に平行線が再描写されてます

                                         


                                        ;線データ
                                        ddim lndt,4,2
                                        lndt(0,0)=100.0,100.0,320.0,240.0
                                        lndt(0,1)=320.0,240.0,320.0,460.0
                                        x1=0:y1=0:x2=0:y2=0
                                        repeat
                                            color:boxf
                                            mux=mousex:muy=mousey
                                            getkey k1,1
                                            getkey k2,2
                                            if k1{    ;左ドラッグで線を動かす
                                                lndt(0,0)=0f+mux:lndt(1,0)=0f+muy
                                            }
                                            if k2{    ;右ドラッグで線を動かす
                                                lndt(2,1)=0f+mux:lndt(3,1)=0f+muy
                                            }
                                            repeat 2
                                                color 255,((cnt+1)/2)*255,((cnt+1)¥2)*255
                                                line lndt(0,cnt),lndt(1,cnt),lndt(2,cnt),lndt(3,cnt)
                                            loop
                                            color 255,255,255
                                            circle lndt(0,0)-20,lndt(1,0)-20,lndt(0,0)+20,lndt(1,0)+20,0
                                            circle lndt(2,1)-20,lndt(3,1)-20,lndt(2,1)+20,lndt(3,1)+20,0
                                            x1=lndt(0,0):y1=lndt(1,0)
                                            x2=lndt(2,0):y2=lndt(3,0)
                                            wldir1=atan(y2-y1,x2-x1)        ;線1のベクトル
                                            x1=lndt(0,1):y1=lndt(1,1)
                                            x2=lndt(2,1):y2=lndt(3,1)
                                            wldir2=atan(y2-y1,x2-x1)        ;線2のベクトル
                                            wldir3=(wldir1+wldir2)/2        ;線1と線2の平行ベクトル
                                            ;平行ベクトルの描写
                                            color ,255
                                            line -cos(wldir3)*100+320,-sin(wldir3)*100+240,cos(wldir3)*100+320,sin(wldir3)*100+240
                                            redraw:await 17:redraw 0
                                        loop

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





                                          折れ線の生成

                                          接続された線分を作成するプログラムです

                                          線分上を左クリックすることで角が生成されていき、右クリックで角が消去されます

                                           

                                           

                                          dim ldt,5,1000
                                          ldt(0,0)=1,100,50
                                          ldt(0,1)=1,500,400
                                          repeat
                                              ok1=k1:getkey k1,1:tk1=k1^ok1&k1:rk1=k1^ok1&ok1
                                              ok2=k2:getkey k2,2:tk2=k2^ok2&k2
                                              mux=mousex:muy=mousey
                                              color 255,255,255:boxf:color
                                              ;線分描写
                                              repeat
                                                  if ldt(0,cnt)=0:break
                                                  sx=ldt(1,cnt)
                                                  sy=ldt(2,cnt)
                                                  dlen=sqrt(powf(sx-mux,2)+powf(sy-muy,2))
                                                  if dlen<10{
                                                      circle sx-10,sy-10,sx+10,sy+10,0
                                                  }
                                                  if cnt=0{
                                                      pos ldt(1,cnt),ldt(2,cnt)
                                                  }else{
                                                      line ldt(1,cnt),ldt(2,cnt)
                                                  }
                                              loop
                                              if tk1{
                                                  phid=-1
                                                  repeat
                                                      ;端の移動
                                                      if ldt(0,cnt)=0:break
                                                      sx=ldt(1,cnt)
                                                      sy=ldt(2,cnt)
                                                      dlen=sqrt(powf(sx-mux,2)+powf(sy-muy,2))
                                                      if dlen<10{
                                                          phid=cnt
                                                          break
                                                      }
                                                      if ldt(0,cnt+1)=0:break
                                                      ex=ldt(1,cnt+1)
                                                      ey=ldt(2,cnt+1)
                                                      dlen=sqrt(powf(ex-mux,2)+powf(ey-muy,2))
                                                      if dlen<10{
                                                          phid=cnt+1
                                                          break
                                                      }
                                                      ;角の生成
                                                      abx=ex-sx:aby=ey-sy            ;(直線の始点→直線の終点)ベクトル
                                                      apx=mux-sx:apy=muy-sy        ;(直線の始点→任意の点)ベクトル
                                                      d=absf(abx*apy-aby*apx)        ;ベクトルの外積
                                                      l=sqrt(powf(ex-sx,2)+powf(ey-sy,2))    ;始点〜終点の距離
                                                      if d!=0{
                                                          if (d/l)<10{
                                                              phid=cnt+1
                                                              memcpy ldt,ldt,5*4*(1000-phid),5*4*phid,5*4*cnt
                                                              break
                                                          }
                                                      }
                                                      await
                                                  loop
                                              }
                                              if k1{
                                                  if phid>=0{
                                                      ldt(1,phid)=mux
                                                      ldt(2,phid)=muy
                                                  }
                                              }
                                              if rk1{
                                                  phid=-1
                                              }
                                              if tk2{    ;角の削除
                                                  repeat
                                                      if ldt(0,cnt)=0:break
                                                      sx=ldt(1,cnt)
                                                      sy=ldt(2,cnt)
                                                      dlen=sqrt(powf(sx-mux,2)+powf(sy-muy,2))
                                                      if dlen<10{
                                                          phid=cnt+1
                                                          memcpy ldt,ldt,5*4*(1000-phid),5*4*cnt,5*4*phid
                                                          break
                                                      }
                                                  loop
                                              }
                                              redraw:await 17:redraw 0
                                          loop

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





                                            太陽

                                            太陽を描写するプログラムです

                                            波は太陽から出る光をそれっぽく描いたものです

                                             


                                            hlen=120
                                            sllen=130
                                            ellen=180
                                            ldiv=15
                                            lnum=360/ldiv
                                            cenx=320:ceny=240
                                            times=7
                                            sec=(0f+ellen-sllen)*times
                                            sdiv=0
                                            repeat
                                                color:boxf
                                                color 255,64
                                                ;太陽描写
                                                circle cenx-hlen,ceny-hlen,cenx+hlen,ceny+hlen
                                                ;波描写
                                                repeat lnum
                                                    tdiv=ldiv*cnt
                                                    sx=cos(deg2rad(tdiv))*sllen+cenx
                                                    sy=sin(deg2rad(tdiv))*sllen+ceny
                                                    ex=cos(deg2rad(tdiv))*ellen+cenx
                                                    ey=sin(deg2rad(tdiv))*ellen+ceny
                                                    ;法線ベクトルは線の傾きの逆数(-X/Y)
                                                    dir=-atan(ex-sx,ey-sy)
                                                    repeat sec
                                                        tx=(sx-ex)/sec*cnt+ex
                                                        ty=(sy-ey)/sec*cnt+ey
                                                        setx=cos(dir)*(cos(deg2rad(sdiv+cnt))*8)+tx
                                                        sety=sin(dir)*(cos(deg2rad(sdiv+cnt))*8)+ty
                                                        if cnt=0{
                                                            pos setx,sety
                                                        }else{
                                                            line setx,sety
                                                        }
                                                    loop
                                                loop
                                                sdiv++
                                                if sdiv>=360{sdiv=0}
                                                redraw:await 17:redraw 0
                                            loop

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





                                              傾いた曲線

                                              斜め方向に凸凹した曲線を描写します

                                              timesの値を変えると曲線のぐにゃぐにゃ具合も変わります

                                               

                                               

                                              ddim lndt,4
                                              lndt(0)=200.0,100.0,400.0,400.0
                                              color 125,125,125
                                              line lndt(2),lndt(3),lndt(0),lndt(1)
                                              ;法線ベクトルは線の傾きの逆数(-X/Y)
                                              dir=-atan(lndt(2)-lndt(0),lndt(3)-lndt(1))
                                              ;描写処理
                                              times=1
                                              sec=360.0*times
                                              color 255
                                              repeat sec
                                                  tx=(lndt(2)-lndt(0))/sec*cnt+lndt(0)
                                                  ty=(lndt(3)-lndt(1))/sec*cnt+lndt(1)
                                                  setx=cos(dir)*(cos(deg2rad(cnt))*50)+tx
                                                  sety=sin(dir)*(cos(deg2rad(cnt))*50)+ty
                                                  if cnt=0{
                                                      pos setx,sety
                                                  }else{
                                                      line setx,sety
                                                  }
                                              loop

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





                                                一日ゲームNo.18「カメとアキレス」

                                                一日ゲーム第十八弾

                                                 

                                                カメをアキレスに追いつかれる前にゴールにたどり着かせるゲームです

                                                計算式の空欄に正しい数字を入れて、カメをゴールまで進ませましょう

                                                レベルが高いほど計算が難しくなります

                                                 

                                                ダウンロード

                                                ソースコード

                                                 

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





                                                  二次元マップのスクロール

                                                  マップチップを並べた画面内を移動するアルゴリズムです

                                                  キャラクターはマスに捉われない動き方をします

                                                   


                                                  csz=32:cszh=csz/2
                                                  gmw=640/csz:gmh=480/csz        ;画面に表示されるマス数
                                                  mpw=gmw*2:mph=gmh*2        ;マップ全体のマス数
                                                  gmwmx=mpw*csz:gmhmx=mph*csz    ;マップ全体の大きさ
                                                  dim mpdt,mpw,mph
                                                  repeat 600
                                                      mpdt(rnd(mpw-2)+1,rnd(mph-2)+1)=1
                                                  loop
                                                  ;マップチップ
                                                  buffer 2,csz*3,csz:celdiv 2,csz,csz,cszh,cszh
                                                  boxf:x=0
                                                  color 1:boxf x,0,x+csz-1,csz:x+csz
                                                  color 255,255,255:boxf x,0,x+csz-1,csz:x+csz
                                                  color 255:circle x,0,x+csz-1,csz
                                                  gsel 0
                                                  gmode 2
                                                  plx=cszh:ply=cszh
                                                  *main
                                                      color:boxf
                                                      getkey k37,37
                                                      getkey k38,38
                                                      getkey k39,39
                                                      getkey k40,40
                                                      if k37{
                                                          plx-4
                                                      }
                                                      if k38{
                                                          ply-4
                                                      }
                                                      if k39{
                                                          plx+4
                                                      }
                                                      if k40{
                                                          ply+4
                                                      }
                                                      plx=limit(plx,cszh,gmwmx-cszh)
                                                      ply=limit(ply,cszh,gmhmx-cszh)
                                                      ;表示
                                                      gstx=limit(plx-csz*gmw/2,0,csz*mpw-csz*gmw)
                                                      gsty=limit(ply-csz*gmh/2,0,csz*mph-csz*gmh)
                                                      sx=gstx/csz-1:sy=gsty/csz-1
                                                      ix=gstx¥csz:iy=gsty¥csz
                                                      repeat gmh+2:j=cnt
                                                          repeat gmw+2:i=cnt
                                                              tx=sx+i:ty=sy+j
                                                              if 0<=tx&tx<mpw&0<=ty&ty<mph{
                                                                  pos (i-1)*csz+cszh-ix,(j-1)*csz+cszh-iy
                                                                  celput 2,mpdt(tx,ty)
                                                              }
                                                          loop
                                                      loop
                                                      pos plx-gstx,ply-gsty:celput 2,2
                                                      redraw:await 17:redraw 0
                                                      goto *main

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





                                                    あみだくじ

                                                    あみだくじ表を自動で作成するプログラムです



                                                    cmx=20    ;横線の数
                                                    rmx=5    ;平行線の数
                                                    randomize
                                                    dim linedt,cmx,rmx
                                                    cnm=0
                                                    repeat
                                                        if cnm>=cmx:break
                                                        x=rnd(cmx):y=rnd(rmx)
                                                        if linedt(x,y)=0{
                                                            setflg=0
                                                            if y=0{
                                                                dir=0
                                                            }else:if y=rmx-1{
                                                                dir=1
                                                            }else{
                                                                dir=rnd(2)
                                                            }
                                                            if dir=0{
                                                                if linedt(x,y+1)=0{
                                                                    linedt(x,y)=1
                                                                    linedt(x,y+1)=-1
                                                                    setflg=1
                                                                }
                                                            }else{
                                                                if linedt(x,y-1)=0{
                                                                    linedt(x,y)=-1
                                                                    linedt(x,y-1)=1
                                                                    setflg=1
                                                                }
                                                            }
                                                            if setflg{
                                                                cnm++
                                                            }
                                                        }
                                                        await
                                                    loop
                                                    sx=120:sy=80
                                                    inlr=100
                                                    inlc=16
                                                    repeat rmx:y=cnt
                                                        line sx,sy-inlc,sx,sy+(cmx+1)*inlc
                                                        repeat cmx:x=cnt
                                                            if linedt(x,y)=1{
                                                                ty=sy+x*inlc
                                                                line sx,ty,sx+inlr,ty
                                                            }
                                                        loop
                                                        sx+inlr
                                                    loop

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





                                                      慣性の法則

                                                      慣性の法則のプログラムです

                                                      十字キーを押すことで物体を移動させます

                                                       

                                                       

                                                      cx=320.0
                                                      cy=240.0
                                                      mv=0.1
                                                      vis=0.02
                                                      cmx=0.0
                                                      cmy=0.0
                                                      angle=0
                                                      cszh=16
                                                      gw=640:gh=480
                                                      *main
                                                          color:boxf:color 255,255,255
                                                          getkey k37,37
                                                          getkey k38,38
                                                          getkey k39,39
                                                          getkey k40,40
                                                          angle=0:kpush=0
                                                          if k37{
                                                              angle+180:kpush++
                                                          }
                                                          if k38{
                                                              angle+90:kpush++
                                                          }
                                                          if k40{
                                                              angle+270:kpush++
                                                          }
                                                          if k39{
                                                              if k40{
                                                                  angle+360
                                                              }else{
                                                                  angle+0
                                                              }
                                                              kpush++
                                                          }
                                                          if kpush>0{
                                                              angle/kpush
                                                              cmx+=cos(deg2rad(angle))*mv
                                                              cmy-=sin(deg2rad(angle))*mv
                                                          }else{
                                                              cmx-=vis*cmx
                                                              cmy-=vis*cmy
                                                          }
                                                          cx+=cmx
                                                          cy+=cmy
                                                          ;バウンド
                                                          if cx<cszh{        ;左壁
                                                              cx=0f+cszh
                                                              cmx=-cmx
                                                          }
                                                          if cx>gw-cszh{    ;右壁
                                                              cx=0f+gw-cszh
                                                              cmx=-cmx
                                                          }
                                                          if cy<cszh{        ;上壁
                                                              cy=0f+cszh
                                                              cmy=-cmy
                                                          }
                                                          if cy>gh-cszh{    ;下壁
                                                              cy=0f+gh-cszh
                                                              cmy=-cmy
                                                          }
                                                          color 255,255,255
                                                          circle cx-cszh,cy-cszh,cx+cszh,cy+cszh
                                                          redraw:await 17:redraw 0
                                                          goto *main

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





                                                        落下と上昇

                                                        落下と上昇を組み合わせたアルゴリズムです

                                                        そのままでは物体が落ちていくだけですが、上キーを押すことで上昇させることができます

                                                         


                                                        vy=0.0        ;速度
                                                        ay=0.0        ;加速度
                                                        vis=0.05    ;粘性抵抗係数
                                                        grav=0.8    ;重力

                                                        chx=320.0
                                                        chy=240.0
                                                        border=480
                                                        chcsz=24:chcszh2=chcsz/2
                                                        fallflg=1
                                                        *main
                                                            color:boxf
                                                            getkey k38,38
                                                            if k38{
                                                                if fallflg=0{
                                                                    ay=0.0
                                                                    vy=0.0
                                                                    chy-=1.0
                                                                }
                                                                fallflg=1
                                                                ay=-grav+(vis*(-vy))
                                                            }else{
                                                                if fallflg=1{
                                                                    ay=grav-(vis*vy)
                                                                }
                                                            }
                                                            vy+ay
                                                            chy+vy
                                                            if chy>=border{
                                                                chy=border
                                                                fallflg=0
                                                            }
                                                            color 255,255,255
                                                            boxf chx-chcszh2,chy-chcsz,chx+chcszh2,chy
                                                            redraw:await 17:redraw 0
                                                            goto *main

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





                                                          縄張りアルゴリズム

                                                          一定の範囲内に進入した場合のみ、キャラクターを追いかけるプログラムです

                                                           

                                                           

                                                          #enum e_i_sflg=0
                                                          #enum e_i_stype
                                                          #enum e_i_rsensx
                                                          #enum e_i_rsensy
                                                          #enum e_i_rsenslen
                                                          #enum e_i_target
                                                          #enum e_d_sx=0
                                                          #enum e_d_sy
                                                          #enum e_d_srad
                                                          #enum e_d_sspd
                                                          pirad2=M_PI*2

                                                          spsum=2
                                                          steer=0.01
                                                          dim i_shipdt,6,spsum
                                                          ddim d_shipdt,4,spsum
                                                          i_shipdt(0,0)=1,0
                                                          d_shipdt(0,0)=600.0, 400.0, deg2rad(220), 0.5
                                                          i_shipdt(0,1)=1,1,300,320,200,-1
                                                          d_shipdt(0,1)=300.0, 320.0, deg2rad(0), 0.0

                                                          *main
                                                              color 255,255,255:boxf:color
                                                              repeat spsum:spid=cnt
                                                                  if i_shipdt(e_i_sflg,spid){
                                                                      rad=d_shipdt(e_d_srad,spid)
                                                                      spd=d_shipdt(e_d_sspd,spid)
                                                                      d_shipdt(e_d_sx,spid)+=cos(rad)*spd
                                                                      d_shipdt(e_d_sy,spid)+=sin(rad)*spd
                                                                      if i_shipdt(e_i_stype,spid)=0{
                                                                          color ,,255
                                                                      }else{    ;相手のなわばりアルゴリズム
                                                                          rsx=0f+i_shipdt(e_i_rsensx,spid)
                                                                          rsy=0f+i_shipdt(e_i_rsensy,spid)
                                                                          len=0f+i_shipdt(e_i_rsenslen,spid)
                                                                          ;なわばり範囲
                                                                          color:circle rsx-len,rsy-len,rsx+len,rsy+len,0
                                                                          espx=d_shipdt(e_d_sx,spid)
                                                                          espy=d_shipdt(e_d_sy,spid)
                                                                          esprad=d_shipdt(e_d_srad,spid)
                                                                          espspd=d_shipdt(e_d_sspd,spid)
                                                                          losid=-1
                                                                          if i_shipdt(e_i_target,spid)>=0{
                                                                              fspx=d_shipdt(e_d_sx,i_shipdt(e_i_target,spid))
                                                                              fspy=d_shipdt(e_d_sy,i_shipdt(e_i_target,spid))
                                                                              tlen=sqrt(powf(rsx-fspx,2)+powf(rsy-fspy,2))
                                                                              if len>tlen{
                                                                                  i_shipdt(e_i_target,spid)=-1
                                                                              }
                                                                          }
                                                                          if i_shipdt(e_i_target,spid)<0{
                                                                              repeat spsum:tspid=cnt
                                                                                  if spid!=tspid&i_shipdt(e_i_stype,tspid)=0{
                                                                                      fspx=d_shipdt(e_d_sx,tspid)
                                                                                      fspy=d_shipdt(e_d_sy,tspid)
                                                                                      tlen=sqrt(powf(rsx-fspx,2)+powf(rsy-fspy,2))
                                                                                      if len>tlen{
                                                                                          len=tlen
                                                                                          losid=tspid
                                                                                          d_shipdt(e_d_sspd,spid)=0.8
                                                                                      }
                                                                                  }
                                                                              loop
                                                                          }
                                                                          if losid>=0{    ;縄張り内に侵入者
                                                                              i_shipdt(e_i_target,spid)=losid
                                                                              rot2=atan(fspy-espy,fspx-espx)
                                                                              rot1=esprad
                                                                              ;下の行をアンコメントするとどこまでも追いかける
                                                                              ;i_shipdt(e_i_rsenslen,spid)=999999
                                                                          }else{    ;侵入者が縄張り外に出た場合
                                                                              tlen=sqrt(powf(rsx-espx,2)+powf(rsy-espy,2))
                                                                              if tlen>10{    ;ほぼ中心地に戻る
                                                                                  rot2=atan(rsy-espy,rsx-espx)
                                                                                  rot1=esprad
                                                                              }else{
                                                                                  d_shipdt(e_d_sspd,spid)=0.0
                                                                              }
                                                                          }
                                                                          ;ターゲットの進行方向と、ターゲットから見た標的の角度差
                                                                          rad=rot2-rot1
                                                                          ;方向の値が0〜円周率に収まるようにする
                                                                          if rad>M_PI:rad-pirad2
                                                                          if rad<-M_PI:rad+pirad2
                                                                          if rad>steer{d_shipdt(e_d_srad,spid)+steer}
                                                                          if rad<-steer{d_shipdt(e_d_srad,spid)-steer}
                                                                          color 255
                                                                      }
                                                                      x=d_shipdt(e_d_sx,spid):y=d_shipdt(e_d_sy,spid)
                                                                      circle x-10,y-10,x+10,y+10
                                                                  }
                                                              loop
                                                              redraw:await 17:redraw 0
                                                              goto *main

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





                                                            迎撃アルゴリズム

                                                            キャラクターの接触ポイントを予測し、それに基づいた行動をさせるアルゴリズムです

                                                             


                                                            #enum e_i_sflg=0
                                                            #enum e_i_stype
                                                            #enum e_d_sx=0
                                                            #enum e_d_sy
                                                            #enum e_d_srad
                                                            #enum e_d_sspd
                                                            pirad2=M_PI*2

                                                            spsum=2
                                                            steer=0.01
                                                            dim i_shipdt,2,spsum
                                                            ddim d_shipdt,4,spsum
                                                            i_shipdt(0,0)=1,0
                                                            d_shipdt(0,0)=600.0, 400.0, deg2rad(220), 0.5
                                                            i_shipdt(0,1)=1,1
                                                            d_shipdt(0,1)=50.0, 420.0, deg2rad(0), 0.8

                                                            *main
                                                                color 255,255,255:boxf:color
                                                                repeat spsum:spid=cnt
                                                                    if i_shipdt(e_i_sflg,spid){
                                                                        rad=d_shipdt(e_d_srad,spid)
                                                                        spd=d_shipdt(e_d_sspd,spid)
                                                                        d_shipdt(e_d_sx,spid)+=cos(rad)*spd
                                                                        d_shipdt(e_d_sy,spid)+=sin(rad)*spd
                                                                        x=d_shipdt(e_d_sx,spid):y=d_shipdt(e_d_sy,spid)
                                                                        if i_shipdt(e_i_stype,spid)=0{
                                                                            color ,,255
                                                                        }else{    ;相手の迎撃アルゴリズム
                                                                            len=999999.0
                                                                            espx=d_shipdt(e_d_sx,spid)
                                                                            espy=d_shipdt(e_d_sy,spid)
                                                                            esprad=d_shipdt(e_d_srad,spid)
                                                                            espspd=d_shipdt(e_d_sspd,spid)
                                                                            losid=-1
                                                                            repeat spsum:tspid=cnt
                                                                                if spid!=tspid&i_shipdt(e_i_stype,tspid)=0{
                                                                                    fspx=d_shipdt(e_d_sx,tspid)
                                                                                    fspy=d_shipdt(e_d_sy,tspid)
                                                                                    tlen=sqrt(powf(espx-fspx,2)+powf(espy-fspy,2))
                                                                                    if len>tlen{
                                                                                        len=tlen
                                                                                        losid=tspid
                                                                                    }
                                                                                }
                                                                            loop
                                                                            if losid>=0{
                                                                                fspx=d_shipdt(e_d_sx,losid)
                                                                                fspy=d_shipdt(e_d_sy,losid)
                                                                                fsprad=d_shipdt(e_d_srad,losid)
                                                                                fspspd=d_shipdt(e_d_sspd,losid)
                                                                                fax=cos(fsprad)*fspspd:fay=sin(fsprad)*fspspd
                                                                                eax=cos(esprad)*espspd:eay=sin(esprad)*espspd
                                                                                vrx=fax-eax:vry=fay-eay
                                                                                srx=fspx-espx:sry=fspy-espy
                                                                                tc=sqrt(srx*srx+sry*sry)/sqrt(vrx*vrx+vry*vry)
                                                                                stx=fspx+fax*tc:sty=fspy+fay*tc
                                                                                ;予測衝突地点
                                                                                color:circle stx-10,sty-10,stx+10,sty+10,0
                                                                                rot2=atan(sty-espy,stx-espx)
                                                                                rot1=esprad
                                                                                ;ターゲットの進行方向と、ターゲットから見た標的の角度差
                                                                                rad=rot2-rot1
                                                                                ;方向の値が0〜円周率に収まるようにする
                                                                                if rad>M_PI:rad-pirad2
                                                                                if rad<-M_PI:rad+pirad2
                                                                                if rad>steer{d_shipdt(e_d_srad,spid)+steer}
                                                                                if rad<-steer{d_shipdt(e_d_srad,spid)-steer}
                                                                            }
                                                                            color 255
                                                                        }
                                                                        circle x-10,y-10,x+10,y+10
                                                                    }
                                                                loop
                                                                redraw:await 17:redraw 0
                                                                goto *main

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