{-
wavedrum-lib, a library to parse, edit and write Korg Wavedrum programs.
Copyright (C) 2013  Ricardo Wurmus

This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>.
-}

{-# LANGUAGE OverloadedStrings #-}

module Wavedrum where

import           Control.Monad (replicateM,mapM_)
import           Data.Binary.Get
import           Data.Binary.Put
import qualified Data.ByteString.Lazy as B

import           Wavedrum.Types
import           Wavedrum.Algorithm

byTarget :: Program -> Target -> [Param]
byTarget prg t = filter (\param -> target param == t) prg

parseProgram :: Get Program
parseProgram = do
  values1  <- replicateM  7 (fmap fromIntegral getWord16be)
  headVals <- replicateM  8 (fmap fromIntegral getWord16be)
  values2  <- replicateM  5 (fmap fromIntegral getWord16be)
  rimVals  <- replicateM  8 (fmap fromIntegral getWord16be)
  values3  <- replicateM 26 (fmap fromIntegral getWord16be)
  let headSettings = getSettingsForAlg (last values1)
  let rimSettings  = getSettingsForAlg (last values2)
  return $ concat
    [ zipWith ($) params1 values1
    , zipWith ($) (zipWith3 ($) headParams (map fst headSettings) (map snd headSettings)) headVals
    , zipWith ($) params2 values2
    , zipWith ($) (zipWith3 ($) rimParams (map fst rimSettings) (map snd rimSettings)) rimVals
    , zipWith ($) params3 values3
    ]
  where
    getSettingsForAlg n =
      if n > 0 && n < length algorithms
      then algoParams $ algorithms !! (n - 1)
      else replicate 8 ("<unused>", (0,0))
    params1 =
      [ Param HeadAlg "Pressure curve"           (  0,  5)
      , Param General "Pre EQ"                   (  0,  4) -- H-H, H-S, S S, H-n, S-n
      , Param HeadAlg "Tune"                     (  0,100)
      , Param HeadAlg "Level"                    (  0,100)
      , Param HeadAlg "Decay"                    (  0,100)
      , Param HeadAlg "Pan"                      (-50, 50) -- L50..R50
      , Param HeadAlg "Algorithm select"         (  1, 36) -- 01..36
      ]
    params2 =
      [ Param RimAlg  "Tune"                     (  0,100)
      , Param RimAlg  "Decay"                    (  0,100)
      , Param RimAlg  "Level"                    (  0,100)
      , Param RimAlg  "Pan"                      (-50, 50) -- L50..R50
      , Param RimAlg  "Algorithm select"         (  1, 25)
      ]
    params3 =
      [ Param HeadPCM "Tune"                     (-24, 24) -- semitones
      , Param HeadPCM "Decay"                    (-99, 99)
      , Param HeadPCM "Level"                    (  0,100)
      , Param HeadPCM "Pan"                      (-50, 50) -- L50..R50
      , Param HeadPCM "PCM instrument select"    (  0,100)
      , Param HeadPCM "Velocity curve"           (  0,  9)
      , Param HeadPCM "Pressure curve"           (  0,  5)
      , Param HeadPCM "Pressure tune"            (-12, 12)
      , Param HeadPCM "Pressure decay"           (-50, 50)
      , Param RimPCM  "Tune"                     (-24, 24) -- semitones
      , Param RimPCM  "Decay"                    (-99, 99)
      , Param RimPCM  "Level"                    (  0,100)
      , Param RimPCM  "Pan"                      (-50, 50) -- L50..R50
      , Param RimPCM  "PCM instrument select"    (  0,100)
      , Param RimPCM  "Velocity curve"           (  0,  9)
      , Param RimPCM  "Pressure curve"           (  0,  5)
      , Param RimPCM  "Pressure tune"            (-12, 12)
      , Param RimPCM  "Pressure decay"           (-50, 50)
      , Param General "Reverb type"              (  0, 10)
      , Param General "Reverb effect level"      (  0,100)
      , Param General "Reverb decay time"        (  0, 90)
      , Param General "Reverb frequency damping" (  0,100)
      , Param General "Delay feedback"           (  0, 99)
      , Param General "Delay effect level"       (  0,100)
      , Param General "Delay time"               (  0,200)
      , Param General "Delay frequency damping"  (  0,100)
      ]
    headParams = replicate 8 $ Param HeadAlg
    rimParams  = replicate 8 $ Param RimAlg

readProgram :: B.ByteString -> Program
readProgram = runGet parseProgram

-- each Program is 108 bytes long (54 16-bit words)
readAllPrograms :: B.ByteString -> [Program]
readAllPrograms bs =
  if B.null bs then []
  else let (rawPrg, rest) = B.splitAt 108 bs in
    readProgram rawPrg : readAllPrograms rest

putRawParams :: Program -> Put
putRawParams = mapM_ putRawParam
  where putRawParam = putWord16be . fromIntegral . value

serialize :: Program -> B.ByteString
serialize p = runPut $ putRawParams p

serializeAll :: [Program] -> B.ByteString
serializeAll = B.concat . map serialize

loadProgramFromFile :: String -> IO Program
loadProgramFromFile f = fmap readProgram (B.readFile f)

loadProgramsFromFile :: String -> IO [Program]
loadProgramsFromFile f = fmap readAllPrograms (B.readFile f)

writeProgramToFile :: String -> Program -> IO ()
writeProgramToFile f p = B.writeFile f (serialize p)

ppProgram :: Program -> IO ()
ppProgram = mapM_ (putStrLn . show)