(defparameter *test-shaders*
  (list (list :vertex-shader
              "#version 400
         layout (location=0) in vec4 position;
         layout (location=1) in vec4 color;
         out vec4 outcolor;
         void main (void) {
           gl_Position = position;
           outcolor = color;
         }")
        (list :fragment-shader
              "#version 400
       in vec4 outcolor;
      out vec4 finalColor;
      void main (void) {
       finalColor = outcolor;}")))

(defun make-gl-program (shaders &optional bindings)
  "Deletes shaders after linking.  If any shader compile fails, returns immediately with error log."
  (let* ((program (gl:create-program))
         (shaders (loop :for (type code) :in shaders
                        :collect
                        (when (member type '(:vertex-shader   :fragment-shader :tess-evaluation-shader
                                             :geometry-shader :compute-shader  :tess-control-shader))
                          (let ((shader (gl:create-shader type)))
                            (gl:shader-source shader (if (listp code)code (list code)))
                            (gl:compile-shader shader)
                            (unless (gl:get-shader shader :compile-status) ;returns T if compile was succesful
                              (return-from make-gl-program (gl:get-shader-info-log shader)))
                            (gl:attach-shader program shader)
                            shader)))))
    (when bindings
      (mapc (lambda (binding) (destructuring-bind (index name) binding
                                (gl:bind-attrib-location program index name)))
            bindings))
    (gl:link-program program)
    (mapcar #'gl:delete-shader shaders)
    program))

(defun fill-buffer (target usage array)
  (sb-sys:with-pinned-objects (array)
    (let* ((length (length array))
           (gl-array (gl::make-gl-array-from-pointer
                      (sb-sys:vector-sap array)
                      (typecase array
                        ((array (unsigned-byte 8)) :int8)
                        ((array (unsigned-byte 16)) :int16)
                        ((array single-float) :float)
                        ((array double-float) :double))
                      length)))
      (gl:buffer-data target usage gl-array)
      (setf (gl::gl-array-pointer gl-array) nil))));just to be on the safe side, eventually lisp will move that pointer

(defun gen-array (type &rest contents)
  (make-array (length contents) :element-type type :initial-contents contents))

(defun test ()
  (let ((program (make-gl-program *test-shaders*))
        (vertices (gen-array 'single-float
                             -0.8 -0.8 0.0 1.0
                              0.0  0.8 0.0 1.0
                              0.8 -0.8 0.0 1.0 ))
        (colours (gen-array 'single-float
                            1.0 0.0 0.0 1.0
                            0.0 1.0 0.0 1.0
                            0.0 0.0 1.0 1.0))
        (vao (gl:gen-vertex-array))
        (vertex-buffer (gl:gen-buffer))
        (colour-buffer (gl:gen-buffer)))
    
    (gl:bind-vertex-array vao)
    (gl:bind-buffer :array-buffer vertex-buffer)
    (fill-buffer :array-buffer :static-draw vertices)
    (gl:vertex-attrib-pointer 0 4 :float :false 0 0)
    (gl:enable-vertex-attrib-array 0)

    (gl:bind-buffer :array-buffer colour-buffer)
    (fill-buffer :array-buffer :static-draw colours)
    (gl:vertex-attrib-pointer 1 4 :float :false 0 0)
    (gl:enable-vertex-attrib-array 1)

    (gl:clear-color 0 0 0 0)
    (gl:clear :color-buffer-bit)
    (gl:use-program program)
    (gl:draw-arrays :triangles 0 3)
    (surface:update *s*)))