Not quite there yet

I noticed a nice little example about writing a game in PyGlet at http://www.learningpython.com/2007/11/10/creating-a-game-with-pyglet-and-python/ and it seemed like something worth stealing so I decided to do a PAL version of it.

The final results of this little experiment can be found here

To begin with

Altough not strictly necessary for a small project like this, just to demonstrate, I will first define some standard infrastructure for our project. First I’ll make a directory pal-space/ to hold all our code and then I’ll add a data/ directory in there where I’m going to put all the resources like sound, graphics etc. Next we will need a package for our little game

;; In pal-space/package.lisp 

(defpackage :pal-space
  (:use :cl :pal)
  (:export :pal-space))

this will create a PAL-SPACE package for us, importing only one symbol (PAL-SPACE) which is going to be our main function for the game. To help us load and compile the code we are going to need an ASDF definition file:

;; In pal-space/pal-space.asd 

(in-package #:asdf) 

(defsystem pal-space
    :components
  ((:file "package")
   (:file "sprites" :depends-on ("package"))
   (:file "pal-space" :depends-on ("sprites" "package")))
  :depends-on ("pal"))

This declares the dependancies in our code and allows us to load them all in the right order with (asdf:oos ‘asdf:load-op :pal-game) or SLIMEs slime-load-system command.

All right. Now we can start coding the actual game.

;; In pal-space/pal-space.lisp
(in-package :pal-space)

(defun pal-space ()
  (with-pal (:paths '("data/"
                      "C:/Documents and Settings/tomppa/Omat tiedostot/Downloads/pal-space/data/"))
    (event-loop ()
       (clear-screen 0 0 0))))

Here we just open a PAL window with the default settings, start the event loop which just draws a blank window on the screen. Only interesting bit is the :paths part; here we define where PAL should look for the resources that we load (with load-image etc.). We have two paths defined, the latter absolute path being just an convinience so I don’t need to change the working directory of my lisp system. You might want fix it to suit your system or completely remove it.

;; In pal-space/sprites.lisp we have nothing yet, it is just a placeholder
;; to get everything compile smoothly with asdf.

Now let’s start adding the actual functionality:

;; In space-ship/sprites.lisp 

(in-package :pal-space) 

(defparameter *sprites* nil) 

(defclass sprite ()
  ((pos :accessor pos-of :initarg :pos)
   (vel :accessor vel-of :initarg :vel :initform (v 0 0))
   (image :accessor image-of :initarg :image)))     

(defmethod initialize-instance :after ((s sprite) &key &allow-other-keys)
  (push s *sprites*))     

(defgeneric width-of (sprite))     

(defmethod width-of ((s sprite))
  (image-width (image-of s)))     

(defgeneric height-of (sprite))
(defmethod height-of ((s sprite))
  (image-height (image-of s)))     

(defgeneric draw (sprite))
(defmethod draw ((s sprite))
  (draw-image (image-of s) (pos-of s)))     

(defgeneric update (sprite))
(defmethod update (s)
  (setf (pos-of s)
	(v+ (pos-of s) (vel-of s))))     

(defgeneric kill (sprite))
(defmethod kill ((s sprite))
  (setf *sprites* (remove s *sprites*)))     

(defun rectangles-overlap-p (a a-width a-height b b-width b-height)
  (let ((ax (vx a))
	(ay (vy a))
	(bx (vx b))
	(by (vy b)))
    (not (or (> ax (+ bx b-width))
	      (< (+ ax a-width) bx)
	       (> ay (+ by b-height))
		(< (+ ay a-height) by)))))     

(defgeneric intersectsp (sprite-a sprite-b))
(defmethod intersectsp ((a sprite) (b sprite))
  (rectangles-overlap-p (pos-of a) (width-of a) (height-of a)
			(pos-of b) (width-of b) (height-of b)))     

(defgeneric collide (sprite-a sprite-b))
(defmethod collide :around ((a sprite) (b sprite))
  (when (intersectsp a b)
    (call-next-method)))     

(defmethod collide ((a sprite) (b sprite))
  nil)     

