Sound, Music & MIDI Collection 2/SMMVOL2.bin/DOS/SS_PLAY/VTSRC12B.ZIP/LIB/SOUNDDEV.PAS

Pascal/Delphi Source File | 1993-03-23 | 23.2 KB | 682 lines

{****************************************************************************}
{                                                                            }
{ MODULE:         SoundDevices                                               }
{                                                                            }
{ DESCRIPTION:    Implements a common interface to access the different      }
{                 sampled audio devices possible on a PC, wether they work   }
{                 with DMA or polling.                                       }
{                                                                            }
{ AUTHOR:         Juan Carlos Arévalo Baeza                                  }
{                                                                            }
{ MODIFICATIONS:  Nobody yet.                                                }
{                                                                            }
{ HISTORY:        xx-May-1992 Conception.                                    }
{                 xx-Jun-1992 Development.                                   }
{                 21-Jul-1992 Documentation (this mess).                     }
{                 07-Oct-1992 Redo from start :-( (DMA Affairs).             }
{                                                                            }
{ (C) 1992 VangeliSTeam                                                      }
{____________________________________________________________________________}

UNIT SoundDevices;

INTERFACE

USES SongElements;



{----------------------------------------------------------------------------}
{ Device configuration definitions.                                          }
{____________________________________________________________________________}

TYPE
  TDevName = STRING[50];                    { Name/description of device.                                    }
  TDevID   = STRING[20];                    { Device identification string.                                  }

  TProc            = PROCEDURE;                       { Generic procedure without parameters.                }
  TNameProc        = FUNCTION             : TDevName; { Procedure that returns the name of a device.         }
  TInitDevProc     = PROCEDURE (Hz: WORD);            { Device initialisation procedure.                     }
  TChgHzProc       = PROCEDURE (Hz: WORD);            { Sample rate change procedure.                        }
  TGetRealFreqProc = FUNCTION  (Hz: WORD) : WORD;     { Returns the real sampling freq. when Hz is selected. }
  TDetectProc      = FUNCTION             : BOOLEAN;  { Device autodetection procedure.                      }

TYPE
  PSoundDevice = ^TSoundDevice;   { Device record for including in a linked list.                            }
  TSoundDevice = RECORD
    DevID         : TDevID;       { Device ID string.                                                        }
    DMA           : BOOLEAN;      { TRUE if the device uses DMA output (shouldn't be needed).                }

    Name            : TNameProc;        { Device name.                                                       }
    Autodetect      : TDetectProc;      { Autodetection procedure.                                           }
    InitRut         : TInitDevProc;     { Initialisation procedure.                                          }
    ChgHzProc       : TChgHzProc;       { Sample rate change procedure.                                      }
    GetRealFreqProc : TGetRealFreqProc; { Real sampling freq.                                                }
    TimerHandler,                       { INT 8 handler for the device.                                      }
    PollRut         : TProc;            { Routine to be executed for active polling (hand made).             }
    EndRut          : TProc;            { Device closing procedure.                                          }

    Next          : PSoundDevice;     { Next record in the list.                                             }
  END;

CONST
  NumDevices   : BYTE         = 0;   { Count of the number of installed devices.    }
  ActiveDevice : PSoundDevice = NIL; { Device being used right now.                 }




{----------------------------------------------------------------------------}
{ Device Stack.                                                              }
{____________________________________________________________________________}

CONST
  DevStkSize = 500;
VAR
  DevStack : ARRAY[1..DevStkSize] OF BYTE;
  DevSS    : WORD;
  DevSP    : WORD;

{----------------------------------------------------------------------------}
{ Sample buffers definition.                                                 }
{____________________________________________________________________________}

TYPE
  TDataType = (dtShortInt, dtInteger);        { Data type of the samples. }

  TIntBuff   = ARRAY[0..32760] OF INTEGER;    { Data types for big arrays. }
  TShortBuff = ARRAY[0..65520] OF SHORTINT;

  PIntBuff   = ^TIntBuff;                     { Idem. }
  PShortBuff = ^TShortBuff;

  PSampleBuffer = ^TSampleBuffer;   { PCM Buffer. }
  TSampleBuffer = RECORD
    InUse    : BOOLEAN;             { TRUE while it's being used by the device.       }
    NSamples,                       { Size of the buffer in samples.                  }
    RateHz   : WORD;                { Sampling frequency.                             }
    Channels : BYTE;                { 1 or 4, channels contained in the buffer.       }
    CASE DataType : TDataType OF
      dtInteger:  ( IData : PIntBuff );   { Pointer to the buffer.                    }
      dtShortInt: ( SData : PShortBuff );
  END;

CONST
  MaxChannels  = SongElements.MaxChannels;
  Sounding     : POINTER = NIL;  { Buffer that is actually sounding (NON-DMA only). }
  SoundLeft    : WORD    = 0;    { Number of samples left in the buffer.            }
  NumChannels  : BYTE    = 1;    { Number of channels in the buffer.                }
  ChannelIncr  : WORD    = 1;    { Size of one sample in the buffer.                }




{----------------------------------------------------------------------------}
{ DMA buffers definition.                                                    }
{____________________________________________________________________________}

CONST
  DMABufferSize = 5*700;     { Size of the buffers. }

VAR
(*
  DMABuffers : ARRAY[1..DMABufferSize*2] OF BYTE; { Physical memory for buffers.                     }
                                                  { Needs 4 to be sure we have 2 countiguous. :-(    }
                                                  { That's the PC-DMA neverending story.             }
*)

  DMABufferPtr : POINTER;                         { DMA-fixed ;-) pointers for   }
  DMABuffer    : POINTER;                         { buffers 1 and 2.             }
  DMABufferEnd : WORD;




{----------------------------------------------------------------------------}
{ Hardware parameters.                                                       }
{____________________________________________________________________________}

CONST
  DefaultHz                   = 16000;     { Default sampling rate.                                }
  DeviceIdling      : BOOLEAN = TRUE;      { TRUE if there are no samples sounding.                }
  TimerHz           : WORD    = DefaultHz; { Clock frequency of the INT 8 timer.                   }
  LastHz            : WORD    = 0;         { Older INT 8 frequency (for detecting change).         }
  SoundHz           : WORD    = DefaultHz; { Sampling frequency of the sound.                      }
  DesiredHz         : WORD    = DefaultHz; { Desired sampling frequency of the sound.              }
  SystemClockCount  : WORD    = 0;         { Clock count for calling the original INT 8.           }
  SystemClockIncr   : WORD    = 0;         { Increment for calling the original INT 8.             }
  TimerVal          : WORD    = 0;         { Value given to the INT 8 timer.                       }
  DeviceInitialized : BOOLEAN = FALSE;     { TRUE if a device has already been initialized.        }
  DMAOffset         : WORD    = 1;         { Number of samples to discard in DMA transferences.    }
  HzChanged         : BOOLEAN = FALSE;
  DoEqualice        : BOOLEAN = FALSE;



{----------------------------------------------------------------------------}
{ Periodic process.                                                          }
{____________________________________________________________________________}

VAR
  PeriodicProc  : TProc;    { Periodic process (normally a music interpreter).           }

CONST
  PeriodicHz    : BYTE = 0; { Frequency for calling the periodic process.                }
  PeriodicStart : WORD = 1; { Countdown starting point (NON-DMA only).                   }
  PeriodicCount : WORD = 0; { Countdown.               (idem).                           }




{----------------------------------------------------------------------------}
{ Buffer provider definitions.                                               }
{____________________________________________________________________________}

TYPE
  TAskBufferProc = FUNCTION : PSampleBuffer; { Buffer provider function. }

VAR
  AskBufferProc  : TAskBufferProc; { Pointer to the buffer provider.             }
  ActualBuffer,                    { Buffer being used.                          }
  NextBuffer     : PSampleBuffer;  { Buffer that will be used next.              }
  PleaseFallback : WORD{BOOLEAN};        { Set TRUE if there are no buffers available. }




{----------------------------------------------------------------------------}
{ Functions to be used by devices only.                                      }
{____________________________________________________________________________}

FUNCTION  InitDevice   (Device: PSoundDevice) : WORD; { Used to declare a device.                            }
PROCEDURE PollDevice;                                 { Used to manually poll the device, if it is required. }
PROCEDURE CalcTimerData(Hz: WORD);                    { Used to calculate the different Hz variables.        }
PROCEDURE DefaultChgHz (Hz: WORD);                    { Used as a default TChgHzProc.                        }
FUNCTION  GetRealFreq  (Hz: WORD)             : WORD; { Used as a default TRealFreqProc.                     }
PROCEDURE InitTimer;                                  { Used to reinitialise the timer after a freq. change. }
FUNCTION  DoGetBuffer                         : WORD; { Used to get the next buffer prepared.                }
PROCEDURE CSOldInt8;                                  { Used to call the old INT 8 vector.                   }




{----------------------------------------------------------------------------}
{ Functions to be used by the sound generators only.                         }
{____________________________________________________________________________}

PROCEDURE SetDevice      (p: PSoundDevice);                             { Used to initialise a buffer for output.  }
FUNCTION  IndexDevice    (i: WORD)                      : PSoundDevice; { Used to index the devices.               }
FUNCTION  LocateDevice   (ID: STRING)                   : PSoundDevice; { Used to find a given device.             }
PROCEDURE SetPeriodicProc(Proc: TProc; PerSecond: WORD);                { Used to initialise the periodic process. }
PROCEDURE SetBufferAsker (Proc: TAskBufferProc);                        { Used to initialise the buffer asker.     }
PROCEDURE StartSampling;                                                { Used to start the sound output.          }
PROCEDURE EndSampling;                                                  { Used to end the sound output.            }


PROCEDURE InitSoundDevices;




IMPLEMENTATION

USES Dos,
     Debugging, Output43;




{----------------------------------------------------------------------------}
{ Internal data.                                                             }
{____________________________________________________________________________}

CONST
  DeviceList       : PSoundDevice = NIL;   { Linked list of all devices.                     }
  OldInt8          : POINTER      = NIL;   { Pointer to the original INT 8.                  }
  IntInstalled     : BOOLEAN      = FALSE; { TRUE if the INT 8 handler is already installed. }




{----------------------------------------------------------------------------}
{ Null procedures used in the unit.                                          }
{____________________________________________________________________________}

PROCEDURE NullProcedure;                  FAR; ASSEMBLER; ASM END;
FUNCTION  NullBufferProc : PSampleBuffer; FAR; BEGIN NullBufferProc := NIL; END;


PROCEDURE NullInt; ASSEMBLER;
  ASM
        PUSH    AX
        MOV     AL,$20
        OUT     $20,AL
        POP     AX
        IRET
  END;




{----------------------------------------------------------------------------}
{ A little bit messy, but it implements an easy jump to the original INT 8.  }
{____________________________________________________________________________}

PROCEDURE CSOldInt8; ASSEMBLER;
  ASM
        JMP FAR PTR CSOldInt8;
  END;

TYPE
  PCSOldInt8 = ^TCSOldInt8;
  TCSOldInt8 = RECORD
    JMP : BYTE;
    Int : POINTER;
  END;

VAR
  _CSOldInt8 : PCSOldInt8;




{----------------------------------------------------------------------------}
{ Periodic process implementation.                                           }
{____________________________________________________________________________}

PROCEDURE InitPeriodic;
  BEGIN
    IF PeriodicHz = 0 THEN BEGIN
      PeriodicStart   := 0;
      PeriodicCount   := 0;
      SystemClockIncr := TimerVal;
    END ELSE BEGIN
      PeriodicStart := TimerHz DIV PeriodicHz;
      IF PeriodicStart = 0 THEN PeriodicStart := 1;
      PeriodicCount := 1;
      SystemClockIncr := TimerVal * PeriodicStart;
    END;
  END;


PROCEDURE SetPeriodicProc(Proc: TProc; PerSecond: WORD);
  BEGIN
    ASM
        PUSHF
        CLI
        LES     BX,[Proc]
        MOV     WORD PTR [PeriodicProc],BX;
        MOV     WORD PTR [PeriodicProc+2],ES;
        POPF
    END;
    PeriodicHz   := PerSecond;
    InitPeriodic;
  END;




{----------------------------------------------------------------------------}
{ Hardware and interrupt handling procedures.                                }
{____________________________________________________________________________}

PROCEDURE OriginalHwTimer; ASSEMBLER;
  ASM
        MOV     AL,54       { Selct timer 0, secuential access and contínuous mode. }
        OUT     43h,AL
        XOR     AL,AL       { Set the counter to 0 (65536). }
        OUT     40h,AL      { Lower byte of the counter.    }
        OUT     40h,AL      { Higher byte.                  }
  END;


PROCEDURE SetHwTimer(value: WORD); ASSEMBLER;
  ASM
        MOV     AL,54       { Selct timer 0, secuential access and contínuous mode. }
        OUT     43h,AL
        MOV     AX,value
        OUT     40h,AL      { Lower byte of the counter.    }
        XCHG    Ah,AL
        OUT     40h,AL      { Higher byte.                  }
  END;


PROCEDURE RestoreTimer;
  BEGIN
    IF IntInstalled THEN
      BEGIN
        SetIntVec(8, OldInt8);
        OriginalHwTimer;
        IntInstalled := FALSE;
      END;
  END;


PROCEDURE InitTimer;
  BEGIN
    InitPeriodic;

    IF NOT IntInstalled THEN
      BEGIN
        IntInstalled := TRUE;
        GetIntVec(8, OldInt8);
        _CSOldInt8^.Int := OldInt8;
        SetIntVec(8, @ActiveDevice^.TimerHandler);
      END;

    SetHwTimer(TimerVal);
  END;




{----------------------------------------------------------------------------}
{ Procedures exported for the sound generator.                               }
{____________________________________________________________________________}

PROCEDURE StartSampling;
  BEGIN
    IF NOT DeviceInitialized THEN RestoreTimer;

    ActualBuffer      := NIL;
    NextBuffer        := NIL;
    SoundLeft         := 0;
    PleaseFallBack    := 0;
    DeviceIdling      := TRUE;
    DMABufferPtr      := DMABuffer;

    FillChar(DMABuffer^, DMABufferSize, $80);

    IF (ActiveDevice <> NIL) {AND (NOT DeviceInitialized)} THEN
      BEGIN
        ASM CLI END;

        DeviceInitialized := TRUE;

        ActiveDevice^.InitRut(DesiredHz);

        ASM STI END;
      END;

  END;


PROCEDURE EndSampling;
  BEGIN
    IF (ActiveDevice <> NIL) AND DeviceInitialized THEN
      BEGIN
        ASM CLI END;
        ActiveDevice^.EndRut;
        RestoreTimer;
        ASM STI END;
        DeviceInitialized := FALSE;
      END;
  END;


PROCEDURE SetBufferAsker (Proc: TAskBufferProc);
  BEGIN
    ASM CLI END;
     AskBufferProc := Proc;
    ASM STI END;
  END;


PROCEDURE SetDevice(p: PSoundDevice);
  BEGIN
    IF p <> NIL THEN
      BEGIN
        IF DeviceInitialized THEN
          BEGIN
            EndSampling;
            ActiveDevice := p;
            StartSampling;
          END
        ELSE
          ActiveDevice := p;
      END;
  END;


FUNCTION LocateDevice(ID: STRING) : PSoundDevice;

  FUNCTION NotInStr(VAR s, ss: STRING) : BOOLEAN;
    VAR
      i : WORD;
    BEGIN
      NotInStr := TRUE;
      IF Length(ss) > Length(s) THEN EXIT;
      FOR i := 1 TO Length(ss) DO
        IF UpCase(s[i]) <> UpCase(ss[i]) THEN EXIT;
      NotInStr := FALSE;
    END;

  VAR
    p : PSoundDevice;
  BEGIN
    p := DeviceList;
    WHILE (p <> NIL) AND NotInStr(p^.DevID, ID) DO p := p^.Next;
    LocateDevice := p;
  END;


FUNCTION IndexDevice(i: WORD) : PSoundDevice;
  VAR
    p : PSoundDevice;
  BEGIN
    p := DeviceList;
    DEC(i);
    WHILE (p <> NIL) AND (i > 0) DO
      BEGIN
        p := p^.Next;
        DEC(i);
      END;

    IndexDevice := p;
  END;




{----------------------------------------------------------------------------}
{ Implementation of some procedures exported to the device controllers.       }
{____________________________________________________________________________}

FUNCTION InitDevice(Device: PSoundDevice) : WORD;
  BEGIN
    Device^.Next := DeviceList;
    DeviceList   := Device;
    IF ActiveDevice = NIL THEN SetDevice(Device);
    INC(NumDevices);
  END;


PROCEDURE PollDevice;
  BEGIN
    ActiveDevice^.PollRut;
  END;


FUNCTION GetRealFreq(Hz: WORD) : WORD;
  VAR
    i    : WORD;
    NHz1 : WORD;
    NHz2 : WORD;
  BEGIN
    IF Hz = 0 THEN Hz := 1;
    i := 1193180 DIV Hz;

    NHz1 := 1193180 DIV  i;
    NHz2 := 1193180 DIV (i + 1);
    IF ABS(INTEGER(NHz1 - Hz)) > ABS(INTEGER(NHz2 - Hz)) THEN NHz1 := NHz2;

    GetRealFreq := NHz1;
  END;


PROCEDURE CalcTimerData(Hz: WORD);
  BEGIN
    Hz := GetRealFreq(Hz);

    IF Hz = 0 THEN TimerVal := $FFFF
              ELSE TimerVal := 1193180 DIV Hz;

    TimerHz         := 1193180 DIV TimerVal;
    SoundHz         := TimerHz;
{    SystemClockIncr := TimerVal;}
  END;


PROCEDURE DefaultChgHz(Hz: WORD);
  BEGIN
    CalcTimerData(Hz);
    InitTimer;
  END;


FUNCTION DoGetBuffer : WORD;
  CONST
    Semaphore : BYTE    = 0;
    Size      : WORD    = 1;
  BEGIN
    DoGetBuffer := 0;
    IF Semaphore > 0 THEN EXIT;
    INC(Semaphore);

    IF ActualBuffer <> NIL THEN
      BEGIN
        Size := ActualBuffer^.NSamples;
        ActualBuffer^.InUse := FALSE; { It must be already finished using. }
      END;

    ActualBuffer := NextBuffer;
    NextBuffer   := AskBufferProc; { Get the buffer, if there is one. }

    IF ActualBuffer = NIL THEN BEGIN     { If there had not been next buffer before. }
      ActualBuffer := NextBuffer;
      IF ActualBuffer <> NIL THEN BEGIN  { If there has just been one more buffer. }
        ActualBuffer^.InUse := TRUE;
        NextBuffer          := AskBufferProc; { Try to get another one. }
      END;
    END;

    IF NextBuffer <> NIL THEN
      NextBuffer^.InUse := TRUE;

    IF ActualBuffer = NIL THEN
      BEGIN                                  { If there is no buffer :-( }
        IF (Size <> 1) AND (NOT ActiveDevice^.DMA) THEN
          INC(PleaseFallBack);
        SoundLeft      := 0;
        IF NOT ActiveDevice^.DMA THEN
          BEGIN
            PeriodicCount := 1;
            LastHz        := PeriodicHz;
            ActiveDevice^.ChgHzProc(LastHz);
          END;
      END
    ELSE
      BEGIN
        IF (LastHz <> ActualBuffer^.RateHz) THEN BEGIN
          LastHz := ActualBuffer^.RateHz;
          ActiveDevice^.ChgHzProc(LastHz);

          HzChanged := TRUE;

        END;
        Sounding     := ActualBuffer^.IData;
        SoundLeft    := ActualBuffer^.NSamples;
        NumChannels  := ActualBuffer^.Channels;
        ChannelIncr  := ActualBuffer^.Channels * (ORD(ActualBuffer^.DataType)+1);

        IF ActiveDevice^.DMA THEN
          BEGIN
            IF SoundLeft > DMAOffset + 5 THEN
              DEC(SoundLeft, DMAOffset)
            ELSE
              SoundLeft := 5;
          END;


      END;

    DoGetBuffer := SoundLeft;

    WriteNum(40, SoundLeft, $70);

    DEC(Semaphore);
  END;




{----------------------------------------------------------------------------}
{ Unit initialisation.                                                       }
{____________________________________________________________________________}

PROCEDURE InitSoundDevices;
  TYPE
    PFreeBlock = ^TFreeBlock;
    TFreeBlock =
      RECORD
        Next : PFreeBlock;
        Size : POINTER;
      END;
  VAR
    l        : LONGINT;
    PtrFree  : POINTER;
    OldHPtr  : POINTER;
    p        : PFreeBlock;
    OffsFree : WORD;
  BEGIN

    _CSOldInt8 := @CSOldInt8;

    PeriodicProc  := NullProcedure;
    AskBufferProc := NullBufferProc;

    { Calc. for the DMA buffers. This messes with the heap, but works. }

    DMABuffer := HeapPtr;

    l := (LONGINT(SEG(DMABuffer^)) SHL 4) + OFS(DMABuffer^); { l = linear address. }

    PtrFree  := HeapPtr;
    OffsFree := 0;

    IF LONGINT(WORD(l)) + DMABufferSize > 65536 THEN { If address doesn't match,    }
      BEGIN                                          { get an address that matches  }
        OffsFree := 65536 - LONGINT(WORD(l));        { by incrementing to a 64 Kb   }
        l := (l AND $F0000) + $10000;                { boundary.                    }
      END;

    DMABuffer    := Ptr((l SHR 4)  AND $F000, WORD(l));
    DMABufferPtr := DMABuffer;
    DMABufferEnd := OFS(DMABuffer^) + DMABufferSize;

    OldHPtr      := HeapPtr;
    HeapPtr      := Ptr((l + DMABufferSize + 16) SHR 4, 0); { Manually, allocate the }
    IF OldHPtr = FreeList THEN                              { buffer.                }
      BEGIN
        FreeList   := HeapPtr;
      END
    ELSE
      BEGIN
        p := FreeList;
        WHILE p^.Next <> OldHPtr DO
          p := p^.Next;
        p^.Next := HeapPtr;
      END;

    FillChar(HeapPtr^, 8, 0); { Clear the Heap Pointer contents. }

    IF OffsFree > 0 THEN              { Update the Heap by freeing  }
      FreeMem(PtrFree, OffsFree);     { manually the unused memory. }
  END;




END.