HSoM (empty) → 1.0.0

raw patch · 63 files changed

+3545/−0 lines, 63 filesdep +Euterpeadep +HCodecsdep +UISFbuild-type:Customsetup-changedbinary-added

Dependencies added: Euterpea, HCodecs, UISF, array, arrows, base, containers, deepseq, ghc-prim, markov-chain, pure-fft, random

Files

• .git/COMMIT_EDITMSG +1/−0
• .git/FETCH_HEAD +1/−0
• .git/HEAD +1/−0
• .git/ORIG_HEAD +1/−0
• .git/config +13/−0
• .git/description +1/−0
• .git/hooks/applypatch-msg.sample +15/−0
• .git/hooks/commit-msg.sample +24/−0
• .git/hooks/post-update.sample +8/−0
• .git/hooks/pre-applypatch.sample +14/−0
• .git/hooks/pre-commit.sample +49/−0
• .git/hooks/pre-push.sample +53/−0
• .git/hooks/pre-rebase.sample +169/−0
• .git/hooks/pre-receive.sample +24/−0
• .git/hooks/prepare-commit-msg.sample +36/−0
• .git/hooks/update.sample +128/−0
• .git/index binary
• .git/info/exclude +6/−0
• .git/logs/HEAD +3/−0
• .git/logs/refs/heads/master +3/−0
• .git/logs/refs/remotes/origin/HEAD +1/−0
• .git/logs/refs/remotes/origin/master +2/−0
• .git/objects/30/75eb05964f6d0466d9429d301ef889e2ef4df6 binary
• .git/objects/44/ff8d50c43737d58946aa4413b947d87c8c35f3 +3/−0
• .git/objects/6f/9dfbd6d9e474c3fdf6267e8afa7405ceaad234 binary
• .git/objects/75/338cbac2a3e4a2cae32448ca729de421ecd404 binary
• .git/objects/a7/cb694607d57876250d17ddbbc9681935048195 binary
• .git/objects/c9/1c7ef73b14ee6c485fa2f09995ff5b3df7c7fd binary
• .git/objects/ee/f56e1b438c2e3f31255486c035c644553703b0 binary
• .git/objects/pack/pack-657e976d66993f23ab15b29cb1903b83553a3dda.idx binary
• .git/objects/pack/pack-657e976d66993f23ab15b29cb1903b83553a3dda.pack too large to diff
• .git/packed-refs +2/−0
• .git/refs/heads/master +1/−0
• .git/refs/remotes/origin/HEAD +1/−0
• .git/refs/remotes/origin/master +1/−0
• HSoM.cabal +56/−0
• HSoM.lhs +12/−0
• HSoM/Examples/AMandFM.lhs +51/−0
• HSoM/Examples/Additive.lhs +234/−0
• HSoM/Examples/EnableGUI.hs +40/−0
• HSoM/Examples/EuterpeaExamples.lhs +179/−0
• HSoM/Examples/FFT.lhs +60/−0
• HSoM/Examples/Interlude.lhs +67/−0
• HSoM/Examples/IntervalTrainer.lhs +199/−0
• HSoM/Examples/LSystems.lhs +139/−0
• HSoM/Examples/MUIExamples1.lhs +90/−0
• HSoM/Examples/MUIExamples2.lhs +178/−0
• HSoM/Examples/MoreMusic.lhs +103/−0
• HSoM/Examples/MusicToSignal.lhs +111/−0
• HSoM/Examples/NewResolutions.lhs +227/−0
• HSoM/Examples/PhysicalModeling.lhs +58/−0
• HSoM/Examples/RandomMusic.lhs +119/−0
• HSoM/Examples/SSF.lhs +22/−0
• HSoM/Examples/SelfSimilar.lhs +77/−0
• HSoM/Examples/SoundCheck.lhs +49/−0
• HSoM/Examples/SpectrumAnalysis.lhs +57/−0
• HSoM/MUI.hs +68/−0
• HSoM/MUI/MidiWidgets.lhs +378/−0
• HSoM/Performance.lhs +201/−0
• License +20/−0
• Setup.hs +51/−0
• System/Random/Distributions.hs +135/−0
• readme.txt +3/−0

@@ -0,0 +1,1 @@+Requires Euterpea 2.0.3

@@ -0,0 +1,1 @@+75338cbac2a3e4a2cae32448ca729de421ecd404		branch 'master' of https://github.com/Euterpea/HSoM

@@ -0,0 +1,1 @@+ref: refs/heads/master

@@ -0,0 +1,1 @@+b0227d9f423638807feb76dc0b2d0769072b6281

@@ -0,0 +1,13 @@+[core]+	repositoryformatversion = 0+	filemode = false+	bare = false+	logallrefupdates = true+	symlinks = false+	ignorecase = true+[remote "origin"]+	url = https://github.com/Euterpea/HSoM.git+	fetch = +refs/heads/*:refs/remotes/origin/*+[branch "master"]+	remote = origin+	merge = refs/heads/master

@@ -0,0 +1,1 @@+Unnamed repository; edit this file 'description' to name the repository.

@@ -0,0 +1,15 @@+#!/bin/sh+#+# An example hook script to check the commit log message taken by+# applypatch from an e-mail message.+#+# The hook should exit with non-zero status after issuing an+# appropriate message if it wants to stop the commit.  The hook is+# allowed to edit the commit message file.+#+# To enable this hook, rename this file to "applypatch-msg".++. git-sh-setup+commitmsg="$(git rev-parse --git-path hooks/commit-msg)"+test -x "$commitmsg" && exec "$commitmsg" ${1+"$@"}+:

@@ -0,0 +1,24 @@+#!/bin/sh+#+# An example hook script to check the commit log message.+# Called by "git commit" with one argument, the name of the file+# that has the commit message.  The hook should exit with non-zero+# status after issuing an appropriate message if it wants to stop the+# commit.  The hook is allowed to edit the commit message file.+#+# To enable this hook, rename this file to "commit-msg".++# Uncomment the below to add a Signed-off-by line to the message.+# Doing this in a hook is a bad idea in general, but the prepare-commit-msg+# hook is more suited to it.+#+# SOB=$(git var GIT_AUTHOR_IDENT | sed -n 's/^\(.*>\).*$/Signed-off-by: \1/p')+# grep -qs "^$SOB" "$1" || echo "$SOB" >> "$1"++# This example catches duplicate Signed-off-by lines.++test "" = "$(grep '^Signed-off-by: ' "$1" |+	 sort | uniq -c | sed -e '/^[ 	]*1[ 	]/d')" || {+	echo >&2 Duplicate Signed-off-by lines.+	exit 1+}

@@ -0,0 +1,8 @@+#!/bin/sh+#+# An example hook script to prepare a packed repository for use over+# dumb transports.+#+# To enable this hook, rename this file to "post-update".++exec git update-server-info

@@ -0,0 +1,14 @@+#!/bin/sh+#+# An example hook script to verify what is about to be committed+# by applypatch from an e-mail message.+#+# The hook should exit with non-zero status after issuing an+# appropriate message if it wants to stop the commit.+#+# To enable this hook, rename this file to "pre-applypatch".++. git-sh-setup+precommit="$(git rev-parse --git-path hooks/pre-commit)"+test -x "$precommit" && exec "$precommit" ${1+"$@"}+:

@@ -0,0 +1,49 @@+#!/bin/sh+#+# An example hook script to verify what is about to be committed.+# Called by "git commit" with no arguments.  The hook should+# exit with non-zero status after issuing an appropriate message if+# it wants to stop the commit.+#+# To enable this hook, rename this file to "pre-commit".++if git rev-parse --verify HEAD >/dev/null 2>&1+then+	against=HEAD+else+	# Initial commit: diff against an empty tree object+	against=4b825dc642cb6eb9a060e54bf8d69288fbee4904+fi++# If you want to allow non-ASCII filenames set this variable to true.+allownonascii=$(git config --bool hooks.allownonascii)++# Redirect output to stderr.+exec 1>&2++# Cross platform projects tend to avoid non-ASCII filenames; prevent+# them from being added to the repository. We exploit the fact that the+# printable range starts at the space character and ends with tilde.+if [ "$allownonascii" != "true" ] &&+	# Note that the use of brackets around a tr range is ok here, (it's+	# even required, for portability to Solaris 10's /usr/bin/tr), since+	# the square bracket bytes happen to fall in the designated range.+	test $(git diff --cached --name-only --diff-filter=A -z $against |+	  LC_ALL=C tr -d '[ -~]\0' | wc -c) != 0+then+	cat <<\EOF+Error: Attempt to add a non-ASCII file name.++This can cause problems if you want to work with people on other platforms.++To be portable it is advisable to rename the file.++If you know what you are doing you can disable this check using:++  git config hooks.allownonascii true+EOF+	exit 1+fi++# If there are whitespace errors, print the offending file names and fail.+exec git diff-index --check --cached $against --

@@ -0,0 +1,53 @@+#!/bin/sh++# An example hook script to verify what is about to be pushed.  Called by "git+# push" after it has checked the remote status, but before anything has been+# pushed.  If this script exits with a non-zero status nothing will be pushed.+#+# This hook is called with the following parameters:+#+# $1 -- Name of the remote to which the push is being done+# $2 -- URL to which the push is being done+#+# If pushing without using a named remote those arguments will be equal.+#+# Information about the commits which are being pushed is supplied as lines to+# the standard input in the form:+#+#   <local ref> <local sha1> <remote ref> <remote sha1>+#+# This sample shows how to prevent push of commits where the log message starts+# with "WIP" (work in progress).++remote="$1"+url="$2"++z40=0000000000000000000000000000000000000000++while read local_ref local_sha remote_ref remote_sha+do+	if [ "$local_sha" = $z40 ]+	then+		# Handle delete+		:+	else+		if [ "$remote_sha" = $z40 ]+		then+			# New branch, examine all commits+			range="$local_sha"+		else+			# Update to existing branch, examine new commits+			range="$remote_sha..$local_sha"+		fi++		# Check for WIP commit+		commit=`git rev-list -n 1 --grep '^WIP' "$range"`+		if [ -n "$commit" ]+		then+			echo >&2 "Found WIP commit in $local_ref, not pushing"+			exit 1+		fi+	fi+done++exit 0

@@ -0,0 +1,169 @@+#!/bin/sh+#+# Copyright (c) 2006, 2008 Junio C Hamano+#+# The "pre-rebase" hook is run just before "git rebase" starts doing+# its job, and can prevent the command from running by exiting with+# non-zero status.+#+# The hook is called with the following parameters:+#+# $1 -- the upstream the series was forked from.+# $2 -- the branch being rebased (or empty when rebasing the current branch).+#+# This sample shows how to prevent topic branches that are already+# merged to 'next' branch from getting rebased, because allowing it+# would result in rebasing already published history.++publish=next+basebranch="$1"+if test "$#" = 2+then+	topic="refs/heads/$2"+else+	topic=`git symbolic-ref HEAD` ||+	exit 0 ;# we do not interrupt rebasing detached HEAD+fi++case "$topic" in+refs/heads/??/*)+	;;+*)+	exit 0 ;# we do not interrupt others.+	;;+esac++# Now we are dealing with a topic branch being rebased+# on top of master.  Is it OK to rebase it?++# Does the topic really exist?+git show-ref -q "$topic" || {+	echo >&2 "No such branch $topic"+	exit 1+}++# Is topic fully merged to master?+not_in_master=`git rev-list --pretty=oneline ^master "$topic"`+if test -z "$not_in_master"+then+	echo >&2 "$topic is fully merged to master; better remove it."+	exit 1 ;# we could allow it, but there is no point.+fi++# Is topic ever merged to next?  If so you should not be rebasing it.+only_next_1=`git rev-list ^master "^$topic" ${publish} | sort`+only_next_2=`git rev-list ^master           ${publish} | sort`+if test "$only_next_1" = "$only_next_2"+then+	not_in_topic=`git rev-list "^$topic" master`+	if test -z "$not_in_topic"+	then+		echo >&2 "$topic is already up-to-date with master"+		exit 1 ;# we could allow it, but there is no point.+	else+		exit 0+	fi+else+	not_in_next=`git rev-list --pretty=oneline ^${publish} "$topic"`+	/usr/bin/perl -e '+		my $topic = $ARGV[0];+		my $msg = "* $topic has commits already merged to public branch:\n";+		my (%not_in_next) = map {+			/^([0-9a-f]+) /;+			($1 => 1);+		} split(/\n/, $ARGV[1]);+		for my $elem (map {+				/^([0-9a-f]+) (.*)$/;+				[$1 => $2];+			} split(/\n/, $ARGV[2])) {+			if (!exists $not_in_next{$elem->[0]}) {+				if ($msg) {+					print STDERR $msg;+					undef $msg;+				}+				print STDERR " $elem->[1]\n";+			}+		}+	' "$topic" "$not_in_next" "$not_in_master"+	exit 1+fi++exit 0++################################################################++This sample hook safeguards topic branches that have been+published from being rewound.++The workflow assumed here is:++ * Once a topic branch forks from "master", "master" is never+   merged into it again (either directly or indirectly).++ * Once a topic branch is fully cooked and merged into "master",+   it is deleted.  If you need to build on top of it to correct+   earlier mistakes, a new topic branch is created by forking at+   the tip of the "master".  This is not strictly necessary, but+   it makes it easier to keep your history simple.++ * Whenever you need to test or publish your changes to topic+   branches, merge them into "next" branch.++The script, being an example, hardcodes the publish branch name+to be "next", but it is trivial to make it configurable via+$GIT_DIR/config mechanism.++With this workflow, you would want to know:++(1) ... if a topic branch has ever been merged to "next".  Young+    topic branches can have stupid mistakes you would rather+    clean up before publishing, and things that have not been+    merged into other branches can be easily rebased without+    affecting other people.  But once it is published, you would+    not want to rewind it.++(2) ... if a topic branch has been fully merged to "master".+    Then you can delete it.  More importantly, you should not+    build on top of it -- other people may already want to+    change things related to the topic as patches against your+    "master", so if you need further changes, it is better to+    fork the topic (perhaps with the same name) afresh from the+    tip of "master".++Let's look at this example:++		   o---o---o---o---o---o---o---o---o---o "next"+		  /       /           /           /+		 /   a---a---b A     /           /+		/   /               /           /+	       /   /   c---c---c---c B         /+	      /   /   /             \         /+	     /   /   /   b---b C     \       /+	    /   /   /   /             \     /+    ---o---o---o---o---o---o---o---o---o---o---o "master"+++A, B and C are topic branches.++ * A has one fix since it was merged up to "next".++ * B has finished.  It has been fully merged up to "master" and "next",+   and is ready to be deleted.++ * C has not merged to "next" at all.++We would want to allow C to be rebased, refuse A, and encourage+B to be deleted.++To compute (1):++	git rev-list ^master ^topic next+	git rev-list ^master        next++	if these match, topic has not merged in next at all.++To compute (2):++	git rev-list master..topic++	if this is empty, it is fully merged to "master".

@@ -0,0 +1,24 @@+#!/bin/sh+#+# An example hook script to make use of push options.+# The example simply echoes all push options that start with 'echoback='+# and rejects all pushes when the "reject" push option is used.+#+# To enable this hook, rename this file to "pre-receive".++if test -n "$GIT_PUSH_OPTION_COUNT"+then+	i=0+	while test "$i" -lt "$GIT_PUSH_OPTION_COUNT"+	do+		eval "value=\$GIT_PUSH_OPTION_$i"+		case "$value" in+		echoback=*)+			echo "echo from the pre-receive-hook: ${value#*=}" >&2+			;;+		reject)+			exit 1+		esac+		i=$((i + 1))+	done+fi

@@ -0,0 +1,36 @@+#!/bin/sh+#+# An example hook script to prepare the commit log message.+# Called by "git commit" with the name of the file that has the+# commit message, followed by the description of the commit+# message's source.  The hook's purpose is to edit the commit+# message file.  If the hook fails with a non-zero status,+# the commit is aborted.+#+# To enable this hook, rename this file to "prepare-commit-msg".++# This hook includes three examples.  The first comments out the+# "Conflicts:" part of a merge commit.+#+# The second includes the output of "git diff --name-status -r"+# into the message, just before the "git status" output.  It is+# commented because it doesn't cope with --amend or with squashed+# commits.+#+# The third example adds a Signed-off-by line to the message, that can+# still be edited.  This is rarely a good idea.++case "$2,$3" in+  merge,)+    /usr/bin/perl -i.bak -ne 's/^/# /, s/^# #/#/ if /^Conflicts/ .. /#/; print' "$1" ;;++# ,|template,)+#   /usr/bin/perl -i.bak -pe '+#      print "\n" . `git diff --cached --name-status -r`+#	 if /^#/ && $first++ == 0' "$1" ;;++  *) ;;+esac++# SOB=$(git var GIT_AUTHOR_IDENT | sed -n 's/^\(.*>\).*$/Signed-off-by: \1/p')+# grep -qs "^$SOB" "$1" || echo "$SOB" >> "$1"

@@ -0,0 +1,128 @@+#!/bin/sh+#+# An example hook script to block unannotated tags from entering.+# Called by "git receive-pack" with arguments: refname sha1-old sha1-new+#+# To enable this hook, rename this file to "update".+#+# Config+# ------+# hooks.allowunannotated+#   This boolean sets whether unannotated tags will be allowed into the+#   repository.  By default they won't be.+# hooks.allowdeletetag+#   This boolean sets whether deleting tags will be allowed in the+#   repository.  By default they won't be.+# hooks.allowmodifytag+#   This boolean sets whether a tag may be modified after creation. By default+#   it won't be.+# hooks.allowdeletebranch+#   This boolean sets whether deleting branches will be allowed in the+#   repository.  By default they won't be.+# hooks.denycreatebranch+#   This boolean sets whether remotely creating branches will be denied+#   in the repository.  By default this is allowed.+#++# --- Command line+refname="$1"+oldrev="$2"+newrev="$3"++# --- Safety check+if [ -z "$GIT_DIR" ]; then+	echo "Don't run this script from the command line." >&2+	echo " (if you want, you could supply GIT_DIR then run" >&2+	echo "  $0 <ref> <oldrev> <newrev>)" >&2+	exit 1+fi++if [ -z "$refname" -o -z "$oldrev" -o -z "$newrev" ]; then+	echo "usage: $0 <ref> <oldrev> <newrev>" >&2+	exit 1+fi++# --- Config+allowunannotated=$(git config --bool hooks.allowunannotated)+allowdeletebranch=$(git config --bool hooks.allowdeletebranch)+denycreatebranch=$(git config --bool hooks.denycreatebranch)+allowdeletetag=$(git config --bool hooks.allowdeletetag)+allowmodifytag=$(git config --bool hooks.allowmodifytag)++# check for no description+projectdesc=$(sed -e '1q' "$GIT_DIR/description")+case "$projectdesc" in+"Unnamed repository"* | "")+	echo "*** Project description file hasn't been set" >&2+	exit 1+	;;+esac++# --- Check types+# if $newrev is 0000...0000, it's a commit to delete a ref.+zero="0000000000000000000000000000000000000000"+if [ "$newrev" = "$zero" ]; then+	newrev_type=delete+else+	newrev_type=$(git cat-file -t $newrev)+fi++case "$refname","$newrev_type" in+	refs/tags/*,commit)+		# un-annotated tag+		short_refname=${refname##refs/tags/}+		if [ "$allowunannotated" != "true" ]; then+			echo "*** The un-annotated tag, $short_refname, is not allowed in this repository" >&2+			echo "*** Use 'git tag [ -a | -s ]' for tags you want to propagate." >&2+			exit 1+		fi+		;;+	refs/tags/*,delete)+		# delete tag+		if [ "$allowdeletetag" != "true" ]; then+			echo "*** Deleting a tag is not allowed in this repository" >&2+			exit 1+		fi+		;;+	refs/tags/*,tag)+		# annotated tag+		if [ "$allowmodifytag" != "true" ] && git rev-parse $refname > /dev/null 2>&1+		then+			echo "*** Tag '$refname' already exists." >&2+			echo "*** Modifying a tag is not allowed in this repository." >&2+			exit 1+		fi+		;;+	refs/heads/*,commit)+		# branch+		if [ "$oldrev" = "$zero" -a "$denycreatebranch" = "true" ]; then+			echo "*** Creating a branch is not allowed in this repository" >&2+			exit 1+		fi+		;;+	refs/heads/*,delete)+		# delete branch+		if [ "$allowdeletebranch" != "true" ]; then+			echo "*** Deleting a branch is not allowed in this repository" >&2+			exit 1+		fi+		;;+	refs/remotes/*,commit)+		# tracking branch+		;;+	refs/remotes/*,delete)+		# delete tracking branch+		if [ "$allowdeletebranch" != "true" ]; then+			echo "*** Deleting a tracking branch is not allowed in this repository" >&2+			exit 1+		fi+		;;+	*)+		# Anything else (is there anything else?)+		echo "*** Update hook: unknown type of update to ref $refname of type $newrev_type" >&2+		exit 1+		;;+esac++# --- Finished+exit 0

