From 9c91ef66490a961020ed0284a93a0a34fbf7cf39 Mon Sep 17 00:00:00 2001 From: "Paul A. Patience" Date: Sun, 28 Jun 2020 17:26:31 -0400 Subject: [PATCH] extensions: randr: fix RR-GET-SCREEN-INFO rates The documentation for the RRGetScreenInfo request is admittedly opaque, but each screen size's corresponding sequence of refresh rates is preceded by a refresh rate count, which the length of the refresh rate information sequence includes, and the first of which RR-GET-SCREEN-INFO was skipping. Also, RR-GET-SCREEN-INFO was invariably reading the current refresh rate and the refresh rate information sequence whether the client had previously queried the version or not (which it had no way of knowing), which led to impenetrable SB-INT:INVALID-ARRAY-INDEX-ERRORs (on SBCL) when the server omitted the refresh rate information sequence in its reply. This commit introduces RR-MAYBE-QUERY-VERSION, which queries the version only when necessary (i.e., when supplied with NIL MAJOR and MINOR arguments), to conveniently handle version-dependent requests, and RR-HAS-RATES to handle the conditional refresh rates. Functions requiring RR-MAYBE-QUERY-VERSION should themselves accept MAJOR and MINOR as arguments in order to pass them on to RR-MAYBE-QUERY-VERSION. Although this commit introduces two backwards-incompatible changes, they should (hopefully) not be too inconvenient because this extension is as yet unfinished and thus unsuitable for general use. The first, and more important, change is the replacement of optional arguments with keyword arguments in all request functions having optional arguments, which affects only those callers who were supplying any optional arguments. Keyword arguments are more practical when functions have many unrequired arguments, and this will be the case of all functions executing version-dependent requests because the functions will need the extra (unrequired) MAJOR and MINOR arguments. The second, and more stylistic, change is the reordering of RR-GET-SCREEN-INFO's multiple return values in order that the current refresh rate and the refresh rate information sequence be located at the end (which evidently affects only the callers of the function). This is more consistent, because any parameters introduced in later protocol versions will belong at the end of any existing multiple return values in order to preserve backwards compatibility. Additionally: - Declaim RR-QUERY-VERSION and RR-GET-SCREEN-INFO, and expand their docstrings. - Fix the incorrect type definition of ROTATION-MASK. - Wrap some overlong lines. - Clean up some comments and whitespace. - Conform various details to the rest of the codebase. --- extensions/randr.lisp | 176 +++++++++++++++++++++++++++++++----------- 1 file changed, 132 insertions(+), 44 deletions(-) diff --git a/extensions/randr.lisp b/extensions/randr.lisp index 6ff4ef0..28e8922 100644 --- a/extensions/randr.lisp +++ b/extensions/randr.lisp @@ -182,7 +182,7 @@ '(member :rotate-0 :rotate-90 :rotate-180 :rotate-270 :reflect-x :reflect-y)) (deftype rotation-mask () - '(or mask16 (clx-list event-mask-class))) + '(or mask16 (clx-list rotation-mask-class))) ;; Select @@ -435,11 +435,23 @@ (boolean state) ) -;; x-requests +;;; Helpers +(declaim (ftype (function (card32 card32) (values boolean &optional)) + rr-has-rates)) +(defun rr-has-rates (major minor) + (or (> major 1) + (and (= major 1) (>= minor 1)))) + +;;; Requests + +(declaim (ftype (function (display) (values card32 card32 &optional)) + rr-query-version)) (defun rr-query-version (display) -"Returns version MAJOR and MINOR from server." - (with-buffer-request-and-reply (display (randr-opcode display) nil :sizes (32)) + "Execute the RRQueryVersion request and return its result as multiple +values consisting of the server's major and minor protocol versions." + (with-buffer-request-and-reply (display (randr-opcode display) nil + :sizes (32)) ((data +rr-QueryVersion+) (card32 +rr-major+) (card32 +rr-minor+)) @@ -447,6 +459,25 @@ (card32-get 8) (card32-get 12)))) +;; Unexported +(declaim (ftype (function (display (or null card32) (or null card32)) + (values card32 card32 &optional)) + rr-maybe-query-version)) +(defun rr-maybe-query-version (display major minor) + "Return MAJOR and MINOR as multiple values, substituting 0 for NIL, +unless they are both NIL, in which case call RR-QUERY-VERSION and return +its values. + +Some requests (e.g., RRGetScreenInfo) behave differently after a version +query (only the first query has any effect on these requests). +In order that the functions executing such requests be able to skip +subsequent (redundant) queries, have them accept MAJOR and MINOR keyword +arguments and call this function with those arguments instead of calling +RR-QUERY-VERSION." + (if (or major minor) + (values (or major 0) (or minor 0)) + (rr-query-version display))) + (defun rr-set-screen-config (window timestamp conf-timestamp size-id rotation refresh) "Sets the current screen to which the given window belongs. Timestamps are obtained from rr-get-screen-info. Rotation can be a list of rotation keys or a rotation mask. Returns timestamp, config timestamp, the root window of the screen and sub-pixel order." (let ((display (window-display window)) @@ -487,39 +518,96 @@ (card16 select-mask) (pad16)))) -(defun rr-get-screen-info (window &optional (result-type 'list)) -"Returns rotations, root-window, timestamp, config-timestamp, current-size-id, current rotation, current rate, a list of screen-size structures, and last a sequence of refresh-rates" +(declaim (ftype (function (window &key + (:major (or null card32)) + (:minor (or null card32)) + (:result-type t)) + (values (clx-list rotation-mask-class) + window + timestamp + timestamp + size-id + (clx-list rotation-mask-class) + (clx-list screen-size) + (or null card16) + (clx-sequence card16) + &optional)) + rr-get-screen-info)) +(defun rr-get-screen-info (window &key major minor (result-type 'list)) + "Execute the RRGetScreenInfo request and return its result as multiple +values consisting of: + +1. List of possible rotations and reflections +2. Root window +3. Timestamp +4. Configuration timestamp +5. Current screen size index (in the list of possible screen sizes) +6. Current rotation and reflection +7. List of possible screen sizes +8. Current refresh rate (non-NIL only if server's protocol version is + 1.1 or later) +9. Sequence of refresh rate information (non-NIL only if server's + protocol version is 1.1 or later) + +Each screen size has in the refresh rate information sequence a +corresponding refresh rate count followed by that number of possible +refresh rates. +For example, '(2 120 60 1 60) means that the first screen size has the +two refresh rates 120 and 60, and that the second screen size has the +single refresh rate 60. + +If MAJOR and MINOR, which comprise the server's protocol version, are +missing, this function executes the RRQueryVersion request before +RRGetScreenInfo in order to, first, potentially ask the server to +include, if it can, the current refresh rate and the refresh rate +information sequence in its reply to the latter request, and second, +determine whether this information is forthcoming. +Otherwise, this function assumes MAJOR and MINOR are the result of +RR-QUERY-VERSION -- failing which it will behave unreliably -- and it +skips executing the RRQueryVersion request." (let ((display (window-display window))) - (declare (type display display) - (type window window)) - (with-buffer-request-and-reply (display (randr-opcode display) nil :sizes (8 16 32)) - ((data +rr-GetScreenInfo+ ) - (window window)) - (let ((num-screens (card16-get 20)) - (num-rates (card16-get 28)) - (rates-location 0)) - (declare (type fixnum rates-location num-rates)) + (declare (type display display)) + (multiple-value-bind (major minor) + (rr-maybe-query-version display major minor) + (with-buffer-request-and-reply (display (randr-opcode display) nil + :sizes (8 16 32)) + ((data +rr-GetScreenInfo+) + (window window)) + (let* ((num-screens (card16-get 20)) + (rate-info-length (card16-get 28)) + (screen-start +replysize+) + (rate-info-start (index+ screen-start (index* num-screens 8))) + (has-rates (rr-has-rates major minor))) (values - (make-rotation-keys (card16-get 1)) ; possible rotations, using card16, not card8 from spec. - (window-get 8) ;root window - (card32-get 12) ;timestamp - (card32-get 16) ;config-timestamp - (card16-get 22) ;size-id - (make-rotation-keys (card16-get 24)) ;current rotation - (card16-get 26) ; current rate - (loop :for x fixnum :from 1 :to num-screens - :for offset fixnum := 32 :then (+ offset 8) - :collect (make-screen-size (card16-get offset) - (card16-get (index+ offset 2)) - (card16-get (index+ offset 4)) - (card16-get (index+ offset 6))) - :finally (setf rates-location (+ offset 8 2))) - (sequence-get :format card16 :length num-rates :index rates-location :result-type result-type)))))) - + ;; Possible rotations and reflections + (make-rotation-keys (card16-get 1)) + (window-get 8) ; Root window + (card32-get 12) ; Timestamp + (card32-get 16) ; Configuration timestamp + (card16-get 22) ; Current screen size index + ;; Current rotation and reflection + (make-rotation-keys (card16-get 24)) + (loop for i fixnum from 1 to num-screens + for offset fixnum = screen-start then (+ offset 8) + collect (make-screen-size (card16-get offset) + (card16-get (index+ offset 2)) + (card16-get (index+ offset 4)) + (card16-get (index+ offset 6)))) + ;; Some servers (e.g., X.Org) always reply with the current + ;; refresh rate if they support it, even before receiving any + ;; version query. + ;; However, the refresh rate information is available only + ;; after querying the version (when providing an appropriate + ;; client version). + (when has-rates (card16-get 26)) ; Current refresh rate + (when has-rates (sequence-get :result-type result-type + :format card16 + :length rate-info-length + :index rate-info-start)))))))) ;; Version 1.2 -(defun rr-get-screen-size-range (window &optional (result-type 'list)) +(defun rr-get-screen-size-range (window &key (result-type 'list)) "Returns a sequence of minimum width, minimum height, max width, max height." (let ((display (window-display window))) (with-buffer-request-and-reply (display (randr-opcode display) nil :sizes (16)) @@ -546,7 +634,7 @@ (card32 width-mm) (card32 height-mm)))) -(defun rr-get-screen-resources (window &optional (result-type 'list)) +(defun rr-get-screen-resources (window &key (result-type 'list)) "" (let ((display (window-display window))) (declare (type display display) @@ -574,7 +662,7 @@ -(defun rr-get-output-info (display output config-timestamp &optional (result-type 'list)) +(defun rr-get-output-info (display output config-timestamp &key (result-type 'list)) "FIXME: indexes might be off, name not decoded properly" (with-buffer-request-and-reply (display (randr-opcode display) nil :sizes (8 16 32)) ((data +rr-getoutputinfo+) @@ -604,7 +692,7 @@ (sequence-get :result-type 'string :format card16 :length name-length :index name-start :transform #'code-char)) ))) -(defun rr-list-output-properties (display output &optional (result-type 'list)) +(defun rr-list-output-properties (display output &key (result-type 'list)) "Returns a list of atom properties for given display. ?keep it simple and return id's or atom-names?" (declare (type display display) (type card32 output)) @@ -615,7 +703,7 @@ (values (sequence-get :format card32 :result-type result-type :length num-atoms :index +replysize+ :transform #'(lambda (id) (atom-name display id))))))) -(defun rr-query-output-property (display output atom &optional (result-type 'list)) +(defun rr-query-output-property (display output atom &key (result-type 'list)) "Querys the current properties of an atom. Atom may be referenced by either id or keyword" (let ((atom (if (typep atom 'keyword) (find-atom display atom) atom))) (declare (type display display) @@ -630,7 +718,7 @@ (boolean-get 10) ; immutable (sequence-get :result-type result-type :index +replysize+ :length (card32-get 4)))))) -(defun rr-configure-output-property (display output atom value-list &optional (pending nil) (range nil)) +(defun rr-configure-output-property (display output atom value-list &key pending range) "Atom can be specified by either id or keyword" (let ((atom (if (typep atom 'keyword) (find-atom display atom) atom)) (seq (coerce value-list 'vector))) @@ -647,7 +735,7 @@ ;; Spec says type is not interpreted, what use? shit, are certain property types tied to certain formats? change if necessary after get-output-property ;; FIXME asynchronous match error -(defun rr-change-output-property (display output atom mode data &optional (atom-type 0) ) +(defun rr-change-output-property (display output atom mode data &key (atom-type 0)) "Mode may be 0-replace 1-prepend 2-append. atom-type is obtained by calling rr-get-output-property " (let ((atom (if (typep atom 'keyword) (find-atom display atom) atom)) (data-length (length data)) @@ -672,7 +760,7 @@ (card32 output) (card32 atom)))) -(defun rr-get-output-property (display output property &optional (type 0) (delete 0) (pending 0) (result-type 'list)) +(defun rr-get-output-property (display output property &key (type 0) (delete 0) (pending 0) (result-type 'list)) "" (let ((atom (if (typep property 'keyword) (find-atom display property) property))) (with-buffer-request-and-reply (display (randr-opcode display) nil :sizes (8 16 32)) @@ -744,7 +832,7 @@ (card32 output) (card32 mode))) -(defun rr-get-crtc-info (display crtc config-timestamp &optional (result-type 'list)) +(defun rr-get-crtc-info (display crtc config-timestamp &key (result-type 'list)) "" (with-buffer-request-and-reply (display (randr-opcode display) nil :sizes (8 16 32)) ((data +rr-getcrtcinfo+) @@ -794,7 +882,7 @@ (values (card16-get 8)))) -(defun rr-get-crtc-gamma (display crtc &optional (result-type 'list)) +(defun rr-get-crtc-gamma (display crtc &key (result-type 'list)) "Get current gamma ramps, returns 3 sequences for red, green, blue." (with-buffer-request-and-reply (display (randr-opcode display) nil :sizes (8 16 32)) ((data +rr-getcrtcgamma+) @@ -825,7 +913,7 @@ ;; version 1.3 - (defun rr-get-screen-resources-current (window &optional (result-type 'list )) + (defun rr-get-screen-resources-current (window &key (result-type 'list)) "Unlike RRGetScreenResources, this merely returns the current configuration, and does not poll for hardware changes." (let ((display (window-display window))) (with-buffer-request-and-reply (display (randr-opcode display) nil :sizes (8 16 32)) @@ -849,7 +937,7 @@ (string-get name-bytes name-start)))))) -;; (defun rr-set-crtc-transform (display crtc transform &optional ( filter-name nil) ( filter-parameters nil)) +;; (defun rr-set-crtc-transform (display crtc transform &key filter-name filter-parameters) ;; "FIXME:Transfrom may be a list or vector of length 9. ?perhaps allow length 6?" ;; (let ((seq (if filter-parameters (coerce filter-parameters 'vector) nil )) ;; (param-length (length filter-parameters)) @@ -874,7 +962,7 @@ ;; ))) -(defun rr-get-crtc-transform (display crtc &optional (result-type 'list)) +(defun rr-get-crtc-transform (display crtc &key (result-type 'list)) "" (with-buffer-request-and-reply (display (randr-opcode display) nil :sizes (8 16 32)) ((data +rr-getcrtctransform+)