LoginSignup
2
0
この記事誰得？ 私しか得しないニッチな技術で記事投稿！
@danjiro(Danjiro Daiwa)

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

Last updated at Posted at 2023-07-15

X68000 ZのMicroPythonで、ひとコマアニメーションアプリ「まいくろえほん」を作成しました。（Python版の作成記事はこちら）。それを X-BASICに移植したので報告。X-BASICの特長、ノウハウも書きました。

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

1koma-mac.gif

幼稚園の子供でもできるので、キッズプラザ大阪では、毎日 150-200本のひとコマアニメーションが作られています。

X-BASIC にする理由

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

X-BASIC の制限

ただ、MicroPython と比較して、以下の制限があります。

  1. 文字数が最大２５６文字
  2. テキスト画面に描画する命令がなく、ポップアップメニューの外枠が描けない
  3. マウスカーソルの色を設定する関数がない
  4. ドライブに保存されたファイルのリストを取得できない

解決方法

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

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

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用ゲームの中から取得した。

デバック手順

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

  1. 行番号つきソースコードは、ed で作成
  2. basic xxx.bas でひとまず実行
  3. エラーがでたら、basic の中で、load "xxx.bas" を実行。エラー箇所まで読み込まれる
  4. list で最後の行番号をメモ。system で終了
  5. ed で、メモした行を検索し、その行、または、その次の行を修正する。
  • よくあるエラーは、行番号の順番が前後している、行番号のない行があった、行番号はついていたが/* がかかれていなかった、if の後ろに then がなかったなど・・・
2
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
2
0