binary file changed (absent → 2852 bytes)

@@ -0,0 +1,6 @@+# git ls-files --others --exclude-from=.git/info/exclude+# Lines that start with '#' are comments.+# For a project mostly in C, the following would be a good set of+# exclude patterns (uncomment them if you want to use them):+# *.[oa]+# *~

@@ -0,0 +1,3 @@+0000000000000000000000000000000000000000 b0227d9f423638807feb76dc0b2d0769072b6281 Donya Quick <donyaquick@gmail.com> 1495035283 -0700	clone: from https://github.com/Euterpea/HSoM.git+b0227d9f423638807feb76dc0b2d0769072b6281 44ff8d50c43737d58946aa4413b947d87c8c35f3 Donya Quick <donyaquick@gmail.com> 1496256585 -0500	pull --no-rebase --progress origin: Fast-forward+44ff8d50c43737d58946aa4413b947d87c8c35f3 75338cbac2a3e4a2cae32448ca729de421ecd404 Donya Quick <donyaquick@gmail.com> 1496257746 -0500	commit: Requires Euterpea 2.0.3

@@ -0,0 +1,3 @@+0000000000000000000000000000000000000000 b0227d9f423638807feb76dc0b2d0769072b6281 Donya Quick <donyaquick@gmail.com> 1495035283 -0700	clone: from https://github.com/Euterpea/HSoM.git+b0227d9f423638807feb76dc0b2d0769072b6281 44ff8d50c43737d58946aa4413b947d87c8c35f3 Donya Quick <donyaquick@gmail.com> 1496256585 -0500	pull --no-rebase --progress origin: Fast-forward+44ff8d50c43737d58946aa4413b947d87c8c35f3 75338cbac2a3e4a2cae32448ca729de421ecd404 Donya Quick <donyaquick@gmail.com> 1496257746 -0500	commit: Requires Euterpea 2.0.3

@@ -0,0 +1,1 @@+0000000000000000000000000000000000000000 b0227d9f423638807feb76dc0b2d0769072b6281 Donya Quick <donyaquick@gmail.com> 1495035283 -0700	clone: from https://github.com/Euterpea/HSoM.git

@@ -0,0 +1,2 @@+b0227d9f423638807feb76dc0b2d0769072b6281 44ff8d50c43737d58946aa4413b947d87c8c35f3 Donya Quick <donyaquick@gmail.com> 1496256217 -0500	fetch --progress --prune origin: fast-forward+44ff8d50c43737d58946aa4413b947d87c8c35f3 75338cbac2a3e4a2cae32448ca729de421ecd404 Donya Quick <donyaquick@gmail.com> 1496257750 -0500	update by push

binary file changed (absent → 814 bytes)

@@ -0,0 +1,3 @@+xŽK+Â0@]繀2™É$)ˆ¸ð"ùL°ÓÚ¦‚·WŠpõÞæÁËÓã1vÈ‡¾ˆh‘ÊNL²2+U2ÈlƒË@œµÌ䁨9.ÒºN€èËP-’£ÀWIޕ	x7€Çä0·~Ÿ]¦öŽú¼ãõ¼6ékŽ³œ¾rÑÆìh†ô@åý®Ë¿ÿuê&³´"-²êm.±KQÞ8FÖ

binary file changed (absent → 844 bytes)

binary file changed (absent → 172 bytes)

binary file changed (absent → 270 bytes)

binary file changed (absent → 145 bytes)

binary file changed (absent → 270 bytes)

binary file changed (absent → 5776 bytes)

file too large to diff

@@ -0,0 +1,2 @@+# pack-refs with: peeled fully-peeled +b0227d9f423638807feb76dc0b2d0769072b6281 refs/remotes/origin/master

@@ -0,0 +1,1 @@+75338cbac2a3e4a2cae32448ca729de421ecd404

@@ -0,0 +1,1 @@+ref: refs/remotes/origin/master

@@ -0,0 +1,1 @@+75338cbac2a3e4a2cae32448ca729de421ecd404

@@ -0,0 +1,56 @@+name:           HSoM
+version:        1.0.0
+Cabal-Version:  >= 1.8
+license:        BSD3
+license-file:	License
+copyright:      Copyright (c) 2008-2015 Paul Hudak and Donya Quick
+category:       Sound
+stability:      experimental
+build-type:     Custom
+author:         Paul Hudak <paul.hudak@yale.edu>,
+				Donya Quick <donyaquick@gmail.com>,
+                Dan Winograd-Cort <daniel.winograd-cort@yale.edu>
+maintainer:     Donya Quick <donyaquick@gmail.com>
+bug-reports:    https://github.com/Euterpea/HSoM/issues
+homepage:       http://www.euterpea.com
+synopsis:       Library for computer music education
+description:
+        Supporting library for the Haskell School of Music textbook.
+extra-source-files:
+        ReadMe.txt
+
+Library
+  hs-source-dirs: .
+  ghc-options: -O2 -funbox-strict-fields -fexcess-precision
+  extensions: CPP
+  exposed-modules: 
+        System.Random.Distributions,
+        HSoM,
+        HSoM.Performance,
+        HSoM.MUI.MidiWidgets,
+        HSoM.MUI,
+        HSoM.Examples.FFT,
+        HSoM.Examples.MoreMusic,
+        HSoM.Examples.RandomMusic,
+        HSoM.Examples.SoundCheck,
+        HSoM.Examples.SelfSimilar,
+        HSoM.Examples.SSF,
+        HSoM.Examples.Interlude,
+        HSoM.Examples.EuterpeaExamples,
+        HSoM.Examples.MUIExamples1,
+        HSoM.Examples.MUIExamples2,
+        HSoM.Examples.IntervalTrainer,
+        HSoM.Examples.NewResolutions,
+        HSoM.Examples.MusicToSignal,
+        HSoM.Examples.SpectrumAnalysis,
+        HSoM.Examples.Additive,
+        HSoM.Examples.AMandFM,
+        HSoM.Examples.PhysicalModeling
+  other-modules:
+  build-depends:
+        base >= 3 && < 5, arrows >= 0.4, array, deepseq, random, 
+        HCodecs >= 0.2, Euterpea >= 2.0.3, 
+        containers, markov-chain, pure-fft, 
+        UISF >= 0.4
+  if (impl(ghc >= 6.10))
+    build-depends: base >= 4 && < 5, ghc-prim

