luv

Workshop wiki

gpu.lisp

mcclim/gpu.lisp

system luv/mcclim · 205 definitions · on GitHub

Direct GPU McCLIM output.

The medium records painter-ordered triangles. It never allocates a pixel image and the mirror presents those vertices directly into its luv canvas.

in-package#:mcluv

A direct-GPU frame whose authored shape has transparent margins must not ask McCLIM to repaint those margins. McCLIM's ordinary background mixin composes every pane background over black, which turns transparency into an opaque rectangle before the backend sees it.

defclasstransparent-gpu-application-pane
clime:never-repaint-background-mixinapplication-pane
defclasstransparent-gpu-top-level-sheet-pane
clime:never-repaint-background-mixinclimi::top-level-sheet-pane
defunmake-gpu-frame-background-transparent

Suppress McCLIM background records at both levels of direct-GPU frame.

let
sheet
frame-top-level-sheetframe
frame
define-conditiongpu-medium-unsupported-design
error
design:initarg:design:readerunsupported-gpu-design
:report
lambda
conditionstream
formatstream"The direct GPU medium does not support ink ~S."
unsupported-gpu-designcondition
defstructgpu-solid-commandfirst-vertexvertex-countclip
defstructgpu-analytic-commandfirst-vertexvertex-countclip
defstructgpu-relief-analytic-commandfirst-vertexvertex-countclip
defstructgpu-gradient-analytic-commandfirst-vertexvertex-countclip
defstructgpu-image-commanddesignfirst-vertexvertex-countclip
defstructgpu-prepared-image-commandpaintfirst-vertexvertex-countclip

A lattice command's vertices live in the ANALYTIC vertex stream: the record is the same twelve floats with the lanes reinterpreted (cell coordinates, grid dimensions, the inked cells' color), so the lattice family borrows the analytic buffer and both analytic vertex stages, and differs only in its fragment shader and its summed-area texture.

defstructgpu-lattice-commandmodulesfirst-vertexvertex-countclip
defstructgpu-lattice-painttextureviewbind-group
defstructgpu-prepared-lattice-commandpaintfirst-vertexvertex-countclip
defstructgpu-text-commandstringxyfont-pathnamesizecoloralign-xalign-yclip
defstructgpu-prepared-text-commandatlasfirst-vertexvertex-countclip
defgenericgpu-command-pipeline-family
command
:documentation

Name the direct-compositor pipeline family required by command.

There is deliberately no default method: a new prepared semantic command must declare both how it encodes and which pipeline cohort must exist before an application render pass opens.

defmethodgpu-command-pipeline-family
declare
ignorecommand
:solid
defmethodgpu-command-pipeline-family
declare
ignorecommand
:analytic
defmethodgpu-command-pipeline-family
declare
ignorecommand
:relief
defmethodgpu-command-pipeline-family
declare
ignorecommand
:gradient
defmethodgpu-command-pipeline-family
declare
ignorecommand
:image
defmethodgpu-command-pipeline-family
declare
ignorecommand
:lattice
defmethodgpu-command-pipeline-family
declare
ignorecommand
:text
defstruct
gpu-prepared-frame-revision
:constructor%make-gpu-prepared-frame-revision
:conc-namegpu-prepared-frame-

One immutable CPU snapshot published by a retained GPU mirror.

number0:type
unsigned-byte64
:read-onlyt
commandsnil:read-onlyt
pipeline-familiesnil:read-onlyt
vertices
:read-onlyt
analytic-vertices
:read-onlyt
relief-vertices
:read-onlyt
gradient-vertices
:read-onlyt
image-vertices
:read-onlyt
text-data
:read-onlyt
defungpu-command-pipeline-families
commands

Return commands' direct pipeline families in first-use order.

remove-duplicates:test#'eq:from-endt
defungpu-mirror-prepared-revision
mirror

Borrow mirror's current immutable CPU revision atomically.

sb-thread:with-mutex
gpu-mirror-prepared-revision-lockmirror
%gpu-mirror-prepared-revisionmirror
defungpu-mirror-prepared-commands
mirror

Return the commands belonging to mirror's current atomic revision.

alexandria:when-let
gpu-prepared-frame-commandsrevision
defunmake-gpu-mirror-prepared-revision
mirrorcommandsverticesanalytic-verticesrelief-verticesgradient-verticesimage-verticestext-data&key
copy-pt

Copy and number one immutable CPU revision without publishing it yet.

flet
snapshot
sequence
ifcopy-p
copy-seqsequence
sequence
let
commands
ifcopy-p
copy-listcommands
commands
sb-thread:with-mutex
gpu-mirror-prepared-revision-lockmirror
%make-gpu-prepared-frame-revision:number
incf
gpu-mirror-prepared-revision-countermirror
:commandscommands:pipeline-families:vertices
snapshotvertices
:analytic-vertices
snapshotanalytic-vertices
:relief-vertices
snapshotrelief-vertices
:gradient-vertices
snapshotgradient-vertices
:image-vertices
snapshotimage-vertices
:text-data
snapshottext-data
defunpublish-gpu-mirror-prepared-revision
mirrorrevision

Prepare dependents, then atomically publish immutable revision if newest.

Pipeline work is intentionally before publication and outside the small revision lock. If it fails, the previous command/buffer cohort remains the complete last-known-good presentation.

prepare-mirror-compositor-revision
mirror-compositormirror
mirrorrevision
sb-thread:with-mutex
gpu-mirror-prepared-revision-lockmirror
let
current
%gpu-mirror-prepared-revisionmirror
when
or
nullcurrent
<
gpu-prepared-frame-numbercurrent
gpu-prepared-frame-numberrevision
setf
%gpu-mirror-prepared-revisionmirror
revision
revision
defunclear-gpu-mirror-prepared-revision
mirror
sb-thread:with-mutex
gpu-mirror-prepared-revision-lockmirror
setf
%gpu-mirror-prepared-revisionmirror
nil
mirror
defunprepare-gpu-mirror-compositor
mirror&key
target-formatniltarget-format-p
depth-stencilnildepth-stencil-p

Prepare mirror's compositor for its current immutable GPU revision.

Applications call this at their pre-pass refresh boundary even when McCLIM's semantic command stream is unchanged. It deliberately accepts only a direct GPU mirror: raster mirrors have no retained semantic revision and are not a fallback for application panels. target-format and depth-stencil identify an application-owned attachment which differs from the mirror canvas. The compositor protocol retains its own last-known-good pipeline cohort when preparation of a newer shader revision fails.

check-typemirrorluv-gpu-mirror
alexandria:when-let
if
ortarget-format-pdepth-stencil-p
apply#'prepare-mirror-compositor-target-revision
mirror-compositormirror
mirrorrevision
append
whentarget-format-p
list:target-formattarget-format
whendepth-stencil-p
list:depth-stencildepth-stencil
prepare-mirror-compositor-revision
mirror-compositormirror
mirrorrevision
mirror
defstructgpu-command-offsets

Base vertex indices for the dense streams joined into one mirror frame.

vertexanalyticreliefgradientimage
defstructgpu-frame-build

Mutable frame-local data shared while semantic commands are prepared.

text-datawidthheight
defgenericrebase-gpu-command
commandoffsets
:documentation

Copy command with its dense-stream range rebased by offsets.

Commands without dense-stream ranges may return themselves. There is no default method: every semantic command family must state its compose rule.

defgenericprepare-gpu-command
commandmirrorframe-build
:documentation

Prepare semantic command for mirror within frame-build.

Return the command to encode, or NIL when it produces no draw. There is no default method so adding a semantic command requires an explicit preparation decision.

defgenericgpu-command-clip
command
:documentation

Return command's logical-device clip rectangle, or NIL.

defgenericencode-gpu-command
commandpassframe-state
:documentation

Encode one prepared command into pass using destination frame-state.

Dispatch is at command grain. Vertex and texture payloads remain in the dense buffers owned by frame-state.

defgenericgpu-command-rasterized-p
compositorcommand
:documentation

Whether compositor wants prepared command in the mirror texture.

A compositor which replays a command directly into its final render pass can return false, avoiding a lower-resolution copy underneath the direct draw.

defmethodgpu-command-rasterized-p
compositorcommand
declare
ignorecompositorcommand
t
defstructsurface-reliefx1y1x2y2radiusheight
defvar*gpu-medium-fallback-source*nil"The semantic primitive currently being decomposed by BASIC-MEDIUM."
defvar*suppress-luv-mirror-visibility*nil"When true, frame realization and repaint remain drawable-only and hidden."
defunnote-gpu-medium-fallback
mediumprimitivefield&optional
amount1
let*
statistics
gpu-medium-fallback-statisticsmedium
entry
copy-list
gethashprimitivestatistics
incf
getfentryfield0
amount
setf
gethashprimitivestatistics
entry
defunclear-gpu-medium-fallback-statistics
medium

Forget McCLIM fallback activity previously observed by medium.

check-typemediumluv-gpu-medium
clrhash
gpu-medium-fallback-statisticsmedium
medium
defungpu-medium-fallback-report
medium

Describe which BASIC-MEDIUM fallbacks fed medium's GPU polygon leaf.

Each entry reports semantic calls, polygon points produced by McCLIM, and GPU triangles emitted by luv. Direct polygon calls are named :DIRECT-POLYGON.

