;;;; shader.lisp

(in-package #:wheelwork)

(defun shader-by-type (type)
  (case type
    (:vertex :vertex-shader)
    (:geometry :geometry-shader)
    (:fragment :fragment-shader)))

(defun gl-shader (type stage)
  (let ((shader (gl:create-shader type)))
    (gl:shader-source shader (varjo:glsl-code stage))
    (gl:compile-shader shader)
    (unless (gl:get-shader shader :compile-status)
      (error "failed to compile ~a shader:~%~a~%"
             type (gl:get-shader-info-log shader)))
    shader))

(defun create-shader (&rest sources)
  (let* ((stages
          (varjo:rolling-translate
           (mapcar (lambda (source)
                     (destructuring-bind (type inputs uniforms code) source
                       (varjo:make-stage type inputs uniforms '(:330) code)))
                   sources)))
         (shaders
          (loop
             :for stage :in stages
             :for source :in sources
             :collect (gl-shader (shader-by-type (car source))
                                 stage)))
         (program (gl:create-program)))
    (dolist (shader shaders) (gl:attach-shader program shader))
    (gl:link-program program)
    (unless (gl:get-program program :link-status)
      (error "failed to link program: ~%~a~%"
             (gl:get-program-info-log program)))
    (dolist (shader shaders)
      (gl:detach-shader program shader)
      (gl:delete-shader shader))
    program))