Reordering of the directories[1]: moving Game/Code to src

git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1302 b956fd51-792f-4845-bead-9b4dfca2ff2c

1 files changed, 0 insertions, 619 deletions

diff --git a/Game/Code/lib/midi/Midiout.pas b/Game/Code/lib/midi/Midiout.pas
deleted file mode 100644
index 606d0dae..00000000
--- a/Game/Code/lib/midi/Midiout.pas
+++ /dev/null
@@ -1,619 +0,0 @@
-{ $Header: /MidiComp/MidiOut.pas 2     10/06/97 7:33 Davec $ }
-
-{ Written by David Churcher <dchurcher@cix.compulink.co.uk>,
-  released to the public domain. }
-
-{ Thanks very much to Fred Kohler for the Technology code. }
-
-unit MidiOut;
-
-{
-  MIDI Output component.
-
-  Properties:
-   DeviceID: 	Windows numeric device ID for the MIDI output device.
- Between 0 and (midioutGetNumDevs-1), or MIDI_MAPPER (-1).
-    Special value MIDI_MAPPER specifies output to the Windows MIDI mapper
- Read-only while device is open, exception if changed while open
-
- MIDIHandle:	The output handle to the MIDI device.
- 0 when device is not open
- Read-only, runtime-only
-
- ProductName: Name of the output device product that corresponds to the
- DeviceID property (e.g. 'MPU 401 out').
- You can write to this while the device is closed to select a particular
- output device by name (the DeviceID property will change to match).
- Exception if this property is changed while the device is open.
-
- Numdevs: Number of MIDI output devices installed on the system. This
- is the value returned by midiOutGetNumDevs. It's included for
- completeness.
-
-    Technology: Type of technology used by the MIDI device. You can set this
-    property to one of the values listed for OutportTech (below) and the component
-    will find an appropriate MIDI device. For example:
-     MidiOutput.Technology := opt_FMSynth;
-    will set MidiInput.DeviceID to the MIDI device ID of the FM synth, if one
-    is installed. If no such device is available an exception is raised,
-    see MidiOutput.SetTechnology.
-
- See the MIDIOUTCAPS entry in MMSYSTEM.HLP for descriptions of the
- following properties:
-  DriverVersion
-  Voices
-  Notes
-  ChannelMask
-  Support
-
- Error: The error code for the last MMSYSTEM error. See the MMSYSERR_
- entries in MMSYSTEM.INT for possible values.
-
-  Methods:
- Open: Open MIDI device specified by DeviceID property for output
-
- Close: Close device
-
- PutMidiEvent(Event:TMyMidiEvent): Output a note or sysex message to the
- device. This method takes a TMyMidiEvent object and transmits it.
- Notes:
-   1. If the object contains a sysex event the OnMidiOutput event will
-    be triggered when the sysex transmission is complete.
-   2. You can queue up multiple blocks of system exclusive data for
-    transmission by chucking them at this method; they will be
-   transmitted as quickly as the device can manage.
-   3. This method will not free the TMyMidiEvent object, the caller
-    must do that. Any sysex data in the TMyMidiEvent is copied before
-   transmission so you can free the TMyMidiEvent immediately after
-   calling PutMidiEvent, even if output has not yet finished.
-
- PutShort(MidiMessage: Byte; Data1: Byte; Data2: Byte): Output a short
- MIDI message. Handy when you can't be bothered to build a TMyMidiEvent.
- If the message you're sending doesn't use Data1 or Data2, set them to 0.
-
- PutLong(TheSysex: Pointer; msgLength: Word): Output sysex data.
-  SysexPointer: Pointer to sysex data to send
-  msgLength: Length of sysex data.
- This is handy when you don't have a TMyMidiEvent.
-
- SetVolume(Left: Word, Right: Word): Set the volume of the
- left and right channels on the output device (only on internal devices?).
- 0xFFFF is maximum volume. If the device doesn't support separate
- left/right volume control, the value of the Left parameter will be used.
- Check the Support property to see whether the device supports volume
- control. See also other notes on volume control under midiOutSetVolume()
- in MMSYSTEM.HLP.
-
-  Events:
- OnMidiOutput: Procedure called when output of a system exclusive block
- is completed.
-
-  Notes:
-   I haven't implemented any methods for midiOutCachePatches and
-  midiOutCacheDrumpatches, mainly 'cause I don't have any way of testing
-  them. Does anyone really use these?
-}
-
-interface
-
-{$IFDEF FPC}
-  {$MODE Delphi}
-  {$H+} // use AnsiString
-{$ENDIF}
-
-uses
-  SysUtils,
-  Windows,
-  Messages,
-  Classes,
-  MMSystem,
-  {$IFDEF FPC}
-  WinAllocation,
-  {$ENDIF}
-  Circbuf,
-  MidiType,
-  MidiDefs,
-  Delphmcb;
-
-{$IFDEF FPC}
-type TmidioutCaps = MIDIOUTCAPS;
-{$ENDIF}
-
-type
-  midioutputState = (mosOpen, mosClosed);
-  EmidioutputError = class(Exception);
-
- { These are the equivalent of constants prefixed with mod_
-   as defined in MMSystem. See SetTechnology }
-  OutPortTech = (
-    opt_None, { none }
-    opt_MidiPort, { output port }
-    opt_Synth, { generic internal synth }
-    opt_SQSynth, { square wave internal synth }
-    opt_FMSynth, { FM internal synth }
-    opt_Mapper); { MIDI mapper }
-  TechNameMap = array[OutPortTech] of string[18];
-
-
-const
-  TechName: TechNameMap = (
-    'None', 'MIDI Port', 'Generic Synth', 'Square Wave Synth',
-    'FM Synth', 'MIDI Mapper');
-
-{-------------------------------------------------------------------}
-type
-  TMidiOutput = class(TComponent)
-  protected
-    Handle: THandle; { Window handle used for callback notification }
-    FDeviceID: Cardinal; { MIDI device ID }
-    FMIDIHandle: Hmidiout; { Handle to output device }
-    FState: midioutputState; { Current device state }
-    PCtlInfo: PMidiCtlInfo; { Pointer to control info for DLL }
-
-    PBuffer: PCircularBuffer; { Output queue for PutTimedEvent, set by Open }
-
-    FError: Word; { Last MMSYSTEM error }
-
- { Stuff from midioutCAPS }
-    FDriverVersion: MMVERSION; { Driver version from midioutGetDevCaps }
-    FProductName: string; { product name }
-    FTechnology: OutPortTech; { Type of MIDI output device }
-    FVoices: Word; { Number of voices (internal synth) }
-    FNotes: Word; { Number of notes (internal synth) }
-    FChannelMask: Word; { Bit set for each MIDI channels that the
-          device responds to (internal synth) }
-    FSupport: DWORD; { Technology supported (volume control,
-          patch caching etc. }
-    FNumdevs: Word; { Number of MIDI output devices on system }
-
-
-    FOnMIDIOutput: TNotifyEvent; { Sysex output finished }
-
-    procedure MidiOutput(var Message: TMessage);
-    procedure SetDeviceID(DeviceID: Cardinal);
-    procedure SetProductName(NewProductName: string);
-    procedure SetTechnology(NewTechnology: OutPortTech);
-    function midioutErrorString(WError: Word): string;
-
-  public
- { Properties }
-    property MIDIHandle: Hmidiout read FMIDIHandle;
-    property DriverVersion: MMVERSION { Driver version from midioutGetDevCaps }
-    read FDriverVersion;
-    property Technology: OutPortTech { Type of MIDI output device }
-    read FTechnology
-      write SetTechnology
-      default opt_Synth;
-    property Voices: Word { Number of voices (internal synth) }
-    read FVoices;
-    property Notes: Word { Number of notes (internal synth) }
-    read FNotes;
-    property ChannelMask: Word { Bit set for each MIDI channels that the }
-    read FChannelMask; { device responds to (internal synth) }
-    property Support: DWORD { Technology supported (volume control, }
-    read FSupport; { patch caching etc. }
-    property Error: Word read FError;
-    property Numdevs: Word read FNumdevs;
-
- { Methods }
-    function Open: Boolean; virtual;
-    function Close: Boolean; virtual;
-    procedure PutMidiEvent(theEvent: TMyMidiEvent); virtual;
-    procedure PutShort(MidiMessage: Byte; Data1: Byte; Data2: Byte); virtual;
-    procedure PutLong(TheSysex: Pointer; msgLength: Word); virtual;
-    procedure SetVolume(Left: Word; Right: Word);
-    constructor Create(AOwner: TComponent); override;
-    destructor Destroy; override;
-
-   { Some functions to decode and classify incoming messages would be nice }
-
-  published
- { TODO: Property editor with dropdown list of product names }
-    property ProductName: string read FProductName write SetProductName;
-
-    property DeviceID: Cardinal read FDeviceID write SetDeviceID default 0;
- { TODO: midiOutGetVolume? Or two properties for Left and Right volume?
-   Is it worth it??
-     midiOutMessage?? Does anyone use this? }
-
- { Events }
-    property Onmidioutput: TNotifyEvent
-      read FOnmidioutput
-      write FOnmidioutput;
-  end;
-
-procedure Register;
-
-{-------------------------------------------------------------------}
-implementation
-
-(* Not used in Delphi 3
-
-{ This is the callback procedure in the external DLL.
-  It's used when midioutOpen is called by the Open method.
-  There are special requirements and restrictions for this callback
-  procedure (see midioutOpen 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}
-function midiHandler(
-    hMidiIn: HMidiIn;
-    wMsg: Word;
-    dwInstance: DWORD;
-    dwParam1: DWORD;
-    dwParam2: DWORD): Boolean; far; external 'DELPHMID.DLL';
-{$ENDIF}
-*)
-
-{-------------------------------------------------------------------}
-
-constructor Tmidioutput.Create(AOwner: TComponent);
-begin
-  inherited Create(AOwner);
-  FState := mosClosed;
-  FNumdevs := midiOutGetNumDevs;
-
- { Create the window for callback notification }
-  if not (csDesigning in ComponentState) then
-  begin
-    Handle := AllocateHwnd(MidiOutput);
-  end;
-
-end;
-
-{-------------------------------------------------------------------}
-
-destructor Tmidioutput.Destroy;
-begin
-  if FState = mosOpen then
-    Close;
-  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 midioutGetErrorText. TODO: These errors aren't very helpful
-  (e.g. "an invalid parameter was passed to a system function") so
-  some proper error strings would be nice. }
-
-
-function Tmidioutput.midioutErrorString(WError: Word): string;
-var
-  errorDesc: PChar;
-begin
-  errorDesc := nil;
-  try
-    errorDesc := StrAlloc(MAXERRORLENGTH);
-    if midioutGetErrorText(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 output device ID and change the other properties to match }
-
-procedure Tmidioutput.SetDeviceID(DeviceID: Cardinal);
-var
-  midioutCaps: TmidioutCaps;
-begin
-  if FState = mosOpen then
-    raise EmidioutputError.Create('Change to DeviceID while device was open')
-  else
-    if (DeviceID >= midioutGetNumDevs) and (DeviceID <> MIDI_MAPPER) then
-      raise EmidioutputError.Create('Invalid device ID')
-    else
-    begin
-      FDeviceID := DeviceID;
-
-   { Set the name and other midioutCAPS properties to match the ID }
-      FError :=
-        midioutGetDevCaps(DeviceID, @midioutCaps, sizeof(TmidioutCaps));
-      if Ferror > 0 then
-        raise EmidioutputError.Create(midioutErrorString(FError));
-
-      with midiOutCaps do
-      begin
-        FProductName := StrPas(szPname);
-        FDriverVersion := vDriverVersion;
-        FTechnology := OutPortTech(wTechnology);
-        FVoices := wVoices;
-        FNotes := wNotes;
-        FChannelMask := wChannelMask;
-        FSupport := dwSupport;
-      end;
-
-    end;
-end;
-
-{-------------------------------------------------------------------}
-{ Set the product name property and put the matching output device number
-  in FDeviceID.
-  This is handy if you want to save a configured output/output device
-  by device name instead of device number, because device numbers may
-  change if users install or remove MIDI devices.
-  Exception if output device with matching name not found,
-  or if output device is open }
-
-procedure Tmidioutput.SetProductName(NewProductName: string);
-var
-  midioutCaps: TmidioutCaps;
-  testDeviceID: Integer;
-  testProductName: string;
-begin
-  if FState = mosOpen then
-    raise EmidioutputError.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
-    { Loop uses -1 to test for MIDI_MAPPER as well }
-      for testDeviceID := -1 to (midioutGetNumDevs - 1) do
-      begin
-        FError :=
-          midioutGetDevCaps(testDeviceID, @midioutCaps, sizeof(TmidioutCaps));
-        if Ferror > 0 then
-          raise EmidioutputError.Create(midioutErrorString(FError));
-        testProductName := StrPas(midioutCaps.szPname);
-        if testProductName = NewProductName then
-        begin
-          FProductName := NewProductName;
-          Break;
-        end;
-      end;
-      if FProductName <> NewProductName then
-        raise EmidioutputError.Create('MIDI output Device ' +
-          NewProductName + ' not installed')
-      else
-        SetDeviceID(testDeviceID);
-    end;
-end;
-
-{-------------------------------------------------------------------}
-{ Set the output technology property and put the matching output device
- number in FDeviceID.
-  This is handy, for example, if you want to be able to switch between a
-  sound card and a MIDI port }
-
-procedure TMidiOutput.SetTechnology(NewTechnology: OutPortTech);
-var
-  midiOutCaps: TMidiOutCaps;
-  testDeviceID: Integer;
-  testTechnology: OutPortTech;
-begin
-  if FState = mosOpen then
-    raise EMidiOutputError.Create(
-      'Change to Product Technology while device was open')
-  else
-  begin
-       { Loop uses -1 to test for MIDI_MAPPER as well }
-    for testDeviceID := -1 to (midiOutGetNumDevs - 1) do
-    begin
-      FError :=
-        midiOutGetDevCaps(testDeviceID,
-        @midiOutCaps, sizeof(TMidiOutCaps));
-      if Ferror > 0 then
-        raise EMidiOutputError.Create(MidiOutErrorString(FError));
-      testTechnology := OutPortTech(midiOutCaps.wTechnology);
-      if testTechnology = NewTechnology then
-      begin
-        FTechnology := NewTechnology;
-        Break;
-      end;
-    end;
-    if FTechnology <> NewTechnology then
-      raise EMidiOutputError.Create('MIDI output technology ' +
-        TechName[NewTechnology] + ' not installed')
-    else
-      SetDeviceID(testDeviceID);
-  end;
-end;
-
-{-------------------------------------------------------------------}
-
-function Tmidioutput.Open: Boolean;
-var
-  hMem: THandle;
-begin
-  Result := False;
-  try
-  { Create the control info for the DLL }
-    if (PCtlInfo = nil) then
-    begin
-      PCtlInfo := GlobalSharedLockedAlloc(Sizeof(TMidiCtlInfo), hMem);
-      PctlInfo^.hMem := hMem;
-    end;
-
-    Pctlinfo^.hWindow := Handle; { Control's window handle }
-
-    FError := midioutOpen(@FMidiHandle, FDeviceId,
-      DWORD(@midiHandler),
-      DWORD(PCtlInfo),
-      CALLBACK_FUNCTION);
-{                FError := midioutOpen(@FMidiHandle, FDeviceId,
-      Handle,
-      DWORD(PCtlInfo),
-      CALLBACK_WINDOW); }
-    if (FError <> 0) then
-   { TODO: use CreateFmtHelp to add MIDI device name/ID to message }
-      raise EmidioutputError.Create(midioutErrorString(FError))
-    else
-    begin
-      Result := True;
-      FState := mosOpen;
-    end;
-
-  except
-    if PCtlInfo <> nil then
-    begin
-      GlobalSharedLockedFree(PCtlInfo^.hMem, PCtlInfo);
-      PCtlInfo := nil;
-    end;
-  end;
-
-end;
-
-{-------------------------------------------------------------------}
-
-procedure TMidiOutput.PutShort(MidiMessage: Byte; Data1: Byte; Data2: Byte);
-var
-  thisMsg: DWORD;
-begin
-  thisMsg := DWORD(MidiMessage) or
-    (DWORD(Data1) shl 8) or
-    (DWORD(Data2) shl 16);
-
-  FError := midiOutShortMsg(FMidiHandle, thisMsg);
-  if Ferror > 0 then
-    raise EmidioutputError.Create(midioutErrorString(FError));
-end;
-
-{-------------------------------------------------------------------}
-
-procedure TMidiOutput.PutLong(TheSysex: Pointer; msgLength: Word);
-{ Notes: This works asynchronously; you send your sysex output by
-calling this function, which returns immediately. When the MIDI device
-driver has finished sending the data the MidiOutPut function in this
-component is called, which will in turn call the OnMidiOutput method
-if the component user has defined one. }
-{ TODO: Combine common functions with PutTimedLong into subroutine }
-
-var
-  MyMidiHdr: TMyMidiHdr;
-begin
- { Initialize the header and allocate buffer memory }
-  MyMidiHdr := TMyMidiHdr.Create(msgLength);
-
- { Copy the data over to the MidiHdr buffer
-   We can't just use the caller's PChar because the buffer memory
-   has to be global, shareable, and locked. }
-  StrMove(MyMidiHdr.SysexPointer, TheSysex, msgLength);
-
- { Store the MyMidiHdr address in the header so we can find it again quickly
-      (see the MidiOutput proc) }
-  MyMidiHdr.hdrPointer^.dwUser := DWORD(MyMidiHdr);
-
- { Get MMSYSTEM's blessing for this header }
-  FError := midiOutPrepareHeader(FMidiHandle, MyMidiHdr.hdrPointer,
-    sizeof(TMIDIHDR));
-  if Ferror > 0 then
-    raise EMidiOutputError.Create(MidiOutErrorString(FError));
-
- { Send it }
-  FError := midiOutLongMsg(FMidiHandle, MyMidiHdr.hdrPointer,
-    sizeof(TMIDIHDR));
-  if Ferror > 0 then
-    raise EMidiOutputError.Create(MidiOutErrorString(FError));
-
-end;
-
-{-------------------------------------------------------------------}
-
-procedure Tmidioutput.PutMidiEvent(theEvent: TMyMidiEvent);
-begin
-  if FState <> mosOpen then
-    raise EMidiOutputError.Create('MIDI Output device not open');
-
-  with theEvent do
-  begin
-    if Sysex = nil then
-    begin
-      PutShort(MidiMessage, Data1, Data2)
-    end
-    else
-      PutLong(Sysex, SysexLength);
-  end;
-end;
-
-{-------------------------------------------------------------------}
-
-function Tmidioutput.Close: Boolean;
-begin
-  Result := False;
-  if FState = mosOpen then
-  begin
-
-        { Note this sends a lot of fast control change messages which some synths can't handle.
-          TODO: Make this optional. }
-{		FError := midioutReset(FMidiHandle);
-  if Ferror <> 0 then
-   raise EMidiOutputError.Create(MidiOutErrorString(FError)); }
-
-    FError := midioutClose(FMidiHandle);
-    if Ferror <> 0 then
-      raise EMidiOutputError.Create(MidiOutErrorString(FError))
-    else
-      Result := True;
-  end;
-
-  FMidiHandle := 0;
-  FState := mosClosed;
-
-end;
-
-{-------------------------------------------------------------------}
-
-procedure TMidiOutput.SetVolume(Left: Word; Right: Word);
-var
-  dwVolume: DWORD;
-begin
-  dwVolume := (DWORD(Left) shl 16) or Right;
-  FError := midiOutSetVolume(DeviceID, dwVolume);
-  if Ferror <> 0 then
-    raise EMidiOutputError.Create(MidiOutErrorString(FError));
-end;
-
-{-------------------------------------------------------------------}
-
-procedure Tmidioutput.midioutput(var Message: TMessage);
-{ Triggered when sysex output from PutLong is complete }
-var
-  MyMidiHdr: TMyMidiHdr;
-  thisHdr: PMidiHdr;
-begin
-  if Message.Msg = Mom_Done then
-  begin
-  { Find the MIDIHDR we used for the output. Message.lParam is its address }
-    thisHdr := PMidiHdr(Message.lParam);
-
-  { Remove it from the output device }
-    midiOutUnprepareHeader(FMidiHandle, thisHdr, sizeof(TMIDIHDR));
-
-  { Get the address of the MyMidiHdr object containing this MIDIHDR structure.
-   We stored this address in the PutLong procedure }
-    MyMidiHdr := TMyMidiHdr(thisHdr^.dwUser);
-
-  { Header and copy of sysex data no longer required since output is complete }
-    MyMidiHdr.Free;
-
-  { Call the user's event handler if any }
-    if Assigned(FOnmidioutput) then
-      FOnmidioutput(Self);
-  end;
- { TODO: Case for MOM_PLAYBACK_DONE }
-end;
-
-{-------------------------------------------------------------------}
-
-procedure Register;
-begin
-  RegisterComponents('Synth', [Tmidioutput]);
-end;
-
-end.
-