live coding result in Shibuya.lisp lispteatime #05: https://lisp.connpass.com/event/238911/

lispteatime-3d-cubes.lisp

;; (ql:quickload '(:alexandria :split-sequence :cl-opengl :cl-glfw3))

(defpackage :lispteatime-3d-cubes
  (:use :cl
        :alexandria)
  (:export :model
           :model-vertices
           :model-uv-mappings
           :model-texture
           :parse-obj
           :start-window))
(in-package :lispteatime-3d-cubes)

;;;; 3D model data
(defstruct model
  (vertices (vector) :type (vector float))
  (uvs (vector) :type (vector float))
  (triangle-vxs (vector) :type (vector float))
  (triangle-uvs (vector) :type (vector float))
  texture)

;;;;
;; .obj format parser
;;
;; to import model data from Blender-generated .obj file
(defun parse-obj (stream)
  (loop
    :with vertices := (make-array 0 :adjustable t :fill-pointer 0)
    :with uvs := (make-array 0 :adjustable t :fill-pointer 0)
    :with triangle-vertices := (make-array 0 :adjustable t :fill-pointer 0)
    :with triangle-uvs := (make-array 0 :adjustable t :fill-pointer 0)
    :for line := (read-line stream nil :eof)
    :until (eq line :eof)
    :do (cond ((starts-with-subseq "v " line)               ;; vertex info
               (with-input-from-string (in line)      
                 (read in)                                  ; discards "v "
                 (vector-push-extend (vector (read in)      ; x
                                             (read in)      ; y
                                             (read in))     ; z
                                     vertices)))
              ((starts-with-subseq "vt " line)              ;; texture mapping info
               (with-input-from-string (in line)       
                 (read in)                                  ; discards "vt "
                 (vector-push-extend (vector (read in)      ; u
                                             (read in))     ; v
                                     uvs)))
              ((starts-with-subseq "f " line)               ;; face info
               (with-input-from-string (in line) 
                 (read in)                                  ; discards "f "
                 (mapcar (lambda (v)
                           (let ((info (split-sequence:split-sequence #\/ v)))
                             (assert (= (length info) 3))
                             (let* ((idx (1- (read-from-string (elt info 0))))
                                    (v (aref vertices idx)))
                               (vector-push-extend (elt v 0) triangle-vertices)
                               (vector-push-extend (elt v 1) triangle-vertices)
                               (vector-push-extend (elt v 2) triangle-vertices))
                             (let* ((idx (1- (read-from-string (elt info 0))))
                                    (uv (aref uvs idx)))
                               (vector-push-extend (elt uv 0) triangle-uvs)
                               (vector-push-extend (elt uv 1) triangle-uvs))))
                         (split-sequence:split-sequence #\space (read-line in)))))
              (t nil))
    :finally (let ((model (make-model :vertices vertices
                                      :uvs uvs
                                      :triangle-vxs triangle-vertices
                                      :triangle-uvs triangle-uvs)))
               (return-from parse-obj model))))

;;;;
;; utilities for OpenGL

(defstruct array-buffer
  body length)

;; convert vector to OpenGL's array buffer
(defun make-array-buffer* (vec &optional (buffer (gl:gen-buffer)))
  (let ((arr (gl:alloc-gl-array :float (length vec))))
    (dotimes (i (length vec))
      (setf (gl:glaref arr i) (elt vec i)))
    (gl:bind-buffer :array-buffer buffer)
    (gl:buffer-data :array-buffer :static-draw arr)
    (gl:bind-buffer :array-buffer 0)
    (gl:free-gl-array arr)
    (make-array-buffer :body buffer :length (length vec))))

(defstruct vertex-array
  body length)

;; convert vector to OpenGL's vertex array
(defun make-vertex-array* (vec va &optional buffer)
  (let* ((buf (if buffer
                  buffer
                  (make-array-buffer* vec)))
         (va (if va va (gl:gen-vertex-array))))
    ;; prepare array buffer to transfer array data to GPU
    (gl:bind-buffer :array-buffer (array-buffer-body buf))
    (gl:enable-vertex-attrib-array (array-buffer-body buf))
    ;; convert array buffer to vertex array
    (gl:bind-vertex-array va)
    (gl:enable-vertex-attrib-array 0)
    (gl:vertex-attrib-pointer 0 3 :float nil 0 (cffi:null-pointer))
    ;; unbound buffer
    (gl:bind-buffer :array-buffer 0)
    (gl:bind-vertex-array 0)
    (make-vertex-array :body va :length (array-buffer-length buf))))

;;;;
;; display OpenGL graphics with GLFW (https://www.glfw.org)

(defstruct state
  frame-count
  cube-model
  cube-vertex
  cube-shader)

(defstruct app
  title width height
  state)

(defun setup ()
  (let* ((pathname "./cube.obj") ;; blenderで triangulateみたいなオプションをtrueにしてexport .objする
         (cube (with-open-file (in pathname)
                 (parse-obj in)))
         (state (make-state :cube-model cube
                            :frame-count 1)))
    (make-app :title "lispteatime #05: 3D Cube"
              :width 800 :height 600
              :state state)))

;; simply draw a white rect
(defun draw-rect (state)
  (declare (ignore state))
  (gl:color 1 1 1 1)
  (gl:rect -100 -100 100 100))

(defun setup-cube (state)
  (setf (state-cube-vertex state)
        (make-vertex-array* (model-triangle-vxs (state-cube-model state))
                            (gl:gen-vertex-array))))

;; simply draw a cube as white
(defun draw-cube (state)
  (let ((vert (state-cube-vertex state)))
    ;; prepare 
    (gl:bind-vertex-array (vertex-array-body vert))
    (gl:push-matrix)
    ;; move camera
    (gl:translate 0 0 0)
    (gl:scale 300 300 300)
    (gl:rotate (state-frame-count state) 0.8 0.8 0.1)
    ;; draw
    (gl:color 0 0.5 0 0.1)
    ;; (gl:draw-arrays :triangle-strip 0 (vertex-array-length vert))
    (gl:color 1 1 1 0.1)
    (loop
      :for n :from 0 :below (vertex-array-length vert)
      :do (gl:draw-arrays :line-loop (* n 3) 3))
    (gl:pop-matrix)))

(defun setup-gl (state)
  ;; for simple cube
  (gl:enable :depth-test :cull-face :blend)
  (setup-cube state)
)

(defun update (state)
  (incf (state-frame-count state)))

(defun draw (state)
  ;; clear buffers
  (gl:clear-color 0.1 0.2 0.1 1)
  (gl:clear :color-buffer-bit)
  (gl:clear :depth-buffer-bit)

;  (draw-rect state)
  (draw-cube state)
  )

(defun start-window ()
  (let* ((app (setup))
         (state (app-state app)))
    (glfw:with-init-window (:title (app-title app)
                            :width (app-width app)
                            :height (app-height app)
                            :resizable nil)
      ;; tells OpenGL to use this function to render screen
      ;; cf. https://github.com/AlexCharlton/cl-glfw3/blob/32c3f34d592d55ee7ce932ed85804c1a9c4158c6/examples/basic-window.lisp#L34
      (setf %gl:*gl-get-proc-address* #'glfw:get-proc-address)
      (setup-gl state)

      ;; set screen range
      (let ((w (app-width app))
            (h (app-height app)))
        (gl:viewport 0 0 w h)
        (gl:frustum (/ w 2 -1) (/ w 2) (/ h 2 -1) (/ h 2) 400 2000)
        (gl:translate 0 0 -800))

      ;; main loop
      (loop
        :until (glfw:window-should-close-p)
        :do (update state)
        :do (draw state)
        :do (glfw:swap-buffers)
        :do (glfw:poll-events)))))