Permalink
Browse files

Fix a bunch of stupid mistakes and add some more GL keywords that wer…

…e missing from the checks.
  • Loading branch information...
Shinmera committed Mar 2, 2018
1 parent 8270b03 commit 2068586a15f20b792fa31f33c2ea471017d12d50
Showing with 60 additions and 44 deletions.
  1. +4 −4 controller.lisp
  2. +0 −1 pipelined-scene.lisp
  3. +45 −29 resources/texture.lisp
  4. +5 −4 toolkit.lisp
  5. +4 −4 trial.asd
  6. +2 −2 window.lisp
View
@@ -24,11 +24,11 @@
(key-press (one-of key :section :grave)))
;; FIXME
;; (define-asset (trial noto-sans) font
;; #p"noto-sans-regular.ttf")
(define-asset (trial noto-sans) font
#p"noto-sans-regular.ttf")
;; (define-asset (trial noto-mono) font
;; #p"noto-mono-regular.ttf")
(define-asset (trial noto-mono) font
#p"noto-mono-regular.ttf")
(define-subject controller ()
((display :initform NIL :accessor display)
View
@@ -19,7 +19,6 @@
(defmethod enter :after ((entity entity) (scene pipelined-scene))
(register-object-for-pass scene entity))
(defmethod leave :after ((entity entity) (scene pipelined-scene))
;; FIXME: A system for figuring out when we can GC shader programs
;; (deregister-object-for-pass scene entity)
View
@@ -30,7 +30,8 @@
:level 0
:samples 1
:internal-format :rgba
:pixel-type :unsigned-byte
:pixel-format NIL
:pixel-type NIL
:pixel-data NIL
:mag-filter :linear
:min-filter :linear-mipmap-linear
@@ -62,40 +63,55 @@
(check-texture-wrapping (second wrapping))
(check-texture-wrapping (third wrapping)))
(defmethod print-object ((texture texture) stream)
(print-unreadable-object (texture stream :type T :identity T)
(case (target texture)
(:texture-1d
(format stream "~a" (width texture)))
((:texture-2d :texture-1d-array :texture-cube-map :texture-2d-multisample)
(format stream "~ax~a" (width texture) (height texture)))
((:texture-3d :texture-2d-array :texture-2d-multisample-array)
(format stream "~ax~ax~a" (width texture) (height texture) (depth texture))))
(format stream " ~a" (internal-format texture))))
(defmethod destructor ((texture texture))
(let ((tex (gl-name texture)))
(lambda () (gl:delete-textures (list tex)))))
(defun allocate-texture-storage (texture)
(with-slots (target storage level internal-format width height depth samples pixel-format pixel-type pixel-data) texture
(case target
((:texture-1d)
(ecase storage
(:dynamic (%gl:tex-image-1d target level internal-format width 0 pixel-format pixel-type pixel-data))
(:static (%gl:tex-storage-1d target level internal-format width))))
((:texture-2d :texture-1d-array)
(ecase storage
(:dynamic (%gl:tex-image-2d target level internal-format width height 0 pixel-format pixel-type pixel-data))
(:static (%gl:tex-storage-2d target level internal-format width height))))
((:texture-cube-map)
(loop for target in '(:texture-cube-map-positive-x :texture-cube-map-negative-x
:texture-cube-map-positive-y :texture-cube-map-negative-y
:texture-cube-map-positive-z :texture-cube-map-negative-z)
for data in (if (consp pixel-data)
pixel-data
(let ((c (cons pixel-data NIL)))
(setf (cdr c) c)))
do (ecase storage
(:dynamic (%gl:tex-image-2d target level internal-format width height 0 pixel-format pixel-type data))
(:static (%gl:tex-storage-2d target level internal-format width height)))))
((:texture-3d :texture-2d-array)
(ecase storage
(:dynamic (%gl:tex-image-3d target level internal-format width height depth 0 pixel-format pixel-type pixel-data))
(:static (%gl:tex-storage-3d target level internal-format width height depth))))
((:texture-2d-multisample)
(%gl:tex-storage-2d-multisample target samples internal-format width height 1))
((:texture-2d-multisample-array)
(%gl:tex-storage-3d-multisample target samples internal-format width height depth 1)))))
(let ((internal-format (cffi:foreign-enum-value '%gl:enum internal-format))
(pixel-data (etypecase pixel-data
(cffi:foreign-pointer pixel-data)
(null (cffi:null-pointer)))))
(case target
((:texture-1d)
(ecase storage
(:dynamic (%gl:tex-image-1d target level internal-format width 0 pixel-format pixel-type pixel-data))
(:static (%gl:tex-storage-1d target level internal-format width))))
((:texture-2d :texture-1d-array)
(ecase storage
(:dynamic (%gl:tex-image-2d target level internal-format width height 0 pixel-format pixel-type pixel-data))
(:static (%gl:tex-storage-2d target level internal-format width height))))
((:texture-cube-map)
(loop for target in '(:texture-cube-map-positive-x :texture-cube-map-negative-x
:texture-cube-map-positive-y :texture-cube-map-negative-y
:texture-cube-map-positive-z :texture-cube-map-negative-z)
for data in (if (consp pixel-data)
pixel-data
(let ((c (cons pixel-data NIL)))
(setf (cdr c) c)))
do (ecase storage
(:dynamic (%gl:tex-image-2d target level internal-format width height 0 pixel-format pixel-type data))
(:static (%gl:tex-storage-2d target level internal-format width height)))))
((:texture-3d :texture-2d-array)
(ecase storage
(:dynamic (%gl:tex-image-3d target level internal-format width height depth 0 pixel-format pixel-type pixel-data))
(:static (%gl:tex-storage-3d target level internal-format width height depth))))
((:texture-2d-multisample)
(%gl:tex-storage-2d-multisample target samples internal-format width height 1))
((:texture-2d-multisample-array)
(%gl:tex-storage-3d-multisample target samples internal-format width height depth 1))))))
(defmethod allocate ((texture texture))
(with-slots (width height depth target level samples internal-format pixel-format pixel-type pixel-data mag-filter min-filter anisotropy wrapping storage)
View
@@ -419,7 +419,7 @@
(defmacro define-enum-check (name &body cases)
(let ((list (intern (format NIL "*~a-~a*" name '#:list)))
(func (intern (Format NIL "~a-~a" '#:check name))))
`(progn (defvar ,list '(,@cases))
`(progn (defparameter ,list '(,@cases))
(defun ,func (enum)
(unless (find enum ,list)
(error "~a is not a valid ~a. Needs to be one of the following:~%~a"
@@ -457,8 +457,8 @@
:rgba16 :rgba16f :rgba16i :rgba16ui
:rgba32f :rgba32i :rgba32ui
:srgb8 :srgb8-alpha8
:depth-component :depth-component-16 :depth-component-24
:depth-component-32 :depth-component-32f
:depth-component :depth-component16 :depth-component24 :depth-component32 :depth-component32f
:stencil-index :stencil-index1 :stencil-index4 :stencil-index8 :stencil-index16
:depth-stencil :depth24-stencil8 :depth32f-stencil8
:compressed-red :compressed-red-rgtc1 :compressed-signed-red-rgtc1
:compressed-rg :compressed-rg-rgtc2 :compressed-signed-rg-rgtc2
@@ -482,7 +482,8 @@
:unsigned-short-4-4-4-4 :unsigned-short-4-4-4-4-rev
:unsigned-short-5-5-5-1 :unsigned-short-1-5-5-5-rev
:unsigned-int-8-8-8-8 :unsigned-int-8-8-8-8-rev
:unsigned-int-10-10-10-2 :unsigned-int-2-10-10-10-rev)
:unsigned-int-10-10-10-2 :unsigned-int-2-10-10-10-rev
:unsigned-int-24-8 :float-32-unsigned-int-24-8-rev)
(define-enum-check shader-type
:compute-shader :vertex-shader
View
@@ -24,12 +24,12 @@
:homepage "https://github.com/Shirakumo/trial"
:components ((:file "package")
(:file "array-container" :depends-on ("package"))
(:file "asset" :depends-on ("package" "toolkit" "resource"))
(:file "asset" :depends-on ("package" "toolkit" "resource" "context"))
(:file "asset-pool" :depends-on ("package" "asset"))
(:file "attributes" :depends-on ("package"))
(:file "camera" :depends-on ("package" "subject" "helpers"))
(:file "context" :depends-on ("package"))
(:file "controller" :depends-on ("package" "mapping" "input" "subject" ("assets" "font")))
(:file "controller" :depends-on ("package" "mapping" "input" "subject" "asset" ("assets" "font")))
(:file "deploy" :depends-on ("package" "gamepad"))
(:file "display" :depends-on ("package" "context" "renderable"))
(:file "effects" :depends-on ("package" "shader-pass"))
@@ -42,10 +42,10 @@
(:file "geometry" :depends-on ("package" "toolkit" "static-vector" ("assets" "vertex-array")))
(:file "geometry-clipmap" :depends-on ("package" "geometry-shapes" "shader-subject"))
(:file "geometry-shapes" :depends-on ("package" "geometry" "asset-pool"))
(:file "helpers" :depends-on ("package" "entity" "transforms" "shader-subject" "shader-pass" "asset"))
(:file "helpers" :depends-on ("package" "entity" "transforms" "shader-subject" "shader-pass" "asset" "resources"))
(:file "input" :depends-on ("package" "event-loop" "retention"))
(:file "layer-set" :depends-on ("package"))
(:file "loader" :depends-on ("package" "scene" "asset"))
(:file "loader" :depends-on ("package" "scene" "resource"))
(:file "main" :depends-on ("package" "display" "toolkit" "scene" "pipeline" "window"))
(:file "mapping" :depends-on ("package" "event-loop" "toolkit"))
(:file "pipeline" :depends-on ("package" "event-loop" "toolkit"))
View
@@ -15,7 +15,7 @@
(when errorp (error "No window with name ~s found." name))))
(defun register-window (window)
(when (and (name window) (window name NIL))
(when (and (name window) (window (name window) NIL))
(cerror "Override the window." "There already is a window with name ~s." (name window)))
(push window *windows*)
window)
@@ -31,7 +31,7 @@
((name :initarg :name :accessor name))
(:default-initargs :name NIL))
(defmethod initialize-instance :before ((window window))
(defmethod initialize-instance :after ((window window) &key)
(register-window window))
(defmethod finalize ((window window))

0 comments on commit 2068586

Please sign in to comment.