particle.lisp

(ql:quickload :cffi)
(ql:quickload :alexandria)
(ql:quickload :trivial-main-thread)
(ql:quickload :cl-opengl)
(ql:quickload :cl-glu)
(ql:quickload :cl-glfw3)

(setf *random-state* (make-random-state t))

(defmacro += (src dst)
  `(setf ,src (+ ,src ,dst)))

(defstruct mouse
  (start-x 0)
  (start-y 0)
  (pushed nil)
  (weight 0.5))

(defstruct particle
  (life 1.0)
  (fade-speed 0.01)
  (x 0.0) (y 0.0) (z 0.0)
  (r 1.0) (g 1.0) (b 1.0) (a 1.0)
  (move-x 10) (move-y 10) (move-z 10)
  (xg 0) (yg -0.8) (zg 0))


(defparameter *keys-pressed* nil)
(defparameter *mouse* (make-mouse))
(defparameter *window-size* nil)

(defparameter *particles* nil)
(defparameter *angle-x* 0)
(defparameter *angle-y* 0)

(defun draw-particles ()
  (gl:enable :blend)
  (gl:point-size 4)
  (gl:begin :points)
  (loop for p across *particles*
        do (gl:color (/ (random 255) 255) (/ (random 255) 255) (/ (random 255) 255) (particle-life p))
        do (gl:vertex (particle-x p) (particle-y p) (particle-z p)))
  (gl:end)
  (gl:disable :blend)
  (gl:point-size 1))

(defun update-particle (p)
  (setf (particle-life p) (- (particle-life p) (particle-fade-speed p)))
  (if (<= (particle-life p) 0)
    (progn (setf (particle-life p) 1.0)
           (setf (particle-x p) 0)
           (setf (particle-y p) 0)
           (setf (particle-z p) 0)
           (setf (particle-fade-speed p) (+ (/ (random 99) 1000) 0.003))
           (setf (particle-move-x p) (* (- (random 50) 26.0) 10))
           (setf (particle-move-y p) (* (- (random 50) 25.0) 10))
           (setf (particle-move-z p) (* (- (random 50) 25.0) 10)))

    (let ((slow-down 10.0))
      (progn (+= (particle-x p)
                 (/ (particle-move-x p) (* 1000 slow-down)))
             (+= (particle-y p)
                 (/ (particle-move-y p) (* 1000 slow-down)))
             (+= (particle-z p)
                 (/ (particle-move-z p) (* 1000 slow-down)))
             (+= (particle-move-x p)
                 (particle-xg p))
             (+= (particle-move-y p)
                 (particle-yg p))
             (+= (particle-move-z p)
                 (particle-zg p))))))

(defun add-particle ()
  (let ((p (make-particle
             :fade-speed (+ (/ (random 99) 1000) 0.003)
             :move-x (* (- (random 50) 26.0) 10)
             :move-y (* (- (random 50) 25.0) 10)
             :move-z (* (- (random 50) 25.0) 10))))
    (vector-push-extend p *particles*)))

(defun set-viewport (width height)
  (gl:viewport 0 0 width height)
  (gl:matrix-mode :projection)
  (gl:load-identity)
  (glu:perspective 30.0 (/ 600 400) 1.0 100.0)
  (gl:matrix-mode :modelview))

(defun draw-xyz ()
  (gl:begin :lines)

  (gl:color 0 1 0)
  (gl:vertex -100 0)
  (gl:vertex 100 0)

  (gl:color 1 0 0)
  (gl:vertex 0 0)
  (gl:vertex 0 100)

  (gl:color 0 0 1)
  (gl:vertex 0 0 -100)
  (gl:vertex 0 0 100)

  (gl:end))

(glfw:def-key-callback key-callback (window key scancode action mod-keys)
  (declare (ignore scancode mod-keys))
  (when (and (eq key :escape) (eq action :press))
    (glfw:set-window-should-close))
  (if (eq action :press)
    (pushnew key *keys-pressed*))
  (if (eq action :release)
    (alexandria:deletef *keys-pressed* key)))

(glfw:def-mouse-button-callback mouse-callback (window button action mod-keys)
  (declare (ignore mod-keys))
  (if (eq action :press)
    (progn (if (eq button :left)
             (let ((pos (glfw:get-cursor-position window)))
               (setf (mouse-start-x *mouse*) (first pos))
               (setf (mouse-start-y *mouse*) (second pos)))
           (pushnew button (mouse-pushed *mouse*))))
    (alexandria:deletef (mouse-pushed *mouse*) button)))

(glfw:def-cursor-pos-callback cursor-callback (window x y)
  (if (not (find :left (mouse-pushed *mouse*)))
    (let ((xdir (- x (mouse-start-x *mouse*)))
          (ydir (- y (mouse-start-y *mouse*))))
      (+= *angle-x* (* ydir (mouse-weight *mouse*)))
      (+= *angle-y* (* xdir (mouse-weight *mouse*)))
      (setf (mouse-start-x *mouse*) x)
      (setf (mouse-start-y *mouse*) y))))

(glfw:def-window-size-callback update-viewport (window w h)
  (declare (ignore window))
  (set-viewport w h))

(defun initialize ()
  (setf %gl:*gl-get-proc-address* #'glfw:get-proc-address)
  (glfw:set-key-callback 'key-callback)
  (glfw:set-mouse-button-callback 'mouse-callback)
  (glfw:set-cursor-position-callback 'cursor-callback)
  (glfw:set-window-size-callback 'update-viewport)
  (gl:clear-color 0 0 0 0)
  (gl:blend-func :src-alpha :one-minus-src-alpha)
  (gl:enable :depth-test)
  (set-viewport 600 400)
  (setf *particles* (make-array 4096 :adjustable t :fill-pointer 0))
  (loop repeat 4096 do (add-particle)))

(defun render ()
  (gl:clear :color-buffer-bit :depth-buffer-bit)
  (gl:load-identity)
  (glu:look-at -6.0 7.0 8.0 0.0 0.0 0.0 0.0 1.0 0.0)
  (%gl:rotate-d *angle-x* 1 0 0)
  (%gl:rotate-d *angle-y* 0 1 0)
  (draw-xyz)
  (draw-particles))

(defun update ()
  (loop for p across *particles* do (update-particle p)))

(defun startup ()
  (trivial-main-thread:with-body-in-main-thread ()
    (glfw:with-init-window (:title "CL/GLFW3 Particle Test" :width 600 :height 400)
                           (initialize)
                           (loop until (glfw:window-should-close-p)
                                 do (render)
                                 do (update)
                                 do (glfw:swap-buffers)
                                 do (glfw:poll-events)))))

(startup)