From 9336594afc2dee51544de6d89f3dc1af72bc4cd9 Mon Sep 17 00:00:00 2001 From: "Paul A. Patience" Date: Thu, 25 Jun 2020 10:16:55 -0400 Subject: [PATCH] extensions: randr: fix RR-GET-OUTPUT-INFO indices The CRTC-START index was incorrect, which caused RR-GET-OUTPUT-INFO to return bogus CRTCs, modes, clones, and name. Additionally, document the function's multiple return values and declaim its type. The latter required adding some types and adjusting some existing types and constants. Finally, reindent RR-GET-OUTPUT-INFO, wrap some overlong lines, and clean up some comments and whitespace. --- extensions/randr.lisp | 123 +++++++++++++++++++++++++++++------------- 1 file changed, 85 insertions(+), 38 deletions(-) diff --git a/extensions/randr.lisp b/extensions/randr.lisp index 6ff4ef0..86b8b70 100644 --- a/extensions/randr.lisp +++ b/extensions/randr.lisp @@ -166,8 +166,16 @@ (eval-when (:compile-toplevel :load-toplevel :execute) - (defconstant +rr-config-status+ '#(:success :invalid-config-time :invalid-time :failed)) - (defconstant +rr-connection+ '#(:connected :disconnected :unknown-connection))) + (defconstant +rr-config-status-vector+ + '#(:success :invalid-config-time :invalid-time :failed)) + (defconstant +connection-vector+ + '#(:connected :disconnected :unknown-connection))) + +(deftype rr-config-status () + '(member :success :invalid-config-time :invalid-time :failed)) + +(deftype connection () + '(member :connected :disconnected :unknown-connection)) ;;; mask-vectors and types @@ -214,10 +222,19 @@ ;; temporarily here since not in xrender.lisp - (eval-when (:compile-toplevel :load-toplevel :execute) - (defconstant +render-subpixel-order+ - '#(:unknown :horizontal-RGB :horizontal-BGR :vertical-RGB :vertical-BGR :none))) + (defconstant +render-subpixel-order-vector+ + '#(:unknown + :horizontal-RGB :horizontal-BGR + :vertical-RGB :vertical-BGR + :none))) + +(deftype render-subpixel-order () + '(member + :unknown + :horizontal-RGB :horizontal-BGR + :vertical-RGB :vertical-BGR + :none)) ;; mask encode-decode functions @@ -259,8 +276,8 @@ (deftype size-id () 'card16) (deftype rr-mode () '(or null resource-id)) +(deftype crtc () 'resource-id) (deftype output () 'resource-id) -(deftype connection () '(or +connected+ +disconnected+ +unknown-connection+)) ;; structs @@ -467,11 +484,11 @@ (card16 refresh) (pad16)) (values - (member8-vector-get 1 +rr-config-status+) + (member8-vector-get 1 +rr-config-status-vector+) (card32-get 8) ;; timestamp (card32-get 12) ;; config timestamp (window-get 16) ;; root window - (member16-vector-get 20 +render-subpixel-order+) ;; sub pixel order + (member16-vector-get 20 +render-subpixel-order-vector+) )))) (defun rr-select-input (window enable) @@ -572,37 +589,67 @@ (string-get name-bytes name-start)) )))) - - -(defun rr-get-output-info (display output config-timestamp &optional (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)) +(declaim (ftype (function (display output timestamp &optional t) + (values rr-config-status + timestamp + crtc + card32 + card32 + connection + render-subpixel-order + (clx-sequence crtc) + card16 + (clx-sequence rr-mode) + (clx-sequence output) + string + &optional)) + rr-get-output-info)) +(defun rr-get-output-info (display output config-timestamp + &optional (result-type 'list)) + "Execute the RRGetOutputInfo request and return its result as multiple +values consisting of: + +1. Configuration status +2. Timestamp +3. Current connected CRTC +4. Width in millimeters +5. Height in millimeters +6. Connection +7. Subpixel order +8. Sequence of CRTCs +9. Number of preferred modes (first in the sequence of possible modes) +10. Sequence of possible modes +11. Sequence of clones +12. Name" + (with-buffer-request-and-reply (display (randr-opcode display) nil + :sizes (8 16 32)) ((data +rr-getoutputinfo+) (card32 output) (card32 config-timestamp)) (let* ((num-crtcs (card16-get 26)) - (num-modes (card16-get 28)) - (num-clones (card16-get 32)) - (name-length (card16-get 34)) - (crtc-start 26) - (mode-start (index+ crtc-start (index* num-crtcs 4))) - (clone-start (index+ mode-start (index* num-modes 4))) - (name-start (index+ clone-start (index* num-clones 4)))) + (num-modes (card16-get 28)) + (num-clones (card16-get 32)) + (name-length (card16-get 34)) + (crtc-start 36) + (mode-start (index+ crtc-start (index* num-crtcs 4))) + (clone-start (index+ mode-start (index* num-modes 4))) + (name-start (index+ clone-start (index* num-clones 4)))) (values - (member8-vector-get 1 +rr-config-status+) - (card32-get 8) ; timestamp - (card32-get 12) ; current connected crtc - (card32-get 16) ; width in mm - (card32-get 20) ; height in mm - (member8-vector-get 24 +rr-connection+) - (member8-vector-get 25 +render-subpixel-order+) ; sub-pixel-order - (sequence-get :result-type result-type :length num-crtcs :index 26) - (card16-get 30) - (sequence-get :result-type result-type :length num-modes :index mode-start) - (sequence-get :result-type result-type :length num-clones :index clone-start) - ;(string-get name-length name-start ) - (sequence-get :result-type 'string :format card16 :length name-length :index name-start :transform #'code-char)) -))) + (member8-vector-get 1 +rr-config-status-vector+) + (card32-get 8) ; Timestamp + (card32-get 12) ; Current connected CRTC + (card32-get 16) ; Width in millimeters + (card32-get 20) ; Height in millimeters + (member8-vector-get 24 +connection-vector+) + (member8-vector-get 25 +render-subpixel-order-vector+) + (sequence-get :result-type result-type :length num-crtcs + :index crtc-start) + (card16-get 30) ; Number of preferred modes + (sequence-get :result-type result-type :length num-modes + :index mode-start) + (sequence-get :result-type result-type :length num-clones + :index clone-start) + (string-get name-length name-start))))) (defun rr-list-output-properties (display output &optional (result-type 'list)) "Returns a list of atom properties for given display. ?keep it simple and return id's or atom-names?" @@ -754,7 +801,7 @@ (pos-outputs (card16-get 30)) (pos-start (index+ +replysize+ (index* num-outputs 4)))) (values - (member8-vector-get 1 +rr-config-status+) + (member8-vector-get 1 +rr-config-status-vector+) (card32-get 8) ; timestamp (int16-get 12) ; x (int16-get 14) ; y @@ -782,7 +829,7 @@ (pad16) ((sequence :format card32) seq)) (values - (member8-vector-get 1 +rr-config-status+) + (member8-vector-get 1 +rr-config-status-vector+) (card32-get 8) ; new timestamp )))) @@ -908,7 +955,7 @@ ;; ((data +rr-getpanning+) ;; (card32 crtc)) ;; (values -;; (member8-vector-get 1 +rr-config-status+) +;; (member8-vector-get 1 +rr-config-status-vector+) ;; (card32-get 8) ; timestamp ;; (rr-panning-get 12) ;; ;(sequence-get :length 8 :format card16 :index 12 :result-type result-type) @@ -928,7 +975,7 @@ ;; (rr-panning rr-panning)) ;; (values -;; (member8-vector-get 1 +rr-config-status+) +;; (member8-vector-get 1 +rr-config-status-vector+) ;; ; (card32-get 8) ; new timestamp ;; )))