Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

extensions: randr: fix RR-GET-OUTPUT-INFO indices #172

Open
wants to merge 1 commit into
base: master
Choose a base branch
from
Open

extensions: randr: fix RR-GET-OUTPUT-INFO indices #172

Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
123 changes: 85 additions & 38 deletions extensions/randr.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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

Expand Down Expand Up @@ -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

Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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"
dkochmanski marked this conversation as resolved.
Show resolved Hide resolved
(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?"
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
))))

Expand Down Expand Up @@ -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)
Expand All @@ -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
;; )))

Expand Down