lodematron-write.lisp

   1
   2 (in-package :lodematron)
   3
   4 ;; WIP
   5
   6 ;; ;; write aligned binary data  -----------------------------------------
   7
   8 ;; (defgeneric align-for-write (binary-file-data alignment))
   9
  10 ;; (defmethod align-for-write ((self binary-file-data) alignment)
  11 ;;   (loop
  12 ;;      until (zerop (logand (length (buffered-data-of self)) (1- alignment)))
  13 ;;      do
  14 ;;      (vector-push-extend 0 (buffered-data-of self))))
  15
  16 ;; (defgeneric write-value (type binary-file-data value &key)
  17 ;;   (:documentation "Read a value of the given type from the file."))
  18
  19 ;; (defmacro with-size-and-alignment-write (element-type alignment array-size value-sym  &rest body)
  20 ;;     (once-only (alignment array-size)
  21 ;;              (with-gensyms (write-once result)
  22 ;;                `(labels ((,write-once (,value-sym)
  23 ;;                           ,@body))
  24 ;;                  (when ,alignment
  25 ;;                    (align-for-write self alignment))
  26 ;;                  (if ,array-size
  27 ;;                      (let ((,result (make-array ,array-size :element-type ',element-type)))
  28 ;;                        (loop
  29 ;;                           for index from 0 below ,array-size
  30 ;;                           do
  31 ;;                             (,write-once (aref ,result index))))
  32 ;;                      (,write-once ,value-sym))))))
  33
  34 ;; ;; (defmethod write-value ((type (eql 'u8)) (self binary-file-data) value &key array-size alignment)
  35 ;; ;;   (labels ((write-once (value)
  36 ;; ;;              (vector-push-extend value (buffered-data-of self))))
  37 ;; ;;     (when alignment
  38 ;; ;;       (align-for-write self alignment))
  39 ;; ;;     (if (array-size)
  40 ;; ;;         (loop
  41 ;; ;;            for index from 0 below array-size
  42 ;; ;;              do
  43 ;; ;;              (write-once (aref value index)))
  44 ;; ;;         (write-once value))))
  45
  46 ;; (defmethod write-value ((type (eql 'u8)) (self binary-file-data) value &key array-size alignment (endian :little))
  47 ;;   (declare (ignore endian))
  48 ;;   (with-size-and-alignment-write
  49 ;;       (unsigned-byte 8) alignment array-size value
  50 ;;       (vector-push-extend value (buffered-data-of self)))))
  51
  52
  53 ;; (defmethod write-value ((type (eql 's8)) (self binary-file-data) value &key array-size alignment (endian :little))
  54 ;;   (declare (ignore endian))
  55 ;;     (with-size-and-alignment-write
  56 ;;       (unsigned-byte 8) alignment array-size value
  57 ;;       (vector-push-extend value (buffered-data-of self)))))
  58
  59 ;; (defmethod write-value ((type (eql 'u16)) (self binary-file-data) value &key array-size alignment (endian :little))
  60 ;;     (with-size-and-alignment-write
  61 ;;         (unsigned-byte 16) alignment array-size value
  62
  63 ;;         (vector-push-extend (ldb (byte 8 0) value)
  64 ;;                             (buffered-data-of self))
  65 ;;         (vector-push-extend (ldb (byte 8 8) value)
  66 ;;                       (buffered-data-of self)))))
  67
  68 ;; (defmethod write-value ((type (eql 's16)) (self binary-file-data) value &key array-size alignment (endian :little))
  69 ;;     (with-size-and-alignment-write
  70 ;;         (unsigned-byte 16) alignment array-size value
  71 ;;     (vector-push-extend (ldb (byte 8 0) value)
  72 ;;                         (buffered-data-of self))
  73 ;;     (vector-push-extend (ldb (byte 8 8) value)
  74 ;;                         (buffered-data-of self))))
  75
  76 ;; (defmethod write-value ((type (eql 'u32)) (self binary-file-data) value &key array-size alignment (endian :little))
  77 ;;     (with-size-and-alignment-write
  78 ;;         (unsigned-byte 32) alignment array-size value
  79 ;;         (vector-push-extend (ldb (byte 8 0) value) (buffered-data-of self))
  80 ;;         (vector-push-extend (ldb (byte 8 8) value) (buffered-data-of self))
  81 ;;         (vector-push-extend (ldb (byte 8 16) value) (buffered-data-of self))
  82 ;;         (vector-push-extend (ldb (byte 8 24) value) (buffered-data-of self)))))
  83
  84 ;; (defmethod write-value ((type (eql 's32)) (self binary-file-data) value &key array-size alignment (endian :little))
  85 ;;     (with-size-and-alignment-write
  86 ;;         (unsigned-byte 32) alignment array-size value
  87 ;;         (vector-push-extend (ldb (byte 8 0) value) (buffered-data-of self))
  88 ;;         (vector-push-extend (ldb (byte 8 8) value) (buffered-data-of self))
  89 ;;         (vector-push-extend (ldb (byte 8 16) value) (buffered-data-of self))
  90 ;;         (vector-push-extend (ldb (byte 8 24) value) (buffered-data-of self)))))
  91
  92
  93 ;; (defmethod write-value ((type (eql 'asciiz)) (self binary-file-data) string &key array-size alignment (endian :little))
  94 ;;   (with-size-and-alignment-write
  95 ;;       string alignment array-size string
  96 ;;       (loop
  97 ;;          for char across string
  98 ;;          do (vector-push-extend
  99 ;;              (char-code char)
 100 ;;              (buffered-data-of self))
 101 ;;            (vector-push-extend (char-code #\Nul) (buffered-data-of self)))))