phase_vocoder_PV   xtlang

;--------------------------------------------------------------------------------------------------------------------
;Traditional Phase vocoder
(bind-func phase_vocoder_PV
  (lambda (buffer_size:i64)
    (let ((idx:i64 0)
          (spectrum_size:i64 (+ (/ buffer_size 2) 1))
          (prev_in_phase:float* (zalloc spectrum_size))
          (prev_out_phase:float* (zalloc spectrum_size))
          (omega_k:float* (zalloc spectrum_size))) ;The center frequency of the kth vocoder channel
    (dotimes (idx (+ (/ buffer_size 2) 1))
      (pset! prev_in_phase idx 0.0)
      (pset! prev_out_phase idx 0.0)
      (pset! omega_k idx (/ (* TWOPIf (i64tof idx))
                            (i64tof buffer_size))))
    (lambda (buffer:float* Sa:i64 Ss:i64)
      (let ((temp_buff:float* (salloc buffer_size))
            (wn:float* (salloc buffer_size))
            (spectrum:Complexf* (salloc spectrum_size))
            (mag:float* (salloc spectrum_size))
            (phase:float* (salloc spectrum_size))
            (delta_phi:float* (salloc spectrum_size))
            (k:float* (salloc spectrum_size))
            (delta_phi_adjust:float* (salloc spectrum_size))
            (inst_freq:float* (salloc spectrum_size))
            (synth_phase:float* (salloc spectrum_size))
            (n:i64 0))
      (hanning_window_func wn buffer_size)
      (vvmul buffer wn buffer_size temp_buff) ;Window the incoming audio and overlap by N/4
      (vrotate temp_buff buffer_size (/ buffer_size 2)) ;Circular shift the windowed frame
      (fft temp_buff spectrum buffer_size) ;Compute the DFT of windowed frame
      (dotimes (n spectrum_size) ;Compute the magnitude spectrum
        (pset! mag n (Complex_mag (pref spectrum n))))
      (dotimes (n spectrum_size) ;Compute the phase spectrum
        (pset! phase n (Complex_phase2 (pref spectrum n))))
      (dotimes (n spectrum_size)
        (pset! delta_phi n (- (pref phase n)
                              (pref prev_in_phase n)
                              (* (i64tof Sa) (pref omega_k n)))) ;Unwrap the phase ;Calculate the Instantaneous Phase
        (pset! k n (round (/ (pref delta_phi n) TWOPIf)))
        (pset! delta_phi_adjust n (- (pref delta_phi n)
                                     (* (pref k n) TWOPIf))) ;Adjust to -pi<phase<pi
        (pset! inst_freq n (+ (pref omega_k n) (/ (pref delta_phi_adjust n) (i64tof Sa)))) ;Calculate the Instantaneous Frequency
        (pset! synth_phase n (+ (pref prev_out_phase n) (* (i64tof Ss) (pref inst_freq n))))) ;Set new Synthesis phase
      (if (= speed 1.0) ;restore phase at speed of 1. The audio will still be delayed, but phase inconsistancies no longer exist.
        (begin
          (dotimes (n spectrum_size)
            (pset! synth_phase n (pref phase n)))))
      (dotimes (n spectrum_size) ;Store current input and output phases for next call
        (pset! prev_in_phase n (pref phase n))
        (pset! prev_out_phase n (pref synth_phase n)))
      (Complex_bufferize mag synth_phase spectrum spectrum_size) ;Create output FFT (Ae^j)
      (pol_to_cart2 spectrum spectrum_size)
      (ifft spectrum temp_buff buffer_size) ;take the real part of iFFT (given a scalar output buffer, kiss_fft keeps real part)
      (vsdiv temp_buff (i64tof buffer_size) buffer_size temp_buff) ;this could be changed to a dotimes
      (vrotate temp_buff buffer_size (/ buffer_size 2)) ;Circular shift the time domain Output
      (hanning_window_func wn buffer_size)
      (vvmul temp_buff wn buffer_size buffer) ;Output windowing
      void))))) ;Overlap and add this to the output