DP Tool Club 17/CD_ASCQ_17_101194.iso/dos/prg/geutsrce/digital.pas

Pascal/Delphi Source File | 1994-08-05 | 18.4 KB | 917 lines

UNIT Digital;


INTERFACE


USES Crt,Y360x480;


CONST
 UseXMS:BOOLEAN=True;
 XMSError:Byte =0;
 SpkrBaseTable:ARRAY[0..255] OF BYTE =
        ($40,$40,$40,$40,$40,$40,$40,$40,$40,$40,$3F,$3F,$3F,$3F,$3F,$3F,
         $3F,$3F,$3F,$3F,$3F,$3F,$3E,$3E,$3E,$3E,$3E,$3E,$3E,$3E,$3E,$3E,
         $3D,$3D,$3D,$3D,$3D,$3D,$3D,$3D,$3D,$3C,$3C,$3C,$3C,$3C,$3C,$3C,
         $3C,$3C,$3C,$3B,$3B,$3B,$3B,$3B,$3B,$3B,$3B,$3B,$3B,$3A,$3A,$3A,
         $3A,$3A,$3A,$3A,$3A,$3A,$3A,$39,$39,$39,$39,$39,$39,$39,$39,$39,
         $39,$38,$38,$38,$38,$38,$38,$38,$38,$37,$37,$37,$37,$37,$36,$36,
         $36,$36,$35,$35,$35,$35,$34,$34,$34,$33,$33,$32,$32,$31,$31,$30,
         $30,$2F,$2E,$2D,$2C,$2B,$2A,$29,$28,$27,$26,$25,$24,$23,$22,$21,
         $20,$1F,$1E,$1D,$1C,$1B,$1A,$19,$18,$17,$16,$15,$14,$13,$12,$11,
         $11,$10,$10,$0F,$0F,$0E,$0E,$0D,$0D,$0D,$0C,$0C,$0C,$0C,$0B,$0B,
         $0B,$0B,$0A,$0A,$0A,$0A,$0A,$09,$09,$09,$09,$09,$09,$09,$09,$09,
         $08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$07,$07,$07,$07,
         $07,$07,$07,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$05,$05,
         $05,$05,$05,$05,$05,$05,$05,$05,$04,$04,$04,$04,$04,$04,$04,$04,
         $04,$04,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$02,$02,$02,$02,
         $02,$02,$02,$02,$02,$01,$01,$01,$01,$01,$01,$01,$01,$01,$01,$01);


TYPE
 BufferType=ARRAY[0..0] OF BYTE;
 BufPointer=^BufferType;
 DeviceType=(LPT1, LPT2, PcSpeaker, Adlib, SoundBlaster);
 Card      =(Speaker,AdLibFM,SB_Norm,SB_Pro,SB_16);
 EMMStructure          =RECORD
                          BytesToMoveLo,
                          BytesToMoveHi,
                          SourceHandle,
                          SourceOffsetLo,
                          SourceOffsetHi,
                          DestinationHandle,
                          DestinationOffsetLo,
                          DestinationOffsetHi  :WORD;
                        END;


VAR
 DonePlaying  :BOOLEAN;
 SpkrTable    :ARRAY[0..255] OF BYTE;
 BufSize      :WORD;
 XMSChoice    :BOOLEAN;
 HeaSize      :BYTE;
 SBPort       :WORD;
 Size         :LongInt;
 XMSPos       :LongInt;
 TextBool     :BOOLEAN;
 NoFilter     :BOOLEAN;
 XMSRecord    :EMMStructure;
 FileCounter  :LongInt;
 Buffer,
 XMSEntryPoint:Pointer;
 BufferHandle,
 BytesRead    :WORD;
 CardType     :Card;
 VolMax       :BYTE;
 Segment,
 Decalage     :WORD;
 Counter      :WORD;
 car          :Char;
 ScrollSpeed  :BYTE;
 Stringn      :STRING;


