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

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





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

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

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

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


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

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





    タブ区切りを揃える

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

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

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

     

    bfstr={"

    Programming		Language
    HSP				Script
    Hello		World
    

    "}

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

     

     

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





      バッチファイル

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

       

       

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

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





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

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

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

         


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

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





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

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

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

           

           

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

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





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

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

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

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

             


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

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





              弾幕

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

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

               

               

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

              #const patnum 1
              #const csz 16

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

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

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

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





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

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

                 


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

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





                  VRAM操作

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

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

                   


                  #module
                  #deffunc areacheck var p,var l,var te,int ge
                      if l<0{
                          p=p+l
                          l=l*(-1)
                      }
                      te=l+p
                      if te<0{
                          te=0
                      }else:if te>ge{
                          te=ge
                      }
                      if p<0{
                          p=0
                      }
                      return
                  #global
                  #module
                  #deffunc vramset array vram,int tx,int ty,int tw,int th,int tc,int tgw,int tgh
                      x=tx:y=ty:w=tw:h=th:c=tc:gw=tgw:gh=tgh
                      r=c&0xff
                      g=(c>>8)&0xff
                      b=(c>>16)&0xff
                      areacheck x,w,tew,gw
                      areacheck y,h,teh,gh
                      if (gw*3)¥4!=0{
                          fx=1
                          ix=1-((gw*3)¥4)
                      }else{
                          fx=0:ix=0
                      }
                      j=y
                      repeat
                          if j>=teh:break
                          tj=(gh-j-1)
                          sfx=fx*tj
                          six=ix*tj
                          i=x+sfx
                          repeat
                              if i>=tew+sfx:break
                              index=(tj*gw+i)*3+six
                              poke vram,index,r
                              poke vram,index+1,g
                              poke vram,index+2,b
                              i++
                          loop
                          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)|-|





                                                    多角形の内部の反射処理

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

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

                                                     


                                                    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}
                                                                x1=0f+wldt(0,wlct):y1=0f+wldt(1,wlct):x2=0f+wldt(2,wlct):y2=0f+wldt(3,wlct)
                                                                x3=bldt(0):y3=bldt(1):x4=tblx:y4=tbly
                                                                d=(x2-x1)*(y4-y3)-(y2-y1)*(x4-x3)
                                                                if d<-0.00001|0.00001<d{
                                                                    u=((x3-x1)*(y4-y3)-(y3-y1)*(x4-x3))/d
                                                                    v=((x3-x1)*(y2-y1)-(y3-y1)*(x2-x1))/d
                                                                    if (u>=0.0&u<=1.0)&(v>=0.0&v<=1.0){
                                                                        ;壁とボールの軌道の交点
                                                                        crsx=0f+x1+u*(x2-x1)
                                                                        crsy=0f+y1+u*(y2-y1)
                                                                        ;反射ベクトル計算
                                                                        wldir=atan(y1-y2,x1-x2)
                                                                        cnflg=0:twlct=wlct
                                                                        wlcos=cos(wldir):wlsin=sin(wldir)
                                                                        blcos=-cos(bldt(3)):blsin=-sin(bldt(3))
                                                                        l=(wlcos*wlcos+wlsin*wlsin)*2.0
                                                                        if l<-0.00001|0.00001<l{
                                                                            t=-(wlcos*blcos+wlsin*blsin)/(wlcos*wlcos+wlsin*wlsin)*2.0
                                                                        }else{
                                                                            t=-(wlcos*blcos+wlsin*blsin)
                                                                        }
                                                                        ;反射後の移動ベクトル
                                                                        x=blcos+t*wlcos:y=blsin+t*wlsin
                                                                        bldt(3)=atan(y,x)
                                                                        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)|-|