taglib/flac-frame.lisp

;;; -*- Mode: Lisp;  show-trailing-whitespace: t; Base: 10; indent-tabs: nil; Syntax: ANSI-Common-Lisp; Package: FLAC-FRAME; -*-
;;; Copyright (c) 2013, Mark VandenBrink. All rights reserved.
(in-package #:flac-frame)

;;; FLAC header types
(defconstant +metadata-streaminfo+  0)
(defconstant +metadata-padding+     1)
(defconstant +metadata-application+ 2)
(defconstant +metadata-seektable+   3)
(defconstant +metadata-comment+     4)
(defconstant +metadata-cuesheet+    5)
(defconstant +metadata-picture+     6)

(defclass flac-header ()
  ((pos         :accessor pos         :initarg :pos         :documentation "file location of this flac header")
   (last-bit    :accessor last-bit    :initarg :last-bit    :documentation "if set, this is the last flac header in file")
   (header-type :accessor header-type :initarg :header-type :documentation "one of the flac header types above")
   (header-len  :accessor header-len  :initarg :header-len  :documentation "how long the info associated w/header is"))
  (:documentation "Representation of FLAC stream header"))

(defmacro with-flac-slots ((instance) &body body)
  `(with-slots (pos last-bit header-type header-len) ,instance
     ,@body))

(defmethod vpprint ((me flac-header) stream)
  (with-flac-slots (me)
    (format stream "pos = ~:d, last-bit = ~b, header-type = ~d, length = ~:d"
            pos
            last-bit
            header-type
            header-len)))

(defun is-valid-flac-file (flac-file)
  "Make sure this is a FLAC file. Look for FLAC header at begining"
  (declare #.utils:*standard-optimize-settings*)
  (stream-seek flac-file 0 :start)
  (let ((valid nil))
    (when (> (stream-size flac-file) 4)
      (unwind-protect
           (handler-case
               (let ((hdr (stream-read-string-with-len flac-file 4)))
                 (setf valid (string= "fLaC" hdr)))
             (condition (c)
               (utils:warn-user "is-valid-flac-file: got condition ~a" c)))
        (stream-seek flac-file 0 :start)))
    valid))

(defun make-flac-header (stream)
  "Make a flac header from current position in stream"
  (declare #.utils:*standard-optimize-settings*)
  (let* ((header (stream-read-u32 stream))
         (flac-header (make-instance 'flac-header
                                     :pos (- (stream-here stream) 4)
                                     :last-bit (utils:get-bitfield header 31 1)
                                     :header-type (utils:get-bitfield header 30 7)
                                     :header-len (utils:get-bitfield header 23 24))))
    flac-header))


(defparameter *flac-tag-pattern* "(^[a-zA-Z]+)=(.*$)" "used to parse FLAC/ORBIS comments")

(defclass flac-tags ()
  ((vendor-str :accessor vendor-str :initarg :vendor-str :initform nil)
   (comments   :accessor comments   :initarg :comments   :initform nil)
   (tags       :accessor tags                            :initform (make-hash-table :test 'equal))))

(defmethod flac-add-tag ((me flac-tags) new-tag new-val)
  (declare #.utils:*standard-optimize-settings*)
  (let ((l-new-tag (string-downcase new-tag)))
    (setf (gethash l-new-tag (tags me)) new-val)))

(defmethod flac-get-tag ((me flac-tags) key)
  (declare #.utils:*standard-optimize-settings*)
  (gethash (string-downcase key) (tags me)))

(defun flac-get-tags (stream)
  "Loop through file and find all comment tags."
  (declare #.utils:*standard-optimize-settings*)
  (let* ((tags (make-instance 'flac-tags))
         (vendor-len (stream-read-u32 stream :endian :big-endian))
         (vendor-str (stream-read-utf-8-string-with-len stream vendor-len))
         (lst-len (stream-read-u32 stream :endian :big-endian)))

    (setf (vendor-str tags) vendor-str)

    (dotimes (i lst-len)
      (let* ((comment-len (stream-read-u32 stream :endian :big-endian))
             (comment (stream-read-utf-8-string-with-len stream comment-len)))
        (push comment (comments tags))
        (optima:match comment ((optima.ppcre:ppcre *flac-tag-pattern* tag value)
                               (flac-add-tag tags tag value)))))
    (setf (comments tags) (nreverse (comments tags)))
    tags))

(defmethod find-flac-frames ((stream flac-file-stream))
  "Loop through file and find all FLAC headers. If we find comment or audio-info headers, go ahead and parse them too."
  (declare #.utils:*standard-optimize-settings*)
  (stream-seek stream 4 :start)

  (handler-case
      (let (headers)
        (loop for h = (make-flac-header stream) then (make-flac-header stream) do
          (push h headers)
          (cond
            ((= +metadata-comment+ (header-type h))
             (setf (flac-tags stream) (flac-get-tags stream)))
            ((= +metadata-streaminfo+ (header-type h))
             (setf (audio-info stream) (get-flac-audio-info stream)))
            (t (stream-seek stream (header-len h) :current)))
          (when (not (zerop (last-bit h))) (return)))
        (setf (flac-headers stream) (nreverse headers)))
    (condition (c)
      (utils:warn-user "find-flac-frames got condition ~a" c))))

(defclass flac-audio-properties ()
  ((min-block-size  :accessor min-block-size  :initarg :min-block-size  :initform 0)
   (max-block-size  :accessor max-block-size  :initarg :max-block-size  :initform 0)
   (min-frame-size  :accessor min-frame-size  :initarg :min-frame-size  :initform 0)
   (max-frame-size  :accessor max-frame-size  :initarg :max-frame-size  :initform 0)
   (sample-rate     :accessor sample-rate     :initarg :sample-rate     :initform 0)
   (num-channels    :accessor num-channels    :initarg :num-channels    :initform 0)
   (bits-per-sample :accessor bits-per-sample :initarg :bits-per-sample :initform 0)
   (total-samples   :accessor total-samples   :initarg :total-samples   :initform 0)
   (md5-sig         :accessor md5-sig         :initarg :md5-sig         :initform 0))
  (:documentation "FLAC audio file properties"))

(defmethod vpprint ((me flac-audio-properties) stream)
  (format stream
          "min/max block size: ~:d/~:d; min/max frame size: ~:d/~:d; sample rate: ~d Hz; # channels: ~d; bps: ~:d; total-samples: ~:d; sig: ~x"
          (min-block-size me) (max-block-size me)
          (min-frame-size me) (max-frame-size me)
          (sample-rate me) (num-channels me) (bits-per-sample me)
          (total-samples me) (md5-sig me)))

(defun get-flac-audio-info (flac-stream)
  "Read in the the audio properties from current file position."
  (declare #.utils:*standard-optimize-settings*)
  (let ((info (make-instance 'flac-audio-properties)))
    (setf (min-block-size info) (stream-read-u16 flac-stream)
          (max-block-size info) (stream-read-u16 flac-stream)
          (min-frame-size info) (stream-read-u24 flac-stream)
          (max-frame-size info) (stream-read-u24 flac-stream))
    (let* ((int1 (stream-read-u32 flac-stream))
           (int2 (stream-read-u32 flac-stream)))
      (setf (total-samples info)   (logior (ash (get-bitfield int1 3  4) -32) int2)
            (bits-per-sample info) (1+ (get-bitfield int1 8  5))
            (num-channels info)    (1+ (get-bitfield int1 11 3))
            (sample-rate info)     (get-bitfield int1 31 20)
            (md5-sig info)         (stream-read-u128 flac-stream)))
    info))

(defun flac-show-raw-tag (flac-file-stream out-stream)
  "Spit out the raw form of comments we found"
  (declare #.utils:*standard-optimize-settings*)
  (format out-stream "Vendor string: <~a>~%" (vendor-str (flac-tags flac-file-stream)))
  (dotimes (i (length (comments (flac-tags flac-file-stream))))
    (format out-stream "~4t[~d]: <~a>~%" i (nth i (comments (flac-tags flac-file-stream))))))