import Data.Char import Sound.SC3.UGen.Rate import qualified Sound.SC3.UGen.DB.Data as D import System.FilePath import Text.Printf -- Rename parameters that conflict with keywords or prelude functions, -- or which have otherwise unwieldy names. rename_input :: String -> String rename_input "in" = "input" rename_input "channelsArray" = "input" rename_input "exp" = "exp_" rename_input "id" = "id_" rename_input "length" = "length_" rename_input "init" = "init_" rename_input "floor" = "floor_" rename_input "div" = "div_" rename_input "max" = "max_" rename_input "min" = "min_" rename_input "spring" = "spring_" rename_input "rate" = "rate_" rename_input "default" = "default_" rename_input s = s -- Rename unit generators that conflict with keywords or prelude -- functions. rename_ugen :: String -> String rename_ugen "in" = "in'" rename_ugen s = s input_name :: D.I -> String input_name = rename_input . D.input_name -- 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 (D.U _ [r] _ _ _) = r fixed_rate (D.U _ [] r _ _) = r fixed_rate _ = 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 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 (x:y:xs) = (x ++ [c]) : with_char c (y:xs) with_char _ xs = xs with_comma :: [String] -> [String] with_comma = with_char ',' with_space :: [String] -> [String] with_space = with_char ' ' downcase_first_char :: String -> String downcase_first_char [] = [] downcase_first_char (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@(D.U n _ r is _) = let nm = 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" (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 (\x -> x : "'") (take n ['a'..]) -- Generate the constructor for the unit generator. gen_cons :: D.U -> [String] gen_cons u@(D.U n _ _ is o) = let 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)) in [ printf "mk%s :: %s -> S.UGen" n n , printf "mk%s (%s %s %s) = S.mkOsc %s \"%s\" [%s] %d" 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 "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 (\u -> not (null (D.ugen_inputs u))) 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 -}