[bknr-cvs] hans changed trunk/bknr/web/src/images/image.lisp

[BKNR Commits]

Revision: 4030
Author: hans
URL: http://bknr.net/trac/changeset/4030

Always create jpeg images with maximum quality.

U   trunk/bknr/web/src/images/image.lisp

Modified: trunk/bknr/web/src/images/image.lisp
===================================================================
--- trunk/bknr/web/src/images/image.lisp	2008-11-10 09:38:22 UTC (rev 4029)
+++ trunk/bknr/web/src/images/image.lisp	2008-11-10 09:39:19 UTC (rev 4030)
@@ -82,9 +82,12 @@
 			    initargs)))
     (ensure-directories-exist (blob-pathname store-image))
     (ignore-errors (delete-file (blob-pathname store-image)))
-    (cl-gd:write-image-to-file (blob-pathname store-image)
-			       :image image
-			       :type type)
+    (apply #'cl-gd:write-image-to-file
+           (blob-pathname store-image)
+           :image image
+           :type type
+           (when (eq type :jpg)
+             (list :quality 95)))
     store-image))
 
 (defmacro with-store-image-from-id ((var id) &rest body)