module SampleGenerator where

import Data.List
import Data.Char

-- TUTORIAL:
--
-- define the frequency that you want at (1)
frequency :: Float
frequency = 100

-- open this script in ghci dump a sample with the `dump' function
-- > dump f x
--
-- ex: dump pdm Triangle
-- ex: dump sample Sine
--
-- where f is a sampling function, either `sample` or `pdm`
-- and
-- where x is one of
data Function
  = Sine
  | Saw
  | Triangle
  | Square
  deriving (Eq, Show)

-- copy-paste the result into the c file

carrierFreq :: Float
carrierFreq = 250E3 / 15.5

samples :: Int
samples   = round (carrierFreq / frequency)

-- Generator functions for sine, saw, triangle and square
gSine t =
  let coeff = 2 * pi / fromIntegral samples
  in 127.5 + 127.5 * sin (coeff * t)

gSaw t =
  let coeff = 255 / fromIntegral samples
  in coeff * t

gTriangle t =
  let samples' = fromIntegral samples
      coeff = 255 * 2 / samples'
      offs  = t - (samples' / 2)
  in 255 - abs (coeff * offs)

gSquare  t =
  let samples' = fromIntegral samples
  in case () of
    _ | t < samples'/2 -> 0
      | otherwise     -> 255

--
sample :: Function -> [Int]
sample f =
  let g h = (round . h . fromIntegral ) <$> [0 .. samples-1]
  in case f of
    Sine     -> g gSine
    Saw      -> g gSaw
    Triangle -> g gTriangle
    Square   -> g gSquare

-- formats a sample into c syntax with the right qualifier and PROGMEM etc etc
format :: (Function -> [Int]) -> Function -> String
format f s =
  let xs = f s
  in "// sample of a " ++ (toLower <$> show s) ++ " at " ++ show frequency ++
     " Hz\n" ++ "static const PROGMEM SAMPLE_WORD_SIZE "++ (toLower <$> show s) ++ (show . truncate $ frequency) ++"[" ++
     show samples ++ "] =\n  { " ++ intercalate ", " (show <$> xs) ++ " };"

--
dump :: (Function -> [Int]) -> Function -> IO ()
dump f = putStrLn . format f

pdm :: Function -> [Int]
pdm = _pdm 0 [] . sample
  where
    _pdm _  acc []     = acc
    _pdm qe acc (x:xs) =
      let f r = _pdm (qe + r - x) (r:acc) xs
      in case x `compare` qe of
        LT -> f 0
        _  -> f 255
