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

Pascal/Delphi Source File | 1991-10-29 | 12.3 KB | 321 lines

{ ------------------------------------------------------------------------ }
{  @@ Source Documentation                           *** TP6 Version ***   }
{                                                                          }
{  Copyright (c) Creative Technology Pte Ltd, 1991. All rights reserved.   }
{                                                                          }
{   TITLE       : DEMOVDP.PAS                                              }
{                                                                          }
{   DESCRIPTION :                                                          }
{       This program demostrates how to perform voice out using the        }
{       CTVDSK.DRV driver. The voice out 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 demovdp;

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

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


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

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

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

    intr($21,Regs);

    if (Lo(Regs.Flags) And $01) > 0  then begin
        Error := True;
        GetFileHandle := 0;
    end
    else begin
        GetFileHandle := 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 PlayVoiceInBkgnd                                             }
{                                                                          }
{   DESCRIPTION:                                                           }
{       Control voice plaing at the background using keyboard.             }
{                                                                          }
{   ENTRY:                                                                 }
{       None.                                                              }
{                                                                          }
{   EXIT:                                                                  }
{       None.                                                              }
{                                                                          }
{ ------------------------------------------------------------------------ }

procedure PlayVoiceInBkgnd;
const
    ESC            = 27;
    SPACE          = 32;
    TAB            = 9;
    CR             = 13;

    EXT            = 256;
    LEFTARROW      = (EXT+75);
    RIGHTARROW     = (EXT+77);

var
    key : char;
    keyval : integer;

begin

    repeat
        if KeyPressed then begin
            key := ReadKey;
            keyval := ord(key);

            if ((key = #0) and keyPressed) then begin
                key := ReadKey;
                keyval := ord(key)+EXT;
            end;

            case (keyval) of
                ESC :
                    begin
                        ctvd_stop;
                        writeln('     Voice Stopped ....');
                    end;

                SPACE :
                    begin
                        ctvd_pause;
                        writeln('     Pause ....');
                        writeln('     Press any key to continue ....');
                        key := Readkey;
                        ctvd_continue;
                    end;

                CR :
                    begin
                        ctvd_break_loop(1);
                        writeln('     Break-out takes place immediately ....');
                    end;

                TAB :
                    begin
                        ctvd_break_loop(0);
                        writeln('     Break-out takes place after the',
                                ' current loop finishes ....');
                    end;
            end;
        end;
    until not boolean(_ct_voice_status);

end;


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

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

begin

    Handle := GetFileHandle(szFilename,Error);

    if not Error then begin
        ctvd_speaker(1);

        if ctvd_output(Handle) = 0 then begin
            PlayVoiceInBkgnd;

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

        ctvd_speaker(0);

        CloseFileHandle(Handle);
    end
    else
        writeln('Open ',szFilename,' 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);

                            OutputFile('DEMO.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 variable environment not set or incomplete or invalid.');

end.