Recipes

The examples use SBCL's sb-thread where they need threads; any thread library works the same.

Windows on a thread of their own

A window belongs to the thread that created it, and that thread must keep taking its messages. A program whose other threads come and go, such as one driven from a REPL, can give its windows a thread of their own and hand that thread the work. The thread owns a message-only window, the messenger; work is sent to it as a message of the program's own. send-message waits until the thread has run it, and the thread takes it even while Windows runs its own loop, as when the user drags a window's border.

(defconstant +run-work+ (+ win32:+wm-app+ 1) "The message that runs *WORK*.")

(defvar *messenger* 0 "The window thread's message-only window.")
(defvar *work* nil "The function the window thread runs next.")
(defvar *result* nil "What it returned, or the error it signalled.")
(defvar *work-lock* (sb-thread:make-mutex) "Lets one thread at a time hand over work.")

(win32:define-window-procedure app-procedure (window message wparam lparam)
  "Run work sent to the messenger; leave everything else to Windows."
  (declare (ignore wparam lparam))
  (when (and (= window *messenger*) (= message +run-work+))
    (setf *result* (handler-case (funcall *work*)
                     (error (condition) condition)))
    0))

(defun call-in-window-thread (function)
  "Call FUNCTION in the window thread, and return what it returns."
  (sb-thread:with-mutex (*work-lock*)
    (setf *work* function)
    (win32:send-message *messenger* +run-work+)
    (if (typep *result* 'error)
        (error *result*)
        *result*)))

(defun start-window-thread ()
  "Start the window thread, and return once it takes work."
  (win32:register-window-class "app" 'app-procedure)
  (win32:with-event (started)
    (sb-thread:make-thread
     (lambda ()
       (win32:set-thread-dpi-awareness :per-monitor-aware-v2)
       (setf *messenger* (win32:create-window "app" :parent :message :styles '()))
       (win32:set-event started)
       (win32:run-message-loop))
     :name "windows")
    (win32:wait-for-event started)))

(defun stop-window-thread ()
  "End the window thread, whose windows have been destroyed."
  (call-in-window-thread (lambda ()
                           (win32:destroy-window *messenger*)
                           (win32:post-quit-message)))
  (win32:unregister-window-class "app"))

Then, from any thread:

(start-window-thread)
(let ((window (call-in-window-thread
               (lambda () (win32:create-window "app" :title "From the REPL"
                                                     :styles '(:overlapped-window :visible))))))
  (setf (win32:window-text window) "Renamed")   ; any thread may do this
  (call-in-window-thread (lambda () (win32:destroy-window window))))
(stop-window-thread)

An error in the work comes back to the caller of call-in-window-thread. Never call it holding a lock the window procedure takes: the window thread would wait for the lock, and the caller for the window thread. This is how cl-windowing's Win32 backend runs its windows.

A game loop

A game renders frames as fast as it can and handles messages between them, without waiting:

(loop
  (multiple-value-bind (quit code) (win32:process-messages)
    (when quit
      (return code)))
  (update-world)
  (render-frame))

The window procedure posts the quit message when the window is destroyed, as in Getting Started.

Drawing with Vulkan

A window drawn through a Vulkan swapchain needs Windows to stay out of the way:

((= message win32:+wm-paint+) (win32:validate-window window) 0)  ; frames come from the swapchain
((= message win32:+wm-erasebkgnd+) 1)                            ; nothing to erase
((= message win32:+wm-size+)
 (unless (= wparam win32:+size-minimized+)
   (setf *swapchain-stale* t))                                   ; recreate at the new size
 0)

The swapchain's size is the client area, client-size; Vulkan on Windows insists on it. vkCreateWin32SurfaceKHR takes the program's module and the window, as pointers: (cl-ffi:make-pointer (win32:module-handle)) and (cl-ffi:make-pointer window). cl-windowing/vulkan does all this for cl-windowing's windows.

Typing text

Join surrogate pairs, and drop control characters:

(defvar *high-surrogate* 0 "The first half of a character typed in two +WM-CHAR+s, or 0.")

(defun typed (code)
  "Return the character a +WM-CHAR+ with CODE completes, or NIL."
  (cond ((<= #xD800 code #xDBFF) (setf *high-surrogate* code) nil)
        ((<= #xDC00 code #xDFFF)
         (prog1 (and (plusp *high-surrogate*)
                     (code-char (+ #x10000 (ash (- *high-surrogate* #xD800) 10) (- code #xDC00))))
           (setf *high-surrogate* 0)))
        ((or (< code 32) (= code 127)) nil)
        (t (code-char code))))

;; In the window procedure:
((= message win32:+wm-char+)
 (let ((character (typed wparam)))
   (when character
     (insert-character character)))
 0)
((= message win32:+wm-syschar+) 0)   ; typed with Alt: no beep

Dragging

Capture the pointer from the press to the release, and give up the drag if the capture is lost:

((= message win32:+wm-lbuttondown+)
 (win32:set-capture window)
 (start-drag (win32:signed-low-word lparam) (win32:signed-high-word lparam))
 0)
((= message win32:+wm-mousemove+)
 (when *dragging*
   (drag-to (win32:signed-low-word lparam) (win32:signed-high-word lparam)))
 0)
((= message win32:+wm-lbuttonup+)
 (end-drag)
 (win32:release-capture)
 0)
((= message win32:+wm-capturechanged+)
 (cancel-drag)        ; another window took the pointer: no release will come
 0)

release-capture sends +wm-capturechanged+ before it returns, so end the drag first, and cancel-drag finds nothing to cancel.

Telling AltGr from Control

(defun altgr-control-p (window wparam lparam)
  "In the handling of a key message for WINDOW: true if this left Control
is the one Windows sends with AltGr."
  (and (eq (win32:virtual-key-name wparam) :control)
       (not (logbitp 24 lparam))
       (multiple-value-bind (next next-wparam next-lparam next-time)
           (win32:peek-message :window window)
         (and next
              (member next (list win32:+wm-keydown+ win32:+wm-syskeydown+
                                 win32:+wm-keyup+ win32:+wm-syskeyup+))
              (eq (win32:virtual-key-name next-wparam) :menu)
              (logbitp 24 next-lparam)
              (= next-time (win32:message-time))))))

Call it from the window procedure for +wm-keydown+ and +wm-keyup+ with the procedure's own arguments.