/
flac.lisp
182 lines (152 loc) · 8.08 KB
/
flac.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
;;; -*- 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 "~4tVendor 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))))))