sbc-synth.scm

; table

(define proto8 (vector
0.00000000e+00 1.56575398e-04 3.43256425e-04 5.54620202e-04
8.23919506e-04 1.13992507e-03 1.47640169e-03 1.78371725e-03
2.01182542e-03 2.10371989e-03 1.99454554e-03 1.61656283e-03
9.02154502e-04 -1.78805361e-04 -1.64973098e-03 -3.49717454e-03
5.65949473e-03 8.02941163e-03 1.04584443e-02 1.27472335e-02
1.46525263e-02 1.59045603e-02 1.62208471e-02 1.53184106e-02
1.29371806e-02 8.85757540e-03 2.92408442e-03 -4.91578024e-03
-1.46404076e-02 -2.61098752e-02 -3.90751381e-02 -5.31873032e-02
6.79989431e-02 8.29847578e-02 9.75753918e-02 1.11196689e-01
1.23264548e-01 1.33264415e-01 1.40753505e-01 1.45389847e-01
1.46955068e-01 1.45389847e-01 1.40753505e-01 1.33264415e-01
1.23264548e-01 1.11196689e-01 9.75753918e-02 8.29847578e-02
-6.79989431e-02 -5.31873032e-02 -3.90751381e-02 -2.61098752e-02
-1.46404076e-02 -4.91578024e-03 2.92408442e-03 8.85757540e-03
1.29371806e-02 1.53184106e-02 1.62208471e-02 1.59045603e-02
1.46525263e-02 1.27472335e-02 1.04584443e-02 8.02941163e-03
-5.65949473e-03 -3.49717454e-03 -1.64973098e-03 -1.78805361e-04
9.02154502e-04 1.61656283e-03 1.99454554e-03 2.10371989e-03
2.01182542e-03 1.78371725e-03 1.47640169e-03 1.13992507e-03
8.23919506e-04 5.54620202e-04 3.43256425e-04 1.56575398e-04
))


(define presc8 (vector-ec (: i 80) (* (vector-ref proto8 i) -8.0)))


; wavegen

(define (calc-scalefactor subbands scalefactor)
  (vector-ec (: sb subbands) (expt 2.0 (+ (vector-ref scalefactor sb) 1.0))))
(define (calc-level subbands bits)
  (vector-ec (: sb subbands) (- (expt 2.0 (inexact (vector-ref bits sb))) 1.0)))
(define (calc-sample subbands scalefactor sample level)
  (vector-ec (: sb subbands)
             (let ((lv (vector-ref level sb)))
               (if (> lv 0.0)
                 (* (vector-ref scalefactor sb)
                    (- (/ (+ 1.0 (* (inexact (vector-ref sample sb)) 2.0)) lv)
                       1.0))
                 0.0))))

(define (calc-join! subbands join L R)
  (when join
    (do-ec (: sb subbands)
           (when (vector-ref join sb)
             (let ((sl (vector-ref L sb))
                   (sr (vector-ref R sb)))
               (vector-set! L sb (+ sl sr))
               (vector-set! R sb (- sl (* 2.0 sr))))))))

(define (sbc-reconstruct-wave-2ch subbands raw-scalefactors bits samples join)
  (let* ((levelL (calc-level subbands (car bits)))
         (levelR (calc-level subbands (cdr bits)))
         (scalefactorL (calc-scalefactor subbands (car raw-scalefactors)))
         (scalefactorR (calc-scalefactor subbands (cdr raw-scalefactors))))
    (define (reconst-block sample)
      (let* ((L (calc-sample subbands scalefactorL (car sample) levelL))
             (R (calc-sample subbands scalefactorR (cdr sample) levelR)))
        (calc-join! subbands join L R)
        (cons L R)))
    (map reconst-block samples)))

; synth

(define (vector-mul! a b)
  (let ((len (vector-length a)))
    (do-ec (: i len)
           (vector-set! a
                        i
                        (* (vector-ref a i)
                           (vector-ref b i))))))

(define (sbc-make-synth8)
  (vector-ec (: i 160) 0))
(define (sbc-make-U8)
  (vector-ec (: i 80) 0))

(define (sbc-init-synth8! synth)
  (do-ec (: i 160) (vector-set! synth i 0)))

(define (shift8! synth)
  (do-ec (: i 16 160)
         (begin
         (vector-set! synth (- 175 i) (vector-ref synth (- 159 i))))))

(define S (vector-ec (: i 8)
                     (vector-ec (: k 16)
                                (cos (* (+ i 0.5)
                                        (+ k 4)
                                        3.141592653
                                        0.125)))))

(define (matrix8! synth samples)
  (do-ec (: k 16)
         (vector-set! synth k
                      (sum-ec (: i 8)
                              (* (vector-ref (vector-ref S i) k)
                                 (vector-ref samples i))))))

(define (matrix8!-old synth samples)
  (do-ec (: k 16)
         (vector-set! synth k
                      (sum-ec (: i 8)
                              (* (cos (* (+ i 0.5)
                                         (+ k 4)
                                         3.141592653
                                         0.125))
                                 (vector-ref samples i))))))

(define (dist8! U synth)
  (do-ec (: i 5) (: j 8)
         (begin
           (vector-set! U (+ (* i 16) j)
                        (vector-ref synth (+ (* i 32) j)))
           (vector-set! U (+ (* i 16) 8 j)
                        (vector-ref synth (+ (* i 32) 24 j))))))

(define (window8! U)
  (vector-mul! U presc8))

(define (calc8 W)
  (vector-ec (: j 8) (sum-ec (: i 10) (vector-ref W (+ j (* 8 i))))))

(define (sbc-synthblk8 synth U samples) ; => vector 8
  (shift8! synth)
  (matrix8! synth samples)
  (dist8! U synth)
  (window8! U)
  (calc8 U))