Mark VandenBrink 12 лет назад
Родитель
Сommit
480511950a
5 измененных файлов с 78 добавлено и 39 удалено
  1. 45 24
      abstract-tag.lisp
  2. 16 5
      flac-frame.lisp
  3. 1 1
      taglib-tests.asd
  4. 1 1
      taglib.asd
  5. 15 8
      utils.lisp

+ 45 - 24
abstract-tag.lisp

@@ -2,7 +2,9 @@
 ;;; Copyright (c) 2013, Mark VandenBrink. All rights reserved.
 (in-package #:abstract-tag)
 
-(defparameter *raw-tags* nil)
+(defparameter *raw-tags* nil
+  "Controls whether or not we print 'raw' tags (aka frames) or
+textual representation of tags")
 
 (defparameter *id3v1-genres*
   #("Blues" "Classic Rock" "Country" "Dance" "Disco" "Funk" "Grunge"
@@ -11,23 +13,25 @@
     "Pranks" "Soundtrack" "Euro-Techno" "Ambient" "Trip-Hop" "Vocal"
     "Jazz+Funk" "Fusion" "Trance" "Classical" "Instrumental" "Acid" "House"
     "Game" "Sound Clip" "Gospel" "Noise" "Alternative Rock" "Bass" "Soul"
-    "Punk" "Space" "Meditative" "Instrumental Pop" "Instrumental Rock" "Ethnic"
-    "Gothic" "Darkwave" "Techno-Industrial" "Electronic" "Pop-Folk" "Eurodance"
-    "Dream" "Southern Rock" "Comedy" "Cult" "Gangsta" "Top 40" "Christian Rap"
-    "Pop/Funk" "Jungle" "Native American" "Cabaret" "New Wave" "Psychedelic"
-    "Rave" "Showtunes" "Trailer" "Lo-Fi" "Tribal" "Acid Punk" "Acid Jazz"
-    "Polka" "Retro" "Musical" "Rock & Roll" "Hard Rock" "Folk" "Folk/Rock"
-    "National Folk" "Swing" "Fusion" "Bebob" "Latin" "Revival" "Celtic"
-    "Bluegrass" "Avantgarde" "Gothic Rock" "Progressive Rock" "Psychedelic Rock"
+    "Punk" "Space" "Meditative" "Instrumental Pop" "Instrumental Rock"
+    "Ethnic" "Gothic" "Darkwave" "Techno-Industrial" "Electronic"
+    "Pop-Folk" "Eurodance" "Dream" "Southern Rock" "Comedy" "Cult"
+    "Gangsta" "Top 40" "Christian Rap" "Pop/Funk" "Jungle" "Native
+    American" "Cabaret" "New Wave" "Psychedelic" "Rave" "Showtunes"
+    "Trailer" "Lo-Fi" "Tribal" "Acid Punk" "Acid Jazz" "Polka" "Retro"
+    "Musical" "Rock & Roll" "Hard Rock" "Folk" "Folk/Rock" "National Folk"
+    "Swing" "Fusion" "Bebob" "Latin" "Revival" "Celtic" "Bluegrass"
+    "Avantgarde" "Gothic Rock" "Progressive Rock" "Psychedelic Rock"
     "Symphonic Rock" "Slow Rock" "Big Band" "Chorus" "Easy Listening"
     "Acoustic" "Humour" "Speech" "Chanson" "Opera" "Chamber Music" "Sonata"
-    "Symphony" "Booty Bass" "Primus" "Porn Groove" "Satire" "Slow Jam" "Club"
-    "Tango" "Samba" "Folklore" "Ballad" "Power Ballad" "Rhythmic Soul"
-    "Freestyle" "Duet" "Punk Rock" "Drum Solo" "A Cappella" "Euro-House" "Dance Hall"
-    "Goa" "Drum & Bass" "Club-House" "Hardcore" "Terror" "Indie"
-    "BritPop" "Negerpunk" "Polsk Punk" "Beat" "Christian Gangsta Rap" "Heavy Metal"
-    "Black Metal" "Crossover" "Contemporary Christian" "Christian Rock"
-    "Merengue" "Salsa" "Thrash Metal" "Anime" "Jpop" "Synthpop"))
+    "Symphony" "Booty Bass" "Primus" "Porn Groove" "Satire" "Slow Jam"
+    "Club" "Tango" "Samba" "Folklore" "Ballad" "Power Ballad" "Rhythmic
+    Soul" "Freestyle" "Duet" "Punk Rock" "Drum Solo" "A Cappella"
+    "Euro-House" "Dance Hall" "Goa" "Drum & Bass" "Club-House" "Hardcore"
+    "Terror" "Indie" "BritPop" "Negerpunk" "Polsk Punk" "Beat" "Christian
+    Gangsta Rap" "Heavy Metal" "Black Metal" "Crossover" "Contemporary
+    Christian" "Christian Rock" "Merengue" "Salsa" "Thrash Metal" "Anime"
+    "Jpop" "Synthpop"))
 
 (defun find-genre (name)
   "For debug purpose only: test function to return index of genre, given a name.
@@ -40,7 +44,8 @@ Ignores case and returns first complete match"
       (incf i))))
 
 (defun get-id3v1-genre (n)
-  "Given N, a supposed ID3 genre, range check it to make sure it is > 0 and < (sizeof *ID3V1-GENRES*)"
+  "Given N, a supposed ID3 genre, range check it to make sure it
+is > 0 and < (sizeof *ID3V1-GENRES*)"
   (declare #.utils:*standard-optimize-settings*)
   (if (or (> n (1- (length *id3v1-genres*)))
             (< n 0))
@@ -150,9 +155,11 @@ Ignores case and returns first complete match"
         ;; only allow one (no refinements) OR we can handle the simple string case
         (when (and (>= (length str) 1) (eq #\( (aref str 0)))
           (setf count (count #\( str))
-          (when (> count 1) (warn-user "Don't support genre refinement yet, found ~d genres" count))
+          (when (> count 1)
+            (warn-user "Don't support genre refinement yet, found ~d genres" count))
           (setf end (position #\) str))
-          (when (null end) (warn-user "Bad format for genre, ending paren is missing"))
+          (when (null end)
+            (warn-user "Bad format for genre, ending paren is missing"))
           (setf str (get-id3v1-genre (parse-integer (subseq str 1 end)))))
         (return-from genre str))))
 
@@ -160,7 +167,7 @@ Ignores case and returns first complete match"
       (get-id3v1-genre (genre (id3-frame:v21-tag-header (id3-frame:id3-header me))))
       nil))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; no V2.1 tags for any of these ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; No V2.1 tags for any of these
 (defmethod album-artist ((me id3-frame:mp3-file))
   (declare #.utils:*standard-optimize-settings*)
   (let ((frames (id3-frame:get-frames me '("TP2" "TPE2"))))
@@ -241,6 +248,7 @@ Ignores case and returns first complete match"
   nil)
 
 (defun mk-lst (str)
+  "Transform 'N/M' to (N M)"
   (declare #.utils:*standard-optimize-settings*)
   (let ((pos (position #\/ str)))
     (if (null pos)
@@ -256,7 +264,8 @@ Ignores case and returns first complete match"
   nil)
 
 (defmethod show-tags ((me id3-frame:mp3-file) &key (raw *raw-tags*))
-  "Show the tags for an MP3.  If RAW is non-nil, dump all the frames; else, print out a subset."
+  "Show the tags for an MP3.  If RAW is non-nil, dump all the frames;
+else, print out a subset."
   (declare #.utils:*standard-optimize-settings*)
   (if raw
       (format t "~a~%~a~%" (id3-frame:filename me)
@@ -283,9 +292,11 @@ Ignores case and returns first complete match"
             (track (track me))
             (writer (writer me))
             (year (year me)))
+
         (format t "~a~%~a~%" (id3-frame:filename me)
                 (if (id3-frame:audio-info me)
                     (mpeg::vpprint (id3-frame:audio-info me) nil) ""))
+
         (when album (format t "~4talbum: ~a~%" album))
         (when album-artist (format t "~4talbum-artist: ~a~%" album-artist))
         (when artist (format t "~4tartist: ~a~%" artist))
@@ -322,7 +333,9 @@ Ignores case and returns first complete match"
 (defmethod compilation  ((me mp4-atom:mp4-file)) (mp4-atom:tag-get-value (mp4-atom:mp4-atoms me) mp4-atom:+itunes-compilation+))
 (defmethod disk         ((me mp4-atom:mp4-file)) (mp4-atom:tag-get-value (mp4-atom:mp4-atoms me) mp4-atom:+itunes-disk+))
 (defmethod tempo        ((me mp4-atom:mp4-file)) (mp4-atom:tag-get-value (mp4-atom:mp4-atoms me) mp4-atom:+itunes-tempo+))
+
 (defmethod genre        ((me mp4-atom:mp4-file))
+  (declare #.utils:*standard-optimize-settings*)
   (let ((genre   (mp4-atom:tag-get-value (mp4-atom:mp4-atoms me) mp4-atom:+itunes-genre+))
         (genre-x (mp4-atom:tag-get-value (mp4-atom:mp4-atoms me) mp4-atom:+itunes-genre-x+)))
     (assert (not (and genre genre-x)))
@@ -330,7 +343,9 @@ Ignores case and returns first complete match"
       (genre   (format nil "~d (~a)" genre (get-id3v1-genre (1- genre))))
       (genre-x genre-x)
       (t       "not present"))))
+
 (defmethod track ((me mp4-atom:mp4-file))
+  (declare #.utils:*standard-optimize-settings*)
   (let ((track   (mp4-atom:tag-get-value (mp4-atom:mp4-atoms me) mp4-atom:+itunes-track+))
         (track-n (mp4-atom:tag-get-value (mp4-atom:mp4-atoms me) mp4-atom:+itunes-track-n+)))
     (assert (not (and track track-n)))
@@ -341,6 +356,8 @@ Ignores case and returns first complete match"
 (defmethod show-tags ((me mp4-atom:mp4-file) &key (raw *raw-tags*))
   "Show the tags for an MP4-FILE. If RAW is non-nil, dump the DATA atoms;
 else show subset of DATA atoms"
+  (declare #.utils:*standard-optimize-settings*)
+
   (format t "~a~%" (mp4-atom:filename me))
   (if raw
       (progn
@@ -403,12 +420,16 @@ else show subset of DATA atoms"
 (defmethod year         ((me flac-frame:flac-file)) (get-flac-tag-info me "date"))
 (defmethod title        ((me flac-frame:flac-file)) (get-flac-tag-info me "title"))
 (defmethod genre        ((me flac-frame:flac-file)) (get-flac-tag-info me "genre"))
-(defmethod track        ((me flac-frame:flac-file)) (let ((tr (get-flac-tag-info me "tracknumber"))
-                                                      (tn (get-flac-tag-info me "tracktotal")))
-                                                  (if tn (list tr tn) tr)))
+
+(defmethod track        ((me flac-frame:flac-file))
+  (let ((tr (get-flac-tag-info me "tracknumber"))
+        (tn (get-flac-tag-info me "tracktotal")))
+    (if tn (list tr tn) tr)))
 
 (defmethod show-tags ((me flac-frame:flac-file) &key (raw *raw-tags*))
   "Show the tags for a FLAC-FILE."
+  (declare #.utils:*standard-optimize-settings*)
+
   (format t "~a~%" (flac-frame:filename me))
   (if raw
       (flac-frame:flac-show-raw-tag me t)

+ 16 - 5
flac-frame.lisp

@@ -12,10 +12,14 @@
 (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"))
+  ((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)
@@ -33,7 +37,9 @@
 (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-string-with-len flac-file 4)))
@@ -44,6 +50,7 @@
 (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)
@@ -53,7 +60,8 @@
     flac-header))
 
 
-(defparameter *flac-tag-pattern* "(^[a-zA-Z]+)=(.*$)" "used to parse FLAC/ORBIS comments")
+(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)
@@ -103,6 +111,7 @@
   "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)
@@ -147,6 +156,7 @@ headers, go ahead and parse them too."
 (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)
@@ -164,6 +174,7 @@ headers, go ahead and parse them too."
 (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))))))

+ 1 - 1
taglib-tests.asd

@@ -4,6 +4,6 @@
 (asdf:defsystem #:taglib-tests
   :description "Simple demo/test code for taglib"
   :author "Mark VandenBrink"
-  :license "Public Domain"
+  :license "UNLICENSE <http://unlicense.org/>"
   :depends-on (#:taglib #:cl-fad #+(or :ccl :sbcl :abcl) #:chanl)
   :components ((:file "taglib-tests")))

+ 1 - 1
taglib.asd

@@ -6,7 +6,7 @@
 (asdf:defsystem #:taglib
   :description "Pure Lisp implementation to read (and write, perhaps, one day) tags"
   :author "Mark VandenBrink"
-  :license "Public Domain"
+  :license "UNLICENSE <http://unlicense.org/>"
   :depends-on (#:optima #:optima.ppcre #:flexi-streams
                         #+(or :ccl :sbcl :abcl) #:bordeaux-threads)
   :components ((:file "packages")

+ 15 - 8
utils.lisp

@@ -3,19 +3,23 @@
 (in-package #:utils)
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  #+DBG (defvar *standard-optimize-settings* '(optimize (debug 3)))
-  #-DBG (defvar *standard-optimize-settings* '(optimize (speed 3) (safety 0) (space 0) (debug 0)))
-  )
+#+dbg
+  (defvar *standard-optimize-settings* '(optimize (debug 3)))
+#-dbg
+  (defvar *standard-optimize-settings* '(optimize (speed 3) (safety 0) (space 0) (debug 0)))
+)
 
 (defparameter *break-on-warn-user* nil "set to T if you'd like to stop in warn-user")
 
 (defun warn-user (format-string &rest args)
   "Print a warning error to *ERROR-OUTPUT* and continue"
   (declare #.utils:*standard-optimize-settings*)
+
   (when *break-on-warn-user*
     (break "Breaking in WARN-USER"))
+
   (format *error-output* "~&********************************************************************************~%")
-  #+CCL (format *error-output* "~&WARNING in ~a:: " (ccl::%last-fn-on-stack 1))
+#+ccl (format *error-output* "~&WARNING in ~a:: " (ccl::%last-fn-on-stack 1))
   (apply #'format *error-output* format-string args)
   (format *error-output* "~&**********************************************************************************~%"))
 
@@ -24,6 +28,7 @@
 (defun printable-array (array &optional (max-len *max-raw-bytes-print-len*))
   "Given an array, return a string of the first *MAX-RAW-BYTES-PRINT-LEN* bytes"
   (declare #.utils:*standard-optimize-settings*)
+
   (let* ((len (length array))
          (print-len (min len max-len))
          (printable-array (make-array print-len :displaced-to array)))
@@ -48,7 +53,8 @@
      ,@body
      (finish-output *standard-output*)))
 
-(defun get-bitmask(start width)
+(declaim (inline get-bitmask))
+(defun get-bitmask (start width)
   "Create a bit mask that begins at bit START (31 is MSB) and is WIDTH bits wide.
 Example: (get-bitmask 31 11) -->> #xffe00000"
   (declare #.utils:*standard-optimize-settings*)
@@ -87,6 +93,7 @@ The above will expand to (ash (logand #xFFFBB240 #xFFE00000) -21) at COMPILE tim
 ;;; Note: CCL hash-tables are thread-safe, but some other implementations
 ;;; don't appear to be...
 (defstruct locked-hash-table lock hash-table)
+
 #+(or :ccl :sbcl :abcl)
 (defmacro with-lock ((l) &body body)
   `(bt:with-lock-held (,l)
@@ -125,7 +132,7 @@ The above will expand to (ash (logand #xFFFBB240 #xFFE00000) -21) at COMPILE tim
     (float (/ (- (get-internal-real-time) real-base) internal-time-units-per-second))))
 
 ;;; Taken from ASDF
-(defmacro DBG (tag &rest exprs)
+(defmacro dbg (tag &rest exprs)
   "debug macro for print-debugging:
 TAG is typically a constant string or keyword to identify who is printing,
 but can be an arbitrary expression returning a tag to be princ'ed first;
@@ -143,13 +150,13 @@ The macro expansion has relatively low overhead in space or time."
     `(let ((,tag-var ,tag))
        (flet ,(when exprs `((,thunk-var () ,last-expr)))
          (if ,tag-var
-             (DBG-helper ,tag-var
+             (dbg-helper ,tag-var
                          (list ,@(loop :for x :in other-exprs :collect
                                        `(cons ',x #'(lambda () ,x))))
                          ',last-expr ,(if exprs `#',thunk-var nil))
              ,(if exprs `(,thunk-var) '(values)))))))
 
-(defun DBG-helper (tag expressions-thunks last-expression last-thunk)
+(defun dbg-helper (tag expressions-thunks last-expression last-thunk)
   ;; Helper for the above debugging macro
   (declare #.utils:*standard-optimize-settings*)
   (labels