Drawing on the GPU

This draws a ring, a shape with a hole, on the GPU from start to finish, with nothing but cl-slug, clsl and cl-gfx on Vulkan. It renders offscreen and prints the image as characters, so it needs no window. Mesa's lavapipe, a Vulkan driver that needs no GPU, runs it too.

The quad covers the whole image, which shows the em square from 0 to 1, so the shape's numbers can come in one uniform block. A real renderer draws one quad per shape, from instances: see Shaders.

(mapc #'asdf:load-system '(:cl-slug :cl-slug/clsl :clsl/vulkan :cl-gfx/vulkan))

(defpackage #:slug-example
  (:use #:cl #:clsl)
  (:local-nicknames (#:slug #:cl-slug) (#:gfx #:cl-gfx)))
(in-package #:slug-example)

;;; The shape: a ring, two circles of eight quadratic arcs, the inner one
;;; clockwise so it is a hole.  In ems, y up.

(defun circle (cx cy radius &key clockwise)
  (let ((step (/ (* 2 pi) 8 (if clockwise -1 1))))
    (coerce (loop for i below 8
                  append (let ((a0 (* i step)) (a1 (* (1+ i) step))
                               (reach (/ radius (cos (/ step 2)))))
                           (list (+ cx (* radius (cos a0))) (+ cy (* radius (sin a0)))
                                 (+ cx (* reach (cos (/ (+ a0 a1) 2))))
                                 (+ cy (* reach (sin (/ (+ a0 a1) 2))))
                                 (+ cx (* radius (cos a1))) (+ cy (* radius (sin a1))))))
            'vector)))

(defvar *store* (slug:make-store))
(defvar *ring* (slug:store-add *store* (concatenate 'vector (circle 0.5 0.5 0.45)
                                                    (circle 0.5 0.5 0.25 :clockwise t))))

;;; The shaders.  The quad covers the target, which shows the em square
;;; from 0 to 1; the shape's eight numbers, as WRITE-SHAPE-DATA writes them,
;;; come in a uniform block.

(define-shader ring-vertex :vertex
    (&uniform (banding :vec4 :group :frame) (data :vec4 :group :frame))
  (let* ((index (vertex-index))
         (corner (vec2 (float (mod index 2)) (float (floor index 2)))))
    ;; Clip space has y down, as Vulkan's does, and ems y up.
    (values (vec4 (- (* 2 (x corner)) 1) (- 1 (* 2 (y corner))) 0 1)
            corner
            banding
            (truncate data))))

(define-shader ring-fragment :fragment
    ((em :vec2) (banding :vec4 :interpolation :flat) (data :ivec4 :interpolation :flat)
     &uniform (curves :sampler2d :group :frame) (bands :usampler2d :group :frame))
  (let ((coverage (cl-slug/clsl:slug-coverage curves bands em banding data)))
    (vec4 coverage coverage coverage 1)))

(defun texture (device format rows copy)
  "A texture of FORMAT holding ROWS rows of *STORE*, read by COPY."
  (let ((texture (gfx:create-texture device :width slug:+texture-width+ :height rows
                                            :format format :usage '(:sampled :copy-dst))))
    (gfx:write-texture texture (funcall copy *store* 0 rows))
    texture))

(defun draw (size)
  "Draw *RING* into a SIZE by SIZE image and return its red bytes, row by row."
  (gfx:with-device (device :backend :vulkan)
    (let* ((program (compile-program '(:vertex ring-vertex :fragment ring-fragment)
                                     :target :vulkan))
           (layouts (mapcar (lambda (entries) (gfx:create-bind-group-layout device entries))
                            (program-layout-entries program)))
           (pipeline (gfx:create-render-pipeline
                      device
                      :vertex (gfx:create-shader-module device (program-spirv program :vertex))
                      :fragment (gfx:create-shader-module device (program-spirv program :fragment))
                      :topology :triangle-strip
                      :color-formats '(:rgba8-unorm)
                      :bind-group-layouts layouts))
           (uniforms (gfx:create-buffer device :size (program-uniform-block-size program :frame)
                                               :usage '(:uniform)))
           (sampler (gfx:create-sampler device :filter :nearest))
           (curves (texture device :rgba16-float (slug:store-curve-rows *store*)
                            #'slug:copy-curve-rows))
           (bands (texture device :rg16-uint (slug:store-band-rows *store*) #'slug:copy-band-rows))
           ;; The :FRAME group, bind group 0: the uniform block at binding 0,
           ;; then the textures in the order the shaders declare them.
           (group (gfx:create-bind-group device (first layouts)
                                         (list (list 0 uniforms)
                                               (list 1 curves sampler)
                                               (list 2 bands sampler))))
           (image (gfx:create-texture device :width size :height size :format :rgba8-unorm
                                             :usage '(:render-target :copy-src))))
      ;; The pixel shader keeps the NaNs of floats, which not every device does.
      (assert (subsetp (program-features program) (gfx:device-features device)))
      (let ((data (make-array slug:+shape-data-floats+ :element-type 'single-float)))
        (slug:write-shape-data *ring* data 0)
        (gfx:write-buffer uniforms (pack-uniforms program :frame
                                                  :values (list :banding (subseq data 0 4)
                                                                :data (subseq data 4 8)))))
      (gfx:with-frame (frame device)
        (gfx:with-render-pass (pass frame :color ((image :clear '(0 0 0 1))))
          (gfx:set-pipeline pass pipeline)
          (gfx:set-bind-group pass 0 group)
          (gfx:draw pass 4)))
      (let ((pixels (gfx:read-texture image)))
        (loop for row below size
              collect (loop for column below size
                            collect (aref pixels (* 4 (+ column (* row size))))))))))

;; Each pixel as a character, darker to lighter.
(dolist (row (draw 24))
  (format t "~{~A~}~%" (mapcar (lambda (value) (char " .:-=+*#" (floor value 32))) row)))

It prints:

                        
        :=+**+=:        
      :*########*:      
     +############+     
    *##############*    
   +################+   
  :######=.  .=######:  
  *#####        #####*  
 :#####          #####: 
 =####=          =####= 
 +####.          .####+ 
 *####            ####* 
 *####            ####* 
 +####.          .####+ 
 =####=          =####= 
 :#####          #####: 
  *#####        #####*  
  :######=.  .=######:  
   +################+   
    *##############*    
     +############+     
      :*########*:      
        :=+**+=:        
                        

The lighter characters at the edges are partly covered pixels: the anti-aliasing.

What to change for a real renderer

• One quad per shape. Put each shape's bounds, transform and write-shape-data numbers in an instance buffer, and draw four vertices per instance, as on Shaders. Pad the quad by a pixel.
• Keep the textures. Make them once, and each frame upload only what changed, growing them when the store outgrows them: see Textures and Uploading.
• Blend. Give the colour times the coverage, premultiplied, and blend premultiplied alpha over the target.

Pyssel's 2D renderer is a complete example: pyssel/2d/slug.lisp draws text laid out by cl-textrender, turned and scaled by a canvas's transform, in batches.