initial commit

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
+