やってたら面白くなってしまって、少しソースが長いですが遊んでみました。
※Dキーでデモソング再生します。
#module
#uselib "winmm.dll"
#func midiOutOpen "midiOutOpen" int, int, int, int, int
#func midiOutClose "midiOutClose" int
#func midiOutShortMsg "midiOutShortMsg" int, int
#func midiOutLongMsg "midiOutLongMsg" int, int, int
#func midiOutPrepareHeader "midiOutPrepareHeader" int, int, int
#func midiOutUnprepareHeader "midiOutUnprepareHeader" int, int, int
#deffunc miopen
midiOutOpen varptr(hmo), 0, 0, 0, 0 : return
#deffunc miclose onexit
if hmo != 0 { midiOutClose hmo } : return
#deffunc mimsg int _msg
midiOutShortMsg hmo, _msg : return
#deffunc milmsg str _msg
dim mhmidi, 16 : hex2bin data, _msg : len = stat
mhmidi.0 = varptr(data), len, len
midiOutPrepareHeader hmo, varptr(mhmidi), varsize(mhmidi)
midiOutLongMsg hmo, varptr(mhmidi), varsize(mhmidi)
repeat : wait 0 : if mhmidi.4&1 { break } : loop
midiOutUnprepareHeader hmo, varptr(mhmidi), varsize(mhmidi)
return
#define ctype msg(%1,%2,%3) (%1)|((%2)<<8)|((%3)<<16)
#defcfunc note int _ch, int _nn, int _vel
if _vel = 0 { return msg($80+_ch, _nn, 64) }
return msg($90+_ch, _nn, _vel)
#defcfunc pc int _ch, int _pn
return msg($C0+_ch, _pn, 0)
#defcfunc cc int _ch, int _cn, int _data
return msg($B0+_ch, _cn, _data)
#defcfunc vol int _ch, int _data
return msg($B0+_ch, $07, _data)
#defcfunc pan int _ch, int _data
return msg($B0+_ch, $0A, _data)
#defcfunc pitch int _ch, int _bend
data = limit(_bend+8192, 0, 16383)
return msg($E0+_ch, /*lsb*/data&$7F, /*msb*/data>>7)
#deffunc partmode int _ch, int _mode; 0:melody, 1:Drum
tmp=17,18,19,20,21,22,23,24,25,16,26,27,28,29,30,31
milmsg strf("F04110421240%02X15%02X%02XF7", tmp(_ch), _mode, ($2B-_mode)-tmp(_ch))
return
#deffunc hex2bin var _bin, str _hex
hex = _hex : len = strlen(_hex)/2 : sdim _bin, len
repeat len : poke _bin, cnt, int("$"+strmid(hex, cnt*2, 2)) : loop
return len
#deffunc miallstop
repeat 16 : mimsg cc(cnt, $78, 0) : loop : return
#deffunc instruments array _p
repeat 16 : mimsg pc(cnt, _p(cnt)) : loop : return
#deffunc volumes array _p
repeat 16 : mimsg vol(cnt, _p(cnt)) : loop : return
#deffunc panpots array _p
repeat 16 : mimsg pan(cnt, _p(cnt)) : loop : return
#deffunc partmodes array _p
repeat 16 : partmode cnt, _p(cnt) : loop : return
#deffunc misetup array _part, array _inst, array _vol, array _pan
milmsg "F04110421240007F0041F7"; gs_reset
partmodes _part : instruments _inst : volumes _vol : panpots _pan
return
#global
miopen
; 初期化 -----------------------------------------
screen 0,1024,704 : onclick *L_ONCLICK : onkey *L_ONKEY
transport = /*play*/1, /*click*/1
dim notes, 16, 128 : dim legatos, 16, 128 : sdim file, 2048
; メイン -----------------------------------------
*MAIN
; エディット
mw=mousew : ch = limit(ch+(mw<0) - (mw>0), 0, 15); チャンネル
cn = limit(108-mousey/8,21,108) : ct = mousex/8 ;ノート
title strf("ロケーター:%3d, 位置:%3d, チャンネル:%2d, ノートNo.:%3d",cl,ct,ch,cn)
; midi再生
if transport {
if transport.1 { if cl\16=0 { mimsg note(9, 34, 64) } : if cl\4=0 { mimsg note(9, 33, 64) } }
repeat 16
_cl = (cl+127)\128 : nn = notes(cnt,cl) : _nn = notes(cnt,_cl)
if nn = 0 { mimsg note( cnt, _nn, 0) : continue }
if legatos(cnt,_cl) {
if nn!=_nn { mimsg note( cnt, nn, 100) }
} else {
mimsg note( cnt, _nn, 0) : mimsg note( cnt, nn, 100)
}
loop
}
; 描画
redraw 0 : rgbcolor $AAAAAA : boxf
; 88鍵盤(21~108)
repeat 88
if ($54A>>((21+cnt)\12))&1 { rgbcolor $DDDDDD } else { rgbcolor $FFFFFF }
_y = ginfo_sy-8-cnt*8 : boxf 0, _y, ginfo_sx, _y+6
loop
; 8小節16分音符
repeat 128
if cnt\16 { rgbcolor $AAAAAA } else { rgbcolor $555555 }
line cnt*8, 0, cnt*8,ginfo_sy
loop
; ノーツ
repeat 16: if cnt=ch {continue}: ich=cnt : repeat 128: ict=cnt
if notes(ich,ict) = 0 { continue }
_col = ich*11: _x = ict*8 : _y = ginfo_sy-8-(notes(ich,ict)-21)*8
hsvcolor _col,128,224 : boxf _x+2, _y+1, _x+6, _y+5
if legatos(ich,ict) = 0 { continue }
hsvcolor _col,128,224 : boxf _x+2, _y+1, _x+10, _y+5
loop : loop
repeat 128: ict=127-cnt
if notes(ch,ict) = 0 { continue }
_col = ch*11: _x = ict*8 : _y = ginfo_sy-8-(notes(ch,ict)-21)*8
hsvcolor _col,224,128 : boxf _x, _y, _x+8, _y+6
hsvcolor _col,128,224 : boxf _x+1, _y+1, _x+7, _y+5
if legatos(ch,ict) = 0 { continue }
boxf _x+1, _y+1, _x+9, _y+5
loop
; ロケーター
_x = ct*8 : rgbcolor $333333 : line _x, 0, _x, ginfo_sy
_x = cl*8 : rgbcolor $333333 : boxf _x-1, 0, _x+1, ginfo_sy : rgbcolor $FFFFFF : line _x, 0, _x, ginfo_sy
redraw 1
; ティック
if transport { cl=(cl+1)\128 }
*L_WAIT
await 90;仮デルタタイム
goto *MAIN
*L_ONCLICK
if wparam = /*LC*/1 { legatos(ch,ct)^=(notes(ch,ct)!=0)&(notes(ch,(ct+1)\128)!=0) : notes(ch,ct) = cn }
if wparam = /*MC*/16 { cl = (ct+127)\128 : miallstop}
if wparam = /*RC*/2 { notes(ch,ct) = 0 : legatos(ch,ct) = 1 }
goto *L_WAIT
*L_ONKEY
logmes ""+wparam
if wparam = /*D */68 { gosub *L_DEMO_SONG }
if wparam = /*N */78 { gosub *L_NEW }
if wparam = /*S */83 { gosub *L_SAVE }
if wparam = /*0 */79 { gosub *L_LOAD }
if wparam = /*SP*/32 { transport^=1 }
if wparam = /*C */67 { transport.1^=1 }
if wparam = /*←*/37 { cl=limit(cl-16,0,127) }
if wparam = /*→*/39 { cl=limit(cl+16,0,127) }
if wparam = /*↑*/38 | wparam = /*↓*/40 { ch = limit(ch-(39-wparam), 0, 15) }
miallstop
goto *L_WAIT
*L_NEW
memset notes, 0, varsize(notes) : memset legatos, 0, varsize(legatos)
return
*L_SAVE
repeat 2048
ich=cnt/128 : ict=cnt\128
poke file, cnt, (legatos(ich, ict)<<7) | notes(ich, ict)
loop
bsave "song.dat", file, 2048
return
*L_LOAD
bload "song.dat", file, 2048
*L_LOAD_2
repeat 2048
d = peek(file, cnt) : ich=cnt/128 : ict=cnt\128
notes(ich, ict) = d&$7F : legatos(ich, ict) = d>>7
loop
return
*L_DEMO_SONG
; デモソング用 ======================================================================================================================
; melo fx lyr bs sub chd chd chd chd kick sn&cy hat s&cl sql sqr
; 音源 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
parts = 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0
insts = $0A, $0A, $5B, $27, $25, $5F, $5F, $5F, $5F, $00, $19, $19, $00, $50, $50, $00
vols = $65, $45, $34, $4F, $5F, $45, $45, $45, $45, $7F, $70, $55, $60, $44, $34, $7F
pans = $40, $40, $40, $40, $40, $00, $7F, $00, $7F, $40, $40, $40, $40, $10, $6F, $40
misetup parts, insts, vols, pans
s ="0FDVVdBQ11cAAACA0FDVVdBQ11fVVQAAAAAAAAAAAADQUNVV11fZWYAA1VUAANJS01PSUtBQ0tLS0tJSAAAAANBQ1VXQUNdXAAAAANBQ1VXQUNdX1VUAANxc1VXQUNhY"
s+="2dnZ2dlZ2NjY2NhY19fX19dXAACAgNBQ1VXXV9VVAAAAANBQ1VXQUNdXAAAAANBQ1VXQUNdX1VUAAAAAAAAAAAAA0FDVVddX2VkAANVVAADSUtNT0lLQUNLS0tLSUgAA"
s+="AADQUNVV0FDXVwAAAADQUNVV0FDXV9VVAADcXNVV0FDYWNnZ2dnZWdjY2NjYWNfX19fXVwAAAADQUNVV11fVVcREyUnERMtLAAAAAMREy0vERMtLyUkAAAAAAAAAAAAA"
s+="xETJSctLzU0AAMlJAADGRsdHxkbERMbGxsbGRgAAAADERMlJxETLSwAAAADERMlJxETLS8lJAADQUMlJxETMTM3Nzc3NTczMzMzMTMvLy8vLy8tLAADERMlJy0vJSQAA"
s+="qqqqqqqqqiqAgKoqgACpqampqampqakpAAAAAKmpqSmurq6urq6uLgAAri4AAKysrKysrKysrCwAAAAArKysLKqqqqqqqqoqAACqKgAAqampqampqampKQAAAACtra0t"
s+="rq6urq4ura2tra0trKysrKysrCwAAAAAsbGxsbGxsTGenp6enp6eHoAAnh6AAJ2dnZ2dnZ2dnR0AAAAAnZ2dHaKioqKioqIiAACiIgAAoCCgoKCgoKCgIAAAAACgoKAg"
s+="np6enp6enh4AAJ4eAACdnZ2dnZ2dnZ0dAAAAAKGhoSGioqKioiKhoaGhoSGgoKCgoKCgIAAAAAClpaWlpaWlJcnJycnJyclJAADJSQAAyMjISMhIyMjISAAAAADIyMhI"
s+="zc3NTc3NzU0AAM1NAADLy8vLy0vLy8tLgIAAAMvLy0vJyUnJyUnJSQAAyUkAAMjIyEjISMjIyEiAAAAAzMzMTM3Nzc3NTczMzMzMTMvLy8vLy8tLgAAAAMvLy8vLy8tL"
s+="xsbGxsbGxkYAAMZGAADFxcVFxUXFxcVFAAAAAMXFxUXJyclJycnJSQAAyUkAAMfHx8fHR8fHx0cAAAAAx8fHR8bGRsbGRsZGAADGRgAAxcXFRcVFxcXFRQAAAADIyMhI"
s+="ycnJyclJyMjIyMhIx8fHx8fHx0cAAAAAxsbGxsbGxsbExMTExMTERIAAxESAAMTExETERMTExEQAAAAAxMTERMjIyEjIyMhIAADISAAAxsbGxsZGxsbGRgAAAADGxsZG"
s+="xMRExMRExEQAAMREAADExMRExETExMREAAAAAMfHx0fIyMjIyEjHx8fHx0fGxsbGxsbGRgAAAADExMTExMTERMHBwcHBwcFBAADBQQAAv7+/P78/v7+/PwAAAAC/v78/"
s+="xMTERMTExEQAAMREAADCwsLCwkLCwsJCAAAAAMLCwkLBwUHBwUHBQQAAwUEAAL+/vz+/P7+/vz8AAAAAw8PDQ8TExMTERMPDw8PDQ8LCwsLCwsJCAAAAAMHBwcHBwcFB"
s+="JIAAACQAAACAACSAgIAkgAAAJAAkAAAAAAAAAAAAAAAkAAAAJAAAAAAAAAAAACQAAAAAACQAAAAAAAAAAAAAACQAAAAAAAAAAAAAAAAAJAAAACQAJAAAAAAAAAAAACQA"
s+="JAAAAIAAJAAAAAAAJAAAAAAAAAAkAAAAAAAAAAAAAAC3gIAANwAAgCYAgAAAADcAAAA3AAAAAAAmAAAAAAAAADcAAAA3AAAAJgAAAAAANwAAAAAANwAAACYAAAAAAAAA"
s+="NwAAAAAAAAAmAAAAAAA3AAAAAAA3AAAAJgAwLy0pKyk3AAAAAAA3ACYAAAA3AAAAAAAAADcAAAAmgAAAJgAAACoAKgAqKioqKoAqgCqAKoAqACoAKgAqACoAKgAqKioq"
s+="KgAqACoqKioqACqAKgAqACoqKioqACoAKgAqACoqKioqACoAKioqKioAKgAqACoAKgAqACoAKgAqACoAKioqKioAKgAqKioqACoAKgAqACoqKioqKgAqACoAKgAqKioq"
s+="gAAAAEUAAAAogAAARQCAAAAAAABFAAAAJwAAAEUAAAAAAAAARQAAACgAAABFAAAAAAAAAEUAAAAnAAAARQAAAAAAAABFAAAAKAAAAEUAAAAAAACARQAAACcAAABFAAAA"
s+="AAAAAEUAAAAoAAAARQAAAAAAAABFAAAAJwAAACcAAAAAAAAAAAAAAElVYQAAAAAAAAAAAAAAUFxQXFBcAAAAAAAAAAAAAAAAaABhAGgAaAAAAAAAAAAAAFVXWVpcXmBh"
s+="AAAAAAAAAAAASVVhAAAAAAAAAAAAAFBcUFxQXAAAAAAAAAAAAAAAAGgAYQBoAGgAAAAAAAAAAABVV1laXF5gYWEAAAAAAAAAAElVYQAAAAAAAAAAAAAAUFxQXFBcAAAA"
s+="AAAAAAAAAAAAaABhAGgAaAAAAAAAAAAAAFVXWVpcXmBhAAAAAAAAAAAASVVhAAAAAAAAAAAAAFBcUFxQXAAAAAAAAAAAAAAAAGgAYQBoAGgAAAAAAAAAAABVV1laXF5g"
s+="AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"
s+="AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA="
#include "hspinet.as"
b64decode file, s, strlen(s) : gosub *L_LOAD_2 : transport = 1, 0 : ch = 15 : return
窓月ららさんから指摘あったように音質がアレで本番や、
リアルタイムには遅延がキツイですが、勉強には良いかもですね。
ドレミって音階出鳴らせますか？
