luv

Workshop wiki

gallery.lisp

mcclim/gallery.lisp

system luv/mcclim/gallery · 17 definitions · on GitHub

Reproducible screenshots of upstream McCLIM examples on the direct GPU port.

in-package#:mcluv
define-application-frameanalytic-shape-gallery
:menu-barnil
:panes
canvas:application:display-function'display-analytic-shape-gallery:scroll-barsnil
:layouts
defaultcanvas
defundisplay-analytic-shape-gallery
framestream
declare
ignoreframe

This deliberately draws through the ordinary recording stream: the backend extension must survive McCLIM recording and repaint as one semantic command, not rely on reaching into the presentation medium.

let
mediumstream
draw-rectangle*medium00720420:filledt:ink
make-rgb-color0.0750.0850.12
draw-analytic-rounded-rectangle*medium5858430206:radius36:filledt:ink
make-linear-gradient5858430206
make-rgb-color1.00.300.48
make-rgb-color0.420.341.0
draw-analytic-rounded-rectangle*medium8482404182:radius24:filledt:ink
make-rgb-color0.120.140.20
draw-text*medium"roundrect in roundrect"116143:ink+white+:text-size22
draw-ellipse*medium570128920054:filledt:ink
make-radial-gradient57012892
make-rgb-color0.721.00.84
make-rgb-color0.040.540.31
draw-ellipse*medium19031010535-1854:filledt:ink
make-rgb-color0.430.581.0
draw-circle*medium45031058:filledt:ink
make-rgb-color1.00.630.18
draw-analytic-rounded-rectangle*medium548274680346:radius36:filledt:ink
make-rgb-color0.730.430.96
defungallery-image-pixel
redgreenbluealpha
flet
channel-byte
value
min255
max0
round
*255value
logior
ash
channel-bytealpha
24
ash
channel-bytered
16
ash
channel-bytegreen
8
channel-byteblue
defunmake-gallery-image-pattern
&optional
let
pixels
make-array:element-type'
unsigned-byte32
dotimes
dotimes
let*
u
/x
v
checker
if
evenp
0.160.0
setf
arefpixelsyx
gallery-image-pixel
+0.16
*0.78u
checker
+0.18
*0.70
-1u
+0.36
*0.58v
1.0
make-patternpixelsnil
defunmake-gallery-opacity-mask
&optional
let
opacities
make-array:element-type'single-float
dotimes
dotimes
let*
setf
arefopacitiesyx
coerce
max0.0
min1.0
'single-float
make-stencilopacities
define-application-framepaint-gallery
:menu-barnil
:panes
canvas:application:display-function'display-paint-gallery:scroll-barsnil
:layouts
defaultcanvas
defundisplay-paint-gallery
framestream
declare
ignoreframe
draw-rectangle*stream00800480:filledt:ink
make-rgb-color0.0550.0650.09

Ordinary DRAW-PATTERN* is a single textured quad. This one also crosses a native rectangular scissor boundary at x=178.

with-drawing-options
stream:clipping-region
make-rectangle*4044178172
draw-pattern*stream*gallery-image-pattern*4044

The same immutable source texture, affinely stretched and clipped by one analytical roundrect coverage evaluation.

let
paint
transform-region
make-transformation
/440.0192
00
/180.0128
30036
*gallery-image-pattern*
draw-analytic-rounded-rectangle*stream30036740216:radius42:filledt:inkpaint

McCLIM's COMPOSE-IN stencil becomes texture alpha; the ellipse adds its own analytical edge without an offscreen mask surface.

let
paint
transform-region
make-transformation
/300.0192
00
/190.0128
52266
*gallery-masked-image-pattern*
draw-ellipse*stream2023611500095:filledt:inkpaint

A genuinely affine paint mapping, deliberately skewed inside the clip.

