Metronome: Difference between revisions

Line 154:

=={{header|Factor}}==

<lang factor>USING: accessors calendar circular colors.constants colors.hsv

~~concurrency.semaphores~~ continuations kernel math ~~openal~~.~~example~~

command-line continuations io kernel math math.parser namespaces

~~threads~~ timers ui ui.gadgets ~~ui.gadgets.worlds ui.pens.solid ;~~

openal.example sequences system timers ui ui.gadgets

ui.pens.solid ;

IN: rosetta-code.metronome

Line 169:

Line 170:

[ blink-gadget ] [ 0.3 play-sine blank-gadget ] 2bi ;

: ~~open-~~metronome-~~window~~ ( -- ~~gadget~~ )

: metronome-iteration ( gadget circular -- )

[ first play-note ] [ rotate-circular ] bi ;

gadget new { 200 200 } >>pref-dim

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 ;

~~MAIN~~: metronome-~~example</lang>~~

M: metronome-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}}==