Commit 71da3d0a by David O'Toole

include plong example and modify doc accordingly

parent 0bdb7837
......@@ -1062,9 +1062,12 @@ At the shell:
<pre class="example">
cd ~/quicklisp/local-projects
git clone https://gitlab.com/dto/plong.git
git clone https://gitlab.com/dto/plong.git
</pre>
<b>NOTE: A copy of plong is included in the source tree. You can copy
or link it to this location instead.</B>
<p>
Then in Slime:
</p>
......
This diff is collapsed. Click to expand it.
plong
=====
a simple ball-and-paddle example for Xelf
plong/ball.png

160 Bytes

File added
(defpackage :plong
(:use :cl :xelf)
(:export plong))
(asdf:defsystem #:plong
:depends-on (:xelf)
:components ((:file "package")
(:file "plong")))
;;; plong.lisp --- a simple remixable ball-and-paddle example for Xelf
;; Copyright (C) 2014-2016 David O'Toole
;; Author: David O'Toole <dto@xelf.me>
;; Keywords: games
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU Lesser General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU Lesser General Public License for more details.
;; You should have received a copy of the GNU Lesser General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Code:
(in-package :plong)
;; Here we define an arbitrary measurement unit used throughout, and
;; set up some variables to hold the height and width of the game
;; world.
(defparameter *unit* 16)
(defun units (n) (* *unit* n))
(defparameter *width* 640)
(defparameter *height* 480)
;; Now it's time to define some game objects. Xelf game objects are
;; called "nodes", and they can interact by being grouped into
;; "buffers" of different kinds. Naturally there are base classes
;; called NODE and BUFFER. These classes define the basic behaviors of
;; the game engine. Nodes are endowed with such properties as an (X Y
;; Z) position, width, height, and image to be displayed, and so on. The
;; default node behaviors also hook all game objects into buffer
;; features, such as collision detection, pathfinding, and
;; serialization.
;; To define nodes of your own, use DEFCLASS and give NODE as a
;; superclass. You can override the default values of NODE slots, as
;; well as add your own.
(defclass ball (node)
((height :initform (units 1))
(width :initform (units 1))
(color :initform "white")
(speed :initform 6)
(heading :initform (direction-heading :downright))))
;; The generic function UPDATE is called on each object once during
;; each game loop.
(defmethod update ((ball ball))
(with-slots (heading speed) ball
(move ball heading speed)))
;; Now we need walls around the game world in order to contain the
;; ball.
(defclass wall (node)
((color :initform "gray50")))
;; We want the ball to bounce off of the walls. The COLLIDE method is
;; called for every frame on all pairs of objects whose bounding boxes
;; collide during that frame.
(defmethod collide ((ball ball) (wall wall))
(with-slots (heading speed x y) ball
;; back away from wall
(move ball (opposite-heading heading) speed)
;; point toward player. (The function PADDLE is defined later.)
(aim ball (heading-between ball (paddle)))
;; sometimes choose another direction to prevent getting stuck
(percent-of-time 10 (incf heading (radian-angle 90)))))
;; The ball should emit a retro beep when colliding with any node. We
;; use DEFRESOURCE to let Xelf know about the sound file. (The Xelf
;; reference gives more information about DEFRESOURCE.)
(defresource "bip.wav" :volume 20)
(defmethod collide :after ((ball ball) (node node))
(play-sample "bip.wav"))
;; Now it's time to bash some bricks! First we define the dimensions
;; of a brick and create a class.
(defparameter *brick-width* (units 2))
(defparameter *brick-height* (units 1.2))
(defclass brick (node)
((color :initform "gray60")
(height :initform *brick-height*)
(width :initform *brick-width*)))
;; Here's how we can add color to bricks when they're being created.
(defmethod initialize-instance :after ((brick brick) &key color)
(when color
(setf (slot-value brick 'color) color)))
;; Finally, the ball should bounce off the bricks and break them.
(defmethod collide ((ball ball) (brick brick))
(with-slots (heading) ball
(destroy brick)
(incf heading (radian-angle 90))))
;; Now we define some useful shorthand functions to refer to the ball and
;; paddle.
(defun ball () (slot-value (current-buffer) 'ball))
(defun paddle () (slot-value (current-buffer) 'paddle))
;; (We'll set up the CURRENT-BUFFER later so that its SLOT-VALUEs
;; are indeed set to right objects.)
;; The player controls a rectangular paddle which can move left or
;; right within the buffer.
(defclass paddle (node)
((direction :initform nil)
(height :initform (units 1))
(width :initform (units 8))
(color :initform "white")))
(defparameter *paddle-speed* 3)
;; Now we define some handy functions to check whether the player is
;; pressing left or right on the keyboard. Numeric keypad is also
;; supported---it's a good idea to check both when using arrows to
;; control your game.
(defun holding-left-arrow ()
(or (keyboard-down-p :kp4)
(keyboard-down-p :left)))
(defun holding-right-arrow ()
(or (keyboard-down-p :kp6)
(keyboard-down-p :right)))
(defun find-joystick-direction ()
(let ((heading (when (left-analog-stick-pressed-p)
(left-analog-stick-heading))))
(when heading
(if (and (> heading (/ pi 2))
(< heading (* 3 (/ pi 2))))
:left
:right))))
(defun find-direction ()
(or (when (plusp (number-of-joysticks))
(find-joystick-direction))
(cond ((holding-left-arrow) :left)
((holding-right-arrow) :right))))
;; In the paddle's UPDATE method, we read the inputs and move the
;; paddle accordingly.
(defmethod update ((paddle paddle))
(with-slots (direction) paddle
(setf direction (find-direction))
(when direction
(move paddle (direction-heading direction) *paddle-speed*))))
;; The paddle should bounce back from the walls, too.
(defmethod collide ((paddle paddle) (wall wall))
(with-slots (direction) paddle
(setf direction (opposite-direction direction))
(move paddle (direction-heading direction) (* *paddle-speed* 2))))
;; The "english" is the directional force applied to the ball because
;; of the player's moving the paddle to the left or right at the
;; moment of collision.
(defmethod english ((paddle paddle))
(with-slots (direction) paddle
(case direction
(:left (direction-heading :upleft))
(:right (direction-heading :upright))
(otherwise (+ (slot-value (ball) 'heading)
(radian-angle 90))))))
;; In the BALL,PADDLE collision method, the english is applied and the
;; ball is bounced away.
(defmethod collide ((ball ball) (paddle paddle))
(with-slots (heading speed) ball
(setf heading (english paddle))
(move ball heading speed)))
;; Now that we have all the pieces of our game world, it's time to put
;; them all together in a buffer. First we have a function to make a
;; wall of a specified height, width, and position.
(defun make-wall (x y width height)
(let ((wall (make-instance 'wall)))
(resize wall width height)
(move-to wall x y)
wall))
;; This function MAKE-BORDER returns a buffer with four walls.
(defun make-border (x y width height)
(let ((left x)
(top y)
(right (+ x width))
(bottom (+ y height)))
(with-new-buffer
;; top wall
(insert (make-wall left top (- right left) (units 1)))
;; bottom wall
(insert (make-wall left bottom (- right left (units -1)) (units 1)))
;; left wall
(insert (make-wall left top (units 1) (- bottom top)))
;; right wall
(insert (make-wall right top (units 1) (- bottom top (units -1))))
;; send it all back
(current-buffer))))
;; Now it's time for pretty rows of colored bricks.
(defparameter *row-colors*
'("dark orchid" "medium orchid" "orchid" "dark orange" "orange" "gold"))
(defun row-color (row)
(nth (mod row (length *row-colors*))
*row-colors*))
(defun make-puzzle ()
(with-new-buffer
(dotimes (row 6)
(dotimes (column 17)
(add-node (current-buffer)
(make-instance 'brick :color (row-color row))
(+ 50 (* column *brick-width*))
(+ 50 (* row *brick-height*)))))))
;; You can see that MAKE-PUZZLE also returns a new buffer. We'll put
;; together these component buffers into the final game board below
;; with a function called PASTE.
;; But first, we need a Buffer subclass for the game board.
(defclass plong (buffer)
((paddle :initform (make-instance 'paddle))
(ball :initform (make-instance 'ball))
(background-color :initform "black")
(width :initform *width*)
(height :initform *height*)))
;; After initializing a new Plong buffer, we set things up so that
;; pressing Control-R causes the game to reset.
(defmethod initialize-instance :after ((plong plong) &key)
(bind-event plong '(:r :control) 'start-game))
;; The START-GAME function builds the game board by inserting the
;; ball and paddle objects, then pasting in the bricks and border.
(defmethod start-game ((plong plong))
(with-slots (ball paddle) plong
(with-buffer plong
(insert ball)
(insert paddle)
(move-to ball 80 280)
(move-to paddle 110 400)
(paste plong (make-border 0 0 (- *width* (units 1)) (- *height* (units 1))))
(paste plong (make-puzzle)))))
;; Now we define the main entry point for the game, the function
;; PLONG. We set up our variables and then invoke WITH-SESSION to
;; start Xelf going.
(defun plong ()
;; Configure the screen dimensions
(setf *screen-height* *height*)
(setf *screen-width* *width*)
;; Allow resizing of window and scaling
(setf *resizable* t)
(setf *scale-output-to-window* t)
(with-session
(open-project :plong)
;; this indexes everything defined with DEFRESOURCE
(index-pending-resources)
(let ((plong (make-instance 'plong)))
;; start the buffer running
(switch-to-buffer plong)
(start-game plong))))
;;; plong.lisp ends here
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment