Liren Large Software Subsidy 10/10.iso/m/m003_1/sdk_dos.ddi/TPASCAL/EFFECT/DEMOFPV.PAS

Pascal/Delphi Source File | 1991-10-31 | 13.9 KB | 368 lines

{ ------------------------------------------------------------------------ }
{  @@ Source Documentation                           *** TP6 Version ***   }
{                                                                          }
{  Copyright (c) Creative Technology Pte Ltd, 1991. All rights reserved.   }
{                                                                          }
{   TITLE       : DEMOFPV.PAS                                              }
{                                                                          }
{   DESCRIPTION :                                                          }
{       This program demostrates how to use the AUXDRV.DRV driver to       }
{       perform panning and fading effect on the playing voice.            }
{                                                                          }
{       You need to have a Sound Blaster Pro card to run this program.     }
{                                                                          }
{       Note that the BLASTER environment has to be set before executing   }
{       this program.                                                      }
{                                                                          }
{ ------------------------------------------------------------------------ }

program demofpv;

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

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


var
    dummy : integer;


{ ------------------------------------------------------------------------ }
{  @@ 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                                                                }
{                                                                          }
{   function OutputVoice (Handle : integer) : Boolean                      }
{                                                                          }
{   DESCRIPTION:                                                           }
{       Output voice with the file handle specified.                       }
{                                                                          }
{   ENTRY:                                                                 }
{       Handle : handle of a file to be outputted.                         }
{                                                                          }
{   EXIT:                                                                  }
{       True if successful, else return False.                             }
{                                                                          }
{ ------------------------------------------------------------------------ }

function OutputVoice (Handle : integer) : Boolean;
begin

    OutputVoice := True;
    ctvd_speaker(1);

    if ctvd_output(Handle) <> 0 then begin
        OutputVoice := False;
        ShowError;
    end;

end;


{ ------------------------------------------------------------------------ }
{  @@ Usage                                                                }
{                                                                          }
{   procedure WaitEffectEnd                                                }
{                                                                          }
{   DESCRIPTION:                                                           }
{       Control the Fading and Panning effect of the digitized sound.      }
{                                                                          }
{   ENTRY:                                                                 }
{       None                                                               }
{                                                                          }
{   EXIT:                                                                  }
{       None                                                               }
{                                                                          }
{ ------------------------------------------------------------------------ }

procedure WaitEffectEnd;
const
    ESC     = 27;
    up_P    = 80;
    lo_p    = 112;
    up_C    = 67;
    lo_c    = 99;
    EXT     = 256;

var
    key : char;
    keyval : integer;

begin

    repeat
        { Stop effect if no voice process }
        if _ct_voice_status = 0 then
            dummy := ctadStopCtrl;

        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
                        dummy := ctadStopCtrl;
                        ctvd_stop;
                    end;
                up_P,lo_p :
                    begin
                        dummy := ctadPauseCtrl;
                        ctvd_pause;
                    end;
                up_C,lo_c :
                    begin
                        dummy := ctadStartCtrl;
                        ctvd_continue;
                    end;
            end;
        end;
    until not ( Boolean(_CTFadeStatus) or Boolean(_CTPanStatus) );

end;


{ ------------------------------------------------------------------------ }
{  @@ Usage                                                                }
{                                                                          }
{   procedure SoundEffect                                                  }
{                                                                          }
{   DESCRIPTION:                                                           }
{       Add sound effect on the playback digitized sound.                  }
{                                                                          }
{   ENTRY:                                                                 }
{       None                                                               }
{                                                                          }
{   EXIT:                                                                  }
{       None                                                               }
{                                                                          }
{ ------------------------------------------------------------------------ }

procedure SoundEffect;
const
    VOC_VOL     = 1;

var
    wPrevVol : word;

begin

    ctadInit;

    { preserve the previous voice volume settings }
    wPrevVol := ctadGetVolume( VOC_VOL ) ;

    { set voice left/right volume to 0 }
    dummy := ctadSetVolume( VOC_VOL, 0 ) ;

    { Setup voice volume fading in mode 0 }
    dummy := ctadFade( VOC_VOL, $f0f0, 5000, 0, 0 ) ;
    dummy := ctadStartCtrl;
    WaitEffectEnd;


    { Setup digitized sound for panning in mode 1  }
    { repeat for 5 counts                          }
    dummy := ctadPan( VOC_VOL, 0, 255, 600, 1, 5 ) ;
    dummy := ctadStartCtrl;
    WaitEffectEnd;


    { set voice left/right volume to 0xf0f0 }
    dummy := ctadSetVolume( VOC_VOL, $f0f0 ) ;

    { Setup voice volume fading in mode 0 }
    dummy := ctadFade( VOC_VOL, 0, 5000, 0, 0 ) ;
    dummy := ctadStartCtrl;
    WaitEffectEnd;


    { set voice left/right volume back to previous status }
    dummy := ctadSetVolume( VOC_VOL, wPrevVol ) ;

    ctadTerminate;

end;



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

var
    lpDoubleBuf: pointer;
    hHandle : integer;
    Err : Boolean;

{ 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');
                    _CTAuxDrv := LoadDriver('AUXDRV.DRV');

                    if (_ctvdsk_drv <> nil) and (_CTAuxDrv <> 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

                            hHandle := GetFileHandle('DEMO1.VOC',Err);

                            if not Err then begin

                                if OutputVoice(hHandle) then
                                    SoundEffect;

                                CloseFileHandle(hHandle);
                            end
                            else
                                writeln('Open DEMO1.VOC error ...');

                            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.