midigen.pas

TMidiGen is a MIDI component by Alan Warriner which allows the simple creation of sound effects and

//modulation
function DoModulation(Time:Integer; lChannel:TMGChannel; LevelPC:Integer):sMIDIEVENT;
var
   level:Integer;

begin
level:=($7f * LevelPC) div 100;

Result:=ShortEvent(Time,lChannel,seModulation,(level*$100)+$1);

end;

//----------------------------------------------------------------------------
//volume
function DoVolume(Time:Integer; lChannel:TMGChannel; LevelPC:Integer):sMIDIEVENT;
var
   level:Integer;

begin
level:=($7f * LevelPC) div 100;

Result:=ShortEvent(Time,lChannel,seVolume,(level*$100)+$7);

end;

//----------------------------------------------------------------------------
//pan
function DoPan(Time:Integer; lChannel:TMGChannel; LevelPC:Integer):sMIDIEVENT;
var
   level:Integer;

begin
level:=$40+(($3f * LevelPC) div 100);


Result:=ShortEvent(Time,lChannel,sePan,(Level*$100)+$a);

end;

//----------------------------------------------------------------------------
//create pitch bend sequence
procedure DoPitchBend(TotalTime:Integer; delayPC:Integer; durationPC:Integer; levelPC:Integer; lChannel:TMGChannel; var DataBuf:PChar; var BufSize:Integer; var EvCount:Integer );
var
   i:Integer;
   pbevent:sMIDIEVENT;
   PBLevel:Integer;
   PBStep:Integer;
   Offset,Steps:Integer;

begin

//nothing to do?
if (TotalTime=0) or (durationPC=0) or (delayPC=100) or (levelPC=0) then Exit;

//delay value
Offset:=(TotalTime * delayPC) div 100;

//no of steps
Steps:=((TotalTime-Offset) * durationPC) div 100;

if (Steps=0) or (Steps>8191) then Exit;

//increment per step
PBStep:=((8191 * levelPC) div 120) div Steps;

PBLevel:=8192+PBStep;

for i:=1 to Steps do
    begin

    if i=1 then
       begin
       //add offset
       pbevent:=ShortEvent(Offset+1,lChannel,sePitchBend,MidiWord(PBLevel));
       end
    else
        begin
        pbevent:=ShortEvent(1,lChannel,sePitchBend,MidiWord(PBLevel));
        end;

    AddShortEvent(pbevent,DataBuf,BufSize,EvCount);

    //inc or dec
    PBLevel:=PBLevel+PBStep;

    end;


end;

//----------------------------------------------------------------------------
//create a short event
function ShortEvent(Time:Integer; lChannel:TMGChannel; Event:SEvent; Data:DWORD; DoCallback:bool=false):sMIDIEVENT;
var
   rv:sMIDIEVENT;
   Status: DWORD;

begin
//reserved
rv.dwStreamID:=0;

//time offset
rv.dwDeltaTime:=Time;

//set status value
case Event of
     //note on
     seNoteOn:Status:=$90;

     //NoteOff
     seNoteOff:Status:=$90;

     //reset
     seReset: Status:=$B0;

     //instrument
     seInstrument: Status:=$C0;

     //pitch bend
     sePitchBend: Status:=$E0;

     //modulation, volume,pan,sustain,reverb,chorus
     seSustain,seModulation,seVolume,sePan,seReverb,seChorus: Status:=$B0;

     //rpn
     seRPNLSB: Status:=$B0;
     seRPNMSB: Status:=$B0;

     //Pitch bend range
     sePBRange: Status:=$B0;

     else Status:=$B0;

     end;

//add channel
Status:=Status or (Cardinal(lChannel) and $f);

//shift left
Data:=Data*$100;

//build event
if DoCallback then //callback?
   rv.dwEvent:=(MEVT_F_SHORT *$1000000) or MEVT_F_CALLBACK or Data or Status
else
    rv.dwEvent:=(MEVT_F_SHORT*$1000000) or Data or Status;

Result:=rv;
end;
//----------------------------------------------------------------------------
//create a midi message MSB LSB from 14 bits of a DWORD
function MidiWord(dw:DWORD):DWORD;
var
   MSB,LSB:DWORD;

begin


LSB:=dw and $7f;
MSB:=(dw and $3f80) * 2;
Result:=MSB or LSB;

end;
//----------------------------------------------------------------------------
//add a midi short event to a memory block
function AddShortEvent(sEvent:sMIDIEVENT; var DataBuf:PChar; var BufSize:Integer; var EvCount:Integer):bool;
begin
Result:=false;

//add event to data block
if AddData(@sEvent,DataBuf,BufSize,sEventSize) then
   begin
   Inc(EvCount);
   Result:=true;
   end

