More work on lwo loading. Useful bit - destructuring macro.
[lodematron.git] / lwo-write.lisp
blob82a3f4eed3167d2880230c4fcc913dc41461848c
2 (in-package :cl-lwo)
4 ;; ;; write aligned binary data -----------------------------------------
6 ;; (defgeneric align-for-write (binary-file-data alignment))
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))))
14 ;; (defgeneric write-value (type binary-file-data value &key)
15 ;; (:documentation "Read a value of the given type from the file."))
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))))))
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))))
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)))))
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)))))
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
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)))))
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))))
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)))))
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)))))
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)))))