commit
809335c869
@ -0,0 +1,2 @@
|
|||||||
|
*~
|
||||||
|
\#*\#
|
||||||
@ -0,0 +1,37 @@
|
|||||||
|
* Break
|
||||||
|
Breakout clone with some future plans.
|
||||||
|
|
||||||
|
** building, running
|
||||||
|
- install quicklisp
|
||||||
|
- place the repository in a directory listed in =quicklisp:*local-project-directories*=
|
||||||
|
- start emacs and slime. SBCL is the only CL implementation tested.
|
||||||
|
- run =(ql:quickload :break)= and switch to the =:break= package.
|
||||||
|
- run =(cepl:repl)= to start CEPL
|
||||||
|
- create a pad and assign it to =*pad*=
|
||||||
|
- =(run-loop)= starts the game loop and =(stop-loop)= stops it. Consider not
|
||||||
|
recompiling the functions while the loop is running because you'll lose access to the
|
||||||
|
closure.
|
||||||
|
|
||||||
|
** lisp libraries used and where to find them
|
||||||
|
- [[https://github.com/cbaggers/cepl][CEPL]] ([[http://techsnuffle.com/cepl/api.html][Documentation]]) :: Lispy way to work with OpenGL
|
||||||
|
- [[https://github.com/cbaggers/rtg-math][rtg-math]] ([[http://techsnuffle.com/rtg-math/rtg-math-reference.html][Documentation]]) :: Lisp-side math library
|
||||||
|
- [[https://github.com/cbaggers/varjo][vari and varjo]] ([[http://techsnuffle.com/varjo/vari-reference.html][language documentation]] [[http://techsnuffle.com/varjo/varjo-reference.html][compiler documentation]]) :: Shader language and
|
||||||
|
its compiler
|
||||||
|
|
||||||
|
** things to do
|
||||||
|
Note: DONE doesn't mean the subheading's content is irrelevant.
|
||||||
|
*** DONE Decouple coordinate system from rendering resolutionn
|
||||||
|
The playable are has is 320 x 240 in size. The size is defined in a global variable,
|
||||||
|
and parts of the code that need it read it. Entity positions and sizes are not
|
||||||
|
adjusted if the size changes, but otherwise it can be adjusted at runtime.
|
||||||
|
*** TODO Remove global variables
|
||||||
|
State relevant to any given scene should be possible to keep in an object representing
|
||||||
|
the scene itself. All update methods should take the context as an argument, rather
|
||||||
|
than accessing global variables defined after the methods.
|
||||||
|
*** TODO Add a menu system and a scene loader
|
||||||
|
A menu is a kind of scene.
|
||||||
|
|
||||||
|
Scenes should probably be on a stack so that you can push/pop them to arbitrary
|
||||||
|
depths.
|
||||||
|
*** TODO Implement keybindings
|
||||||
|
|
||||||
@ -0,0 +1,16 @@
|
|||||||
|
;;;; break.asd
|
||||||
|
|
||||||
|
(asdf:defsystem #:break
|
||||||
|
:description "Breakout clone"
|
||||||
|
:author "Mil <mil@bloome.rs>"
|
||||||
|
:license "GPL"
|
||||||
|
:version "0.0.1"
|
||||||
|
:serial t
|
||||||
|
:depends-on (#:cepl #:rtg-math.vari #:cepl.sdl2 #:swank #:livesupport #:cepl.skitter.sdl2 #:dirt)
|
||||||
|
:components ((:file "package")
|
||||||
|
(:file "render")
|
||||||
|
(:file "utils")
|
||||||
|
(:file "objects")
|
||||||
|
(:file "break")
|
||||||
|
(:file "scene")
|
||||||
|
))
|
||||||
@ -0,0 +1,48 @@
|
|||||||
|
;;;; break.lisp
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;;; This file should be the only one that manages program state.
|
||||||
|
;;;
|
||||||
|
(in-package #:break)
|
||||||
|
|
||||||
|
(defparameter *entities* nil)
|
||||||
|
(defparameter *pad* nil)
|
||||||
|
(defparameter *balls* nil)
|
||||||
|
(defparameter *tiles* nil)
|
||||||
|
|
||||||
|
(defparameter *internal-size* (v! 320 240))
|
||||||
|
(defparameter *projection-matrix* (rtg-math.projection:orthographic-v2 *internal-size* 1.0 100.0))
|
||||||
|
(defparameter *viewport* (make-viewport))
|
||||||
|
|
||||||
|
(defun update-entities ()
|
||||||
|
(let ((ents (cons *pad* (concatenate 'list *balls* *tiles* *entities*))))
|
||||||
|
(map nil #'update ents)))
|
||||||
|
|
||||||
|
(defun window-size-callback (size &rest ignored)
|
||||||
|
(declare (ignore ignored))
|
||||||
|
(setf (viewport-dimensions (current-viewport))
|
||||||
|
(list (aref size 0) (aref size 1)))
|
||||||
|
(setf *projection-matrix* (update-matrix size)))
|
||||||
|
|
||||||
|
(defun step-game ()
|
||||||
|
(with-viewport *viewport*
|
||||||
|
(labels ((draw-ent (ent)
|
||||||
|
(draw-entity ent *projection-matrix*)))
|
||||||
|
(step-host)
|
||||||
|
(update-repl-link)
|
||||||
|
(clear)
|
||||||
|
(update-entities)
|
||||||
|
(draw-entity *pad* *projection-matrix*)
|
||||||
|
(map nil #'draw-ent *balls*)
|
||||||
|
(map nil #'draw-ent *tiles*)
|
||||||
|
(map nil #'draw-ent *entities*)
|
||||||
|
(swap))))
|
||||||
|
|
||||||
|
(let ((running nil))
|
||||||
|
(defun run-loop ()
|
||||||
|
(setf running t)
|
||||||
|
(whilst-listening-to
|
||||||
|
((#'window-size-callback (window 0) :size))
|
||||||
|
(loop :while (and running (not (shutting-down-p))) :do
|
||||||
|
(continuable (step-game)))))
|
||||||
|
(defun stop-loop ()
|
||||||
|
(setf running nil)))
|
||||||
@ -0,0 +1,215 @@
|
|||||||
|
;;;; objects.lisp
|
||||||
|
(in-package :break)
|
||||||
|
|
||||||
|
(defgeneric update (entity))
|
||||||
|
(defgeneric kill (entity))
|
||||||
|
(defgeneric bounding-box (entity))
|
||||||
|
(defgeneric overlap-p (entity1 entity2))
|
||||||
|
|
||||||
|
;;; Base class for everything that needs to be drawn.
|
||||||
|
(defclass entity ()
|
||||||
|
((e-stream :initform nil :initarg :e-stream :accessor e-stream)
|
||||||
|
(position :initform (v! 0 0 0) :initarg :pos :accessor pos)
|
||||||
|
(scale :initform (v! 1 1 1) :initarg :scale :accessor scale)
|
||||||
|
(size :initform (v! 1 1) :initarg :size :accessor size)))
|
||||||
|
|
||||||
|
(defun make-entity (x y color position)
|
||||||
|
(make-instance 'entity
|
||||||
|
:e-stream (make-square-e-stream x y color)
|
||||||
|
:pos position))
|
||||||
|
|
||||||
|
(defmethod update ((entity entity))
|
||||||
|
(setf (pos entity)
|
||||||
|
(make-array
|
||||||
|
3
|
||||||
|
:element-type 'single-float
|
||||||
|
:initial-contents (map 'vector (lambda (scalar) (- (/ scalar 2)))
|
||||||
|
(concatenate 'vector
|
||||||
|
(viewport-internal-size (current-viewport))
|
||||||
|
'(-0.0))))))
|
||||||
|
|
||||||
|
(defmethod kill ((entity entity))
|
||||||
|
(map nil (lambda (arr) (if (consp arr)
|
||||||
|
(free (car arr))
|
||||||
|
(free arr)))
|
||||||
|
(buffer-stream-gpu-arrays (e-stream entity)))
|
||||||
|
(free-buffer-stream (e-stream entity)))
|
||||||
|
|
||||||
|
(defun draw-entity (entity projection-matrix)
|
||||||
|
(let ((to-world (m4:* (m4:translation (pos entity))
|
||||||
|
(m4:scale (scale entity))))
|
||||||
|
(to-view projection-matrix
|
||||||
|
;;(rtg-math.projection:orthographic 320.0 240.0 1.0 100.0)
|
||||||
|
))
|
||||||
|
(map-g #'render (e-stream entity) :to-view to-view :to-world to-world)))
|
||||||
|
|
||||||
|
;;; Background images
|
||||||
|
(defclass bg-image (entity)
|
||||||
|
((alignment :initform :center :initarg :alignment :accessor alignment)
|
||||||
|
(index :initform 1 :initarg :index :accessor index)))
|
||||||
|
|
||||||
|
(defun make-bg-image (alignment index color)
|
||||||
|
(make-instance 'bg-image
|
||||||
|
:alignment alignment
|
||||||
|
:index index
|
||||||
|
:e-stream (make-square-e-stream 320.0 240.0 color)
|
||||||
|
:pos (v! 0 0 0)))
|
||||||
|
|
||||||
|
(defmethod update ((bg-image bg-image))
|
||||||
|
(let ((internal-size (viewport-internal-size (current-viewport))))
|
||||||
|
(setf (pos bg-image)
|
||||||
|
(case (alignment bg-image)
|
||||||
|
(:center (v! (rtg-math.vector2:*s (rtg-math.vector2:/s *internal-size* 2.0) -1.0)
|
||||||
|
(index bg-image)))
|
||||||
|
(:topright (v!
|
||||||
|
(rtg-math.vector2:-
|
||||||
|
(rtg-math.vector2:/s internal-size 2.0)
|
||||||
|
*internal-size*)
|
||||||
|
(index bg-image)))
|
||||||
|
(:bottomleft (v!
|
||||||
|
(rtg-math.vector2:-
|
||||||
|
(rtg-math.vector2:/s internal-size 2.0)
|
||||||
|
internal-size)
|
||||||
|
(index bg-image)))
|
||||||
|
))))
|
||||||
|
|
||||||
|
;;; paddle
|
||||||
|
(defclass pad (entity)
|
||||||
|
((size :initform (v! 100 5) :initarg :size :accessor size)))
|
||||||
|
|
||||||
|
(defun make-pad ()
|
||||||
|
(make-instance 'pad
|
||||||
|
:e-stream (make-square-e-stream 100.0 5.0 (v! 0 0 1 1))
|
||||||
|
:pos (v! 0 -100 0)
|
||||||
|
:size (v! 100.0 5.0)))
|
||||||
|
|
||||||
|
(defmethod (setf size) (new-size (pad pad))
|
||||||
|
(setf (slot-value pad 'size) new-size)
|
||||||
|
(setf (slot-value pad 'scale) (v! (v2:/ (size pad) (v! 100 5)))))
|
||||||
|
|
||||||
|
(defmethod update ((pad pad))
|
||||||
|
(setf (aref (pos pad) 0) ; position should be in pixels, not SDL2 coords
|
||||||
|
(- (aref (mouse-pos (mouse)) 0) (/ 320 2))))
|
||||||
|
|
||||||
|
;;; balls
|
||||||
|
(defclass ball (entity)
|
||||||
|
((direction :initform (v! 1 1 0) :initarg :direction :accessor dir)
|
||||||
|
(speed :initform 1.0 :initarg :speed :accessor spd)
|
||||||
|
(radius :initform 2.5 :initarg :rad :accessor rad)))
|
||||||
|
|
||||||
|
(defun make-ball (pos dir)
|
||||||
|
(make-instance 'ball
|
||||||
|
:e-stream (make-square-e-stream 5 5 (v! 1 1 0 1))
|
||||||
|
:pos (or pos (v! 0 0 0))
|
||||||
|
:rad 2.5
|
||||||
|
:direction (or dir (v! 0.5 0.5 0))))
|
||||||
|
|
||||||
|
(defun turn-ball (ball &key direction)
|
||||||
|
"Returns the new direction the ball should move to.
|
||||||
|
Setf elsewhere."
|
||||||
|
(if (equal direction :v)
|
||||||
|
(v3:* (v! -1 1 1) (dir ball))
|
||||||
|
(v3:* (v! 1 -1 1) (dir ball))))
|
||||||
|
|
||||||
|
(defun turn-ball-at-edge (ball)
|
||||||
|
"Stickiness is not accounted for.
|
||||||
|
Bounding boxes are not accounted for."
|
||||||
|
(if (< (/ (aref *internal-size* 0) 2) (abs (aref (pos ball) 0)))
|
||||||
|
(setf (dir ball) (turn-ball ball :direction :v)))
|
||||||
|
(if (< (/ (aref *internal-size* 1) 2) (abs (aref (pos ball) 1)))
|
||||||
|
(setf (dir ball) (turn-ball ball :direction :h)))
|
||||||
|
(dir ball))
|
||||||
|
|
||||||
|
(defun split-ball (ball &key way)
|
||||||
|
(let ((new-ball (make-ball (pos ball) (v! 1 1 0))))
|
||||||
|
(setf (dir new-ball) (turn-ball ball :direction way))
|
||||||
|
(setf *balls* (cons new-ball *balls*))))
|
||||||
|
|
||||||
|
(defun kick-balls ()
|
||||||
|
(map nil (lambda (ball)
|
||||||
|
(setf (dir ball)
|
||||||
|
(normalize-v3 (v! (- (random 100) 50)
|
||||||
|
(- (random 100) 50)
|
||||||
|
0))))
|
||||||
|
*balls*))
|
||||||
|
|
||||||
|
(defmethod update ((ball ball))
|
||||||
|
(let ((overlap (overlap-p *pad* ball)))
|
||||||
|
(if overlap
|
||||||
|
(progn
|
||||||
|
(setf (dir ball) (normalize-v3
|
||||||
|
(v! (v2:* (v! 2 1)
|
||||||
|
(v2:/ overlap (v2:/S (size *pad*) 2.0)))
|
||||||
|
0)))
|
||||||
|
(setf (aref (dir ball) 1) (abs (aref (dir ball) 1))))))
|
||||||
|
(setf (pos ball) (v3:+ (pos ball) (v3:*s (turn-ball-at-edge ball)
|
||||||
|
(spd ball)))))
|
||||||
|
|
||||||
|
;;; tiles
|
||||||
|
(defclass tile (entity)
|
||||||
|
((life :initform 1 :initarg :life :accessor life)
|
||||||
|
(size :initform (v! 20 10) :initarg :size :accessor size)))
|
||||||
|
|
||||||
|
(defun make-tile (pos &optional life)
|
||||||
|
(make-instance 'tile
|
||||||
|
:e-stream (make-square-e-stream 20 10 (v! 0 0.5 0.5 1))
|
||||||
|
:pos pos
|
||||||
|
:size (v! 20 10)
|
||||||
|
:life (or life 1)))
|
||||||
|
|
||||||
|
(defmethod update ((tile tile))
|
||||||
|
(map nil (lambda (ball)
|
||||||
|
(let ((overlap (overlap-p tile ball)))
|
||||||
|
(if overlap
|
||||||
|
(progn
|
||||||
|
(setf (dir ball)
|
||||||
|
(if (= (abs (aref (v2:/ overlap (v2:/S (size tile) 2.0)) 1))
|
||||||
|
1.0)
|
||||||
|
(turn-ball ball :direction :h)
|
||||||
|
(turn-ball ball :direction :v)))
|
||||||
|
(decf (life tile))
|
||||||
|
(if (= (life tile) 0)
|
||||||
|
(progn
|
||||||
|
(setf *tiles* (remove tile *tiles*))
|
||||||
|
(kill tile)))))))
|
||||||
|
*balls*))
|
||||||
|
|
||||||
|
;;; Collision magic
|
||||||
|
(defmethod bounding-box ((entity entity))
|
||||||
|
(let ((y (v! (aref (pos entity) 0)
|
||||||
|
(+ (aref (size entity) 0)
|
||||||
|
(aref (pos entity) 0))))
|
||||||
|
(x (v! (aref (pos entity) 1)
|
||||||
|
(+ (aref (size entity) 1)
|
||||||
|
(aref (pos entity) 1)))))
|
||||||
|
(v! y x)))
|
||||||
|
|
||||||
|
(defmethod overlap-p ((ent1 entity) (ent2 entity))
|
||||||
|
"AABB bounding box checking. Currently unused."
|
||||||
|
(labels ((test-y (entity1 entity2)
|
||||||
|
(or (in-range (aref (bounding-box entity1) 0)
|
||||||
|
(subseq (bounding-box entity2) 0 2))
|
||||||
|
(in-range (aref (bounding-box entity1) 1)
|
||||||
|
(subseq (bounding-box entity2) 0 2))))
|
||||||
|
(test-x (entity1 entity2)
|
||||||
|
(or (in-range (aref (bounding-box entity1) 2)
|
||||||
|
(subseq (bounding-box entity2) 2))
|
||||||
|
(in-range (aref (bounding-box entity1) 3)
|
||||||
|
(subseq (bounding-box entity2) 2)))))
|
||||||
|
(and (test-y ent1 ent2)
|
||||||
|
(test-x ent1 ent2))))
|
||||||
|
|
||||||
|
(defmethod overlap-p ((ent1 entity) (ball ball))
|
||||||
|
(let* ((ball-center (v2:+S (subseq (pos ball) 0 2) (rad ball)))
|
||||||
|
(ent-center (v2:+ (subseq (pos ent1) 0 2) (v2:/S (size ent1) 2.0)))
|
||||||
|
(point (clamp-v2 (v2:*S (v2:/S (size ent1) 2.0) -1.0)
|
||||||
|
(v2:/S (size ent1) 2.0)
|
||||||
|
(v2:- ball-center ent-center)))
|
||||||
|
(diff (v2:- ball-center (v2:+ ent-center point))))
|
||||||
|
;; (format t "~a, ~a, ~a, ~a, ~a" (sqrt (+ (expt (aref diff 0) 2)
|
||||||
|
;; (expt (aref diff 1) 2)))
|
||||||
|
;; point ball-center ent-center (rad ball))
|
||||||
|
(if (> (rad ball) (sqrt (+ (expt (aref diff 0) 2)
|
||||||
|
(expt (aref diff 1) 2))))
|
||||||
|
point
|
||||||
|
nil)))
|
||||||
@ -0,0 +1,9 @@
|
|||||||
|
;;;; package.lisp
|
||||||
|
|
||||||
|
(defpackage #:break
|
||||||
|
(:use #:cl
|
||||||
|
#:cepl
|
||||||
|
#:vari
|
||||||
|
#:rtg-math
|
||||||
|
#:livesupport
|
||||||
|
#:cepl.skitter))
|
||||||
@ -0,0 +1,58 @@
|
|||||||
|
;;;; render.lisp
|
||||||
|
(in-package :break)
|
||||||
|
|
||||||
|
(defstruct-g pos-col
|
||||||
|
(posiiton :vec3 :accessor pos)
|
||||||
|
(color :vec4 :accessor col))
|
||||||
|
|
||||||
|
(defun-g vert ((vert pos-col) &uniform (to-view :mat4) (to-world :mat4))
|
||||||
|
(values (* to-view
|
||||||
|
(* to-world
|
||||||
|
(v! (pos vert) 1.0)))
|
||||||
|
(col vert)))
|
||||||
|
|
||||||
|
(defun-g frag ((color :vec4))
|
||||||
|
color)
|
||||||
|
|
||||||
|
(defpipeline-g render ()
|
||||||
|
(vert pos-col)
|
||||||
|
(frag :vec4))
|
||||||
|
|
||||||
|
(defun make-square-e-stream (x y color)
|
||||||
|
(let* ((verts (make-gpu-array `((,(v! x y 0) ,color)
|
||||||
|
(,(v! 0 y 0) ,color)
|
||||||
|
(,(v! 0 0 0) ,color)
|
||||||
|
(,(v! x 0 0) ,color))
|
||||||
|
:element-type 'pos-col :dimensions 4))
|
||||||
|
(indices (make-gpu-array '(0 1 2 0 2 3)
|
||||||
|
:dimensions 6 :element-type :unsigned-short)))
|
||||||
|
(make-buffer-stream verts :index-array indices)))
|
||||||
|
|
||||||
|
(defun viewport-internal-size (viewport)
|
||||||
|
(let* ((viewport-width (viewport-resolution-x viewport))
|
||||||
|
(viewport-height (viewport-resolution-y viewport))
|
||||||
|
(internal-width (aref *internal-size* 0))
|
||||||
|
(internal-height (aref *internal-size* 1))
|
||||||
|
(viewport-aspect-ratio (/ viewport-width viewport-height)))
|
||||||
|
(if (> viewport-aspect-ratio (/ internal-width internal-height))
|
||||||
|
(v! (* internal-height viewport-aspect-ratio)
|
||||||
|
internal-height)
|
||||||
|
(v! internal-width
|
||||||
|
(/ internal-width viewport-aspect-ratio)))))
|
||||||
|
|
||||||
|
(defun update-matrix (window-size)
|
||||||
|
(let* ((window-width (aref window-size 0))
|
||||||
|
(window-height (aref window-size 1))
|
||||||
|
(internal-width (aref *internal-size* 0))
|
||||||
|
(internal-height (aref *internal-size* 1))
|
||||||
|
(window-aspect-ratio (reduce #'/ window-size))
|
||||||
|
(new-size (if (> window-aspect-ratio (/ internal-width internal-height))
|
||||||
|
(v! (* internal-height window-aspect-ratio)
|
||||||
|
internal-height) ; wider, preserve height
|
||||||
|
(v! internal-width
|
||||||
|
(/ internal-width window-aspect-ratio)))))
|
||||||
|
;; (format t "Matrix arguments: ~a ~a.~%" (aref new-size 0) (aref new-size 1))
|
||||||
|
|
||||||
|
(rtg-math.projection:orthographic
|
||||||
|
(aref new-size 0) (aref new-size 1)
|
||||||
|
1.0 100.0)))
|
||||||
@ -0,0 +1,14 @@
|
|||||||
|
;;;; scene.lisp
|
||||||
|
(in-package :break)
|
||||||
|
|
||||||
|
(defun init-scene (scene)
|
||||||
|
(map nil #'kill *balls*)
|
||||||
|
(map nil #'kill *tiles*)
|
||||||
|
(setf *balls* (list (make-ball nil nil)))
|
||||||
|
(setf *tiles* (map 'list #'make-tile scene))
|
||||||
|
(step-game))
|
||||||
|
|
||||||
|
(defvar *test-scene*
|
||||||
|
(list
|
||||||
|
(v! 100 100 0) (v! 80 100 0) (v! 60 100 0)
|
||||||
|
(v! 100 90 0) (v! 100 80 0) (v! 100 70 0)))
|
||||||
@ -0,0 +1,18 @@
|
|||||||
|
;;;; utils.lisp
|
||||||
|
(in-package :break)
|
||||||
|
|
||||||
|
(defun in-range (num vec)
|
||||||
|
(and (not (< num (aref vec 0)))
|
||||||
|
(not (> num (aref vec 1)))))
|
||||||
|
|
||||||
|
(defun clamp-v2 (min max vec)
|
||||||
|
(v! (clamp (aref min 0) (aref max 0) (aref vec 0))
|
||||||
|
(clamp (aref min 1) (aref max 1) (aref vec 1))))
|
||||||
|
|
||||||
|
(defun magnitude (vec)
|
||||||
|
(sqrt (apply #'+ (map 'list
|
||||||
|
(lambda (s) (expt s 2))
|
||||||
|
vec))))
|
||||||
|
|
||||||
|
(defun normalize-v3 (vec)
|
||||||
|
(v3:/S vec (magnitude vec)))
|
||||||
Loading…
Reference in new issue