end;
//----------------------------------------------------------------------------
//re-allocate memory and add data
function AddData(Data:PChar; var DataBuf:PChar; var BufSize:Integer; DataSize:Integer):bool;
var
   TempBuf: PChar;

begin

//max buffersize allowed
if BufSize+DataSize>$ffff then
   begin
   Result:=false;
   Exit;
   end;

//allocate temporary block
TempBuf:=PChar(GlobalAlloc(GMEM_FIXED,BufSize+DataSize));
Inc(TotalAlloc);


//failed?
if TempBuf=nil then
   begin
   Result:=false;
   Exit;
   end;

if (DataBuf<>nil) and (BufSize>0) then
   begin
   //copy original data
   CopyMemory(TempBuf,DataBuf,BufSize);
   end;

//add new data
CopyMemory(TempBuf+BufSize,Data,DataSize);

//delete original
if DataBuf<>nil then
   begin
   GlobalFree(HGLOBAL(DataBuf));
   Dec(TotalAlloc);

   DataBuf:=nil;
   end;

//assign variable
DataBuf:=TempBuf;
BufSize:=BufSize+DataSize;


Result:=true;
end;

//----------------------------------------------------------------------------
//extract note & octave data from a string
//return no of valid strings found
function TMidiGen.ExtractNotes(NoteString:String; var Data:TList):bool;
var
   noteval,inst,note,tdel,del,tdur,dur,tOct,Oct,lts,sl,dp,dmp:Integer;
   ts,tns,tos,tdels,tnots:String;
   info:^event;
   LastStartTime:Integer;
   tInstrument:TMGInstrument;
   tChannel:TMGChannel;
   CanUsePB:bool;

begin
NoteString:=Trim(NoteString);
NoteString:=AnsiUpperCase(NoteString);
dp:=0;
LastStartTime:=0;
Oct:=fOctave;
dur:=-1;
del:=0;
CanUsePB:=true;

//default instrument if not percussion channel
if (Integer(fInstrument)<128) and (ChannelInUse<>PERCUSSION) then
   begin
   tChannel:=ChannelInUse;
   tInstrument:=fInstrument;
   end
else
   begin
   tChannel:=PERCUSSION;
   tInstrument:=fInstrument;
   end;


//strip out all spaces
repeat
  dmp:=AnsiPos(' ',NoteString);

  if dmp>0 then
     Delete(NoteString,dmp,1);

until dmp=0;


sl:=Length(NoteString);

if sl=0 then
   begin
   Result:=false;
   Exit;
   end;

