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 -- 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,D.U) -> [String] gen_param (u,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,D.U) -> [String] gen_defaults (u,u') = let (D.U nm _ r _ _ _ _ _) = u (D.U nm' _ _ _ is' _ _ _) = u' pre = [ printf "%s :: %s" nm' nm , printf "%s = %s {" nm' nm] 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 u' = D.u_rename u 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,u') d = gen_defaults (u,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 -}