test/window-hints.sgl

1(import (sigil async) (sigil io)

2 (sigil wm host) (sigil wm scene) (sigil wm model))

3(define host (start-host!))

4(define before #f)

5(define updated? #f)

6(on-event! host

7 (lambda (event)

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

9 (case (event-type event)

10 ((output-added)

11 (configure-output! host id

12 (dict enabled: #t x: 0 y: 0 scale: 1 transform: 0 mode: -1 width: 640 height: 480 refresh: 60000)))

13 ((output-configured)

14 (display "WAYLAND_SOCKET=") (display (host-socket host)) (newline) (flush-output-port))

15 ((window-initial)

16 (when before (error "hint change repeated initial handshake"))

17 (configure-window! host id 64 64))

18 ((window-mapped)

19 (set! before (car (dict-ref (host-snapshot host) windows:)))

20 (unless (and (= (dict-ref before min-width:) 64) (= (dict-ref before max-width:) 64))

21 (error "initial fixed hints missing"))

22 (submit-plan! host

23 (make-scene-plan (list (placement window: id box: (rect x: 0 y: 0 width: 64 height: 64))) id 200))

24 (display "WINDOW_HINTS_READY\n") (flush-output-port))

25 ((window-hints)

26 (let ((after (car (dict-ref (host-snapshot host) windows:))))

27 (unless (and (= (event-ref event min-width:) 32)

28 (= (event-ref event min-height:) 24)

29 (= (dict-ref after min-width:) 32)

30 (= (dict-ref after min-height:) 24)

31 (= (dict-ref after max-width:) 104)

32 (= (dict-ref after max-height:) 94)

33 (= (dict-ref before min-width:) 64)

34 (= (dict-ref before max-width:) 64))

35 (error "committed hints or detached snapshot incorrect")))

36 (set! updated? #t)

37 (stop-host! host))))))

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

39(unless (and updated? (= (host-statistic host 1) 0) (= (host-statistic host 2) 0)

40 (= (host-statistic host 3) 0))

41 (error "window hint update or teardown incomplete"))

42(display "WINDOW_HINTS=PASS committed updates initial handshake once detached snapshot joined teardown\n")