;;; -*- 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) (log5:defcategory cat-log-flac-frame) (defmacro log-flac-frame (&rest log-stuff) `(log5:log-for (cat-log-flac-frame) ,@log-stuff)) ;;; 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*) (log5:with-context "is-valid-flac-file" (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))) (log-flac-frame "got <~a> for flac header" hdr) (setf valid (string= "fLaC" hdr)) (log-flac-frame "valid = ~a" valid)) (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*) (log5:with-context "make-flac-header" (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)))) (log-flac-frame "header = ~a" (vpprint flac-header nil)) 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*) (log5:with-context "flac-get-tags" (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) (log-flac-frame "got ~a/~a" 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*) (log5:with-context "find-flac-frames" (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) (log-flac-frame "Found flac frame: ~a" (vpprint h nil)) (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) (log-flac-frame "got condition ~a when finding flac frames" 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))))))