X-BASICで、ひとコマアニメーション

[X68000 Z](https://www.zuiki.co.jp/x68000z/)の[MicroPython](https://dnjiro.hatenablog.com/entry/micropython)で、ひとコマアニメーションアプリ「まいくろえほん」を作成しました。[（Python版の作成記事はこちら）](https://qiita.com/danjiro/items/31280c6b6ad4d2716749)。それを X-BASICに移植したので報告。X-BASICの特長、ノウハウも書きました。

# ひとコマアニメーションとは

- 2018年[キッズプラザ大阪コンピュータ工房](https://www.kidsplaza.or.jp/gallery/2020/000405/)で開発された、アニメ制作手法です。１コマ絵を描くだけで、[ホワイトボードアニメーション](https://tsuta-world.com/lp/vau/whiteboard_anime/)が作れます。[出典はこちら](https://9vae.blogspot.com/p/blog-page_15.html)。[OnePというXMLフォーマット](https://qiita.com/danjiro/items/31280c6b6ad4d2716749)で保存されます。

![1koma-mac.gif](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/67734/7bdbd338-1cfb-5453-7edc-bcb3a43b2999.gif)

幼稚園の子供でもできるので、[キッズプラザ大阪](https://www.kidsplaza.or.jp/gallery/2020/000405/)では、毎日 150-200本のひとコマアニメーションが作られています。

# X-BASIC にする理由

ひとコマアニメーションを、X68000 Z の MicroPython で作成したところ、動作速度がやや遅いです。そこで、X-BASIC で書き直すことにしました。X-BASIC は C に変換し、コンパイルできるので、かなり速く動くはずです。

# X-BASIC の制限

ただ、MicroPython と比較して、以下の制限があります。
1. 文字数が最大２５６文字
1. テキスト画面に描画する命令がなく、ポップアップメニューの外枠が描けない
1. マウスカーソルの色を設定する関数がない
1. ドライブに保存されたファイルのリストを取得できない

# 解決方法

これについて、以下のようにしました。

1. 文字は freads を使い、２５６文字ごとに処理する。下のソース 1140 func readNxt が続きの２５６文字を読み込む部分です。 境界の処理が完全ではない気がするけど、一応動いてます。
1. テキスト画面の描画はあきらめて、文字反転でメニューを表示することにしました。
1. 描画色はグラフィック画面左上に表示。
1. ファイルのデータを読み出す機能はあきらめる。再生したいファイルを 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 コンパイルするとさらに速くなりました

![basic.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/67734/5915b527-5de9-5694-d4e5-4df3f68c55d5.png)




# 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") はファイルがないとエラーになる。<br>error off, error on ではさむとよい
-  行番号だけではエラーになる。300 /* としないといけない。コメント /* の後ろに */は不要
-  FM音源のBASIC命令をCコンパイルするには、OPMDRV3.X が必要。新しい X68k用ゲームの中から取得した。

## デバック手順

以下の手順がよいみたいです

1. 行番号つきソースコードは、ed で作成
1. basic xxx.bas でひとまず実行
1. エラーがでたら、basic の中で、load "xxx.bas" を実行。エラー箇所まで読み込まれる
1. list で最後の行番号をメモ。system で終了
1. ed で、メモした行を検索し、その行、または、その次の行を修正する。

- よくあるエラーは、行番号の順番が前後している、行番号のない行があった、行番号はついていたが/* がかかれていなかった、if の後ろに then がなかったなど・・・