diff --git a/extra/rosetta-code/metronome/metronome.factor b/extra/rosetta-code/metronome/metronome.factor index 7b74caf9ed..ad02fccf0d 100644 --- 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 ; -: 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 ; +: ( bpm notes -- gadget ) + \ metronome-gadget new swap >>notes swap >>bpm ; -: start-metronome-timer ( bpm -- timer semaphore ) - 0 [ (start-metronome-timer) ] keep ; +: metronome-quot ( gadget -- quot ) + dup notes>> [ metronome-iteration ] 2curry ; -: run-metronome ( semaphore notes -- ) - [ open-metronome-window ] 2dip 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" open-window ] with-ui ; MAIN: metronome-example