luv

Workshop wiki

canvas.lisp

hal/sdl/canvas.lisp

system luv · 138 definitions · on GitHub

SDL realization of the native canvas protocol.

in-package#:luv
defclasssdl-canvas
title:initarg:title:initform"luv canvas":accessorcanvas-title

NIL width or height means "whatever suits the display this window opens on"; the native size is resolved once, at window creation, when SDL can finally be asked about the desktop.

width:initarg:width:initform800:accessorcanvas-width
height:initarg:height:initform600:accessorcanvas-height
fullscreen-p:initarg:fullscreen-p:initformnil:accessorcanvas-fullscreen-p:documentation"Whether the window occupies its display's borderless fullscreen mode."
high-pixel-density-p:initarg:high-pixel-density-p:initformnil:readersdl-canvas-high-pixel-density-p:documentation"Whether this canvas explicitly asks SDL for a Retina-density drawable."
x:initarg:x:initformnil:accessorsdl-canvas-x
y:initarg:y:initformnil:accessorsdl-canvas-y
visible-p:initarg:visible-p:initformt:accessorcanvas-visible-p
presentation-api:initarg:presentation-api:initform:vulkan:readersdl-canvas-presentation-api:documentation"The native graphics machinery SDL must select when realizing the window."

The loop publishes where it is and when it got there. Everything the watchdog knows, and everything ./sly status reports about a window that has stopped answering, is read out of these three slots.

phase:initform:new:accessorsdl-canvas-phase
phase-time:initformnil:accessorsdl-canvas-phase-time
ticks:initform0:accessorsdl-canvas-ticks
watchdog:initformnil:accessorsdl-canvas-watchdog
window:initformnil:accessorsdl-canvas-window
context:initformnil:accessorcanvas-context
state:initform:new:accessorcanvas-state
startup-error:initformnil:accessorsdl-canvas-startup-error
startup-completion:initform
sb-thread:make-semaphore:count0
:accessorsdl-canvas-startup-completion
shutdown-completion:initform
sb-thread:make-semaphore:count0
:accessorsdl-canvas-shutdown-completion
close-requested-p:initformnil:accessorsdl-canvas-close-requested-p
thread:initformnil:accessorsdl-canvas-thread
wake-event-type:initformnil:accessorsdl-canvas-wake-event-type
request-lock:initform
sb-thread:make-mutex:name"luv SDL canvas request lock"
:readersdl-canvas-request-lock
requests:initformnil:accessorsdl-canvas-requests

What has gone wrong on this loop, kept: the newest first, each with the backtrace it was caught with. A frame failure also parks here, in FRAME-FAILURE, and holds further frames until it is resumed.

failures:initformnil:accessorsdl-canvas-failures
frame-failure:initformnil:accessorsdl-canvas-frame-failure
frame-count:initform0:accessorsdl-canvas-frame-count
frames-held-p:initformnil:accessorsdl-canvas-frames-held-p
defstructsdl-canvas-requestfunction
completion
sb-thread:make-semaphore:count0
:read-onlyt
valueserror
defmacrowith-sdl-native-environment
&bodybody

Run body with the floating-point environment expected by native drivers.

#+sbcl`
sb-int:with-float-traps-masked
:invalid:divide-by-zero:overflow:underflow:inexact
,@body
#+
anddarwin
notsbcl
`(float-features:with-float-traps-masked t ,@body)
#-
orsbcldarwin
`(progn ,@body)
defparameter*runtime-signals-sdl-must-not-take*

SIGILL, SIGTRAP, SIGBUS, SIGFPE, SIGSEGV.

'
457811

The signals SBCL's runtime handles itself, by number.

SDL's KMSDRM backend mutes the console keyboard and registers an emergency restore handler over every fatal signal, SIGSEGV included. SBCL takes ordinary SIGSEGVs as part of running Lisp -- garbage collection's write barrier and the control stack guard both arrive that way -- and SDL's handler answers one by re-raising it with PTHREAD_KILL, whose SIGINFO carries no faulting address at all. What reaches SBCL is then a memory fault at (UID << 32) | PID: a CORRUPTION WARNING and a MEMORY-FAULT-ERROR in place of a collection.

defconstant+sigaction-size+256

Room for one struct sigaction, which is 152 bytes on x86-64 Linux.

The bytes are only ever moved between the kernel and this buffer.

defuncall-with-runtime-signal-handlers-preserved

Call function, restoring SBCL's own fatal-signal handlers afterwards.

Wrap the SDL calls that may install console-keyboard cleanup handlers: the muting itself is worth keeping on a virtual console, but the handlers are not SDL's to take. SDL_Quit and the process's own exit still restore the keyboard.

#+linux
let
cffi:with-foreign-object
saved:char
loopforsignalinsignalsforindexfrom0do
cffi:foreign-funcall"sigaction":intsignal:pointer
cffi:null-pointer
:pointer
cffi:inc-pointersaved
:int
unwind-protect
funcallfunction
loopforsignalinsignalsforindexfrom0do
cffi:foreign-funcall"sigaction":intsignal:pointer
cffi:inc-pointersaved
:pointer
cffi:null-pointer
:int
#-linux (funcall function)
defunlinux-console-tty-p

Whether this process has a Linux virtual console as its controlling terminal.

#+linux
let
name
ignore-errors
uiop:run-program'
"tty"
:output:string:error-outputnil
whenname
let
name
string-trim'
#\Space#\Tab#\Newline#\Return
name
and
uiop:string-prefix-p"/dev/tty"name
let
number
subseqname
length"/dev/tty"
and
plusp
lengthnumber
every#'digit-char-pnumber
#-linux nil
defunselect-sdl-video-driver

Choose KMSDRM on a real console, otherwise a safe headless SDL backend.

An explicit SDL_VIDEODRIVER, DISPLAY, or WAYLAND_DISPLAY always wins. This must run before SDL video initialization: it covers standalone executables as well as processes started through the Nix development shell.

when
and
null
uiop:getenv"SDL_VIDEODRIVER"
null
uiop:getenv"DISPLAY"
null
uiop:getenv"WAYLAND_DISPLAY"
sb-posix:setenv"SDL_VIDEODRIVER"
if"kmsdrm""offscreen"
1
defuncall-with-sdl-main-thread

Call function where synchronous SDL canvas work can use the native main thread.

On Darwin, a batch Lisp normally evaluates its toplevel form on the process main thread. Opening a canvas from that continuation would let Cocoa replace the continuation with its durable event loop. This boundary moves function to a worker while the calling thread runs TRIVIAL-MAIN-THREAD, then restores the caller with function's values or condition after native teardown. Calls from an existing worker (including SLY and standalone program workers) already have a main-thread host and execute directly.

