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 {
      T -> T Real
body :: SigSt.T Real,
      T -> Frequency Real
sampleRate :: DN.Frequency Real,
      T -> Positions
positions :: Positions
   }

data Positions =
   Positions {
      Positions -> Int
start, Positions -> Int
length,
      Positions -> Int
loopStart, Positions -> Int
loopLength :: Int,
      Positions -> Real
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 :: forall ar. AbsRel ar => File ar -> IO (T Real)
load File ar
path =
   IO (Handle (T Real))
-> (Handle (T Real) -> IO ExitCode)
-> (Handle (T Real) -> IO (T Real))
-> IO (T Real)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (T -> FilePath -> IO (Handle (T Real))
forall y (sig :: * -> *).
C y =>
T -> FilePath -> IO (Handle (sig y))
SoxRead.open T
SoxOption.none (File ar -> FilePath
forall ar fd. (AbsRel ar, FileDir fd) => Path ar fd -> FilePath
Path.toString File ar
path)) Handle (T Real) -> IO ExitCode
forall signal. Handle signal -> IO ExitCode
SoxRead.close ((Handle (T Real) -> IO (T Real)) -> IO (T Real))
-> (Handle (T Real) -> IO (T Real)) -> IO (T Real)
forall a b. (a -> b) -> a -> b
$
   (Handle -> IO (T Real)) -> Handle (T Real) -> IO (T Real)
forall (m :: * -> *) signal.
(Handle -> m signal) -> Handle signal -> m signal
SoxRead.withHandle1 (ChunkSize -> Handle -> IO (T Real)
forall a. Storable a => ChunkSize -> Handle -> IO (Vector a)
SVL.hGetContentsSync ChunkSize
SVL.defaultChunkSize)

loadRanges :: (PathClass.AbsRel ar) => Path.Dir ar -> Info -> IO [T]
loadRanges :: forall ar. AbsRel ar => Dir ar -> Info -> IO [T]
loadRanges Dir ar
dir (Info RelFile
file Real
sr [Positions]
poss) =
   (T Real -> [T]) -> IO (T Real) -> IO [T]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      (\T Real
smp -> (Positions -> T) -> [Positions] -> [T]
forall a b. (a -> b) -> [a] -> [b]
map (T Real -> Frequency Real -> Positions -> T
Cons T Real
smp (Real -> Frequency Real
forall a. a -> Frequency a
DN.frequency Real
sr)) [Positions]
poss)
      (File ar -> IO (T Real)
forall ar. AbsRel ar => File ar -> IO (T Real)
load (Dir ar
dir Dir ar -> RelFile -> File ar
forall os ar fd. DirPath os ar -> RelPath os fd -> Path os ar fd
</> RelFile
file))


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

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


parts :: T -> (SigSt.T Real, SigSt.T Real, SigSt.T Real)
parts :: T -> (T Real, T Real, T Real)
parts T
smp =
   let pos :: Positions
pos = T -> Positions
positions T
smp
       (T Real
attack,T Real
sustain) =
          (T Real -> T Real, T Real -> T Real)
-> (T Real, T Real) -> (T Real, T Real)
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair
             (Int -> T Real -> T Real
forall a. Storable a => Int -> Vector a -> Vector a
SigSt.drop (Positions -> Int
start Positions
pos),
              Int -> T Real -> T Real
forall a. Storable a => Int -> Vector a -> Vector a
SigSt.take (Positions -> Int
loopLength Positions
pos)) ((T Real, T Real) -> (T Real, T Real))
-> (T Real, T Real) -> (T Real, T Real)
forall a b. (a -> b) -> a -> b
$
          Int -> T Real -> (T Real, T Real)
forall a. Storable a => Int -> Vector a -> (Vector a, Vector a)
SigSt.splitAt (Positions -> Int
loopStart Positions
pos) (T Real -> (T Real, T Real)) -> T Real -> (T Real, T Real)
forall a b. (a -> b) -> a -> b
$
          T -> T Real
body T
smp
       release :: T Real
release =
          Int -> T Real -> T Real
forall a. Storable a => Int -> Vector a -> Vector a
SigSt.drop (Positions -> Int
loopStart Positions
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Positions -> Int
loopLength Positions
pos) (T Real -> T Real) -> T Real -> T Real
forall a b. (a -> b) -> a -> b
$
          Int -> T Real -> T Real
forall a. Storable a => Int -> Vector a -> Vector a
SigSt.take (Positions -> Int
start     Positions
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Positions -> Int
length     Positions
pos) (T Real -> T Real) -> T Real -> T Real
forall a b. (a -> b) -> a -> b
$
          T -> T Real
body T
smp
   in  (T Real
attack, T Real
sustain, T Real
release)



-- * examples

tomatensalatPositions :: [Positions]
tomatensalatPositions :: [Positions]
tomatensalatPositions =
   Int -> Int -> Int -> Int -> Real -> Positions
Positions      Int
0 Int
29499  Int
12501 Int
15073 Real
321.4 Positions -> [Positions] -> [Positions]
forall a. a -> [a] -> [a]
:
   Int -> Int -> Int -> Int -> Real -> Positions
Positions  Int
29499 Int
31672  Int
38163 Int
17312 Real
320.6 Positions -> [Positions] -> [Positions]
forall a. a -> [a] -> [a]
:
   Int -> Int -> Int -> Int -> Real -> Positions
Positions  Int
67379 Int
28610  Int
81811 Int
10667 Real
323.2 Positions -> [Positions] -> [Positions]
forall a. a -> [a] -> [a]
:
   Int -> Int -> Int -> Int -> Real -> Positions
Positions  Int
95989 Int
31253 Int
106058 Int
16111 Real
323.7 Positions -> [Positions] -> [Positions]
forall a. a -> [a] -> [a]
:
   {-
   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.
   -}
   Int -> Int -> Int -> Int -> Real -> Positions
Positions Int
127242 Int
38596 Int
136689 Int
11514 Real
319.3 Positions -> [Positions] -> [Positions]
forall a. a -> [a] -> [a]
:
   []


tomatensalat :: Info
tomatensalat :: Info
tomatensalat =
   FilePath -> Real -> [Positions] -> Info
info FilePath
"tomatensalat2.wav" Real
44100 [Positions]
tomatensalatPositions


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

hal :: Info
hal :: Info
hal =
   FilePath -> Real -> [Positions] -> Info
info FilePath
"haskell-in-leipzig2.wav" Real
44100 [Positions]
halPositions


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

graphentheorie :: Info
graphentheorie :: Info
graphentheorie =
   FilePath -> Real -> [Positions] -> Info
info FilePath
"graphentheorie0.wav" Real
44100 [Positions]
graphentheoriePositions