commit 809335c869043612ce3ee47142125eafa3b83011
Author: mil <mil@bloome.rs>
Date:   Thu Sep 24 23:50:31 2020 +0200

    Initial commit

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..1b7f6df
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,2 @@
+*~
+\#*\#
\ No newline at end of file
diff --git a/README.org b/README.org
new file mode 100644
index 0000000..aea3fe2
--- /dev/null
+++ b/README.org
@@ -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
+    
diff --git a/break.asd b/break.asd
new file mode 100644
index 0000000..73f4255
--- /dev/null
+++ b/break.asd
@@ -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")
+               ))
diff --git a/break.lisp b/break.lisp
new file mode 100644
index 0000000..0db3510
--- /dev/null
+++ b/break.lisp
@@ -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)))
diff --git a/objects.lisp b/objects.lisp
new file mode 100644
index 0000000..27cf34a
--- /dev/null
+++ b/objects.lisp
@@ -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)))
diff --git a/package.lisp b/package.lisp
new file mode 100644
index 0000000..8095ca3
--- /dev/null
+++ b/package.lisp
@@ -0,0 +1,9 @@
+;;;; package.lisp
+
+(defpackage #:break
+  (:use #:cl
+	#:cepl
+	#:vari
+	#:rtg-math
+	#:livesupport
+	#:cepl.skitter))
diff --git a/render.lisp b/render.lisp
new file mode 100644
index 0000000..cbbf4a4
--- /dev/null
+++ b/render.lisp
@@ -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)))
diff --git a/scene.lisp b/scene.lisp
new file mode 100644
index 0000000..4ac560d
--- /dev/null
+++ b/scene.lisp
@@ -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)))
diff --git a/utils.lisp b/utils.lisp
new file mode 100644
index 0000000..06c978f
--- /dev/null
+++ b/utils.lisp
@@ -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)))