test/pointer-observer.sgl

1(import (sigil async)

2 (sigil wm host)

3 (sigil wm input))

5(define host (start-host!))

6(define outputs '())

7(define configured 0)

8(define observations '())

9(define outbound #f)

10(define inbound #f)

12(on-event! host

13 (lambda (event)

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

15 (case (event-type event)

16 ((ready)

17 (set-seat-capabilities! host 3)

18 (set-pointer-route! host #t))

19 ((output-added)

20 (configure-output! host id

21 (dict enabled: #t x: (* 640 (length outputs)) y: 0 scale: 1 transform: 0

22 mode: -1 width: 640 height: 480 refresh: 60000))

23 (set! outputs (append outputs (list id))))

24 ((output-configured)

25 (set! configured (+ configured 1))

26 (when (= configured 2)

27 (observe-pointer! host #t)

28 (emulate-motion! host 1 100 100)

29 (emulate-motion! host 1 110 100)

30 (set! outbound (emulate-motion! host 1 700 100))))

31 ((pointer-target-changed)

32 (set! observations

33 (append observations (list (cons (event-ref event output:) (event-ref event moved?:))))))

34 ((input-completed)

35 (cond

36 ((eqv? id outbound)

37 (observe-pointer! host #f)

38 (set! inbound (emulate-motion! host 1 100 100)))

39 ((eqv? id inbound) (stop-host! host))))))))

41(with-async (run-host! host))

42(unless (equal? observations (list (cons (car outputs) #f) (cons (cadr outputs) #t)))

43 (error "pointer observer did not filter unchanged or disabled samples" observations))

44(unless (= (host-statistic host 2) 0) (error "pointer facts overflowed"))

45(display "POINTER_OBSERVER=PASS two outputs transition-only disabled fast path\n")