{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-} 
module Main where
import GHC.Float
import Graphics.Gloss
import Graphics.Gloss.Interface.Pure.Simulate
import Graphics.Gloss.Interface.IO.Simulate
import Graphics.Gloss.Data.Color
import Graphics.Gloss.Data.ViewPort
import Debug.Trace
import Control.Monad.Fix
import Control.Monad
import Control.Concurrent
import Foreign.ForeignPtr
import System.CPUTime
import Control.Parallel
import Control.Parallel.Strategies
import Data.Map

import qualified Sound.File.Sndfile as Snd
import qualified Sound.File.Sndfile.Buffer.Vector as B
import Control.Monad.Trans.State.Strict
import Control.Monad.IO.Class
import Control.Monad

import Sound.Analysis.Spectrum
import Sound.Analysis.SpectralFlux
import Sound.Analysis.Onset
import Sound.Filters.FreqFilters
import Sound.Filters.FluxFilters

import Sound.Data.PCM
import Sound.Data.Stream
import Sound.Data.Freq
import Sound.Data.Flux
import qualified Sound.Data.Onset as O
import qualified Sound.SFML.Mixer as M
import qualified Data.Sequence as S
import qualified Data.Foldable as F
--(ToDraw, ToBeDrawn)
type Time = Float
data DrawableOnsets = DrawableOnsets {  time :: !Float,
                                        mix :: M.Mixer,
                                        onsets :: !O.OnsetData,
                                        pics   :: ![Picture],
                                        vp     :: !ViewPort}
--RUN WITH OPTIONS
-- +RTS -N2 -s -qg2 -A1024k
main = do
    --bs holds our BufferS
    (info, Just (bs :: B.Buffer Double)) <- Snd.readFile musicPath
    --Convert to an unboxed array
    let b = sterilize bs

    --Grab all of the sound file
    let ct = (truncate $ (fromIntegral $ Snd.frames info)/2048.0)
    let i = StreamInfo 1024 44100 2
    let b' = sampleRawPCM 0 ct (i, b)
    let s = pcmStream b'
    
    let freqs = freqStream s
    --let !osStream = onsetStream 32 (lowpass $ fluxStream freqs 24)
    let !osStream = onsetStream 32 (fluxStream freqs 24)
    
    let bins = [86, 172..]
    let freqBins = [43, 86..]
    let mix = M.initMixer
    let inWin = InWindow "Gloss" (500,500) (1,1)
    
    print $ show (fmap S.length (O.bands osStream))
    --mix' <- M.withMixer mix $ setupMusic
    --M.withMixer mix' $ M.startChannel "testchan"
    --simulateIO inWin white 60 (makeModel mix' osStream) drawWorld stepWorld

setupMusic = do
    get
    M.addChannel musicPath "testchan" 100.0
    
musicPath = "./downtheroad.wav"
makeModel :: M.Mixer -> O.OnsetData -> DrawableOnsets
makeModel mixer !os = DrawableOnsets 0.0 mixer os [] viewPortInit

{-# INLINE updateStream #-}
updateStream :: Float -> DrawableOnsets -> DrawableOnsets
updateStream !t' !dos = dos'
    where   (drawable, remBands) =  S.foldrWithIndex frameSrch (S.empty, S.singleton S.empty) osBands

            ps    = (S.foldrWithIndex makeDrawable [] drawable)
            remaining = O.OnsetData i remBands

            os = onsets dos
            i = O.info os
            osBands = O.bands os
            
            oldPics = pics dos
            ps' = (oldPics++ps)
            numPics = length ps'
            culledPics  | numPics > 300 = ps
                        | otherwise = ps'
            
            frameSrch :: Int -> S.Seq O.Onset -> (S.Seq (Maybe O.Onset), S.Seq (S.Seq O.Onset)) -> (S.Seq (Maybe O.Onset), S.Seq (S.Seq O.Onset))
            frameSrch !i !e acc@(!toDraw, !left)
                | elem' == Nothing = (Nothing S.<| toDraw, e S.<| left)
                | t' > (frameToTime elem') = (elem' S.<| toDraw, left' S.<| left)
                | otherwise = (Nothing S.<| toDraw, e S.<| left)
                where   (!elemS, !left') = S.splitAt 1 e
                        !elem'  | S.length elemS >= 1 = Just $ S.index elemS 0
                                | otherwise = Nothing
            frameToTime (Just !f) = fromIntegral (O.frame f)*( (fromIntegral $ sampleRate i)/(fromIntegral $ fftWindow i))*2.0
            
            dos' = dos{time=t',onsets=remaining, pics=culledPics}


{-# INLINE makeDrawable #-}
makeDrawable :: Int -> Maybe O.Onset -> [Picture] -> [Picture]
makeDrawable i (Just !(O.Onset f p)) acc = (translate (fromIntegral i*2) (f'*2) $ (color (colorWheel !! i)(rectangleSolid p' p')) ): acc
    where   p' = double2Float (p*0.005)
            f' = (fromIntegral f)
makeDrawable _ Nothing acc = acc --color (colorWheel !! i) (rectangleSolid 1 1)

colorWheel = cycle [red, green, blue, yellow, cyan, magenta, rose, violet, azure, aquamarine, chartreuse, orange]
            

drawWorld :: DrawableOnsets -> IO Picture
drawWorld (DrawableOnsets t m os ps view)  = return $ applyViewPortToPicture view $ pictures ps

toPlot :: S.Seq (S.Seq O.Onset) -> Int -> [(Double, Double)]
toPlot fs n = snd $ F.foldl step (0.0, []) fs'
    where   fs' = fmap (flip S.index $ n) fs
            --step :: (Int, [(Int, Double)]) -> Double -> (Int, [(Int, Double)])
            step (i, es) e = (i+1.0, es++[(i, O.power e)])

{-# INLINE stepWorld #-}
stepWorld :: ViewPort -> Float -> DrawableOnsets -> IO DrawableOnsets
stepWorld vp t' dos@(DrawableOnsets t m os ps view) = do
    playhead <- evalStateT (M.playheadPosition "testchan") m
    let chans = M.channels m
    let dur = M.duration $ chans ! "testchan"
    --traceIO("duration: "++show dur++" pos: "++show playhead)
    let vp' = view{viewPortTranslate=(-30, -((t/43.0)-38)),viewPortScale=10}
    return $ updateStream (playhead*1000) dos{vp=vp'}

checkInit oldTick newTick | oldTick == 0.0 = trace("starting value: "++show newTick)$newTick
                 | otherwise = oldTick
