' *****************
' *** SOUND.LST ***
' *****************
'
DEFWRD "a-z"
'
> PROCEDURE beep(number)
  LOCAL i
  FOR i=1 TO number
    PRINT CHR$(7);
    PAUSE 10
  NEXT i
RETURN
' **********
'
> PROCEDURE alarm.sound
  ' *** ta-ti-ta sound (warning)
  SOUND 1,10,12,4,25
  SOUND 1,10,6,4,25
  SOUND 1,10,12,4,50
  SOUND 1,0
RETURN
' **********
'
> PROCEDURE siren1.sound(number)
  ' *** siren (length determined by number)
  LOCAL n,i
  FOR n=1 TO number
    FOR i=1 TO 8
      SOUND 1,15,i,4,1
    NEXT i
    PAUSE 5
    FOR i=1 TO 8
      SOUND 1,15,i,4,1
    NEXT i
    PAUSE 5
  NEXT n
  WAVE 0,0
RETURN
' **********
'
> PROCEDURE tideli.sound
  SOUND 0,15,2,3,5
  SOUND 0,15,2,4,5
  SOUND 0,15,2,3,5
  SOUND 0,15,2,5,5
  SOUND 0,15,2,3,5
  SOUND 0,15,2,6,10
  SOUND 0,0
RETURN
' **********
'
> PROCEDURE bounce1.sound(pause)
  LOCAL n
  FOR n=15 DOWNTO 0
    SOUND 1,n,5,1
    SOUND 2,n,12,2
    SOUND 3,n,5,4
    WAVE 7
    PAUSE pause
    SOUND 3,n,5,5
    PAUSE pause
  NEXT n
  WAVE 0,0
RETURN
' **********
'
> PROCEDURE bounce2.sound(pause)
  LOCAL n
  FOR n=15 DOWNTO 0
    SOUND 1,n,1,3
    SOUND 2,n,5,3
    SOUND 3,n,1,4
    WAVE 7
    PAUSE pause
    SOUND 3,n,1,5
    PAUSE pause
  NEXT n
  WAVE 0,0
RETURN
' **********
'
> PROCEDURE tong.sound
  SOUND 1,10,1,5
  WAVE 1,1,3,6000,10
RETURN
' **********
'
> PROCEDURE poof.sound
  WAVE 56,7,0,20000,0
RETURN
' **********
'
> PROCEDURE clang.sound
  SOUND 1,14,1,5
  SOUND 2,14,5,7
  SOUND 3,14,8,6
  WAVE 7,7,9,17391
RETURN
' **********
'
> PROCEDURE heartbeat.sound
  SOUND 1,9,1,4
  SOUND 2,7,1,4
  SOUND 3,10,1,1
  WAVE 7739,3,8,4964
RETURN
' **********
'
> PROCEDURE ting.sound
  SOUND 1,15,10,6
  SOUND 2,0,1,1
  SOUND 3,0,12,1
  WAVE 1,1,9,12085
RETURN
' **********
'
> PROCEDURE pompom.sound
  ' *** play Pompom-tune (XBIOS 32 format)
  '
  ' *** load POMPOM.INL (384 bytes) here
  INLINE pompom.snd%,384
  '
  ~XBIOS(32,L:pompom.snd%)
  PAUSE 400
  WAVE 0,0