check-typemediumluv-gpu-medium
let
entries
maphash
lambda
primitivestatistics
push
list*:primitiveprimitivestatistics
entries
gpu-medium-fallback-statisticsmedium
sortentries#'string<:key
lambda
entry
symbol-name
getfentry:primitive
defmacrowith-gpu-medium-fallback
mediumprimitive
&bodybody
`
defclassgpu-mirror-frame-state
mirror:initarg:mirror:initformnil:accessorgpu-frame-state-mirror
view:initarg:view:initformnil:accessorgpu-frame-state-view
vertex-buffer:initarg:vertex-buffer:initformnil:accessorgpu-frame-state-vertex-buffer
vertex-capacity:initarg:vertex-capacity:initform0:accessorgpu-frame-state-vertex-capacity
analytic-buffer:initarg:analytic-buffer:initformnil:accessorgpu-frame-state-analytic-buffer
analytic-capacity:initarg:analytic-capacity:initform0:accessorgpu-frame-state-analytic-capacity
relief-buffer:initarg:relief-buffer:initformnil:accessorgpu-frame-state-relief-buffer
relief-capacity:initarg:relief-capacity:initform0:accessorgpu-frame-state-relief-capacity
gradient-buffer:initarg:gradient-buffer:initformnil:accessorgpu-frame-state-gradient-buffer
gradient-capacity:initarg:gradient-capacity:initform0:accessorgpu-frame-state-gradient-capacity
image-buffer:initarg:image-buffer:initformnil:accessorgpu-frame-state-image-buffer
image-capacity:initarg:image-capacity:initform0:accessorgpu-frame-state-image-capacity
text-buffer:initarg:text-buffer:initformnil:accessorgpu-frame-state-text-buffer
text-capacity:initarg:text-capacity:initform0:accessorgpu-frame-state-text-capacity
define-conditiongpu-frame-state-release-error
error
failures:initarg:failures:readergpu-frame-state-release-failures
:report
lambda
conditionstream
let
failures
gpu-frame-state-release-failurescondition
formatstream"~D GPU frame resource~:P failed to release"
lengthfailures
whenfailures
formatstream"; first failure for ~S: ~A"
caarfailures
cdarfailures
write-char#\.stream
defclassgpu-cached-image-paint
texture:initarg:texture:readergpu-image-paint-texture
view:initarg:view:readergpu-image-paint-view
bind-group:initarg:bind-group:initformnil:readergpu-image-paint-bind-group
width:initarg:width:readergpu-image-paint-width
height:initarg:height:readergpu-image-paint-height

gpu-medium-push-vertex and append-gpu-text-vertex premultiply authored rgb on the CPU. Solid and Slug vertex stages therefore forward rgb unchanged; multiplying by their alpha lane here would premultiply a second time.

shader:define-shader-methodshader:shader-specification-formcluv-solid-vertex-specification
role
eql:mcluv-solid
stage
eql:vertex
:stage:vertex:inputs
position-opacity:vec3:location0
color-input:vec3:location1
:outputs
clip-position:vec4:built-in:position
color-output:vec4:location0
let*
clip
shader:vec4
shader:swizzleposition-opacity:xy
0.01.0
color
shader:vec4color-input
shader:swizzleposition-opacity:z
shader:set-outputclip-positionclip
shader:set-outputcolor-outputcolor
shader:define-shader-methodshader:shader-specification-formcluv-solid-fragment-specification
role
eql:mcluv-solid
stage
eql:fragment
:stage:fragment:inputs
color-input:vec4:location0
:outputs
color-output:vec4:location0
shader:set-outputcolor-outputcolor-input
shader:define-shader-methodshader:shader-specification-formcluv-slug-vertex-specification
role
eql:mcluv-slug
stage
eql:vertex
:stage:vertex:inputs
position-alpha:vec3:location0
outline-horizontal:vec3:location1
atlas-vertical:vec3:location2
band-low:vec3:location3
band-high:vec3:location4
color-input:vec3:location5
:outputs
clip-position:vec4:built-in:position
render-coordinate:vec2:location0
render-atlas-base:vec2:location1
render-band-bounds:vec4:location2
render-band-counts:vec2:location3
render-color:vec4:location4
let*
shader:set-outputclip-position
shader:vec4
shader:swizzleposition-alpha:xy
0.01.0
shader:set-outputrender-coordinate
shader:swizzleoutline-horizontal:xy
shader:set-outputrender-atlas-base
shader:swizzleatlas-vertical:xy
shader:set-outputrender-band-bounds
shader:set-outputrender-band-counts
shader:vec2
shader:swizzleoutline-horizontal:z
shader:swizzleatlas-vertical:z
shader:set-outputrender-color
shader:vec4color-input
shader:swizzleposition-alpha:z
defmethodshader:shader-specification-for
role
eql:mcluv-slug
stage
eql:fragment
declare
ignorerolestage
defungpu-medium-color
medium
handler-case
multiple-value-list
color-rgba
medium-inkmedium
error
error'gpu-medium-unsupported-design:design
medium-inkmedium
defgenericgpu-medium-append-analytic-design
designmediumcenterx-axisy-axishalf-widthhalf-heightradius
:documentation

Append one analytical shape painted by design, or return NIL.

defungpu-medium-size
medium
let
mirror
medium-drawablemedium
ifmirror
with-bounding-rectangle*
:widthwidth:heightheight
mirror-sheetmirror

Window events synchronize this region before repaint. Drawing must not call back into the native canvas thread while McCLIM holds its mirror lock.

values11
defungpu-medium-clip-rectangle
medium

Return medium's rectangular clip in logical device coordinates, or NIL.

let
region
medium-clipping-regionmedium
unless
region-equalregion+everywhere+
let
transformation
if
climi::medium-sheetmedium
compose-transformations
medium-device-transformationmedium
medium-transformationmedium
medium-device-transformationmedium
with-bounding-rectangle*
lefttoprightbottom
transform-regiontransformationregion
multiple-value-bind
let
left
top
right
max0.0
bottom
max0.0
minheightbottom
listlefttop
maxleftright
maxtopbottom
defungpu-medium-push-vertex
mediumxycolor
multiple-value-bind
device-xdevice-y
transform-position
medium-device-transformationmedium
xy
multiple-value-bind
let
vertices
gpu-medium-verticesmedium
flet
push-value
value
vector-push-extend
coercevalue'single-float
vertices

The mathematical shader vocabulary uses Vulkan's downward viewport. Metal lowering flips clip Y at the target boundary.

push-value
-
*2
/device-xwidth
1
push-value
-
*2
/device-yheight
1

Both native backends currently expose float32x3 vertex attributes. Carry opacity in position.z and store premultiplied rgb separately.

let
alpha
fourthcolor
push-valuealpha
dolist
component
subseqcolor03
push-value
*componentalpha
defungpu-medium-push-triangle
mediumabccolor
dolist
point
listabc
gpu-medium-push-vertexmedium
firstpoint
secondpoint
color
defungpu-medium-analytic-padding
mediumx-axisy-axis

Return enough local expansion for two device pixels around an affine quad.

let
transformation
medium-device-transformationmedium
multiple-value-bind
axxaxy
transform-distancetransformation
firstx-axis
secondx-axis
multiple-value-bind
ayxayy
transform-distancetransformation
firsty-axis
secondy-axis
let
determinant
-
*axxayy
*ayxaxy
if
<
absdeterminant
1.0e-8
nil
*2.0
max
/
sqrt
+
*ayyayy
*ayxayx
absdeterminant
/
sqrt
+
*axyaxy
*axxaxx
absdeterminant
defungpu-medium-push-analytic-vertex
mediumcenterx-axisy-axislocal-xlocal-yhalf-widthhalf-heightradiuscolor
let
x
+
firstcenter
*local-x
firstx-axis
*local-y
firsty-axis
y
+
secondcenter
*local-x
secondx-axis
*local-y
secondy-axis
multiple-value-bind
device-xdevice-y
transform-position
medium-device-transformationmedium
xy
multiple-value-bind
let
vertices
gpu-medium-analytic-verticesmedium
flet
push-value
value
vector-push-extend
coercevalue'single-float
vertices
push-value
-
*2
/device-xwidth
1
push-value
-
*2
/device-yheight
1
push-value
fourthcolor
push-valuelocal-x
push-valuelocal-y
push-value0.0
push-valuehalf-width
push-valuehalf-height
push-valueradius
dolist
component
subseqcolor03
push-valuecomponent
defungpu-medium-append-analytic-quad
mediumcenterx-axisy-axishalf-widthhalf-heightradiuscolor
alexandria:when-let
padding
gpu-medium-analytic-paddingmediumx-axisy-axis
let*
vertices
gpu-medium-analytic-verticesmedium
first-vertex
/
lengthvertices
12
left
-
+half-widthpadding
right
+half-widthpadding
top
-
+half-heightpadding
bottom
+half-heightpadding
flet
vertex
xy
gpu-medium-push-analytic-vertexmediumcenterx-axisy-axisxyhalf-widthhalf-heightradiuscolor
vertexleftbottom
vertexrightbottom
vertexrighttop
vertexleftbottom
vertexrighttop
vertexlefttop
vector-push-extend
make-gpu-analytic-command:first-vertexfirst-vertex:vertex-count6:clip
gpu-medium-commandsmedium
t
defungpu-medium-push-relief-analytic-vertex
mediumcenterx-axisy-axislocal-xlocal-yhalf-widthhalf-heightradiuscolorheight
let
x
+
firstcenter
*local-x
firstx-axis
*local-y
firsty-axis
y
+
secondcenter
*local-x
secondx-axis
*local-y
secondy-axis
multiple-value-bind
device-xdevice-y
transform-position
medium-device-transformationmedium
xy
multiple-value-bind
widthheight-in-pixels
let
vertices
gpu-medium-relief-verticesmedium
flet
push-value
value
vector-push-extend
coercevalue'single-float
vertices
dolist
value
list
-
*2
/device-xwidth
1
-
*2
/device-yheight-in-pixels
1
fourthcolor
local-xlocal-y0.0half-widthhalf-heightradius
firstcolor
secondcolor
thirdcolor
height0.00.0
push-valuevalue
defungpu-medium-append-relief-analytic-quad
mediumcenterx-axisy-axishalf-widthhalf-heightradiuscolorheight
alexandria:when-let
padding
gpu-medium-analytic-paddingmediumx-axisy-axis
let*
vertices
gpu-medium-relief-verticesmedium
first-vertex
/
lengthvertices
15
left
-
+half-widthpadding
right
+half-widthpadding
top
-
+half-heightpadding
bottom
+half-heightpadding
flet
vertex
xy
gpu-medium-push-relief-analytic-vertexmediumcenterx-axisy-axisxyhalf-widthhalf-heightradiuscolorheight
vertexleftbottom
vertexrightbottom
vertexrighttop
vertexleftbottom
vertexrighttop
vertexlefttop
vector-push-extend
make-gpu-relief-analytic-command:first-vertexfirst-vertex:vertex-count6:clip
gpu-medium-commandsmedium
t
defmethodgpu-medium-append-analytic-design
mediumcenterx-axisy-axishalf-widthhalf-heightradius
let
color
multiple-value-list
color-rgba
design-ink
relief-albedodesign
00

A construction-time pane may briefly have a singular device transform. Consume the relief primitive in that state instead of decomposing it into polygons that cannot preserve its height channel.

or
gpu-medium-append-relief-analytic-quadmediumcenterx-axisy-axishalf-widthhalf-heightradiuscolor
relief-heightdesign
t
defungpu-medium-push-gradient-analytic-vertex
mediumgradientcenterx-axisy-axislocal-xlocal-yhalf-widthhalf-heightradius
let
x
+
firstcenter
*local-x
firstx-axis
*local-y
firsty-axis
y
+
secondcenter
*local-x
secondx-axis
*local-y
secondy-axis
multiple-value-bind
device-xdevice-y
transform-position
medium-device-transformationmedium
xy
multiple-value-bind
multiple-value-bind
paint-xpaint-ypaint-kind
multiple-value-bind
r1g1b1a1
color-rgba
gradient-start-colorgradient
multiple-value-bind
r2g2b2a2
color-rgba
gradient-end-colorgradient
let
vertices
gpu-medium-gradient-verticesmedium
flet
push-value
value
vector-push-extend
coercevalue'single-float
vertices
dolist
value
list
-
*2
/device-xwidth
1
-
*2
/device-yheight
1
0.0local-xlocal-y0.0half-widthhalf-heightradiuspaint-xpaint-ypaint-kindr1g1b1r2g2b2a1a20.0
push-valuevalue
defungpu-medium-append-gradient-analytic-quad
mediumgradientcenterx-axisy-axishalf-widthhalf-heightradius
alexandria:when-let
padding
gpu-medium-analytic-paddingmediumx-axisy-axis
let*
vertices
gpu-medium-gradient-verticesmedium
first-vertex
/
lengthvertices
21
left
-
+half-widthpadding
right
+half-widthpadding
top
-
+half-heightpadding
bottom
+half-heightpadding
flet
vertex
xy
gpu-medium-push-gradient-analytic-vertexmediumgradientcenterx-axisy-axisxyhalf-widthhalf-heightradius
vertexleftbottom
vertexrightbottom
vertexrighttop
vertexleftbottom
vertexrighttop
vertexlefttop
vector-push-extend
make-gpu-gradient-analytic-command:first-vertexfirst-vertex:vertex-count6:clip
gpu-medium-commandsmedium
t
defmethodgpu-medium-append-analytic-design
mediumcenterx-axisy-axishalf-widthhalf-heightradius
gpu-medium-append-gradient-analytic-quadmediumdesigncenterx-axisy-axishalf-widthhalf-heightradius
defungpu-image-paint-source
design

Return the immutable pixel-bearing design shared by transformed paints.

loopwhile
typepdesign'climi::transformed-design
do
setfdesign
climi::transformed-design-designdesign
finally
returndesign
defungpu-image-paint-p
design
let
or
typepsource'pattern
and
typepsource'climi::masked-compositum
not
typepsource'climi::uniform-compositum
defungpu-image-paint-coordinate
designxy

Map a point in drawing coordinates back into design's source image.

if
typepdesign'climi::transformed-design
multiple-value-bind
source-xsource-y
transform-position
invert-transformation
climi::transformed-design-transformationdesign
xy
gpu-image-paint-coordinate
climi::transformed-design-designdesign
source-xsource-y
with-bounding-rectangle*
lefttoprightbottom
bounding-rectangledesign
values
/
-xleft
max1
-rightleft
/
-ytop
max1
-bottomtop
defungpu-medium-push-image-vertex
mediumdesigncenterx-axisy-axislocal-xlocal-yhalf-widthhalf-heightradius
let
x
+
firstcenter
*local-x
firstx-axis
*local-y
firsty-axis
y
+
secondcenter
*local-x
secondx-axis
*local-y
secondy-axis
multiple-value-bind
device-xdevice-y
transform-position
medium-device-transformationmedium
xy
multiple-value-bind
multiple-value-bind
uv
let
vertices
gpu-medium-image-verticesmedium
flet
push-value
value
vector-push-extend
coercevalue'single-float
vertices
dolist
value
list
-
*2
/device-xwidth
1
-
*2
/device-yheight
1
0.0local-xlocal-y0.0half-widthhalf-heightradiusuv1.0
push-valuevalue
defungpu-medium-append-image-analytic-quad
mediumdesigncenterx-axisy-axishalf-widthhalf-heightradius
alexandria:when-let
padding
gpu-medium-analytic-paddingmediumx-axisy-axis
let*
vertices
gpu-medium-image-verticesmedium
first-vertex
/
lengthvertices
12
left
-
+half-widthpadding
right
+half-widthpadding
top
-
+half-heightpadding
bottom
+half-heightpadding
flet
vertex
xy
gpu-medium-push-image-vertexmediumdesigncenterx-axisy-axisxyhalf-widthhalf-heightradius
vertexleftbottom
vertexrightbottom
vertexrighttop
vertexleftbottom
vertexrighttop
vertexlefttop
vector-push-extend
make-gpu-image-command:designdesign:first-vertexfirst-vertex:vertex-count6:clip
gpu-medium-commandsmedium
t
defmethodgpu-medium-append-analytic-design
designpattern
mediumcenterx-axisy-axishalf-widthhalf-heightradius
gpu-medium-append-image-analytic-quadmediumdesigncenterx-axisy-axishalf-widthhalf-heightradius
defmethodgpu-medium-append-analytic-design
designclimi::masked-compositum
mediumcenterx-axisy-axishalf-widthhalf-heightradius
if
typepdesign'climi::uniform-compositum
call-next-method
gpu-medium-append-image-analytic-quadmediumdesigncenterx-axisy-axishalf-widthhalf-heightradius
defmethodgpu-medium-append-analytic-design
designclimi::transformed-design
mediumcenterx-axisy-axishalf-widthhalf-heightradius
if
gpu-medium-append-image-analytic-quadmediumdesigncenterx-axisy-axishalf-widthhalf-heightradius
call-next-method
defmethodgpu-medium-append-analytic-design
designmediumcenterx-axisy-axishalf-widthhalf-heightradius
handler-case
gpu-medium-append-analytic-quadmediumcenterx-axisy-axishalf-widthhalf-heightradius
multiple-value-list
color-rgbadesign
error
defuncoordinate-pairs
coordinates
loopfor
xy
on
coercecoordinates'list
by#'cddrwhileycollect
listxy
defungpu-medium-fill-convex-polygon
mediumpointscolor
when
>=
lengthpoints
3
let
origin
firstpoints
loopfortailon
restpoints
while
secondtail
do
gpu-medium-push-trianglemediumorigin
firsttail
secondtail
color
defgenericgpu-medium-append-painted-polygon
designmediumpoints
:documentation

Append one convex polygon using design's native paint path, or NIL.

defmethodgpu-medium-append-painted-polygon
designmediumpoints
declare
ignoredesignmediumpoints
nil
defungpu-medium-append-gradient-polygon
mediumgradientpoints
when
>=
lengthpoints
3
let*
vertices
gpu-medium-gradient-verticesmedium
first-vertex
/
lengthvertices
21
origin
firstpoints
flet
vertex
point
gpu-medium-push-gradient-analytic-vertexmediumgradient'
0.00.0
'
1.00.0
'
0.01.0
firstpoint
secondpoint
0.00.0-1.0
loopfortailon
restpoints
while
secondtail
do
vertexorigin
vertex
firsttail
vertex
secondtail
let
vertex-count
-
/
lengthvertices
21
first-vertex
vector-push-extend
make-gpu-gradient-analytic-command:first-vertexfirst-vertex:vertex-countvertex-count:clip
gpu-medium-commandsmedium
vertex-count
defungpu-medium-append-image-polygon
mediumdesignpoints
when
>=
lengthpoints
3
let*
vertices
gpu-medium-image-verticesmedium
first-vertex
/
lengthvertices
12
origin
firstpoints
flet
vertex
point
gpu-medium-push-image-vertexmediumdesign'
0.00.0
'
1.00.0
'
0.01.0
firstpoint
secondpoint
0.00.0-1.0
loopfortailon
restpoints
while
secondtail
do
vertexorigin
vertex
firsttail
vertex
secondtail
let
vertex-count
-
/
lengthvertices
12
first-vertex
vector-push-extend
make-gpu-image-command:designdesign:first-vertexfirst-vertex:vertex-countvertex-count:clip
gpu-medium-commandsmedium
vertex-count
defmethodgpu-medium-append-painted-polygon
designpattern
mediumpoints
defmethodgpu-medium-append-painted-polygon
designclimi::masked-compositum
mediumpoints
unless
typepdesign'climi::uniform-compositum
defmethodgpu-medium-append-painted-polygon
designclimi::transformed-design
mediumpoints
defungpu-medium-stroke-segment
mediumstartendthicknesscolor
let*
dx
-
firstend
firststart
dy
unless
zeroplength
let*
scale
/
*0.5thickness
length
ny
a
list
+
firststart
nx
+
secondstart
ny
b
list
-
firststart
nx
-
secondstart
ny
c
list
-
firstend
nx
-ny
d
list
+
firstend
nx
+ny

BASIC-MEDIUM deliberately implements these primitives in terms of its polygon leaf. The around methods retain that useful behavior while making the otherwise invisible decomposition measurable by the gallery.

defmethodmedium-draw-point*:around
with-gpu-medium-fallback
medium:point
call-next-methodmediumxy
defmethodmedium-draw-line*:around
x1y1x2y2
with-gpu-medium-fallback
medium:line
call-next-methodmediumx1y1x2y2
defmethodmedium-draw-rectangle*
x1y1x2y2filled
iffilled
let*
left
minx1x2
right
maxx1x2
top
miny1y2
bottom
maxy1y2
half-width
*0.5
-rightleft
half-height
*0.5
-bottomtop
unless
gpu-medium-append-analytic-design
medium-inkmedium
medium
list
*0.5
+leftright
*0.5
+topbottom
'
1.00.0
'
0.01.0
half-widthhalf-height0.0
with-gpu-medium-fallback
medium:rectangle
call-next-methodmediumx1y1x2y2filled
with-gpu-medium-fallback
medium:rectangle
call-next-methodmediumx1y1x2y2filled
medium
defuncomplete-ellipse-p
eta1eta2
>=
abs
-eta2eta1
-
*2pi
1.0e-6
defmethodmedium-draw-ellipse*
cxcyrdx1rdy1rdx2rdy2eta1eta2filled
if
andfilled
gpu-medium-append-analytic-design
medium-inkmedium
medium
listcxcy
listrdx1rdy1
listrdx2rdy2
1.01.01.0
medium
with-gpu-medium-fallback
medium:ellipse
call-next-methodmediumcxcyrdx1rdy1rdx2rdy2eta1eta2filled
defmethodclimi::medium-draw-circle*
cxcyradiuseta1eta2filled
if
andfilled
gpu-medium-append-analytic-design
medium-inkmedium
medium
listcxcy
listradius0.0
list0.0radius
1.01.01.0
medium
with-gpu-medium-fallback
medium:circle
call-next-methodmediumcxcyradiuseta1eta2filled
defgenericmedium-draw-analytic-rounded-rectangle*
mediumx1y1x2y2radiusfilled
:documentation

Draw the uniform-radius roundrect primitive when medium supports it.

defmethodmedium-draw-analytic-rounded-rectangle*
mediumx1y1x2y2radiusfilled
draw-rounded-rectangle*mediumx1y1x2y2:radiusradius:filledfilled

McCLIM's basic medium clears by composing the background over black, which is right for a raster that has no alpha and wrong for a medium whose destination is a live scene: a pane whose background has opacity zero should paint nothing, so a HUD title or a world bubble can float.

defmethodmedium-clear-area
lefttoprightbottom
draw-rectangle*mediumlefttoprightbottom:ink
medium-backgroundmedium
defunclear-raster-medium-reliefs
medium
setf
fill-pointer
raster-medium-reliefsmedium
0
medium
defmethodmedium-draw-analytic-rounded-rectangle*
x1y1x2y2radiusfilled
when
andfilled
typep
medium-inkmedium
'relief-design
let
transformation
medium-device-transformationmedium
with-bounding-rectangle*
lefttoprightbottom
transform-regiontransformation
make-rectangle*x1y1x2y2
multiple-value-bind
radius-xxradius-xy
transform-distancetransformationradius0
multiple-value-bind
radius-yxradius-yy
transform-distancetransformation0radius
vector-push-extend
make-surface-relief:x1left:y1top:x2right:y2bottom:radius
min
sqrt
+
*radius-xxradius-xx
*radius-xyradius-xy
sqrt
+
*radius-yxradius-yx
*radius-yyradius-yy
:height
relief-height
medium-inkmedium
raster-medium-reliefsmedium
call-next-method
defmethodmedium-draw-analytic-rounded-rectangle*
x1y1x2y2radiusfilled
iffilled
let*
left
minx1x2
right
maxx1x2
top
miny1y2
bottom
maxy1y2
half-width
*0.5
-rightleft
half-height
*0.5
-bottomtop
if
gpu-medium-append-analytic-design
medium-inkmedium
medium
list
*0.5
+leftright
*0.5
+topbottom
'
1.00.0
'
0.01.0
half-widthhalf-heightradius
medium
call-next-method
call-next-method

McCLIM's own DRAW-ROUNDED-RECTANGLE* is a convenience function whose decomposition loses the semantic primitive. Give this extension a real displayed output record so ordinary application panes retain and replay it as one command. DEF-GRECORDING supplies the standard ink/transformation capture and replay behavior used by McCLIM's built-in drawing operations.

climi::def-grecordingdraw-analytic-rounded-rectangle
climi::gs-transformation-mixin
x1y1x2y2radiusfilled
with-bounding-rectangle*
lefttoprightbottom
transform-region
medium-transformationstream
make-rectangle*x1y1x2y2
valueslefttoprightbottom

DEF-GRECORDING normally reaches a built-in medium operation through McCLIM's stream-forwarding methods. This is a new generic, so provide the equivalent drawing leg explicitly while retaining the generated recording leg and output-record class.

defmethodmedium-draw-analytic-rounded-rectangle*:around
streamoutput-recording-stream
x1y1x2y2radiusfilled
cond
stream-recording-pstream
let
record
make-instance'draw-analytic-rounded-rectangle-output-record:streamstream:x1x1:y1y1:x2x2:y2y2:radiusradius:filledfilled
stream-add-output-recordstreamrecord
stream-drawing-pstream
with-sheet-medium
mediumstream
medium-draw-analytic-rounded-rectangle*mediumx1y1x2y2radiusfilled
defundraw-analytic-rounded-rectangle*
sheetx1y1x2y2&restoptions&key
radius7
filledt
&allow-other-keys

Draw a roundrect as one backend primitive, with portable decomposition fallback.

apply#'invoke-with-drawing-optionssheet
lambda
medium
medium-draw-analytic-rounded-rectangle*mediumx1y1x2y2radiusfilled
options

The lattice primitive: a grid of unit cells as one analytic shape.

Drawn as many rectangles, every shared module edge is a compositing boundary: two half-covered fragments of the same ink OVER-composite to three quarters, a hairline that shimmers as the surface moves. As one primitive there is no interior boundary at all -- the fragment shader integrates the grid exactly over its own footprint (see hal/shader/lattice.lisp), so the drawing is seam-proof by construction rather than by alignment.

defungpu-medium-append-lattice-quad
mediummodulesx1y1x2y2color

Append modules as one exactly box-filtered lattice quad, or return NIL.

let*
rows
array-dimensionmodules0
columns
array-dimensionmodules1
when
and
plusprows
pluspcolumns
let*
x-axis
list
/
-x2x1
columns
0.0
y-axis
list0.0
/
-y2y1
rows
padding
gpu-medium-analytic-paddingmediumx-axisy-axis
whenpadding
let*
vertices
gpu-medium-analytic-verticesmedium
first-vertex
/
lengthvertices
12
origin
listx1y1
left
-padding
right
+columnspadding
top
-padding
bottom
+rowspadding
flet
vertex
xy
gpu-medium-push-analytic-vertexmediumoriginx-axisy-axisxycolumnsrows0.0color
vertexleftbottom
vertexrightbottom
vertexrighttop
vertexleftbottom
vertexrighttop
vertexlefttop
vector-push-extend
make-gpu-lattice-command:modulesmodules:first-vertexfirst-vertex:vertex-count6:clip
gpu-medium-commandsmedium
t
defgenericmedium-draw-lattice*
mediummodulesx1y1x2y2
:documentation

Draw modules -- a bit array of unit cells, 1 where inked -- filling the rectangle as one exactly filtered primitive when medium supports it. The medium's ink paints the inked cells, the zero cells are white paper, and the paper's edge is the primitive's own filtered boundary.

defmethodmedium-draw-lattice*
mediummodulesx1y1x2y2

Portable decomposition: white paper, then one rectangle per inked cell. Hairlines between adjacent cells are this decomposition's nature; a backend with the primitive has none.

let*
rows
array-dimensionmodules0
columns
array-dimensionmodules1
cell-width
/
-x2x1
columns
cell-height
/
-y2y1
rows
ink
medium-inkmedium
setf
medium-inkmedium
+white+
unwind-protect
medium-draw-rectangle*mediumx1y1x2y2t
setf
medium-inkmedium
ink
dotimes
rowrows
dotimes
columncolumns
when
=1
arefmodulesrowcolumn
let
left
+x1
*columncell-width
top
+y1
*rowcell-height
medium-draw-rectangle*mediumlefttop
+leftcell-width
+topcell-height
t
defmethodmedium-draw-lattice*
modulesx1y1x2y2
let
color
ignore-errors
unless
andcolor
gpu-medium-append-lattice-quadmediummodulesx1y1x2y2color
call-next-method
climi::def-grecordingdraw-lattice
climi::gs-transformation-mixin
modulesx1y1x2y2
with-bounding-rectangle*
lefttoprightbottom
transform-region
medium-transformationstream
make-rectangle*x1y1x2y2
valueslefttoprightbottom
defmethodmedium-draw-lattice*:around
streamoutput-recording-stream
modulesx1y1x2y2
cond
stream-recording-pstream
let
record
make-instance'draw-lattice-output-record:streamstream:modulesmodules:x1x1:y1y1:x2x2:y2y2
stream-add-output-recordstreamrecord
stream-drawing-pstream
with-sheet-medium
mediumstream
medium-draw-lattice*mediummodulesx1y1x2y2
defundraw-lattice*
sheetmodulesx1y1x2y2&restoptions

Draw a unit-cell bit grid as one exactly filtered backend primitive. INK paints the inked cells on white paper; the whole grid, paper edge included, is a single coverage computation, so nothing in it can seam.

apply#'invoke-with-drawing-optionssheet
lambda
medium
medium-draw-lattice*mediummodulesx1y1x2y2
options
defmethodmedium-draw-bezigon*:around
coordinatesclosedfilled
with-gpu-medium-fallback
medium:bezigon
call-next-methodmediumcoordinatesclosedfilled
defmethodmedium-draw-pattern*
patternxy
let
width
pattern-widthpattern
height
pattern-heightpattern
gpu-medium-append-analytic-design
transform-region
make-translation-transformationxy
pattern
medium
list
'
1.00.0
'
0.01.0
0.0
medium
defmethodmedium-draw-polygon*
coordinatesclosedfilled
let
points
coordinate-pairscoordinates
note-gpu-medium-fallbackmedium:polygon-points
lengthpoints
let
painted-vertex-count
andfilled
gpu-medium-append-painted-polygon
medium-inkmedium
mediumpoints
first-vertex
/
length
gpu-medium-verticesmedium
6
unlesspainted-vertex-count
let
color
iffilled
let
thickness
line-style-effective-thickness
medium-line-stylemedium
medium
loopfor
startend
onpointswhileenddo
gpu-medium-stroke-segmentmediumstartendthicknesscolor
when
andclosed
>
lengthpoints
2
gpu-medium-stroke-segmentmedium
car
lastpoints
firstpoints
thicknesscolor
let
vertex-count
orpainted-vertex-count
-
/
length
gpu-medium-verticesmedium
6
first-vertex
when
pluspvertex-count
note-gpu-medium-fallbackmedium:gpu-triangles
/vertex-count3
unlesspainted-vertex-count
vector-push-extend
make-gpu-solid-command:first-vertexfirst-vertex:vertex-countvertex-count:clip
gpu-medium-commandsmedium
medium
defmethodinvoke-with-output-buffered
continuation&optionalbuffered-p
declare
ignoremediumbuffered-p

Pane-local buffering is not a frame boundary. McCLIM gives every pane a distinct medium, so only repaint-gpu-mirror may clear, join, and publish their retained streams in painter order.

funcallcontinuation
defungpu-sheet-paint-order
sheet

Return sheet and descendants in McCLIM's repaint painter order.

conssheet
mapcan#'gpu-sheet-paint-order
reverse
sheet-childrensheet
defungpu-sheet-presentation-medium
sheet

Return sheet's actual drawing medium, outside any recording context.

if
typepsheet'output-recording-stream
with-output-recording-options
sheet:recordnil:drawt
sheet-mediumsheet
sheet-mediumsheet
defmethodrebase-gpu-command
offsets
make-gpu-solid-command:first-vertex
+
gpu-command-offsets-vertexoffsets
gpu-solid-command-first-vertexcommand
:vertex-count
gpu-solid-command-vertex-countcommand
:clip
gpu-solid-command-clipcommand
defmethodrebase-gpu-command
offsets
make-gpu-analytic-command:first-vertex
+
gpu-command-offsets-analyticoffsets
gpu-analytic-command-first-vertexcommand
:vertex-count
gpu-analytic-command-vertex-countcommand
:clip
gpu-analytic-command-clipcommand
defmethodrebase-gpu-command
offsets
make-gpu-lattice-command:modules
gpu-lattice-command-modulescommand
:first-vertex
+
gpu-command-offsets-analyticoffsets
gpu-lattice-command-first-vertexcommand
:vertex-count
gpu-lattice-command-vertex-countcommand
:clip
gpu-lattice-command-clipcommand
defmethodrebase-gpu-command
make-gpu-relief-analytic-command:first-vertex
+
gpu-command-offsets-reliefoffsets
gpu-relief-analytic-command-first-vertexcommand
:vertex-count
gpu-relief-analytic-command-vertex-countcommand
:clip
gpu-relief-analytic-command-clipcommand
defmethodrebase-gpu-command
make-gpu-gradient-analytic-command:first-vertex
+
gpu-command-offsets-gradientoffsets
gpu-gradient-analytic-command-first-vertexcommand
:vertex-count
gpu-gradient-analytic-command-vertex-countcommand
:clip
gpu-gradient-analytic-command-clipcommand
defmethodrebase-gpu-command
offsets
make-gpu-image-command:design
gpu-image-command-designcommand
:first-vertex
+
gpu-command-offsets-imageoffsets
gpu-image-command-first-vertexcommand
:vertex-count
gpu-image-command-vertex-countcommand
:clip
gpu-image-command-clipcommand
defmethodrebase-gpu-command
offsets
declare
ignoreoffsets
command
luv:zdefun
compose-gpu-mirror-media:zone:mcluv/compose
mirror&optional
source-sheet
mirror-sheetmirror
"Join SOURCE-SHEET's drawing streams into MIRROR's presentation buffer."
let*
media
remove-duplicates
remove-if-not
lambda
medium
typepmedium'luv-gpu-medium
:test#'eq
target-medium
snapshots
mapcar
lambda
medium
list
copy-seq
gpu-medium-verticesmedium
copy-seq
gpu-medium-analytic-verticesmedium
copy-seq
gpu-medium-relief-verticesmedium
copy-seq
gpu-medium-gradient-verticesmedium
copy-seq
gpu-medium-image-verticesmedium
copy-seq
gpu-medium-commandsmedium
media
setf
fill-pointer
gpu-medium-verticestarget-medium
0
fill-pointer
gpu-medium-analytic-verticestarget-medium
0
fill-pointer
gpu-medium-relief-verticestarget-medium
0
fill-pointer
gpu-medium-gradient-verticestarget-medium
0
fill-pointer
gpu-medium-image-verticestarget-medium
0
fill-pointer
gpu-medium-commandstarget-medium
0
dolist
snapshotsnapshots
let
offsets
make-gpu-command-offsets:vertex
/
length
gpu-medium-verticestarget-medium
6
:analytic
/
length
gpu-medium-analytic-verticestarget-medium
12
:relief
/
length
gpu-medium-relief-verticestarget-medium
15
:gradient
/
length
gpu-medium-gradient-verticestarget-medium
21
:image
/
length
gpu-medium-image-verticestarget-medium
12
loopforcommandacross
sixthsnapshot
do
vector-push-extend
rebase-gpu-commandcommandoffsets
gpu-medium-commandstarget-medium
loopforvalueacross
firstsnapshot
do
vector-push-extendvalue
gpu-medium-verticestarget-medium
loopforvalueacross
secondsnapshot
do
vector-push-extendvalue
gpu-medium-analytic-verticestarget-medium
loopforvalueacross
thirdsnapshot
do
vector-push-extendvalue
gpu-medium-relief-verticestarget-medium
loopforvalueacross
fourthsnapshot
do
vector-push-extendvalue
gpu-medium-gradient-verticestarget-medium
loopforvalueacross
fifthsnapshot
do
vector-push-extendvalue
gpu-medium-image-verticestarget-medium
target-medium
defunpresent-gpu-mirror-sheet
mirrorsheet

Publish sheet's retained semantic stream through embedded GPU mirror.

check-typemirrorluv-gpu-mirror
mirror
defuncall-with-gpu-mirror-sheet-repaint
mirrorsheetfunction

Replace sheet's retained streams with one redraw, then publish mirror.

check-typemirrorluv-gpu-mirror
let
media
remove-duplicates
remove-if-not
lambda
medium
typepmedium'luv-gpu-medium
:test#'eq
dolist
mediummedia
setf
fill-pointer
gpu-medium-verticesmedium
0
fill-pointer
gpu-medium-analytic-verticesmedium
0
fill-pointer
gpu-medium-relief-verticesmedium
0
fill-pointer
gpu-medium-gradient-verticesmedium
0
fill-pointer
gpu-medium-image-verticesmedium
0
fill-pointer
gpu-medium-commandsmedium
0
incf
gpu-medium-buffering-depthmedium
unwind-protect
funcallfunction
dolist
mediummedia
decf
gpu-medium-buffering-depthmedium
luv:zdefun
repaint-gpu-mirror:zone:mcluv/repaint
mirror&key
present-pt
"Rebuild MIRROR's retained triangle stream as one complete McCLIM frame."
let*
sheet
mirror-sheetmirror
media
remove-duplicates
remove-if-not
lambda
medium
typepmedium'luv-gpu-medium
:test#'eq
dolist
mediummedia
setf
fill-pointer
gpu-medium-verticesmedium
0
setf
fill-pointer
gpu-medium-analytic-verticesmedium
0
setf
fill-pointer
gpu-medium-relief-verticesmedium
0
setf
fill-pointer
gpu-medium-gradient-verticesmedium
0
setf
fill-pointer
gpu-medium-image-verticesmedium
0
setf
fill-pointer
gpu-medium-commandsmedium
0
incf
gpu-medium-buffering-depthmedium
unwind-protect
repaint-sheetsheet+everywhere+
dolist
mediummedia
decf
gpu-medium-buffering-depthmedium

Each pane owns a semantic medium, but one mirror owns the ordered GPU frame. The top-level stream is its compact presentation buffer.

whenpresent-p
defmethodservice-luv-frame-events
let*
sheet
mirror-sheetmirror
frame
pane-framesheet
unless
climi::frame-processframe
defmethodenable-mirror
sheetmirrored-sheet-mixin
declare
ignoreport
alexandria:when-let
mirror
sheet-direct-mirrorsheet
unless
or
mirror-embedded-pmirror
*suppress-luv-mirror-visibility*
luv:show-canvas
mirror-targetmirror

Which TrueType file a CLIM text style means. DejaVu ships with the system and is always there; a nicer face takes over the :SANS-SERIF family -- the default face of every McCLIM pane here -- when it can be found. The checkout bundles Iosevka Aile (OFL, subset to the Latin, Greek, Cyrillic, punctuation, arrow, and symbol ranges a game UI needs) beside Monaspace in FONTS/; a face may also be dropped into the user's own fonts, and DejaVu stands in otherwise.

defparameter*bundled-fonts-directory*
asdf:system-relative-pathname"luv/mcclim""fonts/"
"The checkout's bundled fonts, captured while the system is loaded."
defunuser-font-pathname
name

The font file name from the bundled fonts, else the user's own fonts, else NIL.

or
probe-file
merge-pathnamesname*bundled-fonts-directory*
probe-file
merge-pathnames
formatnil"Library/Fonts/~A"name
user-homedir-pathname
defparameter*sans-serif-font-preferences*'
"Iosevka Aile""IosevkaAile-Regular.ttf""IosevkaAile-Bold.ttf""IosevkaAile-Italic.ttf""IosevkaAile-BoldItalic.ttf"
"Input Sans""InputSans-Regular.ttf""InputSans-Bold.ttf""InputSans-Italic.ttf""InputSans-BoldItalic.ttf"

Families to try for :SANS-SERIF, best first: a name and the regular, bold, italic, and bold-italic files looked for in the bundled and then the user's fonts. Italics are optional; the upright stands in.

defparameter*gpu-sans-serif-fonts*
cons
cl-dejavu:font-pathname"DejaVuSans.ttf"
cl-dejavu:font-pathname"DejaVuSans-Bold.ttf"

The regular and bold files behind the :SANS-SERIF family on the GPU text path; adopt-user-sans-serif-fonts retargets them.

defvar*adopted-sans-serif-family*

DejaVu Sans

"The name of the family :SANS-SERIF currently resolves to."
defunadopt-user-sans-serif-fonts

Point both text paths' :SANS-SERIF at the best installed preference.

The GPU medium reads *GPU-SANS-SERIF-FONTS*; the raster medium goes through MCCLIM-RENDER's *FAMILIES/FACES* table, so that is retargeted too, and any raster port already open forgets the faces it had cached. Returns the family name adopted.

loopfor
nameregularbolditalicbold-italic
in*sans-serif-font-preferences*forregular-file=forbold-file=when
andregular-filebold-file
do
setf*gpu-sans-serif-fonts*
consregular-filebold-file
*adopted-sans-serif-family*name
flet
retarget
keypathname
whenpathname
let
entry
assockeymcclim-truetype:*families/faces*:test#'equal
ifentry
setf
cdrentry
pathname
push
conskeypathname
mcclim-truetype:*families/faces*
retarget'
:sans-serif:roman
regular-file
retarget'
:sans-serif:bold
bold-file
retarget'
:sans-serif:italic
orregular-file
retarget'
:sans-serif
:bold:italic
orbold-file
retarget'
:sans-serif
:italic:bold
orbold-file
dolist
portclimi::*all-ports*
when
typepport'mcclim-truetype:ttf-port-mixin
mcclim-truetype::invalidate-port-font-cacheport

The basic port keeps its own memo of style to font on top of the TrueType caches; without clearing it the old faces keep being served.

clrhash
climi::port-text-style-mappingsport
returnname
finally
defungpu-text-font-pathname
text-style
multiple-value-bind
familyfacesize
text-style-components
climb:parse-text-style*text-style
declare
ignoresize
let
bold-p
member:bold
if
listpface
face
listface
cond
eqfamily:fix
cl-dejavu:font-pathname"DejaVuSansMono.ttf"
eqfamily:serif
cl-dejavu:font-pathname
ifbold-p"DejaVuSerif-Bold.ttf""DejaVuSerif.ttf"
defungpu-text-style-size
text-style
nth-value2
text-style-components
climb:parse-text-style*text-style
defungpu-font-metric
text-stylereader
let
pathname
size
let
*size
/
funcallreaderfont
zpb-ttf:units/emfont
defmethodtext-style-ascent
text-style
declare
ignoremedium
gpu-font-metrictext-style#'zpb-ttf:ascender
defmethodtext-style-descent
text-style
declare
ignoremedium
-
gpu-font-metrictext-style#'zpb-ttf:descender
defmethodtext-style-character-width
text-stylecharacter
nth-value0
text-sizemedium
stringcharacter
:text-styletext-style
defmethodtext-size
string&keytext-style
start0
end
declare
ignoremedium
let*
text-style
climb:parse-text-style*
merge-text-stylestext-style*default-text-style*
text
subseq
stringstring
startend
size
unit
/size
luv.slug:slug-shaped-text-units-per-emshaped
width
*unit
luv.slug:slug-shaped-text-x-advanceshaped
ascent
gpu-font-metrictext-style#'zpb-ttf:ascender
descent
-
gpu-font-metrictext-style#'zpb-ttf:descender
valueswidth
+ascentdescent
width0ascent
defmethodtext-bounding-rectangle*
string&keytext-style
start0
end
multiple-value-bind
widthheightcursor-dxcursor-dybaseline
text-sizemediumstring:text-styletext-style:startstart:endend
values0
-baseline
width
-heightbaseline
cursor-dxcursor-dy
defmethodmedium-draw-text*
stringxystartendalign-xalign-ytoward-xtoward-ytransform-glyphs
declare
ignoretoward-xtoward-ytransform-glyphs
let*
string
stringstring
end
min
orend
lengthstring
lengthstring
text
subseqstringstartend
style
climb:parse-text-style*
merge-text-styles
medium-text-stylemedium
*default-text-style*
color
multiple-value-bind
device-xdevice-y
transform-position
medium-device-transformationmedium
xy
unless
zerop
lengthtext
vector-push-extend
make-gpu-text-command:stringtext:xdevice-x:ydevice-y:font-pathname:size:colorcolor:align-xalign-x:align-yalign-y:clip
gpu-medium-commandsmedium
nil
defunensure-gpu-mirror-context
mirror&keyreadback-p
when
mirror-embedded-pmirror
return-fromensure-gpu-mirror-context
mirror-contextmirror
let*
target
mirror-targetmirror
usage
ifreadback-p'
:render-attachment:copy-src
'
:render-attachment
device
or
mirror-devicemirror
context
or
mirror-contextmirror
setf
mirror-contextmirror
luv:make-canvas-contexttargetluv:*gpu-provider*
luv:make-canvas-configuration:devicedevice:usageusage
multiple-value-bind
unless
and
equalusage
luv:canvas-configuration-usage
luv::canvas-context-configurationcontext
luv:configure-canvas-contextcontext
luv:make-canvas-configuration:devicedevice:format:usageusage
context
defunrelease-gpu-mirror-pipeline
mirror
maphash
lambda
designpaint
declare
ignoredesign
alexandria:when-let
group
gpu-image-paint-bind-grouppaint
luv:destroy
gpu-image-paint-viewpaint
luv:destroy
gpu-image-paint-texturepaint
gpu-mirror-image-paintsmirror
clrhash
gpu-mirror-image-paintsmirror
maphash
lambda
modulespaint
declare
ignoremodules
alexandria:when-let
group
gpu-lattice-paint-bind-grouppaint
luv:destroy
gpu-lattice-paint-viewpaint
luv:destroy
gpu-lattice-paint-texturepaint
gpu-mirror-lattice-paintsmirror
clrhash
gpu-mirror-lattice-paintsmirror
maphash
lambda
atlasgroup
declare
ignoreatlas
gpu-mirror-text-bind-groupsmirror
clrhash
gpu-mirror-text-bind-groupsmirror
alexandria:when-let
cache
gpu-mirror-slug-cachemirror
dolist
resource
list
gpu-mirror-pipelinemirror
gpu-mirror-analytic-pipelinemirror
gpu-mirror-relief-pipelinemirror
gpu-mirror-gradient-analytic-pipelinemirror
gpu-mirror-image-pipelinemirror
gpu-mirror-text-pipelinemirror
gpu-mirror-bind-groupmirror
gpu-mirror-uniform-buffermirror
gpu-mirror-text-fragment-modulemirror
gpu-mirror-text-vertex-modulemirror
gpu-mirror-text-layoutmirror
gpu-mirror-fragment-modulemirror
gpu-mirror-vertex-modulemirror
gpu-mirror-analytic-fragment-modulemirror
gpu-mirror-analytic-vertex-modulemirror
gpu-mirror-relief-fragment-modulemirror
gpu-mirror-relief-vertex-modulemirror
gpu-mirror-gradient-analytic-fragment-modulemirror
gpu-mirror-gradient-analytic-vertex-modulemirror
gpu-mirror-image-samplermirror
gpu-mirror-image-fragment-modulemirror
gpu-mirror-image-vertex-modulemirror
gpu-mirror-image-layoutmirror
gpu-mirror-lattice-pipelinemirror
gpu-mirror-lattice-fragment-modulemirror
gpu-mirror-lattice-vertex-modulemirror
gpu-mirror-lattice-layoutmirror
gpu-mirror-layoutmirror
whenresource
luv:destroyresource
setf
gpu-mirror-pipelinemirror
nil
gpu-mirror-fragment-modulemirror
nil
gpu-mirror-vertex-modulemirror
nil
gpu-mirror-analytic-pipelinemirror
nil
gpu-mirror-analytic-fragment-modulemirror
nil
gpu-mirror-analytic-vertex-modulemirror
nil
gpu-mirror-relief-pipelinemirror
nil
gpu-mirror-relief-fragment-modulemirror
nil
gpu-mirror-relief-vertex-modulemirror
nil
gpu-mirror-gradient-analytic-pipelinemirror
nil
gpu-mirror-gradient-analytic-fragment-modulemirror
nil
gpu-mirror-gradient-analytic-vertex-modulemirror
nil
gpu-mirror-image-pipelinemirror
nil
gpu-mirror-image-samplermirror
nil
gpu-mirror-image-fragment-modulemirror
nil
gpu-mirror-image-vertex-modulemirror
nil
gpu-mirror-image-layoutmirror
nil
gpu-mirror-lattice-pipelinemirror
nil
gpu-mirror-lattice-fragment-modulemirror
nil
gpu-mirror-lattice-vertex-modulemirror
nil
gpu-mirror-lattice-layoutmirror
nil
gpu-mirror-layoutmirror
nil
gpu-mirror-uniform-buffermirror
nil
gpu-mirror-bind-groupmirror
nil
gpu-mirror-formatmirror
nil
gpu-mirror-slug-cachemirror
nil
gpu-mirror-text-pipelinemirror
nil
gpu-mirror-text-fragment-modulemirror
nil
gpu-mirror-text-vertex-modulemirror
nil
gpu-mirror-text-layoutmirror
nil
defunensure-gpu-mirror-analytic-pipeline
mirrordeviceformat
unless
gpu-mirror-analytic-pipelinemirror
let
vertexnil
fragmentnil
pipelinenil
completed-pnil
unwind-protect
progn
setfvertex
luv:createdevice
luv:make-shader-module-descriptor:label"McCLIM analytic vertex":language:mathematical:code
fragment
luv:createdevice
luv:make-shader-module-descriptor:label"McCLIM analytic fragment":language:mathematical:code
pipeline
luv:createdevice
luv:make-render-pipeline-descriptor:label"direct McCLIM analytic shapes":layout
gpu-mirror-layoutmirror
:vertex`
:module,vertex:buffers
:array-stride48:attributes
:shader-location0:offset0:format:float32x3
:shader-location1:offset12:format:float32x3
:shader-location2:offset24:format:float32x3
:shader-location3:offset36:format:float32x3
:fragment`
:module,fragment:targets
:format,format:blend:premultiplied-alpha
:primitive'
:topology:triangle-list
setf
gpu-mirror-analytic-vertex-modulemirror
vertex
gpu-mirror-analytic-fragment-modulemirror
fragment
gpu-mirror-analytic-pipelinemirror
pipeline
completed-pt
unlesscompleted-p
dolist
resource
removenil
listpipelinefragmentvertex
luv:destroyresource
defunensure-gpu-mirror-relief-pipeline
mirrordeviceformat
unless
gpu-mirror-relief-pipelinemirror
let
vertexnil
fragmentnil
pipelinenil
completed-pnil
unwind-protect
progn
setfvertex
luv:createdevice
luv:make-shader-module-descriptor:label"McCLIM relief vertex":language:mathematical:code
fragment
luv:createdevice
luv:make-shader-module-descriptor:label"McCLIM relief fragment":language:mathematical:code
pipeline
luv:createdevice
luv:make-render-pipeline-descriptor:label"direct McCLIM analytical relief":layout
gpu-mirror-layoutmirror
:vertex`
:module,vertex:buffers
:array-stride60:attributes
:shader-location0:offset0:format:float32x3
:shader-location1:offset12:format:float32x3
:shader-location2:offset24:format:float32x3
:shader-location3:offset36:format:float32x3
:shader-location4:offset48:format:float32x3
:fragment`
:module,fragment:targets
:format,format:blend:premultiplied-alpha
:primitive'
:topology:triangle-list
setf
gpu-mirror-relief-vertex-modulemirror
vertex
gpu-mirror-relief-fragment-modulemirror
fragment
gpu-mirror-relief-pipelinemirror
pipeline
completed-pt
unlesscompleted-p
dolist
resource
removenil
listpipelinefragmentvertex
luv:destroyresource
defunensure-gpu-mirror-image-pipeline
mirrordeviceformat
unless
gpu-mirror-image-pipelinemirror
let
vertexnil
fragmentnil
samplernil
pipelinenil
completed-pnil
unwind-protect
progn
setfvertex
luv:createdevice
luv:make-shader-module-descriptor:label"McCLIM image analytic vertex":language:mathematical:code
fragment
luv:createdevice
luv:make-shader-module-descriptor:label"McCLIM image analytic fragment":language:mathematical:code
layout
luv:createdevice
luv:make-bind-group-layout-descriptor:label"McCLIM image paint layout":entries'
:binding0:type:texture
:binding1:type:sampler
sampler
luv:createdevice
luv:make-sampler-descriptor:label"McCLIM image paint linear sampler"
pipeline
luv:createdevice
luv:make-render-pipeline-descriptor:label"direct McCLIM image paints":layoutlayout:vertex`
:module,vertex:buffers
:array-stride48:attributes
:shader-location0:offset0:format:float32x3
:shader-location1:offset12:format:float32x3
:shader-location2:offset24:format:float32x3
:shader-location3:offset36:format:float32x3
:fragment`
:module,fragment:targets
:format,format:blend:premultiplied-alpha
:primitive'
:topology:triangle-list
setf
gpu-mirror-image-vertex-modulemirror
vertex
gpu-mirror-image-fragment-modulemirror
fragment
gpu-mirror-image-layoutmirror
layout
gpu-mirror-image-samplermirror
sampler
gpu-mirror-image-pipelinemirror
pipeline
completed-pt
unlesscompleted-p
dolist
resource
removenil
listpipelinesamplerlayoutfragmentvertex
luv:destroyresource
defunensure-gpu-mirror-gradient-analytic-pipeline
mirrordeviceformat
unless
gpu-mirror-gradient-analytic-pipelinemirror
let
vertexnil
fragmentnil
pipelinenil
completed-pnil
unwind-protect
progn
setfvertex
luv:createdevice
luv:make-shader-module-descriptor:label"McCLIM gradient analytic vertex":language:mathematical:code
fragment
luv:createdevice
luv:make-shader-module-descriptor:label"McCLIM gradient analytic fragment":language:mathematical:code
pipeline
luv:createdevice
luv:make-render-pipeline-descriptor:label"direct McCLIM gradient analytic shapes":layout
gpu-mirror-layoutmirror
:vertex`
:module,vertex:buffers
:array-stride84:attributes
:shader-location0:offset0:format:float32x3
:shader-location1:offset12:format:float32x3
:shader-location2:offset24:format:float32x3
:shader-location3:offset36:format:float32x3
:shader-location4:offset48:format:float32x3
:shader-location5:offset60:format:float32x3
:shader-location6:offset72:format:float32x3
:fragment`
:module,fragment:targets
:format,format:blend:premultiplied-alpha
:primitive'
:topology:triangle-list
setf
gpu-mirror-gradient-analytic-vertex-modulemirror
vertex
gpu-mirror-gradient-analytic-fragment-modulemirror
fragment
gpu-mirror-gradient-analytic-pipelinemirror
pipeline
completed-pt
unlesscompleted-p
dolist
resource
removenil
listpipelinefragmentvertex
luv:destroyresource
defunensure-gpu-mirror-lattice-pipeline
mirrordeviceformat

The lattice family reuses the analytic vertex stage and vertex layout wholesale -- its vertices live in the analytic buffer -- and differs only in the fragment stage and the summed-area texture it reads.

unless
gpu-mirror-lattice-pipelinemirror
let
vertexnil
fragmentnil
pipelinenil
completed-pnil
unwind-protect
progn
setfvertex
luv:createdevice
luv:make-shader-module-descriptor:label"McCLIM lattice vertex":language:mathematical:code
fragment
luv:createdevice
luv:make-shader-module-descriptor:label"McCLIM lattice fragment":language:mathematical:code
layout
luv:createdevice
luv:make-bind-group-layout-descriptor:label"McCLIM lattice table":entries'
:binding0:type:texture
pipeline
luv:createdevice
luv:make-render-pipeline-descriptor:label"direct McCLIM lattice":layoutlayout:vertex`
:module,vertex:buffers
:array-stride48:attributes
:shader-location0:offset0:format:float32x3
:shader-location1:offset12:format:float32x3
:shader-location2:offset24:format:float32x3
:shader-location3:offset36:format:float32x3
:fragment`
:module,fragment:targets
:format,format:blend:premultiplied-alpha
:primitive'
:topology:triangle-list
setf
gpu-mirror-lattice-vertex-modulemirror
vertex
gpu-mirror-lattice-fragment-modulemirror
fragment
gpu-mirror-lattice-layoutmirror
layout
gpu-mirror-lattice-pipelinemirror
pipeline
completed-pt
unlesscompleted-p
dolist
resource
removenil
listpipelinelayoutfragmentvertex
luv:destroyresource
defunensure-gpu-mirror-text-pipeline
mirrordeviceformat
unless
gpu-mirror-text-pipelinemirror
let
vertexnil
fragmentnil
pipelinenil
completed-pnil
unwind-protect
progn
setfvertex
luv:createdevice
luv:make-shader-module-descriptor:label"McCLIM Slug vertex":language:mathematical:code
fragment
luv:createdevice
luv:make-shader-module-descriptor:label"McCLIM Slug fragment":language:mathematical:code
layout
luv:createdevice
luv:make-bind-group-layout-descriptor:label"McCLIM Slug atlases":entries'
:binding0:type:texture
:binding1:type:texture
pipeline
luv:createdevice
luv:make-render-pipeline-descriptor:label"direct McCLIM Slug text":layoutlayout:vertex`
:module,vertex:buffers
:array-stride72:attributes
:shader-location0:offset0:format:float32x3
:shader-location1:offset12:format:float32x3
:shader-location2:offset24:format:float32x3
:shader-location3:offset36:format:float32x3
:shader-location4:offset48:format:float32x3
:shader-location5:offset60:format:float32x3
:fragment`
:module,fragment:targets
:format,format:blend:premultiplied-alpha
:primitive'
:topology:triangle-list
setf
gpu-mirror-text-vertex-modulemirror
vertex
gpu-mirror-text-fragment-modulemirror
fragment
gpu-mirror-text-layoutmirror
layout
gpu-mirror-text-pipelinemirror
pipeline
gpu-mirror-slug-cachemirror
completed-pt
unlesscompleted-p
dolist
resource
removenil
listpipelinelayoutfragmentvertex
luv:destroyresource
defunensure-gpu-mirror-pipeline
mirrorcontext
let
unless
and
gpu-mirror-pipelinemirror
eqformat
gpu-mirror-formatmirror
let*
vertex
luv:createdevice
luv:make-shader-module-descriptor:label"McCLIM solid vertex":language:mathematical:code
fragmentnil
uniform-buffernil
bind-groupnil
pipelinenil
completed-pnil
unwind-protect
progn
setffragment
luv:createdevice
luv:make-shader-module-descriptor:label"McCLIM solid fragment":language:mathematical:code
shader:shader-specification-for:mcluv-solid:fragment
layout
luv:createdevice
luv:make-bind-group-layout-descriptor:label"direct McCLIM frame layout":entries'
:binding0:type:uniform-buffer
uniform-buffer
luv:createdevice
luv:make-buffer-descriptor:label"direct McCLIM frame placeholder":size16:usage'
:uniform:copy-dst
bind-group
luv:createdevice
luv:make-bind-group-descriptor:label"direct McCLIM frame bindings":layoutlayout:entries`
:binding0:resource,uniform-buffer
pipeline
luv:createdevice
luv:make-render-pipeline-descriptor:label"direct McCLIM solid geometry":layoutlayout:vertex`
:module,vertex:buffers
:array-stride24:attributes
:shader-location0:offset0:format:float32x3
:shader-location1:offset12:format:float32x3
:fragment`
:module,fragment:targets
:format,format:blend:premultiplied-alpha
:primitive'
:topology:triangle-list
setf
gpu-mirror-vertex-modulemirror
vertex
gpu-mirror-fragment-modulemirror
fragment
gpu-mirror-layoutmirror
layout
gpu-mirror-uniform-buffermirror
uniform-buffer
gpu-mirror-bind-groupmirror
bind-group
gpu-mirror-pipelinemirror
pipeline
gpu-mirror-formatmirror
format
completed-pt
unlesscompleted-p
dolist
resource
removenil
listpipelinebind-groupuniform-bufferlayoutfragmentvertex
luv:destroyresource

