--- a/.lispwords Sat Apr 23 15:18:20 2016 +0000
+++ b/.lispwords Sun Apr 24 21:46:22 2016 +0000
@@ -1,2 +1,3 @@
(1 scancode-case)
(1 make-sketch)
+(2 with-vals)
--- a/package.lisp Sat Apr 23 15:18:20 2016 +0000
+++ b/package.lisp Sun Apr 24 21:46:22 2016 +0000
@@ -1,115 +1,128 @@
(defpackage #:coding-math.utils
(:use
- #:cl
- #:sketch
- #:coding-math.quickutils)
+ #:cl
+ #:sketch
+ #:coding-math.quickutils)
(:export
- #:in-context
- #:make-sketch
- #:scancode-case
- #:mulf
- #:dividesp
- #:square))
+ #:in-context
+ #:make-sketch
+ #:scancode-case
+ #:with-vals
+ #:mulf
+ #:dividesp
+ #:square))
(defpackage #:coding-math.math
(:use
- #:cl
- #:coding-math.quickutils
- #:coding-math.utils)
+ #:cl
+ #:coding-math.quickutils
+ #:coding-math.utils)
(:export
- #:tau
- #:distance
- #:random-range
- #:random-around
- #:norm
- #:lerp
- #:precise-lerp
- #:map-range
- #:clamp
- #:wrap-zero
- #:wrap-range
- #:outside-p))
+ #:tau
+ #:distance
+ #:random-range
+ #:random-around
+ #:norm
+ #:lerp
+ #:precise-lerp
+ #:map-range
+ #:clamp
+ #:wrap-zero
+ #:wrap-range
+ #:outsidep
+ #:insidep
+ #:ranges-overlap-p
+ #:hitbox-x
+ #:hitbox-y
+ #:hitbox-radius
+ #:hitbox-width
+ #:hitbox-height
+ #:circles-collide-p
+ #:circle-point-collide-p
+ #:rect-point-collide-p
+ #:rects-collide-p
+ ))
(defpackage #:coding-math.vectors
(:use
- #:cl
- #:coding-math.math
- #:coding-math.quickutils
- #:coding-math.utils)
+ #:cl
+ #:coding-math.math
+ #:coding-math.quickutils
+ #:coding-math.utils)
(:export
- #:vec
- #:vec-x
- #:vec-y
- #:make-vec
- #:make-vec-md
- #:make-vec-ma
- #:vec-magnitude
- #:vec-direction
- #:vec-angle
- #:vec-add
- #:vec-sub
- #:vec-mul
- #:vec-div
- #:vec-add!
- #:vec-sub!
- #:vec-mul!
- #:vec-div!
- #:vec-to-string))
+ #:vec
+ #:vec-x
+ #:vec-y
+ #:make-vec
+ #:make-vec-md
+ #:make-vec-ma
+ #:vec-magnitude
+ #:vec-direction
+ #:vec-angle
+ #:vec-add
+ #:vec-sub
+ #:vec-mul
+ #:vec-div
+ #:vec-add!
+ #:vec-sub!
+ #:vec-mul!
+ #:vec-div!
+ #:vec-to-string))
(defpackage #:coding-math.particles
(:use
- #:cl
- #:coding-math.math
- #:coding-math.vectors
- #:coding-math.quickutils
- #:coding-math.utils)
+ #:cl
+ #:coding-math.math
+ #:coding-math.vectors
+ #:coding-math.quickutils
+ #:coding-math.utils)
(:export
- #:particle
- #:particle-vel
- #:particle-pos
- #:particle-grv
- #:particle-radius
- #:particle-mass
- #:particle-friction
- #:particle-speed
- #:particle-direction
- #:make-particle
- #:particle-x
- #:particle-y
- #:particle-wrap!
- #:particle-update!
- #:particle-accelerate!
- #:particle-angle-to
- #:particle-distance-to
- #:particle-gravitate-to!))
+ #:particle
+ #:particle-vel
+ #:particle-pos
+ #:particle-grv
+ #:particle-radius
+ #:particle-mass
+ #:particle-friction
+ #:particle-speed
+ #:particle-direction
+ #:make-particle
+ #:particle-x
+ #:particle-y
+ #:particle-wrap!
+ #:particle-update!
+ #:particle-accelerate!
+ #:particle-angle-to
+ #:particle-distance-to
+ #:particle-gravitate-to!))
(defpackage #:coding-math.fps
(:use
- #:cl
- #:sketch
- #:coding-math.quickutils
- #:coding-math.utils)
+ #:cl
+ #:sketch
+ #:coding-math.quickutils
+ #:coding-math.utils)
(:export
- #:calc-fps
- #:draw-fps))
+ #:calc-fps
+ #:draw-fps))
(defpackage #:coding-math
(:use
- #:cl
- #:sketch
- #:coding-math.quickutils
- #:coding-math.utils
- #:coding-math.fps
- #:coding-math.math
- #:coding-math.vectors
- #:coding-math.particles))
+ #:cl
+ #:sketch
+ #:coding-math.quickutils
+ #:coding-math.utils
+ #:coding-math.fps
+ #:coding-math.math
+ #:coding-math.vectors
+ #:coding-math.particles))
(defpackage #:coding-math.ballistics
(:use
- #:cl
- #:sketch
- #:coding-math.quickutils
- #:coding-math.particles
- #:coding-math.utils
- #:coding-math.math
- #:coding-math.fps))
+ #:cl
+ #:sketch
+ #:coding-math.quickutils
+ #:coding-math.particles
+ #:coding-math.utils
+ #:coding-math.math
+ #:coding-math.fps))
--- a/src/ballistics.lisp Sat Apr 23 15:18:20 2016 +0000
+++ b/src/ballistics.lisp Sun Apr 24 21:46:22 2016 +0000
@@ -132,4 +132,4 @@
;;;; Run
-(defparameter *demo* (make-game))
+; (defparameter *demo* (make-game))
--- a/src/main.lisp Sat Apr 23 15:18:20 2016 +0000
+++ b/src/main.lisp Sun Apr 24 21:46:22 2016 +0000
@@ -1,8 +1,8 @@
(in-package #:coding-math)
-(declaim (optimize (speed 0)
- (safety 3)
- (debug 3)))
+(declaim (optimize (speed 1)
+ (safety 1)
+ (debug 1)))
;;;; Config
(defparameter *width* 600)
@@ -15,15 +15,25 @@
;;;; Sketch
(defun particle-oob-p (particle)
(let ((r (particle-radius particle)))
- (or (outside-p (- 0 r)
- (+ *width* r)
- (particle-x particle))
- (outside-p (- 0 r)
- (+ *height* r)
- (particle-y particle)))))
+ (or (outsidep (- 0 r)
+ (+ *width* r)
+ (particle-x particle))
+ (outsidep (- 0 r)
+ (+ *height* r)
+ (particle-y particle)))))
-(declaim (inline draw-particle))
+(defun draw-rect (r)
+ (rect (getf r :x)
+ (getf r :y)
+ (getf r :width)
+ (getf r :height)))
+
+(defun draw-circle (c)
+ (circle (getf c :x)
+ (getf c :y)
+ (getf c :radius)))
+
(defun draw-particle (particle)
(circle (particle-x particle)
(particle-y particle)
@@ -33,30 +43,46 @@
(defsketch cm (:width *width*
:height *height*
:debug :scancode-d)
- ((mx 0)
- (my 0)
- (frame 1)
- (p nil))
+ ((mouse)
+ (frame)
+ (r)
+ (mr)
+ )
(background (gray 1))
(incf frame)
;;
- (with-pen (make-pen :stroke (gray 0.3)
- :fill (if (> (distance mx my *center-x* *center-y*) 100)
- (gray 1)
- (gray 0.5)))
- (circle *center-x* *center-y* 100))
+
+ (setf (getf mr :x) (getf mouse :x))
+ (setf (getf mr :y) (getf mouse :y))
+
+ (with-pen (make-pen :stroke (gray 0.5)
+ :fill (cond
+ ((rects-collide-p r mr)
+ (rgb 0 0 0.7 0.5))
+ (t (gray 0.9))))
+ (draw-rect r)
+ (draw-rect mr))
+
;;
(when (zerop (mod frame 20))
(calc-fps 20))
(draw-fps))
+(defun make-cm ()
+ (make-sketch 'cm
+ (mouse (list :x 0 :y 0))
+ (frame 1)
+ (r (list :x 20 :y 50 :width (- *width* 40) :height 30))
+ (mr (list :x 300 :y 300 :width 90 :height 90))
+ ))
+
;;;; Mouse
(defmethod kit.sdl2:mousemotion-event ((window cm) ts b x y xrel yrel)
(declare (ignore ts b xrel yrel))
- (with-slots (mx my rect-x rect-y rect-w rect-h cx cy cr) window
- (setf mx x)
- (setf my y)
+ (with-slots (mouse) window
+ (setf (getf mouse :x) x)
+ (setf (getf mouse :y) y)
;;
;;
))
@@ -74,6 +100,7 @@
:direction (random tau))))))
(defun keyup (instance scancode)
+ (declare (ignore instance))
(scancode-case scancode
(:scancode-space
nil)))
@@ -88,4 +115,4 @@
;;;; Run
-; (defparameter *demo* (make-instance 'cm))
+; (defparameter *demo* (make-cm))
--- a/src/math.lisp Sat Apr 23 15:18:20 2016 +0000
+++ b/src/math.lisp Sun Apr 24 21:46:22 2016 +0000
@@ -1,15 +1,19 @@
(in-package #:coding-math.math)
-;; Constants
+(declaim (inline outsidep insidep wrap-zero wrap-range))
+(declaim (inline norm lerp clamp distance))
+
+;;;; Constants
(defparameter tau (* pi 2))
+
;; Geometry
(defun distance (x0 y0 x1 y1)
(sqrt (+ (square (- x0 x1))
(square (- y0 y1)))))
-;; Random
+;;;; Random
(defun random-range (min max)
(+ min (random (- max min))))
@@ -18,7 +22,7 @@
(+ val range)))
-;; Number range mapping
+;;;; Number range mapping
(defun norm (min max val)
(/ (- val min)
(- max min)))
@@ -48,14 +52,16 @@
(lerp dest-from dest-to
(norm source-from source-to source-val)))
-(defun clamp (min max n)
- (cond
- ((> n max) max)
- ((< n min) min)
- (t n)))
+(defun clamp (from to n)
+ (let ((max (max from to))
+ (min (min from to)))
+ (cond
+ ((> n max) max)
+ ((< n min) min)
+ (t n))))
-;; Wrapping
+;;;; Wrapping
(defun wrap-zero (max val)
"Wrap `val` around the range [0, max)."
(mod val max))
@@ -66,6 +72,74 @@
(mod (- val min)
(- max min))))
-(defun outside-p (min max val)
- (or (< val min)
- (> val max)))
+
+(defun insidep (from to val)
+ (< (min from to) val (max from to)))
+
+(defun outsidep (from to val)
+ (not (insidep from to val)))
+
+(defun ranges-overlap-p (from0 to0 from1 to1)
+ (not (or (< (max from0 to0)
+ (min from1 to1))
+ (> (min from0 to0)
+ (max from1 to1)))))
+
+
+;;;; Collisions
+(defgeneric hitbox-x (object))
+
+(defgeneric hitbox-y (object))
+
+(defgeneric hitbox-radius (object))
+
+
+(defmethod hitbox-x ((object list))
+ (getf object :x))
+
+(defmethod hitbox-y ((object list))
+ (getf object :y))
+
+(defmethod hitbox-radius ((object list))
+ (getf object :radius))
+
+(defmethod hitbox-width ((object list))
+ (getf object :width))
+
+(defmethod hitbox-height ((object list))
+ (getf object :height))
+
+
+(defun circles-collide-p (c0 c1)
+ (let ((d (distance (hitbox-x c0) (hitbox-y c0)
+ (hitbox-x c1) (hitbox-y c1))))
+ (< d (+ (hitbox-radius c0)
+ (hitbox-radius c1)))))
+
+(defun circle-point-collide-p (c p)
+ (let ((d (distance (hitbox-x c) (hitbox-y c)
+ (hitbox-x p) (hitbox-y p))))
+ (< d (hitbox-radius c))))
+
+(defun rect-point-collide-p (r p)
+ (with-vals ((rx hitbox-x)
+ (ry hitbox-y)
+ (rw hitbox-width)
+ (rh hitbox-height))
+ r
+ (and (insidep rx (+ rx rw) (hitbox-x p))
+ (insidep ry (+ ry rh) (hitbox-y p)))))
+
+(defun rects-collide-p (r0 r1)
+ (with-vals ((r0x hitbox-x) ; lol
+ (r0y hitbox-y)
+ (r0w hitbox-width)
+ (r0h hitbox-height)) r0
+ (with-vals ((r1x hitbox-x)
+ (r1y hitbox-y)
+ (r1w hitbox-width)
+ (r1h hitbox-height)) r1
+ (and (ranges-overlap-p r0x (+ r0x r0w)
+ r1x (+ r1x r1w))
+ (ranges-overlap-p r0y (+ r0y r0h)
+ r1y (+ r1y r1h))))))
--- a/src/particles.lisp Sat Apr 23 15:18:20 2016 +0000
+++ b/src/particles.lisp Sun Apr 24 21:46:22 2016 +0000
@@ -115,3 +115,13 @@
(vec-angle gravity)
(particle-angle-to particle attractor-particle))
(particle-accelerate! particle gravity)))
+
+
+(defmethod hitbox-x ((p particle))
+ (particle-x p))
+
+(defmethod hitbox-y ((p particle))
+ (particle-y p))
+
+(defmethod hitbox-radius ((p particle))
+ (particle-radius p))
--- a/src/utils.lisp Sat Apr 23 15:18:20 2016 +0000
+++ b/src/utils.lisp Sun Apr 24 21:46:22 2016 +0000
@@ -44,3 +44,10 @@
`((sdl2:scancode= ,scancode ,key-scancode)
,@body)))
pairs)))))
+
+(defmacro with-vals (bindings value-form &body body)
+ (with-gensyms (val)
+ `(let* ((,val ,value-form)
+ ,@(loop :for (s accessor) :in bindings
+ :collect `(,s (,accessor ,val))))
+ ,@body)))