#lang racket/base
;; Copyright Neil Van Dyke.  See file "info.rkt".

(require racket/port
         "mediafile-misc.rkt"
         "planet-overeasy.rkt")

(define (%mediafile:read-ogg-framing-flag-byte in)
  (let ((framing-flag-byte (read-byte in)))
    (if (= 1 framing-flag-byte)
        (void)
        (error '%mediafile:read-ogg-framing-flag-byte
               "invalid framing flag byte ~S in input ~S"
               framing-flag-byte
               in))))

(define (%mediafile:read-ogg-cookie cookie in)
  (let ((actual (read-bytes (bytes-length cookie) in)))
    (if (equal? actual cookie)
        (void)
        (error 'read-ogg-cookie
               "expected ~S but read ~S from port ~S"
               cookie
               actual
               in))))

(define (%mediafile:parse-ogg-uint32/bstr bstr (start 0))
  (+ (bytes-ref bstr start)
     (arithmetic-shift (bytes-ref bstr (+ start 1)) 8)
     (arithmetic-shift (bytes-ref bstr (+ start 2)) 16)
     (arithmetic-shift (bytes-ref bstr (+ start 3)) 24)))

(define (%mediafile:parse-ogg-uint64/bstr bstr (start 0))
  (+ (bytes-ref bstr start)
     (arithmetic-shift (bytes-ref bstr (+ start 1)) 8)
     (arithmetic-shift (bytes-ref bstr (+ start 2)) 16)
     (arithmetic-shift (bytes-ref bstr (+ start 3)) 24)
     (arithmetic-shift (bytes-ref bstr (+ start 4)) 32)
     (arithmetic-shift (bytes-ref bstr (+ start 5)) 40)
     (arithmetic-shift (bytes-ref bstr (+ start 6)) 48)
     (arithmetic-shift (bytes-ref bstr (+ start 7)) 56)))

