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

Pascal/Delphi Source File | 1991-09-27 | 10.9 KB | 278 lines

{ ------------------------------------------------------------------------ }
{  @@ Source Documentation                           *** TP6 Version ***   }
{                                                                          }
{  Copyright (c) Creative Technology Pte Ltd, 1991. All rights reserved.   }
{                                                                          }
{   TITLE       : DEMOVMR.PAS                                              }
{                                                                          }
{   DESCRIPTION :                                                          }
{       This program demostrates how to perform voice recording using the  }
{       CT-VOICE.DRV driver. The voice recording is using the Conventional }
{       memory method. The recording can be terminated by pressing ESC.    }
{                                                                          }
{       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 CT-VOICE.DRV into memory.                             }
{                                                                          }
{ ------------------------------------------------------------------------ }

program demovmr;

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

{ Include type-defined for VOC header }
{$I sbcvoice.inc }

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


{ ------------------------------------------------------------------------ }
{  @@ Usage                                                                }
{                                                                          }
{   function WriteToFile(var F: file; lpBuf: pointer;                      }
{                        lSize: longint) : Boolean                         }
{                                                                          }
{   DESCRIPTION:                                                           }
{       Write data from buffer to file.                                    }
{                                                                          }
{   ENTRY:                                                                 }
{       F :- File where data to be written to.                             }
{       lpBuf :- buffer to be written to file.                             }
{       lSize :- Size to be written to file.                               }
{                                                                          }
{   EXIT:                                                                  }
{       Return True if successful, else return False.                      }
{                                                                          }
{ ------------------------------------------------------------------------ }

function WriteToFile (var F: file; lpBuf: pointer; lSize: longint) : Boolean;
type
    PtrRec = record
        lo, hi : word
    end;

var
    wByteToWrite, wByteWritten, wTemp : word;

begin

    WriteToFile := True;
    wTemp := 0;

    repeat
        wByteToWrite := $8000;

        if lSize < $8000 then
            wByteToWrite := Word(lSize);

        BlockWrite(F,lpBuf^,wByteToWrite,wByteWritten);

        if wByteWritten <> wByteToWrite then begin
            writeln('Disk Full ...');
            WriteToFile := False;
            lSize := 0;
        end
        else begin
            wTemp := wTemp + wByteWritten;

            { advance pointer }
            PtrRec(lpBuf).lo := PtrRec(lpBuf).lo + wByteWritten;

            { adjust when cross segment }
            if not Boolean(Hi(wTemp)) then
                PtrRec(lpBuf).hi := PtrRec(lpBuf).hi + $1000;

            lSize := lSize - wByteWritten;
        end;
    until not boolean(Lo(word(lSize)));

end;


{ ------------------------------------------------------------------------ }
{  @@ Usage                                                                }
{                                                                          }
{   function Recording (lpBuf: pointer; lBufSize: longint) : Boolean       }
{                                                                          }
{   DESCRIPTION:                                                           }
{       Start recording voice.                                             }
{                                                                          }
{   ENTRY:                                                                 }
{       lpBuf :- buffer for voice recording.                               }
{       lBufSize :- buffer size.                                           }
{                                                                          }
{   EXIT:                                                                  }
{       True if successful, else return False.                             }
{                                                                          }
{ ------------------------------------------------------------------------ }

function Recording (lpBuf: pointer; lpBufSize: longint) : Boolean;
begin
    Recording := False;
    ctvm_speaker(0);

    if ctvm_input(lpBuf,lpBufSize,8000) = 0 then begin
        Recording := True;
        writeln('Start recording, press ESC key to terminate .....');

        repeat
            if KeyPressed then
                if ReadKey = #27 then
                    ctvm_stop;

        until not Boolean(_ct_voice_status);

        writeln('Recording end.');
    end;

end;


{ ------------------------------------------------------------------------ }
{  @@ Usage                                                                }
{                                                                          }
{   procedure SaveVoiceFile(szFilename: string; lpBuf: pointer)            }
{                                                                          }
{   DESCRIPTION:                                                           }
{       Save recorded voice from memory to file.                           }
{                                                                          }
{   ENTRY:                                                                 }
{       szFilename :- file name to be saved to.                            }
{       lpBuf :- recorded voice buffer.                                    }
{                                                                          }
{   EXIT:                                                                  }
{       None                                                               }
{                                                                          }
{ ------------------------------------------------------------------------ }

procedure SaveVoiceFile (szFilename: string; lpBuf: pointer);
var
    F : file;
    lVoiceSize, lTemp : longint;
    header : VOCHDR;
    dummy : boolean;
    S : String[20];

begin
    S := 'Creative Voice File';
    move( S[1], header.id, 20 );
    header.id[19] := #26;
    header.voice_offset := SizeOf(VOCHDR);
    header.version := $010a;
    header.check_code := $1129;

    {$I-}
    Assign(F, szFilename);
    Rewrite(F,1);
    {$I+}

    if IOResult = 0 then begin
        if WriteToFile(F,@header,longint(SizeOf(VOCHDR))) then begin
            lVoiceSize := longint( pointer(longint(lpBuf)+1)^ );
            lVoiceSize := lVoiceSize and $00ffffff;

            { add 5 bytes for the bloack header and terminating block }
            lVoiceSize := lVoiceSize + 5;

            dummy := WriteToFile(F,lpBuf,lVoiceSize);
        end;

        Close(F);
    end
    else
        writeln('Create ',szFilename,' error.');

end;


{ ------------------------------------------------------------------------ }
{  @@ Usage                                                                }
{                                                                          }
{   procedure RecordVoice (szFilename: string)                             }
{                                                                          }
{   DESCRIPTION:                                                           }
{       Record voice into a file with filename specified. 128 KB           }
{       memory is allocated for voice recording.                           }
{                                                                          }
{   ENTRY:                                                                 }
{       szFileName :- File to be recorded.                                 }
{                                                                          }
{   EXIT:                                                                  }
{       None                                                               }
{                                                                          }
{ ------------------------------------------------------------------------ }

procedure RecordVoice (szFilename: string);
var
    lpVoiceBuf, lpTmpPtr, lpMarkPtr : pointer;
    lBufSize : longint;

begin

    { allocate memory 128 KB memory }
    Mark(lpMarkPtr);
    GetMem(lpVoiceBuf,$ffff);
    GetMem(lpTmpPtr,$ffff);

    if (lpVoiceBuf <> nil) and (lpTmpPtr <> nil) then begin
        lBufSize := $ffff + $ffff;

        if Recording(lpVoiceBuf,lBufSize) then
            SaveVoiceFile(szFilename,lpVoiceBuf);
    end
    else
        writeln('Memory allocation error ...');

    { release allocated memory }
    Release(lpMarkPtr);

end;


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

{ 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

                    _voice_drv := LoadDriver('CT-VOICE.DRV');

                    if _voice_drv <> nil then begin

                        if ctvm_init = 0 then begin

                            ctvm_speaker(0);

                            RecordVoice('TEMP.VOC');

                            ctvm_terminate;

                        end;
                    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.