FUNCTION  Hexa_Addr(Address:WORD):WORD;
FUNCTION  NoXMS:BOOLEAN;
PROCEDURE Init_Speaker;
PROCEDURE End_Speaker;
FUNCTION  AdLib_Test:BOOLEAN;
FUNCTION  SB_Test:BOOLEAN;
PROCEDURE Spk_On;
PROCEDURE Spk_Off;
FUNCTION  Mixer_Test:BOOLEAN;
PROCEDURE SbProSetFilter(Filter:BOOLEAN);
PROCEDURE VoiceMixerVol(Volume:BYTE);
PROCEDURE InitializeAdLib;
PROCEDURE SetOutPutDevice(DeviceName:DeviceType);
PROCEDURE SetPlaySpeed(Speed:LONGINT);
PROCEDURE PlayRAWSoundFile(FileName:STRING;SampleRate:WORD);
PROCEDURE LoadPlayXMS(FileName:STRING;SampleRate:WORD);
PROCEDURE CleanUp;


IMPLEMENTATION


TYPE
 ZeroAndOne=0..1;


VAR
 DataLength       :WORD;
 Bufferp          :BufPointer;
 i                :BYTE;
 LPTAddress       :WORD;
 LPTPort          :ARRAY[1 .. 2] OF WORD ABSOLUTE $0040:$0008;
 OldTimerInterrupt:Pointer;
 OldINT9          :Pointer;
 InterruptVector  :ARRAY[0..255] OF Pointer ABSOLUTE $0000:$0000;
 VolReg           :BYTE;
 Sauve            :ARRAY[0..331] OF BYTE;
 X                :WORD;


PROCEDURE CLI;ASSEMBLER;
ASM
  cli
END;


PROCEDURE STI;ASSEMBLER;
ASM
  sti
END;


FUNCTION Hexa_Addr(Address:WORD):WORD;
BEGIN
  Hexa_Addr:=(Address-512) Div 16*10+200;
END;


FUNCTION NoXMS:BOOLEAN;ASSEMBLER;
LABEL JumpOver;
ASM
  push   es
  mov    ax,4300h
  int    2Fh
  mov    bl,1
  cmp    al,80h
  jne    JumpOver
  mov    ax,4310h
  int    2Fh
  mov    [word ptr XMSEntryPoint+0],BX
  mov    [word ptr XMSEntryPoint+2],ES
  mov    bl,0
 JumpOver:
  mov    al,bl
  pop    es
END;


FUNCTION XMSMaxAvail:WORD;ASSEMBLER;
LABEL JumpOver;
ASM
  mov    ah,08h
  mov    XMSError,0
  call   [dword ptr XMSEntryPoint]
  or     ax,ax
  jnz    JumpOver
  mov    XMSError,bl
 JumpOver:
END;


FUNCTION XMSGetMem(SizeInKB:WORD):WORD;ASSEMBLER;
LABEL JumpOver;
ASM
  mov    ah,09h
  mov    dx,SizeInKB
  mov    XMSError,0
  call   [dword ptr XMSEntryPoint]
  or     ax,ax
  jnz    JumpOver
  mov    XMSError,bl
 JumpOver:
  mov    ax,dx
END;


PROCEDURE XMSFreeMem(Handle:WORD);ASSEMBLER;
LABEL JumpOver;
ASM
  mov    ah,0Ah
  mov    dx,Handle
  mov    XMSError,0
  call   [dword ptr XMSEntryPoint]
  or     ax,ax
  jnz    JumpOver
  mov    XMSError,bl
 JumpOver:
END;


PROCEDURE XMSMove(VAR EMMParamBlock:EMMStructure);ASSEMBLER;
LABEL JumpOver;
ASM
  push   ds
  push   es
  push   ds
  pop    es
  mov    ah,0Bh
  mov    XMSError,0
  lds    si,EMMParamBlock
  call   [dword ptr es:XMSEntryPoint]
  or     ax,ax
  jnz    JumpOver
  mov    XMSError,bl
 JumpOver:
  pop    es
  pop    ds
