--- 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))
--- /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);
+}
--- /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);
+}
--- 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
--- 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 ;;;;