GLSL plasma using Common Lisp

plasma.lisp

(ql:quickload :cffi)
(ql:quickload :cl-opengl)
(ql:quickload :cl-glfw3)

(defpackage #:plasma
  (:use #:cl #:glfw #:alexandria))

(in-package #:plasma)

(export '(run))

(defvar *width* nil)
(defvar *height* nil)

(defvar *shader-program* nil)
(defvar *vertex-shader* nil)
(defvar *fragment-shader* nil)

(def-key-callback quit-on-escape (window key scancode action mod-keys)
  (declare (ignore window scancode mod-keys))
  (when (and (eq key :escape) (eq action :press))
    (set-window-should-close)))

(defun make-shader (type source)
  (let ((shader-id (gl:create-shader type)))
    (gl:shader-source shader-id source)
    (gl:compile-shader shader-id)

    (let ((compile-error (gl:get-shader-info-log shader-id)))
      (if (equalp compile-error "")
          shader-id
          (error compile-error)))))

(defun make-program (vertex-shader fragment-shader)
  (let ((program (gl:create-program)))
    (gl:attach-shader program vertex-shader)
    (gl:attach-shader program fragment-shader)
    (gl:link-program program)

    (let ((link-error (gl:get-program-info-log program)))
      (if (equalp link-error "")
          program
          (error link-error)))))

(defun delete-shaders ()
  (if *shader-program*
      (progn
        (gl:delete-program *shader-program*)
        (setf *shader-program* nil)
        (gl:delete-shader *vertex-shader*)
        (setf *vertex-shader* nil)
        (gl:delete-shader *fragment-shader*)
        (setf *fragment-shader* nil))))

(defparameter +vertex-shader-source+ "
#version 330

uniform mat4 projection;
in vec4 position;
out vec2 texCoordV;

void main() {
    texCoordV = vec2(position.x, position.y);
    gl_Position = projection * position;
}
")

(defparameter +fragment-shader-source+ "
#version 330
#define PI 3.1415926535897932384626433832795

// Input our our time variable
uniform float u_time;
uniform float u_k;

in vec2 texCoordV;
out vec4 colorOut;

highp float rand(vec2 co)
{
    highp float a = 12.9898;
    highp float b = 78.233;
    highp float c = 43758.5453;
    highp float dt= dot(co.xy ,vec2(a,b));
    highp float sn= mod(dt,3.14);
    return fract(sin(sn) * c);
}

void main()
{
    float v = 0.0;
    vec2 c = texCoordV * u_k - u_k/2.0;
    v += sin((c.x+u_time));
    v += sin((c.y+u_time)/2.0);
    v += sin((c.x+c.y+u_time)/2.0);
    c += u_k/2.0 * vec2(sin(u_time/3.0), cos(u_time/2.0));
    v += sin(sqrt(c.x*c.x+c.y*c.y+1.0)+u_time);
    v = v/2.0;
    vec3 col = vec3(rand(c * u_time), sin(-PI*v), cos(PI*v));
    colorOut = vec4(col*.5 + .5, 1);
}
")

(defun setup-shaders ()
  (with-simple-restart
      (retry "Retry compiling shaders.")
    (let* ((vertex-shader (make-shader :vertex-shader +vertex-shader-source+))
           (fragment-shader (make-shader :fragment-shader +fragment-shader-source+))
           (program (make-program vertex-shader fragment-shader)))

      (setf *vertex-shader* vertex-shader)
      (setf *fragment-shader* fragment-shader)
      (setf *shader-program* program))))

(defvar *shader-time* 0.0)

(defun render ()
  (with-simple-restart
      (retry "Retry rendering")
    (if *shader-program*
        (let ((time-loc (gl:get-uniform-location *shader-program* "u_time"))
              (k-loc (gl:get-uniform-location *shader-program* "u_k")))
          (gl:program-uniformf *shader-program* time-loc (incf *shader-time* 0.1))
          ;; this is set here to allow for easy updates when running under slime
          (gl:program-uniformf *shader-program* k-loc 0.012)))

    (gl:clear :color-buffer)
    (gl:with-pushed-matrix
      (if *shader-program*
          (gl:use-program *shader-program*)
          (gl:color 1 0 1))

      (gl:rect 0 0 *width* *height*))))

(defun make-orthographic-projection (left right top bottom near far)
  (make-array 16
              :initial-contents
              (list (/ 2 (- right left))
                    0
                    0
                    0

                    0
                    (/ 2 (- top bottom))
                    0
                    0

                    0
                    0
                    (/ 2 (- far near))
                    0

                    (/ (- (+ right left)) (- right left))
                    (/ (- (+ top bottom)) (- top bottom))
                    (/ (- (+ far near)) (- far near))
                    1)))

(defun set-viewport (width height)
  (setf *width* width)
  (setf *height* height)
  (gl:viewport 0 0 width height)

  ;; create an orthographic projection with the same dimensions as the window
  (let ((projection-loc (gl:get-uniform-location *shader-program* "projection"))
        (projection-matrix (make-orthographic-projection 0 width 0 height -1 1)))
    ;; pass the projection in to the vertex shader
    (gl:program-uniform-matrix *shader-program* projection-loc 4 (vector projection-matrix) nil)))

(def-window-size-callback update-viewport (window w h)
  (declare (ignore window))
  (set-viewport w h)
  (render)
  (swap-buffers)
  (poll-events))

(defun run ()
  (with-init-window (:title "Plasma" :width 800 :height 600)
      (setf %gl:*gl-get-proc-address* #'get-proc-address)
      (set-key-callback 'quit-on-escape)
      (set-window-size-callback 'update-viewport)
      (gl:clear-color 0 0 0 0)
      (setup-shaders)
      (set-viewport 800 600)

      (loop until (window-should-close-p)
         do (render)
         do (swap-buffers)
         do (poll-events))

      (delete-shaders)))