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. ! Copyright (C) 2013 Jon Harper.
! 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 continuations kernel math openal.example kernel math openal.example sequences timers ui ui.gadgets
threads timers 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 ;
@ -17,28 +16,29 @@ IN: rosetta-code.metronome
: play-note ( gadget freq -- ) : play-note ( gadget freq -- )
[ blink-gadget ] [ 0.3 play-sine blank-gadget ] 2bi ; [ blink-gadget ] [ 0.3 play-sine blank-gadget ] 2bi ;
: open-metronome-window ( -- gadget ) : metronome-iteration ( gadget circular -- )
gadget new { 200 200 } >>pref-dim [ first play-note ] [ rotate-circular ] bi ;
dup "Metronome" open-window yield ;
: metronome-loop ( gadget notes semaphore -- ) TUPLE: metronome-gadget < gadget bpm notes timer ;
[
acquire [ play-note ] [ drop find-world handle>> ] 2bi
] curry with circular-loop ;
: (start-metronome-timer) ( bpm semaphore -- timer ) : <metronome-gadget> ( bpm notes -- gadget )
[ release ] curry swap bpm>duration every ; \ metronome-gadget new swap >>notes swap >>bpm ;
: start-metronome-timer ( bpm -- timer semaphore ) : metronome-quot ( gadget -- quot )
0 <semaphore> [ (start-metronome-timer) ] keep ; dup notes>> <circular> [ metronome-iteration ] 2curry ;
: run-metronome ( semaphore notes -- ) : metronome-timer ( gadget -- timer )
[ open-metronome-window ] 2dip <circular> swap metronome-loop ; [ metronome-quot ] [ bpm>> bpm>duration ] bi every ;
: metronome ( bpm notes -- ) M: metronome-gadget graft* ( gadget -- )
[ start-metronome-timer ] dip [ metronome-timer ] keep timer<< ;
[ run-metronome ] 2curry [ stop-timer ] [ ] cleanup ;
: 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 MAIN: metronome-example