END;


FUNCTION Read_FM:BYTE;
BEGIN
  ASM
    mov   dx ,388h
    in    al ,dx
    mov   @result,al
  END;
END;


PROCEDURE Init_Speaker;ASSEMBLER;
ASM
  In    al ,61h
  Or    al ,3
  Out   61h,al
  Mov   al ,0B6h
  Out   43h,al
  Mov   al ,0B0h
  Out   43h,al
  Mov   al ,034h
  Out   43h,al
  Xor   al ,al
  Out   42h,al
  Out   42h,al
  Mov   al ,090h
  Out   43h,al
END;


PROCEDURE End_Speaker;ASSEMBLER;
ASM
  In    al ,61h
  And   al ,11111100b
  Out   61h,al
END;


PROCEDURE Adlibw(Reg,Data:BYTE);ASSEMBLER;
ASM
  mov   dx ,388h
  mov   al ,Reg
  out   dx ,al
  in    al ,dx
  in    al ,dx
  in    al ,dx
  in    al ,dx
  in    al ,dx
  in    al ,dx
  inc   dx
  mov   al ,Data
  out   dx ,al
  in    al ,dx
  in    al ,dx
  in    al ,dx
  in    al ,dx
  in    al ,dx
  in    al ,dx
  in    al ,dx
  in    al ,dx
  in    al ,dx
  in    al ,dx
  in    al ,dx
  in    al ,dx
  in    al ,dx
  in    al ,dx
  in    al ,dx
  in    al ,dx
  in    al ,dx
  in    al ,dx
  in    al ,dx
  in    al ,dx
  in    al ,dx
  in    al ,dx
  in    al ,dx
  in    al ,dx
  in    al ,dx
  in    al ,dx
  in    al ,dx
  in    al ,dx
  in    al ,dx
  in    al ,dx
  in    al ,dx
  in    al ,dx
  in    al ,dx
  in    al ,dx
  in    al ,dx
END;


FUNCTION AdLib_Test:BOOLEAN;
VAR
 Res1,Res2,i:BYTE;
BEGIN
  AdLibw($01,$00);
  AdLibw($04,$60);
  AdLibw($04,$80);
  Res1:=Read_FM;
  AdLibw($02,$FF);
  AdLibw($04,$21);
  FOR i:=0 TO 200 DO;
    Res2:=Read_FM;
  AdLibw($04,$60);
  AdLibw($04,$80);
  IF (((Res1 AND $E0)=0) AND ((Res2 AND $E0)=$C0)) THEN
  BEGIN
    AdLib_Test:=True;
    CardType  :=AdLibFM;
  END
  ELSE
    AdLib_Test:=False;
END;


FUNCTION SB_Test:BOOLEAN;
CONST
 NrTimes  =10;
 NrTimes2 =50;
VAR
 Found    :BOOLEAN;
 Counter1,
 Counter2 :WORD;
BEGIN
  SBPort  :=$210;
  Found   :=False;
  Counter1:=NrTimes;
  WHILE (SBPort<=$260) AND NOT Found DO
  BEGIN
    Port[SBPort+$6]:=1;
    Port[SBPort+$6]:=0;
    Counter2:=NrTimes2;
    WHILE (Counter2>0) AND (Port[SBPort+$E]<128) DO
      Dec(Counter2);
    IF (Counter2=0) OR (Port[SBPort+$A]<>$AA) THEN
    BEGIN
      Dec(Counter1);
      IF (Counter1=0) THEN
      BEGIN
        Counter1:=NrTimes;
        SBPort  :=SBPort+$10;
      END
    END
    ELSE Found:=True;
  END;
  IF Found THEN
  BEGIN
    SB_Test:=True;
    CardType:=SB_Norm;
  END
  ELSE SB_Test:=False;
END;


PROCEDURE Spk_On;
BEGIN
  REPEAT UNTIL Port[SBPort+$C]<$80;
  Port[SBPort+$C]:=$D1;
END;


