mads

afp
 avatar
unknown
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...