Application 1: Ballistics: Episode 1
author |
Steve Losh <steve@stevelosh.com> |
date |
Mon, 18 Apr 2016 23:54:44 +0000 |
parents |
540972fdbaab |
children |
f45dc41717a9 |
(in-package #:coding-math)
(declaim (optimize (speed 0)
(safety 3)
(debug 3)))
;;;; Config
(defparameter *width* 600)
(defparameter *height* 400)
(defparameter *center-x* (/ *width* 2))
(defparameter *center-y* (/ *height* 2))
;;;; 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)))))
(declaim (inline draw-particle))
(defun draw-particle (particle)
(circle (particle-x particle)
(particle-y particle)
(particle-radius particle)))
(defsketch cm (:width *width*
:height *height*
:debug :scancode-d)
((mx 0)
(my 0)
(frame 1)
(rect-w 300)
(rect-h 200)
(rect-x (- *center-x* (/ 300 2)))
(rect-y (- *center-y* (/ 200 2)))
(cx 0)
(cy 0)
(cr 10)
(bounce -0.7))
(background (gray 1))
(incf frame)
;;
(with-pen (make-pen :stroke (gray 0.3) :fill (gray 0.8))
(rect (- rect-x cr)
(- rect-y cr)
(+ rect-w cr cr)
(+ rect-h cr cr)))
(with-pen (make-pen :stroke (gray 0) :fill (gray 0.5))
(circle cx cy cr))
;;
(when (zerop (mod frame 20))
(calc-fps 20))
(draw-fps))
;;;; 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)
;;
(setf cx (clamp rect-x
(+ rect-x rect-w)
x))
(setf cy (clamp rect-y
(+ rect-y rect-h)
y))
;;
))
;;;; 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
))
(defun keyup (instance scancode)
(scancode-case scancode
(:scancode-space
(setf (vec-magnitude (particle-vel (slot-value instance 'particle)))
(random-range 4.0 6.0)
(vec-angle (particle-vel (slot-value instance 'particle)))
(random tau)
)
)
))
(defmethod kit.sdl2:keyboard-event ((instance cm) 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 'cm))