guile-examples/sound/riff-wave/model.scm

(library (model)
  (export ;; Constants
          BITS-PER-BYTE
          EXTRA-FORMAT-BYTES
          FORMAT-SIZE-NO-EXTRA-BYTES

          COMPRESSION-CODE-BYTES
          NUM-CHANNELS-BYTES
          SAMPLE-RATE-BYTES
          AVG-BYTE-RATE-BYTES
          BLOCK-ALIGN-BYTES
          SIGNIFICANT-BITS-PER-SAMPLE-BYTES

          ;; construct-header-chunk
          make-riff-wave
          riff-wave?
          riff-wave-header-chunk
          riff-wave-format-chunk
          riff-wave-data-chunk

          make-header-chunk
          header-chunk?
          header-chunk-id
          header-chunk-size
          header-chunk-riff-type

          ;; construct-format-chunk
          make-format-chunk
          format-chunk?
          format-chunk-id
          format-chunk-size
          format-chunk-compression-code
          format-chunk-num-channels
          format-chunk-sample-rate
          format-chunk-avg-byte-rate
          format-chunk-block-align
          format-chunk-significant-bits-per-sample

          ;; construct-data-chunk
          make-data-chunk
          data-chunk?
          data-chunk-id
          data-chunk-size
          data-chunk-samples

          calculate-format-chunk-size
          calculate-data-chunk-size
          calculate-header-chunk-size)

  (import (except (rnrs base) let-values)
          (only (guile)
                lambda* λ)
          ;; (ice-9 exceptions)
          ;; (ice-9 binary-ports)
          ;; (rnrs bytevectors)
          ;; (srfi srfi-43)
          ;; structs
          (srfi srfi-9)
          ;; functional structs
          (srfi srfi-9 gnu)
          (bytevector-utils))

  (define BITS-PER-BYTE 8)
  (define EXTRA-FORMAT-BYTES 0)
  (define FORMAT-SIZE-NO-EXTRA-BYTES 16)

  (define COMPRESSION-CODE-BYTES 2)
  (define NUM-CHANNELS-BYTES 2)
  (define SAMPLE-RATE-BYTES 4)
  (define AVG-BYTE-RATE-BYTES 4)
  (define BLOCK-ALIGN-BYTES 2)
  (define SIGNIFICANT-BITS-PER-SAMPLE-BYTES 2)

  (define calculate-data-chunk-size
    (λ (num-samples bit-depth num-channels)
      ;; in bytes
      (/
       ;; per channel a sample of bit-depth bits
       (* num-samples bit-depth num-channels)
       ;; 8 bits in a byte
       8)))

  (define calculate-format-chunk-size
    (λ (extra-format-bytes-count)
      (let ([size-without-extra-format-bytes 16])
        (+ size-without-extra-format-bytes
           extra-format-bytes-count))))

  (define calculate-header-chunk-size
    (λ (format-chunk-size data-chunk-size)
      "This is the size of the whole file, minus the 8 bytes spent
on expressing the id and the size."
      (+
       ;; id is in 4 bytes, 4 ascii characters
       4
       ;; id and size of the format chunk + format chunk size
       (+ 8 format-chunk-size)
       ;; id and size of the data chunk + data chunk size
       (+ 8 data-chunk-size))))

  (define-immutable-record-type <riff-wave>
    (make-riff-wave header-chunk
                    format-chunk
                    data-chunk)
    riff-wave?
    (header-chunk riff-wave-header-chunk)
    (format-chunk riff-wave-format-chunk)
    (data-chunk riff-wave-data-chunk))


  (define-immutable-record-type <header-chunk>
    (construct-header-chunk id size riff-type)
    header-chunk?
    (id header-chunk-id)
    (size header-chunk-size)
    (riff-type header-chunk-riff-type))


  (define make-header-chunk
    (λ (size)
      (construct-header-chunk "RIFF"
                              size
                              "WAVE")))


  (define-immutable-record-type <format-chunk>
    (construct-format-chunk id
                            size
                            compression-code
                            num-channels
                            sample-rate
                            avg-byte-rate
                            block-align
                            significant-bits-per-sample)
    format-chunk?
    (id format-chunk-id)
    (size format-chunk-size)
    (compression-code format-chunk-compression-code)
    (num-channels format-chunk-num-channels)
    (sample-rate format-chunk-sample-rate)
    (avg-byte-rate format-chunk-avg-byte-rate)
    (block-align format-chunk-block-align)
    (significant-bits-per-sample format-chunk-significant-bits-per-sample))


  (define make-format-chunk
    (λ (compression-code
        num-channels
        sample-rate
        bit-depth)
      (construct-format-chunk "fmt "
                              (+ FORMAT-SIZE-NO-EXTRA-BYTES
                                 EXTRA-FORMAT-BYTES)
                              compression-code
                              num-channels
                              sample-rate
                              ;; Each sample takes bit-depth
                              ;; bits for each channel ->
                              ;; bit-depth * number of
                              ;; channels.
                              (/ (* sample-rate bit-depth)
                                 BITS-PER-BYTE)
                              (* num-channels
                                 (/ bit-depth BITS-PER-BYTE))
                              bit-depth)))

  (define-record-type <data-chunk>
    (construct-data-chunk id size samples)
    data-chunk?
    (id data-chunk-id)
    (size data-chunk-size)
    (samples data-chunk-samples))


  (define make-data-chunk
    (λ (samples bit-depth num-channels)
      (construct-data-chunk "data"
                            (calculate-data-chunk-size (vector-length samples)
                                                       bit-depth
                                                       num-channels)
                            samples))))