# HG changeset patch # User Steve Losh # Date 1479747507 0 # Node ID 11cac4bb8d4cafc0adf290aaf2c0bd13ae9b4d40 # Parent 8b67739b3eb8d1de04ae070dd22dba9328bc4521 Start porting the graphics to use VAOs/shaders diff -r 8b67739b3eb8 -r 11cac4bb8d4c src/gui.lisp --- a/src/gui.lisp Sat Nov 19 12:23:13 2016 +0000 +++ b/src/gui.lisp Mon Nov 21 16:58:27 2016 +0000 @@ -16,32 +16,163 @@ ;;;; OpenGL ------------------------------------------------------------------- +(defvar *vertex-shader-program* + (read-file-into-string "src/shaders/vertex.glsl")) + +(defvar *fragment-shader-program* + (read-file-into-string "src/shaders/fragment.glsl")) + + +(defmacro with-buffer ((buffer-handle) &body body) + `(prog1 + (gl:bind-buffer :array-buffer ,buffer-handle) + (progn ,@body) + (gl:bind-buffer :array-buffer 0))) + +(defmacro with-texture ((texture-handle) &body body) + `(prog1 + (gl:bind-texture :texture-2d ,texture-handle) + (progn ,@body) + (gl:bind-texture :texture-2d 0))) + +(defmacro with-vertex-array ((vertex-array-handle) &body body) + `(prog1 + (gl:bind-vertex-array ,vertex-array-handle) + (progn ,@body) + (gl:bind-vertex-array 0))) + + (defun initialize-texture (size) (let* ((handle (gl:gen-texture))) - (gl:bind-texture :texture-2d handle) + (with-texture (handle) + (gl:tex-image-2d :texture-2d 0 :luminance size size 0 :luminance + :unsigned-byte (cffi:null-pointer)) + (gl:tex-parameter :texture-2d :texture-min-filter :nearest) ; sharp pixels or gtfo + (gl:tex-parameter :texture-2d :texture-mag-filter :nearest) + (gl:enable :texture-2d)) + handle)) + +(defun initialize-buffer (data &key (gl-type :float)) + "Create and initialize an OpenGL buffer with `data` of type `gl-type`. - (gl:tex-image-2d :texture-2d 0 :luminance size size 0 :luminance - :unsigned-byte (cffi:null-pointer)) - (gl:tex-parameter :texture-2d :texture-min-filter :nearest) ; sharp pixels or gtfo - (gl:tex-parameter :texture-2d :texture-mag-filter :nearest) - (gl:enable :texture-2d) + Returns the GL handle to the buffer. - (gl:bind-texture :texture-2d 0) + " + (let ((handle (elt (gl:gen-buffers 1) 0))) ; create buffer + (with-buffer (handle) ; bind buffer + (let ((array (gl:alloc-gl-array gl-type ; create temp array + (length data)))) + (dotimes (i (length data)) ; fill array from the data + (setf (gl:glaref array i) (aref data i))) + (gl:buffer-data :array-buffer :static-draw array) ; copy array -> buffer + (gl:free-gl-array array))) ; done with array handle)) +(defun initialize-quad-buffers () + "Initialize index, position, and texture coordinate buffers for a quad." + ;; 0--3 + ;; |\ | + ;; |_\| + ;; 1 2 + (let ((index-buffer (initialize-buffer #(0 2 1 + 0 3 2) + :gl-type :unsigned-short)) + (position-buffer (initialize-buffer #(0.0 0.0 0.0 + 0.0 1.0 0.0 + 1.0 1.0 0.0 + 1.0 0.0 0.0))) + (texcoord-buffer (initialize-buffer #(0.0 0.0 0.0 + 0.0 0.5 0.0 + 1.0 0.5 0.0 + 1.0 0.0 0.0)))) + (values index-buffer position-buffer texcoord-buffer))) + +(defun initialize-vertex-array (index-buffer data-buffer position + &key (gl-type :float)) + (let ((vertex-array (gl:gen-vertex-array))) + (with-vertex-array (vertex-array) + (gl:bind-buffer :array-buffer data-buffer) + (gl:enable-vertex-attrib-array position) + (gl:vertex-attrib-pointer 0 3 gl-type nil 0 (cffi:null-pointer)) + (gl:bind-buffer :element-array-buffer index-buffer)) + vertex-array)) + + +(defun compile-shader (shader source) + (gl:shader-source shader source) + (gl:compile-shader shader)) + +(defun compile-shaders (&key + (vertex *vertex-shader-program*) + (fragment *fragment-shader-program*)) + "Compile the given shader sources into a shader program. + + Compilation errors will be printed. + + The result is suitable for giving to `gl:use-program`. + + " + (let ((vertex-shader (gl:create-shader :vertex-shader)) + (fragment-shader (gl:create-shader :fragment-shader))) + (compile-shader vertex-shader vertex) + (compile-shader fragment-shader fragment) + + ;; Print any errors + (format t "Vertex shader log:~%") + (print (gl:get-shader-info-log vertex-shader)) + + (format t "Fragment shader log:~%") + (print (gl:get-shader-info-log fragment-shader)) + + (let ((program (gl:create-program))) + (gl:attach-shader program vertex-shader) + (gl:attach-shader program fragment-shader) + (gl:link-program program) + (gl:use-program program) + (values program vertex-shader fragment-shader)))) + ;;;; Screen ------------------------------------------------------------------- (define-widget screen (QGLWidget) - ((texture :accessor screen-texture) - (debugger :accessor screen-debugger :initarg :debugger) - (chip :accessor screen-chip :initarg :chip))) + ((debugger :accessor screen-debugger :initarg :debugger) + (chip :accessor screen-chip :initarg :chip) + (index-buffer :accessor screen-index-buffer) + (position-buffer :accessor screen-position-buffer) + (texcoord-buffer :accessor screen-texcoord-buffer) + (position-array :accessor screen-position-array) + (texcoord-array :accessor screen-texcoord-array) + (fragment-shader :accessor screen-fragment-shader) + (vertex-shader :accessor screen-vertex-shader) + (shader-program :accessor screen-shader-program) + (texture :accessor screen-texture))) + +(define-widget unfucked-context (QGLContext) + ()) + +(define-override (unfucked-context choose-mac-visual) (handle) + (pr "Visual") + (stop-overriding)) + +(defmethod construct ((screen screen)) + (let ((gl-format (q+:make-qglformat))) + (setf (q+:version gl-format) (values 3 3) + (q+:profile gl-format) (q+:qglformat.core-profile) + (q+:sample-buffers gl-format) t) + (new screen (new unfucked-context gl-format)) + (pr (q+:major-version (q+:format screen))) + (pr (q+:minor-version (q+:format screen))) + (break) + (let ((glcontext (q+:context screen))) + (if (q+:is-valid glcontext) + (format t "Successfully created context ~A.~%" glcontext) + (format t "Failed to create context.~%"))))) + (defun make-screen (chip) - (let ((debugger (chip8.debugger::make-debugger chip))) - (make-instance 'screen - :debugger debugger - :chip chip))) + (make-instance 'screen + :debugger (chip8.debugger::make-debugger chip) + :chip chip)) (defun die (screen) @@ -49,15 +180,38 @@ (q+:close (screen-debugger screen)) (q+:close screen)) + (define-initializer (screen setup) (setf (q+:window-title screen) "cl-chip8" (q+:fixed-size screen) (values *width* *height*)) (q+:show debugger)) +(define-finalizer (screen teardown) + (gl:delete-shader vertex-shader) + (gl:delete-shader fragment-shader) + (gl:delete-program shader-program) + (gl:delete-buffers (list index-buffer + position-buffer + texcoord-buffer)) + (gl:delete-vertex-arrays (list position-array + texcoord-array))) + + (define-override (screen "initializeGL") () - (setf (screen-texture screen) (initialize-texture 64)) + (setf texture (initialize-texture 64)) + (multiple-value-bind (index position texcoord) (initialize-quad-buffers) + (setf index-buffer index + position-buffer position + texcoord-buffer texcoord)) + (multiple-value-bind (program vertex fragment) (compile-shaders) + (setf shader-program program + vertex-shader vertex + fragment-shader fragment)) + (setf position-array (initialize-vertex-array index-buffer position-buffer 0) + texcoord-array (initialize-vertex-array index-buffer texcoord-buffer 1)) (stop-overriding)) + (define-subwidget (screen timer) (q+:make-qtimer screen) (setf (q+:single-shot timer) NIL) (q+:start timer (round 1000 *fps*))) @@ -76,30 +230,31 @@ (gl:clear-color 0.0 0.0 0.0 1.0) (gl:clear :color-buffer-bit) - (gl:bind-texture :texture-2d (screen-texture screen)) + (gl:use-program (screen-shader-program screen)) + (gl:bind-vertex-array (screen-position-array screen)) + (gl:bind-vertex-array (screen-texcoord-array screen)) - (let ((chip (screen-chip screen))) - (when t ; (chip8::chip-video-dirty chip) - (setf (chip8::chip-video-dirty chip) nil) - (gl:tex-sub-image-2d :texture-2d 0 0 0 64 32 :luminance :unsigned-byte - (chip8::chip-video chip)))) + #+no (with-texture (screen-texture screen) + (let ((chip (screen-chip screen))) + (when t ; (chip8::chip-video-dirty chip) + (setf (chip8::chip-video-dirty chip) nil) + (gl:tex-sub-image-2d :texture-2d 0 0 0 64 32 :luminance :unsigned-byte + (chip8::chip-video chip)))) - (let ((tw 1) - (th 0.5)) - (gl:with-primitives :quads - (gl:tex-coord 0 0) - (gl:vertex 0 0) + (let ((tw 1) + (th 0.5)) + (gl:with-primitives :quads + (gl:tex-coord 0 0) + (gl:vertex 0 0) - (gl:tex-coord tw 0) - (gl:vertex *width* 0) + (gl:tex-coord tw 0) + (gl:vertex *width* 0) - (gl:tex-coord tw th) - (gl:vertex *width* *height*) + (gl:tex-coord tw th) + (gl:vertex *width* *height*) - (gl:tex-coord 0 th) - (gl:vertex 0 *height*))) - - (gl:bind-texture :texture-2d 0) + (gl:tex-coord 0 th) + (gl:vertex 0 *height*)))) (q+:end-native-painting painter)) diff -r 8b67739b3eb8 -r 11cac4bb8d4c src/shaders/fragment.glsl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/shaders/fragment.glsl Mon Nov 21 16:58:27 2016 +0000 @@ -0,0 +1,9 @@ +#version 330 + +out vec4 out_Color; +smooth in vec2 pos; +smooth in vec2 tex; + +void main() { + out_Color = vec4(1.0, 1.0, 1.0, 1.0); +} diff -r 8b67739b3eb8 -r 11cac4bb8d4c src/shaders/vertex.glsl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/shaders/vertex.glsl Mon Nov 21 16:58:27 2016 +0000 @@ -0,0 +1,13 @@ +#version 330 + +layout (location = 0) in vec3 in_position; +layout (location = 1) in vec3 in_texcoord; + +smooth out vec2 pos; +smooth out vec2 tex; + +void main() { + pos = in_position.xy * 30.0; + tex = in_texcoord.xy; + gl_Position = vec4(pos.xy, 0.0, 1.0); +} diff -r 8b67739b3eb8 -r 11cac4bb8d4c vendor/make-quickutils.lisp --- a/vendor/make-quickutils.lisp Sat Nov 19 12:23:13 2016 +0000 +++ b/vendor/make-quickutils.lisp Mon Nov 21 16:58:27 2016 +0000 @@ -12,6 +12,7 @@ :once-only :rcurry :read-file-into-byte-vector + :read-file-into-string :symb :with-gensyms diff -r 8b67739b3eb8 -r 11cac4bb8d4c vendor/quickutils.lisp --- a/vendor/quickutils.lisp Sat Nov 19 12:23:13 2016 +0000 +++ b/vendor/quickutils.lisp Mon Nov 21 16:58:27 2016 +0000 @@ -2,7 +2,7 @@ ;;;; See http://quickutil.org for details. ;;;; To regenerate: -;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :CURRY :ENSURE-BOOLEAN :ENSURE-GETHASH :ENSURE-LIST :ONCE-ONLY :RCURRY :READ-FILE-INTO-BYTE-VECTOR :SYMB :WITH-GENSYMS) :ensure-package T :package "CHIP8.QUICKUTILS") +;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :CURRY :ENSURE-BOOLEAN :ENSURE-GETHASH :ENSURE-LIST :ONCE-ONLY :RCURRY :READ-FILE-INTO-BYTE-VECTOR :READ-FILE-INTO-STRING :SYMB :WITH-GENSYMS) :ensure-package T :package "CHIP8.QUICKUTILS") (eval-when (:compile-toplevel :load-toplevel :execute) (unless (find-package "CHIP8.QUICKUTILS") @@ -18,8 +18,9 @@ :ENSURE-GETHASH :ENSURE-LIST :ONCE-ONLY :RCURRY :WITH-OPEN-FILE* :WITH-INPUT-FROM-FILE - :READ-FILE-INTO-BYTE-VECTOR :MKSTR - :SYMB :STRING-DESIGNATOR :WITH-GENSYMS)))) + :READ-FILE-INTO-BYTE-VECTOR + :READ-FILE-INTO-STRING :MKSTR :SYMB + :STRING-DESIGNATOR :WITH-GENSYMS)))) (eval-when (:compile-toplevel :load-toplevel :execute) (defun make-gensym-list (length &optional (x "G")) "Returns a list of `length` gensyms, each generated as if with a call to `make-gensym`, @@ -210,6 +211,22 @@ result)))) + (defun read-file-into-string (pathname &key (buffer-size 4096) external-format) + "Return the contents of the file denoted by `pathname` as a fresh string. + +The `external-format` parameter will be passed directly to `with-open-file` +unless it's `nil`, which means the system default." + (with-input-from-file + (file-stream pathname :external-format external-format) + (let ((*print-pretty* nil)) + (with-output-to-string (datum) + (let ((buffer (make-array buffer-size :element-type 'character))) + (loop + :for bytes-read = (read-sequence buffer file-stream) + :do (write-sequence buffer datum :start 0 :end bytes-read) + :while (= bytes-read buffer-size))))))) + + (defun mkstr (&rest args) "Receives any number of objects (string, symbol, keyword, char, number), extracts all printed representations, and concatenates them all into one string. @@ -272,7 +289,7 @@ (eval-when (:compile-toplevel :load-toplevel :execute) (export '(compose curry ensure-boolean ensure-gethash ensure-list once-only - rcurry read-file-into-byte-vector symb with-gensyms - with-unique-names))) + rcurry read-file-into-byte-vector read-file-into-string symb + with-gensyms with-unique-names))) ;;;; END OF quickutils.lisp ;;;;