PROCEDURE Spk_Off;
BEGIN
  REPEAT UNTIL Port[SBPort+$C]<$80;
  Port[SBPort+$C]:=$D3;
END;


PROCEDURE SbWriteMixerReg(Reg,Val:BYTE);ASSEMBLER;
ASM
  mov   dx ,SBPort
  add   dx ,04h
  mov   al ,Reg
  out   dx ,al
  add   dx ,01h
  mov   al ,Val
  out   dx ,al
END;


FUNCTION SbReadMixerReg(Reg:BYTE):BYTE;ASSEMBLER;
ASM
  mov   dx ,SBPort
  add   dx ,04h
  mov   al ,Reg
  out   dx ,al
  add   dx ,01h
  in    al ,dx
END;


PROCEDURE VoiceMixerVol(Volume:BYTE);
BEGIN
  IF CardType=SB_Pro THEN
    SbWriteMixerReg(VolReg,Volume OR (Volume SHL 4));
  IF CardType=SB_16  THEN
  BEGIN
    SbWriteMixerReg(VolReg  ,Volume);
    SbWriteMixerReg(VolReg+1,Volume);
  END;
END;


FUNCTION Mixer_Test:BOOLEAN;
BEGIN
{  SbWriteMixerReg($00,$00); RESET}
  Mixer_Test:=False;
  SbWriteMixerReg($30,$0B);
  IF SbReadMixerReg($30)=$0B THEN
  BEGIN
    Mixer_Test:=True;
    CardType  :=SB_16;
    VolReg    :=$30;
    SbWriteMixerReg($30  ,$09);
    SbWriteMixerReg($30+1,$09);
    VolMax    :=31;
  END
  ELSE
  BEGIN
    SbWriteMixerReg($22,$F3);
    IF SbReadMixerReg($22)=$F3 THEN
    BEGIN
      Mixer_Test:=True;
      CardType  :=SB_Pro;
      VolReg    :=$22;
      SbWriteMixerReg($22,$99);
      VolMax    :=15;
    END;
  END;
END;


PROCEDURE SbProSetFilter(Filter:BOOLEAN);
VAR
 i:BYTE;
BEGIN
  i:=SbReadMixerReg($0E);
  SbWriteMixerReg($0E,(i AND NOT $20)+(BYTE(Filter) * $20));
END;


PROCEDURE InitializeAdlib;
BEGIN
  FOR i:=1 TO 255 DO
    AdLibw(i,0);
  Adlibw($01,$20);
  Adlibw($C0,$01);
  Adlibw($23,$27);
  Adlibw($43,$00);
  Adlibw($63,$FF);
  Adlibw($83,$0F);
  Adlibw($E3,$02);
  Adlibw($A0,$0C);
  Adlibw($B0,$3F);
END;


PROCEDURE OscilloKey;
VAR
 Xo:BYTE;
BEGIN
  Inc(X);
  IF X>331 THEN X:=0;
  Xo:=i;
  IF Xo>255 THEN Xo:=255;
  IF Xo<1   THEN Xo:=1;
  YEcritPoint(X+14,sauve[X]+441,230);
  YEcritPoint(X+14,sauve[X]+440,230);
  YEcritPoint(X+14,Xo+441,231);
  YEcritPoint(X+14,Xo+440,231);
  sauve[X]:=Xo;
    CASE car OF
     #80:BEGIN
           IF Counter<247*ScrollSpeed THEN
           BEGIN
             Inc(Counter);
             YScroll(Counter DIV ScrollSpeed);
           END;
         END;
     #72:BEGIN
           IF Counter>20*ScrollSpeed THEN
           BEGIN
             Dec(Counter);
             YScroll(Counter DIV ScrollSpeed);
           END;
         END;
    END;
    IF KeyPressed THEN car:=ReadKey;
END;


PROCEDURE PlayPCSpeaker;Interrupt;
CONST
 Counter:WORD=0;
