taglib/streams.lisp

;;; -*- Mode: Lisp;  show-trailing-whitespace: t; Base: 10; indent-tabs: nil; Syntax: ANSI-Common-Lisp; Package: STREAMS; -*-
;;; Copyright (c) 2013, Mark VandenBrink. All rights reserved.

(in-package #:audio-streams)

(log5:defcategory cat-log-stream)
(defmacro log-stream (&rest log-stuff) `(log5:log-for (cat-log-stream) ,@log-stuff))

(deftype octet () '(unsigned-byte 8))
(defmacro make-octets (len) `(make-array ,len :element-type 'octet))

(defclass base-stream ()
  ((filename  :accessor filename  :initarg :filename)
   (instream  :accessor instream  :initform nil)
   (endian    :accessor endian    :initarg :endian :initform nil)   ; controls endian-ness of read/writes
   (modified  :accessor modified  :initform nil)					; for when we implement writing tags
   (file-size :accessor file-size))
  (:documentation "Base class for all audio file types"))

(defmethod initialize-instance :after ((me base-stream) &key read-only &allow-other-keys)
  (log5:with-context "base-stream-initializer"
  (with-slots (instream filename file-size endian) me
	(setf instream (if read-only
					   (open filename :direction :input :element-type 'octet)
					   (open filename :direction :io :if-exists :overwrite :element-type 'octet)))
	(setf binary-types:*endian* endian)
	(setf file-size (file-length instream))
	(log-stream "stream = ~a, name = ~a, size = ~:d~%endian = ~a"
				   instream filename file-size endian))))

(defmethod stream-close ((me base-stream))
  "Close an open stream."
  (with-slots (instream modified) me
	(when modified
	  (warn "at some point, should I add code to auto-write modified audio-files?")
	  (setf modified nil))
	(when instream
	  (close instream)
	  (setf instream nil))))

(defmethod stream-seek ((me base-stream) offset from)
  "C-library like seek function. from can be one of :current, :start, :end.
Returns the current offset into the stream"
  (assert (member from '(:current :start :end)) () "seek takes one of :current, :start, :end")
  (with-slots (instream file-size) me
	(ecase from
	  (:start (file-position instream offset))
	  (:current
	   (let ((current (file-position instream)))
		 (file-position instream (+ current offset))))
	  (:end
	   (file-position instream (- file-size offset))))))

(defmethod stream-read-u8 ((me base-stream))
  "read 1 byte from file"
  (multiple-value-bind (value size) (binary-types:read-binary 'u8 (slot-value me 'instream))
	(assert (= size 1) () "Expected to read 1 byte, got ~d instead" size)
	value))

(defmethod stream-read-u16 ((me base-stream))
  "read 2 bytes from file"
  (multiple-value-bind (value size) (binary-types:read-binary 'u16 (slot-value me 'instream))
	(assert (= size 2) () "Expected to read 2 bytes, got ~d instead" size)
	value))

;;; read 3-bytes
(binary-types:define-unsigned u24 3)

(defmethod stream-read-u24 ((me base-stream))
  "read 3 bytes from file"
  (multiple-value-bind (value size) (binary-types:read-binary 'u24 (slot-value me 'instream))
	(assert (= size 3) () "Expected to read 3 bytes, got ~d instead" size)
	value))

(defmethod stream-read-u32 ((me base-stream))
  "read 4 bytes from file"
  (multiple-value-bind (value size) (binary-types:read-binary 'u32 (slot-value me 'instream))
	(assert (= size 4) () "Expected to read 4 bytes, got ~d instead" size)
	value))

(defmethod stream-read-string ((me base-stream) &key size (terminators nil))
  "Read normal string from file. If size is provided, read exactly that many octets.
If terminators is supplied, it is a list of characters that can terminate a string (and hence stop read)"
  (multiple-value-bind (value read-size)
	  (binary-types:read-binary-string (slot-value me 'instream) :size size :terminators terminators)
	(declare (ignore read-size))
	;; what checks should happen here?
	value))

(defmethod stream-read-octets ((me base-stream) size)
  "Read SIZE octets from input-file"
  (let* ((octets (make-octets size))
		 (read-len (read-sequence octets (slot-value me 'instream))))
	(assert (= read-len size))
	octets))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; MP4 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(log5:defcategory cat-log-mp4-stream)
(defmacro log-mp4-stream (&rest log-stuff) `(log5:log-for (cat-log-mp4-stream) ,@log-stuff))

(defclass mp4-stream (base-stream)
  ((mp4-atoms :accessor mp4-atoms :initform nil))
  (:documentation "Class to access m4a/mp4 files"))

(defun make-mp4-stream (filename read-only &key)
  "Convenience function to create an instance of MP4-FILE with appropriate init args"
  (log5:with-context "make-mp4-stream"
	(log-mp4-stream "opening ~a" filename)
	(let (handle)
	  (handler-case 
		  (progn
			(setf handle (make-instance 'mp4-stream :filename filename :endian :big-endian :read-only read-only))
			(with-slots (mp4-atoms) handle
			  (log-mp4-stream "getting atoms")
			  (setf mp4-atoms (mp4-atom:find-mp4-atoms handle))))
		(condition (c)
		  (warn "make-mp4-stream got condition: ~a" c)
		  (when handle (stream-close handle))
		  (setf handle nil)))
		handle)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; MP3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(log5:defcategory cat-log-mp3-stream)

(defmacro log-mp3-stream (&rest log-stuff) `(log5:log-for (cat-log-mp3-stream) ,@log-stuff))

(defclass mp3-stream (base-stream)
  ((mp3-header :accessor mp3-header :initform nil))
  (:documentation "Class to access mp3 files"))

(defun make-mp3-stream (filename read-only &key)
  "Convenience function to create an instance of MP3-FILE with appropriate init args.
NB: we assume non-syncsafe as default"
  (log5:with-context "make-mp3-stream"
	(log-mp3-stream "opening ~a" filename)
	(let (handle)
	  (handler-case 
		  (progn
			(setf handle (make-instance 'mp3-stream :filename filename :endian :little-endian :read-only read-only))
			(with-slots (mp3-header) handle
			  (log-mp3-stream "getting frames")
			  (setf mp3-header (mp3-frame:find-mp3-frames handle))))
		(condition (c)
		  (warn "make-mp3-stream got condition: ~a" c)
		  (when handle (stream-close handle))
		  (setf handle nil)))
	  handle)))

(defmethod stream-read-sync-safe-u32 ((me mp3-stream))
  "Read a sync-safe integer from file.  Used by mp3 files"
  (let* ((ret 0))
	(setf (ldb (byte 7 21) ret) (stream-read-u8 me))
	(setf (ldb (byte 7 14) ret) (stream-read-u8 me))
	(setf (ldb (byte 7 7) ret)  (stream-read-u8 me))
	(setf (ldb (byte 7 0) ret)  (stream-read-u8 me))
	ret))

(defmethod stream-read-sync-safe-octets ((me mp3-stream) len)
  "Used to undo sync-safe read of file"
  (let* ((last-byte-was-FF nil)
		 (byte nil)
		 (de-synced-data (binary-types:with-binary-output-to-vector (out)
						   (dotimes (i len)
							 (setf byte (stream-read-u8 me))
							 (if last-byte-was-FF
								 (if (not (zerop byte))
									 (write-byte byte out))
								 (write-byte byte out))
							 (setf last-byte-was-FF (= byte #xFF))))))
	de-synced-data))