Paste: delayloop utility

! Copyright (C) 2009 Darrin Thompson.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors calendar combinators continuations fry kernel
locals sequences threads ;
IN: delayloop

GENERIC: stall ( obj -- )
GENERIC: slow-down ( obj -- )

TUPLE: staller interval ;

: <staller> ( -- obj ) instant staller boa ;

M: staller stall ( obj -- )
    interval>> sleep ;

M: staller slow-down ( obj -- )
    [ 100 milliseconds time+ ] change-interval drop ;

ERROR: need-to-slow-down ;

! Locals, loops, and continuations all in one place.
! Avert your eyes.
:: delay-retry ( param quot staller -- obj )
    [
        [
            staller stall
            [ param quot call return ]
            [ dup need-to-slow-down? [ drop ] [ rethrow ] if
              staller slow-down
            ] recover
            t
        ] loop
    ] with-return ; inline

: delay-each ( seq quot -- )
    <staller> '[ _ _ delay-retry ] each ; inline

New Annotation