BEGIN
  IF NOT(DonePlaying) THEN
  BEGIN
    IF Counter<=DataLength THEN
    BEGIN
      i:=bufferp^[Counter];
      ASM
        xor   al ,al
        out   42h,al
        mov   al ,i
        mov   bx ,offset SpkrTable
        xlat
        out   42h,al
      END;
      Inc(Counter);
    END
    ELSE
    BEGIN
      DonePlaying:=True;
      Counter    :=0;
    END;
  END;
  ASM
    mov   al ,020h
    out   20h,al
  END;
END;


PROCEDURE PlayLPT;Interrupt;
CONST
 Counter:WORD=0;
BEGIN
  IF NOT(DonePlaying) THEN
  BEGIN
    IF Counter<=DataLength THEN
    BEGIN
      i:=Bufferp^[Counter];
      ASM
        mov   dx, LPTAddress
        mov   al, i
        out   dx, al
      END;
      Inc(Counter);
    END
    ELSE
    BEGIN
      DonePlaying:=True;
      Counter    :=0;
    END;
  END;
  ASM
    mov   al ,020h
    out   20h,al
  END;
END;


PROCEDURE PlayAdlib;Interrupt;
CONST
 Counter:WORD=0;
VAR
 j:BYTE;
BEGIN
  If Not(DonePlaying) Then
  Begin
    If Counter <= DataLength Then
    Begin
      i:=Bufferp^[Counter];
      j:=i SHR 3;
      ASM
        mov   dx ,388h
        mov   al ,043h
        out   dx ,al
        in    al ,dx
        in    al ,dx
        in    al ,dx
        in    al ,dx
        in    al ,dx
        in    al ,dx
        inc   dx
        mov   al , j
        out   dx ,al
      END;
      Inc(Counter);
    END
    ELSE
    BEGIN
      DonePlaying:=True;
      Counter    :=0;
    END;
  END;
  ASM
    mov   al ,020h
    out   20h,al
  END;
END;


PROCEDURE PlaySoundBlaster;Interrupt;
CONST
 Counter:WORD=0;
BEGIN
  If Not(DonePlaying) Then
  Begin
    If Counter <= DataLength Then
    Begin
      i:=Bufferp^[Counter];
      ASM
        mov   dx ,SBPort
        add   dx ,0Ch
        mov   cx ,100h
        mov   al ,010h
        out   dx ,al
       @L1:
        in    al ,dx
        or    al ,al
        jns   @OK
        loop  @L1
        ret
       @OK:
        mov   al ,i
        out   dx ,al
      END;
      Inc(Counter);
    END
    ELSE
    BEGIN
      DonePlaying:=True;
      Counter    :=0;
    END;
  END;
  ASM
    mov   al ,020h
    out   20h,al
  END;
END;


PROCEDURE Set8253Channel(ProgramValue:WORD);
BEGIN
  Port[$43]:=54;
  Port[$40]:=Lo(ProgramValue);
  Port[$40]:=Hi(ProgramValue);
END;


PROCEDURE SetPlaySpeed(Speed:LONGINT);
VAR
 ProgramValue:WORD;
BEGIN
  ProgramValue:=1193180 DIV Speed;
  Set8253Channel(ProgramValue);
END;


PROCEDURE SetDefaultTimerSpeed;
BEGIN
  Set8253Channel(0);
END;


FUNCTION LoadBuffer(VAR F:FILE;VAR BufP:BufPointer):WORD;
VAR
 NumRead:WORD;
BEGIN
  BlockRead(F,BufP^,BufSize,NumRead);
  LoadBuffer:=NumRead;
END;


FUNCTION LoadBufferXMS(VAR BufP:BufPointer):WORD;
VAR
 XMSRecord    :EMMStructure;
 NumberOfBytes:WORD;
 NumRead      :WORD;
