This week only. Pastebin PRO Accounts Christmas Special! Don't miss out!Want more features on Pastebin? Sign Up, it's FREE!

Church Bells

By: Matthen on Oct 20th, 2012  |  syntax: None  |  size: 1.51 KB  |  views: 84  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. VisualiseSequence[l_, highlight_: False] := Graphics[{
  2.     If[highlight, {Yellow, Disk[{0, 0}, 1.4]}, {}],
  3.     Circle[],
  4.     Table[{p = {Sin[ Pi (i - 1)/2], Cos[Pi ( i - 1) /2]};
  5.       Lighter@({Red, Orange, Green, Blue}[[l[[i]]]]), Disk[p, 0.3],
  6.       Black, Text[Style[l[[i]], Medium], p]
  7.       }, {i, 4}]
  8.     }];
  9. ValidTransition[p1_, p2_] := (p1 != p2) &&
  10.    Not@(Or @@
  11.       Map[# > 1 &,
  12.        Abs[Flatten@Table[Position[p1, n], {n, p2}] -
  13.          Range@Length@p1]]);
  14. Vertices = Permutations[Range[4]];
  15. AllEdges = Tuples[Vertices, 2];
  16. Edges = DeleteDuplicates[
  17.    Map[#[[1]] -> #[[2]] &,
  18.     Select[AllEdges,
  19.      ValidTransition[#[[1]], #[[2]]] &]], (#1 == #2 ||
  20.       Reverse@#1 == #2) &];
  21. Needs["GraphUtilities`"];
  22. path = First[HamiltonianCycles[Edges]];
  23. pathedges = Transpose[{path, RotateRight[path]}];
  24. SongVis[n_] :=
  25.  
  26.   GraphPlot[Edges,
  27.    VertexRenderingFunction -> (Inset[
  28.        VisualiseSequence[#2, #2 == path[[n]]], #1, {0, 0}, 0.6] &),
  29.    
  30.    EdgeRenderingFunction -> (If[
  31.        MemberQ[pathedges, #2] ||
  32.         MemberQ[pathedges, Reverse[#2]], {Red, Thickness[.01],
  33.         Line[#1]}, {Black, Line[#1]}] &)
  34.    ];
  35. Manipulate[SongVis[n], {n, 1, 24, 1}]
  36.  
  37.  
  38. (* and play it*)
  39. startTs =
  40.   Accumulate[
  41.    Table[0.3 + RandomReal[NormalDistribution[0, 0.1]], {i, 96}]];
  42. Bell[n_, m_] := Module[{note = {"C", "D", "F", "G"}[[n]]},
  43.    SoundNote[{note}, {startTs[[m]], startTs[[m]] + 1},
  44.     "TubularBells"]
  45.    ];
  46. Sound[Map[Bell @@ # &, Transpose[{Flatten[path], Range[96]}], {1}]]
clone this paste RAW Paste Data