#+darwin (if (not (trivial-main-thread:main-thread-p)) (funcall function) (let ((completion (sb-thread:make-semaphore :count 0)) (values nil) (failure nil) (runner-started-p nil) (worker nil)) (setf worker (sb-thread:make-thread (lambda () (unwind-protect (handler-case (progn ;; Establish the runner before FUNCTION can ask a ;; canvas to replace its task with SDL's event loop. (trivial-main-thread:call-in-main-thread (lambda () (values)) :blocking t) (setf runner-started-p t values (multiple-value-list (funcall function)))) (error (condition) (setf failure condition))) (sb-thread:signal-semaphore completion) (when runner-started-p (trivial-main-thread:stop-main-runner)))) :name "luv SDL batch operation")) ;; The worker's first main-thread call interrupts this wait and enters ;; the runner. STOP-MAIN-RUNNER later restores this continuation. (sb-thread:wait-on-semaphore completion) (sb-thread:join-thread worker) (if failure (error failure) (values-list values))))#-darwin
funcallfunction
defgenericprepare-sdl-canvas-host
:documentation

Prepare the native application host before SDL_Init.

defgenericactivate-sdl-canvas-host
:documentation

Show and activate canvas after its SDL window exists.

defgenericdeactivate-sdl-canvas-host
:documentation

Release canvas's native application presence after SDL_Quit.

defgenericclaim-sdl-canvas-host
:documentation

Claim any process-global native host required before canvas starts.

defgenericrelease-sdl-canvas-host
:documentation

Release a host previously claimed for canvas.

defmethodprepare-sdl-canvas-host
declare
ignorecanvas
unless
sdl3:set-app-metadata"luv""0.0.1""com.mbrock.luv"
error"SDL application metadata failed: ~A"
sdl3:get-error
defmethodactivate-sdl-canvas-host
when
let
window
sdl-canvas-windowcanvas
unless
sdl3:show-windowwindow
error"SDL window show failed: ~A"
sdl3:get-error

Raising is a request to the window manager and may legitimately be denied by focus-stealing policy, so it is not an open failure.

sdl3:raise-windowwindow

cl-sdl3's KEYCODE enum is currently incomplete (and mistypes ]), while SDL keycodes are Unicode values by design. Keep the raw integer at this boundary.

cffi:defcfun
"SDL_GetKeyFromScancode"raw-sdl-key-from-scancode
:uint32
scancodesdl3::scancode
modstatesdl3::keymod
defgenericsdl-presentation-window-flags
presentation-api
:documentation

Return the immutable SDL window flags required by presentation-api.

defgenericsdl-presentation-api-for
provider
:documentation

Return the SDL presentation policy required by GPU provider.

defmethodsdl-presentation-window-flags
presentation-api
eql:vulkan
declare
ignorepresentation-api

On macOS a point already names a sufficiently fine game-rendering pixel. Asking SDL for high density doubles both drawable axes on Retina displays, quadrupling scene work and making point-sized embedded UI unnecessarily small. Other platforms retain their native high-density drawable.

append'
:vulkan
#-darwin'
:high-pixel-density
'
:resizable:hidden
#+darwin (defmethod sdl-presentation-window-flags ((presentation-api (eql :metal))) (declare (ignore presentation-api)) '(:metal :resizable :hidden))
defunsdl-canvas-window-flags

The SDL window flags canvas needs: its presentation API plus its own state.

let
flags
copy-list
sdl-presentation-window-flags
sdl-canvas-presentation-apicanvas
when
sdl-canvas-high-pixel-density-pcanvas
pushnew:high-pixel-densityflags
if
cons:fullscreenflags
flags
defparameter*sdl-default-canvas-fill*0.8"How much of a display's usable area an unsized window asks for."
defparameter*sdl-default-canvas-aspect*1.6

The widest shape an unsized window takes before it stops following the display. An ultrawide desktop is a place to put several windows, not a reason to open one 3.6:1 window nobody can look across.

defparameter*sdl-fallback-canvas-size*'
1280800
"The window size to open when SDL cannot describe any display."
defunsdl-default-canvas-size

Return a comfortable window size for the primary display, in points.

SDL_GetDisplayUsableBounds already excludes the menu bar and the dock, so a fraction of it is a window that fits wherever the desktop actually is. The height leads and the width follows it at an ordinary aspect, never wider than the same fraction of the desktop. The answer is in logical points, which is what SDL_CreateWindow wants: a Retina window is the same physical size as its low-density twin and simply resolves finer, so the density belongs in the drawable rather than in this number.

let
display
sdl3:get-primary-display
multiple-value-bind
successbounds
if
zeropdisplay
valuesnilnil
sdl3:get-display-usable-boundsdisplay
defunresolve-kmsdrm-vulkan-canvas-size

Use the active display mode required by SDL's direct-display Vulkan WSI.

Unlike a desktop window system, KMSDRM presents Vulkan through VK_KHR_display. SDL can only create that surface at a mode the display actually advertises; arbitrary window dimensions commonly fail in SDL_Vulkan_CreateSurface.

when
and
eq:vulkan
sdl-canvas-presentation-apicanvas
string-equal"kmsdrm"
sdl3:get-current-video-driver
let*
display
sdl3:get-primary-display
mode
unless
zeropdisplay
sdl3:get-current-display-modedisplay
whenmode
setf
canvas-widthcanvas
sdl3:%wmode
canvas-heightcanvas
sdl3:%hmode
t
defunresolve-sdl-canvas-size

Fill in whichever of canvas's dimensions were left for the display to pick.

unless
and
canvas-widthcanvas
canvas-heightcanvas
multiple-value-bind
setf
canvas-widthcanvas
or
canvas-widthcanvas
width
canvas-heightcanvas
or
canvas-heightcanvas
height
values
canvas-widthcanvas
canvas-heightcanvas
defunsdl-canvas-direct-display-p

Whether canvas is hosted directly by SDL's KMSDRM video driver.

flet
direct-p
string-equal"kmsdrm"
sdl3:get-current-video-driver
defunsdl-canvas-refresh-rate

Return canvas's current display refresh rate, or NIL when SDL omits it.

flet
refresh-rate
let*
window
sdl-canvas-windowcanvas
display
if
andwindow
not
cffi:null-pointer-pwindow
sdl3:get-display-for-windowwindow
sdl3:get-primary-display
mode
unless
zeropdisplay
sdl3:get-current-display-modedisplay
whenmode
let
numerator
sdl3:%refresh-rate-numeratormode
denominator
sdl3:%refresh-rate-denominatormode
approximate
sdl3:%refresh-ratemode
cond
and
pluspnumerator
pluspdenominator
/
floatnumerator1d0
denominator
pluspapproximate
floatapproximate1d0
defmethodcanvas-presentation-time

Drawable acquisition has already happened when this is queried. A cadence frame is intended for its following beat; direct display is paced by FIFO image release and uses the panel's real refresh interval.

let*
rate
cond
typepclock'cadence-clock
clock-frames-per-secondclock

Acquisition may have blocked since the event loop cached its coherent NOW. Prediction starts from a fresh underlying sample, then the backend temporarily overrides logical time with it.

