--- a/.lispwords Fri Apr 22 23:13:31 2016 +0000
+++ b/.lispwords Sat Apr 23 15:18:20 2016 +0000
@@ -1,1 +1,2 @@
(1 scancode-case)
+(1 make-sketch)
--- a/package.lisp Fri Apr 22 23:13:31 2016 +0000
+++ b/package.lisp Sat Apr 23 15:18:20 2016 +0000
@@ -4,8 +4,9 @@
#:sketch
#:coding-math.quickutils)
(:export
- #:a
#:in-context
+ #:make-sketch
+ #:scancode-case
#:mulf
#:dividesp
#:square))
@@ -70,6 +71,8 @@
#:particle-radius
#:particle-mass
#:particle-friction
+ #:particle-speed
+ #:particle-direction
#:make-particle
#:particle-x
#:particle-y
@@ -106,6 +109,7 @@
#:cl
#:sketch
#:coding-math.quickutils
+ #:coding-math.particles
#:coding-math.utils
#:coding-math.math
#:coding-math.fps))
--- a/src/ballistics.lisp Fri Apr 22 23:13:31 2016 +0000
+++ b/src/ballistics.lisp Sat Apr 23 15:18:20 2016 +0000
@@ -7,41 +7,92 @@
(defparameter *center-x* (/ *width* 2))
(defparameter *center-y* (/ *height* 2))
+
+;;;; Drawing
(defun draw-gun (gun)
(in-context
- (translate (a gun 'x) (a gun 'y))
- (with-pen (make-pen :stroke (gray 0.0) :fill (gray 0.0))
- (circle 0 0 15)
- (rotate (degrees (a gun 'angle)))
- (rect 0 -4 25 8)
+ (translate (getf gun 'x) (getf gun 'y))
+ (with-pen (make-pen :stroke (gray 0.0))
+ (circle 0 0 25)
+ (rotate (degrees (getf gun 'angle)))
+ (rect 0 -8 40 16)
)))
+(defun draw-ball (ball)
+ (with-pen (make-pen :stroke (gray 0.1) :fill (gray 0.6))
+ (circle (particle-x ball) (particle-y ball) (particle-radius ball))))
+
+
+;;;; Game
(defun aim (gun x y)
- (setf (cdr (assoc 'angle gun))
+ (setf (getf gun 'angle)
(clamp (- (/ tau 4))
-0.3
- (atan (- y (a gun 'y))
- (- x (a gun 'x))))))
+ (atan (- y (getf gun 'y))
+ (- x (getf gun 'x))))))
+
+(defun shoot (game)
+ (force-output)
+ (with-slots (gun cannonball can-shoot-p firedp) game
+ (let ((angle (getf gun 'angle)))
+ (setf
+ can-shoot-p nil
+ firedp t
+ (particle-x cannonball) (+ (getf gun 'x) (* 40 (cos angle)))
+ (particle-y cannonball) (+ (getf gun 'y) (* 40 (sin angle)))
+ (particle-speed cannonball) 10
+ (particle-direction cannonball) angle))))
+
+(defun update-ball (game)
+ (with-slots (cannonball firedp can-shoot-p) game
+ (particle-update! cannonball)
+ (when (> (- (particle-y cannonball)
+ (particle-radius cannonball))
+ *height*)
+ (setf can-shoot-p t
+ firedp nil))))
(defsketch game (:width *width*
:height *height*
:debug :scancode-d)
- ((frame 1)
- (aiming nil)
- (gun `((x . 40)
- (y . ,*height*)
- (angle . ,(- (/ tau 8))))))
+ ((frame)
+ (aiming)
+ (gun)
+ (cannonball)
+ (can-shoot-p)
+ (firedp)
+ )
(background (gray 1))
(incf frame)
;;
(draw-gun gun)
-
+ (draw-ball cannonball)
+ (when firedp
+ (update-ball sketch::sketch-window))
;;
(when (zerop (mod frame 20))
(calc-fps 20))
(draw-fps))
+(defun make-game ()
+ (make-sketch 'game
+ (frame 1)
+ (aiming nil)
+ (can-shoot-p t)
+ (firedp nil)
+ (gun `(x 40
+ y ,*height*
+ angle ,(- (/ tau 8))))
+ (cannonball (make-particle (getf gun 'x)
+ (getf gun 'y)
+ :speed 15
+ :direction (getf gun 'angle)
+ :radius 7
+ :gravity 0.2))))
+
+
+;;;; Mouse
(defmethod kit.sdl2:mousebutton-event
((game game) state timestamp button x y)
(declare (ignore timestamp x y))
@@ -56,5 +107,29 @@
(when (slot-value game 'aiming)
(aim (slot-value game 'gun) x y)))
+
+;;;; Keyboard
+(defun keydown (game scancode)
+ (declare (ignore game))
+ (scancode-case scancode
+ (:scancode-space
+ nil)))
+
+(defun keyup (game scancode)
+ (scancode-case scancode
+ (:scancode-space
+ (when (can-shoot-p game)
+ (shoot game)))))
+
+
+(defmethod kit.sdl2:keyboard-event ((instance game) state timestamp repeatp keysym)
+ (declare (ignore timestamp repeatp))
+ (cond
+ ((eql state :keyup) (keyup instance (sdl2:scancode-value keysym)))
+ ((eql state :keydown) (keydown instance (sdl2:scancode-value keysym)))
+ (t nil)))
+
+
+
;;;; Run
-; (defparameter *demo* (make-instance 'game))
+(defparameter *demo* (make-game))
--- a/src/main.lisp Fri Apr 22 23:13:31 2016 +0000
+++ b/src/main.lisp Sat Apr 23 15:18:20 2016 +0000
@@ -63,17 +63,6 @@
;;;; Keyboard
-(defmacro scancode-case (scancode-form &rest pairs)
- (let ((scancode (gensym "scancode")))
- `(let ((,scancode ,scancode-form))
- (cond
- ,@(mapcar (lambda (pair)
- (destructuring-bind (key-scancode &rest body) pair
- `((sdl2:scancode= ,scancode ,key-scancode)
- ,@body)))
- pairs)))))
-
-
(defun keydown (instance scancode)
(scancode-case scancode
(:scancode-space
@@ -87,9 +76,7 @@
(defun keyup (instance scancode)
(scancode-case scancode
(:scancode-space
- nil
- )
- ))
+ nil)))
(defmethod kit.sdl2:keyboard-event ((instance cm) state timestamp repeatp keysym)
--- a/src/particles.lisp Fri Apr 22 23:13:31 2016 +0000
+++ b/src/particles.lisp Sat Apr 23 15:18:20 2016 +0000
@@ -48,6 +48,12 @@
(defun particle-y (particle)
(vec-y (particle-pos particle)))
+(defun particle-speed (particle)
+ (vec-magnitude (particle-vel particle)))
+
+(defun particle-direction (particle)
+ (vec-direction (particle-vel particle)))
+
(defun particle-wrap! (particle width height)
(with-slots (radius) particle
(setf (particle-x particle)
@@ -66,6 +72,12 @@
(defun (setf particle-y) (new-value particle)
(setf (vec-y (particle-pos particle)) new-value))
+(defun (setf particle-speed) (new-value particle)
+ (setf (vec-magnitude (particle-vel particle)) new-value))
+
+(defun (setf particle-direction) (new-value particle)
+ (setf (vec-direction (particle-vel particle)) new-value))
+
(defun particle-update! (particle)
(with-accessors ((pos particle-pos)
--- a/src/utils.lisp Fri Apr 22 23:13:31 2016 +0000
+++ b/src/utils.lisp Sat Apr 23 15:18:20 2016 +0000
@@ -18,9 +18,6 @@
,store-expr)))
-(defun a (alist key) ; lol
- (cdr (assoc key alist)))
-
(defmacro in-context (&body body)
`(prog1
(push-matrix)
@@ -28,3 +25,22 @@
(pop-matrix)))
+(defmacro make-sketch (class &rest bindings)
+ `(let*
+ (,@(loop :for (k v) :in bindings
+ :collect (list k v)))
+ (make-instance
+ ,class
+ ,@(loop :for (k) :in bindings
+ :append (list (alexandria:make-keyword k) k)))))
+
+
+(defmacro scancode-case (scancode-form &rest pairs)
+ (with-gensyms (scancode)
+ `(let ((,scancode ,scancode-form))
+ (cond
+ ,@(mapcar (lambda (pair)
+ (destructuring-bind (key-scancode &rest body) pair
+ `((sdl2:scancode= ,scancode ,key-scancode)
+ ,@body)))
+ pairs)))))
--- a/src/vectors.lisp Fri Apr 22 23:13:31 2016 +0000
+++ b/src/vectors.lisp Sat Apr 23 15:18:20 2016 +0000
@@ -38,6 +38,9 @@
(setf y (* magnitude (sin angle)))))
angle)
+(defun (setf vec-direction) (angle vec)
+ (setf (vec-angle vec) angle))
+
(defun (setf vec-magnitude) (magnitude vec)
(let ((angle (vec-angle vec)))
(with-slots (x y) vec