RETURN
' **********
'
> PROCEDURE initio.sound
  ' *** put sound-data in string (XBIOS 32 format)
  ' *** commands in DATA-lines :
  ' ***         REG = 14 parameters for registers 0-13
  ' ***         END = end of sound-string
  ' ***         PAUSE = pause (followed by time in 1/50 seconds)
  ' ***         VAR = decrease/increase tone : channel,start,+/-step,end-value
  ' *** 'WAVE 0,0' terminates all sounds
  ' *** if Keyclick is on, any keypress will terminate sound
  ' *** uses Procedure Sound.string
  ' *** use soundstring : @do.sound(sound$)
  '
  bounce3.sound:
  DATA REG,0,0,0,0,0,0,27,248,16,16,16,35,95,0
  DATA VAR,3,255,-1,116
  DATA PAUSE,255,END
  RESTORE bounce3.sound
  @sound.string(bounce3$)
  '
  bounce4.sound:
  DATA REG,0,216,4,219,5,0,0,254,16,0,0,223,118,0
  DATA VAR,0,0,22,0,END
  RESTORE bounce4.sound
  @sound.string(bounce4$)
  '
  bounce5.sound:
  DATA REG,82,2,251,13,34,0,0,248,16,0,0,0,86,0
  DATA VAR,0,0,11,0,END
  RESTORE bounce5.sound
  @sound.string(bounce5$)
  '
  bounce6.sound:
  DATA REG,0,0,0,0,0,0,0,252,16,0,0,20,70,0
  DATA VAR,1,0,1,255,END
  RESTORE bounce6.sound
  @sound.string(bounce6$)
  '
  tingeling.sound:
  DATA REG,0,0,0,0,0,0,23,248,16,16,16,130,62,0
  DATA VAR,0,255,-106,116
  DATA PAUSE,255,END
  RESTORE tingeling.sound
  @sound.string(tingeling$)
  '
  tingeling2.sound:
  DATA REG,0,0,0,0,0,0,0,254,16,0,0,207,88,0
  DATA VAR,0,0,41,0,END
  RESTORE tingeling2.sound
  @sound.string(tingeling2$)
  '
  siren2.sound:
  DATA REG,0,1,0,0,0,0,0,8,15,0,0,0,0,0,0,10
  DATA VAR,0,1,10,0,END
  RESTORE siren2.sound
  @sound.string(siren2$)
  '
  chopper.sound:
  DATA REG,176,0,238,1,119,12,26,227,16,11,14,111,2,12,END
  RESTORE chopper.sound
  @sound.string(chopper$)
  '
  surf.sound:
  DATA REG,0,0,0,0,0,0,31,199,16,16,16,0,32,14,END
  RESTORE surf.sound
  @sound.string(surf$)
  '
  ting2.sound:
  DATA REG,200,0,201,0,100,0,0,248,16,16,16,0,20,0,END
  RESTORE ting2.sound
  @sound.string(ting2$)
  '
  ding.sound:
  DATA REG,64,1,56,1,0,0,0,252,16,16,0,20,20,0,END
  RESTORE ding.sound
  @sound.string(ding$)
  '
  ploink.sound:
  DATA REG,2,15,2,15,0,0,0,252,16,16,0,20,20,10
  DATA VAR,1,240,-16,0
  DATA PAUSE,10
  DATA REG,2,15,2,15,0,0,0,252,0,0,0,20,20,10,END
  RESTORE ploink.sound
  @sound.string(ploink$)
  '
  toing.sound:
  DATA REG,140,1,216,4,219,5,0,254,16,0,0,207,88,0
  DATA VAR 0,0,41,0,END
  RESTORE toing.sound
  @sound.string(toing$)
  '
  bell.sound:
  DATA REG,64,0,120,0,0,0,0,252,16,16,0,20,20,0,END
  RESTORE bell.sound
  @sound.string(bell$)
  '
  gong.sound:
  DATA REG,1,5,0,5,2,5,0,248,16,16,16,0,20,1,END
  RESTORE gong.sound
  @sound.string(gong$)
  '
  gong2.sound:
  DATA REG,210,3,232,3,209,7,0,248,16,16,16,111,163,0,END
  RESTORE gong2.sound
  @sound.string(gong2$)
  '
  gong3.sound:
  DATA REG,0,13,0,12,0,15,0,248,16,16,16,200,200,2
  DATA PAUSE,250,END
  RESTORE gong3.sound
  @sound.string(gong3$)
  '
  dingdong.sound:
  DATA REG,65,1,64,1,66,1,0,248,16,16,16,255,70,1
  DATA PAUSE,40
  DATA REG,65,1,242,0,127,1,0,248,16,16,16,255,100,1,END
  RESTORE dingdong.sound
  @sound.string(dingdong$)
  '
  pieuw.sound:
  DATA REG,1,0,0,0,0,0,0,254,16,0,0,0,35,1
  DATA VAR,0,50,1,100,END
  RESTORE pieuw.sound
  @sound.string(pieuw$)
  '
  poing.sound:
  DATA REG,1,0,0,0,0,0,0,254,16,0,0,0,35,1
  DATA VAR,0,100,-1,50,END
  RESTORE poing.sound
  @sound.string(poing$)
  '
  zap.sound:
  DATA REG,0,16,0,0,0,0,0,252,15,0,0,20,0,4
  DATA VAR,1,0,1,15
  DATA PAUSE,1
  DATA REG,0,16,0,0,0,0,0,252,0,0,0,20,0,4,END
  RESTORE zap.sound
  @sound.string(zap$)
  '
  dlink.sound:
  DATA REG,8,2,12,4,0,0,0,252,16,16,0,20,20,9
  DATA VAR,0,200,-20,0
  DATA PAUSE,1
  DATA REG,8,2,12,4,0,0,0,252,0,0,0,20,20,9,END
  RESTORE dlink.sound
  @sound.string(dlink$)
  '
  shot.sound:
  DATA REG,0,0,0,0,0,0,15,199,16,16,16,0,16,0
  DATA PAUSE,25
  DATA REG,0,0,0,0,0,0,15,199,0,0,0,0,16,0,END
  RESTORE shot.sound
  @sound.string(shot$)
  '
  explosion1.sound:
  DATA REG,0,0,0,0,0,0,31,199,16,16,16,0,50,9,END
  RESTORE explosion1.sound
  @sound.string(explosion1$)
  '
  explosion2.sound:
  DATA REG,0,0,100,0,200,0,31,198,16,16,16,207,88,0
  DATA VAR,6,255,0,0,END
  RESTORE explosion2.sound
  @sound.string(explosion2$)
  '
  laser.sound:
  DATA REG,100,0,200,0,50,0,31,220,16,0,16,127,37,0
  DATA VAR,0,0,137,200
  DATA PAUSE,128,END
  RESTORE laser.sound
  @sound.string(laser$)
  '
  fft.sound:
  DATA REG,42,2,88,4,164,8,0,199,16,16,16,106,10,4
  DATA VAR 4,124,54,164,END
  RESTORE fft.sound
  @sound.string(fft$)
  '
  steam.sound:
  DATA REG,0,0,0,0,0,0,10,199,16,16,16,0,80,0
  DATA PAUSE,20
  DATA REG,0,0,0,0,0,0,10,255,0,0,0,0,80,100,END
  RESTORE steam.sound
  @sound.string(steam$)
  '
  thrill.sound:
  DATA REG,86,0,86,0,0,0,0,252,16,15,0,50,1,10
  DATA VAR,9,16,-1,0
  DATA PAUSE,0
  DATA REG,86,0,86,0,0,0,0,252,0,15,0,50,1,10,END
  RESTORE thrill.sound
  @sound.string(thrill$)
  '
  jingle.sound:
  DATA REG,100,4,101,4,0,0,0,252,15,15,0,0,30,0
  DATA PAUSE,5
  DATA REG,100,3,101,3,0,0,0,252,15,15,0,0,30,0
  DATA PAUSE,5
  DATA REG,100,2,101,2,0,0,0,252,15,15,0,0,30,0
  DATA PAUSE,5
  DATA REG,100,1,101,1,0,0,0,252,15,15,0,0,30,0
  DATA PAUSE,5
  DATA REG,100,0,101,0,0,0,0,252,16,16,0,0,30,0,END
  RESTORE jingle.sound
  @sound.string(jingle$)
  '
