Liren Large Software Subsidy 10/10.iso/m/m003_1/sdk_dos.ddi/TPASCAL/VOICE/DEMOVDR.PAS

Pascal/Delphi Source File | 1991-10-29 | 11.0 KB | 271 lines

{ ------------------------------------------------------------------------ }
{  @@ Source Documentation                           *** TP6 Version ***   }
{                                                                          }
{  Copyright (c) Creative Technology Pte Ltd, 1991. All rights reserved.   }
{                                                                          }
{   TITLE       : DEMOVDR.PAS                                              }
{                                                                          }
{   DESCRIPTION :                                                          }
{       This program demostrates how to perform voice recording using      }
{       the CTVDSK.DRV driver. The voice recording is using the Disk       }
{       Double Buffering method.                                           }
{                                                                          }
{       The program checks BLASTER environment for the Card settings.      }
{       It also performs test base on BLASTER environment settings to      }
{       ensure they are tally with the hardware settings on the Card.      }
{                                                                          }
{       Note that the program included the module LOADDRV.PAS to load      }
{       the loadable CTVDSK.DRV into memory.                               }
{                                                                          }
{ ------------------------------------------------------------------------ }

program demovdr;

{ Include the SBC Unit, and any other units needed }
uses sbc_tp6, dos, crt;

{ Include load driver function }
{$I loaddrv.pas  }


{ ------------------------------------------------------------------------ }
{  @@ Usage                                                                }
{                                                                          }
{   function GetCreateFileHandle (szFilename: String;                      }
{                                 var Error: Boolean) : integer            }
{                                                                          }
{   DESCRIPTION:                                                           }
{       Create a file with the filename specified and returns the file     }
{       handle.                                                            }
{                                                                          }
{   ENTRY:                                                                 }
{       szFilename :- filename to create                                   }
{       Error :- Error flag                                                }
{                                                                          }
{   EXIT:                                                                  }
{       File handle. Error flag set to True if error occurs.               }
{                                                                          }
{ ------------------------------------------------------------------------ }

function GetCreateFileHandle (szFilename: String; var Error: Boolean) : integer;
var
    Regs : Registers;

begin
    szFilename := szFilename + #0;
    FillChar( Regs, SizeOf(Regs), 0 );
    With Regs Do
        begin
            AX := $3c00;
            DS := Seg(szFilename);
            DX := Ofs(szFilename)+1;
            CX := $20;
        end;

    intr($21,Regs);

    if (Lo(Regs.Flags) And $01) > 0  then begin
        Error := True;
        GetCreateFileHandle := 0;
    end
    else begin
        GetCreateFileHandle := Regs.AX;
        Error := False;
    end;
end;


{ ------------------------------------------------------------------------ }
{  @@ Usage                                                                }
{                                                                          }
{   procedure CloseFileHandle (Handle: integer)                            }
{                                                                          }
{   DESCRIPTION:                                                           }
{       Close a file with file handle specified.                           }
{                                                                          }
{   ENTRY:                                                                 }
{       Handle :- handle of file to be closed.                             }
{                                                                          }
{   EXIT:                                                                  }
{       None.                                                              }
{                                                                          }
{ ------------------------------------------------------------------------ }

procedure CloseFileHandle (Handle: integer);
var
    Regs : Registers;

begin
    FillChar( Regs, SizeOf(Regs), 0 );
    With Regs Do
        begin
            AX := $3e00;
            BX := Handle;
        end;

    intr($21,Regs);

end;


{ ------------------------------------------------------------------------ }
{  @@ Usage                                                                }
{                                                                          }
{   procedure ShowError                                                    }
{                                                                          }
{   DESCRIPTION:                                                           }
{       Display error occurred during the process of voice I/O.            }
{                                                                          }
{   ENTRY:                                                                 }
{       None.                                                              }
{                                                                          }
{   EXIT:                                                                  }
{       None.                                                              }
{                                                                          }
{ ------------------------------------------------------------------------ }

procedure ShowError;
var
    Err : integer;

begin

    Err := ctvd_drv_error;
    writeln('Driver error = ',Err);

    Err := ctvd_ext_error;
    if (Err <> 0) then
        writeln('DOS error = ',Err);
end;


{ ------------------------------------------------------------------------ }
{  @@ Usage                                                                }
{                                                                          }
{   procedure RecordUntilStopped                                           }
{                                                                          }
{   DESCRIPTION:                                                           }
{       Starts voice recording. Press ESC key to terminate the recording.  }
{                                                                          }
{   ENTRY:                                                                 }
{       None.                                                              }
{                                                                          }
{   EXIT:                                                                  }
{       None.                                                              }
{                                                                          }
{ ------------------------------------------------------------------------ }

procedure RecordUntilStopped;
begin

    repeat
        if keypressed then
            if Readkey = #27 then
                ctvd_stop;

    until not boolean(_ct_voice_status);

end;


{ ------------------------------------------------------------------------ }
{  @@ Usage                                                                }
{                                                                          }
{   procedure RecordFile (szFilename : string)                             }
{                                                                          }
{   DESCRIPTION:                                                           }
{       Record voice with the filename specified.                          }
{                                                                          }
{   ENTRY:                                                                 }
{       szFilename :- filename to be output.                               }
{                                                                          }
{   EXIT:                                                                  }
{       None.                                                              }
{                                                                          }
{ ------------------------------------------------------------------------ }

procedure RecordFile (szFilename : string);
var
    Handle: integer;
    Error: Boolean;

begin

    Handle := GetCreateFileHandle(szFilename,Error);

    if not Error then begin
        ctvd_speaker(0);

        if ctvd_input(Handle,8000) = 0 then begin
            RecordUntilStopped;

            if ctvd_drv_error <> 0 then
                ShowError
            else
                writeln('Voice record ended.');
        end
        else
            ShowError;

        CloseFileHandle(Handle);
    end
    else
        writeln('Create ',szFilename,' file error ...');

end;


{ ------------------------------------------------------------------------ }

var
    lpDoubleBuf: pointer;

{ main function }
begin  { program body }

    if GetEnvSetting = 0 then begin

        if boolean( sbc_check_card and $0004 ) then begin

            if boolean(sbc_test_int) then begin

                if sbc_test_dma >= 0 then begin

                    _ctvdsk_drv := LoadDriver('CTVDSK.DRV');

                    if _ctvdsk_drv <> nil then begin

                        { Allocate memory for Disk Double Buffer. }
                        { Note the the program has to allocate 16 }
                        { bytes more for paragraph adjust.        }

                        GetMem(lpDoubleBuf,61456);
                        ctvd_buffer_addx(lpDoubleBuf,15);

                        if ctvd_init(15) = 0 then begin

                            ctvd_speaker(0);

                            RecordFile('TEMP.VOC');

                            ctvd_terminate;

                        end
                        else
                            ShowError;
                    end;
                end
                else
                    writeln('Error on DMA channel.');
            end
            else
                writeln('Error on interrupt.');
        end
        else
            writeln('Sound Blaster card not found or wrong I/O setting.');
    end
    else
        writeln('BLASTER environment variable not set or incomplete or invalid.');

end.