taglib/base-file.lisp

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

(in-package #:base-file)

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

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

(defclass base-file ()
  ((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-file) &key read-only &allow-other-keys)
  (log5:with-context "base-file-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-base-file "stream = ~a, name = ~a, size = ~:d~%endian = ~a"
				   instream filename file-size endian))))

(defmethod close-audio-file ((me base-file))
  "Close an open file"
  (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 seek ((me base-file) 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 read-u8 ((me base-file))
  "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 read-u16 ((me base-file))
  "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 read-u24 ((me base-file))
  "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 read-u32 ((me base-file))
  "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 read-string ((me base-file) &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 read-octets ((me base-file) 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))