module Synthesizer.LLVM.Server.SampledSound where

import Synthesizer.LLVM.Server.Common (Real)

import qualified Sound.Sox.Read          as SoxRead
import qualified Sound.Sox.Option.Format as SoxOption
import Control.Exception (bracket)

import qualified Synthesizer.Storable.Signal      as SigSt
import qualified Data.StorableVector.Lazy         as SVL

import qualified System.Path.PartClass as PathClass
import qualified System.Path as Path
import System.Path ((</>))

import Data.Tuple.HT (mapPair)

import qualified Number.DimensionTerm as DN

import Prelude hiding (Real, length)



data T =
   Cons {
      body :: SigSt.T Real,
      sampleRate :: DN.Frequency Real,
      positions :: Positions
   }

data Positions =
   Positions {
      start, length,
      loopStart, loopLength :: Int,
      period :: Real
   }


-- ToDo: flag failure if files cannot be found, or just remain silent
load :: (PathClass.AbsRel ar) => Path.File ar -> IO (SVL.Vector Real)
load path =
   bracket (SoxRead.open SoxOption.none (Path.toString path)) SoxRead.close $
   SoxRead.withHandle1 (SVL.hGetContentsSync SVL.defaultChunkSize)

loadRanges :: (PathClass.AbsRel ar) => Path.Dir ar -> Info -> IO [T]
loadRanges dir (Info file sr poss) =
   fmap
      (\smp -> map (Cons smp (DN.frequency sr)) poss)
      (load (dir </> file))


data
   Info =
      Info {
         infoName :: Path.RelFile,
         infoRate :: Real,
         infoPositions :: [Positions]
      }

info :: FilePath -> Real -> [Positions] -> Info
info path = Info (Path.relFile path)


parts :: T -> (SigSt.T Real, SigSt.T Real, SigSt.T Real)
parts smp =
   let pos = positions smp
       (attack,sustain) =
          mapPair
             (SigSt.drop (start pos),
              SigSt.take (loopLength pos)) $
          SigSt.splitAt (loopStart pos) $
          body smp
       release =
          SigSt.drop (loopStart pos + loopLength pos) $
          SigSt.take (start     pos + length     pos) $
          body smp
   in  (attack, sustain, release)



-- * examples

tomatensalatPositions :: [Positions]
tomatensalatPositions =
   Positions      0 29499  12501 15073 321.4 :
   Positions  29499 31672  38163 17312 320.6 :
   Positions  67379 28610  81811 10667 323.2 :
   Positions  95989 31253 106058 16111 323.7 :
   {-
   vor dem 't' kommt noch das Ende vom 'a'
   wir bräuchten eine weitere Positionsangabe,
   um am Ende etwas überspringen zu können.
   Ein Smart-Konstruktor wie 'positions'
   könnte das bisherige Verhalten nachmachen.
   -}
   Positions 127242 38596 136689 11514 319.3 :
   []


tomatensalat :: Info
tomatensalat =
   info "tomatensalat2.wav" 44100 tomatensalatPositions


halPositions :: [Positions]
halPositions =
--   Positions   2371 25957   7362  6321 :
   Positions   2371 25957 (2371+25957) 1 320 :
   Positions  40546 34460  63540  9546 317.4 :
   Positions  79128 32348  94367 14016 317.8 :
   Positions 112027 21227 125880  5500 322.5 :
   Positions 146057 23235 168941   352 320 :
   []

hal :: Info
hal =
   info "haskell-in-leipzig2.wav" 44100 halPositions


graphentheoriePositions :: [Positions]
graphentheoriePositions =
   Positions      0 29524  13267 14768 301.1 :
   Positions  29524 35333  47624  9968 301.6 :
   Positions  64857 31189  73818 16408 297.3 :
   Positions  96046 31312 106206 18504 302.9 :
   Positions 127358 32127 132469 16530 299.4 :
   []

graphentheorie :: Info
graphentheorie =
   info "graphentheorie0.wav" 44100 graphentheoriePositions