commit 4ae3851eaea896105cfe7fb97457210649043cdb
parent 54ec6bcd626c46728bee10d20b9ae78e7186eb43
Author: Tomas Hlavaty <tom@logand.com>
Date: Mon, 23 May 2011 22:35:20 +0200
more OfficeArtBlips added
Diffstat:
| M | ole.lisp | | | 64 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++--------- |
1 file changed, 55 insertions(+), 9 deletions(-)
diff --git a/ole.lisp b/ole.lisp
@@ -408,14 +408,36 @@
(make-instance 'shorter-stream :wrap ,wrap :size ,size)
(lambda (,var) ,@body)))
+(define-structure POINT ()
+ (x dword)
+ (y dword))
+
+(define-structure RECT ()
+ (left dword)
+ (top dword)
+ (right dword)
+ (bottom dword))
+
+(define-structure OfficeArtMetafileHeader ()
+ (cbSize dword)
+ (rcBounds RECT)
+ (ptSize POINT)
+ (cbSave dword)
+ (compression byte :member '(#x00 #xfe))
+ (filter byte :always #xfe))
+
(defun read-record (stream dir &optional n) ;; TODO remove dir and n
(let ((x (read-RecordHeader stream)))
(with-slots (recVer recInstance recType recLen) x
- (flet ((blip (ext)
+ (flet ((blip (ext guid2 &optional metafileHeader)
(with-shorter-stream (in stream (RecordHeader.recLen x))
- (list x
+ (list x ;; TODO make struct
(read-value 'guid in)
- (read-value 'ubyte in)
+ (when (member recInstance guid2)
+ (read-value 'guid in))
+ (if metafileHeader
+ (read-value 'OfficeArtMetafileHeader in)
+ (read-value 'ubyte in))
(with-open-file (out (format nil "~a/_~d.~a" dir n ext)
:direction :output
:if-does-not-exist :create
@@ -427,14 +449,38 @@
(assert (zerop recVer))
(assert (zerop recInstance))
(list x (read-CurrentUserAtom stream))
- #+nil
+ #+nil ;; why recLen too small?
(with-shorter-stream (in stream (RecordHeader.recLen x))
- (list x (read-CurrentUserAtom in)))) ;; why recLen too small?
- ((#xF01E) ;; OfficeArtBlipPNG
+ (list x (read-CurrentUserAtom in))))
+ ((#xF01A) ;; OfficeArtBlipEMF
(assert (zerop recVer))
- (assert (member recInstance '(#x6e0 #x6e1)))
- (values (blip "png") :png))
+ (assert (member recInstance '(#x3d4 #x3d5)))
+ (values (blip "emf" '(#x3d5) t) :emf))
+ ((#xF01B) ;; OfficeArtBlipWMF
+ (assert (zerop recVer))
+ (assert (member recInstance '(#x216 #x217)))
+ (values (blip "wmf" '(#x217) t) :wmf))
+ ((#xF01C) ;; OfficeArtBlipPICT
+ (assert (zerop recVer))
+ (assert (member recInstance '(#x542 #x543)))
+ (values (blip "pict" '(#x543) t) :pict))
(#xF01D ;; OfficeArtBlipJPEG
(assert (zerop recVer))
(assert (member recInstance '(#x46A #x46B #x6E2 #x6E3)))
- (values (blip "jpeg") :jpeg)))))))
+ (values (blip "jpeg" '(#x46B #x6E3)) :jpeg))
+ ((#xF01E) ;; OfficeArtBlipPNG
+ (assert (zerop recVer))
+ (assert (member recInstance '(#x6e0 #x6e1)))
+ (values (blip "png"'(#x6e1)) :png))
+ ((#xF01F) ;; OfficeArtBlipDIB
+ (assert (zerop recVer))
+ (assert (member recInstance '(#x7a8 #x7a9)))
+ (values (blip "dib" '(#x7a9)) :dib))
+ ((#xF029) ;; OfficeArtBlipTIFF
+ (assert (zerop recVer))
+ (assert (member recInstance '(#x6e4 #x6e5)))
+ (values (blip "tiff" '(#x6e5)) :tiff))
+ ((#xF02A) ;; OfficeArtBlipJPEG
+ (assert (zerop recVer))
+ (assert (member recInstance '(#x46A #x46B #x6E2 #x6E3)))
+ (values (blip "jpeg" '(#x46B #x6E3)) :jpeg)))))))