BEGIN
  NumRead:=BufSize;
  IF (XMSPos+BufSize)>Size THEN
    NumRead:=Size-XMSPos;
  NumberOfBytes:=NumRead;
  IF NumRead MOD 2=1 THEN
    Inc(NumberOfBytes);
  WITH XMSRecord DO
  BEGIN
    BytesToMoveLo      :=NumberOfBytes;
    BytesToMoveHi      :=0;
    SourceHandle       :=BufferHandle;
    SourceOffsetLo     :=XMSPos MOD 65536;
    SourceOffsetHi     :=XMSPos DIV 65536;
    DestinationHandle  :=0;
    DestinationOffsetLo:=Ofs(BufP^);
    DestinationOffsetHi:=Seg(BufP^);
  END;
  XMSMove(XMSRecord);
  IF XMSError<>0 THEN
  BEGIN
    FreeMem(BufP,BufSize);
    Stringn:=' XMS-->RAM error detected';
    XMSFreeMem(BufferHandle);
    Exit;
  END;
  Inc(XMSPos,NumRead);
  LoadBufferXMS:=NumRead;
END;


PROCEDURE PlayBuffer(BufPtr:BufPointer;BSize:WORD);
BEGIN
  Bufferp    :=BufPtr;
  DataLength :=BSize-1;
  DonePlaying:=False;
END;


PROCEDURE PlayBufferXMS(BufPtr:BufPointer;BSize:WORD);
BEGIN
  Bufferp    :=BufPtr;
  DataLength :=BSize-1;
  DonePlaying:=False;
END;


PROCEDURE InitializeData;
CONST
 CalledOnce:BOOLEAN=False;
BEGIN
  IF NOT(CalledOnce) THEN
  BEGIN
    DonePlaying      :=True;
    OldTimerInterrupt:=InterruptVector[$08];
    CalledOnce       :=True;
  END;
  FOR X:=0 TO 331 DO
    sauve[X]:=128;
  X:=0;
END;


PROCEDURE SetOutPutDevice(DeviceName:DeviceType);
BEGIN
  CLI;
  CASE DeviceName OF
    LPT1,LPT2   :BEGIN
                   LPTAddress:=LPTPort[Ord(DeviceName)];
                   InterruptVector[$08]:=@PlayLPT;
                 END;
    PCSpeaker   :BEGIN
                   InterruptVector[$08]:=@PlayPCSpeaker;
                 END;
    Adlib       :BEGIN
                   InterruptVector[$08]:=@PlayAdlib;
                 END;
    SoundBlaster:BEGIN
                   InterruptVector[$08]:=@PlaySoundBlaster;
                 END;
    ELSE
    BEGIN
     { This Sound Device is not available.
      Using the PC Speaker as the Sound Device...}
      InterruptVector[$08]:=@PlayPCSpeaker;
    END;
  END;
  STI;
END;


PROCEDURE SetTimerInterruptVectorDefault;
BEGIN
  CLI;
  InterruptVector[$08]:=OldTimerInterrupt;
  STI;
END;


PROCEDURE PlayRAWSoundFile(FileName:STRING;SampleRate:WORD);
VAR
 RawDataFile:FILE;
 SoundBuffer:ARRAY[ZeroAndOne] OF BufPointer;
 BufNum     :ZeroAndOne;
 Size       :WORD;
