src/main.lisp @ 29b2d3f28208

(in-package #:coding-math)

;;;; Config
(defparameter *width* 600)
(defparameter *height* 400)

(defparameter *center-x* (/ *width* 2))
(defparameter *center-y* (/ *height* 2))


;;;; Sketch
(defun draw-particle (p pen)
  (with-pen pen
    (circle (particle-x p) (particle-y p) (particle-radius p))))

(defun draw-line (p1 p2)
  (with-vecs ((x1 y1) p1 (x2 y2) p2)
    (line x1 y1 x2 y2)))

(defun draw-circle (p radius)
  (circle (vec-x p) (vec-y p) radius))

(defun draw-square (p radius)
  (rect (- (vec-x p) radius)
        (- (vec-y p) radius)
        (* 2 radius)
        (* 2 radius)))

(defun draw-point (p)
  (point (vec-x p) (vec-y p)))

(defun oob-p (p &optional (r 0.0))
  (or (outsidep (- 0 r) (+ *width* r) (vec-x p))
      (outsidep (- 0 r) (+ *height* r) (vec-y p))))


(defsketch cm (:width *width*
               :height *height*
               :debug :scancode-d)
    ((ready)
     (mouse)
     (p0)
     (p1)
     (p2)
     (cp)
     (end-pen (make-pen :fill (gray 0.2)))
     (control-pen (make-pen :stroke (gray 0.1) :fill (gray 0.5)))
     (line-pen (make-pen :stroke (gray 0.5)))
     (target-pen (make-pen :fill (rgb 0.5 0.0 0.0)))
     (fn-pen (make-pen :stroke (rgb 0.0 0 0.5)
                       :weight 1
                       :curve-steps 80))
     (curve-pen (make-pen :stroke (rgb 0.5 0 0)
                          :weight 1
                          :curve-steps 60
                          :fill (rgb 0.5 0.0 0.0)))
     )
  (with-fps
    (background (gray 1))
    ;;
    (when ready

      (with-vecs ((p0x p0y) p0
                  (p1x p1y) mouse
                  (p2x p2y) p2)
        (setf cp (make-vec
                   (- (* p1x 2)
                      (/ (+ p0x p2x) 2))
                   (- (* p1y 2)
                      (/ (+ p0y p2y) 2))))
        (with-pen line-pen
          (draw-line p0 cp)
          (draw-line cp p2))
        (with-pen end-pen
          (draw-circle p0 5)
          (draw-circle p2 5))
        (with-pen target-pen
          (draw-circle mouse 5))
        (with-pen control-pen
          (draw-circle cp 5))
        (with-pen fn-pen
          (draw-function
            (lambda (v)
              (make-vec (map-range 0.0 tau 0.0 *width* v)
                        (+ *center-y* (* 100.0 (sin v)))))
            :start 0.0
            :end tau
            )
          )
        (with-pen curve-pen
          (quadratic-bezier-curve p0 p2 mouse)
          (quadratic-bezier-curve p0 p2 cp)
                
                ))
      )

    ;;
    ))

(defun make-cm ()
  (make-sketch 'cm
    (mouse (make-vec))))


(defun reset (game)
  (setf (slot-value game 'ready) nil)
  (setf
    (slot-value game 'p0)
    (make-random-vec *width* *height*)
    (slot-value game 'p1)
    (make-random-vec *width* *height*)
    (slot-value game 'p2)
    (make-random-vec *width* *height*)
    )
  (setf (slot-value game 'ready) t))


;;;; Mouse
(defmethod kit.sdl2:mousemotion-event ((window cm) ts b x y xrel yrel)
  (declare (ignore ts b xrel yrel))
  (with-slots (mouse) window
    (setf (vec-x mouse) x)
    (setf (vec-y mouse) y)
    ;;
    ;;
    ))


;;;; Keyboard
(defun keydown (instance scancode)
  (declare (ignorable instance))
  (scancode-case scancode
    (:scancode-space (reset instance))))

(defun keyup (instance scancode)
  (declare (ignorable instance))
  (scancode-case scancode
    (:scancode-space
     nil)))


(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-cm))