ifrate
+now
/1d0rate
now
defunmake-sdl-canvas
&key
title"luv canvas"
xy
visible-pt
fullscreen-pnil
high-pixel-density-pnil
presentation-api:vulkan

Construct an unrealized SDL canvas.

width or height may be NIL, which asks the display for a size when the window is finally created.

make-instance'sdl-canvas:titletitle:widthwidth:heightheight:xx:yy:visible-pvisible-p:clockclock:timetime:fullscreen-pfullscreen-p:high-pixel-density-phigh-pixel-density-p:presentation-apipresentation-api
defmethodcanvas-size
if
call-on-sdl-canvas-threadcanvas
lambda
multiple-value-bind
sdl3:get-window-size-in-pixels
sdl-canvas-windowcanvas
unlesssuccess
error'canvas-error:canvascanvas:operation:size:reason:native-size-failed:details
sdl3:get-error
values
canvas-widthcanvas
canvas-heightcanvas
defmethodcanvas-logical-size
if
call-on-sdl-canvas-threadcanvas
lambda
multiple-value-bind
sdl3:get-window-size
sdl-canvas-windowcanvas
unlesssuccess
error'canvas-error:canvascanvas:operation:logical-size:reason:native-size-failed:details
sdl3:get-error
values
canvas-widthcanvas
canvas-heightcanvas
defmethodset-canvas-relative-pointer-mode
unless
error'canvas-state-error:canvascanvas:operation:relative-pointer-mode:reason:invalid-state:state:expected-state:open
call-on-sdl-canvas-threadcanvas
lambda
unless
sdl3:set-window-relative-mouse-mode
sdl-canvas-windowcanvas
not
nullenabled
error'canvas-error:canvascanvas:operation:relative-pointer-mode:reason:native-pointer-mode-failed:details
sdl3:get-error
not
nullenabled
defunsdl-canvas-native-thread-p#+darwin (declare (ignore canvas))#+darwin (trivial-main-thread:main-thread-p)#-darwin
eqsb-thread:*current-thread*
sdl-canvas-threadcanvas
defuntake-sdl-canvas-requests
sb-thread:with-mutex
sdl-canvas-request-lockcanvas
prog1
sdl-canvas-requestscanvas
setf
sdl-canvas-requestscanvas
nil
zdefun
process-sdl-canvas-requests:zone:canvas/process-requests
dolist
handler-case
setf
sdl-canvas-request-valuesrequest
multiple-value-list
funcall
sdl-canvas-request-functionrequest
error
condition
setf
sdl-canvas-request-errorrequest
condition
sb-thread:signal-semaphore
sdl-canvas-request-completionrequest
defunfail-sdl-canvas-requests
canvascondition
dolist
setf
sdl-canvas-request-errorrequest
condition
sb-thread:signal-semaphore
sdl-canvas-request-completionrequest
defunsdl-canvas-terminal-error

Return the native-loop failure callers need, preserving its original type.

or
sdl-canvas-startup-errorcanvas
make-condition'canvas-error:canvascanvas:operation:frame:reason:canvas-closed
defunwake-sdl-canvas

Wake canvas's native SDL event loop after cross-thread work arrives.

let
event-type
sdl-canvas-wake-event-typecanvas
whenevent-type
cffi:with-foreign-object
event'
:unionsdl3:event
dotimes
index
cffi:foreign-type-size'
:unionsdl3:event
setf
cffi:mem-arefevent:uint8index
0
setf
cffi:mem-refevent:uint32
event-type
sdl3:push-eventevent
defmethod:after
when
typepclock'cadence-clock
setf
cadence-clock-next-frame-timeclock
nil
defuncall-on-sdl-canvas-thread

Call function synchronously on canvas's native event thread.

unless
error'canvas-state-error:canvascanvas:operation:dispatch:reason:invalid-state:state:expected-state:open
let
request
make-sdl-canvas-request:functionfunction
sb-thread:with-mutex
sdl-canvas-request-lockcanvas
setf
sdl-canvas-requestscanvas
nconc
sdl-canvas-requestscanvas
listrequest

Bounded, because the alternative is not "wait a little longer" but "hang forever with nothing on screen". The canvas thread services this queue once a frame; if it has stopped doing that, no amount of waiting will help and every caller after this one queues behind the same block.

unless
sb-thread:wait-on-semaphore
sdl-canvas-request-completionrequest
:timeout*canvas-dispatch-timeout*
error'canvas-dispatch-timeout:canvascanvas:operation:dispatch:reason:thread-unresponsive:seconds*canvas-dispatch-timeout*
when
sdl-canvas-request-errorrequest
error
sdl-canvas-request-errorrequest
values-list
sdl-canvas-request-valuesrequest
defuncall-sdl-canvas-window-operation
unless
error'canvas-state-error:canvascanvas:operationoperation:reason:invalid-state:state:expected-state:open
call-on-sdl-canvas-threadcanvas
lambda
unless
funcallfunction
sdl-canvas-windowcanvas
error'canvas-error:canvascanvas:operationoperation:reason:native-window-operation-failed:details
sdl3:get-error
canvas
defmethod
check-typetitlestring
when
call-sdl-canvas-window-operationcanvas:set-title
lambda
window
sdl3:set-window-titlewindowtitle
setf
slot-valuecanvas'title
title
defmethodcanvas-position
if
call-on-sdl-canvas-threadcanvas
lambda
multiple-value-bind
successxy
sdl3:get-window-position
sdl-canvas-windowcanvas
unlesssuccess
error'canvas-error:canvascanvas:operation:position:reason:native-position-failed:details
sdl3:get-error
valuesxy
values
sdl-canvas-xcanvas
sdl-canvas-ycanvas
defmethodmove-canvas
check-typexinteger
check-typeyinteger
when
call-on-sdl-canvas-threadcanvas
lambda

Top-level placement is only a request: Wayland and some other window managers are entitled to reject it.

sdl3:set-window-position
sdl-canvas-windowcanvas
xy
setf
sdl-canvas-xcanvas
x
sdl-canvas-ycanvas
y
canvas
defmethodresize-canvas
check-typewidth
integer1
check-typeheight
integer1
when
call-sdl-canvas-window-operationcanvas:resize
lambda
window
sdl3:set-window-sizewindowwidthheight
setf
canvas-widthcanvas
width
canvas-heightcanvas
height
canvas
defmethodcanvas-clipboard-text

The clipboard belongs to the video subsystem, which only answers on the thread that initialized it.

call-on-sdl-canvas-threadcanvas
lambda
when
sdl3:has-clipboard-text
let
text
sdl3:get-clipboard-text
and
plusp
lengthtext
text
defmethodset-canvas-fullscreen
let
enabled
andenabledt
when
call-sdl-canvas-window-operationcanvas:fullscreen
lambda
window
prog1
sdl3:set-window-fullscreenwindowenabled

The new extent arrives as an ordinary resize event; letting SDL settle here keeps canvas-size honest for a caller that looks immediately after toggling.

sdl3:sync-windowwindow
canvas
defmethodrequest-canvas-frame

