Mil
/
break
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Initial commit

Browse Source
master
mil 4 years ago
commit 809335c869
9 changed files with 417 additions and 0 deletions
Show Stats Download Patch File Download Diff File

2
.gitignore vendored
Unescape View File

@ -0,0 +1,2 @@
*~
\#*\#

37
README.org
Unescape View File

@ -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

16
break.asd
Unescape View File

@ -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")
))

48
break.lisp
Unescape View File

@ -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)))

215
objects.lisp
Unescape View File

@ -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)))

9
package.lisp
Unescape View File

@ -0,0 +1,9 @@
;;;; package.lisp
(defpackage #:break
(:use #:cl
#:cepl
#:vari
#:rtg-math
#:livesupport
#:cepl.skitter))

58
render.lisp
Unescape View File

@ -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)))

14
scene.lisp
Unescape View File

@ -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)))

18
utils.lisp
Unescape View File

@ -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)))
Write Preview
Loading…
Cancel
Save