First test for Bitmaps.

[uxul-world.git] / leveleditor.lisp

diff --git a/leveleditor.lisp b/leveleditor.lisp
old mode 100644 (file)
new mode 100755 (executable)
index 9607616..4427396
--- a/leveleditor.lisp
+++ b/leveleditor.lisp
@@ -5,26 +5,28 @@
 (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)))
+  "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 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 +35,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|))
@@ -143,6 +146,8 @@ form (x y object arg1 arg2 ...)."
                                       :master object-frame))
           (anchor-button (make-instance 'ltk:button :text ""
                                         :master object-frame))
+          (info-button (make-instance 'ltk:button :text "Info"
+                                      :master object-frame))
           (btns (make-array (list width height) :adjustable nil :element-type 'ltk:button)))
        (labels ((redraw-button (i j)
                   "Redraw Button (i, j)"
@@ -178,9 +183,6 @@ form (x y object arg1 arg2 ...)."
                       ((eq cval 'uxul-world::key)
                        (config-button-image cbtn key))
                       ((eq cval 'uxul-world::anchor)
-                       (format t "fuck")
-                       (format t (cadr cval2))
-                       (write (gethash (cadr cval2) anchors))
                        (config-button-image cbtn (gethash (cadr cval2) anchors)))
                       ((eq cval 'uxul-world::uxul)
                        (config-button-image cbtn uxul)))))
@@ -193,6 +195,18 @@ form (x y object arg1 arg2 ...)."
                   (let ((current-upper-x (car current-upper-left))
                         (current-upper-y (cdr current-upper-left)))
                     (cond
+                      ((eql current-chosen-object :info)
+                       (let ((sym (gethash (cons (+ i current-upper-x)
+                                         (+ j current-upper-y))
+                                   item-table nil)))
+                         (if sym
+                             (ltk:do-msg
+                                 (format nil (concatenate 'string
+                                                          "Symbolname: \"" (symbol-name (car sym)) "\"~%"
+                                                          "First argument: \"" (cadr sym) "\"~%"
+                                                          "Second argument: \"" (caddr sym) "\"")))
+                             (ltk:do-msg "There doesnt seem to be anything here."))
+                         (return-from react)))
                       ((eql current-chosen-object 'uxul-world::anchor)
                        (cond
                          ((string= (ltk:text argument1-entry) "")
@@ -237,8 +251,11 @@ form (x y object arg1 arg2 ...)."
          (ltk:grid ddown-button 2 2)
          (setf (ltk:command ddown-button) #'(lambda () (move-field-about (- 1 width) 0)))
 
-         (ltk:grid argument1-entry 1 0 :columnspan 5)
-         (ltk:grid argument2-entry 1 6 :columnspan 5)
+         (ltk:grid argument1-entry 1 0 :columnspan 4)
+         (ltk:grid argument2-entry 1 5 :columnspan 4)
+         (ltk:grid info-button 1 9 :columnspan 2)
+         (setf (ltk:command info-button)
+               #'(lambda () (setf current-chosen-object :info)))
 
          (ltk:grid empty-button 0 0)
          (config-button-image empty-button empty)