From: U-christoph-TP\christoph <christoph@christoph-TP.(none)>
Date: Wed, 7 Jul 2010 21:45:25 +0000 (+0200)
Subject: Major Changes. Windows Compatibility.
X-Git-Url: http://uxul.de/gitweb/?p=uxul-world.git;a=commitdiff_plain;h=3a5b6fe5b066ace9e3d03ec20c96c224cdbeb0b8

Major Changes. Windows Compatibility.
---

diff --git a/BUGS b/BUGS
old mode 100644
new mode 100755
diff --git a/Makefile b/Makefile
old mode 100644
new mode 100755
diff --git a/README b/README
old mode 100644
new mode 100755
diff --git a/anchor.png b/anchor.png
old mode 100644
new mode 100755
diff --git a/animation.lisp b/animation.lisp
index 20fce5b..c64a20a 100755
--- a/animation.lisp
+++ b/animation.lisp
@@ -4,6 +4,9 @@
 
 (in-package :uxul-world)
 
+(defparameter *zoom-ash* -1)
+(defmacro zoom-trans (x) `(ash ,x *zoom-ash*))
+
 (defparameter *graphics-table* nil)
 
 ;; the functions may assume that the contents of a graphics-file -
@@ -11,11 +14,28 @@
 ;; graphics with an equivalent path any time you load an image.
 
 (defclass animation (xy-coordinates)
-  ((images :initarg :images
-		     :initform (make-array (list 0) :element-type 'sdl:surface)
-		     :accessor images
-;		     :type (simple-array 'sdl:surface (*))
-		     :documentation "Array with the images")
+  (
+;;   (images :initarg :images
+;; 		     :initform (make-array (list 0) :element-type 'sdl:surface)
+;; 		     :accessor images
+;; ;		     :type (simple-array 'sdl:surface (*))
+;; 		     :documentation "Array with the images")
+   (images-2x :initarg :images-2x
+	      :initform (make-array (list 0) :element-type 'sdl:surface)
+	      :accessor images-2x
+	      :documentation "Array of double-sized images")
+   (images-1x :initarg :images-1x
+	      :initform (make-array (list 0) :element-type 'sdl:surface)
+	      :accessor images-1x
+	      :documentation "Array of normal-sized images")
+   (images-.5x :initarg :images-.5x
+	       :initform (make-array (list 0) :element-type 'sdl:surface)
+	       :accessor images-.5x
+	       :documentation "Array of half-sized images")
+   (images-.25x :initarg :images-.25x
+		:initform (make-array (list 0) :element-type 'sdl:surface)
+		:accessor images-.25x
+		:documentation "Array of quarter-sized images")	      
    (sprite-image-number :initform 0
 			:initarg :sprite-image-number
 			:accessor sprite-image-number
@@ -55,6 +75,18 @@ will be used to minimize the number of file-accesses for loading
 animations. For any animation created from a file by the api from
 below, this will refer to an animation in the *graphics-table*." )))
 
+(defmethod images ((obj animation))
+  (cond
+    ((= *zoom-ash* 0)
+     (images-2x obj))
+    ((= *zoom-ash* -1)
+     (images-1x obj))
+    ((= *zoom-ash* -2)
+     (images-.5x obj))
+    ((= *zoom-ash* -3)
+     (images-.25x obj))))
+
+
 (defmethod draw ((obj animation))
   (when (not (<= (sprite-delay obj) 0)) ;<=, because -a means "paused,
 					;but a is the delay when
@@ -66,8 +98,8 @@ below, this will refer to an animation in the *graphics-table*." )))
       (setf (sprite-image-number obj) (mod (+ 1 (sprite-image-number obj)) (length (images obj))))))
   (when (visible obj)
     (sdl:draw-surface-at-* (elt (images obj) (sprite-image-number obj))
-			   (+ *current-translation-x* (round (x obj)))
-			   (+ *current-translation-y* (round (y obj))))))
+			   (zoom-trans (+ *current-translation-x* (round (x obj))))
+			   (zoom-trans (+ *current-translation-y* (round (y obj)))))))
 
 ;additional methods to make life easier
 (defmethod pause ((obj animation))
@@ -112,10 +144,28 @@ reference, if the current filename already exists."
   "Create an animation from the list of animation-names given in the
 images-variable."
   (make-instance 'animation
-		 :images (mapcar
-			  #'(lambda (x)
-			      (sdl:convert-surface :surface (sdl-image:load-image
-			       x
-			       :image-type :PNG :alpha 1 )))
-				 image-list)
+		 :images-2x (mapcar
+			     #'(lambda (x)
+				 (sdl:convert-surface :surface (sdl-image:load-image
+								(car x)
+								:image-type :PNG :alpha 1 )))
+			     image-list)
+		 :images-1x (mapcar
+			     #'(lambda (x)
+				 (sdl:convert-surface :surface (sdl-image:load-image
+								(cadr x)
+								:image-type :PNG :alpha 1 )))
+			     image-list)
+		 :images-.5x (mapcar
+			     #'(lambda (x)
+				 (sdl:convert-surface :surface (sdl-image:load-image
+								(caddr x)
+								:image-type :PNG :alpha 1 )))
+			     image-list)
+		 :images-.25x (mapcar
+			     #'(lambda (x)
+				 (sdl:convert-surface :surface (sdl-image:load-image
+								(cadddr x)
+								:image-type :PNG :alpha 1 )))
+			     image-list)
 		 :sprite-delay frame-skip))
\ No newline at end of file
diff --git a/background_test_layer_1.png b/background_test_layer_1.png
old mode 100644
new mode 100755
diff --git a/background_test_layer_2.png b/background_test_layer_2.png
old mode 100644
new mode 100755
diff --git a/background_test_layer_3.png b/background_test_layer_3.png
old mode 100644
new mode 100755
diff --git a/blue_nasobem.png b/blue_nasobem.png
old mode 100644
new mode 100755
diff --git a/blue_nasobem2.png b/blue_nasobem2.png
old mode 100644
new mode 100755
diff --git a/blue_nasobem3.png b/blue_nasobem3.png
old mode 100644
new mode 100755
diff --git a/boomerang1.png b/boomerang1.png
old mode 100644
new mode 100755
diff --git a/boomerang2.png b/boomerang2.png
old mode 100644
new mode 100755
diff --git a/boomerang3.png b/boomerang3.png
old mode 100644
new mode 100755
diff --git a/boomerang4.png b/boomerang4.png
old mode 100644
new mode 100755
diff --git a/boomerang5.png b/boomerang5.png
old mode 100644
new mode 100755
diff --git a/boomerang6.png b/boomerang6.png
old mode 100644
new mode 100755
diff --git a/boomerang7.png b/boomerang7.png
old mode 100644
new mode 100755
diff --git a/boomerang8.png b/boomerang8.png
old mode 100644
new mode 100755
diff --git a/brown_stone.png b/brown_stone.png
old mode 100644
new mode 100755
diff --git a/burning-marshmallow.lisp b/burning-marshmallow.lisp
old mode 100644
new mode 100755
diff --git a/burning_marshmallow_ld1.png b/burning_marshmallow_ld1.png
old mode 100644
new mode 100755
diff --git a/burning_marshmallow_ld2.png b/burning_marshmallow_ld2.png
old mode 100644
new mode 100755
diff --git a/burning_marshmallow_lu1.png b/burning_marshmallow_lu1.png
old mode 100644
new mode 100755
diff --git a/burning_marshmallow_lu2.png b/burning_marshmallow_lu2.png
old mode 100644
new mode 100755
diff --git a/burning_marshmallow_rd1.png b/burning_marshmallow_rd1.png
old mode 100644
new mode 100755
diff --git a/burning_marshmallow_rd2.png b/burning_marshmallow_rd2.png
old mode 100644
new mode 100755
diff --git a/burning_marshmallow_ru1.png b/burning_marshmallow_ru1.png
old mode 100644
new mode 100755
diff --git a/burning_marshmallow_ru2.png b/burning_marshmallow_ru2.png
old mode 100644
new mode 100755
diff --git a/coral.png b/coral.png
new file mode 100755
index 0000000..294d63f
Binary files /dev/null and b/coral.png differ
diff --git a/door.png b/door.png
old mode 100644
new mode 100755
diff --git a/draw.lisp b/draw.lisp
index 1b058e6..82a32c9 100755
--- a/draw.lisp
+++ b/draw.lisp
@@ -5,25 +5,26 @@
 (in-package :uxul-world)
 
 (defun draw-background (x-trans y-trans)
-  (let ((ani3 (car (images (make-animation 0 |background_test_layer_3|))))
-	(ani2 (car (images (make-animation 0 |background_test_layer_2|)))))
+  ;; (let ((ani3 (car (images (make-animation 0 |background_test_layer_3|))))
+;; 	(ani2 (car (images (make-animation 0 |background_test_layer_2|)))))
 
-    (loop for i from -1 to 16
-	 do (loop for j from -1 to 12
-		 do (progn
-		      (sdl:draw-surface-at-* ani2
-					     (+ (* i 64) (round
-							  (mod (/ x-trans 4) 64)))
-					     (+ (* j 64) (round
-							  (mod (/ y-trans 4) 64)))))))
-    (loop for i from -1 to 16
-	 do (loop for j from -1 to 12
-		 do 
-		 (sdl:draw-surface-at-* ani3
-					     (+ (* 64 i) (round
-							  (mod (/ x-trans 2) 64)))
-					     (+ (* 64 j) (round
-							  (mod (/ y-trans 2) 64))))))))
+;;     (loop for i from -1 to 16
+;; 	 do (loop for j from -1 to 12
+;; 		 do (progn
+;; 		      (sdl:draw-surface-at-* ani2
+;; 					     (+ (* i 64) (round
+;; 							  (mod (/ x-trans 4) 64)))
+;; 					     (+ (* j 64) (round
+;; 							  (mod (/ y-trans 4) 64)))))))
+;;     (loop for i from -1 to 16
+;; 	 do (loop for j from -1 to 12
+;; 		 do 
+;; 		 (sdl:draw-surface-at-* ani3
+;; 					     (+ (* 64 i) (round
+;; 							  (mod (/ x-trans 2) 64)))
+;; 					     (+ (* 64 j) (round
+;; 							  (mod (/ y-trans 2) 64)))))))
+  )
 
 (defmethod draw ((obj room))
   (let ((*current-translation-x*
@@ -33,7 +34,7 @@
 	    (- 800 (width obj)))
 	   (T
 	    (- 400 (x (graphic-centralizer obj)))))|#
-	 (- 400 (x (graphic-centralizer obj)))
+	 (- (ash 400 (- *zoom-ash*)) (x (graphic-centralizer obj)))
 	  )
 	(*current-translation-y*
 	 #|(cond
@@ -42,7 +43,7 @@
 	    (- 600 (height obj)))
 	   (T
 	    (- 300 (y (graphic-centralizer obj)))))|#
-	 (- 300 (y (graphic-centralizer obj)))
+	 (- (ash 300 (- *zoom-ash*)) (y (graphic-centralizer obj)))
 	  ))
     (draw-background *current-translation-x* *current-translation-y*)
     (dolist (image (get-objects obj 'uxul-world::game-object))
diff --git a/empty.png b/empty.png
old mode 100644
new mode 100755
diff --git a/files.lisp b/files.lisp
index e8e50db..65918ae 100755
--- a/files.lisp
+++ b/files.lisp
@@ -8,27 +8,73 @@
 (defun si (var val)
   (setf (symbol-value (intern var)) val))
 
-(defun init-file (file)
-  "Load a file into a Variable. Access with |filename| (without .png
-and path)."
-  (si (pathname-name file)
-      (with-open-file (in file :element-type '(unsigned-byte 8)) 
-	(let* ((length (file-length in))
-	       (content (make-array (list length)
-				    :element-type '(unsigned-byte 8)
-				    :adjustable nil)))
-	  (read-sequence content in)
-	  content))))
-
-(defun file-relevant-p (file)
+
+(defun stretch-image (x y img)
+  "Call ImageMagick to resize that file to 64x64."
+  (lisp-magick:with-magick-wand (mywand)
+    (lisp-magick::magick-read-image-blob mywand img)
+    (lisp-magick::magick-resize-image mywand x y #x00000000 1d0)
+    (lisp-magick::magick-set-format mywand "png")
+    (lisp-magick::magick-get-image-blob mywand)))
+
+(defun ash-sized-image (img a)
+  "Calculate an image of half of the size."
+  (lisp-magick:with-magick-wand (mywand)
+    (lisp-magick::magick-read-image-blob mywand img)
+    (let
+	((w (lisp-magick::magick-get-image-width mywand))
+	 (h (lisp-magick::magick-get-image-height mywand)))
+      (lisp-magick::magick-resize-image mywand
+					(max 1 (floor (/ w a))) (max 1 (floor (/ h a))) ;; no ash here ...
+					#x00000000 1d0)
+      (lisp-magick::magick-set-format mywand "png")
+      (lisp-magick::magick-get-image-blob mywand))))
+
+(defun all-sizes (img)
+  (list img
+	(ash-sized-image img 2)
+	(ash-sized-image img 4)
+	(ash-sized-image img 8)))
+
+
+;; (defun init-file (file)
+;;   "Load a file into a Variable. Access with |filename| (without .png
+;; and path)."
+;;   (si (pathname-name file)
+;;       (stretched-image 
+;;       (with-open-file (in file :element-type '(unsigned-byte 8)) 
+;; 	(let* ((length (file-length in))
+;; 	       (content (make-array (list length)
+;; 				    :element-type '(unsigned-byte 8)
+;; 				    :adjustable nil)))
+;; 	  (read-sequence content in)
+;; 	  content)))))
+
+(defun init-png-file (file)
+  "Load an image file into a Variable. Set |filename| (without .png
+and path) to a list with all sizes of that image."
+  (si (pathname-name file) 
+      (all-sizes
+       (with-open-file (in file :element-type '(unsigned-byte 8)) 
+	 (let* ((length (file-length in))
+		(content (make-array (list length)
+				     :element-type '(unsigned-byte 8)
+				     :adjustable nil)))
+	   (read-sequence content in)
+	   content)))))
+
+(defun png-p (file)
   "Is the file relevant for initialization? So far only .png-files are
 relevant."
   (string= (pathname-type file) "png"))
 
-(defun init-files ()
-  "Load the relevant files into variables"
+(defun init-png-files ()
   (cl-fad:walk-directory
    (asdf:component-pathname (asdf:find-system :uxul-world))
-   #'init-file :test #'file-relevant-p))
+   #'init-png-file :test #'png-p))
+
+(defun init-files ()
+  "Load the relevant files into variables"
+  (init-png-files))
 
 (init-files)
\ No newline at end of file
diff --git a/fireball1.png b/fireball1.png
new file mode 100755
index 0000000..821075a
Binary files /dev/null and b/fireball1.png differ
diff --git a/fireball2.png b/fireball2.png
new file mode 100755
index 0000000..d127bd0
Binary files /dev/null and b/fireball2.png differ
diff --git a/flying-nasobem.lisp b/flying-nasobem.lisp
old mode 100644
new mode 100755
diff --git a/functions.lisp b/functions.lisp
index 2cbf8ca..aa71ef5 100755
--- a/functions.lisp
+++ b/functions.lisp
@@ -570,8 +570,9 @@ are not zero"
   
 
 (defun old-draw-rectangle (obj &key (r 0) (g 0) (b 0))
-  (sdl:draw-rectangle-* (+ *current-translation-x* (x obj))
-			(+ *current-translation-y* (y obj))
-			(width obj)
-			(height obj)
+  (declare (type game-object obj))
+  (sdl:draw-rectangle-* (zoom-trans (+ *current-translation-x* (x obj)))
+			(zoom-trans (+ *current-translation-y* (y obj)))
+			(zoom-trans (width obj))
+			(zoom-trans (height obj))
 			:color (sdl:color :r r :g g :b b)))
diff --git a/game-object-with-animation.lisp b/game-object-with-animation.lisp
index 993e72e..f188e53 100755
--- a/game-object-with-animation.lisp
+++ b/game-object-with-animation.lisp
@@ -10,7 +10,8 @@
   ((animation-translation :initarg :animation-translation
 			  :accessor animation-translation
 			  :initform (make-xy 0 0)
-			  :documentation "The translation of the animation")
+			  :documentation "The translation of the
+			  animation (in double zoom).")
    (animation :initarg :animation
 	      :accessor animation
 	      :documentation "The animation of this object")
@@ -55,9 +56,10 @@
 	 (+ (y obj) (height obj) (y bounds))
 	 (- *current-translation-x*)
 	 (- *current-translation-y*)
-	 (- +screen-width+ *current-translation-x*)
-	 (- +screen-height+ *current-translation-y*))
-	T)))
+	 (- (ash +screen-width+ (- *zoom-ash*)) *current-translation-x*)
+	 (- (ash +screen-height+ (- *zoom-ash*)) *current-translation-y*))
+	T))
+)
 
 
 
diff --git a/game.lisp b/game.lisp
index 5b98d6a..c026d4d 100755
--- a/game.lisp
+++ b/game.lisp
@@ -17,6 +17,7 @@
   "Start the Game: Call room-function for getting the room-object to
 run. Music is ignored so far. 15-fps makes only every second frame be
 drawn (for very slow computers)"
+  (sdl:set-video-driver "directx")
      (sdl:with-init (sdl:sdl-init-video sdl:sdl-init-audio)
        (sdl:window +screen-width+ +screen-height+
 		   :title-caption "Uxul World"
@@ -49,6 +50,12 @@ drawn (for very slow computers)"
 			    (cond
 			      ((sdl:key= key :SDL-KEY-ESCAPE)
 			       (sdl:push-quit-event))
+			      ((sdl:key= key :SDL-KEY-O)
+			       (setf *zoom-ash*
+				     (max -3 (1- *zoom-ash*))))
+			      ((sdl:key= key :SDL-KEY-I)
+			       (setf *zoom-ash*
+				     (min 0 (1+ *zoom-ash*))))
 			      (T
 			       (on-key-down *current-room* key))))
 	   (:key-up-event (:key key)
diff --git a/grass_colored.png b/grass_colored.png
old mode 100644
new mode 100755
diff --git a/gray_stone.png b/gray_stone.png
old mode 100644
new mode 100755
diff --git a/imagemagick.lisp b/imagemagick.lisp
new file mode 100755
index 0000000..51b0e13
--- /dev/null
+++ b/imagemagick.lisp
@@ -0,0 +1,36 @@
+;; Copyright 2010 Christoph Senjak
+
+(in-package :uxul-world)
+
+;; "Binding" for the "convert"-Program
+
+(defparameter *convert* #P"C:\\Program Files (x86)\\ImageMagick-6.6.2-Q16\\convert.exe")
+
+(defun run-convert (arguments in)
+  "Return output of convert"
+  (let* ((p (sb-ext:run-program *convert* arguments
+				      :wait nil
+				      :input :stream
+				      :output :stream))
+	 (pin (sb-ext:process-input p))
+	 (pou (sb-ext:process-output p))
+	 (ret '()))
+    (loop for byte across in do
+	 (progn
+	   (format t "doing~%")
+	   (write-byte byte pin)
+	   (loop while (listen pou) do
+		;; this read should never fail and never be eof
+		(format t "reading 1~%")
+		(push (read-byte pou) ret))))
+    (format t "finishing out, closing~%")
+    (finish-output pin)
+    (close pin)
+    (let ((c 0))
+      (loop while (setf c (read-byte pou nil nil)) do
+	   (format t "reading 2~%")
+	   (push c ret)))
+    ret))
+
+(defun resize-image (bytes x y)
+  (run-convert (list "-scale" (format nil "~dx~d" x y) "-" "-") bytes))
\ No newline at end of file
diff --git a/key.png b/key.png
old mode 100644
new mode 100755
diff --git a/leaf.png b/leaf.png
old mode 100644
new mode 100755
diff --git a/leveleditor.lisp b/leveleditor.lisp
old mode 100644
new mode 100755
diff --git a/nasobem2.png b/nasobem2.png
old mode 100644
new mode 100755
diff --git a/nasobem3.png b/nasobem3.png
old mode 100644
new mode 100755
diff --git a/teleporter.png b/teleporter.png
old mode 100644
new mode 100755
diff --git a/trampoline1.png b/trampoline1.png
new file mode 100755
index 0000000..c103fcd
Binary files /dev/null and b/trampoline1.png differ
diff --git a/trampoline2.png b/trampoline2.png
new file mode 100755
index 0000000..3ab30bd
Binary files /dev/null and b/trampoline2.png differ
diff --git a/tulip2.png b/tulip2.png
old mode 100644
new mode 100755
diff --git a/tulip3.png b/tulip3.png
old mode 100644
new mode 100755
diff --git a/uxul-world-leveleditor.asd b/uxul-world-leveleditor.asd
old mode 100644
new mode 100755
diff --git a/uxul-world-leveleditor.lisp b/uxul-world-leveleditor.lisp
old mode 100644
new mode 100755
diff --git a/uxul-world.asd b/uxul-world.asd
index b11d187..47b03e9 100755
--- a/uxul-world.asd
+++ b/uxul-world.asd
@@ -7,7 +7,8 @@
   :version "No Release Yet"
   :author "Christoph Senjak <firstName.secondName at googlemail.com>"
   :license "Copyright 2009 Christoph Senjak."
-  :depends-on (#:lispbuilder-sdl #:closer-mop
+  :depends-on (#:lispbuilder-sdl #:lisp-magick
+				 #:closer-mop
 				 #:cl-fad
                                  #:lispbuilder-sdl-image)
   :components ((:file "uxul-world")
diff --git a/uxul1shoot_small.png b/uxul1shoot_small.png
old mode 100644
new mode 100755
diff --git a/uxul2shoot_small.png b/uxul2shoot_small.png
old mode 100644
new mode 100755