You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
216 lines
6.8 KiB
216 lines
6.8 KiB
;;;; 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)))
|