1:- module(mididcg, [ midi//3
    2                   , noteon//3
    3                   , noteoff//2
    4                   , note//4
    5                   , prog//2
    6                   , prog//3
    7                   , prog//4
    8                   , pan//2
    9                   , volume//2
   10						 , tempo//1
   11						 , keysig//2
   12						 , timesig//1
   13                   , instr//2
   14                   ]).   15
   16:- use_module(library(clpfd)).   17:- use_module(library(dcg_pair)).   18:- use_module(library(dcg_core), [get//1, set//1]).   19:- use_module(library(genmidi), [gm/4]).   20
   21midi(Msg,Arg1,Arg2) --> get(T) <\> [msg(T,M,Arg1,Arg2)], {M #= Msg}.
   22midi(Msg,Arg1)      --> get(T) <\> [msg(T,M,Arg1)], {M #= Msg}.
   23meta(Msg,Bytes)     --> get(T) <\> [meta(T,M,N,Bytes)], {M #= Msg, length(Bytes,N)}.
   24text(Type,Text)     --> get(T) <\> [text(T,M,Text)], {text_type_code(M, Type)}.
   25
   26text_type_code(0x01, text).
   27text_type_code(0x02, copyright).
   28text_type_code(0x03, track_name).
   29text_type_code(0x04, instrument).
   30text_type_code(0x05, lyric).
   31text_type_code(0x06, marker).
   32text_type_code(0x07, cue).
   33
   34tempo(T)             --> meta(0x51, [B2, B1, B0]), {divmod(T,256,Z,B0), divmod(Z,256,B2,B1)}.
   35keysig(Sharps,major) --> meta(0x59, [Sharps, 0]).
   36keysig(Sharps,minor) --> meta(0x59, [Sharps, 1]).
   37timesig(Num/Denom)   --> meta(0x58, [Num, DenomPower, 24, 8]), { Denom #= 2^DenomPower }.
   38
   39holding_time(P) --> \< get(T), call_dcg(P), \< set(T).
   40
   41noteon(Ch,NN,V) --> midi(144+Ch,NN,V).
   42noteoff(Ch,NN) --> midi(128+Ch,NN,0).
   43
   44note(Ch,Vel,Dur,NN) --> 
   45   {N1 #= NN, V1 #= Vel},
   46   noteon(Ch,N1,V1), \< adv(Dur),
   47   noteoff(Ch,N1).
   48
   49prog(Ch,Prog) -->
   50	midi(192+Ch,Prog).
   51	
   52prog(Ch,Prog,Bank) -->
   53   { MSB #= Bank // 128, 
   54     LSB #= Bank mod 128
   55   },
   56	midi(176+Ch,0,MSB),
   57	midi(176+Ch,32,LSB),
   58	prog(Ch,Prog).
   59
   60prog(Ch,Prog,MSB,LSB) -->
   61	midi(176+Ch,0,MSB),
   62	midi(176+Ch,32,LSB),
   63	prog(Ch,Prog).
   64
   65instr(Ch,Instr) -->
   66   {gm(Instr,Prog,MSB,LSB)},
   67   prog(Ch,Prog,MSB,LSB).
   68
   69pan(Ch,Pan) --> midi(176+Ch,10,Pan).
   70
   71volume(Ch,Vol) --> midi(176+Ch,7,Vol).
   72
   73adv(Dur,T1,T2) :- T2