;;; -*- Mode: Lisp; show-trailing-whitespace: t; Base: 10; indent-tabs: nil; Syntax: ANSI-Common-Lisp; Package: FLAC; -*- ;;; Copyright (c) 2013, Mark VandenBrink. All rights reserved. (in-package #:flac) ;;; 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) (let ((hdr (stream-read-iso-string flac-file 4))) (setf valid (string= "fLaC" hdr)))) (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-seek 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]+)=(.*$)" "regex 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 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 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)) (defclass flac-file () ((filename :accessor filename :initform nil :initarg :filename :documentation "filename that was parsed") (flac-headers :accessor flac-headers :initform nil :documentation "holds all the flac headers in file") (audio-info :accessor audio-info :initform nil :documentation "parsed audio info") (flac-tags :accessor flac-tags :initform nil :documentation "parsed comment tags.")) (:documentation "Stream for parsing flac files")) (defun parse-audio-file (instream &optional (get-audio-info nil)) "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*) (declare (ignore get-audio-info)) ; audio info comes for "free" (stream-seek instream 4 :start) (let ((parsed-info (make-instance 'flac-file :filename (stream-filename instream)))) (let (headers) (loop for h = (make-flac-header instream) then (make-flac-header instream) do (push h headers) (cond ((= +metadata-comment+ (header-type h)) (setf (flac-tags parsed-info) (flac-get-tags instream))) ((= +metadata-streaminfo+ (header-type h)) (setf (audio-info parsed-info) (get-flac-audio-info instream))) (t (stream-seek instream (header-len h) :current))) (when (not (zerop (last-bit h))) (return))) (setf (flac-headers parsed-info) (nreverse headers))) parsed-info)) (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))))))