textures.lisp

textures.lisp

(in-package :boxgl)

(defvar *vs-vanilla*
"#version 330 core
layout (location = 0) in vec3 aPos;
void main()
{
  gl_Position = vec4(aPos.x, aPos.y, aPos.z, 1.0);
}")

(defvar *fs-vanilla*
"#version 330 core
out vec4 FragColor;
void main()
{
  FragColor = vec4(1.0f, 0.5f, 0.2f, 1.0f);
}")

(defvar *vs-textures-brickwall*
"#version 330 core
layout (location = 0) in vec3 aPos;
layout (location = 1) in vec3 aColor;
layout (location = 2) in vec2 aTexCoord;

out vec3 ourColor;
out vec2 TexCoord;

void main()
{
    gl_Position = vec4(aPos, 1.0);
    ourColor = aColor;
    TexCoord = vec2(aTexCoord.x, aTexCoord.y);
}
")

(defvar *fs-textures-brickwall*
"#version 330 core
out vec4 FragColor;

in vec3 ourColor;
in vec2 TexCoord;

// texture sampler
uniform sampler2D texture1;
uniform sampler2D texture2;

void main()
{
    //FragColor = vec4(ourColor, 1.0f);
    // FragColor = texture(texture1, TexCoord);
    // Rainbow mixture
    //FragColor = texture(texture2, TexCoord) * vec4(ourColor, 1.0);

    // linearly interpolate between both textures (80% bricks, 20% smile)
    // Exercise 1 at the end is to flip the way the smail is looking (texture2)
    FragColor = mix(texture(texture1, TexCoord), texture(texture2, vec2(-1 * TexCoord.x, TexCoord.y)), 0.4);
}
")

(defvar *vertices-brickwall*
  ;; positions     colors       texture coords
  #( 0.5  0.5 0.0  1.0 0.0 0.0  1.0 1.0
     0.5 -0.5 0.0  0.0 1.0 0.0  1.0 0.0
    -0.5 -0.5 0.0  0.0 0.0 1.0  0.0 0.0
    -0.5  0.5 0.0  1.0 1.0 0.0  0.0 1.0))

;; From Trial
(defun infer-pixel-type (depth type)
  (ecase depth
    ((1 8) (ecase type
             (:signed :byte)
             (:unsigned :unsigned-byte)))
    (16 (ecase type
          (:signed :short)
          (:unsigned :unsigned-short)
          (:float :half-float)))
    (32 (ecase type
          (:signed :int)
          (:unsigned :unsigned-int)
          (:float :float)))))

(defmethod load-image (path (type (eql :png)) &key)
  (let ((png (pngload:load-file path :flatten T :flip-y T)))
    (values (pngload:data png)
            (pngload:width png)
            (pngload:height png)
            (infer-pixel-type (pngload:bit-depth png) :unsigned)
            (ecase (pngload:color-type png)
              (:greyscale :red)
              (:greyscale-alpha :rg)
              (:truecolour :rgb)
              (:truecolour-alpha :rgba)))))
;; End From Trial

(defun load-texture (&key (path "/Users/sgithens/Desktop/wall.png"))
  (multiple-value-bind (data width height pixel-type pixel-format)
                       (load-image path :png)
    (let ((arr (gl:alloc-gl-array :unsigned-char (length data))))
      (dotimes (i (length data))
        (setf (gl:glaref arr i) (aref data i)))
      arr
    )
  )
)


(defun brick-wall-texture-ex (&key
                                   (vs-source *vs-textures-brickwall*)
                                   (fs-source *fs-textures-brickwall*)
                                  ;  (vs-source *vs-vanilla*)
                                  ;  (fs-source *fs-vanilla*)
                                   (vertices  *vertices-brickwall*)
                                   )
  "The primary example in the Textures Chapter"
  (let* ((gl-frame (make-instance 'boxgl-frame))
         (gl-pane  (slot-value gl-frame 'gl-pane))
         (vs nil)
         (fs nil)
         (program nil)
         (infolog nil)

         (buffers nil)
         (vertex-buffer nil)
         (index-buffer nil)
         (vertex-array 0)

         (textures nil)
         (brick-texture nil)
         (smile-texture nil)

         (d1 nil)
         (d2 nil)
         (d3 nil)
         (d4 nil)
         (d5 nil)

         (stride nil))
    (capi:display gl-frame)

    (opengl:rendering-on (gl-pane)
      (setf vs (gl:create-shader :vertex-shader))
      (gl:shader-source vs vs-source)
      (gl:compile-shader vs)
      (setf infolog (gl:get-shader-info-log vs))

      (setf fs (gl:create-shader :fragment-shader))
      (gl:shader-source fs fs-source)
      (gl:compile-shader fs)
      (setf d1 (gl:get-shader-info-log fs))

      (setf program (gl:create-program))
      (gl:attach-shader program vs)
      (gl:attach-shader program fs)
      (gl:link-program program)

      (setf d2 (gl:get-program-info-log program))

      (setf buffers (gl:gen-buffers 2))
      (setf vertex-buffer (elt buffers 0))
      (setf index-buffer (elt buffers 1))

      ; (setf textures (gl:gen-textures 2))
      (setf brick-texture (gl:gen-texture));;(elt textures 0))
      (setf smile-texture (gl:gen-texture));;(elt textures 1))

      ;; Buffer the 4 vertices for the 2 triangled rectangle
      (gl:bind-buffer :array-buffer vertex-buffer)
      (let ((arr (gl:alloc-gl-array :float (length vertices)))
            ; (verts #( 0.5  0.5 0.0
            ;           0.5 -0.5 0.0
            ;          -0.5 -0.5 0.0
            ;          -0.5  0.5 0.0))
                     )
        (dotimes (i (length vertices))
          (setf (gl:glaref arr i) (aref vertices i)))
        (gl:buffer-data :array-buffer :static-draw arr)
        (gl:free-gl-array arr))
      (gl:bind-buffer :array-buffer 0)

      ;; Buffer the 2 sets of element indices to draw 2 triangles from the
      ;; above vertices
      (gl:bind-buffer :element-array-buffer index-buffer)
      (let ((arr (gl:alloc-gl-array :unsigned-short 6))
            (indexes #(0 1 3
                       1 2 3)))
        (dotimes (i (length indexes))
          (setf (gl:glaref arr i) (aref indexes i)))
        (gl:buffer-data :element-array-buffer :static-draw arr)
        (gl:free-gl-array arr))
      (gl:bind-buffer :element-array-buffer 0)

      ;; Setup the vertex array with the vertex buffer, vertex attributes, and index buffer
      ;; There are 3 vertex attributes now for vertice, color, and texture coordinate
      ;; The stride is 8 now, because each vertice in the vertex buffer has 8 elements,
      ;;   three for the vertex, three for the color, and two for texture
      (setf vertex-array (gl:gen-vertex-array))
      (gl:bind-vertex-array vertex-array)
      (gl:bind-buffer :array-buffer vertex-buffer)

      (setf stride (* 8 (cffi:foreign-type-size :float)))

      ;; location 0: vertex
      (gl:vertex-attrib-pointer 0 3 :float nil stride (cffi:null-pointer))
      (gl:enable-vertex-attrib-array 0)
      ;; location 1: color
      (gl:vertex-attrib-pointer 1 3 :float nil stride (* 3 (cffi:foreign-type-size :float)))
      (gl:enable-vertex-attrib-array 1)
      ;; location 2: texture
      (gl:vertex-attrib-pointer 2 2 :float nil stride (* 6 (cffi:foreign-type-size :float)))
      (gl:enable-vertex-attrib-array 2)

      (gl:bind-buffer :element-array-buffer index-buffer)
      (gl:bind-vertex-array 0) ;; We're done, unbind it until we want it again

      ;; Set up the texture
      ;; brick texture
      (gl:bind-texture :texture-2d brick-texture)
      (gl:tex-parameter :texture-2d :texture-wrap-s :repeat)
      (gl:tex-parameter :texture-2d :texture-wrap-t :repeat)
      (gl:tex-parameter :texture-2d :texture-min-filter :linear)
      (gl:tex-parameter :texture-2d :texture-mag-filter :linear)
      (gl:tex-image-2d :texture-2d 0 :rgba 512 512 0 :rgba :unsigned-byte
        (gl::gl-array-pointer (load-texture)))
      (gl:generate-mipmap :texture-2d)

      ;; smile texture
      (gl:bind-texture :texture-2d smile-texture)
      (gl:tex-parameter :texture-2d :texture-wrap-s :repeat)
      (gl:tex-parameter :texture-2d :texture-wrap-t :repeat)
      (gl:tex-parameter :texture-2d :texture-min-filter :linear)
      (gl:tex-parameter :texture-2d :texture-mag-filter :linear)
      (gl:tex-image-2d :texture-2d 0 :rgba 512 512 0 :rgba :unsigned-byte
        (gl::gl-array-pointer (load-texture :path "/Users/sgithens/Desktop/awesomeface.png")))
      (gl:generate-mipmap :texture-2d)

      (gl:use-program program)
      (gl:uniformi (gl:get-uniform-location program "texture1") brick-texture)
      (gl:uniformi (gl:get-uniform-location program "texture2") smile-texture)

      (gl:clear-color 0.2 0.3 0.3 1.0)
      (gl:clear :color-buffer-bit :depth-buffer-bit)

      (gl:active-texture :texture1)
      (gl:bind-texture :texture-2d brick-texture)
      (gl:active-texture :texture2)
      (gl:bind-texture :texture-2d smile-texture)


      (gl:bind-vertex-array vertex-array)
      ; (gl:polygon-mode :front-and-back :line)
      (gl:draw-elements :triangles (gl:make-null-gl-array :unsigned-short) :count 6)
    )

    (print "Infolog")
    (print infolog)
    (print "D1")
    (print d1)
    (print "D2")
    (print d2)
    (print "huh...239")
    (opengl:swap-buffers gl-pane)
    gl-pane
  )
)