PP.hs

module Sound.SC3.UGen.DB.PP where

import qualified Data.Char as C {- base -}
import Data.Maybe {- base -}

import Sound.SC3.UGen.MCE {- hsc3 -}
import Sound.SC3.UGen.PP {- hsc3 -}
import Sound.SC3.UGen.Type {- hsc3 -}
import Sound.SC3.UGen.UGen {- hsc3 -}

import Sound.SC3.UGen.DB.Meta {- hsc3-db -}

-- | Print FORTH (reverse polish) notation for graph, see hsc3-forth
-- for details.  The flag controls printing of 'UId' entries.
-- This should, but does not, print the MCE instruction for primitives
-- that halt mce expansion, ie. ENVGEN and so on.
ugen_graph_forth_pp :: Bool -> UGen -> String
ugen_graph_forth_pp print_uid u =
    let recur = ugen_graph_forth_pp print_uid
        prim_pp (Primitive rt nm i _ sp k) =
            let rt' = if meta_is_operator nm || meta_is_filter nm
                      then ""
                      else ('.' : map C.toLower (show rt))
                nm' = concat [ugen_user_name nm sp,rt']
                k' = case k of
                       NoId -> Nothing
                       UId uid -> if print_uid then Just (show uid ++ " uid") else Nothing
            in unwords (map recur i ++ catMaybes [k',Just nm'])
    in case u of
         Constant_U (Constant n) -> real_pp n
         Label_U (Label s) -> concat ["s\" ",show s,"\""]
         Primitive_U p -> prim_pp p
         Proxy_U (Proxy p n) -> prim_pp p ++ "@" ++ show n
         MCE_U (MCE_Unit u') -> recur u'
         MCE_U (MCE_Vector v) ->
             if mce_is_direct_proxy (MCE_Vector v)
             then prim_pp (proxySource (fromJust (un_proxy (head v))))
             else unwords (map recur v ++ [show (length v),"mce"])
         MRG_U (MRG l r) -> unwords [recur l,recur r,"2","mrg"]
         _ -> show u