removed pascal code

1 files changed, 0 insertions, 727 deletions

diff --git a/src/lib/midi/Midiin.pas b/src/lib/midi/Midiin.pas
deleted file mode 100644
index 66e4f76d..00000000
--- a/src/lib/midi/Midiin.pas
+++ /dev/null
@@ -1,727 +0,0 @@
-{ $Header: /MidiComp/Midiin.pas 2     10/06/97 7:33 Davec $ }
-
-{ Written by David Churcher <dchurcher@cix.compulink.co.uk>,
-  released to the public domain. }
-
-unit MidiIn;
-
-{
-  Properties:
- DeviceID: 	Windows numeric device ID for the MIDI input device.
- Between 0 and NumDevs-1.
- Read-only while device is open, exception when changed while open
-
- MIDIHandle:	The input handle to the MIDI device.
- 0 when device is not open
- Read-only, runtime-only
-
- MessageCount:	Number of input messages waiting in input buffer
-
- Capacity:	Number of messages input buffer can hold
- Defaults to 1024
- Limited to (64K/event size)
- Read-only when device is open (exception when changed while open)
-
- SysexBufferSize:	Size in bytes of each sysex buffer
- Defaults to 10K
- Minimum 0K (no buffers), Maximum 64K-1
-
- SysexBufferCount:	Number of sysex buffers
- Defaults to 16
- Minimum 0 (no buffers), Maximum (avail mem/SysexBufferSize)
- Check where these buffers are allocated?
-
- SysexOnly: True to ignore all non-sysex input events. May be changed while
- device is open. Handy for patch editors where you have lots of short MIDI
- events on the wire which you are always going to ignore anyway.
-
- DriverVersion: Version number of MIDI device driver. High-order byte is
- major version, low-order byte is minor version.
-
- ProductName: Name of product (e.g. 'MPU 401 In')
-
- MID and PID: Manufacturer ID and Product ID, see
- "Manufacturer and Product IDs" in MMSYSTEM.HLP for list of possible values.
-
-  Methods:
- GetMidiEvent: Read Midi event at the head of the FIFO input buffer.
- Returns a TMyMidiEvent object containing MIDI message data, timestamp,
- and sysex data if applicable.
- This method automatically removes the event from the input buffer.
- It makes a copy of the received sysex buffer and puts the buffer back
- on the input device.
- The TMyMidiEvent object must be freed by calling MyMidiEvent.Free.
-
- Open: Opens device. Note no input will appear until you call the Start
- method.
-
- Close: Closes device. Any pending system exclusive output will be cancelled.
-
- Start: Starts receiving MIDI input.
-
- Stop: Stops receiving MIDI input.
-
-  Events:
- OnMidiInput: Called when MIDI input data arrives. Use the GetMidiEvent to
- get the MIDI input data.
-
- OnOverflow: Called if the MIDI input buffer overflows. The caller must
- clear the buffer before any more MIDI input can be received.
-
- Notes:
- Buffering: Uses a circular buffer, separate pointers for next location
- to fill and next location to empty because a MIDI input interrupt may
- be adding data to the buffer while the buffer is being read. Buffer
- pointers wrap around from end to start of buffer automatically. If
- buffer overflows then the OnBufferOverflow event is triggered and no
- further input will be received until the buffer is emptied by calls
- to GetMidiEvent.
-
- Sysex buffers: There are (SysexBufferCount) buffers on the input device.
- When sysex events arrive these buffers are removed from the input device and
- added to the circular buffer by the interrupt handler in the DLL.  When the sysex events
- are removed from the circular buffer by the GetMidiEvent method the buffers are
- put back on the input. If all the buffers are used up there will be no
- more sysex input until at least one sysex event is removed from the input buffer.
- In other	words if you're expecting lots of sysex input you need to set the
- SysexBufferCount property high enough so that you won't run out of
- input buffers before you get a chance to read them with GetMidiEvent.
-
- If the synth sends a block of sysex that's longer than SysexBufferSize it
- will be received as separate events.
- TODO: Component derived from this one that handles >64K sysex blocks cleanly
- and can stream them to disk.
-
- Midi Time Code (MTC) and Active Sensing: The DLL is currently hardcoded
- to filter these short events out, so that we don't spend all our time
- processing them.
- TODO: implement a filter property to select the events that will be filtered
- out.
-}
-
-interface
-
-{$IFDEF FPC}
-  {$MODE Delphi}
-  {$H+} // use long strings
-{$ENDIF}
-
-uses
-  Classes,
-  SysUtils,
-  Messages,
-  Windows,
-  MMSystem,
-  {$IFDEF FPC}
-  WinAllocation,
-  {$ENDIF}
-  MidiDefs,
-  MidiType,
-  MidiCons,
-  Circbuf,
-  Delphmcb;
-
-type
-  MidiInputState = (misOpen, misClosed, misCreating, misDestroying);
-  EMidiInputError = class(Exception);
-
- {-------------------------------------------------------------------}
-  TMidiInput = class(TComponent)
-  private
-    Handle: THandle; { Window handle used for callback notification }
-    FDeviceID: Word; { MIDI device ID }
-    FMIDIHandle: HMIDIIn; { Handle to input device }
-    FState: MidiInputState; { Current device state }
-
-    FError: Word;
-    FSysexOnly: Boolean;
-
- { Stuff from MIDIINCAPS }
-    FDriverVersion: MMVERSION;
-    FProductName: string;
-    FMID: Word; { Manufacturer ID }
-    FPID: Word; { Product ID }
-
- { Queue }
-    FCapacity: Word; { Buffer capacity }
-    PBuffer: PCircularBuffer; { Low-level MIDI input buffer created by Open method }
-    FNumdevs: Word; { Number of input devices on system }
-
- { Events }
-    FOnMIDIInput: TNotifyEvent; { MIDI Input arrived }
-    FOnOverflow: TNotifyEvent; { Input buffer overflow }
- { TODO: Some sort of error handling event for MIM_ERROR }
-
- { Sysex }
-    FSysexBufferSize: Word;
-    FSysexBufferCount: Word;
-    MidiHdrs: Tlist;
-
-    PCtlInfo: PMidiCtlInfo; { Pointer to control info for DLL }
-
-  protected
-    procedure Prepareheaders;
-    procedure UnprepareHeaders;
-    procedure AddBuffers;
-    procedure SetDeviceID(DeviceID: Word);
-    procedure SetProductName(NewProductName: string);
-    function GetEventCount: Word;
-    procedure SetSysexBufferSize(BufferSize: Word);
-    procedure SetSysexBufferCount(BufferCount: Word);
-    procedure SetSysexOnly(bSysexOnly: Boolean);
-    function MidiInErrorString(WError: Word): string;
-
-  public
-    constructor Create(AOwner: TComponent); override;
-    destructor Destroy; override;
-
-    property MIDIHandle: HMIDIIn read FMIDIHandle;
-
-    property DriverVersion: MMVERSION read FDriverVersion;
-    property MID: Word read FMID; { Manufacturer ID }
-    property PID: Word read FPID; { Product ID }
-
-    property Numdevs: Word read FNumdevs;
-
-    property MessageCount: Word read GetEventCount;
- { TODO: property to select which incoming messages get filtered out }
-
-    procedure Open;
-    procedure Close;
-    procedure Start;
-    procedure Stop;
- { Get first message in input queue }
-    function GetMidiEvent: TMyMidiEvent;
-    procedure MidiInput(var Message: TMessage);
-
-   { Some functions to decode and classify incoming messages would be good }
-
-  published
-
- { TODO: Property editor with dropdown list of product names }
-    property ProductName: string read FProductName write SetProductName;
-
-    property DeviceID: Word read FDeviceID write SetDeviceID default 0;
-    property Capacity: Word read FCapacity write FCapacity default 1024;
-    property Error: Word read FError;
-    property SysexBufferSize: Word
-      read FSysexBufferSize
-      write SetSysexBufferSize
-      default 10000;
-    property SysexBufferCount: Word
-      read FSysexBufferCount
-      write SetSysexBufferCount
-      default 16;
-    property SysexOnly: Boolean
-      read FSysexOnly
-      write SetSysexOnly
-      default False;
-
- { Events }
-    property OnMidiInput: TNotifyEvent read FOnMidiInput write FOnMidiInput;
-    property OnOverflow: TNotifyEvent read FOnOverflow write FOnOverflow;
-
-  end;
-
-procedure Register;
-
-{====================================================================}
-implementation
-
-uses Controls,
-     Graphics;
-
-(* Not used in Delphi 3
-{ This is the callback procedure in the external DLL.
-  It's used when midiInOpen is called by the Open method.
-  There are special requirements and restrictions for this callback
-  procedure (see midiInOpen in MMSYSTEM.HLP) so it's impractical to
-  make it an object method }
-{$IFDEF WIN32}
-function midiHandler(
-    hMidiIn: HMidiIn;
-    wMsg: UINT;
-    dwInstance: DWORD;
-    dwParam1: DWORD;
-    dwParam2: DWORD): Boolean; stdcall; external 'DELMID32.DLL';
-{$ELSE}
-procedure midiHandler(
-    hMidiIn: HMidiIn;
-    wMsg: Word;
-    dwInstance: DWORD;
-    dwParam1: DWORD;
-    dwParam2: DWORD); far; external 'DELPHMID';
-{$ENDIF}
-*)
-{-------------------------------------------------------------------}
-
-constructor TMidiInput.Create(AOwner: TComponent);
-begin
-  inherited Create(AOwner);
-  FState := misCreating;
-
-  FSysexOnly := False;
-  FNumDevs := midiInGetNumDevs;
-  MidiHdrs := nil;
-
- { Set defaults }
-  if  (FNumDevs > 0) then
-    SetDeviceID(0);
-  FCapacity := 1024;
-  FSysexBufferSize := 4096;
-  FSysexBufferCount := 16;
-
- { Create the window for callback notification }
-  if not (csDesigning in ComponentState) then
-  begin
-    Handle := AllocateHwnd(MidiInput);
-  end;
-
-  FState := misClosed;
-
-end;
-
-{-------------------------------------------------------------------}
-{ Close the device if it's open }
-
-destructor TMidiInput.Destroy;
-begin
-  if (FMidiHandle <> 0) then
-  begin
-    Close;
-    FMidiHandle := 0;
-  end;
-
-  if (PCtlInfo <> nil) then
-    GlobalSharedLockedFree(PCtlinfo^.hMem, PCtlInfo);
-
-  DeallocateHwnd(Handle);
-  inherited Destroy;
-end;
-
-{-------------------------------------------------------------------}
-{ Convert the numeric return code from an MMSYSTEM function to a string
-  using midiInGetErrorText. TODO: These errors aren't very helpful
-  (e.g. "an invalid parameter was passed to a system function") so
-  sort out some proper error strings. }
-
-function TMidiInput.MidiInErrorString(WError: Word): string;
-var
-  errorDesc: PChar;
-begin
-  errorDesc := nil;
-  try
-    errorDesc := StrAlloc(MAXERRORLENGTH);
-    if midiInGetErrorText(WError, errorDesc, MAXERRORLENGTH) = 0 then
-      result := StrPas(errorDesc)
-    else
-      result := 'Specified error number is out of range';
-  finally
-    if errorDesc <> nil then StrDispose(errorDesc);
-  end;
-end;
-
-{-------------------------------------------------------------------}
-{ Set the sysex buffer size, fail if device is already open }
-
-procedure TMidiInput.SetSysexBufferSize(BufferSize: Word);
-begin
-  if FState = misOpen then
-    raise EMidiInputError.Create('Change to SysexBufferSize while device was open')
-  else
-  { TODO: Validate the sysex buffer size. Is this necessary for WIN32? }
-    FSysexBufferSize := BufferSize;
-end;
-
-{-------------------------------------------------------------------}
-{ Set the sysex buffer count, fail if device is already open }
-
-procedure TMidiInput.SetSysexBuffercount(Buffercount: Word);
-begin
-  if FState = misOpen then
-    raise EMidiInputError.Create('Change to SysexBuffercount while device was open')
-  else
-  { TODO: Validate the sysex buffer count }
-    FSysexBuffercount := Buffercount;
-end;
-
-{-------------------------------------------------------------------}
-{ Set the Sysex Only flag to eliminate unwanted short MIDI input messages }
-
-procedure TMidiInput.SetSysexOnly(bSysexOnly: Boolean);
-begin
-  FSysexOnly := bSysexOnly;
- { Update the interrupt handler's copy of this property }
-  if PCtlInfo <> nil then
-    PCtlInfo^.SysexOnly := bSysexOnly;
-end;
-
-{-------------------------------------------------------------------}
-{ Set the Device ID to select a new MIDI input device
-  Note: If no MIDI devices are installed, throws an 'Invalid Device ID' exception }
-
-procedure TMidiInput.SetDeviceID(DeviceID: Word);
-var
-  MidiInCaps: TMidiInCaps;
-begin
-  if FState = misOpen then
-    raise EMidiInputError.Create('Change to DeviceID while device was open')
-  else
-    if (DeviceID >= midiInGetNumDevs) then
-      raise EMidiInputError.Create('Invalid device ID')
-    else
-    begin
-      FDeviceID := DeviceID;
-
-   { Set the name and other MIDIINCAPS properties to match the ID }
-      FError :=
-        midiInGetDevCaps(DeviceID, @MidiInCaps, sizeof(TMidiInCaps));
-      if Ferror <> MMSYSERR_NOERROR then
-        raise EMidiInputError.Create(MidiInErrorString(FError));
-
-      FProductName := StrPas(MidiInCaps.szPname);
-      FDriverVersion := MidiInCaps.vDriverVersion;
-      FMID := MidiInCaps.wMID;
-      FPID := MidiInCaps.wPID;
-
-    end;
-end;
-
-{-------------------------------------------------------------------}
-{ Set the product name and put the matching input device number in FDeviceID.
-  This is handy if you want to save a configured input/output device
-  by device name instead of device number, because device numbers may
-  change if users add or remove MIDI devices.
-  Exception if input device with matching name not found,
-  or if input device is open }
-
-procedure TMidiInput.SetProductName(NewProductName: string);
-var
-  MidiInCaps: TMidiInCaps;
-  testDeviceID: Word;
-  testProductName: string;
-begin
-  if FState = misOpen then
-    raise EMidiInputError.Create('Change to ProductName while device was open')
-  else
-  { Don't set the name if the component is reading properties because
- the saved Productname will be from the machine the application was compiled
- on, which may not be the same for the corresponding DeviceID on the user's
- machine. The FProductname property will still be set by SetDeviceID }
-    if not (csLoading in ComponentState) then
-    begin
-      begin
-        for testDeviceID := 0 to (midiInGetNumDevs - 1) do
-        begin
-          FError :=
-            midiInGetDevCaps(testDeviceID, @MidiInCaps, sizeof(TMidiInCaps));
-          if Ferror <> MMSYSERR_NOERROR then
-            raise EMidiInputError.Create(MidiInErrorString(FError));
-          testProductName := StrPas(MidiInCaps.szPname);
-          if testProductName = NewProductName then
-          begin
-            FProductName := NewProductName;
-            Break;
-          end;
-        end;
-        if FProductName <> NewProductName then
-          raise EMidiInputError.Create('MIDI Input Device ' +
-            NewProductName + ' not installed ')
-        else
-          SetDeviceID(testDeviceID);
-      end;
-    end;
-end;
-
-
-{-------------------------------------------------------------------}
-{ Get the sysex buffers ready }
-
-procedure TMidiInput.PrepareHeaders;
-var
-  ctr: Word;
-  MyMidiHdr: TMyMidiHdr;
-begin
-  if (FSysexBufferCount > 0) and (FSysexBufferSize > 0)
-    and (FMidiHandle <> 0) then
-  begin
-    Midihdrs := TList.Create;
-    for ctr := 1 to FSysexBufferCount do
-    begin
-   { Initialize the header and allocate buffer memory }
-      MyMidiHdr := TMyMidiHdr.Create(FSysexBufferSize);
-
-   { Store the address of the MyMidiHdr object in the contained MIDIHDR
-              structure so we can get back to the object when a pointer to the
-              MIDIHDR is received.
-              E.g. see TMidiOutput.Output method }
-      MyMidiHdr.hdrPointer^.dwUser := DWORD(MyMidiHdr);
-
-   { Get MMSYSTEM's blessing for this header }
-      FError := midiInPrepareHeader(FMidiHandle, MyMidiHdr.hdrPointer,
-        sizeof(TMIDIHDR));
-      if Ferror <> MMSYSERR_NOERROR then
-        raise EMidiInputError.Create(MidiInErrorString(FError));
-
-   { Save it in our list }
-      MidiHdrs.Add(MyMidiHdr);
-    end;
-  end;
-
-end;
-
-{-------------------------------------------------------------------}
-{ Clean up from PrepareHeaders }
-
-procedure TMidiInput.UnprepareHeaders;
-var
-  ctr: Word;
-begin
-  if (MidiHdrs <> nil) then { will be Nil if 0 sysex buffers }
-  begin
-    for ctr := 0 to MidiHdrs.Count - 1 do
-    begin
-      FError := midiInUnprepareHeader(FMidiHandle,
-        TMyMidiHdr(MidiHdrs.Items[ctr]).hdrPointer,
-        sizeof(TMIDIHDR));
-      if Ferror <> MMSYSERR_NOERROR then
-        raise EMidiInputError.Create(MidiInErrorString(FError));
-      TMyMidiHdr(MidiHdrs.Items[ctr]).Free;
-    end;
-    MidiHdrs.Free;
-    MidiHdrs := nil;
-  end;
-end;
-
-{-------------------------------------------------------------------}
-{ Add sysex buffers, if required, to input device }
-
-procedure TMidiInput.AddBuffers;
-var
-  ctr: Word;
-begin
-  if MidiHdrs <> nil then { will be Nil if 0 sysex buffers }
-  begin
-    if MidiHdrs.Count > 0 then
-    begin
-      for ctr := 0 to MidiHdrs.Count - 1 do
-      begin
-        FError := midiInAddBuffer(FMidiHandle,
-          TMyMidiHdr(MidiHdrs.Items[ctr]).hdrPointer,
-          sizeof(TMIDIHDR));
-        if FError <> MMSYSERR_NOERROR then
-          raise EMidiInputError.Create(MidiInErrorString(FError));
-      end;
-    end;
-  end;
-end;
-
-{-------------------------------------------------------------------}
-
-procedure TMidiInput.Open;
-var
-  hMem: THandle;
-begin
-  try
-  { Create the buffer for the MIDI input messages }
-    if (PBuffer = nil) then
-      PBuffer := CircBufAlloc(FCapacity);
-
-  { Create the control info for the DLL }
-    if (PCtlInfo = nil) then
-    begin
-      PCtlInfo := GlobalSharedLockedAlloc(Sizeof(TMidiCtlInfo), hMem);
-      PctlInfo^.hMem := hMem;
-    end;
-    PctlInfo^.pBuffer := PBuffer;
-    Pctlinfo^.hWindow := Handle; { Control's window handle }
-    PCtlInfo^.SysexOnly := FSysexOnly;
-    FError := midiInOpen(@FMidiHandle, FDeviceId,
-      DWORD(@midiHandler),
-      DWORD(PCtlInfo),
-      CALLBACK_FUNCTION);
-
-    if (FError <> MMSYSERR_NOERROR) then
-   { TODO: use CreateFmtHelp to add MIDI device name/ID to message }
-      raise EMidiInputError.Create(MidiInErrorString(FError));
-
-  { Get sysex buffers ready }
-    PrepareHeaders;
-
-  { Add them to the input }
-    AddBuffers;
-
-    FState := misOpen;
-
-  except
-    if PBuffer <> nil then
-    begin
-      CircBufFree(PBuffer);
-      PBuffer := nil;
-    end;
-
-    if PCtlInfo <> nil then
-    begin
-      GlobalSharedLockedFree(PCtlInfo^.hMem, PCtlInfo);
-      PCtlInfo := nil;
-    end;
-
-  end;
-
-end;
-
-{-------------------------------------------------------------------}
-
-function TMidiInput.GetMidiEvent: TMyMidiEvent;
-var
-  thisItem: TMidiBufferItem;
-begin
-  if (FState = misOpen) and
-    CircBufReadEvent(PBuffer, @thisItem) then
-  begin
-    Result := TMyMidiEvent.Create;
-    with thisItem do
-    begin
-      Result.Time := Timestamp;
-      if (Sysex = nil) then
-      begin
-    { Short message }
-        Result.MidiMessage := LoByte(LoWord(Data));
-        Result.Data1 := HiByte(LoWord(Data));
-        Result.Data2 := LoByte(HiWord(Data));
-        Result.Sysex := nil;
-        Result.SysexLength := 0;
-      end
-      else
-             { Long Sysex message }
-      begin
-        Result.MidiMessage := MIDI_BEGINSYSEX;
-        Result.Data1 := 0;
-        Result.Data2 := 0;
-        Result.SysexLength := Sysex^.dwBytesRecorded;
-        if Sysex^.dwBytesRecorded <> 0 then
-        begin
-     { Put a copy of the sysex buffer in the object }
-          GetMem(Result.Sysex, Sysex^.dwBytesRecorded);
-          StrMove(Result.Sysex, Sysex^.lpData, Sysex^.dwBytesRecorded);
-        end;
-
-    { Put the header back on the input buffer }
-        FError := midiInPrepareHeader(FMidiHandle, Sysex,
-          sizeof(TMIDIHDR));
-        if Ferror = 0 then
-          FError := midiInAddBuffer(FMidiHandle,
-            Sysex, sizeof(TMIDIHDR));
-        if Ferror <> MMSYSERR_NOERROR then
-          raise EMidiInputError.Create(MidiInErrorString(FError));
-      end;
-    end;
-    CircbufRemoveEvent(PBuffer);
-  end
-  else
-  { Device isn't open, return a nil event }
-    Result := nil;
-end;
-
-{-------------------------------------------------------------------}
-
-function TMidiInput.GetEventCount: Word;
-begin
-  if FState = misOpen then
-    Result := PBuffer^.EventCount
-  else
-    Result := 0;
-end;
-
-{-------------------------------------------------------------------}
-
-procedure TMidiInput.Close;
-begin
-  if FState = misOpen then
-  begin
-    FState := misClosed;
-
-  { MidiInReset cancels any pending output.
-  Note that midiInReset causes an MIM_LONGDATA callback for each sysex
-  buffer on the input, so the callback function and Midi input buffer
-  should still be viable at this stage.
-  All the resulting MIM_LONGDATA callbacks will be completed by the time
-  MidiInReset returns, though. }
-    FError := MidiInReset(FMidiHandle);
-    if Ferror <> MMSYSERR_NOERROR then
-      raise EMidiInputError.Create(MidiInErrorString(FError));
-
-  { Remove sysex buffers from input device and free them }
-    UnPrepareHeaders;
-
-  { Close the device (finally!) }
-    FError := MidiInClose(FMidiHandle);
-    if Ferror <> MMSYSERR_NOERROR then
-      raise EMidiInputError.Create(MidiInErrorString(FError));
-
-    FMidiHandle := 0;
-
-    if (PBuffer <> nil) then
-    begin
-      CircBufFree(PBuffer);
-      PBuffer := nil;
-    end;
-  end;
-end;
-
-{-------------------------------------------------------------------}
-
-procedure TMidiInput.Start;
-begin
-  if FState = misOpen then
-  begin
-    FError := MidiInStart(FMidiHandle);
-    if Ferror <> MMSYSERR_NOERROR then
-      raise EMidiInputError.Create(MidiInErrorString(FError));
-  end;
-end;
-
-{-------------------------------------------------------------------}
-
-procedure TMidiInput.Stop;
-begin
-  if FState = misOpen then
-  begin
-    FError := MidiInStop(FMidiHandle);
-    if Ferror <> MMSYSERR_NOERROR then
-      raise EMidiInputError.Create(MidiInErrorString(FError));
-  end;
-end;
-
-{-------------------------------------------------------------------}
-
-procedure TMidiInput.MidiInput(var Message: TMessage);
-{ Triggered by incoming message from DLL.
-  Note DLL has already put the message in the queue }
-begin
-  case Message.Msg of
-    mim_data:
-  { Trigger the user's MIDI input event, if they've specified one and
-  we're not in the process of closing the device. The check for
-  GetEventCount > 0 prevents unnecessary event calls where the user has
-  already cleared all the events from the input buffer using a GetMidiEvent
-  loop in the OnMidiInput event handler }
-      if Assigned(FOnMIDIInput) and (FState = misOpen)
-        and (GetEventCount > 0) then
-        FOnMIDIInput(Self);
-
-    mim_Overflow: { input circular buffer overflow }
-      if Assigned(FOnOverflow) and (FState = misOpen) then
-        FOnOverflow(Self);
-  end;
-end;
-
-{-------------------------------------------------------------------}
-
-procedure Register;
-begin
-  RegisterComponents('Synth', [TMIDIInput]);
-end;
-
-end.
-