X-Git-Url: http://uxul.de/gitweb/?a=blobdiff_plain;f=leveleditor.lisp;h=192f79f8ade49f0601c3d9fa98a0d6c05875557b;hb=refs%2Fremotes%2Forigin%2FHEAD;hp=86a6ccc5a6fa2ff806d08a55cb31450cb1256888;hpb=741faf5a2e1b4a133807530778e507d674cc02b1;p=uxul-world.git

diff --git a/leveleditor.lisp b/leveleditor.lisp
old mode 100644
new mode 100755
index 86a6ccc..192f79f
--- a/leveleditor.lisp
+++ b/leveleditor.lisp
@@ -1,30 +1,84 @@
-;;; 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."
@@ -33,6 +87,7 @@
 (defun prepare-images (&optional (care-about-initialization *leveleditor-images*))
   (when (not care-about-initialization)
     (setf *leveleditor-images* (make-hash-table))
+    (uxul-world::init-files)
     (setf (gethash 'uxul-world::uxul *leveleditor-images*) (stretched-image uxul-world::|uxul_small1|))
     (setf (gethash 'uxul-world::leaf *leveleditor-images*) (stretched-image uxul-world::|leaf|))
     (setf (gethash 'uxul-world::nasobem *leveleditor-images*) (stretched-image uxul-world::|nasobem|))