--- a/coding-math.asd Mon Apr 18 22:58:22 2016 +0000
+++ b/coding-math.asd Mon Apr 18 23:54:44 2016 +0000
@@ -22,6 +22,7 @@
:serial t
:components ((:file "utils")
(:file "math")
+ (:file "fps")
(:file "vectors")
(:file "particles")
(:file "main")
--- a/package.lisp Mon Apr 18 22:58:22 2016 +0000
+++ b/package.lisp Mon Apr 18 23:54:44 2016 +0000
@@ -1,84 +1,106 @@
(defpackage #:coding-math.utils
- (:use #:cl #:coding-math.quickutils)
+ (:use
+ #:cl
+ #:sketch
+ #:coding-math.quickutils)
(:export
- #:mulf
- #:dividesp))
+ #:a
+ #:in-context
+ #:mulf
+ #:dividesp))
(defpackage #:coding-math.math
- (:use #:cl
- #:coding-math.quickutils
- #:coding-math.utils)
+ (:use
+ #:cl
+ #:coding-math.quickutils
+ #:coding-math.utils)
(:export
- #:tau
- #:random-range
- #:random-around
- #:norm
- #:lerp
- #:precise-lerp
- #:map-range
- #:clamp
- #:wrap-zero
- #:wrap-range
- #:outside-p))
+ #:tau
+ #:random-range
+ #:random-around
+ #:norm
+ #:lerp
+ #:precise-lerp
+ #:map-range
+ #:clamp
+ #:wrap-zero
+ #:wrap-range
+ #:outside-p))
(defpackage #:coding-math.vectors
- (:use #:cl
- #:coding-math.quickutils
- #:coding-math.utils)
+ (:use
+ #:cl
+ #: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.vectors
- #:coding-math.quickutils
- #:coding-math.utils)
+ (:use
+ #:cl
+ #:coding-math.vectors
+ #:coding-math.quickutils
+ #:coding-math.utils)
(:export
- #:particle
- #:particle-vel
- #:particle-pos
- #:particle-grv
- #:particle-radius
- #:particle-mass
- #: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
+ #: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)
+ (:export
+ #:calc-fps
+ #:draw-fps))
(defpackage #:coding-math
- (:use #:cl
- #:sketch
- #:coding-math.quickutils
- #:coding-math.utils
- #:coding-math.math
- #:coding-math.vectors
- #:coding-math.particles
- ))
+ (:use
+ #: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.utils))
+ (:use
+ #:cl
+ #:sketch
+ #:coding-math.quickutils
+ #:coding-math.utils
+ #:coding-math.math
+ #:coding-math.fps))
--- a/src/ballistics.lisp Mon Apr 18 22:58:22 2016 +0000
+++ b/src/ballistics.lisp Mon Apr 18 23:54:44 2016 +0000
@@ -1,1 +1,60 @@
(in-package #:coding-math.ballistics)
+
+;;;; Config
+(defparameter *width* 600)
+(defparameter *height* 400)
+
+(defparameter *center-x* (/ *width* 2))
+(defparameter *center-y* (/ *height* 2))
+
+(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)
+ )))
+
+(defun aim (gun x y)
+ (setf (cdr (assoc 'angle gun))
+ (clamp (- (/ tau 4))
+ -0.3
+ (atan (- y (a gun 'y))
+ (- x (a gun 'x))))))
+
+(defsketch game (:width *width*
+ :height *height*
+ :debug :scancode-d)
+ ((frame 1)
+ (aiming nil)
+ (gun `((x . 40)
+ (y . ,*height*)
+ (angle . ,(- (/ tau 8))))))
+ (background (gray 1))
+ (incf frame)
+ ;;
+ (draw-gun gun)
+
+ ;;
+ (when (zerop (mod frame 20))
+ (calc-fps 20))
+ (draw-fps))
+
+
+(defmethod kit.sdl2:mousebutton-event
+ ((game game) state timestamp button x y)
+ (declare (ignore timestamp x y))
+ (when (= 1 button)
+ (case state
+ (:mousebuttondown (setf (slot-value game 'aiming) t))
+ (:mousebuttonup (setf (slot-value game 'aiming) nil)))))
+
+(defmethod kit.sdl2:mousemotion-event
+ ((game game) timestamp button-mask x y xrel yrel)
+ (declare (ignore timestamp button-mask xrel yrel))
+ (when (slot-value game 'aiming)
+ (aim (slot-value game 'gun) x y)))
+
+;;;; Run
+; (defparameter *demo* (make-instance 'game))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/fps.lisp Mon Apr 18 23:54:44 2016 +0000
@@ -0,0 +1,21 @@
+(in-package #:coding-math.fps)
+
+;;;; FPS
+(defvar *last-draw* 0)
+(defvar *fps* 0.0)
+(defvar *mspf* 0.0)
+
+
+(defun calc-fps (frames)
+ (let* ((current-draw (get-internal-real-time))
+ (elapsed (float (/ (- current-draw *last-draw*)
+ internal-time-units-per-second))))
+ (setf *last-draw* current-draw)
+ (setf *mspf* (* 1000 (/ elapsed frames)))
+ (setf *fps* (* frames (/ 1 elapsed)))))
+
+(defun draw-fps ()
+ (text (format nil "MSPF: ~,1F" *mspf*) 0 0)
+ (text (format nil "FPS: ~,1F" *fps*) 0 20))
+
+
--- a/src/main.lisp Mon Apr 18 22:58:22 2016 +0000
+++ b/src/main.lisp Mon Apr 18 23:54:44 2016 +0000
@@ -8,39 +8,10 @@
(defparameter *width* 600)
(defparameter *height* 400)
-(defparameter center-x (/ *width* 2))
-(defparameter center-y (/ *height* 2))
-
-
-;;;; FPS
-(defvar *last-draw*
- (get-internal-real-time))
-
-(defvar *fps* 0.0)
-(defvar *mspf* 0.0)
-
-
-(defun calc-fps (frames)
- (let* ((current-draw (get-internal-real-time))
- (elapsed (float (/ (- current-draw *last-draw*)
- internal-time-units-per-second))))
- (setf *last-draw* current-draw)
- (setf *mspf* (* 1000 (/ elapsed frames)))
- (setf *fps* (* frames (/ 1 elapsed)))))
-
-(defun draw-fps ()
- (text (format nil "MSPF: ~,1F" *mspf*) 0 0)
- (text (format nil "FPS: ~,1F" *fps*) 0 20))
-
+(defparameter *center-x* (/ *width* 2))
+(defparameter *center-y* (/ *height* 2))
;;;; Sketch
-(defmacro in-context (&rest body)
- `(prog1
- (push-matrix)
- (progn ,@body)
- (pop-matrix)))
-
-
(defun particle-oob-p (particle)
(let ((r (particle-radius particle)))
(or (outside-p (- 0 r)
@@ -66,8 +37,8 @@
(frame 1)
(rect-w 300)
(rect-h 200)
- (rect-x (- center-x (/ 300 2)))
- (rect-y (- center-y (/ 200 2)))
+ (rect-x (- *center-x* (/ 300 2)))
+ (rect-y (- *center-y* (/ 200 2)))
(cx 0)
(cy 0)
(cr 10)
--- a/src/utils.lisp Mon Apr 18 22:58:22 2016 +0000
+++ b/src/utils.lisp Mon Apr 18 23:54:44 2016 +0000
@@ -12,3 +12,14 @@
`(let* (,@(mapcar #'list temps exprs)
(,(car stores) (* ,n ,access-expr)))
,store-expr)))
+
+(defun a (alist key) ; lol
+ (cdr (assoc key alist)))
+
+(defmacro in-context (&body body)
+ `(prog1
+ (push-matrix)
+ (progn ,@body)
+ (pop-matrix)))
+
+