Compare commits
No commits in common. "ede9644f715ece1059c6d1b4ab24382ba8ca1bcd" and "00fe7a2393d7489d3e518a5b2cc729ece12e85cd" have entirely different histories.
ede9644f71
...
00fe7a2393
90
dfs.tidal
90
dfs.tidal
|
|
@ -1,90 +0,0 @@
|
||||||
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
|
|
||||||
|
|
||||||
Loading…
Reference in New Issue