Code: Select all
(defun stretched-base64-image (img)
"Call ImageMagick to resize that file to 32x32. This is made for sbcl."
(let*
((imagemagick (sb-ext:run-program "/usr/bin/convert" (list "-geometry" "32x32!" "-" "-")
:input :stream :output :stream :error :stream :wait nil))
(thread (sb-thread:make-thread #'(lambda ()
(labels ((beginread (cbyte cinput stream)
(if (eql cbyte 'EOF)
(make-array (list (length cinput))
:initial-contents (nreverse cinput)
:adjustable nil)
(progn
(beginread
(read-byte stream nil 'EOF)
(push cbyte cinput) stream)))))
(beginread (read-byte
(sb-ext:process-output imagemagick)
nil 'EOF)
nil
(sb-ext:process-output imagemagick)))))))
(write-sequence img (sb-ext:process-input imagemagick))
(finish-output (sb-ext:process-input imagemagick))
(close (sb-ext:process-input imagemagick))
(cl-base64:usb8-array-to-base64-string (sb-thread:join-thread thread))))
Code: Select all
(with-open-file (in file :element-type '(unsigned-byte 8))
(let* ((length (file-length in))
(content (make-array (list length)
:element-type '(unsigned-byte 8)
:adjustable nil)))
(read-sequence content in)
content))
Code: Select all
(read-byte stream nil 'EOF)
Code: Select all
; file: /tmp/fileAJJi3Q.lisp
; in: DEFUN STRETCHED-BASE64-IMAGE
; (READ-BYTE STREAM NIL 'MY-PACKAGE::EOF)
; --> BLOCK IF LET IF SB-IMPL::EOF-OR-LOSE IF ERROR
; ==>
; STREAM
;
; note: deleting unreachable code
;
; compilation unit finished
; printed 1 note
I know there is cl-magick but I couldnt find a function to convert byte-vectors into byte-vectors, and I have my reasons why I load the files into byte-vectors, and dont access the files directly (and as written below, this shouldnt be the problem here).
The whole code seems to work, but returns strange output, when running convert manually, and then encoding it with uuencode --base64, something completely different results.
To find the error, I replaced 32x32! by 1x1! and removed the base64-encoding. The resulting vector is correct - when I convert the file manually and look at the bytes written, the result is the same. Only the base64-encoded result is different.
So there must be something wrong with cl-base64. Any suggestions?
EDIT:Ok, I have made my own Base64-Implementation, and with it, it works:
Code: Select all
(defun get-base64-char-for-number (i)
(declare (type (integer 0 63) i))
(elt "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" i))
(defun base64-encode-threebytes (byte1 byte2 byte3)
(declare (type (unsigned-byte 8) byte1 byte2 byte3))
(coerce
(list
(get-base64-char-for-number (logand #b111111 (ash byte1 -2)))
(get-base64-char-for-number (logand #b111111 (+ (ash (ash byte1 6) -2) (ash byte2 -4))))
(get-base64-char-for-number (logand #b111111 (+ (ash (ash byte2 4) -2) (ash byte3 -6))))
(get-base64-char-for-number (logand #b111111 (ash (ash byte3 2) -2)))) 'string))
(defun base64-encode-bytelist (bytelist &optional (ret ""))
(if bytelist
(if (cdr bytelist)
(if (cddr bytelist)
(base64-encode-bytelist
(cdddr bytelist)
(concatenate 'string
ret
(base64-encode-threebytes
(car bytelist)
(cadr bytelist)
(caddr bytelist))))
;;else (genau zwei elemente)
(concatenate 'string ret
(base64-encode-threebytes
(car bytelist)
(cadr bytelist)
0)
"="))
;;else (genau ein element)
(concatenate 'string ret
(base64-encode-threebytes
(car bytelist) 0 0)
"=="))
;;else (kein element)
ret))