Keep live mirrors honest when a new pipeline family is introduced after their solid pipeline already exists.

defunensure-embedded-gpu-mirror-preparation-resources
mirrordevice

Create only what a textureless mirror needs to prepare its commands.

unless
gpu-mirror-slug-cachemirror
setf
gpu-mirror-slug-cachemirror
mirror
defunensure-gpu-mirror-frame-state
mirrorcontextsurface
let*
state
gethashkey
gpu-mirror-frame-statesmirror
ifstate
unless
eqsurface
luv:gpu-texture-view-texture
gpu-frame-state-viewstate

Metal presents each drawable through a fresh borrowed texture wrapper. Keep the stable slot's buffer, but refresh the cheap view so it never retains the destroyed wrapper from the prior frame.

luv:destroy
gpu-frame-state-viewstate
setf
gpu-frame-state-viewstate
luv:create
luv:make-texture-view-descriptor:texturesurface
setfstate
make-instance'gpu-mirror-frame-state:mirrormirror:view
luv:create
luv:make-texture-view-descriptor:texturesurface
gethashkey
gpu-mirror-frame-statesmirror
state

Also repairs states retained across a live class redefinition which introduced the owner slot.

setf
gpu-frame-state-mirrorstate
mirror
state
luv:zdefun
upload-gpu-prepared-frame-revision:zone:mcluv/upload:value
*4
+
length
gpu-prepared-frame-verticesrevision
length
gpu-prepared-frame-analytic-verticesrevision
length
gpu-prepared-frame-relief-verticesrevision
length
gpu-prepared-frame-gradient-verticesrevision
length
gpu-prepared-frame-image-verticesrevision
length
gpu-prepared-frame-text-datarevision
statedevicerevision
"Materialize immutable CPU REVISION into one destination frame STATE."
flet
upload
dataensure-buffer
when
plusp
lengthdata
let
buffer
funcallensure-bufferstatedevice
*4
lengthdata
upload
gpu-prepared-frame-verticesrevision
#'ensure-gpu-frame-vertex-buffer
upload
gpu-prepared-frame-analytic-verticesrevision
#'ensure-gpu-frame-analytic-buffer
upload
gpu-prepared-frame-relief-verticesrevision
#'ensure-gpu-frame-relief-buffer
upload
gpu-prepared-frame-gradient-verticesrevision
#'ensure-gpu-frame-gradient-buffer
upload
gpu-prepared-frame-image-verticesrevision
#'ensure-gpu-frame-image-buffer
upload
gpu-prepared-frame-text-datarevision
#'ensure-gpu-frame-text-buffer
state
defunensure-gpu-frame-vertex-buffer
statedevicebyte-count
when
>byte-count
gpu-frame-state-vertex-capacitystate
let*
capacity
ash1
integer-length
max1
1-byte-count
replacement
luv:createdevice
luv:make-buffer-descriptor:label"direct McCLIM vertices":sizecapacity:usage'
:vertex:copy-dst
alexandria:when-let
old
gpu-frame-state-vertex-bufferstate
setf
gpu-frame-state-vertex-bufferstate
replacement
gpu-frame-state-vertex-capacitystate
capacity
gpu-frame-state-vertex-bufferstate
defunensure-gpu-frame-text-buffer
statedevicebyte-count
when
>byte-count
gpu-frame-state-text-capacitystate
let*
capacity
ash1
integer-length
max1
1-byte-count
replacement
luv:createdevice
luv:make-buffer-descriptor:label"direct McCLIM Slug vertices":sizecapacity:usage'
:vertex:copy-dst
alexandria:when-let
old
gpu-frame-state-text-bufferstate
setf
gpu-frame-state-text-bufferstate
replacement
gpu-frame-state-text-capacitystate
capacity
gpu-frame-state-text-bufferstate
defunensure-gpu-frame-analytic-buffer
statedevicebyte-count
when
>byte-count
gpu-frame-state-analytic-capacitystate
let*
capacity
ash1
integer-length
max1
1-byte-count
replacement
luv:createdevice
luv:make-buffer-descriptor:label"direct McCLIM analytic vertices":sizecapacity:usage'
:vertex:copy-dst
alexandria:when-let
old
gpu-frame-state-analytic-bufferstate
setf
gpu-frame-state-analytic-bufferstate
replacement
gpu-frame-state-analytic-capacitystate
capacity
gpu-frame-state-analytic-bufferstate
defunensure-gpu-frame-relief-buffer
statedevicebyte-count
when
>byte-count
gpu-frame-state-relief-capacitystate
let*
capacity
ash1
integer-length
max1
1-byte-count
replacement
luv:createdevice
luv:make-buffer-descriptor:label"direct McCLIM relief vertices":sizecapacity:usage'
:vertex:copy-dst
alexandria:when-let
old
gpu-frame-state-relief-bufferstate
setf
gpu-frame-state-relief-bufferstate
replacement
gpu-frame-state-relief-capacitystate
capacity
gpu-frame-state-relief-bufferstate
defunensure-gpu-frame-gradient-buffer
statedevicebyte-count
when
>byte-count
gpu-frame-state-gradient-capacitystate
let*
capacity
ash1
integer-length
max1
1-byte-count
replacement
luv:createdevice
luv:make-buffer-descriptor:label"direct McCLIM gradient vertices":sizecapacity:usage'
:vertex:copy-dst
alexandria:when-let
old
gpu-frame-state-gradient-bufferstate
setf
gpu-frame-state-gradient-bufferstate
replacement
gpu-frame-state-gradient-capacitystate
capacity
gpu-frame-state-gradient-bufferstate
defunensure-gpu-frame-image-buffer
statedevicebyte-count
when
>byte-count
gpu-frame-state-image-capacitystate
let*
capacity
ash1
integer-length
max1
1-byte-count
replacement
luv:createdevice
luv:make-buffer-descriptor:label"direct McCLIM image paint vertices":sizecapacity:usage'
:vertex:copy-dst
alexandria:when-let
old
gpu-frame-state-image-bufferstate
setf
gpu-frame-state-image-bufferstate
replacement
gpu-frame-state-image-capacitystate
capacity
gpu-frame-state-image-bufferstate
defunensure-gpu-image-paint
mirrordesign
let*
cache
gpu-mirror-image-paintsmirror
or
gethashsourcecache
with-bounding-rectangle*
lefttoprightbottom
bounding-rectanglesource
let*
width
max1
ceiling
-rightleft
height
max1
ceiling
-bottomtop
pixels
pattern-array
climi::%collapse-patternsourcelefttopwidthheight
device
mirror-devicemirror
texturenil
viewnil
bind-groupnil
completed-pnil
unwind-protect
progn