Dynamic bindings do not follow a closure onto another thread. Preserve the opt-in trace explicitly so a caller can measure the real native frame rather than only the time spent waiting for its request. #OHNIWM

What went wrong, kept.

The pump itself must not die of application errors: a frame that throws, a key handler that throws, a paint that throws. Each of those runs under a guard that catches the condition with its backtrace still standing, retains it on the canvas, logs it, and lets the loop go on servicing the window. A failed frame parks the frame clock -- rendering into a broken world every 16 ms would only bury the evidence -- until someone fixes the cause and asks for resume-canvas-frames. Anyone who changed the world and wants to know what the next frame made of it can fence-canvas and read what was retained since.

defstructcanvas-failure

One error caught on a canvas loop, with everything needed to read it later.

serialcanvasphaseuniversal-timetickconditionreportbacktrace
defvar*canvas-failure-serial*0

A count of every failure retained on any canvas, so a caller can mark a moment and later ask what failed after it.

defvar*canvas-failure-lock*
sb-thread:make-mutex:name"luv canvas failure lock"
defparameter*canvas-failure-limit*12"How many failures a canvas keeps; the oldest are forgotten."
defparameter*canvas-failure-backtrace-depth*40"How many frames of backtrace a retained failure carries."
defvar*open-sdl-canvases*'

Every SDL canvas whose loop is running, so a fence or a hold can find them without being handed one.

defvar*open-sdl-canvases-lock*
sb-thread:make-mutex:name"luv open canvases lock"
defunopen-canvases

The canvases whose native loops are running right now.

sb-thread:with-mutex
defparameter*canvas-failure-backtrace-floor*'
"SDL-CANVAS-EVENT-LOOP""PROCESS-SDL-CANVAS-REQUESTS""MAIN-RUNNER"

Frames at which a retained backtrace stops: below them is the pump and the image's own toplevel, the same in every failure and never the point.

defuncapture-backtrace-string

The current backtrace as text, from the frame that asked for it down to the pump: forms abbreviated, the frames of the capture itself left out.

let
text
with-output-to-string
stream
let
*print-length*6
*print-level*3
*print-pretty*nil
sb-debug:print-backtrace:streamstream:countdepth:emergency-best-effortt
with-output-to-string
out
with-input-from-string
intext
loopforline=
read-lineinnil
forindexfrom0whileline

The first line names the thread; then the capture, the guard's handler, %SIGNAL, and ERROR itself.

unless
and
pluspindex
<index5
or
search"CAPTURE-BACKTRACE-STRING"line
search"%SIGNAL"line
search"(ERROR "line
search"(LAMBDA (CONDITION)"line
do
write-linelineout
whendo
defunretain-canvas-failure
canvasphaseconditionbacktrace

Keep condition, caught in phase on canvas with backtrace, and log it.

let
failure
make-canvas-failure:canvascanvas:phasephase:universal-time
get-universal-time
:tick
sdl-canvas-tickscanvas
:conditioncondition:report
handler-case
princ-to-stringcondition
error
formatnil"~S"
type-ofcondition
:backtracebacktrace
sb-thread:with-mutex
setf
canvas-failure-serialfailure
setf
sdl-canvas-failurescanvas
subseq
consfailure
sdl-canvas-failurescanvas
0
log-event:canvas"~S failed in ~(~A~): ~A~@[~%~A~]"phase
canvas-failure-reportfailure
backtrace
failure
defuncanvas-failures

canvas's retained failures, newest first.

sdl-canvas-failurescanvas
defuncanvas-failures-since
serial

Every retained failure on any open canvas newer than serial, oldest first.

sort
loopforcanvasinappend
remove-if-not
lambda
failure
>
canvas-failure-serialfailure
serial
#'<:key#'canvas-failure-serial
defuncanvas-failure-serial-now

The failure serial as of now: pass it later to canvas-failures-since.

defunreport-canvas-failure
failure&optional
stream*standard-output*

Print failure for a person: when, where, what, and the backtrace.

multiple-value-bind
decode-universal-time
canvas-failure-universal-timefailure
formatstream

&~2,'0D:~2,'0D:~2,'0D canvas ~S failed in ~(~A) ~ (loop iteration ~D):~% ~A~%

hourminutesecond
canvas-title
canvas-failure-canvasfailure
canvas-failure-phasefailure
canvas-failure-tickfailure
canvas-failure-reportfailure
when
canvas-failure-backtracefailure
formatstream"~A~%"
canvas-failure-backtracefailure
defmacroguarding-sdl-canvas
canvasphase
&bodybody

Run body on canvas's loop in PHASE; an error is retained, not raised. Returns body's values, or NIL and the failure as a second value.