(module+ test
  (test (%mediafile:parse-ogg-uint32/bstr #"\0\0\0\0") 0)
  ;; TODO: Get some real-world test cases.
  (test (%mediafile:parse-ogg-uint64/bstr #"\0\0\0\0\0\0\0\0") 0))

(define (%mediafile:read-ogg-uint32 in)
  (%mediafile:parse-ogg-uint32/bstr (read-bytes 4 in)))

(define (%mediafile:read-ogg-uint64 in)
  (%mediafile:parse-ogg-uint64/bstr (read-bytes 8 in)))

(define (%mediafile:read-ogg-framing-page-header in)
  (%mediafile:read-ogg-cookie #"OggS" in)
  (let* ((stream-structure-version  (read-byte       in))
         (header-type-flag          (read-byte       in))
         (absolute-granule-position (%mediafile:read-ogg-uint64 in))
         (stream-serial-number      (%mediafile:read-ogg-uint32 in))
         (page-sequence-number      (%mediafile:read-ogg-uint32 in))
         (page-checksum             (%mediafile:read-ogg-uint32 in))
         (page-segment-count        (read-byte       in))
         (segment-table             (read-bytes page-segment-count in)))
    ;; TODO: !!! Return what of these?  Do we really want page-segment-count?
    page-segment-count))

(define (%mediafile:read-vorbis-common-header in)
  (let ((packet-type (read-byte in)))
    (%mediafile:read-ogg-cookie #"vorbis" in)
    packet-type))

(define (%mediafile:read-vorbis-identification-header in attrs)
  (log-mediafile-debug "%mediafile:read-vorbis-identification-header ~S ~S"
                       in
                       attrs)
  (let ((attrs (%mediafile:attrs-add-many
                attrs
                ('vorbis:vorbis-version    (%mediafile:read-ogg-uint32 in))
                ('vorbis:audio-channels    (read-byte       in))
                ('vorbis:audio-sample-rate (%mediafile:read-ogg-uint32 in))
                ('vorbis:bitrate-maximum   (%mediafile:read-ogg-uint32 in))
                ('vorbis:bitrate-nominal   (%mediafile:read-ogg-uint32 in))
                ('vorbis:bitrate-minimum   (%mediafile:read-ogg-uint32 in)))))
    (let ((blocksize-byte (read-byte in)))
      (%mediafile:read-ogg-framing-flag-byte in)
      (%mediafile:attrs-add-many
       attrs
       ('vorbis:blocksize-0 (arithmetic-shift blocksize-byte -4))
       ('vorbis:blocksize-1 (bitwise-and blocksize-byte #b1111))))))

(define (%mediafile:read-ogg-string-bytes in)
  (let ((len (%mediafile:read-ogg-uint32 in)))
    (read-bytes len in)))

(define (%mediafile:read-ogg-string in)
  (bytes->string/utf-8 (%mediafile:read-ogg-string-bytes in)))

(define (%mediafile:read-vorbis-comment in attrs)
  (let ((bstr (%mediafile:read-ogg-string-bytes in)))
    (cond ((regexp-match-positions #rx#"=" bstr)
           => (lambda (m)
                (let ((name-string (string->symbol (string-append "vorbis:comment:"
                                                                  (string-downcase (bytes->string/latin-1 bstr #f 0 (caar m))))))
                      (val-string  (bytes->string/utf-8 bstr #f (cdar m))))
                  (%mediafile:attrs-add attrs name-string val-string))))
          (else (error '%mediafile:read-vorbis-comment
                       "comment byte string ~S is missing an \"=\" byte"
                       bstr)))))

(define (%mediafile:%mediafile:read-vorbis-comment-header in attrs)
  (log-debug "%mediafile:%mediafile:read-vorbis-comment-header ~S ~S"
             in
             attrs)
  (let* ((attrs         (cons (cons 'vorbis:vendor-string (%mediafile:read-ogg-string in))
                              attrs))
         (comment-count (%mediafile:read-ogg-uint32 in)))
    (let loop ((comment-count comment-count)
               (attrs         attrs))
      (if (zero? comment-count)
          (begin (%mediafile:read-ogg-framing-flag-byte in)
                 attrs)
          (loop (sub1 comment-count)
                (%mediafile:read-vorbis-comment in attrs))))))

(define (%mediafile:parse-ogg-headers in)
  (let loop-framing ((waiting-for '(1 3))
                     (attrs       '()))
    (if (null? waiting-for)
        ;; TODO: !!! Parse multiple streams.  Get test file!
        `((1 . ,(%mediafile:attrs-reverse attrs)))
        ;; TODO: This peeking for "OggS" is questionable.
        (let ((next-4-bytes (peek-bytes 4 0 in)))
          (and (equal? #"OggS" next-4-bytes)
               (%mediafile:read-ogg-framing-page-header in))
          (let ((packet-type (%mediafile:read-vorbis-common-header in)))
            (case packet-type
              ((1) ; identification-header
               (loop-framing (remove 1 waiting-for)
                             (%mediafile:read-vorbis-identification-header in attrs)))
              ((3) ; comment header
               (loop-framing (remove 3 waiting-for)
                             (%mediafile:%mediafile:read-vorbis-comment-header in attrs)))
              ((5) ; setup header
               ;; TODO: Maybe parse setup header instead of error.
               (error '%mediafile:parse-ogg-headers
                      "got vorbis setup header before got both identification and comment header"
                      packet-type))
              (else (error '%mediafile:parse-ogg-headers
                           "unknown packet type ~S"
                           packet-type))))))))

(module+ test
  (test (%mediafile:parse-ogg-headers
         (open-input-bytes
          (bytes-append
           ;; Ogg Framing Page Header
           #"OggS" ; bytes 0-3 (4) = capture_pattern
           #"\0" ; byte 4 (1) = stream_structure_version
           #"\2" ; byte 5 (1) = header_type_flag = fresh packet, first page of logical bitstream (bos), NOT last page of logical bitstream
           #"\0\0\0\0\0\0\0\0" ; bytes 6-13 (8) = absolute granule position
           #"\2424\351\\" ; bytes 14-17 (4) = stream serial number
           #"\0\0\0\0" ; bytes 18-21 (4) = page sequence no
           #"\223\301X|" ; bytes 22-25 (4) = page checksum
           #"\1" ; byte 26 (1) = page segments = 1
           #"\3" ; byte 27 (1) = segment table (1 segment) = 3
           
           ;; Vorbis Common Header (sec. 4.2.1)
           #"\1" ; bytes (1) = packet_type = identification header
           #"vorbis" ; bytes (6) = "vorbis" cookie
           
           ;; Identification Header (sec. 4.2.2)
           #"\0\0\0\0" ; bytes (4) = #1 vorbis_version = 0
           #"\2" ; byte (1) = #2 audio_channels = 2
           #"D\254\0\0" ; bytes (4) = #3 audio-sample-rate = !!!
           #"\0\0\0\0" ; bytes (4) = #4 bitrate-maximum = 0
           #"\200\265\1\0" ; bytes (4) = #5 bitrate-nominal = !!!
           #"\0\0\0\0" ; bytes (4) = #6 bitrate-minimum = 0
           #"\270" ; byte (1) = #7 blocksize-0 and #8 blocksize-1 = !!!
           #"\1" ; byte (1) = #9 framing-flag
           
           ;; Ogg Framing Page Header
           #"OggS" ; bytes 0-3 (4) = capture_pattern
           #"\0" ; byte (1) = stream-structure-version
           #"\0" ; byte (1) = header-type-flag
           #"\0\0\0\0\0\0\0\0" ; bytes (8) = absolute granule position
           #"\2424\351\\" ; bytes (4) = stream serial number
           #"\1\0\0\0" ; bytes (4) = page sequence no
           #"\307\212\230\a" ; bytes (4) = page checksum
           #"\22" ; byte (1) = page-segments = 18
           #"\3776\377\377\377\377\377\377\377\377\377\377\377\377\377\377\377\a"
           ;; Vorbis Common Header (sec. 4.2.1)
           #"\3" ; byte (1) = packet-type = 3 = comment header
           #"vorbis" ; bytes (6) = "vorbis" cookie
           
           ;; Vorbis Comment Header (sec. 5)
           #"*\0\0\0" ; bytes (4) = vendor-length = 42
           #"Xiph.Org libVorbis I 20100325 (Everywhere)" ; bytes (42) = vendor-string
           #"\a\0\0\0" ; bytes (4) = user-comment-list-length = 7
           ;; comment-list
           #"M\0\0\0" ; bytes (4) = length = 77
           #"ARTIST=Tchaikovsky (The USSR Symphony Orchestra: Evgeny Svetlanov: Conductor)"
           #"*\0\0\0" ; bytes (4) = length = 42
           #"ALBUM=Discovery Sampler Classical Volume I"
           #"6\0\0\0" ; bytes (4) = length = 54
           #"TITLE=Marche Miniature: Suite No. 1 In D Minor, Op. 43"
           #"\t\0\0\0" ; bytes (4) = length = 9
           #"DATE=1995"
           #"\17\0\0\0" ; bytes (4) = length = 15
           #"GENRE=Classical"
           #"\r\0\0\0" ; bytes (4) = length = 13
           #"TRACKNUMBER=1"
           #"\r\0\0\0" ; bytes (4) = length = 13
           #"CDDB=6c0f0d08"
           #"\1" ; byte (1) = framing-bit
           
           ;; Vorbis Common Header (sec. 4.2.1)
           #"\5" ; byte (1) = packet-type = 5 = setup header
           #"vorbis" ; bytes (6) = "vorbis" cookie
           ;; Vorbis Setup Header (sect. 4.2.4)
           #"%BCV\1\0@\0\0$s\30*F\245s\26\204\20\32BP\31\343\34B\316k\354\31BL\21\202\0342L[\313%s\220!\244\240B\210[(\201\320\220U\0\0@\0\0\207Ax\24\204\212A\b!\204%=X\222\203'=\b!\204\2109x\24\204iA\b!\204\20B\b!\204\20B\b!\204E9h\222\203'A\b\35\204\34308\f\203\3458\370\34\204E9X\20\203'A\350 \204\17B\270\232\203\2549\b!\204$5HP\203\69\350\34\204\302,(\212\202\3040\270\26\204\0045(\214\202\3440\310\324\203\vB\210\232\203I5\370\32\204gAx\26\204iA\b!\204$AH\220\203\6A\310\30\204FAX\222\203\69\270\24\204\313A\250\32\204*9\b\37\204 4d\25\0\220\0\0\240\242(\212\242(\n\20\32\262\n\0\310\0\0\20@Q\24\307q\34\311\221\34\311\261\34\v\b\rY\5\0\0\1\0\b\0\0\240H\212\244H\216\344H\222$Y\222%Y\222%Y\222\346\211\252,\313\262,\313\262,\3132\20\32\262\n"
           )))
        ;;New logical stream (#1, serial: 5ce934a2): type vorbis
        ;;Vorbis headers parsed for stream 1, information follows...
        ;;Version: 0
        ;;Vendor: Xiph.Org libVorbis I 20100325 (Everywhere)
        ;;Channels: 2
        ;;Rate: 44100
        ;;
        ;;Nominal bitrate: 112.000000 kb/s
        ;;Upper bitrate not set
        ;;Lower bitrate not set
        ;;User comments section follows...
        ;;      ARTIST=Tchaikovsky (The USSR Symphony Orchestra: Evgeny Svetlanov: Conductor)
        ;;      ALBUM=Discovery Sampler Classical Volume I
        ;;      TITLE=Marche Miniature: Suite No. 1 In D Minor, Op. 43
        ;;      DATE=1995
        ;;      GENRE=Classical
        ;;      TRACKNUMBER=1
        ;;      CDDB=6c0f0d08
        ;;Vorbis stream 1:
        ;;      Total data length: 1661658 bytes
        ;;      Playback length: 2m:10.026s
        ;;      Average bitrate: 102.234906 kb/s
        ;;Logical stream 1 ended
        '((1 . ((vorbis:vorbis-version      . 0)
                (vorbis:audio-channels      . 2)
                (vorbis:audio-sample-rate   . 44100)
                (vorbis:bitrate-maximum     . 0)
                (vorbis:bitrate-nominal     . 112000)
                (vorbis:bitrate-minimum     . 0)
                (vorbis:blocksize-0         . 11)
                (vorbis:blocksize-1         . 8)
                (vorbis:vendor-string       . "Xiph.Org libVorbis I 20100325 (Everywhere)")
                (vorbis:comment:artist      . "Tchaikovsky (The USSR Symphony Orchestra: Evgeny Svetlanov: Conductor)")
                (vorbis:comment:album       . "Discovery Sampler Classical Volume I")
                (vorbis:comment:title       . "Marche Miniature: Suite No. 1 In D Minor, Op. 43")
                (vorbis:comment:date        . "1995")
                (vorbis:comment:genre       . "Classical")
                (vorbis:comment:tracknumber . "1")
                (vorbis:comment:cddb        . "6c0f0d08")
                ;; !!!
                )))))

(provide get-vorbis-file-props)
(define (get-vorbis-file-props path)
  (call-with-input-file path %mediafile:parse-ogg-headers))