Major Changes. Windows Compatibility.

diff --git a/BUGS b/BUGS
old mode 100644 (file)
new mode 100755 (executable)

diff --git a/Makefile b/Makefile
old mode 100644 (file)
new mode 100755 (executable)

diff --git a/README b/README
old mode 100644 (file)
new mode 100755 (executable)

diff --git a/anchor.png b/anchor.png
old mode 100644 (file)
new mode 100755 (executable)

diff --git a/animation.lisp b/animation.lisp
index 20fce5b..c64a20a 100755 (executable)
--- 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 (file)
new mode 100755 (executable)

diff --git a/background_test_layer_2.png b/background_test_layer_2.png
old mode 100644 (file)
new mode 100755 (executable)

diff --git a/background_test_layer_3.png b/background_test_layer_3.png
old mode 100644 (file)
new mode 100755 (executable)

diff --git a/blue_nasobem.png b/blue_nasobem.png
old mode 100644 (file)
new mode 100755 (executable)

diff --git a/blue_nasobem2.png b/blue_nasobem2.png
old mode 100644 (file)
new mode 100755 (executable)

diff --git a/blue_nasobem3.png b/blue_nasobem3.png
old mode 100644 (file)
new mode 100755 (executable)

diff --git a/boomerang1.png b/boomerang1.png
old mode 100644 (file)
new mode 100755 (executable)

diff --git a/boomerang2.png b/boomerang2.png
old mode 100644 (file)
new mode 100755 (executable)

diff --git a/boomerang3.png b/boomerang3.png
old mode 100644 (file)
new mode 100755 (executable)

diff --git a/boomerang4.png b/boomerang4.png
old mode 100644 (file)
new mode 100755 (executable)

diff --git a/boomerang5.png b/boomerang5.png
old mode 100644 (file)
new mode 100755 (executable)

diff --git a/boomerang6.png b/boomerang6.png
old mode 100644 (file)
new mode 100755 (executable)

diff --git a/boomerang7.png b/boomerang7.png
old mode 100644 (file)
new mode 100755 (executable)

diff --git a/boomerang8.png b/boomerang8.png
old mode 100644 (file)
new mode 100755 (executable)

diff --git a/brown_stone.png b/brown_stone.png
old mode 100644 (file)
new mode 100755 (executable)

diff --git a/burning-marshmallow.lisp b/burning-marshmallow.lisp
old mode 100644 (file)
new mode 100755 (executable)

diff --git a/burning_marshmallow_ld1.png b/burning_marshmallow_ld1.png
old mode 100644 (file)
new mode 100755 (executable)

diff --git a/burning_marshmallow_ld2.png b/burning_marshmallow_ld2.png
old mode 100644 (file)
new mode 100755 (executable)

diff --git a/burning_marshmallow_lu1.png b/burning_marshmallow_lu1.png
old mode 100644 (file)
new mode 100755 (executable)

diff --git a/burning_marshmallow_lu2.png b/burning_marshmallow_lu2.png
old mode 100644 (file)
new mode 100755 (executable)

diff --git a/burning_marshmallow_rd1.png b/burning_marshmallow_rd1.png
old mode 100644 (file)
new mode 100755 (executable)

diff --git a/burning_marshmallow_rd2.png b/burning_marshmallow_rd2.png
old mode 100644 (file)
new mode 100755 (executable)

diff --git a/burning_marshmallow_ru1.png b/burning_marshmallow_ru1.png
old mode 100644 (file)
new mode 100755 (executable)

diff --git a/burning_marshmallow_ru2.png b/burning_marshmallow_ru2.png
old mode 100644 (file)
new mode 100755 (executable)

diff --git a/coral.png b/coral.png
new file mode 100755 (executable)
index 0000000..294d63f
Binary files /dev/null and b/coral.png differ

diff --git a/door.png b/door.png
old mode 100644 (file)
new mode 100755 (executable)

diff --git a/draw.lisp b/draw.lisp
index 1b058e6..82a32c9 100755 (executable)
--- 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 (file)
new mode 100755 (executable)

