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

diff --git a/extra/rosetta-code/metronome/metronome.factor b/extra/rosetta-code/metronome/metronome.factor
index 7b74caf9ed1281e41a3e7b46bddb43416454ab10..ad02fccf0d4dd2b056f10c624a403aec39d100d0 100644 (file)
--- a/extra/rosetta-code/metronome/metronome.factor
+++ b/extra/rosetta-code/metronome/metronome.factor
@@ -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 ;
+
+TUPLE: metronome-gadget < gadget bpm notes timer ;
+
+: <metronome-gadget> ( bpm notes -- gadget )
+    \ metronome-gadget new swap >>notes swap >>bpm ;
 
-: metronome-loop ( gadget notes semaphore -- )
-    [
-        acquire [ play-note ] [ drop find-world handle>> ] 2bi
-    ] curry with circular-loop ;
+: metronome-quot ( gadget -- quot )
+    dup notes>> <circular> [ metronome-iteration ] 2curry ;
 
-: (start-metronome-timer) ( bpm semaphore -- timer )
-    [ release ] curry swap bpm>duration every ;
+: metronome-timer ( gadget -- timer )
+    [ metronome-quot ] [ bpm>> bpm>duration ] bi every ;
 
-: start-metronome-timer ( bpm -- timer semaphore )
-    0 <semaphore> [ (start-metronome-timer) ] keep ;
+M: metronome-gadget graft* ( gadget -- )
+    [ metronome-timer ] keep timer<< ;
 
-: run-metronome ( semaphore notes -- )
-    [ open-metronome-window ] 2dip <circular> swap metronome-loop ;
+M: metronome-gadget ungraft*
+    timer>> stop-timer ;
 
-: metronome ( bpm notes -- )
-    [ start-metronome-timer ] dip
-    [ run-metronome ] 2curry [ stop-timer ] [ ] cleanup ;
+M: metronome-gadget pref-dim* drop { 200 200 } ;
 
-: metronome-example ( -- ) 60 { 440 220 330 } metronome ;
+: metronome-example ( -- )
+    [ 60 { 440 220 330 } <metronome-gadget> "Metronome" open-window ] with-ui ;
 
 MAIN: metronome-example