X68000 ZのMicroPythonで、ひとコマアニメーションアプリ「まいくろえほん」を作成しました。（Python版の作成記事はこちら）。それを X-BASICに移植したので報告。X-BASICの特長、ノウハウも書きました。
ひとコマアニメーションとは
- 2018年キッズプラザ大阪コンピュータ工房で開発された、アニメ制作手法です。１コマ絵を描くだけで、ホワイトボードアニメーションが作れます。出典はこちら。OnePというXMLフォーマットで保存されます。
幼稚園の子供でもできるので、キッズプラザ大阪では、毎日 150-200本のひとコマアニメーションが作られています。
X-BASIC にする理由
ひとコマアニメーションを、X68000 Z の MicroPython で作成したところ、動作速度がやや遅いです。そこで、X-BASIC で書き直すことにしました。X-BASIC は C に変換し、コンパイルできるので、かなり速く動くはずです。
X-BASIC の制限
ただ、MicroPython と比較して、以下の制限があります。
- 文字数が最大２５６文字
- テキスト画面に描画する命令がなく、ポップアップメニューの外枠が描けない
- マウスカーソルの色を設定する関数がない
- ドライブに保存されたファイルのリストを取得できない
解決方法
これについて、以下のようにしました。
- 文字は freads を使い、２５６文字ごとに処理する。下のソース 1140 func readNxt が続きの２５６文字を読み込む部分です。 境界の処理が完全ではない気がするけど、一応動いてます。
- テキスト画面の描画はあきらめて、文字反転でメニューを表示することにしました。
- 描画色はグラフィック画面左上に表示。
- ファイルのデータを読み出す機能はあきらめる。再生したいファイルを out.one という名前にして起動すれば、そのファイルを読み出して再生します。
X-BASIC版「まいくろえほん」 ソースリスト
ehon.bas
10 locate 0,0,0 /*Text Cursor OFF*/
20 screen 1,3,1,1 /*512x512x64kColor*/
30 mouse(4) /*SoftKeyboard OFF*/
40 mouse(1) /*Mouse Cursor ON*/
50 str SAVFILE="out.one"
60 str TMPFILE="out.###"
70 str ADDFILE="add.###"
80 str qu:qu=chr$(34) /*"*/
90 str cr:cr=chr$(13)+chr$(10)/*CRLF*/
100 int stIS = -1:int adp=0:int adf=-1
110 str strk(1000)[12] /* line (x,y)*/
120 str strc[256],getrgb /* line color*/
130 int sx0 = -999
140 int sy0 = -999
150 int wrH,wrS,wrV /*=128,31,15*/
160 int wrtCol=255
170 int wrtW=2 /* width */
180 dim int colHue(6) ={0,32,64,96,128,160,0} /*RYGCBMR*/
190 int pal,fp,wid,x,y,z,dx,dy,lbtn,rbtn,mx,my,brk,x0,y0,xx,yy,fw,fr
200 str ss[256],tt[256],mml[256],lin[256]
210 int mnOn,mh,mw,it,bt0
220 /*-------------------*/
230 int lenMenu =7
240 dim str menu(7)={"RYGCBMW","- %d +","- H +","- S +","- V +"," Run "," Quit "}
250 /*func=(fnRGBW ,fnWidth ,fnHue ,fnSat ,fnVal ,fnSaveRun,fnQuit)
260 /*-------------------*/
270 opm_init()
280 opm_alloc(1000)
290 m_tempo(200)
300 mml="@65A"
310 opm_trk(1)
320 mh=(lenMenu+1)*16
330 mw=0
340 for it=0 to lenMenu
350 if strlen(menu(it))>mw then mw=strlen(menu(it))
360 next
370 mw = mw*8
380 mx=100:my=100
390 mnOn=1
400 fnRun(0)
410 drawMenu(100,100)
420 bt0=0
430 while 1
440 mspos(x,y)
450 msstat(dx,dy,lbtn,rbtn)
460 if bt0=lbtn*2+rbtn then{
470 if mnOn=0 and lbtn<>0 then addPoint(x,y)
480 continue
490 }
500 if(adp>0) then addSave()
510 bt0=lbtn*2+rbtn
520 if rbtn<>0 then drawMenu(x,y)
530 if lbtn<>0 then{
540 if execMenu(x,y)>0 then continue
550 if mnOn then drawMenu(x,y)
560 addLine()
570 }
580 endwhile
590 input "End",sx0
600 mouse(0)
610 cls
620 end
630 /*
640 func setPal()
650 wrH=wrH mod 192:wrS=wrS mod 32:wrV=wrV mod 32
660 wrtCol=hsv(wrH,wrS,wrV)
670 drawMenu(0,0):drawMenu(mx,my)
680 endfunc
690 func fnRGBW(x;int)
700 wrV=31:wrS=31
710 if x/8<6 then{ wrH=colHue(x/8)
720 }else wrS=0
730 setPal()
740 endfunc
750 func fnHue(x;int)
760 if x/8<4 then{ wrH=(wrH-8) mod 192
770 }else wrH= (wrH+8) mod 192
780 setPal()
790 endfunc
800 func fnSat(x;int)
810 if x/8<4 then{ wrS=wrS-4
820 }else wrS=wrS+4
830 if wrS<0 then wrS=0
840 if wrS>31 then wrS=31
850 setPal()
860 endfunc
870 func fnVal(x;int)
880 if x/8<4 then{ wrV=wrV-4
890 }else wrV=wrV+4
900 if wrV<0 then wrV=0
910 if wrV>31 then wrV=31
920 setPal()
930 endfunc
940 /*
950 func int intHex(x;int)
960 y = asc(mid$(ss,x,1))-asc("0")
970 if y>=10 then y = y-(asc("A")-asc("9"))+1
980 if y>=10 then y = y-(asc("a")-asc("A"))
990 return(y)
1000 endfunc
1010 func int getPal()
1020 rr=intHex(1)*16+intHex(2)
1030 gg=intHex(3)*16+intHex(4)
1040 bb=intHex(5)*16+intHex(6)
1050 ret = ((gg shl 8) and &HF800) or ((rr shl 3) and &H7C0) or ((bb shr 2) and &H3E)
1060 return(ret)
1070 endfunc
1080 func getRGB(cc;int)
1090 rr=(cc and &H7C0)shr 3
1100 gg=(cc and &HF800)shr 8
1110 bb=(cc and &H3E)shl 2
1120 getrgb=right$("0"+hex$(rr),2)+right$("0"+hex$(gg),2)+ right$("0"+hex$(bb),2)
1130 endfunc
1140 func readNxt(ch;int)
1150 tt=mid$(lin,x,strlen(lin)-x+1)
1160 freads(lin,fp)
1170 y=instr(1,tt,qu)
1180 if y>0 then {
1190 ss=mid$(tt,1,y-1):y=0
1200 }else{
1210 y=instr(1,lin,chr$(ch))
1220 y2=instr(1,lin,qu)
1230 if y2>0 and y2<y then y=y2
1240 if y<=0 then{ ss=""
1250 return()}
1260 ss=tt+mid$(lin,1,y-1)
1270 }
1280 x=y+1
1290 if instr(1,lin,"<path")>0 then ss="nxt"
1300 endfunc
1310 func int drawLine()
1320 wid=1
1330 x=instr(1,lin,"width=")
1340 if x>0 then {
1350 y=instr(x+7,lin,qu) /*34=" 39='*/
1360 ss=mid$(lin,x+7,y-x-7)
1370 wid=int(val(ss)/2) }
1380 pal=15
1390 x=instr(1,lin,"stroke=")
1400 if x>0 then {
1410 y=instr(x+7,lin,"#")
1420 ss=mid$(lin,x+9,6)
1430 pal=getPal() }
1440 y=instr(1,lin,"d=")
1450 x=y+4: x0=-999:y0=-999
1460 while 1
1470 y=instr(x,lin,",")
1480 if y<=0 then{ readNxt(',')
1490 }else ss=mid$(lin,x,y-x)
1500 if ss="nxt" then return(2)
1510 if strlen(ss)=0 then return(0)
1520 xx=int(val(ss)):x=y+1
1530 y=instr(x,lin,"L")
1540 if y<=0 then{ readNxt('L')
1550 }else ss=mid$(lin,x,y-x)
1560 if ss="nxt" then return(2)
1570 if strlen(ss)=0 then return(0)
1580 yy=int(val(ss)):x=y+1
1590 if x0<>-999 or y0<>-999 then {
1600 m_play(1)
1610 if wid>8 then {
1620 circle(x0,y0,wid,pal,0,360,388)
1630 }else{
1640 line(x0,y0,xx-wid,yy,pal)
1650 if wid>0 then {
1660 line(x0,y0,xx,yy-wid,pal)
1670 line(x0,y0,xx+wid,yy,pal)
1680 line(x0,y0,xx,yy+wid,pal) }
1690 }
1700 }
1710 x0=xx:y0=yy
1720 msstat(dx,dy,lbtn,rbtn)
1730 if rbtn<>0 then return(1)
1740 endwhile
1750 endfunc
1760 func fnRun(x;int)
1770 wipe()
1780 error off
1790 fp=fopen(SAVFILE,"r"):brk=0
1800 if fp<>-1 then{
1810 repeat
1820 if brk=0 then freads(lin,fp)
1830 if instr(1,lin,"</page")>0 then break
1840 if instr(1,lin,"<path")>0 then {
1850 brk=drawLine()
1860 if brk=1 then break
1870 }
1880 until feof(fp)=-1
1890 fclose(fp)
1900 }
1910 drawMenu(mx,my)
1920 error on
1930 endfunc
1940 /*
1950 func int execMenu(x;int,y;int)
1960 if mnOn=0 or x<mx or x>mx+mw or y<my or y>my+mh then return(0)
1970 switch (y-my)/16
1980 case 0: fnRGBW(x-mx):break
1990 case 1: fnWidth(x-mx):break
2000 case 2: fnHue(x-mx):break
2010 case 3: fnSat(x-mx):break
2020 case 4: fnVal(x-mx):break
2030 case 5: fnSaveRun(x-mx):break
2040 case 6: fnQuit(x-mx):break
2050 endswitch
2060 return(1)
2070 endfunc
2080 /*
2090 func fnWidth(x;int)
2100 if x/8<4 then {
2110 if wrtW>=2 then {
2120 wrtW=wrtW/2 }
2130 }else{
2140 if wrtW<=32 then {
2150 wrtW=wrtW*2 }
2160 }
2170 drawMenu(0,0):drawMenu(mx,my)
2180 endfunc
2190 func fnQuit(x;int)
2200 drawMenu(0,0)
2210 fnSave(x)
2220 if adf<>-1 then fclose(adf)
2230 cls:mouse(0)
2240 exit(0)
2250 endfunc
2260 func opm_init()
2270 m_init()
2280 endfunc
2290 func opm_alloc(size;int)
2300 m_alloc(1,size) /*iocs(i.OPMDRV, 0x01, (1 << 16) | size)
2310 m_assign(1,1) /*iocs(i.OPMDRV, 0x02, (1 << 16) | 1) /*assign 1*/
2320 endfunc
2330 func int opm_free()
2340 ret = m_free(1)
2350 return(ret)
2360 endfunc
2370 func opm_trk(trk;int)
2380 m_trk(trk,mml)
2390 endfunc
2400 /*
2410 func drawMenu(x;int,y;int)
2420 if mnOn>0 then {
2430 mnOn=0:cls
2440 return()
2450 }
2460 if x+mw>511 then x=511-mw
2470 if y+mh>511 then y=511-mh
2480 mnOn=1:mx =x-(x mod 8):my = y-(y mod 16)
2490 circle(32,32,32,0,0,360,388):paint(32,32,0)
2500 wid=wrtW/2:if wid<2 then wid=2
2510 circle(32,32,wid,wrtCol,0,360,388):paint(32,32,wrtCol)
2520 y= my/16
2530 for it=0 to lenMenu
2540 locate mx/8,y:color 11
2550 if it=1 then {
2560 print "-";right$(" "+str$(wrtW),3);" +"
2570 }else print menu(it)
2580 y=y+1: z=z+1:color 3
2590 next
2600 endfunc
2610 func addLine()
2620 if adf=-1 then adf=fopen(ADDFILE,"c")
2630 adp=0:getRGB(wrtCol)
2640 strc=" <path stroke="+qu+"#"+getrgb+qu +" width="+qu+str$(wrtW)+qu+" d="+qu
2650 stIS = stIS+1
2660 sx0=-999:sy0=-999
2670 endfunc
2680 func addPoint(x;int,y;int)
2690 if abs(x-sx0)<3 and abs(y-sy0)<3 then return()
2700 if adp = 0 then{
2710 strk(adp)="M"+str$(x)+","+str$(y):adp=adp+1
2720 }else if adp<1000 then {
2730 strk(adp)="L"+str$(x)+","+str$(y):adp=adp+1
2740 m_play(1):wid=wrtW/2
2750 if wid>8 then {
2760 circle(sx0,sy0,wid,wrtCol,0,360,388)
2770 }else{
2780 line(sx0,sy0,x-wid,y,wrtCol)
2790 line(sx0,sy0,x,y-wid,wrtCol)
2800 line(sx0,sy0,x+wid,y,wrtCol)
2810 line(sx0,sy0,x,y+wid,wrtCol)
2820 }
2830 }
2840 sx0=x:sy0=y
2850 endfunc
2860 func addSave()
2870 if adp>1 then{
2880 fwrites(strc,adf)
2890 for it=0 to adp-1
2900 fwrites(strk(it),adf)
2910 next
2920 ss=qu+"/>"+cr
2930 fwrites(ss,adf)
2940 }
2950 adp=0
2960 endfunc
2970 func fnSaveRun(x;int)
2980 drawMenu(0,0) /*menu off*/
2990 fnSave(x)
3000 fnRun(x)
3010 endfunc
3020 func fnSave(x;int)
3030 if adf=-1 then return()
3040 error off
3050 fclose(adf): adf=-1
3060 fw = fopen(TMPFILE,"c")
3070 ss="<?xml version="+qu+"1.0"+qu+" encoding="+qu+"UTF-8"+qu+" standalone="+qu+"yes"+qu+"?>"+cr
3080 fwrites(ss,fw)
3090 ss="<onep viewBox="+qu+"0 0 512 512"+qu+">"+cr: fwrites(ss,fw)
3100 ss="<page>"+cr: fwrites(ss,fw)
3110 wrt=0
3120 fr = fopen(SAVFILE,"r")
3130 if fr<>-1 then {
3140 repeat
3150 freads(lin,fr)
3160 if instr(1,lin,"</page")>0 then break
3170 if wrt>0 then{ fwrites(lin,fw)
3180 if instr(1,lin,"/>")>0 then fwrites(cr,fw)
3190 }
3200 if instr(1,lin,"<page")>0 then wrt=1
3210 until feof(fr)=-1: fclose(fr)
3220 }
3230 fr = fopen(ADDFILE,"r")
3240 if fr<>-1 then {
3250 repeat
3260 freads(lin,fr):fwrites(lin,fw)
3270 if instr(1,lin,"/>")>0 then fwrites(cr,fw)
3280 until feof(fr)=-1
3290 fclose(fr)
3300 }
3310 ss="</page>"+cr:fwrites(ss,fw)
3320 ss="</onep>"+cr:fwrites(ss,fw)
3330 fclose(fw)
3340 fdelete(SAVFILE)
3350 frename(TMPFILE,SAVFILE)
3360 error on
3370 endfunc
実行結果
C コンパイルしなくても、MicroPython より速くなりました。C コンパイルするとさらに速くなりました
X-BASIC に関するメモ
移植時にひっかかった点をまとめます
- 文字は最大２５６文字
- さいしょに型宣言が必要。
- 文字宣言は str a[10] か str a="abcde"。一度宣言すると文字数は変更できない
- 初期値は定数しかいれられない。マルチステートメントが使える。str qu:qu=chr$(34)
- 引用符はchr$(34)を使う、chr$(34)+"abc"+chr$(34)
- 関数の return は、値を返さない場合でも return() とかっこが必要
- printにはかっこをつけない。; で区切ると空白がはいらない。
- 関数の引数に文字(;str)は使わないほうがよい。おちるときがあった。引数用の文字をきめとくとよい。
- 関数の引数の型は、func int xyz(x;int, y;int) のように書く。
- ファイル読み出し、fopen("xxx","r") はファイルがないとエラーになる。
error off, error on ではさむとよい - 行番号だけではエラーになる。300 /* としないといけない。コメント /* の後ろに */は不要
- FM音源のBASIC命令をCコンパイルするには、OPMDRV3.X が必要。新しい X68k用ゲームの中から取得した。
デバック手順
以下の手順がよいみたいです
- 行番号つきソースコードは、ed で作成
- basic xxx.bas でひとまず実行
- エラーがでたら、basic の中で、load "xxx.bas" を実行。エラー箇所まで読み込まれる
- list で最後の行番号をメモ。system で終了
- ed で、メモした行を検索し、その行、または、その次の行を修正する。
- よくあるエラーは、行番号の順番が前後している、行番号のない行があった、行番号はついていたが/* がかかれていなかった、if の後ろに then がなかったなど・・・