rem WAV Files (Stereo) ........... Rev 7.0
      rem A J Tooth // April 2005
      
      *FLOAT64
      mode 22
      rem Parameter setup
      proc_param
      
      rem Header setup
      proc_wavheader
      
      rem =============================================================
      
      rem DATA : Sine wave
      proc_wave
      
      sys "PlaySound",wav%,0,5
      
      print tab(5,5);"Do you want to save this sound-clip? (y/n)"
      repeat
        a$=get$
      until a$="y" or a$="n"
      
      rem Save the Clip
      if a$="y" then proc_clipsave
      
      rem Visualisation of the waveform
      proc_visual
      
      a$=get$
      quit
      end
      rem End of Program ========================================================
      rem =======================================================================
      
      rem Scale
      def proc_scal
      local fr, tr2, w%, stp%, h%
      
      tr2=1.059463094 : rem Twelfth root of 2
      freq(0)=cyc
      fr=cyc
      for w%=1 to 14
        case w% of
          when 1,2,4,5,6,8,9,11,12,13 : stp%=2
          when 3,7,10,14 : stp%=1
        endcase
        for h%=1 to stp%
          fr=fr*tr2
        next h%
        freq(w%)=fr
      next w%
      endproc
      rem =======================================================================
      
      rem Header setup
      def proc_wavheader
      P% = wav%
      [OPT 0
      DB "RIFF"        ; File type
      DD !lgth%-8      ; Total bytes less 8
      DB "WAVEfmt "    ; Chunk type
      DD 16            ; Size f chunk
      DW 1             ; Denotes PCM frmat
      DW ?ch%          ; Number f channels. 1 = mono 2 = stereo
      DD !srate%       ; Sampling frequency
      DD !srate%*?ch%  ; Bytes per second - same as sampling freq fr Mono
      DW 1*?ch%        ; Data word size * number f channels
      DW 8             ; Bits per sample
      DB "data"        ; Chunk type
      DD !dbytes%      ; Number f dta bytes = sample rate * duration
      ]
      endproc
      rem =======================================================================
      
      rem Parameter setup
      def proc_param
      
      dim srate% 3, dbytes% 3
      dim lgth% 3, ch% 0
      dim freq(14)
      
      !srate%=44100 : rem Sampling frequency in Hz
      ?ch%=2 : rem 1=mono 2=stereo
      
      input tab(5,5);"Enter the base frequency (440)",cyc
      if cyc<=0.0 then cyc=440.0
      snd%=15
      input tab(5,7);"Enter a speed, for example, 10 would be 1/10th second per note (4)",cut%
      if cut%<=0 then cut%=4
      input tab(5,9);"Enter any two numbers between -20 and 20 to determine harmonics ",h1;tab(75,9),h2
      a$=inkey$(50):cls
      
      cnt%=int(!srate%/cut%)
      rem Scale of A Major
      proc_scal
      
      rem Number of data bytes
      !dbytes%=snd%*cnt%
      !lgth%=!dbytes%+44
      dim wav% (!lgth%-1)
      endproc
      rem =======================================================================
      
      rem DATA : Sine wave
      def proc_wave
      local u%, env, t, delt, k%
      dim i% local 3
      !i%=44
      
      for u%=0 to 14
        t=0.0
        delt=pi*freq(u%)/!srate% : rem Number of cycles/second divided by the sampling frequency
        for k%=1 to cnt%
          y=k%/cnt%
          env=0.5*exp(-(y-0.5)*(y-0.5)*15)
          if (k% mod 2=0) then
            wav%?(!i%)=int(0.5+env*(127.0*(3+(sin(2*t)+sin(2*h1*t)+sin(2*h2*t))/3)))
          else
            wav%?(!i%)=int(0.5+env*(127.0*(3+(sin(t)+sin(4*h1*t)+sin(4*h2*t))/3)))
          endif
          !i%+=1
          t+=delt
        next k%
      next u%
      endproc
      rem =======================================================================
      
      rem Save the Clip
      def proc_clipsave
      dim g% 0, bsave% 500, m% 3, slgth% 3
      
      rem Assembly
      for  pass%=0 to 2 step  2
        proc_bsave(pass%)
      next  pass%
      
      print tab(5,10);"Type in a name for the clip."
      input tab(5,12);name$
      path$="C:\Documents and Settings\Owner\My Documents\My Music\"
      fil$=path$+name$+".wav"
      print tab(0,15);"File located at: ";fil$
      
      !slgth%=!lgth%-1
      ?g%=openout fil$
      call bsave%
      close#?g%
      
      print tab(5,18);"DONE. Press any key to finish."
      a$=get$
      cls
      endproc
      rem =======================================================================
      
      rem Byte save routine
      def proc_bsave(opt%)
      
      P%=bsave%
      
      [opt opt%
      
      mov ebx,0
      mov bl,[g%]
      
      mov edx,0
      mov [m%],edx
      .loop
      mov al,wav%[edx]
      call "osbput"
      inc dword [m%]
      mov edx,[m%]
      cmp edx,[slgth%]
      jle loop
      ret
      ]
      endproc
      rem ==================================================================
      
      rem Visualisation of the waveform
      def proc_visual
      local s%, f%
      
      colour 128: cls : off
      *REFRESH OFF
      
      for s%=44 to (44+!dbytes%-1000) step 16
        colour 128:cls
        sys "GetCurrentProcess" to hprocess%
        sys "SetPriorityClass", hprocess%, &100
        for f%=0 to 998 step 2
          if f%=0 then
            gcol 9
            plot 2*f%,200+5*wav%?(s%+f%)
            gcol 11
            plot 2*f%,200+5*wav%?(s%+f%+1)
          else
            move 2*(f%-2),200+5*wav%?(s%+f%-2)
            gcol 9
            plot 5,2*f%,200+5*wav%?(s%+f%)
            move 2*(f%-1),200+5*wav%?(s%+f%-1)
            gcol 11
            plot 5,2*(f%+1),200+5*wav%?(s%+f%+1)
          endif
        next f%
        sys "GetCurrentProcess" to hprocess%
        sys "SetPriorityClass", hprocess%, &20
        
        colour 2:print tab(2,2);"Note: ";1+((s%-44) div cnt%);
        *REFRESH
        b$=inkey$(1)
        if b$<>"" then c$=get$
      next s%
      *REFRESH ON
      endproc
      rem ==================================================================