' ' ファイルリストを作るサンプルプログラム (c)2017 SmileBoom Co.Ltd. ' option strict cls var sw=true var a$ input "フォルダのみで作りますか(y/n):",a$ if a$=="y" || a$=="Y" then sw=false flist "../",sw end '====================================== '■フォルダリスト生成 '====================================== def flist pr$,sw var l$="-"*40 print l$:print pr$:print l$ var cnt=mklist(pr$,0,0,"", sw ) print l$:print "file + folder = ";cnt end '-------------------------------------- '◎階層型フォルダリスト生成(再帰呼び出し) '-------------------------------------- ' pr$ : 検索対象のフォルダ名 ' lv : 階層レベル ' cnt : 総合ファイル(+フォルダ)数のカウンタ ' tr$ : ツリー表示のための罫線管理文字列 ' sw : 検索にファイルも含めるか(TRUE=あり) '-------------------------------------- def mklist(pr$,lv,cnt,tr$,sw) '--- 指定されたフォルダのリストを取得 dim list$[0] files pr$,list$ '--- フォルダが先に来るようにソート var l=len(list$) if l>1 then rsort list$ '--- リスト内にファイルが含まれているか? var n$,c$,x$ var i,v,isfile=0 for i=0 to l-1 n$=list$[i]:if n$[0]==" " then isfile=1:break 'ファイル発見 next if !sw then l=i '--- リスト内にフォルダがあれば中に入って調査する for i=0 to l-1 n$=list$[i]:n$=mid$(n$,1,len(n$)-1) if i==l-1 then c$="" else c$="" if list$[i][0]=="+" then '--- フォルダの中を調べる print tr$+c$+"";:color #YELLOW:print n$:color #WHITE if i==l-1 && !isfile then c$=" " else c$="" cnt=mklist(pr$+n$+"/",lv+1,cnt,tr$+c$,sw) elseif sw then '--- ファイルとして表示 print tr$+c$+"";n$ endif '--- if (cnt mod 30)==29 then input "-"*40+" more";c$ cnt=cnt+1 next '--- return cnt end
・全部消すのにかかった時間がスコアになっています(低いほど優秀)
' ' マウスで遊ぶ簡単なゲーム (c)2017 SmileBoom Co.Ltd. ' option strict '--- システムで利用するグローバル変数の定義 var ___i var scw=400,sch=240,sca=16/9 var z_top=-256,z_tx=0,z_sp=300,z_gr=800,z_end=1024 var vs=1 'vsync 0:off 1:on var sp_mos=511 var keyn$="" var btw1=15,btw2=4 var btn=0,bto,btr,bti,btcnt=0 var stvx1,stvy1,stvx2,stvy2 var mosx,mosy,mosw,mosh var mosvx,mosvy,mosvw,mosvh var mosbn=0,mosbo,mosbr,mosbi,mosbcnt=0 '--- 表示関係のの初期化 xscreen scw,sch,sca gprio z_gr:gpage 0,0:sppage 3 makeSky gtext 4,sch-10,"GAME1 (c)2017 SmileBoom Co.Ltd.",#WHITE,0 '--- マウス処理の初期化 mosx=scw/2:mosy=sch/2 spset sp_mos,272,496,16,16,1 spofs sp_mos,mosx,mosy,z_top spcol sp_mos ',0,0,1,1 spfunc sp_mos,"spfuncMouse" '--- プログラムの初期化 gosub @initUser ' ' メインループ ' 'softkbd=0 while 1 '--- keyn$=inkey$() getController getMouse call SPRITE '--- userProgram '--- if vs then vsync 1 '--- if keyn$=="q" || keyn$=="Q" then break wend ' ' プログラムの終了 ' print "byebye!" softkbd=1 end '======================================= ' ユーザーが利用するグローバル変数を定義 '======================================= @initUser '--- public value var eneCount=100,eneHit=0 var def_score=999,score=def_score,hiscore=0 '--- eneInit '--- color rgb(32,120,255):locate 2,2:print "TIME:" color #WHITE return '======================================= ' ユーザーのプログラム '======================================= def userProgram '--- スコアの表示 score=score-1:if score<0 then score=0 locate 7,2:print left$(str$(score)+" "*4,4); '--- マウスと敵の当たり判定 var ex=sphitsp(sp_mos) if ex==-1 then return '--- 敵に触った beep 3 var x,y var r=(360/eneCount)*eneHit x=(scw/2)+sin(rad(r))*(sch/3) y=(sch/2)+cos(rad(r))*(sch/3) spofs ex,,,z_gr-10 spanim ex,"xy",-16,x,y,1 spscale ex,1,1 spanim ex,"s",-30,0.75,0.75,-30,1,1,0 spvar ex,0,1 sprot ex,r spcolor ex,rgb(240,120,120,120) spcol ex,0,0 'hit disable '--- eneHit=eneHit+1 if eneHit<eneCount then return '--- すべての敵に触った(クリア) beep 5 eneHit=0 var i for i=0 to eneCount-1 r=sprot(i) x=(scw/2)+sin(rad(r))*(scw) y=(sch/2)+cos(rad(r))*(scw) spofs i,,,z_sp spanim i,"xy",-16,x,y,1 spanim i,"s",-16,2,2,1 spcolor i,rgb(255,255,255,255) spvar i,0,0 spcol i,1,-1 next '--- ハイスコア更新? if hiscore<score then hiscore=score color rgb(255,64,200):locate 16,2:print "RECORD:"; color #WHITE:print hiscore;" " '--- score=def_score end '======================================= ' 敵の初期化 '======================================= def eneInit var i,u,v,w,h,sp for i=0 to eneCount-1 spset rnd(2048) out sp spofs sp,rnd(scw-32)+16,rnd(sch/4)+16,z_sp spchr sp out u,v,w,h sphome sp,w/2,h/2 spfunc sp,"eneMove" spvar sp,0,0 spcol sp,1,-1 next end '======================================= ' 敵の移動 '======================================= def eneMove var i,sp=CALLIDX if spchk(sp) and #CHKXY then return if spvar(sp,0) then return '--- var ox,oy,x,y,t=rnd(180)+60 x=rnd(scw+32)-16:y=rnd(sch+32)-16 spofs sp out ox,oy spanim sp,"xy",-t,x,y,1 spanim sp,"s",-t,rnd(4)*0.5+0.5,rnd(4)*0.5+0.5,1 spanim sp,"r",-30,deg(atan(y-oy,x-ox)),1 end '====================================== ' 背景のグラデーション表示 '====================================== def makeSky var x,y,i=256/sch,r,g,b for y=0 to sch-1 r=max(0,min(255,(y/5)*i)) g=max(0,min(255,(y/2)*i)) b=max(0,min(255,(y*i*2))) gline 0,y,scw-1,y,rgb(r,g,b) next end ' ' 汎用ライブラリ ' '======================================= ' ボタン関係のリピートチェック '======================================= def chkrep o,n,c out _o,_n,_i,_r,_c _n=n:_i=n and (not o) if n!=o then _c=0:_r=n else _c=c+1 if !((_c-btw1) mod btw2) then _r=n else _r=0 _o=n end '======================================= ' コントローラ情報取得 '======================================= def getController chkrep bto,button(),btcnt out bto,btn,bti,btr,btcnt stvx1=stick(#STICK_LX):stvy1=stick(#STICK_LY) stvx2=stick(#STICK_RX):stvy2=stick(#STICK_RY) end '======================================= ' マウス情報取得(マウス座標の生成) '======================================= def getMouse mousemov out mosvx,mosvy,mosvw,mosvh chkrep mosbo,mousebtn(),mosbcnt out mosbo,mosbn,mosbi,mosbr,mosbcnt '--- 座標計算 mosx=max(0,min(scw-1,mosx+mosvx)) mosy=max(0,min(sch-1,mosy+mosvy)) '--- ホイール計算 mosw=max(-10,min(10,mosw+mosvw)) mosh=max(-10,min(10,mosh+mosvh)) end '======================================= ' spfunc:マウスカーソル '======================================= def spfuncMouse var ix=CALLIDX if ix==-1 then return spofs ix,mosx,mosy end '======================================= ' グラフィック画面への文字表示(ややプロポーショナル) '======================================= def gtext x,y,t$,c,b var i=0,o,w var c$ while i<len(t$) c$=mid$(t$,i,1):i=i+1 chkprop c$ out o,w gputchr x+o,y,c$,c if b then gputchr x+(o div 2 ),y,c$,c:x=x+1 x=x+w wend end '--- def chkprop c$ out o,w o=-1:w=6 if c$==" " then o=-2:w=4 if c$=="(" || c$==")" then o=-2:w=4 if c$=="." || c$=="," || c$==":" then o=-2:w=4 if c$=="i" || c$=="l" then o=-2:w=4 if c$=="I" then w=5 end
・タブレットは解像度やアスペクト比などが機種ごとに異なるためご利用中の機器ごとに調整が必要です
・コントローラからの入力においても機種ごとに扱う値の範囲が異なるため調整が必要です
・DEFユーザー命令を使うことでグローバルな変数を増やさない構造(ユーザー用の広域変数は @InitUser サブルーチン内で定義)
・スプライトの内部変数を使った状態の管理(SPVAR命令)
・動的に画像を生成してスプライトを使って描画する仕組み
' ' シンプルなお絵かきツールのサンプル ' ' (c)2017 SmileBoom Co.Ltd. ' option strict '--- システムで利用するグローバル変数の定義 var ___i var scw=640,sch=360,sca=16/9 'var scw=1280,sch=720,sca=16/9 'var scw=400,sch=240,sca=16/9 var z_top=-256,z_tx=0,z_sp=300,z_gr=800,z_end=1024 var vs=0 'vsync 0:off 1:on var deb=1 'print debug text var deby=0,oldms=millisec var sp_mos=511 var keyn$="" var btw1=15,btw2=4 var btn=0,bto,btr,bti,btcnt=0 var stvx1,stvy1,stvx2,stvy2 var mosx,mosy,mosw,mosh var mosvx,mosvy,mosvw,mosvh var mosbn=0,mosbo,mosbr,mosbi,mosbcnt=0 var tabax,tabay,tabx,taby,tabpr=0,tabtp,tabz=0 var oldtabpr,oldtabz,tabpri var tabbn=0,tabbo,tabbr,tabbi,tabbcnt=0,tabsf=16 var tabw=47704,tabh=27940 'WACOM PTK-640(16:9) 'var tabw=20318,tabh=16238 'WACOM GD0608-U(4:3) '--- 表示関係のの初期化 xscreen scw,sch,sca 'console 2,2,scw/8-4,sch/8-4 gprio z_gr:gpage 0,0:sppage 3 gfill 0,0,scw-1,sch-1,rgb(0,0,0) gfill 0,sch-13,scw-1,sch-1,#NAVY gtext 4,sch-10,"EASY PAINT SAMPLE (c)2017 SmileBoom Co.Ltd.",#WHITE,0 '--- マウス処理の初期化 mosx=scw/2:mosy=sch/2 spset sp_mos,272,496,16,16,1 spofs sp_mos,mosx,mosy,z_top spcol sp_mos,0,0,1,1 spfunc sp_mos,"spfuncMouse" '--- プログラムの初期化 gosub @initUser ' ' メインループ ' softkbd=0 while 1 '--- deby=0 debp format$("millisec:%d",millisec-oldms):oldms=millisec debp "" '--- keyn$=inkey$() getController getMouse getTablet call SPRITE '--- userProgram '--- if vs then vsync 1 '--- if keyn$=="q" || keyn$=="Q" then break wend ' ' プログラムの終了 ' print "byebye!" softkbd=1 end '======================================= ' ユーザーが利用するグローバル変数を定義 '======================================= @initUser '--- public value var sp_tool,sp_csrtool var sp_pen,sp_csrpen var sp_hsv,sp_csrhsv var sp_line,sp_point,sp_fill var toolType=0,toolMode=0 var toolPen=0,toolColor=rgb(255,255,255) var toolName$="",oldName$="" var oldmx,oldmy,ofsx,ofsy var hsv_h=0 dim pen[16*16],sld[2],sp_sld[2] '--- makeTool '--- return '======================================= ' ユーザーのプログラム '======================================= def userProgram debp "" debp format$("mode:%d name:%s pen:%d H:%3d S:%3d V:%3d", toolMode, toolName$, toolPen, hsv_h, sld[0], sld[1] ) '--- 最初のクリック確認(ツール切替かツールの最初の動作) if !toolMode then if !tool_1st() then return endif '--- ツール利用中にツールウィンドウ上にマウスが乗った? var v var t$=toolName$ if t$!="win" && toolMode<2 then if sphitsp(sp_mos,sp_tool) then if (mosbi and 1) || tabpri then toolMode=0:v=tool_1st():return endif endif endif '--- 1-3)ツールで操作中 if toolMode==1 then ' --- マウスまたはタブレットで描き始めた? t$=t$+"_1st":if chkcall(t$) then call t$ elseif toolMode==2 then ' --- マウスで描画中 t$=t$+"_2nd":if chkcall(t$) then call t$,mosx,mosy,mosbn and 1 elseif toolMode==3 then ' --- タブレットで描画中 t$=t$+"_2nd":if chkcall(t$) then call t$,tabx,taby,tabpr endif end '======================================= ' ツールの選択、または機能の最初の処理実行 '======================================= def tool_1st() '--- マウスの中央ボタンかタブレットのボタンでツールウィンドウをダイレクトに移動 if mosbn==4 || tabbn==2 then spofs sp_tool,mosx,mosy return 0 endif '--- ツールウィンドウ上にマウスがある? var t$="" var sp=sphitsp(sp_mos) var r,g,b,x,y,u,v,w,h,nx,ny,tp=sp if sp==sp_tool then v=sphitsp():if v!=-1 then sp=v t$=id2text$(spvar(sp,0)) endif '--- 画面上の色を吸い取る if mosbn==2 || tabbn==1 then if sp!=-1 then spchr sp out u,v,w,h 'ツールアイコン上の色も吸うならココを改造 else v=gspoit(mosx,mosy) rgbread v out r,g,b rgb2hsv r,g,b out hsv_h,sld[0],sld[1] drawHSV endif return 0 endif '--- マウスのボタンかタブレットが押されているか? if mosbn!=1 && !tabpr then return 0 '--- ツールボタン上にマウスが無ければ機能の実行開始 if !sphitsp(sp_mos,sp_tool) then '--- over : マウスまたはタブレットで描き始めた toolMode=1:return 1 endif '--- ツールウィンドウの座標等を取得 spofs sp_tool out nx,ny spofs sp out x,y debp format$( "pos:%d,%d [%s] ",x,y,t$ ) '--- ツールウィンドウに触っている if sp==sp_tool then '--- ツールウィンドウをつかんで移動 oldName$=toolName$:toolName$="win":toolMode=1 ofsx=x-mosx:ofsy=y-mosy return 1 endif '--- HSV色選択アイコンに触っている if t$=="hsv" || t$=="sld0" || t$=="sld1" then if t$!="hsv" then v=val(right$(t$,1)):sld[v]=slider(sld[v],sp,x+nx,y+ny) else checkHSV endif drawHSV return 0 endif '--- ペン先の切り替えアイコンに触っている if t$[0]=="P" then spofs sp_csrpen,x,y toolPen=val(t$[1]):makepen return 0 endif '--- 機能切り替えアイコンに触っている oldName$=toolName$ if chkcall(t$+"_Init") then '--- 初期化のみで終了する機能 call t$+"_Init" else '--- 機能を切り替える spofs sp_csrtool,x,y toolName$=t$ toolMode=1 endif return 0 end '======================================= ' ツールウィンドウを移動 '======================================= def win_1st if (mosbn and 1) || tabpr then spofs sp_tool,mosx+ofsx,mosy+ofsy else toolName$=oldName$:toolMode=0 endif end '======================================= ' TOOL:ペンを使った描画機能 '======================================= def pen_1st if mosbi==1 then oldmx=mosx:oldmy=mosy:toolMode=2 if tabpri then oldmx=tabx:oldmy=taby:toolMode=3 if toolMode<2 then return gpen oldmx,oldmy end '--- def pen_2nd x,y,b if b then glinedda oldmx,oldmy,x,y oldmx=x:oldmy=y else toolMode=0 endif end '======================================= ' TOOL:塗りつぶし機能 '======================================= def pain_1st var x=-1,y if mosbi==1 then x=mosx:y=mosy if tabpri then x=tabx:y=taby if x==-1 then return gpaint x,y,toolColor end '======================================= ' TOOL:画面消去 '======================================= def cls_Init gfill 0,0,scw-1,sch-1,toolColor toolName$=oldName$ end '======================================= ' HSVの色相(Hue)に関する角度を取得 '======================================= def checkHSV var hx,hy,x,y,u,v,w,h spofs sp_tool out hx,hy spofs sp_hsv out x,y hx=hx+x:hy=hy+y 'center var a=atan(hy-mosy,hx-mosx) if a<0 then a=a+2*pi() hsv_h=((deg(a)+180) mod 360) drawHSV end '======================================= ' スライダーでHSVの彩度(Saturation)または明度(Value)調整 '======================================= def slider(old,sp,x,y) var u,v,w,h spchr sp out u,v,w,h h=h-16 var i=(mosy-y)-4 if i<0 then i=0 if i>56 then i=56 y=i+4:i=(255/56)*i if i==old then return old var t=-1 if (mosbi and 1) || tabpri then t=-8 spanim sp+1,"xy",t,0,y,1 return 255-i end '======================================= ' HSV関係の表示初期化 '======================================= def drawHSV var vp,wp gpage out vp,wp:gpage 0,3 '--- HSV円の描画 var u=512,v=132,rr=32 hsvCircle sld[0],sld[1],u+rr,v+rr,rr '--- カレント色の表示 var x=u+rr*2+16,y=16+rr*2+4 var w=38,h=20,r,g,b hsv2rgb hsv_h,sld[0],sld[1] out r,g,b toolColor=rgb(r,g,b) gfill x,y,x+w-1,y+h-1,toolColor gbox x,y,x+w-1,y+h-1,#WHITE gbox x+1,y+1,x+w-2,y+h-2,#BLACK '--- gpage vp,wp '--- makepen '--- スライダーの表示 var i for i=0 to 1 spofs sp_sld[i],0,4+((255-sld[i])*(56/255)) next '--- HSV用のカーソル(スプライトによるアニメ付き) var ox=cos(rad(hsv_h))*24 var oy=sin(rad(hsv_h))*24 spofs sp_csrhsv,ox,oy end '======================================= ' ツール用の機能ウィンドウを開く '======================================= def makeTool '--- スプライト画像エリアで画像を作る gpage 0,3 '描画ページを3(=SPRITE)にする var u=512,v=0,tw=128,th=132 var x=u,y=v,w=tw,h=th gfill x,y,1023,1023,rgb(0,0,0,0) 'スプライト画像範囲の右半分を利用する '--- ウィンドウを描画 gfill x+1,y,x+w-2,y+h-1,#WHITE gbox x,y+1,x+w-1,y+h-2,#WHITE gfill x+2,y+2+9,x+w-3,y+h-3,#NAVY gtext x+2,y+2,"tool",#BLACK,true '--- ツールウィンドウ用にスプライト生成 spset u,v,tw,th,1 out sp_tool spofs sp_tool,scw,16,z_sp spanim sp_tool,"xy",-16,scw-tw-16,16,1 spfunc sp_tool,"spfuncTool" spvar sp_tool,0,text2id("win") spcol sp_tool v=th '--- 色選択用にHSVの円を描く var sp,r=32 spset u,v,r*2,r*2,1 out sp_hsv splink sp_hsv,sp_tool spofs sp_hsv,8+r,16+r,0 sphome sp_hsv,r,r spcol sp_hsv spvar sp_hsv,0,text2id("hsv") '--- HSV(S,V)調節用のスライダーエリアを生成 tw=r*2:x=u+tw+4:y=v:w=16:h=tw var i,ex for i=0 to 1 '--- base gfill x,y,x+w-1,y+h-1,#WHITE gfill x+2,y+2,x+w-1-2,y+h-1-2,rgb(0,16,64) spset x,y,w,h,1 out sp splink sp,sp_tool spofs sp,16+tw+i*22,16,0 spcol sp spvar sp,0,text2id("sld"+str$(i)) '--- スライダー用のサム部品 spset 208,20,16,8,1 out ex sp_sld[i]=ex splink ex,sp sphome ex,0,4 spofs ex,0,4,-1 '--- sld[i]=255 x=x+16 next v=v+th '--- 機能用のボタンを生成(名前は4文字まで) data 32,64,16,16,"pen" data 112,64,16,16,"pain" data 256,96,16,16,"cls" data -1 var t$ u=8:v=88 while 1 read x:if x==-1 then break read y,w,h,t$ spset x,y,w,h,1 out sp splink sp,sp_tool spofs sp,u,v,0 spcol sp u=u+19 spvar sp,0,text2id(t$) 'スプライトの内部変数32ビットに文字列保管(4文字分) wend '--- ツールアイコン用のカーソル spset 80,96,16,16,1 out sp_csrtool splink sp_csrtool,sp_tool spofs sp_csrtool,8,88,-1 spanim sp_csrtool,"c",-15,#YELLOW,-15,#WHITE,0 toolName$="pen" '--- ペン先の生成(円とペイントで作る) u=512:v=128+72:w=16:h=16:y=v for i=0 to 5 x=u+i*19 gcircle x+7,y+7,i+1,#WHITE gpaint x+7,y+7,#WHITE spset x,y,w,h,1 out sp if i==0 then sp_pen=sp splink sp,sp_tool spofs sp,8+i*19,88+20,0 spcol sp spvar sp,0,text2id("P"+str$(i)) next '--- 最後のペンだけメッシュを入れてみる x=u+5*19:y=v gputchr x,y,chr$(&HE2FF)+chr$(&HE2FF),0 gputchr x,y+8,chr$(&HE2FF)+chr$(&HE2FF),0 '--- ペン先選択用のカーソル spset 80,96,16,16,1 out sp_csrpen splink sp_csrpen,sp_tool spofs sp_pen out x,y spofs sp_csrpen,x,y,-1 spanim sp_csrpen,"c",-15,#RED,-15,#WHITE,0 '--- スプライトによるカーソル用の画像を定義 v=v+16 gfill u,v,u+15,v+15,#WHITE u=u+1:v=v+1 '--- スプライトによるライン用カーソルを4本定義 for i=0 to 3 sp=createcsr(u,v,scw,1) if i==0 then sp_line=sp next '--- スプライトによるポイント用カーソルを2個定義 for i=0 to 1 sp=createcsr(u,v,5,5) sphome sp,0.5,0.5 spanim sp,"r",-30,360,0 if i==0 then sp_point=sp next '--- スプライトによる塗りつぶし用カーソルを1つ定義 sp_fill=createcsr(u,v,100,100) '--- スプライトによるHSV用カーソルを1つ定義 sp_csrhsv=createcsr(u,v,5,5) splink sp_csrhsv,sp_hsv spofs sp_csrhsv,0,0,-1 sphome sp_csrhsv,0.5,0.5 spanim sp_csrhsv,"r",-30,360,0 spshow sp_csrhsv '--- drawHSV toolPen=0:makepen '--- 描画ページを戻す gpage 0,0 end '======================================= ' スプライトによるカーソル定義と初期設定 '======================================= def createcsr(u,v,w,h) var sp spset u,v,1,1,1 out sp sphome sp,0,0 spscale sp,w,h spofs sp,0,0,z_sp spcolor sp,rgb(200,255,255,255) sphide sp return sp end '======================================= ' スプライトを使ったポイントの表示 '======================================= def setPoint x,y,n spofs sp_point+n,x,y spshow sp_point+n end def clrPoint n sphide sp_point+n end '======================================= ' スプライトを使った塗りつぶしの板表示 '======================================= def setFill x1,y1,x2,y2 var w=abs(x1-x2) var h=abs(y1-y2) if x2<x1 then swap x1,x2 if y2<y1 then swap y1,y2 spofs sp_fill,x1,y1 spscale sp_fill,w,h spshow sp_fill end def clrFill sphide sp_fill end '======================================= ' スプライトを使った線の表示 '======================================= def setLine x1,y1,x2,y2,n var l=sqr((x2-x1)*(x2-x1)+(y2-y1)*(y2-y1)) var r=deg(atan(y2-y1,x2-x1)) spofs sp_line+n,x1,y1 spscale sp_line+n,l,1 sprot sp_line+n,r spshow sp_line+n end '--- スプライトによる線の消去 def clrLine n sphide sp_line+n end '======================================= ' スプライトを使った矩形の表示 '======================================= def setBox x1,y1,x2,y2 setLine x1,y1,x2,y1,0 setLine x2,y1,x2,y2,1 setLine x2,y2,x1,y2,2 setLine x1,y2,x1,y1,3 end '--- スプライトによる矩形の消去 def clrBox clrLine 0 clrLine 1 clrLine 2 clrLine 3 end '======================================= ' ペン先のイメージを配列に記録 (in)toolPen,toolColor '======================================= def makepen var vp,wp,u,v,w,h gpage out vp,wp:gpage 0,3 '--- spchr sp_pen+toolPen out u,v,w,h var x,y,c for y=0 to 15 for x=0 to 15 c=gspoit(u+x,v+y) if c then c=toolColor pen[x+y*16]=c next next '--- gpage vp,wp end '======================================= ' 文字列(最大4文字)から32ビットのIDを生成 '======================================= def text2id(t$) var i,id=0 var c$ for i=0 to 3 id=id << 8 c$=mid$(t$,i,1) if c$=="" then c$=" " id=id+asc(c$) next return id end '======================================= ' 32ビットIDから文字列(最大4文字)を生成 '======================================= def id2text$(id) var i var c$,t$="" if id==0 then return "" for i=0 to 3 c$=chr$(id and &hFF) if c$!=" " then t$=c$+t$ id=id >> 8 next if c$==" " then c$="" return t$ end '======================================= ' ツール用のスプライト処理先 '======================================= def spfuncTool var ix=CALLIDX if !spused(ix) then return '--- end ' ' 汎用ライブラリ ' '======================================= ' デバッグメッセージの表示 '======================================= def debp t$ if !deb then return '--- 'color #WHITE,#BLACK locate 0,deby+2:inc deby print " "+t$ 'color #WHITE,0 end '======================================= ' ボタン関係のリピートチェック '======================================= def chkrep o,n,c out _o,_n,_i,_r,_c _n=n:_i=n and (not o) if n!=o then _c=0:_r=n else _c=c+1 if !((_c-btw1) mod btw2) then _r=n else _r=0 _o=n end '======================================= ' コントローラ情報取得 '======================================= def getController chkrep bto,button(),btcnt out bto,btn,bti,btr,btcnt stvx1=stick(#STICK_LX):stvy1=stick(#STICK_LY) stvx2=stick(#STICK_RX):stvy2=stick(#STICK_RY) '--- debp format$("button:%04X,%04X,%04X",btn,bti,btr) debp format$("stick :%+6d,%+6d/%+6d,%+6d",stvx1,stvy1,stvx2,stvy2) end '======================================= ' マウス情報取得(マウス座標の生成) '======================================= def getMouse mousemov out mosvx,mosvy,mosvw,mosvh chkrep mosbo,mousebtn(),mosbcnt out mosbo,mosbn,mosbi,mosbr,mosbcnt '--- 座標計算 mosx=max(0,min(scw-1,mosx+mosvx)) mosy=max(0,min(sch-1,mosy+mosvy)) '--- ホイール計算 mosw=max(-10,min(10,mosw+mosvw)) mosh=max(-10,min(10,mosh+mosvh)) '--- debp format$("mouse :%X,%X,%X / %4d,%4d / %+2d,%+2d",mosbn,mosbi,mosbr,mosx,mosy,mosw,mosh) end '======================================= ' spfunc:マウスカーソル '======================================= def spfuncMouse var ix=CALLIDX if ix==-1 then return spofs ix,mosx,mosy end '======================================= ' タブレット情報取得 '--------------------------------------- ' tabpr:0=off, 1- ' tabtp:1=eraser,4=spray ' tabz :0=off, 1-=float '======================================= def getTablet var bn oldtabpr=tabpr:oldtabz=tabz tabletstat out tabax,tabay,tabpr,tabtp,tabz,bn chkrep tabbo,bn,tabbcnt out tabbo,tabbn,tabbi,tabbr,tabbcnt if !oldtabpr && tabpr then tabpri=tabpr else tabpri=0 '--- スクリーン座標系への変換(キャリブレーション等で最大範囲を取得して対応させたい) var sx=scw+(tabsf*2),sy=sch+(tabsf*2) tabx=max(0,min(scw-1,floor((sx/tabw)*tabax)-tabsf)) taby=max(0,min(sch-1,floor((sy/tabh)*tabay)-tabsf)) '--- mouse cursor if tabz then mosx=tabx:mosy=taby endif '--- debp format$("tablet:%X,%X,%X a:%5d,%5d o:%4d,%4d p:%4d t:%d z:%2d",tabbn,tabbi,tabbr,tabax,tabay,tabx,taby,tabpr,tabtp,tabz) end '======================================= ' グラフィック画面への文字表示(ややプロポーショナル) '======================================= def gtext x,y,t$,c,b var i=0,o,w var c$ while i<len(t$) c$=mid$(t$,i,1):i=i+1 chkprop c$ out o,w gputchr x+o,y,c$,c if b then gputchr x+(o div 2 ),y,c$,c:x=x+1 x=x+w wend end '--- def chkprop c$ out o,w o=-1:w=6 if c$==" " then o=-2:w=4 if c$=="(" || c$==")" then o=-2:w=4 if c$=="." || c$=="," || c$==":" then o=-2:w=4 if c$=="i" || c$=="l" then o=-2:w=4 if c$=="I" then w=5 end '======================================= ' HSVの円を描画 '======================================= def hsvCircle s,v,cx,cy,r1 var x1,y1,x2,y2,as=1,ang,r,g,b for ang=0 to 360-1 step as x1=cx+cos(rad(ang))*r1 y1=cy+sin(rad(ang))*r1 x2=cx+cos(rad(ang+as))*r1 y2=cy+sin(rad(ang+as))*r1 hsv2rgb ang,s,v out r,g,b gtri cx,cy,x1,y1,x2,y2,rgb(r,g,b) next end '======================================= ' HSVからRGBを生成 '======================================= def hsv2rgb h,s,v out r,g,b var l=v-((s/255)*v),w=v-l if s==0 then r=v:g=v:b=v elseif h<=60 then r=v:g=(h/60)*w+l:b=l elseif h<=120 then r=((120-h)/60)*w+l:g=v:b=l elseif h<=180 then r=l:g=v:b=((h-120)/60)*w+l elseif h<=240 then r=l:g=((240-h)/60)*w+l:b=v elseif h<=300 then r=((h-240)/60)*w+l:g=l:b=v else r=v:g=l:b=((360-h)/60)*w+l endif r=floor(r) g=floor(g) b=floor(b) end '======================================= ' RGBからHSVを生成 '======================================= def rgb2hsv r,g,b out h,s,v if !r && !g && !b then h=0:s=0:v=0:return '--- v=max(r,g,b) var l=min(r,g,b) var w=v-l '--- s=floor((w/v)*256) '--- if r==g && r==b then h=0 elseif r>g && r>b then h=60*(g-b)/w elseif g>r && g>b then h=60*(b-r)/w+120 else h=60*(r-g)/w+240 endif '--- if h<0 then h=h+360 h=floor(h) end '======================================= ' DDALINE '======================================= def glinedda x,y,ex,ey var vx=ex-x,vy=ey-y var w=abs(vx),h=abs(vy),s,e var i,sw=sgn(vx),sh=sgn(vy) if w>h then e=-w for i=0 to w-1 gpen x,y x=x+sw:e=e+2*h if e>=0 then y=y+sh:e=e-2*w next else e=-h for i=0 to h-1 gpen x,y y=y+sh:e=e+2*w if e>=0 then x=x+sw:e=e-2*h next endif end '======================================= ' DRAW PEN '======================================= def gpen x,y var c=toolColor '--- tab? if toolMode==2 then '--- mouse if toolPen==5 then x=x and &HFFFE:y=y and &HFFFE gload x-7,y-7,16,16,pen,0 return endif '--- tab var w=tabpr div 100 if w>100 then w=100 w=w div 2 if tabtp==1 then c=#BLACK gfill x-w,y-w,x+w,y+w,c end '===== end of source =====
' ' コントローラで遊ぶ簡単なゲーム (c)2017 SmileBoom Co.Ltd. ' option strict '--- システムで利用するグローバル変数の定義 var ___i var scw=400,sch=240,sca=16/9 var z_top=-256,z_tx=0,z_sp=300,z_gr=800,z_end=1024 var vs=1 'vsync 0:off 1:on var sp_mos=511 var keyn$="" var btw1=15,btw2=4 var btn=0,bto,btr,bti,btcnt=0 var stvx1,stvy1,stvx2,stvy2 '--- var se_pos=0,se_time=1,se_frq=2,se_vol=3 var se_deftime=4,se_defvol=5,se_xfrq=6 var se_valmax=8 var max_sndch=8 var se[max_sndch,se_valmax],mml$[max_sndch] '--- @dt_note data 69,71,73,74,76,78,80,81 'CDEFGABC var dt_note[8] copy dt_note,@dt_note '--- @dt_len data 48,24,12,6,3 'L1,L2,L4,L8,L16 var dt_len[5] copy dt_len,@dt_len '--- @dt_mml data "x-100L16CDEFGAB" data "x+1000L1C" data "E" data "F" data "G" data "A" data "B" data "<C" var max_dtmml=8 var dt_mml$[max_dtmml] copy dt_mml$,@dt_mml '--- seOpen '--- 表示関係のの初期化 xscreen scw,sch,sca gprio z_gr:gpage 0,0:sppage 3 makeSky locate 1,sch/8-2:print "GAME2 (c)2017 SmileBoom Co.Ltd." '--- プログラムの初期化 gosub @initUser ' ' メインループ ' 'softkbd=0 while 1 '--- keyn$=inkey$() getController call SPRITE '--- seUpdate userProgram '--- if vs then vsync 1 '--- if keyn$=="q" || keyn$=="Q" then break wend ' ' プログラムの終了 ' seClose print "byebye!" fontdef softkbd=1 end '======================================= ' ユーザーが利用するグローバル変数を定義 '======================================= @initUser '--- public value var scrlx=0,scrly=0 var eneCount=100,eneHit=0 var max_score=999999,score=0,hiscore=2525 var sp_playercnt=1,sp_player=500 var sp_shotcnt=128,sp_shot=sp_player-sp_shotcnt var sp_itemcnt=16,sp_item=sp_shot-sp_itemcnt var sp_bombcnt=32,sp_bomb=sp_item-sp_bombcnt var sp_enemycnt=64,sp_enemy=0 '--- if sp_enemycnt>sp_bomb then sp_enemycnt=sp_bomb '--- spvar value var v_hp=0,v_atk=1,v_score=2, '--- 'makeFont '--- color rgb(32,120,255):locate 2,2:print "SCORE:" color rgb(255,64,200):locate 20,2:print "HISCORE:" color #WHITE '--- playerInit shotInit itemInit bombInit enemyInit return '======================================= ' ユーザーのプログラム '======================================= def userProgram '--- scroll gofs scrlx,scrly if maincnt and 1 then scrly=(scrly-1) and 255 '--- スコアの表示 if score>max_score then score=max_score locate 8,2:print left$(str$(score)+" "*6,6); '--- ハイスコア更新? if hiscore<score then hiscore=score locate 28,2:print hiscore;" " if keyn$!="" then locate 40,1 : print asc(keyn$);" " locate 40,2 : print hex$(bti and &HFFFF,4);" " end '======================================= ' player '======================================= def playerInit var sp=sp_player spset sp,3299 spofs sp,scw/2,sch/2,z_tx+10 spfunc sp,"funcPlayer" spcol sp,&H000F spvar sp,v_hp,100 end '--- main def funcPlayer var sp=CALLIDX if !spused(sp) then return '--- var x,y,k=0,spd=4 var vx=(1.0/32768)*stvx1 var vy=(1.0/32768)*stvy1 '--- if !vx && !vy then if btn and 1 then vy=-1 if btn and 2 then vy= 1 if btn and 4 then vx=-1 if btn and 8 then vx= 1 endif '--- move spofs sp out x,y x=max(0,min(scw-1,x+vx*spd)) y=max(0,min(sch-1,y+vy*spd)) spofs sp,x,y '--- shot if bti and &H40 then shotCreate x,y,0,-1,0 if bti and &H10 then itemCreate x,y,0 end '======================================= ' player shot '======================================= def shotInit var i,u,v,w,h,sp for i=0 to sp_shotcnt-1 spclr sp_shot+i next end '--- create def shotCreate x,y,vx,vy,t var sp spset sp_shot,sp_shot+sp_shotcnt-1,3357 out sp if sp==-1 then return '--- seSet 1 spofs sp,x,y,z_sp spanim sp,"xy",-16,x,-32,1 spfunc sp,"funcShot" spcol sp,&HFFF0 spvar sp,v_hp,1 spvar sp,v_atk,3 end '--- main def funcShot var sp=CALLIDX '--- hit? var ex=sphitsp( sp, sp_enemy,sp_enemy+sp_enemycnt-1 ) if ex!=-1 then enemyDamage sp,ex '--- dead? var hp=spvar(sp,v_hp) if hp>=0 && (spchk(sp) and #CHKXY) then return '--- end spclr sp end '======================================= ' enemy '======================================= def enemyInit var i,u,v,w,h,sp for i=0 to sp_enemycnt-1 enemyCreate rnd(scw-32)+16,-64,rnd(10) next end '--- create def enemyCreate x,y,t var sp spset sp_enemy,sp_enemy+sp_enemycnt-1,3275 out sp if sp==-1 then return '--- spofs sp,x,y,z_sp spanim sp,"i",8,3259,8,3260,8,3258,0 spcol sp,&H000F spvar sp,v_hp,1 spvar sp,v_atk,5 spvar sp,v_score,3 spfunc sp,"funcEnemy" end '--- damage def enemyDamage sp,ex var atk1=spvar(sp,v_atk),hp1=spvar(sp,v_hp) var atk2=spvar(ex,v_atk),hp2=spvar(ex,v_hp) '--- hp1=hp1-atk2:spvar sp,v_hp,hp1 hp2=hp2-atk1:spvar ex,v_hp,hp2 '--- dead if hp2>=0 then return '--- score=score+spvar(ex,v_score) seSet 0 var x,y spofs ex out x,y spclr(ex) bombCreate x,y,0 end '--- main def funcEnemy var sp=CALLIDX if spchk(sp) and #CHKXY then return '--- var ox,oy,x,y,t=rnd(180)+60 x=rnd(scw+32)-16:y=rnd(sch+32)-16 spofs sp out ox,oy spanim sp,"xy",-t,x,y,1 spanim sp,"r",-30,deg(atan(y-oy,x-ox)),1 end '======================================= ' item '======================================= def itemInit var i,u,v,w,h,sp for i=0 to sp_itemcnt-1 spclr sp_item+i next end '--- create( 1UP=2493 ) def itemCreate x,y,t var sp spset sp_item,sp_item+sp_itemcnt-1,3275 out sp if sp==-1 then return '--- spofs sp,x,y,z_sp spanim sp,"i",4,3276,4,3277,4,3278,4,3275,10 spfunc sp,"funcItem" spcol sp,&HFFF0 end '--- main def funcItem var sp=CALLIDX if spchk(sp) and #CHKI then return '--- spclr sp end '======================================= ' bomb '======================================= def bombInit var i,u,v,w,h,sp for i=0 to sp_bombcnt-1 spclr sp_bomb+i next end '--- create def bombCreate x,y,t var sp spset sp_bomb,sp_bomb+sp_bombcnt-1,3424 out sp if sp==-1 then return '--- spofs sp,x,y,z_sp spcolor sp,rgb(240,255,255,255) spanim sp,"i",4,3425,4,3426,4,3427,1 spanim sp,"c",-60,rgb(0,0,0,0),1 spfunc sp,"funcBomb" end '--- main def funcBomb var sp=CALLIDX if spchk(sp) and #CHKI then return '--- spclr sp end '====================================== ' 背景の表示 '====================================== def makeSky dim img[16*16] '--- get image gsave 3,240,304,16,16,img '--- put image var x,y,i=256/sch,r,g,b for y=0 to 512-1 step 16 for x=0 to scw-1 step 16 gload x,y,16,16,img,1 next next '--- offset clear scrlx=0:scrly=0 gofs 0,0 end ' ' 汎用ライブラリ ' '======================================= ' ボタン関係のリピートチェック '======================================= def chkrep o,n,c out _o,_n,_i,_r,_c _n=n:_i=n and (not o) if n!=o then _c=0:_r=n else _c=c+1 if !((_c-btw1) mod btw2) then _r=n else _r=0 _o=n end '======================================= ' コントローラ情報取得 '======================================= def getController '--- check key var b=button(),k if keyn$!="" then k=asc(keyn$) if k==28 then b=b or &H08 if k==29 then b=b or &H04 if k==30 then b=b or &H01 if k==31 then b=b or &H02 if k==32 then b=b or &H40 if k==asc("Z") || k==asc("z") then b=b or &H10 if k==asc("X") || k==asc("x") then b=b or &H20 if k==asc("C") || k==asc("c") then b=b or &H80 endif '--- chkrep bto,b,btcnt out bto,btn,bti,btr,btcnt '--- stvx1=stick(#STICK_LX):stvy1=stick(#STICK_LY) stvx2=stick(#STICK_RX):stvy2=stick(#STICK_RY) end '======================================= ' グラフィック画面への文字表示(ややプロポーショナル) '======================================= def gtext x,y,t$,c,b var i=0,o,w var c$ while i<len(t$) c$=mid$(t$,i,1):i=i+1 chkprop c$ out o,w gputchr x+o,y,c$,c if b then gputchr x+(o div 2 ),y,c$,c:x=x+1 x=x+w wend end '--- def chkprop c$ out o,w o=-1:w=6 if c$==" " then o=-2:w=4 if c$=="(" || c$==")" then o=-2:w=4 if c$=="." || c$=="," || c$==":" then o=-2:w=4 if c$=="i" || c$=="l" then o=-2:w=4 if c$=="I" then w=5 end '======================================= ' make font '======================================= def makeFont var i,c,ox,oy,x,y var img[8*8] fontdef gpage 0,-1 for i=&H20 to &H7F ox=(i mod 64)*8:oy=(i div 64)*8 gsave ox,oy,8,8,img for y=0 to 7 for x=6 to 0 step -1 if img[x+y*8] then img[x+1+y*8]=img[x+y*8] next next gload ox,oy,8,8,img,1 next gpage 0,0 end '======================================= ' set sound effect '======================================= def seSet no var ch,v '--- if no>=max_dtmml then return '--- for ch=0 to max_sndch-1 if mml$[ch]!="" then continue '--- set new se mml$[ch]=dt_mml$[no] se[ch,se_pos]=0 se[ch,se_deftime]=dt_len[2] 'L4 se[ch,se_time]=0 se[ch,se_defvol]=200 se[ch,se_vol]=se[ch,se_defvol] se[ch,se_xfrq]=0 break next end '--- def seOpen var ch,v for ch=0 to max_sndch-1 for v=0 to se_valmax-1 se[ch,v]=0 next mml$[ch]="" next end '--- def seClose var ch,v for ch=0 to max_sndch-1 synthVol ch,0 for v=0 to se_valmax-1 se[ch,v]=0 next next end '--- mml sequencer def seUpdate var ch,tm,frq,vol,pos for ch=0 to max_sndch-1 '--- use? if mml$[ch]=="" then continue '--- time tm=se[ch,se_time] pos=se[ch,se_pos] if !tm then '--- end? if pos>=len(mml$[ch]) then synthVol ch,0:mml$[ch]="":continue endif '--- mmlScan ch else '--- se[ch,se_time]=tm-1 '--- test( f&v down) frq=max(0,se[ch,se_frq]+se[ch,se_xfrq]) se[ch,se_frq]=frq vol=max(0,min(255,se[ch,se_vol]-1)) se[ch,se_vol]=vol endif '--- output frq=se[ch,se_frq] vol=se[ch,se_vol] synthFrq ch,frq synthVol ch,vol '--- next end '======================================= ' scan MML '======================================= def mmlScan ch '--- var c$,m$=mml$[ch] var p=se[ch,se_pos] var f=se[ch,se_frq] var l=se[ch,se_deftime] var v=se[ch,se_vol] var a,n '--- scan loop while 1 '--- command c$=mid$(m$,p,1):p=p+1 a=asc(c$) and &HDF 'to BIG '--- note? if a>=asc("A") && a<=asc("G") then f=440.0*pow(2.0,(dt_note[a-asc("A")]-69)/12.0) break endif '--- check command if a==asc("L") then '--- length getNumber m$,p out n,p if n==1 then l=dt_len[0] if n==2 then l=dt_len[1] if n==4 then l=dt_len[2] if n==8 then l=dt_len[3] if n==16 then l=dt_len[4] se[ch,se_deftime]=l elseif a==asc("X") then '--- effect-frq getNumber m$,p out n,p se[ch,se_xfrq]=n endif wend '--- se[ch,se_frq]=f se[ch,se_vol]=v se[ch,se_time]=l se[ch,se_pos]=p end '======================================= ' get number from strings '======================================= def getNumber m$,p out _n,_p var i=0,s=1 var c$=mid$(m$,p,1) '--- sign if c$=="+" || c$=="-" then if c$=="-" then s=-1 p=p+1:c$=mid$(m$,p,1) endif '--- _n=0 while c$>="0" && c$<="9" p=p+1:i=i+asc(c$)-asc("0"):_n=i*s c$=mid$(m$,p,1) if c$<"0" || c$>"9" then break i=i*10 wend _p=p end '======================================= ' sound synthesizer '======================================= def synthFrq ch,f var R%=5592.4*f sound ch*8+3,(R%>>24) and 255 sound ch*8+2,(R%>>16) and 255 sound ch*8+1,(R%>> 8) and 255 sound ch*8+0,R% and 255 end '--- def synthVol ch,v sound ch*8+4,v end