ARGB32 integers occupy BGRA bytes on the little-endian native targets, matching the portable texture format.

setftexture
luv:createdevice
luv:make-texture-descriptor:label"cached McCLIM image paint":size:dimensions:2d:format:bgra8-unorm:usage'
:texture-binding:copy-dst
view
luv:createdevice
luv:make-texture-view-descriptor:texturetexture
luv:write-texture
luv:make-texture-copy:texturetexture
pixels
luv:make-texture-data-layout:bytes-per-row:rows-per-imageheight
when
gpu-mirror-image-layoutmirror
setfbind-group
luv:createdevice
luv:make-bind-group-descriptor:label"cached McCLIM image paint bindings":layout
gpu-mirror-image-layoutmirror
:entries`
:binding0:resource,view
:binding1:resource,
gpu-mirror-image-samplermirror
let
paint
make-instance'gpu-cached-image-paint:texturetexture:viewview:bind-groupbind-group:widthwidth:heightheight
setf
gethashsourcecache
paint
completed-pt
paint
unlesscompleted-p
dolist
resource
removenil
listbind-groupviewtexture
luv:destroyresource
defunlattice-summed-area-table
modules

modules (a ROWS x COLUMNS bit array, 1 where a cell is inked) as its summed-area table on the (ROWS+1) x (COLUMNS+1) node lattice, packed for an RG16-UINT texture with the count in the low word.

Node (row, column) counts the inked cells strictly below and left of it. The table of a unit-cell-constant function is exactly bilinear within each cell, which is what lets the fragment shader recover continuous box integrals from four taps. Sixteen bits hold any grid up to 256 x 256 of solid ink.

let*
rows
array-dimensionmodules0
columns
array-dimensionmodules1
table
make-array
list
1+rows
1+columns
:element-type'
unsigned-byte32
:initial-element0
dotimes
rowrowstable
dotimes
columncolumns
setf
areftable
1+row
1+column
+
arefmodulesrowcolumn
areftablerow
1+column
areftable
1+row
column
-
areftablerowcolumn
defunensure-gpu-lattice-paint
mirrormodules

The summed-area texture for modules, cached by the grid's identity.

let
cache
gpu-mirror-lattice-paintsmirror
or
gethashmodulescache
let*
height
array-dimensiontable0
width
array-dimensiontable1
device
mirror-devicemirror
texturenil
viewnil
bind-groupnil
completed-pnil
unwind-protect
progn
setftexture
luv:createdevice
luv:make-texture-descriptor:label"cached McCLIM lattice table":size:dimensions:2d:format:rg16-uint:usage'
:texture-binding:copy-dst
view
luv:createdevice
luv:make-texture-view-descriptor:texturetexture
luv:write-texture
luv:make-texture-copy:texturetexture
table
luv:make-texture-data-layout:bytes-per-row:rows-per-imageheight
when
gpu-mirror-lattice-layoutmirror
setfbind-group
luv:createdevice
luv:make-bind-group-descriptor:label"cached McCLIM lattice bindings":layout
gpu-mirror-lattice-layoutmirror
:entries`
:binding0:resource,view
let
paint
make-gpu-lattice-paint:texturetexture:viewview:bind-groupbind-group
setf
gethashmodulescache
paint
completed-pt
paint
unlesscompleted-p
dolist
resource
removenil
listbind-groupviewtexture
luv:destroyresource
defunensure-gpu-text-bind-group
mirroratlas
or
gethashatlas
gpu-mirror-text-bind-groupsmirror
setf
gethashatlas
gpu-mirror-text-bind-groupsmirror
luv:create
mirror-devicemirror
luv:make-bind-group-descriptor:label"McCLIM Slug atlas bindings":layout
gpu-mirror-text-layoutmirror
:entries`
:binding0:resource,
luv.slug:slug-glyph-atlas-band-viewatlas
:binding1:resource,
luv.slug:slug-glyph-atlas-curve-viewatlas
defungpu-text-aligned-baseline
commandmin-xmin-ymax-xmax-y
let
x
gpu-text-command-xcommand
y
gpu-text-command-ycommand
size
gpu-text-command-sizecommand
values
-x
*size
ecase
gpu-text-command-align-xcommand
:baseline:left
0
:center
/
+min-xmax-x
2
:rightmax-x
+y
*size
ecase
gpu-text-command-align-ycommand
:baseline0
:topmax-y
:center
/
+min-ymax-y
2
:bottommin-y
defunappend-gpu-text-vertex
datawidthheightscreen-xscreen-yalphaoutline-xoutline-yhorizontal-countband-offsetcurve-offsetvertical-countmin-xmin-ymax-xmax-ycolor
flet
push-value
value
vector-push-extend
coercevalue'single-float
data
dolist
value
list
-
*2
/screen-xwidth
1
-
*2
/screen-yheight
1
alphaoutline-xoutline-yhorizontal-countband-offsetcurve-offsetvertical-countmin-xmin-y0max-xmax-y0
*
firstcolor
alpha
*
secondcolor
alpha
*
thirdcolor
alpha
push-valuevalue
luv:zdefun
append-gpu-text-command:zone:mcluv/prepare-text:value
length
gpu-text-command-stringcommand
mirrorcommanddatawidthheight
let*
cache
gpu-mirror-slug-cachemirror
font-pathname
gpu-text-command-font-pathnamecommand
shaped
luv.slug:cached-slug-shaped-textcachefont-pathname
gpu-text-command-stringcommand
size
gpu-text-command-sizecommand
color
gpu-text-command-colorcommand
let
font-loader
let
glyphs
luv.slug:make-slug-glyph-placementsshapedfont-loadercachefont-pathname
whenglyphs
multiple-value-bind
min-xmin-ymax-xmax-y
luv.slug:slug-text-extentsglyphsshapedfont-loader
multiple-value-bind
baseline-xbaseline-y
gpu-text-aligned-baselinecommandmin-xmin-ymax-xmax-y
let
first-vertex
/
lengthdata
18

The screen quad is dilated here rather than per vertex: its pixel scale is SIZE, and a HiDPI canvas only makes that an underestimate, which is the safe side. Two logical pixels was the old constant.

dolist
glyphglyphs
let*
resource
luv.slug:slug-glyph-placement-resourceglyph
serialized
luv.slug:slug-device-glyph-serializedresource
location
gethashresource
luv.slug:slug-glyph-atlas-locationsatlas
outline-left
-
luv.slug:slug-glyph-placement-outline-min-xglyph
padding
outline-bottom
-
luv.slug:slug-glyph-placement-outline-min-yglyph
padding
outline-right
+
luv.slug:slug-glyph-placement-outline-max-xglyph
padding
outline-top
+
luv.slug:slug-glyph-placement-outline-max-yglyph
padding
origin-x
luv.slug:slug-glyph-placement-origin-xglyph
origin-y
luv.slug:slug-glyph-placement-origin-yglyph
left
+baseline-x
*size
+origin-xoutline-left
right
+baseline-x
*size
+origin-xoutline-right
top
-baseline-y
*size
+origin-youtline-top
bottom
-baseline-y
*size
+origin-youtline-bottom
horizontal-count
luv.slug:slug-serialized-outline-horizontal-band-countserialized
vertical-count
luv.slug:slug-serialized-outline-vertical-band-countserialized
flet
vertex
sxsyoxoy
append-gpu-text-vertexdatawidthheightsxsy
fourthcolor
oxoyhorizontal-count
firstlocation
secondlocation
vertical-count
luv.slug:slug-glyph-placement-outline-min-xglyph
luv.slug:slug-glyph-placement-outline-min-yglyph
luv.slug:slug-glyph-placement-outline-max-xglyph
luv.slug:slug-glyph-placement-outline-max-yglyph
color
vertexleftbottomoutline-leftoutline-bottom
vertexrightbottomoutline-rightoutline-bottom
vertexrighttopoutline-rightoutline-top
vertexleftbottomoutline-leftoutline-bottom
vertexrighttopoutline-rightoutline-top
vertexlefttopoutline-leftoutline-top
make-gpu-prepared-text-command:atlasatlas:first-vertexfirst-vertex:vertex-count
-
/
lengthdata
18
first-vertex
:clip
gpu-text-command-clipcommand
defmethodprepare-gpu-command
mirrorframe-build
declare
ignoremirrorframe-build
command
defmethodprepare-gpu-command
mirrorframe-build
declare
ignoremirrorframe-build
command
defmethodprepare-gpu-command
mirrorframe-build
declare
ignoremirrorframe-build
command
defmethodprepare-gpu-command
mirrorframe-build
declare
ignoremirrorframe-build
command
defmethodprepare-gpu-command
mirrorframe-build
declare
ignoreframe-build
make-gpu-prepared-lattice-command:paint
ensure-gpu-lattice-paintmirror
gpu-lattice-command-modulescommand
:first-vertex
gpu-lattice-command-first-vertexcommand
:vertex-count
gpu-lattice-command-vertex-countcommand
:clip
gpu-lattice-command-clipcommand
defmethodprepare-gpu-command
mirrorframe-build
declare
ignoreframe-build
make-gpu-prepared-image-command:paint
ensure-gpu-image-paintmirror
gpu-image-command-designcommand
:first-vertex
gpu-image-command-first-vertexcommand
:vertex-count
gpu-image-command-vertex-countcommand
:clip
gpu-image-command-clipcommand
defmethodprepare-gpu-command
mirrorframe-build
append-gpu-text-commandmirrorcommand
gpu-frame-build-text-dataframe-build
gpu-frame-build-widthframe-build
gpu-frame-build-heightframe-build
luv:zdefun
prepare-gpu-frame-commands:zone:mcluv/prepare:value
lengthsemantic-commands
mirrorsemantic-commands
multiple-value-bind
let*
text-data
make-array1024:element-type'single-float:adjustablet:fill-pointer0
frame-build
make-gpu-frame-build:text-datatext-data:widthwidth:heightheight
commands
loopforcommandacrosssemantic-commandsforprepared=
prepare-gpu-commandcommandmirrorframe-build
whenprepareddo
pushpreparedcommands
values
nreversecommands
text-data
defmethodgpu-command-clip
gpu-solid-command-clipcommand
defmethodgpu-command-clip
gpu-analytic-command-clipcommand
defmethodgpu-command-clip
gpu-relief-analytic-command-clipcommand
defmethodgpu-command-clip
gpu-gradient-analytic-command-clipcommand
defmethodgpu-command-clip
gpu-lattice-command-clipcommand
defmethodgpu-command-clip
gpu-prepared-lattice-command-clipcommand
defmethodgpu-command-clip
gpu-image-command-clipcommand
defmethodgpu-command-clip
gpu-prepared-image-command-clipcommand
defmethodgpu-command-clip
gpu-text-command-clipcommand
defmethodgpu-command-clip
gpu-prepared-text-command-clipcommand
defunencode-gpu-draw-range
passpipelinebind-groupbufferfirst-vertexvertex-count

Bind one prepared command's resources and draw its dense vertex range.

luv:set-pipelinepasspipeline
luv:set-bind-grouppass0bind-group
luv:drawpassvertex-count1first-vertex
defmethodencode-gpu-command
let
mirror
gpu-frame-state-mirrorstate
encode-gpu-draw-rangepass
gpu-mirror-pipelinemirror
gpu-mirror-bind-groupmirror
gpu-frame-state-vertex-bufferstate
gpu-solid-command-first-vertexcommand
gpu-solid-command-vertex-countcommand
defmethodencode-gpu-command
let
mirror
gpu-frame-state-mirrorstate
encode-gpu-draw-rangepass
gpu-mirror-analytic-pipelinemirror
gpu-mirror-bind-groupmirror
gpu-frame-state-analytic-bufferstate
gpu-analytic-command-first-vertexcommand
gpu-analytic-command-vertex-countcommand
defmethodencode-gpu-command
let
mirror
gpu-frame-state-mirrorstate
encode-gpu-draw-rangepass
gpu-mirror-relief-pipelinemirror
gpu-mirror-bind-groupmirror
gpu-frame-state-relief-bufferstate
gpu-relief-analytic-command-first-vertexcommand
gpu-relief-analytic-command-vertex-countcommand
defmethodencode-gpu-command
let
mirror
gpu-frame-state-mirrorstate
encode-gpu-draw-rangepass
gpu-mirror-gradient-analytic-pipelinemirror
gpu-mirror-bind-groupmirror
gpu-frame-state-gradient-bufferstate
gpu-gradient-analytic-command-first-vertexcommand
gpu-gradient-analytic-command-vertex-countcommand
defmethodencode-gpu-command
let
mirror
gpu-frame-state-mirrorstate
encode-gpu-draw-rangepass
gpu-mirror-lattice-pipelinemirror
gpu-lattice-paint-bind-group
gpu-prepared-lattice-command-paintcommand
gpu-frame-state-analytic-bufferstate
gpu-prepared-lattice-command-first-vertexcommand
gpu-prepared-lattice-command-vertex-countcommand
defmethodencode-gpu-command
let
mirror
gpu-frame-state-mirrorstate
encode-gpu-draw-rangepass
gpu-mirror-image-pipelinemirror
gpu-image-paint-bind-group
gpu-prepared-image-command-paintcommand
gpu-frame-state-image-bufferstate
gpu-prepared-image-command-first-vertexcommand
gpu-prepared-image-command-vertex-countcommand
defmethodencode-gpu-command
let
mirror
gpu-frame-state-mirrorstate
encode-gpu-draw-rangepass
gpu-mirror-text-pipelinemirror
ensure-gpu-text-bind-groupmirror
gpu-prepared-text-command-atlascommand
gpu-frame-state-text-bufferstate
gpu-prepared-text-command-first-vertexcommand
gpu-prepared-text-command-vertex-countcommand
defunset-gpu-frame-scissor
passmirrorsurfaceclip

Encode clip in physical drawable pixels and return whether it is nonempty.

destructuring-bind
surface-widthsurface-height&restignored
luv:gpu-texture-sizesurface
declare
ignoreignored
multiple-value-bind
logical-widthlogical-height
destructuring-bind
lefttoprightbottom
orclip
list00logical-widthlogical-height
let*
scale-x
/surface-widthlogical-width
scale-y
/surface-heightlogical-height
x
max0
minsurface-width
floor
*leftscale-x
y
max0
minsurface-height
floor
*topscale-y
right
maxx
minsurface-width
ceiling
*rightscale-x
bottom
maxy
minsurface-height
ceiling
*bottomscale-y
width
-rightx
height
-bottomy
defungpu-mirror-logical-size
mirror
if
mirror-embedded-pmirror
let
sheet
mirror-sheetmirror
values
max1
ceiling
bounding-rectangle-widthsheet
max1
ceiling
bounding-rectangle-heightsheet
luv:canvas-logical-size
mirror-targetmirror
defundetach-gpu-frame-state-resources
state

Logically empty state and return every resource it formerly owned.

prog1
removenil
list
gpu-frame-state-viewstate
gpu-frame-state-vertex-bufferstate
gpu-frame-state-analytic-bufferstate
gpu-frame-state-relief-bufferstate
gpu-frame-state-gradient-bufferstate
gpu-frame-state-image-bufferstate
gpu-frame-state-text-bufferstate
setf
gpu-frame-state-viewstate
nil
gpu-frame-state-vertex-bufferstate
nil
gpu-frame-state-vertex-capacitystate
0
gpu-frame-state-analytic-bufferstate
nil
gpu-frame-state-analytic-capacitystate
0
gpu-frame-state-relief-bufferstate
nil
gpu-frame-state-relief-capacitystate
0
gpu-frame-state-gradient-bufferstate
nil
gpu-frame-state-gradient-capacitystate
0
gpu-frame-state-image-bufferstate
nil
gpu-frame-state-image-capacitystate
0
gpu-frame-state-text-bufferstate
nil
gpu-frame-state-text-capacitystate
0
defunrelease-gpu-frame-state
state

Exhaustively release state after first detaching all logical ownership.

let
failuresnil
dolist
handler-case
luv:destroyresource
error
condition
push
consresourcecondition
failures
whenfailures
error'gpu-frame-state-release-error:failures
nreversefailures
state
defunrelease-gpu-mirror-frame-states
mirror
let
statesnil
failuresnil
maphash
lambda
keystate
declare
ignorekey
pushstatestates
gpu-mirror-frame-statesmirror

Logical detachment precedes native destruction, so a condition cannot leave a half-owned table that will double-release on a later close.

clrhash
gpu-mirror-frame-statesmirror
dolist
statestates
handler-case
error
condition
push
consstatecondition
failures
whenfailures
error'gpu-frame-state-release-error:failures
nreversefailures
mirror
luv:zdefun
render-gpu-mirror-frame:zone:mcluv/frame:value
length
gpu-medium-commands
sheet-medium
mirror-sheetmirror
mirror&keyreadback-buffer
let
medium
sheet-medium
mirror-sheetmirror
when
and
mirror-embedded-pmirror
zerop
length
gpu-medium-commandsmedium
return-fromrender-gpu-mirror-framemirror

Drawing may continue on the McCLIM side while canvas presentation crosses onto its native frame thread. Upload one immutable frame snapshot so the allocation size and the bytes written cannot drift.

let*
vertices
copy-seq
gpu-medium-verticesmedium
analytic-vertices
copy-seq
gpu-medium-analytic-verticesmedium
relief-vertices
copy-seq
gpu-medium-relief-verticesmedium
gradient-vertices
copy-seq
gpu-medium-gradient-verticesmedium
image-vertices
copy-seq
gpu-medium-image-verticesmedium
semantic-commands
copy-seq
gpu-medium-commandsmedium
when
plusp
length
gpu-medium-commandsmedium
let*
context
ensure-gpu-mirror-contextmirror:readback-p
not
nullreadback-buffer
byte-count
*4
lengthvertices
multiple-value-bind
commandstext-data
prepare-gpu-frame-commandsmirrorsemantic-commands
publish-gpu-mirror-prepared-revisionmirror
make-gpu-mirror-prepared-revisionmirrorcommandsverticesanalytic-verticesrelief-verticesgradient-verticesimage-verticestext-data:copy-pnil
when
mirror-embedded-pmirror

Destination-frame ownership is unknown until the application borrows its drawable. Publication therefore remains CPU-only; encode-direct-gpu-mirror uploads this exact revision into that drawable's bounded source state before replaying its commands.

return-fromrender-gpu-mirror-framemirror
call-with-gpu-mirror-targetmirrorcontext
lambda
surfaceencoder
let*
buffer
and
pluspbyte-count
ensure-gpu-frame-vertex-bufferstatedevicebyte-count
analytic-byte-count
*4
lengthanalytic-vertices
analytic-buffer
and
pluspanalytic-byte-count
ensure-gpu-frame-analytic-bufferstatedeviceanalytic-byte-count
relief-byte-count
*4
lengthrelief-vertices
relief-buffer
and
plusprelief-byte-count
ensure-gpu-frame-relief-bufferstatedevicerelief-byte-count
gradient-byte-count
*4
lengthgradient-vertices
gradient-buffer
and
pluspgradient-byte-count
ensure-gpu-frame-gradient-bufferstatedevicegradient-byte-count
image-byte-count
*4
lengthimage-vertices
image-buffer
and
pluspimage-byte-count
ensure-gpu-frame-image-bufferstatedeviceimage-byte-count
text-byte-count
*4
lengthtext-data
text-buffer
and
plusptext-byte-count
ensure-gpu-frame-text-bufferstatedevicetext-byte-count
pass
luv:begin-render-passencoder
luv:make-render-pass-descriptor:label"direct McCLIM frame":color-attachments`
:view,
gpu-frame-state-viewstate
:load-op:clear:store-op:store:clear-value
0.940.940.941.0
whenbuffer
luv:write-bufferbuffervertices
whenanalytic-buffer
luv:write-bufferanalytic-bufferanalytic-vertices
whenrelief-buffer
luv:write-bufferrelief-bufferrelief-vertices
whengradient-buffer
luv:write-buffergradient-buffergradient-vertices
whenimage-buffer
luv:write-bufferimage-bufferimage-vertices
whentext-buffer
luv:write-buffertext-buffertext-data
let
active-clip
list:unset
active-clip-visible-pt
dolist
commandcommands
let
clip
unless
equalclipactive-clip
setfactive-clipclip
setfactive-clip-visible-p
set-gpu-frame-scissorpassmirrorsurfaceclip
when
andactive-clip-visible-p
gpu-command-rasterized-p
mirror-compositormirror
command
encode-gpu-commandcommandpassstate
whenreadback-buffer
luv:encodeencoder
luv:make-gpu-copy-texture-to-buffer-command:sourcesurface:destinationreadback-buffer
mirror
defmethodpresent-mirror
let
target
mirror-targetmirror
medium
sheet-medium
mirror-sheetmirror
when
and
or
mirror-embedded-pmirror
eq:open
or
mirror-embedded-pmirror
plusp
length
gpu-medium-commandsmedium
if
mirror-embedded-pmirror

No drawable is acquired and no pass is encoded. Publish the retained snapshot synchronously with the repaint that authored it, so command ranges and all six dense buffers are one revision.

luv:request-canvas-frametarget
lambda
timestamp
declare
ignoretimestamp
mirror
defuncapture-gpu-mirror-screenshot
mirrorpathname

Render direct-GPU mirror into its hidden drawable and save a PNG.

check-typemirrorluv-gpu-mirror
let
target
mirror-targetmirror
unless
eq:open
error"Cannot capture a McCLIM mirror whose canvas is ~S."
ensure-directories-existpathname
luv:request-canvas-frametarget
lambda
timestamp
declare
ignoretimestamp
let*
width
firstextent
buffer
luv:create
luv:make-buffer-descriptor:label"direct McCLIM screenshot readback":size:usage'
:copy-dst
unwind-protect
progn
render-gpu-mirror-framemirror:readback-bufferbuffer
let
luv:write-rgba-pngpathnamepixelswidthheightformat
valuespathnamepixelswidthheightformat
defmethodrelease-mirror-presentation
release-mirror-compositor
mirror-compositormirror
setf
mirror-compositormirror
nil
alexandria:when-let
texture
mirror-texturemirror
setf
mirror-texturemirror
nil
mirror