Major Changes. Windows Compatibility.

[uxul-world.git] / imagemagick.lisp

diff --git a/imagemagick.lisp b/imagemagick.lisp
new file mode 100755 (executable)
index 0000000..51b0e13
--- /dev/null
+++ b/imagemagick.lisp
@@ -0,0 +1,36 @@
+;; Copyright 2010 Christoph Senjak\r
+\r
+(in-package :uxul-world)\r
+\r
+;; "Binding" for the "convert"-Program\r
+\r
+(defparameter *convert* #P"C:\\Program Files (x86)\\ImageMagick-6.6.2-Q16\\convert.exe")\r
+\r
+(defun run-convert (arguments in)\r
+  "Return output of convert"\r
+  (let* ((p (sb-ext:run-program *convert* arguments\r
+                                     :wait nil\r
+                                     :input :stream\r
+                                     :output :stream))\r
+        (pin (sb-ext:process-input p))\r
+        (pou (sb-ext:process-output p))\r
+        (ret '()))\r
+    (loop for byte across in do\r
+        (progn\r
+          (format t "doing~%")\r
+          (write-byte byte pin)\r
+          (loop while (listen pou) do\r
+               ;; this read should never fail and never be eof\r
+               (format t "reading 1~%")\r
+               (push (read-byte pou) ret))))\r
+    (format t "finishing out, closing~%")\r
+    (finish-output pin)\r
+    (close pin)\r
+    (let ((c 0))\r
+      (loop while (setf c (read-byte pou nil nil)) do\r
+          (format t "reading 2~%")\r
+          (push c ret)))\r
+    ret))\r
+\r
+(defun resize-image (bytes x y)\r
+  (run-convert (list "-scale" (format nil "~dx~d" x y) "-" "-") bytes))
\ No newline at end of file