mads
afpunknown
fsharp
2 years ago
4.6 kB
6
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...