module Main
   where

{-
  ghc -prof -auto-all -O -fvia-C SpeedTest.hs
  a.out +RTS -p -RTS
-}

import GHC.IOBase

{- saw tooth oscillator with modulated frequency -}
osciModSaw :: RealFrac a => a -> [a] -> [a]
osciModSaw phase freq = map (\x -> 2*x-1) (freqToPhase phase freq)

{- Convert a list of phase steps into a list of momentum phases
   phase is a number in the interval [0,1)
   freq contains the phase steps -}
freqToPhase :: RealFrac a => a -> [a] -> [a]
freqToPhase phase freq =
   scanl (\phase dif -> snd (properFraction (phase+dif))) phase freq

exponential :: Floating a => a -> a -> [a]
exponential halfLife y0 = iterate (*0.5**(1/halfLife)) y0



-- write the signal as binary file containing 1 6bit words
writeSignalMono :: (Floating a, RealFrac a) =>
   FilePath -> [a] -> IO ()
writeSignalMono fileName signal =
   writeFile fileName (signalToBinaryMono signal)

signalToBinaryMono :: (Floating a, RealFrac a) => [a] -> String
signalToBinaryMono = concat.(map floatToBin)

clip :: Ord a => a -> a -> a -> a
clip lower upper = (max lower).(min upper)

-- work-around the problem, that properFraction doesn't preserve
-- that the fractional part is betten 0 and 1
splitFrac :: (RealFrac a, Integral b) => a -> (b,a)
splitFrac x = if x>=0
              then properFraction x
              else let (n,f) = properFraction x in (n-1,f+1)

floatToBin :: (Floating a, RealFrac a) => a -> String
floatToBin x = let int     = round (32767 * (clip (-1) 1 x))
                   (hi,lo) = divMod int 256
               in  [toEnum lo, toEnum (mod hi 256)]

main =
   do writeSignalMono "zero.sw" (replicate 100000 0)
      writeSignalMono "saw.sw" (take 100000 (osciModSaw 0 (exponential 10000 0.1)))