lwo-write.lisp

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