RETURN
' ***
> PROCEDURE sound.string(VAR s$)
  LOCAL n,snd$,snd,channel,begin,step,end
  s$=""
  DO
    READ snd$
    snd$=UPPER$(snd$)
    EXIT IF snd$="END"
    IF snd$="REG"
      FOR n=0 TO 13
        READ snd
        s$=s$+CHR$(n)+CHR$(snd)
      NEXT n
    ENDIF
    IF snd$="PAUSE"
      READ snd
      s$=s$+CHR$(130)+CHR$(snd)
    ENDIF
    IF snd$="VAR"
      READ channel,begin,step,end
      s$=s$+CHR$(128)+CHR$(begin)+CHR$(129)+CHR$(channel)+CHR$(step)
      s$=s$+CHR$(end)
    ENDIF
  LOOP
  s$=s$+CHR$(255)+CHR$(0)               ! terminator
RETURN
' ***
> PROCEDURE do.sound(sound$)
  VOID XBIOS(32,L:VARPTR(sound$))
RETURN
' **********
'
> PROCEDURE initio.speech
  ' *** uses STSPEECH.TOS to speak
  ' *** RESERVE doesn't function, therefore reset necessary
  ' *** don't be surprised by a sudden freeze or some bombs
  ' *** routine by Dave Morrison
  ' *** uses Standard Procedure
  LOCAL i%,k%,bpage%,prg%,phoneme$,speech$,m$
  file$="I:\HIGH_MED\SOUND\STSPEECH.TOS"                ! or other path
  IF NOT EXIST(file$)
    ALERT 3,"Can't find| |STSPEECH.TOS|",1,"EXIT",button
    @exit
  ENDIF
  RESERVE FRE(0)-29000
  bpage%=EXEC(3,file$,"","")
  IF bpage%>0
    prg%=bpage%+&H100
    POKE prg%+&HE,&H4E
    POKE prg%+&HF,&H75
    POKE prg%+&H6C,&H4E
    POKE prg%+&H6D,&H75
    speech_buf%=prg%+&H6EEE
    POKE speech_buf%,&HFE
    phoneme%=prg%+&H32
    speech%=prg%+&H88
    RESTORE speech_data
    FOR i%=1 TO 6
      READ k%
      phoneme$=phoneme$+CHR$(k%)
      speech$=speech$+CHR$(k%)
    NEXT i%
    phoneme$=phoneme$+MKL$(phenome%)
    speech$=speech$+MKL$(speech%)
    FOR i%=1 TO 6
      READ k%
      phoneme$=phoneme$+CHR$(k%)
      speech$=speech$+CHR$(k%)
    NEXT i%
    phoneme%=VARPTR(phoneme$)
    speech%=VARPTR(speech$)
  ELSE
    m$="*** ERROR ***| |EXEC 3 returns|    "+STR$(bpage%)
    ALERT 3,m$,1,"EXIT",k
    @exit
  ENDIF
  '
  speech_data:
  DATA &h48,&he7,&hff,&hfe,&h4e,&hb9,&h4c,&hdf,&h7f,&hff,&h4e,&h75
