render system aaaaa
This commit is contained in:
parent
11e0f2f0df
commit
ab434ea3c2
GPG Key ID:
5BEBEEAB2C73D520
|
|
@ -47,9 +47,9 @@
|
||||||
,(m 2 0) ,(m 2 1) 0.0 ,(m 2 2))
|
,(m 2 0) ,(m 2 1) 0.0 ,(m 2 2))
|
||||||
)))
|
)))
|
||||||
|
|
||||||
(defvar *view-width* 384
|
(defvar *view-width* 512
|
||||||
"View-space width in pixels.")
|
"View-space width in pixels.")
|
||||||
(defvar *view-height* 256
|
(defvar *view-height* 384
|
||||||
"View-space height in pixels.")
|
"View-space height in pixels.")
|
||||||
(defvar *view-ppu* 64
|
(defvar *view-ppu* 64
|
||||||
"Pixels in view-space per unit in world-space.")
|
"Pixels in view-space per unit in world-space.")
|
||||||
|
|
@ -66,12 +66,16 @@
|
||||||
"Re-sort the *world-views* list by render pass."
|
"Re-sort the *world-views* list by render pass."
|
||||||
(sort *world-views* #'< :key (lambda (v) (o! (deref-pointer v) render-pass))))
|
(sort *world-views* #'< :key (lambda (v) (o! (deref-pointer v) render-pass))))
|
||||||
|
|
||||||
|
(declaim (special *projection*))
|
||||||
|
|
||||||
(let (render-target win-width win-height)
|
(let (render-target win-width win-height)
|
||||||
(defun render-system-init ()
|
(defun render-system-init ()
|
||||||
(setf win-width (* *view-width* *pixel-scale*)
|
(setf win-width (* *view-width* *pixel-scale*)
|
||||||
win-height (* *view-height* *pixel-scale*)
|
win-height (* *view-height* *pixel-scale*)
|
||||||
render-target (make-instance 'render-target :width *view-width* :height *view-height*))
|
render-target (make-instance 'render-target :width *view-width* :height *view-height*))
|
||||||
|
|
||||||
|
(load #p"wh-engine/render/shaders/basic-shaders.lisp")
|
||||||
|
|
||||||
;; change render target mode
|
;; change render target mode
|
||||||
(gl:bind-texture :texture-2d (o! render-target render-texture))
|
(gl:bind-texture :texture-2d (o! render-target render-texture))
|
||||||
(gl:tex-parameter :texture-2d :texture-min-filter :nearest)
|
(gl:tex-parameter :texture-2d :texture-min-filter :nearest)
|
||||||
|
|
|
||||||
|
|
@ -12,163 +12,150 @@
|
||||||
else if (consp form)
|
else if (consp form)
|
||||||
do (replace-xref-vars (cdr form) vars replace-fun)))
|
do (replace-xref-vars (cdr form) vars replace-fun)))
|
||||||
|
|
||||||
(defvar *vert-builtins* '((*vertex-id* . "gl_VertexID")
|
(defparameter *vert-builtins* '((*vertex-id* . "gl_VertexID")
|
||||||
(*instance-id* . "gl_InstanceID")
|
(*instance-id* . "gl_InstanceID")
|
||||||
(*draw-id* . "gl_DrawID")
|
(*draw-id* . "gl_DrawID")
|
||||||
(*base-vertex* . "gl_BaseVertex")
|
(*base-vertex* . "gl_BaseVertex")
|
||||||
(*base-instance* . "gl_BaseInstance")
|
(*base-instance* . "gl_BaseInstance")
|
||||||
;; out
|
;; out
|
||||||
(*position* . "gl_Position")
|
(*position* . "gl_Position")
|
||||||
(*point-size* . "gl_PointSize")
|
(*point-size* . "gl_PointSize")
|
||||||
(*clip-distance* . "gl_ClipDistance")))
|
(*clip-distance* . "gl_ClipDistance")))
|
||||||
|
|
||||||
(defvar *frag-builtins* '((*frag-coord* . "gl_FragCoord")
|
(defparameter *frag-builtins* '((*frag-coord* . "gl_FragCoord")
|
||||||
(*front-facing* . "gl_FrontFacing")
|
(*front-facing* . "gl_FrontFacing")
|
||||||
(*point-coord* . "gl_PointCoord")
|
(*point-coord* . "gl_PointCoord")
|
||||||
(*sample-id* . "gl_SampleID")
|
(*sample-id* . "gl_SampleID")
|
||||||
(*sample-position* . "gl_SamplePosition")
|
(*sample-position* . "gl_SamplePosition")
|
||||||
(*sample-mask-in* . "gl_SampleMaskIn")
|
(*sample-mask-in* . "gl_SampleMaskIn")
|
||||||
(*clip-distance* . "gl_ClipDistance")
|
(*clip-distance* . "gl_ClipDistance")
|
||||||
(*primitive-id* . "gl_PrimitiveID")
|
(*primitive-id* . "gl_PrimitiveID")
|
||||||
(*layer* . "gl_Layer")
|
(*layer* . "gl_Layer")
|
||||||
(*viewport-index* . "gl_ViewportIndex")
|
(*viewport-index* . "gl_ViewportIndex")
|
||||||
;; out
|
;; out
|
||||||
(*frag-depth* . "gl_FragDepth")
|
(*frag-depth* . "gl_FragDepth")
|
||||||
(*sample-mask* . "gl_SampleMask")))
|
(*sample-mask* . "gl_SampleMask")))
|
||||||
|
|
||||||
(defvar *infix-ops* '((+ "+" t)
|
(defparameter *infix-ops* '((+ "+" t)
|
||||||
(- "-" t)
|
(- "-" T)
|
||||||
(* "*" t)
|
(* "*" t)
|
||||||
(/ "/" t)
|
(/ "/" t)
|
||||||
(mod "%" t)
|
(mod "%" t)
|
||||||
(= "==" t)
|
(= "==" t)
|
||||||
(eq "==" nil)
|
(eq "==" nil)
|
||||||
(eql "==" nil)
|
(eql "==" nil)
|
||||||
(equal "==" nil)
|
(equal "==" nil)
|
||||||
(/= "!=" nil)
|
(/= "!=" nil)
|
||||||
(< "<" t)
|
(< "<" t)
|
||||||
(> ">" t)
|
(> ">" t)
|
||||||
(<= "<=" t)
|
(<= "<=" t)
|
||||||
(>= ">=" t)
|
(>= ">=" t)
|
||||||
(<< "<<" nil)
|
(<< "<<" nil)
|
||||||
(>> ">>" nil)
|
(>> ">>" nil)
|
||||||
(ash "<<" nil)
|
(ash "<<" nil)
|
||||||
(logand "&" t)
|
(logand "&" t)
|
||||||
(logior "|" t)
|
(logior "|" t)
|
||||||
(logxor "^" t)
|
(logxor "^" t)
|
||||||
(and "&&" t)
|
(and "&&" t)
|
||||||
(or "||" t)))
|
(or "||" t)))
|
||||||
|
|
||||||
(defvar *types* '((:void . "void")
|
(defparameter *types* '((:void . "void")
|
||||||
(:bool . "bool")
|
(:bool . "bool")
|
||||||
(:int . "int")
|
(:int . "int")
|
||||||
(:uint . "uint")
|
(:uint . "uint")
|
||||||
(:float . "float")
|
(:float . "float")
|
||||||
(:double . "double")
|
(:vec2 . "vec2")
|
||||||
(:vec2 . "vec2")
|
(:vec3 . "vec3")
|
||||||
(:vec3 . "vec3")
|
(:vec4 . "vec4")
|
||||||
(:vec4 . "vec4")
|
(:mat2 . "mat2")
|
||||||
(:double-vec2 . "dvec2")
|
(:mat3 . "mat3")
|
||||||
(:double-vec3 . "dvec3")
|
(:mat4 . "mat4")
|
||||||
(:double-vec4 . "dvec4")
|
(:sampler-1d . "sampler1D")
|
||||||
(:bool-vec2 . "bvec2")
|
(:depth-sampler-1d . "sampler1DShadow")
|
||||||
(:bool-vec3 . "bvec3")
|
(:array-sampler-1d . "sampler1DArray")
|
||||||
(:bool-vec4 . "bvec4")
|
(:depth-array-sampler-1d . "sampler1DArrayShadow")
|
||||||
(:int-vec2 . "ivec2")
|
(:sampler-2d . "sampler2D")
|
||||||
(:int-vec3 . "ivec3")
|
(:depth-sampler-2d . "sampler2DShadow")
|
||||||
(:int-vec4 . "ivec4")
|
(:array-sampler-2d . "sampler2DArray")
|
||||||
(:uint-vec2 . "uvec2")
|
(:depth-array-sampler-2d . "sampler2DArrayShadow")
|
||||||
(:uint-vec3 . "uvec3")
|
(:multisampler-2d . "sampler2DMS")
|
||||||
(:uint-vec4 . "uvec4")
|
(:array-multisampler-2d . "sampler2DMSArray")
|
||||||
(:mat2 . "mat2")
|
(:rect-sampler-2d . "sampler2DRect")
|
||||||
(:mat3 . "mat3")
|
(:depth-rect-sampler-2d . "sampler2DRectShadow")
|
||||||
(:mat4 . "mat4")
|
(:sampler-3d . "sampler3D")
|
||||||
(:sampler-1d . "sampler1D")
|
(:cube-sampler . "samplerCube")
|
||||||
(:depth-sampler-1d . "sampler1DShadow")
|
(:depth-cube-sampler . "samplerCubeShadow")
|
||||||
(:array-sampler-1d . "sampler1DArray")
|
(:array-cube-sampler . "samplerCubeArray")
|
||||||
(:depth-array-sampler-1d . "sampler1DArrayShadow")
|
(:depth-array-cube-sampler . "samplerCubeArrayShadow")
|
||||||
(:sampler-2d . "sampler2D")
|
(:buffer-sampler . "samplerBuffer")))
|
||||||
(:depth-sampler-2d . "sampler2DShadow")
|
|
||||||
(:array-sampler-2d . "sampler2DArray")
|
|
||||||
(:depth-array-sampler-2d . "sampler2DArrayShadow")
|
|
||||||
(:multisampler-2d . "sampler2DMS")
|
|
||||||
(:array-multisampler-2d . "sampler2DMSArray")
|
|
||||||
(:rect-sampler-2d . "sampler2DRect")
|
|
||||||
(:depth-rect-sampler-2d . "sampler2DRectShadow")
|
|
||||||
(:sampler-3d . "sampler3D")
|
|
||||||
(:cube-sampler . "samplerCube")
|
|
||||||
(:depth-cube-sampler . "samplerCubeShadow")
|
|
||||||
(:array-cube-sampler . "samplerCubeArray")
|
|
||||||
(:depth-array-cube-sampler . "samplerCubeArrayShadow")
|
|
||||||
(:buffer-sampler . "samplerBuffer")))
|
|
||||||
|
|
||||||
(defvar *shader-funs* '((bool . "bool")
|
(defparameter *shader-funs* '((bool . "bool")
|
||||||
(int . "int")
|
(int . "int")
|
||||||
(uint . "uint")
|
(uint . "uint")
|
||||||
(float . "float")
|
(float . "float")
|
||||||
(double . "double")
|
(double . "double")
|
||||||
(vec2 . "vec2")
|
(vec2 . "vec2")
|
||||||
(vec3 . "vec3")
|
(vec3 . "vec3")
|
||||||
(vec4 . "vec4")
|
(vec4 . "vec4")
|
||||||
(radians . "radians")
|
(radians . "radians")
|
||||||
(degrees . "degrees")
|
(degrees . "degrees")
|
||||||
(sin . "sin")
|
(sin . "sin")
|
||||||
(cos . "cos")
|
(cos . "cos")
|
||||||
(tan . "tan")
|
(tan . "tan")
|
||||||
(asin . "asin")
|
(asin . "asin")
|
||||||
(acos . "acos")
|
(acos . "acos")
|
||||||
(atan . "atan")
|
(atan . "atan")
|
||||||
(sinh . "sinh")
|
(sinh . "sinh")
|
||||||
(cosh . "cosh")
|
(cosh . "cosh")
|
||||||
(tanh . "tanh")
|
(tanh . "tanh")
|
||||||
(asinh . "asinh")
|
(asinh . "asinh")
|
||||||
(acosh . "acosh")
|
(acosh . "acosh")
|
||||||
(atanh . "atanh")
|
(atanh . "atanh")
|
||||||
(expt . "pow")
|
(expt . "pow")
|
||||||
(exp . "exp")
|
(exp . "exp")
|
||||||
(log . "log")
|
(log . "log")
|
||||||
(sqrt . "sqrt")
|
(sqrt . "sqrt")
|
||||||
(abs . "abs")
|
(abs . "abs")
|
||||||
(signum . "sign")
|
(signum . "sign")
|
||||||
(floor . "floor")
|
(floor . "floor")
|
||||||
(ffloor . "floor")
|
(ffloor . "floor")
|
||||||
(truncate . "trunc")
|
(truncate . "trunc")
|
||||||
(ftruncate . "trunc")
|
(ftruncate . "trunc")
|
||||||
(round . "round")
|
(round . "round")
|
||||||
(fround . "round")
|
(fround . "round")
|
||||||
(ceiling . "ceil")
|
(ceiling . "ceil")
|
||||||
(fceiling . "ceil")
|
(fceiling . "ceil")
|
||||||
(mod . "mod")
|
(mod . "mod")
|
||||||
(min . "min")
|
(min . "min")
|
||||||
(max . "max")
|
(max . "max")
|
||||||
(linear-blend . "mix")
|
(linear-blend . "mix")
|
||||||
(step . "step")
|
(step . "step")
|
||||||
(smooth-step . "smoothstep")
|
(smooth-step . "smoothstep")
|
||||||
(float-nan-p . "isnan")
|
(float-nan-p . "isnan")
|
||||||
(float-infinity-p . "isinf")
|
(float-infinity-p . "isinf")
|
||||||
(vlength . "length")
|
(vlength . "length")
|
||||||
(vdistance . "distance")
|
(vdistance . "distance")
|
||||||
(v. . "dot")
|
(v. . "dot")
|
||||||
(vc . "cross")
|
(vc . "cross")
|
||||||
(v2norm . "normalize")
|
(v2norm . "normalize")
|
||||||
(vforward . "faceforward")
|
(vforward . "faceforward")
|
||||||
(vreflect . "reflect")
|
(vreflect . "reflect")
|
||||||
(vrefract . "refract")
|
(vrefract . "refract")
|
||||||
(mtranspose . "transpose")
|
(mtranspose . "transpose")
|
||||||
(mdet . "determinant")
|
(mdet . "determinant")
|
||||||
(minv . "inverse")
|
(minv . "inverse")
|
||||||
(v< . "lessThan")
|
(v< . "lessThan")
|
||||||
(v<= . "lessThanEqual")
|
(v<= . "lessThanEqual")
|
||||||
(v> . "greaterThan")
|
(v> . "greaterThan")
|
||||||
(v>= . "greaterThanEqual")
|
(v>= . "greaterThanEqual")
|
||||||
(v= . "equal")
|
(v= . "equal")
|
||||||
(v/= . "notEqual")
|
(v/= . "notEqual")
|
||||||
(texture-size . "textureSize")
|
(texture-size . "textureSize")
|
||||||
(texture-lod . "textureQueryLod")
|
(texture-lod . "textureQueryLod")
|
||||||
(texture-levels . "textureQueryLevels")
|
(texture-levels . "textureQueryLevels")
|
||||||
(texture-samples . "textureSamples")
|
(texture-samples . "textureSamples")
|
||||||
(sample-texture . "texture")
|
(sample-texture . "texture")
|
||||||
(sample-texture-raw . "texelFetch")))
|
(sample-texture-raw . "texelFetch")))
|
||||||
|
|
||||||
(defun swizzlep (sym)
|
(defun swizzlep (sym)
|
||||||
(let ((sym-str (string-downcase (symbol-name sym))))
|
(let ((sym-str (string-downcase (symbol-name sym))))
|
||||||
|
|
@ -424,14 +411,15 @@
|
||||||
collect (apply #'conv-shader-io :uniform var))
|
collect (apply #'conv-shader-io :uniform var))
|
||||||
funs)))
|
funs)))
|
||||||
|
|
||||||
(defun transpile-shader (name &key
|
(defun transpile-shader
|
||||||
version
|
(name &key
|
||||||
((:in vert-inputs))
|
version
|
||||||
((:inter inter-vars))
|
((:in vert-inputs))
|
||||||
((:out frag-outputs))
|
((:inter inter-vars))
|
||||||
((:uniform uniform-vars))
|
((:out frag-outputs))
|
||||||
((:vert vert-body))
|
((:uniform uniform-vars))
|
||||||
((:frag frag-body)))
|
((:vert vert-body))
|
||||||
|
((:frag frag-body)))
|
||||||
"Translate Lisp shader code to GLSL."
|
"Translate Lisp shader code to GLSL."
|
||||||
;; create implicit inter vars
|
;; create implicit inter vars
|
||||||
(replace-xref-vars frag-body vert-inputs
|
(replace-xref-vars frag-body vert-inputs
|
||||||
|
|
@ -473,22 +461,236 @@
|
||||||
`(:vert ,vert-glsl :frag ,frag-glsl
|
`(:vert ,vert-glsl :frag ,frag-glsl
|
||||||
(:in ,vert-inputs :inter ,inter-vars :out ,frag-outputs :uniform ,uniform-vars
|
(:in ,vert-inputs :inter ,inter-vars :out ,frag-outputs :uniform ,uniform-vars
|
||||||
:version ,version :vert ,vert-body :frag ,frag-body))))
|
:version ,version :vert ,vert-body :frag ,frag-body))))
|
||||||
|
|
||||||
|
|
||||||
(defmacro define-shader (name (&key
|
;; Shader class
|
||||||
((:in (&rest vert-inputs)) ())
|
(defclass shader ()
|
||||||
((:inter (&rest inter-vars)) ())
|
((name :documentation "The symbol naming this shader."
|
||||||
((:out (&rest frag-outputs)) ())
|
:type symbol
|
||||||
((:uniform (&rest uniform-vars)) ()))
|
:initarg :name)
|
||||||
&key
|
(program :documentation "The GL program associated with this shader."
|
||||||
((:vert (&body vert-body)))
|
:type fixnum
|
||||||
((:frag (&body frag-body)))
|
:initarg :program)
|
||||||
version)
|
(vertex-array :documentation "The GL vertex array associated with this shader."
|
||||||
|
:type fixnum
|
||||||
|
:initarg :vertex-array)
|
||||||
|
(vertex-buffers :documentation "List of GL vertex buffers associated with this shader.
|
||||||
|
(handle gl-array stride current-idx)"
|
||||||
|
:type list
|
||||||
|
:initarg :vertex-buffers
|
||||||
|
:initform nil)
|
||||||
|
(vertex-props :documentation "Alist of vertex property metadata.
|
||||||
|
(name handle type buffer-idx offset)"
|
||||||
|
:type list
|
||||||
|
:initarg :vertex-props)
|
||||||
|
(uniform-props :documentation "Alist of uniform property metadata.
|
||||||
|
(name handle type)"
|
||||||
|
:type list
|
||||||
|
:initarg :uniform-props)
|
||||||
|
(num-vertices :documentation "Number of vertices waiting to be drawn."
|
||||||
|
:type fixnum
|
||||||
|
:initform 0)
|
||||||
|
(max-vertices :documentation "Maximum number of vertices that can be drawn at a time."
|
||||||
|
:type fixnum
|
||||||
|
:initarg :max-vertices
|
||||||
|
:initform 64)
|
||||||
|
(options :documentation "Shader options."
|
||||||
|
:type list
|
||||||
|
:initarg :options)
|
||||||
|
(mode :documentation "Shader mode. One of (:LINES :TRIANGLES :QUADS)"
|
||||||
|
:type (or symbol null)
|
||||||
|
:initform nil)
|
||||||
|
(transpilation :documentation "Raw transpilation data for shaders which have not been initialized yet."
|
||||||
|
:type (or list null)
|
||||||
|
:initarg :transpilation
|
||||||
|
:initform nil)))
|
||||||
|
|
||||||
|
(defun make-glsl-program (code-plist)
|
||||||
|
(let ((program (gl:create-program)))
|
||||||
|
(loop for (stage code) on code-plist by #'cddr
|
||||||
|
do (let ((s (gl:create-shader (ecase stage
|
||||||
|
(:vert :vertex-shader)
|
||||||
|
(:frag :fragment-shader)))))
|
||||||
|
(gl:shader-source s code)
|
||||||
|
(gl:compile-shader s)
|
||||||
|
(unless (gl:get-shader s :compile-status)
|
||||||
|
(error (gl:get-shader-info-log s)))
|
||||||
|
(gl:attach-shader program s)))
|
||||||
|
(gl:link-program program)
|
||||||
|
(unless (gl:get-program program :link-status)
|
||||||
|
(error (gl:get-program-info-log program)))
|
||||||
|
program))
|
||||||
|
|
||||||
|
(defun setup-vbo (type stride max-vertices props vbo-idx)
|
||||||
|
"Create and configure a GL vertex buffer.
|
||||||
|
Returns: (VBO ARR)"
|
||||||
|
(let* ((vbo (gl:gen-buffer))
|
||||||
|
(arr (gl:alloc-gl-array type (* stride max-vertices)))
|
||||||
|
(elt-size (gl::foreign-type-size (gl::gl-array-type arr))))
|
||||||
|
(gl:bind-buffer :array-buffer vbo)
|
||||||
|
(gl:buffer-data :array-buffer :dynamic-draw arr)
|
||||||
|
(loop for p in props
|
||||||
|
;; (name handle type vbo-idx offset)
|
||||||
|
when (eq (fourth p) type)
|
||||||
|
do (setf (fourth p) vbo-idx)
|
||||||
|
(gl:enable-vertex-attrib-array (second p))
|
||||||
|
(gl:vertex-attrib-pointer (second p)
|
||||||
|
(case (third p)
|
||||||
|
(:vec2 2)
|
||||||
|
(:vec3 3)
|
||||||
|
(:vec4 4)
|
||||||
|
(t 1))
|
||||||
|
type nil
|
||||||
|
(* elt-size stride) (* elt-size (fifth p))))
|
||||||
|
(gl:bind-buffer :array-buffer 0)
|
||||||
|
(values vbo arr)))
|
||||||
|
|
||||||
|
(defmethod ensure-initialized ((shader shader))
|
||||||
|
(when #[shader :slot transpilation]
|
||||||
|
(let ((code (butlast #[shader :slot transpilation]))
|
||||||
|
(vars (car (last #[shader :slot transpilation]))))
|
||||||
|
(setf #[shader :slot transpilation] nil)
|
||||||
|
(setf #[shader :slot program] (make-glsl-program code))
|
||||||
|
;; create VAO
|
||||||
|
(setf #[shader :slot vertex-array] (gl:gen-vertex-array))
|
||||||
|
(gl:bind-vertex-array #[shader :slot vertex-array])
|
||||||
|
;; create VBOs for vertex properties
|
||||||
|
(loop for (prop-name . prop-plist) in (getf vars :in)
|
||||||
|
for prop-type = (getf prop-plist :type)
|
||||||
|
for prop-loc = (or (getf prop-plist :location)
|
||||||
|
(gl:get-attrib-location #[shader :slot program] (conv-shader-var prop-name)))
|
||||||
|
with float-idx = 0 and int-idx = 0 and uint-idx = 0
|
||||||
|
|
||||||
|
if (member prop-type '(:float :vec2 :vec3 :vec4))
|
||||||
|
collect (list prop-name prop-loc prop-type :float float-idx) into props
|
||||||
|
and do (incf float-idx (1+ (position prop-type '(:float :vec2 :vec3 :vec4))))
|
||||||
|
else if (member prop-type '(:int :bool))
|
||||||
|
collect (list prop-name prop-loc prop-type :int int-idx) into props
|
||||||
|
and do (incf int-idx)
|
||||||
|
else
|
||||||
|
collect (list prop-name prop-loc prop-type :unsigned-int uint-idx) into props
|
||||||
|
and do (incf uint-idx)
|
||||||
|
|
||||||
|
finally
|
||||||
|
(setf #[shader :slot vertex-props] props)
|
||||||
|
(let ((vbo-idx 0))
|
||||||
|
(when (> float-idx 0)
|
||||||
|
(multiple-value-bind (vbo arr)
|
||||||
|
(setup-vbo :float float-idx #[shader :slot max-vertices] #[shader :slot vertex-props] vbo-idx)
|
||||||
|
(setf #[shader :slot vertex-buffers]
|
||||||
|
(nconc #[shader :slot vertex-buffers]
|
||||||
|
`((,vbo ,arr ,float-idx 0))))
|
||||||
|
(incf vbo-idx)))
|
||||||
|
(when (> int-idx 0)
|
||||||
|
(multiple-value-bind (vbo arr)
|
||||||
|
(setup-vbo :int int-idx #[shader :slot max-vertices] #[shader :slot vertex-props] vbo-idx)
|
||||||
|
(setf #[shader :slot vertex-buffers]
|
||||||
|
(nconc #[shader :slot vertex-buffers]
|
||||||
|
`((,vbo ,arr ,int-idx 0))))
|
||||||
|
(incf vbo-idx)))
|
||||||
|
(when (> uint-idx 0)
|
||||||
|
(multiple-value-bind (vbo arr)
|
||||||
|
(setup-vbo :unsigned-int uint-idx #[shader :slot max-vertices] #[shader :slot vertex-props] vbo-idx)
|
||||||
|
(setf #[shader :slot vertex-buffers]
|
||||||
|
(nconc #[shader :slot vertex-buffers]
|
||||||
|
`((,vbo ,arr ,uint-idx 0))))))))
|
||||||
|
(gl:bind-vertex-array 0)
|
||||||
|
;; uniform properties
|
||||||
|
(setf #[shader :slot uniform-props]
|
||||||
|
(loop for (prop-name . prop-plist) in (getf vars :uniform)
|
||||||
|
for prop-type = (getf prop-plist :type)
|
||||||
|
for prop-loc = (or (getf prop-plist :location)
|
||||||
|
(gl:get-attrib-location #[shader :slot program] (conv-shader-var prop-name)))
|
||||||
|
collect (list prop-name prop-loc prop-type)))
|
||||||
|
)))
|
||||||
|
|
||||||
|
(defmethod begin-draw ((shader shader) mode)
|
||||||
|
(setf #[shader :slot mode] mode))
|
||||||
|
|
||||||
|
(defmethod end-draw ((shader shader))
|
||||||
|
(when (> #[shader :slot num-vertices] 0)
|
||||||
|
#[shader (flush-vertices)])
|
||||||
|
(setf #[shader :slot mode] nil))
|
||||||
|
|
||||||
|
(defmethod uniform ((shader shader) name value)
|
||||||
|
(let ((prop (assoc name #[shader :slot uniform-props])))
|
||||||
|
(case (third prop)
|
||||||
|
(:float (gl:uniformfv (second prop) value))
|
||||||
|
((:int :uint :bool) (gl:uniformiv (second prop) value))
|
||||||
|
(:vec2 (gl:uniformf (second prop) (vx2 value) (vy2 value)))
|
||||||
|
(:vec3 (gl:uniformf (second prop) (vx3 value) (vy3 value) (vz3 value)))
|
||||||
|
(:vec4 (gl:uniformf (second prop) (vx4 value) (vy4 value) (vz4 value) (vw4 value)))
|
||||||
|
(:mat2 (gl:uniform-matrix-2fv (second prop) (vector (marr2 value))))
|
||||||
|
(:mat3 (gl:uniform-matrix-3fv (second prop) (vector (marr3 value))))
|
||||||
|
(:mat4 (gl:uniform-matrix-4fv (second prop) (vector (marr4 value)))))))
|
||||||
|
|
||||||
|
(defmethod vertex ((shader shader) &rest rest)
|
||||||
|
(declare (optimize (speed 3)))
|
||||||
|
;; apply values
|
||||||
|
(loop for (name value) on rest by #'cddr
|
||||||
|
for prop = (assoc name #[shader :slot vertex-props])
|
||||||
|
for type = (third prop)
|
||||||
|
for buf = (nth (fourth prop) #[shader :slot vertex-buffers])
|
||||||
|
for array = (second buf)
|
||||||
|
for idx = (+ (fourth buf) (fifth prop))
|
||||||
|
|
||||||
|
if (eq type :vec2)
|
||||||
|
do (setf (gl:glaref array idx) (vx2 value)
|
||||||
|
(gl:glaref array (+ idx 1)) (vy2 value))
|
||||||
|
else if (eq type :vec3)
|
||||||
|
do (setf (gl:glaref array idx) (vx3 value)
|
||||||
|
(gl:glaref array (+ idx 1)) (vy3 value)
|
||||||
|
(gl:glaref array (+ idx 2)) (vz3 value))
|
||||||
|
else if (eq type :vec4)
|
||||||
|
do (setf (gl:glaref array idx) (vx4 value)
|
||||||
|
(gl:glaref array (+ idx 1)) (vy4 value)
|
||||||
|
(gl:glaref array (+ idx 2)) (vz4 value)
|
||||||
|
(gl:glaref array (+ idx 3)) (vw4 value))
|
||||||
|
else if (eq type :bool)
|
||||||
|
do (setf (gl:glaref array idx) (if value 1 0))
|
||||||
|
else
|
||||||
|
do (setf (gl:glaref array idx) value))
|
||||||
|
;; increment counters
|
||||||
|
(loop for buf in #[shader :slot vertex-buffers]
|
||||||
|
do (incf (fourth buf) (third buf)))
|
||||||
|
(incf #[shader :slot num-vertices])
|
||||||
|
;; flush
|
||||||
|
(when (>= #[shader :slot num-vertices] #[shader :slot max-vertices])
|
||||||
|
#[shader (flush-vertices)]))
|
||||||
|
|
||||||
|
(defmethod flush-vertices ((shader shader))
|
||||||
|
(declare (optimize (speed 3)))
|
||||||
|
(gl:use-program #[shader :slot program])
|
||||||
|
(gl:bind-vertex-array #[shader :slot vertex-array])
|
||||||
|
(gl:draw-arrays #[shader :slot mode] 0 #[shader :slot num-vertices])
|
||||||
|
;; reset counters
|
||||||
|
(setf #[shader :slot num-vertices] 0)
|
||||||
|
(loop for buf in #[shader :slot vertex-buffers]
|
||||||
|
do (setf (fourth buf) 0)))
|
||||||
|
|
||||||
|
(defmacro define-shader
|
||||||
|
(name (&key
|
||||||
|
((:in (&rest vert-inputs)) ())
|
||||||
|
((:inter (&rest inter-vars)) ())
|
||||||
|
((:out (&rest frag-outputs)) ())
|
||||||
|
((:uniform (&rest uniform-vars)) ()))
|
||||||
|
&key
|
||||||
|
((:vert (&body vert-body)))
|
||||||
|
((:frag (&body frag-body)))
|
||||||
|
documentation
|
||||||
|
version
|
||||||
|
options)
|
||||||
"Define a GLSL shader with Lisp code."
|
"Define a GLSL shader with Lisp code."
|
||||||
`(defparameter ,name (transpile-shader ',name
|
`(defparameter ,name
|
||||||
:version ,version
|
(make-instance 'shader
|
||||||
:in ',vert-inputs
|
:name ',name
|
||||||
:inter ',inter-vars
|
:options ',options
|
||||||
:out ',frag-outputs
|
:transpilation
|
||||||
:uniform ',uniform-vars
|
(transpile-shader ',name
|
||||||
:vert ',vert-body :frag ',frag-body)))
|
:version ,version
|
||||||
|
:in ',vert-inputs
|
||||||
|
:inter ',inter-vars
|
||||||
|
:out ',frag-outputs
|
||||||
|
:uniform ',uniform-vars
|
||||||
|
:vert ',vert-body
|
||||||
|
:frag ',frag-body))
|
||||||
|
,documentation))
|
||||||
|
|
|
||||||
|
|
@ -1,26 +0,0 @@
|
||||||
;;;; basic-shader.lisp (Lisp shader code)
|
|
||||||
(in-package wh-engine/render)
|
|
||||||
|
|
||||||
(define-shader basic-shader
|
|
||||||
(:in ((vert-pos :type :vec3 :location 0)
|
|
||||||
(vert-uv :type :vec2 :location 1))
|
|
||||||
:out ((*frag-colour* :type :vec4))
|
|
||||||
:uniform ((model :type :mat4)
|
|
||||||
(view :type :mat4)
|
|
||||||
(proj :type :mat4)
|
|
||||||
(main-tex :type :sampler-2d)
|
|
||||||
(colour :type :vec4)))
|
|
||||||
:version 330
|
|
||||||
:vert ((setf *position* (* proj view model (vec4 vert-pos 1.0))))
|
|
||||||
:frag ((setf *frag-colour* (* (sample-texture main-tex vert-uv) colour))))
|
|
||||||
|
|
||||||
(define-shader render-target-blit-shader
|
|
||||||
(:in ((vert-pos :type :vec2 :location 0))
|
|
||||||
:out ((*frag-colour* :type :vec4)
|
|
||||||
(*frag-depth* :type :float))
|
|
||||||
:uniform ((main-tex :type :sampler-2d)
|
|
||||||
(depth-tex :type :depth-sampler-2d)))
|
|
||||||
:version 330
|
|
||||||
:vert ((setf *position* (vec4 vert-pos 0.0 1.0)))
|
|
||||||
:frag ((setf *frag-colour* (sample-texture main-tex vert-pos)
|
|
||||||
*frag-depth* (sample-texture depth-tex vert-pos))))
|
|
||||||
|
|
@ -0,0 +1,66 @@
|
||||||
|
;;;; basic-shaders.lisp (Lisp shader code)
|
||||||
|
(in-package wh-engine/render)
|
||||||
|
|
||||||
|
(define-shader basic-shader
|
||||||
|
(:in ((vert-pos :type :vec3 :location 0)
|
||||||
|
(vert-uv :type :vec2 :location 1))
|
||||||
|
:out ((*frag-colour* :type :vec4))
|
||||||
|
:uniform ((model :type :mat4)
|
||||||
|
(view :type :mat4)
|
||||||
|
(proj :type :mat4)
|
||||||
|
(main-tex :type :sampler-2d)
|
||||||
|
(colour :type :vec4)))
|
||||||
|
:documentation "Simple shader for 2D sprites."
|
||||||
|
:version 330
|
||||||
|
:vert ((setf *position* (* proj view model (vec4 vert-pos 1.0))))
|
||||||
|
:frag ((setf *frag-colour* (* (sample-texture main-tex vert-uv) colour)))
|
||||||
|
:options (:depth-test t
|
||||||
|
:depth-write t
|
||||||
|
:blend t))
|
||||||
|
|
||||||
|
(define-shader render-target-blit-shader
|
||||||
|
(:in ((vert-pos :type :vec2 :location 0))
|
||||||
|
:out ((*frag-colour* :type :vec4)
|
||||||
|
(*frag-depth* :type :float))
|
||||||
|
:uniform ((main-tex :type :sampler-2d)
|
||||||
|
(depth-tex :type :depth-sampler-2d)))
|
||||||
|
:documentation "Shader for compositing render targets together."
|
||||||
|
:version 330
|
||||||
|
:vert ((setf *position* (vec4 vert-pos 0.0 1.0)))
|
||||||
|
:frag ((setf *frag-colour* (sample-texture main-tex vert-pos)
|
||||||
|
*frag-depth* (sample-texture depth-tex vert-pos)))
|
||||||
|
:options (:depth-test t
|
||||||
|
:depth-write t
|
||||||
|
:blend nil))
|
||||||
|
|
||||||
|
(define-shader ui-basic-shader
|
||||||
|
(:in ((vert-pos :type :vec2 :location 0)
|
||||||
|
(vert-uv :type :vec2 :location 1))
|
||||||
|
:out ((*frag-colour* :type :vec4))
|
||||||
|
:uniform ((model :type :mat4)
|
||||||
|
(proj :type :mat4)
|
||||||
|
(main-tex :type :sampler-2d)
|
||||||
|
(colour :type :vec4)))
|
||||||
|
:documentation "Simple shader for overlay UI."
|
||||||
|
:version 330
|
||||||
|
:vert ((setf *position* (* proj model (vec4 vert-pos 1.0 1.0))))
|
||||||
|
:frag ((setf *frag-colour* (* (sample-texture main-tex vert-uv) colour)))
|
||||||
|
:options (:depth-test nil
|
||||||
|
:depth-write nil
|
||||||
|
:blend t))
|
||||||
|
|
||||||
|
(define-shader ui-glyph-shader
|
||||||
|
(:in ((vert-pos :type :vec2 :location 0)
|
||||||
|
(vert-uv :type :vec2 :location 1))
|
||||||
|
:out ((*frag-colour* :type :vec4))
|
||||||
|
:uniform ((model :type :mat4)
|
||||||
|
(proj :type :mat4)
|
||||||
|
(main-tex :type :sampler-2d)
|
||||||
|
(colour :type :vec3)))
|
||||||
|
:documentation "Shader for text and other glyphs within overlay UI."
|
||||||
|
:version 330
|
||||||
|
:vert ((setf *position* (* proj model (vec4 vert-pos 1.0 1.0))))
|
||||||
|
:frag ((setf *frag-colour* (vec4 colour (vx (sample-texture main-tex vert-uv)))))
|
||||||
|
:options (:depth-test nil
|
||||||
|
:depth-write nil
|
||||||
|
:blend t))
|
||||||
Loading…
Reference in New Issue