Refactoring de camera

business-tycoon.asd

@@ -2,16 +2,22 @@
 
 (asdf:defsystem #:business-tycoon
   :description "Describe business-tycoon here"
-  :author "Your Name <your.name@example.com>"
-  :license  "Specify license here"
+  :author "Gabriel Pariat <gabriel@pariatech.com>"
+  :license  "AGPLv3"
   :version "0.0.1"
   :serial t
-  :depends-on (#:cl-glfw3 #:cl-opengl #:trivial-main-thread #:cffi #:png-read)
+  :depends-on (#:cl-glfw3
+	       #:cl-opengl
+	       #:trivial-main-thread
+	       #:cffi
+	       #:png-read
+	       #:mathkit
+	       #:sb-cga)
   :components ((:module "src"
 		:serial t
 		:components ((:file "package")
 			     (:file "shader")
-			     (:file "observable")
+			     (:file "texture")
 			     (:file "renderer")
 			     (:file "window")
 			     (:file "business-tycoon")))))

src/camera.lisp

@@ -0,0 +1,95 @@
+(defpackage #:camera
+  (:use #:cl)
+  (:import-from #:sb-cga #:vec #:normalize #:cross-product #:vec+ #:vec* #:vec-)
+  (:import-from #:kit.math #:deg-to-rad #:look-at)
+  (:export #:get-view-matrix
+	   #:move-left
+	   #:move-right
+	   #:move-backward
+	   #:move-forward
+	   #:process-mouse-movement
+	   #:process-mouse-scroll
+	   #:make-camera
+	   #:*zoom*))
+
+(in-package #:camera)
+
+(defparameter *position* nil)
+(defparameter *front* nil)
+(defparameter *up* nil)
+(defparameter *right* nil)
+(defparameter *world-up* nil)
+(defparameter *yaw* nil)
+(defparameter *pitch* nil)
+(defparameter *mouvement-speed* 2.5)
+(defparameter *mouse-sensitivity* 0.1)
+(defparameter *zoom* 45.0)
+
+(defun get-view-matrix ()
+  (look-at *position* (vec+ *position* *front*) *up*))
+
+(defun move-left (delta-time)
+  (setf *position*
+	(vec- *position*
+	      (vec* *right*
+		    (* *mouvement-speed*
+		       (coerce delta-time 'single-float))))))
+
+(defun move-right (delta-time)
+  (setf *position*
+	(vec+ *position*
+	      (vec* *right*
+		    (* *mouvement-speed*
+		       (coerce delta-time 'single-float))))))
+
+(defun move-backward (delta-time)
+  (setf *position*
+	(vec- *position*
+	      (vec* *front*
+		    (* *mouvement-speed*
+		       (coerce delta-time 'single-float))))))
+
+(defun move-forward (delta-time)
+  (setf *position*
+	(vec+ *position*
+	      (vec* *front*
+		    (* *mouvement-speed*
+		       (coerce delta-time 'single-float))))))
+
+(defun front-vector (yaw pitch)
+  (normalize (vec (coerce (* (cos (deg-to-rad yaw)) (cos (deg-to-rad pitch))) 'single-float)
+		  (coerce (sin (deg-to-rad pitch)) 'single-float)
+		  (coerce (* (sin (deg-to-rad yaw)) (cos (deg-to-rad pitch))) 'single-float))))
+
+(defun right-vector (front world-up)
+  (normalize (cross-product front world-up)))
+
+(defun up-vector (right front)
+  (normalize (cross-product right front)))
+
+(defun process-mouse-movement (xoffset yoffset &optional (constrain-pitch t))
+  (incf *yaw* (* xoffset *mouse-sensitivity*))
+  (setf *pitch* (let ((pitch (+ *pitch* (* yoffset *mouse-sensitivity*))))
+		  (if constrain-pitch (min (max pitch -89.0) 89.0) pitch)))
+  (setf *front* (front-vector *yaw* *pitch*))
+  (setf *right* (right-vector *front* *world-up*))
+  (setf *up* (up-vector *right* *front*)))
+
+(defmethod process-mouse-scroll (yoffset)
+  (setf *zoom* (max (min (- *zoom* yoffset) 45.0) 1.0)))
+
+(defun make-camera (&optional
+		      (position (vec 0.0 0.0 0.0))
+		      (world-up (vec 0.0 1.0 0.0))
+		      (yaw -90.0)
+		      (pitch 0.0))
+  (let* ((front (front-vector yaw pitch))
+	 (right (right-vector front world-up))
+	 (up (up-vector right front)))
+    (setf *position* position)
+    (setf *world-up* world-up)
+    (setf *yaw* yaw)
+    (setf *pitch* pitch)
+    (setf *front* front)
+    (setf *right* right)
+    (setf *up* up)))

src/renderer.lisp

@@ -1,54 +1,61 @@
 
 (in-package #:business-tycoon)
 
-(defparameter *vertex-shader-source* '("
-#version 330 core
-layout (location = 0) in vec3 aPos;
-layout (location = 1) in vec3 aColor;
-
-out vec3 ourColor;
-
-void main()
-{
-    gl_Position = vec4(aPos, 1.0);
-    ourColor = aColor;
-}
-"))
-
-(defparameter *fragment-shader-source* '("
-#version 330 core
-out vec4 FragColor;
-
-in vec3 ourColor;
-
-void main()
-{
-    FragColor = vec4(ourColor, 1.0);
-}
-"))
-
-
 (defparameter *vbo* 0)
 (defparameter *vao* 0)
 (defparameter *ebo* 0)
 (defparameter *shader-program* nil)
-(defparameter *texture* nil)
+(defparameter *texture1* nil)
+(defparameter *texture2* nil)
 
 (defun init-renderer ()
-  (setf *shader-program* (shader:load #p"src/shader.vert" #p"src/shader.frag"))
-  (setf *texture* (texture:load #p"textures/wall.png"))
+  (setf *shader-program* (shader:load #p"shaders/shader.vert" #p"shaders/shader.frag"))
+  (setf *texture1* (texture:load #p"textures/container.png"))
+  (setf *texture2* (texture:load #p"textures/awesomeface.png"))
   (setf *vbo* (gl:gen-buffer))
   (setf *ebo* (gl:gen-buffer))
   (setf *vao* (gl:gen-vertex-array))
   
+  (gl:enable :depth-test)
   (gl:bind-vertex-array *vao*)
   (gl:bind-buffer :array-buffer *vbo*)
   (gl:bind-buffer :element-array-buffer *ebo*)
- ;;                   positions       colors         texture coords
-  (let* ((vertices #( 0.5  0.5 0.0    1.0 0.0 0.0    1.0 1.0 ;; top right
-		      0.5 -0.5 0.0    0.0 1.0 0.0    1.0 0.0 ;; bottom right
-		     -0.5 -0.5 0.0    0.0 0.0 1.0    0.0 0.0 ;; bottom left
-		     -0.5  0.5 0.0    1.0 1.0 0.0    0.0 1.0 ;; top left
+ ;;                   positions       texture coords
+  (let* ((vertices #(-0.5 -0.5 -0.5    0.0 0.0
+		     +0.5 -0.5 -0.5    1.0 0.0
+		     +0.5 +0.5 -0.5    1.0 1.0
+		     -0.5 +0.5 -0.5    0.0 1.0
+		     -0.5 -0.5 -0.5    0.0 0.0
+
+		     -0.5 -0.5 +0.5    0.0 0.0
+		     +0.5 -0.5 +0.5    1.0 0.0
+		     +0.5 +0.5 +0.5    1.0 1.0
+		     -0.5 +0.5 +0.5    0.0 1.0
+		     -0.5 -0.5 +0.5    0.0 0.0
+
+		     -0.5 +0.5 +0.5    1.0 0.0
+		     -0.5 +0.5 -0.5    1.0 1.0
+		     -0.5 -0.5 -0.5    0.0 1.0
+		     -0.5 -0.5 +0.5    0.0 0.0
+		     -0.5 +0.5 +0.5    1.0 0.0
+
+		     +0.5 +0.5 +0.5    1.0 0.0
+		     +0.5 +0.5 -0.5    1.0 1.0
+		     +0.5 -0.5 -0.5    0.0 1.0
+		     +0.5 -0.5 +0.5    0.0 0.0
+		     +0.5 +0.5 +0.5    1.0 0.0
+
+		     -0.5 -0.5 -0.5    0.0 1.0
+		     +0.5 -0.5 -0.5    1.0 1.0
+		     +0.5 -0.5 +0.5    1.0 0.0
+		     -0.5 -0.5 +0.5    0.0 0.0
+		     -0.5 -0.5 -0.5    0.0 1.0
+
+		     -0.5 +0.5 -0.5    0.0 1.0
+		     +0.5 +0.5 -0.5    1.0 1.0
+		     +0.5 +0.5 +0.5    1.0 0.0
+		     -0.5 +0.5 +0.5    0.0 0.0
+		     -0.5 +0.5 -0.5    0.0 1.0
 		     ))
 	 (arr (gl:alloc-gl-array :float (length vertices))))
     (dotimes (i (length vertices))
@@ -56,8 +63,13 @@ void main()
     (gl:buffer-data :array-buffer :static-draw arr)
     (gl:free-gl-array arr))
   
-  (let* ((indices #(0 1 3
-		    1 2 3))
+  (let* ((indices #(0 1 2 2 3 4
+		    5 6 7 7 8 9
+		    10 11 12 12 13 14
+		    15 16 17 17 18 19
+		    20 21 22 22 23 24
+		    25 26 27 27 28 29
+		    30 31 32 32 33 34))
 	 (arr (gl:alloc-gl-array :int (length indices))))
     (dotimes (i (length indices))
       (setf (gl:glaref arr i) (aref indices i)))
@@ -65,17 +77,16 @@ void main()
     (gl:free-gl-array arr))
   
   (gl:vertex-attrib-pointer 0 3 :float nil
-			    (* 8 (cffi:foreign-type-size :float))
+			    (* 5 (cffi:foreign-type-size :float))
 			    (cffi:null-pointer))
   (gl:enable-vertex-attrib-array 0)
-  (gl:vertex-attrib-pointer 1 3 :float nil
-			    (* 8 (cffi:foreign-type-size :float))
+  (gl:vertex-attrib-pointer 1 2 :float nil
+			    (* 5 (cffi:foreign-type-size :float))
 			    (cffi:make-pointer (* 3 (cffi:foreign-type-size :float))))
   (gl:enable-vertex-attrib-array 1)
-  (gl:vertex-attrib-pointer 2 2 :float nil
-			    (* 8 (cffi:foreign-type-size :float))
-			    (cffi:make-pointer (* 6 (cffi:foreign-type-size :float))))
-  (gl:enable-vertex-attrib-array 2))
+  (shader:use *shader-program*)
+  (shader:set-int *shader-program* "texture1" 0)
+  (shader:set-int *shader-program* "texture2" 1))
 
 (defun enable-wireframe ()
  (gl:polygon-mode :front-and-back :line))
@@ -91,11 +102,44 @@ void main()
     (setf wireframe (not wireframe))))
 
 (defun render ()
-  (gl:clear :color-buffer)
+  (gl:clear :color-buffer :depth-buffer-bit)
+
   (shader:use *shader-program*)
-  (texture:bind *texture*)
+  (gl:active-texture :texture0)
+  (texture:bind *texture1*)
+  (gl:active-texture :texture1)
+  (texture:bind *texture2*)
   (gl:bind-vertex-array *vao*)
-  (gl:draw-elements :triangles (gl:make-null-gl-array :unsigned-int) :count 6)
+
+  (shader:set-mat4 *shader-program* "view" (camera:get-view-matrix) nil)
+  (shader:set-mat4 *shader-program*
+		   "projection"
+		   (kit.math:perspective-matrix (kit.math:deg-to-rad camera:*zoom*)
+						(apply #'/ (glfw:get-window-size))
+						0.1
+						100.0)
+		   nil)
+
+  (let ((cube-positions (list (sb-cga:vec 0.0 0.0 0.0)
+			      (sb-cga:vec 2.0 5.0 -15.0)
+			      (sb-cga:vec -1.5 -2.2 -2.5)
+			      (sb-cga:vec -3.8 -2.0 -12.3)
+			      (sb-cga:vec 2.4 -0.4 -3.5)
+			      (sb-cga:vec -1.7 3.0 -7.5)
+			      (sb-cga:vec 1.3 -2.0 -2.5)
+			      (sb-cga:vec 1.5 2.0 -2.5)
+			      (sb-cga:vec 1.5 0.2 -1.5)
+			      (sb-cga:vec -1.3 1.0 -1.5))))
+    (loop for position in cube-positions
+	  for i from 0
+	  do (let* ((translation (sb-cga:translate position))
+		    (angle (coerce (* i (kit.math:deg-to-rad 20.0)) 'single-float))
+		    (rotation (sb-cga:rotate-around (sb-cga:vec 0.5 1.0 0.0) angle))
+		    (model (sb-cga:matrix* translation rotation)))
+	       (shader:set-mat4 *shader-program* "model" model nil)
+	       (gl:draw-elements :triangles
+				 (gl:make-null-gl-array :unsigned-int)
+				 :count 36))))
   (gl:bind-vertex-array 0)
 
   (glfw:swap-buffers))

src/shader.frag

@@ -1,12 +0,0 @@
-#version 330 core
-out vec4 FragColor;
-
-in vec3 ourColor;
-in vec2 TexCoord;
-
-uniform sampler2D ourTexture;
-
-void main()
-{
-    FragColor = texture(ourTexture, TexCoord);
-}

src/shader.lisp

@@ -1,7 +1,7 @@
 (defpackage #:shader
   (:shadow #:load)
   (:use #:cl)
-  (:export #:load #:use #:set-bool #:set-int #:set-float))
+  (:export #:load #:use #:shader-program #:set-bool #:set-int #:set-float #:set-mat4))
 
 (in-package :shader)
 
@@ -45,3 +45,8 @@
 (define-set-uniform set-bool gl:uniformi)
 (define-set-uniform set-int gl:uniformi)
 (define-set-uniform set-float gl:uniformf)
+
+(defmethod set-mat4 ((self shader) name matrice &optional (transpose t))
+  (gl:uniform-matrix-4fv (gl:get-uniform-location (shader-program self) name)
+			 (vector matrice)
+			 transpose))

src/shader.vert

@@ -1,14 +0,0 @@
-#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 = aTexCoord;
-}

src/texture.lisp

@@ -13,10 +13,13 @@
 	 (image (png-read:read-png-file png-image-path))
 	 (image-data (png-read:image-data image))
 	 (image-dimensions (array-dimensions image-data))
-	 (data (loop for w below (first image-dimensions)
-		     nconc (loop for h below (second image-dimensions)
+	 (data (loop for h below (second image-dimensions)
+		     nconc (loop for w below (first image-dimensions)
 				 nconc (loop for c below (third image-dimensions)
-					     collect (aref image-data w h c)))))
+					     collect (aref image-data
+							   w
+							   (- (png-read:height image) h 1)
+							   c)))))
 	 (format (case (png-read:colour-type image)
 		   (:truecolor-alpha :rgba)
 		   (:truecolor :rgb))))
@@ -27,7 +30,7 @@
     (gl:tex-parameter :texture-2d :texture-mag-filter :linear)
     (gl:tex-image-2d :texture-2d
 		     0
-		     :rgba
+		     :rgb
 		     (png-read:width image)
 		     (png-read:height image)
 		     0

src/window.lisp

@@ -1,15 +1,7 @@
 (in-package #:business-tycoon)
 
-(defun set-viewport (width height)
-  (gl:viewport 0 0 width height)
-  (gl:matrix-mode :projection)
-  (gl:load-identity)
-  (gl:ortho -50 50 -50 50 -1 1)
-  (gl:matrix-mode :modelview)
-  (gl:load-identity))
-
-(defun get-key (key)
-  (glfw:get-key key))
+(defparameter *delta-time* 0)
+(defparameter *last-frame* 0)
 
 (defun close-window ()
   (glfw:set-window-should-close))
@@ -22,11 +14,29 @@
     (toggle-wireframe)))
 
 (glfw:def-mouse-button-callback mouse-button-callback (window button action mod-keys)
-    (declare (ignore window button action mod-keys)))
+  (declare (ignore window button action mod-keys)))
 
-(glfw:def-window-size-callback update-viewport (window w h)
+(let ((last-x 400) (last-y 300))
+  (glfw:def-cursor-pos-callback cursor-pos-callback (window x y)
+    (declare (ignore window))
+    (camera:process-mouse-movement (- x last-x) (- last-y y))
+    (setf last-x x)
+    (setf last-y y))
+
+  (glfw:def-cursor-enter-callback cursor-enter-callback (window enterp)
     (declare (ignore window))
-    (set-viewport w h))
+    (when enterp
+      (let ((cursor-position (glfw:get-cursor-position)))
+	(setf last-x (first cursor-position))
+	(setf last-y (second cursor-position))))))
+
+(glfw:def-scroll-callback scroll-callback (window x y)
+  (declare (ignore window x))
+  (camera:process-mouse-scroll y))
+
+(glfw:def-window-size-callback update-viewport (window w h)
+  (declare (ignore window))
+  (gl:viewport 0 0 w h))
 
 (defun open-window (&key (title "") (width 800) (height 600))
   ;; (tmt:with-body-in-main-thread ()
@@ -41,10 +51,22 @@
       (glfw:set-key-callback 'key-callback)
       (glfw:set-mouse-button-callback 'mouse-button-callback)
       (glfw:set-window-size-callback 'update-viewport)
+      (glfw:set-cursor-enter-callback 'cursor-enter-callback)
+      (glfw:set-cursor-position-callback 'cursor-pos-callback)
+      (glfw:set-scroll-callback 'scroll-callback)
+      (glfw:set-input-mode :cursor :disabled)
       (gl:clear-color 0 0 0 0)
-      (set-viewport width height)
+      (gl:viewport 0 0 width height)
+      (camera:make-camera)
       (init-renderer)
       (loop until (glfw:window-should-close-p)
-	    do (render)
-	    do (glfw:poll-events))))
+	    do (let ((current-frame (glfw:get-time)))
+		 (setf *delta-time* (- current-frame *last-frame*))
+		 (setf *last-frame* current-frame)
+		 (when (eq (glfw:get-key :w) :press) (camera:move-forward *delta-time*))
+		 (when (eq (glfw:get-key :s) :press) (camera:move-backward *delta-time*))
+		 (when (eq (glfw:get-key :a) :press) (camera:move-left *delta-time*))
+		 (when (eq (glfw:get-key :d) :press) (camera:move-right *delta-time*))
+		 (render)
+		 (glfw:poll-events)))))
 ;; )