let
backtrace
gensym"BACKTRACE"
failure
gensym"FAILURE"
`
let
,backtracenil
,failurenil
values
handler-case
handler-bind
error
lambda
condition
declare
ignorecondition
,@body
error
condition
setf,failure
retain-canvas-failure,canvas,phasecondition,backtrace
nil
,failure
defunresume-canvas-frames

Let canvas run frames again after a frame failure parked them.

setf
sdl-canvas-frame-failurecanvas
nil
canvas
defunhold-canvas-frames

Stop canvas running frames or delivering events; the window is still pumped. For the duration of a redefinition the loop must not run through.

setf
sdl-canvas-frames-held-pcanvas
t
canvas
defuncall-with-canvas-frames-held
function&optional

Call function with every canvas in canvases holding its frames and events.

unwind-protect
progn

A frame already under way finishes; wait for the loops to come round to a phase that honours the hold.

dolist
canvascanvases
fence-canvascanvas:frames0:timeout1.0
funcallfunction
defunfence-canvas
canvas&key
frames1
timeout5.0

Wait until canvas has run frames more frames -- or, with no frame clock, come round its loop twice more -- and return :DONE; :FAILED as soon as a frame failure parks it; :CLOSED if it closes; :timeout after timeout seconds. This is how a caller who just changed the world finds out what the next frame made of the change.

let*
start-frames
sdl-canvas-frame-countcanvas
start-ticks
sdl-canvas-tickscanvas
deadline
+
get-internal-real-time
*timeoutinternal-time-units-per-second
loop
cond
sdl-canvas-frame-failurecanvas
return:failed
not
member'
:opening:open
return:closed
if
andcadence-p
not
sdl-canvas-frames-held-pcanvas
>=
sdl-canvas-frame-countcanvas
+start-framesframes
>=
sdl-canvas-tickscanvas
+start-ticks2
return:done
>
get-internal-real-time
deadline
return:timeout
sleep0.002
defunfence-canvases
&key
frames1
timeout5.0

fence-canvas every open canvas; an alist of canvas to outcome.

mapcar
lambda
conscanvas
fence-canvascanvas:framesframes:timeouttimeout
defunsdl-canvas-window-event-p
canvasevent
=
sdl3:%window-idevent
sdl3:get-window-id
sdl-canvas-windowcanvas
defunsdl-canvas-window-id-p
canvaswindow-id
=window-id
sdl3:get-window-id
sdl-canvas-windowcanvas
defunsdl-mouse-button-name
button
casebutton
1:left
2:middle
3:right
4:x1
5:x2
defundispatch-sdl-pointer-motion
canvaseventclass
when
dispatch-canvas-eventcanvas
make-instanceclass:timestamp
sdl3:%timestampevent
:x
sdl3:%xevent
:y
sdl3:%yevent
:delta-x
sdl3:%xrelevent
:delta-y
sdl3:%yrelevent
defundispatch-sdl-pointer-button
canvaseventclass
when
let
button
sdl-mouse-button-name
sdl3:%buttonevent
whenbutton
dispatch-canvas-eventcanvas
make-instanceclass:timestamp
sdl3:%timestampevent
:x
sdl3:%xevent
:y
sdl3:%yevent
:buttonbutton:clicks
sdl3:%clicksevent
defundispatch-sdl-pointer-wheel
canvasevent

Turn one SDL wheel event into a canvas one.

SDL reports a flipped direction rather than flipped amounts when the platform is set to natural scrolling, so the sign is corrected here and consumers only ever see what the user meant.

when

The struct reader hands the direction back as the enum's keyword when it can translate it and as the raw integer when it cannot, so both spellings of "flipped" are honoured; anything else is normal.

let*
direction
sdl3:%directionevent
sign
if
or
eqdirection:flipped
eqldirection
cffi:foreign-enum-value'sdl3::mouse-wheel-direction:flipped
-1.01.0
dispatch-canvas-eventcanvas
make-instance'canvas-pointer-wheel-event:timestamp
sdl3:%timestampevent
:x
sdl3:%mouse-xevent
:y
sdl3:%mouse-yevent
:scroll-x
*sign
sdl3:%xevent
:scroll-y
*sign
sdl3:%yevent
defundispatch-sdl-pointer-boundary
canvaseventclass
when
multiple-value-bind
buttonsxy
sdl3:get-mouse-state
declare
ignorebuttons
dispatch-canvas-eventcanvas
make-instanceclass:timestamp
sdl3:%timestampevent
:xx:yy
defunsdl-scancode-key-name
scancode

Translate SDL's physical key names into luv's portable vocabulary.

casescancode
:minus
intern"-""KEYWORD"
:equals
intern"=""KEYWORD"
:leftbracket
intern"[""KEYWORD"
:rightbracket
intern"]""KEYWORD"
:backslash
intern"\\""KEYWORD"
:semicolon
intern";""KEYWORD"
:apostrophe
intern"'""KEYWORD"
:grave
intern"`""KEYWORD"
:comma
intern",""KEYWORD"
:period
intern".""KEYWORD"
:slash
intern"/""KEYWORD"
:lctrl:control-left
:lshift:shift-left
:lalt:alt-left
:lgui:super-left
:rctrl:control-right
:rshift:shift-right
:ralt:alt-right
:rgui:super-right
:capslock:caps-lock
:printscreen:print-screen
:scrolllock:scroll-lock
:numlockclear:num-lock
:pageup:page-up
:pagedown:page-down
:application:menu
otherwisescancode
defunsdl-key-modifiers
modifiers

Translate SDL's left/right modifier bitfield into logical modifiers.

labels
present-p
&restnames
some
lambda
name
membernamemodifiers
names
removenil
list
and
present-p:lshift:rshift
:shift
and
present-p:lctrl:rctrl:ctrl
:control
and
present-p:lalt:ralt:alt
:meta
and
present-p:lgui:rgui:gui
:super
and
present-p:caps
:caps-lock
and
present-p:num
:num-lock

SDL's KMSDRM backend never learns the console's keymap, so a Dvorak console gets QWERTY characters from SDL_GetKeyFromScancode. The layout override translates scancodes itself; keys it does not list (digits, space, editing keys) fall through to SDL, whose QWERTY answer matches.

defparameter+dvorak-scancode-characters+'
:q.#\'
:w.#\,
:e.#\.
:r.#\p
:t.#\y
:y.#\f
:u.#\g
:i.#\c
:o.#\r
:p.#\l
:leftbracket.#\/
:rightbracket.#\=
:a.#\a
:s.#\o
:d.#\e
:f.#\u
:g.#\i
:h.#\d
:j.#\h
:k.#\t
:l.#\n
:semicolon.#\s
:apostrophe.#\-
:z.#\;
:x.#\q
:c.#\j
:v.#\k
:b.#\x
:n.#\b
:m.#\m
:comma.#\w
:period.#\v
:slash.#\z
:minus.#\[
:equals.#\]
"Dvorak characters by physical scancode; unlisted keys match QWERTY."
defparameter+us-shifted-characters+'
#\1.#\!
#\2.#\@
#\3.#\#
#\4.#\$
#\5.#\%
#\6.#\^
#\7.#\&
#\8.#\*
#\9.#\(
#\0.#\)
#\'.#\"
#\,.#\<
#\..#\>
#\;.#\:
#\/.#\?
#\-.#\_
#\=.#\+
#\[.#\{
#\].#\}
#\`.#\~
#\\.#\|
"The US shift pairs, which Dvorak shares for its printing characters."
defvar*canvas-keyboard-layout*:environment

Character layout override: :DVORAK, NIL to trust SDL's keymap, or :ENVIRONMENT to read luv_KEYBOARD_layout at first use.

defvar*canvas-swap-caps-control*:environment

Whether the Caps Lock key acts as Control, as the console's ctrl:swapcaps option intends: T, NIL, or :ENVIRONMENT to read luv_KEYBOARD_SWAP_CAPS_CONTROL at first use. The physical Control keys stay Control; nobody wants Caps Lock in a game.

defvar*canvas-caps-control-down-p*nil

Whether the Caps Lock key, remapped to Control, is currently held. SDL's modifier state reports Caps Lock as a toggle rather than a held key, so the swap has to track the key itself.

