2009/08/04 Jumping after falling down from a stone is possible
- 2009/08/20 Fixed
+
+2011/01/02 Background not implemented
+
+2011/01/02 A lot of deprecated stuff in the code must be cleaned
+
-;;; Copyright 2009 Christoph Senjak
+;;; Copyright 2009-2011 Christoph Senjak
(in-package :uxul-world)
-;;; Copyright 2009 Christoph Senjak
+;;; Copyright 2009-2011 Christoph Senjak
-;; Basic definitions for animations. Needs lispbuilder-sdl.
+;; Basic definitions for animations.
(in-package :uxul-world)
;; :accessor images
;; ; :type (simple-array 'sdl:surface (*))
;; :documentation "Array with the images")
+ (full-widths :initarg :full-widths
+ :initform (make-array (list 0))
+ :accessor full-widths
+ :documentation "Widths of images-1x")
+ (full-heights :initarg :full-heights
+ :initform (make-array (list 0))
+ :accessor full-heights
+ :documentation "Heights of images-1x")
(images-2x :initarg :images-2x
- :initform (make-array (list 0) :element-type 'sdl:surface)
+ :initform (make-array (list 0))
:accessor images-2x
:documentation "Array of double-sized images")
(images-1x :initarg :images-1x
- :initform (make-array (list 0) :element-type 'sdl:surface)
+ :initform (make-array (list 0))
:accessor images-1x
:documentation "Array of normal-sized images")
(images-.5x :initarg :images-.5x
- :initform (make-array (list 0) :element-type 'sdl:surface)
+ :initform (make-array (list 0))
:accessor images-.5x
:documentation "Array of half-sized images")
(images-.25x :initarg :images-.25x
- :initform (make-array (list 0) :element-type 'sdl:surface)
+ :initform (make-array (list 0))
:accessor images-.25x
:documentation "Array of quarter-sized images")
(sprite-image-number :initform 0
(setf (already-jumped obj) 0)
(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))
- (zoom-trans (+ *current-translation-x* (round (x obj))))
- (zoom-trans (+ *current-translation-y* (round (y obj)))))))
+ (make-quad (elt (images obj) (sprite-image-number obj))
+ (zoom-trans (round (x obj)))
+ (zoom-trans (round (y obj)))
+
+ (ash (elt (full-widths obj)
+ (sprite-image-number obj)) (+ 2 *zoom-ash*))
+ (ash (elt (full-heights obj)
+ (sprite-image-number obj)) (+ 2 *zoom-ash*))
+
+)))
;additional methods to make life easier
(defmethod pause ((obj animation))
(defun make-animation (frame-skip &rest image-list)
"Create an animation from the list of animation-names given in the
images-variable."
+ ;(format t "make-animation is being called~%")
(make-instance 'animation
+ :full-widths (mapcar
+ #'(lambda (x) (bmp-width (cadr x))) image-list)
+ :full-heights (mapcar
+ #'(lambda (x) (bmp-height (cadr x))) image-list)
:images-2x (mapcar
- #'(lambda (x)
- (sdl:convert-surface :surface (sdl:load-image
- (car x) :alpha 1 )))
+ #'(lambda (x) (load-bmp-blob-into-texture (car x)))
image-list)
:images-1x (mapcar
- #'(lambda (x)
- (sdl:convert-surface :surface (sdl:load-image
- (cadr x)
- :alpha 1 )))
+ #'(lambda (x) (load-bmp-blob-into-texture (cadr x)))
image-list)
:images-.5x (mapcar
- #'(lambda (x)
- (sdl:convert-surface :surface (sdl:load-image
- (caddr x)
- :alpha 1 )))
+ #'(lambda (x) (load-bmp-blob-into-texture (caddr x)))
image-list)
:images-.25x (mapcar
- #'(lambda (x)
- (sdl:convert-surface :surface (sdl:load-image
- (cadddr x)
- :alpha 1 )))
+ #'(lambda (x) (load-bmp-blob-into-texture (cadddr x)))
image-list)
:sprite-delay frame-skip))
\ No newline at end of file
;;; -*- lisp -*-\r
\r
-;;; Copyright 2010 Christoph Senjak\r
+;;; Copyright 2010-2011 Christoph Senjak\r
\r
(in-package :uxul-world)\r
\r
-;;; Copyright 2009 Christoph Senjak
+;;; Copyright 2009-2011 Christoph Senjak
(in-package :uxul-world)
-;;; Copyright 2009 Christoph Senjak
+;;; Copyright 2009-2011 Christoph Senjak
(in-package :uxul-world)
-;;; Copyright 2009 Christoph Senjak
+;;; Copyright 2009-2011 Christoph Senjak
(in-package :uxul-world)
-;;; Copyright 2009 Christoph Senjak
+;;; Copyright 2009-2011 Christoph Senjak
;; various draw-methods
(defmethod draw ((obj room))
(let ((*current-translation-x*
- #|(cond
- ((< (- (x (graphic-centralizer obj)) 400) 0) 0)
- ((> (+ (x (graphic-centralizer obj)) 400) (width obj))
- (- 800 (width obj)))
- (T
- (- 400 (x (graphic-centralizer obj)))))|#
- (- (ash 400 (- *zoom-ash*)) (x (graphic-centralizer obj)))
- )
+ (* 2 (- 400 (x (graphic-centralizer obj)))))
(*current-translation-y*
- #|(cond
- ((< (- (y (graphic-centralizer obj)) 300) 0) 0)
- ((> (+ (y (graphic-centralizer obj)) 300) (height obj))
- (- 600 (height obj)))
- (T
- (- 300 (y (graphic-centralizer obj)))))|#
- (- (ash 300 (- *zoom-ash*)) (y (graphic-centralizer obj)))
- ))
+ (* 2 (- 300 (y (graphic-centralizer obj))))))
(draw-background *current-translation-x* *current-translation-y*)
+ (gl:scale *zoomx* (- *zoomy*) 1)
+ (gl:translate *current-translation-x* *current-translation-y* 0)
(dolist (image (get-objects obj 'uxul-world::game-object))
- (if (and (redraw image)
- (visible image)
- (rectangle-in-screen image)) (draw image)))))
+ (and (redraw image) (visible image) (draw image)))))
;; FIXME
(old-draw-rectangle obj :r 255 :g 255 :b 255))
;;; FIXME ************
- (sdl:draw-box-*
- 10 10 (floor (* (power obj) (/ (- +screen-width+ 20) 10))) 10
- :color (sdl:color :r (abs *player-bar-color*) :g (abs *player-bar-color*) :b (abs *player-bar-color*)))
+ ;; (sdl:draw-box-*
+ ;; 10 10 (floor (* (power obj) (/ (- +screen-width+ 20) 10))) 10
+ ;; :color (sdl:color :r (abs *player-bar-color*) :g (abs *player-bar-color*) :b (abs *player-bar-color*)))
(incf *player-bar-color* 5)
(if (= *player-bar-color* 255) (setf *player-bar-color* -255))
(call-next-method))
-(defmethod draw ((obj stone))
- (call-next-method)
- #+nil(if (rectangle-in-screen obj)
- (old-draw-rectangle obj :r 255 :g 255 :b 255)))
+(defmethod draw ((obj stone)) (call-next-method))
-(defmethod draw ((obj simple-enemy))
- (call-next-method)
- #+nil(if (rectangle-in-screen obj)
- (old-draw-rectangle obj :r 255 :g 255 :b 255)))
+(defmethod draw ((obj simple-enemy)) (call-next-method))
-;;; Copyright 2009 Christoph Senjak
+;;; Copyright 2009-2011 Christoph Senjak
(in-package :uxul-world)
-;;; Copyright 2009 Christoph Senjak
+;;; Copyright 2009-2011 Christoph Senjak
;; This file declares the constants for loading different files and
;; file-formats.
-;;; Copyright 2009 Christoph Senjak
+;;; Copyright 2009-2011 Christoph Senjak
(in-package :uxul-world)
-;;; Copyright 2009 Christoph Senjak
+;;; Copyright 2009-2011 Christoph Senjak
(in-package :uxul-world)
-;;; Copyright 2009 Christoph Senjak
+;;; Copyright 2009-2011 Christoph Senjak
(in-package :uxul-world)
-;;; Copyright 2009 Christoph Senjak
+;;; Copyright 2009-2011 Christoph Senjak
(in-package :uxul-world)
(defmethod draw-bounds ((obj game-object))
"This function draws a rectangle with the Object's Bounds. May be useful for some debug-spam"
- (sdl:draw-rectangle-* (+ (x obj) *current-translation-x*)
- (+ (y obj) *current-translation-y*)
- (width obj) (height obj)
- :color sdl:*BLACK*))
+ ;; (sdl:draw-rectangle-* (+ (x obj) *current-translation-x*)
+ ;; (+ (y obj) *current-translation-y*)
+ ;; (width obj) (height obj)
+ ;; :color sdl:*BLACK*)
+)
(defun collide-blocks (moving-rectangle standing-rectangle collision)
"as MANY collision-methods need to move the moving-object around the
-;;; Copyright 2009 Christoph Senjak
+;;; Copyright 2009-2011 Christoph Senjak
(in-package :uxul-world)
(defparameter *cfont* nil)
+(defparameter *zoomx* 1.0)
+(defparameter *zoomy* 1.0)
(defun run-testing-room ()
(start-game :room-function #'make-testing-room))
"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:set-video-driver "directx")
+ (sdl:with-init (sdl:sdl-init-video) ;sdl:sdl-init-video sdl:sdl-init-audio)
(sdl:window +screen-width+ +screen-height+
:title-caption "Uxul World"
:icon-caption "Uxul World"
+ :flags sdl:sdl-opengl
;:opengl T
- :flags (logior sdl:sdl-hw-accel sdl:sdl-hw-surface)
- :flags (logior sdl:sdl-hw-surface) #| sdl:sdl-fullscreen )|#
-)
+ ;:flags (logior sdl:sdl-hw-accel sdl:sdl-hw-surface)
+ ;:flags (logior sdl:sdl-hw-surface) #| sdl:sdl-fullscreen )|#
+ )
+ (setf cl-opengl-bindings:*gl-get-proc-address*
+ #'sdl-cffi::sdl-gl-get-proc-address)
;;(if music (sdl-mixer:OPEN-AUDIO :frequency 44100))
- (let ((*graphics-table* (make-hash-table :test #'equal)))
+
+ (gl:hint :perspective-correction-hint :nicest)
+
+
+ (let ((*graphics-table* (make-hash-table :test #'equal))
+ (*zoomx* (/ 1.0 +screen-width+))
+ (*zoomxi* (/ .01 +screen-width+))
+ (*zoomy* (/ 1.0 +screen-height+))
+ (*zoomyi* (/ .01 +screen-height+))
+ (*zoom-ash* 0))
(if 15-fps
(setf (sdl:frame-rate) 15)
(setf (sdl:frame-rate) 30))
(setf *current-room* (funcall room-function))
- (sdl:clear-display (sdl:color :r 0 :g 0 :b 0));; :update-p nil)
+ ;(sdl:clear-display (sdl:color :r 0 :g 0 :b 0));; :update-p nil)
;;(if music (sdl-mixer:play-sample levelmusic))
(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*))))
+ ((sdl:key= key :SDL-KEY-U)
+ (incf *zoomx* *zoomxi*)
+ (incf *zoomy* *zoomyi*))
+ ((sdl:key= key :SDL-KEY-D)
+ (decf *zoomx* *zoomxi*)
+ (decf *zoomy* *zoomyi*))
(T
(on-key-down *current-room* key))))
+ (:mouse-button-down-event
+ (:button btn)
+ (cond
+ ((= btn sdl:mouse-wheel-up)
+ (incf *zoomx* *zoomxi*) (incf *zoomy* *zoomyi*))
+ ((= btn sdl:mouse-wheel-down)
+ (decf *zoomx* *zoomxi*) (decf *zoomy* *zoomyi*))))
(:key-up-event (:key key)
(on-key-up *current-room* key))
(:idle
(invoke *current-room*)
(when 15-fps
(invoke *current-room*))
- (sdl:clear-display (sdl:color :r 128 :g 128 :b 128)); :update-p nil)
+ (gl:clear :color-buffer-bit :depth-buffer-bit)
+ (gl:enable :texture-2d)
+ (gl:enable :blend)
+ (gl:blend-func :src-alpha :one-minus-src-alpha)
+ (gl:load-identity)
(draw *current-room*)
- (sdl:update-display)
- ))))))
+ (gl:flush)
+ (sdl:update-display)))))))
-;; For Debugging
+;; ;; For Debugging
-(defun preview-animation (frameskip &rest images)
+;; (defun preview-animation (frameskip &rest images)
- (sdl:with-init (sdl:sdl-init-video sdl:sdl-init-audio)
- (sdl:window +screen-width+ +screen-height+
- :title-caption "Uxul World"
- :icon-caption "Uxul World"
- :flags (logior sdl:sdl-hw-accel)
- #| :flags (logior sdl:sdl-hw-surface sdl:sdl-fullscreen )|# )
- (let ((*graphics-table*
- #-ecl (trivial-garbage:make-weak-hash-table
- :weakness :value
- :test #'equal)
- #+ecl (make-hash-table :test #'equal)
- )
- (my-anim (apply #'make-animation frameskip images))
- )
+;; (sdl:with-init (sdl:sdl-init-video sdl:sdl-init-audio)
+;; (sdl:window +screen-width+ +screen-height+
+;; :title-caption "Uxul World"
+;; :icon-caption "Uxul World"
+;; :flags (logior sdl:sdl-hw-accel)
+;; #| :flags (logior sdl:sdl-hw-surface sdl:sdl-fullscreen )|# )
+;; (let ((*graphics-table*
+;; #-ecl (trivial-garbage:make-weak-hash-table
+;; :weakness :value
+;; :test #'equal)
+;; #+ecl (make-hash-table :test #'equal)
+;; )
+;; (my-anim (apply #'make-animation frameskip images))
+;; )
- (setf (sdl:frame-rate) 30)
- (sdl:clear-display (sdl:color :r 64 :g 64 :b 46));; :update-p nil)
+;; (setf (sdl:frame-rate) 30)
+;; (sdl:clear-display (sdl:color :r 64 :g 64 :b 46));; :update-p nil)
- (sdl:with-events ()
- (:quit-event () t)
- (:key-down-event (:key key)
- (cond
- ((sdl:key= key :SDL-KEY-ESCAPE)
- (sdl:push-quit-event))))
- (:idle
- (progn
- (sdl:clear-display (sdl:color :r 64 :g 64 :b 46));; :update-p nil)
+;; (sdl:with-events ()
+;; (:quit-event () t)
+;; (:key-down-event (:key key)
+;; (cond
+;; ((sdl:key= key :SDL-KEY-ESCAPE)
+;; (sdl:push-quit-event))))
+;; (:idle
+;; (progn
+;; (sdl:clear-display (sdl:color :r 64 :g 64 :b 46));; :update-p nil)
- (draw my-anim)
+;; (draw my-anim)
- (sdl:update-display)
- ))))))
+;; (sdl:update-display)
+;; ))))))
-;; Copyright 2010 Christoph Senjak\r
+;; Copyright 2010-2011 Christoph Senjak\r
\r
(in-package :uxul-world)\r
\r
-;;; Copyright 2009 Christoph Senjak
+;;; Copyright 2009-2011 Christoph Senjak
(in-package :uxul-world-leveleditor)
-;;; Copyright 2009 Christoph Senjak
+;;; Copyright 2009-2011 Christoph Senjak
(in-package :uxul-world)
-;;; Copyright 2009 Christoph Senjak
+;;; Copyright 2009-2011 Christoph Senjak
(in-package :uxul-world)
-;;; Copyright 2009 Christoph Senjak
+;;; Copyright 2009-2011 Christoph Senjak
(in-package :uxul-world)
--- /dev/null
+;; Copyright 2010-2011 Christoph Senjak\r
+\r
+(in-package :uxul-world)\r
+\r
+(defun load-bmp-blob-into-texture (blob)\r
+ (let*\r
+ ((id (car (gl:gen-textures 1)))\r
+ (pix (bmp-pixel-data blob))\r
+ (w (bmp-width blob))\r
+ (h (bmp-height blob)))\r
+ (gl:bind-texture :texture-2d id)\r
+ (gl:tex-image-2d :texture-2d 0 :rgba8 w h 0 :bgra :unsigned-byte pix)\r
+ (gl:tex-parameter :texture-2d :texture-min-filter :linear)\r
+ (gl:tex-parameter :texture-2d :texture-mag-filter :linear)\r
+ (gl:flush)\r
+ id))\r
+\r
+(defun make-quad (id x y w h)\r
+ (setf x (- (+ x x) +screen-width+ ))\r
+ (setf y (- (+ y y) +screen-height+))\r
+ (gl:bind-texture :texture-2d id)\r
+ (gl:with-primitive :quads\r
+ (gl:tex-coord 0 0) (gl:vertex x (+ y h))\r
+ (gl:tex-coord 1 0) (gl:vertex (+ x w) (+ y h))\r
+ (gl:tex-coord 1 1) (gl:vertex (+ x w) y)\r
+ (gl:tex-coord 0 1) (gl:vertex x y)))\r
+\r
-;;; Copyright 2009 Christoph Senjak
+;;; Copyright 2009-2011 Christoph Senjak
(in-package :uxul-world)
-;;; Copyright 2009 Christoph Senjak
+;;; Copyright 2009-2011 Christoph Senjak
(in-package :uxul-world)
-;;; Copyright 2009 Christoph Senjak
+;;; Copyright 2009-2011 Christoph Senjak
(in-package :uxul-world)
-;;; Copyright 2009 Christoph Senjak
+;;; Copyright 2009-2011 Christoph Senjak
(in-package :uxul-world)
-;;; Copyright 2009 Christoph Senjak
+;;; Copyright 2009-2011 Christoph Senjak
(in-package :uxul-world)
-;;; Copyright 2010 Christoph Senjak\r
+;;; Copyright 2010-2011 Christoph Senjak\r
\r
(in-package :uxul-world)\r
\r
-;;; Copyright 2009 Christoph Senjak
+;;; Copyright 2009-2011 Christoph Senjak
(defpackage #:uxul-world-leveleditor
(:use
: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 #:cl-opengl
+ #:closer-mop
#:cl-fad
#:lispbuilder-sdl)
:components ((:file "uxul-world")
(:file "constants")
(:file "macros")
(:file "bmp")
+ (:file "opengl")
(:file "xy-coordinates")
(:file "collision")
(:file "files")
-;;; Copyright 2009 Christoph Senjak
+;;; Copyright 2009-2011 Christoph Senjak
(defpackage #:uxul-world
(:use
-;;; Copyright 2009 Christoph Senjak
+;;; Copyright 2009-2011 Christoph Senjak
(in-package :uxul-world)