RETURN
' ***
> PROCEDURE talk(txt$)
  ' *** use phonetic spelling to improve pronunciation
  POKE speech_buf%+1,LEN(txt$)
  txt$=txt$+CHR$(0)
  BMOVE VARPTR(txt$),speech_buf%+2,LEN(txt$)
  CALL phoneme%
  CALL speech%
  PAUSE 5
RETURN
' **********
'
> PROCEDURE load.sample(file$,VAR sample|())
  ' *** load sample in byte-array
  LOCAL m$,length%,sample%
  IF EXIST(file$)
    OPEN "I",#90,file$
    length%=LOF(#90)
    CLOSE #90
    ERASE sample|()
    DIM sample|(length%-1)
    sample%=V:sample|(0)
    BLOAD file$,sample%
  ELSE
    m$="Can't find|sample-file|"+file$+"|   !!??"
    ALERT 3,m$,1,"EDIT",k
    EDIT
  ENDIF
RETURN
' ***
> PROCEDURE play.sample(speed%,VAR sample|())
  ' *** play sample (loaded with Procedure Load.sample)
  ' *** try speed% 0-10
  LOCAL bascode%,length%,start%
  '
  ' *** load BASCODE.INL (2794 bytes) here (= BASCODE.EXE from program Replay)
  ' *** don't worry about the message 'End of file reached' after loading
  INLINE bascode%,8000
  '
  length%=DIM?(sample|())
  adres%=V:sample|(0)
  start%=bascode%+28
  LONG{start%+2}=adres%
  LONG{start%+6}=length%
  LONG{start%+10}=speed%
  CALL start%
RETURN
' **********
'
> PROCEDURE sample
  ' *** play sample (a short after this Procedure PAUSE may be necessary)
  LOCAL bascode%,sample%,start%
  '
  ' *** load BASCODE.INL (2794 bytes) here (= BASCODE.EXE from program Replay)
  ' *** don't worry about the message 'end of file reached' after loading
  INLINE bascode%,8000
  '
  ' *** load sample here (change length, max. 32746 bytes)
  INLINE sample%,10000
  '
  start%=bascode%+28
  LONG{start%+2}=sample%
  LONG{start%+6}=10000          ! change length here as well
  LONG{start%+10}=2             ! try speed 0-10 for best effect
  CALL start%
RETURN
' **********
'