commit 074b2fe386ae8461df9925b1f97925d3ad242a28 Author: loooph Date: Wed Feb 22 00:27:22 2023 +0100 initial commit diff --git a/dfs.tidal b/dfs.tidal new file mode 100644 index 0000000..f8ea6f9 --- /dev/null +++ b/dfs.tidal @@ -0,0 +1,90 @@ +import Data.Graph + +import Data.Graph.Inductive.Basic + +import Data.Array + +import qualified Data.Array as A + +import Data.Tuple as T + +import Data.List + +tabulate :: Bounds -> [Vertex] -> Table Int +tabulate bnds vs = A.array bnds (zip vs [1..]) +-- +tabOrd :: Graph -> ([Tree Vertex] -> [Vertex]) -> Table Int +tabOrd g ord = tabulate (bounds g) $ ord $ dff g +-- +tree :: Graph -> [Edge] +tree g = (concat (map flat ts)) + where + ts = dff g + flat (Node v ts) = [ (v,w) | Node w us <- ts] ++ concat (map flat ts) +-- +treeG :: Graph -> [Edge] +treeG = tree +-- +back :: Graph -> Table Int -> [Edge] +back g post = filter f $ edges g + where f (v,w) = post ! v < post ! w +-- +backG :: Graph -> [Edge] +backG g = back g $ tabOrd g postorderF +-- +cross :: Graph -> Table Int -> Table Int -> [Edge] +cross g pre post = filter f $ edges g + where f (v,w) = post ! v > post ! w && pre ! v > pre ! w +-- +crossG :: Graph -> [Edge] +crossG g = cross g (tabOrd g preorderF) (tabOrd g postorderF) +-- +forward :: Graph -> Table Int -> [Edge] +forward g pre = (filter f $ edges g) \\ tree g + where f (v,w) = pre ! v < pre ! w +-- +forwardG :: Graph -> [Edge] +forwardG g = forward g $ tabOrd g preorderF +-- +-- basically only used for Edge -> Pattern Int as input for scale +pairfastcat :: (a, a) -> Pattern a +pairfastcat = (\(u,v) -> fastcat $ pure <$> [u,v]) +-- +nodeEdgePairs :: Graph -> [(Vertex,[Edge])] +nodeEdgePairs g = map (\u -> (u,[(u,v)| v <- g ! u])) $ preorderF $ dff g +-- +instrument :: Graph -> Edge -> [Char] +instrument g e + | p treeG = "clubkick" + | p forwardG = "superpwm" + | p backG = "casio" + | p crossG = "amencutup" + where p f = e `elem` (f g) + +-- TODO Tiefe +-- TODO Wurzel betonen + +g1 = buildG (0,6) [(1,5),(1,2),(1,3),(2,4),(3,5),(4,2),(4,3),(5,1),(5,2),(5,6),(6,0),(0,6)] + +g2 = buildG (0,6) $ id <$> [(0,1),(1,2),(2,3),(3,4),(4,5),(5,6),(2,1)] + +preorderF $ dff g2 + +-- numbers ist nur für debug +let edgePattern g e = (scale "major" $ pure $ snd e) # (s $ pure $ instrument g e) + # gain 1 + vertexPattern g v = (n $ pure $ toEnum v) # s "numbers" + # end 0.4 + # gain 0.9 + p g = (\(x,y) -> fastcat [vertexPattern g x, fastcat $ (edgePattern g) <$> y]) <$> (fromList $ nodeEdgePairs g) + p' = p g2 +in d1 $ fast 2 + -- $ ghost + $ innerJoin p' + # size 0.8 + # room 0.7 + # lpf (randcat [1000, 1500, 2000]) + # pan (randcat [-0.5,-0.3,-0.1,0,0.1,0.3,0.5]) + +hush +