mirrors/clog
1
Fork 0
mirror of https://github.com/rabbibotton/clog.git synced 2025-12-06 10:40:45 -08:00
Code Issues Projects Releases Wiki Activity
clog/source/clog-webgl.lisp
David Botton 5ac17aaaea more work on binding WebGL
2022-08-10 22:34:29 -04:00

854 lines
36 KiB
Common Lisp
Raw Blame History

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; CLOG - The Common Lisp Omnificent GUI ;;;;
;;;; (c) 2020-2021 David Botton ;;;;
;;;; License BSD 3 Clause ;;;;
;;;; ;;;;
;;;; clog-webgl.lisp ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(mgl-pax:define-package :clog-webgl
(:documentation "CLOG-WEBGL bindings to WebGL")
(:use #:cl #:parse-float #:clog #:mgl-pax))
(cl:in-package :clog-webgl)
(defsection @clog-webgl (:title "CLOG WebGL Objects")
"CLOG-WebGL - Class for CLOG WebGL objects"
(clog-webgl class)
(create-webgl generic-function)
(drawing-buffer-width generic-function)
(drawing-buffer-height generic-function)
(active-texture generic-function)
(blend-color generic-function)
(blend-equation generic-function)
(blend-equation-seperate generic-function)
(blend-function generic-function)
(blend-function-seperate generic-function)
(check-frame-buffer-status generic-function)
(clear-color generic-function)
(clear-depth generic-function)
(clear-webgl generic-function)
(clear-stencil generic-function)
(color-mask generic-function)
(depth-function generic-function)
(depth-mask generic-function)
(depth-range generic-function)
(disable generic-function)
(disable-vertex-attribute-array generic-function)
(draw-arrays generic-function)
(draw-elements generic-function)
(enable generic-function)
(enable-vertex-attribute-array generic-function)
(finish generic-function)
(flush generic-function)
(frame-buffer-render-buffer generic-function)
(viewport generic-function)
(vertex-attribute-pointer generic-function)
(compile-shader-source generic-function)
(compile-webgl-program generic-function)
"CLOG-WebGL-Shader - Class for CLOG WebGL-Shader objects"
(clog-webgl-shader class)
(create-shader generic-function)
(shader-source generic-function)
(shader-parameter generic-function)
(shader-info-log generic-function)
(compile-shader generic-function)
(delete-shader generic-function)
"CLOG-WebGL-Program - Class for CLOG WebGL-Program objects"
(clog-webgl-program class)
(create-program generic-function)
(attach-shader generic-function)
(detach-shader generic-function)
(bind-attribute-location generic-function)
(program-parameter generic-function)
(attribute-location generic-function)
(program-info-log generic-function)
(link-program generic-function)
(use-program generic-function)
(delete-program generic-function)
"CLOG-WebGL-Buffer - Class for CLOG WebGL-Buffer objects"
(clog-webgl-buffer class)
(create-webgl-buffer generic-function)
(bind-buffer generic-function)
(buffer-data generic-function)
(buffer-sub-data generic-function)
(delete-buffer generic-function)
"CLOG-WebGL-Vertex-Array - Class for CLOG WebGL-Vertex-Array objects"
(clog-vertex-array class)
(create-vertex-array generic-function)
(bind-vertex-array generic-function)
(delete-vertex-array generic-function)
"CLOG-WebGL-Frame-Buffer - Class for CLOG WebGL-Frame-Buffer objects"
(clog-webgl-frame-buffer class)
(create-webgl-frame-buffer generic-function)
(bind-frame-buffer generic-function)
(delete-frame-buffer generic-function)
"CLOG-WebGL-Render-Buffer - Class for CLOG WebGL-Render-Buffer objects"
(clog-webgl-render-buffer class)
(create-webgl-render-buffer generic-function)
(bind-render-buffer generic-function)
(delete-render-buffer generic-function)
"CLOG-WebGL-Texture - Class for CLOG WebGL-Texture objects"
(clog-webgl-texture class)
(create-webgl-texture generic-function)
(bind-texture generic-function)
(delete-texture generic-function))
;; Use clog-canvas to create the html element and then use clog-webgl
;; to obtain the WebGL2 context
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Implementation - clog-webgl
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defclass clog-webgl (clog-obj)())
;;;;;;;;;;;;;;;;;;
;; create-webgl ;;
;;;;;;;;;;;;;;;;;;
(defgeneric create-webgl (clog-canvas &key context)
(:documentation "Create a new CLOG-WebGL from a CLOG-Canvas. Context
can be webgl (version 1) or webgl2 (default)"))
(defmethod create-webgl ((obj clog-canvas) &key (context "webgl2"))
(let ((web-id (clog-connection:generate-id)))
(js-execute obj (format nil "clog['~A']=clog['~A'].getContext('~A')"
web-id
(html-id obj) context))
(make-instance 'clog-webgl
:connection-id (clog::connection-id obj)
:html-id web-id)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Properties - clog-webgl
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defgeneric drawing-buffer-width (clog-webgl)
(:documentation "Drawing are of buffer width. returns float"))
(defmethod drawing-buffer-width ((obj clog-webgl))
(parse-float (query obj "drawingBufferWidth")))
(defgeneric drawing-buffer-height (clog-webgl)
(:documentation "Drawing are of buffer height. returns float"))
(defmethod drawing-buffer-height ((obj clog-webgl))
(parse-float (query obj "drawingBufferHeight")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Methdods - clog-webgl
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defgeneric active-texture (clog-webgl glenum-texture)
(:documentation "Sets the active textcture in gl context based on :TEXTUREI
where I is the texture number."))
(defmethod active-texture ((obj clog-webgl) glenum-texture)
(execute obj (format nil "activeTexture(~A.~A)"
(script-id obj) glenum-texture)))
(defgeneric blend-color (clog-webgl red green blue alpha)
(:documentation "Used to set the source and destination blending factors."))
(defmethod blend-color ((obj clog-webgl) red green blue alpha)
(execute obj (format nil "blendColor(~A,~A,~A,~A)"
red green blue alpha)))
(defgeneric blend-equation (clog-webgl glenum-mode)
(:documentation "Used to set both the RGB blend equation and alpha blend equation to a single equation.
:FUNC_ADD : source + destination (default value)
:FUNC_SUBTRACT : source - destination
:FUNC_REVERSE_SUBTRACT : destination - source
When using a WebGL 2 context, the following values are available additionally:
:MIN : Minimum of source and destination
:MAX : Maximum of source and destination"))
(defmethod blend-equation ((obj clog-webgl) glenum-mode)
(execute obj (format nil "blendEquation(~A.~A)" (script-id obj) glenum-mode)))
(defgeneric blend-equation-separate (clog-webgl glenum-mode-rgb glenum-mode-alpha)
(:documentation "Used to set both the RGB blend equation and alpha blend equation to a single equation.
:FUNC_ADD : source + destination (default value)
:FUNC_SUBTRACT : source - destination
:FUNC_REVERSE_SUBTRACT : destination - source
When using a WebGL 2 context, the following values are available additionally:
:MIN : Minimum of source and destination
:MAX : Maximum of source and destination"))
(defmethod blend-equation-separate ((obj clog-webgl) glenum-mode-rgb glenum-mode-alpha)
(execute obj (format nil "blendEquationSeparate(~A.~A,~A.~A)"
(script-id obj) glenum-mode-rgb
(script-id obj) glenum-mode-alpha)))
(defgeneric blend-function (clog-webgl glenum-source-factor glenum-destination-factor)
(:documentation "Defines which function is used for blending pixel arithmetic.
See - https://developer.mozilla.org/en-US/docs/Web/API/WebGLRenderingContext/blendFunc"))
(defmethod blend-function ((obj clog-webgl) glenum-sfactor glenum-dfactor)
(execute obj (format nil "blendFunc(~A.~A,~A.~A)"
(script-id obj) glenum-sfactor
(script-id obj) glenum-dfactor)))
(defgeneric blend-function-seperate
(clog-webgl
glenum-source-factor-rgb glenum-destination-factor-rgb
glenum-source-factor-alpha glenum-destination-factor-alpha)
(:documentation "Defines which function is used for blending pixel arithmetic.
See - https://developer.mozilla.org/en-US/docs/Web/API/WebGLRenderingContext/blendFunc"))
(defmethod blend-function-seperate
((obj clog-webgl)
glenum-sfactor-rgb glenum-dfactor-rgb
glenum-sfactor-alpha glenum-dfactor-alhpa)
(execute obj (format nil "blendFunc(~A.~A,~A.~A,~A.~A,~A.~A)"
(script-id obj) glenum-sfactor-rgb
(script-id obj) glenum-dfactor-rgb
(script-id obj) glenum-sfactor-alpha
(script-id obj) glenum-dfactor-alpha)))
(defgeneric check-frame-buffer-status (clog-webgl target)
(:documentation "Completeness status of frame buffer. Target can be:
:FRAMEBUFFER
Collection buffer data storage of color, alpha, depth and stencil buffers used to render an image.
When using a WebGL 2 context, the following values are available additionally:
:DRAW_FRAMEBUFFER
Equivalent to :FRAMEBUFFER. Used as a destination for drawing, rendering, clearing, and writing operations.
:READ_FRAMEBUFFER
Used as a source for reading operations."))
(defmethod check-frame-buffer-status ((obj clog-webgl) target)
(parse-integer (query obj (format nil "checkFrameBufferStatus(~A.~A)"
(script-id obj) target))
:junk-allowed t))
(defgeneric clear-color (clog-webgl red green blue alpha)
(:documentation "Specifies the color values used when clearing color buffers
with CLEAR-WEBGL."))
(defmethod clear-color ((obj clog-webgl) red green blue alpha)
(execute obj (format nil "clearColor(~A,~A,~A,~A)"
red green blue alpha)))
(defgeneric clear-depth (clog-webgl depth)
(:documentation "Specifying the depth value used when the depth buffer is cleared."))
(defmethod clear-depth ((obj clog-webgl) depth)
(execute obj (format nil "clearDepth(~A)"
depth)))
(defgeneric clear-stencil (clog-webgl stencil)
(:documentation "Specifying the stencil index used when the stencil buffer is cleared."))
(defmethod clear-stencil ((obj clog-webgl) stencil)
(execute obj (format nil "clearStencil(~A)"
stencil)))
(defgeneric clear-webgl (clog-webgl glenum-mask)
(:documentation "Clears buffers to preset values. GLENUM-MASK can be:
:COLOR_BUFFER_BIT
:DEPTH_BUFFER_BIT
:STENCIL_BUFFER_BIT"))
(defmethod clear-webgl ((obj clog-webgl) glenum-mask)
(execute obj (format nil "clear(~A.~A)"
(script-id obj) glenum-mask)))
(defgeneric color-mask (clog-webgl red green blue alpha)
(:documentation "Sets which color components to enable or to disable when drawing or rendering
red green blue alpha are nil or true"))
(defmethod color-mask ((obj clog-webgl) red green blue alpha)
(execute obj (format nil "colorMask(~A,~A,~A,~A)"
(p-true-js red) (p-true-js green)
(p-true-js blue) (p-true-js alpha))))
;; WebGLRenderingContext.compressedTexImage2D() and WebGL2RenderingContext.compressedTexImage3D()
;; WebGLRenderingContext.compressedTexSubImage2D()
;; WebGLRenderingContext.copyTexImage2D()
;; WebGLRenderingContext.copyTexSubImage2D()
(defgeneric cull-face (clog-webgl glenum-mode)
(:documentation "Specifies whether or not front- and/or back-facing polygons
can be culled. GLENUM-MODE can be:
:FRONT
:BACK
:FRONT_AND_BACK"))
(defmethod cull-face ((obj clog-webgl) glenum-mode)
(execute obj (format nil "cullFace(~A.~A)"
(script-id obj) glenum-mode)))
(defgeneric depth-function (clog-webgl glenum-func)
(:documentation "Specifies a function that compares incoming pixel depth to
the current depth buffer value. GLENUM-FUNC can be:
:NEVER (never pass)
:LESS (pass if the incoming value is less than the depth buffer value)
:EQUAL (pass if the incoming value equals the depth buffer value)
:LEQUAL (pass if the incoming value is less than or equal to the depth buffer value)
:GREATER (pass if the incoming value is greater than the depth buffer value)
:NOTEQUAL (pass if the incoming value is not equal to the depth buffer value)
:GEQUAL (pass if the incoming value is greater than or equal to the depth buffer value)
:ALWAYS (always pass)"))
(defmethod depth-function ((obj clog-webgl) glenum-func)
(execute obj (format nil "depthFunc(~A.~A)"
(script-id obj) glenum-func)))
(defgeneric depth-mask (clog-webgl enablep)
(:documentation "Specifying whether or not writing into the depth buffer is
enabled"))
(defmethod depth-mask ((obj clog-webgl) enablep)
(execute obj (format nil "depthMask(~A)"
(p-true-js enablep))))
(defgeneric depth-range (clog-webgl znear zfar)
(:documentation "Specifies the depth range mapping from normalized device
coordinates to window or viewport coordinates."))
(defmethod depth-range ((obj clog-webgl) znear zfar)
(execute obj (format nil "depthRange(~A,~A)"
znear zfar)))
(defgeneric enable-capability (clog-webgl glenum-capability)
(:documentation "Enables specific WebGL capabilities for this context.
For GLENUM-CAPABILITY see:
https://developer.mozilla.org/en-US/docs/Web/API/WebGLRenderingContext/enable"))
(defmethod enable-capability ((obj clog-webgl) glenum-capability)
(execute obj (format nil "enable(~A.~A)"
(script-id obj) glenum-capability)))
(defgeneric disable-capability (clog-webgl glenum-capability)
(:documentation "Disables specific WebGL capabilities for this context.
For GLENUM-CAPABILITY see:
https://developer.mozilla.org/en-US/docs/Web/API/WebGLRenderingContext/disable"))
(defmethod disable-capability ((obj clog-webgl) glenum-capability)
(execute obj (format nil "disable(~A.~A)"
(script-id obj) glenum-capability)))
(defgeneric draw-arrays (clog-webgl mode offset count)
(:documentation "Renders primitives from array data. MODE can be:
:POINTS Draws a single dot.
:LINE_STRIP Draws a straight line to the next vertex.
:LINE_LOOP Draws a straight line to the next vertex, and connects the last vertex back to the first.
:LINES Draws a line between a pair of vertices.
:TRIANGLE_STRIP
:TRIANGLE_FAN
:TRIANGLES Draws a triangle for a group of three vertices."))
(defmethod draw-arrays ((obj clog-webgl) primitive-type offset count)
(execute obj (format nil "drawArrays(~A.~A,~A,~A)"
(script-id obj) primitive-type
offset count)))
(defgeneric draw-elements (clog-webgl mode count type offset)
(:documentation "Renders primitives from array data.
MODE can be:
:POINTS Draws a single dot.
:LINE_STRIP Draws a straight line to the next vertex.
:LINE_LOOP Draws a straight line to the next vertex, and connects the last vertex back to the first.
:LINES Draws a line between a pair of vertices.
:TRIANGLE_STRIP
:TRIANGLE_FAN
:TRIANGLES Draws a triangle for a group of three vertices.
TYPE can be:
:UNSIGNED_BYTE
:UNSIGNED_SHORT"))
(defmethod draw-elements ((obj clog-webgl) mode count type offset)
(execute obj (format nil "drawElements(~A.~A,~A,~A.~A,~A)"
(script-id obj) mode
count
(script-id obj) type
offset)))
(defgeneric enable-vertex-attribute-array (clog-webgl attribute-location)
(:documentation "Turns the generic vertex attribute array on at a given index
position."))
(defmethod enable-vertex-attribute-array ((obj clog-webgl) attribute-location)
(execute obj (format nil "enableVertexAttribArray(~A)"
attribute-location)))
(defgeneric finish (clog-webgl)
(:documentation "Blocks execution until all previously called commands are
finished. [this needs to be written to fire an event when done to work fully
with CLOG]"))
(defmethod finish ((obj clog-webgl))
(execute obj "finish()"))
(defgeneric flush (clog-webgl)
(:documentation "Empties different buffer commands, causing all commands to
be executed as quickly as possible"))
(defmethod flush ((obj clog-webgl))
(execute obj "flush()"))
(defgeneric frame-buffer-render-buffer (clog-webgl target attachment renderbuffertarget
clog-webgl-render-buffer)
(:documentation "Attaches a clog-Render-buffer object to a clog-frame-buffer object"))
(defmethod frame-buffer-render-buffer ((obj clog-webgl) target attachment renderbuffertarget
(renderbuffer clog-webgl-render-buffer))
(execute obj (format nil "framebufferRenderbuffer(~A.~A,~A.~A,~A.~A,~A)"
(script-id obj) target
(script-id obj) attachment
(script-id obj) renderbuffertarget
(script-id renderbuffer))))
(defgeneric disable-vertex-attribute-array (clog-webgl attribute-location)
(:documentation "Turns the generic vertex attribute array off at a given index
position."))
(defmethod disable-vertex-attribute-array ((obj clog-webgl) attribute-location)
(execute obj (format nil "desableVertexAttribArray(~A)"
attribute-location)))
(defmethod viewport ((obj clog-webgl) x y width height)
(execute obj (format nil "viewport(~A,~A,~A,~A)"
x y width height)))
(defmethod vertex-attribute-pointer ((obj clog-webgl) attribute-location size type normalize stride offset)
(execute obj (format nil "vertexAttribPointer(~A,~A,~A.~A,~A,~A,~A)"
attribute-location size (script-id obj) type
(p-true-js normalize) stride offset)))
(defmethod compile-shader-source ((obj clog-webgl) glenum-type source)
(let ((shader (create-shader obj glenum-type)))
(setf (shader-source shader) source)
(compile-shader shader)
(let ((result (shader-parameter shader :COMPILE_STATUS)))
(cond ((js-true-p result)
shader)
(t
(setf result (shader-info-log shader))
(delete-shader shader)
(error result))))))
(defmethod compile-webgl-program ((obj clog-webgl) vertex-shader fragment-shader)
(let ((program (create-program obj)))
(attach-shader program vertex-shader)
(attach-shader program fragment-shader)
(link-program program)
(let ((result (program-parameter program :LINK_STATUS)))
(cond ((js-true-p result)
program)
(t
(setf result (program-info-log program))
(delete-program program)
(error result))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Implementation - clog-webgl-shader
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defclass clog-webgl-shader (clog-obj)
((gl :accessor gl :initarg :clog-webgl)))
(defgeneric create-shader (clog-webgl glenum-type)
(:documentation "Create a clog-webgl-shader for type :GLENUM.
See https://github.com/KhronosGroup/WebGL/blob/main/specs/latest/2.0/webgl2.idl
For :GLENUM values"))
(defmethod create-shader ((obj clog-webgl) glenum-type)
(let ((web-id (clog-connection:generate-id)))
(js-execute obj (format nil "clog['~A']=~A.createShader(~A.~A)"
web-id
(script-id obj) (script-id obj) glenum-type))
(make-instance 'clog-webgl-shader
:connection-id (clog::connection-id obj)
:html-id web-id
:clog-webgl obj)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Properties - clog-webgl-shader
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmethod (setf shader-source) (source (obj clog-webgl-shader))
(execute (gl obj) (format nil "shaderSource(~A, '~A')"
(script-id obj)
(escape-string source)))
source)
(defmethod shader-parameter ((obj clog-webgl-shader) glenum-param)
(query (gl obj) (format nil "getShaderParameter(~A, ~A.~A)"
(script-id obj)
(script-id (gl obj)) glenum-param)))
(defmethod shader-info-log ((obj clog-webgl-shader))
(query (gl obj) (format nil "getShaderInfoLog(~A)"
(script-id obj))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Methods - clog-webgl-shader
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmethod compile-shader ((obj clog-webgl-shader))
(execute (gl obj) (format nil "compileShader(~A)"
(script-id obj))))
(defmethod delete-shader ((obj clog-webgl-shader))
(execute (gl obj) (format nil "deleteShader(~A)"
(script-id obj))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Implementation - clog-webgl-program
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defclass clog-webgl-program (clog-obj)
((gl :accessor gl :initarg :clog-webgl)))
(defgeneric create-program (clog-webgl)
(:documentation "Create a clog-webgl-program"))
(defmethod create-program ((obj clog-webgl))
(let ((web-id (clog-connection:generate-id)))
(js-execute obj (format nil "clog['~A']=~A.createProgram()"
web-id
(script-id obj)))
(make-instance 'clog-webgl-program
:connection-id (clog::connection-id obj)
:html-id web-id
:clog-webgl obj)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Parameters - clog-webgl-program
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmethod program-parameter ((obj clog-webgl-program) glenum-param)
(query (gl obj) (format nil "getProgramParameter(~A, ~A.~A)"
(script-id obj)
(script-id (gl obj)) glenum-param)))
(defmethod attribute-location ((obj clog-webgl-program) name)
(query (gl obj) (format nil "getAttribLocation(~A, '~A')"
(script-id obj) name)))
(defmethod program-info-log ((obj clog-webgl-program))
(query (gl obj) (format nil "getProgramInfoLog(~A)"
(script-id obj))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Methods - clog-webgl-program
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defgeneric attach-shader (clog-webgl-program clog-webgl-shader)
(:documentation "Attaches either a fragment or vertex CLOG-WEBGL-SHADER"))
(defmethod attach-shader ((obj clog-webgl-program) (shader clog-webgl-shader))
(execute (gl obj) (format nil "attachShader(~A, ~A)"
(script-id obj)
(script-id shader))))
(defgeneric detach-shader (clog-webgl-program clog-webgl-shader)
(:documentation "Detaches a CLOG-WEBGL-SHADER"))
(defmethod detach-shader ((obj clog-webgl-program) (shader clog-webgl-shader))
(execute (gl obj) (format nil "detachShader(~A, ~A)"
(script-id obj)
(script-id shader))))
(defgeneric bind-attribute-location (clog-webgl-program index name)
(:documentation "Binds a generic vertex INDEX to an attribute variable
called NAME."))
(defmethod bind-attribute-location ((obj clog-webgl-program) index name)
(execute (gl obj) (format nil "bindAttribLocation(~A, ~A, '~A')"
(script-id obj) index name)))
(defmethod link-program ((obj clog-webgl-program))
(execute (gl obj) (format nil "linkProgram(~A)" (script-id obj))))
(defmethod use-program ((obj clog-webgl-program))
(execute (gl obj) (format nil "useProgram(~A)" (script-id obj))))
(defmethod delete-program ((obj clog-webgl-program))
(execute (gl obj) (format nil "deleteProgram(~A)"
(script-id obj))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Implementation - clog-webgl-buffer
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defclass clog-webgl-buffer (clog-obj)
((gl :accessor gl :initarg :clog-webgl)
(gl-type :accessor gl-type :initarg :gl-type)))
(defgeneric create-webgl-buffer (clog-webgl &key bind-type)
(:documentation "Create a clog-webgl-buffer. If BIND-TYPE
is set binds the buffer to either :ARRAY_BUFFER or :ELEMENT_ARRAY_BUFFER
in WebGL2 the following added:
:COPY_READ_BUFFER : Buffer for copying from one buffer object to another.
:COPY_WRITE_BUFFER : Buffer for copying from one buffer object to another.
:TRANSFORM_FEEDBACK_BUFFER : Buffer for transform feedback operations.
:UNIFORM_BUFFER : Buffer used for storing uniform blocks.
:PIXEL_PACK_BUFFER : Buffer used for pixel transfer operations.
:PIXEL_UNPACK_BUFFER : Buffer used for pixel transfer operations."))
(defmethod create-webgl-buffer ((obj clog-webgl) &key bind-type)
(let ((web-id (clog-connection:generate-id)))
(js-execute obj (format nil "clog['~A']=~A.createBuffer()"
web-id
(script-id obj)))
(let ((new-obj (make-instance 'clog-webgl-buffer
:connection-id (clog::connection-id obj)
:html-id web-id
:clog-webgl obj
:gl-type bind-type)))
(when bind-type
(bind-buffer new-obj bind-type))
new-obj)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Methods - clog-webgl-buffer
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defgeneric bind-buffer (clog-webgl-buffer glenum-target)
(:documentation "Set BIND-TYPE of buffer to either :ARRAY_BUFFER or
:ELEMENT_ARRAY_BUFFER. WebGL2 adds:
:COPY_READ_BUFFER : Buffer for copying from one buffer object to another.
:COPY_WRITE_BUFFER : Buffer for copying from one buffer object to another.
:TRANSFORM_FEEDBACK_BUFFER : Buffer for transform feedback operations.
:UNIFORM_BUFFER : Buffer used for storing uniform blocks.
:PIXEL_PACK_BUFFER : Buffer used for pixel transfer operations.
:PIXEL_UNPACK_BUFFER : Buffer used for pixel transfer operations."))
(defmethod bind-buffer ((obj clog-webgl-buffer) glenum-target)
(execute (gl obj) (format nil "bindBuffer(~A.~A,~A)"
(script-id (gl obj)) glenum-target
(script-id obj)))
(setf (gl-type obj) glenum-target))
(defgeneric buffer-data (clog-webgl-buffer data-list data-type glenum-usage)
(:documentation "Initializes and creates the buffer object's data store.
DATA-LIST is a Lisp list of data elements.
DATA-TYPE is the WebGL data type as a string \"Float32Array\"
GLENUM-USAGE us a usage hint like :STATIC_DRAW"))
(defmethod buffer-data ((obj clog-webgl-buffer) data-list data-type hint)
(execute (gl obj) (format nil "bufferData(~A.~A, new ~A([~{~A~^,~}]), ~A.~A)"
(script-id (gl obj)) (gl-type obj)
data-type data-list
(script-id (gl obj)) hint)))
(defgeneric buffer-sub-data (clog-webgl-buffer offset data-list data-type)
(:documentation "Initializes and creates the buffer object's data store.
OFFSET element index offset where to start reading the buffer.
DATA-LIST is a Lisp list of data elements.
DATA-TYPE is the WebGL data type as a string \"Float32Array\""))
(defmethod buffer-sub-data ((obj clog-webgl-buffer) offset data-list data-type)
(execute (gl obj) (format nil "bufferSubData(~A.~A, ~A, new ~A([~{~A~^,~}]))"
(script-id (gl obj)) (gl-type obj)
offset
data-type data-list)))
(defmethod delete-buffer ((obj clog-webgl-buffer))
(execute (gl obj) (format nil "deleteBuffer(~A)"
(script-id obj))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Implementation - clog-webgl-vertex-array
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defclass clog-webgl-vertex-array (clog-obj)
((gl :accessor gl :initarg :clog-webgl)))
(defgeneric create-vertex-array (clog-webgl)
(:documentation "Create a clog-webgl-vertex-array"))
(defmethod create-vertex-array ((obj clog-webgl))
(let ((web-id (clog-connection:generate-id)))
(js-execute obj (format nil "clog['~A']=~A.createVertexArray()"
web-id
(script-id obj)))
(make-instance 'clog-webgl-vertex-array
:connection-id (clog::connection-id obj)
:html-id web-id
:clog-webgl obj)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Methods - clog-webgl-vertex-array
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmethod bind-vertex-array ((obj clog-webgl-vertex-array))
(execute (gl obj) (format nil "bindVertexArray(~A)"
(script-id obj))))
(defmethod delete-vertex-array ((obj clog-webgl-vertex-array))
(execute (gl obj) (format nil "deleteVertexArray(~A)"
(script-id obj))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Implementation - clog-webgl-frame-buffer
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defclass clog-webgl-frame-buffer (clog-obj)
((gl :accessor gl :initarg :clog-webgl)
(gl-type :accessor gl-type :initarg :gl-type)))
(defgeneric create-webgl-frame-buffer (clog-webgl &key bind-type)
(:documentation "Create a clog-webgl-frame-buffer. If BIND-TYPE
is set binds the frame-buffer to :FRAMEBUFFER in WebGL2 the following are
added:
:DRAW_FRAMEBUFFER : Used as a destination for drawing operations such as draw*,
clear* and blit-frame-buffer.
:READ_FRAMEBUFFER : Used as a source for reading operations such as readPixels
and blit-frame-buffer."))
(defmethod create-webgl-frame-buffer ((obj clog-webgl) &key bind-type)
(let ((web-id (clog-connection:generate-id)))
(js-execute obj (format nil "clog['~A']=~A.createFrameBuffer()"
web-id
(script-id obj)))
(let ((new-obj (make-instance 'clog-webgl-frame-buffer
:connection-id (clog::connection-id obj)
:html-id web-id
:clog-webgl obj
:gl-type bind-type)))
(when bind-type
(bind-frame-buffer new-obj bind-type))
new-obj)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Methods - clog-webgl-frame-buffer
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defgeneric bind-frame-buffer (clog-webgl-frame-buffer glenum-target)
(:documentation "Set BIND-TYPE of frame-buffer to :FRAMEBUFFER
in WebGL2 the following are added:
:DRAW_FRAMEBUFFER : Used as a destination for drawing operations such as draw*,
clear* and blit-frame-buffer.
:READ_FRAMEBUFFER : Used as a source for reading operations such as readPixels
and blit-frame-buffer"))
(defmethod bind-frame-buffer ((obj clog-webgl-frame-buffer) glenum-target)
(execute (gl obj) (format nil "bindFrameBuffer(~A.~A,~A)"
(script-id (gl obj)) glenum-target
(script-id obj)))
(setf (gl-type obj) glenum-target))
(defmethod delete-frame-buffer ((obj clog-webgl-frame-buffer))
(execute (gl obj) (format nil "deleteFrameBuffer(~A)"
(script-id obj))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Implementation - clog-webgl-render-buffer
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defclass clog-webgl-render-buffer (clog-obj)
((gl :accessor gl :initarg :clog-webgl)
(gl-type :accessor gl-type :initarg :gl-type)))
(defgeneric create-webgl-render-buffer (clog-webgl &key bind-type)
(:documentation "Create a clog-webgl-render-buffer. If BIND-TYPE
is set binds the render-buffer to :RENDERBUFFER"))
(defmethod create-webgl-render-buffer ((obj clog-webgl) &key bind-type)
(let ((web-id (clog-connection:generate-id)))
(js-execute obj (format nil "clog['~A']=~A.createRenderBuffer()"
web-id
(script-id obj)))
(let ((new-obj (make-instance 'clog-webgl-render-buffer
:connection-id (clog::connection-id obj)
:html-id web-id
:clog-webgl obj
:gl-type bind-type)))
(when bind-type
(bind-render-buffer new-obj bind-type))
new-obj)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Methods - clog-webgl-render-buffer
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defgeneric bind-render-buffer (clog-webgl-render-buffer glenum-target)
(:documentation "Set BIND-TYPE of render-buffer to :RENDERBUFFER"))
(defmethod bind-render-buffer ((obj clog-webgl-render-buffer) glenum-target)
(execute (gl obj) (format nil "bindRenderBuffer(~A.~A,~A)"
(script-id (gl obj)) glenum-target
(script-id obj)))
(setf (gl-type obj) glenum-target))
(defmethod delete-render-buffer ((obj clog-webgl-render-buffer))
(execute (gl obj) (format nil "deleteRenderBuffer(~A)"
(script-id obj))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Implementation - clog-webgl-texture
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defclass clog-webgl-texture (clog-obj)
((gl :accessor gl :initarg :clog-webgl)
(gl-type :accessor gl-type :initarg :gl-type)))
(defgeneric create-webgl-texture (clog-webgl &key bind-type)
(:documentation "Create a clog-webgl-texture. If BIND-TYPE
is set binds the texture to:
:TEXTURE_2D : A two-dimensional texture.
:TEXTURE_CUBE_MAP : A cube-mapped texture.
in WebGL 2 also:
:TEXTURE_3D : A three-dimensional texture.
:TEXTURE_2D_ARRAY : A two-dimensional array texture."))
(defmethod create-webgl-texture ((obj clog-webgl) &key bind-type)
(let ((web-id (clog-connection:generate-id)))
(js-execute obj (format nil "clog['~A']=~A.createTexture()"
web-id
(script-id obj)))
(let ((new-obj (make-instance 'clog-webgl-texture
:connection-id (clog::connection-id obj)
:html-id web-id
:clog-webgl obj
:gl-type bind-type)))
(when bind-type
(bind-texture new-obj bind-type))
new-obj)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Methods - clog-webgl-texture
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defgeneric bind-texture (clog-webgl-texture glenum-target)
(:documentation "Set BIND-TYPE of texture to:
:TEXTURE_2D : A two-dimensional texture.
:TEXTURE_CUBE_MAP : A cube-mapped texture.
in WebGL 2 also:
:TEXTURE_3D : A three-dimensional texture.
:TEXTURE_2D_ARRAY : A two-dimensional array texture."))
(defmethod bind-texture ((obj clog-webgl-texture) glenum-target)
(execute (gl obj) (format nil "bindTexture(~A.~A,~A)"
(script-id (gl obj)) glenum-target
(script-id obj)))
(setf (gl-type obj) glenum-target))
(defmethod delete-texture ((obj clog-webgl-texture))
(execute (gl obj) (format nil "deleteTexture(~A)"
(script-id obj))))
Reference in a new issue View git blame Copy permalink