LearnOpenGL.com - Hello rectangle

;;;; Tutorial 01: Hello OpenGL from - https://learnopengl.com/Getting-started/Hello-Triangle
;;;; Original C source: https://learnopengl.com/code_viewer_gh.php?code=src/1.getting_started/2.2.hello_triangle_indexed/hello_triangle_indexed.cpp

;;;; Usage; Recommend using quicklisp and create an ASD file that loads this.
;;;;          Dependencies: #:CL-opengl #:bt-semaphore #:Lispbuilder-sdl
(defpackage #:hello-rectangle
  (:use #:cl)
  (:export :main))

(in-package #:hello-rectangle)

(defparameter *fps* 60)
(defparameter *Width* 640)
(defparameter *height* 480)


(defparameter *vertex-shader-source* "
#version 330 core
layout (location = 0) in vec3 position;
void main(){
  gl_Position = vec4(position.x, position.y, position.z, 1.0);
}")

(defparameter *fragment-shader-source* "
#version 330 core
out vec4 color;
void main(){
  color = vec4(1.0f, 0.5f, 0.2f, 1.0f);
}")

(defparameter *verticies-data* #( 0.5  0.5 0.0  ; Top Right
                  0.5 -0.5 0.0  ; Bottom Right
                 -0.5 -0.5 0.0  ; Bottom Left
                 -0.5  0.5 0.0)); Top Left

(defparameter *indices-data* #(0 1 3   ; First Triangle
                1 2 3)) ; Second Triangle

(defparameter *verticies* nil)
(defparameter *indices* nil)
(defparameter *VBO* nil)
(defparameter *VAO* nil)
(defparameter *EBO* nil)

(defparameter *shader-program* nil)


(defun check-shader-error (shader)
"Check for shader compilation errors"
  (let ((success (cffi:foreign-alloc :int :initial-element 0)))
    (unwind-protect
     (progn
       (%gl:get-shader-iv shader :compile-status success)
       (unless (= (cffi:mem-aref success :int) 1)
         (error "OpenGL Shader Error:~%~a~%" (gl:get-shader-info-log shader)))
      (cffi:foreign-free success)))))


(defun check-program-error (program)
"Check for linking errors"
  (let ((success (cffi:foreign-alloc :int :initial-element 0)))
    (unwind-protect
     (progn
       (%gl:get-program-iv program :link-status success)
       (unless (= (cffi:mem-aref success :int) 1)
         (error "OpenGL Program Error:~%~a~%" (gl:get-program-info-log program))))
      (cffi:foreign-free success))))

(defun setup-program (vertex-Shader Fragment-Shader)
"link and attach the shader programs"
  (let ((program (gl:create-program)))
    (gl:attach-shader program vertex-shader)
    (gl:attach-shader program fragment-shader)
    (gl:link-program program)

    (check-program-error program)
    (setf *shader-program* program)))

(defun setup-shaders ()
"Build and compile the actual shaders"
  (let ((vertex-shader (gl:create-shader :vertex-shader))
    (fragment-shader (gl:create-shader :fragment-shader)))

    ;; Vertex shader
    (gl:shader-source vertex-shader *vertex-shader-source*)
    (gl:compile-shader vertex-shader)

    (check-shader-error vertex-shader)

    ;; Fragment shader
    (gl:shader-source fragment-shader *fragment-shader-source*)
    (gl:compile-shader fragment-shader)
    (check-shader-error fragment-shader)

    (setup-program vertex-shader fragment-shader)
    (gl:delete-shader vertex-shader)
    (gl:delete-shader fragment-shader)))

(defun setup-vertex-attributes ()
"Set up vertex data (and buffer(s)) and configure vertex attributes"
  (setf *VBO* (gl:gen-buffer))
  (setf *vao* (gl:gen-vertex-array))
  (setf *EBO* (gl:gen-buffer))


  ;; Convert CL arrays into an C arrays
  (setf *verticies*
    (loop :with gl-array = (gl:alloc-gl-array :float (length *verticies-data*))
          :for i :below (length *verticies-data*)
          :do (setf (gl:glaref gl-array i) (aref *verticies-data* i))
          :finally (return gl-array))

    *indices*
    (loop :with gl-array = (gl:alloc-gl-array :unsigned-int (length *indices-data*))
          :for i :below (length *indices-data*)
          :do (setf (gl:glaref gl-array i) (aref *indices-data* i))
          :finally (return gl-array)))


  (gl:bind-vertex-array *vao*)
  (gl:bind-buffer :array-buffer *vbo*)
  (gl:buffer-data :array-buffer :static-draw *verticies*)



  (gl:bind-buffer :element-array-buffer *ebo*)
  (gl:buffer-data :element-array-buffer :static-draw *indices*)

  (gl:vertex-attrib-pointer 0 3 :float nil (* 3 (cffi:foreign-type-size :float)) 0)
  (gl:enable-vertex-attrib-array 0)
  (gl:bind-buffer :array-buffer 0)
  (gl:bind-vertex-array 0))

(defun init-openGL ()
"Gets openGL ready"
  (gl:clear-color .2 .3 .3 1.0)
  ;;(gl:polygon-mode :front-and-back :line)

  (setup-shaders)
  (setup-vertex-attributes)
  )

(defun rendering ()
"Displays the actual rectangle"
  (gl:clear :color-buffer-bit)

  (gl:use-program *shader-program*)

  (gl:bind-vertex-array *vao*)
  (%gl:draw-elements :triangles 6 :unsigned-int 0)
  (gl:bind-vertex-array 0)

  (sdl:update-display))

(defun freeing-memory ()
"Clear allocated memory"
  (gl:free-gl-array *verticies*)
  (gl:free-gl-array *indices*)

  (gl:delete-vertex-arrays '(*vao*))
  (gl:delete-buffers '(*vbo* *ebo* ))

  (gl:delete-program *shader-program*))


(defun main (&aux (title "Hello Rectangle"))
  (bt:make-thread
    (lambda ()
      (sdl:with-init ()
        (unwind-protect ; ensures proper error handling in-case of crash
          (sdl:window *width* *height* :title-caption title :flags '(sdl:sdl-opengl)) ; Window creation with opengl rendering
          (setf (sdl:frame-rate) *fps*)
          (sdl:enable-key-repeat 100 1)

          (setf cl-opengl-bindings:*gl-get-proc-address* #'sdl-cffi::sdl-gl-get-proc-address) ; overwrite SDL's rendering with CL-opengl's.

          (init-openGL)

          (sdl:with-events ()
            (:quit-event () t)

            (:idle ()
            (rendering)))

          (freeing-memory)))) ;; Freeing the memory after program terminates
   :name title))