#lang racket/base
(require racket/port
racket/system
"rackout-system.rkt")
(module+ test
(require (planet neil/overeasy:2)))
(provide xrandr-display?
xrandr-display-name-string
xrandr-display-connected?
xrandr-display-mm-pair
xrandr-display-max-pixels-pair)
(define-struct xrandr-display
(name-string
connected?
mm-pair
max-pixels-pair)
#:transparent)
(define (%xrandr:bytes->integer bstr)
(string->number (bytes->string/latin-1 bstr)))
(provide parse-xrandr-output)
(define (parse-xrandr-output in
#:connected-only? (connected-only? #false))
(let loop-no-display ((reverse-result '())
(screen-number #f))
(cond ((eof-object? (peek-byte in))
(reverse reverse-result))
((regexp-try-match #rx#"^Screen +([0-9]+):[^\n]*\n" in)
=> (lambda (m)
(loop-no-display reverse-result
(%xrandr:bytes->integer (cadr m)))))
((regexp-try-match #rx#"^([-A-Za-z0-9]+) (connected )?" in)
=> (lambda (m)
(apply (lambda (all name connected)
(let ((mm-pair (cond ((regexp-try-match #rx#"^[^\n]*[^0-9]([0-9]+)mm x ([0-9]+)mm[^\n]*\n" in)
=> (lambda (m)
(apply (lambda (all width-mm height-mm)
(cons (%xrandr:bytes->integer width-mm)
(%xrandr:bytes->integer height-mm)))
m)))
((regexp-try-match #rx#"^[^\n]*\n" in)
#f)
(else (error 'parse-xrandr-output
"could not find end of display line at: ~S"
(port->bytes in))))))
(let loop-modes ((pixel-resolution-pair #f))
(cond ((regexp-try-match #rx#"^ +([0-9]+)x([0-9]+) [^\n]*\n" in)
=> (lambda (m)
(loop-modes (or pixel-resolution-pair
(cons (%xrandr:bytes->integer (list-ref m 1))
(%xrandr:bytes->integer (list-ref m 2)))))))
(else
(loop-no-display (if (or connected (not connected-only?))
(cons (make-xrandr-display
(bytes->string/latin-1 name)
(and connected #t)
mm-pair
pixel-resolution-pair)
reverse-result)
reverse-result)
screen-number))))))
m)))
(else (error 'parse-xrandr-output
"could not parse display start at: ~S"
(port->bytes in))))))
(module+ test
(test (let ((bstr
(bytes-append
#"Screen 0: minimum 320 x 200, current 2480 x 1920, maximum 8192 x 8192\n"
#"VGA-0 disconnected (normal left inverted right x axis y axis)\n"
#"LVDS connected 1400x1050+1080+0 (normal left inverted right x axis y axis) 287mm x 215mm\n"
#" 1400x1050 60.0*+ 50.0 \n"
#" 1280x1024 59.9 60.0 \n"
#" 1280x960 59.9 \n"
#" 1280x854 59.9 \n"
#" 1280x800 59.8 \n"
#" 1280x720 59.9 \n"
#" 1152x768 59.8 \n"
#" 1024x768 60.0 59.9 \n"
#" 800x600 60.3 59.9 \n"
#" 848x480 59.7 \n"
#" 720x480 59.7 \n"
#" 640x480 60.0 59.4 \n"
#"DVI-0 connected 1920x1080+0+0 left (normal left inverted right x axis y axis) 510mm x 287mm\n"
#" 1920x1080 60.0*+ 60.0 \n"
#" 1280x1024 75.0 60.0 \n"
#" 1152x864 75.0 \n"
#" 1024x768 75.1 60.0 \n"
#" 800x600 75.0 60.3 \n"
#" 640x480 75.0 60.0 \n"
#" 720x400 70.1 \n")))
(values (parse-xrandr-output (open-input-bytes bstr))
(parse-xrandr-output (open-input-bytes bstr) #:connected-only? #t)))
(values (list (make-xrandr-display "VGA-0" #f #f #f)
(make-xrandr-display "LVDS" #t '(287 . 215) '(1400 . 1050))
(make-xrandr-display "DVI-0" #t '(510 . 287) '(1920 . 1080)))
(list (make-xrandr-display "LVDS" #t '(287 . 215) '(1400 . 1050))
(make-xrandr-display "DVI-0" #t '(510 . 287) '(1920 . 1080)))))
(test (let ((bstr
(bytes-append
#"Screen 0: minimum 320 x 200, current 3520 x 1080, maximum 8192 x 8192\n"
#"LVDS1 connected 1600x900+1920+0 (normal left inverted right x axis y axis) 309mm x 174mm\n"
#" 1600x900 60.0*+ 40.0\n"
#" 1440x900 59.9\n"
#" 1360x768 59.8 60.0\n"
#" 1152x864 60.0\n"
#" 1024x768 60.0\n"
#" 800x600 60.3 56.2\n"
#" 640x480 59.9\n"
#"VGA1 disconnected (normal left inverted right x axis y axis)\n"
#"HDMI1 connected 1920x1080+0+0 (normal left inverted right x axis y axis) 477mm x 268mm\n"
#" 1920x1080 60.0*+\n"
#" 1680x1050 60.0\n"
#" 1280x1024 60.0\n"
#" 1280x960 60.0\n"
#" 1152x864 60.0\n"
#" 1024x768 60.0\n"
#" 800x600 60.3\n"
#" 640x480 60.0\n"
#"DP1 disconnected (normal left inverted right x axis y axis)\n"
#"HDMI2 disconnected (normal left inverted right x axis y axis)\n"
#"HDMI3 disconnected (normal left inverted right x axis y axis)\n"
#"DP2 disconnected (normal left inverted right x axis y axis)\n"
#"DP3 disconnected (normal left inverted right x axis y axis)\n")))
(values (parse-xrandr-output (open-input-bytes bstr))
(parse-xrandr-output (open-input-bytes bstr) #:connected-only? #t)))
(values (list (make-xrandr-display "LVDS1" #t '(309 . 174) '(1600 . 900))
(make-xrandr-display "VGA1" #f #f #f)
(make-xrandr-display "HDMI1" #t '(477 . 268) '(1920 . 1080))
(make-xrandr-display "DP1" #f #f #f)
(make-xrandr-display "HDMI2" #f #f #f)
(make-xrandr-display "HDMI3" #f #f #f)
(make-xrandr-display "DP2" #f #f #f)
(make-xrandr-display "DP3" #f #f #f))
(list (make-xrandr-display "LVDS1" #t '(309 . 174) '(1600 . 900))
(make-xrandr-display "HDMI1" #t '(477 . 268) '(1920 . 1080)))))
(test (let ((bstr
(bytes-append
#"Screen 0: minimum 320 x 200, current 2960 x 1050, maximum 8192 x 8192\n"
#"DisplayPort-0 connected 1680x1050+1280+0 (normal left inverted right x axis y axis) 474mm x 296mm\n"
#" 1680x1050 60.0*+\n"
#" 1280x1024 75.0 60.0\n"
#" 1280x960 60.0\n"
#" 1152x864 75.0\n"
#" 1024x768 75.1 70.1 60.0\n"
#" 832x624 74.6\n"
#" 800x600 72.2 75.0 60.3 56.2\n"
#" 640x480 72.8 75.0 66.7 60.0\n"
#" 720x400 70.1\n"
#"DisplayPort-1 connected 1280x1024+0+0 (normal left inverted right x axis y axis) 337mm x 270mm\n"
#" 1280x1024 60.0* \n")))
(values (parse-xrandr-output (open-input-bytes bstr))
(parse-xrandr-output (open-input-bytes bstr) #:connected-only? #t)))
(values (list (make-xrandr-display "DisplayPort-0" #t '(474 . 296) '(1680 . 1050))
(make-xrandr-display "DisplayPort-1" #t '(337 . 270) '(1280 . 1024)))
(list (make-xrandr-display "DisplayPort-0" #t '(474 . 296) '(1680 . 1050))
(make-xrandr-display "DisplayPort-1" #t '(337 . 270) '(1280 . 1024)))))
(test (let ((bstr
(bytes-append
#"Screen 0: minimum 320 x 200, current 2480 x 1920, maximum 16384 x 16384\n"
#"DisplayPort-0 connected 1200x1920+1280+0 left (normal left inverted right x axis y axis) 518mm x 324mm\n"
#" 1920x1200 60.0*+\n"
#" 1920x1080 60.0 \n"
#" 1600x1200 60.0 \n"
#" 1680x1050 60.0 \n"
#" 1280x1024 60.0 \n"
#" 1280x960 60.0 \n"
#" 1024x768 60.0 \n"
#" 800x600 60.3 \n"
#" 640x480 60.0 \n"
#" 720x400 70.1 \n"
#"DVI-0 connected 1024x1280+0+283 left (normal left inverted right x axis y axis) 376mm x 301mm\n"
#" 1280x1024 60.0*+ 75.0 \n"
#" 1152x864 75.0 \n"
#" 1024x768 75.1 60.0 \n"
#" 800x600 75.0 60.3 \n"
#" 640x480 75.0 60.0 \n"
#" 720x400 70.1 \n")))
(values (parse-xrandr-output (open-input-bytes bstr))
(parse-xrandr-output (open-input-bytes bstr) #:connected-only? #t)))
(values (list (make-xrandr-display "DisplayPort-0" #t '(518 . 324) '(1920 . 1200))
(make-xrandr-display "DVI-0" #t '(376 . 301) '(1280 . 1024)))
(list (make-xrandr-display "DisplayPort-0" #t '(518 . 324) '(1920 . 1200))
(make-xrandr-display "DVI-0" #t '(376 . 301) '(1280 . 1024))))))
(define (find-big-xrandr-display-and-resolution xrandr-displays)
(cond ((null? xrandr-displays)
(error 'find-big-xrandr-display-and-resolution
"no displays"))
((null? (cdr xrandr-displays))
(let ((dpy (car xrandr-displays)))
(values dpy (xrandr-display-max-pixels-pair dpy))))
(else
(let* ((scored-dpys (map (lambda (dpy)
(cons (+ (cond ((xrandr-display-max-pixels-pair dpy) => cdr)
(else 0))
(cond ((xrandr-display-mm-pair dpy) => cdr)
(else 0)))
dpy))
xrandr-displays))
(scored-dpys (sort scored-dpys >= #:key car))
(dpy (cdar scored-dpys)))
(values dpy (xrandr-display-max-pixels-pair dpy))))))
(module+ test
(let ((lvds (make-xrandr-display "LVDS" #t '(287 . 215) '(1400 . 1050)))
(dvi-0 (make-xrandr-display "DVI-0" #t '(510 . 287) '(1920 . 1080))))
(test (find-big-xrandr-display-and-resolution (list lvds dvi-0))
(values dvi-0
'(1920 . 1080))))
(let ((lvds1 (make-xrandr-display "LVDS1" #t '(309 . 174) '(1600 . 900)))
(hdmi1 (make-xrandr-display "HDMI1" #t '(477 . 268) '(1920 . 1080))))
(test (find-big-xrandr-display-and-resolution (list lvds1 hdmi1))
(values hdmi1 '(1920 . 1080))))
(let ((dp-0 (make-xrandr-display "DisplayPort-0" #t '(474 . 296) '(1680 . 1050)))
(dp-1 (make-xrandr-display "DisplayPort-1" #t '(337 . 270) '(1280 . 1024))))
(test (find-big-xrandr-display-and-resolution (list dp-0 dp-1))
(values dp-0 '(1680 . 1050))))
(let ((dp-0 (make-xrandr-display "DisplayPort-0" #t '(518 . 324) '(1920 . 1200)))
(dvi-0 (make-xrandr-display "DVI-0" #t '(376 . 301) '(1280 . 1024))))
(test (find-big-xrandr-display-and-resolution (list dp-0 dvi-0))
(values dp-0 '(1920 . 1200)))))
(define current-xrandr-command
(make-parameter "/usr/bin/xrandr"))
(define (xrandr-pixels-pair->command-line-arg pixels-pair)
(string-append (number->string (car pixels-pair))
"x"
(number->string (cdr pixels-pair))))
(define (xrandr-arguments-for-only-one-display-on all-xds on-xd pixels-pair)
(let ((on-xd-name (xrandr-display-name-string on-xd)))
`("--output"
,on-xd-name
"--auto"
"--size"
,(xrandr-pixels-pair->command-line-arg (xrandr-display-max-pixels-pair on-xd))
,@(let loop ((all-xds all-xds))
(if (null? all-xds)
'()
(let ((off-xd-name (xrandr-display-name-string (car all-xds))))
(if (equal? off-xd-name on-xd-name)
(loop (cdr all-xds))
`("--output"
,off-xd-name
"--off"
,@(loop (cdr all-xds))))))))))
(module+ test
(let ((dp-0 (make-xrandr-display "DisplayPort-0" #t '(518 . 324) '(1920 . 1200)))
(dvi-0 (make-xrandr-display "DVI-0" #t '(376 . 301) '(1280 . 1024))))
(test (xrandr-arguments-for-only-one-display-on (list dp-0 dvi-0)
dp-0
'(1920 . 1200))
(list "--output"
"DisplayPort-0"
"--auto"
"--size"
"1920x1200"
"--output"
"DVI-0"
"--off"))))
(define (xrandr-panning-args fb-pixels-pair output-pixels-pair)
(let ((width-arg (if (> (car fb-pixels-pair) (car output-pixels-pair))
(car fb-pixels-pair)
0))
(height-arg (if (> (cdr fb-pixels-pair) (cdr output-pixels-pair))
(cdr fb-pixels-pair)
0)))
(if (and (zero? width-arg) (zero? height-arg))
'()
`("--panning"
,(xrandr-pixels-pair->command-line-arg (cons width-arg height-arg))))))
(define (xrandr-arguments-for-all-connected-displays-on all-xds)
(let*-values (((big-xd big-pixels-pair) (find-big-xrandr-display-and-resolution all-xds))
((big-xd-name) (xrandr-display-name-string big-xd))
((width height) (let loop ((all-xds all-xds)
(width 1)
(height 1))
(if (null? all-xds)
(values width height)
(let* ((xd (car all-xds))
(xd-mpp (xrandr-display-max-pixels-pair xd)))
(loop (cdr all-xds)
(max width (car xd-mpp))
(max height (cdr xd-mpp)))))))
((fb-pixels-pair) (cons width height)))
`("--fb"
,(xrandr-pixels-pair->command-line-arg fb-pixels-pair)
"--output"
,big-xd-name
"--auto"
"--size"
,(xrandr-pixels-pair->command-line-arg big-pixels-pair)
,@(xrandr-panning-args fb-pixels-pair big-pixels-pair)
,@(let loop ((all-xds all-xds))
(if (null? all-xds)
'()
(let* ((xd (car all-xds))
(xd-name (xrandr-display-name-string xd))
(xd-pixels-pair (xrandr-display-max-pixels-pair xd)))
(if (equal? xd-name big-xd-name)
(loop (cdr all-xds))
`("--output"
,(xrandr-display-name-string xd)
"--auto"
"--same-as"
,big-xd-name
"--size"
,(xrandr-pixels-pair->command-line-arg xd-pixels-pair)
,@(xrandr-panning-args fb-pixels-pair xd-pixels-pair)
,@(loop (cdr all-xds))))))))))
(module+ test
(let ((dp-0 (make-xrandr-display "DisplayPort-0" #t '(518 . 324) '(1920 . 1200)))
(dvi-0 (make-xrandr-display "DVI-0" #t '(376 . 301) '(1280 . 1024))))
(test (xrandr-arguments-for-all-connected-displays-on (list dp-0 dvi-0))
(list "--fb"
"1920x1200"
"--output"
"DisplayPort-0"
"--auto"
"--size"
"1920x1200"
"--output"
"DVI-0"
"--auto"
"--same-as"
"DisplayPort-0"
"--size"
"1280x1024"
"--panning"
"1920x1200"))))
(provide get-xrandr-displays)
(define (get-xrandr-displays #:connected-only? (connected-only? #false))
(parse-xrandr-output
(open-input-bytes (system-command/stdout-bytes
#:error-name 'get-xrandr-displays
#:sudo? #false
#:stderr-ignore? #true
#:command (current-xrandr-command)
#:args '()))
#:connected-only? connected-only?))
(provide xrandr-use-big-display-only)
(define (xrandr-use-big-display-only)
(let*-values (((all-xds) (get-xrandr-displays #:connected-only? #true))
((on-xd pixels-pair) (find-big-xrandr-display-and-resolution all-xds))
((args) (xrandr-arguments-for-only-one-display-on all-xds on-xd pixels-pair)))
(system-command/ignored-output
#:error-name 'xrandr-use-big-display-only
#:sudo? #false
#:command (current-xrandr-command)
#:args args)))
(provide xrandr-use-all-connected-displays-with-panning)
(define (xrandr-use-all-connected-displays-with-panning)
(system-command/ignored-output
#:error-name 'xrandr-use-all-connected-displays-with-panning
#:sudo? #false
#:command (current-xrandr-command)
#:args (xrandr-arguments-for-all-connected-displays-on
(get-xrandr-displays #:connected-only? #true))))