Play beeps

play.red

Red [
	Needs: View
	Author: "Gregg Irwin"
	Porter: "Toomas Vooglaid"
	Source: https://gitter.im/red/red/gui-branch?at=5c7f0f2e86e34a126f92a7be
	Port-date: 6-Mar-2019
]
#system [
	#import [
		"kernel32.dll" stdcall [
			_Beep: "Beep" [
				frequency	[integer!] 
				duration	[integer!] 
				return:		[integer!]
			]
		]
	]
]

beep: routine [freq [integer!] dur [integer!] return: [integer!]][
	_Beep freq dur
]
notes:  ["C" "C#" "D" "D#" "E" "F" "F#" "G" "G#" "A" "A#" "B"]
A440:   440
base-note: find notes "A"
base-octave: 4
freq-int: 1

play-note: func [note sharp octave duration /local base-A op steps] [
    ;print [note sharp octave duration]
    steps: offset? base-note find notes rejoin [note either sharp ["#"][""]]
    if zero? octave [ocatve: base-octave]
    base-A: 2 ** (octave - base-octave) * A440
    freq: base-A
	if not zero? steps [
        loop absolute steps [
			freq: either negative? steps [
				divide freq 1.059463
			][
				multiply freq 1.059463
			]
		]    ; 1.059463^12 = 2
    ]
    beep round/to freq 1 to-integer duration * 500
]

any-note: charset "ABCDEFG"
sharp-note: charset "ACDFG"
non-sharp-note: charset "BE"
octave-num: charset "12345678"
digit: charset "0123456789."
rule: [
    some [
        [ copy note sharp-note (sharp: false) opt [#"#" (sharp: true)]
        | copy note non-sharp-note (sharp: false)]
		opt [copy octave octave-num] 
		skip (duration: "1")
        opt [copy duration some digit] (
            ; Now we have all the data to play a note.
            play-note note sharp
                either unset? :octave [base-octave][to-integer octave]
                load duration
        )
	|	#"_" (wait 1)
	|	#"-" (wait .25)
	|	skip
    ]
]

play: func [input] [parse input rule]

either empty? args: system/options/args [
	view [
		title "Play notes"
		sheet: area 400x300 return
		button "Play" [play sheet/text]
		button "Open" [if file: request-file [sheet/text: read file]]
		button "Save" [if file: request-file/save [write file sheet/text]]
		button "Clear" [clear sheet/text]
		button "Quit" [unview]
		button 40 "?" [
			view/flags [title "Play-notes help"
				below
				text 400x180 {This is one octave:
["C" "C#" "D" "D#" "E" "F" "F#" "G" "G#" "A" "A#" "B"]
Unless you add octave number to note, 4th octave is 
assumed, e.g. C# -> C#4. After note its duration may be given,
e.g. .5 1 1.5 2. If not provided, 1 is assumed (500 ms).
Paus (wait 1) is represented by "_", quarter-pause by "-".
After compilation it may be invoked with file-name of a 
tune -- tune is played without opening the window. If called
without argument, window is opened, where you can compose
your tune.

E.g: simple tune of an Estonian children's song:}
				area 400x130 {C D E F G G G 1.5 -
C D E F G G G 1.5 -
F F F F E E E 1.5 -
D D D D C C C 1.5 -
G E E E G E E E
A G F E F D D D
F D D D F D D D
G F E D E C C 1.5
} 
				button "OK" [unview]
			][popup]
		]
	]
][
	play read to-file args/1
]

comment [
;["C" "C#" "D" "D#" "E" "F" "F#" "G" "G#" "A" "A#" "B"]

;Ode to Joy
play {
B4 	B4 	C5 	D5 
D#5 	C5 	B4 	A4 
G4 	G4 	A4 	B4 
B4 1.5 	A4 .5 	A4 2
B4 	B4 	C5 	D5 
D#5 	C5 	B4 	A4 
G4 	G4 	A4 	B4 
A4 1.5 	G4 .5 	G4 2
A4 	A4 	B4 	G4 
A4 	B4 .5 	C5 .5 	B4 G4 
A4 	B4 .5 	C5 .5 	B4 A4 
G4 	A4 	D4 2 
B4 	B4 	C5 	D5 
D#5 	C5 	B4 	A4 
G4 	G4 	A4 	B4 
A4 1.5 	G4 .5 	G4 2
}

;Beethoven's 5th
{C4 .5 C4 .5 C4 .5 G#3 2 --
A#3 .5 A#3 .5 A#3 .5 G3 2} 

;Estonian children's song
{
C D E F G G G 1.5 -
C D E F G G G 1.5 -
F F F F E E E 1.5 -
D D D D C C C 1.5 -
G E E E G E E E
A G F E F D D D
F D D D F D D D
G F E D E C C 1.5 -
}

parse "C1 .5 D4 F4 E4 D4 G2 G2 G4 G4 E4 F4 D2 D2 D4 F4 E4 D4 C4 C4 B4 A4 G4 F4 E4 D4 C1" rule
parse "D4 .5 F4 E4 D4 G2 G2 G4 A4 E4 F4 D2 D2 D4 F4 E4 F4 C4 G4 D4 E4 C2" rule

parse "A1 A#1 2 B1 1.5 C#3 4" rule
parse "C1 .5 C#1 .5 D1 .5 B7 .5 C8 .5" rule
parse "A3 A4 A5 A6" rule
]

Compile with red -c play.red
Call as play <tune-file> or without argument.
In first case tune in file is played, in second case window is opened where you can compose your tune.