diff --git a/files.lisp b/files.lisp
index e8e50db..65918ae 100755 (executable)
--- 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 (executable)
index 0000000..821075a
Binary files /dev/null and b/fireball1.png differ

diff --git a/fireball2.png b/fireball2.png
new file mode 100755 (executable)
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 (file)
new mode 100755 (executable)

diff --git a/functions.lisp b/functions.lisp
index 2cbf8ca..aa71ef5 100755 (executable)
--- 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 (executable)
--- 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 (executable)
--- 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 (file)
new mode 100755 (executable)

diff --git a/gray_stone.png b/gray_stone.png
old mode 100644 (file)
new mode 100755 (executable)

diff --git a/imagemagick.lisp b/imagemagick.lisp
new file mode 100755 (executable)
index 0000000..51b0e13
--- /dev/null
+++ b/imagemagick.lisp
@@ -0,0 +1,36 @@
+;; Copyright 2010 Christoph Senjak\r
+\r
+(in-package :uxul-world)\r
+\r
+;; "Binding" for the "convert"-Program\r
+\r
+(defparameter *convert* #P"C:\\Program Files (x86)\\ImageMagick-6.6.2-Q16\\convert.exe")\r
+\r
+(defun run-convert (arguments in)\r
+  "Return output of convert"\r
+  (let* ((p (sb-ext:run-program *convert* arguments\r
+                                     :wait nil\r
+                                     :input :stream\r
+                                     :output :stream))\r
+        (pin (sb-ext:process-input p))\r
+        (pou (sb-ext:process-output p))\r
+        (ret '()))\r
+    (loop for byte across in do\r
+        (progn\r
+          (format t "doing~%")\r
+          (write-byte byte pin)\r
+          (loop while (listen pou) do\r
+               ;; this read should never fail and never be eof\r
+               (format t "reading 1~%")\r
+               (push (read-byte pou) ret))))\r
+    (format t "finishing out, closing~%")\r
+    (finish-output pin)\r
+    (close pin)\r
+    (let ((c 0))\r
+      (loop while (setf c (read-byte pou nil nil)) do\r
+          (format t "reading 2~%")\r
+          (push c ret)))\r
+    ret))\r
+\r
+(defun resize-image (bytes x y)\r
+  (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 (file)
new mode 100755 (executable)

diff --git a/leaf.png b/leaf.png
old mode 100644 (file)
new mode 100755 (executable)

diff --git a/leveleditor.lisp b/leveleditor.lisp
old mode 100644 (file)
new mode 100755 (executable)

diff --git a/nasobem2.png b/nasobem2.png
old mode 100644 (file)
new mode 100755 (executable)

diff --git a/nasobem3.png b/nasobem3.png
old mode 100644 (file)
new mode 100755 (executable)

diff --git a/teleporter.png b/teleporter.png
old mode 100644 (file)
new mode 100755 (executable)

diff --git a/trampoline1.png b/trampoline1.png
new file mode 100755 (executable)
index 0000000..c103fcd
Binary files /dev/null and b/trampoline1.png differ

diff --git a/trampoline2.png b/trampoline2.png
new file mode 100755 (executable)
index 0000000..3ab30bd
Binary files /dev/null and b/trampoline2.png differ

diff --git a/tulip2.png b/tulip2.png
old mode 100644 (file)
new mode 100755 (executable)

diff --git a/tulip3.png b/tulip3.png
old mode 100644 (file)
new mode 100755 (executable)

diff --git a/uxul-world-leveleditor.asd b/uxul-world-leveleditor.asd
old mode 100644 (file)
new mode 100755 (executable)

diff --git a/uxul-world-leveleditor.lisp b/uxul-world-leveleditor.lisp
old mode 100644 (file)
new mode 100755 (executable)

diff --git a/uxul-world.asd b/uxul-world.asd
index b11d187..47b03e9 100755 (executable)
--- 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 (file)
new mode 100755 (executable)

diff --git a/uxul2shoot_small.png b/uxul2shoot_small.png
old mode 100644 (file)
new mode 100755 (executable)