BEGIN
  GetMem(SoundBuffer[0],BufSize);
  GetMem(SoundBuffer[1],BufSize);
  SetPlaySpeed(SampleRate);
  Assign(RawDataFile,FileName);
  Reset (RawDataFile,1);
  IF HeaSize>0 THEN
    Seek(RawDataFile,HeaSize);
  BufNum:=0;
  Size:=LoadBuffer(RawDataFile,SoundBuffer[BufNum]);
  PlayBuffer(SoundBuffer[BufNum],Size);
  car:=#80;
  WHILE (NOT(EOF(RawDataFile)) AND (car<>#27)) DO
  BEGIN
    BufNum:=(BufNum+1) AND 1;
    Size  :=LoadBuffer(RawDataFile,SoundBuffer[BufNum]);
    REPEAT OscilloKey; UNTIL DonePlaying;
    PlayBuffer(SoundBuffer[BufNum],Size);
  END;
  Close(RawDataFile);
  REPEAT OscilloKey; UNTIL DonePlaying;
  SetDefaultTimerSpeed;
  FreeMem(SoundBuffer[1],BufSize);
  FreeMem(SoundBuffer[0],BufSize);
END;


PROCEDURE LoadPlayXMS(FileName:STRING;SampleRate:WORD);
VAR
 RawDataFile:FILE;
 SoundBuffer:ARRAY[ZeroAndOne] OF BufPointer;
 BufNum     :ZeroAndOne;
 SizeS      :WORD;
BEGIN
  XMSError:=0;
  IF MaxAvail<16000 THEN
  BEGIN
    XMSError:=1;
    Stringn:=' Not enough RAM memory for XMS buffer';
    Exit;
  END;
  GetMem(Buffer,16000);
  Assign(RawDataFile,FileName);
  Reset (RawDataFile,1);
  Size:=FileSize(RawDataFile);
  IF XMSMaxAvail<=(Size+1023) SHR 10 THEN
  BEGIN
    FreeMem(Buffer,16000);
    Close(RawDataFile);
    XMSError:=2;
    Stringn:=' Not enough XMS memory';
    Exit;
  END
  ELSE
  BEGIN
    Seek(RawDataFile,0);
    BufferHandle:=XMSGetMem((Size+1023) SHR 10);
    FileCounter:=0;
    REPEAT
      BlockRead(RawDataFile,Buffer^,16000,BytesRead);
      IF BytesRead MOD 2=1 THEN
        Inc(BytesRead);
      IF BytesRead<>0 THEN
      BEGIN
        WITH XMSRecord DO
        BEGIN
          BytesToMoveLo      :=BytesRead;
          BytesToMoveHi      :=0;
          SourceHandle       :=0;
          SourceOffsetLo     :=Ofs(Buffer^);
          SourceOffsetHi     :=Seg(Buffer^);
          DestinationHandle  :=BufferHandle;
          DestinationOffsetLo:=FileCounter MOD 65536;
          DestinationOffsetHi:=FileCounter DIV 65536;
        END;
        XMSMove(XMSRecord);
        IF XMSError<>0 THEN
        BEGIN
          FreeMem(Buffer,16000);
          Close(RawDataFile);
          Stringn:=' RAM-->XMS error detected';
          XMSFreeMem(BufferHandle);
          Exit;
        END;
        Inc(FileCounter,BytesRead);
      END;
    UNTIL BytesRead<>16000;
  END;
  Close(RawDataFile);
  FreeMem(Buffer,16000);
  GetMem(SoundBuffer[0],BufSize);
  GetMem(SoundBuffer[1],BufSize);
  SetPlaySpeed(SampleRate);
  XMSPos:=0;
  IF HeaSize>0 THEN
    XMSPos:=HeaSize;
  BufNum:=0;
  SizeS:=LoadBufferXMS(SoundBuffer[BufNum]);
  PlayBufferXMS(SoundBuffer[BufNum],SizeS);
  car:=#80;
  WHILE (NOT(XMSPos>=Size) AND (car<>#27)) DO
  BEGIN
    BufNum:=(BufNum+1) AND 1;
    SizeS :=LoadBufferXMS(SoundBuffer[BufNum]);
    REPEAT OscilloKey; UNTIL DonePlaying;
    PlayBufferXMS(SoundBuffer[BufNum],SizeS);
  END;
  REPEAT OscilloKey; UNTIL DonePlaying;
  SetDefaultTimerSpeed;
  XMSFreeMem(BufferHandle);
  FreeMem(SoundBuffer[1],BufSize);
  FreeMem(SoundBuffer[0],BufSize);
END;


PROCEDURE CleanUp;
BEGIN
  SetDefaultTimerSpeed;
  SetTimerInterruptVectorDefault;
END;


BEGIN
  InitializeData;
  CardType:=Speaker;
  SBPort  :=$220;
  VolMax  :=   9;
END.