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

rosetta-code.metronome, simplify and fix script/deploy 

Timers have 1 thread per timer, so it's ok to block. This removes
the need for a timer releasing a semaphore and another thread
acquiring the semaphore.

Also, when running in with-ui, the quotation must return for the UI
to actually start, so the previous method didn't work
db4
Jon Harper 2013-10-16 23:58:54 +02:00 committed by John Benediktsson
parent 16e3bac2d3
commit 19204e83b4
1 changed files with 20 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,9 +1,8 @@
! Copyright (C) 2013 Jon Harper.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors calendar circular colors.constants colors.hsv
concurrency.semaphores continuations kernel math openal.example
threads timers ui ui.gadgets ui.gadgets.worlds ui.pens.solid ;
kernel math openal.example sequences timers ui ui.gadgets
ui.pens.solid ;
IN: rosetta-code.metronome
: bpm>duration ( bpm -- duration ) 60 swap / seconds ;
@ -17,28 +16,29 @@ IN: rosetta-code.metronome
: play-note ( gadget freq -- )
[ blink-gadget ] [ 0.3 play-sine blank-gadget ] 2bi ;
: open-metronome-window ( -- gadget )
gadget new { 200 200 } >>pref-dim
dup "Metronome" open-window yield ;
: metronome-iteration ( gadget circular -- )
[ first play-note ] [ rotate-circular ] bi ;
: metronome-loop ( gadget notes semaphore -- )
[
acquire [ play-note ] [ drop find-world handle>> ] 2bi
] curry with circular-loop ;
TUPLE: metronome-gadget < gadget bpm notes timer ;
: (start-metronome-timer) ( bpm semaphore -- timer )
[ release ] curry swap bpm>duration every ;
: <metronome-gadget> ( bpm notes -- gadget )
\ metronome-gadget new swap >>notes swap >>bpm ;
: start-metronome-timer ( bpm -- timer semaphore )
0 <semaphore> [ (start-metronome-timer) ] keep ;
: metronome-quot ( gadget -- quot )
dup notes>> <circular> [ metronome-iteration ] 2curry ;
: run-metronome ( semaphore notes -- )
[ open-metronome-window ] 2dip <circular> swap metronome-loop ;
: metronome-timer ( gadget -- timer )
[ metronome-quot ] [ bpm>> bpm>duration ] bi every ;
: metronome ( bpm notes -- )
[ start-metronome-timer ] dip
[ run-metronome ] 2curry [ stop-timer ] [ ] cleanup ;
M: metronome-gadget graft* ( gadget -- )
[ metronome-timer ] keep timer<< ;
: metronome-example ( -- ) 60 { 440 220 330 } metronome ;
M: metronome-gadget ungraft*
timer>> stop-timer ;
M: metronome-gadget pref-dim* drop { 200 200 } ;
: metronome-example ( -- )
[ 60 { 440 220 330 } <metronome-gadget> "Metronome" open-window ] with-ui ;
MAIN: metronome-example