From: U-christoph-TP\christoph <christoph@christoph-TP.(none)>
Date: Mon, 16 Aug 2010 18:07:49 +0000 (+0200)
Subject: Corrected the dependencies. Level Editor works again using Skippy.
X-Git-Url: http://uxul.de/gitweb/?p=uxul-world.git;a=commitdiff_plain;h=ce717bf849f95f3de30061b413c9c196b60b2363

Corrected the dependencies. Level Editor works again using Skippy.
---

diff --git a/BUGS b/BUGS
index 2756efa..c2882d8 100755
--- a/BUGS
+++ b/BUGS
@@ -1,4 +1,5 @@
-2009/08/20 starting the level-editor produces an error.
+2009/08/20 starting the level-editor produces an error
+ - FIXED (at least didnt happen again)
 
 2009/04/09 Setting the Animation of Jumping doesnt always work correct
 
diff --git a/README b/README
index 8e524a7..e517188 100755
--- a/README
+++ b/README
@@ -3,8 +3,12 @@ Last Updated 2010/05/19
 This Game is under development and may not be ready to use yet. I will
 try to keep this Readme current, but cant promise it.
 
-It depends on Lispbuilder-SDL (SVN-Revision 759 should work), LTK and
-lisp-magick.
+It depends on
+ Lispbuilder-SDL (SVN-Revision 759 should work)
+ LTK
+ skippy
+ flexi-streams
+ c2mop
 
 To start a testing-level, do (start-game).
 
diff --git a/leveleditor.lisp b/leveleditor.lisp
index 4427396..3dfc2a0 100755
--- a/leveleditor.lisp
+++ b/leveleditor.lisp
@@ -4,11 +4,55 @@
 
 (defparameter *leveleditor-images* nil)
 
-(defun stretched-image (img)
-  "Resize that file to 32x32 and convert it into a ppm."
-  ;; HAAAAAAAAAAAACK
-  (map '(vector (unsigned-byte 8)) #'char-code
-       (resized (resize-bmp-blob img 32 32))))
+(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 ppm."
+  (bmp-to-gif
+   (uxul-world::resize-bmp-blob (car imgs) 32 32)))
 
 (defun annotated-image (img ann)
   "Add a (lower-left) annotation."
diff --git a/uxul-world-leveleditor.asd b/uxul-world-leveleditor.asd
index 2ea18f5..d4fc3eb 100755
--- a/uxul-world-leveleditor.asd
+++ b/uxul-world-leveleditor.asd
@@ -8,8 +8,7 @@
   :author "Christoph Senjak <firstName.secondName at googlemail.com>"
   :license "Copyright 2009 Christoph Senjak."
   :depends-on (#:uxul-world
-	       #:ltk
-	       #:lisp-magick)
+	       #:ltk #:skippy #:flexi-streams)
   :components ((:file "uxul-world-leveleditor")
 	       (:file "leveleditor"))
   :serial t)
\ No newline at end of file
diff --git a/uxul-world.asd b/uxul-world.asd
index bbf4d66..9190c77 100755
--- a/uxul-world.asd
+++ b/uxul-world.asd
@@ -7,8 +7,7 @@
   :version "No Release Yet"
   :author "Christoph Senjak <firstName.secondName at googlemail.com>"
   :license "Copyright 2009 Christoph Senjak."
-  :depends-on (#:lispbuilder-sdl #:lisp-magick
-				 #:closer-mop
+  :depends-on (#:lispbuilder-sdl #:closer-mop
 				 #:cl-fad
                                  #:lispbuilder-sdl-image)
   :components ((:file "uxul-world")