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))
|
||||
)))
|
||||
|
||||
(defvar *view-width* 384
|
||||
(defvar *view-width* 512
|
||||
"View-space width in pixels.")
|
||||
(defvar *view-height* 256
|
||||
(defvar *view-height* 384
|
||||
"View-space height in pixels.")
|
||||
(defvar *view-ppu* 64
|
||||
"Pixels in view-space per unit in world-space.")
|
||||
|
|
@ -66,12 +66,16 @@
|
|||
"Re-sort the *world-views* list by render pass."
|
||||
(sort *world-views* #'< :key (lambda (v) (o! (deref-pointer v) render-pass))))
|
||||
|
||||
(declaim (special *projection*))
|
||||
|
||||
(let (render-target win-width win-height)
|
||||
(defun render-system-init ()
|
||||
(setf win-width (* *view-width* *pixel-scale*)
|
||||
win-height (* *view-height* *pixel-scale*)
|
||||
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
|
||||
(gl:bind-texture :texture-2d (o! render-target render-texture))
|
||||
(gl:tex-parameter :texture-2d :texture-min-filter :nearest)
|
||||
|
|
|
|||
|
|
@ -12,163 +12,150 @@
|
|||
else if (consp form)
|
||||
do (replace-xref-vars (cdr form) vars replace-fun)))
|
||||
|
||||
(defvar *vert-builtins* '((*vertex-id* . "gl_VertexID")
|
||||
(*instance-id* . "gl_InstanceID")
|
||||
(*draw-id* . "gl_DrawID")
|
||||
(*base-vertex* . "gl_BaseVertex")
|
||||
(*base-instance* . "gl_BaseInstance")
|
||||
;; out
|
||||
(*position* . "gl_Position")
|
||||
(*point-size* . "gl_PointSize")
|
||||
(*clip-distance* . "gl_ClipDistance")))
|
||||
(defparameter *vert-builtins* '((*vertex-id* . "gl_VertexID")
|
||||
(*instance-id* . "gl_InstanceID")
|
||||
(*draw-id* . "gl_DrawID")
|
||||
(*base-vertex* . "gl_BaseVertex")
|
||||
(*base-instance* . "gl_BaseInstance")
|
||||
;; out
|
||||
(*position* . "gl_Position")
|
||||
(*point-size* . "gl_PointSize")
|
||||
(*clip-distance* . "gl_ClipDistance")))
|
||||
|
||||
(defvar *frag-builtins* '((*frag-coord* . "gl_FragCoord")
|
||||
(*front-facing* . "gl_FrontFacing")
|
||||
(*point-coord* . "gl_PointCoord")
|
||||
(*sample-id* . "gl_SampleID")
|
||||
(*sample-position* . "gl_SamplePosition")
|
||||
(*sample-mask-in* . "gl_SampleMaskIn")
|
||||
(*clip-distance* . "gl_ClipDistance")
|
||||
(*primitive-id* . "gl_PrimitiveID")
|
||||
(*layer* . "gl_Layer")
|
||||
(*viewport-index* . "gl_ViewportIndex")
|
||||
;; out
|
||||
(*frag-depth* . "gl_FragDepth")
|
||||
(*sample-mask* . "gl_SampleMask")))
|
||||
(defparameter *frag-builtins* '((*frag-coord* . "gl_FragCoord")
|
||||
(*front-facing* . "gl_FrontFacing")
|
||||
(*point-coord* . "gl_PointCoord")
|
||||
(*sample-id* . "gl_SampleID")
|
||||
(*sample-position* . "gl_SamplePosition")
|
||||
(*sample-mask-in* . "gl_SampleMaskIn")
|
||||
(*clip-distance* . "gl_ClipDistance")
|
||||
(*primitive-id* . "gl_PrimitiveID")
|
||||
(*layer* . "gl_Layer")
|
||||
(*viewport-index* . "gl_ViewportIndex")
|
||||
;; out
|
||||
(*frag-depth* . "gl_FragDepth")
|
||||
(*sample-mask* . "gl_SampleMask")))
|
||||
|
||||
(defvar *infix-ops* '((+ "+" t)
|
||||
(- "-" t)
|
||||
(* "*" t)
|
||||
(/ "/" t)
|
||||
(mod "%" t)
|
||||
(= "==" t)
|
||||
(eq "==" nil)
|
||||
(eql "==" nil)
|
||||
(equal "==" nil)
|
||||
(/= "!=" nil)
|
||||
(< "<" t)
|
||||
(> ">" t)
|
||||
(<= "<=" t)
|
||||
(>= ">=" t)
|
||||
(<< "<<" nil)
|
||||
(>> ">>" nil)
|
||||
(ash "<<" nil)
|
||||
(logand "&" t)
|
||||
(logior "|" t)
|
||||
(logxor "^" t)
|
||||
(and "&&" t)
|
||||
(or "||" t)))
|
||||
(defparameter *infix-ops* '((+ "+" t)
|
||||
(- "-" T)
|
||||
(* "*" t)
|
||||
(/ "/" t)
|
||||
(mod "%" t)
|
||||
(= "==" t)
|
||||
(eq "==" nil)
|
||||
(eql "==" nil)
|
||||
(equal "==" nil)
|
||||
(/= "!=" nil)
|
||||
(< "<" t)
|
||||
(> ">" t)
|
||||
(<= "<=" t)
|
||||
(>= ">=" t)
|
||||
(<< "<<" nil)
|
||||
(>> ">>" nil)
|
||||
(ash "<<" nil)
|
||||
(logand "&" t)
|
||||
(logior "|" t)
|
||||
(logxor "^" t)
|
||||
(and "&&" t)
|
||||
(or "||" t)))
|
||||
|
||||
(defvar *types* '((:void . "void")
|
||||
(:bool . "bool")
|
||||
(:int . "int")
|
||||
(:uint . "uint")
|
||||
(:float . "float")
|
||||
(:double . "double")
|
||||
(:vec2 . "vec2")
|
||||
(:vec3 . "vec3")
|
||||
(:vec4 . "vec4")
|
||||
(:double-vec2 . "dvec2")
|
||||
(:double-vec3 . "dvec3")
|
||||
(:double-vec4 . "dvec4")
|
||||
(:bool-vec2 . "bvec2")
|
||||
(:bool-vec3 . "bvec3")
|
||||
(:bool-vec4 . "bvec4")
|
||||
(:int-vec2 . "ivec2")
|
||||
(:int-vec3 . "ivec3")
|
||||
(:int-vec4 . "ivec4")
|
||||
(:uint-vec2 . "uvec2")
|
||||
(:uint-vec3 . "uvec3")
|
||||
(:uint-vec4 . "uvec4")
|
||||
(:mat2 . "mat2")
|
||||
(:mat3 . "mat3")
|
||||
(:mat4 . "mat4")
|
||||
(:sampler-1d . "sampler1D")
|
||||
(:depth-sampler-1d . "sampler1DShadow")
|
||||
(:array-sampler-1d . "sampler1DArray")
|
||||
(:depth-array-sampler-1d . "sampler1DArrayShadow")
|
||||
(:sampler-2d . "sampler2D")
|
||||
(: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")))
|
||||
(defparameter *types* '((:void . "void")
|
||||
(:bool . "bool")
|
||||
(:int . "int")
|
||||
(:uint . "uint")
|
||||
(:float . "float")
|
||||
(:vec2 . "vec2")
|
||||
(:vec3 . "vec3")
|
||||
(:vec4 . "vec4")
|
||||
(:mat2 . "mat2")
|
||||
(:mat3 . "mat3")
|
||||
(:mat4 . "mat4")
|
||||
(:sampler-1d . "sampler1D")
|
||||
(:depth-sampler-1d . "sampler1DShadow")
|
||||
(:array-sampler-1d . "sampler1DArray")
|
||||
(:depth-array-sampler-1d . "sampler1DArrayShadow")
|
||||
(:sampler-2d . "sampler2D")
|
||||
(: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")
|
||||
(int . "int")
|
||||
(uint . "uint")
|
||||
(float . "float")
|
||||
(double . "double")
|
||||
(vec2 . "vec2")
|
||||
(vec3 . "vec3")
|
||||
(vec4 . "vec4")
|
||||
(radians . "radians")
|
||||
(degrees . "degrees")
|
||||
(sin . "sin")
|
||||
(cos . "cos")
|
||||
(tan . "tan")
|
||||
(asin . "asin")
|
||||
(acos . "acos")
|
||||
(atan . "atan")
|
||||
(sinh . "sinh")
|
||||
(cosh . "cosh")
|
||||
(tanh . "tanh")
|
||||
(asinh . "asinh")
|
||||
(acosh . "acosh")
|
||||
(atanh . "atanh")
|
||||
(expt . "pow")
|
||||
(exp . "exp")
|
||||
(log . "log")
|
||||
(sqrt . "sqrt")
|
||||
(abs . "abs")
|
||||
(signum . "sign")
|
||||
(floor . "floor")
|
||||
(ffloor . "floor")
|
||||
(truncate . "trunc")
|
||||
(ftruncate . "trunc")
|
||||
(round . "round")
|
||||
(fround . "round")
|
||||
(ceiling . "ceil")
|
||||
(fceiling . "ceil")
|
||||
(mod . "mod")
|
||||
(min . "min")
|
||||
(max . "max")
|
||||
(linear-blend . "mix")
|
||||
(step . "step")
|
||||
(smooth-step . "smoothstep")
|
||||
(float-nan-p . "isnan")
|
||||
(float-infinity-p . "isinf")
|
||||
(vlength . "length")
|
||||
(vdistance . "distance")
|
||||
(v. . "dot")
|
||||
(vc . "cross")
|
||||
(v2norm . "normalize")
|
||||
(vforward . "faceforward")
|
||||
(vreflect . "reflect")
|
||||
(vrefract . "refract")
|
||||
(mtranspose . "transpose")
|
||||
(mdet . "determinant")
|
||||
(minv . "inverse")
|
||||
(v< . "lessThan")
|
||||
(v<= . "lessThanEqual")
|
||||
(v> . "greaterThan")
|
||||
(v>= . "greaterThanEqual")
|
||||
(v= . "equal")
|
||||
(v/= . "notEqual")
|
||||
(texture-size . "textureSize")
|
||||
(texture-lod . "textureQueryLod")
|
||||
(texture-levels . "textureQueryLevels")
|
||||
(texture-samples . "textureSamples")
|
||||
(sample-texture . "texture")
|
||||
(sample-texture-raw . "texelFetch")))
|
||||
(defparameter *shader-funs* '((bool . "bool")
|
||||
(int . "int")
|
||||
(uint . "uint")
|
||||
(float . "float")
|
||||
(double . "double")
|
||||
(vec2 . "vec2")
|
||||
(vec3 . "vec3")
|
||||
(vec4 . "vec4")
|
||||
(radians . "radians")
|
||||
(degrees . "degrees")
|
||||
(sin . "sin")
|
||||
(cos . "cos")
|
||||
(tan . "tan")
|
||||
(asin . "asin")
|
||||
(acos . "acos")
|
||||
(atan . "atan")
|
||||
(sinh . "sinh")
|
||||
(cosh . "cosh")
|
||||
(tanh . "tanh")
|
||||
(asinh . "asinh")
|
||||
(acosh . "acosh")
|
||||
(atanh . "atanh")
|
||||
(expt . "pow")
|
||||
(exp . "exp")
|
||||
(log . "log")
|
||||
(sqrt . "sqrt")
|
||||
(abs . "abs")
|
||||
(signum . "sign")
|
||||
(floor . "floor")
|
||||
(ffloor . "floor")
|
||||
(truncate . "trunc")
|
||||
(ftruncate . "trunc")
|
||||
(round . "round")
|
||||
(fround . "round")
|
||||
(ceiling . "ceil")
|
||||
(fceiling . "ceil")
|
||||
(mod . "mod")
|
||||
(min . "min")
|
||||
(max . "max")
|
||||
(linear-blend . "mix")
|
||||
(step . "step")
|
||||
(smooth-step . "smoothstep")
|
||||
(float-nan-p . "isnan")
|
||||
(float-infinity-p . "isinf")
|
||||
(vlength . "length")
|
||||
(vdistance . "distance")
|
||||
(v. . "dot")
|
||||
(vc . "cross")
|
||||
(v2norm . "normalize")
|
||||
(vforward . "faceforward")
|
||||
(vreflect . "reflect")
|
||||
(vrefract . "refract")
|
||||
(mtranspose . "transpose")
|
||||
(mdet . "determinant")
|
||||
(minv . "inverse")
|
||||
(v< . "lessThan")
|
||||
(v<= . "lessThanEqual")
|
||||
(v> . "greaterThan")
|
||||
(v>= . "greaterThanEqual")
|
||||
(v= . "equal")
|
||||
(v/= . "notEqual")
|
||||
(texture-size . "textureSize")
|
||||
(texture-lod . "textureQueryLod")
|
||||
(texture-levels . "textureQueryLevels")
|
||||
(texture-samples . "textureSamples")
|
||||
(sample-texture . "texture")
|
||||
(sample-texture-raw . "texelFetch")))
|
||||
|
||||
(defun swizzlep (sym)
|
||||
(let ((sym-str (string-downcase (symbol-name sym))))
|
||||
|
|
@ -424,14 +411,15 @@
|
|||
collect (apply #'conv-shader-io :uniform var))
|
||||
funs)))
|
||||
|
||||
(defun transpile-shader (name &key
|
||||
version
|
||||
((:in vert-inputs))
|
||||
((:inter inter-vars))
|
||||
((:out frag-outputs))
|
||||
((:uniform uniform-vars))
|
||||
((:vert vert-body))
|
||||
((:frag frag-body)))
|
||||
(defun transpile-shader
|
||||
(name &key
|
||||
version
|
||||
((:in vert-inputs))
|
||||
((:inter inter-vars))
|
||||
((:out frag-outputs))
|
||||
((:uniform uniform-vars))
|
||||
((:vert vert-body))
|
||||
((:frag frag-body)))
|
||||
"Translate Lisp shader code to GLSL."
|
||||
;; create implicit inter vars
|
||||
(replace-xref-vars frag-body vert-inputs
|
||||
|
|
@ -473,22 +461,236 @@
|
|||
`(:vert ,vert-glsl :frag ,frag-glsl
|
||||
(:in ,vert-inputs :inter ,inter-vars :out ,frag-outputs :uniform ,uniform-vars
|
||||
:version ,version :vert ,vert-body :frag ,frag-body))))
|
||||
|
||||
|
||||
(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)))
|
||||
version)
|
||||
;; Shader class
|
||||
(defclass shader ()
|
||||
((name :documentation "The symbol naming this shader."
|
||||
:type symbol
|
||||
:initarg :name)
|
||||
(program :documentation "The GL program associated with this shader."
|
||||
:type fixnum
|
||||
:initarg :program)
|
||||
(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."
|
||||
`(defparameter ,name (transpile-shader ',name
|
||||
:version ,version
|
||||
:in ',vert-inputs
|
||||
:inter ',inter-vars
|
||||
:out ',frag-outputs
|
||||
:uniform ',uniform-vars
|
||||
:vert ',vert-body :frag ',frag-body)))
|
||||
`(defparameter ,name
|
||||
(make-instance 'shader
|
||||
:name ',name
|
||||
:options ',options
|
||||
:transpilation
|
||||
(transpile-shader ',name
|
||||
: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