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

Pascal/Delphi Source File | 1993-03-31 | 8.2 KB | 340 lines

{****************************************************************************}
{                                                                            }
{ MODULE:         DevFile                                                    }
{                                                                            }
{ DESCRIPTION:    Device driver for the Adlib sound card and compatibles.    }
{                 This works with Sound Blasters and with Covox SM II.       }
{                 It uses timer polling.                                     }
{                                                                            }
{ AUTHOR:         Juan Carlos Arévalo                                        }
{                                                                            }
{ MODIFICATIONS:  Nobody (yet ;-)                                            }
{                                                                            }
{ HISTORY:        12-Nov-1992 Description                                    }
{                                                                            }
{ (C) 1992 VangeliSTeam                                                      }
{____________________________________________________________________________}

UNIT DevFile;

INTERFACE




{ Device ID String. }

CONST
  FileDevID    = 'File';
  FileDevFName : STRING = 'SBDSP$';




FUNCTION FileRun : CHAR;




IMPLEMENTATION

USES Dos, Kbd, SoundDevices, StrConst;


VAR
  Fil : FILE;




FUNCTION DosDevIOCTL(VAR f; Cat, Func: BYTE; VAR Data) : WORD; ASSEMBLER;
  ASM
          PUSH    DS

          MOV     CH,[Cat]
          MOV     CL,[Func]
          LDS     BX,[f]
          MOV     BX,FileRec([DS:BX]).Handle
          LDS     DX,Data
          MOV     AX,$440C
          INT     $21

          POP     DS

          JC      @@Fin
          XOR     AX,AX
@@Fin:
  END;

VAR
  NULL : BYTE ABSOLUTE 0:0;






VAR
  FileBuffer : ARRAY[1..1600] OF BYTE;
  FileDevIdx : WORD;

  TimerPos : BYTE ABSOLUTE 0:$46C;

CONST
  LastTimerPos : BYTE = 0;


FUNCTION FilePoll : BOOLEAN; FAR;
  TYPE
    WB = ARRAY[1..32760] OF WORD;
  CONST
    Delay        : WORD = 0;
    Ct           : WORD = 0;
  VAR
    MBuffer  : ^WB ABSOLUTE Sounding;
    i, j     : WORD;
    r        : WORD;
    lim      : WORD;
  BEGIN

    FilePoll := TRUE;

    IF TimerPos = LastTimerPos THEN EXIT;

    LastTimerPos := TimerPos;

    INC(Ct, 500);
    lim := Ct DIV 180;
    Ct  := Ct MOD 180;

    FOR j := 1 TO lim DO
      BEGIN
        IF DoGetBuffer <> 0 THEN
          BEGIN

            IF FileDevIdx + SoundLeft > 1600 THEN
              BEGIN
{
                DosDevIOCtl(Fil, $80, 3, NULL);
                DosDevIOCtl(Fil, $80, 0, NULL);
}
                BlockWrite(Fil, FileBuffer[1], FileDevIdx, r);
                FileDevIdx := 0;
              END;

                ASM

                 MOV    CX,SoundLeft
                 LES    SI,MBuffer
                 MOV    DI,OFFSET FileBuffer
                 MOV    AX,FileDevIdx
                 ADD    DI,AX

@@lp:
                 MOV    AX,[ES:SI]
                 ADD    AX,[ES:SI+6]
                 ADD    AX,[ES:SI+8]
                 ADD    AX,[ES:SI+14]
                 ADD    AX,[ES:SI+16]
                 ADD    AX,[ES:SI+22]
                 ADD    AX,[ES:SI+24]
                 ADD    AX,[ES:SI+30]

                 MOV    BX,[ES:SI+2]
                 ADD    BX,[ES:SI+4]
                 ADD    BX,[ES:SI+10]
                 ADD    BX,[ES:SI+12]
                 ADD    BX,[ES:SI+18]
                 ADD    BX,[ES:SI+20]
                 ADD    BX,[ES:SI+26]
                 ADD    BX,[ES:SI+28]


                 ADD    AX,BX
                 JNO    @@nooverf
                 JS     @@posit
                  MOV   AX,-32768
                 JMP    @@nooverf
