diff options
Diffstat (limited to '')
| -rw-r--r-- | Game/Code/lib/midi/CIRCBUF.PAS | 192 |
1 files changed, 192 insertions, 0 deletions
diff --git a/Game/Code/lib/midi/CIRCBUF.PAS b/Game/Code/lib/midi/CIRCBUF.PAS new file mode 100644 index 00000000..e84fc2c4 --- /dev/null +++ b/Game/Code/lib/midi/CIRCBUF.PAS @@ -0,0 +1,192 @@ +{ $Header: /MidiComp/CIRCBUF.PAS 2 10/06/97 7:33 Davec $ }
+
+{ Written by David Churcher <dchurcher@cix.compulink.co.uk>,
+ released to the public domain. }
+
+
+{ A First-In First-Out circular buffer.
+ Port of circbuf.c from Microsoft's Windows MIDI monitor example.
+ I did do a version of this as an object (see Rev 1.1) but it was getting too
+ complicated and I couldn't see any real benefits to it so I dumped it
+ for an ordinary memory buffer with pointers.
+
+ This unit is a bit C-like, everything is done with pointers and extensive
+ use is made of the undocumented feature of the Inc() function that
+ increments pointers by the size of the object pointed to.
+ All of this could probably be done using Pascal array notation with
+ range-checking turned off, but I'm not sure it's worth it.
+}
+
+Unit Circbuf;
+
+interface
+
+Uses Wintypes, WinProcs, MMSystem;
+
+type
+ {$IFNDEF WIN32}
+ { API types not defined in Delphi 1 }
+ DWORD = Longint;
+ HGLOBAL = THandle;
+ UINT = Word;
+ TFNTimeCallBack = procedure(uTimerID, uMessage: UINT; dwUser, dw1, dw2: DWORD);
+ {$ENDIF}
+
+ { MIDI input event }
+ TMidiBufferItem = record
+ timestamp: DWORD; { Timestamp in milliseconds after midiInStart }
+ data: DWORD; { MIDI message received }
+ sysex: PMidiHdr; { Pointer to sysex MIDIHDR, nil if not sysex }
+ end;
+ PMidiBufferItem = ^TMidiBufferItem;
+
+ { MIDI input buffer }
+ TCircularBuffer = record
+ RecordHandle: HGLOBAL; { Windows memory handle for this record }
+ BufferHandle: HGLOBAL; { Windows memory handle for the buffer }
+ pStart: PMidiBufferItem; { ptr to start of buffer }
+ pEnd: PMidiBufferItem; { ptr to end of buffer }
+ pNextPut: PMidiBufferItem; { next location to fill }
+ pNextGet: PMidiBufferItem; { next location to empty }
+ Error: Word; { error code from MMSYSTEM functions }
+ Capacity: Word; { buffer size (in TMidiBufferItems) }
+ EventCount: Word; { Number of events in buffer }
+ end;
+
+ PCircularBuffer = ^TCircularBuffer;
+
+function GlobalSharedLockedAlloc( Capacity: Word; var hMem: HGLOBAL ): Pointer;
+procedure GlobalSharedLockedFree( hMem: HGLOBAL; ptr: Pointer );
+
+function CircbufAlloc( Capacity: Word ): PCircularBuffer;
+procedure CircbufFree( PBuffer: PCircularBuffer );
+function CircbufRemoveEvent( PBuffer: PCircularBuffer ): Boolean;
+function CircbufReadEvent( PBuffer: PCircularBuffer; PEvent: PMidiBufferItem ): Boolean;
+{ Note: The PutEvent function is in the DLL }
+
+implementation
+
+{ Allocates in global shared memory, returns pointer and handle }
+function GlobalSharedLockedAlloc( Capacity: Word; var hMem: HGLOBAL ): Pointer;
+var
+ ptr: Pointer;
+begin
+ { Allocate the buffer memory }
+ hMem := GlobalAlloc(GMEM_SHARE Or GMEM_MOVEABLE Or GMEM_ZEROINIT, Capacity );
+
+ if (hMem = 0) then
+ ptr := Nil
+ else
+ begin
+ ptr := GlobalLock(hMem);
+ if (ptr = Nil) then
+ GlobalFree(hMem);
+ end;
+
+{$IFNDEF WIN32}
+ if (ptr <> Nil) then
+ GlobalPageLock(HIWORD(DWORD(ptr)));
+{$ENDIF}
+ GlobalSharedLockedAlloc := Ptr;
+end;
+
+procedure GlobalSharedLockedFree( hMem: HGLOBAL; ptr: Pointer );
+begin
+{$IFNDEF WIN32}
+ if (ptr <> Nil) then
+ GlobalPageUnlock(HIWORD(DWORD(ptr)));
+{$ENDIF}
+ if (hMem <> 0) then
+ begin
+ GlobalUnlock(hMem);
+ GlobalFree(hMem);
+ end;
+end;
+
+function CircbufAlloc( Capacity: Word ): PCircularBuffer;
+var
+ NewCircularBuffer: PCircularBuffer;
+ NewMIDIBuffer: PMidiBufferItem;
+ hMem: HGLOBAL;
+begin
+ { TODO: Validate circbuf size, <64K }
+ NewCircularBuffer :=
+ GlobalSharedLockedAlloc( Sizeof(TCircularBuffer), hMem );
+ if (NewCircularBuffer <> Nil) then
+ begin
+ NewCircularBuffer^.RecordHandle := hMem;
+ NewMIDIBuffer :=
+ GlobalSharedLockedAlloc( Capacity * Sizeof(TMidiBufferItem), hMem );
+ if (NewMIDIBuffer = Nil) then
+ begin
+ { TODO: Exception here? }
+ GlobalSharedLockedFree( NewCircularBuffer^.RecordHandle,
+ NewCircularBuffer );
+ NewCircularBuffer := Nil;
+ end
+ else
+ begin
+ NewCircularBuffer^.pStart := NewMidiBuffer;
+ { Point to item at end of buffer }
+ NewCircularBuffer^.pEnd := NewMidiBuffer;
+ Inc(NewCircularBuffer^.pEnd, Capacity);
+ { Start off the get and put pointers in the same position. These
+ will get out of sync as the interrupts start rolling in }
+ NewCircularBuffer^.pNextPut := NewMidiBuffer;
+ NewCircularBuffer^.pNextGet := NewMidiBuffer;
+ NewCircularBuffer^.Error := 0;
+ NewCircularBuffer^.Capacity := Capacity;
+ NewCircularBuffer^.EventCount := 0;
+ end;
+ end;
+ CircbufAlloc := NewCircularBuffer;
+end;
+
+procedure CircbufFree( pBuffer: PCircularBuffer );
+begin
+ if (pBuffer <> Nil) then
+ begin
+ GlobalSharedLockedFree(pBuffer^.BufferHandle, pBuffer^.pStart);
+ GlobalSharedLockedFree(pBuffer^.RecordHandle, pBuffer);
+ end;
+end;
+
+{ Reads first event in queue without removing it.
+ Returns true if successful, False if no events in queue }
+function CircbufReadEvent( PBuffer: PCircularBuffer; PEvent: PMidiBufferItem ): Boolean;
+var
+ PCurrentEvent: PMidiBufferItem;
+begin
+ if (PBuffer^.EventCount <= 0) then
+ CircbufReadEvent := False
+ else
+ begin
+ PCurrentEvent := PBuffer^.PNextget;
+
+ { Copy the object from the "tail" of the buffer to the caller's object }
+ PEvent^.Timestamp := PCurrentEvent^.Timestamp;
+ PEvent^.Data := PCurrentEvent^.Data;
+ PEvent^.Sysex := PCurrentEvent^.Sysex;
+ CircbufReadEvent := True;
+ end;
+end;
+
+{ Remove current event from the queue }
+function CircbufRemoveEvent(PBuffer: PCircularBuffer): Boolean;
+begin
+ if (PBuffer^.EventCount > 0) then
+ begin
+ Dec( Pbuffer^.EventCount);
+
+ { Advance the buffer pointer, with wrap }
+ Inc( Pbuffer^.PNextGet );
+ If (PBuffer^.PNextGet = PBuffer^.PEnd) then
+ PBuffer^.PNextGet := PBuffer^.PStart;
+
+ CircbufRemoveEvent := True;
+ end
+ else
+ CircbufRemoveEvent := False;
+end;
+
+end.
|