test/draw.sgl — sigil-wm

1(import (sigil math) (sigil ffi) (sigil wm draw))

2(define (require condition message) (unless condition (error message)))

3(define font (open-text-font "monospace" "Regular" 12 2))

4(define image (render-text font "Scaled text" 160 32 #xffffffff))

5(require (= (text-image-pixel-width image) 320) "text not rasterized at scale 2")

6(require (= (text-image-pixel-height image) 64) "wrong scaled height")

7(destroy-text-image! image)

8(define fitted (fit-text font "A long title with combining á and a final word" 70))

9(require (and (text-run-ellipsized? fitted) (<= (text-run-width fitted) 70)) "title width fit failed")

10(define cache (make-image-cache))

11(define renders 0)

12(define previous #f)

13(define rejected #f)

14(define (render)

15 (set! renders (+ renders 1))

16 (render-text font "Cached image" 160 32 #xffffffff))

17(require (cache-image! cache 1 'original render

18 (lambda (image changed?) (set! previous image) changed?)) "cache insertion failed")

19(require (cache-image! cache 1 'original render

20 (lambda (image changed?) (and (not changed?) (eq? previous image)))) "unchanged image not reused")

21(require (= renders 1) "unchanged image rerendered")

22(require (not (cache-image! cache 1 'replacement render

23 (lambda (image changed?) (set! rejected image) #f))) "rejected image accepted")

24(require (guard (exception (#t #t)) (text-image-data rejected) #f) "rejected image leaked")

25(require (cache-image! cache 1 'original render

           (lambda (image changed?) (and (not changed?) (eq? previous image) (text-image-data image)))) "old cache lost after rejection")

27(clear-image-cache! cache)

28(require (guard (exception (#t #t)) (text-image-data previous) #f) "cached image leaked")

29(close-text-font! font)

30(define canvas (make-canvas 20 10 2))

31(fill-rect! canvas 0 0 20 10 #x3366ccff)

32(define shape (canvas-image canvas))

33(require (= (pointer-ref (text-image-data shape) ffi/uint32 0) #xff3366cc) "shape pixel differs")

34(destroy-text-image! shape)

35(display "DRAW=PASS scale ellipsis cache-reuse rejected-copy lifetime shapes\n")