controls/midi/KOLCircbuf.pas

   1 {
   2
   3        Unit: KOLCIRCBUFFER
   4     purpose: Midi circular buffer based on ms sdk example code
   5      Author: KOL translation and > 64 sysex buffering: Thaddy de Koning
   6              Original Author: David Churcher
   7   Copyright: released to the public domain
   8     Remarks: Well known Great components.
   9              Do not confuse this with my project JEDI midi translation for KOL
  10 }
  11 { $Header: /MidiComp/CIRCBUF.PAS 2     10/06/97 7:33 Davec $ }
  12
  13 { Written by David Churcher <dchurcher@cix.compulink.co.uk>,
  14   released to the public domain. }
  15
  16
  17 { A First-In First-Out circular buffer.
  18   Port of circbuf.c from Microsoft's Windows MIDI monitor example.
  19   I did do a version of this as an object (see Rev 1.1) but it was getting too
  20   complicated and I couldn't see any real benefits to it so I dumped it
  21   for an ordinary memory buffer with pointers.
  22
  23   This unit is a bit C-like, everything is done with pointers and extensive
  24   use is made of the undocumented feature of the Inc() function that
  25   increments pointers by the size of the object pointed to.
  26   All of this could probably be done using Pascal array notation with
  27   range-checking turned off, but I'm not sure it's worth it.
  28 }
  29
  30 {Changes by Thaddy:
  31
  32 1: Allocation granularity changed from word to dword in globzl* functions.
  33 2: Midievents capacity chged to DWORD
  34 3: Changed the Tcircular buffer record type accordingly
  35
  36    These changes overcome the 64K sysex limit in the original code
  37
  38 }
  39 Unit KOLCIRCBUF;
  40
  41 interface
  42
  43 Uses KOL, windows,MMSystem;
  44
  45 type
  46
  47         { MIDI input event }
  48         TMidiBufferItem = record
  49                 timestamp: DWORD;       { Timestamp in milliseconds after midiInStart }
  50                 data: DWORD;            { MIDI message received }
  51                 sysex: PMidiHdr;        { Pointer to sysex MIDIHDR, nil if not sysex }
  52         end;
  53         PMidiBufferItem = ^TMidiBufferItem;
  54
  55         { MIDI input buffer }
  56         TCircularBuffer = record
  57                 RecordHandle: HGLOBAL;          { Windows memory handle for this record }
  58                 BufferHandle: HGLOBAL;          { Windows memory handle for the buffer }
  59                 pStart: PMidiBufferItem;                { ptr to start of buffer }
  60                 pEnd: PMidiBufferItem;                  { ptr to end of buffer }
  61                 pNextPut: PMidiBufferItem;              { next location to fill }
  62                 pNextGet: PMidiBufferItem;              { next location to empty }
  63                 Error: Word;                            { error code from MMSYSTEM functions }
  64                 Capacity: dWord;                                { buffer size (in TMidiBufferItems) } //Changed from WORD, tdk
  65                 EventCount: dWord;                      { Number of events in buffer }// Changed from WORD, tdk
  66         end;
  67
  68    PCircularBuffer = ^TCircularBuffer;
  69
  70 function GlobalSharedLockedAlloc( Capacity: dWord; var hMem: HGLOBAL ): Pointer;
  71 procedure GlobalSharedLockedFree( hMem: HGLOBAL; ptr: Pointer );
  72
  73 function CircbufAlloc( Capacity: dWord ): PCircularBuffer;
  74 procedure CircbufFree( PBuffer: PCircularBuffer );
  75 function CircbufRemoveEvent( PBuffer: PCircularBuffer ): Boolean;
  76 function CircbufReadEvent( PBuffer: PCircularBuffer; PEvent: PMidiBufferItem ): Boolean;
  77 { Note: The PutEvent function is in the DLL }
  78
  79 implementation
  80
  81 { Allocates in global shared memory, returns pointer and handle }
  82 function GlobalSharedLockedAlloc( Capacity: dWord; var hMem: HGLOBAL ): Pointer;
  83 var
  84         ptr: Pointer;
  85 begin
  86         { Allocate the buffer memory }
  87         //getmem(pointer(hmem),capacity);
  88   //Result:=pointer(hmem);
  89 {Original code:}
  90
  91  hmem:= GlobalAlloc(GMEM_SHARE Or GMEM_MOVEABLE Or GMEM_ZEROINIT, Capacity );
  92
  93         if (hMem = 0) then
  94                 ptr := Nil
  95         else
  96                 begin
  97                 ptr := GlobalLock(hMem);
  98                 if (ptr = Nil) then
  99                         GlobalFree(hMem);
 100                 end;
 101
 102         GlobalSharedLockedAlloc := Ptr;
 103   {*}
 104 end;
 105
 106
 107 procedure GlobalSharedLockedFree( hMem: HGLOBAL; ptr: Pointer );
 108 begin
 109 //freemem(pointer(hmem));
 110 {Original code:}
 111         if (hMem <> 0) then
 112                 begin
 113                 GlobalUnlock(hMem);
 114                 GlobalFree(hMem);
 115                 end;
 116 {*}
 117 end;
 118
 119 function CircbufAlloc( Capacity: dWord ): PCircularBuffer;
 120 var
 121         NewCircularBuffer: PCircularBuffer;
 122         NewMIDIBuffer: PMidiBufferItem;
 123         hMem: HGLOBAL;
 124 begin
 125         { TODO: Validate circbuf size, <64K }  //DONE, or rather skipped:this is pure win32 code:), tdk
 126         NewCircularBuffer :=
 127                 GlobalSharedLockedAlloc( Sizeof(TCircularBuffer), hMem );
 128         if (NewCircularBuffer <> Nil) then
 129                 begin
 130                 NewCircularBuffer^.RecordHandle := hMem;
 131                 NewMIDIBuffer :=
 132                         GlobalSharedLockedAlloc( Capacity * Sizeof(TMidiBufferItem), hMem );
 133                 if (NewMIDIBuffer = Nil) then
 134                         begin
 135                         { TODO: Exception here? }
 136                         GlobalSharedLockedFree( NewCircularBuffer^.RecordHandle,
 137                                                                                         NewCircularBuffer );
 138                         NewCircularBuffer := Nil;
 139                         end
 140                 else
 141                         begin
 142       NewCircularBuffer^.pStart := NewMidiBuffer;
 143                         { Point to item at end of buffer }
 144                         NewCircularBuffer^.pEnd := NewMidiBuffer;
 145                         Inc(NewCircularBuffer^.pEnd, Capacity);
 146                         { Start off the get and put pointers in the same position. These
 147                           will get out of sync as the interrupts start rolling in }
 148                         NewCircularBuffer^.pNextPut := NewMidiBuffer;
 149                         NewCircularBuffer^.pNextGet := NewMidiBuffer;
 150                         NewCircularBuffer^.Error := 0;
 151                         NewCircularBuffer^.Capacity := Capacity;
 152                         NewCircularBuffer^.EventCount := 0;
 153                         end;
 154                 end;
 155         CircbufAlloc := NewCircularBuffer;
 156 end;
 157
 158 procedure CircbufFree( pBuffer: PCircularBuffer );
 159 begin
 160         if (pBuffer <> Nil) then
 161                 begin
 162                 GlobalSharedLockedFree(pBuffer^.BufferHandle, pBuffer^.pStart);
 163                 GlobalSharedLockedFree(pBuffer^.RecordHandle, pBuffer);
 164                 end;
 165 end;
 166
 167 { Reads first event in queue without removing it.
 168   Returns true if successful, False if no events in queue }
 169 function CircbufReadEvent( PBuffer: PCircularBuffer; PEvent: PMidiBufferItem ): Boolean;
 170 var
 171         PCurrentEvent: PMidiBufferItem;
 172 begin
 173         if (PBuffer^.EventCount <= 0) then
 174                         CircbufReadEvent := False
 175         else
 176                 begin
 177                 PCurrentEvent := PBuffer^.PNextget;
 178
 179                 { Copy the object from the "tail" of the buffer to the caller's object }
 180                 PEvent^.Timestamp := PCurrentEvent^.Timestamp;
 181                 PEvent^.Data := PCurrentEvent^.Data;
 182         PEvent^.Sysex := PCurrentEvent^.Sysex;
 183                 CircbufReadEvent := True;
 184                 end;
 185 end;
 186
 187 { Remove current event from the queue }
 188 function CircbufRemoveEvent(PBuffer: PCircularBuffer): Boolean;
 189 begin
 190         if (PBuffer^.EventCount > 0) then
 191                 begin
 192                 Dec( Pbuffer^.EventCount);
 193
 194                 { Advance the buffer pointer, with wrap }
 195                 Inc( Pbuffer^.PNextGet );
 196                 If (PBuffer^.PNextGet = PBuffer^.PEnd) then
 197                         PBuffer^.PNextGet := PBuffer^.PStart;
 198
 199                 CircbufRemoveEvent := True;
 200                 end
 201         else
 202                 CircbufRemoveEvent := False;
 203 end;
 204
 205 end.