steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

rosetta-code.metronome: simplify stack shuffling

db4
Jon Harper 2013-09-29 19:24:37 +02:00
parent 939395ac13
commit ccf1b82882
1 changed files with 8 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
extra/rosetta-code/metronome/metronome.factor
View File

@ -2,9 +2,8 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors calendar circular colors.constants colors.hsv USING: accessors calendar circular colors.constants colors.hsv
concurrency.semaphores generalizations kernel math concurrency.semaphores kernel math openal.example threads timers
openal.example threads timers ui ui.gadgets ui.gadgets.worlds ui ui.gadgets ui.gadgets.worlds ui.pens.solid ;
ui.pens.solid ;
IN: rosetta-code.metronome IN: rosetta-code.metronome
: bpm>duration ( bpm -- duration ) 60 swap / seconds ; : bpm>duration ( bpm -- duration ) 60 swap / seconds ;
@ -27,16 +26,15 @@ IN: rosetta-code.metronome
acquire [ play-note ] [ drop find-world handle>> ] 2bi acquire [ play-note ] [ drop find-world handle>> ] 2bi
] curry with circular-loop ; ] curry with circular-loop ;
: start-metronome-timer ( bpm semaphore -- timer ) : (start-metronome-timer) ( bpm semaphore -- timer )
[ release ] curry swap bpm>duration every ; [ release ] curry swap bpm>duration every ;
: start-metronome-timer ( bpm -- timer semaphore )
0 <semaphore> [ (start-metronome-timer) ] keep ;
: metronome ( bpm notes -- ) : metronome ( bpm notes -- )
<circular> open-metronome-window [ start-metronome-timer ] dip
swap 0 <semaphore> [ open-metronome-window ] 2dip <circular> swap metronome-loop
{
[ 2nip start-metronome-timer ]
[ metronome-loop drop ]
} 4 ncleave
stop-timer ; stop-timer ;
! example usage: 60 { 440 220 330 } metronome ! example usage: 60 { 440 220 330 } metronome