defuncanvas-swap-caps-control-p
when
setf*canvas-swap-caps-control*
let
value
uiop:getenv"LUV_KEYBOARD_SWAP_CAPS_CONTROL"
andvalue
not
membervalue'
"""0"
:test#'string=
*canvas-swap-caps-control*
defunsdl-swapped-key-modifiers
modifiers

Logical modifiers for modifiers with the Caps-as-Control swap applied.

let
logical
if
let
cleaned
remove:caps-locklogical
if*canvas-caps-control-down-p*
adjoin:controlcleaned
cleaned
logical
defuncanvas-keyboard-layout
when
setf*canvas-keyboard-layout*
let
name
uiop:getenv"LUV_KEYBOARD_LAYOUT"
cond
nullname
nil
string-equalname"dvorak"
:dvorak
t
warn"Ignoring unknown LUV_KEYBOARD_LAYOUT ~S."name
nil
*canvas-keyboard-layout*
defunlayout-key-character
scancodemodifiers

Return scancode's character under the override layout, or NIL to ask SDL.

case
:dvorak
let
base
whenbase
if
intersection'
:lshift:rshift:shift
modifiers
if
alpha-char-pbase
char-upcasebase
base
defunsdl-key-character
scancodemodifiers

Return scancode's character under the configured layout and modifiers.

or
layout-key-characterscancodemodifiers
let
code
raw-sdl-key-from-scancodescancodemodifiersnil
when
or
membercode'
891327127
<=32code
1-char-code-limit
code-charcode
zdefun
dispatch-sdl-key:zone:canvas/key-event:value
canvaseventclass

Read fields directly from SDL_Event. Materializing cl-sdl3's KEYBOARD-EVENT would translate its KEY slot through the broken enum even though luv intentionally derives characters from SCANCODE and mod.

let*
type'
:structsdl3:keyboard-event
window-id
cffi:foreign-slot-valueeventtype'sdl3::%window-id
when
let*
raw-scancode
cffi:foreign-slot-valueeventtype'sdl3::%scancode
swapped-p
and
eqraw-scancode:capslock
scancode
ifswapped-p:lctrlraw-scancode
modifiers
cffi:foreign-slot-valueeventtype'sdl3::%mod
key-name
unless
eqkey-name:unknown
dispatch-canvas-eventcanvas
make-instanceclass:timestamp
cffi:foreign-slot-valueeventtype'sdl3::%timestamp
:key-namekey-name:modifiers:character
sdl-key-characterscancodemodifiers
:unshifted-character:repeat-p
cffi:foreign-slot-valueeventtype'sdl3::%repeat
defundispatch-sdl-window-event
canvaseventclass
when
dispatch-canvas-eventcanvas
make-instanceclass:timestamp
sdl3:%timestampevent
defundispatch-sdl-window-size-event
canvaseventclass
when
dispatch-canvas-eventcanvas
make-instanceclass:timestamp
sdl3:%timestampevent
:width
sdl3:%data-1event
:height
sdl3:%data-2event
defundispatch-sdl-canvas-close-request
canvastimestamp

Offer a native close to canvas and apply the default immediate policy.

An application returning :DEFER-CANVAS-CLOSE has begun orderly teardown on another thread; its eventual close-canvas call ends the loop. This lets it release resources layered above the presentation context before SDL destroys that context. Every other handler retains the ordinary native close policy.

unless
eq:defer-canvas-close
setf
sdl-canvas-close-requested-pcanvas
t
defunsynchronize-sdl-canvas-logical-size
canvastimestamp

Publish SDL's current logical size when it changed without RESIZED first.

multiple-value-bind
unless
and
=width
canvas-widthcanvas
=height
canvas-heightcanvas
setf
canvas-widthcanvas
width
canvas-heightcanvas
height
dispatch-canvas-eventcanvas
make-instance'canvas-window-resized-event:timestamptimestamp:widthwidth:heightheight
zdefun
handle-sdl-canvas-event:zone:canvas/event:valueevent-type
canvaseventevent-type

Keep the raw event tag: SDL_RegisterEvents may return a value absent from cl-sdl3's static enum. Decode only the native events we understand.

cond
=event-type
cffi:foreign-enum-value'sdl3::event-type:quit

macOS Command-Q is SDL_EVENT_quit rather than a window-close event. Give it the identical application teardown path.

dispatch-sdl-canvas-close-requestcanvas
cffi:foreign-slot-valueevent'
:structsdl3:common-event
'sdl3::%timestamp
memberevent-type
list
cffi:foreign-enum-value'sdl3::event-type:window-close-requested
cffi:foreign-enum-value'sdl3::event-type:window-resized
cffi:foreign-enum-value'sdl3::event-type:window-pixel-size-changed
cffi:foreign-enum-value'sdl3::event-type:window-mouse-enter
cffi:foreign-enum-value'sdl3::event-type:window-mouse-leave
cffi:foreign-enum-value'sdl3::event-type:window-focus-gained
cffi:foreign-enum-value'sdl3::event-type:window-focus-lost
let
window-event
cffi:mem-refevent'
:structsdl3:window-event
when
cond
=event-type
cffi:foreign-enum-value'sdl3::event-type:window-close-requested
dispatch-sdl-canvas-close-requestcanvas
sdl3:%timestampwindow-event
=event-type
cffi:foreign-enum-value'sdl3::event-type:window-resized
setf
canvas-widthcanvas
sdl3:%data-1window-event
canvas-heightcanvas
sdl3:%data-2window-event
=event-type
cffi:foreign-enum-value'sdl3::event-type:window-pixel-size-changed

Wayland may report the new pixel extent before the corresponding logical resize. Querying here keeps layout ahead of repaint.

=event-type
cffi:foreign-enum-value'sdl3::event-type:window-mouse-enter
=event-type
cffi:foreign-enum-value'sdl3::event-type:window-mouse-leave
=event-type
cffi:foreign-enum-value'sdl3::event-type:window-focus-gained
=event-type
cffi:foreign-enum-value'sdl3::event-type:key-down
=event-type
cffi:foreign-enum-value'sdl3::event-type:key-up
=event-type
cffi:foreign-enum-value'sdl3::event-type:mouse-motion
dispatch-sdl-pointer-motioncanvas
cffi:mem-refevent'
:structsdl3:mouse-motion-event
'canvas-pointer-motion-event
=event-type
cffi:foreign-enum-value'sdl3::event-type:mouse-button-down
dispatch-sdl-pointer-buttoncanvas
cffi:mem-refevent'
:structsdl3:mouse-button-event
'canvas-pointer-button-press-event
=event-type
cffi:foreign-enum-value'sdl3::event-type:mouse-button-up
dispatch-sdl-pointer-buttoncanvas
cffi:mem-refevent'
:structsdl3:mouse-button-event
'canvas-pointer-button-release-event
=event-type
cffi:foreign-enum-value'sdl3::event-type:mouse-wheel
dispatch-sdl-pointer-wheelcanvas
cffi:mem-refevent'
:structsdl3:mouse-wheel-event
defunpoll-sdl-canvas-event
cffi:with-foreign-object
event'
:unionsdl3:event
when
sdl3:poll-eventevent
guarding-sdl-canvas
canvas:events
handle-sdl-canvas-eventcanvasevent
cffi:mem-refevent:uint32
t

Where the loop is, published for anyone who wants to know whether it is still moving. Two slot writes per phase: this runs on the thread whose responsiveness is the whole question, so it may not allocate, lock, or call out.

defunenter-sdl-canvas-phase
canvasphase

Record that canvas's native loop has just entered phase.

The time is written first: a reader that catches the pair mid-update then sees the old phase with a fresh clock, and so underestimates a stall by one phase rather than inventing one.

setf
sdl-canvas-phase-timecanvas
get-internal-real-time
sdl-canvas-phasecanvas
phase
defunsdl-canvas-phase-seconds

How long canvas has been in its current phase, or NIL before it started.

let
entered
sdl-canvas-phase-timecanvas
whenentered
/
float
-
get-internal-real-time
entered
1d0
internal-time-units-per-second
defparameter*canvas-event-wait-slice*0.25

The longest a canvas ever stays inside SDL waiting for an event.

A loop that can block indefinitely cannot be observed: it looks exactly like a loop that has died, and a demand-clock canvas used to do precisely that by asking SDL_WaitEvent for no deadline at all. Every wait is now a step this long at most, so the loop always comes up for air, always republishes where it is, and a watchdog can tell a parked canvas from a wedged one by the only evidence that matters: whether the loop came back.

defunwait-for-sdl-canvas-event
canvastimeout
cffi:with-foreign-object
event'
:unionsdl3:event
when
sdl3:wait-event-timeouteventtimeout

Handling belongs to its own phase: an event handler runs application code -- a keystroke into the terminal wall, a click into an overlay -- and is a place the loop can be lost for reasons that have nothing to do with waiting.

guarding-sdl-canvas
canvas:events
handle-sdl-canvas-eventcanvasevent
cffi:mem-refevent:uint32
defunsdl-canvas-wait-milliseconds
canvastimestamp

How many milliseconds this iteration may spend inside SDL's event wait.

let
ifrequested
max0
minrequestedslice
slice
zdefun
run-sdl-canvas-frame:zone:canvas/service-frame
canvastimestamp

Service the clock once, under guard. A frame that fails parks the clock in FRAME-FAILURE; a frame that runs counts.

multiple-value-bind
ran-pfailure
cond
failure
setf
sdl-canvas-frame-failurecanvas
failure
ran-p
incf
sdl-canvas-frame-countcanvas
defunsdl-canvas-event-loop
loopuntil
sdl-canvas-close-requested-pcanvas
do
let

Held or parked, the loop still pumps the window; it only stops running the application through it.

*canvas-events-held-p*
or
sdl-canvas-frames-held-pcanvas
and
sdl-canvas-frame-failurecanvas
t
unless
sdl-canvas-close-requested-pcanvas
let

The next event or loop turn deserves a fresh real time. If an event handler asks first, its answer remains stable through the following request and frame phases.

incf
sdl-canvas-tickscanvas

The watchdog.

A window whose loop has stopped is not merely idle: macOS paints the beachball over it, it answers nothing, and the only way out is finding the process and killing it by hand. Every stall reaching the desktop this way has cost someone a hunt, so the loop is now watched from a thread that cannot be caught by the same block -- the phases above are all bounded, so a phase that stops advancing means the loop is gone, and that is a fact rather than a guess.

Three deadlines, each doing strictly more than the last: say so, take a native sample while the evidence still exists, and finally end the process so that no beachballing window outlives the Lisp that made it.

defparameter*canvas-watchdog-interval*0.5"How often the watchdog looks at the canvas it is watching."
defparameter*canvas-watchdog-warn-seconds*2.0

How long one phase may last before the watchdog starts saying so.

Nothing in a healthy loop takes this long: a frame is milliseconds, a request is serviced within one, and a wait is capped by *CANVAS-EVENT-WAIT-SLICE*. Two seconds is already far past anything that has ever been legitimate here.

defparameter*canvas-watchdog-sample-seconds*6.0

How long a stall lasts before the watchdog samples the process natively.

The sample is the part that is impossible to recover afterwards: once the image is killed, or restarted by whoever notices the window, the stack that would have named the deadlock is gone.

defparameter*canvas-watchdog-fatal-seconds*30.0

How long a stall lasts before the image ends itself, or NIL to never.

A wedged canvas thread on Darwin is the main thread, so the image is already unusable: every canvas call times out and the window answers nothing. Dying is what keeps the desktop clean, and ./sly start brings back a working image in seconds.

defvar*canvas-watchdog-inhibit-hook*nil

A function of no arguments; true means never end the process.

An attached debugger stopped inside a frame callback is a stall by every measure this file can take, and is also exactly what someone debugging the render loop wants. SLY-SERVER.LISP points this at a live Slynk connection check, so an image someone is holding open only ever gets logged at.

defunsdl-canvas-watched-phase-p
phase

Whether phase is one the event loop guarantees to leave promptly.

memberphase'
:requests:frame:waiting:events
defunsdl-canvas-fatal-deadline

How long canvas may stall before the image ends itself, or NIL for never.

Only a canvas with a window on screen is worth dying over: that window is the thing that beachballs, outlives its Lisp in the user's face, and has to be hunted down and killed by hand. A hidden canvas -- a capture, a benchmark, a smoke test -- is watched and sampled just the same, but a slow first frame there is somebody's build, not somebody's desktop.

defmethodcanvas-health
let
failure
sdl-canvas-frame-failurecanvas
list:state:phase
sdl-canvas-phasecanvas
:phase-seconds:ticks
sdl-canvas-tickscanvas
:frames
sdl-canvas-frame-countcanvas
:stalled-p:held-p
sdl-canvas-frames-held-pcanvas
:failure-count
length
sdl-canvas-failurescanvas
:frame-failure
andfailure
list:report
canvas-failure-reportfailure
:phase
canvas-failure-phasefailure
:universal-time
canvas-failure-universal-timefailure
:tick
canvas-failure-tickfailure
defuncanvas-stall-sample-pathname
declare
ignorecanvas
let
name
formatnil"canvas-stall-~D-~D.txt"
sb-unix:unix-getpid
get-universal-time
merge-pathnamesname
or
ignore-errors
let
directory
asdf:system-relative-pathname"luv""build/"
ensure-directories-existdirectory
uiop:temporary-directory
defunsample-stalled-canvas-process
canvasseconds

Write a native sample of this process while the stall is still happening.

#-darwin
progn
log-event:watchdog"no native sampler on this platform; stall of ~,1F s unsampled"seconds
nil
#+darwin (let ((pathname (canvas-stall-sample-pathname canvas))) (handler-case (progn (uiop:run-program (list "sample" (princ-to-string (sb-unix:unix-getpid)) "1" "-file" (namestring pathname)) :output nil :error-output nil :ignore-error-status t) (log-event :watchdog "sampled the process ~,1F s into the stall: ~A" seconds (namestring pathname)) pathname) (error (condition) (log-event :watchdog "could not sample the stalled process: ~A" condition) nil)))
defunend-stalled-canvas-process
canvasseconds
log-event:watchdog

canvas ~S has been in ~S for ~,1F s; ending this image so its window ~ does not outlive it. Bind luv:*canvas-watchdog-fatal-seconds* to NIL to keep ~ a stalled image for inspection.

sdl-canvas-phasecanvas
seconds
finish-output*error-output*

Unwinding would need the very thread that is stuck, and every ordinary teardown path goes through it. Leave abruptly instead: the window dies with the process, which is the entire point.

sb-ext:exit:code70:abortt
defunwatch-sdl-canvas

Watch canvas's native loop until it closes, escalating while it is stuck.

let
announced0.0
sampled-pnil
loopwhile
member'
:opening:open
do
let
cond
nullseconds
when
pluspannounced
log-event:watchdog"canvas ~S is answering again"
setfannounced0.0sampled-pnil
t
let
when
setfannouncedseconds
log-event:watchdog

canvas S has been in ~S for ~,1F s and is not ~ servicing its window~@[; ending this image in ~,1F s unless it recovers]

sdl-canvas-phasecanvas
seconds
whenfatal
max0.0
-fatalseconds
defunstart-sdl-canvas-watchdog
setf
sdl-canvas-watchdogcanvas
sb-thread:make-thread
lambda
handler-case
error
condition
log-event:watchdog"watchdog for ~S stopped: ~A"condition
:name"luv canvas watchdog"
defunstop-sdl-canvas-watchdog
let
thread
sdl-canvas-watchdogcanvas
setf
sdl-canvas-watchdogcanvas
nil
when
andthread
sb-thread:thread-alive-pthread

The watchdog leaves on its own once the state is no longer open; it only ever sleeps for an interval, so this join is bounded by that.

ignore-errors
sb-thread:join-threadthread:timeout:defaultnil
values
defunrun-sdl-canvas
with-sdl-native-environment
let
sdl-initialized-pnil
unwind-protect
handler-case
progn
unless
error"SDL video initialization failed: ~A"
sdl3:get-error
setfsdl-initialized-pt
let
wake-event-type
sdl3:register-events1
when
zeropwake-event-type
error"SDL user event registration failed: ~A"
sdl3:get-error
setf
sdl-canvas-wake-event-typecanvas
wake-event-type
let
window
multiple-value-bind

KMSDRM's console keyboard support installs its own fatal-signal handlers here.

when
cffi:null-pointer-pwindow
error"SDL window creation failed: ~A"
sdl3:get-error
setf
sdl-canvas-windowcanvas
window
when
and
sdl-canvas-xcanvas
sdl-canvas-ycanvas

Wayland and some other window managers deliberately deny applications control over top-level placement.

sdl3:set-window-positionwindow
sdl-canvas-xcanvas
sdl-canvas-ycanvas
multiple-value-bind
log-event:canvas"opened ~S, ~Dx~D pixels, ~(~A~)"widthheight
sdl-canvas-presentation-apicanvas
sb-thread:signal-semaphore
sdl-canvas-startup-completioncanvas
error
condition

Only what the guards above cannot catch reaches here: startup, and the loop's own machinery.

log-event:canvas"~S failed outside any guard: ~A"condition
setf
sdl-canvas-startup-errorcanvas
condition
when
sb-thread:signal-semaphore
sdl-canvas-startup-completioncanvas

Teardown is deliberately outside the watchdog's reach: it runs on this same thread with the loop already gone, so its phases would look like a stall, and killing the image in the middle of releasing a device would trade a clean window for a dirty exit.

setf:closing
log-event:canvas"closing ~S after ~D loop iterations"
sdl-canvas-tickscanvas
when
handler-case
error
condition
unless
sdl-canvas-startup-errorcanvas
setf
sdl-canvas-startup-errorcanvas
condition
when
sdl-canvas-windowcanvas
sdl3:destroy-window
sdl-canvas-windowcanvas
setf
sdl-canvas-windowcanvas
nil

The window is gone from SDL; give the native loop a few turns so the desktop learns it too, rather than leaving a ghost that beachballs until the process ends.

looprepeat5do
sdl3:pump-events
sleep0.005
whensdl-initialized-p
handler-case
error
condition
unless
sdl-canvas-startup-errorcanvas
setf
sdl-canvas-startup-errorcanvas
condition
setf
sdl-canvas-wake-event-typecanvas
nil

If event dispatch or rendering killed the native loop, wake every synchronous caller with that exact condition. Replacing it with a generic :CANVAS-CLOSED made the actionable error available only by inspecting SDL-CANVAS-STARTUP-ERROR after the fact.

log-event:canvas"closed ~S"

close-canvas's completion is also permission for its caller to open a replacement. Publish native-host release before waking it.

sb-thread:signal-semaphore
sdl-canvas-shutdown-completioncanvas
defunstart-sdl-canvas-thread#+darwin (progn ;; Claim synchronously. CALL-IN-MAIN-THREAD cannot run a second canvas ;; while the first one owns SDL's durable Cocoa event loop, so queueing it ;; would leave OPEN-CANVAS waiting forever with no possible signaller. (claim-sdl-canvas-host canvas) (handler-case (progn (setf (sdl-canvas-thread canvas) (trivial-main-thread:main-thread)) (sb-thread:make-thread (lambda () (handler-case (trivial-main-thread:call-in-main-thread ;; CALL-IN-MAIN-THREAD is intentionally nonblocking here: ;; this dispatcher returns once the work is queued. Keep ;; host ownership around the queued function itself. (lambda () (unwind-protect (run-sdl-canvas canvas) (release-sdl-canvas-host canvas)))) (error (condition) ;; A dispatcher failure happens outside RUN-SDL-CANVAS's ;; lifecycle handler. Publish it to both waiters rather ;; than leaving OPEN-CANVAS or CLOSE-CANVAS asleep. (release-sdl-canvas-host canvas) (setf (sdl-canvas-startup-error canvas) condition (canvas-state canvas) :closed) (sb-thread:signal-semaphore (sdl-canvas-startup-completion canvas)) (sb-thread:signal-semaphore (sdl-canvas-shutdown-completion canvas))))) :name "luv SDL Cocoa dispatcher")) (error (condition) (release-sdl-canvas-host canvas) (error condition))))#-darwin
setf
sdl-canvas-threadcanvas
sb-thread:make-thread:name"luv SDL canvas event loop"
defmethodopen-canvas
unless
member'
:new:closed
error'canvas-state-error:canvascanvas:operation:open:reason:invalid-state:state:expected-state'
:new:closed
setf:opening
sdl-canvas-startup-errorcanvas
nil
sdl-canvas-close-requested-pcanvas
nil
sdl-canvas-startup-completioncanvas
sb-thread:make-semaphore:count0
sdl-canvas-shutdown-completioncanvas
sb-thread:make-semaphore:count0
handler-case
error
condition

Keep a rejected host claim out of the :OPENING state. In particular, callers such as realize-mirror may reasonably attempt cleanup after open-canvas signals; close-canvas must not wait for a thread that was never started.

setf
sdl-canvas-startup-errorcanvas
condition
:closed
errorcondition
sb-thread:wait-on-semaphore
sdl-canvas-startup-completioncanvas
cond
sdl-canvas-startup-errorcanvas
error
sdl-canvas-startup-errorcanvas
t
error'canvas-error:canvascanvas:operation:open:reason:closed-during-startup
defmethodclose-canvas
when
member'
:opening:open
setf
sdl-canvas-close-requested-pcanvas
t
unless
sb-thread:wait-on-semaphore
sdl-canvas-shutdown-completioncanvas
values