PROGRAM SOUND
C
C     SOUND CAPABILITIES
C     OLYMPIC SOFTWARE  9/27/88
C
      EXTERNAL INPUT,OUTPUT,SLOGIC
      INTEGER*2 NTON,IFR(5),ICNT(5),IOP
      INTEGER*2 IF0,IAL,IAL1,IAL2,IAL3,IDX,IT,IT1,I
C
      DATA NTON /5/
      DATA IFR(1),IFR(2),IFR(3),IFR(4),IFR(5) /100,300,500,700,900/
      DATA ICNT(1),ICNT(2),ICNT(3),ICNT(4),ICNT(5) /18,18,18,18,18/
C
C***   IFR CONTAINS FREQUENCIES IN HERTZ
C***   ICNT CONTAINS DURATION TIMES IN 1/18 SECONDS
C
      IT=3
      IT1=252
C
C**     GET TIMER READY
      IDX=67
      IAL=182
      CALL OUTPUT(IAL,IDX)
C
C**     TURN SPEAKER ON
      IDX=97
      CALL INPUT(IAL1,IDX)
      IDX=97
      IOP=2
      CALL SLOGIC(IOP,IAL,IAL1,IT)
      CALL OUTPUT(IAL,IDX)
C
      DO 10 I=1,NTON
C**     LOAD FREQUENCY COUNT
      IF0=1.19318E+06/IFR(I)
      IAL2=IF0-INT(IF0/256)*256
      IAL3=IF0/256
      IDX=66
      CALL OUTPUT(IAL2,IDX)
      IDX=66
      CALL OUTPUT(IAL3,IDX)
C
C**     CALL TIMER
      CALL STIMER(ICNT(I))
C
 10   CONTINUE
C
C**     TURN SPEAKER OFF
      IDX=97
      CALL INPUT(IAL1,IDX)
      IOP=1
      CALL SLOGIC(IOP,IAL,IAL1,IT1)
      IDX=97
      CALL OUTPUT(IAL,IDX)
C
      STOP
      END
C
      SUBROUTINE STIMER(ICNT)
C
C     SHORT INTERVAL TIMER ROUTINE
C     PROGRAM ENDS AFTER ICNT COUNTS (TOTAL DELAY <1 HOUR)
C     INTERVAL : 1/18 SEC
C     MIDNIGHT CROSSING RESETS STIMER (STIMER RETURNS)
C     OLYMPIC SOFTWARE  --  9/26/88
C
      EXTERNAL TBIOS
      INTEGER*2 IAR(6),ICNT
      INTEGER*4 ICX,IDX,EC
C
      IAR(1)=0
      CALL TBIOS(IAR)
      IDX=IAR(5)*256+IAR(6)
      IAR(1)=0
 100  CALL TBIOS(IAR)
      EC=IAR(5)*256+IAR(6)-IDX
      IF(EC.LT.0)EC=EC+4*16384
      IF(IAR(2).NE.0)GOTO 200
      IF(EC.LT.ICNT)GOTO 100
C
 200  RETURN
      END