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

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





タブ区切りを揃える

横並びの単語を一定数の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)|-|





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

                                                            一日ゲーム第十八弾

                                                             

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

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

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

                                                             

                                                            ダウンロード

                                                            ソースコード

                                                             

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