@@posit:          MOV   AX,32767
@@nooverf:
                 XOR    AH,80h
                 MOV    [DI],AH
                 INC    DI
                 ADD    SI,MaxChannels*2
                 LOOP   @@lp

                END;

{
            FOR i := 1 TO SoundLeft DO
              BEGIN
                FileBuffer[FileDevIdx + i] := HI(MBuffer^[i*4] +
                                               MBuffer^[i*4-1] +
                                               MBuffer^[i*4-2] +
                                               MBuffer^[i*4-3]) XOR 128;
              END;
}
            INC(FileDevIdx, SoundLeft);
            Delay := 0;
          END
        ELSE
          INC(Delay);

        PeriodicProc;
        IF Delay > 3 THEN
          BEGIN
            IF FileDevIdx > 0 THEN
              BEGIN
                BlockWrite(Fil, FileBuffer[1], FileDevIdx, r);
              END;
            FilePoll := FALSE;
            EXIT;
          END;


      END;

    FilePoll := TRUE;

  END;


PROCEDURE DevFilePoll; FAR;
  BEGIN
    FilePoll;
  END;


FUNCTION FileRun : CHAR;
  VAR
    ch : CHAR;
  BEGIN

    FileRun := #0;

    WHILE NOT KbdKeyPressed AND FilePoll DO DEC(LastTimerPos);

    WHILE KbdKeyPressed DO
      BEGIN
        ch := CHAR(KbdReadKey);
        FileRun := ch;
      END;

    DeviceIdling := TRUE;

  END;



{----------------------------------------------------------------------------}
{ Name function.                                                             }
{____________________________________________________________________________}

FUNCTION FileName : TDevName; FAR;
  BEGIN
    FileName := GetString(StrDevFileName);
  END;




{----------------------------------------------------------------------------}
{ Autodetect routine. It's always present. Well, it's not, but... O:-)       }
{____________________________________________________________________________}

FUNCTION DevDetect : BOOLEAN; FAR;
  BEGIN
    DevDetect := TRUE;
  END;




{----------------------------------------------------------------------------}
{ Device Initialisation routine.                                             }
{____________________________________________________________________________}

PROCEDURE DevInit(Hz: WORD); FAR;
  VAR
    w     : WORD;
  BEGIN
    Assign(Fil, FileDevFName);
    Rewrite(Fil, 1);

    w := 0;

    DosDevIOCtl(Fil, $80, 1, Hz);
    DosDevIOCtl(Fil, $80, 5, w);

    CalcTimerData(Hz);   { Init variables. Shouldn't do it this way, but... }
    FileDevIdx   := 0;
    DeviceIdling := FALSE;
  END;




{----------------------------------------------------------------------------}
{ Device deinitialisation routine.                                           }
{____________________________________________________________________________}

PROCEDURE DevEnd; FAR;
  BEGIN
{
    DosDevIOCtl(Fil, $80, 0, NULL);
}
    Close(Fil);
  END;




{----------------------------------------------------------------------------}
{ Accesory routines.                                                         }
{____________________________________________________________________________}

PROCEDURE DevChgHz(Hz: WORD); FAR;
  BEGIN
    CalcTimerData(Hz);
    DosDevIOCtl(Fil, $80, 0, NULL);
    Close(Fil);
    Rewrite(Fil, 1);
    DosDevIOCtl(Fil, $80, 1, Hz);
  END;




{----------------------------------------------------------------------------}
{ Device record.                                                             }
{____________________________________________________________________________}

CONST
  FileData : TSoundDevice = (
    DevID      : FileDevID;
    DMA        : FALSE
  );




{----------------------------------------------------------------------------}
{ Init code.                                                                 }
{____________________________________________________________________________}

BEGIN

  WITH FileData DO BEGIN
    Name            := FileName;
    AutoDetect      := DevDetect;
    InitRut         := DevInit;
    ChgHzProc       := DevChgHz;
    GetRealFreqProc := GetRealFreq;
    PollRut         := DevFilePoll;
    EndRut          := DevEnd;
  END;

  InitDevice(@FileData);

END.