-;;; Copyright 2009 Christoph Senjak
+;;; Copyright 2009-2011 Christoph Senjak
(in-package :uxul-world-leveleditor)
(defparameter *leveleditor-images* nil)
-(defun stretched-image (img)
- "Call ImageMagick to resize that file to 32x32."
- (lisp-magick:with-magick-wand (mywand)
- (lisp-magick::magick-read-image-blob mywand img)
- (lisp-magick::magick-resize-image mywand 32 32 #x00000000 1d0)
- (lisp-magick::magick-set-format mywand "gif")
- (lisp-magick::magick-get-image-blob mywand)))
+(defun bmp-to-gif (inblob)
+ "Convert BMP to Grayscale-Gif using skippy."
+ (let*
+ ((w (uxul-world::bmp-width inblob))
+ (h (uxul-world::bmp-height inblob))
+ (img (uxul-world::bmp-pixel-data inblob))
+ (color-table (skippy:make-color-table))
+ (colors
+ (let
+ ((v (make-array '(256) :adjustable nil)))
+ (dotimes (i 256)
+ (setf (elt v i)
+ (skippy:ensure-color (skippy:rgb-color i i i) color-table)))
+ v))
+ (grayscale (lambda (x)
+ ;; 0 becomes transparent
+ (cond
+ ((< (elt x 3) 128) 0)
+ (t (max 1
+ (round
+ (/ (+ (elt x 1) (elt x 2) (elt x 0)) 3)))))))
+ (image-data
+ (let ((id (skippy:make-image-data w h)))
+ (dotimes (i w)
+ (dotimes (j h)
+ (setf (elt id (+ i (* w (- h j 1))))
+ (elt colors
+ (funcall grayscale
+ (make-array '(4)
+ :element-type '(unsigned-byte 8)
+ :displaced-to img
+ :displaced-index-offset
+ (* 4 (+ i (* w j)))))))))
+ id))
+ (image (skippy:make-image :width w :height h
+ :image-data image-data
+ :transparency-index 0))
+ (data-stream (skippy:make-data-stream
+ :height h :width w
+ :color-table color-table)))
+ (skippy:add-image image data-stream)
+ (flexi-streams:with-output-to-sequence (out)
+ (skippy:write-data-stream data-stream out))))
+
+(defun stretched-image (imgs)
+ "Resize that image to 32x32 and convert it into a gif."
+ (let*
+ ((w (car imgs))
+ (h (cadr imgs))
+ (x (elt imgs 6))
+ (y (elt imgs 7))
+ (*spritesheet* uxul-world::*spritesheet*)
+ (image (uxul-world::sub-image x y w h (car *spritesheet*)
+ (cadr *spritesheet*)
+ (cadr *spritesheet*))))
+ (bmp-to-gif
+ (uxul-world::resize-bmp-blob image 32 32))))
(defun annotated-image (img ann)
"Add a (lower-left) annotation."
- (lisp-magick:with-magick-wand (mywand)
- (lisp-magick::magick-read-image-blob mywand img)
- (lisp-magick:with-drawing-wand (dw)
- (lisp-magick:with-pixel-wand (pw :comp (255 255 255))
- (lisp-magick::draw-set-text-under-color dw pw))
- (lisp-magick:with-pixel-wand (pw :comp (255 0 0))
- (lisp-magick::draw-set-fill-color dw pw))
- (lisp-magick:draw-annotation dw (coerce 0 'double-float) (coerce 32 'double-float) ann)
- (lisp-magick:magick-draw-image mywand dw))
- (lisp-magick::magick-set-format mywand "gif")
- (lisp-magick::magick-get-image-blob mywand)))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;FIXME
+img
+
+;; (lisp-magick:with-magick-wand (mywand)
+;; (lisp-magick::magick-read-image-blob mywand img)
+;; (lisp-magick:with-drawing-wand (dw)
+;; (lisp-magick:with-pixel-wand (pw :comp (255 255 255))
+;; (lisp-magick::draw-set-text-under-color dw pw))
+;; (lisp-magick:with-pixel-wand (pw :comp (255 0 0))
+;; (lisp-magick::draw-set-fill-color dw pw))
+;; (lisp-magick:draw-annotation dw (coerce 0 'double-float) (coerce 32 'double-float) ann)
+;; (lisp-magick:magick-draw-image mywand dw))
+;; (lisp-magick::magick-set-format mywand "gif")
+;; (lisp-magick::magick-get-image-blob mywand)))
+)
(defun numbered-image (img num)
"Annotate the image with a number."