import Data.Char import Sound.SC3.UGen.Rate {- hsc3 -} import qualified Sound.SC3.UGen.DB.Data as D {- hsc3-db -} import qualified Sound.SC3.UGen.DB.Record as D import qualified Sound.SC3.UGen.DB.Rename as D import System.FilePath {- filepath -} import Text.Printf -- True if the unit generator can operate at multiple rates, in which -- case the record will require a rate field. needs_rate :: D.U -> Bool needs_rate u = length (D.ugen_operating_rates u) > 1 -- In the case of one input rate use that instead of default rate, -- which can be innacurate (see pitch for example). fixed_rate :: D.U -> Rate fixed_rate u = case D.ugen_operating_rates u of [r] -> r [] -> D.ugen_default_rate u _ -> undefined --u_input_nm u k = D.input_name (D.ugen_inputs u !! k) -- List of field names and types. inputs_of :: D.U -> [(String, String)] inputs_of u = let is = D.ugen_inputs u bs = zip (map D.input_name is) (repeat "S.UGen") in if needs_rate u then ("rate", "S.Rate") : bs else bs -- Append a character to each but the last string. with_char :: Char -> [String] -> [String] with_char c l = case l of x:y:xs -> (x ++ [c]) : with_char c (y:xs) _ -> l with_comma :: [String] -> [String] with_comma = with_char ',' with_space :: [String] -> [String] with_space = with_char ' ' downcase_first_char :: String -> String downcase_first_char s = case s of [] -> [] x:xs -> toLower x : xs -- Construct the parameter record. gen_param :: D.U -> [String] gen_param u = let n = D.ugen_name u pre = [printf "data %s = %s {" n n] post = [" } deriving (Show)"] f (nm, ty) = printf " %s :: %s" nm ty in pre ++ with_comma (map f (inputs_of u)) ++ post -- Construct a default instance of the parameter structure. gen_defaults :: D.U -> [String] gen_defaults u = let (D.U n _ r _ is _ _ _) = u nm = D.rename_ugen (downcase_first_char n) pre = [ printf "%s :: %s" nm n , printf "%s = %s {" nm n] post = [ " }" ] opt = if needs_rate u then [printf " rate = S.%s," (show r)] else [] f i = printf " %s = %f" (D.input_name i) (D.input_default i) in pre ++ opt ++ with_comma (map f is) ++ post -- Generate a list of variable names (a,b..) var_names :: Int -> [String] var_names n = map (: "'") (take n ['a'..]) -- Generate the constructor for the unit generator. gen_cons :: D.U -> [String] gen_cons u = let (D.U n _ _ _ is _ o _) = u xs = var_names (length is) nr = needs_rate u l_opt = if nr then "r" else "" r_opt = if nr then "r" else printf "S.%s" (show (fixed_rate u)) o' = case o of Left x -> show x Right _ -> "undefined" in [ printf "mk%s :: %s -> S.UGen" n n , printf "mk%s (%s %s %s) = S.mkOsc %s \"%s\" [%s] %s" n n l_opt (concat (with_space xs)) r_opt n (concat (with_comma xs)) o'] -- Generate instance of the Make class. gen_make :: D.U -> [String] gen_make u = let n = D.ugen_name u in [ printf "instance Make %s where" n , printf " ugen = mk%s" n ] -- Path to write files to. sc3_ugen_dir :: FilePath sc3_ugen_dir = "Sound" "SC3" "UGen" -- Write module for a unit generator. write_module :: D.U -> IO () write_module u = let n = D.ugen_name u m = [ printf "-- | %s" (D.ugen_summary u) , printf "module Sound.SC3.UGen.Record.%s where" n , "import qualified Sound.SC3.UGen as S" , "import Sound.SC3.UGen.Record" ] p = gen_param u d = gen_defaults u c = gen_cons u i = gen_make u fn = sc3_ugen_dir "Record" n <.> ".hs" in writeFile fn (unlines (m ++ p ++ d ++ c ++ i)) main :: IO () main = do let us = filter (not . null . D.ugen_inputs) D.ugenDB mapM_ write_module us {- gen_module_clause :: [D.U] -> [String] gen_module_clause us = let f u = printf " module Sound.SC3.UGen.Record.%s" (D.ugen_name u) pre = ["{-# LANGUAGE DisambiguateRecordFields #-}" ,"module Sound.SC3.UGen.Record.All ("] post = [" ) where"] in pre ++ with_comma (map f us) ++ post gen_imports :: [D.U] -> [String] gen_imports = let f u = printf "import Sound.SC3.UGen.Record.%s" (D.ugen_name u) in map f write_records :: [D.U] -> IO () write_records us = let s = unlines (gen_module_clause us ++ gen_imports us) in writeFile (sc3_ugen_dir "Record" "All" <.> "hs") s -}