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

Pascal/Delphi Source File | 1991-11-01 | 8.3 KB | 239 lines

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

program demovmp;

{ 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  }

var
    lpVoiceBuf : pointer;


{ ------------------------------------------------------------------------ }
{  @@ Usage                                                                }
{                                                                          }
{   function LoadFile (szFilename : string) : Boolean                      }
{                                                                          }
{   DESCRIPTION:                                                           }
{       Load file into memory.                                             }
{                                                                          }
{   ENTRY:                                                                 }
{       szFileName :- File to be loaded.                                   }
{                                                                          }
{   EXIT:                                                                  }
{       True if successful, else return False.                             }
{                                                                          }
{ ------------------------------------------------------------------------ }

function LoadFile (szFilename : string) : Boolean;
type
    PtrRec = record
        lo, hi : word
    end;

var
    wTemp, wByteRead : word;
    lpTmpPtr : pointer;
    lFSize : longint;
    F : file;

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

    LoadFile := False;

    if IOResult = 0 then begin
        lFSize := FileSize(F);

        { allocate memory }
        Mark(lpVoiceBuf);

        repeat
            wTemp := $8000;

            if lFSize < $8000 then
                wTemp := word(lFSize);

            GetMem(lpTmpPtr,wTemp);

            lFSize := lFSize - wTemp;
        until not Boolean(Lo(word(lFSize)));

        if (lpTmpPtr <> nil) then begin
            lpTmpPtr := lpVoiceBuf;
            LoadFile := True;
            wByteRead := 0;

            { Read data from file to buffer }
            repeat
                BlockRead(F,lpTmpPtr^,$8000,wTemp);
                wByteRead := wByteRead + wTemp;

                { advance pointer }
                PtrRec(lpTmpPtr).lo := PtrRec(lpTmpPtr).lo + wTemp;

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

            until wTemp <> $8000;
        end
        else
            writeln('Memory allocation error ...');

        close(F);
    end
    else
        writeln('Open ',szFilename,' error ...');
end;



{ ------------------------------------------------------------------------ }
{  @@ Usage                                                                }
{                                                                          }
{   procedure OutputVoice                                                  }
{                                                                          }
{   DESCRIPTION:                                                           }
{       Output voice from a memory buffer. The user is allowed to control  }
{       the voice output from the keyboard.                                }
{                                                                          }
{   ENTRY:                                                                 }
{       None                                                               }
{                                                                          }
{   EXIT:                                                                  }
{       None                                                               }
{                                                                          }
{ ------------------------------------------------------------------------ }

procedure OutputVoice;
const
    ESC     = 27;
    up_P    = 80;
    lo_p    = 112;
    up_C    = 67;
    lo_c    = 99;
    up_B    = 66;
    lo_b    = 98;
    up_S    = 83;
    lo_s    = 115;
    EXT     = 256;

var
    key : char;
    keyval, dummy : integer;
    lpBufPtr : pointer;
    lTemp : Longint;

begin

    lTemp := Longint(lpVoiceBuf) + Longint((VOCHDR(lpVoiceBuf^)).voice_offset);
    lpBufPtr := pointer(lTemp);

    ctvm_speaker(1);

    if ctvm_output(lpBufPtr) = 0 then 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
                    up_S,lo_s,ESC :
                        ctvm_stop;
                    up_P,lo_p :
                        dummy := ctvm_pause;
                    up_C,lo_c :
                        dummy := ctvm_continue;
                    up_B,lo_b :
                        dummy := ctvm_break_loop(1);
                end;
            end;
        until not boolean(_ct_voice_status);
    end;

    ctvm_speaker(0);
end;



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

{ main function }
var
    wVersion : word;

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);
                            wVersion := ctvm_version;
                            writeln('     CT-VOICE version ',Hi(wVersion),
                                    '.',Lo(wVersion):2);

                            if LoadFile('DEMO.VOC')  then begin
                                OutputVoice;
                                Release(lpVoiceBuf);
                            end;

                            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.