home *** CD-ROM | disk | FTP | other *** search
/ Sound, Music & MIDI Collection 2 / SMMVOL2.bin / PROG / MIDICOMP.ZIP / CIRCBUF.PAS next >
Encoding:
Pascal/Delphi Source File  |  1995-07-01  |  5.8 KB  |  183 lines
  1. { $Header:   F:/delphi/midi/vcs/circbuf.pas   1.8   02 Jul 1995 00:51:04   DAVEC  $ }
  2.  
  3. { A First-In First-Out circular buffer.
  4.   Port of circbuf.c from Microsoft's Windows MIDI monitor example.
  5.   I did do a version of this as an object (see Rev 1.1) but it was getting too 
  6.   complicated and I couldn't see any real benefits to it so I dumped it 
  7.   for an ordinary memory buffer with pointers. 
  8.  
  9.   The main problem is that the object has to be allocated in global shared
  10.   memory and the PutEvent method has to be accessed from a DLL at interrupt
  11.   time. Since you can't debug DLLs in Delphi this could be a nightmare to 
  12.   get working. Maybe later!
  13.  
  14.   This unit is a bit C-like, everything is done with pointers and extensive
  15.   use is made of the undocumented feature of the Inc() function that 
  16.   increments pointers by the size of the object pointed to.
  17.   All of this could probably be done using Pascal array notation with
  18.   range-checking turned off, but I'm not sure it's worth it.
  19. }
  20.  
  21. Unit Circbuf;
  22.  
  23. interface
  24.  
  25. Uses Wintypes, WinProcs, MMSystem;
  26.  
  27. type
  28.     { MIDI input event }
  29.     TMidiInputBufferItem = record                
  30.           timestamp: Longint;    { Timestamp in milliseconds after midiInStart }
  31.         data: Longint;        { MIDI message received }
  32.         sysex: PMidiHdr;    { Pointer to sysex MIDIHDR, nil if not sysex }
  33.     end;
  34.     PMidiInputBufferItem = ^TMidiInputBufferItem;
  35.  
  36.     { MIDI input buffer }
  37.     TCircularBuffer = record
  38.         RecordHandle: THANDLE;        { Windows memory handle for this record }
  39.         BufferHandle: THANDLE;        { Windows memory handle for the buffer }
  40.         pStart: PMidiInputBufferItem;        { ptr to start of buffer }
  41.         pEnd: PMidiInputBufferItem;            { ptr to end of buffer }
  42.         pNextPut: PMidiInputBufferItem;        { next location to fill }
  43.         pNextGet: PMidiInputBufferItem;        { next location to empty }
  44.         Error: Word;                 { error code from MMSYSTEM functions }
  45.         Capacity: Word;                { buffer size (in TMidiInputBufferItems) }
  46.         EventCount: Word;            { Number of events in buffer }
  47.     end;
  48.  
  49.    PCircularBuffer = ^TCircularBuffer;
  50.  
  51. function GlobalSharedLockedAlloc( Capacity: Word; var hMem: THANDLE ): Pointer;
  52. procedure GlobalSharedLockedFree( hMem: THANDLE; ptr: Pointer );
  53.  
  54. function CircbufAlloc( Capacity: Word ): PCircularBuffer;
  55. procedure CircbufFree( PBuffer: PCircularBuffer );
  56. function CircbufRemoveEvent( PBuffer: PCircularBuffer ): Boolean;
  57. function CircbufReadEvent( PBuffer: PCircularBuffer; PEvent: PMidiInputBufferItem ): Boolean;
  58. { Note: The PutEvent function is in the DLL }
  59.  
  60. implementation
  61.  
  62. { Allocates in global shared memory, returns pointer and handle }
  63. function GlobalSharedLockedAlloc( Capacity: Word; var hMem: THANDLE ): Pointer;
  64. var
  65.     ptr: Pointer;
  66. begin
  67.     { Allocate the buffer memory }
  68.     hMem := GlobalAlloc(GMEM_SHARE Or GMEM_MOVEABLE Or GMEM_ZEROINIT, Capacity );
  69.  
  70.     if (hMem = 0) then
  71.         ptr := Nil
  72.     else
  73.         begin
  74.         ptr := GlobalLock(hMem);
  75.         if (ptr = Nil) then
  76.             GlobalFree(hMem);
  77.         end;
  78.  
  79.     if (ptr <> Nil) then
  80.         GlobalPageLock(HIWORD(Longint(ptr)));
  81.  
  82.     GlobalSharedLockedAlloc := Ptr;
  83. end;
  84.  
  85. procedure GlobalSharedLockedFree( hMem: THANDLE; ptr: Pointer );
  86. begin
  87.     if (ptr <> Nil) then
  88.         GlobalPageUnlock(HIWORD(Longint(ptr)));
  89.     if (hMem <> 0) then
  90.         begin
  91.         GlobalUnlock(hMem);
  92.         GlobalFree(hMem);
  93.         end;
  94. end;
  95.  
  96. function CircbufAlloc( Capacity: Word ): PCircularBuffer;
  97. var
  98.     NewCircularBuffer: PCircularBuffer;
  99.     NewMIDIBuffer: PMidiInputBufferItem;
  100.     hMem: THANDLE;
  101. begin
  102.     { TODO: Validate circbuf size, <64K }
  103.     NewCircularBuffer := 
  104.         GlobalSharedLockedAlloc( Sizeof(TCircularBuffer), hMem );
  105.     if (NewCircularBuffer <> Nil) then
  106.         begin
  107.         NewCircularBuffer^.RecordHandle := hMem;
  108.         NewMIDIBuffer := 
  109.             GlobalSharedLockedAlloc( Capacity * Sizeof(TMidiInputBufferItem), hMem );
  110.         if (NewMIDIBuffer = Nil) then
  111.             begin
  112.             { TODO: Exception here? }
  113.             GlobalSharedLockedFree( NewCircularBuffer^.RecordHandle, 
  114.                                             NewCircularBuffer );
  115.             NewCircularBuffer := Nil;
  116.             end
  117.         else
  118.             begin
  119.                     NewCircularBuffer^.pStart := NewMidiBuffer;
  120.             { Point to item at end of buffer }
  121.             NewCircularBuffer^.pEnd := NewMidiBuffer;
  122.             Inc(NewCircularBuffer^.pEnd, Capacity);
  123.             { Start off the get and put pointers in the same position. These
  124.               will get out of sync as the interrupts start rolling in }
  125.             NewCircularBuffer^.pNextPut := NewMidiBuffer;
  126.             NewCircularBuffer^.pNextGet := NewMidiBuffer;
  127.             NewCircularBuffer^.Error := 0;
  128.             NewCircularBuffer^.Capacity := Capacity;
  129.             NewCircularBuffer^.EventCount := 0;
  130.             end;
  131.         end;
  132.     CircbufAlloc := NewCircularBuffer;
  133. end;
  134.  
  135. procedure CircbufFree( pBuffer: PCircularBuffer );
  136. begin
  137.     if (pBuffer <> Nil) then
  138.         begin
  139.         GlobalSharedLockedFree(pBuffer^.BufferHandle, pBuffer^.pStart);
  140.         GlobalSharedLockedFree(pBuffer^.RecordHandle, pBuffer);
  141.         end;
  142. end;
  143.  
  144. { Reads first event in queue without removing it.
  145.   Returns true if successful, False if no events in queue }
  146. function CircbufReadEvent( PBuffer: PCircularBuffer; PEvent: PMidiInputBufferItem ): Boolean;
  147. var
  148.     PCurrentEvent: PMidiInputBufferItem;
  149. begin
  150.     if (PBuffer^.EventCount <= 0) then
  151.             CircbufReadEvent := False
  152.     else
  153.         begin
  154.         PCurrentEvent := PBuffer^.PNextget;
  155.  
  156.         { Copy the object from the "tail" of the buffer to the caller's object }
  157.         PEvent^.Timestamp := PCurrentEvent^.Timestamp;
  158.         PEvent^.Data := PCurrentEvent^.Data;
  159.                 PEvent^.Sysex := PCurrentEvent^.Sysex;
  160.         CircbufReadEvent := True;
  161.         end;
  162. end;
  163.  
  164. { Remove current event from the queue }
  165. function CircbufRemoveEvent(PBuffer: PCircularBuffer): Boolean;
  166. begin
  167.     if (PBuffer^.EventCount > 0) then
  168.         begin
  169.         Dec( Pbuffer^.EventCount);
  170.  
  171.         { Advance the buffer pointer, with wrap }
  172.         Inc( Pbuffer^.PNextGet );
  173.         If (PBuffer^.PNextGet = PBuffer^.PEnd) then
  174.             PBuffer^.PNextGet := PBuffer^.PStart;
  175.  
  176.         CircbufRemoveEvent := True;
  177.         end
  178.     else
  179.         CircbufRemoveEvent := False;
  180. end;
  181.  
  182. end.
  183.