mads
afpunknown
fsharp
3 years ago
4.6 kB
11
Indexable
open FParsec
type Duration =
| One = 1
| Two = 2
| Fourth = 4
| Eights = 8
| Sixteen = 16
| Thirtytwo = 32
let getDuration (duration: int32) =
match duration with
| 1 -> Duration.One
| 2 -> Duration.Two
| 4 -> Duration.Fourth
| 8 -> Duration.Eights
| 16 -> Duration.Sixteen
| 32 -> Duration.Thirtytwo
| _ -> Duration.Sixteen
type FullDuration =
{
Duration: Duration
Extended: bool
}
type Notes =
| A = 1
| ASharp = 2
| B = 3
| C = 4
| CSharp = 5
| D = 6
| DSharp = 7
| E = 8
| F = 9
| FSharp = 10
| G = 11
| GSharp = 12
| UFkedUp = 13
let getNote (note: string): Notes =
match note with
| "a" -> Notes.A
| "#a" -> Notes.ASharp
| "b" -> Notes.B
| "c" -> Notes.C
| "#c" -> Notes.CSharp
| "d" -> Notes.D
| "#d" -> Notes.DSharp
| "e" -> Notes.E
| "f" -> Notes.F
| "#f" -> Notes.FSharp
| "g" -> Notes.G
| "#g" -> Notes.GSharp
| _ -> Notes.UFkedUp
type Octaves =
| One = 1
| Two = 2
| Three = 3
let getOctave (octave: int32) =
match octave with
| 1 -> Octaves.One
| 2 -> Octaves.Two
| 3 -> Octaves.Three
| _ -> Octaves.One
type Tone =
{
Note: Notes
Octave: Octaves
}
type Pitch =
| Pause of bool
| Tone of Tone
type Token =
{
Duration: FullDuration
Pitch: Option<Tone>
}
let testToken = "16#A2 1E1"
//PARSERS
let duration_p = (pint32) .>>. opt ((pchar '.'))
let note_p = manyChars (letter <|> pchar '#')
let octave_p = pint32
let tone_p = note_p .>>. octave_p
let empty_or_tone_p = opt tone_p
//helping matches
let isExtended (x: char option) =
match x with
| Some(x) -> true
| None -> false
let isTone (x: (string * int32)option) =
match x with
| Some(x) -> Some {Note = getNote (fst x); Octave = getOctave (snd x)}
| None -> None
let createToken dur tone = {
Duration = {Duration=getDuration (fst dur); Extended= isExtended (snd dur)}
Pitch = isTone tone
}
let token = pipe2 duration_p empty_or_tone_p createToken
let parser = sepEndBy token spaces
let test p str =
match str |> run p with
| Success(result, _, _) -> result
| Failure(errorMsg, _, _) -> failwith errorMsg
let answer = test parser testToken
//PARSERS END
let pScore: Parser<Token list, unit> = parser
let parse (input: string): Choice<string, Token list> =
match run pScore input with
| Failure(errorMsg,_,_)-> Choice1Of2(errorMsg)
| Success(result,_,_) -> Choice2Of2(result)
// Helper function to test parsers
//let test (p: Parser<'a, unit>) (str: string): unit =
// match run p str with
// | Success(result, _, _) -> printfn "Success: %A" result
// | Failure(errorMsg, _, _) -> printfn "Failure: %s" errorMsg
// TODO 3 calculate duration from token.
// bpm = 120 (bpm = beats per minute)
// 'Duration in seconds' * 1000 * 'seconds per beat' (if extended *1.5)
// Whole note: 4 seconds
// Half note: 2 seconds
// Quarter note: 1 second
// Eight note: 1/2 second
// Sixteenth note 1/4 second
// thirty-second note: 1/8
let durationFromToken (token: Token): float =
let extended: float =
match token.Duration.Extended with
| true -> 1.5
| false -> 1.0
let noteVal: float =
match token.Duration.Duration with
| Duration.One -> 4.0
| Duration.Two -> 2.0
| Duration.Fourth -> 1.0
| Duration.Eights -> 0.5
| Duration.Sixteen -> 0.25
| Duration.Thirtytwo -> 0.125
| _ -> 1.0
let seconds_per_beat = 0.5
noteVal * 1000.0 * seconds_per_beat * extended
// TODO 4 calculate overall index of octave
// note index + (#octave-1) * 12
let overallIndex (note: Notes, octave:Octaves) =
LanguagePrimitives.EnumToValue note + (LanguagePrimitives.EnumToValue octave - 1) * 12
// TODO 5 calculate semitones between to notes*octave
// [A; A#; B; C; C#; D; D#; E; F; F#; G; G#]
// overallIndex upper - overallIndex lower
let semitonesBetween (lower: (Notes * Octaves), upper: Notes * Octaves): int32 = overallIndex upper - overallIndex lower
// TODO 6
// For a tone frequency formula can be found here: http://www.phy.mtu.edu/~suits/NoteFreqCalcs.html
// 220 * 2^(1/12) ^ semitonesBetween (A1, Token.pitch)
let frequency (token: Token): float =
match token.Pitch with
| Some x -> 220.0 * 2.0**(1.0/12.0)**float(semitonesBetween((Notes.A, Octaves.One),(x.Note, x.Octave)))
| None -> 0
Editor is loading...