test/output-management.sgl

1(import (sigil async) (sigil io) (sigil process) (sigil wm host) (sigil wm repl))

2(define host (start-host! protocols: 128 request-deadline: 2000))

3(define outputs '())

4(define ready? #f)

5(define initial-token #f)

6(define accept? #t)

7(define hold? #f)

8(define proposals '())

9(define outcomes '())

10(define retired '())

11(define errors '())

12(on-event! host

13 (lambda (event)

14 (guard (exception

15 (#t (set! errors (cons exception errors)) (write exception) (newline) (stop-host! host)))

16 (let ((id (event-ref event id:)))

17 (case (event-type event)

18 ((output-added) (set! outputs (append outputs (list id))))

19 ((ready)

20 (set! initial-token

21 (configure-outputs! host

22 (map (lambda (output index)

23 (dict id: output enabled: #t x: (* index 960) y: 0 scale: 1 transform: 0

24 mode: -1 width: 960 height: 640 refresh: 60000))

25 outputs (iota (length outputs))))))

26 ((configuration-result)

27 (when (and initial-token (= id initial-token))

28 (unless (event-ref event success?:) (error "initial output configuration failed"))

29 (set! ready? #t)

30 (display "OUTPUT_NAME=")

31 (display (dict-ref (car (dict-ref (host-snapshot host) outputs:)) name:)) (newline)

32 (display "WAYLAND_SOCKET=") (display (host-socket host)) (newline)

33 (flush-output-port)))

34 ((output-configuration-request)

35 (unless (= (length (event-ref event heads:)) 2) (error "incomplete copied proposal"))

36 (set! proposals (append proposals (list event)))

37 (unless hold?

38 (reply-output-configuration! host id (and accept? (event-ref event heads:)))))

39 ((output-configuration-result) (set! outcomes (append outcomes (list event))))

40 ((request-retired) (set! retired (cons id retired)))

41 ((output-removed) (set! outputs (filter (lambda (output) (not (= output id))) outputs)))

42 ((command-rejected) (error "unexpected output command rejection" (event-raw event))))))))

43(with-async

44 (let ((repl (start-repl! host (getenv "SIGIL_WM_REPL") (interaction-environment))))

45 (run-host! host)

46 (stop-repl! repl)))

47(unless (and ready? (null? errors) (= (host-statistic host 1) 0)

48 (= (host-statistic host 2) 0) (= (host-statistic host 3) 0)

49 (= (host-statistic host 4) 0))

50 (error "output proposal lifetime failed" errors))

51(display "OUTPUT_MANAGEMENT_HOST=PASS\n")