check-ui-quotation ( name quot -- )

Vocabulary

demos.smoke-test

Inputs

name	an object
quot	an object

Outputs

None

Definition

USING: accessors calendar combinators concurrency.promises
gpu.demos.bunny io kernel sequences system threads ui ;

IN: demos.smoke-test

:: check-ui-quotation ( name quot -- )
    name print
    flush demo-error-assets :> baseline-errors open-worlds
    :> baseline quot ( -- ) call-effect
    baseline-errors check-demo-errors 500 milliseconds sleep
    open-worlds [ baseline member-eq? not ] filter
    :> windows windows [ handle>> ] map
    :> handles windows empty? f assert= windows [| window |
        window bunny-world? [ window wait-for-bunny ] when
        window check-demo-window baseline
        [ demo-frame drop ] each window demo-frame drop
    ] each windows [| window |
        window close-window window promise>> ?promise drop
        window handle>> f assert=
    ] each os macos?
    [ handles [ input-grabbed?>> f assert= ] each ] when
    baseline-errors check-demo-errors name "PASS: " prepend
    print flush ;