From: Christoph Senjak <christoph@christoph-senjaks-macbook-pro.local>
Date: Sat, 22 Aug 2009 18:04:52 +0000 (+0200)
Subject: Two additional String-Arguments in the Level-Editor are now possible.
X-Git-Url: http://uxul.de/gitweb/?p=uxul-world.git;a=commitdiff_plain;h=4e8bd7f10df674c08e258b6b1bd5c3d2cf60573c

Two additional String-Arguments in the Level-Editor are now possible.
So far no problem. But it could produce bugs.
---

diff --git a/leveleditor.lisp b/leveleditor.lisp
index 02f45b1..da98fb1 100644
--- a/leveleditor.lisp
+++ b/leveleditor.lisp
@@ -62,7 +62,7 @@ form (x y object arg1 arg2 ...)."
   (let ((ret nil))
     (maphash #'(lambda (key val)
 		 (when val
-		   (push (list (car key) (cdr key) val) ret)))
+		   (push (concatenate 'list (list (car key) (cdr key)) val)  ret)))
 	     item-table)
     ret))
 
@@ -71,7 +71,7 @@ form (x y object arg1 arg2 ...)."
   (let ((item-table (make-hash-table :test 'equal)))
     ;;initialize given level
     (dolist (item level)
-      (setf (gethash (cons (car item) (cadr item)) item-table) (caddr item)))
+      (setf (gethash (cons (car item) (cadr item)) item-table) (cddr item)))
     
     (ltk:with-ltk ()
       (let*
@@ -108,6 +108,10 @@ form (x y object arg1 arg2 ...)."
 				     :master arrow-frame))
 	   (ddown-button (make-instance 'ltk:button :text "\\\\//"
 				       :master arrow-frame))
+	   (argument1-entry (make-instance 'ltk:entry :text ""
+					   :master object-frame))
+	   (argument2-entry (make-instance 'ltk:entry :text ""
+					   :master object-frame))
 	   (uxul-button (make-instance 'ltk:button :text ""
 				       :master object-frame))
 	   (nasobem-button (make-instance 'ltk:button :text ""
@@ -172,15 +176,11 @@ form (x y object arg1 arg2 ...)."
 		 (react (i j)
 		   (let ((current-upper-x (car current-upper-left))
 			 (current-upper-y (cdr current-upper-left)))
-		     (cond
-		       ((eq current-chosen-object 'uxul-world::burning-marshmallow)
-			(setf (gethash (cons (+ i current-upper-x)
-					     (+ j current-upper-y))
-				       item-table) 'uxul-world::burning-marshmallow))
-		       (t
-			(setf (gethash (cons (+ i current-upper-x)
-					     (+ j current-upper-y))
-				       item-table) current-chosen-object)))
+		     (setf (gethash (cons (+ i current-upper-x)
+					  (+ j current-upper-y))
+				    item-table)
+			   (and current-chosen-object
+				(list current-chosen-object (ltk:text argument1-entry) (ltk:text argument2-entry))))
 		     (redraw-button i j)))
 		 (move-field-about (i j)
 		   (let ((current-upper-y (car current-upper-left))
@@ -206,6 +206,9 @@ 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 empty-button 0 0)
 	  (config-button-image empty-button empty)
 	  (setf (ltk:command empty-button)