' ' ファイルリストを作るサンプルプログラム (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