let
paint
transform-region
make-transformation1.750.45-0.181.35382290
*gallery-image-pattern*
draw-analytic-rounded-rectangle*stream382260752446:radius30:filledt:inkpaint
draw-text*stream"rect clip"40208:ink+white+:text-size18
draw-text*stream"rounded + affine"300244:ink+white+:text-size18
draw-text*stream"opacity mask"104464:ink+white+:text-size18
defparameter*mcclim-gallery-scenes*`
:relief"Height-bearing McCLIM gadgets"widget-lab360180
:analytic"Analytic GUI primitives"analytic-shape-gallery720420
:paints"Image paints, masks, and affine placement"paint-gallery800480
:calculator"Calculator"clim-demo.calculator:calculator-app420520
:gadgets"Gadgets"clim-demo::gadget-test980760
:tables"Tables and borders"clim-demo.tables-with-borders:tables-with-borders1280720
:text"Text transformations"clim-demo.draw-text-test:draw-text-test1280720
:borders"Border styles"clim-demo::bordered-output800700
:wrapping"Baseline and wrapping"clim-demo.seos-baseline:seos-baseline700700
"Named upstream McCLIM application frames captured by the gallery script."
defungallery-frame-media
let
sheet
frame-top-level-sheetframe
remove-duplicates
removenil
mapcan
lambda
child
list
sheet-mediumchild
:test#'eq
defungallery-frame-fallback-report
let
combined
make-hash-table:test#'eq
dolist
when
typepmedium'luv-gpu-medium
dolist
let*
primitive
getfentry:primitive
target
copy-list
gethashprimitivecombined
loopfor
fieldvalue
on
cddrentry
by#'cddrdo
incf
getftargetfield0
value
setf
gethashprimitivecombined
target
let
entries
maphash
lambda
primitivestatistics
push
list*:primitiveprimitivestatistics
entries
combined
sortentries#'string<:key
lambda
entry
symbol-name
getfentry:primitive
defuncapture-gallery-frame
managerframe-classpathnamewidthheight
let
unwind-protect
progn

Adoption realizes an invisible native mirror. Deliberately leave the frame disabled: no show-canvas, activation, or focus change.

setfframe
make-application-frameframe-class:frame-managermanager:enablenil:widthwidth:heightheight
let*
sheet
frame-top-level-sheetframe
mirror
sheet-direct-mirrorsheet
unless
typepmirror'luv-gpu-mirror
error"~S did not realize a direct GPU mirror."frame-class
let

A disabled sheet intentionally does not repaint. Enable its drawing lifecycle while the GPU mirror's visibility hook is suppressed, then capture the still-hidden drawable.

setf
sheet-enabled-psheet
t

RUN-FRAME-TOP-LEVEL normally supplies this binding. The hidden harness deliberately bypasses its event loop, but redisplay functions may still create embedded gadgets.

let
*application-frame*frame
redisplay-frame-panesframe:force-pt
repaint-gpu-mirrormirror:present-pnil
whenframe
destroy-frameframe
defunhtml-escaped-string
value
with-output-to-string
stream
loopforcharacteracross
princ-to-stringvalue
do
write-string
casecharacter
#\&"&amp;"
#\<"&lt;"
#\>"&gt;"
#\""&quot;"
otherwise
stringcharacter
stream
defunwrite-gallery-index
pathnameresults
with-open-file
streampathname:direction:output:if-exists:supersede:if-does-not-exist:create
formatstream"<!doctype html><meta charset=\"utf-8\"><title>McCLIM on luv</title>~%"
formatstream"<style>body{font:16px system-ui;margin:2rem;background:#202124;color:#eee}main{display:grid;grid-template-columns:repeat(auto-fit,minmax(360px,1fr));gap:1.5rem}article{background:#303134;padding:1rem;border-radius:12px}img{width:100%;height:auto;background:#eee}pre{white-space:pre-wrap;font-size:12px}</style>~%"
formatstream"<h1>McCLIM on luv: direct Metal gallery</h1><main>~%"
dolist
resultresults
destructuring-bind
&keynametitlefilereporterror
result
declare
ignorename
formatstream"<article><h2>~A</h2>"
iferror
formatstream"<p>Capture failed: ~A</p>"
formatstream"<img src=\"~A\" alt=\"~A\"><pre>~A</pre>"
formatstream"</article>~%"
formatstream"</main>~%"
defuncapture-mcclim-gallery
directory&key

Capture scenes invisibly through the direct GPU backend into directory.

INDEX.HTML displays the images and each scene's measured BASIC-MEDIUM fallback activity. FALLBACKS.SEXP is the same evidence in machine-readable form.

let*
directory
uiop:ensure-directory-pathnamedirectory
port
find-port:server-path'
:luv-gpu
manager
or
first
climi::frame-managersport
make-instance'luv-frame-manager:portport
results
ensure-directories-existdirectory
dolist
scenescenes
destructuring-bind
nametitleframe-classwidthheight
scene
let*
filename
formatnil"~(~A~).png"name
pathname
merge-pathnamesfilenamedirectory
formatt"Capturing ~A without showing its canvas...~%"title
handler-case
let
report
capture-gallery-framemanagerframe-classpathnamewidthheight
push
list:namename:titletitle:filefilename:reportreport
results
error
condition
push
list:namename:titletitle:filefilename:error
princ-to-stringcondition
results
setfresults
nreverseresults
with-open-file
stream
merge-pathnames#P"fallbacks.sexp"directory
:direction:output:if-exists:supersede:if-does-not-exist:create
let
*print-pretty*t
writeresults:streamstream
write-gallery-index
merge-pathnames#P"index.html"directory
results
formatt"McCLIM gallery written under ~A~%"directory
results