(defclass space-ship (sprite)
  ()
  (:default-initargs :image (tag 'space-ship)
                     :pos (v (/ (get-screen-width) 2)
			     (get-screen-height))))     

(defmethod draw ((s space-ship))
  (call-next-method)
  (draw-fps))     

(defmethod update ((s space-ship))
  (setf (pos-of s) (get-mouse-pos)))

Here we just define SPRITE and SPACE-SHIP classes that have a few methods for handling the collisions, updates and drawing the FPS counter with PAL’s DRAW-FPS function. Created instances all automatically get added to the list of *SPRITES*s in the :AFTER method for INITIALIZE-INSTANCE. We also subclass our SPACE-SHIP sprite with suitable default initarguments and add the mouse following behaviour to it in UPDATE method. The TAG function just evaluates (when needed) the resource loading form named SPACE-SHIP, the tags are defined in our main file:

;; In pal-space/pal-space.lisp

(in-package :pal-space)

(define-tags bullet (load-image "bullet.png")
             space-ship (load-image "ship.png")
	     monster (load-image "monster.png"))     

(defun pal-space ()
  (with-pal (:width 640
	     :height 480
	     :paths '("data/"
                      "C:/Documents and Settings/tomppa/Omat tiedostot/Downloads/pal-space/data/"))
    (setf *sprites* nil)
    (set-cursor nil)
    (make-instance 'space-ship)
    (event-loop ()
       (clear-screen 0 0 0)
       (dolist (s *sprites*)
	 (draw s)
	 (update s)))))

Important part here is the DEFINE-TAGS form which defines symbol->resource mappings to ease the handling of images. Now we should have the player sprite on screen following mouse and our main function is mostly finished. Since we are following the style of the original Python version the rest is going to be done by just refining the behaviour of the SPRITE class and its subclasses.

Now to wrap things up we will just add the BULLET and MONSTER classes:

;; In pal-space/sprites.lisp

(defclass monster (sprite)
  ()
  (:default-initargs :image (tag 'monster)
                     :pos (v (random (get-screen-width)) 0)
                     :vel (v (- (random 5) 2) 2)))     

(defmethod initialize-instance :after ((s monster) &key &allow-other-keys)
   (incf *monster-count*))     

(defmethod kill ((s monster))
  (call-next-method)
  (decf *monster-count*))     

(defmethod update ((s monster))
  (call-next-method)
  (with-accessors ((pos pos-of) (vel vel-of)) s
    (when (> (vy pos) (get-screen-height))
	 (kill s))
    (when (or (> (vx pos) (get-screen-width))
	 (< (vx pos) 0))
    (setf vel (v (- (vx vel))
	         (vy vel))))))     

(defclass bullet (sprite)
  ()
  (:default-initargs :image (tag 'bullet) :vel (v 0 -2)))     

(defmethod update ((s bullet))
  (call-next-method)
  (when (< (vy (pos-of s)) 0)
	(kill s))
  (dolist (sprite *sprites*)
    (collide s sprite)))

(defmethod collide ((b bullet) (m monster))
  (incf *score* 10)
  (kill m)
  (kill b))

And finally

After a few other adjustments our final sprites.lisp looks like this:

(in-package :pal-space)

(defparameter *sprites* nil)
(defparameter *max-monsters* 30)
(defparameter *monster-count* 0)
(defparameter *score* 0)

(defclass sprite ()
  ((pos :accessor pos-of :initarg :pos)
   (vel :accessor vel-of :initarg :vel :initform (v 0 0))
   (image :accessor image-of :initarg :image)))

(defmethod initialize-instance :after ((s sprite) &key &allow-other-keys)
  (push s *sprites*))

(defgeneric width-of (sprite))
(defmethod width-of ((s sprite))
  (image-width (image-of s)))

(defgeneric height-of (sprite))
(defmethod height-of ((s sprite))
  (image-height (image-of s)))

(defgeneric draw (sprite))
(defmethod draw ((s sprite))
  (draw-image (image-of s) (pos-of s)))

(defgeneric update (sprite))
(defmethod update (s)
  (setf (pos-of s)
        (v+ (pos-of s) (vel-of s))))

(defgeneric kill (sprite))
(defmethod kill ((s sprite))
  (setf *sprites* (remove s *sprites*)))

(defun rectangles-overlap-p (a a-width a-height b b-width b-height)
  (let ((ax (vx a))
        (ay (vy a))
        (bx (vx b))
        (by (vy b)))
    (not (or (> ax (+ bx b-width))
             (< (+ ax a-width) bx)
             (> ay (+ by b-height))
             (< (+ ay a-height) by)))))

(defgeneric intersectsp (sprite-a sprite-b))
(defmethod intersectsp ((a sprite) (b sprite))
  (rectangles-overlap-p (pos-of a) (width-of a) (height-of a)
                        (pos-of b) (width-of b) (height-of b)))

(defgeneric collide (sprite-a sprite-b))

(defmethod collide :around ((a sprite) (b sprite))
  (when (intersectsp a b)
    (call-next-method)))

(defmethod collide ((a sprite) (b sprite))
  nil)

(defclass space-ship (sprite)
  ()
  (:default-initargs :image (tag 'space-ship)
                     :pos (v (/ (get-screen-width) 2)
                             (get-screen-height))))

(defmethod draw ((s space-ship))
  (call-next-method)
  (draw-fps)
  (draw-text (prin1-to-string *score*) (v 300 0)))

(defmethod update ((s space-ship))
  (setf (pos-of s) (get-mouse-pos))
  (when (key-pressed-p :key-mouse-1)
    (make-instance 'bullet :pos (pos-of s))
    (make-instance 'bullet :pos (v+ (pos-of s) (v 10 0)))))

(defclass monster (sprite)
  ()
  (:default-initargs :image (tag 'monster)
                     :pos (v (random (get-screen-width)) 0)
                     :vel (v (- (random 5) 2) 2)))

(defmethod initialize-instance :after ((s monster) &key &allow-other-keys)
  (incf *monster-count*))

(defmethod kill ((s monster))
  (call-next-method)
  (decf *monster-count*))

(defmethod update ((s monster))
  (call-next-method)
  (with-accessors ((pos pos-of) (vel vel-of)) s
    (when (> (vy pos) (get-screen-height))
      (kill s))
    (when (or (> (vx pos) (get-screen-width))
              (< (vx pos) 0))
      (setf vel (v (- (vx vel))
                   (vy vel))))))

(defclass bullet (sprite)
  ()
  (:default-initargs :image (tag 'bullet) :vel (v 0 -2)))

(defmethod update ((s bullet))
  (call-next-method)
  (when (< (vy (pos-of s)) 0)
    (kill s))
  (dolist (sprite *sprites*)
    (collide s sprite)))

(defmethod collide ((b bullet) (m monster))
  (incf *score* 10)
  (kill m)
  (kill b))

And as nice finishing touch we will add a scrolling background to our pal-space.lisp:

;; Final pal-space/pal-space.lisp

(in-package :pal-space)

(defparameter *scroll* 0)

(define-tags bullet (load-image "bullet.png")
             space-ship (load-image "ship.png")
             monster (load-image "monster.png")
             background (load-image "bg.png"))

(defun pal-space ()
  (with-pal (:title "PAL Space"
	     :fullscreenp nil
             :width 640
             :height 480
             :paths '("data/"
                      "C:/Documents and Settings/tomppa/Omat tiedostot/Downloads/pal-space/data/"))
    (setf *sprites* nil
          *scroll* 0
          *monster-count* 0
          *score* 0)
    (set-cursor nil)
    (make-instance 'space-ship)
    (event-loop ()
      (draw-image* (tag 'background)
                   (v 0 0)
                   (v 0 (- *scroll* 128))
                   (get-screen-width) (+ (get-screen-height) 128))
      (setf *scroll* (mod (incf *scroll*) 128))
      (when (< *monster-count* *max-monsters*)
        (make-instance 'monster))
      (dolist (s *sprites*)
        (draw s)
        (update s)))))

What is wrong with it?

There are still a lot of things missing or wrong with our little game, most obviously being that the player can’t die. Collision detection is also extremely slow, which is easy to see if you tune up the bullet rate. The Python version uses separate lists for bullets and monsters while our version compares every bullet against every sprite. This is easy to fix by providing a way to classify the sprites by their type when needed and caching the values, so that implementing something like (do-sprites (s class) …) should be relatively efficient.
Sound effects and music would be also nice to have, not to mention huge particle explosions… Maybe I’ll get back to it when I have more time.

This entry was posted on Tuesday, November 13th, 2007 at 2:09 am and is filed under Programming. You can follow any responses to this entry through the RSS 2.0 feed. You can leave a response, or trackback from your own site.