Jump to content

Metronome: Difference between revisions

Metronome (view source)

Revision as of 12:04, 19 October 2013

799 bytes added ,  10 years ago
→‎{{header|Factor}}
Line 154:
=={{header|Factor}}==
<lang factor>USING: accessors calendar circular colors.constants colors.hsv
concurrency.semaphorescommand-line continuations io kernel math openalmath.exampleparser namespaces
threadsopenal.example sequences system timers ui ui.gadgets ui.gadgets.worlds ui.pens.solid ;
ui.pens.solid ;
IN: rosetta-code.metronome
 
Line 169 ⟶ 170:
[ blink-gadget ] [ 0.3 play-sine blank-gadget ] 2bi ;
 
: open-metronome-windowiteration ( gadget circular -- gadget )
[ first play-note ] [ rotate-circular ] bi ;
gadget new { 200 200 } >>pref-dim
dup "Metronome" open-window yield ;
 
TUPLE: metronome-loopgadget (< gadget bpm notes semaphore --timer );
[
acquire [ play-note ] [ drop find-world handle>> ] 2bi
] curry with circular-loop ;
 
: (start-<metronome-timer)gadget> ( bpm semaphorenotes -- timergadget )
[\ releasemetronome-gadget ] currynew swap bpm>duration>notes everyswap >>bpm ;
 
: start-metronome-timerquot ( bpmgadget -- timer semaphorequot )
0dup notes>> <semaphorecircular> [ (start-metronome-timer)iteration ] keep2curry ;
 
: run-metronome-timer ( semaphore notesgadget -- timer )
[ open-metronome-windowquot ] 2dip[ <circularbpm>> swapbpm>duration metronome-loop] bi every ;
 
M: metronome-gadget (graft* bpm( notesgadget -- )
[ start-metronome-timer ] dipkeep timer<< ;
[ run-metronome ] 2curry [ stop-timer ] [ ] cleanup ;
 
M: metronome-examplegadget ( -- ) 60 { 440 220 330 } metronome ;ungraft*
timer>> stop-timer ;
 
MAINM: metronome-example</lang>gadget pref-dim* drop { 200 200 } ;
 
: metronome-defaults ( -- bpm notes ) 60 { 440 220 330 } ;
 
: metronome-ui ( bpm notes -- ) <metronome-gadget> "Metronome" open-window ;
 
: metronome-example ( -- ) metronome-defaults metronome-ui ;
 
: validate-args ( int-args -- )
[ length 2 < ] [ [ 0 <= ] any? ] bi or [ "args error" throw ] when ;
 
: (metronome-cmdline) ( args -- bpm notes )
[ string>number ] map dup validate-args
unclip swap ;
 
: metronome-cmdline ( -- bpm notes )
command-line get [ metronome-defaults ] [ (metronome-cmdline) ] if-empty ;
 
: print-defaults ( -- )
metronome-defaults swap prefix
[ " " write ] [ number>string write ] interleave nl ;
 
: metronome-usage ( -- )
"Usage: metronome [BPM FREQUENCIES...]" print
"Arguments must be non-zero" print
"Example: metronome " write print-defaults flush ;
 
: metronome-main ( -- )
[ [ metronome-cmdline metronome-ui ] [ drop metronome-usage 1 exit ] recover ] with-ui ;
 
MAIN: metronome-main</lang>
 
=={{header|Haskell}}==
Anonymous user
Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/200061"
Cookies help us deliver our services. By using our services, you agree to our use of cookies.
More information