構文解析の第一歩
1980年代に F-BASIC の MML を移調するために作った XPOSE.BAS というプログラムを PC-BASIC 上で動作するように直しました。
実行結果
変換元ファイル (source) と変換先ファイル (destination) 、半音でどれくらい移調するかを指定します。
以下の例では 12 を指定し、１オクターブ高くしています。マイナスで低くなります。
PC-BASIC 1.2.14
(C) Copyright 2013--2018 Rob Hagemans.
60300 Bytes free
chdir"onedrive\documents\basic\music
Ok
run"xpose
Source? usagi.bas
Destination? scrn:
Shift #? 12
10 'USAGI for PC-BASIC
20 '(C) 2020 N.Takahashi / MIT License
30 '
40 ' u sagi u sagi nanimite haneru
50 PLAY "T68 O5F4A8A8 B8A8B4 F8F8F8A8 B8A8B4"
60 ' juu goya o tsuki san
70 PLAY "A8B9O6C8C8 O5B8A16A16F8E8"
80 ' miteha ne ru
90 PLAY "A8F8E4 F8E8D4 E4P4"
Ok
ソース
expand source をクリックするとソースを展開します。元に戻すにはブラウザの再読み込みボタンを押してください。
XPOSE.BAS
1986年に F-BASIC 向けに作成したものを、PC-BASIC のためにエラー番号を修正しました。
- 5行目：関数を定義するサブルーチンを呼び出します。
- 6行目：変数を初期かするサブルーチンを呼び出します。
- 15行目：ソースの行を構文解析し MML (Music Macro Language) があれば移調するサブルーチンを呼び出します。
- 22行目：
ERR=62 は PC-BASIC の Input past end（ファイルの全てのデータを読んだ後に INPUT 文を実行した）ですが、F-BASIC では ERR=54 でした。
1000 'XPOSE - Transpose Chord for MML
1010 ' (C) 1986 N.Takahashi
1020 '
1030 'main --------------------------------------------------------------------
1040 GOSUB 2310 'define functions
1050 GOSUB 2480 'initialize variables
1060 ON ERROR GOTO 1200
1070 OPEN "I",#1,SRC$
1080 OPEN "O",#2,DST$
1090 WHILE TRUE
1100 LINE INPUT #1,L$
1110 'PRINT : PRINT L$
1120 IF L$="." THEN 1170
1130 L2$=""
1140 GOSUB 1250 'parse line
1150 PRINT #2,L2$
1160 WEND
1170 CLOSE #1
1180 CLOSE #2
1190 END
1200 '
1210 IF ERR=4 OR ERR=62 THEN RESUME 1170
1220 ON ERROR GOTO 0
1230 ERROR ERR
1240 END
1250 'parse line --------------------------------------------------------------
1260 P=1 : P1=P : PART=0
1270 GOSUB 2000 'skip space
1280 GOSUB 2150 : GOSUB 2220 'skip line number
1290 GOSUB 2060 'skip word
1300 IF W$<>"DATA" AND W$<>"PLAY" AND W$<>"PLAY@" THEN 1450 'not MML
1310 GOSUB 2000 'skip space
1320 WHILE P<=LEN(L$) AND MID$(L$,P,1)=QUOTE$
1330 P1=P1+1 : L2$=L2$+QUOTE$ : P2=P2+1 : P=P1
1340 PART=PART+1
1350 GOSUB 1470 'parse MML
1360 IF P>LEN(L$) THEN 1440
1370 IF MID$(L$,P,1)<>QUOTE$ THEN GOSUB 2250 : GOTO 1450 'error
1380 P1=P1+1 : L2$=L2$+QUOTE$ : P2=P2+1 : P=P1
1390 GOSUB 2000 'skip space
1400 IF P>LEN(L$) THEN 1440
1410 IF MID$(L$,P,1)<>"," THEN GOSUB 2250 : GOTO 1450 'error
1420 P1=P1+1 : L2$=L2$+"," : P2=P2+1 : P=P1
1430 GOSUB 2000 'skip space
1440 WEND
1450 GOSUB 1970 'skip to end of line
1460 RETURN
1470 'parse MML ---------------------------------------------------------------
1480 WHILE P<=LEN(L$) AND MID$(L$,P,1)<>QUOTE$
1490 GOSUB 1530 'skip neither note nor octave command
1500 GOSUB 1590 'replase note or octave command with shifting
1510 WEND
1520 RETURN
1530 'skip neither note nor octave command ------------------------------------
1540 WHILE P1<=LEN(L$) AND NOT FN NOP(MID$(L$,P1,1)) AND MID$(L$,P1,1)<>QUOTE$
1550 P1=P1+1
1560 WEND
1570 IF P1>P THEN L2$=L2$+MID$(L$,P,P1-P) : P2=P2+P1-P : P=P1
1580 RETURN
1590 'replase note or octave command with shifting ----------------------------
1600 IF P>LEN(L$) THEN RETURN
1610 C$="" : C2$=""
1620 GOSUB 1890 : IF P1>P THEN 1720 'get octave
1630 GOSUB 1750 : IF P1=P THEN 1740 'get note
1640 M=N+(O(PART)-1)*12 'calc special note number M
1650 M2=M+S 'shift
1660 IF M2<1 OR M2>96 THEN GOSUB 2250 'error
1670 N2=((M2-1) MOD 12)+1 : O2=((M2-1) \ 12)+1 'calc note N2 and octave O2
1680 IF O2(PART)<>O2 THEN O2(PART)=O2 : C2$="O"+FN ST$(O2)
1690 NS2$=FN NS$(N2)
1700 IF MID$(NS2$,2)=" " THEN NS2$=LEFT$(NS2$,1)
1710 C2$=C2$+NS2$
1720 IF P1>P THEN L2$=L2$+C2$ : P2=P2+LEN(C2$) : P=P1
1730 'PRINT PART,C$,C2$
1740 RETURN
1750 'get note ----------------------------------------------------------------
1760 N$=""
1770 IF P1<=LEN(L$) AND FN NP(MID$(L$,P1,1)) THEN N$=MID$(L$,P1,1) : P1=P1+1
1780 C$=C$+N$
1790 N=FN N(N$)
1800 IF N$<>"" THEN GOSUB 1820 'get sharp or flat
1810 RETURN
1820 'get sharp or flat -------------------------------------------------------
1830 S$=""
1840 IF P1<=LEN(L$) AND FN SP(MID$(L$,P1,1)) THEN S$=MID$(L$,P1,1) : P1=P1+1
1850 C$=C$+S$
1860 IF S$="#" OR S$="+" THEN N=N+1
1870 IF S$="-" THEN N=N-1
1880 RETURN
1890 'get octave --------------------------------------------------------------
1900 O$=""
1910 IF FN OP(MID$(L$,P1,1)) THEN O$=MID$(L$,P1,1) : P1=P1+1
1920 C$=C$+O$
1930 IF O$=">" THEN O(PART)=O(PART)+1
1940 IF O$="<" THEN O(PART)=O(PART)-1
1950 IF O$="O" OR O$="o" THEN P1S=P1 : GOSUB 2150 : IF P1S=P1 THEN O(PART)=4 ELSE O(PART)=N : C$=C$+FN ST$(N)
1960 RETURN
1970 'skip to end of line -----------------------------------------------------
1980 P1=P1+LEN(MID$(L$,P))
1990 IF P1>P THEN L2$=L2$+MID$(L$,P) : P2=P2+P1-P : P=P1
2000 'skip space --------------------------------------------------------------
2010 WHILE P1P THEN L2$=L2$+SPACE$(P1-P) : P2=P2+P1-P : P=P1
2050 RETURN
2060 'skip word ---------------------------------------------------------------
2070 GOSUB 2000 'skip space
2080 W$=""
2090 WHILE P1P THEN L2$=L2$+W$ : P2=P2+LEN(W$) : P=P1
2140 RETURN
2150 'get number from L$ into N -----------------------------------------------
2160 N=0
2170 WHILE P1P THEN L2$=L2$+FN ST$(N) : P2=P2+LEN(FN ST$(N)) : P=P1
2240 RETURN
2250 'error in P -------------------------------------------------------------
2260 PRINT L$
2270 W$=STRING$(LEN(L$)," ")
2280 MID$(W$,P,1)="^"
2290 PRINT W$
2300 RETURN
2310 'define functions -------------------------------------------------------
2320 TBLN$="CcDdEeFfGgAaBb"
2330 TBLNO$="Oo<>CcDdEeFfGgAaBb"
2340 TBLO$="Oo<>"
2350 TBLN2$="Cc Dd EeFf Gg Aa Bb"
2360 TBLN3$="C C+D D+E F F+G G+A A+B "
2370 TBLS$="#+-"
2380 DEF FN NOP(C$)=(INSTR(TBLNO$,C$)>0)
2390 DEF FN OP(C$)=(INSTR(TBLO$,C$)>0)
2400 DEF FN NP(C$)=(INSTR(TBLN$,C$)>0)
2410 DEF FN N(C$)=(INSTR(TBLN2$,C$)+1)\2
2420 DEF FN DP(C$)=(C$>="0" AND C$<="9")
2430 DEF FN SP(C$)=(INSTR(TBLS$,C$)>0)
2440 DEF FN NS$(N)=MID$(TBLN3$,N*2-1,2)
2450 DEF FN ST$(N)=MID$(STR$(N),2)
2460 DEF FN AP(C$)=(C$>="a" AND C$<="z")OR(C$>="A" AND C$<="Z")OR FN DP(C$)
2470 RETURN
2480 'initialize variables ---------------------------------------------------
2490 TRUE=1=1
2500 QUOTE$=CHR$(34)
2510 O(1)=4 : O(2)=4 : O(3)=4
2520 O2(1)=4 : O2(2)=4 : O2(3)=4
2530 PART=1
2540 LINE INPUT "Source? ";SRC$ : IF SRC$="" THEN SRC$="KYBD:"
2550 LINE INPUT "Destination? ";DST$ : IF DST$="" THEN DST$="SCRN:"
2560 LINE INPUT "Shift #? ";U$ : S=VAL(U$)
2570 RETURN
USAGI.BAS
今回テスト用に作った「うさぎ」の歌を演奏するプログラムです。
- 5行目：テンポ
T は F-BASIC、PC-BASIC で有効、Small Basic では無視されます。
- 9行目：F-BASIC や Small Basic では休符は
R でしたが PC-BASIC では P になります。間違えると Syntax error になります。
10 'USAGI for PC-BASIC
20 '(C) 2020 N.Takahashi / MIT License
30 '
40 ' u sagi u sagi nanimite haneru
50 PLAY "T68 O4F4A8A8 B8A8B4 F8F8F8A8 B8A8B4"
60 ' juu goya o tsuki san
70 PLAY "A8B9O5C8C8 O4B8A16A16F8E8"
80 ' miteha ne ru
90 PLAY "A8F8E4 F8E8D4 E4P4"
蛇足
今回紹介した XPOSE.BAS は、とても懐かしいプログラムです。大学祭で4台の FM-77 を授業で作成した通信用のコネクタでつなぎカルテットを行ったときに、調の合っていない
MML を移調するために作りました。
大学卒業後、NIFTY-Serve の FFMHOB ＜FMフォーラム3（ホビー館）＞に「MML移調ユーティリティ」として投稿したものです。
以下は当時の案内文で『NIFTY-Serve FMフォーラム フリーソフトウェア ガイドブック』にも掲載された内容です。
【ソ フ ト 名】 MML移調ユーティリティ
【登 録 名】 XPOS.ISH
【バ イ ト 数】 5289Bytes
【検 索 キ ー】 1:XPOSE 2:$FM7 3:#MUSIC 4:MML
【著 作 権 者】 高橋 信貴(NONKEY) GAH01412
【対 応 機 種】 FM-7系(F-BASIC V3.0)
【動 作 確 認】 FM-7、FM-77
【開 発 言 語】 F-BASIC V3.0
【公 開 日】 90/09/16
【ｿﾌﾄｳｪｱ 種 別】 フリーソフトウェア
----------------------------------------------------------------------
【ソフト紹介】
F-BASICのMML(Music Macro Language)を移調(半音上げたり、何音か下げたり…)する
ためのユーティリティ・プログラムです。
本プログラムではASCIIセーブされたF-BASICプログラムのPLAY文とDATA文のMMLを認
識し移調するようになっています。
Copyright © 2020 たかはしのんき. All rights reserved.