@@ -0,0 +1,12 @@+> {-# OPTIONS -XFlexibleInstances #-}
+> {-# OPTIONS -XTypeSynonymInstances #-}
+
+> module HSoM (
+>     module HSoM.MUI,
+>     module HSoM.Performance
+>     ) where
+> import Euterpea
+> import HSoM.MUI
+> import HSoM.Performance
+
+

@@ -0,0 +1,51 @@+> {-#  LANGUAGE Arrows  #-}
+
+> module HSoM.Examples.AMandFM where
+> import Euterpea
+> import FRP.UISF.AuxFunctions
+
+> tab1 = tableSinesN 4096 [1]
+
+> tremolo ::   Clock c =>
+>              Double -> Double -> SigFun c () Double
+> tremolo tfrq dep = proc () -> do
+>      trem  <- osc tab1 0 -< tfrq
+>      outA  -< 1 + dep*trem
+
+> amfmInst  :: Instr (Mono AudRate)
+>        -- Dur -> AbsPitch -> Volume -> AudSF () Double
+> amfmInst dur ap vol ps = 
+>   let  f    = apToHz ap
+>        v    = fromIntegral vol / 100
+>        d    = fromRational dur
+>        (tremAmt, tremFreq, vibAmt, vibFreq) =  
+>            if length ps < 4 then (0, 1, 0, 1)
+>            else (ps !! 0, ps !! 1, ps !! 2, ps !! 3)
+>   in proc () -> do
+>        asr <- envLineSeg [0,1,1,0] [d*0.01, d*0.98, d*0.01] -< ()
+>        vibSig <- osc tab1 0 -< vibFreq
+>        sineSig <- osc tab1 0 -< f + f*vibSig*vibAmt
+>        tremEnv <- tremolo tremFreq tremAmt -< ()
+>        outA -< (1-tremAmt) * asr * tremEnv * sineSig
+
+> iMap :: InstrMap (Mono AudRate)
+> iMap = [(CustomInstrument "AMFM", amfmInst)] 
+
+> mkAMFM :: FilePath -> [Double] -> IO ()
+> mkAMFM str p = writeWav str iMap $
+>     instrument (CustomInstrument "AMFM") $ 
+>     note 2 ((C,4::Octave), [Params p])
+
+> amfm1 =  mkAMFM "amfm1.wav" [] -- neither trem nor vib
+> amfm2 =  mkAMFM "amfm2.wav" [0.2,1.5,0.0,1.0] -- trem only
+> amfm3 =  mkAMFM "amfm3.wav" [0.0,1.0,0.02,4.0] -- vib only
+> amfm4 =  mkAMFM "amfm4.wav" [0.2,1.5,0.02,4.0] -- both
+
+Vibrato and tremolo into the audible frequency range:
+
+> amfm5 = mkAMFM "amfm5.wav" [0.2,50.0,0.0,1.0] -- trem only
+> amfm6 = mkAMFM "amfm6.wav" [0.0,1.0,0.05,100.0] -- vib only
+> amfm7 = mkAMFM "amfm7.wav" [0.2,50.0,0.05,100.0] -- both
+
+> writeAll = sequence [amfm1, amfm2, amfm3, amfm4, amfm5, amfm6, amfm7]
+

@@ -0,0 +1,234 @@+> {-#  LANGUAGE Arrows  #-}
+
+> module HSoM.Examples.Additive where
+> import Euterpea
+> import FRP.UISF.AuxFunctions
+
+
+> tab1 = tableSinesN 4096 [1]
+
+> bell1  :: Instr (Mono AudRate)
+>        -- Dur -> AbsPitch -> Volume -> AudSF () Double
+> bell1 dur ap vol [] = 
+>   let  f    = apToHz ap
+>        v    = fromIntegral vol / 100
+>        d    = fromRational dur
+>        sfs  = map  (\p-> constA (f*p) >>> osc tab1 0) 
+>                    [4.07, 3.76, 3, 2.74, 2, 1.71, 1.19, 0.92, 0.56]
+>   in proc () -> do
+>        aenv  <- envExponSeg [0,1,0.001] [0.003,d-0.003] -< ()
+>        a1    <- foldSF (+) 0 sfs -< ()
+>        outA -< a1*aenv*v/9
+
+
+> tab1' = tableSines3N 4096 [(4.07,1,0), (3.76,1,0), (3,1,0),
+>   (2.74,1,0), (2,1,0), (1.71,1,0), (1.19,1,0), (0.92,1,0), (0.56,1,0)]
+
+> bell'1  :: Instr (Mono AudRate)
+> bell'1 dur ap vol [] = 
+>   let  f    = apToHz ap
+>        v    = fromIntegral vol / 100
+>        d    = fromRational dur
+>   in proc () -> do
+>        aenv  <- envExponSeg [0,1,0.001] [0.003,d-0.003] -< ()
+>        a1    <- osc tab1' 0 -< f
+>        outA -< a1*aenv*v
+
+> bellTest1 = outFile "bell1.wav" 6 (bell1 6 (absPitch (C,5)) 100 []) 
+
+
+> mySF f d p = proc () -> do
+>                s     <- osc tab1 0 <<< constA (f*p) -< ()
+>                aenv  <- envExponSeg [0,1,0.001] [0.003,d/p-0.003] -< ()
+>                outA  -< s*aenv
+
+> bell2  :: Instr (Mono AudRate)
+>        -- Dur -> AbsPitch -> Volume -> AudSF () Double
+> bell2 dur ap vol [] = 
+>   let  f    = apToHz ap
+>        v    = fromIntegral vol / 100
+>        d    = fromRational dur
+>        sfs  = map  (mySF f d)
+>                    [4.07, 3.76, 3, 2.74, 2, 1.71, 1.19, 0.92, 0.56]
+>   in proc () -> do
+>        a1    <- foldSF (+) 0 sfs -< ()
+>        outA  -< a1*v/9
+
+> bellTest1' = outFile "bell'1.wav" 6 (bell'1 6 (absPitch (C,5)) 100 [])
+
+> bellTest2 = outFile "bell2.wav" 6 (bell2 6 (absPitch (C,5)) 100 []) 
+
+
+> sineTable :: Table
+> sineTable = tableSinesN 4096 [1]
+
+> env1 :: AudSF () Double
+> env1 = envExpon 20 10 10000
+
+> good = outFile "good.wav" 10 
+>        (osc sineTable 0 <<< envExpon 20 10 10000 :: AudSF () Double)
+
+> bad  = outFile "bad.wav" 10 
+>        (osc sineTable 0 <<< envLine  20 10 10000 :: AudSF () Double)
+
+> sfTest1 :: AudSF (Double,Double) Double -> Instr (Mono AudRate)
+>         -- AudSF (Double,Double) Double -> 
+>         -- Dur -> AbsPitch -> Volume -> [Double] -> AudSF () Double
+> sfTest1 sf dur ap vol [] =
+>   let f = apToHz ap
+>       v = fromIntegral vol / 100
+>   in proc () -> do
+>        a1 <- osc sineTable 0 <<< env1 -< () 
+>        a2 <- sf -< (a1,f)
+>        outA -< a2*v
+
+
+> tLow    =  outFile "low.wav" 10 $
+>            sfTest1 filterLowPass 10 (absPitch (C,5)) 80 []
+
+> tHi     =  outFile "hi.wav" 10 $
+>            sfTest1 filterHighPass 10 (absPitch (C,5)) 80 []
+
+> tLowBW  =  outFile "lowBW.wav" 10 $
+>            sfTest1 filterLowPassBW 10 (absPitch (C,5)) 80 []
+
+> tHiBW   =  outFile "hiBW.wav" 10 $
+>            sfTest1 filterHighPassBW 10 (absPitch (C,5)) 80 []
+
+> addBandWidth ::  AudSF (Double,Double,Double) Double ->
+>                  AudSF (Double,Double) Double
+
+> addBandWidth filter =
+>   proc (a,f) -> do filter -< (a,f,200)
+
+> tBP    =  outFile "bp.wav" 10 $
+>           sfTest1 (addBandWidth (filterBandPass 1)) 10 (absPitch (C,6)) 80 []
+
+> tBS    =  outFile "bs.wav" 10 $
+>           sfTest1 (addBandWidth (filterBandStop 1)) 10 (absPitch (C,6)) 80 []
+
+> tBPBW  =  outFile "bpBW.wav" 10 $
+>           sfTest1 (addBandWidth filterBandPassBW) 10 (absPitch (C,6)) 80 []
+
+> tBSBW  =  outFile "bsBW.wav" 10 $
+>           sfTest1 (addBandWidth filterBandStopBW) 10 (absPitch (C,6)) 80 []
+
+
+> noise1  :: Instr (Mono AudRate)
+>         -- Dur -> AbsPitch -> Volume -> [Double] -> AudSF () Double
+> noise1 dur ap vol [] = 
+>   let  v = fromIntegral vol / 100
+>   in proc () -> do
+>        a1    <- noiseWhite 42 -< ()
+>        outA  -< a1*v
+> test1 = outFile "noise1.wav" 6 (noise1 6 (absPitch (C,5)) 100 []) 
+
+
+> env2 :: AudSF () Double
+> env2 = envExpon 1 10 2000
+
+> sfTest2  :: AudSF (Double,Double,Double) Double -> Instr (Mono AudRate)
+>          -- AudSF (Double,Double,Double) Double -> 
+>          -- Dur -> AbsPitch -> Volume -> [Double] -> AudSF () Double
+> sfTest2 sf dur ap vol [] =
+>   let  f = apToHz ap
+>        v = fromIntegral vol / 100
+>   in proc () -> do
+>        a1 <- noiseWhite 42 -< ()
+>        bw <- env2 -< ()
+>        a2 <- sf -< (a1,f,bw)
+>        outA -< a2
+
+> tBP'    =  outFile "bp'.wav" 10 $
+>            sfTest2 (filterBandPass 1) 10 (absPitch (C,5)) 80 []
+
+> tBS'    =  outFile "bs'.wav" 10 $
+>            sfTest2 (filterBandStop 1) 10 (absPitch (C,5)) 80 []
+
+> tBPBW'  =  outFile "bpBW'.wav" 10 $
+>            sfTest2 filterBandPassBW 10 (absPitch (C,5)) 80 []
+
+> tBSBW'  =  outFile "bsBW'.wav" 10 $
+>            sfTest2 filterBandStopBW 10 (absPitch (C,5)) 80 []
+
+
+> noise2  :: Instr (Mono AudRate)
+> noise2 dur ap vol [] = 
+>   let  f = apToHz ap
+>        v = fromIntegral vol / 100
+>   in proc () -> do
+>        a1    <- noiseBLI 42 -< f
+>        outA  -< a1*v
+
+> test2 = outFile "noise2.wav" 6 (noise2 6 (absPitch (C,5)) 100 []) 
+
+
+> ss1  :: Instr (Mono AudRate)
+> ss1 dur ap vol [] = 
+>   let  v    = fromIntegral vol / 100
+>   in proc () -> do
+>        a1    <- noiseWhite 42 -< ()
+>        a2    <- filterBandPass 2 -< (a1, 1000, 200)
+>        outA  -< a2*v/5
+
+> test3 = outFile "ss1.wav" 6 (ss1 6 (absPitch (C,5)) 100 []) 
+
+
+> wind :: Instr (Mono AudRate)
+> wind dur ap vol [] = 
+>   let  f = apToHz ap
+>        v = fromIntegral vol / 100
+>   in proc () -> do
+>        a1    <- noiseWhite 42 -< ()
+>        lfo1  <- osc sineTable 0 -< 0.9
+>        lfo2  <- osc sineTable 0 -< 1.3
+>        a2    <- filterBandPass 2 -< (a1, f + 100*(lfo1+lfo2), 200)
+>        outA  -< a2*v/5
+
+> test4 = outFile "wind.wav" 6 (wind 6 (absPitch (C,7)) 100 []) 
+
+
+> buzzy  :: Instr (Mono AudRate)
+> buzzy dur ap vol [] = 
+>   let  f    = apToHz ap
+>        v    = fromIntegral vol / 100
+>   in proc () -> do
+>        a1 <- oscPartials sineTable 0 -< (f,20)
+>        outA -< a1*v
+
+> test5 = outFile "buzzy.wav" 6 (buzzy 6 (absPitch (C,5)) 100 []) 
+
+
+> buzzy2 :: Instr (Mono AudRate)
+> buzzy2 dur ap vol [] = 
+>   let  f    = apToHz ap
+>        v    = fromIntegral vol / 100
+>        d    = fromRational dur
+>   in proc () -> do
+>        a1   <- oscPartials sineTable 0 -< (f,20)
+>        env  <- envExponSeg [0, 1, 0.001] [0.003, d - 0.003] -< ()
+>        a2   <- filterLowPass -< (a1,20000*env)
+>        outA -< a2*v*env
+
+> test6 = outFile "buzzy2.wav" 6 (buzzy2 6 (absPitch (C,5)) 100 []) 
+
+> scifi1 :: Instr (Mono AudRate)
+> scifi1 dur ap vol [] = 
+>   let  v    = fromIntegral vol / 100
+>   in proc () -> do
+>        a1 <- noiseBLH 42 -< 8
+>        a2 <- osc sineTable 0 -< 600 + 200*a1
+>        outA -< a2*v
+
+> test7 = outFile "scifi1.wav" 10 (scifi1 10 (absPitch (C,5)) 100 []) 
+
+
+> scifi2 :: Instr (Mono AudRate)
+> scifi2 dur ap vol [] = 
+>   let  v    = fromIntegral vol / 100
+>   in proc () -> do
+>        a1 <- noiseBLI 44 -< 8
+>        a2 <- osc sineTable 0 -< 600 + 200*a1
+>        outA -< a2*v
+
+> test8 = outFile "scifi2.wav" 10 (scifi2 10 (absPitch (C,5)) 100 []) 

@@ -0,0 +1,40 @@+{-# LANGUAGE ForeignFunctionInterface #-}
+{--
+On Mac OS X, with versions of GHC prior to 7.8, you will have to use this
+``EnableGUI trick'' to run GUI programs for Euterpea from within ghci.
+
+To do so, first compile this file, EnableGUI.hs, to binary:
+    ghc -c -fffi EnableGUI.hs
+
+(Note: on some systems it is necessary to add the option
+``-framework ApplicationServices'')
+Then, run your Euterpea GUI programs in ghci like this:
+
+ghci UIExamples.hs EnableGUI
+*UIExamples> :m +EnableGUI
+*UIExamples EnableGUI> enableGUI >> main
+
+With this, GHCi will be able to fully activate the Graphics Window. (Fully
+compiled GUI programs do not suffer from this anomaly.)
+
+--}
+
+module EnableGUI(enableGUI) where
+
+import Data.Int
+import Foreign
+
+type ProcessSerialNumber = Int64
+
+foreign import ccall "GetCurrentProcess" getCurrentProcess :: Ptr ProcessSerialNumber -> IO Int16
+foreign import ccall "_CGSDefaultConnection" cgsDefaultConnection :: IO ()
+foreign import ccall "CPSEnableForegroundOperation" cpsEnableForegroundOperation :: Ptr ProcessSerialNumber -> IO ()
+foreign import ccall "CPSSignalAppReady" cpsSignalAppReady :: Ptr ProcessSerialNumber -> IO ()
+foreign import ccall "CPSSetFrontProcess" cpsSetFrontProcess :: Ptr ProcessSerialNumber -> IO ()
+
+enableGUI = alloca $ \psn -> do
+    getCurrentProcess psn
+    cgsDefaultConnection
+    cpsEnableForegroundOperation psn
+    cpsSignalAppReady psn
+    cpsSetFrontProcess psn

@@ -0,0 +1,179 @@+> module HSoM.Examples.EuterpeaExamples where
+> import Euterpea
+> import HSoM.Examples.MoreMusic
+> import HSoM.Examples.Interlude
+> import HSoM.Examples.SelfSimilar
+> import HSoM.Examples.SSF
+
+Simple examples of Euterpea in action.  Note that this module also
+imports modules Interlude and SelfSimilar.
+
+-----------------------------------------------------------------------------
+
+From the tutorial, try things such as pr12, cMajArp, cMajChd, etc. and
+try applying inversions, retrogrades, etc. on the same examples.  Also
+try "childSong6" imported from module Interlude.  For example:
+
+> t0 = play childSong6
+
+-----------------------------------------------------------------------------
+
+C Major scale for use in examples below:
+
+> cMajScale = Modify (Tempo 2)
+>             (line [c 4 en, d 4 en, e 4 en, f 4 en, 
+>                    g 4 en, a 4 en, b 4 en, c 5 en])
+>
+> cms' = line [c 4 en, d 4 en, e 4 en, f 4 en, 
+>              g 4 en, a 4 en, b 4 en, c 5 en]
+>
+> cms = cMajScale
+
+Test of various articulations and dynamics:
+
+> t1 = play (Modify (Instrument Percussion)
+>        (Modify (Phrase [Art (Staccato (1/10))]) cms :+:
+>         cms                             :+:
+>         Modify (Phrase [Art (Legato  (11/10))]) cms    ))
+>
+> temp = Modify (Instrument AcousticGrandPiano) 
+>          (Modify (Phrase [Dyn (Crescendo 4)]) (c 4 en))
+>
+> mu2 = Modify (Instrument Vibraphone)
+>        (Modify (Phrase [Dyn (Diminuendo (3/4))]) cms :+:
+>          (Modify (Phrase [Dyn (Crescendo 4), Dyn (Loudness 25)]) cms))
+> t2 = play mu2
+>
+> t3 = play (Modify (Instrument Flute) 
+>        (Modify (Phrase [Tmp (Accelerando 0.3)]) cms :+:
+>         Modify (Phrase [Tmp (Ritardando  0.6)]) cms    ))
+
+
+-----------------------------------------------------------------------------
+
+Example from the SelfSimilar module.
+
+> t10s   = play (rep (offset (dur ttm0)) (Modify (Transpose 4)) 2 ttm0)
+
+-----------------------------------------------------------------------------
+
+Example from the Interlude module.
+
+> cs6 = play childSong6
+
+-----------------------------------------------------------------------------
+
+Example from the Ssf (Stars and Stripes Forever) module.
+
+> ssf0 = play ssf
+
+-----------------------------------------------------------------------------
+
+Midi percussion test.  Plays all "notes" in a range.  (Requires adding
+an instrument for percussion to the UserPatchMap.)
+
+> drums a b = Modify (Instrument Percussion)
+>                   (line (map (\p-> Prim $ Note sn (pitch p)) [a..b]))
+> t11 a b = play (drums a b)
+
+-----------------------------------------------------------------------------
+
+Test of cut and shorten.
+
+> t12  = play (cut 4 childSong6)
+> t12a = play (cms /=: childSong6)
+
+-----------------------------------------------------------------------------
+
+Tests of the trill functions.
+
+> t13note = Prim (Note qn (C,5))
+> t13 =  play (trill   1 sn t13note)
+> t13a = play (trill'  2 dqn t13note)
+> t13b = play (trilln  1 5 t13note)
+> t13c = play (trilln' 3 7 t13note)
+> t13d = play (roll tn t13note)
+> t13e = play (Modify (Tempo (2/3)) 
+>               (Modify (Transpose 2) 
+>                 (Modify (Instrument AcousticGrandPiano) 
+>                   (trilln' 2 7 t13note))))
+
+-----------------------------------------------------------------------------
+
+Tests of drum.
+
+> t14 = play (Modify (Instrument Percussion) (perc AcousticSnare qn))
+
+> -- a "funk groove"
+> t14b = let p1 = perc LowTom        qn
+>            p2 = perc AcousticSnare en
+>        in play (Modify (Tempo 3) (Modify (Instrument Percussion) (cut 8 (forever
+>                  ((p1 :+: qnr :+: p2 :+: qnr :+: p2 :+:
+>                    p1 :+: p1 :+: qnr :+: p2 :+: enr)
+>                   :=: roll en (perc ClosedHiHat 2))))))
+
+> -- a "jazz groove"
+> t14c = let p1 = perc CrashCymbal2  qn
+>            p2 = perc AcousticSnare en
+>            p3 = perc LowTom        qn
+>        in play (Modify (Tempo 3) (Modify (Instrument Percussion) (cut 4 (forever
+>                  ((p1 :+: (Modify (Tempo (3/2)) (p2 :+: enr :+: p2))
+>                   :=: (p3 :+: qnr)) )))))
+
+> t14d = let p1 = perc LowTom        en
+>            p2 = perc AcousticSnare hn
+>        in play (Modify (Instrument Percussion)
+>                   (  roll tn p1
+>                  :+: p1
+>                  :+: p1
+>                  :+: Prim (Rest en)
+>                  :+: roll tn p1
+>                  :+: p1
+>                  :+: p1
+>                  :+: Prim (Rest qn)
+>                  :+: roll tn p2
+>                  :+: p1
+>                  :+: p1  ))
+
+-----------------------------------------------------------------------------
+
+Tests of the MIDI interface.
+
+> loadMidiFile fn = do
+>   r <- importFile fn 
+>   case r of
+>     Left err -> error err
+>     Right m  -> return m
+
+Music into a MIDI file.
+
+> tab m = writeMidi m
+
+Music to a Midi datatype and back to Music.
+
+> tad m = fromMidi $ toMidi $ perform m
+
+A MIDI file to a MidiFile datatype and back to a MIDI file.
+
+> tcb file = do
+>              x <- loadMidiFile file
+>              exportFile "test.mid" x
+
+MIDI file to MidiFile datatype.
+
+> tc file = do
+>             x <- loadMidiFile file
+>             print x
+
+MIDI file to Music, a UserPatchMap, and a Context.
+
+> tcd file = do
+>              x <- loadMidiFile file
+>              print $ fromMidi x
+
+A MIDI file to Music and back to a MIDI file.
+
+> tcdab file = do
+>              x <- loadMidiFile file
+>              exportFile "test.mid" $ toMidi $ perform $ fromMidi x
+

@@ -0,0 +1,60 @@+Filename: fft.hs
+Created by: Daniel Winograd-Cort
+Created on: unknown
+Last Modified by: Daniel Winograd-Cort
+Last Modified on: 16-Dec-2015 by Donya Quick
+
+This module requires the array and pure-fft packages.
+
+> {-# LANGUAGE Arrows #-}
+> module HSoM.Examples.FFT where
+> import FRP.UISF
+> import Control.Arrow.Operations
+> import Numeric.FFT (fft)
+> import Data.Complex
+> import Data.Map (Map)
+> import qualified Data.Map as Map
+
+
+
+Alternative for working with Math.FFT instead of Numeric.FFT
+import qualified Math.FFT as FFT
+import Data.Array.IArray
+import Data.Array.CArray
+myFFT n lst = elems $ (FFT.dft) (listArray (0, n-1) lst)
+
+
+--------------------------------------
+-- Fast Fourier Transform
+--------------------------------------
+
+Returns n samples of type b from the input stream at a time, 
+updating after k samples.  This function is good for chunking 
+data and is a critical component to fftA
+
+> quantize :: ArrowCircuit a => Int -> Int -> a b (SEvent [b])
+> quantize n k = proc d -> do
+>     rec (ds,c) <- delay ([],0) -< (take n (d:ds), c+1)
+>     returnA -< if c >= n && c `mod` k == 0 then Just ds else Nothing
+
+Converts the vector result of a dft into a map from frequency to magnitude.
+One common use is:
+fftA >>> arr (fmap $ presentFFT clockRate)
+
+> presentFFT :: Double -> [Double] -> Map Double Double
+> presentFFT clockRate a = Map.fromList $ zipWith (curry mkAssoc) [0..] a where 
+>     mkAssoc (i,c) = (freq, c) where
+>         samplesPerPeriod = fromIntegral (length a)
+>         freq = i * (clockRate / samplesPerPeriod)
+
+Given a quantization frequency (the number of samples between each 
+successive FFT calculation) and a fundamental period, this will decompose
+the input signal into its constituent frequencies.
+NOTE: The fundamental period must be a power of two!
+
+> fftA :: ArrowCircuit a => Int -> Int -> a Double (SEvent [Double])
+> fftA qf fp = proc d -> do
+>     carray <- quantize fp qf -< d :+ 0
+>     returnA -< fmap (map magnitude . take (fp `div` 2) . fft) carray
+
+

@@ -0,0 +1,67 @@+> module  HSoM.Examples.Interlude
+>         (  childSong6,  --  :: Music Pitch,
+>            prefix       --  :: [Music a] -> Music a)
+>         )  where
+> import Euterpea
+
+> addDur       :: Dur -> [Dur -> Music a] -> Music a
+> addDur d ns  =  let f n = n d
+>                 in line (map f ns)
+
+> graceNote :: Int -> Music Pitch -> Music Pitch
+> graceNote n  (Prim (Note d p))  =
+>           note (d/8) (trans n p) :+: note (7*d/8) p
+> graceNote n  _                  = 
+>           error "Can only add a grace note to a note."
+
+> b1  = addDur dqn [b 2,   fs 3,  g 3,   fs 3]
+> b2  = addDur dqn [b 2,   es 3,  fs 3,  es 3]
+> b3  = addDur dqn [as 2,  fs 3,  g 3,   fs 3]
+
+> bassLine =  times 3 b1 :+: times 2 b2 :+: 
+>             times 4 b3 :+: times 5 b1
+
+> mainVoice = times 3 v1 :+: v2
+
+> v1   = v1a :+: graceNote (-1) (d 4 qn) :+: v1b                 --  bars 1-2
+> v1a  = addDur en [a 4, e 4, d 4, fs 4, cs 4, b 3, e 4, b 3]
+> v1b  = addDur en [cs 4, b 3]
+
+> v2 = v2a :+: v2b :+: v2c :+: v2d :+: v2e :+: v2f :+: v2g
+
+> v2a  =  line [  cs 4 (dhn+dhn), d 4 dhn, 
+>                 f 4 hn, gs 4 qn, fs 4 (hn+en), g 4 en]     --  bars 7-11
+> v2b  =  addDur en [  fs 4, e 4, cs 4, as 3] :+: a 3 dqn :+:
+>         addDur en [  as 3, cs 4, fs 4, e 4, fs 4]          --  bars 12-13
+> v2c  =  line [  g 4 en, as 4 en, cs 5 (hn+en), d 5 en, cs 5 en] :+:
+>         e 4 en :+: enr :+: 
+>         line [  as 4 en, a 4 en, g 4 en, d 4 qn, c 4 en, cs 4 en] 
+>                                                            --  bars 14-16
+> v2d  =  addDur en [  fs 4, cs 4, e 4, cs 4, 
+>                      a 3, as 3, d 4, e 4, fs 4]            --  bars 17-18.5
+> v2e  =  line [  graceNote 2 (e 4 qn), d 4 en, graceNote 2 (d 4 qn), cs 4 en,
+>                 graceNote 1 (cs 4 qn), b 3 (en+hn), cs 4 en, b 3 en ]  
+>                                                            --  bars 18.5-20
+> v2f  =  line [  fs 4 en, a 4 en, b 4 (hn+qn), a 4 en, fs 4 en, e 4 qn,
+>                 d 4 en, fs 4 en, e 4 hn, d 4 hn, fs 4 qn]  --  bars 21-23
+> v2g  =  tempo (3/2) (line [cs 4 en, d 4 en, cs 4 en]) :+: 
+>         b 3 (3*dhn+hn)                                     --  bars 24-28
+
+> childSong6 :: Music Pitch
+> childSong6 =  let t = (dhn/qn)*(69/120)
+>               in instrument  RhodesPiano 
+>                              (tempo t (bassLine :=: mainVoice))
+
+> prefixes         :: [a] -> [[a]]
+> prefixes []      =  []
+> prefixes (x:xs)  =  let f pf = x:pf
+>                     in [x] : map f (prefixes xs)
+
+> prefix :: [Music a] -> Music a
+> prefix mel =  let  m1  = line (concat (prefixes mel))
+>                    m2  = transpose 12 (line (concat (prefixes (reverse mel))))
+>                    m   = instrument Flute m1 :=: instrument VoiceOohs m2
+>               in m :+: transpose 5 m :+: m
+
+> mel1 = [c 4 en, e 4 sn, g 4 en, b 4 sn, a 4 en, f 4 sn, d 4 en, b 3 sn, c 4 en]
+> mel2 = [c 4 sn, e 4 sn, g 4 sn, b 4 sn, a 4 sn, f 3 sn, d 4 sn, b 3 sn, c 4 sn]

@@ -0,0 +1,199 @@+> {-# LANGUAGE Arrows #-}
+
+> module HSoM.Examples.IntervalTrainer where
+> import HSoM
+> import Euterpea
+> import FRP.UISF
+> import System.Random (randomRIO)
+> import Codec.Midi (Message(ProgramChange))
+> import FRP.UISF.AuxFunctions (concatA, evMap)
+> import Data.Monoid
+
+
+> main = runMUI (defaultMUIParams {uiSize=(600,700), uiTitle="Interval Trainer"}) intervalTrainer
+
+> -- music theory name for intervals:
+> intNameList :: [String]
+> intNameList =
+>   ["uni","min2","Maj2","min3","Maj3","4th","aug4",
+>    "5th","min6","Maj6","min7","Maj7","oct"]
+
+States of the MUI's internal Finite State Machine:
+
+> data State = Start | Base | Guessed
+>   deriving (Eq,Ord,Show)
+
+State transition table:
+
+        | Next    | Repeat  | Giveup  | Guess   | Reset   |
+-----------------------------------------------------------
+Start   | Base    | Start   | Start   | Start   | Start   | 
+Base    | Base    | Base    | Guessed | Guessed | Start   |
+Guessed | Base    | Guessed | Guessed | Guessed | Start   |
+
+State variables:
+
+total:   number ofintervals generated
+correct: number guessed correctly
+repeats: number of repeat requests prior to making a guess
+answer:  a pair, the random root note and the random interval
+state:   the durrect FSA state (see above)
+
+State variable updates:
+
+Variable | Event : action
+------------------------------------------------------------------------
+total    | Next (Base) : incr, Guess (Base) : incr, Giveup (Base) : incr
+correct  | Guess (Base) /\ match : incr
+repeats  | Repeat (Base) : incr
+answer   | Next : generate and save new random root and interval
+state    | see State Transition Table
+
+Also, Reset forces total, correct, and repeats to 0, and answer to (0,0).
+
+The main UI:
+
+> intervalTrainer :: UISF () ()
+> intervalTrainer = proc _ -> do
+>     -- MIDI output select:
+>     mo <- setSize (600,90) $ selectOutput -< ()
+>     -- Play note:
+>     pns <- setSize (600,60) . title "Play notes" . leftRight $
+>             radio ["Together","Low then high","High then low"] 0 -< ()
+>     -- Note length:
+>     dur <- setSize (600,60) . title "Note length" . leftRight $ 
+>             radio ["Whole","Half","Quarter","Eighth"] 2 -< ()
+>     -- Max interval
+>     maxInt <- (| (setSize (600,60) . title "Maximum interval" . leftRight) (do
+>                 max <- shiSlider 1 (1,12) 12 -< ()
+>                 sDisplay -< intNameList !! max
+>                 returnA -< max )|)
+>     -- Range:
+>     range  <- (| (setSize (600,60) . title "Range in octaves" . leftRight) (do
+>                 range <- shiSlider 1 (2,10) 4 -< ()
+>                 sDisplay -< take 3 $ show $ fromIntegral range / 2
+>                 returnA -< range )|)
+>     -- Lowest octave:
+>     lowOct <- (| (setSize (600,60) . title "Lowest octave" . leftRight) (do
+>                 low <- shiSlider 1 (1,8) 4 -< ()
+>                 sDisplay -< show low
+>                 returnA -< low )|)
+>     -- Instrument:
+>     instr <- setSize (600,60) . title "Instrument" . leftRight $ 
+>               radio ["Acous Piano","Elec Piano","Violin","Saxophone","Flute"] 0 -< ()
+>     -- Control:
+>     (nextE,repeatE,giveUpE,resetE) <- (| (setSize (600,60) . title "Control" . leftRight) (do
+>         next   <- edge <<< button "Next"      -< ()
+>         repeat <- edge <<< button "Repeat"    -< ()
+>         giveUp <- edge <<< button "Give Up"   -< ()
+>         reset  <- edge <<< button "Reset"     -< ()
+>         returnA -< (next,repeat,giveUp,reset) )|)
+>     -- User Input:
+>     guesses <- (| (setSize (600,90) . title "Guess the interval") (do
+>         g1 <- leftRight $
+>                 concatA $ map (\s -> edge <<< button s) 
+>                            ["uni","min2","Maj2","min3","Maj3","4th","aug4"] -< repeat ()
+>         g2 <- leftRight $
+>                 concatA $ map (\s -> edge <<< button s)
+>                            ["5th","min6","Maj6","min7","Maj7","oct"] -< repeat ()
+>         returnA -< g1++g2) |)
+>     -- edge-detect pushbuttons:
+>     let guessesE = foldl1 (.|.) $ zipWith (->>) guesses intNameList
+>     rec -- the state
+>         state    <- delay Start <<< accum Start -< updates
+>         -- event filter based on MUI state
+>         let whileIn' :: SEvent a -> State -> SEvent a
+>             e `whileIn'` s = if s == state then e else Nothing
+>             updates  = (giveUpE `whileIn'` Base ->> const Guessed)         .|.
+>                        (nextE ->> const Base) .|. (resetE ->> const Start) .|.
+>                        (guessesE `whileIn'` Base ->> const Guessed)
+>     let whileIn :: SEvent a -> State -> SEvent a
+>         e `whileIn` s = if s == state then e else Nothing
+>  
+>     -- Random intervals:
+>     randIntE <- evMap (liftAIO mkRandInt) -< snapshot_ nextE (maxInt, lowOct, range)
+>     interval <- hold (0,0)  -< randIntE
+>     let trigger  = snapshot randIntE (dur, instr) .|.
+>                    snapshot_ repeatE (interval, (dur, instr))
+>     -- state variables:
+>     let matchE   = snapshot (guessesE `whileIn` Base) interval =>> 
+>                     \(g,(r,i)) -> if g==intNameList!!i then succ else id
+>     total   <- delay 0 <<< accum 0 -< ((guessesE `whileIn` Base ->> succ) .|.
+>                            (nextE    `whileIn` Base ->> succ) .|.
+>                            (giveUpE  `whileIn` Base ->> succ) .|.
+>                            (resetE ->> const 0)                  )
+>     correct <- delay 0 <<< accum 0 -< (matchE .|. (resetE ->> const 0))
+>     repeats <- delay 0 <<< accum 0 -< ((repeatE `whileIn` Base ->> succ) .|.
+>                            (resetE ->> const 0)                  )
+>     -- Note delays
+>     let f n pn dur = if pn==n then 1 / fromIntegral (2 ^ dur) else 0
+>         del0 = f 2 pns dur -- lo note delay only when "hi then lo"
+>         del1 = f 1 pns dur -- hi note delay only when "lo then hi"
+>     -- Random interval & Midi signals:
+>     note0 <- vdelay -< (del0, (trigger =>> mkNote 0))
+>     note1 <- vdelay -< (del1, (trigger =>> mkNote 1))
+>     nowE <- now -< ()
+>     let progChan = nowE ->> (map Std $
+>                     zipWith ProgramChange [0,1,2,3,4] [0,4,40,66,73])
+>         midiMsgs = progChan .|. (note0 `mappend` note1)
+>     -- Display results:
+>     (| (setSize (600,30) . leftRight) (do
+>         title "Score:"   $ display -< showScore correct total
+>         title "Repeats:" $ display -< show repeats
+>         title "Answer:"  $ display -< 
+>                 if state==Guessed then intNameList!!(snd interval) else ""
+>         returnA -< () )|)
+>     -- Midi output
+>     midiOut -< (mo, midiMsgs)
+>     returnA -< ()
+
+
+Auxilliary Functions:
+
+> sDisplay              = setSize (50,25) display
+> shiSlider inc ran pre = setSize (300,25) $ hiSlider inc ran pre
+> sButton str           = setSize (75,25)  $ button str
+
+> showScore     :: Int -> Int -> String
+> showScore c 0 = "0"
+> showScore c t = show c ++ "/" ++ show t ++ " = " ++ 
+>                 take 5 (show (100 * fromIntegral c / fromIntegral t)) ++ "%"
+
+> mkRandInt :: (Int,Int,Int) -> IO (Int,Int)
+> mkRandInt (maxInt,lowOct,range) = 
+>   do
+>     let low = lowOct*12
+>     int  <- randomRIO (0,maxInt) :: IO Int
+>     root <- randomRIO (low, low + range*6 - int) :: IO Int
+>     return (root,int)
+
+> mkNote :: Int -> ((Int,Int),(Int,Int)) -> [MidiMessage]
+> mkNote n ((root,int),(dur,instr)) =
+>   let durT = 1 / fromIntegral (2 ^ dur)
+>   in if n==0 then [ANote instr root 100 durT]
+>              else [ANote instr (root+int) 100 durT]
+
+0 whole   1   sec  1/2^0
+1 half    1/2 sec  1/2^1
+2 quarter 1/4 sec  1/2^2
+3 eighth  1/8 sec  1/2^3
+
+at 60 BPM a whole note is 1 sec
+
+ANote :: Channel -> Key -> Velocity -> Time -> MidiMessage
+
+--------------------------------------
+-- Yampa-style utilities
+--------------------------------------
+
+> (=>>) :: SEvent a -> (a -> b) -> SEvent b
+> (=>>) = flip fmap
+> (->>) :: SEvent a -> b -> SEvent b
+> (->>) = flip $ fmap . const
+> (.|.) :: SEvent a -> SEvent a -> SEvent a
+> (.|.) = flip $ flip maybe Just
+> 
+> snapshot :: SEvent a -> b -> SEvent (a,b)
+> snapshot = flip $ fmap . flip (,)
+> snapshot_ :: SEvent a -> b -> SEvent b
+> snapshot_ = flip $ fmap . const -- same as ->>

@@ -0,0 +1,139 @@+> module HSoM.Examples.LSystems where
+> import Euterpea
+> import Data.List hiding (transpose)
+> import System.Random 
+
+> data DetGrammar a = DetGrammar  a           --  start symbol
+>                                 [(a,[a])]   --  productions
+>   deriving Show
+
+> detGenerate :: Eq a => DetGrammar a -> [[a]]
+> detGenerate (DetGrammar st ps) = iterate (concatMap f) [st]
+>             where f a = maybe [a] id (lookup a ps)
+
+> redAlgae = DetGrammar 'a'
+>                [  ('a',"b|c"),   ('b',"b"),  ('c',"b|d"),
+>                   ('d',"e\\d"),  ('e',"f"),  ('f',"g"),
+>                   ('g',"h(a)"),  ('h',"h"),  ('|',"|"),
+>                   ('(',"("),     (')',")"),  ('/',"\\"),
+>                   ('\\',"/")
+>                ]
+
+> t n g = sequence_ (map putStrLn (take n (detGenerate g)))
+
+> data Grammar a = Grammar  a          --  start sentence
+>                           (Rules a)  --  production rules
+>      deriving Show
+
+> data Rules a  =  Uni  [Rule a] 
+>               |  Sto  [(Rule a, Prob)]
+>      deriving (Eq, Ord, Show)
+
+> data Rule a = Rule { lhs :: a, rhs :: a }
+>      deriving (Eq, Ord, Show)
+
+> type Prob = Double
+> type ReplFun a  = [[(Rule a, Prob)]] -> (a, [Rand]) -> (a, [Rand])
+> type Rand       = Double
+
+> gen :: Ord a => ReplFun a -> Grammar a -> Int -> [a]
+> gen f (Grammar s rules) seed = 
+>     let  Sto newRules  = toStoRules rules
+>          rands         = randomRs (0.0,1.0) (mkStdGen seed)
+>     in  if checkProbs newRules
+>         then generate f newRules (s,rands)
+>         else (error "Stochastic rule-set is malformed.")
+
+> toStoRules :: (Ord a, Eq a) => Rules a -> Rules a  
+> toStoRules (Sto rs)  = Sto rs
+> toStoRules (Uni rs)  = 
+>   let rs' = groupBy (\r1 r2 -> lhs r1 == lhs r2) (sort rs)
+>   in Sto (concatMap insertProb rs')
+
+> insertProb :: [a] -> [(a, Prob)] 
+> insertProb rules =  let prb = 1.0 / fromIntegral (length rules)
+>                     in zip rules (repeat prb)
+
+> checkProbs :: (Ord a, Eq a) => [(Rule a, Prob)] -> Bool
+> checkProbs rs = and (map checkSum (groupBy sameLHS (sort rs)))
+
+> eps = 0.001 
+
+> checkSum :: [(Rule a, Prob)] -> Bool 
+> checkSum rules =  let mySum = sum (map snd rules)
+>                   in abs (1.0 - mySum) <= eps 
+
+> sameLHS :: Eq a => (Rule a, Prob) -> (Rule a, Prob) -> Bool 
+> sameLHS (r1,f1) (r2,f2) = lhs r1 == lhs r2
+
+> generate ::  Eq a =>  
+>              ReplFun a -> [(Rule a, Prob)] -> (a,[Rand]) -> [a] 
+> generate f rules xs = 
+>   let  newRules      =  map probDist (groupBy sameLHS rules)
+>        probDist rrs  =  let (rs,ps) = unzip rrs
+>                         in zip rs (tail (scanl (+) 0 ps))
+>   in map fst (iterate (f newRules) xs)
+
+> data LSys a  =  N a 
+>              |  LSys a   :+   LSys a 
+>              |  LSys a   :.   LSys a 
+>              |  Id 
+>      deriving (Eq, Ord, Show) 
+
+> replFun :: Eq a => ReplFun (LSys a)
+> replFun rules (s, rands) =
+>   case s of
+>     a :+ b  ->  let  (a',rands')   = replFun rules (a, rands )
+>                      (b',rands'')  = replFun rules (b, rands')
+>                 in (a' :+ b', rands'')
+>     a :. b  ->  let  (a',rands')   = replFun rules (a, rands )
+>                      (b',rands'')  = replFun rules (b, rands')
+>                 in (a' :. b', rands'')
+>     Id      ->  (Id, rands)
+>     N x     ->  (getNewRHS rules (N x) (head rands), tail rands)
+
+> getNewRHS :: Eq a => [[(Rule a, Prob)]] -> a -> Rand -> a
+> getNewRHS rrs ls rand = 
+>   let  loop ((r,p):rs)  = if rand <= p then rhs r else loop rs
+>        loop []          = error "getNewRHS anomaly"
+>   in case (find (\ ((r,p):_) -> lhs r == ls) rrs) of
+>         Just rs  -> loop rs
+>         Nothing  -> error "No rule match"
+
+> type IR a b = [(a, Music b -> Music b)]  --  ``interpetation rules'' 
+
+> interpret :: (Eq a) => LSys a -> IR a b -> Music b -> Music b
+> interpret (a :. b)  r m = interpret a r (interpret b r m)  
+> interpret (a :+ b)  r m = interpret a r m :+: interpret b r m
+> interpret Id        r m = m 
+> interpret (N x)     r m = case (lookup x r) of
+>                             Just f   -> f m
+>                             Nothing  -> error "No interpetation rule"
+
+> data LFun = Inc | Dec | Same
+>      deriving (Eq, Ord, Show)
+
+> ir :: IR LFun Pitch
+> ir = [ (Inc, transpose 1),
+>        (Dec, transpose (-1)),
+>        (Same, id)]
+
+> inc, dec, same :: LSys LFun
+> inc   = N Inc
+> dec   = N Dec
+> same  = N Same
+
+> sc = inc :+ dec
+
+> r1a  = Rule inc (sc :. sc)
+> r1b  = Rule inc sc
+> r2a  = Rule dec (sc :. sc)
+> r2b  = Rule dec sc
+> r3a  = Rule same inc
+> r3b  = Rule same dec
+> r3c  = Rule same same
+
+> g1 = Grammar same (Uni [r1b, r1a, r2b, r2a, r3a, r3b])
+
+> t1 n =  instrument Vibraphone $
+>         interpret (gen replFun g1 42 !! n) ir (c 5 tn)

@@ -0,0 +1,90 @@+> {-#  LANGUAGE Arrows, CPP  #-}
+
+> module HSoM.Examples.MUIExamples1 where
+> import Euterpea
+> import Data.Maybe (mapMaybe)
+> import HSoM
+> import FRP.UISF
+> import FRP.UISF.Graphics (withColor', rgbE, rectangleFilled)
+> import FRP.UISF.Widget.Construction (mkWidget)
+
+
+> ui0  ::  UISF () ()
+> ui0  =   proc _ -> do
+>     ap <- hiSlider 1 (0,100) 0 -< ()
+>     display -< pitch ap
+
+> mui0 = runMUI' ui0
+
+> ui1 ::  UISF () ()
+> ui1 =   setSize (150,150) $ 
+>   proc _ -> do
+>     ap <- title "Absolute Pitch" (hiSlider 1 (0,100) 0) -< ()
+>     title "Pitch" display -< pitch ap
+
+> mui1  =  runMUI' ui1
+
+> ui2   ::  UISF () ()
+> ui2   =   leftRight $
+>   proc _ -> do
+>     ap <- title "Absolute Pitch" (hiSlider 1 (0,100) 0) -< ()
+>     title "Pitch" display -< pitch ap
+
+> mui2  =  runMUI' ui2
+
+
+> ui3  ::  UISF () ()
+> ui3  =   proc _ -> do
+>     devid <- selectOutput -< ()
+>     ap <- title "Absolute Pitch" (hiSlider 1 (0,100) 0) -< ()
+>     title "Pitch" display -< pitch ap
+>     uap <- unique -< ap
+>     midiOut -< (devid, fmap (\k-> [ANote 0 k 100 0.1]) uap)
+
+> mui3  = runMUI' ui3
+
+
+> ui4   :: UISF () ()
+> ui4   = proc _ -> do
+>     mi  <- selectInput   -< ()
+>     mo  <- selectOutput  -< ()
+>     m   <- midiIn        -< mi
+>     midiOut -< (mo, m)
+
+> mui4  = runMUI' ui4
+
+> getDeviceIDs = topDown $
+>   proc () -> do
+>     mi    <- selectInput   -< ()
+>     mo    <- selectOutput  -< ()
+>     outA  -< (mi,mo)
+
+> mui'4 = runMUI  (defaultMUIParams 
+>                     {  uiTitle  = "MIDI Input / Output UI", 
+>                        uiSize   = (200,200)})
+>                 ui4
+
+> ui5 ::  UISF () ()
+> ui5 =   proc _ -> do
+>     devid   <- selectOutput -< ()
+>     ap      <- title "Absolute Pitch" (hiSlider 1 (0,100) 0) -< ()
+>     title "Pitch" display -< pitch ap
+>     f       <- title "Tempo" (hSlider (1,10) 1) -< ()
+>     tick    <- timer -< 1/f
+>     midiOut -< (devid, fmap (const [ANote 0 ap 100 0.1]) tick)
+
+> colorSwatchUI :: UISF () ()
+> colorSwatchUI = setSize (300, 220) $ pad (4,0,4,0) $ leftRight $ 
+>     proc _ -> do
+>         r <- newColorSlider "R" -< ()
+>         g <- newColorSlider "G" -< ()
+>         b <- newColorSlider "B" -< ()
+>         e <- unique -< (r,g,b)
+>         let rect = withColor' (rgbE r g b) (rectangleFilled ((0,0),d))
+>         pad (4,8,0,0) $ canvas d -< fmap (const rect) e
+>   where
+>     d = (170,170)
+>     newColorSlider l = title l $ withDisplay $ viSlider 16 (0,255) 0
+
+> colorSwatch = runMUI' colorSwatchUI
+

@@ -0,0 +1,178 @@+> {-# LANGUAGE Arrows #-}
+
+> module HSoM.Examples.MUIExamples2 where
+> import HSoM
+> import FRP.UISF
+> import Euterpea
+> import Data.Maybe (mapMaybe)
+
+
+=============
+Chord builder
+
+Here is a simple program that plays the selected chord when a root
+note is entered using a Midi input device.
+
+We define a mapping between chord extensions and their intervals with
+respect to the root note.
+
+> chordIntervals = [("Maj", [4,3,5]),
+>                   ("Maj7", [4,3,4,1]),
+>                   ("Maj9", [2,2,3,4,1]),
+>                   ("6", [4,3,2,3]),
+>                   ("m", [3,4,5]),
+>                   ("m7", [3,4,3,2]),
+>                   ("m9", [2,1,4,3,2]),
+>                   ("m7b5", [3,3,4,2]),
+>                   ("mMaj7", [3,4,4,1]),
+>                   ("dim", [3,3,3]),
+>                   ("7", [4,3,3,2]),
+>                   ("9", [2,2,3,3,2]),
+>                   ("7b9", [1,3,3,3,2])]
+
+We display the list of extensions on the screen as radio buttons for
+the user to click on.
+
+The toChord function takes in the index of the selected chord extension 
+and an input message as the root note, and outputs the notes of
+the selected chord based on the root note.  For simplicity, we only
+process the head of the message list and ignore everything else.
+
+> toChord :: Int -> [MidiMessage] -> [MidiMessage]
+> toChord i (ms@(m:_)) = 
+>   case m of 
+>     Std (NoteOn c k v) -> f NoteOn c k v
+>     Std (NoteOff c k v) -> f NoteOff c k v
+>     _ -> ms
+>   where f g c k v = map (\k -> Std (g c k v)) 
+>                         (scanl (+) k (snd (chordIntervals !! i)))
+
+The UI is arranged in the following way.  On the left side, the list
+of input and output devices are displayed top-down. On the right is
+the list of chord extensions.  We take the name of each extension from
+the chordIntervals list to create the radio buttons.  
+
+When a Midi input event occurs, the input message and the currently
+selected index to the list of chords is sent to the toChord function,
+and the resulting chord is sent to the output device.
+
+> buildChord = runMUI (defaultMUIParams {uiSize=(500,500), uiTitle="Chord Builder"}) $ leftRight $ proc _ -> do
+>   (mi,mo) <- topDown (selectInput &&& selectOutput) -< ()
+>   m <- midiIn -< mi
+>   i <- topDown $ title "Extension" $ radio (fst (unzip chordIntervals)) 0 -< ()
+>   midiOut -< (mo, fmap (toChord i) m)
+
+
+=================
+Bifurcate example
+
+Here is an example with some ideas borrowed from Gary Lee Nelson's
+composition "Bifurcate me, Baby!"
+
+The basic idea is to evaluate the logistic growth function at
+different points and convert the value to a musical note.  The growth
+function is given by
+
+  x_(n+1) = r x_n (1 - x_n)
+
+We start with an initial population x_0 and iteratively apply the
+growth function to it, where r is the growth rate.  For certain values
+of r, the population stablizes to a certain value, but as r increases,
+the period doubles, quadruples, and eventually leads to chaos.  It is
+one of the classic examples in chaos theory.
+
+First we define the growth function which, given a rate r and
+current population x, generates the next population.
+
+> grow :: Double -> Double -> Double
+> grow r x = r * x * (1-x)
+
+Then we define a signal 'tick' that pulsates at a given frequency
+specified by slider f.  This is the signal that will drive the
+simulation.  The timer function takes in a frequency.
+
+The next thing we need is a time-varying population.  This is where 
+the delay function and the rec keyword come in handy.  We initialize 
+the 'pop' signal with the value 0.1, and then on every tick, we 
+grow it with the instantaneous value of the growth rate signal.
+
+We can now write a simple function that maps a population value to a
+musical note:
+
+> popToNote :: Double -> [MidiMessage]
+> popToNote x = [ANote 0 n 64 0.05] where n = truncate (x * 127)
+
+Finally, to play the note, we simply send the current population to 
+popToNote, and send the result to the selected Midi output device.  
+
+> bifurcate = runMUI (defaultMUIParams {uiSize=(300,500), uiTitle="Bifurcate!"}) $ proc _ -> do
+>   mo <- selectOutput -< ()
+>   f  <- title "Frequency" $ withDisplay (hSlider (1, 10) 1) -< ()
+>   r  <- title "Growth rate" $ withDisplay (hSlider (2.4, 4.0) 2.4) -< ()
+>   
+>   tick <- timer -< 1.0 / f
+>   rec pop <- delay 0.1 -<  maybe pop (const $ grow r pop) tick
+>       
+>   _ <- title "Population" $ display -< pop
+>   midiOut -< (mo, fmap (const (popToNote pop)) tick)
+
+
+============
+Echo example
+
+Here we present a program that takes in a Midi event stream and, in
+addition to playing each note received from the input device, it also
+echoes the note at a given rate, while playing each successive note
+more softly until the velocity reduces to 0.
+
+The key component we need for this problem is a delay function that
+can delay a given event signal for a certain amount of time.  vdelay
+takes in the amount of time to delay and an input signal
+and outputs the delayed signal.
+
+There are two signals we want to attenuate.  One is the signal coming
+from the input device, and the other is the delayed and decayed signal
+containing the echoes.  In the code shown below, they are denoted as m
+and s, respectively.  We merge the two event streams into one and then 
+remove events with empty Midi messages by replacing them with Nothing.  
+The resulting signal, m', is then sent to the Midi output device.
+
+The echo signal s is created recursively from m' as follows.  We examine 
+the signal m' and decay any events that we find there, using the decay 
+rate indicated by the instantaneous value from the slider r.  This 
+decayed signal is fed into the vdelay signal function along with 
+the amount of time to delay (the inverse of the echo frequency, 
+which is given by the other slider f).
+
+> echo = runMUI (defaultMUIParams {uiSize=(500,500), uiTitle="Echo"}) $ proc _ -> do
+>   mi <- selectInput  -< ()
+>   mo <- selectOutput -< ()
+>   m <- midiIn -< mi
+>   r <- title "Decay rate" $ withDisplay (hSlider (0, 0.9) 0.5) -< ()
+>   f <- title "Echoing frequency" $ withDisplay (hSlider (1, 10) 10) -< ()
+>   
+>   rec let m' = removeNull $ mergeS m s
+>       s <- vdelay -< (1.0 / f, fmap (mapMaybe (decay 0.1 r)) m')
+>   
+>   midiOut -< (mo, m')
+
+> mergeS :: Maybe [MidiMessage] -> Maybe [MidiMessage] -> Maybe [MidiMessage]
+> mergeS (Just ns1) (Just ns2) = Just (ns1 ++ ns2)
+> mergeS n1         Nothing    = n1
+> mergeS Nothing    n2         = n2
+
+> removeNull :: Maybe [MidiMessage] -> Maybe [MidiMessage]
+> removeNull Nothing   = Nothing
+> removeNull (Just []) = Nothing
+> removeNull (Just xs) = Just xs
+
+> decay :: Time -> Double -> MidiMessage -> Maybe MidiMessage
+> decay dur r m = 
+>   let f c k v d = if v > 0 
+>                   then Just (ANote c k (truncate (fromIntegral v * r)) d)
+>                   else Nothing
+>   in case m of
+>     ANote c k v d -> f c k v d
+>     Std (NoteOn c k v) -> f c k v dur
+>     _ -> Nothing
+

@@ -0,0 +1,103 @@+> module HSoM.Examples.MoreMusic where
+> import Euterpea
+
+> pr1, pr2 :: Pitch -> Music Pitch
+> pr1 p =  tempo (5/6) 
+>          (  tempo (4/3)  (  mkLn 1 p qn :+:
+>                             tempo (3/2) (  mkLn 3 p en  :+:
+>                                            mkLn 2 p sn  :+:
+>                                            mkLn 1 p qn     ) :+:
+>                             mkLn 1 p qn) :+:
+>             tempo (3/2)  (  mkLn 6 p en))
+
+> pr2 p = 
+>    let  m1   = tempo (5/4) (tempo (3/2) m2 :+: m2)
+>         m2   = mkLn 3 p en
+>    in tempo (7/6) (  m1 :+:
+>                      tempo (5/4) (mkLn 5 p en) :+:
+>                      m1 :+:
+>                      tempo (3/2) m2)
+
+> mkLn :: Int -> p -> Dur -> Music p
+> mkLn n p d = line $ take n $ repeat $ note d p
+
+> pr12  :: Music Pitch
+> pr12  = pr1 (C,4) :=: pr2 (G,4)
+
+
+> trill :: Int -> Dur -> Music Pitch -> Music Pitch
+> trill i sDur (Prim (Note tDur p)) =
+>    if sDur >= tDur  then note tDur p
+>                     else  note sDur p :+: 
+>                           trill  (negate i) sDur 
+>                                  (note (tDur-sDur) (trans i p))
+> trill i d (Modify (Tempo r) m)  = tempo r (trill i (d*r) m)
+> trill i d (Modify c m)          = Modify c (trill i d m)
+> trill _ _ _                     = 
+>       error "trill: input must be a single note."
+> {-# LINE 702 "MoreMusic.lhs" #-}
+> trill' :: Int -> Dur -> Music Pitch -> Music Pitch
+> trill' i sDur m = trill (negate i) sDur (transpose i m)
+
+> trilln :: Int -> Int -> Music Pitch -> Music Pitch
+> trilln i nTimes m = trill i (dur m / fromIntegral nTimes) m
+
+> trilln' :: Int -> Int -> Music Pitch -> Music Pitch
+> trilln' i nTimes m = trilln (negate i) nTimes (transpose i m)
+
+> roll  :: Dur -> Music Pitch -> Music Pitch
+> rolln :: Int -> Music Pitch -> Music Pitch
+
+> roll  dur    m = trill  0 dur m
+> rolln nTimes m = trilln 0 nTimes m
+
+> ssfMel :: Music Pitch
+> ssfMel = line (l1 ++ l2 ++ l3 ++ l4)
+>   where  l1  = [ trilln 2 5 (bf 6 en), ef 7 en, ef 6 en, ef 7 en ]
+>          l2  = [ bf 6 sn, c  7 sn, bf 6 sn, g 6 sn, ef 6 en, bf 5 en ]
+>          l3  = [ ef 6 sn, f 6 sn, g 6 sn, af 6 sn, bf 6 en, ef 7 en ]
+>          l4  = [ trill 2 tn (bf 6 qn), bf 6 sn, denr ]
+
+> starsAndStripes :: Music Pitch
+> starsAndStripes = instrument Flute ssfMel
+
+> grace :: Int -> Rational -> Music Pitch -> Music Pitch
+> grace n r (Prim (Note d p))  =
+>       note (r*d) (trans n p) :+: note ((1-r)*d) p
+> grace n r _                  = 
+>       error "grace: can only add a grace note to a note"
+
+> grace2 ::  Int -> Rational -> 
+>            Music Pitch -> Music Pitch -> Music Pitch
+> grace2 n r (Prim (Note d1 p1)) (Prim (Note d2 p2)) =
+>       note (d1-r*d2) p1 :+: note (r*d2) (trans n p2) :+: note d2 p2
+> grace2 _ _ _ _  = 
+>       error "grace2: can only add a grace note to a note"
+
+> funkGroove :: Music Pitch
+> funkGroove
+>   =  let  p1  = perc LowTom         qn
+>           p2  = perc AcousticSnare  en
+>      in  tempo 3 $ instrument Percussion $ cut 8 $ forever
+>          (  (  p1 :+: qnr :+: p2 :+: qnr :+: p2 :+:
+>                p1 :+: p1 :+: qnr :+: p2 :+: enr)
+>             :=: roll en (perc ClosedHiHat 2) )
+
+
+> rep ::  (Music a -> Music a) -> (Music a -> Music a) -> Int 
+>         -> Music a -> Music a
+> rep f g 0 m  = rest 0
+> rep f g n m  = m :=: g (rep f g (n-1) (f m))
+
+> run,  cascade,  cascades,  final :: Music Pitch
+> run', cascade', cascades', final' :: Music Pitch
+
+> run       = rep (transpose 5) (offset tn) 8 (c 4 tn)
+> cascade   = rep (transpose 4) (offset en) 8 run
+> cascades  = rep  id           (offset sn) 2 cascade
+
+> final = cascades :+: retro cascades
+> run'       = rep (offset tn) (transpose 5) 8 (c 4 tn)
+> cascade'   = rep (offset en) (transpose 4) 8 run'
+> cascades'  = rep (offset sn)  id           2 cascade'
+> final'     = cascades' :+: retro cascades'

@@ -0,0 +1,111 @@+> {-# LANGUAGE Arrows #-}
+
+This file demonstrates how to turn a Music value into an audio signal 
+using the Render module.
+
+> module HSoM.Examples.MusicToSignal where
+> import HSoM
+> import Euterpea
+
+First, define some instruments.
+
+> reedyWav = tableSinesN 1024 [0.4, 0.3, 0.35, 0.5, 0.1, 0.2, 0.15, 
+>                            0.0, 0.02, 0.05, 0.03]
+
+> reed :: Instr (Stereo AudRate)
+> reed dur pch vol params = 
+>     let reedy = osc reedyWav 0
+>         freq  = apToHz pch
+>         vel   = fromIntegral vol / 127 / 3
+>         env   = envLineSeg [0, 1, 0.8, 0.6, 0.7, 0.6, 0] 
+>                            (replicate 6 (fromRational dur/6))
+>     in proc _ -> do
+>       amp <- env -< ()
+>       r1 <- reedy -< freq
+>       r2 <- reedy -< freq + (0.023 * freq)
+>       r3 <- reedy -< freq + (0.019 * freq)
+>       let [a1, a2, a3] = map (* (amp * vel)) [r1, r2, r3]
+>       let rleft = a1 * 0.5 + a2 * 0.44 * 0.35 + a3 * 0.26 * 0.65
+>           rright = a1 * 0.5 + a2 * 0.44 * 0.65 + a3 * 0.26 * 0.35
+>       outA -< (rleft, rright)
+
+> saw = tableSinesN 4096 [1, 0.5, 0.333, 0.25, 0.2, 0.166, 0.142, 0.125, 
+>                         0.111, 0.1, 0.09, 0.083, 0.076, 0.071, 0.066, 0.062]
+
+> plk :: Instr (Stereo AudRate)
+> plk dur pch vol params = 
+>     let vel  = fromIntegral vol / 127 / 3
+>         freq = apToHz pch
+>         sf   = pluck saw freq SimpleAveraging
+>     in proc _ -> do
+>          a <- sf -< freq
+>          outA -< (a * vel * 0.4, a * vel * 0.6)
+
+Define some instruments:
+
+> myBass, myReed :: InstrumentName
+> myBass = CustomInstrument "pluck-like"
+> myReed = CustomInstrument "reed-like"
+
+Construct a custom instrument map.  An instrument map is just 
+an association list containing mappings from InstrumentName to Instr.
+
+> myMap :: InstrMap (Stereo AudRate)
+> myMap = [(myBass, plk), (myReed, reed)]
+
+> bass   = mMap (\p-> (p, 40 :: Volume)) $ instrument myBass bassLine
+> melody = mMap (\p-> (p,100 :: Volume)) $ instrument myReed mainVoice
+
+> childSong6 :: Music (Pitch, Volume)
+> childSong6 = tempo 1.5 (bass :=: melody)
+
+All instruments used in the same performance must output the same number 
+of channels, but renderSF supports both mono or stereo instruments 
+(and any instrument that produces samples in the AudioSample type class).
+The outFile function will produce a monaural or stereo file accordingly.
+
+> recordSong = uncurry (outFile "song.wav") (renderSF childSong6 myMap)
+
+> main = recordSong
+
+This stuff is taken from Euterpea.Examples.Interlude:
+
+> bassLine =  times 3 b1 :+: times 2 b2 :+: 
+>             times 4 b3 :+: times 5 b1
+
+> mainVoice = times 3 v1 :+: v2
+
+> v1   = v1a :+: graceNote (-1) (d 5 qn) :+: v1b                 -- bars 1-2
+> v1a  = addDur en [a 5, e 5, d 5, fs 5, cs 5, b 4, e 5, b 4]
+> v1b  = addDur en [cs 5, b 4]
+
+> v2 = v2a :+: v2b :+: v2c :+: v2d :+: v2e :+: v2f :+: v2g
+> v2a  =  line [  cs 5 (dhn+dhn), d 5 dhn, 
+>                 f 5 hn, gs 5 qn, fs 5 (hn+en), g 5 en]
+> v2b  =  addDur en [  fs 5, e 5, cs 5, as 4] :+: a 4 dqn :+:
+>         addDur en [  as 4, cs 5, fs 5, e 5, fs 5]
+> v2c  =  line [  g 5 en, as 5 en, cs 6 (hn+en), d 6 en, cs 6 en] :+:
+>         e 5 en :+: enr :+: 
+>         line [  as 5 en, a 5 en, g 5 en, d 5 qn, c 5 en, cs 5 en] 
+> v2d  =  addDur en [  fs 5, cs 5, e 5, cs 5, 
+>                      a 4, as 4, d 5, e 5, fs 5]
+> v2e  =  line [  graceNote 2 (e 5 qn), d 5 en, graceNote 2 (d 5 qn), cs 5 en,
+>                 graceNote 1 (cs 5 qn), b 4 (en+hn), cs 5 en, b 4 en ]  
+> v2f  =  line [  fs 5 en, a 5 en, b 5 (hn+qn), a 5 en, fs 5 en, e 5 qn,
+>                 d 5 en, fs 5 en, e 5 hn, d 5 hn, fs 5 qn]
+> v2g  =  tempo (3/2) (line [cs 5 en, d 5 en, cs 5 en]) :+: 
+>         b 4 (3*dhn+hn)
+
+> b1  = addDur dqn [b 3,   fs 4,  g 4,   fs 4]
+> b2  = addDur dqn [b 3,   es 4,  fs 4,  es 4]
+> b3  = addDur dqn [as 3,  fs 4,  g 4,   fs 4]
+
+> addDur       :: Dur -> [Dur -> Music a] -> Music a
+> addDur d ns  =  let f n = n d
+>                 in line (map f ns)
+
+> graceNote :: Int -> Music Pitch -> Music Pitch
+> graceNote n  (Prim (Note d p))  =
+>           note (d/8) (trans n p) :+: note (7*d/8) p
+> graceNote n  _                  = 
+>           error "Can only add a grace note to a note."

@@ -0,0 +1,227 @@+New Resolutions by Jean-Luc Ponty, Scott O'Neil, and John Garvin
+
+> module HSoM.Examples.NewResolutions where
+> import Euterpea
+> import HSoM
+
+> nrContext = Context {cTime = 0,
+>                      cPlayer = fancyPlayer,
+>                      cInst = Marimba,
+>                      cDur = 1.0,
+>                      cPch = 0,
+>                      cKey = (C,Major),
+>                      cVol = 100}
+>
+
+
+> root, minThird, fifth, octave :: Pitch -> Dur -> Music Pitch
+> root       p dur = Prim $ Note dur p
+> minThird   p dur = Prim $ Note dur (trans 3 p)
+> majThird   p dur = Prim $ Note dur (trans 4 p)
+> fifth      p dur = Prim $ Note dur (trans 7 p)
+> majSixth   p dur = Prim $ Note dur (trans 9 p)
+> minSeventh p dur = Prim $ Note dur (trans 10 p)
+> octave     p dur = Prim $ Note dur (trans 12 p)
+> oMinThird  p dur = Prim $ Note dur (trans 15 p)
+> oFifth     p dur = Prim $ Note dur (trans 19 p)
+
+> minArpegUp, minArpegDown :: Pitch -> Dur -> Music Pitch
+> minArpegUp p d = root p d
+>                  :+: minThird p d
+>                  :+: fifth p d 
+>                  :+: octave p d
+> minArpegDown p d = octave p d
+>                :+: fifth p d
+>                :+: minThird p d
+>                :+: root p d
+> majArpegDown p d = octave p d
+>                :+: fifth p d
+>                :+: majThird p d
+>                :+: root p d
+> six3ArpegDown p d = octave p d
+>                 :+: majSixth p d
+>                 :+: majThird p d
+>                 :+: root p d
+
+> pattern = minArpegUp (D,5) sn
+>       :+: minArpegDown (C,5) sn
+>       :+: minArpegUp (A,4) sn
+>       :+: minArpegDown (G,4) sn
+>       :+: minArpegUp (F,4) sn
+>       :+: d 5 sn :+: a 4 sn :+: f 4 sn :+: a 4 sn
+
+> melPattern = d 6 en :+: c 6 en :+: d 6 en
+>          :+: snr
+>          :+: a 5 en :+: g 5 en :+: a 5 en
+
+> melody1 = melPattern :+: enr :+: d 5 sn
+>       :+: f 5 sn :+: g 5 en :+: f 5 sn :+: d 5 en :+: c 5 en
+>       :+: d 5 en :+: melPattern :+: d 5 sn
+>       :+: f 5 sn :+: f 5 sn :+: g 5 sn :+: f 5 sn
+>       :+: d 5 sn :+: c 5 en :+: d 5 den
+>       :+: melPattern :+: d 5 sn
+>       :+: f 5 sn :+: g 5 sn :+: f 5 sn :+: d 5 en
+>       :+: c 5 sn :+: d 5 en
+>       :+: d 6 en :+: c 6 en :+: d 6 den :+: c 6 en
+>       :+: a 5 en :+: c 6 en :+: a 5 sn :+: g 5 en
+>       :+: f 5 en :+: af 5 en
+>       :+: g 5 sn :+: f 5 sn :+: d 5 sn :+: c 5 sn 
+> -- last note removed to make fit with pattern
+
+> bellPart = d 7 en :+: f 7 en :+: c 7 en :+: d 7 en
+>        :+: a 6 en :+: c 7 en :+: g 6 en :+: a 6 en
+>        :+: f 6 en :+: g 6 en
+>        :+: d 6 sn :+: f 6 sn :+: a 6 sn :+: c 7 sn
+
+> vibesLine = d 5 qn :+: c 5 qn :+: a 4 qn
+>         :+: g 4 qn :+: f 4 qn :+: d 4 qn
+> vibesPart = vibesLine :=: Modify (Transpose 12) vibesLine
+
+> cMajorScale = [(C,0), (D,0), (E,0), (F,0), (G,0), (A,0), (B,0)]
+> gMajorScale = [(G,0), (A,0), (B,0), (C,1), (D,1), (E,1), (Fs,1)]
+> dPentMinScale = [(D,0), (F,0), (G,0), (A,0), (C,1)]
+
+> prevNote []         _       = error ("Scale empty")
+> prevNote [x]        _       = error ("Note not found in scale")
+> prevNote ((y,n):ys) (p,oct) | y == p = let (x,m) = last ys
+>                                        in (x, oct + m - n - 1)
+> prevNote ((x,m):(y,n):xys) (p,oct) | y == p    = (x, oct + m - n)
+>                                    | otherwise = prevNote ((y,n):xys) (p,oct)
+
+> nextNote scale note = nextNote' (head scale) scale note
+> nextNote' _ [] _ = error ("Scale empty")
+> nextNote' (fstP,fstO) [(x,m)]           (p,oct)
+>                                       | x == p    = (fstP, oct - m + fstO + 1)
+>                                       | otherwise = error ("Note not found in scale")
+> nextNote' fst         ((x,m):(y,n):xys) (p,oct)
+>                                       | x == p    = (y, oct - m + n)
+>                                       | otherwise = nextNote' fst ((y,n):xys) (p,oct)
+
+> back2Note s = prevNote s . prevNote s
+
+> nextNR = nextNote dPentMinScale
+> prevNR = prevNote dPentMinScale
+> back2NR = back2Note dPentMinScale
+
+> diddle p = snr :+: Prim (Note sn p) 
+>            :+: Prim (Note sn (prevNR p)) :+: Prim (Note sn p)
+
+> melody2 = d 6 sn :+: d 6 en :+: c 6 en :+: d 6 sn :+: c 6 en
+>       :+: a 5 en :+: g 5 sn :+: f 5 sn
+>       :+: g 5 sn :+: f 5 sn :+: d 5 sn :+: f 5 sn
+>       :+: diddle (D,5) :+: diddle (C,5)
+>       :+: diddle (D,6) :+: diddle (C,6) :+: diddle (A,5)
+>       :+: diddle (G,5) :+: diddle (F,5) :+: diddle (D,5)
+>       :+: snr :+: d 6 en :+: c 6 en :+: d 6 den
+>       :+: c 6 en :+: a 5 en :+: g 5 den
+>       :+: f 5 en :+: g 5 en :+: f 5 sn
+>       :+: g 5 sn :+: f 5 sn :+: d 5 sn :+: c 5 sn
+>       :+: d 5 den :+: d 6 en :+: c 6 den :+: a 5 en :+: g 5 den
+>       :+: f 5 en :+: d 5 den :+: c 5 en :+: d 5 qn
+
+> part1 = Modify (Instrument Marimba) (Modify (Phrase [Dyn (Loudness 70)]) pattern)
+>         :+:
+>         Modify (Instrument Xylophone) (Modify (Phrase [Dyn (Loudness 120)]) melody1)
+>     :=: Modify (Instrument Marimba) (Modify (Phrase [Dyn (Loudness 70)]) (times 4 pattern))
+> bridge = Modify (Instrument Xylophone) (d 5 hn) -- (d 5 hn [Volume 120])
+>      :=: (times 2 $
+>          Modify (Instrument Marimba) (Modify (Phrase [Dyn (Loudness 60)]) (Modify (Transpose (-12)) bellPart))
+>      :=: Modify (Instrument Vibraphone) (Modify (Phrase [Dyn (Loudness 40)]) vibesPart)
+>      :=: Modify (Instrument Glockenspiel) (Modify (Phrase [Dyn (Loudness 80)]) bellPart))
+> part2 = Modify (Instrument Xylophone) (Modify (Phrase [Dyn (Loudness 120)]) melody2)
+>     :=: Modify (Instrument Marimba) (Modify (Phrase [Dyn (Loudness 70)]) (times 3 pattern
+>                                                  :+: minArpegUp   (D,5) sn
+>                                                  :+: minArpegDown (C,5) sn
+>                                                  :+: minArpegUp   (A,4) sn
+>                                                  :+: minArpegDown (G,4) sn
+>                                                  :+: minArpegUp   (F,4) sn
+>                                                  :+: d 5 sn))
+>     :=: times 4 (Modify (Instrument Vibraphone) (Modify (Phrase [Dyn (Loudness 40)]) vibesPart))
+
+> run1 p d = root p d       :+: minThird p d  :+: fifth p d
+>        :+: minSeventh p d :+: octave p d    :+: oMinThird p d
+>        :+: oFifth p d     :+: oMinThird p d :+: octave p d
+>        :+: minSeventh p d :+: fifth p d      :+: minThird p d
+
+> part3Pattern el = el (D,4) sn :+: el (C,4) sn :+: el (D,4) sn :+: el (F,4) sn
+
+> run2 p d = times 2 $
+>       fifth p d     :+: minSeventh p d :+: octave p d
+>   :+: oMinThird p d :+: octave p d     :+: minSeventh p d
+
+> run3 p d = times 3 $
+>       oMinThird p d :+: octave p d :+: minSeventh p d :+: fifth p d
+
+> vibeLine3 = let el = \p -> octave p den :+: fifth p den
+>                        :+: minSeventh p den :+: octave p den
+>             in el (D,4) :+: el (C,4) :+: el (D,4)
+>                :+: f 5 den :+: c 5 den
+>                :+: ef 5 en :+: f 5 en :+: af 5 en
+> vibePart3 = vibeLine3 :=: Modify (Transpose 12) vibeLine3
+
+> melody3 = a 5 (11/16) :+: f 6 sn
+>       :+: ef 6 en :+: d 6 en :+: c 6 en :+: g 5 dqn
+>       :+: times 3 (a 5 sn :+: f 6 en) :+: a 5 en
+>       :+: f 6 en :+: af 5 en :+: f 6 en :+: af 5 en
+>       :+: minArpegDown (F,5) sn :+: snr
+>       :+: majArpegDown (F,5) sn :+: snr
+>       :+: six3ArpegDown (F,5) sn :+: snr :+: f 6 sn :+: d 6 sn
+>       :+: ef 6 sn :+: d 6 sn :+: c 6 sn :+: g 5 sn :+: snr
+>       :+: majArpegDown (Ef,5) sn :+: snr :+: ef 6 sn :+: c 6 sn
+>       :+: majArpegDown (F,5) sn :+: snr
+>       :+: six3ArpegDown (F,5) sn :+: snr :+: f 6 sn :+: d 6 sn
+>       :+: minArpegDown (F,5) sn :+: snr
+>       :+: minArpegDown (F,5) sn :+: af 5 sn :+: c 6 sn :+: f 6 sn
+>       :+: line (map (times 2) [f 6 sn, d 6 sn, c 6 sn,
+>                                a 5 sn, g 5 sn, f 5 sn])
+>       :+: ef 5 sn :+: f 5 sn :+: g 5 sn :+: bf 5 sn
+>       :+: c 6 sn :+: d 6 sn :+: ef 6 sn :+: d 6 sn
+>       :+: c 6 sn :+: bf 5 sn :+: a 5 sn :+: g 5 sn
+>       :+: times 4 (a 5 sn :+: a 5 sn :+: g 5 sn)
+>       :+: times 2 (af 5 sn :+: af 5 sn :+: g 5 sn)
+>       :+: times 2 (af 5 sn :+: g 5 sn :+: f 5 sn)
+>       :+: a 5 dqn
+>       :+: f 6 sn :+: d 6 sn :+: c 6 sn
+>       :+: a 5 sn :+: g 5 sn :+: f 5 sn
+>       :+: g 5 sn :+: bf 5 sn :+: ef 6 dqn
+>       :+: bf 6 den :+: bf 6 sn
+>       :+: a 6 en :+: a 6 sn :+: g 6 en :+: g 6 sn
+>       :+: f 6 den :+: a 5 sn :+: c 6 sn :+: d 6 sn
+>       :+: f 6 den :+: f 6 sn :+: d 6 sn :+: c 6 sn
+>       :+: af 5 sn :+: af 5 sn :+: g 5 sn
+>       :+: f 5 sn :+: d 5 sn :+: c 5 sn
+
+> harmony3 = Modify (Phrase [Dyn (Loudness 60)]) (part3Pattern run1
+>                                    :=: part3Pattern run2
+>                                    :=: Modify (Transpose 12) (part3Pattern run3))
+>        :=: Modify (Phrase [Dyn (Loudness 50)]) (Modify (Instrument Vibraphone) vibePart3)
+
+> part3 = Modify (Phrase [Dyn (Loudness 60)]) (part3Pattern run1)
+>     :+: (Modify (Phrase [Dyn (Loudness 60)]) (part3Pattern run1)
+>          :=: Modify (Phrase [Dyn (Loudness 90)]) (part3Pattern run2))
+>     :+: (Modify (Phrase [Dyn (Loudness 60)]) ((part3Pattern run1) 
+>                                               :=: (part3Pattern run2))
+>          :=: Modify (Phrase [Dyn (Loudness 100)]) (Modify (Transpose 12) (part3Pattern run3)))
+>     :+: Modify (Phrase [Dyn (Loudness 60)]) (part3Pattern run1
+>                                              :=: part3Pattern run2
+>                                              :=: Modify (Transpose 12) (part3Pattern run3))
+>     :=: Modify (Phrase [Dyn (Loudness 70)]) (Modify (Instrument Vibraphone) vibePart3)
+>     :+: (times 4 harmony3 :=: Modify (Phrase [Dyn (Loudness 100)]) (Modify (Instrument Xylophone) melody3)
+>                                                        :=: (Modify (Instrument Marimba) melody3))
+
+> all3Insts m = Modify (Instrument Marimba) m
+>           :=: Modify (Instrument Xylophone) m
+>           :=: Modify (Instrument Vibraphone) m
+
+> endEl n = Prim (Note sn n)          :+: Prim (Note sn (back2NR n))
+>       :+: Prim (Note sn (prevNR n)) :+: Prim (Note sn n)
+
+> endRun = line $ map endEl $ take 10 $ iterate nextNR (D,5)
+
+> ending = all3Insts $
+>       Prim (Note qn (D,5))
+>   :+: Modify (Phrase [Dyn (Loudness 120)]) (endRun :+: d 7 sn)
+
+> newResolutions = part1 :+: bridge :+: part2 :+: part3 :+: ending
+
+> nr = play newResolutions

@@ -0,0 +1,58 @@+> {-#  LANGUAGE Arrows  #-}
+
+> module HSoM.Examples.PhysicalModeling where
+> import Euterpea
+> import FRP.UISF.AuxFunctions
+
+> sineTable441 :: Table
+> sineTable441 = tableSinesN 100 [1]
+
+> s441 :: AudSF () Double
+> s441 = proc () -> do
+>          rec s <- delayLineT 100 sineTable441 -< s
+>          outA -< s
+
+> ts441 = outFile "s441.wav" 5 s441
+
+> echo :: AudSF Double Double
+> echo = proc s -> do
+>          rec fb  <- delayLine 0.5 -< s + 0.7*fb
+>          outA -< fb/3
+
+
+> modVib :: Double -> Double -> AudSF Double Double
+> modVib rate depth =
+>   proc sin -> do
+>     vib   <- osc sineTable 0  -< rate
+>     sout  <- delayLine1 0.2   -< (sin,0.1+0.005*vib)
+>     outA -< sout
+
+> tModVib = outFile "modvib.wav" 6 $
+>                   constA 440 >>> osc sineTable 0 >>> modVib 5 0.005
+
+> sineTable :: Table
+> sineTable = tableSinesN 4096 [1]
+
+
+
+> flute ::  Time -> Double -> Double -> Double -> Double 
+>           -> AudSF () Double
+> flute dur amp fqc press breath = 
+>   proc () -> do
+>     env1   <- envLineSeg  [0, 1.1*press, press, press, 0] 
+>                           [0.06, 0.2, dur-0.16, 0.02]  -< ()
+>     env2   <- envLineSeg  [0, 1, 1, 0] 
+>                           [0.01, dur-0.02, 0.01]       -< ()
+>     envib  <- envLineSeg  [0, 0, 1, 1] 
+>                           [0.5, 0.5, dur-1]            -< ()
+>     flow   <- noiseWhite 42    -< ()
+>     vib    <- osc sineTable 0  -< 5
+>     let  emb = breath*flow*env1 + env1 + vib*0.1*envib
+>     rec  flute  <- delayLine (1/fqc)    -< out
+>          x      <- delayLine (1/fqc/2)  -< emb + flute*0.4
+>          out    <- filterLowPassBW -< (x-x*x*x + flute*0.4, 2000)
+>     outA -< out*amp*env2
+    
+
+> tFlute = outFile "tFlute.wav" 5 $ flute 5 0.3 440 0.99 0.2 
+> tFlute2 = outFileNorm "tFlute2.wav" 5 $ flute 5 0.7 440 0.99 0.2 

@@ -0,0 +1,119 @@+> module HSoM.Examples.RandomMusic where
+> import Euterpea
+> import System.Random
+> import System.Random.Distributions
+> import qualified Data.MarkovChain as M
+
+
+> sGen :: StdGen
+> sGen = mkStdGen 42
+
+> randInts :: StdGen -> [Int]
+> randInts g =  let (x,g') = next g
+>               in x : randInts g'
+
+> randFloats :: [Float]
+> randFloats = randomRs (-1,1) sGen
+
+> randIntegers :: [Integer]
+> randIntegers = randomRs (0,100) sGen
+
+> randString :: String
+> randString = randomRs ('a','z') sGen
+
+> randIO :: IO Float
+> randIO = randomRIO (0,1)
+
+> randIO' :: IO ()
+> randIO' = do  r1 <- randomRIO (0,1) :: IO Float
+>               r2 <- randomRIO (0,1) :: IO Float
+>               print (r1 == r2)
+
+> toAbsP1    :: Float -> AbsPitch
+> toAbsP1 x  = round (40*x + 30)
+
+> mkNote1  :: AbsPitch -> Music Pitch
+> mkNote1  = note tn . pitch
+
+> mkLine1        :: [AbsPitch] -> Music Pitch
+> mkLine1 rands  = line (take 32 (map mkNote1 rands))
+
+uniform distribution
+
+> m1 :: Music Pitch
+> m1 = mkLine1 (randomRs (30,70) sGen)
+
+linear distribution
+
+> m2 :: Music Pitch
+> m2 =  let rs1 = rands linear sGen
+>       in mkLine1 (map toAbsP1 rs1)
+
+exponential distribution
+
+> m3      :: Float -> Music Pitch
+> m3 lam  =  let rs1 = rands (exponential lam) sGen
+>            in mkLine1 (map toAbsP1 rs1)
+
+Gaussian distribution
+
+> m4 :: Float -> Float -> Music Pitch
+> m4 sig mu   =  let rs1 = rands (gaussian sig mu) sGen
+>                in mkLine1 (map toAbsP1 rs1)
+
+
+Gaussian distribution with mean set to 0
+
+> m5      :: Float -> Music Pitch
+> m5 sig  =  let rs1 = rands (gaussian sig 0) sGen
+>            in mkLine2 50 (map toAbsP2 rs1)
+
+exponential distribution with mean adjusted to 0
+
+> m6      :: Float -> Music Pitch
+> m6 lam  =  let rs1 = rands (exponential lam) sGen
+>            in mkLine2 50 (map (toAbsP2 . subtract (1/lam)) rs1)
+
+> toAbsP2     :: Float -> AbsPitch
+> toAbsP2 x   = round (5*x)
+
+> mkLine2 :: AbsPitch -> [AbsPitch] -> Music Pitch
+> mkLine2 start rands = 
+>    line (take 64 (map mkNote1 (scanl (+) start rands)))
+
+> m2' = let rs1 = rands linear sGen
+>       in sum (take 1000 rs1) / 1000 :: Float
+
+> m5' sig = let rs1 = rands (gaussian sig 0) sGen
+>           in sum (take 1000 rs1)
+
+> m6' lam = let rs1 = rands (exponential lam) sGen
+>               rs2 = map (subtract (1/lam)) rs1
+>           in sum (take 1000 rs2)
+
+some sample training sequences
+
+> ps0,ps1,ps2 :: [Pitch]
+> ps0  = [(C,4), (D,4), (E,4)]
+> ps1  = [(C,4), (D,4), (E,4), (F,4), (G,4), (A,4), (B,4)]
+> ps2  = [  (C,4), (E,4), (G,4), (E,4), (F,4), (A,4), (G,4), (E,4),
+>           (C,4), (E,4), (G,4), (E,4), (F,4), (D,4), (C,4)]
+
+functions to package up run and runMulti
+
+> mc    ps   n = mkLine3 (M.run n ps 0 (mkStdGen 42))
+> mcm   pss  n = mkLine3 (concat (M.runMulti  n pss 0 
+>                                             (mkStdGen 42)))
+
+music-making functions
+
+> mkNote3     :: Pitch -> Music Pitch
+> mkNote3     = note tn
+
+> mkLine3     :: [Pitch] -> Music Pitch
+> mkLine3 ps  = line (take 64 (map mkNote3 ps))
+
+testing the Markov output directly
+
+> lc  ps n    = take 1000 (M.run n ps 0 (mkStdGen 42))
+> lcl pss n m = take 1000 (M.runMulti n pss 0 (mkStdGen 42) !! m)

@@ -0,0 +1,22 @@+The first phrase of the flute part of "Stars and Stripes Forever."
+
+> module HSoM.Examples.SSF where
+> import Euterpea
+> import HSoM.Examples.MoreMusic
+
+> legato = Legato (11/10)
+> staccato = Staccato (5/10)
+>
+> ssfMelody = line (m1 ++ m2 ++ m3 ++ m4)
+
+> m1 = [trilln 2 5 (bf 5 en), Modify (Phrase [Art staccato]) (line [ef 6 en, ef 5 en, ef 6 en])]
+
+> m2 = [Modify (Phrase [Art legato]) (line [bf 5 sn, c  6 sn, bf 5 sn, g  5 sn]),
+>	    Modify (Phrase [Art staccato])    (line [ef 5 en, bf 4 en])]
+
+> m3 = [Modify (Phrase [Art legato]) (line [ef 5 sn, f  5 sn, g  5 sn, af 5 sn]),
+>	    Modify (Phrase [Art staccato])    (line [bf 5 en, ef 6 en])]
+
+> m4 = [trill 2 tn (bf 5 qn), bf 5 sn, denr]
+
+> ssf = Modify (Instrument Flute) ssfMelody

@@ -0,0 +1,77 @@+
+
+> module HSoM.Examples.SelfSimilar where
+> import Euterpea
+
+> data Cluster  = Cluster SNote [Cluster]
+> type SNote    = (Dur,AbsPitch)
+
+> selfSim      :: [SNote] -> Cluster
+> selfSim pat  = Cluster (0,0) (map mkCluster pat)
+>     where mkCluster note =
+>             Cluster note (map (mkCluster . addMult note) pat)
+
+> addMult                  :: SNote -> SNote -> SNote
+> addMult (d0,p0) (d1,p1)  = (d0*d1,p0+p1)
+
+> fringe                       :: Int -> Cluster -> [SNote]
+> fringe 0 (Cluster note cls)  = [note]
+> fringe n (Cluster note cls)  = concatMap (fringe (n-1)) cls
+
+
+> simToMusic     :: [SNote] -> Music Pitch
+> simToMusic     = line . map mkNote
+
+> mkNote         :: (Dur,AbsPitch) -> Music Pitch
+> mkNote (d,ap)  = note d (pitch ap)
+
+
+> ss pat n tr te = 
+>    transpose tr $ tempo te $ simToMusic $ fringe n $ selfSim pat
+
+> m0   :: [SNote]
+> m0   = [(1,2),(1,0),(1,5),(1,7)]
+
+> tm0  = instrument Vibraphone (ss m0 4 50 20)
+> ttm0 = tm0 :=: transpose (12) (retro tm0)
+
+> m1   :: [SNote]
+> m1   = [(1,0),(0.5,0),(0.5,0)]
+
+> tm1  = instrument Percussion (ss m1 4 43 2)
+> m2   :: [SNote]
+> m2   = [(dqn,0),(qn,4)]
+
+> tm2  = ss m2 6 50 (1/50)
+> m3    :: [SNote]
+> m3    = [(hn,3),(qn,4),(qn,0),(hn,6)]
+
+> tm3   = ss m3 4 50 (1/4)
+
+> ttm3  =  let  l1 =  instrument Flute tm3
+>               l2 =  instrument AcousticBass $
+>                       transpose (-9) (retro tm3)
+>          in l1 :=: l2
+
+> m4    :: [SNote]
+> m4    = [  (hn,3),(hn,8),(hn,22),(qn,4),(qn,7),(qn,21),
+>            (qn,0),(qn,5),(qn,15),(wn,6),(wn,9),(wn,19) ]
+
+> tm4   = ss m4 3 50 8
+> fringe'                        :: Int -> Cluster -> [[SNote]]
+> fringe' 0  (Cluster note cls)  = [[note]]
+> fringe' n  (Cluster note cls)  = map (fringe (n-1)) cls
+
+> simToMusic'  :: [[SNote]] -> Music Pitch
+> simToMusic'  = chord . map (line . map mkNote)
+
+> ss' pat n tr te = 
+>    transpose tr $ tempo te $ simToMusic' $ fringe' n $ selfSim pat
+
+> ss1  = ss' m2 4 50 (1/8)
+> ss2  = ss' m3 4 50 (1/2)
+> ss3  = ss' m4 3 50 2
+
+> m5   = [(en,4),(sn,7),(en,0)]
+> ss5  = ss  m5 4 45 (1/500)
+> ss6  = ss' m5 4 45 (1/1000)

@@ -0,0 +1,49 @@+> {-# LANGUAGE Arrows #-}
+
+> module HSoM.Examples.SoundCheck where
+> import Euterpea
+
+> sineTable     = tableSinesN 16384 [1]
+> sawtoothTable = tableSinesN 16384 
+>                   [1, 0.5, 0.3, 0.25, 0.2, 0.167, 0.14, 0.125, 0.111]
+
+> oscSine = osc sineTable 0
+
+> sine :: AudSF () Double
+> sine = 
+>     proc _ -> do
+>       oscSine -< 440
+
+> sine_am :: AudSF () Double
+> sine_am = 
+>     proc _ -> do
+>       amp  <- oscSine -< 5
+>       s    <- oscSine -< 440
+>       outA -< amp * s
+
+> sine_fm :: AudSF () Double
+> sine_fm = 
+>     proc _ -> do
+>       frq <- oscSine -< 3
+>       oscSine -< 330 + frq * 110 -- oscillates between 220 and 440 at 3 Hz
+
+> sine_fm2 :: AudSF () Double
+> sine_fm2 = 
+>     proc _ -> do
+>       modfrq <- oscSine -< 0.1
+>       frq    <- oscSine -< 3 + modfrq * 100
+>       oscSine -< 330 + frq * 110 -- oscillates between 220 and 440 at 3 Hz
+
+> sawtooth :: AudSF () Double
+> sawtooth = 
+>     proc _ -> do
+>       osc sawtoothTable 0 -< 440
+
+> squareWave :: AudSF () Double
+> squareWave =
+>     proc _ -> do
+>       frq <- oscSine -< 1000
+>       outA -< if frq > 0 then 0.99 else -0.99
+
+> test :: AudSF () Double -> IO ()
+> test = outFile "test.wav" 3.0

@@ -0,0 +1,57 @@+> {-#  LANGUAGE Arrows  #-}
+
+> module HSoM.Examples.SpectrumAnalysis where
+> import Euterpea
+
+> import Data.Complex (Complex ((:+)), polar)
+> import Data.Maybe (listToMaybe, catMaybes)
+
+> dft :: RealFloat a => [Complex a] -> [Complex a]
+> dft xs = 
+>   let  lenI = length xs
+>        lenR = fromIntegral lenI
+>        lenC = lenR :+ 0
+>   in [  let i = -2 * pi * fromIntegral k / lenR
+>         in (1/lenC) * sum [  (xs!!n) * exp (0 :+ i * fromIntegral n)
+>                              | n <- [0,1..lenI-1] ]
+>         | k <- [0,1..lenI-1] ]
+
+> mkTerm :: Int -> Double -> [Complex Double]
+> mkTerm num n = let f = 2 * pi / fromIntegral num
+>                in [  sin (n * f * fromIntegral i) / n :+ 0
+>                      | i <- [0,1..num-1] ]
+
+> mkxa, mkxb, mkxc :: Int-> [Complex Double]
+> mkxa num = mkTerm num 1
+> mkxb num = zipWith (+) (mkxa num) (mkTerm num 3)
+> mkxc num = zipWith (+) (mkxb num) (mkTerm num 5)
+
+> printComplexL :: [Complex Double] -> IO ()
+> printComplexL xs  =
+>   let  f (i,rl:+im) = 
+>             do  putStr (spaces (3 - length (show i))  )
+>                 putStr (show i       ++ ":  ("        )
+>                 putStr (niceNum rl  ++ ", "           )
+>                 putStr (niceNum im  ++ ")\n"          )
+>   in mapM_ f (zip [0..length xs - 1] xs)
+
+> niceNum :: Double -> String
+> niceNum d =
+>   let  d' = fromIntegral (round (1e10 * d)) / 1e10
+>        (dec, fra)  = break (== '.') (show d')
+>        (fra',exp)  = break (== 'e') fra
+>   in  spaces (3  - length dec) ++ dec ++ take 11 fra'
+>       ++ exp ++ spaces (12 - length fra' - length exp)
+
+> spaces :: Int -> String
+> spaces  n = take n (repeat ' ')
+
+> mkPulse :: Int -> [Complex Double]
+> mkPulse n = 100 : take (n-1) (repeat 0)
+> {-# LINE 721 "SpectrumAnalysis.lhs" #-}
+> x1 num = let f = pi * 2 * pi / fromIntegral num
+>          in map (:+ 0) [  sin (f * fromIntegral i)
+>                           | i <- [0,1..num-1] ]
+> {-# LINE 757 "SpectrumAnalysis.lhs" #-}
+> mkPolars :: [Complex Double] -> [Complex Double]
+> mkPolars = map ((\(m,p)-> m:+p) . polar)

@@ -0,0 +1,68 @@+{-# LANGUAGE FlexibleContexts #-}
+
+module HSoM.MUI 
+  ( -- UI functions
+    UISF 
+  , asyncV              -- :: NFData b => Integer -> Int -> SF a b -> UISF a ([b], Bool)
+  , Dimension           -- type Dimension = (Int, Int)
+  , topDown, bottomUp, leftRight, rightLeft    -- :: UISF a b -> UISF a b
+  , setSize             -- :: Dimension -> UISF a b -> UISF a b
+  , setLayout           -- :: Layout -> UISF a b -> UISF a b
+  , pad                 -- :: (Int, Int, Int, Int) -> UISF a b -> UISF a b
+  , defaultMUIParams    -- :: UIParams
+  , UIParams (..)       -- :: UISF () () -> IO ()
+  , runMUI              -- :: UIParams -> UISF () () -> IO ()
+  , runMUI'             -- :: UISF () () -> IO ()
+  , getTime             -- :: UISF () Time
+    -- Widgets
+  , label               -- :: String -> UISF a a
+  , displayStr          -- :: UISF String ()
+  , display             -- :: Show a => UISF a ()
+  , withDisplay         -- :: Show b => UISF a b -> UISF a b
+  , textboxE            -- :: String -> UISF (SEvent String) String
+  , textbox             -- :: String -> UISF (SEvent String) String
+  , title               -- :: String -> UISF a b -> UISF a b
+  , button              -- :: String -> UISF () Bool
+  , stickyButton        -- :: String -> UISF () Bool
+  , checkbox            -- :: String -> Bool -> UISF () Bool
+  , checkGroup          -- :: [(String, a)] -> UISF () [a]
+  , radio               -- :: [String] -> Int -> UISF () Int
+  , hSlider, vSlider    -- :: RealFrac a => (a, a) -> a -> UISF () a
+  , hiSlider, viSlider  -- :: Integral a => a -> (a, a) -> a -> UISF () a
+  , realtimeGraph       -- :: RealFrac a => Layout -> Time -> Color -> UISF (Time, [(a,Time)]) ()
+  , histogram           -- :: RealFrac a => Layout -> UISF (Event [a]) ()
+  , listbox             -- :: (Eq a, Show a) => UISF ([a], Int) Int
+  , midiIn              -- :: UISF (Maybe InputDeviceID) (SEvent [MidiMessage])
+  , midiOut             -- :: UISF (Maybe OutputDeviceID, SEvent [MidiMessage]) ()
+  , midiInM             -- :: UISF [InputDeviceID] (SEvent [MidiMessage])
+  , midiOutM            -- :: UISF [(OutputDeviceID, SEvent [MidiMessage])] ()
+  , midiOutB            -- :: UISF (Maybe OutputDeviceID, BufferOperation MidiMessage) Bool
+  , midiOutMB           -- :: UISF [(OutputDeviceID, BufferOperation MidiMessage)] Bool
+  , BufferOperation (..) -- Reexported for use with midiOutMB 
+  , selectInput         -- :: UISF () (Maybe InputDeviceID)
+  , selectOutput        -- :: UISF () (Maybe OutputDeviceID)
+  , selectInputM        -- :: UISF () [InputDeviceID]
+  , selectOutputM       -- :: UISF () [OutputDeviceID]
+  , canvas              -- :: Dimension -> UISF (Event Graphic) ()
+  , canvas'             -- :: Layout -> (a -> Dimension -> Graphic) -> UISF (Event a) ()
+  -- Widget Utilities
+  , makeLayout          -- :: LayoutType -> LayoutType -> Layout
+  , LayoutType (..)     -- data LayoutType = Stretchy { minSize :: Int } | Fixed { fixedSize :: Int }
+  , Color (..)          -- data Color = Black | Blue | Green | Cyan | Red | Magenta | Yellow | White
+  ) where
+
+import HSoM.MUI.MidiWidgets
+import Euterpea.IO.MIDI.MidiIO (initializeMidi, terminateMidi)
+import FRP.UISF hiding ((~++))
+
+defaultMUIParams :: UIParams
+defaultMUIParams = defaultUIParams { uiTitle = "MUI" }
+
+runMUI :: UIParams -> UISF () () -> IO ()
+runMUI params = runUI (params { uiInitialize = uiInitialize params >> initializeMidi, 
+                                uiClose = uiClose params >> terminateMidi})
+
+runMUI' :: UISF () () -> IO ()
+runMUI' = runMUI defaultMUIParams
+
+asyncV x = asyncVT x

@@ -0,0 +1,378 @@+> {-# LANGUAGE RecursiveDo, Arrows, TupleSections, ExistentialQuantification, ScopedTypeVariables, FlexibleContexts, CPP #-}
+
+Authors: Paul Hudak, Donya Quick, and Dan Winograd-Cort
+
+> module HSoM.MUI.MidiWidgets (
+>   midiIn
+> , midiOut
+> , midiInM
+> , midiOutM, midiOutB, midiOutMB
+> , runMidi, runMidiM, runMidiMFlood, runMidiMB, runMidiMBFlood
+> , musicToMsgs
+> , musicToBO
+> , selectInput,  selectOutput
+> , selectInputM, selectOutputM
+> , BufferOperation (..) -- Reexported for use with midiOutMB 
+> , asyncMidi, asyncMidiOn
+> ) where
+
+> import FRP.UISF hiding ((~++))
+> import Euterpea hiding (Time, SF, delay)
+
+> -- for musicToMsgs
+> import Data.List (nub, elemIndex, sortBy)
+> import Euterpea.IO.MIDI.MidiIO hiding (Time)
+
+> -- These three imports are for the runMidi functions
+> import FRP.UISF.UISF (addTerminationProc)
+> --import Euterpea.IO.MUI.UISFCompat
+> import Control.SF.SF
+> import Control.DeepSeq
+> import Control.Monad
+> import Control.Concurrent (ThreadId, threadDelay, killThread)
+> import Data.IORef
+> -- imports from UISFCompat
+> import Data.Monoid
+> import FRP.UISF.Asynchrony
+> import Data.Maybe (listToMaybe)
+> import FRP.UISF.AuxFunctions hiding ((~++))
+> import Control.Arrow.ArrowP
+> import Euterpea.IO.Audio.Types
+> import FRP.UISF.Asynchrony
+
+
+
+
+
+
+============================================================
+========================= Widgets ==========================
+============================================================
+
+-------------------
+ | Midi Controls | 
+-------------------
+midiIn is a widget that accepts a MIDI device ID and returns the event 
+stream of MidiMessages that that device is producing.
+
+midiOut is a widget that accepts a MIDI device ID as well as a stream 
+of MidiMessages and sends the MidiMessages to the device.
+
+> midiIn :: UISF (Maybe InputDeviceID) (SEvent [MidiMessage])
+> midiIn = liftAIO f where
+>  f Nothing = return Nothing
+>  f (Just dev) = do
+>   m <- pollMidi dev
+>   return $ fmap (\(_t, ms) -> map Std ms) m
+ 
+> midiOut :: UISF (Maybe OutputDeviceID, SEvent [MidiMessage]) ()
+> midiOut = liftAIO f where
+>   f (Nothing, _) = return ()
+>   f (Just dev, Nothing) = outputMidi dev
+>   f (Just dev, Just ms) = do
+>       outputMidi dev >> mapM_ (\m -> deliverMidiEvent dev (0, m)) ms
+
+ 
+The midiInM widget takes input from multiple devices and combines 
+it into a single stream. 
+
+> midiInM :: UISF [InputDeviceID] (SEvent [MidiMessage])
+> midiInM = foldA mappend Nothing (arr Just >>> midiIn)
+
+> midiInM' :: UISF [(InputDeviceID, Bool)] (SEvent [MidiMessage])
+> midiInM' = arr (map fst . filter snd) >>> midiInM
+
+
+A midiOutM widget sends output to multiple MIDI devices by sequencing
+the events through a single midiOut. The same messages are sent to 
+each device. The midiOutM is designed to be hooked up to a stream like
+that from a checkGroup.
+
+> midiOutM :: UISF [(OutputDeviceID, SEvent [MidiMessage])] ()
+> midiOutM = foldA const () (arr (first Just) >>> midiOut)
+
+> midiOutM' :: UISF ([(OutputDeviceID, Bool)], SEvent [MidiMessage]) ()
+> midiOutM' = arr fixData >>> midiOutM where
+>   fixData (lst, mmsgs) = map ((,mmsgs) . fst) $ filter snd lst
+
+
+A midiOutB widget wraps the regular midiOut widget with a buffer. 
+This allows for a timed series of messages to be prepared and sent
+to the widget at one time. With the regular midiOut, there is no
+timestamping of the messages and they are assumed to be played "now"
+rather than at some point in the future. Just as MIDI files have the
+events timed based on ticks since the last event, the events here 
+are timed based on seconds since the last event. If an event is 
+to occur 0.0 seconds after the last event, then it is assumed to be
+played at the same time as that other event and all simultaneous 
+events are handed to midiOut at the same timestep. Finally, the 
+widget returns a flat that is True if the buffer is empty and False
+if the buffer is full (meaning that items are still being played).
+
+> midiOutB :: UISF (Maybe OutputDeviceID, BufferOperation MidiMessage) Bool
+> midiOutB = proc (devID, bo) -> do
+>   (out, b) <- eventBuffer -< bo
+>   midiOut -< (devID, if shouldClear bo then Just clearMsgs `mappend` out else out)
+>   returnA -< b
+>  where clearMsgs = map (\c -> Std (ControlChange c 123 0)) [0..15]
+>        shouldClear ClearBuffer = True
+>        shouldClear (SkipAheadInBuffer _) = True
+>        shouldClear (SetBufferPlayStatus _ bo) = shouldClear bo
+>        shouldClear (SetBufferTempo      _ bo) = shouldClear bo
+>        shouldClear _ = False
+
+> midiOutB' :: UISF (Maybe OutputDeviceID, SEvent [(DeltaT, MidiMessage)]) Bool
+> midiOutB' = second (arr $ maybe NoBOp AppendToBuffer) >>> midiOutB
+
+
+The midiOutMB widget combines the power of midiOutM with midiOutB, allowing 
+multiple sets of buffer controlled midi messages to be sent to different 
+devices.  The Bool output is True if every buffer is empty (that is, no device 
+has any pending music to be played) and False otherwise.
+
+> midiOutMB :: UISF [(OutputDeviceID, BufferOperation MidiMessage)] Bool
+> midiOutMB = foldA (&&) True (arr (first Just) >>> midiOutB)
+
+> midiOutMB' :: UISF ([(OutputDeviceID, Bool)], SEvent [(DeltaT, MidiMessage)]) Bool
+> midiOutMB' = arr fixData >>> midiOutMB where
+>   fixData (lst, mmsgs) = map ((,maybe NoBOp AppendToBuffer mmsgs) . fst) $ filter snd lst
+
+
+-------------
+ | runMidi | 
+-------------
+The following functions are experimental functions for doing all Midi 
+behavior at once in an external thread.  There are mutiple versions 
+corresponding to Multiple input/output (M), Batch (B), and message 
+flooding (Flood).
+
+> runMidi :: (NFData b, NFData c)
+>         => SF (b, SEvent [MidiMessage]) 
+>               (c, SEvent [MidiMessage])
+>         -> UISF (b, (Maybe InputDeviceID, Maybe OutputDeviceID)) [c]
+> runMidi sf = asyncC' uisfAsyncThreadHandler (iAction . fst . snd, oAction) sf' where
+>   iAction Nothing = return Nothing
+>   iAction (Just idev) = do
+>     m <- pollMidi idev
+>     return $ fmap (\(_t, ms) -> map Std ms) m
+>   oAction (Nothing, _) = return ()
+>   oAction (Just odev, ms) = do
+>     outputMidi odev
+>     maybe (return ()) (mapM_ $ \m -> deliverMidiEvent odev (0, m)) ms
+>   sf' = toAutomaton $ arr (\((b,(idev,odev)),mms) -> ((b,mms),odev)) >>> first sf >>>
+>           arr (\((c,mms),odev) -> (c, (odev, mms)))
+
+> runMidiM :: (NFData b, NFData c)
+>          => SF (b, ([(InputDeviceID, SEvent [MidiMessage])], [OutputDeviceID]))
+>                (c, [(OutputDeviceID, SEvent [MidiMessage])])
+>          -> UISF (b, ([InputDeviceID],[OutputDeviceID])) [c]
+> runMidiM sf = asyncC' uisfAsyncThreadHandler (iAction . fst . snd, oAction) sf' where
+>   iAction [] = return []
+>   iAction (idev:devs) = do
+>     m <- pollMidi idev
+>     let ret = fmap (\(_t, ms) -> map Std ms) m
+>     rst <- iAction devs
+>     return $ (idev, ret):rst
+>   oAction [] = return ()
+>   oAction ((odev, ms):rst) = do
+>     outputMidi odev
+>     maybe (return ()) (mapM_ $ \m -> deliverMidiEvent odev (0, m)) ms
+>     oAction rst
+>   sf' = toAutomaton $ arr (\((b,(idevs,odevs)),mms) -> (b,(mms,odevs))) >>> sf
+
+> runMidiMFlood :: (NFData b, NFData c)
+>               => SF (b, SEvent [MidiMessage])
+>                     (c, SEvent [MidiMessage])
+>               -> UISF (b, ([InputDeviceID],[OutputDeviceID])) [c]
+> runMidiMFlood = runMidiFloodHelper runMidiM
+
+> runMidiMB :: (NFData b, NFData c)
+>           => SF (b, ([(InputDeviceID, SEvent [MidiMessage])], [OutputDeviceID]))
+>                 (c, [(OutputDeviceID, BufferOperation MidiMessage)])
+>           -> UISF (b, ([InputDeviceID],[OutputDeviceID])) [(c, Bool)] --([c], Bool)
+> runMidiMB sf = asyncC' uisfAsyncThreadHandler (iAction . fst . snd, oAction) sf' where
+>                   -- >>> arr (\lst -> let (cs, bools) = unzip lst in (cs, and bools)) >>> delay ([],True) where
+>   iAction idevs = do
+>     t <- getTimeNow
+>     mms <- iAction' idevs
+>     return (mms, t)
+>   iAction' [] = return []
+>   iAction' (idev:devs) = do
+>     m <- pollMidi idev
+>     let ret = fmap (\(_t, ms) -> map Std ms) m
+>     rst <- iAction' devs
+>     return $ (idev, ret):rst
+>   oAction [] = return ()
+>   oAction ((odev, ms):rst) = do
+>     outputMidi odev
+>     maybe (return ()) (mapM_ $ \m -> deliverMidiEvent odev (0, m)) ms
+>     oAction rst
+>   sf' = toAutomaton $ arr (\((b,(idevs,odevs)),(mms, t)) -> ((b,(mms,odevs)), t)) >>> first sf
+>           >>> arr (\((c, bos), t) -> (c, (map (,t) bos))) >>> second (foldA cons ([], True) buffer)
+>           >>> arr (\(c, (lst, bool)) -> ((c, bool), lst))
+>   cons (e, b) (lst, b') = (e:lst, b && b')
+>   buffer = proc ((dev, bo), t) -> do
+>       (out, b) <- eventBuffer' -< (bo, t)
+>       returnA -< ((dev, if shouldClear bo then Just clearMsgs `mappend` out else out), b)
+>   clearMsgs = map (\c -> Std (ControlChange c 123 0)) [0..15]
+>   shouldClear ClearBuffer = True
+>   shouldClear (SkipAheadInBuffer _) = True
+>   shouldClear (SetBufferPlayStatus _ bo) = shouldClear bo
+>   shouldClear (SetBufferTempo      _ bo) = shouldClear bo
+>   shouldClear _ = False
+
+
+> runMidiMBFlood :: (NFData b, NFData c)
+>                => SF (b, SEvent [MidiMessage])
+>                      (c, BufferOperation MidiMessage)
+>                -> UISF (b, ([InputDeviceID],[OutputDeviceID])) [(c, Bool)] --([c], Bool)
+> runMidiMBFlood = runMidiFloodHelper runMidiMB
+
+> runMidiFloodHelper :: Arrow a =>
+>      (a (b, ([(idev, SEvent [m])], [odev])) (c, [(odev, mms)]) -> t)
+>      -> a (b, SEvent [m]) (c, mms) -> t
+> runMidiFloodHelper runner sf = runner sf' where
+>   sf' = arr (\(b, (idevs, odevs)) -> ((b, foldl (flip (mappend . snd)) Nothing idevs), odevs)) >>> first sf >>> 
+>           arr (\((c, mms), odevs) -> (c, map (\d -> (d, mms)) odevs))
+
+
+
+
+
+
+The musicToMsgs function bridges the gap between a Music1 value and
+the input type of midiOutB. It turns a Music1 value into a series 
+of MidiMessages that are timestamped using the number of seconds 
+since the last event. The arguments are as follows:
+
+- True if allowing for an infinite music value, False if the input
+  value is known to be finite. 
+
+- InstrumentName overrides for channels for infinite case. When the
+  input is finite, an empty list can be supplied since the instruments
+  will be pulled from the Music1 value directly (which is obviously 
+  not possible to do in the infinite case).
+
+- The Music1 value to convert to timestamped MIDI messages.
+
+> musicToMsgs :: Bool -> [InstrumentName] -> Music1 -> [(DeltaT, MidiMessage)]
+> musicToMsgs inf is m = 
+>     let p = perform m -- obtain the performance
+>         instrs = if null is && not inf then nub $ map eInst p else is
+>         chan e = 1 + case elemIndex (eInst e) instrs of 
+>                          Just i -> i
+>                          Nothing -> error ("Instrument "++show (eInst e)++
+>                                     "is not assigned to a channel.")                               
+>         f e = (eTime e, ANote (chan e) (ePitch e) (eVol e) (fromRational $ eDur e))
+>         f2 e = [(eTime e, Std (NoteOn (chan e) (ePitch e) (eVol e))), 
+>                (eTime e + eDur e, Std (NoteOff (chan e) (ePitch e) (eVol e)))]
+>         evs = if inf then map f p else sortBy mOrder $ concatMap f2 p -- convert to MidiMessages
+>         times = map (fromRational.fst) evs -- absolute times
+>         newTimes = zipWith subtract (head times : times) times -- relative times
+>         progChanges = zipWith (\c i -> (0, Std $ ProgramChange c i)) 
+>                       [1..16] $ map toGM instrs
+>     in  if length instrs > 16 then error "too many instruments!" 
+>         else progChanges ++ zip newTimes (map snd evs) where
+>     mOrder (t1,m1) (t2,m2) = compare t1 t2
+
+> musicToBO :: Bool -> [InstrumentName] -> Music1 -> BufferOperation MidiMessage
+> musicToBO inf is m = AppendToBuffer $ musicToMsgs inf is m
+ 
+ 
+----------------------
+ | Device Selection | 
+----------------------
+selectInput and selectOutput are shortcut widgets for producing a set 
+of radio buttons corresponding to the available input and output devices 
+respectively.  The output is the DeviceID for the chosen device rather 
+that just the radio button index as the radio widget would return.
+
+> selectInput  :: UISF () (Maybe InputDeviceID)
+> selectOutput :: UISF () (Maybe OutputDeviceID)
+> selectInput  = selectDev "Input device"  (liftM fst $ getAllDevices)
+> selectOutput = selectDev "Output device" (liftM snd $ getAllDevices)
+
+> selectDev :: String -> IO [(deviceid, DeviceInfo)] -> UISF () (Maybe deviceid)
+> selectDev t getDevs = initialAIO getDevs $ \devices ->
+>   let devs = filter (\(i,d) -> name d /= "Microsoft MIDI Mapper") devices
+>       defaultChoice = if null devs then (-1) else 0
+>       names = if null devs then ["(No Devices)"] else map (name . snd) devs
+>   in  title t $ proc _ -> do
+>       r <- radio names 0 -< ()
+>       returnA -< if null devs then Nothing else Just $ fst (devs !! r)
+
+
+The selectInputM and selectOutputM widgets use checkboxes instead of 
+radio buttons to allow the user to select multiple inputs and outputs.
+These widgets should be used with midiInM and midiOutM respectively.
+
+> selectInputM  :: UISF () [InputDeviceID]
+> selectOutputM :: UISF () [OutputDeviceID]
+> selectInputM  = selectDevM "Input devices"  (liftM fst $ getAllDevices)
+> selectOutputM = selectDevM "Output devices" (liftM snd $ getAllDevices)
+
+> selectDevM :: String -> IO [(deviceid, DeviceInfo)] -> UISF () [deviceid]
+> selectDevM t getDevs = initialAIO getDevs $ \devices ->
+>   let devs = filter (\(i,d) -> name d /= "Microsoft MIDI Mapper") devices
+>   in  title t $ checkGroup $ map (\(i,d) -> (name d, i)) devs
+
+> -- For backward compatibility with runMidi, which should be rewritten
+> asyncC' :: (ArrowIO a, ArrowLoop a, ArrowCircuit a, ArrowChoice a, NFData b, NFData c) => 
+>            x -- ^ The thread handler
+>         -> (b -> IO d, e -> IO ()) -- ^ Effectful input and output channels for the automaton
+>         -> (Automaton (->) (b,d) (c,e))  -- ^ The automaton to convert to asynchronize
+>         -> a b [c]
+> asyncC' _ (ia, oa) sf = asyncCIO (return (), const $ return ()) sf' where
+>   sf' _ = (arr id &&& actionToIOAuto ia) >>> pureAutoToIOAuto sf >>> second (actionToIOAuto oa) >>> arr fst
+
+
+> asyncMidiHelper asy rinit (_defb, defc) dd f = asy (ini, term) sf >>> arr listToMaybe >>> hold defc where
+>   sf _ = proc b -> do
+>     rec r <- delay rinit -< r'
+>         (omt, r', c) <- arr f -< (r,b)
+>     actionToIOAuto action -< omt
+>     returnA -< c
+>   ini = return ()
+>   term _ = putStrLn "MIDI back-end terminated."
+>   action omt = do
+>     let td = sum $ map snd omt
+>     forM_ omt $ \(om, t) -> do
+>       forM_ om $ \(odev,mm) -> do
+>         outputMidi odev
+>         forM_ mm (\m -> deliverMidiEvent odev (0, m))
+>       when (t > 0) (threadDelay t)
+>     when (td <= 0) (threadDelay dd)
+
+
+
+> asyncMidi :: NFData c => r -> (b,c) -> Int -> ((r, b) -> ([([(OutputDeviceID, [MidiMessage])], Int)], r, c)) -> UISF b c
+> asyncMidi = asyncMidiHelper asyncCIO
+
+> asyncMidiOn :: NFData c => Int -> r -> (b,c) -> Int -> ((r, b) -> ([([(OutputDeviceID, [MidiMessage])], Int)], r, c)) -> UISF b c
+> asyncMidiOn n = asyncMidiHelper (asyncCIOOn n)
+
+=========================================================
+
+From UISFCompat.lhs
+
+
+> asyncUISFV x = asyncVT x
+
+The below function is useful for making use of asyncUISF*
+which both make use of Automatons rather than SFs.
+NOTE: Actually, SF and Automaton (->) are the same thing.  Perhaps we should 
+      replace our definition of SF with just a type synonym instead.
+
+> toAutomaton :: forall a b . SF a b -> Automaton (->) a b
+> toAutomaton ~(SF f) = Automaton $ \a -> let (b, sf) = f a in (b, toAutomaton sf)
+
+The below function is useful for directly asynchronizing AudSFs and CtrSFs in UISF.
+
+> clockedSFToUISF :: forall a b c . (NFData b, Clock c) => DeltaT -> SigFun c a b -> UISF a [(b, Time)]
+> clockedSFToUISF buffer ~(ArrowP sf) = let r = rate (undefined :: c) 
+>   in asyncUISFV r buffer (toAutomaton sf)
+
+This function is the standard UISF asynchronous thread handler:
+
+> uisfAsyncThreadHandler :: ThreadId -> UISF a a
+> uisfAsyncThreadHandler = addTerminationProc . killThread

@@ -0,0 +1,201 @@+> {-#  LANGUAGE FlexibleInstances, TypeSynonymInstances  #-}
+> module HSoM.Performance where
+> import Euterpea
+
+From Euterpea we have:
+
+type Performance = [MEvent]
+
+data MEvent = MEvent {  eTime    :: PTime, 
+                      eInst    :: InstrumentName, 
+                      ePitch   :: AbsPitch,
+                      eDur     :: DurT, 
+                      eVol     :: Volume, 
+                      eParams  :: [Double]}
+     deriving (Show,Eq,Ord)
+
+type PTime     = Rational
+type DurT      = Rational
+
+merge :: Performance -> Performance -> Performance
+merge []          es2         =  es2
+merge es1         []          =  es1
+merge a@(e1:es1)  b@(e2:es2)  =  
+  if eTime e1 < eTime e2  then  e1  : merge es1 b
+                          else  e2  : merge a es2
+
+
+> data Context a = Context {  cTime    :: PTime, 
+>                             cPlayer  :: Player a, 
+>                             cInst    :: InstrumentName, 
+>                             cDur     :: DurT, 
+>                             cPch     :: AbsPitch,
+>                             cVol     :: Volume,
+>                             cKey     :: (PitchClass, Mode) }
+>      deriving Show
+
+> metro              :: Int -> Dur -> DurT
+> metro setting dur  = 60 / (fromIntegral setting * dur)
+
+> type PMap a  = PlayerName -> Player a
+
+> hsomPerform :: PMap a -> Context a -> Music a -> Performance
+> hsomPerform pm c m = fst (perf pm c m)
+
+> perf :: PMap a -> Context a -> Music a -> (Performance, DurT)
+> perf pm 
+>   c@Context {cTime = t, cPlayer = pl, cDur = dt, cPch = k} m =
+>   case m of
+>      Prim (Note d p)            -> (playNote pl c d p, d*dt)
+>      Prim (Rest d)              -> ([], d*dt)
+>      m1 :+: m2                  ->  
+>              let  (pf1,d1)  = perf pm c m1
+>                   (pf2,d2)  = perf pm (c {cTime = t+d1}) m2
+>              in (pf1++pf2, d1+d2)
+>      m1 :=: m2                  -> 
+>              let  (pf1,d1)  = perf pm c m1
+>                   (pf2,d2)  = perf pm c m2
+>              in (merge pf1 pf2, max d1 d2)
+>      Modify  (Tempo r)       m  -> perf pm (c {cDur = dt / r})    m
+>      Modify  (Transpose p)   m  -> perf pm (c {cPch = k + p})     m
+>      Modify  (Instrument i)  m  -> perf pm (c {cInst = i})        m
+>      Modify  (KeySig pc mo)  m  -> perf pm (c {cKey = (pc,mo)})   m
+>      Modify  (Phrase pas)    m  -> interpPhrase pl pm c pas       m
+>      Modify  (Custom s)     m  -> 
+>          if take 7 s == "Player " then perf pm (c {cPlayer = pm $ drop 7 s})  m
+>          else perf pm c m
+
+> type PlayerName = String
+
+> data Player a = MkPlayer {  pName         :: PlayerName, 
+>                             playNote      :: NoteFun a,
+>                             interpPhrase  :: PhraseFun a}
+
+> type NoteFun a    =  Context a -> Dur -> a -> Performance
+> type PhraseFun a  =  PMap a -> Context a -> [PhraseAttribute]
+>                      -> Music a -> (Performance, DurT)
+
+> instance Show a => Show (Player a) where
+>    show p = pName p
+
+> defPlayer  :: Player Note1
+> defPlayer  = MkPlayer 
+>              {  pName         = "Default",
+>                 playNote      = defPlayNote      defNasHandler,
+>                 interpPhrase  = defInterpPhrase  defPasHandler}
+
+> defPlayNote ::  (Context (Pitch,[a]) -> a -> MEvent-> MEvent)
+>                 -> NoteFun (Pitch, [a])
+> defPlayNote nasHandler 
+>   c@(Context cTime cPlayer cInst cDur cPch cVol cKey) d (p,nas) =
+>     let initEv = MEvent {  eTime    = cTime,     eInst  = cInst,
+>                           eDur     = d * cDur,  eVol = cVol,
+>                           ePitch   = absPitch p + cPch,
+>                           eParams  = [] }
+>     in [ foldr (nasHandler c) initEv nas ]
+
+> defNasHandler :: Context a -> NoteAttribute -> MEvent -> MEvent
+> defNasHandler c (Volume v)     ev = ev {eVol = v}
+> defNasHandler c (Params pms)   ev = ev {eParams = pms}
+> defNasHandler _            _   ev = ev
+
+> defInterpPhrase :: 
+>    (PhraseAttribute -> Performance -> Performance) -> 
+>    (  PMap a -> Context a -> [PhraseAttribute] ->  -- PhraseFun
+>       Music a -> (Performance, DurT) )
+> defInterpPhrase pasHandler pm context pas m =
+>        let (pf,dur) = perf pm context m
+>        in (foldr pasHandler pf pas, dur)
+
+> defPasHandler :: PhraseAttribute -> Performance -> Performance
+> defPasHandler (Dyn (Accent x))    = 
+>     map (\e -> e {eVol = round (x * fromIntegral (eVol e))})
+> defPasHandler (Art (Staccato x))  = 
+>     map (\e -> e {eDur = x * eDur e})
+> defPasHandler (Art (Legato   x))  = 
+>     map (\e -> e {eDur = x * eDur e})
+> defPasHandler _                   = id
+
+
+> defPMap "Fancy"    = fancyPlayer
+> defPMap "Default"  = defPlayer
+> defPMap n          = defPlayer { pName = n }
+
+> defCon  :: Context Note1
+> defCon  = Context {  cTime    = 0,
+>                      cPlayer  = fancyPlayer,
+>                      cInst    = AcousticGrandPiano,
+>                      cDur     = metro 120 qn,
+>                      cPch     = 0,
+>                      cKey     = (C, Major),
+>                      cVol     = 127 }
+
+> fancyPlayer :: Player (Pitch, [NoteAttribute])
+> fancyPlayer  = MkPlayer {  pName         = "Fancy",
+>                            playNote      = defPlayNote defNasHandler,
+>                            interpPhrase  = fancyInterpPhrase}
+
+> fancyInterpPhrase             :: PhraseFun a
+> fancyInterpPhrase pm c [] m   = perf pm c m
+> fancyInterpPhrase pm 
+>   c@Context {  cTime = t, cPlayer = pl, cInst = i, 
+>                cDur = dt, cPch = k, cVol = v}
+>   (pa:pas) m =
+>   let  pfd@(pf,dur)  =  fancyInterpPhrase pm c pas m
+>        loud x        =  fancyInterpPhrase pm c (Dyn (Loudness x) : pas) m
+>        stretch x     =  let  t0 = eTime (head pf);  r  = x/dur
+>                              upd (e@MEvent {eTime = t, eDur = d}) = 
+>                                let  dt  = t-t0
+>                                     t'  = (1+dt*r)*dt + t0
+>                                     d'  = (1+(2*dt+d)*r)*d
+>                                in e {eTime = t', eDur = d'}
+>                         in (map upd pf, (1+x)*dur)
+>        inflate x     =  let  t0  = eTime (head pf);  
+>                              r   = x/dur
+>                              upd (e@MEvent {eTime = t, eVol = v}) = 
+>                                  e {eVol =  round ( (1+(t-t0)*r) * 
+>                                             fromIntegral v)}
+>                         in (map upd pf, dur)
+>   in case pa of
+>     Dyn (Accent x) ->
+>         ( map (\e-> e {eVol = round (x * fromIntegral (eVol e))}) pf, dur)
+>     Dyn (StdLoudness l) -> 
+>         case l of 
+>            PPP  -> loud 40;       PP -> loud 50;   P    -> loud 60
+>            MP   -> loud 70;       SF -> loud 80;   MF   -> loud 90
+>            NF   -> loud 100;      FF -> loud 110;  FFF  -> loud 120
+>     Dyn (Loudness x)     ->  fancyInterpPhrase pm
+>                              c{cVol = round x} pas m
+>     Dyn (Crescendo x)    ->  inflate   x ; Dyn (Diminuendo x)  -> inflate (-x)
+>     Tmp (Ritardando x)   ->  stretch   x ; Tmp (Accelerando x) -> stretch (-x)
+>     Art (Staccato x)     ->  (map (\e-> e {eDur = x * eDur e}) pf, dur)
+>     Art (Legato x)       ->  (map (\e-> e {eDur = x * eDur e}) pf, dur)
+>     Art (Slurred x)      -> 
+>         let  lastStartTime  = foldr (\e t -> max (eTime e) t) 0 pf
+>              setDur e       =   if eTime e < lastStartTime
+>                                 then e {eDur = x * eDur e}
+>                                 else e
+>         in (map setDur pf, dur) 
+>     Art _                -> pfd
+>     Orn _                -> pfd
+
+> class Performable a where
+>   perfDur :: PMap Note1 -> Context Note1 -> Music a -> (Performance, DurT)
+
+> instance Performable Note1 where
+>   perfDur pm c m = perf pm c m
+
+> instance Performable Pitch where
+>   perfDur pm c = perfDur pm c . toMusic1
+
+> instance Performable (Pitch, Volume) where
+>   perfDur pm c = perfDur pm c . toMusic1
+
+> defToPerf :: Performable a => Music a -> Performance
+> defToPerf = fst . perfDur defPMap defCon
+
+> toPerf :: Performable a => PMap Note1 -> Context Note1 -> Music a -> Performance
+> toPerf pm con = fst . perfDur pm con
+
+> playA myPMap myCon = playC defParams{perfAlg=hsomPerform myPMap myCon}
+> writeMidiA fn myPMap myCon = exportMidiFile fn . toMidi . hsomPerform myPMap myCon

@@ -0,0 +1,20 @@+Copyright (c) 2008-2015 Paul Hudak and Donya Quick
+
+This software is provided 'as-is', without any express or implied
+warranty.  In no event will the authors be held liable for any damages
+arising from the use of this software.
+
+Permission is granted to anyone to use this software for any purpose,
+including commercial applications, and to alter it and redistribute it
+freely, subject to the following restrictions:
+
+1. The origin of this software must not be misrepresented; you must not
+   claim that you wrote the original software.  If you use this software
+   in a product, an acknowledgment in the product documentation would
+   be appreciated but is not required.
+
+2. Altered source versions must be plainly marked as such, and must not
+   be misrepresented as being the original software.
+
+3. This notice may not be removed or altered from any source
+   distribution.

@@ -0,0 +1,51 @@+import Distribution.Simple
+main = defaultMain
+
+-- January 18, 2014
+-- The following setup script uses the CCA preprocessor (ccap) to preprocess 
+-- certain *.as files in the Euterpea code base.  As of January 18, 2014, only 
+-- one file is being preprocessed in this way (Euterpea.IO.Audio.Basics), and 
+-- as some users have had difficulty with installations due to this 
+-- preprocessing step, we are removing it from the installation procedure.
+-- 
+-- Now, to process *.as files, one can directly use the ArrowWrap module in 
+-- Euterpea.  In ArrowWrap, all files to be preprocessed must be declared in 
+-- the list called fileList.  Then, simply run main.
+-- 
+-- If this preprocessor is going to be reenabled, or if ArrowWrap is going 
+-- to be used, one must either add haskell-src-exts >= 1.14.0 to the cabal 
+-- build-depends or just install it directly.
+{-
+module Main (main) where
+
+import Distribution.Simple
+import Distribution.Simple.PreProcess
+import Distribution.Simple.Program
+import Distribution.Simple.Utils
+import System.Exit
+
+import ArrowWrap
+
+findArrowP verbosity = do
+  a <- findProgramLocation verbosity "ccap"
+  case a of 
+    Nothing -> error "Preprocessor ccap not found. Please make sure the \
+                     \CCA library is already installed, and ccap is in \
+                     \your PATH environment."
+    Just p  -> return p
+
+ppArrow bi lbi = PreProcessor {
+    platformIndependent = True,
+    runPreProcessor = 
+      mkSimplePreProcessor $ \inFile outFile verbosity ->
+        do info verbosity (inFile ++ " has been preprocessed to " ++ outFile)
+           arrowp <- findArrowP verbosity
+           runArrowP arrowp inFile outFile
+  }
+
+myHooks = simpleUserHooks 
+            { hookedPreProcessors = ("as", ppArrow) : knownSuffixHandlers }
+
+main :: IO ()
+main = defaultMainWithHooks myHooks
+-}

@@ -0,0 +1,135 @@+-- Algorithms taken from Dodge and Jerse's Computer Music: Synthesis,
+-- Composition, and Performance, Chapter 11. 
+
+module System.Random.Distributions (
+  -- * Random Distributions
+  linear, exponential, bilExp, gaussian, cauchy, poisson, frequency
+
+  -- * Utility Functions
+  , rands
+
+  ) where
+
+import System.Random
+
+{- | Given a random number generator, generates a linearly distributed
+random variable between 0 and 1.  Returns the random value together
+with a new random number generator.  The probability density function
+is given by
+
+> f(x) = 2(1-x)  0 <= x <= 1
+>      = 0       otherwise
+
+-}
+linear :: (RandomGen g, Floating a, Random a, Ord a) => g -> (a,g)
+linear g0 = 
+    let (r1, g1) = randomR (0, 1) g0
+        (r2, g2) = randomR (0, 1) g1
+    in (min r1 r2, g2)
+
+{- | Takes a random number generator and produces another one
+ that avoids generating the given number.
+-}
+avoid :: (Random a, Eq a, RandomGen g) => a -> (g -> (a,g)) -> g -> (a,g)
+avoid x f g = if r == x then avoid x f g' else (r,g')
+    where (r,g') = f g
+
+{- | Generates an exponentially distributed random variable given a
+spread parameter lambda.  A larger spread increases the probability of
+generating a small number.  The mean of the distribution is
+1/lambda.  The range of the generated number is [0,inf] although
+the chance of getting a very large number is very small.
+
+The probability density function is given by
+
+> f(x) = lambda e^(-lambda * x)
+-}
+exponential :: (RandomGen g, Floating a, Random a, Eq a) => 
+            a  -- ^ horizontal spread of the function.
+         -> g  -- ^ a random number generator.
+         -> (a,g)
+exponential lambda g0 = (-log r1 / lambda, g1)
+    where (r1, g1) = avoid 0 random g0
+
+{- | Generates a random number with a bilateral exponential distribution.  
+Similar to exponential, but the mean of the distribution is 0 and
+50% of the results fall between (-1/lambda, 1/lambda).
+
+-}
+bilExp :: (Floating a, Ord a, Random a, RandomGen g) =>
+          a    -- ^ horizontal spread of the function.
+       -> g    -- ^ a random number generator.
+       -> (a,g)
+bilExp lambda g0 = 
+    let (r', g1) = avoid 0 random g0
+        r = 2 * r'
+        u = if r > 1 then 2 - r else r
+    in (signum (1 - r) * log u / lambda, g1)
+
+{- | Generates a random number with a Gaussian distribution.  
+-}
+gaussian :: (Floating a, Random a, RandomGen g) =>
+            a     -- ^ standard deviation.
+         -> a     -- ^ mean.
+         -> g     -- ^ a random number generator.
+         -> (a,g)
+gaussian stddev center g0 = 
+    let n = 12
+        s = sum $ take n $ randoms g0
+    in (stddev * (s - fromIntegral n / 2) + center, fst (split g0))
+
+{- | Generates a Cauchy-distributed random variable.  
+The distribution is symmetric with a mean of 0.  
+
+-}
+cauchy :: (Floating a, Random a, RandomGen g, Eq a) =>
+          a   -- ^ alpha (density).
+       -> g   -- ^ a random number generator.
+       -> (a,g)
+cauchy density g0 = (density * tan (u * pi), g1)
+    where (u, g1) = avoid 0.5 random g0
+
+{- | Generates a Poisson-distributed random variable.
+The given parameter lambda is the mean of the distribution.  
+If lambda is an integer, the probability that the result j=lambda-1
+will be as great as that of j=lambda.  The Poisson distribution
+is discrete. The returned value will be a non-negative
+integer.
+
+-}
+poisson :: (Num t, Ord a, Floating a, RandomGen g, Random a) =>
+           a -> g -> (t, g)
+poisson lambda g0 = (k 0 us, g1)
+    where v   = exp (-lambda)
+          us  = scanl1 (*) (randoms g0)
+          g1  = fst (split g0)
+          k n (u:us)
+              | u >= v     = k (n+1) us
+              | otherwise  = n
+          k _ [] = error "System.Random.Distributions.poisson: randoms did not return an infinite list"
+
+{- | Given a list of weight-value pairs, generates a value randomly picked
+from the list, weighting the probability of choosing each value by the 
+weight given.
+
+-}
+frequency :: (Floating w, Ord w, Random w, RandomGen g) 
+             => [(w, a)] -> g -> (a,g)
+frequency xs g0 = (pick r xs, g1)
+    where (r, g1) = randomR (0, tot) g0
+          tot = sum (map fst xs)
+          pick n ((w,a):xs) 
+             | n <= w    = a
+             | otherwise = pick (n-w) xs
+          pick _ [] = error "System.Random.Distributions.frequency: The impossible happened"
+
+
+{- | Given a function generating a random number variable and a random
+number generator, produces an infinite list of random values 
+generated from the given function.
+
+-}
+rands :: (RandomGen g, Random a) => 
+         (g -> (a,g)) -> g -> [a]
+rands f g = x : rands f g' where (x,g') = f g
+

@@ -0,0 +1,3 @@+Library to accompany the Haskell School of Music textbook.
+See License file for licensing information.
+Send questions/comments to Donya Quick (donyaquick@gmail.com).