while sl>0 do
      begin
      note:=-1;
      inst:=-1;
      tdel:=-1;
      noteval:=-1;

      //find , delimiter
      dmp:=AnsiPos(',',NoteString);

      //no , delimiter but not an empty string
      if (dmp=0) and (sl>0) then dmp:=sl+1;

      if dmp>1 then
          begin

          //get , delimited substring
          ts:=Trim(Copy(NoteString,1,dmp-1));

          //no data specified?
          lts:=Length(ts);
          if lts=0 then Break;

          //find ; delimiters
          //no number or ; to start?
          if (StrToIntDef(ts[1],-1)=-1) and (ts[1]<>';') then
             begin
             //add start ;
             ts:=';'+ts;
             end;

          //starts with ;?
          if ts[1]=';' then
             begin
             //add default delay
             ts:=IntToStr(del)+ts;
             end;

          //only one ;
          if LastDelimiter(';',ts)=AnsiPos(';',ts) then
             begin
             //only one so tag one on the end
             ts:=ts+';';
             end;

          //ends with ;?
          lts:=Length(ts);
          if ts[lts]=';' then
             begin
             //used for duration changes in PB checks
             if dur=-1 then dur:=fDuration;

             //add default duration
             ts:=ts+IntToStr(dur);
             end;


          //extract delay************************
          dp:=AnsiPos(';',ts);

          //get ; delimited delay substring
          tdels:=Copy(ts,1,dp-1);

          //get delay?
          tdel:=StrToIntDef(tdels,-1);
          if tdel>-1 then del:=tdel;

          //no pitch bend if delay not zero
          if tdel<>0 then CanUsePB:=false;

          //delete substring from master
          Delete(ts,1,dp);

          //extract note & octave or instrument**********************
          dp:=AnsiPos(';',ts);

          //get ; delimited note substring
          tnots:=Copy(ts,1,dp-1);
          lts:=Length(tnots);

          inst:=-1;
          //instrument change?
          if lts>1 then
             begin
             if tnots[1]='I' then
                begin
                //instrument number
                inst:=StrToIntDef(Copy(tnots,2,lts-1),-1);
                end;
             end;

          noteval:=-1;
          if inst<0 then
             begin
              //direct note value?
              if lts>1 then
                 begin
                 if tnots[1]='N' then
                    begin
                    //note value
                    noteval:=StrToIntDef(Copy(tnots,2,lts-1),-1);
                    if (noteval<0) or (noteval>127) then noteval:=-1;
                    end;
                 end;
             end;

          //not an instrument or note value
          if (noteval<0) and (inst<0) then
             begin
              //no octave specified?
              if (lts<2) or (StrToIntDef(tnots[lts],-1)=-1) then
                 begin
                 tnots:=tnots+IntToStr(Oct);
                 lts:=Length(tnots);
                 end;

              //#, + or -?
              if (StrToIntDef(tnots[2],-1)<>-1) then //octave value is second character
                 begin
                 //extract note and octave
                 tns:=Copy(tnots,1,1);
                 tos:=Copy(tnots,2,lts-1);
                 end
              else //accidental
                 begin
                 tns:=Copy(tnots,1,2);
                 tos:=Copy(tnots,3,lts-1);
                 end;

              //valid note?
              note:=-1;
              tOct:=StrToIntDef(tos,-1);
              if (tOct>-1)  and (tOct<11) then //octave ok
                 begin
                 //search for note string
                 note:=GetNoteNumber(tns);
                 if note>-1 then
                    begin
                    Oct:=tOct;
                    note:=Oct*12+note;
                    end;
                 end;

              end;
              end;

          //delete substring from ; master
          Delete(ts,1,dp);

          //get duration
          tdur:=StrToIntDef(ts,-1);
          if tdur>0 then
             begin
             //no pitch bend if duration varies
             if (dur<>tdur) and (dur<>-1) then CanUsePB:=false;

             dur:=tdur;
             end;

       if noteval>-1 then note:=noteval;

       //add data to TList
       if ((tdur>-1) and (tdel>-1)) and (((inst>-1) and (inst<=LASTINSTRUMENT)) or ((note>-1) and (note<128))) then
          begin
          new (info);
          LastStartTime:=del+LastStartTime;
          info.Processed:=false;

          //instrument change
          if (inst>-1) then
             begin
             info.dwEventStart:=LastStartTime;
             info.dwEventType:=seInstrument;
             info.dwData:=inst;

             if inst>127 then
                begin
                tChannel:=PERCUSSION;
                tInstrument:=TMGInstrument(inst);
                end
             else
                begin
                tChannel:=ChannelInUse;
                end;

             info.dwChannel:=tChannel;
             //add instrument
             if ChannelInUse<>PERCUSSION then
                Data.Add(info)
             else
                tChannel:=PERCUSSION;
             end

          else //note
             begin
             info.dwEventStart:=LastStartTime;
             info.dwEventType:=seNoteOn;
             if (tChannel=PERCUSSION) and (ChannelInUse<>PERCUSSION) then
                info.dwData:=Integer(tInstrument)
             else
                info.dwData:=note;

             info.dwChannel:=tChannel;
             //add note on
             Data.Add(info);

             //now do note off
             new(info);
             info.dwEventStart:=LastStartTime+dur;
             info.dwEventType:=seNoteOff;
             if (tChannel=PERCUSSION ) and (ChannelInUse<>PERCUSSION)then
                info.dwData:=Integer(tInstrument)
             else
                info.dwData:=note;

             info.dwData:=note;
             info.dwChannel:=tChannel;
             Data.Add(info);
             end;

          end;

       //delete substring from master
       Delete(NoteString,1,dmp);

       sl:=Length(NoteString);
       end;

//sort tlist into event start order
Data.Sort(EventSort);

Result:=CanUsePB;
end;
//----------------------------------------------------------------------------
//tlist sort function
function EventSort(Item1, Item2: Pointer): Integer;
var
   info1,info2:^event;
begin
info1:=Item1;
info2:=Item2;

//instrument change first
if info1.dwEventStart=info2.dwEventStart then
   begin

   if (info1.dwEventType=seInstrument) and (info2.dwEventType<>seInstrument) then
      begin
      Result:=-1;
      Exit;
      end;


   if (info2.dwEventType=seInstrument) and (info1.dwEventType<>seInstrument) then
      begin
      Result:=1;
      Exit;
      end;
   end;

Result:=info1.dwEventStart-info2.dwEventStart;
end;

//---------------------------------------------------------------------
//output debug info to file
{procedure dbout(dbstring:String;ok:bool;extra:String='');
var
   fs:TFileStream;
   ts:String;

begin

fs:=TFileStream.Create(ExtractFilePath(Application.ExeName)+'dbinfo.txt',fmOpenReadWrite);
fs.Seek(0,soFromEnd);

ts:=IntToStr(GetTickCount)+#9#9;

fs.Write(ts[1],Length(ts));

if ok then
   dbstring:=dbstring+' OK'
else
    dbstring:=dbstring+' *FAIL*';

dbstring:=dbstring+#9#9+IntToStr(EventCount)+' '+extra+#13;
fs.Write(dbstring[1],Length(dbstring));
fs.Free;

end;}

end.