Fix alarms with image saves
parent
e455dd0362
commit
3f3a6ea1f7
|
@ -15,8 +15,8 @@ IN: temporary
|
|||
|
||||
! Binary Min Heap
|
||||
{ 1 2 3 4 5 6 } [ 0 left 0 right 1 left 1 right 2 left 2 right ] unit-test
|
||||
{ t } [ t 5 <entry> t 3 <entry> T{ min-heap } heap-compare ] unit-test
|
||||
{ f } [ t 5 <entry> t 3 <entry> T{ max-heap } heap-compare ] unit-test
|
||||
{ t } [ t 5 f <entry> t 3 f <entry> T{ min-heap } heap-compare ] unit-test
|
||||
{ f } [ t 5 f <entry> t 3 f <entry> T{ max-heap } heap-compare ] unit-test
|
||||
|
||||
[ t 2 ] [ <min-heap> t 300 pick heap-push t 200 pick heap-push t 400 pick heap-push t 3 pick heap-push t 2 pick heap-push heap-pop ] unit-test
|
||||
|
||||
|
|
|
@ -22,9 +22,9 @@ GENERIC: heap-size ( heap -- n )
|
|||
: <heap> ( class -- heap )
|
||||
>r V{ } clone r> construct-delegate ; inline
|
||||
|
||||
TUPLE: entry value key index ;
|
||||
TUPLE: entry value key heap index ;
|
||||
|
||||
: <entry> ( value key -- entry ) f entry construct-boa ;
|
||||
: <entry> ( value key heap -- entry ) f entry construct-boa ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
|
@ -153,7 +153,7 @@ DEFER: down-heap
|
|||
PRIVATE>
|
||||
|
||||
M: priority-queue heap-push* ( value key heap -- entry )
|
||||
>r <entry> dup r> [ data-push ] keep up-heap ;
|
||||
[ <entry> dup ] keep [ data-push ] keep up-heap ;
|
||||
|
||||
: heap-push ( value key heap -- ) heap-push* drop ;
|
||||
|
||||
|
@ -166,8 +166,14 @@ M: priority-queue heap-push* ( value key heap -- entry )
|
|||
M: priority-queue heap-peek ( heap -- value key )
|
||||
data-first >entry< ;
|
||||
|
||||
: entry>index ( entry heap -- n )
|
||||
over entry-heap eq? [
|
||||
"Invalid entry passed to heap-delete" throw
|
||||
] unless
|
||||
entry-index ;
|
||||
|
||||
M: priority-queue heap-delete ( entry heap -- )
|
||||
>r entry-index r>
|
||||
[ entry>index ] keep
|
||||
2dup heap-size 1- = [
|
||||
nip data-pop*
|
||||
] [
|
||||
|
|
|
@ -1,7 +1,8 @@
|
|||
! Copyright (C) 2005, 2008 Slava Pestov, Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays calendar combinators generic init kernel math
|
||||
namespaces sequences heaps boxes threads debugger quotations ;
|
||||
namespaces sequences heaps boxes threads debugger quotations
|
||||
assocs ;
|
||||
IN: alarms
|
||||
|
||||
TUPLE: alarm quot time interval entry ;
|
||||
|
@ -67,8 +68,13 @@ SYMBOL: alarm-thread
|
|||
dup trigger-alarms
|
||||
alarm-thread-loop ;
|
||||
|
||||
: cancel-alarms ( alarms -- )
|
||||
[
|
||||
heap-pop-all [ nip alarm-entry box> drop ] assoc-each
|
||||
] when* ;
|
||||
|
||||
: init-alarms ( -- )
|
||||
<min-heap> alarms set-global
|
||||
alarms global [ cancel-alarms <min-heap> ] change-at
|
||||
[ alarm-thread-loop ] "Alarms" spawn
|
||||
alarm-thread set-global ;
|
||||
|
||||
|
@ -83,4 +89,5 @@ PRIVATE>
|
|||
from-now f add-alarm ;
|
||||
|
||||
: cancel-alarm ( alarm -- )
|
||||
alarm-entry box> alarms get-global heap-delete ;
|
||||
alarm-entry ?box
|
||||
[ alarms get-global heap-delete ] [ drop ] if ;
|
||||
|
|
Loading…
Reference in New Issue