diff --git a/.git/COMMIT_EDITMSG b/.git/COMMIT_EDITMSG new file mode 100644 --- /dev/null +++ b/.git/COMMIT_EDITMSG @@ -0,0 +1,4 @@ +dependency caps and audio render update + +Dependencies are capped more strictly and audio rendering will now clip +by default (rather than overflowing) when values exceed +/-1. diff --git a/.git/FETCH_HEAD b/.git/FETCH_HEAD new file mode 100644 --- /dev/null +++ b/.git/FETCH_HEAD @@ -0,0 +1,1 @@ +896621f361866ce787d0bad1dfd5434d371b5679 branch 'master' of https://github.com/Euterpea/Euterpea2 diff --git a/.git/HEAD b/.git/HEAD new file mode 100644 --- /dev/null +++ b/.git/HEAD @@ -0,0 +1,1 @@ +ref: refs/heads/master diff --git a/.git/ORIG_HEAD b/.git/ORIG_HEAD new file mode 100644 --- /dev/null +++ b/.git/ORIG_HEAD @@ -0,0 +1,1 @@ +b1eb4e6bd0c330b7cbe720d59df11bf3105b2b85 diff --git a/.git/config b/.git/config new file mode 100644 --- /dev/null +++ b/.git/config @@ -0,0 +1,14 @@ +[core] + repositoryformatversion = 0 + filemode = false + bare = false + logallrefupdates = true + symlinks = false + ignorecase = true + hideDotFiles = dotGitOnly +[remote "origin"] + url = https://github.com/Euterpea/Euterpea2.git + fetch = +refs/heads/*:refs/remotes/origin/* +[branch "master"] + remote = origin + merge = refs/heads/master diff --git a/.git/description b/.git/description new file mode 100644 --- /dev/null +++ b/.git/description @@ -0,0 +1,1 @@ +Unnamed repository; edit this file 'description' to name the repository. diff --git a/.git/hooks/applypatch-msg.sample b/.git/hooks/applypatch-msg.sample new file mode 100644 --- /dev/null +++ b/.git/hooks/applypatch-msg.sample @@ -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+"$@"} +: diff --git a/.git/hooks/commit-msg.sample b/.git/hooks/commit-msg.sample new file mode 100644 --- /dev/null +++ b/.git/hooks/commit-msg.sample @@ -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 +} diff --git a/.git/hooks/post-update.sample b/.git/hooks/post-update.sample new file mode 100644 --- /dev/null +++ b/.git/hooks/post-update.sample @@ -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 diff --git a/.git/hooks/pre-applypatch.sample b/.git/hooks/pre-applypatch.sample new file mode 100644 --- /dev/null +++ b/.git/hooks/pre-applypatch.sample @@ -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+"$@"} +: diff --git a/.git/hooks/pre-commit.sample b/.git/hooks/pre-commit.sample new file mode 100644 --- /dev/null +++ b/.git/hooks/pre-commit.sample @@ -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 -- diff --git a/.git/hooks/pre-push.sample b/.git/hooks/pre-push.sample new file mode 100644 --- /dev/null +++ b/.git/hooks/pre-push.sample @@ -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: +# +# +# +# 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 diff --git a/.git/hooks/pre-rebase.sample b/.git/hooks/pre-rebase.sample new file mode 100644 --- /dev/null +++ b/.git/hooks/pre-rebase.sample @@ -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". diff --git a/.git/hooks/prepare-commit-msg.sample b/.git/hooks/prepare-commit-msg.sample new file mode 100644 --- /dev/null +++ b/.git/hooks/prepare-commit-msg.sample @@ -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" diff --git a/.git/hooks/update.sample b/.git/hooks/update.sample new file mode 100644 --- /dev/null +++ b/.git/hooks/update.sample @@ -0,0 +1,128 @@ +#!/bin/sh +# +# An example hook script to blocks 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 )" >&2 + exit 1 +fi + +if [ -z "$refname" -o -z "$oldrev" -o -z "$newrev" ]; then + echo "usage: $0 " >&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 diff --git a/.git/index b/.git/index new file mode 100644 Binary files /dev/null and b/.git/index differ diff --git a/.git/info/exclude b/.git/info/exclude new file mode 100644 --- /dev/null +++ b/.git/info/exclude @@ -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] +# *~ diff --git a/.git/logs/HEAD b/.git/logs/HEAD new file mode 100644 --- /dev/null +++ b/.git/logs/HEAD @@ -0,0 +1,21 @@ +0000000000000000000000000000000000000000 f8154e00ed87f700e71790ab9966fc8414807b8a donya 1450296215 -0500 commit (initial): Initial commit +f8154e00ed87f700e71790ab9966fc8414807b8a 4f1c6161cd6b76930d6ab63910f661e4c9280c64 donya 1450311885 -0500 commit: Renaming & restructuring +4f1c6161cd6b76930d6ab63910f661e4c9280c64 85af43da1948ffbdf3b1fff153d88119842852b9 donya 1450315255 -0500 commit: Field renaming for MContext +85af43da1948ffbdf3b1fff153d88119842852b9 5ea6aeb96d1894c8e38cc8f865fadb85bcacaad2 donya 1451596992 -0500 pull --progress --rebase --prune origin master: checkout 5ea6aeb96d1894c8e38cc8f865fadb85bcacaad2 +5ea6aeb96d1894c8e38cc8f865fadb85bcacaad2 5ea6aeb96d1894c8e38cc8f865fadb85bcacaad2 donya 1451596993 -0500 rebase finished: returning to refs/heads/master +5ea6aeb96d1894c8e38cc8f865fadb85bcacaad2 8ca262164429aa9765dfd2fa47331f3349869329 donya 1451597251 -0500 commit: Dependency on UISF removed +8ca262164429aa9765dfd2fa47331f3349869329 9bc107a80e863822b328bf64a795c3ef54e001b1 donya 1451597503 -0500 commit: Reame updated +9bc107a80e863822b328bf64a795c3ef54e001b1 31ba3d0f73a9b2159cfa27d8e11e275daee8c481 donya 1451954740 -0500 pull --progress --rebase --prune origin master: checkout 31ba3d0f73a9b2159cfa27d8e11e275daee8c481 +31ba3d0f73a9b2159cfa27d8e11e275daee8c481 31ba3d0f73a9b2159cfa27d8e11e275daee8c481 donya 1451954740 -0500 rebase finished: returning to refs/heads/master +31ba3d0f73a9b2159cfa27d8e11e275daee8c481 877cdbe88a44c2962bc9bc66e021ad8a9c185268 Donya Quick 1452131260 -0500 commit: Added writeWav +877cdbe88a44c2962bc9bc66e021ad8a9c185268 323835bed7c98ee14e0445126cfc2df5cbed9bae Donya Quick 1452451734 -0500 pull --progress --rebase --prune origin master: checkout 323835bed7c98ee14e0445126cfc2df5cbed9bae +323835bed7c98ee14e0445126cfc2df5cbed9bae 323835bed7c98ee14e0445126cfc2df5cbed9bae Donya Quick 1452451735 -0500 rebase finished: returning to refs/heads/master +323835bed7c98ee14e0445126cfc2df5cbed9bae 73bc3b4c2d2ca70c8a8844a118e3d3db3aeb4d0c Donya Quick 1452537818 -0500 pull --progress --rebase --prune origin master: checkout 73bc3b4c2d2ca70c8a8844a118e3d3db3aeb4d0c +73bc3b4c2d2ca70c8a8844a118e3d3db3aeb4d0c 73bc3b4c2d2ca70c8a8844a118e3d3db3aeb4d0c Donya Quick 1452537818 -0500 rebase finished: returning to refs/heads/master +73bc3b4c2d2ca70c8a8844a118e3d3db3aeb4d0c 61d09a71180e5a1a4ea1d893f82a4709d8e79c27 Donya Quick 1453084077 -0500 commit: removeInstruments fixed +61d09a71180e5a1a4ea1d893f82a4709d8e79c27 b1eb4e6bd0c330b7cbe720d59df11bf3105b2b85 Donya Quick 1455221540 -0500 commit: invert fix +b1eb4e6bd0c330b7cbe720d59df11bf3105b2b85 086557985556cc77f5a559d74d0502a2d761babd Donya Quick 1456862557 -0500 pull --progress --rebase --prune origin master: checkout 086557985556cc77f5a559d74d0502a2d761babd +086557985556cc77f5a559d74d0502a2d761babd 086557985556cc77f5a559d74d0502a2d761babd Donya Quick 1456862558 -0500 rebase finished: returning to refs/heads/master +086557985556cc77f5a559d74d0502a2d761babd 7a5e865406dc8dc8d2bd730b7625656fc4c80036 Donya Quick 1459959169 -0400 commit: Dependency version changes +7a5e865406dc8dc8d2bd730b7625656fc4c80036 896621f361866ce787d0bad1dfd5434d371b5679 Donya Quick 1461339370 -0400 commit: Exports added +896621f361866ce787d0bad1dfd5434d371b5679 4afd6ed7d81c474bf5c88c395a584e4f68b039ce Donya Quick 1462819240 -0400 commit: dependency caps and audio render update diff --git a/.git/logs/refs/heads/master b/.git/logs/refs/heads/master new file mode 100644 --- /dev/null +++ b/.git/logs/refs/heads/master @@ -0,0 +1,16 @@ +0000000000000000000000000000000000000000 f8154e00ed87f700e71790ab9966fc8414807b8a donya 1450296215 -0500 commit (initial): Initial commit +f8154e00ed87f700e71790ab9966fc8414807b8a 4f1c6161cd6b76930d6ab63910f661e4c9280c64 donya 1450311885 -0500 commit: Renaming & restructuring +4f1c6161cd6b76930d6ab63910f661e4c9280c64 85af43da1948ffbdf3b1fff153d88119842852b9 donya 1450315255 -0500 commit: Field renaming for MContext +85af43da1948ffbdf3b1fff153d88119842852b9 5ea6aeb96d1894c8e38cc8f865fadb85bcacaad2 donya 1451596992 -0500 rebase finished: refs/heads/master onto 5ea6aeb96d1894c8e38cc8f865fadb85bcacaad2 +5ea6aeb96d1894c8e38cc8f865fadb85bcacaad2 8ca262164429aa9765dfd2fa47331f3349869329 donya 1451597251 -0500 commit: Dependency on UISF removed +8ca262164429aa9765dfd2fa47331f3349869329 9bc107a80e863822b328bf64a795c3ef54e001b1 donya 1451597503 -0500 commit: Reame updated +9bc107a80e863822b328bf64a795c3ef54e001b1 31ba3d0f73a9b2159cfa27d8e11e275daee8c481 donya 1451954740 -0500 rebase finished: refs/heads/master onto 31ba3d0f73a9b2159cfa27d8e11e275daee8c481 +31ba3d0f73a9b2159cfa27d8e11e275daee8c481 877cdbe88a44c2962bc9bc66e021ad8a9c185268 Donya Quick 1452131260 -0500 commit: Added writeWav +877cdbe88a44c2962bc9bc66e021ad8a9c185268 323835bed7c98ee14e0445126cfc2df5cbed9bae Donya Quick 1452451735 -0500 rebase finished: refs/heads/master onto 323835bed7c98ee14e0445126cfc2df5cbed9bae +323835bed7c98ee14e0445126cfc2df5cbed9bae 73bc3b4c2d2ca70c8a8844a118e3d3db3aeb4d0c Donya Quick 1452537818 -0500 rebase finished: refs/heads/master onto 73bc3b4c2d2ca70c8a8844a118e3d3db3aeb4d0c +73bc3b4c2d2ca70c8a8844a118e3d3db3aeb4d0c 61d09a71180e5a1a4ea1d893f82a4709d8e79c27 Donya Quick 1453084077 -0500 commit: removeInstruments fixed +61d09a71180e5a1a4ea1d893f82a4709d8e79c27 b1eb4e6bd0c330b7cbe720d59df11bf3105b2b85 Donya Quick 1455221540 -0500 commit: invert fix +b1eb4e6bd0c330b7cbe720d59df11bf3105b2b85 086557985556cc77f5a559d74d0502a2d761babd Donya Quick 1456862558 -0500 rebase finished: refs/heads/master onto 086557985556cc77f5a559d74d0502a2d761babd +086557985556cc77f5a559d74d0502a2d761babd 7a5e865406dc8dc8d2bd730b7625656fc4c80036 Donya Quick 1459959169 -0400 commit: Dependency version changes +7a5e865406dc8dc8d2bd730b7625656fc4c80036 896621f361866ce787d0bad1dfd5434d371b5679 Donya Quick 1461339370 -0400 commit: Exports added +896621f361866ce787d0bad1dfd5434d371b5679 4afd6ed7d81c474bf5c88c395a584e4f68b039ce Donya Quick 1462819240 -0400 commit: dependency caps and audio render update diff --git a/.git/logs/refs/remotes/origin/HEAD b/.git/logs/refs/remotes/origin/HEAD new file mode 100644 --- /dev/null +++ b/.git/logs/refs/remotes/origin/HEAD @@ -0,0 +1,1 @@ +0000000000000000000000000000000000000000 9bc107a80e863822b328bf64a795c3ef54e001b1 Donya Quick 1451691193 -0800 clone: from https://github.com/Euterpea/Euterpea2.git diff --git a/.git/logs/refs/remotes/origin/master b/.git/logs/refs/remotes/origin/master new file mode 100644 --- /dev/null +++ b/.git/logs/refs/remotes/origin/master @@ -0,0 +1,16 @@ +0000000000000000000000000000000000000000 f8154e00ed87f700e71790ab9966fc8414807b8a donya 1450296225 -0500 update by push +f8154e00ed87f700e71790ab9966fc8414807b8a 4f1c6161cd6b76930d6ab63910f661e4c9280c64 donya 1450311899 -0500 update by push +4f1c6161cd6b76930d6ab63910f661e4c9280c64 85af43da1948ffbdf3b1fff153d88119842852b9 donya 1450315267 -0500 update by push +85af43da1948ffbdf3b1fff153d88119842852b9 5ea6aeb96d1894c8e38cc8f865fadb85bcacaad2 donya 1451596991 -0500 pull --progress --rebase --prune origin master: fast-forward +5ea6aeb96d1894c8e38cc8f865fadb85bcacaad2 8ca262164429aa9765dfd2fa47331f3349869329 donya 1451597262 -0500 update by push +8ca262164429aa9765dfd2fa47331f3349869329 9bc107a80e863822b328bf64a795c3ef54e001b1 donya 1451597514 -0500 update by push +9bc107a80e863822b328bf64a795c3ef54e001b1 31ba3d0f73a9b2159cfa27d8e11e275daee8c481 donya 1451954738 -0500 pull --progress --rebase --prune origin master: fast-forward +31ba3d0f73a9b2159cfa27d8e11e275daee8c481 877cdbe88a44c2962bc9bc66e021ad8a9c185268 Donya Quick 1452131278 -0500 update by push +877cdbe88a44c2962bc9bc66e021ad8a9c185268 323835bed7c98ee14e0445126cfc2df5cbed9bae Donya Quick 1452451733 -0500 pull --progress --rebase --prune origin master: fast-forward +323835bed7c98ee14e0445126cfc2df5cbed9bae 73bc3b4c2d2ca70c8a8844a118e3d3db3aeb4d0c Donya Quick 1452537816 -0500 pull --progress --rebase --prune origin master: fast-forward +73bc3b4c2d2ca70c8a8844a118e3d3db3aeb4d0c 61d09a71180e5a1a4ea1d893f82a4709d8e79c27 Donya Quick 1453084100 -0500 update by push +61d09a71180e5a1a4ea1d893f82a4709d8e79c27 b1eb4e6bd0c330b7cbe720d59df11bf3105b2b85 Donya Quick 1455221559 -0500 update by push +b1eb4e6bd0c330b7cbe720d59df11bf3105b2b85 086557985556cc77f5a559d74d0502a2d761babd Donya Quick 1456862556 -0500 pull --progress --rebase --prune origin master: fast-forward +086557985556cc77f5a559d74d0502a2d761babd 7a5e865406dc8dc8d2bd730b7625656fc4c80036 Donya Quick 1459959184 -0400 update by push +7a5e865406dc8dc8d2bd730b7625656fc4c80036 896621f361866ce787d0bad1dfd5434d371b5679 Donya Quick 1461339414 -0400 update by push +896621f361866ce787d0bad1dfd5434d371b5679 4afd6ed7d81c474bf5c88c395a584e4f68b039ce Donya Quick 1462819260 -0400 update by push diff --git a/.git/objects/07/34c378fd990e9ab7a7f9fb2fe361a84d41e95e b/.git/objects/07/34c378fd990e9ab7a7f9fb2fe361a84d41e95e new file mode 100644 Binary files /dev/null and b/.git/objects/07/34c378fd990e9ab7a7f9fb2fe361a84d41e95e differ diff --git a/.git/objects/08/6557985556cc77f5a559d74d0502a2d761babd b/.git/objects/08/6557985556cc77f5a559d74d0502a2d761babd new file mode 100644 --- /dev/null +++ b/.git/objects/08/6557985556cc77f5a559d74d0502a2d761babd @@ -0,0 +1,1 @@ +x•ŽKŽÂ0Yû}P·q$4š9ÀH,¸€»ÝV²Àaƒ4·å¬^mJõd¹ÝæÖÓ¡¯ª0&‹Hc°Ö9‰å‡Z|µ‰Ô¹Š•$š{^µu`Rö¹ 8‡<ë`±„±T"®Ž0°åL~ôiY¡,í?ÃyŸçßwÓ¾I¾ëé _@>Ää&G ˆFöw]?õÌuù}l³Ìm빉B}Çx»Ì]&È¥h1/v(M£ diff --git a/.git/objects/0e/668119469c51796e6d599be3210067a29b2519 b/.git/objects/0e/668119469c51796e6d599be3210067a29b2519 new file mode 100644 Binary files /dev/null and b/.git/objects/0e/668119469c51796e6d599be3210067a29b2519 differ diff --git a/.git/objects/0f/40bd8185ca44ac857d80e28f1571f7dc4c2f0b b/.git/objects/0f/40bd8185ca44ac857d80e28f1571f7dc4c2f0b new file mode 100644 Binary files /dev/null and b/.git/objects/0f/40bd8185ca44ac857d80e28f1571f7dc4c2f0b differ diff --git a/.git/objects/12/422ea17098ee8ef49c69ec4f706610531ff7a5 b/.git/objects/12/422ea17098ee8ef49c69ec4f706610531ff7a5 new file mode 100644 Binary files /dev/null and b/.git/objects/12/422ea17098ee8ef49c69ec4f706610531ff7a5 differ diff --git a/.git/objects/15/3be0645392d0fcd358365100287c8153667803 b/.git/objects/15/3be0645392d0fcd358365100287c8153667803 new file mode 100644 Binary files /dev/null and b/.git/objects/15/3be0645392d0fcd358365100287c8153667803 differ diff --git a/.git/objects/18/120c7891df6d6b7a4edb6505c550b9a48dcfc6 b/.git/objects/18/120c7891df6d6b7a4edb6505c550b9a48dcfc6 new file mode 100644 Binary files /dev/null and b/.git/objects/18/120c7891df6d6b7a4edb6505c550b9a48dcfc6 differ diff --git a/.git/objects/19/0569154271005cf561a49b93e0dacf5d237670 b/.git/objects/19/0569154271005cf561a49b93e0dacf5d237670 new file mode 100644 Binary files /dev/null and b/.git/objects/19/0569154271005cf561a49b93e0dacf5d237670 differ diff --git a/.git/objects/19/a4d9c645f7e4b9f5414e5bb1b45de9a1c3ea40 b/.git/objects/19/a4d9c645f7e4b9f5414e5bb1b45de9a1c3ea40 new file mode 100644 Binary files /dev/null and b/.git/objects/19/a4d9c645f7e4b9f5414e5bb1b45de9a1c3ea40 differ diff --git a/.git/objects/1d/4d0774da205784863ae2d06988d4c525dd5b22 b/.git/objects/1d/4d0774da205784863ae2d06988d4c525dd5b22 new file mode 100644 Binary files /dev/null and b/.git/objects/1d/4d0774da205784863ae2d06988d4c525dd5b22 differ diff --git a/.git/objects/1f/0b51995096b04b9c0bb36b633333ee53cf6ede b/.git/objects/1f/0b51995096b04b9c0bb36b633333ee53cf6ede new file mode 100644 Binary files /dev/null and b/.git/objects/1f/0b51995096b04b9c0bb36b633333ee53cf6ede differ diff --git a/.git/objects/22/9b691fbf867126dc4e40ed8b5bf16facc90e7a b/.git/objects/22/9b691fbf867126dc4e40ed8b5bf16facc90e7a new file mode 100644 Binary files /dev/null and b/.git/objects/22/9b691fbf867126dc4e40ed8b5bf16facc90e7a differ diff --git a/.git/objects/23/e8522114db4fb8526a9948e7c91250c63a9928 b/.git/objects/23/e8522114db4fb8526a9948e7c91250c63a9928 new file mode 100644 Binary files /dev/null and b/.git/objects/23/e8522114db4fb8526a9948e7c91250c63a9928 differ diff --git a/.git/objects/26/252acd178a04d8b98a75016a754d8b7bc4dfdd b/.git/objects/26/252acd178a04d8b98a75016a754d8b7bc4dfdd new file mode 100644 Binary files /dev/null and b/.git/objects/26/252acd178a04d8b98a75016a754d8b7bc4dfdd differ diff --git a/.git/objects/28/0bbfa003c4249f5fc4a59ad5fa724272bc2d02 b/.git/objects/28/0bbfa003c4249f5fc4a59ad5fa724272bc2d02 new file mode 100644 Binary files /dev/null and b/.git/objects/28/0bbfa003c4249f5fc4a59ad5fa724272bc2d02 differ diff --git a/.git/objects/28/fb2df2b4bf2f8be62602e7b3b6ad99289fefac b/.git/objects/28/fb2df2b4bf2f8be62602e7b3b6ad99289fefac new file mode 100644 Binary files /dev/null and b/.git/objects/28/fb2df2b4bf2f8be62602e7b3b6ad99289fefac differ diff --git a/.git/objects/29/09458fe91e193322f78abdafd7c8b9c2480b9f b/.git/objects/29/09458fe91e193322f78abdafd7c8b9c2480b9f new file mode 100644 Binary files /dev/null and b/.git/objects/29/09458fe91e193322f78abdafd7c8b9c2480b9f differ diff --git a/.git/objects/2c/1360591bec55fca7893b298b53197be3c867ba b/.git/objects/2c/1360591bec55fca7893b298b53197be3c867ba new file mode 100644 Binary files /dev/null and b/.git/objects/2c/1360591bec55fca7893b298b53197be3c867ba differ diff --git a/.git/objects/2e/0b0c295239ecdf1e63e6a7536505ac813f47f9 b/.git/objects/2e/0b0c295239ecdf1e63e6a7536505ac813f47f9 new file mode 100644 Binary files /dev/null and b/.git/objects/2e/0b0c295239ecdf1e63e6a7536505ac813f47f9 differ diff --git a/.git/objects/31/5c172ba4c6d45564249a225f0e075f671c5fbb b/.git/objects/31/5c172ba4c6d45564249a225f0e075f671c5fbb new file mode 100644 --- /dev/null +++ b/.git/objects/31/5c172ba4c6d45564249a225f0e075f671c5fbb @@ -0,0 +1,3 @@ +x+)JMU022e040031QpJ,ÎLÎLw+Í+ÖËÉ(f 8¹…ŸyQð’BÛ +E®Gfä"«-Ö*Ê©XÇ|?Gú°é§Ã7¥6‹O«½ÈÕ Uäœ_š—6já'ŸY¬=6”œÝshë¤éÚ÷í¡ª<ýAÆ·‰aæ¨v˜.`î rãòç"¡ +‚RóRR‹@ŠÔTµÎŠw±ÜØÙUʘUêÛ]}äþ]¨¢Ê‚T°{ÎnÌ­ò­yxwK~WºêL†µ™SÕ_X2 diff --git a/.git/objects/31/ba3d0f73a9b2159cfa27d8e11e275daee8c481 b/.git/objects/31/ba3d0f73a9b2159cfa27d8e11e275daee8c481 new file mode 100644 Binary files /dev/null and b/.git/objects/31/ba3d0f73a9b2159cfa27d8e11e275daee8c481 differ diff --git a/.git/objects/32/3835bed7c98ee14e0445126cfc2df5cbed9bae b/.git/objects/32/3835bed7c98ee14e0445126cfc2df5cbed9bae new file mode 100644 Binary files /dev/null and b/.git/objects/32/3835bed7c98ee14e0445126cfc2df5cbed9bae differ diff --git a/.git/objects/35/8436995aff5176e643cebf3c5d070536ac57cb b/.git/objects/35/8436995aff5176e643cebf3c5d070536ac57cb new file mode 100644 Binary files /dev/null and b/.git/objects/35/8436995aff5176e643cebf3c5d070536ac57cb differ diff --git a/.git/objects/38/79732a59fd96782ac7fec01e882bc419a650f6 b/.git/objects/38/79732a59fd96782ac7fec01e882bc419a650f6 new file mode 100644 Binary files /dev/null and b/.git/objects/38/79732a59fd96782ac7fec01e882bc419a650f6 differ diff --git a/.git/objects/38/b9dc35dfc14d5f4d529bdbdffe7a3ea8b12458 b/.git/objects/38/b9dc35dfc14d5f4d529bdbdffe7a3ea8b12458 new file mode 100644 Binary files /dev/null and b/.git/objects/38/b9dc35dfc14d5f4d529bdbdffe7a3ea8b12458 differ diff --git a/.git/objects/39/1156a543887fc398238ebd6b61194807e1c8df b/.git/objects/39/1156a543887fc398238ebd6b61194807e1c8df new file mode 100644 Binary files /dev/null and b/.git/objects/39/1156a543887fc398238ebd6b61194807e1c8df differ diff --git a/.git/objects/3a/77dd1cc37ae544654eafe0d6106d0322fcd6d6 b/.git/objects/3a/77dd1cc37ae544654eafe0d6106d0322fcd6d6 new file mode 100644 Binary files /dev/null and b/.git/objects/3a/77dd1cc37ae544654eafe0d6106d0322fcd6d6 differ diff --git a/.git/objects/3a/f2137fd14e17ec39cd86c35eb817be41236fa3 b/.git/objects/3a/f2137fd14e17ec39cd86c35eb817be41236fa3 new file mode 100644 Binary files /dev/null and b/.git/objects/3a/f2137fd14e17ec39cd86c35eb817be41236fa3 differ diff --git a/.git/objects/3d/2457f12c9429a1f6df0d9005b8ee39c2b8515a b/.git/objects/3d/2457f12c9429a1f6df0d9005b8ee39c2b8515a new file mode 100644 Binary files /dev/null and b/.git/objects/3d/2457f12c9429a1f6df0d9005b8ee39c2b8515a differ diff --git a/.git/objects/3e/ee7432174ba6920cdc77a546f40abea4363bb0 b/.git/objects/3e/ee7432174ba6920cdc77a546f40abea4363bb0 new file mode 100644 Binary files /dev/null and b/.git/objects/3e/ee7432174ba6920cdc77a546f40abea4363bb0 differ diff --git a/.git/objects/41/d19a4642f6660a4179f3c71e91735989598daf b/.git/objects/41/d19a4642f6660a4179f3c71e91735989598daf new file mode 100644 Binary files /dev/null and b/.git/objects/41/d19a4642f6660a4179f3c71e91735989598daf differ diff --git a/.git/objects/42/e3ec9572ed4138542efdf91a07554c835f4882 b/.git/objects/42/e3ec9572ed4138542efdf91a07554c835f4882 new file mode 100644 Binary files /dev/null and b/.git/objects/42/e3ec9572ed4138542efdf91a07554c835f4882 differ diff --git a/.git/objects/46/4199cbe596b6d8e366c3f5900c87740c819acf b/.git/objects/46/4199cbe596b6d8e366c3f5900c87740c819acf new file mode 100644 Binary files /dev/null and b/.git/objects/46/4199cbe596b6d8e366c3f5900c87740c819acf differ diff --git a/.git/objects/46/6a9d4591dd2b033e07fa515b559afe6166f0a3 b/.git/objects/46/6a9d4591dd2b033e07fa515b559afe6166f0a3 new file mode 100644 Binary files /dev/null and b/.git/objects/46/6a9d4591dd2b033e07fa515b559afe6166f0a3 differ diff --git a/.git/objects/46/d74297ecb00ced0498fca2d37ef1123967d685 b/.git/objects/46/d74297ecb00ced0498fca2d37ef1123967d685 new file mode 100644 Binary files /dev/null and b/.git/objects/46/d74297ecb00ced0498fca2d37ef1123967d685 differ diff --git a/.git/objects/4a/fd6ed7d81c474bf5c88c395a584e4f68b039ce b/.git/objects/4a/fd6ed7d81c474bf5c88c395a584e4f68b039ce new file mode 100644 Binary files /dev/null and b/.git/objects/4a/fd6ed7d81c474bf5c88c395a584e4f68b039ce differ diff --git a/.git/objects/4d/011c28a383821201d0c2da48db909df774df62 b/.git/objects/4d/011c28a383821201d0c2da48db909df774df62 new file mode 100644 Binary files /dev/null and b/.git/objects/4d/011c28a383821201d0c2da48db909df774df62 differ diff --git a/.git/objects/4f/1c6161cd6b76930d6ab63910f661e4c9280c64 b/.git/objects/4f/1c6161cd6b76930d6ab63910f661e4c9280c64 new file mode 100644 --- /dev/null +++ b/.git/objects/4f/1c6161cd6b76930d6ab63910f661e4c9280c64 @@ -0,0 +1,1 @@ +x•N»NÄ0¤öWlu‘÷Ç ¡k(Añ~¬HÄŽ âï±BEI53šÍø¼®K…ò¦fÐg6ΑÓJ#ir“Grj¢ æяg…VÇ9ŠÍN"¡YJd¢éhÐÌÒºyž¦èiđ¤qd…mõ-9}[¸;àó㒸îÞn‰¾Û9wõÜØ9Š?ÿ:ûã¿ü>;¼¿›½¿ÂÌ{{ߌpµÖMPuÐÂüÝ +úVZŠ m=Â;£ÖznÔ¥­ƒZ2¾‘Ö©òvãÔ7áµ ]ƒgùÏ$YÙ²5 +WmPÞ)1þøuÞßÖp3ˆ>cO ΍5¥•q>1:˜‰¯àՊ›OaÓc±5 Î+°¯<Ú˜·¼¦2¬eòÈ»q9i©Hnªœø_ªÁ-oYˍµ|ëˆ_ɁÁڃ&ƒÐ.Ël9ÇL†”Óãu¬K¶þ@—@E??ÐnW´¬Û­CςªÀ„Ó™F?-~ɨÂ0Oººƒ_Q‰6ñÄÆÁ7U¦, diff --git a/.git/objects/65/0d6db099811f2892c4dd0d24c34de9a8d07435 b/.git/objects/65/0d6db099811f2892c4dd0d24c34de9a8d07435 new file mode 100644 Binary files /dev/null and b/.git/objects/65/0d6db099811f2892c4dd0d24c34de9a8d07435 differ diff --git a/.git/objects/66/08033e85b06e8aa5ef9fe4a115b47500a073f0 b/.git/objects/66/08033e85b06e8aa5ef9fe4a115b47500a073f0 new file mode 100644 Binary files /dev/null and b/.git/objects/66/08033e85b06e8aa5ef9fe4a115b47500a073f0 differ diff --git a/.git/objects/66/a5ca12ace8806a4001b7082db3bdb8b35267eb b/.git/objects/66/a5ca12ace8806a4001b7082db3bdb8b35267eb new file mode 100644 Binary files /dev/null and b/.git/objects/66/a5ca12ace8806a4001b7082db3bdb8b35267eb differ diff --git a/.git/objects/68/440e1520af9fb733724b7b81e907a4dab956b8 b/.git/objects/68/440e1520af9fb733724b7b81e907a4dab956b8 new file mode 100644 Binary files /dev/null and b/.git/objects/68/440e1520af9fb733724b7b81e907a4dab956b8 differ diff --git a/.git/objects/68/afa542d4797b1b25cc5a255fb4ae50014fcc65 b/.git/objects/68/afa542d4797b1b25cc5a255fb4ae50014fcc65 new file mode 100644 Binary files /dev/null and b/.git/objects/68/afa542d4797b1b25cc5a255fb4ae50014fcc65 differ diff --git a/.git/objects/69/680bdab02d8e951979477178f796b43bd5df01 b/.git/objects/69/680bdab02d8e951979477178f796b43bd5df01 new file mode 100644 Binary files /dev/null and b/.git/objects/69/680bdab02d8e951979477178f796b43bd5df01 differ diff --git a/.git/objects/69/fdad39ac0a3e2e0c9b5347e7e6f666d8f769a4 b/.git/objects/69/fdad39ac0a3e2e0c9b5347e7e6f666d8f769a4 new file mode 100644 Binary files /dev/null and b/.git/objects/69/fdad39ac0a3e2e0c9b5347e7e6f666d8f769a4 differ diff --git a/.git/objects/6c/080e1fa918201ddbbdf7faa8bf8426e590092d b/.git/objects/6c/080e1fa918201ddbbdf7faa8bf8426e590092d new file mode 100644 Binary files /dev/null and b/.git/objects/6c/080e1fa918201ddbbdf7faa8bf8426e590092d differ diff --git a/.git/objects/6c/78ae03df6c1bc335f2c3d91ab317967dd10a8b b/.git/objects/6c/78ae03df6c1bc335f2c3d91ab317967dd10a8b new file mode 100644 Binary files /dev/null and b/.git/objects/6c/78ae03df6c1bc335f2c3d91ab317967dd10a8b differ diff --git a/.git/objects/6d/983efc33facf5d019fefdc11c253042f6f1a57 b/.git/objects/6d/983efc33facf5d019fefdc11c253042f6f1a57 new file mode 100644 Binary files /dev/null and b/.git/objects/6d/983efc33facf5d019fefdc11c253042f6f1a57 differ diff --git a/.git/objects/6e/b5f25f3191008705cf5d25da4253992c579f87 b/.git/objects/6e/b5f25f3191008705cf5d25da4253992c579f87 new file mode 100644 Binary files /dev/null and b/.git/objects/6e/b5f25f3191008705cf5d25da4253992c579f87 differ diff --git a/.git/objects/72/00e3a6391ba70ec0e19bf5e6a7effdbcdd0cf6 b/.git/objects/72/00e3a6391ba70ec0e19bf5e6a7effdbcdd0cf6 new file mode 100644 Binary files /dev/null and b/.git/objects/72/00e3a6391ba70ec0e19bf5e6a7effdbcdd0cf6 differ diff --git a/.git/objects/72/420aa90b49de8264d659eee043ad94c94f08f0 b/.git/objects/72/420aa90b49de8264d659eee043ad94c94f08f0 new file mode 100644 Binary files /dev/null and b/.git/objects/72/420aa90b49de8264d659eee043ad94c94f08f0 differ diff --git a/.git/objects/72/44f2a719afed28d42fdd235e91ba80a76bf8c8 b/.git/objects/72/44f2a719afed28d42fdd235e91ba80a76bf8c8 new file mode 100644 --- /dev/null +++ b/.git/objects/72/44f2a719afed28d42fdd235e91ba80a76bf8c8 @@ -0,0 +1,2 @@ +xu=‹Â@†­ó+lÜm®Ä;a‹˜S\›6;awƒ ‡ÿÝhÈ]"±›yŸæ™Ts +›õl ¿bÑw¬¢ã ÄÏAcM©FeœOL†æ⼶â¦ÄScØ4ŸØ6 Î+ðUy´%&°h3xMeX9ÊV“HErWåÄoi¨>ÕîÙxËZî¬åkG„€øB Ö4„v9[.`Ï9f2¤œž×±.Ùúi\ýüDK¸^Ðb°m·ý}ÕùOä½ü4z˜ÿ“‘ö0îÓrËawð¹ŒJ´‰'6.îYž! diff --git a/.git/objects/73/bc3b4c2d2ca70c8a8844a118e3d3db3aeb4d0c b/.git/objects/73/bc3b4c2d2ca70c8a8844a118e3d3db3aeb4d0c new file mode 100644 --- /dev/null +++ b/.git/objects/73/bc3b4c2d2ca70c8a8844a118e3d3db3aeb4d0c @@ -0,0 +1,1 @@ +xŽMNÃ0…Yû³ ÊØñO\q®àŒ'M¤Æn··ÇjaÏjÞÓ÷>i(/Ë\¡Ãþ®fõÒhå$¢¡ÑX´|ÇC«QuÎ:‡P85Qu}gŽŽ|Ï,5£ÖF*K#©8jȁE8Õ)ˆ9}x¹žóñ=q])xÓÂHm”¶Ê9„'4ˆ‚®ßUþ§×÷¿žøš+MNËÐ\Ê¥0Õ9'qÏÃz[PNg.kCò¦°BƼßç˜v°Öb(q áϹÿ|Ôâ,nÄ»Þd diff --git a/.git/objects/76/62906e1fb8860b48907234e40addbfdc4bd604 b/.git/objects/76/62906e1fb8860b48907234e40addbfdc4bd604 new file mode 100644 Binary files /dev/null and b/.git/objects/76/62906e1fb8860b48907234e40addbfdc4bd604 differ diff --git a/.git/objects/79/3937ccb5e6531cc7ad87b1d34f4ef1a23a6e72 b/.git/objects/79/3937ccb5e6531cc7ad87b1d34f4ef1a23a6e72 new file mode 100644 Binary files /dev/null and b/.git/objects/79/3937ccb5e6531cc7ad87b1d34f4ef1a23a6e72 differ diff --git a/.git/objects/79/e1abc7ad5a3aa84e9c723999da1a2977b07839 b/.git/objects/79/e1abc7ad5a3aa84e9c723999da1a2977b07839 new file mode 100644 Binary files /dev/null and b/.git/objects/79/e1abc7ad5a3aa84e9c723999da1a2977b07839 differ diff --git a/.git/objects/7a/5e865406dc8dc8d2bd730b7625656fc4c80036 b/.git/objects/7a/5e865406dc8dc8d2bd730b7625656fc4c80036 new file mode 100644 Binary files /dev/null and b/.git/objects/7a/5e865406dc8dc8d2bd730b7625656fc4c80036 differ diff --git a/.git/objects/7a/7cacc4ba4fa2ca82e2d85abf6b44e7f93625ce b/.git/objects/7a/7cacc4ba4fa2ca82e2d85abf6b44e7f93625ce new file mode 100644 Binary files /dev/null and b/.git/objects/7a/7cacc4ba4fa2ca82e2d85abf6b44e7f93625ce differ diff --git a/.git/objects/7a/e36bd46d77905af4da2001aedd031cc773f6c2 b/.git/objects/7a/e36bd46d77905af4da2001aedd031cc773f6c2 new file mode 100644 Binary files /dev/null and b/.git/objects/7a/e36bd46d77905af4da2001aedd031cc773f6c2 differ diff --git a/.git/objects/7b/f4417449debcc857e7444b200faf64d6cb58a2 b/.git/objects/7b/f4417449debcc857e7444b200faf64d6cb58a2 new file mode 100644 Binary files /dev/null and b/.git/objects/7b/f4417449debcc857e7444b200faf64d6cb58a2 differ diff --git a/.git/objects/80/1751ee70ac4794f625f38c9417be1408ff90df b/.git/objects/80/1751ee70ac4794f625f38c9417be1408ff90df new file mode 100644 Binary files /dev/null and b/.git/objects/80/1751ee70ac4794f625f38c9417be1408ff90df differ diff --git a/.git/objects/85/af43da1948ffbdf3b1fff153d88119842852b9 b/.git/objects/85/af43da1948ffbdf3b1fff153d88119842852b9 new file mode 100644 Binary files /dev/null and b/.git/objects/85/af43da1948ffbdf3b1fff153d88119842852b9 differ diff --git a/.git/objects/87/7cdbe88a44c2962bc9bc66e021ad8a9c185268 b/.git/objects/87/7cdbe88a44c2962bc9bc66e021ad8a9c185268 new file mode 100644 --- /dev/null +++ b/.git/objects/87/7cdbe88a44c2962bc9bc66e021ad8a9c185268 @@ -0,0 +1,4 @@ +xŽM +Â0F]çs%3i’D¼€+×ÓÌ‹´ÕoïÏÜ}ރ/OÃÐW ‡‹:«B +Ž|b£K¹a*1P鬴šJEG–(’˜ Ï:Vpر[¢ãÔú” SüèˆJÑ «¶¹iÑ𽞦öÓøb8Üû|†µ|áqݎZo™/ºúŒ `ã R°°´ÞZ“«þW›ˆ +<ç¾ê‘æ vúI— diff --git a/.git/objects/87/c4b67904dfc03dcabd7f4c0ec98fc4031f8531 b/.git/objects/87/c4b67904dfc03dcabd7f4c0ec98fc4031f8531 new file mode 100644 --- /dev/null +++ b/.git/objects/87/c4b67904dfc03dcabd7f4c0ec98fc4031f8531 @@ -0,0 +1,2 @@ +x+)JMU022e040031QpJ,ÎLÎLw+Í+ÖËÉ(fh|W°Æ}Ê7ÕÏ=SÄ÷‰püŸpYm±PQP_΅ÇsçîžTk½eÏ »ó½¿®A9ç—楀Ú0Aè‰Ãgk %g÷Ú:iºö}{¨*O1•–æg¶> –9¾¶}ãe¿‹¬òŠ  +‚RóRR‹@ŠÔTµÎŠw±ÜØÙUʘUêÛ]}äþ]¨¢Ê‚T°{ÎnÌ­ò­yxwK~WºêL†µ™Sƒ²^Î diff --git a/.git/objects/88/37a8a5670a0e0375d119c9d20d4353b5913a03 b/.git/objects/88/37a8a5670a0e0375d119c9d20d4353b5913a03 new file mode 100644 Binary files /dev/null and b/.git/objects/88/37a8a5670a0e0375d119c9d20d4353b5913a03 differ diff --git a/.git/objects/88/3ee63aca3703b5c269e0fa4bf0880ade5a9984 b/.git/objects/88/3ee63aca3703b5c269e0fa4bf0880ade5a9984 new file mode 100644 Binary files /dev/null and b/.git/objects/88/3ee63aca3703b5c269e0fa4bf0880ade5a9984 differ diff --git a/.git/objects/89/367b0736b710c6e9c383ef2e019fb07f6cf51c b/.git/objects/89/367b0736b710c6e9c383ef2e019fb07f6cf51c new file mode 100644 Binary files /dev/null and b/.git/objects/89/367b0736b710c6e9c383ef2e019fb07f6cf51c differ diff --git a/.git/objects/89/6621f361866ce787d0bad1dfd5434d371b5679 b/.git/objects/89/6621f361866ce787d0bad1dfd5434d371b5679 new file mode 100644 --- /dev/null +++ b/.git/objects/89/6621f361866ce787d0bad1dfd5434d371b5679 @@ -0,0 +1,1 @@ +x;NAD‰ç}¬Þùd!$ÀGèín˖í™e=‹áöØNȑ*¨<©ŠÛé´ï`S~è³*ĀeÄRò0lm.–½Šõì¼h¡,˜¼ f¢Yk‡DAs £p¾ÅŽ’Ž)ÚCܲçŒè¢¡¥ïÚ ¯­þ|,{>ÀZnðõù\µŸ™&]]Ë >ΗÑ#¾oìú?Û¼}Omîg c^vT«ßiª¸Y*\OAmл£²2¿Y¨ diff --git a/.git/objects/8c/a262164429aa9765dfd2fa47331f3349869329 b/.git/objects/8c/a262164429aa9765dfd2fa47331f3349869329 new file mode 100644 Binary files /dev/null and b/.git/objects/8c/a262164429aa9765dfd2fa47331f3349869329 differ diff --git a/.git/objects/95/4c9cf3acd7bc7d436c9548c6d50a7936b3055c b/.git/objects/95/4c9cf3acd7bc7d436c9548c6d50a7936b3055c new file mode 100644 Binary files /dev/null and b/.git/objects/95/4c9cf3acd7bc7d436c9548c6d50a7936b3055c differ diff --git a/.git/objects/96/325c6d0739c4a2f762fb0d8e9f6de13202272d b/.git/objects/96/325c6d0739c4a2f762fb0d8e9f6de13202272d new file mode 100644 Binary files /dev/null and b/.git/objects/96/325c6d0739c4a2f762fb0d8e9f6de13202272d differ diff --git a/.git/objects/98/2001952233e68b31aa67fd4fce281e33f0f1c6 b/.git/objects/98/2001952233e68b31aa67fd4fce281e33f0f1c6 new file mode 100644 Binary files /dev/null and b/.git/objects/98/2001952233e68b31aa67fd4fce281e33f0f1c6 differ diff --git a/.git/objects/9b/c107a80e863822b328bf64a795c3ef54e001b1 b/.git/objects/9b/c107a80e863822b328bf64a795c3ef54e001b1 new file mode 100644 --- /dev/null +++ b/.git/objects/9b/c107a80e863822b328bf64a795c3ef54e001b1 @@ -0,0 +1,1 @@ +x•ŽË !@=S hf` 1Æì`†èa?®¬‰Ýk¶Oï]^òÊ<Žn=¤C_U­Š2{,[¡V9QB ˆšKbÏ;ÞÏë¤ýUdÑÓO.(@ÈÚ£ Ι²ßuý·37•Qí¶TéZÍ”CDÅ diff --git a/.git/objects/9d/78fa8fa693d03da04df9e4e1644ed7a5b5d237 b/.git/objects/9d/78fa8fa693d03da04df9e4e1644ed7a5b5d237 new file mode 100644 Binary files /dev/null and b/.git/objects/9d/78fa8fa693d03da04df9e4e1644ed7a5b5d237 differ diff --git a/.git/objects/a1/b5f177c89e03bb1f90afbc3ee699d9c9b063de b/.git/objects/a1/b5f177c89e03bb1f90afbc3ee699d9c9b063de new file mode 100644 Binary files /dev/null and b/.git/objects/a1/b5f177c89e03bb1f90afbc3ee699d9c9b063de differ diff --git a/.git/objects/a1/bd5bad273b384e804013a76ba56070c418244b b/.git/objects/a1/bd5bad273b384e804013a76ba56070c418244b new file mode 100644 Binary files /dev/null and b/.git/objects/a1/bd5bad273b384e804013a76ba56070c418244b differ diff --git a/.git/objects/a2/e4ba96b68cfb636a59754dc68261df30cc6530 b/.git/objects/a2/e4ba96b68cfb636a59754dc68261df30cc6530 new file mode 100644 Binary files /dev/null and b/.git/objects/a2/e4ba96b68cfb636a59754dc68261df30cc6530 differ diff --git a/.git/objects/a2/f609f631d66e93917a5ace7ad8e9d3e1ff7dcd b/.git/objects/a2/f609f631d66e93917a5ace7ad8e9d3e1ff7dcd new file mode 100644 Binary files /dev/null and b/.git/objects/a2/f609f631d66e93917a5ace7ad8e9d3e1ff7dcd differ diff --git a/.git/objects/a3/69e39dd54db4cf0df66937ea62949fc00175e5 b/.git/objects/a3/69e39dd54db4cf0df66937ea62949fc00175e5 new file mode 100644 Binary files /dev/null and b/.git/objects/a3/69e39dd54db4cf0df66937ea62949fc00175e5 differ diff --git a/.git/objects/a6/92c6ff1f43e7f0e6048501efab53476b451697 b/.git/objects/a6/92c6ff1f43e7f0e6048501efab53476b451697 new file mode 100644 Binary files /dev/null and b/.git/objects/a6/92c6ff1f43e7f0e6048501efab53476b451697 differ diff --git a/.git/objects/a7/1c310b22d3873f19dbef3fd1847db262523a4a b/.git/objects/a7/1c310b22d3873f19dbef3fd1847db262523a4a new file mode 100644 Binary files /dev/null and b/.git/objects/a7/1c310b22d3873f19dbef3fd1847db262523a4a differ diff --git a/.git/objects/a9/2acc695c112526737719cae217919dd26cc8b0 b/.git/objects/a9/2acc695c112526737719cae217919dd26cc8b0 new file mode 100644 Binary files /dev/null and b/.git/objects/a9/2acc695c112526737719cae217919dd26cc8b0 differ diff --git a/.git/objects/a9/54bb4608151754bc3ef6b10f354257fc23247e b/.git/objects/a9/54bb4608151754bc3ef6b10f354257fc23247e new file mode 100644 Binary files /dev/null and b/.git/objects/a9/54bb4608151754bc3ef6b10f354257fc23247e differ diff --git a/.git/objects/a9/e9e0080f3f5357b79e1034457f57c4c50a61c1 b/.git/objects/a9/e9e0080f3f5357b79e1034457f57c4c50a61c1 new file mode 100644 Binary files /dev/null and b/.git/objects/a9/e9e0080f3f5357b79e1034457f57c4c50a61c1 differ diff --git a/.git/objects/aa/9e74daedbcb4fbae1920ed99ce78a3b122d07f b/.git/objects/aa/9e74daedbcb4fbae1920ed99ce78a3b122d07f new file mode 100644 Binary files /dev/null and b/.git/objects/aa/9e74daedbcb4fbae1920ed99ce78a3b122d07f differ diff --git a/.git/objects/ad/3a905fb36fe44c5f0f7d1bf0e6fab3d36b4d61 b/.git/objects/ad/3a905fb36fe44c5f0f7d1bf0e6fab3d36b4d61 new file mode 100644 Binary files /dev/null and b/.git/objects/ad/3a905fb36fe44c5f0f7d1bf0e6fab3d36b4d61 differ diff --git a/.git/objects/ad/790ff8bd9f52c7ddfb2b28093a8ff21940e3b6 b/.git/objects/ad/790ff8bd9f52c7ddfb2b28093a8ff21940e3b6 new file mode 100644 Binary files /dev/null and b/.git/objects/ad/790ff8bd9f52c7ddfb2b28093a8ff21940e3b6 differ diff --git a/.git/objects/ad/934e32017310e7df1888d183754ae30fa6c67e b/.git/objects/ad/934e32017310e7df1888d183754ae30fa6c67e new file mode 100644 Binary files /dev/null and b/.git/objects/ad/934e32017310e7df1888d183754ae30fa6c67e differ diff --git a/.git/objects/ad/f2673657fa321a214a529e015ee10b062af2f4 b/.git/objects/ad/f2673657fa321a214a529e015ee10b062af2f4 new file mode 100644 Binary files /dev/null and b/.git/objects/ad/f2673657fa321a214a529e015ee10b062af2f4 differ diff --git a/.git/objects/af/80f1983c7a72bae981b15def1d8cc05c9ec872 b/.git/objects/af/80f1983c7a72bae981b15def1d8cc05c9ec872 new file mode 100644 Binary files /dev/null and b/.git/objects/af/80f1983c7a72bae981b15def1d8cc05c9ec872 differ diff --git a/.git/objects/b0/9012e440f3043b48b074cdbcc2b592972bdf3f b/.git/objects/b0/9012e440f3043b48b074cdbcc2b592972bdf3f new file mode 100644 Binary files /dev/null and b/.git/objects/b0/9012e440f3043b48b074cdbcc2b592972bdf3f differ diff --git a/.git/objects/b1/030551f45c9a9ab195759fb1b77e5b346421fb b/.git/objects/b1/030551f45c9a9ab195759fb1b77e5b346421fb new file mode 100644 Binary files /dev/null and b/.git/objects/b1/030551f45c9a9ab195759fb1b77e5b346421fb differ diff --git a/.git/objects/b1/eb4e6bd0c330b7cbe720d59df11bf3105b2b85 b/.git/objects/b1/eb4e6bd0c330b7cbe720d59df11bf3105b2b85 new file mode 100644 Binary files /dev/null and b/.git/objects/b1/eb4e6bd0c330b7cbe720d59df11bf3105b2b85 differ diff --git a/.git/objects/b2/4b2515b2d6b41f2101bf7c8ea8e825495d0168 b/.git/objects/b2/4b2515b2d6b41f2101bf7c8ea8e825495d0168 new file mode 100644 Binary files /dev/null and b/.git/objects/b2/4b2515b2d6b41f2101bf7c8ea8e825495d0168 differ diff --git a/.git/objects/b8/4d39c532ad044ad8b60cee3bc5292061de39a6 b/.git/objects/b8/4d39c532ad044ad8b60cee3bc5292061de39a6 new file mode 100644 Binary files /dev/null and b/.git/objects/b8/4d39c532ad044ad8b60cee3bc5292061de39a6 differ diff --git a/.git/objects/b9/499a0096c52a092b1f7dd5d9ebabfcaeff6f96 b/.git/objects/b9/499a0096c52a092b1f7dd5d9ebabfcaeff6f96 new file mode 100644 Binary files /dev/null and b/.git/objects/b9/499a0096c52a092b1f7dd5d9ebabfcaeff6f96 differ diff --git a/.git/objects/bc/3466a48bc1ea669750415e2741d93b7f244611 b/.git/objects/bc/3466a48bc1ea669750415e2741d93b7f244611 new file mode 100644 Binary files /dev/null and b/.git/objects/bc/3466a48bc1ea669750415e2741d93b7f244611 differ diff --git a/.git/objects/be/dc2220c923720d40fbf6b318d4b16245c73a55 b/.git/objects/be/dc2220c923720d40fbf6b318d4b16245c73a55 new file mode 100644 --- /dev/null +++ b/.git/objects/be/dc2220c923720d40fbf6b318d4b16245c73a55 @@ -0,0 +1,3 @@ +xŽK +1]ç¹€ÒI:“ˆ¸ðzƒîØ£ƒLFÇ(x{?Gp÷ª à•i‡f½‹6«ÚŽA]ôÀ}î%…Fê diff --git a/.git/objects/c1/1295cd418389633d038186b951bd6617e7f6e4 b/.git/objects/c1/1295cd418389633d038186b951bd6617e7f6e4 new file mode 100644 Binary files /dev/null and b/.git/objects/c1/1295cd418389633d038186b951bd6617e7f6e4 differ diff --git a/.git/objects/c1/7ffce0743beb137344a74f6ae5fb5046c955b1 b/.git/objects/c1/7ffce0743beb137344a74f6ae5fb5046c955b1 new file mode 100644 Binary files /dev/null and b/.git/objects/c1/7ffce0743beb137344a74f6ae5fb5046c955b1 differ diff --git a/.git/objects/c1/ba0d1945a06d1610f61128dbe0355002d90c2f b/.git/objects/c1/ba0d1945a06d1610f61128dbe0355002d90c2f new file mode 100644 Binary files /dev/null and b/.git/objects/c1/ba0d1945a06d1610f61128dbe0355002d90c2f differ diff --git a/.git/objects/c4/2b297f598a10a933a3e8a3856946c737e25a90 b/.git/objects/c4/2b297f598a10a933a3e8a3856946c737e25a90 new file mode 100644 Binary files /dev/null and b/.git/objects/c4/2b297f598a10a933a3e8a3856946c737e25a90 differ diff --git a/.git/objects/c7/3c5f5403087b409710374014d8d3f3b91489d1 b/.git/objects/c7/3c5f5403087b409710374014d8d3f3b91489d1 new file mode 100644 Binary files /dev/null and b/.git/objects/c7/3c5f5403087b409710374014d8d3f3b91489d1 differ diff --git a/.git/objects/c8/2f114a3376658176753aa69cb1882ff9e34024 b/.git/objects/c8/2f114a3376658176753aa69cb1882ff9e34024 new file mode 100644 Binary files /dev/null and b/.git/objects/c8/2f114a3376658176753aa69cb1882ff9e34024 differ diff --git a/.git/objects/c8/5e4a4f82193fd374d9808476f8439ff61d79bc b/.git/objects/c8/5e4a4f82193fd374d9808476f8439ff61d79bc new file mode 100644 --- /dev/null +++ b/.git/objects/c8/5e4a4f82193fd374d9808476f8439ff61d79bc @@ -0,0 +1,3 @@ +x¥‘½ +Â0F]›§¸c…ÒMÐÁAÁB-XÁ95W 4Iɏŷ7m©(R2¸…œ“/÷KªZU°X®fB1W#ìœEÝ Mó"Ý8ƈa +¦[jø¥ä·ÌI“xjH:= 9y¸éˆ’¡¤Vs‹gúHH4.J ?êÚ;j$„‹FiûÛü«\À2Ó¼¯4óbš E'‡«¤ïiÖÐ?xb–˜¹ßÐ}ó2ó´“zÎ%€r6ãþw‡ó ‰Þ¡Ýsüü‘Ñ…“j$Â, diff --git a/.git/objects/cc/2e92fccfecefca2ba40533b089ace71f5bba65 b/.git/objects/cc/2e92fccfecefca2ba40533b089ace71f5bba65 new file mode 100644 Binary files /dev/null and b/.git/objects/cc/2e92fccfecefca2ba40533b089ace71f5bba65 differ diff --git a/.git/objects/cd/b16d7a4d7ce1ddb46f600a67259900ad69e165 b/.git/objects/cd/b16d7a4d7ce1ddb46f600a67259900ad69e165 new file mode 100644 Binary files /dev/null and b/.git/objects/cd/b16d7a4d7ce1ddb46f600a67259900ad69e165 differ diff --git a/.git/objects/cf/2b919bc619dd9c7d058d324954872788d208e9 b/.git/objects/cf/2b919bc619dd9c7d058d324954872788d208e9 new file mode 100644 Binary files /dev/null and b/.git/objects/cf/2b919bc619dd9c7d058d324954872788d208e9 differ diff --git a/.git/objects/cf/2cd659a50d600cb0315d2897a67e8b19635ac1 b/.git/objects/cf/2cd659a50d600cb0315d2897a67e8b19635ac1 new file mode 100644 Binary files /dev/null and b/.git/objects/cf/2cd659a50d600cb0315d2897a67e8b19635ac1 differ diff --git a/.git/objects/cf/aafd13c43ed1207a8a323d7532ac25ce643e36 b/.git/objects/cf/aafd13c43ed1207a8a323d7532ac25ce643e36 new file mode 100644 Binary files /dev/null and b/.git/objects/cf/aafd13c43ed1207a8a323d7532ac25ce643e36 differ diff --git a/.git/objects/d0/ded1ec1f5916aa8e3df243a7a2e953e49abfb7 b/.git/objects/d0/ded1ec1f5916aa8e3df243a7a2e953e49abfb7 new file mode 100644 Binary files /dev/null and b/.git/objects/d0/ded1ec1f5916aa8e3df243a7a2e953e49abfb7 differ diff --git a/.git/objects/d2/ba530f2b786897d2b6b681d5f438efa154b349 b/.git/objects/d2/ba530f2b786897d2b6b681d5f438efa154b349 new file mode 100644 Binary files /dev/null and b/.git/objects/d2/ba530f2b786897d2b6b681d5f438efa154b349 differ diff --git a/.git/objects/d6/32a8bbb2a5162fba6f031bf3a3a8c58167c034 b/.git/objects/d6/32a8bbb2a5162fba6f031bf3a3a8c58167c034 new file mode 100644 Binary files /dev/null and b/.git/objects/d6/32a8bbb2a5162fba6f031bf3a3a8c58167c034 differ diff --git a/.git/objects/d7/b27434f174e0dbe05f8bef916760dfee482141 b/.git/objects/d7/b27434f174e0dbe05f8bef916760dfee482141 new file mode 100644 Binary files /dev/null and b/.git/objects/d7/b27434f174e0dbe05f8bef916760dfee482141 differ diff --git a/.git/objects/d8/a75f45fc2a9f796ef5af34dd139f243f0e1df6 b/.git/objects/d8/a75f45fc2a9f796ef5af34dd139f243f0e1df6 new file mode 100644 Binary files /dev/null and b/.git/objects/d8/a75f45fc2a9f796ef5af34dd139f243f0e1df6 differ diff --git a/.git/objects/d9/712de374ecf26cff922a1fa3eaf739bfa71471 b/.git/objects/d9/712de374ecf26cff922a1fa3eaf739bfa71471 new file mode 100644 Binary files /dev/null and b/.git/objects/d9/712de374ecf26cff922a1fa3eaf739bfa71471 differ diff --git a/.git/objects/dc/277dc4fd142e9bdf214b89824f0ecd5c5910ec b/.git/objects/dc/277dc4fd142e9bdf214b89824f0ecd5c5910ec new file mode 100644 Binary files /dev/null and b/.git/objects/dc/277dc4fd142e9bdf214b89824f0ecd5c5910ec differ diff --git a/.git/objects/de/0e0984670170b610524acf8c55af1102969233 b/.git/objects/de/0e0984670170b610524acf8c55af1102969233 new file mode 100644 Binary files /dev/null and b/.git/objects/de/0e0984670170b610524acf8c55af1102969233 differ diff --git a/.git/objects/de/184f0f48f080cd952b4906bd6d10ce95d657aa b/.git/objects/de/184f0f48f080cd952b4906bd6d10ce95d657aa new file mode 100644 Binary files /dev/null and b/.git/objects/de/184f0f48f080cd952b4906bd6d10ce95d657aa differ diff --git a/.git/objects/de/1cc98e65c7c80ceea57473bdadce3f65ea49a7 b/.git/objects/de/1cc98e65c7c80ceea57473bdadce3f65ea49a7 new file mode 100644 Binary files /dev/null and b/.git/objects/de/1cc98e65c7c80ceea57473bdadce3f65ea49a7 differ diff --git a/.git/objects/df/9b55b1972552b0142c70dcd1ab0d1b80a6127d b/.git/objects/df/9b55b1972552b0142c70dcd1ab0d1b80a6127d new file mode 100644 Binary files /dev/null and b/.git/objects/df/9b55b1972552b0142c70dcd1ab0d1b80a6127d differ diff --git a/.git/objects/e0/947bc61ee49f66c63fe1c930c899cbd6b1a368 b/.git/objects/e0/947bc61ee49f66c63fe1c930c899cbd6b1a368 new file mode 100644 Binary files /dev/null and b/.git/objects/e0/947bc61ee49f66c63fe1c930c899cbd6b1a368 differ diff --git a/.git/objects/e1/a32ab024ca47185d08c172e66b5ae83b6d8ea5 b/.git/objects/e1/a32ab024ca47185d08c172e66b5ae83b6d8ea5 new file mode 100644 Binary files /dev/null and b/.git/objects/e1/a32ab024ca47185d08c172e66b5ae83b6d8ea5 differ diff --git a/.git/objects/e6/e7d977a11bc0f0fd2d821ba0faff4eab5e22bd b/.git/objects/e6/e7d977a11bc0f0fd2d821ba0faff4eab5e22bd new file mode 100644 Binary files /dev/null and b/.git/objects/e6/e7d977a11bc0f0fd2d821ba0faff4eab5e22bd differ diff --git a/.git/objects/e7/a64b8b7d8600b944a2d7a5ffff8f590b4199b7 b/.git/objects/e7/a64b8b7d8600b944a2d7a5ffff8f590b4199b7 new file mode 100644 Binary files /dev/null and b/.git/objects/e7/a64b8b7d8600b944a2d7a5ffff8f590b4199b7 differ diff --git a/.git/objects/ea/e7723c93fc4fd784831416d1f087bed2707fba b/.git/objects/ea/e7723c93fc4fd784831416d1f087bed2707fba new file mode 100644 Binary files /dev/null and b/.git/objects/ea/e7723c93fc4fd784831416d1f087bed2707fba differ diff --git a/.git/objects/eb/02119459572b6b0cf79a2f9b4895b3b9764380 b/.git/objects/eb/02119459572b6b0cf79a2f9b4895b3b9764380 new file mode 100644 Binary files /dev/null and b/.git/objects/eb/02119459572b6b0cf79a2f9b4895b3b9764380 differ diff --git a/.git/objects/ed/fb8f1378c1c0021ed0a0f847618b4b310c14f1 b/.git/objects/ed/fb8f1378c1c0021ed0a0f847618b4b310c14f1 new file mode 100644 --- /dev/null +++ b/.git/objects/ed/fb8f1378c1c0021ed0a0f847618b4b310c14f1 @@ -0,0 +1,3 @@ +x½RÑjÂ0Ýs¿âB_,8Qƒ JÙÜX7 ÛØc‰ö¶bS’ˆŠîߗ¦†ÆMÙÛ^JrÎÍ=çžÛ9ãs ïn®BØ_ûD¯ÓhzqšöáeÍM‰ «÷]1#R¢ìÃÃ-3|ª¤"Õ…b^)Ü* þõ—ç…°âùš!4°àl Á7í7…Í6EtUs¡N‹.ÀƒY‚(Ê+éù´€,›&ÑÛtö™=FoÏ÷I’eNàv4üÝ & +K.v“ +dëaIsZ•Ðë ‚>Ð<ð|¬rZ4Þ*Ü(=;ç)¨a ˜X`R ZÃx¬¹†ÑcÿmìXKúí$ìn½N-8Æhg.͵9°.JØcÑÕô¸LÄVÑtnåÚã-"¸­Ì=0šR}WŽ`KiI™Ä&èÖu2) C›Jéš4DénùÔfÂyíDd®v\ý¸+aM©åN¢0̹ðc*kª‹Ø>?4rddÔ™àˆœÙl¼ätnï¸Ðšaqa“†ÑöO=çm¨÷ •uYŒ diff --git a/.git/objects/ef/337b7200de9c55fdc48320e19a26e19564d79b b/.git/objects/ef/337b7200de9c55fdc48320e19a26e19564d79b new file mode 100644 Binary files /dev/null and b/.git/objects/ef/337b7200de9c55fdc48320e19a26e19564d79b differ diff --git a/.git/objects/f0/716627a25c33e08df74920306b4fe6f446ac00 b/.git/objects/f0/716627a25c33e08df74920306b4fe6f446ac00 new file mode 100644 Binary files /dev/null and b/.git/objects/f0/716627a25c33e08df74920306b4fe6f446ac00 differ diff --git a/.git/objects/f2/9871f63fcf1a8c2cc7ea8d7e2d3505f641c08e b/.git/objects/f2/9871f63fcf1a8c2cc7ea8d7e2d3505f641c08e new file mode 100644 Binary files /dev/null and b/.git/objects/f2/9871f63fcf1a8c2cc7ea8d7e2d3505f641c08e differ diff --git a/.git/objects/f4/077bc12e204876fb485cac9bb75ac11a651c0c b/.git/objects/f4/077bc12e204876fb485cac9bb75ac11a651c0c new file mode 100644 Binary files /dev/null and b/.git/objects/f4/077bc12e204876fb485cac9bb75ac11a651c0c differ diff --git a/.git/objects/f8/154e00ed87f700e71790ab9966fc8414807b8a b/.git/objects/f8/154e00ed87f700e71790ab9966fc8414807b8a new file mode 100644 --- /dev/null +++ b/.git/objects/f8/154e00ed87f700e71790ab9966fc8414807b8a @@ -0,0 +1,2 @@ +x•A +1 E]÷¹€’L›©·#Ö N«c¼½2žÀÕ›÷~îÓT (ÒÊfU¤I·X|aÏñ“ú8Ž9dF)““§]ú çÞÞ»e^÷CS{d¹éæ { À8¤q †52¢Ë˛鿞;¶jU®ð ¸Ä17« diff --git a/.git/objects/fe/09b1a7385815667ec69a1b68be676d0eb7cf46 b/.git/objects/fe/09b1a7385815667ec69a1b68be676d0eb7cf46 new file mode 100644 Binary files /dev/null and b/.git/objects/fe/09b1a7385815667ec69a1b68be676d0eb7cf46 differ diff --git a/.git/objects/fe/977d416f9d343f9e97002d5664550eeed16ee0 b/.git/objects/fe/977d416f9d343f9e97002d5664550eeed16ee0 new file mode 100644 Binary files /dev/null and b/.git/objects/fe/977d416f9d343f9e97002d5664550eeed16ee0 differ diff --git a/.git/packed-refs b/.git/packed-refs new file mode 100644 --- /dev/null +++ b/.git/packed-refs @@ -0,0 +1,2 @@ +# pack-refs with: peeled fully-peeled +9bc107a80e863822b328bf64a795c3ef54e001b1 refs/remotes/origin/master diff --git a/.git/refs/heads/master b/.git/refs/heads/master new file mode 100644 --- /dev/null +++ b/.git/refs/heads/master @@ -0,0 +1,1 @@ +4afd6ed7d81c474bf5c88c395a584e4f68b039ce diff --git a/.git/refs/remotes/origin/HEAD b/.git/refs/remotes/origin/HEAD new file mode 100644 --- /dev/null +++ b/.git/refs/remotes/origin/HEAD @@ -0,0 +1,1 @@ +ref: refs/remotes/origin/master diff --git a/.git/refs/remotes/origin/master b/.git/refs/remotes/origin/master new file mode 100644 --- /dev/null +++ b/.git/refs/remotes/origin/master @@ -0,0 +1,1 @@ +4afd6ed7d81c474bf5c88c395a584e4f68b039ce diff --git a/Euterpea.cabal b/Euterpea.cabal --- a/Euterpea.cabal +++ b/Euterpea.cabal @@ -1,135 +1,75 @@ -name: Euterpea -version: 1.1.1 -Cabal-Version: >= 1.8 -license: BSD3 -license-file: License -copyright: Copyright (c) 2008-2015 Paul Hudak -category: Sound -stability: experimental -build-type: Custom -author: Paul Hudak , - Eric Cheng , - Hai (Paul) Liu -maintainer: Donya Quick , - Dan Winograd-Cort , - Mark Santolucito -bug-reports: https://github.com/Euterpea/Euterpea/issues -homepage: http://haskell.cs.yale.edu/ -synopsis: Library for computer music research and education -description: - Euterpea is a domain-specific language embedded in Haskell for - computer music research, education, and development, providing - both note-level and signal-level abstractions. It is a descendant - of Haskore and HasSound, and is intended for both educational purposes - as well as serious computer music applications. Euterpea is a - wide-spectrum DSL, suitable for high-level music representation, - algorithmic composition, and analysis; mid-level concepts such as - MIDI; and low-level audio processing, sound synthesis, and instrument - design. It also includes a "musical user interface," a set of - computer-music specific GUI widgets such as keyboards, pushbuttons, - sliders, and so on. The performance of Euterpea is intended to be - as good as any other computer music language, with the goal of being - able to develop real-time applications, using both MIDI and a - high-performance back-end for real-time audio. -extra-source-files: - ReadMe.txt, - Euterpea/Examples/EnableGUI.hs, - HSoM/HSoM.lhs, - HSoM/Preface.lhs, - HSoM/Intro.lhs, - HSoM/Music.lhs, - HSoM/Poly.lhs, - HSoM/Interlude.lhs, - HSoM/Syntax.lhs, - HSoM/MoreMusic.lhs, - HSoM/QualifiedTypes.lhs, - HSoM/Performance.lhs, - HSoM/SelfSimilar.lhs, - HSoM/Induction.lhs, - HSoM/Algebra.lhs, - HSoM/LSystems.lhs, - HSoM/RandomMusic.lhs, - HSoM/ToMidi.lhs, - HSoM/IO.lhs, - HSoM/Monads.lhs, - HSoM/MUI.lhs, - HSoM/Signals.lhs, - HSoM/SigFuns.lhs, - HSoM/SpectrumAnalysis.lhs, - HSoM/Additive.lhs, - HSoM/List-tour.lhs, - HSoM/Class-tour.lhs, - HSoM/Bitans.lhs, - HSoM/Patterns.lhs, - HSoM/myFormat.fmt, - HSoM/HSoM.bib - -Test-Suite test-euterpea - type: exitcode-stdio-1.0 - Hs-Source-Dirs: Tests - Main-Is: RunAllTests.hs - Ghc-Options: -threaded - build-depends: base, Euterpea, - QuickCheck >= 2.6, Cabal >= 1.9.2, - ansi-terminal - -Library - hs-source-dirs: . - ghc-options: -O2 -funbox-strict-fields -fexcess-precision - extensions: CPP - exposed-modules: - Euterpea, - Euterpea.Experimental, - Euterpea.ExperimentalPlay, - Control.Arrow.ArrowP, - Control.SF.SF, - Euterpea.Examples.EuterpeaExamples - Euterpea.Examples.Interlude, - Euterpea.Examples.Instruments, - Euterpea.Examples.IntervalTrainer, - Euterpea.Examples.LSystems, - Euterpea.Examples.MUIExamples, - Euterpea.Examples.MUI, - Euterpea.Examples.MusicToSignal, - Euterpea.Examples.NewResolutions, - Euterpea.Examples.RandomMusic, - Euterpea.Examples.SelfSimilar, - Euterpea.Examples.SoundCheck, - Euterpea.Examples.SSF, - Euterpea.Examples.SigFuns, - Euterpea.Examples.Additive, - Euterpea.IO.Audio.Basics, - Euterpea.IO.Audio.BasicSigFuns, - Euterpea.IO.Audio.IO, - Euterpea.IO.Audio.Render, - Euterpea.IO.Audio.Types, - Euterpea.IO.Audio.CSound, - Euterpea.IO.Audio, - Euterpea.IO.MIDI.MidiIO, - Euterpea.IO.MIDI.FromMidi, - Euterpea.IO.MIDI.GeneralMidi, - Euterpea.IO.MIDI.ToMidi, - Euterpea.IO.MIDI.ExportMidiFile, - Euterpea.IO.MIDI, - Euterpea.IO.MUI.MidiWidgets, - Euterpea.IO.MUI.InstrumentWidgets, - Euterpea.IO.MUI.InstrumentBase, - Euterpea.IO.MUI.FFT, - Euterpea.IO.MUI.Guitar, - Euterpea.IO.MUI.Piano, - Euterpea.IO.MUI.UISFCompat, - Euterpea.IO.MUI, - Euterpea.Music.Note.MoreMusic, - Euterpea.Music.Note.Music, - Euterpea.Music.Note.Performance, - Euterpea.Music.Signal.SpectrumAnalysis, - System.Random.Distributions - other-modules: - build-depends: - base >= 3 && < 5, arrows >= 0.4, array, deepseq, random, - PortMidi, HCodecs >= 0.2, - stm, containers, bytestring, heap == 0.6.0, - markov-chain, pure-fft, - UISF >= 0.4 - if (impl(ghc >= 6.10)) - build-depends: base >= 4 && < 5, ghc-prim +name: Euterpea +version: 2.0.0 +Cabal-Version: >= 1.8 +license: BSD3 +license-file: License +copyright: Copyright (c) 2008-2016 Euterpea authors +category: Sound +stability: experimental +build-type: Custom +author: Paul Hudak , + Eric Cheng , + Hai (Paul) Liu , + Donya Quick , + Dan Winograd-Cort +maintainer: Donya Quick +bug-reports: https://github.com/Euterpea/Euterpea2/issues +homepage: http://www.euterpea.com +synopsis: Library for computer music research and education +description: + Euterpea is a domain-specific language embedded in Haskell for + computer music research, education, and development, providing + both note-level and signal-level abstractions. It is a descendant + of Haskore and HasSound, and is intended for both educational purposes + as well as serious computer music applications. Euterpea is a + wide-spectrum DSL, suitable for high-level music representation, + algorithmic composition, and analysis; mid-level concepts such as + MIDI; and low-level audio processing, sound synthesis, and instrument + design. It also includes a "musical user interface," a set of + computer-music specific GUI widgets such as keyboards, pushbuttons, + sliders, and so on. The performance of Euterpea is intended to be + as good as any other computer music language, with the goal of being + able to develop real-time applications, using both MIDI and a + high-performance back-end for real-time audio. +extra-source-files: + ReadMe.txt, + Euterpea/Examples/EnableGUI.hs + +Library + hs-source-dirs: . + ghc-options: -O2 -funbox-strict-fields -fexcess-precision + extensions: CPP + exposed-modules: + Euterpea, + Euterpea.Music, + Control.Arrow.ArrowP, + Control.SF.SF, + Euterpea.IO.Audio.Basics, + Euterpea.IO.Audio.BasicSigFuns, + Euterpea.IO.Audio.IO, + Euterpea.IO.Audio.Render, + Euterpea.IO.Audio.Types, + Euterpea.IO.Audio.CSound, + Euterpea.IO.Audio, + Euterpea.IO.MIDI.MEvent, + Euterpea.IO.MIDI.MidiIO, + Euterpea.IO.MIDI.FromMidi, + Euterpea.IO.MIDI.GeneralMidi, + Euterpea.IO.MIDI.ToMidi, + Euterpea.IO.MIDI.Play, + Euterpea.IO.MIDI.ExportMidiFile, + Euterpea.IO.MIDI + other-modules: + build-depends: + base >= 4 && < 5, + arrows == 0.4.4.1, + array>=0.5.0.0 && <=0.5.1.1, + deepseq>=1.3.0.2 && <=1.4.2.0, + random>=1.0.1.1 && <=1.1, + PortMidi==0.1.5.2, + HCodecs == 0.5, + stm==2.4.2, + containers>=0.5.5.1 && <=0.5.7.1, + bytestring>=0.10.4.0 && <= 0.10.8.0, + heap == 0.6.0, + ghc-prim diff --git a/Euterpea.lhs b/Euterpea.lhs --- a/Euterpea.lhs +++ b/Euterpea.lhs @@ -2,33 +2,18 @@ > {-# OPTIONS -XTypeSynonymInstances #-} > module Euterpea ( -> module Euterpea.Music.Note.Music, -> module Euterpea.Music.Note.MoreMusic, -> module Euterpea.Music.Note.Performance, +> module Euterpea.Music, > module Euterpea.IO.Audio, > module Euterpea.IO.MIDI, -> module Euterpea.IO.MUI, > module Control.Arrow, -> -- These 4 lines are from FRP.UISF.AuxFunctions -> SEvent, edge, accum, constA, constSF, foldA, foldSF, -> unique, hold, now, mergeE, -> delay, vdelay, fdelay, -> timer, genEvents, Time, DeltaT, > -- This next line is from Codec.Midi > exportFile, importFile > ) where > -> import Euterpea.Music.Note.Music hiding (t251) -> import Euterpea.Music.Note.MoreMusic -> import Euterpea.Music.Note.Performance +> import Euterpea.Music > import Euterpea.IO.Audio > import Euterpea.IO.MIDI -> import Euterpea.IO.MUI - > import Control.Arrow -> import FRP.UISF.AuxFunctions hiding ((~++)) - > import Codec.Midi(exportFile, importFile) - > import Control.Arrow.Operations diff --git a/Euterpea/Examples/Additive.hs b/Euterpea/Examples/Additive.hs deleted file mode 100644 --- a/Euterpea/Examples/Additive.hs +++ /dev/null @@ -1,220 +0,0 @@ -{-# LINE 8 "Additive.lhs" #-} --- This code was automatically generated by lhs2tex --code, from the file --- HSoM/Additive.lhs. (See HSoM/MakeCode.bat.) -{-# LINE 18 "Additive.lhs" #-} -{-# LANGUAGE Arrows #-} - -module Euterpea.Examples.Additive where -import Euterpea -{-# LINE 383 "Additive.lhs" #-} --- TBD -{-# LINE 393 "Additive.lhs" #-} --- TBD -{-# LINE 426 "Additive.lhs" #-} -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 = tableSinesN 4096 [1] - -bellTest1 = outFile "bell1.wav" 6 (bell1 6 (absPitch (C,5)) 100 []) -{-# LINE 449 "Additive.lhs" #-} -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 - -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)] - -bellTest1' = outFile "bell'1.wav" 6 (bell'1 6 (absPitch (C,5)) 100 []) -{-# LINE 491 "Additive.lhs" #-} -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 - -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 - -bellTest2 = outFile "bell2.wav" 6 (bell2 6 (absPitch (C,5)) 100 []) -{-# LINE 739 "Additive.lhs" #-} -sineTable :: Table -sineTable = tableSinesN 4096 [1] - -env1 :: AudSF () Double -env1 = envExpon 20 10 10000 -{-# LINE 764 "Additive.lhs" #-} -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) -{-# LINE 774 "Additive.lhs" #-} -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 -{-# LINE 789 "Additive.lhs" #-} -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 [] -{-# LINE 805 "Additive.lhs" #-} -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 [] -{-# LINE 826 "Additive.lhs" #-} -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 []) -{-# LINE 839 "Additive.lhs" #-} -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 -{-# LINE 856 "Additive.lhs" #-} -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 [] -{-# LINE 872 "Additive.lhs" #-} -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 []) -{-# LINE 885 "Additive.lhs" #-} -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 []) -{-# LINE 898 "Additive.lhs" #-} -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 []) -{-# LINE 914 "Additive.lhs" #-} -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 []) -{-# LINE 927 "Additive.lhs" #-} -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 []) -{-# LINE 943 "Additive.lhs" #-} -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 []) -{-# LINE 956 "Additive.lhs" #-} -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 []) diff --git a/Euterpea/Examples/EnableGUI.hs b/Euterpea/Examples/EnableGUI.hs deleted file mode 100644 --- a/Euterpea/Examples/EnableGUI.hs +++ /dev/null @@ -1,40 +0,0 @@ -{-# 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 diff --git a/Euterpea/Examples/EuterpeaExamples.lhs b/Euterpea/Examples/EuterpeaExamples.lhs deleted file mode 100644 --- a/Euterpea/Examples/EuterpeaExamples.lhs +++ /dev/null @@ -1,218 +0,0 @@ -> module Euterpea.Examples.EuterpeaExamples where -> -> import Euterpea -> import Euterpea.Examples.Interlude -> import Euterpea.Examples.SelfSimilar -> import Euterpea.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 )) - ------------------------------------------------------------------------------ - -A function to recursively apply transformations f (to elements in a -sequence) and g (to accumulated phrases): - -> {- -> rep :: (Music a -> Music a) -> (Music a -> Music a) -> Int -> -> Music a -> Music a -> rep f g 0 m = Prim (Rest 0) -> rep f g n m = m :=: g (rep f g (n-1) (f m)) - -An example using "rep" three times, recursively, to create a "cascade" -of sounds. - -> run = rep (Modify (Transpose 5)) (delayM tn) 8 (c 4 tn) -> cascade = rep (Modify (Transpose 4)) (delayM en) 8 run -> cascades = rep id (delayM sn) 2 cascade -> -} - -> t4' x = play (Modify (Instrument AcousticGrandPiano) x) -> t4 = play (Modify (Instrument AcousticGrandPiano) -> (cascades :+: revM cascades)) - -What happens if we simply reverse the f and g arguments? - -> {- -> run' = rep (delayM tn) (Modify (Transpose 5)) 4 (c 4 tn) -> cascade' = rep (delayM en) (Modify (Transpose 4)) 6 run' -> cascades' = rep (delayM sn) id 2 cascade' -> -} - -> t5 = play (Modify (Instrument AcousticGrandPiano) cascades') - ------------------------------------------------------------------------------ - -Example from the SelfSimilar module. - -> t10s = play (rep (delayM (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 (repeatM -> ((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 (repeatM -> ((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 = do -> exportFile "test.mid" $ makeMidi (m, defCon, defUpm) - -Music to a MidiFile datatype and back to Music. - -> tad m = fromMidi (testMidi 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 $ fst3 $ fromMidi x -> print $ snd3 $ fromMidi x -> print $ thd3 $ fromMidi x - -A MIDI file to Music and back to a MIDI file. - -> tcdab file = do -> x <- loadMidiFile file -> exportFile "test.mid" $ makeMidi $ fromMidi x - -> fst3 (a,b,c) = a -> snd3 (a,b,c) = b -> thd3 (a,b,c) = c - diff --git a/Euterpea/Examples/Instruments.hs b/Euterpea/Examples/Instruments.hs deleted file mode 100644 --- a/Euterpea/Examples/Instruments.hs +++ /dev/null @@ -1,88 +0,0 @@ -{-# LANGUAGE Arrows #-} -module Euterpea.Examples.Instruments where -import Euterpea -import Euterpea.Experimental - --- Here is a demonstration of the guitar and piano widgets available in Euterpea. - -main = instrumentDemo -instrumentDemo :: IO () -instrumentDemo = runMUI (defaultMUIParams {uiSize=(1038,706), uiTitle="Instrument Demo"}) $ proc _ -> do - devId <- selectOutput -< () - -- The song player is a standard component that plays back a music value. The string is used - -- as a display name. - song <- songPlayer [("Sonata In C", tempo 2 sonataInC), ("Frere Jaques", tempo (2/3) fjfj)] -< () - -- The InstrumentData structure holds the settings for each instrument. - -- If you want to be able to change these settings at runtime, a structure like this is necessary - -- addNotation presents a checkbox that allows the user to toggle the display of pitch classes - -- on the instruements. In this example, a single settings variable is used. - settings <- addNotation -< defaultInstrumentData - -- The guitar UISF takes in a keymap (sixString is the only one available at the moment) and - -- a midi channel. Any midi messages passed into the guitar will be coerced to that channel. - guitar1 <- guitar sixString 1 -< (settings, Nothing) - -- Select instrument takes in a channel and an initial midi instrument, 0 is Grand Piano, 25 is steel guitar. - -- As the slider is changed, it prepends midi messages to its input to change the instrument on the given - -- channel. - outG <- selectInstrument 1 25 -< guitar1 - piano1 <- piano defaultMap0 0 -< (settings, song) - outP <- selectInstrument 0 0 -< piano1 - -- ~++ attempts to concatenate Maybe Lists, using Nothing as though it were [] - midiOut -< (devId, outG ~++ outP) - --- The exposition of Mozart's Sonata in C, the "Easy Sonata" - -sonataInC :: Music Pitch -sonataInC = line [c 5 wn, e 5 hn, g 5 hn, b 4 dhn, c 5 en, d 5 en, c 5 hn, rest hn, - a 5 wn, g 5 hn, c 6 hn, g 5 hn, f 5 en, g 5 en, e 5 en, f 5 en, e 5 hn, rest hn, - a 4 qn, b 4 en, c 5 en, d 5 en, e 5 en, f 5 en, g 5 en, a 5 en, - g 5 en, f 5 en, e 5 en, d 5 en, c 5 en, b 4 en, a 4 en, - g 4 qn, a 4 en, b 4 en, c 5 en, d 5 en, e 5 en, f 5 en, g 5 en, - f 5 en, e 5 en, d 5 en, c 5 en, b 4 en, a 4 en, g 4 en, - f 4 qn, g 4 en, a 4 en, b 4 en, c 5 en, d 5 en, e 5 en, f 5 en, - e 5 en, d 5 en, c 5 en, b 4 en, a 4 en, g 4 en, f 4 en, - e 4 qn, f 4 en, g 4 en, a 4 en, b 4 en, c 5 en, d 5 en, e 5 en, - d 5 en, c 5 en, b 4 en, a 4 en, g 4 en, f 4 en, e 4 en, - d 4 qn, e 4 en, f 4 en, g 4 en, a 4 en, b 4 en, cs 5 en, - d 5 en, a 4 en, b 4 en, cs 5 en, d 5 en, e 5 en, f 5 en, g 5 en, - a 5 en, b 5 en, c 6 en, b 5 en, a 5 en, g 5 en, f 5 en, e 5 en, - f 5 en, g 5 en, a 5 en, g 5 en, f 5 en, e 5 en, d 5 en, c 5 en, - b 4 qn, g 5 qn, e 5 qn, c 5 qn, d 5 qn, g 5 qn, e 5 qn, c 5 qn, - d 5 hn, g 5 hn, g 4 hn, rest hn, - fs 4 en, g 4 en, fs 4 en, g 4 en, fs 4 en, g 4 en, fs 4 en, g 4 en, - f 4 en, g 4 en, f 4 en, g 4 en, f 4 en, g 4 en, f 4 en, g 4 en, - g 5 qn, e 5 qn, c 5 dhn, d 5 en, e 5 en, d 5 qn, c 5 qn, - c 5 dqn, b 4 en, b 4 hn, rest wn, g 5 qn, e 5 qn, c 5 dhn, - d 5 en, e 5 en, d 5 qn, c 5 qn, c 5 dqn, b 4 en, b 4 hn, rest wn, - g 5 en, e 3 en,g 3 en, c 4 en, e 4 en, g 5 en, e 5 en, c 5 en, - a 4 en, f 3 en, a 3 en, c 4 en, f 4 en, a 4 en, c 5 en, a 4 en, - f 5 en, d 3 en, f 3 en, b 3 en, d 4 en, f 5 en, d 5 en, b 4 en, - g 4 en, e 3 en, g 3 en, b 3 en, e 4 en, g 4 en, b 4 en, g 4 en, - e 5 en, c 4 en, e 4 en, a 4 en, c 5 en, e 5 en, c 5 en, a 4 en, - f 4 en, d 4 en, f 4 en, a 4 en, d 5 en, f 4 en, a 4 en, f 4 en, - d 6 en, b 3 en, d 4 en, g 4 en, b 4 en, d 6 en, b 5 en, g 5 en, - e 5 en, c 4 en, e 4 en, g 4 en, c 5 en, c 6 en, g 5 en, e 5 en, - d 5 wn, d 5 hn, d 5 hn, a 5 wn, a 5 hn, a 5 hn, g 5 qn, a 5 en, - b 5 en, c 6 en, d 6 en, e 6 en, d 6 en, c 6 en, b 5 en, a 5 en, - g 5 en, f 5 en, e 5 en, d 5 en, c 5 en, e 5 en, d 5 en, e 5 en, - d 5 en, e 5 en, d 5 en, e 5 en, d 5 en, e 5 en, d 5 en, e 5 en, - d 5 en, e 5 en, d 5 en, c 5 en, d 5 en, c 5 hn, c 5 en, g 4 en, - c 5 en, e 5 en, g 5 en, e 5 en, c 5 en, e 5 en, f 5 en, d 5 en, - b 4 en, d 5 en, c 5 hn, c 4 en, g 3 en, c 4 en, e 4 en, g 4 en, - e 4 en, c 4 en, e 4 en, f 4 en, d 4 en, b 3 en, d 4 en, c 4 hn, - c 5 hn, c 4 hn] - --- Frere-Jaques using some more Euterpea features - -fj0, fj1, fj2, fj3, fj4 :: Music Pitch -fj0 = c 4 qn :+: c 4 qn :+: c 4 qn -fj1 = c 4 qn :+: d 4 qn :+: e 4 qn :+: c 4 qn -fj2 = e 4 qn :+: f 4 qn :+: g 4 hn -fj3 = g 4 en :+: a 4 en :+: g 4 en :+: f 4 en :+: e 4 qn :+: c 4 qn -fj4 = c 4 qn :+: g 3 qn :+: c 4 hn - -fj :: Music Pitch -fj = two fj1 :+: two fj2 :+: two fj3 :+: two fj4 - where two m = m :+: m - -fjfj :: Music Pitch -fjfj = Modify (Tempo 4) (Modify (Instrument AcousticGrandPiano) fj) diff --git a/Euterpea/Examples/Interlude.hs b/Euterpea/Examples/Interlude.hs deleted file mode 100644 --- a/Euterpea/Examples/Interlude.hs +++ /dev/null @@ -1,72 +0,0 @@ -{-# LINE 8 "Interlude.lhs" #-} --- This code was automatically generated by lhs2tex --code, from the file --- HSoM/Interlude.lhs. (See HSoM/MakeCode.bat.) -{-# LINE 94 "Interlude.lhs" #-} -module Euterpea.Examples.Interlude - ( childSong6, -- :: Music Pitch, - prefix -- :: [Music a] -> Music a) - ) where -import Euterpea -{-# LINE 179 "Interlude.lhs" #-} -addDur :: Dur -> [Dur -> Music a] -> Music a -addDur d ns = let f n = n d - in line (map f ns) -{-# LINE 198 "Interlude.lhs" #-} -graceNote :: Int -> Music Pitch -> Music Pitch -{-# LINE 206 "Interlude.lhs" #-} -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." -{-# LINE 232 "Interlude.lhs" #-} -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] -{-# LINE 241 "Interlude.lhs" #-} -bassLine = timesM 3 b1 :+: timesM 2 b2 :+: - timesM 4 b3 :+: timesM 5 b1 -{-# LINE 253 "Interlude.lhs" #-} -mainVoice = timesM 3 v1 :+: v2 -{-# LINE 258 "Interlude.lhs" #-} -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] -{-# LINE 266 "Interlude.lhs" #-} -v2 = v2a :+: v2b :+: v2c :+: v2d :+: v2e :+: v2f :+: v2g -{-# LINE 289 "Interlude.lhs" #-} -v2a = line [ cs 5 (dhn+dhn), d 5 dhn, - f 5 hn, gs 5 qn, fs 5 (hn+en), g 5 en] -- bars 7-11 -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] -- bars 12-13 -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] - -- bars 14-16 -v2d = addDur en [ fs 5, cs 5, e 5, cs 5, - a 4, as 4, d 5, e 5, fs 5] -- bars 17-18.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 ] - -- bars 18.5-20 -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] -- bars 21-23 -v2g = tempo (3/2) (line [cs 5 en, d 5 en, cs 5 en]) :+: - b 4 (3*dhn+hn) -- bars 24-28 -{-# LINE 326 "Interlude.lhs" #-} -childSong6 :: Music Pitch -childSong6 = let t = (dhn/qn)*(69/120) - in instrument RhodesPiano - (tempo t (bassLine :=: mainVoice)) -{-# LINE 376 "Interlude.lhs" #-} -prefixes :: [a] -> [[a]] -prefixes [] = [] -prefixes (x:xs) = let f pf = x:pf - in [x] : map f (prefixes xs) -{-# LINE 394 "Interlude.lhs" #-} -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 -{-# LINE 404 "Interlude.lhs" #-} -mel1 = [c 5 en, e 5 sn, g 5 en, b 5 sn, a 5 en, f 5 sn, d 5 en, b 4 sn, c 5 en] -mel2 = [c 5 sn, e 5 sn, g 5 sn, b 5 sn, a 5 sn, f 5 sn, d 5 sn, b 4 sn, c 5 sn] diff --git a/Euterpea/Examples/IntervalTrainer.lhs b/Euterpea/Examples/IntervalTrainer.lhs deleted file mode 100644 --- a/Euterpea/Examples/IntervalTrainer.lhs +++ /dev/null @@ -1,199 +0,0 @@ -> {-# LANGUAGE Arrows #-} - -> module Euterpea.Examples.IntervalTrainer where - -> import Euterpea -> import Euterpea.Experimental (liftAIO) -> import System.Random (randomRIO) -> import Codec.Midi (Message(ProgramChange)) - -> import FRP.UISF.AuxFunctions (concatA, evMap) - - -> 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 ~++ 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 ->> diff --git a/Euterpea/Examples/LSystems.hs b/Euterpea/Examples/LSystems.hs deleted file mode 100644 --- a/Euterpea/Examples/LSystems.hs +++ /dev/null @@ -1,145 +0,0 @@ -{-# LINE 8 "LSystems.lhs" #-} --- This code was automatically generated by lhs2tex --code, from the file --- HSoM/LSystems.lhs. (See HSoM/MakeCode.bat.) -{-# LINE 19 "LSystems.lhs" #-} -module Euterpea.Examples.LSystems where - -import Euterpea -import Data.List hiding (transpose) -import System.Random -{-# LINE 81 "LSystems.lhs" #-} -data DetGrammar a = DetGrammar a -- start symbol - [(a,[a])] -- productions - deriving Show -{-# LINE 89 "LSystems.lhs" #-} -detGenerate :: Eq a => DetGrammar a -> [[a]] -detGenerate (DetGrammar st ps) = iterate (concatMap f) [st] - where f a = maybe [a] id (lookup a ps) -{-# LINE 131 "LSystems.lhs" #-} -redAlgae = DetGrammar 'a' - [ ('a',"b|c"), ('b',"b"), ('c',"b|d"), - ('d',"e\\d"), ('e',"f"), ('f',"g"), - ('g',"h(a)"), ('h',"h"), ('|',"|"), - ('(',"("), (')',")"), ('/',"\\"), - ('\\',"/") - ] -{-# LINE 157 "LSystems.lhs" #-} -t n g = sequence_ (map putStrLn (take n (detGenerate g))) -{-# LINE 221 "LSystems.lhs" #-} -data Grammar a = Grammar a -- start sentence - (Rules a) -- production rules - deriving Show -{-# LINE 232 "LSystems.lhs" #-} -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 -{-# LINE 247 "LSystems.lhs" #-} -type ReplFun a = [[(Rule a, Prob)]] -> (a, [Rand]) -> (a, [Rand]) -type Rand = Double -{-# LINE 264 "LSystems.lhs" #-} -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.") -{-# LINE 280 "LSystems.lhs" #-} -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) -{-# LINE 300 "LSystems.lhs" #-} -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 -{-# LINE 317 "LSystems.lhs" #-} -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) -{-# LINE 347 "LSystems.lhs" #-} -data LSys a = N a - | LSys a :+ LSys a - | LSys a :. LSys a - | Id - deriving (Eq, Ord, Show) -{-# LINE 366 "LSystems.lhs" #-} -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) -{-# LINE 384 "LSystems.lhs" #-} -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" -{-# LINE 405 "LSystems.lhs" #-} -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" -{-# LINE 418 "LSystems.lhs" #-} -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 -{-# LINE 437 "LSystems.lhs" #-} -sc = inc :+ dec -{-# LINE 442 "LSystems.lhs" #-} -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 -{-# LINE 452 "LSystems.lhs" #-} -g1 = Grammar same (Uni [r1b, r1a, r2b, r2a, r3a, r3b]) -{-# LINE 458 "LSystems.lhs" #-} -t1 n = instrument Vibraphone $ - interpret (gen replFun g1 42 !! n) ir (c 5 tn) diff --git a/Euterpea/Examples/MUI.hs b/Euterpea/Examples/MUI.hs deleted file mode 100644 --- a/Euterpea/Examples/MUI.hs +++ /dev/null @@ -1,228 +0,0 @@ -{-# LINE 8 "MUI.lhs" #-} --- This code was automatically generated by lhs2tex --code, from the file --- HSoM/MUI.lhs. (See HSoM/MakeCode.bat.) -{-# LINE 19 "MUI.lhs" #-} -{-# LANGUAGE Arrows, CPP #-} - -module Euterpea.Examples.MUI where -import Euterpea -{-# LINE 25 "MUI.lhs" #-} -import Data.Maybe (mapMaybe) -import Euterpea.Experimental -#if MIN_VERSION_UISF(0,4,0) -import FRP.UISF.Graphics (withColor', rgbE, rectangleFilled) -import FRP.UISF.Widget.Construction (mkWidget) -#else -import FRP.UISF.SOE (withColor', rgb, polygon) -import FRP.UISF.Widget (mkWidget) -#endif -{-# LINE 585 "MUI.lhs" #-} -ui0 :: UISF () () -ui0 = proc _ -> do - ap <- hiSlider 1 (0,100) 0 -< () - display -< pitch ap -{-# LINE 605 "MUI.lhs" #-} -mui0 = runMUI' ui0 -{-# LINE 686 "MUI.lhs" #-} -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 -{-# LINE 708 "MUI.lhs" #-} -ui2 :: UISF () () -ui2 = leftRight $ - proc _ -> do - ap <- title "Absolute Pitch" (hiSlider 1 (0,100) 0) -< () - title "Pitch" display -< pitch ap - -mui2 = runMUI' ui2 -{-# LINE 837 "MUI.lhs" #-} -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 -{-# LINE 871 "MUI.lhs" #-} -ui4 :: UISF () () -ui4 = proc _ -> do - mi <- selectInput -< () - mo <- selectOutput -< () - m <- midiIn -< mi - midiOut -< (mo, m) - -mui4 = runMUI' ui4 -{-# LINE 885 "MUI.lhs" #-} -getDeviceIDs = topDown $ - proc () -> do - mi <- selectInput -< () - mo <- selectOutput -< () - outA -< (mi,mo) -{-# LINE 935 "MUI.lhs" #-} -mui'4 = runMUI (defaultMUIParams - { uiTitle = "MIDI Input / Output UI", - uiSize = (200,200)}) - ui4 -{-# LINE 1111 "MUI.lhs" #-} -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) - --- Pitch Player with Timer -mui5 = runMUI' ui5 -{-# LINE 1233 "MUI.lhs" #-} -chordIntervals :: [ (String, [Int]) ] -chordIntervals = [ ("Maj", [4,3,5]), ("Maj7", [4,3,4,1]), - ("Maj9", [4,3,4,3]), ("Maj6", [4,3,2,3]), - ("min", [3,4,5]), ("min7", [3,4,3,2]), - ("min9", [3,4,3,4]), ("min7b5", [3,3,4,2]), - ("mMaj7", [3,4,4,1]), ("dim", [3,3,3]), - ("dim7", [3,3,3,3]), ("Dom7", [4,3,3,2]), - ("Dom9", [4,3,3,4]), ("Dom7b9", [4,3,3,3]) ] -{-# LINE 1250 "MUI.lhs" #-} -toChord :: Int -> MidiMessage -> [MidiMessage] -toChord i m = - case m of - Std (NoteOn c k v) -> f NoteOn c k v - Std (NoteOff c k v) -> f NoteOff c k v - _ -> [] - where f g c k v = map (\k' -> Std (g c k' v)) - (scanl (+) k (snd (chordIntervals !! i))) -{-# LINE 1277 "MUI.lhs" #-} -buildChord :: UISF () () -buildChord = leftRight $ - proc _ -> do - (mi, mo) <- getDeviceIDs -< () - m <- midiIn -< mi - i <- topDown $ title "Chord Type" $ - radio (fst (unzip chordIntervals)) 0 -< () - midiOut -< (mo, fmap (concatMap $ toChord i) m) - -chordBuilder = runMUI (defaultMUIParams - { uiTitle = "Chord Builder", - uiSize = (600,400)}) - buildChord -{-# LINE 1338 "MUI.lhs" #-} -grow :: Double -> Double -> Double -grow r x = r * x * (1-x) -{-# LINE 1370 "MUI.lhs" #-} -popToNote :: Double -> [MidiMessage] -popToNote x = [ANote 0 n 64 0.05] - where n = truncate (x * 127) -{-# LINE 1380 "MUI.lhs" #-} -bifurcateUI :: UISF () () -bifurcateUI = proc _ -> do - mo <- selectOutput -< () - f <- title "Frequency" $ withDisplay (hSlider (1, 10) 1) -< () - tick <- timer -< 1/f - r <- title "Growth rate" $ withDisplay (hSlider (2.4, 4.0) 2.4) -< () - pop <- accum 0.1 -< fmap (const (grow r)) tick - _ <- title "Population" $ display -< pop - midiOut -< (mo, fmap (const (popToNote pop)) tick) - -bifurcate = runMUI (defaultMUIParams - { uiTitle = "Bifurcate!", - uiSize = (300,500)}) - bifurcateUI -{-# LINE 1434 "MUI.lhs" #-} -echoUI :: UISF () () -echoUI = proc _ -> do - (mi, mo) <- getDeviceIDs -< () - m <- midiIn -< mi - r <- title "Decay rate" $ withDisplay (hSlider (0, 0.9) 0.5) -< () - f <- title "Echoing frequency" $ withDisplay (hSlider (1, 10) 10) -< () - - rec s <- vdelay -< (1/f, fmap (mapMaybe (decay 0.1 r)) m') - let m' = m ~++ s - - midiOut -< (mo, m') - -echo = runMUI' echoUI -{-# LINE 1451 "MUI.lhs" #-} -decay :: Time -> Double -> MidiMessage -> Maybe MidiMessage -decay dur r m = - let f c k v d = if v > 0 - then let v' = truncate (fromIntegral v * r) - in Just (ANote c k v' 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 -{-# LINE 1712 "MUI.lhs" #-} -gAndPUI :: UISF () () -gAndPUI = proc _ -> do - (mi, mo) <- getDeviceIDs -< () - m <- midiIn -< mi - settings <- addNotation -< defaultInstrumentData - outG <- guitar sixString 1 -< (settings, Nothing) - outP <- piano defaultMap0 0 -< (settings, m) - midiOut -< (mo, outG ~++ outP) - -gAndP = runMUI (defaultMUIParams { uiSize=(1050,700), - uiTitle="Guitar and Piano"}) - gAndPUI -{-# LINE 1783 "MUI.lhs" #-} -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) -#if MIN_VERSION_UISF(0,4,0) - let rect = withColor' (rgbE r g b) (rectangleFilled ((0,0),d)) -#else - let rect = withColor' (rgb r g b) (box ((0,0),d)) -#endif - 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 -#if MIN_VERSION_UISF(0,4,0) -#else - box ((x,y), (w, h)) = - polygon [(x, y), (x + w, y), (x + w, y + h), (x, y + h)] -#endif - -colorSwatch = runMUI' colorSwatchUI -{-# LINE 1898 "MUI.lhs" #-} -ui6 = topDown $ proc _ -> do - b1 <- button "Button 1" -< () - (b2, b3) <- leftRight (proc _ -> do - b2 <- button "Button 2" -< () - b3 <- button "Button 3" -< () - returnA -< (b2, b3)) -< () - b4 <- button "Button 4" -< () - display -< b1 || b2 || b3 || b4 -{-# LINE 1916 "MUI.lhs" #-} -ui'6 = topDown $ proc _ -> do - b1 <- button "Button 1" -< () - (b2, b3) <- leftRight (proc b1 -> do - b2 <- button "Button 2" -< () - display -< b1 - b3 <- button "Button 3" -< () - returnA -< (b2, b3)) -< b1 - b4 <- button "Button 4" -< () - display -< b1 || b2 || b3 || b4 -{-# LINE 1947 "MUI.lhs" #-} -ui''6 = proc () -> do - b1 <- button "Button 1" -< () - (b2, b3) <- (| leftRight (do - b2 <- button "Button 2" -< () - display -< b1 - b3 <- button "Button 3" -< () - returnA -< (b2, b3)) |) - b4 <- button "Button 4" -< () - display -< b1 || b2 || b3 || b4 diff --git a/Euterpea/Examples/MUIExamples.lhs b/Euterpea/Examples/MUIExamples.lhs deleted file mode 100644 --- a/Euterpea/Examples/MUIExamples.lhs +++ /dev/null @@ -1,177 +0,0 @@ -> {-# LANGUAGE Arrows #-} - -> module Euterpea.Examples.MUIExamples where - -> 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 - diff --git a/Euterpea/Examples/MusicToSignal.lhs b/Euterpea/Examples/MusicToSignal.lhs deleted file mode 100644 --- a/Euterpea/Examples/MusicToSignal.lhs +++ /dev/null @@ -1,116 +0,0 @@ -> {-# LANGUAGE Arrows #-} - -This file demonstrates how to turn a Music value into an audio signal -using the Render module. - -> module Euterpea.Examples.MusicToSignal where - -> 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 = Custom "pluck-like" -> myReed = Custom "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 = timesM 3 b1 :+: timesM 2 b2 :+: -> timesM 4 b3 :+: timesM 5 b1 - -> mainVoice = timesM 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." - -childSong6 :: Music Pitch -childSong6 = let t = (dhn/qn)*(69/120) - in instrument RhodesPiano - (tempo t (bassLine :=: mainVoice)) diff --git a/Euterpea/Examples/NewResolutions.lhs b/Euterpea/Examples/NewResolutions.lhs deleted file mode 100644 --- a/Euterpea/Examples/NewResolutions.lhs +++ /dev/null @@ -1,226 +0,0 @@ -New Resolutions by Jean-Luc Ponty, Scott O'Neil, and John Garvin - -> module Euterpea.Examples.NewResolutions where -> import Euterpea - -> nrContext = Context {cTime = 0, -> cPlayer = fancyPlayer, -> cInst = Marimba, -> cDur = 1.0, -> cPch = 0, -> cKey = (C,Major), -> cVol = 100} -> -> tNewRes m = makeMidi (m, nrContext, defUpm) - -> 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)]) (timesM 4 pattern)) -> bridge = Modify (Instrument Xylophone) (d 5 hn) -- (d 5 hn [Volume 120]) -> :=: (timesM 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)]) (timesM 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)) -> :=: timesM 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 = timesM 2 $ -> fifth p d :+: minSeventh p d :+: octave p d -> :+: oMinThird p d :+: octave p d :+: minSeventh p d - -> run3 p d = timesM 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 -> :+: timesM 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 (timesM 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 -> :+: timesM 4 (a 5 sn :+: a 5 sn :+: g 5 sn) -> :+: timesM 2 (af 5 sn :+: af 5 sn :+: g 5 sn) -> :+: timesM 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) -> :+: (timesM 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 diff --git a/Euterpea/Examples/RandomMusic.hs b/Euterpea/Examples/RandomMusic.hs deleted file mode 100644 --- a/Euterpea/Examples/RandomMusic.hs +++ /dev/null @@ -1,113 +0,0 @@ -{-# LINE 8 "RandomMusic.lhs" #-} --- This code was automatically generated by lhs2tex --code, from the file --- HSoM/RandomMusic.lhs. (See HSoM/MakeCode.bat.) -{-# LINE 19 "RandomMusic.lhs" #-} -module Euterpea.Examples.RandomMusic where - -import Euterpea - -import System.Random -import System.Random.Distributions -import qualified Data.MarkovChain as M -{-# LINE 55 "RandomMusic.lhs" #-} -sGen :: StdGen -sGen = mkStdGen 42 -{-# LINE 84 "RandomMusic.lhs" #-} -randInts :: StdGen -> [Int] -randInts g = let (x,g') = next g - in x : randInts g' -{-# LINE 114 "RandomMusic.lhs" #-} -randFloats :: [Float] -randFloats = randomRs (-1,1) sGen - -randIntegers :: [Integer] -randIntegers = randomRs (0,100) sGen - -randString :: String -randString = randomRs ('a','z') sGen -{-# LINE 136 "RandomMusic.lhs" #-} -randIO :: IO Float -randIO = randomRIO (0,1) -{-# LINE 143 "RandomMusic.lhs" #-} -randIO' :: IO () -randIO' = do r1 <- randomRIO (0,1) :: IO Float - r2 <- randomRIO (0,1) :: IO Float - print (r1 == r2) -{-# LINE 338 "RandomMusic.lhs" #-} -toAbsP1 :: Float -> AbsPitch -toAbsP1 x = round (40*x + 30) -{-# LINE 347 "RandomMusic.lhs" #-} -mkNote1 :: AbsPitch -> Music Pitch -mkNote1 = note tn . pitch - -mkLine1 :: [AbsPitch] -> Music Pitch -mkLine1 rands = line (take 32 (map mkNote1 rands)) -{-# LINE 361 "RandomMusic.lhs" #-} --- 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) -{-# LINE 421 "RandomMusic.lhs" #-} --- 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))) -{-# LINE 445 "RandomMusic.lhs" #-} -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) -{-# LINE 534 "RandomMusic.lhs" #-} --- 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)) -{-# LINE 556 "RandomMusic.lhs" #-} --- 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) diff --git a/Euterpea/Examples/SSF.lhs b/Euterpea/Examples/SSF.lhs deleted file mode 100644 --- a/Euterpea/Examples/SSF.lhs +++ /dev/null @@ -1,33 +0,0 @@ -The first phrase of the flute part of "Stars and Stripes Forever." - -> module Euterpea.Examples.SSF where -> import Euterpea -> -> legato = Legato (11/10) -> staccato = Staccato (5/10) -> -> ssfMelody = line (m1 ++ m2 ++ m3 ++ m4) -> m1 = [ trilln 2 5 (bf 6 en), -> Modify (Phrase [Art staccato]) (line [ef 7 en, -> ef 6 en, -> ef 7 en])] -> -> m2 = [Modify (Phrase [Art legato]) (line [bf 6 sn, -> c 7 sn, -> bf 6 sn, -> g 6 sn]), -> Modify (Phrase [Art staccato]) (line [ef 6 en, -> bf 5 en])] -> -> m3 = [Modify (Phrase [Art legato]) (line [ef 6 sn, -> f 6 sn, -> g 6 sn, -> af 6 sn]), -> Modify (Phrase [Art staccato]) (line [bf 6 en, -> ef 7 en])] -> -> m4 = [ trill 2 tn (bf 6 qn), -> bf 6 sn, -> denr] -> -> ssf = Modify (Instrument Flute) ssfMelody diff --git a/Euterpea/Examples/SelfSimilar.hs b/Euterpea/Examples/SelfSimilar.hs deleted file mode 100644 --- a/Euterpea/Examples/SelfSimilar.hs +++ /dev/null @@ -1,81 +0,0 @@ -{-# LINE 8 "SelfSimilar.lhs" #-} --- This code was automatically generated by lhs2tex --code, from the file --- HSoM/SelfSimilar.lhs. (See HSoM/MakeCode.bat.) -{-# LINE 18 "SelfSimilar.lhs" #-} -module Euterpea.Examples.SelfSimilar where -import Euterpea -{-# LINE 64 "SelfSimilar.lhs" #-} -data Cluster = Cluster SNote [Cluster] -type SNote = (Dur,AbsPitch) -{-# LINE 85 "SelfSimilar.lhs" #-} -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) -{-# LINE 103 "SelfSimilar.lhs" #-} -fringe :: Int -> Cluster -> [SNote] -fringe 0 (Cluster note cls) = [note] -fringe n (Cluster note cls) = concatMap (fringe (n-1)) cls -{-# LINE 130 "SelfSimilar.lhs" #-} -simToMusic :: [SNote] -> Music Pitch -simToMusic = line . map mkNote - -mkNote :: (Dur,AbsPitch) -> Music Pitch -mkNote (d,ap) = note d (pitch ap) -{-# LINE 143 "SelfSimilar.lhs" #-} -ss pat n tr te = - transpose tr $ tempo te $ simToMusic $ fringe n $ selfSim pat -{-# LINE 151 "SelfSimilar.lhs" #-} -m0 :: [SNote] -m0 = [(1,2),(1,0),(1,5),(1,7)] - -tm0 = instrument Vibraphone (ss m0 4 50 20) -{-# LINE 159 "SelfSimilar.lhs" #-} -ttm0 = tm0 :=: transpose (12) (revM tm0) -{-# LINE 165 "SelfSimilar.lhs" #-} -m1 :: [SNote] -m1 = [(1,0),(0.5,0),(0.5,0)] - -tm1 = instrument Percussion (ss m1 4 43 2) -{-# LINE 178 "SelfSimilar.lhs" #-} -m2 :: [SNote] -m2 = [(dqn,0),(qn,4)] - -tm2 = ss m2 6 50 (1/50) -{-# LINE 187 "SelfSimilar.lhs" #-} -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) (revM 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 -{-# LINE 245 "SelfSimilar.lhs" #-} -fringe' :: Int -> Cluster -> [[SNote]] -fringe' 0 (Cluster note cls) = [[note]] -fringe' n (Cluster note cls) = map (fringe (n-1)) cls -{-# LINE 257 "SelfSimilar.lhs" #-} -simToMusic' :: [[SNote]] -> Music Pitch -simToMusic' = chord . map (line . map mkNote) -{-# LINE 263 "SelfSimilar.lhs" #-} -ss' pat n tr te = - transpose tr $ tempo te $ simToMusic' $ fringe' n $ selfSim pat -{-# LINE 270 "SelfSimilar.lhs" #-} -ss1 = ss' m2 4 50 (1/8) -ss2 = ss' m3 4 50 (1/2) -ss3 = ss' m4 3 50 2 -{-# LINE 284 "SelfSimilar.lhs" #-} -m5 = [(en,4),(sn,7),(en,0)] -ss5 = ss m5 4 45 (1/500) -ss6 = ss' m5 4 45 (1/1000) diff --git a/Euterpea/Examples/SigFuns.hs b/Euterpea/Examples/SigFuns.hs deleted file mode 100644 --- a/Euterpea/Examples/SigFuns.hs +++ /dev/null @@ -1,81 +0,0 @@ -{-# LINE 8 "SigFuns.lhs" #-} --- This code was automatically generated by lhs2tex --code, from the file --- HSoM/SigFuns.lhs. (See HSoM/MakeCode.bat.) -{-# LINE 18 "SigFuns.lhs" #-} -{-# LANGUAGE Arrows #-} - -module Euterpea.Examples.SigFuns where - -import Euterpea -import Control.Arrow ((>>>),(<<<),arr) -{-# LINE 461 "SigFuns.lhs" #-} -s1 :: Clock c => SigFun c () Double -s1 = proc () -> do - s <- oscFixed 440 -< () - outA -< s -{-# LINE 480 "SigFuns.lhs" #-} -tab1 :: Table -tab1 = tableSinesN 4096 [1] -{-# LINE 487 "SigFuns.lhs" #-} -s2 :: Clock c => SigFun c () Double -s2 = proc () -> do - osc tab1 0 -< 440 -{-# LINE 570 "SigFuns.lhs" #-} -tab2 = tableSinesN 4096 [1.0,0.5,0.33] -{-# LINE 577 "SigFuns.lhs" #-} -s3 :: Clock c => SigFun c () Double -s3 = proc () -> do - osc tab2 0 -< 440 -{-# LINE 583 "SigFuns.lhs" #-} -s4 :: Clock c => SigFun c () Double -s4 = proc () -> do - f0 <- oscFixed 440 -< () - f1 <- oscFixed 880 -< () - f2 <- oscFixed 1320 -< () - outA -< (f0 + 0.5*f1 + 0.33*f2) / 1.83 -{-# LINE 622 "SigFuns.lhs" #-} -vibrato :: Clock c => - Double -> Double -> SigFun c Double Double -vibrato vfrq dep = proc afrq -> do - vib <- osc tab1 0 -< vfrq - aud <- osc tab2 0 -< afrq + vib * dep - outA -< aud -{-# LINE 635 "SigFuns.lhs" #-} -s5 :: AudSF () Double -s5 = constA 1000 >>> vibrato 5 20 -{-# LINE 712 "SigFuns.lhs" #-} -simpleClip :: Clock c => SigFun c Double Double -simpleClip = arr f where - f x = if abs x <= 1.0 then x else signum x -{-# LINE 734 "SigFuns.lhs" #-} -time :: Clock c => SigFun c () Double -time = integral <<< constA 1 -{-# LINE 787 "SigFuns.lhs" #-} -simpleInstr :: InstrumentName -simpleInstr = Custom "Simple Instrument" -{-# LINE 828 "SigFuns.lhs" #-} -myInstr :: Instr (AudSF () Double) - -- Dur -> AbsPitch -> Volume -> [Double] -> (AudSF () Double) -myInstr dur ap vol [vfrq,dep] = - proc () -> do - vib <- osc tab1 0 -< vfrq - aud <- osc tab2 0 -< apToHz ap + vib * dep - outA -< aud -{-# LINE 851 "SigFuns.lhs" #-} -myInstrMap :: InstrMap (AudSF () Double) -myInstrMap = [(simpleInstr, myInstr)] -{-# LINE 875 "SigFuns.lhs" #-} -(dr, sf) = renderSF mel myInstrMap -main = outFile "simple.wav" dr sf -{-# LINE 884 "SigFuns.lhs" #-} -mel :: Music1 -mel = - let m = Euterpea.line [ na1 (c 4 en), na1 (ef 4 en), na1 (f 4 en), - na2 (af 4 qn), na1 (f 4 en), na1 (af 4 en), - na2 (bf 4 qn), na1 (af 4 en), na1 (bf 4 en), - na1 (c 5 en), na1 (ef 5 en), na1 (f 5 en), - na3 (af 5 wn) ] - na1 (Prim (Note d p)) = Prim (Note d (p,[Params [0, 0]])) - na2 (Prim (Note d p)) = Prim (Note d (p,[Params [5,10]])) - na3 (Prim (Note d p)) = Prim (Note d (p,[Params [5,20]])) - in instrument simpleInstr m diff --git a/Euterpea/Examples/SoundCheck.hs b/Euterpea/Examples/SoundCheck.hs deleted file mode 100644 --- a/Euterpea/Examples/SoundCheck.hs +++ /dev/null @@ -1,50 +0,0 @@ -{-# LANGUAGE Arrows #-} - -module Euterpea.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 diff --git a/Euterpea/Experimental.lhs b/Euterpea/Experimental.lhs deleted file mode 100644 --- a/Euterpea/Experimental.lhs +++ /dev/null @@ -1,44 +0,0 @@ - - -The experimental module for Euterpea includes several features that we believe -are not yet mature enough for prime time in Euterpea but that we would like -to include in the project as a whole. One should not rely on the features -found here as they may be removed or changed without thought to backwards -compatability. - -> module Euterpea.Experimental ( -> module Euterpea.IO.MUI.InstrumentWidgets -> -- The InstrumentWidgets module provides support for the piano and guitar -> -- MUI widgets. -> , asyncUISFV, asyncUISFE, clockedSFToUISF -> , runMidi, runMidiM, runMidiMFlood, runMidiMB, runMidiMBFlood -> -- These conversion functions are for lifting SFs into UISFs. -> , Automaton(..), toAutomaton -> -- The async function allows a signal function to run asynchronously. -> -- This can be especially useful for a hard computation that needs to be -> -- performed sporadically in the MUI. -> , quantize, presentFFT, fftA -> -- These functions are used for applying and using the result of a Fast -> -- Fourier Transform. -> , liftAIO -- :: (b -> IO c) -> a b c -> , initialAIO -- :: IO d -> (d -> a b c) -> a b c -> -- These two functions allow one to lift generic IO actions to a -> -- UISF. They should be used with care. -> , uisfSource, uisfSink, uisfPipe -> , uisfSourceE, uisfSinkE, uisfPipeE -> ) where - -> import Euterpea.IO.MUI.UISFCompat -> import Euterpea.IO.MUI.InstrumentWidgets -> import Euterpea.IO.MUI.MidiWidgets -> import Euterpea.IO.MUI.FFT -> import FRP.UISF.AuxFunctions -> import FRP.UISF.UISF - -#if MIN_VERSION_UISF(0,4,0) -> import FRP.UISF.Asynchrony -> asyncUISFE x = asyncE x -#endif - - - diff --git a/Euterpea/ExperimentalPlay.lhs b/Euterpea/ExperimentalPlay.lhs deleted file mode 100644 --- a/Euterpea/ExperimentalPlay.lhs +++ /dev/null @@ -1,311 +0,0 @@ -Special playback functions -Created by Donya Quick -Last modified: 27-Oct-2014 - -Experimental playback implementation. - -> module Euterpea.ExperimentalPlay ( -> play' -- new implementation of play -> ,playC -- custom playback implementation to replace playA, playS, playDev, etc. -> ,devices -- function that prints available MIDI device information -> ,musicToMsgs' -- music to MIDI message conversion -> ,linearCP -- linear channel assignment policy -> ,dynamicCP -- dynamic channel assignment policy -> ,predefinedCP -- user-specified channel map (for MUIs) -> ,defParams -> ,playM' -> ,PlayParams(..) -> ) where -> import Codec.Midi hiding (Tempo) -> import Control.DeepSeq -> import Control.Monad -> import Control.Concurrent -> import Control.Exception -> import Data.List -> import Euterpea.IO.MIDI.MidiIO -> import Euterpea.IO.MIDI.ToMidi -> import Euterpea.Music.Note.Music -> import Euterpea.Music.Note.Performance -> import Sound.PortMidi - --------------------------- - | User-Level Functions | --------------------------- - -Playback parameter data type. - -> data PlayParams = PlayParams{ -> pmap :: PMap Note1, -- player map -> ctxt :: Context Note1, -- context -> strict :: Bool, -- strict timing (False for infinite values) -> chanPolicy :: ChannelMapFun, -- channel assignment policy -> devID :: Maybe OutputDeviceID, -- output device (Nothing means to use the OS default) -> closeDelay :: Time -- delay in seconds to avoid truncated notes -> } - -Default parameters are the default pmap+context, allowing for infinite playback, -using a linear channel assignment policy for 16 channels with percussion on -channel 9 (which is channel 10 when indexing from 1), using the default MIDI -device as set by the operating system, and using a closing delay of 1.0sec. - -> defParams = PlayParams defPMap defCon False (linearCP 16 9) Nothing 1.0 - -New implementation of play using default parameters: - -> play' :: (Performable a, NFData a) => Music a -> IO () -> play' = playC defParams - -"Custom play" interface: - -> playC :: (Performable a, NFData a) => PlayParams -> Music a -> IO () -> playC p = if strict p then playStrict p else playInf p - -Getting a list of all MIDI input and output devices, showing both -their device IDs and names. - -> devices = do -> (devsIn, devsOut) <- getAllDevices -> let f (devid, devname) = " "++show devid ++ "\t" ++ name devname ++ "\n" -> strIn = concatMap f devsIn -> strOut = concatMap f devsOut -> putStrLn "\nInput devices: " >> putStrLn strIn -> putStrLn "Output devices: " >> putStrLn strOut - - ------------------------------------- - | Supporting functions for playC | ------------------------------------- - -Strict playback: timing will be as close to perfect as possible, but the -Music value must be finite. Timing will be correct starting from the first -note, even if there is a long computation delay prior to any sound. - -> playStrict :: (Performable a, NFData a) => PlayParams -> Music a -> IO () -> playStrict p m = m `deepseq` -> let x = toMidi (fst $ perfDur (pmap p) (ctxt p) m) defUpm -> in x `deepseq` playM' (devID p) x - -> playM' :: Maybe OutputDeviceID -> Midi -> IO () -> playM' devID midi = handleCtrlC $ do -> initialize -> (maybe (defaultOutput playMidi) playMidi devID) midi -> terminate -> return () where -> handleCtrlC :: IO a -> IO a -> handleCtrlC op = onException op terminate - - -Infinite playback: arbitrarily long music values can be played, although -with the compromise that timing may be imperfect due to lazy evaluation of -the Music value. Delays may happen if a section of the Music value is time- -consuming to compute. Infinite parallelism is not supported. - -> playInf :: Performable a => PlayParams -> Music a -> IO () -> playInf p m = handleCtrlC $ do -> initializeMidi -> (maybe (defaultOutput playRec) playRec (devID p)) $ musicToMsgs' p m -> threadDelay $ round (closeDelay p * 1000000) -> terminateMidi -> return () where -> handleCtrlC :: IO a -> IO a -> handleCtrlC op = onException op terminateMidi - -> playRec dev [] = return () -> playRec dev (x@(t,m):ms) = -> if t > 0 then threadDelay (toMicroSec t) >> playRec dev ((0,m):ms) else -> let mNow = x : takeWhile ((<=0).fst) ms -> mLater = drop (length mNow - 1) ms -> in doMidiOut dev (Just $ mNow) >> playRec dev mLater where -> doMidiOut dev Nothing = outputMidi dev -> doMidiOut dev (Just ms) = do -> outputMidi dev -> mapM_ (\(t,m) -> deliverMidiEvent dev (0, m)) ms -> toMicroSec x = round (x * 1000000) - - ---------------------------------- - | Music to Message conversion | ---------------------------------- - -Music to message conversion will take place differently depending -on the channel assignment method. Using linearCP will assign the first -n instruments to channels 0 through n-1 (or 1 through n). Using -dynamicCP will fill up n channels and then replace the last-used -instrument's channel with the new instrument. - -Some synthesizers only recognize 10 unique channels, others use the -full 16 allowed by general MIDI. Drums are usually on channel 9 -(channel 10 when indexing from 1), but not always. Sometimes drums -can be assigned to a custom channel. - -A ChannelMap stores which instrument is assigned to which channel. -This table is built automatically when playing a Music value; the -user does not need to worry about constructing it. - -> type ChannelMap = [(InstrumentName, Channel)] - -Given an InstrumentName and a ChannelMap, a ChannelMapFun picks a new -channel to assign to the instrument and retruns both that and the -updated ChannelMap. This is done each time a new InstrumentName is -encountered (in other words, it is not in the current ChannelMap). - -> type ChannelMapFun = InstrumentName -> ChannelMap -> (Channel, ChannelMap) - -The function below first converts to ANote values and then to Std On/Off -pairs. This is needed to avoid timing issues associated with using ANote -and trying to call terminateMIDI, since if there is an ANote at the end -it will sometimes have its NoteOff lost, which can cause errors. - -> musicToMsgs' :: (Performable a) => PlayParams -> Music a -> [(Time, MidiMessage)] -> musicToMsgs' p m = -> let (perf,dt) = perfDur (pmap p) (ctxt p) m -- obtain the performance -> evsA = channelMap (chanPolicy p) [] perf -- time-stamped ANote values -> evs = stdMerge evsA -- merged On/Off events sorted by absolute time -> times = map fst evs -- absolute times in seconds -> newTimes = zipWith subtract (head times : times) times -- relative times -> in zip newTimes (map snd evs) where -> -- stdMerge: converts ANotes into a sorted list of On/Off events -> stdMerge :: [(Time, MidiMessage)] -> [(Time, MidiMessage)] -> stdMerge [] = [] -> stdMerge ((t,ANote c k v d):es) = -> (t, Std $ NoteOn c k v) : -> stdMerge (insertBy (\(a,b) (x,y) -> compare a x) (t+d, Std $ NoteOff c k v) es) -> stdMerge (e1:es) = e1 : stdMerge es -> -- channelMap: performs instrument assignment for a list of Events -> channelMap :: ChannelMapFun -> ChannelMap -> [Event] -> [(Time, MidiMessage)] -> channelMap cf cMap [] = [] -> channelMap cf cMap (e:es) = -> let i = eInst e -> ((chan, cMap'), newI) = case lookup i cMap of Nothing -> (cf i cMap, True) -> Just x -> ((x, cMap), False) -> e' = (fromRational (eTime e), -> ANote chan (ePitch e) (eVol e) (fromRational $ eDur e)) -> es' = channelMap cf cMap' es -> iNum = if i==Percussion then 0 else fromEnum i -> in if newI then (fst e', Std $ ProgramChange chan iNum) : e' : es' -> else e' : es' - -The linearCP channel map just fills up channels left to right until it hits -the maximum number and then throws an error. Percussion is handled as a -special case. - -> type NumChannels = Int -- maximum number of channels (i.e. 0-15 is 16 channels) -> type PercChan = Int -- percussion channel, using indexing from zero - -> linearCP :: NumChannels -> PercChan -> ChannelMapFun -> linearCP cLim pChan i cMap = if i==Percussion then (pChan, (i,pChan):cMap) else -> let n = length $ filter ((/=Percussion). fst) cMap -> newChan = if n>=pChan then n+1 else n -- step over the percussion channel -> in if newChan < cLim then (newChan, (i, newChan) : cMap) else -> error ("Cannot use more than "++show cLim++" instruments.") - -For the dynamicCP channel map, new assignements are added in the left side -of the channel map/list. This means that the item farthest to the right -is the oldest and should be replaced when the table is full. Percussion -is handled separately. - -> dynamicCP :: NumChannels -> PercChan -> ChannelMapFun -> dynamicCP cLim pChan i cMap = -> if i==Percussion then (pChan, (i, pChan):cMap) else -> let cMapNoP = filter ((/=Percussion). fst) cMap -> extra = if length cMapNoP == length cMap then [] else [(Percussion, pChan)] -> newChan = snd $ last cMapNoP -> in if length cMapNoP < cLim - 1 then linearCP cLim pChan i cMap -> else (newChan, (i, newChan) : (take (length cMapNoP - 1) cMapNoP)++extra) - - -A predefined policy will send instruments to user-defined channels. If new -instruments are found that are not accounted for, an error is thrown. - -> predefinedCP :: ChannelMap -> ChannelMapFun -> predefinedCP cMapFixed i _ = case lookup i cMapFixed of -> Nothing -> error (show i ++ " is not included in the channel map.") -> Just c -> (c, cMapFixed) - -------------------------------- - | NFData instances for Midi | -------------------------------- - -> instance NFData FileType where -> rnf x = () - -> instance NFData TimeDiv where -> rnf (TicksPerBeat i) = rnf i -> rnf (TicksPerSecond i j) = rnf j `seq` rnf i - -> instance NFData Midi where -> rnf (Midi ft td ts) = rnf ft `seq` rnf td `seq` rnf ts - -> instance NFData Message where -> rnf (NoteOff c k v) = rnf c `seq` rnf k `seq` rnf v -> rnf (NoteOn c k v) = rnf c `seq` rnf k `seq` rnf v -> rnf (KeyPressure c k v) = rnf c `seq` rnf k `seq` rnf v -> rnf (ProgramChange c v) = rnf c `seq` rnf v -> rnf (ChannelPressure c v) = rnf c `seq` rnf v -> rnf (PitchWheel c v) = rnf c `seq` rnf v -> rnf (TempoChange t) = rnf t -> rnf x = () -- no other message types are currently used by Euterpea - -> instance NFData MidiMessage where -> rnf (Std m) = rnf m -> rnf (ANote c k v d) = rnf c `seq` rnf k `seq` rnf v `seq` rnf d - - --------------------------------- - | NFData instances for Music | --------------------------------- - -> instance NFData a => NFData (Music a) where -> rnf (a :+: b) = rnf a `seq` rnf b -> rnf (a :=: b) = rnf a `seq` rnf b -> rnf (Prim p) = rnf p -> rnf (Modify c m) = rnf c `seq` rnf m - -> instance NFData a => NFData (Primitive a) where -> rnf (Note d a) = rnf d `seq` rnf a -> rnf (Rest d) = rnf d - -> instance NFData Control where -> rnf (Tempo t) = rnf t -> rnf (Transpose t) = rnf t -> rnf (Instrument i) = rnf i -> rnf (Phrase xs) = rnf xs -> rnf (Player p) = rnf p -> rnf (KeySig r m) = rnf r `seq` rnf m - -> instance NFData PitchClass where -> rnf p = () - -> instance NFData Mode where -> rnf x = () - -> instance NFData PhraseAttribute where -> rnf (Dyn d) = rnf d -> rnf (Tmp t) = rnf t -> rnf (Art a) = rnf a -> rnf (Orn o) = rnf o - -> instance NFData Dynamic where -> rnf (Accent r) = rnf r -> rnf (Crescendo r) = rnf r -> rnf (Diminuendo r) = rnf r -> rnf (StdLoudness x) = rnf x -> rnf (Loudness r) = rnf r - -> instance NFData StdLoudness where -> rnf x = () - -> instance NFData Articulation where -> rnf (Staccato r) = rnf r -> rnf (Legato r) = rnf r -> rnf x = () - -> instance NFData Ornament where -> rnf x = () - -> instance NFData Tempo where -> rnf (Ritardando r) = rnf r -> rnf (Accelerando r) = rnf r - -> instance NFData InstrumentName where -> rnf x = () diff --git a/Euterpea/IO/Audio.hs b/Euterpea/IO/Audio.hs --- a/Euterpea/IO/Audio.hs +++ b/Euterpea/IO/Audio.hs @@ -1,14 +1,24 @@ -module Euterpea.IO.Audio - ( module Euterpea.IO.Audio.BasicSigFuns, - module Euterpea.IO.Audio.Basics, - module Euterpea.IO.Audio.Types, - module Euterpea.IO.Audio.IO, - module Euterpea.IO.Audio.Render - ) where - -import Euterpea.IO.Audio.BasicSigFuns -import Euterpea.IO.Audio.Basics -import Euterpea.IO.Audio.Types -import Euterpea.IO.Audio.IO -import Euterpea.IO.Audio.Render - +module Euterpea.IO.Audio + ( module Euterpea.IO.Audio.BasicSigFuns, + module Euterpea.IO.Audio.Basics, + module Euterpea.IO.Audio.Types, + module Euterpea.IO.Audio.IO, + module Euterpea.IO.Audio.Render, + writeWav, + writeWavNorm + ) where + +import Euterpea.IO.Audio.BasicSigFuns +import Euterpea.IO.Audio.Basics +import Euterpea.IO.Audio.Types +import Euterpea.IO.Audio.IO +import Euterpea.IO.Audio.Render + +writeWav fname iMap m = + let (d,s) = renderSF m iMap + in outFile fname d s + +writeWavNorm fname iMap m = + let (d,s) = renderSF m iMap + in outFileNorm fname d s + diff --git a/Euterpea/IO/Audio/BasicSigFuns.lhs b/Euterpea/IO/Audio/BasicSigFuns.lhs --- a/Euterpea/IO/Audio/BasicSigFuns.lhs +++ b/Euterpea/IO/Audio/BasicSigFuns.lhs @@ -1,1239 +1,1222 @@ -> {-# LANGUAGE Arrows, BangPatterns, -> ExistentialQuantification, FlexibleContexts, -> FunctionalDependencies, ScopedTypeVariables, -> NoMonomorphismRestriction #-} - -Euterpea adaptation of some unit generators from csound -------------------------------------------------------- - -Conventions: - -(1) Optional arguments in some csound unit generators sometimes carry -different semantics depending on the way the generator is called. -Here they are encoded as algebraic datatypes instead (see 'pluck' for -example). A single optional argument is normally encoded using -Haskell's Maybe type. - -(2) csound's i-type is updated only once on every note's -initialization pass. They are represented as unlifted arguments here -(i.e. non-signal). - -(3) Many unit generators in csound take a signal 'amp' as input, which -scales its result by 'amp'. Since this feature induces computational -overhead when scaling is not needed, and is easily expressed using -arrow syntax when needed, we omit that functionality from Eutperpea's -versions of the unit generators. - -> module Euterpea.IO.Audio.BasicSigFuns ( -> Table, -> pluck, -> PluckDecayMethod(..), -> balance, -> tableExponN, -> tableExpon, -> tableLinearN, -> tableLinear, -> tableSines3N, -> tableSines3, -> tableSinesN, -> tableSines, -> tableBesselN, -> tableBessel, -> filterLowPass, -> filterHighPass, -> filterBandPass, -> filterBandStop, -> filterLowPassBW, -> filterHighPassBW, -> filterBandPassBW, -> filterBandStopBW, -> filterComb, -> osc, -> oscI, -> oscFixed, -> oscDur, -> oscDurI, -> oscPartials, -> envLine, -> envExpon, -> envLineSeg, -> envExponSeg, -> envASR, -> envCSEnvlpx, -> noiseWhite, noiseBLI, noiseBLH, -> delayLine, delayLine1, delayLineT, -> samples, milliseconds, seconds, countTime -> ) where - -> -- oscil, oscili, oscils, oscil1, oscil1i, -> -- table, tablei, tableIx, tableiIx, -> -- buzz, -> -- delayt, -> -- delay, vdelay, -> -- comb, -> -- reson, areson, -> -- tone, atone, -> -- rand, randi, randh, -> -- line, -> -- expon, linseg, expseg, linen, -> -- envlpx, -> -- integral, -> -- gen05, gen05', exponential1, -> -- gen07, gen07', lineSeg1, -> -- gen09, gen09', compSine2, -> -- gen10, gen10', compSine1, -> -- gen12, gen12', -> -- butterlp, butterhp, butterbp, butterbr, - -> import Euterpea.IO.Audio.Basics -> import Euterpea.IO.Audio.Types -> import Control.Arrow -> import Control.Arrow.Operations -> import Control.Arrow.ArrowP -> import FRP.UISF.AuxFunctions (SEvent, constA) -> import Data.Array.Base (unsafeAt) -> import Data.Array.Unboxed - -> import Foreign.Marshal -> import Foreign.Ptr -> import Foreign.Storable - -> import GHC.IO -> import System.Random - -Helper Functions ----------------- - -> wrap :: (Ord n, Num n) => n -> n -> n -> wrap val bound = if val > bound then wrap val (val-bound) else val - -> clip :: Ord n => n -> n -> n -> n -> clip val lower upper -> | val <= lower = lower -> | val >= upper = upper -> | otherwise = val - -Raises 'a' to the power 'b' using logarithms. - -> pow :: Floating a => a -> a -> a -> pow a b = exp (log a * b) - -Returns the fractional part of 'x'. - -> frac :: RealFrac r => r -> r -> frac = snd . properFraction - -Table Creation and Access -------------------------- - -A Table is essentially a UArray. - -> data Table = Table -> !Int -- size -> !(UArray Int Double) -- table implementation -> !Bool -- Whether the table is normalized - -> instance Show Table where -> show (Table sz a n) = "Table with " ++ show sz ++ " entries: " ++ show a - -> funToTable :: (Double->Double) -> Bool -> Int -> Table -> funToTable f normalize size = -> let delta = 1 / fromIntegral size -> ys = take size (map f [0, delta.. ]) ++ [head ys] -> -- make table one size larger as an extended guard point -> zs = if normalize then map (/ maxabs ys) ys else ys -> maxabs = maximum . map abs -> in Table size (listArray (0, size) zs) normalize - -> readFromTable :: Table -> Double -> Double -> readFromTable (Table sz array _) pos = -> let idx = truncate (fromIntegral sz * pos) -- range must be [0,size] -> in array `unsafeAt` idx -> {-# INLINE [0] readFromTable #-} - -> readFromTableA :: Arrow a => Table -> a Double Double -> readFromTableA = arr . readFromTable - -> readFromTableRaw :: Table -> Int -> Double -> readFromTableRaw (Table _ a _) idx = a `unsafeAt` idx - -Like readFromTable, but with linear interpolation. - -> readFromTablei :: Table -> Double -> Double -> readFromTablei (Table sz array _) pos = -> let idx = fromIntegral sz * pos -- fractional "index" in table ([0,sz]) -> idx0 = (truncate idx) `mod` sz :: Int -> idx1 = idx0 + 1 :: Int -> val0 = array `unsafeAt` idx0 -> val1 = array `unsafeAt` idx1 -> in val0 + (val1 - val0) * (idx - fromIntegral idx0) -> {-# INLINE [0] readFromTablei #-} - -> readFromTableiA :: Arrow a => Table -> a Double Double -> readFromTableiA = arr . readFromTablei - -Accesses table values by direct indexing with linear interpolation. -The index 'pos' is expected to be normalized (between 0 and 1). Values -out of bounds are either clipped or wrapped. - -> tablei :: (Clock p, Arrow a) => -> Table -- Table to read from. -> -> Bool -- Whether to wrap around index; -> -- if not, index is clipped within bounds -> -> ArrowP a p Double Double -> tablei tab True = -> proc pos -> do -> outA -< readFromTablei tab (wrap pos 1) -> tablei tab False = -> proc pos -> do -> outA -< readFromTablei tab (clip pos 0 1) - -Accesses table values by direct indexing; the index is normalized -(between 0 and 1). - -> table :: (Clock p, Arrow a) => Table -> Bool -> ArrowP a p Double Double -> table tab True = -> proc pos -> do -> outA -< readFromTable tab (wrap pos 1) -> table tab False = -> proc pos -> do -> outA -< readFromTable tab (clip pos 0 1) - -Like tablei, but the index is interpreted as a raw value (between 0 -and (size of table - 1), inclusive). - -> tableiIx :: (Clock p, Arrow a) => -> Table -> Bool -> ArrowP a p Double Double -> tableiIx tab@(Table sz array _) True = -> proc idx -> do -> let idx0 = (truncate idx) `mod` sz -> val0 = readFromTableRaw tab idx0 -> val1 = readFromTableRaw tab (idx0 + 1) -> outA -< val0 + (val1 - val0) * (idx - fromIntegral idx0) -> tableiIx tab@(Table sz _ _) False = -> proc idx -> do -> let pos = idx / fromIntegral (sz-1) -> outA -< readFromTablei tab (clip pos 0 1) - -Like table, but index interpreted as raw value. - -> tableIx :: (Clock p, Arrow a) => Table -> Bool -> ArrowP a p Double Double -> tableIx tab@(Table sz array _) True = -> proc idx -> do -> outA -< readFromTableRaw tab (truncate idx `mod` (sz-1)) -> tableIx tab@(Table sz array _) False = -> proc idx -> do -> outA -< readFromTableRaw tab (clip (truncate idx) 0 (sz-1)) - -Oscillators ------------ - -'osc' generates periodic signals consisting of the values returned -from sampling a stored function table. The internal phase is -simultaneously advanced in accordance with the input signal 'freq'. - -> osc :: (Clock p, ArrowCircuit a) => -> Table -> -> Double -- Initial phase of sampling, expressed as a -> -- fraction of a cycle (0 to 1). -> -> ArrowP a p Double Double -> osc table iphs = osc_ iphs >>> readFromTableA table - -'oscI' is like 'osc', but with linear interpolation. - -> oscI :: (Clock p, ArrowCircuit a) => -> Table -> -> Double -> -> ArrowP a p Double Double -> oscI table iphs = osc_ iphs >>> readFromTableiA table - -Helper function for osc and oscI. - -> osc_ :: forall p a. (Clock p, ArrowCircuit a) => -> Double -> ArrowP a p Double Double -> osc_ phs = -> let sr = rate (undefined :: p) -> in proc freq -> do -> rec -> let delta = 1 / sr * freq -> phase = if next > 1 then frac next else next -> next <- delay phs -< frac (phase + delta) -> outA -< phase - -Simple, fast sine oscillator, that uses only one multiply and two add -operations to generate one sample of output, and does not require a -function table. - -> oscFixed :: forall p a . (Clock p, ArrowCircuit a) => -> Double -> ArrowP a p () Double -> oscFixed freq = -> let omh = 2 * pi * freq / sr -> d = sin omh -> c = 2 * cos omh -> sr = rate (undefined :: p) -> sf = proc () -> do -> rec -> let r = c * d2 - d1 -> d1 <- delay 0 -< d2 -> d2 <- delay d -< r -> outA -< r -> in sf - -'oscDur' accesses values by sampling once through the function table -at a rate determined by 'dur'. For the first 'del' seconds, the point -of scan will reside at the first location of the table; it will then -begin moving through the table at a constant rate, reaching the end in -another 'dur' seconds; from that time on (i.e. after 'del' + 'dur' -seconds) it will remain pointing at the last location. - -> oscDur :: (Clock p, ArrowChoice a, ArrowCircuit a) => -> Table -> -> Double -> -- delay in seconds before 'oscDur' incremental sampling begins -> -> Double -> -- duration in seconds to sample through the table just once. -> -> ArrowP a p () Double -> oscDur = oscDur_ osc - -Like 'oscDur', but with linear interpolation. - -> oscDurI :: (Clock p, ArrowChoice a, ArrowCircuit a) => -> Table -> -> Double -> -- delay in seconds before 'oscDur' incremental sampling begins. -> -> Double -> -- duration in seconds to sample through the table just once. -> -> ArrowP a p () Double -> oscDurI = oscDur_ oscI - -Helper function for oscDur and oscDurI. - -> oscDur_ :: forall p a . (Clock p, ArrowChoice a, ArrowCircuit a) => -> (Table -> Double -> ArrowP a p Double Double) -> -> Table -> Double -> Double -> ArrowP a p () Double -> oscDur_ osc table@(Table sz _ _) del dur = -> let sr = rate (undefined :: p) -> t1 = del * sr -> t2 = t1 + dur * sr -> v0 = readFromTableRaw table 0 -> v2 = readFromTableRaw table (sz-1) -> in proc () -> do -> i <- countUp -< () -> let i' = fromIntegral i -> y <- case (i' < t1, i' < t2) of -> (True, _) -> outA -< v0 -> (False, True) -> osc table 0 -< 1 / dur -> (False, False) -> outA -< v2 -> outA -< y - -These are not implemented. - -> foscil, foscili :: (Clock p, Arrow a) => -> Table -> ArrowP a p (Double,Double,Double,Double) Double -> foscil table = -> proc (freq,carfreq,modfreq,modindex) -> do -> outA -< 0 - -> foscili table = -> proc (freq,carfreq,modfreq,modindex) -> do -> outA -< 0 - -> loscil :: (Clock p, Arrow a) => Table -> ArrowP a p Double Double -> loscil table = -> proc freq -> do -> outA -< 0 - -Output a set of harmonically related sine partials. - -> oscPartials :: forall p . Clock p => -> Table -- table containing a sine wave; -> -- a table size of at least 8192 is recommended. -> -> Double -- initial phase of the fundamental frequency, -> -- expressed as a fraction of a cycle (0 to 1). -> -> Signal p (Double,Int) Double -> -- 'freq' is the fundamental frequency in cycles per -> -- second; 'nharms' is the number of harmonics requested. -> oscPartials table initialPhase = -> let sr = rate (undefined :: p) -> in proc (freq, nharms) -> do -> rec -> let delta = 1 / sr * freq -> phase = if next > 1 then frac next else next -> next <- delay initialPhase -< frac (phase + delta) -> outA -< sum [ readFromTable table (frac (phase * fromIntegral pn)) | -> pn <- [1..nharms] ] -> / fromIntegral nharms - -Pluck ------ - -> data PluckDecayMethod -> = SimpleAveraging -> -- A simple smoothing process. -> | StretchedAveraging Double -> -- Smoothing time stretched by a factor. -> | SimpleDrum Double -> -- The range from pitch to noise is controlled by a 'roughness -> -- factor' (0 to 1). Zero gives the plucked string effect, while -> -- 1 reverses the polarity of every sample (octave down, odd -> -- harmonics). The setting .5 gives an optimum snare drum. -> | StretchedDrum Double Double -> -- Combines both roughness and stretch factors. parm1 is -> -- roughness (0 to 1), and parm2 the stretch factor (=1). -> | WeightedAveraging Double Double -> -- As SimpleAveraging, with parm1 weighting the current sample -> -- (the status quo) and iparm2 weighting the previous adjacent -> -- one. iparm1 + iparm2must be <= 1. -> | RecursiveFilter -> -- 1st order recursive filter, with coefs .5. Unaffected by -> -- parameter values. - -> pluck :: forall p . Clock p => -> Table -> Double -> PluckDecayMethod -> Signal p Double Double -> pluck table pitch method = -> let sr = rate (undefined :: p) -> in proc cps -> do -> rec -> z <- delayLineT (max 64 (truncate (sr / pitch))) table -< y -> z' <- delay 0 -< z -> let y = case method of -> SimpleAveraging -> 0.5 * (z + z') -> -- or is this "RecursiveFilter?" -> WeightedAveraging a b -> z * a + z' * b -> _ -> error "pluck: method not implemented" -> outA -< y - -Grain ------ - -Not implemented. - -> grain :: Table -> -- Grain waveform. This can be just a sine wave or a sampled sound. -> -> Table -> -- Amplitude envelope used for the grains. -> -> Double -> -- Maximum grain duration in seconds. This is the biggest -> -- value to be assigned to 'gdur'. -> -> Bool -> -- If 'True', all grains will begin reading from the -> -- beginning of the 'gfn' table. If 'False', grains -> -- will start reading from random 'gfn' table positions. -> -> Signal p (Double,Double,Double,Double,Double) Double -> grain gfn wfn mgdur grnd = -> proc (pitch,dens,ampoff,pitchoff,gdur) -> do -> outA -< 0 - -Delay Lines ------------ - -csound's delayr and delayw are not implemented -- instead, one can use -a fixed-time delay with native recursive arrow syntax to achieve -modified feedback loops. - -> data Buf = Buf !Int !(Ptr Double) - -> updateBuf :: Buf -> Int -> Double -> IO Double -> updateBuf (Buf _ a) i u = a `seq` i `seq` u `seq` do -> let p = a `advancePtr` i -> x' <- peek p -> poke p u -> return x' - -> peekBuf (Buf sz a) i = peek (a `advancePtr` (min (sz-1) i)) - -TODO: deal with pre-initialized buffers - -> mkArr :: Int -> Buf -> mkArr n = n `seq` Buf n (unsafePerformIO $ -> Foreign.Marshal.newArray (replicate n 0)) - -> mkArrWithTable size t = Buf size (unsafePerformIO $ -> Foreign.Marshal.newArray (map (readFromTable t) [0, (1/sz)..((sz-1)/sz)])) -> where sz = fromIntegral size - -A fixed-length delay line, initialized using a table. - -> delayLineT :: forall p . Clock p => -> Int -> Table -> Signal p Double Double -> delayLineT size table = -> let sr = rate (undefined :: p) -> buf = mkArrWithTable size table -> in proc x -> do -> rec -> let i' = if i == size-1 then 0 else i+1 -> i <- delay 0 -< i' -> y <- delay 0 -< x -> -- TODO: this proc can't be strict on x, but how can we -> -- deal with strictness better without this hack? -> outA -< unsafePerformIO $ updateBuf buf i y - -A fixed-length delay line. - -> delayLine :: forall p . Clock p => -> Double -> Signal p Double Double -> delayLine maxdel = -> let sr = rate (undefined :: p) -> sz = truncate (sr * maxdel) -> buf = mkArr sz -> in proc x -> do -> rec -> let i' = if i == sz-1 then 0 else i+1 -> i <- delay 0 -< i' -> y <- delay 0 -< x -> outA -< unsafePerformIO $ updateBuf buf i y - -delay line with one tap. - -> delayLine1 :: forall p . Clock p => Double -> Signal p (Double, Double) Double -> delayLine1 maxdel = -> let sr = rate (undefined :: p) -> sz = truncate (sr * maxdel) -> buf = mkArr sz -> in proc (sig,dlt) -> do -> rec -> let i' = if i == sz-1 then 0 else i+1 -> dl = min maxdel dlt -> tap = i - truncate (sr * dl) -> tapidx = if tap < 0 then sz + tap else tap -> i <- delay 0 -< i' -> y <- delay 0 -< sig -> outA -< unsafePerformIO $ do -> s <- peekBuf buf tapidx -> _ <- updateBuf buf i y -> return s - -delay line with two taps. - -> delay2 :: Double -> Signal p (Double, Double, Double) Double -> delay2 maxdel = -> proc (sig, dlt1, dlt2) -> do -> outA -< 0 - -delay line with three taps. - -> delay3 :: Double -> Signal p (Double, Double, Double, Double) Double -> delay3 maxdel = -> proc (sig, dlt1, dlt2, dlt3) -> do -> outA -< 0 - -delay line with four taps. - -> delay4 :: Double -> Signal p (Double, Double, Double, Double, Double) Double -> delay4 maxdel = -> proc (sig, dlt1, dlt2, dlt3, dlt4) -> do -> outA -< 0 - -Noise Generators ----------------- - -Analogous to rand, randi, and randh in csound. - -Generate uniform white noise with an R.M.S value of 1 / sqrt 2, where -'seed' is the random seed. - -> noiseWhite :: Int -> Signal p () Double -> noiseWhite seed = -> let gen = mkStdGen seed -> in proc () -> do -> rec -> let (a,g') = random g :: (Double,StdGen) -> g <- delay gen -< g' -> outA -< a * 2 - 1 - -Controlled band-limited noise with interpolation between each new -number, and with an RMS value of 1 / sqrt 2. -'cps' controls how fast the new numbers are generated. -'seed' is the random seed. - -> noiseBLI :: forall p . Clock p => Int -> Signal p Double Double -> noiseBLI seed = -> let sr = rate (undefined :: p) -> gen = mkStdGen seed -> (i_n1, i_g1) = random gen :: (Double,StdGen) -> (i_n2, i_g2) = random i_g1 :: (Double,StdGen) -> i_pr = (i_n1, i_n2, i_g2) -> in proc cps -> do -> let bound = sr / cps -> rec -> state <- delay (0, i_pr) -< state' -> let (cnt, pr@(n1, n2, g)) = state -> n = n1 + (n2 - n1) * cnt / bound -> state' = if cnt + 1 < bound -> then (cnt + 1, pr) -> else let (n3, g') = random g :: (Double,StdGen) -> in (0, (n2, n3, g')) -> outA -< n * 2 - 1 - -Controlled band-limited noise without interpolation (holds -previous value instead), and with an RMS value of 1 / sqrt 2. -'cps' controls how fast the new numbers are generated. -'seed' is the random seed. - -> noiseBLH :: forall p . Clock p => Int -> Signal p Double Double -> noiseBLH seed = -> let sr = rate (undefined :: p) -> gen = mkStdGen seed -> (i_n1, i_g) = random gen :: (Double,StdGen) -> i_pr = (i_n1, i_g) -> in proc cps -> do -> let bound = sr / cps -> rec -> state <- delay (0, i_pr) -< state' -> let (cnt, pr@(n, g)) = state -> state' = if cnt + 1 < bound -> then (cnt + 1, pr) -> else let (n', g') = random g :: (Double,StdGen) -> in (0, (n', g')) -> outA -< n * 2 - 1 - -Gain Adjustment ---------------- - -Adjusts RMS amplitude of 'sig' so that it matches RMS amplitude of 'ref'. - -> balance :: forall p . Clock p => -> Int -> Signal p (Double, Double) Double -> balance ihp = -> proc (sig, ref) -> do -> rec -> (sqrsum, refsum) <- delay (0, 0) -< (sqrsum', refsum') -> let sqrsum' = c1 * sig * sig + c2 * sqrsum -> refsum' = c1 * ref * ref + c2 * refsum -> ratio = if sqrsum == 0 then sqrt $ refsum -> else sqrt $ refsum / sqrsum -> outA -< sig * ratio -> where sr = rate (undefined :: p) -> tpidsr = 2 * pi / sr -- tpidsr = two-pi over sr -> b = 2 - cos (fromIntegral ihp * tpidsr) -> c1 = 1 - c2 -> c2 = b - sqrt (b * b - 1) - -Filters -------- - -> data BandPassData = BandPassData{ -> rsnKcf :: !Double -> , rsnKbw :: !Double -> , rsnCosf :: !Double -> , rsnC1 :: !Double -> , rsnC2 :: !Double -> , rsnC3 :: !Double -> , rsnYt1 :: !Double -> , rsnYt2 :: !Double -> } -> rsnDefault :: BandPassData -> rsnDefault = BandPassData (-1) (-1) 0 0 0 0 0 0 - -A second-order resonant (band pass) filter. - -Analogous to csound's 'reson' routine. - -> filterBandPass :: forall p . Clock p => -> Int -- 'scale': 1 signifies a peak response factor of 1, i.e. all -> -- frequencies other than kcf are attenuated in accordance with -> -- the (normalized) response curve; 2 raises the response -> -- factor so that its overall RMS value equals 1; 0 ignifies -> -- no scaling of the signal, leaving that to some later -> -- adjustment (like balance). -> -> Signal p (Double, Double, Double) Double -> -- 'sig' is the signal to be filtered, -> -- 'kcf' is the center frequency of the filter, -> -- and 'kbw' is the bandwidth of it. -> filterBandPass scale = -> proc (sig, kcf, kbw) -> do -> rec -> rsnData <- delay rsnDefault -< rsnData' -> currData <- if kcf == rsnKcf rsnData && kbw == rsnKbw rsnData -> then outA -< rsnData -> else update -< (rsnData, kcf, kbw) -> let BandPassData{ rsnC1 = c1, rsnC2 = c2, rsnC3 = c3, -> rsnYt1 = yt1, rsnYt2 = yt2 } = currData -> a = c1 * sig + c2 * yt1 - c3 * yt2 -> rsnData' = currData{ rsnYt1 = a, rsnYt2 = yt1 } -> outA -< a -> where sr = rate (undefined :: p) -> tpidsr = 2 * pi / sr -- tpidsr = two-pi over sr -> update = proc (rsnData, kcf, kbw) -> do -> -- kcf or kbw changed, recalc consts -> let cosf = cos $ kcf * tpidsr -- cos (2pi * freq / rate) -> c3 = exp $ - kbw * tpidsr -- exp (-2pi * bwidth / rate) -> -- (note on csound code) mtpdsr = -tpidsr -> -- c1 Gain for input signal. -> -- c2 (Minused) gain for output of delay 1. -> -- c3 Gain for output of delay 2. -> c3p1 = c3 + 1 -> c3t4 = c3 * 4 -> c2 = c3t4 * cosf / c3p1 -> omc3 = 1 - c3 -> c2sqr = c2 * c2 -> c1 = case scale of -> 1 -> omc3 * sqrt (1 - c2sqr / c3t4) -> 2 -> sqrt $ (c3p1 * c3p1 - c2sqr) * omc3 / c3p1 -> _ -> 1.0 -> outA -< rsnData{ rsnKcf = kcf, rsnKbw = kbw, rsnCosf = cosf, -> rsnC1 = c1, rsnC2 = c2, rsnC3 = c3 } - -A band stop filter whose transfer function is the complement of -filterBandPass. - -Analogous to csound's 'areson' routine. - -> filterBandStop :: forall p. Clock p => -> Int -> Signal p (Double, Double, Double) Double -> filterBandStop scale = proc (sig, kcf, kbw) -> do -> r <- filterBandPass scale -< (sig, kcf, kbw) -> outA -< sig - r - -> data ButterData = ButterData !Double !Double !Double !Double !Double - -> sqrt2 :: Double -> sqrt2 = sqrt 2 - -> blpset :: Double -> Double -> ButterData -> blpset freq sr = ButterData a1 a2 a3 a4 a5 -> where c = 1 / tan (pidsr * freq) -> csq = c * c; pidsr = pi / sr -> a1 = 1 / (1 + sqrt2 * c + csq) -> a2 = 2 * a1 -> a3 = a1 -> a4 = 2 * (1 - csq) * a1 -> a5 = (1 - sqrt2 * c + csq) * a1 - -> bhpset :: Double -> Double -> ButterData -> bhpset freq sr = ButterData a1 a2 a3 a4 a5 -> where c = tan (pidsr * freq) -> csq = c * c; pidsr = pi / sr -> a1 = 1 / (1 + sqrt2 * c + csq) -> a2 = (-2) * a1 -> a3 = a1 -> a4 = 2 * (csq - 1) * a1 -> a5 = (1 - sqrt2 * c + csq) * a1 - -> bbpset :: Double -> Double -> Double -> ButterData -> bbpset freq band sr = ButterData a1 a2 a3 a4 a5 -> where c = 1 / tan (pidsr * band) -> d = 2 * cos (2 * pidsr * freq) -> pidsr = pi / sr -> a1 = 1 / (1 + c) -> a2 = 0 -> a3 = negate a1 -> a4 = negate (c * d * a1) -> a5 = (c - 1) * a1 - -> bbrset :: Double -> Double -> Double -> ButterData -> bbrset freq band sr = ButterData a1 a2 a3 a4 a5 -> where c = tan (pidsr * band) -> d = 2 * cos (2 * pidsr * freq) -> pidsr = pi / sr -> a1 = 1 / (1 + c) -> a2 = negate d * a1 -> a3 = a1 -> a4 = a2 -> a5 = (1 - c) * a1 - -A second-order low-pass Butterworth filter, where 'sig' is the input -signal to be filtered, and 'freq' is the cutoff center frequency. - -Analogous to csound's 'butterlp' routine. - -> filterLowPassBW :: forall p . Clock p => Signal p (Double, Double) Double -> filterLowPassBW = -> let sr = rate (undefined :: p) -> in proc (sig, freq) -> do -> butter -< (sig, blpset freq sr) - -A high-pass Butterworth filter. - -Analogous to csound's 'butterhp' routine. - -> filterHighPassBW :: forall p . Clock p => Signal p (Double, Double) Double -> filterHighPassBW = -> let sr = rate (undefined :: p) -> in proc (sig, freq) -> do -> butter -< (sig, bhpset freq sr) - -A band-pass Butterworth filter where 'band' is the bandwidth. -'filterBandPassBW -< (s, 2000, 100)' will pass only 1950 to 2050 Hz in 's'. - -Analogous to csound's 'butterbp' routine. - -> filterBandPassBW :: forall p . Clock p => -> Signal p (Double, Double, Double) Double -> filterBandPassBW = -> let sr = rate (undefined :: p) -> in proc (sig, freq, band) -> do -> butter -< (sig, bbpset freq band sr) - -A band-stop Butterworth filter where 'band' is the bandwidth. -'filterBandStopBW -< (s, 4000, 1000)' will filter 's' such that frequencies -between 3500 to 4500 Hz are rejected. - -Analogous to csound's 'butterbr' routine. - -> filterBandStopBW :: forall p . Clock p => -> Signal p (Double, Double, Double) Double -> filterBandStopBW = -> let sr = rate (undefined :: p) -> in proc (sig, freq, band) -> do -> butter -< (sig, bbrset freq band sr) - -Helper function for various Butterworth filters. - -> butter :: Clock p => Signal p (Double,ButterData) Double -> butter = proc (sig, ButterData a1 a2 a3 a4 a5) -> do -> rec let t = sig - a4 * y' - a5 * y'' -> y = t * a1 + a2 * y' + a3 * y'' -> y' <- delay 0 -< t -> y'' <- delay 0 -< y' -> outA -< y - -This filter reiterates input with an echo density determined by loop -time 'looptime'. The attenuation rate is independent and is -determined by 'rvt', the reverberation time (defined as the time in -seconds for a signal to decay to 1/1000 of, or 60dB down from, its -original amplitude). Output from 'filterComb' will appear only after -'looptime' seconds. - -Analogous to csound's 'comb' routine. - -> filterComb :: Clock p => -> Double -- loop time in seconds, which determines the "echo -> -- density" of the reverberation. This in turn -> -- characterizes the "color" of the filter whose -> -- frequency response curve will contain 'looptime' * -> -- sr/2 peaks spaced evenly between 0 and sr/2 (the -> -- Nyquist frequency). Loop time can be as large as -> -- available memory will permit. -> -> Signal p (Double, Double) Double -> filterComb looptime = -> let log001 = -6.9078 -> del = delayLine looptime -> in proc (sig, rvt) -> do -> let gain = exp (log001 * looptime / rvt) -> rec -> r <- del -< sig + r * gain -> outA -< r - -A first-order recursive low-pass filter with variable frequency -response. 'hp' is the response curve's half-power point, in Hertz. -Half power is defined as peak power / sqrt 2. - -Analogous to csound's tone routine. - -> filterLowPass :: forall p . Clock p => Signal p (Double,Double) Double -> filterLowPass = -> let sr = rate (undefined :: p) -> in proc (sig, hp) -> do -> rec -> let y' = c1 * sig + c2 * y -> b = 2 - cos (2 * pi * hp / sr) -> c2 = b - sqrt (b * b - 1.0) -> c1 = 1 - c2 -> y <- delay 0 -< y' -> outA -< y - -A high-pass filter whose transfer function is the complement of that -of 'filterLowPass'. The transfer function of 'filterHighPass' -represents the "filtered out" aspects of its complement. However, -power scaling is not normalized in 'filterHighPass' but remains the -true complement of filterLowPass. Thus an audio signal, filtered by -parallel matching 'filterLowPass' and 'filterHighPass', would under -addition simply reconstruct the original spectrum. - -> filterHighPass :: Clock p => Signal p (Double,Double) Double -> filterHighPass = proc (sig, hp) -> do -> y <- filterLowPass -< (sig, hp) -> outA -< sig - y - -Envelopes ---------- - -'envLine' generates control or audio signals whose values move linearly -from an initial value to a final one. A common error with this signal -function is to assume that the value of 'b' is held after the time -'dur'. 'envLine' does not automatically end or stop at the end of the -duration given. If your note length is longer than 'dur' seconds, the -resulting value will not come to rest at 'b', but will instead -continue to rise or fall with the same rate. If a rise (or fall) and -then hold is required then 'envLineSeg' should be considered instead. - -> envLine :: forall p . Clock p => -> Double -- Starting value. -> -> Double -- Duration in seconds. -> -> Double -- Value after 'dur' seconds. -> -> Signal p () Double -> envLine a dur b = -> let sr = rate (undefined :: p) -> in proc () -> do -> rec -> y <- delay a -< y + (b-a) * (1 / sr / dur) -> outA -< y - -Trace an exponential curve between specified points. - -> envExpon :: forall p . Clock p => -> Double -- Starting value. Zero is illegal for exponentials. -> -> Double -- Duration in seconds. -> -> Double -- Value after 'dur' seconds. For exponentials, -> -- must be non-zero and must agree in sign with 'a'. -> -> Signal p () Double -> envExpon a dur b = -> let sr = rate (undefined :: p) -> in proc () -> do -> rec -> y <- delay a -< y * pow (b/a) (1 / sr / dur) -> outA -< y - -Unfortunately, envLine and envExpon cannot be abstracted to a common -function because Template Haskell doesn't like higher-order functions. - -> data Tab = Tab [Double] !Int !(UArray Int Double) - -> aAt :: Tab -> Int -> Double -> aAt (Tab _ sz a) i = unsafeAt a (min (sz-1) i) - -Helper function for envLineSeg and envExponSeg. - -> seghlp :: forall p . Clock p => -> [Double] -- List of points to trace through. -> -> [Double] -- List of durations for each line segment. -> -- Needs to be one element fewer than 'iamps'. -> -> Signal p () (Double,Double,Double,Double) -> seghlp iamps idurs = -> let sr = rate (undefined :: p) -> sz = length iamps -> amps = Tab iamps sz (listArray (0, sz-1) iamps) -> durs = Tab idurs (sz-1) (listArray (0, sz-2) (map (*sr) idurs)) -> in proc _ -> do -> -- TODO: this is better defined using 'integral', but which is faster? -> rec -> let (t', i') = if t >= durs `aAt` i -> then if i == sz-2 then (t+1, i) else (0, i+1) -> else (t+1, i) -> i <- delay 0 -< i' -> t <- delay 0 -< t' -> let a1 = aAt amps i -> a2 = aAt amps (i+1) -> d = aAt durs i -> outA -< (a1,a2,t,d) - -Trace a series of line segments between specified points. - -> envLineSeg :: Clock p => -> [Double] -- List of points to trace through. -> -> [Double] -- List of durations for each line segment. -> -- Needs to be one element fewer than 'amps'. -> -> Signal p () Double -> envLineSeg amps durs = -> let sf = seghlp amps durs -> in proc () -> do -> (a1,a2,t,d) <- sf -< () -> outA -< a1 + (a2-a1) * (t / d) - -Trace a series of exponential segments between specified points. - -> envExponSeg :: Clock p => -> [Double] -- List of points to trace through. -> -> [Double] -- List of durations for each line segment. -> -- Needs to be one element fewer than 'amps'. -> -> Signal p () Double -> envExponSeg ampinps durs = -> let amps' = case ampinps of -> (a:amps) -> max 0.001 a : amps -> [] -> [] -> sf = seghlp amps' durs -> in proc () -> do -> (a1,a2,t,d) <- sf -< () -> outA -< a1 * pow (a2/a1) (t / d) - -Creates a straight-line rise and decay envelope. Rise modifications -are applied for the first 'rise' seconds, and decay from time 'dur' - -'dec'. If these periods are separated in time there will be a steady -state during which the output will remain constant. If the overall -duration idur is exceeded in performance, the final decay will -continue on in the same direction, going negative. - -> envASR :: (Clock p) => -> Double -- rise time in seconds. -> -> Double -- overall duration in seconds. -> -> Double -- decay time in seconds. -> -> Signal p () Double -> envASR rise dur dec = -> let sf = envLineSeg [0,1,1,0] [rise, dur-rise-dec, dec] -> in proc () -> do -> env <- sf -< () -> outA -< env - -Apply an envelope consisting of 3 segments: - 1. stored function rise shape - 2. modified exponential pseudo steady state - 3. exponential decay - -Rise modifications are applied for the first 'rise' seconds, and decay -from time 'dur' - 'dec'. If these periods are separated in time the -output will be modified by the first exponential pattern. If rise and -decay periods overlap then both modifications will be in effect for -that time. If the overall duration 'dur' is exceeded in performance, -the final decay will continue on in the same direction, tending -asymptotically to zero. - -> envCSEnvlpx :: forall p . Clock p => -> Double -- rise time in seconds. -> -> Double -- overall duration in seconds. -> -> Double -- decay time in seconds. -> -> Table -- table of stored rise shape. -> -> Double -> -- attenuation factor, by which the last value of the -> -- 'envCSEnvlpx' rise is modified during the note's pseudo -> -- steady state. A factor greater than 1 causes an -> -- exponential growth and a factor less than 1 creates an -> -- exponential decay. A factor of 1 will maintain a true -> -- steady state at the last rise value. Note that this -> -- attenuation is not by fixed rate (as in a piano), but -> -- is sensitive to a note's duration. However, if 'atss' -> -- is negative (or if steady state < 4 k-periods) a fixed -> -- attenuation rate of 'abs' 'atss' per second will be -> -- used. 0 is illegal. -> -> Double -> -- attenuation factor by which the closing steady state -> -- value is reduced exponentially over the decay -> -- period. This value must be positive and is normally of -> -- the order of .01. A large or excessively small value is -> -- apt to produce a cutoff which is audible. A zero or -> -- negative value is illegal. -> -> Signal p () Double -> envCSEnvlpx rise dur dec tab atss atdec = -> let sr = rate (undefined :: p) -> cnt1 = (dur - rise - dec) * sr + 0.5 -> -- num of samples in steady state -> mlt1 = pow atss (1 / cnt1) -> mlt2 = pow atdec (1 / sr / dec) -> in proc () -> do -> rec -> i <- countUp -< () -> let i' = fromIntegral i -> y <- delay (readFromTableRaw tab 0) -< y' -> y' <- case (i' < rise * sr, i' < (dur-dec) * sr) of -> (True, _) -> table tab False -< i' / (rise*sr+0.5) -> (False, True) -> outA -< y * mlt1 -> (False, False) -> outA -< y * mlt2 -> outA -< y' - -GEN routines ------------- - -All the GEN routines in Csound are normalized by default. In -Euterpea, the names of normalized table generators end in "N"; those -without an "N" are unnormalized - -> type TableSize = Int -> type PartialNum = Double -> type PartialStrength = Double -> type PhaseOffset = Double -> type StartPt = Double -> type SegLength = Double -> type EndPt = Double - -> type DoubleSegFun = -> (Double, StartPt) -> [(SegLength, EndPt)] -> Double -> Double - -Analgous to csound's gen05 routine. - -> tableExponN :: TableSize -> -- The size of the table to be produced. -> -> StartPt -> -- The y-coordinate for the start point, (0,y). -> -> [(SegLength, EndPt)] -> -- Pairs of segment lengths and y-coordinates. The segment -> -- lengths are the projection along the x-axis. The first -> -- pair will define the line from (0, startPt) to (segLength, -> -- endPt). -> -> Table -> tableExponN size sp segs = tableExp_ sp segs True size -> tableExpon :: Int -> StartPt -> [(SegLength, EndPt)] -> Table -> tableExpon size sp segs = tableExp_ sp segs False size -> tableExp_ :: StartPt -> [(SegLength, EndPt)] -> Bool -> Int -> Table -> tableExp_ sp segs = funToTable (interpLine sp segs interpExpLine) - -Analogous to csound's gen07 routine. - -> tableLinearN :: TableSize -> -- The size of the table to be produced. -> -> StartPt -> -- The y-coordinate for the start point, (0,y). -> -> [(SegLength, EndPt)] -> -- Pairs of segment lengths and y-coordinates. The segment -> -- lengths are the projection along the x-axis. The first -> -- pair will define the line from (0, startPt) to (segLength, -> -- endPt). -> -> Table -> tableLinearN size sp segs = tableLin_ sp segs True size -> tableLinear :: Int -> StartPt -> [(SegLength, EndPt)] -> Table -> tableLinear size sp segs = tableLin_ sp segs False size -> tableLin_ :: StartPt -> [(SegLength, EndPt)] -> Bool -> Int -> Table -> tableLin_ sp segs = funToTable (interpLine sp segs interpStraightLine) - -Make a table from a collection of sine waves at different offsets and -strengths. - -Analogous to csound's gen09 routine. - -> tableSines3N :: TableSize -> -- The size of the table to be produced. -> -> [(PartialNum, PartialStrength, PhaseOffset)] -> -- List of triples of the partial (0,1,...), partial -> -- strength on [0,1], and phase offset on [0,360]. -> -> Table -> tableSines3N size ps = tableSines3_ ps True size -> tableSines3 :: Int -> [(PartialNum, PartialStrength, PhaseOffset)] -> Table -> tableSines3 size ps = tableSines3_ ps False size -> tableSines3_ :: [(PartialNum, PartialStrength, PhaseOffset)] -> Bool -> Int -> Table -> tableSines3_ ps = funToTable (makeCompositeSineFun ps) - -> tableSinesF :: (Floating a, Enum a) => [a] -> a -> a -> tableSinesF pss x = let phase = 2 * pi * x -> in sum (zipWith (*) [ sin (phase * pn) | pn <- [1..] ] pss) - -Analogous to csound's gen10 routine. - -> tableSinesN :: TableSize -> [PartialStrength] -> Table -> tableSinesN size pss = tableSinesN_ pss True size -> tableSines :: Int -> [Double] -> Table -> tableSines size pss = tableSinesN_ pss False size -> tableSinesN_ :: [Double] -> Bool -> Int -> Table -> tableSinesN_ pss = funToTable (tableSinesF pss) - -Generates the log of a modified Bessel function of the second kind, -order 0, suitable for use in amplitude-modulated FM. - -Analogous to csound's gen12 routine. - -> tableBesselN :: TableSize -> -> Double -- specifies the x interval [0 to +xint] over which -> -- the function is defined. -> -> Table -> tableBesselN size xint = tableBess_ xint True size -> tableBessel :: Int -> Double -> Table -> tableBessel size xint = tableBess_ xint False size -> tableBess_ :: Double -> Bool -> Int -> Table -> tableBess_ xint = funToTable (tableBessF xint) -> tableBessF :: Floating s => s -> s -> s -> tableBessF xint x = -> log $ 1 + -> let tsquare = x * x * xint * xint / 3.75 / 3.75 -> in sum $ zipWith (*) [ 3.5156229, 3.0899424, 1.2067492, -> 0.2659732, 0.0360768, 0.0045813 ] -> $ iterate (*tsquare) tsquare - -Utility functions for tableExpon and tableLinear. - -> normalizeSegs :: [(SegLength, entPt)] -> [(SegLength, entPt)] -> normalizeSegs segs = -> let s = sum (map fst segs) -> fact = if (s > 1) then (1/s) else 1 -- don't force max<1 up to max=1 -> in map (\(x,y) -> (x*fact, y)) segs - -> interpLine :: StartPt -> -- The y-coordinate for the start point (0,y). -> -> [(SegLength, EndPt)] -> -- Pairs of segment lengths (projected on the x-axis) -> -- and y-coordinates (end points). -> -> DoubleSegFun -> -- The function to use for interpolation -> -> Double -> -- The x-coordinate for which to find the -> -- corresponding f(x)=y. -> -> Double -> interpLine sp [] d f = 0 -- catchall case -> interpLine sp points f d = f (0,sp) (normalizeSegs points) d - -The exponential interpolation function stretches e^x between two -endpoints for each pair of points. - -> interpExpLine :: (Double, StartPt) -> -- The startpoing as (x,y) -> -> [(SegLength, EndPt)] -> -- A list of line segments with (x',y) where x' is -> -- a length projected on the x-axis -> -> Double -> -- The target x-coordinate to find a corresponding -> -- y value for -> -> Double -> interpExpLine (s1, e1) [] d = e1 -- termination case, end of list -> interpExpLine (s1, e1) ((s2, e2):t) d = -> if d > s2 then interpExpLine (s2, e2) t (d-s2) else -> let h = e2 - e1 -> x = if h<0 then s2-d else d -> in if s2<=0 then e2 else -- accomodate discontinuities -> (abs h)*((exp (x/s2))-1)/((exp 1)-1) + (min e1 e2) - -> interpStraightLine :: (Double, StartPt) -> -- The startpoing as (x,y) -> -> [(SegLength, EndPt)] -> -- A list of line segments with (x',y) where x' is -> -- a length projected on the x-axis -> -> Double -> -- The target x-coordinate to find a corresponding -> -- y value for -> -> Double -> interpStraightLine (s1, e1) [] d = e1 -- termination case, end of list -> interpStraightLine (s1, e1) ((s2, e2):t) d = -> if d > s2 then interpStraightLine (s2, e2) t (d-s2) else -> let h = e2 - e1 -- height of triangle -> s = h/s2 -- slope of triangle -> in if s2<=0 then e2 else -> e1 + (s*d) -- start point plus slope times distance - -Function to find a particular point at a particular strength - -> makeSineFun :: (PartialNum, PartialStrength, PhaseOffset) -> -- Triple of the partial (0,1,...), partial strength -> -- on [0,1], and phase offset on [0,360]. -> -> Double -> -- The x coordinate for which to find f(x)=y -> -> Double -> makeSineFun (pNum, pStrength, pOffset) x = -> let x' = x * 2 * pi -- convert [0,1] to [0,pi] radians -> po = (pOffset/360) * 2 * pi -- convert [0,360] to [0,pi] radians -> in pStrength * sin (x' * pNum + po) - -For a particular point, sum all partials. - -> makeCompositeSineFun :: [(PartialNum, PartialStrength, PhaseOffset)] -> -- List of triples of the partial (0,1,...), -> -- partial strength on [0,1], and phase offset -> -- on [0,360]. -> -> Double -> -- The x coordinate for which to find f(x)=y -> -> Double -> makeCompositeSineFun [] x = 0 -> makeCompositeSineFun (p:ps) x = makeSineFun p x + makeCompositeSineFun ps x - - --------------------------------------- --- Time events --------------------------------------- - -> samples :: forall p . Clock p => Signal p () (SEvent ()) -> samples = constA (Just ()) - -> timeBuilder :: forall p . Clock p => Double -> Signal p () (SEvent ()) -> timeBuilder d = -> let r = (rate (undefined :: p))*d -> in proc _ -> do -> rec i <- delay 0 -< if i >= r then i-r else i+1 -> outA -< if i < 1 then Just () else Nothing - -> milliseconds :: Clock p => Signal p () (SEvent ()) -> milliseconds = timeBuilder (1/1000) - -> seconds :: Clock p => Signal p () (SEvent ()) -> seconds = timeBuilder 1 - -> countTime :: Clock p => Int -> Signal p () (SEvent ()) -> Signal p () (SEvent ()) -> countTime n t = proc _ -> do -> e <- t -< () -> rec i <- delay 0 -< maybe i' (const $ i'+1) e -> let (i',o) = if i == n then (0, Just ()) else (i, Nothing) -> outA -< o +> {-# LANGUAGE Arrows, BangPatterns, +> ExistentialQuantification, FlexibleContexts, +> FunctionalDependencies, ScopedTypeVariables, +> NoMonomorphismRestriction #-} + +Euterpea adaptation of some unit generators from csound +------------------------------------------------------- + +Conventions: + +(1) Optional arguments in some csound unit generators sometimes carry +different semantics depending on the way the generator is called. +Here they are encoded as algebraic datatypes instead (see 'pluck' for +example). A single optional argument is normally encoded using +Haskell's Maybe type. + +(2) csound's i-type is updated only once on every note's +initialization pass. They are represented as unlifted arguments here +(i.e. non-signal). + +(3) Many unit generators in csound take a signal 'amp' as input, which +scales its result by 'amp'. Since this feature induces computational +overhead when scaling is not needed, and is easily expressed using +arrow syntax when needed, we omit that functionality from Eutperpea's +versions of the unit generators. + +> module Euterpea.IO.Audio.BasicSigFuns ( +> Table, +> pluck, +> PluckDecayMethod(..), +> balance, +> tableExponN, +> tableExpon, +> tableLinearN, +> tableLinear, +> tableSines3N, +> tableSines3, +> tableSinesN, +> tableSines, +> tableBesselN, +> tableBessel, +> filterLowPass, +> filterHighPass, +> filterBandPass, +> filterBandStop, +> filterLowPassBW, +> filterHighPassBW, +> filterBandPassBW, +> filterBandStopBW, +> filterComb, +> osc, +> oscI, +> oscFixed, +> oscDur, +> oscDurI, +> oscPartials, +> envLine, +> envExpon, +> envLineSeg, +> envExponSeg, +> envASR, +> envCSEnvlpx, +> noiseWhite, noiseBLI, noiseBLH, +> delayLine, delayLine1, delayLineT, +> samples, milliseconds, seconds, countTime +> ) where + + +> import Euterpea.IO.Audio.Basics +> import Euterpea.IO.Audio.Types +> import Control.Arrow +> import Control.Arrow.Operations +> import Control.Arrow.ArrowP +> import Data.Array.Base (unsafeAt) +> import Data.Array.Unboxed + +> import Foreign.Marshal +> import Foreign.Ptr +> import Foreign.Storable + +> import GHC.IO +> import System.Random + +> type SEvent a = Maybe a +> constA = arr . const + +Helper Functions +---------------- + +> wrap :: (Ord n, Num n) => n -> n -> n +> wrap val bound = if val > bound then wrap val (val-bound) else val + +> clip :: Ord n => n -> n -> n -> n +> clip val lower upper +> | val <= lower = lower +> | val >= upper = upper +> | otherwise = val + +Raises 'a' to the power 'b' using logarithms. + +> pow :: Floating a => a -> a -> a +> pow a b = exp (log a * b) + +Returns the fractional part of 'x'. + +> frac :: RealFrac r => r -> r +> frac = snd . properFraction + +Table Creation and Access +------------------------- + +A Table is essentially a UArray. + +> data Table = Table +> !Int -- size +> !(UArray Int Double) -- table implementation +> !Bool -- Whether the table is normalized + +> instance Show Table where +> show (Table sz a n) = "Table with " ++ show sz ++ " entries: " ++ show a + +> funToTable :: (Double->Double) -> Bool -> Int -> Table +> funToTable f normalize size = +> let delta = 1 / fromIntegral size +> ys = take size (map f [0, delta.. ]) ++ [head ys] +> -- make table one size larger as an extended guard point +> zs = if normalize then map (/ maxabs ys) ys else ys +> maxabs = maximum . map abs +> in Table size (listArray (0, size) zs) normalize + +> readFromTable :: Table -> Double -> Double +> readFromTable (Table sz array _) pos = +> let idx = truncate (fromIntegral sz * pos) -- range must be [0,size] +> in array `unsafeAt` idx +> {-# INLINE [0] readFromTable #-} + +> readFromTableA :: Arrow a => Table -> a Double Double +> readFromTableA = arr . readFromTable + +> readFromTableRaw :: Table -> Int -> Double +> readFromTableRaw (Table _ a _) idx = a `unsafeAt` idx + +Like readFromTable, but with linear interpolation. + +> readFromTablei :: Table -> Double -> Double +> readFromTablei (Table sz array _) pos = +> let idx = fromIntegral sz * pos -- fractional "index" in table ([0,sz]) +> idx0 = (truncate idx) `mod` sz :: Int +> idx1 = idx0 + 1 :: Int +> val0 = array `unsafeAt` idx0 +> val1 = array `unsafeAt` idx1 +> in val0 + (val1 - val0) * (idx - fromIntegral idx0) +> {-# INLINE [0] readFromTablei #-} + +> readFromTableiA :: Arrow a => Table -> a Double Double +> readFromTableiA = arr . readFromTablei + +Accesses table values by direct indexing with linear interpolation. +The index 'pos' is expected to be normalized (between 0 and 1). Values +out of bounds are either clipped or wrapped. + +> tablei :: (Clock p, Arrow a) => +> Table -- Table to read from. +> -> Bool -- Whether to wrap around index; +> -- if not, index is clipped within bounds +> -> ArrowP a p Double Double +> tablei tab True = +> proc pos -> do +> outA -< readFromTablei tab (wrap pos 1) +> tablei tab False = +> proc pos -> do +> outA -< readFromTablei tab (clip pos 0 1) + +Accesses table values by direct indexing; the index is normalized +(between 0 and 1). + +> table :: (Clock p, Arrow a) => Table -> Bool -> ArrowP a p Double Double +> table tab True = +> proc pos -> do +> outA -< readFromTable tab (wrap pos 1) +> table tab False = +> proc pos -> do +> outA -< readFromTable tab (clip pos 0 1) + +Like tablei, but the index is interpreted as a raw value (between 0 +and (size of table - 1), inclusive). + +> tableiIx :: (Clock p, Arrow a) => +> Table -> Bool -> ArrowP a p Double Double +> tableiIx tab@(Table sz array _) True = +> proc idx -> do +> let idx0 = (truncate idx) `mod` sz +> val0 = readFromTableRaw tab idx0 +> val1 = readFromTableRaw tab (idx0 + 1) +> outA -< val0 + (val1 - val0) * (idx - fromIntegral idx0) +> tableiIx tab@(Table sz _ _) False = +> proc idx -> do +> let pos = idx / fromIntegral (sz-1) +> outA -< readFromTablei tab (clip pos 0 1) + +Like table, but index interpreted as raw value. + +> tableIx :: (Clock p, Arrow a) => Table -> Bool -> ArrowP a p Double Double +> tableIx tab@(Table sz array _) True = +> proc idx -> do +> outA -< readFromTableRaw tab (truncate idx `mod` (sz-1)) +> tableIx tab@(Table sz array _) False = +> proc idx -> do +> outA -< readFromTableRaw tab (clip (truncate idx) 0 (sz-1)) + +Oscillators +----------- + +'osc' generates periodic signals consisting of the values returned +from sampling a stored function table. The internal phase is +simultaneously advanced in accordance with the input signal 'freq'. + +> osc :: (Clock p, ArrowCircuit a) => +> Table +> -> Double -- Initial phase of sampling, expressed as a +> -- fraction of a cycle (0 to 1). +> -> ArrowP a p Double Double +> osc table iphs = osc_ iphs >>> readFromTableA table + +'oscI' is like 'osc', but with linear interpolation. + +> oscI :: (Clock p, ArrowCircuit a) => +> Table +> -> Double +> -> ArrowP a p Double Double +> oscI table iphs = osc_ iphs >>> readFromTableiA table + +Helper function for osc and oscI. + +> osc_ :: forall p a. (Clock p, ArrowCircuit a) => +> Double -> ArrowP a p Double Double +> osc_ phs = +> let sr = rate (undefined :: p) +> in proc freq -> do +> rec +> let delta = 1 / sr * freq +> phase = if next > 1 then frac next else next +> next <- delay phs -< frac (phase + delta) +> outA -< phase + +Simple, fast sine oscillator, that uses only one multiply and two add +operations to generate one sample of output, and does not require a +function table. + +> oscFixed :: forall p a . (Clock p, ArrowCircuit a) => +> Double -> ArrowP a p () Double +> oscFixed freq = +> let omh = 2 * pi * freq / sr +> d = sin omh +> c = 2 * cos omh +> sr = rate (undefined :: p) +> sf = proc () -> do +> rec +> let r = c * d2 - d1 +> d1 <- delay 0 -< d2 +> d2 <- delay d -< r +> outA -< r +> in sf + +'oscDur' accesses values by sampling once through the function table +at a rate determined by 'dur'. For the first 'del' seconds, the point +of scan will reside at the first location of the table; it will then +begin moving through the table at a constant rate, reaching the end in +another 'dur' seconds; from that time on (i.e. after 'del' + 'dur' +seconds) it will remain pointing at the last location. + +> oscDur :: (Clock p, ArrowChoice a, ArrowCircuit a) => +> Table +> -> Double +> -- delay in seconds before 'oscDur' incremental sampling begins +> -> Double +> -- duration in seconds to sample through the table just once. +> -> ArrowP a p () Double +> oscDur = oscDur_ osc + +Like 'oscDur', but with linear interpolation. + +> oscDurI :: (Clock p, ArrowChoice a, ArrowCircuit a) => +> Table +> -> Double +> -- delay in seconds before 'oscDur' incremental sampling begins. +> -> Double +> -- duration in seconds to sample through the table just once. +> -> ArrowP a p () Double +> oscDurI = oscDur_ oscI + +Helper function for oscDur and oscDurI. + +> oscDur_ :: forall p a . (Clock p, ArrowChoice a, ArrowCircuit a) => +> (Table -> Double -> ArrowP a p Double Double) +> -> Table -> Double -> Double -> ArrowP a p () Double +> oscDur_ osc table@(Table sz _ _) del dur = +> let sr = rate (undefined :: p) +> t1 = del * sr +> t2 = t1 + dur * sr +> v0 = readFromTableRaw table 0 +> v2 = readFromTableRaw table (sz-1) +> in proc () -> do +> i <- countUp -< () +> let i' = fromIntegral i +> y <- case (i' < t1, i' < t2) of +> (True, _) -> outA -< v0 +> (False, True) -> osc table 0 -< 1 / dur +> (False, False) -> outA -< v2 +> outA -< y + +These are not implemented. + +> foscil, foscili :: (Clock p, Arrow a) => +> Table -> ArrowP a p (Double,Double,Double,Double) Double +> foscil table = +> proc (freq,carfreq,modfreq,modindex) -> do +> outA -< 0 + +> foscili table = +> proc (freq,carfreq,modfreq,modindex) -> do +> outA -< 0 + +> loscil :: (Clock p, Arrow a) => Table -> ArrowP a p Double Double +> loscil table = +> proc freq -> do +> outA -< 0 + +Output a set of harmonically related sine partials. + +> oscPartials :: forall p . Clock p => +> Table -- table containing a sine wave; +> -- a table size of at least 8192 is recommended. +> -> Double -- initial phase of the fundamental frequency, +> -- expressed as a fraction of a cycle (0 to 1). +> -> Signal p (Double,Int) Double +> -- 'freq' is the fundamental frequency in cycles per +> -- second; 'nharms' is the number of harmonics requested. +> oscPartials table initialPhase = +> let sr = rate (undefined :: p) +> in proc (freq, nharms) -> do +> rec +> let delta = 1 / sr * freq +> phase = if next > 1 then frac next else next +> next <- delay initialPhase -< frac (phase + delta) +> outA -< sum [ readFromTable table (frac (phase * fromIntegral pn)) | +> pn <- [1..nharms] ] +> / fromIntegral nharms + +Pluck +----- + +> data PluckDecayMethod +> = SimpleAveraging +> -- A simple smoothing process. +> | StretchedAveraging Double +> -- Smoothing time stretched by a factor. +> | SimpleDrum Double +> -- The range from pitch to noise is controlled by a 'roughness +> -- factor' (0 to 1). Zero gives the plucked string effect, while +> -- 1 reverses the polarity of every sample (octave down, odd +> -- harmonics). The setting .5 gives an optimum snare drum. +> | StretchedDrum Double Double +> -- Combines both roughness and stretch factors. parm1 is +> -- roughness (0 to 1), and parm2 the stretch factor (=1). +> | WeightedAveraging Double Double +> -- As SimpleAveraging, with parm1 weighting the current sample +> -- (the status quo) and iparm2 weighting the previous adjacent +> -- one. iparm1 + iparm2must be <= 1. +> | RecursiveFilter +> -- 1st order recursive filter, with coefs .5. Unaffected by +> -- parameter values. + +> pluck :: forall p . Clock p => +> Table -> Double -> PluckDecayMethod -> Signal p Double Double +> pluck table pitch method = +> let sr = rate (undefined :: p) +> in proc cps -> do +> rec +> z <- delayLineT (max 64 (truncate (sr / pitch))) table -< y +> z' <- delay 0 -< z +> let y = case method of +> SimpleAveraging -> 0.5 * (z + z') +> -- or is this "RecursiveFilter?" +> WeightedAveraging a b -> z * a + z' * b +> _ -> error "pluck: method not implemented" +> outA -< y + +Grain +----- + +Not implemented. + +> grain :: Table +> -- Grain waveform. This can be just a sine wave or a sampled sound. +> -> Table +> -- Amplitude envelope used for the grains. +> -> Double +> -- Maximum grain duration in seconds. This is the biggest +> -- value to be assigned to 'gdur'. +> -> Bool +> -- If 'True', all grains will begin reading from the +> -- beginning of the 'gfn' table. If 'False', grains +> -- will start reading from random 'gfn' table positions. +> -> Signal p (Double,Double,Double,Double,Double) Double +> grain gfn wfn mgdur grnd = +> proc (pitch,dens,ampoff,pitchoff,gdur) -> do +> outA -< 0 + +Delay Lines +----------- + +csound's delayr and delayw are not implemented -- instead, one can use +a fixed-time delay with native recursive arrow syntax to achieve +modified feedback loops. + +> data Buf = Buf !Int !(Ptr Double) + +> updateBuf :: Buf -> Int -> Double -> IO Double +> updateBuf (Buf _ a) i u = a `seq` i `seq` u `seq` do +> let p = a `advancePtr` i +> x' <- peek p +> poke p u +> return x' + +> peekBuf (Buf sz a) i = peek (a `advancePtr` (min (sz-1) i)) + +TODO: deal with pre-initialized buffers + +> mkArr :: Int -> Buf +> mkArr n = n `seq` Buf n (unsafePerformIO $ +> Foreign.Marshal.newArray (replicate n 0)) + +> mkArrWithTable size t = Buf size (unsafePerformIO $ +> Foreign.Marshal.newArray (map (readFromTable t) [0, (1/sz)..((sz-1)/sz)])) +> where sz = fromIntegral size + +A fixed-length delay line, initialized using a table. + +> delayLineT :: forall p . Clock p => +> Int -> Table -> Signal p Double Double +> delayLineT size table = +> let sr = rate (undefined :: p) +> buf = mkArrWithTable size table +> in proc x -> do +> rec +> let i' = if i == size-1 then 0 else i+1 +> i <- delay 0 -< i' +> y <- delay 0 -< x +> -- TODO: this proc can't be strict on x, but how can we +> -- deal with strictness better without this hack? +> outA -< unsafePerformIO $ updateBuf buf i y + +A fixed-length delay line. + +> delayLine :: forall p . Clock p => +> Double -> Signal p Double Double +> delayLine maxdel = +> let sr = rate (undefined :: p) +> sz = truncate (sr * maxdel) +> buf = mkArr sz +> in proc x -> do +> rec +> let i' = if i == sz-1 then 0 else i+1 +> i <- delay 0 -< i' +> y <- delay 0 -< x +> outA -< unsafePerformIO $ updateBuf buf i y + +delay line with one tap. + +> delayLine1 :: forall p . Clock p => Double -> Signal p (Double, Double) Double +> delayLine1 maxdel = +> let sr = rate (undefined :: p) +> sz = truncate (sr * maxdel) +> buf = mkArr sz +> in proc (sig,dlt) -> do +> rec +> let i' = if i == sz-1 then 0 else i+1 +> dl = min maxdel dlt +> tap = i - truncate (sr * dl) +> tapidx = if tap < 0 then sz + tap else tap +> i <- delay 0 -< i' +> y <- delay 0 -< sig +> outA -< unsafePerformIO $ do +> s <- peekBuf buf tapidx +> _ <- updateBuf buf i y +> return s + +delay line with two taps. + +> delay2 :: Double -> Signal p (Double, Double, Double) Double +> delay2 maxdel = +> proc (sig, dlt1, dlt2) -> do +> outA -< 0 + +delay line with three taps. + +> delay3 :: Double -> Signal p (Double, Double, Double, Double) Double +> delay3 maxdel = +> proc (sig, dlt1, dlt2, dlt3) -> do +> outA -< 0 + +delay line with four taps. + +> delay4 :: Double -> Signal p (Double, Double, Double, Double, Double) Double +> delay4 maxdel = +> proc (sig, dlt1, dlt2, dlt3, dlt4) -> do +> outA -< 0 + +Noise Generators +---------------- + +Analogous to rand, randi, and randh in csound. + +Generate uniform white noise with an R.M.S value of 1 / sqrt 2, where +'seed' is the random seed. + +> noiseWhite :: Int -> Signal p () Double +> noiseWhite seed = +> let gen = mkStdGen seed +> in proc () -> do +> rec +> let (a,g') = random g :: (Double,StdGen) +> g <- delay gen -< g' +> outA -< a * 2 - 1 + +Controlled band-limited noise with interpolation between each new +number, and with an RMS value of 1 / sqrt 2. +'cps' controls how fast the new numbers are generated. +'seed' is the random seed. + +> noiseBLI :: forall p . Clock p => Int -> Signal p Double Double +> noiseBLI seed = +> let sr = rate (undefined :: p) +> gen = mkStdGen seed +> (i_n1, i_g1) = random gen :: (Double,StdGen) +> (i_n2, i_g2) = random i_g1 :: (Double,StdGen) +> i_pr = (i_n1, i_n2, i_g2) +> in proc cps -> do +> let bound = sr / cps +> rec +> state <- delay (0, i_pr) -< state' +> let (cnt, pr@(n1, n2, g)) = state +> n = n1 + (n2 - n1) * cnt / bound +> state' = if cnt + 1 < bound +> then (cnt + 1, pr) +> else let (n3, g') = random g :: (Double,StdGen) +> in (0, (n2, n3, g')) +> outA -< n * 2 - 1 + +Controlled band-limited noise without interpolation (holds +previous value instead), and with an RMS value of 1 / sqrt 2. +'cps' controls how fast the new numbers are generated. +'seed' is the random seed. + +> noiseBLH :: forall p . Clock p => Int -> Signal p Double Double +> noiseBLH seed = +> let sr = rate (undefined :: p) +> gen = mkStdGen seed +> (i_n1, i_g) = random gen :: (Double,StdGen) +> i_pr = (i_n1, i_g) +> in proc cps -> do +> let bound = sr / cps +> rec +> state <- delay (0, i_pr) -< state' +> let (cnt, pr@(n, g)) = state +> state' = if cnt + 1 < bound +> then (cnt + 1, pr) +> else let (n', g') = random g :: (Double,StdGen) +> in (0, (n', g')) +> outA -< n * 2 - 1 + +Gain Adjustment +--------------- + +Adjusts RMS amplitude of 'sig' so that it matches RMS amplitude of 'ref'. + +> balance :: forall p . Clock p => +> Int -> Signal p (Double, Double) Double +> balance ihp = +> proc (sig, ref) -> do +> rec +> (sqrsum, refsum) <- delay (0, 0) -< (sqrsum', refsum') +> let sqrsum' = c1 * sig * sig + c2 * sqrsum +> refsum' = c1 * ref * ref + c2 * refsum +> ratio = if sqrsum == 0 then sqrt $ refsum +> else sqrt $ refsum / sqrsum +> outA -< sig * ratio +> where sr = rate (undefined :: p) +> tpidsr = 2 * pi / sr -- tpidsr = two-pi over sr +> b = 2 - cos (fromIntegral ihp * tpidsr) +> c1 = 1 - c2 +> c2 = b - sqrt (b * b - 1) + +Filters +------- + +> data BandPassData = BandPassData{ +> rsnKcf :: !Double +> , rsnKbw :: !Double +> , rsnCosf :: !Double +> , rsnC1 :: !Double +> , rsnC2 :: !Double +> , rsnC3 :: !Double +> , rsnYt1 :: !Double +> , rsnYt2 :: !Double +> } +> rsnDefault :: BandPassData +> rsnDefault = BandPassData (-1) (-1) 0 0 0 0 0 0 + +A second-order resonant (band pass) filter. + +Analogous to csound's 'reson' routine. + +> filterBandPass :: forall p . Clock p => +> Int -- 'scale': 1 signifies a peak response factor of 1, i.e. all +> -- frequencies other than kcf are attenuated in accordance with +> -- the (normalized) response curve; 2 raises the response +> -- factor so that its overall RMS value equals 1; 0 ignifies +> -- no scaling of the signal, leaving that to some later +> -- adjustment (like balance). +> -> Signal p (Double, Double, Double) Double +> -- 'sig' is the signal to be filtered, +> -- 'kcf' is the center frequency of the filter, +> -- and 'kbw' is the bandwidth of it. +> filterBandPass scale = +> proc (sig, kcf, kbw) -> do +> rec +> rsnData <- delay rsnDefault -< rsnData' +> currData <- if kcf == rsnKcf rsnData && kbw == rsnKbw rsnData +> then outA -< rsnData +> else update -< (rsnData, kcf, kbw) +> let BandPassData{ rsnC1 = c1, rsnC2 = c2, rsnC3 = c3, +> rsnYt1 = yt1, rsnYt2 = yt2 } = currData +> a = c1 * sig + c2 * yt1 - c3 * yt2 +> rsnData' = currData{ rsnYt1 = a, rsnYt2 = yt1 } +> outA -< a +> where sr = rate (undefined :: p) +> tpidsr = 2 * pi / sr -- tpidsr = two-pi over sr +> update = proc (rsnData, kcf, kbw) -> do +> -- kcf or kbw changed, recalc consts +> let cosf = cos $ kcf * tpidsr -- cos (2pi * freq / rate) +> c3 = exp $ - kbw * tpidsr -- exp (-2pi * bwidth / rate) +> -- (note on csound code) mtpdsr = -tpidsr +> -- c1 Gain for input signal. +> -- c2 (Minused) gain for output of delay 1. +> -- c3 Gain for output of delay 2. +> c3p1 = c3 + 1 +> c3t4 = c3 * 4 +> c2 = c3t4 * cosf / c3p1 +> omc3 = 1 - c3 +> c2sqr = c2 * c2 +> c1 = case scale of +> 1 -> omc3 * sqrt (1 - c2sqr / c3t4) +> 2 -> sqrt $ (c3p1 * c3p1 - c2sqr) * omc3 / c3p1 +> _ -> 1.0 +> outA -< rsnData{ rsnKcf = kcf, rsnKbw = kbw, rsnCosf = cosf, +> rsnC1 = c1, rsnC2 = c2, rsnC3 = c3 } + +A band stop filter whose transfer function is the complement of +filterBandPass. + +Analogous to csound's 'areson' routine. + +> filterBandStop :: forall p. Clock p => +> Int -> Signal p (Double, Double, Double) Double +> filterBandStop scale = proc (sig, kcf, kbw) -> do +> r <- filterBandPass scale -< (sig, kcf, kbw) +> outA -< sig - r + +> data ButterData = ButterData !Double !Double !Double !Double !Double + +> sqrt2 :: Double +> sqrt2 = sqrt 2 + +> blpset :: Double -> Double -> ButterData +> blpset freq sr = ButterData a1 a2 a3 a4 a5 +> where c = 1 / tan (pidsr * freq) +> csq = c * c; pidsr = pi / sr +> a1 = 1 / (1 + sqrt2 * c + csq) +> a2 = 2 * a1 +> a3 = a1 +> a4 = 2 * (1 - csq) * a1 +> a5 = (1 - sqrt2 * c + csq) * a1 + +> bhpset :: Double -> Double -> ButterData +> bhpset freq sr = ButterData a1 a2 a3 a4 a5 +> where c = tan (pidsr * freq) +> csq = c * c; pidsr = pi / sr +> a1 = 1 / (1 + sqrt2 * c + csq) +> a2 = (-2) * a1 +> a3 = a1 +> a4 = 2 * (csq - 1) * a1 +> a5 = (1 - sqrt2 * c + csq) * a1 + +> bbpset :: Double -> Double -> Double -> ButterData +> bbpset freq band sr = ButterData a1 a2 a3 a4 a5 +> where c = 1 / tan (pidsr * band) +> d = 2 * cos (2 * pidsr * freq) +> pidsr = pi / sr +> a1 = 1 / (1 + c) +> a2 = 0 +> a3 = negate a1 +> a4 = negate (c * d * a1) +> a5 = (c - 1) * a1 + +> bbrset :: Double -> Double -> Double -> ButterData +> bbrset freq band sr = ButterData a1 a2 a3 a4 a5 +> where c = tan (pidsr * band) +> d = 2 * cos (2 * pidsr * freq) +> pidsr = pi / sr +> a1 = 1 / (1 + c) +> a2 = negate d * a1 +> a3 = a1 +> a4 = a2 +> a5 = (1 - c) * a1 + +A second-order low-pass Butterworth filter, where 'sig' is the input +signal to be filtered, and 'freq' is the cutoff center frequency. + +Analogous to csound's 'butterlp' routine. + +> filterLowPassBW :: forall p . Clock p => Signal p (Double, Double) Double +> filterLowPassBW = +> let sr = rate (undefined :: p) +> in proc (sig, freq) -> do +> butter -< (sig, blpset freq sr) + +A high-pass Butterworth filter. + +Analogous to csound's 'butterhp' routine. + +> filterHighPassBW :: forall p . Clock p => Signal p (Double, Double) Double +> filterHighPassBW = +> let sr = rate (undefined :: p) +> in proc (sig, freq) -> do +> butter -< (sig, bhpset freq sr) + +A band-pass Butterworth filter where 'band' is the bandwidth. +'filterBandPassBW -< (s, 2000, 100)' will pass only 1950 to 2050 Hz in 's'. + +Analogous to csound's 'butterbp' routine. + +> filterBandPassBW :: forall p . Clock p => +> Signal p (Double, Double, Double) Double +> filterBandPassBW = +> let sr = rate (undefined :: p) +> in proc (sig, freq, band) -> do +> butter -< (sig, bbpset freq band sr) + +A band-stop Butterworth filter where 'band' is the bandwidth. +'filterBandStopBW -< (s, 4000, 1000)' will filter 's' such that frequencies +between 3500 to 4500 Hz are rejected. + +Analogous to csound's 'butterbr' routine. + +> filterBandStopBW :: forall p . Clock p => +> Signal p (Double, Double, Double) Double +> filterBandStopBW = +> let sr = rate (undefined :: p) +> in proc (sig, freq, band) -> do +> butter -< (sig, bbrset freq band sr) + +Helper function for various Butterworth filters. + +> butter :: Clock p => Signal p (Double,ButterData) Double +> butter = proc (sig, ButterData a1 a2 a3 a4 a5) -> do +> rec let t = sig - a4 * y' - a5 * y'' +> y = t * a1 + a2 * y' + a3 * y'' +> y' <- delay 0 -< t +> y'' <- delay 0 -< y' +> outA -< y + +This filter reiterates input with an echo density determined by loop +time 'looptime'. The attenuation rate is independent and is +determined by 'rvt', the reverberation time (defined as the time in +seconds for a signal to decay to 1/1000 of, or 60dB down from, its +original amplitude). Output from 'filterComb' will appear only after +'looptime' seconds. + +Analogous to csound's 'comb' routine. + +> filterComb :: Clock p => +> Double -- loop time in seconds, which determines the "echo +> -- density" of the reverberation. This in turn +> -- characterizes the "color" of the filter whose +> -- frequency response curve will contain 'looptime' * +> -- sr/2 peaks spaced evenly between 0 and sr/2 (the +> -- Nyquist frequency). Loop time can be as large as +> -- available memory will permit. +> -> Signal p (Double, Double) Double +> filterComb looptime = +> let log001 = -6.9078 +> del = delayLine looptime +> in proc (sig, rvt) -> do +> let gain = exp (log001 * looptime / rvt) +> rec +> r <- del -< sig + r * gain +> outA -< r + +A first-order recursive low-pass filter with variable frequency +response. 'hp' is the response curve's half-power point, in Hertz. +Half power is defined as peak power / sqrt 2. + +Analogous to csound's tone routine. + +> filterLowPass :: forall p . Clock p => Signal p (Double,Double) Double +> filterLowPass = +> let sr = rate (undefined :: p) +> in proc (sig, hp) -> do +> rec +> let y' = c1 * sig + c2 * y +> b = 2 - cos (2 * pi * hp / sr) +> c2 = b - sqrt (b * b - 1.0) +> c1 = 1 - c2 +> y <- delay 0 -< y' +> outA -< y + +A high-pass filter whose transfer function is the complement of that +of 'filterLowPass'. The transfer function of 'filterHighPass' +represents the "filtered out" aspects of its complement. However, +power scaling is not normalized in 'filterHighPass' but remains the +true complement of filterLowPass. Thus an audio signal, filtered by +parallel matching 'filterLowPass' and 'filterHighPass', would under +addition simply reconstruct the original spectrum. + +> filterHighPass :: Clock p => Signal p (Double,Double) Double +> filterHighPass = proc (sig, hp) -> do +> y <- filterLowPass -< (sig, hp) +> outA -< sig - y + +Envelopes +--------- + +'envLine' generates control or audio signals whose values move linearly +from an initial value to a final one. A common error with this signal +function is to assume that the value of 'b' is held after the time +'dur'. 'envLine' does not automatically end or stop at the end of the +duration given. If your note length is longer than 'dur' seconds, the +resulting value will not come to rest at 'b', but will instead +continue to rise or fall with the same rate. If a rise (or fall) and +then hold is required then 'envLineSeg' should be considered instead. + +> envLine :: forall p . Clock p => +> Double -- Starting value. +> -> Double -- Duration in seconds. +> -> Double -- Value after 'dur' seconds. +> -> Signal p () Double +> envLine a dur b = +> let sr = rate (undefined :: p) +> in proc () -> do +> rec +> y <- delay a -< y + (b-a) * (1 / sr / dur) +> outA -< y + +Trace an exponential curve between specified points. + +> envExpon :: forall p . Clock p => +> Double -- Starting value. Zero is illegal for exponentials. +> -> Double -- Duration in seconds. +> -> Double -- Value after 'dur' seconds. For exponentials, +> -- must be non-zero and must agree in sign with 'a'. +> -> Signal p () Double +> envExpon a dur b = +> let sr = rate (undefined :: p) +> in proc () -> do +> rec +> y <- delay a -< y * pow (b/a) (1 / sr / dur) +> outA -< y + +Unfortunately, envLine and envExpon cannot be abstracted to a common +function because Template Haskell doesn't like higher-order functions. + +> data Tab = Tab [Double] !Int !(UArray Int Double) + +> aAt :: Tab -> Int -> Double +> aAt (Tab _ sz a) i = unsafeAt a (min (sz-1) i) + +Helper function for envLineSeg and envExponSeg. + +> seghlp :: forall p . Clock p => +> [Double] -- List of points to trace through. +> -> [Double] -- List of durations for each line segment. +> -- Needs to be one element fewer than 'iamps'. +> -> Signal p () (Double,Double,Double,Double) +> seghlp iamps idurs = +> let sr = rate (undefined :: p) +> sz = length iamps +> amps = Tab iamps sz (listArray (0, sz-1) iamps) +> durs = Tab idurs (sz-1) (listArray (0, sz-2) (map (*sr) idurs)) +> in proc _ -> do +> -- TODO: this is better defined using 'integral', but which is faster? +> rec +> let (t', i') = if t >= durs `aAt` i +> then if i == sz-2 then (t+1, i) else (0, i+1) +> else (t+1, i) +> i <- delay 0 -< i' +> t <- delay 0 -< t' +> let a1 = aAt amps i +> a2 = aAt amps (i+1) +> d = aAt durs i +> outA -< (a1,a2,t,d) + +Trace a series of line segments between specified points. + +> envLineSeg :: Clock p => +> [Double] -- List of points to trace through. +> -> [Double] -- List of durations for each line segment. +> -- Needs to be one element fewer than 'amps'. +> -> Signal p () Double +> envLineSeg amps durs = +> let sf = seghlp amps durs +> in proc () -> do +> (a1,a2,t,d) <- sf -< () +> outA -< a1 + (a2-a1) * (t / d) + +Trace a series of exponential segments between specified points. + +> envExponSeg :: Clock p => +> [Double] -- List of points to trace through. +> -> [Double] -- List of durations for each line segment. +> -- Needs to be one element fewer than 'amps'. +> -> Signal p () Double +> envExponSeg ampinps durs = +> let amps' = case ampinps of +> (a:amps) -> max 0.001 a : amps +> [] -> [] +> sf = seghlp amps' durs +> in proc () -> do +> (a1,a2,t,d) <- sf -< () +> outA -< a1 * pow (a2/a1) (t / d) + +Creates a straight-line rise and decay envelope. Rise modifications +are applied for the first 'rise' seconds, and decay from time 'dur' - +'dec'. If these periods are separated in time there will be a steady +state during which the output will remain constant. If the overall +duration idur is exceeded in performance, the final decay will +continue on in the same direction, going negative. + +> envASR :: (Clock p) => +> Double -- rise time in seconds. +> -> Double -- overall duration in seconds. +> -> Double -- decay time in seconds. +> -> Signal p () Double +> envASR rise dur dec = +> let sf = envLineSeg [0,1,1,0] [rise, dur-rise-dec, dec] +> in proc () -> do +> env <- sf -< () +> outA -< env + +Apply an envelope consisting of 3 segments: + 1. stored function rise shape + 2. modified exponential pseudo steady state + 3. exponential decay + +Rise modifications are applied for the first 'rise' seconds, and decay +from time 'dur' - 'dec'. If these periods are separated in time the +output will be modified by the first exponential pattern. If rise and +decay periods overlap then both modifications will be in effect for +that time. If the overall duration 'dur' is exceeded in performance, +the final decay will continue on in the same direction, tending +asymptotically to zero. + +> envCSEnvlpx :: forall p . Clock p => +> Double -- rise time in seconds. +> -> Double -- overall duration in seconds. +> -> Double -- decay time in seconds. +> -> Table -- table of stored rise shape. +> -> Double +> -- attenuation factor, by which the last value of the +> -- 'envCSEnvlpx' rise is modified during the note's pseudo +> -- steady state. A factor greater than 1 causes an +> -- exponential growth and a factor less than 1 creates an +> -- exponential decay. A factor of 1 will maintain a true +> -- steady state at the last rise value. Note that this +> -- attenuation is not by fixed rate (as in a piano), but +> -- is sensitive to a note's duration. However, if 'atss' +> -- is negative (or if steady state < 4 k-periods) a fixed +> -- attenuation rate of 'abs' 'atss' per second will be +> -- used. 0 is illegal. +> -> Double +> -- attenuation factor by which the closing steady state +> -- value is reduced exponentially over the decay +> -- period. This value must be positive and is normally of +> -- the order of .01. A large or excessively small value is +> -- apt to produce a cutoff which is audible. A zero or +> -- negative value is illegal. +> -> Signal p () Double +> envCSEnvlpx rise dur dec tab atss atdec = +> let sr = rate (undefined :: p) +> cnt1 = (dur - rise - dec) * sr + 0.5 +> -- num of samples in steady state +> mlt1 = pow atss (1 / cnt1) +> mlt2 = pow atdec (1 / sr / dec) +> in proc () -> do +> rec +> i <- countUp -< () +> let i' = fromIntegral i +> y <- delay (readFromTableRaw tab 0) -< y' +> y' <- case (i' < rise * sr, i' < (dur-dec) * sr) of +> (True, _) -> table tab False -< i' / (rise*sr+0.5) +> (False, True) -> outA -< y * mlt1 +> (False, False) -> outA -< y * mlt2 +> outA -< y' + +GEN routines +------------ + +All the GEN routines in Csound are normalized by default. In +Euterpea, the names of normalized table generators end in "N"; those +without an "N" are unnormalized + +> type TableSize = Int +> type PartialNum = Double +> type PartialStrength = Double +> type PhaseOffset = Double +> type StartPt = Double +> type SegLength = Double +> type EndPt = Double + +> type DoubleSegFun = +> (Double, StartPt) -> [(SegLength, EndPt)] -> Double -> Double + +Analgous to csound's gen05 routine. + +> tableExponN :: TableSize +> -- The size of the table to be produced. +> -> StartPt +> -- The y-coordinate for the start point, (0,y). +> -> [(SegLength, EndPt)] +> -- Pairs of segment lengths and y-coordinates. The segment +> -- lengths are the projection along the x-axis. The first +> -- pair will define the line from (0, startPt) to (segLength, +> -- endPt). +> -> Table +> tableExponN size sp segs = tableExp_ sp segs True size +> tableExpon :: Int -> StartPt -> [(SegLength, EndPt)] -> Table +> tableExpon size sp segs = tableExp_ sp segs False size +> tableExp_ :: StartPt -> [(SegLength, EndPt)] -> Bool -> Int -> Table +> tableExp_ sp segs = funToTable (interpLine sp segs interpExpLine) + +Analogous to csound's gen07 routine. + +> tableLinearN :: TableSize +> -- The size of the table to be produced. +> -> StartPt +> -- The y-coordinate for the start point, (0,y). +> -> [(SegLength, EndPt)] +> -- Pairs of segment lengths and y-coordinates. The segment +> -- lengths are the projection along the x-axis. The first +> -- pair will define the line from (0, startPt) to (segLength, +> -- endPt). +> -> Table +> tableLinearN size sp segs = tableLin_ sp segs True size +> tableLinear :: Int -> StartPt -> [(SegLength, EndPt)] -> Table +> tableLinear size sp segs = tableLin_ sp segs False size +> tableLin_ :: StartPt -> [(SegLength, EndPt)] -> Bool -> Int -> Table +> tableLin_ sp segs = funToTable (interpLine sp segs interpStraightLine) + +Make a table from a collection of sine waves at different delays and +strengths. + +Analogous to csound's gen09 routine. + +> tableSines3N :: TableSize +> -- The size of the table to be produced. +> -> [(PartialNum, PartialStrength, PhaseOffset)] +> -- List of triples of the partial (0,1,...), partial +> -- strength on [0,1], and phase delay on [0,360]. +> -> Table +> tableSines3N size ps = tableSines3_ ps True size +> tableSines3 :: Int -> [(PartialNum, PartialStrength, PhaseOffset)] -> Table +> tableSines3 size ps = tableSines3_ ps False size +> tableSines3_ :: [(PartialNum, PartialStrength, PhaseOffset)] -> Bool -> Int -> Table +> tableSines3_ ps = funToTable (makeCompositeSineFun ps) + +> tableSinesF :: (Floating a, Enum a) => [a] -> a -> a +> tableSinesF pss x = let phase = 2 * pi * x +> in sum (zipWith (*) [ sin (phase * pn) | pn <- [1..] ] pss) + +Analogous to csound's gen10 routine. + +> tableSinesN :: TableSize -> [PartialStrength] -> Table +> tableSinesN size pss = tableSinesN_ pss True size +> tableSines :: Int -> [Double] -> Table +> tableSines size pss = tableSinesN_ pss False size +> tableSinesN_ :: [Double] -> Bool -> Int -> Table +> tableSinesN_ pss = funToTable (tableSinesF pss) + +Generates the log of a modified Bessel function of the second kind, +order 0, suitable for use in amplitude-modulated FM. + +Analogous to csound's gen12 routine. + +> tableBesselN :: TableSize +> -> Double -- specifies the x interval [0 to +xint] over which +> -- the function is defined. +> -> Table +> tableBesselN size xint = tableBess_ xint True size +> tableBessel :: Int -> Double -> Table +> tableBessel size xint = tableBess_ xint False size +> tableBess_ :: Double -> Bool -> Int -> Table +> tableBess_ xint = funToTable (tableBessF xint) +> tableBessF :: Floating s => s -> s -> s +> tableBessF xint x = +> log $ 1 + +> let tsquare = x * x * xint * xint / 3.75 / 3.75 +> in sum $ zipWith (*) [ 3.5156229, 3.0899424, 1.2067492, +> 0.2659732, 0.0360768, 0.0045813 ] +> $ iterate (*tsquare) tsquare + +Utility functions for tableExpon and tableLinear. + +> normalizeSegs :: [(SegLength, entPt)] -> [(SegLength, entPt)] +> normalizeSegs segs = +> let s = sum (map fst segs) +> fact = if (s > 1) then (1/s) else 1 -- don't force max<1 up to max=1 +> in map (\(x,y) -> (x*fact, y)) segs + +> interpLine :: StartPt +> -- The y-coordinate for the start point (0,y). +> -> [(SegLength, EndPt)] +> -- Pairs of segment lengths (projected on the x-axis) +> -- and y-coordinates (end points). +> -> DoubleSegFun +> -- The function to use for interpolation +> -> Double +> -- The x-coordinate for which to find the +> -- corresponding f(x)=y. +> -> Double +> interpLine sp [] d f = 0 -- catchall case +> interpLine sp points f d = f (0,sp) (normalizeSegs points) d + +The exponential interpolation function stretches e^x between two +endpoints for each pair of points. + +> interpExpLine :: (Double, StartPt) +> -- The startpoing as (x,y) +> -> [(SegLength, EndPt)] +> -- A list of line segments with (x',y) where x' is +> -- a length projected on the x-axis +> -> Double +> -- The target x-coordinate to find a corresponding +> -- y value for +> -> Double +> interpExpLine (s1, e1) [] d = e1 -- termination case, end of list +> interpExpLine (s1, e1) ((s2, e2):t) d = +> if d > s2 then interpExpLine (s2, e2) t (d-s2) else +> let h = e2 - e1 +> x = if h<0 then s2-d else d +> in if s2<=0 then e2 else -- accomodate discontinuities +> (abs h)*((exp (x/s2))-1)/((exp 1)-1) + (min e1 e2) + +> interpStraightLine :: (Double, StartPt) +> -- The startpoing as (x,y) +> -> [(SegLength, EndPt)] +> -- A list of line segments with (x',y) where x' is +> -- a length projected on the x-axis +> -> Double +> -- The target x-coordinate to find a corresponding +> -- y value for +> -> Double +> interpStraightLine (s1, e1) [] d = e1 -- termination case, end of list +> interpStraightLine (s1, e1) ((s2, e2):t) d = +> if d > s2 then interpStraightLine (s2, e2) t (d-s2) else +> let h = e2 - e1 -- height of triangle +> s = h/s2 -- slope of triangle +> in if s2<=0 then e2 else +> e1 + (s*d) -- start point plus slope times distance + +Function to find a particular point at a particular strength + +> makeSineFun :: (PartialNum, PartialStrength, PhaseOffset) +> -- Triple of the partial (0,1,...), partial strength +> -- on [0,1], and phase delay on [0,360]. +> -> Double +> -- The x coordinate for which to find f(x)=y +> -> Double +> makeSineFun (pNum, pStrength, pOffset) x = +> let x' = x * 2 * pi -- convert [0,1] to [0,pi] radians +> po = (pOffset/360) * 2 * pi -- convert [0,360] to [0,pi] radians +> in pStrength * sin (x' * pNum + po) + +For a particular point, sum all partials. + +> makeCompositeSineFun :: [(PartialNum, PartialStrength, PhaseOffset)] +> -- List of triples of the partial (0,1,...), +> -- partial strength on [0,1], and phase delay +> -- on [0,360]. +> -> Double +> -- The x coordinate for which to find f(x)=y +> -> Double +> makeCompositeSineFun [] x = 0 +> makeCompositeSineFun (p:ps) x = makeSineFun p x + makeCompositeSineFun ps x + + +-------------------------------------- +-- Time events +-------------------------------------- + +> samples :: forall p . Clock p => Signal p () (SEvent ()) +> samples = constA (Just ()) + +> timeBuilder :: forall p . Clock p => Double -> Signal p () (SEvent ()) +> timeBuilder d = +> let r = (rate (undefined :: p))*d +> in proc _ -> do +> rec i <- delay 0 -< if i >= r then i-r else i+1 +> outA -< if i < 1 then Just () else Nothing + +> milliseconds :: Clock p => Signal p () (SEvent ()) +> milliseconds = timeBuilder (1/1000) + +> seconds :: Clock p => Signal p () (SEvent ()) +> seconds = timeBuilder 1 + +> countTime :: Clock p => Int -> Signal p () (SEvent ()) -> Signal p () (SEvent ()) +> countTime n t = proc _ -> do +> e <- t -< () +> rec i <- delay 0 -< maybe i' (const $ i'+1) e +> let (i',o) = if i == n then (0, Just ()) else (i, Nothing) +> outA -< o diff --git a/Euterpea/IO/Audio/Basics.hs b/Euterpea/IO/Audio/Basics.hs --- a/Euterpea/IO/Audio/Basics.hs +++ b/Euterpea/IO/Audio/Basics.hs @@ -1,63 +1,63 @@ -{-# LANGUAGE Arrows, ExistentialQuantification, FlexibleContexts, ScopedTypeVariables #-} - -module Euterpea.IO.Audio.Basics ( - outA, - integral, - countDown, countUp, - upsample, - pchToHz, apToHz -) where - -import Euterpea.Music.Note.Music -import Euterpea.IO.Audio.Types -import Control.Arrow -import Control.Arrow.Operations -import Control.Arrow.ArrowP - - -outA :: (Arrow a) => a b b -outA = arr id - -integral :: forall a p. (ArrowCircuit a, Clock p) => ArrowP a p Double Double -integral = - let dt = 1 / rate (undefined :: p) - in proc x -> do - rec let i' = i + x * dt - i <- delay 0 -< i' - outA -< i - -countDown :: ArrowCircuit a => Int -> a () Int -countDown x = proc _ -> do - rec i <- delay x -< i - 1 - outA -< i - -countUp :: ArrowCircuit a => a () Int -countUp = proc _ -> do - rec i <- delay 0 -< i + 1 - outA -< i - - -upsample :: forall a b c p1 p2. (ArrowChoice a, ArrowCircuit a, Clock p1, Clock p2, AudioSample c) - => ArrowP a p1 b c -> ArrowP a p2 b c -upsample f = g - where g = proc x -> do - rec - cc <- delay 0 -< if cc >= r-1 then 0 else cc+1 - y <- if cc == 0 then ArrowP (strip f) -< x - else delay zero -< y - outA -< y - r = if outRate < inRate - then error "Cannot upsample a signal of higher rate to lower rate" - else outRate / inRate - inRate = rate (undefined :: p1) - outRate = rate (undefined :: p2) - --- Some useful auxiliary functions. - --- | Converting an AbsPitch to hertz (cycles per second): -apToHz :: Floating a => AbsPitch -> a -apToHz ap = 440 * 2 ** (fromIntegral (ap - absPitch (A,5)) / 12) - --- | Converting from a Pitch value to Hz: -pchToHz :: Floating a => Pitch -> a +{-# LANGUAGE Arrows, ExistentialQuantification, FlexibleContexts, ScopedTypeVariables #-} + +module Euterpea.IO.Audio.Basics ( + outA, + integral, + countDown, countUp, + upsample, + pchToHz, apToHz +) where + +import Euterpea.Music +import Euterpea.IO.Audio.Types +import Control.Arrow +import Control.Arrow.Operations +import Control.Arrow.ArrowP + + +outA :: (Arrow a) => a b b +outA = arr id + +integral :: forall a p. (ArrowCircuit a, Clock p) => ArrowP a p Double Double +integral = + let dt = 1 / rate (undefined :: p) + in proc x -> do + rec let i' = i + x * dt + i <- delay 0 -< i' + outA -< i + +countDown :: ArrowCircuit a => Int -> a () Int +countDown x = proc _ -> do + rec i <- delay x -< i - 1 + outA -< i + +countUp :: ArrowCircuit a => a () Int +countUp = proc _ -> do + rec i <- delay 0 -< i + 1 + outA -< i + + +upsample :: forall a b c p1 p2. (ArrowChoice a, ArrowCircuit a, Clock p1, Clock p2, AudioSample c) + => ArrowP a p1 b c -> ArrowP a p2 b c +upsample f = g + where g = proc x -> do + rec + cc <- delay 0 -< if cc >= r-1 then 0 else cc+1 + y <- if cc == 0 then ArrowP (strip f) -< x + else delay zero -< y + outA -< y + r = if outRate < inRate + then error "Cannot upsample a signal of higher rate to lower rate" + else outRate / inRate + inRate = rate (undefined :: p1) + outRate = rate (undefined :: p2) + +-- Some useful auxiliary functions. + +-- | Converting an AbsPitch to hertz (cycles per second): +apToHz :: Floating a => AbsPitch -> a +apToHz ap = 440 * 2 ** (fromIntegral (ap - absPitch (A,4)) / 12) + +-- | Converting from a Pitch value to Hz: +pchToHz :: Floating a => Pitch -> a pchToHz = apToHz . absPitch diff --git a/Euterpea/IO/Audio/IO.hs b/Euterpea/IO/Audio/IO.hs --- a/Euterpea/IO/Audio/IO.hs +++ b/Euterpea/IO/Audio/IO.hs @@ -34,7 +34,7 @@ -> Double -- ^ Duration of the wav in seconds. -> Signal p () a -- ^ Signal representing the sound. -> IO () -outFile = outFileHelp id +outFile = outFileHelp' id normList :: [Double] -> [Double] normList xs = map (/ mx) xs @@ -50,7 +50,7 @@ -> Double -- ^ Duration of the wav in seconds. -> Signal p () a -- ^ Signal representing the sound. -> IO () -outFileNorm = outFileHelp normList +outFileNorm = outFileHelp' normList outFileHelp :: forall a p. (AudioSample a, Clock p) => ([Double] -> [Double]) -- ^ Post-processing function. @@ -70,6 +70,33 @@ channelNumber = numChannels, sampleData = array } in exportFile filepath aud + +{- +Alternative definition of the above that enforces a clipping behavior when +the value exceeds the [-1.0, 1.0] range. The overflow behavior makes it +very hard to debug sound modeling problems that involve certain waveforms, +such as saw waves. Clipping is also a more common behavior in other audio +software rather than overflowing or wrap-around. +-} + +outFileHelp' :: forall a p. (AudioSample a, Clock p) => + ([Double] -> [Double]) -- ^ Post-processing function. + -> String -- ^ Filename to write to. + -> Double -- ^ Duration of the wav in seconds. + -> Signal p () a -- ^ Signal representing the sound. + -> IO () +outFileHelp' f filepath dur sf = + let sr = rate (undefined :: p) + numChannels = numChans (undefined :: a) + numSamples = truncate (dur * sr) * numChannels + dat = map (fromSample . (*0.999) . clipFix) + (f (toSamples dur sf)) :: [Int32] + array = listArray (0, numSamples-1) dat + aud = Audio { sampleRate = truncate sr, + channelNumber = numChannels, + sampleData = array } + in exportFile filepath aud where + clipFix x = if x > 1.0 then 1.0 else if x < -1.0 then -1.0 else x {- diff --git a/Euterpea/IO/Audio/Render.hs b/Euterpea/IO/Audio/Render.hs --- a/Euterpea/IO/Audio/Render.hs +++ b/Euterpea/IO/Audio/Render.hs @@ -1,125 +1,124 @@ -{-# LANGUAGE Arrows, ScopedTypeVariables, NamedFieldPuns, FlexibleContexts #-} - --- Render a Music object to a audio signal function that can be further --- manipulated or saved to a file. It is channel-agnostic in that it is --- able to deal with instruments of arbitrary number of channels. - -module Euterpea.IO.Audio.Render ( - Instr, InstrMap, renderSF, -) where - -import Control.Arrow -import Control.Arrow.Operations -import Control.Arrow.ArrowP -import Control.SF.SF - -import Euterpea.Music.Note.Music -import Euterpea.Music.Note.MoreMusic -import Euterpea.Music.Note.Performance -import Euterpea.IO.Audio.Basics -import Euterpea.IO.Audio.Types - -import Data.List -import qualified Data.IntMap as M -import Data.Ord (comparing) - --- Every instrument is a function that takes a duration, absolute --- pitch, volume, and a list of parameters (Doubles). What the function --- actually returns is implementation independent. -type Instr a = Dur -> AbsPitch -> Volume -> [Double] -> a - -type InstrMap a = [(InstrumentName, Instr a)] - -lookupInstr :: InstrumentName -> InstrMap a -> Instr a -lookupInstr ins im = - case lookup ins im of - Just i -> i - Nothing -> error $ "Instrument " ++ show ins ++ - " does not have a matching Instr in the supplied InstrMap." - --- Each note in a Performance is tagged with a unique NoteId, which --- helps us keep track of the signal function associated with a note. -type NoteId = Int - --- In this particular implementation, 'a' is the signal function that --- plays the given note. -data NoteEvt a = NoteOn NoteId a - | NoteOff NoteId - -type Evt a = (Double, NoteEvt a) -- Timestamp in seconds, and the note event - - --- Turn an Event into a NoteOn and a matching NoteOff with the same NodeId. -eventToEvtPair :: InstrMap a -> Event -> Int -> [Evt a] -eventToEvtPair imap (Event {eTime, eInst, ePitch, eDur, eVol, eParams}) nid = - let instr = lookupInstr eInst imap - tOn = fromRational eTime - tDur = fromRational eDur :: Double - sf = instr eDur ePitch eVol eParams - in [(tOn, NoteOn nid sf), (tOn + tDur, NoteOff nid)] - --- Turn a Performance into an SF of NoteOn/NoteOffs. --- For each note, generate a unique id to tag the NoteOn and NoteOffs. --- The tag is used as the key to the collection of signal functions --- for efficient insertion/removal. -toEvtSF :: Clock p => Performance -> InstrMap a -> Signal p () [Evt a] -toEvtSF pf imap = - let evts = sortBy (comparing fst) $ concat $ - zipWith (eventToEvtPair imap) pf [0..] - -- Sort all NoteOn/NoteOff events by timestamp. - in proc _ -> do - rec - t <- integral -< 1 - es <- delay evts -< next - let (evs, next) = span ((<= t) . fst) es - -- Trim events that are due off the list and output them, - -- retaining the rest - outA -< evs - --- Modify the collection upon receiving NoteEvts. The timestamps --- are not used here, but they are expected to be the same. - -modSF :: M.IntMap a -> [Evt a] -> M.IntMap a -modSF = foldl' mod - where mod m (_, NoteOn nid sf) = M.insert nid sf m - mod m (_, NoteOff nid) = M.delete nid m - - --- Simplified version of a parallel switcher. --- Note that this is tied to the particular implementation of SF, as it --- needs to use runSF to run all the signal functions in the collection. - -pSwitch :: forall p col a. (Clock p, Functor col) => - col (Signal p () a) -- Initial SF collection. - -> Signal p () [Evt (Signal p () a)] -- Input event stream. - -> (col (Signal p () a) -> [Evt (Signal p () a)] -> col (Signal p () a)) - -- A Modifying function that modifies the collection of SF - -- based on the event that is occuring. - -> Signal p () (col a) - -- The resulting collection of output values obtained from - -- running all SFs in the collection. - -pSwitch col esig mod = - proc _ -> do - evts <- esig -< () - rec - -- perhaps this can be run at a lower rate using upsample - sfcol <- delay col -< mod sfcol' evts - let rs = fmap (\s -> runSF (strip s) ()) sfcol :: col (a, SF () a) - (as, sfcol' :: col (Signal p () a)) = (fmap fst rs, fmap (ArrowP . snd) rs) - outA -< as - - -renderSF :: (Clock p, Performable a, AudioSample b) => - Music a - -> InstrMap (Signal p () b) - -> (Double, Signal p () b) - -- ^ Duration of the music in seconds, - -- and a signal function that plays the music. - -renderSF m im = - let (pf, d) = perfDur defPMap defCon m - evtsf = toEvtSF pf im - allsf = pSwitch M.empty evtsf modSF - sf = allsf >>> arr (foldl' mix zero . M.elems) -- add up all samples - in (fromRational d, sf) +{-# LANGUAGE Arrows, ScopedTypeVariables, NamedFieldPuns, FlexibleContexts #-} + +-- Render a Music object to a audio signal function that can be further +-- manipulated or saved to a file. It is channel-agnostic in that it is +-- able to deal with instruments of arbitrary number of channels. + +module Euterpea.IO.Audio.Render ( + Instr, InstrMap, renderSF, +) where + +import Control.Arrow +import Control.Arrow.Operations +import Control.Arrow.ArrowP +import Control.SF.SF + +import Euterpea.Music +import Euterpea.IO.MIDI.MEvent +import Euterpea.IO.Audio.Basics +import Euterpea.IO.Audio.Types + +import Data.List +import qualified Data.IntMap as M +import Data.Ord (comparing) + +-- Every instrument is a function that takes a duration, absolute +-- pitch, volume, and a list of parameters (Doubles). What the function +-- actually returns is implementation independent. +type Instr a = Dur -> AbsPitch -> Volume -> [Double] -> a + +type InstrMap a = [(InstrumentName, Instr a)] + +lookupInstr :: InstrumentName -> InstrMap a -> Instr a +lookupInstr ins im = + case lookup ins im of + Just i -> i + Nothing -> error $ "Instrument " ++ show ins ++ + " does not have a matching Instr in the supplied InstrMap." + +-- Each note in a Performance is tagged with a unique NoteId, which +-- helps us keep track of the signal function associated with a note. +type NoteId = Int + +-- In this particular implementation, 'a' is the signal function that +-- plays the given note. +data NoteEvt a = NoteOn NoteId a + | NoteOff NoteId + +type Evt a = (Double, NoteEvt a) -- Timestamp in seconds, and the note event + + +-- Turn an Event into a NoteOn and a matching NoteOff with the same NodeId. +eventToEvtPair :: InstrMap a -> MEvent -> Int -> [Evt a] +eventToEvtPair imap (MEvent {eTime, eInst, ePitch, eDur, eVol, eParams}) nid = + let instr = lookupInstr eInst imap + tOn = fromRational eTime + tDur = fromRational eDur :: Double + sf = instr eDur ePitch eVol eParams + in [(tOn, NoteOn nid sf), (tOn + tDur, NoteOff nid)] + +-- Turn a Performance into an SF of NoteOn/NoteOffs. +-- For each note, generate a unique id to tag the NoteOn and NoteOffs. +-- The tag is used as the key to the collection of signal functions +-- for efficient insertion/removal. +toEvtSF :: Clock p => [MEvent] -> InstrMap a -> Signal p () [Evt a] +toEvtSF pf imap = + let evts = sortBy (comparing fst) $ concat $ + zipWith (eventToEvtPair imap) pf [0..] + -- Sort all NoteOn/NoteOff events by timestamp. + in proc _ -> do + rec + t <- integral -< 1 + es <- delay evts -< next + let (evs, next) = span ((<= t) . fst) es + -- Trim events that are due off the list and output them, + -- retaining the rest + outA -< evs + +-- Modify the collection upon receiving NoteEvts. The timestamps +-- are not used here, but they are expected to be the same. + +modSF :: M.IntMap a -> [Evt a] -> M.IntMap a +modSF = foldl' mod + where mod m (_, NoteOn nid sf) = M.insert nid sf m + mod m (_, NoteOff nid) = M.delete nid m + + +-- Simplified version of a parallel switcher. +-- Note that this is tied to the particular implementation of SF, as it +-- needs to use runSF to run all the signal functions in the collection. + +pSwitch :: forall p col a. (Clock p, Functor col) => + col (Signal p () a) -- Initial SF collection. + -> Signal p () [Evt (Signal p () a)] -- Input event stream. + -> (col (Signal p () a) -> [Evt (Signal p () a)] -> col (Signal p () a)) + -- A Modifying function that modifies the collection of SF + -- based on the event that is occuring. + -> Signal p () (col a) + -- The resulting collection of output values obtained from + -- running all SFs in the collection. + +pSwitch col esig mod = + proc _ -> do + evts <- esig -< () + rec + -- perhaps this can be run at a lower rate using upsample + sfcol <- delay col -< mod sfcol' evts + let rs = fmap (\s -> runSF (strip s) ()) sfcol :: col (a, SF () a) + (as, sfcol' :: col (Signal p () a)) = (fmap fst rs, fmap (ArrowP . snd) rs) + outA -< as + + +renderSF :: (Clock p, ToMusic1 a, AudioSample b) => + Music a + -> InstrMap (Signal p () b) + -> (Double, Signal p () b) + -- ^ Duration of the music in seconds, + -- and a signal function that plays the music. + +renderSF m im = + let (pf, d) = perform1Dur $ toMusic1 m -- Updated 16-Dec-2015 + evtsf = toEvtSF pf im + allsf = pSwitch M.empty evtsf modSF + sf = allsf >>> arr (foldl' mix zero . M.elems) -- add up all samples + in (fromRational d, sf) diff --git a/Euterpea/IO/MIDI.hs b/Euterpea/IO/MIDI.hs --- a/Euterpea/IO/MIDI.hs +++ b/Euterpea/IO/MIDI.hs @@ -1,27 +1,27 @@ -module Euterpea.IO.MIDI - ( - fromMidi -- :: Midi -> (Music1, Context (Pitch, [NoteAttribute]), UserPatchMap) - , module Euterpea.IO.MIDI.GeneralMidi --- , fromGM -- :: Int -> InstrumentName --- , toGM -- :: InstrumentName -> Int - , defaultOutput -- :: (OutputDeviceID -> a -> IO b) -> a -> IO b - , defaultInput -- :: (InputDeviceID -> a -> IO b) -> a -> IO b - , playMidi -- :: OutputDeviceID -> Midi -> IO () - , MidiMessage(..) -- data MidiMessage = ANote { .. } | Std Message - , Message(..) -- data Message (from Codec.Midi) - , DeviceInfo(..) -- data DeviceInfo (from Sound.PortMidi) - , OutputDeviceID -- newtype OutputDeviceID - , InputDeviceID -- newtype InputDeviceID - --, DeviceID -- type DeviceID = Int (from Sound.PortMidi) - --, exportMidiFile -- :: FilePath -> Midi -> IO () - --, writeMidi -- :: (Performable a) => FilePath -> Music a -> IO () - --, writeMidiA -- :: (Performable a) => FilePath -> PMap Note1 -> Context Note1 -> Music a -> IO () - , module Euterpea.IO.MIDI.ToMidi - , module Euterpea.IO.MIDI.ExportMidiFile - ) where - -import Euterpea.IO.MIDI.FromMidi -import Euterpea.IO.MIDI.GeneralMidi -import Euterpea.IO.MIDI.MidiIO -import Euterpea.IO.MIDI.ToMidi -import Euterpea.IO.MIDI.ExportMidiFile +module Euterpea.IO.MIDI + ( + fromMidi -- :: Midi -> (Music1, Context (Pitch, [NoteAttribute]), UserPatchMap) + , module Euterpea.IO.MIDI.GeneralMidi +-- , fromGM -- :: Int -> InstrumentName +-- , toGM -- :: InstrumentName -> Int + , defaultOutput -- :: (OutputDeviceID -> a -> IO b) -> a -> IO b + , defaultInput -- :: (InputDeviceID -> a -> IO b) -> a -> IO b + , playMidi -- :: OutputDeviceID -> Midi -> IO () + , MidiMessage(..) -- data MidiMessage = ANote { .. } | Std Message + , Message(..) -- data Message (from Codec.Midi) + , DeviceInfo(..) -- data DeviceInfo (from Sound.PortMidi) + , OutputDeviceID -- newtype OutputDeviceID + , InputDeviceID -- newtype InputDeviceID + , module Euterpea.IO.MIDI.ToMidi + , module Euterpea.IO.MIDI.ExportMidiFile + , module Euterpea.IO.MIDI.Play + , module Euterpea.IO.MIDI.MEvent + ) where + +import Euterpea.IO.MIDI.FromMidi +import Euterpea.IO.MIDI.GeneralMidi +import Euterpea.IO.MIDI.MidiIO +import Euterpea.IO.MIDI.ToMidi +import Euterpea.IO.MIDI.ExportMidiFile +import Euterpea.IO.MIDI.Play +import Euterpea.IO.MIDI.MEvent diff --git a/Euterpea/IO/MIDI/ExportMidiFile.lhs b/Euterpea/IO/MIDI/ExportMidiFile.lhs --- a/Euterpea/IO/MIDI/ExportMidiFile.lhs +++ b/Euterpea/IO/MIDI/ExportMidiFile.lhs @@ -268,15 +268,15 @@ The exportMidiFile can now be used as follows in place of Codec.Midi's exportFile: - writeMidi :: (Performable a) => FilePath -> Music a -> IO () + writeMidi :: (ToMusic1 a) => FilePath -> Music a -> IO () writeMidi fn = exportMidiFile fn . testMidi - writeMidiA :: (Performable a) => FilePath -> PMap Note1 -> Context Note1 -> Music a -> IO () + writeMidiA :: (ToMusic1 a) => FilePath -> PMap Note1 -> Context Note1 -> Music a -> IO () writeMidiA fn pm con m = exportMidiFile fn $ testMidiA pm con m - test :: (Performable a) => Music a -> IO () + test :: (ToMusic1 a) => Music a -> IO () test = exportMidiFile "test.mid" . testMidi - testA :: Performable a => PMap Note1 -> Context Note1 -> Music a -> IO () + testA :: ToMusic1 a => PMap Note1 -> Context Note1 -> Music a -> IO () testA pm con m = exportMidiFile "test.mid" (testMidiA pm con m) diff --git a/Euterpea/IO/MIDI/FromMidi.lhs b/Euterpea/IO/MIDI/FromMidi.lhs --- a/Euterpea/IO/MIDI/FromMidi.lhs +++ b/Euterpea/IO/MIDI/FromMidi.lhs @@ -1,7 +1,5 @@ > module Euterpea.IO.MIDI.FromMidi (fromMidi) where -> import Euterpea.Music.Note.Music -> import Euterpea.Music.Note.MoreMusic -> import Euterpea.Music.Note.Performance +> import Euterpea.Music > import Euterpea.IO.MIDI.ToMidi > import Euterpea.IO.MIDI.GeneralMidi > import Data.List @@ -247,13 +245,12 @@ The fromMidi function wraps the combination of midiToEvents and eventsToMusic and performs the final conversion to Music1. -> fromMidi :: Midi -> (Music1, Context (Pitch, [NoteAttribute]), UserPatchMap) +> fromMidi :: Midi -> Music1 > fromMidi m = > let seList = midiToEvents m > iNums = filter (>0) $ map getInstrument seList > upm = makeUPM $ map toEnum iNums -> in (mMap (\(p,v) -> (p, [Volume v])) $ eventsToMusic seList, -> defCon, upm) +> in mMap (\(p,v) -> (p, [Volume v])) $ eventsToMusic seList This function is to correct for the fact that channel 10 is diff --git a/Euterpea/IO/MIDI/GeneralMidi.hs b/Euterpea/IO/MIDI/GeneralMidi.hs --- a/Euterpea/IO/MIDI/GeneralMidi.hs +++ b/Euterpea/IO/MIDI/GeneralMidi.hs @@ -1,277 +1,276 @@ -{-# LINE 9 "GeneralMidi.lhs" #-} --- This code was automatically generated by lhs2tex --code, from the file --- HSoM/GeneralMidi.lhs. (See HSoM/MakeCode.bat.) -{-# LINE 16 "GeneralMidi.lhs" #-} -module Euterpea.IO.MIDI.GeneralMidi where - -import Euterpea.Music.Note.Music (InstrumentName(..)) - -fromGM :: Int -> InstrumentName -fromGM i | i >= 0 && i <= 127 = toEnum i -fromGM i = error $ "fromGMNo: " ++ show i ++ - " is not a valid General Midi Number" -toGM :: InstrumentName -> Int -toGM Percussion = 0 -toGM (Custom name) = 0 -toGM i = fromEnum i - -instance Enum InstrumentName where - fromEnum AcousticGrandPiano = 0 - fromEnum BrightAcousticPiano = 1 - fromEnum ElectricGrandPiano = 2 - fromEnum HonkyTonkPiano = 3 - fromEnum RhodesPiano = 4 - fromEnum ChorusedPiano = 5 - fromEnum Harpsichord = 6 - fromEnum Clavinet = 7 - fromEnum Celesta = 8 - fromEnum Glockenspiel = 9 - fromEnum MusicBox = 10 - fromEnum Vibraphone = 11 - fromEnum Marimba = 12 - fromEnum Xylophone = 13 - fromEnum TubularBells = 14 - fromEnum Dulcimer = 15 - fromEnum HammondOrgan = 16 - fromEnum PercussiveOrgan = 17 - fromEnum RockOrgan = 18 - fromEnum ChurchOrgan = 19 - fromEnum ReedOrgan = 20 - fromEnum Accordion = 21 - fromEnum Harmonica = 22 - fromEnum TangoAccordion = 23 - fromEnum AcousticGuitarNylon = 24 - fromEnum AcousticGuitarSteel = 25 - fromEnum ElectricGuitarJazz = 26 - fromEnum ElectricGuitarClean = 27 - fromEnum ElectricGuitarMuted = 28 - fromEnum OverdrivenGuitar = 29 - fromEnum DistortionGuitar = 30 - fromEnum GuitarHarmonics = 31 - fromEnum AcousticBass = 32 - fromEnum ElectricBassFingered = 33 - fromEnum ElectricBassPicked = 34 - fromEnum FretlessBass = 35 - fromEnum SlapBass1 = 36 - fromEnum SlapBass2 = 37 - fromEnum SynthBass1 = 38 - fromEnum SynthBass2 = 39 - fromEnum Violin = 40 - fromEnum Viola = 41 - fromEnum Cello = 42 - fromEnum Contrabass = 43 - fromEnum TremoloStrings = 44 - fromEnum PizzicatoStrings = 45 - fromEnum OrchestralHarp = 46 - fromEnum Timpani = 47 - fromEnum StringEnsemble1 = 48 - fromEnum StringEnsemble2 = 49 - fromEnum SynthStrings1 = 50 - fromEnum SynthStrings2 = 51 - fromEnum ChoirAahs = 52 - fromEnum VoiceOohs = 53 - fromEnum SynthVoice = 54 - fromEnum OrchestraHit = 55 - fromEnum Trumpet = 56 - fromEnum Trombone = 57 - fromEnum Tuba = 58 - fromEnum MutedTrumpet = 59 - fromEnum FrenchHorn = 60 - fromEnum BrassSection = 61 - fromEnum SynthBrass1 = 62 - fromEnum SynthBrass2 = 63 - fromEnum SopranoSax = 64 - fromEnum AltoSax = 65 - fromEnum TenorSax = 66 - fromEnum BaritoneSax = 67 - fromEnum Oboe = 68 - fromEnum EnglishHorn = 69 - fromEnum Bassoon = 70 - fromEnum Clarinet = 71 - fromEnum Piccolo = 72 - fromEnum Flute = 73 - fromEnum Recorder = 74 - fromEnum PanFlute = 75 - fromEnum BlownBottle = 76 - fromEnum Shakuhachi = 77 - fromEnum Whistle = 78 - fromEnum Ocarina = 79 - fromEnum Lead1Square = 80 - fromEnum Lead2Sawtooth = 81 - fromEnum Lead3Calliope = 82 - fromEnum Lead4Chiff = 83 - fromEnum Lead5Charang = 84 - fromEnum Lead6Voice = 85 - fromEnum Lead7Fifths = 86 - fromEnum Lead8BassLead = 87 - fromEnum Pad1NewAge = 88 - fromEnum Pad2Warm = 89 - fromEnum Pad3Polysynth = 90 - fromEnum Pad4Choir = 91 - fromEnum Pad5Bowed = 92 - fromEnum Pad6Metallic = 93 - fromEnum Pad7Halo = 94 - fromEnum Pad8Sweep = 95 - fromEnum FX1Train = 96 - fromEnum FX2Soundtrack = 97 - fromEnum FX3Crystal = 98 - fromEnum FX4Atmosphere = 99 - fromEnum FX5Brightness = 100 - fromEnum FX6Goblins = 101 - fromEnum FX7Echoes = 102 - fromEnum FX8SciFi = 103 - fromEnum Sitar = 104 - fromEnum Banjo = 105 - fromEnum Shamisen = 106 - fromEnum Koto = 107 - fromEnum Kalimba = 108 - fromEnum Bagpipe = 109 - fromEnum Fiddle = 110 - fromEnum Shanai = 111 - fromEnum TinkleBell = 112 - fromEnum Agogo = 113 - fromEnum SteelDrums = 114 - fromEnum Woodblock = 115 - fromEnum TaikoDrum = 116 - fromEnum MelodicDrum = 117 - fromEnum SynthDrum = 118 - fromEnum ReverseCymbal = 119 - fromEnum GuitarFretNoise = 120 - fromEnum BreathNoise = 121 - fromEnum Seashore = 122 - fromEnum BirdTweet = 123 - fromEnum TelephoneRing = 124 - fromEnum Helicopter = 125 - fromEnum Applause = 126 - fromEnum Gunshot = 127 - fromEnum i = error $ "fromEnum: " ++ show i ++ " is not implemented" - - toEnum 0 = AcousticGrandPiano - toEnum 1 = BrightAcousticPiano - toEnum 2 = ElectricGrandPiano - toEnum 3 = HonkyTonkPiano - toEnum 4 = RhodesPiano - toEnum 5 = ChorusedPiano - toEnum 6 = Harpsichord - toEnum 7 = Clavinet - toEnum 8 = Celesta - toEnum 9 = Glockenspiel - toEnum 10 = MusicBox - toEnum 11 = Vibraphone - toEnum 12 = Marimba - toEnum 13 = Xylophone - toEnum 14 = TubularBells - toEnum 15 = Dulcimer - toEnum 16 = HammondOrgan - toEnum 17 = PercussiveOrgan - toEnum 18 = RockOrgan - toEnum 19 = ChurchOrgan - toEnum 20 = ReedOrgan - toEnum 21 = Accordion - toEnum 22 = Harmonica - toEnum 23 = TangoAccordion - toEnum 24 = AcousticGuitarNylon - toEnum 25 = AcousticGuitarSteel - toEnum 26 = ElectricGuitarJazz - toEnum 27 = ElectricGuitarClean - toEnum 28 = ElectricGuitarMuted - toEnum 29 = OverdrivenGuitar - toEnum 30 = DistortionGuitar - toEnum 31 = GuitarHarmonics - toEnum 32 = AcousticBass - toEnum 33 = ElectricBassFingered - toEnum 34 = ElectricBassPicked - toEnum 35 = FretlessBass - toEnum 36 = SlapBass1 - toEnum 37 = SlapBass2 - toEnum 38 = SynthBass1 - toEnum 39 = SynthBass2 - toEnum 40 = Violin - toEnum 41 = Viola - toEnum 42 = Cello - toEnum 43 = Contrabass - toEnum 44 = TremoloStrings - toEnum 45 = PizzicatoStrings - toEnum 46 = OrchestralHarp - toEnum 47 = Timpani - toEnum 48 = StringEnsemble1 - toEnum 49 = StringEnsemble2 - toEnum 50 = SynthStrings1 - toEnum 51 = SynthStrings2 - toEnum 52 = ChoirAahs - toEnum 53 = VoiceOohs - toEnum 54 = SynthVoice - toEnum 55 = OrchestraHit - toEnum 56 = Trumpet - toEnum 57 = Trombone - toEnum 58 = Tuba - toEnum 59 = MutedTrumpet - toEnum 60 = FrenchHorn - toEnum 61 = BrassSection - toEnum 62 = SynthBrass1 - toEnum 63 = SynthBrass2 - toEnum 64 = SopranoSax - toEnum 65 = AltoSax - toEnum 66 = TenorSax - toEnum 67 = BaritoneSax - toEnum 68 = Oboe - toEnum 69 = EnglishHorn - toEnum 70 = Bassoon - toEnum 71 = Clarinet - toEnum 72 = Piccolo - toEnum 73 = Flute - toEnum 74 = Recorder - toEnum 75 = PanFlute - toEnum 76 = BlownBottle - toEnum 77 = Shakuhachi - toEnum 78 = Whistle - toEnum 79 = Ocarina - toEnum 80 = Lead1Square - toEnum 81 = Lead2Sawtooth - toEnum 82 = Lead3Calliope - toEnum 83 = Lead4Chiff - toEnum 84 = Lead5Charang - toEnum 85 = Lead6Voice - toEnum 86 = Lead7Fifths - toEnum 87 = Lead8BassLead - toEnum 88 = Pad1NewAge - toEnum 89 = Pad2Warm - toEnum 90 = Pad3Polysynth - toEnum 91 = Pad4Choir - toEnum 92 = Pad5Bowed - toEnum 93 = Pad6Metallic - toEnum 94 = Pad7Halo - toEnum 95 = Pad8Sweep - toEnum 96 = FX1Train - toEnum 97 = FX2Soundtrack - toEnum 98 = FX3Crystal - toEnum 99 = FX4Atmosphere - toEnum 100 = FX5Brightness - toEnum 101 = FX6Goblins - toEnum 102 = FX7Echoes - toEnum 103 = FX8SciFi - toEnum 104 = Sitar - toEnum 105 = Banjo - toEnum 106 = Shamisen - toEnum 107 = Koto - toEnum 108 = Kalimba - toEnum 109 = Bagpipe - toEnum 110 = Fiddle - toEnum 111 = Shanai - toEnum 112 = TinkleBell - toEnum 113 = Agogo - toEnum 114 = SteelDrums - toEnum 115 = Woodblock - toEnum 116 = TaikoDrum - toEnum 117 = MelodicDrum - toEnum 118 = SynthDrum - toEnum 119 = ReverseCymbal - toEnum 120 = GuitarFretNoise - toEnum 121 = BreathNoise - toEnum 122 = Seashore - toEnum 123 = BirdTweet - toEnum 124 = TelephoneRing - toEnum 125 = Helicopter - toEnum 126 = Applause - toEnum 127 = Gunshot - toEnum n = error $ "toEnum: " ++ show n ++ " is not implemented for InstrumentName" +{-# LINE 9 "GeneralMidi.lhs" #-} +-- This code was automatically generated by lhs2tex --code, from the file +-- HSoM/GeneralMidi.lhs. (See HSoM/MakeCode.bat.) +{-# LINE 16 "GeneralMidi.lhs" #-} +module Euterpea.IO.MIDI.GeneralMidi where +import Euterpea.Music (InstrumentName(..)) + +fromGM :: Int -> InstrumentName +fromGM i | i >= 0 && i <= 127 = toEnum i +fromGM i = error $ "fromGMNo: " ++ show i ++ + " is not a valid General Midi Number" +toGM :: InstrumentName -> Int +toGM Percussion = 0 +toGM (CustomInstrument name) = 0 +toGM i = fromEnum i + +instance Enum InstrumentName where + fromEnum AcousticGrandPiano = 0 + fromEnum BrightAcousticPiano = 1 + fromEnum ElectricGrandPiano = 2 + fromEnum HonkyTonkPiano = 3 + fromEnum RhodesPiano = 4 + fromEnum ChorusedPiano = 5 + fromEnum Harpsichord = 6 + fromEnum Clavinet = 7 + fromEnum Celesta = 8 + fromEnum Glockenspiel = 9 + fromEnum MusicBox = 10 + fromEnum Vibraphone = 11 + fromEnum Marimba = 12 + fromEnum Xylophone = 13 + fromEnum TubularBells = 14 + fromEnum Dulcimer = 15 + fromEnum HammondOrgan = 16 + fromEnum PercussiveOrgan = 17 + fromEnum RockOrgan = 18 + fromEnum ChurchOrgan = 19 + fromEnum ReedOrgan = 20 + fromEnum Accordion = 21 + fromEnum Harmonica = 22 + fromEnum TangoAccordion = 23 + fromEnum AcousticGuitarNylon = 24 + fromEnum AcousticGuitarSteel = 25 + fromEnum ElectricGuitarJazz = 26 + fromEnum ElectricGuitarClean = 27 + fromEnum ElectricGuitarMuted = 28 + fromEnum OverdrivenGuitar = 29 + fromEnum DistortionGuitar = 30 + fromEnum GuitarHarmonics = 31 + fromEnum AcousticBass = 32 + fromEnum ElectricBassFingered = 33 + fromEnum ElectricBassPicked = 34 + fromEnum FretlessBass = 35 + fromEnum SlapBass1 = 36 + fromEnum SlapBass2 = 37 + fromEnum SynthBass1 = 38 + fromEnum SynthBass2 = 39 + fromEnum Violin = 40 + fromEnum Viola = 41 + fromEnum Cello = 42 + fromEnum Contrabass = 43 + fromEnum TremoloStrings = 44 + fromEnum PizzicatoStrings = 45 + fromEnum OrchestralHarp = 46 + fromEnum Timpani = 47 + fromEnum StringEnsemble1 = 48 + fromEnum StringEnsemble2 = 49 + fromEnum SynthStrings1 = 50 + fromEnum SynthStrings2 = 51 + fromEnum ChoirAahs = 52 + fromEnum VoiceOohs = 53 + fromEnum SynthVoice = 54 + fromEnum OrchestraHit = 55 + fromEnum Trumpet = 56 + fromEnum Trombone = 57 + fromEnum Tuba = 58 + fromEnum MutedTrumpet = 59 + fromEnum FrenchHorn = 60 + fromEnum BrassSection = 61 + fromEnum SynthBrass1 = 62 + fromEnum SynthBrass2 = 63 + fromEnum SopranoSax = 64 + fromEnum AltoSax = 65 + fromEnum TenorSax = 66 + fromEnum BaritoneSax = 67 + fromEnum Oboe = 68 + fromEnum EnglishHorn = 69 + fromEnum Bassoon = 70 + fromEnum Clarinet = 71 + fromEnum Piccolo = 72 + fromEnum Flute = 73 + fromEnum Recorder = 74 + fromEnum PanFlute = 75 + fromEnum BlownBottle = 76 + fromEnum Shakuhachi = 77 + fromEnum Whistle = 78 + fromEnum Ocarina = 79 + fromEnum Lead1Square = 80 + fromEnum Lead2Sawtooth = 81 + fromEnum Lead3Calliope = 82 + fromEnum Lead4Chiff = 83 + fromEnum Lead5Charang = 84 + fromEnum Lead6Voice = 85 + fromEnum Lead7Fifths = 86 + fromEnum Lead8BassLead = 87 + fromEnum Pad1NewAge = 88 + fromEnum Pad2Warm = 89 + fromEnum Pad3Polysynth = 90 + fromEnum Pad4Choir = 91 + fromEnum Pad5Bowed = 92 + fromEnum Pad6Metallic = 93 + fromEnum Pad7Halo = 94 + fromEnum Pad8Sweep = 95 + fromEnum FX1Train = 96 + fromEnum FX2Soundtrack = 97 + fromEnum FX3Crystal = 98 + fromEnum FX4Atmosphere = 99 + fromEnum FX5Brightness = 100 + fromEnum FX6Goblins = 101 + fromEnum FX7Echoes = 102 + fromEnum FX8SciFi = 103 + fromEnum Sitar = 104 + fromEnum Banjo = 105 + fromEnum Shamisen = 106 + fromEnum Koto = 107 + fromEnum Kalimba = 108 + fromEnum Bagpipe = 109 + fromEnum Fiddle = 110 + fromEnum Shanai = 111 + fromEnum TinkleBell = 112 + fromEnum Agogo = 113 + fromEnum SteelDrums = 114 + fromEnum Woodblock = 115 + fromEnum TaikoDrum = 116 + fromEnum MelodicDrum = 117 + fromEnum SynthDrum = 118 + fromEnum ReverseCymbal = 119 + fromEnum GuitarFretNoise = 120 + fromEnum BreathNoise = 121 + fromEnum Seashore = 122 + fromEnum BirdTweet = 123 + fromEnum TelephoneRing = 124 + fromEnum Helicopter = 125 + fromEnum Applause = 126 + fromEnum Gunshot = 127 + fromEnum i = error $ "fromEnum: " ++ show i ++ " is not implemented" + + toEnum 0 = AcousticGrandPiano + toEnum 1 = BrightAcousticPiano + toEnum 2 = ElectricGrandPiano + toEnum 3 = HonkyTonkPiano + toEnum 4 = RhodesPiano + toEnum 5 = ChorusedPiano + toEnum 6 = Harpsichord + toEnum 7 = Clavinet + toEnum 8 = Celesta + toEnum 9 = Glockenspiel + toEnum 10 = MusicBox + toEnum 11 = Vibraphone + toEnum 12 = Marimba + toEnum 13 = Xylophone + toEnum 14 = TubularBells + toEnum 15 = Dulcimer + toEnum 16 = HammondOrgan + toEnum 17 = PercussiveOrgan + toEnum 18 = RockOrgan + toEnum 19 = ChurchOrgan + toEnum 20 = ReedOrgan + toEnum 21 = Accordion + toEnum 22 = Harmonica + toEnum 23 = TangoAccordion + toEnum 24 = AcousticGuitarNylon + toEnum 25 = AcousticGuitarSteel + toEnum 26 = ElectricGuitarJazz + toEnum 27 = ElectricGuitarClean + toEnum 28 = ElectricGuitarMuted + toEnum 29 = OverdrivenGuitar + toEnum 30 = DistortionGuitar + toEnum 31 = GuitarHarmonics + toEnum 32 = AcousticBass + toEnum 33 = ElectricBassFingered + toEnum 34 = ElectricBassPicked + toEnum 35 = FretlessBass + toEnum 36 = SlapBass1 + toEnum 37 = SlapBass2 + toEnum 38 = SynthBass1 + toEnum 39 = SynthBass2 + toEnum 40 = Violin + toEnum 41 = Viola + toEnum 42 = Cello + toEnum 43 = Contrabass + toEnum 44 = TremoloStrings + toEnum 45 = PizzicatoStrings + toEnum 46 = OrchestralHarp + toEnum 47 = Timpani + toEnum 48 = StringEnsemble1 + toEnum 49 = StringEnsemble2 + toEnum 50 = SynthStrings1 + toEnum 51 = SynthStrings2 + toEnum 52 = ChoirAahs + toEnum 53 = VoiceOohs + toEnum 54 = SynthVoice + toEnum 55 = OrchestraHit + toEnum 56 = Trumpet + toEnum 57 = Trombone + toEnum 58 = Tuba + toEnum 59 = MutedTrumpet + toEnum 60 = FrenchHorn + toEnum 61 = BrassSection + toEnum 62 = SynthBrass1 + toEnum 63 = SynthBrass2 + toEnum 64 = SopranoSax + toEnum 65 = AltoSax + toEnum 66 = TenorSax + toEnum 67 = BaritoneSax + toEnum 68 = Oboe + toEnum 69 = EnglishHorn + toEnum 70 = Bassoon + toEnum 71 = Clarinet + toEnum 72 = Piccolo + toEnum 73 = Flute + toEnum 74 = Recorder + toEnum 75 = PanFlute + toEnum 76 = BlownBottle + toEnum 77 = Shakuhachi + toEnum 78 = Whistle + toEnum 79 = Ocarina + toEnum 80 = Lead1Square + toEnum 81 = Lead2Sawtooth + toEnum 82 = Lead3Calliope + toEnum 83 = Lead4Chiff + toEnum 84 = Lead5Charang + toEnum 85 = Lead6Voice + toEnum 86 = Lead7Fifths + toEnum 87 = Lead8BassLead + toEnum 88 = Pad1NewAge + toEnum 89 = Pad2Warm + toEnum 90 = Pad3Polysynth + toEnum 91 = Pad4Choir + toEnum 92 = Pad5Bowed + toEnum 93 = Pad6Metallic + toEnum 94 = Pad7Halo + toEnum 95 = Pad8Sweep + toEnum 96 = FX1Train + toEnum 97 = FX2Soundtrack + toEnum 98 = FX3Crystal + toEnum 99 = FX4Atmosphere + toEnum 100 = FX5Brightness + toEnum 101 = FX6Goblins + toEnum 102 = FX7Echoes + toEnum 103 = FX8SciFi + toEnum 104 = Sitar + toEnum 105 = Banjo + toEnum 106 = Shamisen + toEnum 107 = Koto + toEnum 108 = Kalimba + toEnum 109 = Bagpipe + toEnum 110 = Fiddle + toEnum 111 = Shanai + toEnum 112 = TinkleBell + toEnum 113 = Agogo + toEnum 114 = SteelDrums + toEnum 115 = Woodblock + toEnum 116 = TaikoDrum + toEnum 117 = MelodicDrum + toEnum 118 = SynthDrum + toEnum 119 = ReverseCymbal + toEnum 120 = GuitarFretNoise + toEnum 121 = BreathNoise + toEnum 122 = Seashore + toEnum 123 = BirdTweet + toEnum 124 = TelephoneRing + toEnum 125 = Helicopter + toEnum 126 = Applause + toEnum 127 = Gunshot + toEnum n = error $ "toEnum: " ++ show n ++ " is not implemented for InstrumentName" diff --git a/Euterpea/IO/MIDI/MEvent.lhs b/Euterpea/IO/MIDI/MEvent.lhs new file mode 100644 --- /dev/null +++ b/Euterpea/IO/MIDI/MEvent.lhs @@ -0,0 +1,115 @@ +-- ========================================================================================== +-- Conversion to MEvent datatype + +> module Euterpea.IO.MIDI.MEvent where +> import Euterpea.Music + +> data MEvent = MEvent { +> eTime :: PTime, -- onset time +> eInst :: InstrumentName, -- instrument +> ePitch :: AbsPitch, -- pitch number +> eDur :: DurT, -- note duration +> eVol :: Volume, -- volume +> eParams :: [Double]} -- optional other parameters +> deriving (Show,Eq,Ord) + +> type Performance = [MEvent] + +> 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 MContext = MContext {mcTime :: PTime, +> mcInst :: InstrumentName, +> mcDur :: DurT, +> mcVol :: Volume} +> deriving Show + +> perform :: (ToMusic1 a) => Music a -> Performance +> perform = perform1 . toMusic1 + +> perform1 :: Music1 -> Performance +> perform1 = fst . perform1Dur + +> perform1Dur :: Music1 -> (Performance, DurT) +> perform1Dur = musicToMEvents defCon . applyControls where +> defCon = MContext {mcTime = 0, mcInst = AcousticGrandPiano, mcDur = metro 120 qn, mcVol=127} +> -- timing musicToMEventss +> metro :: Int -> Dur -> DurT +> metro setting dur = 60 / (fromIntegral setting * dur) +> applyControls :: Music1 -> Music1 +> applyControls (Modify (Tempo r) m) = scaleDurations r $ applyControls m +> applyControls (Modify (Transpose k) m) = shiftPitches1 k $ applyControls m +> applyControls (m1 :+: m2) = applyControls m1 :+: applyControls m2 +> applyControls (m1 :=: m2) = applyControls m1 :=: applyControls m2 +> applyControls x = x + +> musicToMEvents :: MContext -> Music1 -> (Performance, DurT) +> musicToMEvents c@MContext{mcTime=t, mcDur=dt} (Prim (Note d p)) = ([noteToMEvent c d p], d*dt) +> musicToMEvents c@MContext{mcTime=t, mcDur=dt} (Prim (Rest d)) = ([], d*dt) +> musicToMEvents c@MContext{mcTime=t, mcDur=dt} (m1 :+: m2) = +> let (evs1, d1) = musicToMEvents c m1 +> (evs2, d2) = musicToMEvents c{mcTime = t+d1} m2 +> in (evs1 ++ evs2, d1+d2) +> musicToMEvents c@MContext{mcTime=t, mcDur=dt} (m1 :=: m2) = +> let (evs1, d1) = musicToMEvents c m1 +> (evs2, d2) = musicToMEvents c m2 +> in (merge evs1 evs2, max d1 d2) +> musicToMEvents c (Modify (Instrument i) m) = musicToMEvents c{mcInst=i} m +> musicToMEvents c (Modify (Phrase pas) m) = phraseToMEvents c pas m +> musicToMEvents c (Modify x m) = musicToMEvents c m -- Transpose and Tempo addressed by applyControls + +> noteToMEvent :: MContext -> Dur -> (Pitch, [NoteAttribute]) -> MEvent +> noteToMEvent c@(MContext ct ci cdur cvol) d (p, nas) = +> let e0 = MEvent{eTime=ct, ePitch=absPitch p, eInst=ci, eDur=d*cdur, eVol=cvol, eParams=[]} +> in foldr nasFun e0 nas where +> nasFun :: NoteAttribute -> MEvent -> MEvent +> nasFun (Volume v) ev = ev {eVol = v} +> nasFun (Params pms) ev = ev {eParams = pms} +> nasFun _ ev = ev + +> phraseToMEvents :: MContext -> [PhraseAttribute] -> Music1 -> (Performance, DurT) +> phraseToMEvents c [] m = musicToMEvents c m +> phraseToMEvents c@MContext{mcTime=t, mcInst=i, mcDur=dt} (pa:pas) m = +> let pfd@(pf,dur) = phraseToMEvents c pas m +> loud x = phraseToMEvents 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) -> phraseToMEvents c{mcVol = 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 -- not supported +> Orn _ -> pfd -- not supported diff --git a/Euterpea/IO/MIDI/Play.lhs b/Euterpea/IO/MIDI/Play.lhs new file mode 100644 --- /dev/null +++ b/Euterpea/IO/MIDI/Play.lhs @@ -0,0 +1,325 @@ +> module Euterpea.IO.MIDI.Play ( +> play -- standard playback, allows infinite values +> ,playDev -- play to a custom device, allows infinite values +> ,playS -- play with strict timing (finite values only) +> ,playDevS -- play to a custom device with strict timing (finite values only) +> ,playC -- custom playback implementation to replace playA, playS, playDev, etc. +> ,devices -- function that prints available MIDI device information +> ,musicToMsgs' -- music to MIDI message conversion +> ,linearCP -- linear channel assignment policy +> ,dynamicCP -- dynamic channel assignment policy +> ,predefinedCP -- user-specified channel map (for MUIs) +> ,defParams +> ,playM' +> ,PlayParams(..) +> ,ChannelMapFun +> ,ChannelMap +> ) where + +> import Codec.Midi hiding (Tempo) +> import Control.DeepSeq +> import Control.Monad +> import Control.Concurrent +> import Control.Exception +> import Data.List +> import Euterpea.IO.MIDI.MidiIO +> import Euterpea.IO.MIDI.ToMidi +> import Euterpea.IO.MIDI.MEvent +> import Euterpea.Music +> import Sound.PortMidi + +-------------------------- + | User-Level Functions | +-------------------------- + +Playback parameter data type. + +> data PlayParams = PlayParams{ +> strict :: Bool, -- strict timing (False for infinite values) +> chanPolicy :: ChannelMapFun, -- channel assignment policy +> devID :: Maybe OutputDeviceID, -- output device (Nothing means to use the OS default) +> closeDelay :: Time, -- offset in seconds to avoid truncated notes +> perfAlg :: Music1 -> [MEvent] +> } + +Default parameters are the default pmap+context, allowing for infinite playback, +using a linear channel assignment policy for 16 channels with percussion on +channel 9 (which is channel 10 when indexing from 1), using the default MIDI +device as set by the operating system, and using a closing offset of 1.0sec. + +> defParams = PlayParams False (linearCP 16 9) Nothing 1.0 perform1 + +New implementation of play using default parameters: + +> play :: (ToMusic1 a, NFData a) => Music a -> IO () +> play = playC defParams + +> playS :: (ToMusic1 a, NFData a) => Music a -> IO () +> playS = playC defParams{strict=True} + +> playDev :: (ToMusic1 a, NFData a) => Int -> Music a -> IO () +> playDev i = playC defParams{devID = Just $ unsafeOutputID i} + +> playDevS :: (ToMusic1 a, NFData a) => Int -> Music a -> IO() +> playDevS i = playC defParams{strict=True, devID = Just $ unsafeOutputID i} + +"Custom play" interface: + +> playC :: (ToMusic1 a, NFData a) => PlayParams -> Music a -> IO () +> playC p = if strict p then playStrict p else playInf p + +Getting a list of all MIDI input and output devices, showing both +their device IDs and names. + +> devices = do +> (devsIn, devsOut) <- getAllDevices +> let f (devid, devname) = " "++show devid ++ "\t" ++ name devname ++ "\n" +> strIn = concatMap f devsIn +> strOut = concatMap f devsOut +> putStrLn "\nInput devices: " >> putStrLn strIn +> putStrLn "Output devices: " >> putStrLn strOut + + +------------------------------------ + | Supporting functions for playC | +------------------------------------ + +Strict playback: timing will be as close to perfect as possible, but the +Music value must be finite. Timing will be correct starting from the first +note, even if there is a long computation offset prior to any sound. + +> playStrict :: (ToMusic1 a, NFData a) => PlayParams -> Music a -> IO () +> playStrict p m = m `deepseq` +> let x = toMidi (perfAlg p $ toMusic1 m) +> in x `deepseq` playM' (devID p) x + +> playM' :: Maybe OutputDeviceID -> Midi -> IO () +> playM' devID midi = handleCtrlC $ do +> initialize +> (maybe (defaultOutput playMidi) playMidi devID) midi +> terminate +> return () where +> handleCtrlC :: IO a -> IO a +> handleCtrlC op = onException op terminate + + +Infinite playback: arbitrarily long music values can be played, although +with the compromise that timing may be imperfect due to lazy evaluation of +the Music value. Delays may happen if a section of the Music value is time- +consuming to compute. Infinite parallelism is not supported. + +> playInf :: ToMusic1 a => PlayParams -> Music a -> IO () +> playInf p m = handleCtrlC $ do +> initializeMidi +> (maybe (defaultOutput playRec) playRec (devID p)) $ musicToMsgs' p m +> threadDelay $ round (closeDelay p * 1000000) +> terminateMidi +> return () where +> handleCtrlC :: IO a -> IO a +> handleCtrlC op = onException op terminateMidi + +> playRec dev [] = return () +> playRec dev (x@(t,m):ms) = +> if t > 0 then threadDelay (toMicroSec t) >> playRec dev ((0,m):ms) else +> let mNow = x : takeWhile ((<=0).fst) ms +> mLater = drop (length mNow - 1) ms +> in doMidiOut dev (Just $ mNow) >> playRec dev mLater where +> doMidiOut dev Nothing = outputMidi dev +> doMidiOut dev (Just ms) = do +> outputMidi dev +> mapM_ (\(t,m) -> deliverMidiEvent dev (0, m)) ms +> toMicroSec x = round (x * 1000000) + + +--------------------------------- + | Music to Message conversion | +--------------------------------- + +Music to message conversion will take place differently depending +on the channel assignment method. Using linearCP will assign the first +n instruments to channels 0 through n-1 (or 1 through n). Using +dynamicCP will fill up n channels and then replace the last-used +instrument's channel with the new instrument. + +Some synthesizers only recognize 10 unique channels, others use the +full 16 allowed by general MIDI. Drums are usually on channel 9 +(channel 10 when indexing from 1), but not always. Sometimes drums +can be assigned to a custom channel. + +A ChannelMap stores which instrument is assigned to which channel. +This table is built automatically when playing a Music value; the +user does not need to worry about constructing it. + +> type ChannelMap = [(InstrumentName, Channel)] + +Given an InstrumentName and a ChannelMap, a ChannelMapFun picks a new +channel to assign to the instrument and retruns both that and the +updated ChannelMap. This is done each time a new InstrumentName is +encountered (in other words, it is not in the current ChannelMap). + +> type ChannelMapFun = InstrumentName -> ChannelMap -> (Channel, ChannelMap) + +The function below first converts to ANote values and then to Std On/Off +pairs. This is needed to avoid timing issues associated with using ANote +and trying to call terminateMIDI, since if there is an ANote at the end +it will sometimes have its NoteOff lost, which can cause errors. + +> musicToMsgs' :: (ToMusic1 a) => PlayParams -> Music a -> [(Time, MidiMessage)] +> musicToMsgs' p m = +> let perf = perfAlg p $ toMusic1 m -- obtain the performance +> evsA = channelMap (chanPolicy p) [] perf -- time-stamped ANote values +> evs = stdMerge evsA -- merged On/Off events sorted by absolute time +> times = map fst evs -- absolute times in seconds +> newTimes = zipWith subtract (head times : times) times -- relative times +> in zip newTimes (map snd evs) where +> -- stdMerge: converts ANotes into a sorted list of On/Off events +> stdMerge :: [(Time, MidiMessage)] -> [(Time, MidiMessage)] +> stdMerge [] = [] +> stdMerge ((t,ANote c k v d):es) = +> (t, Std $ NoteOn c k v) : +> stdMerge (insertBy (\(a,b) (x,y) -> compare a x) (t+d, Std $ NoteOff c k v) es) +> stdMerge (e1:es) = e1 : stdMerge es +> -- channelMap: performs instrument assignment for a list of Events +> channelMap :: ChannelMapFun -> ChannelMap -> [MEvent] -> [(Time, MidiMessage)] +> channelMap cf cMap [] = [] +> channelMap cf cMap (e:es) = +> let i = eInst e +> ((chan, cMap'), newI) = case lookup i cMap of Nothing -> (cf i cMap, True) +> Just x -> ((x, cMap), False) +> e' = (fromRational (eTime e), +> ANote chan (ePitch e) (eVol e) (fromRational $ eDur e)) +> es' = channelMap cf cMap' es +> iNum = if i==Percussion then 0 else fromEnum i +> in if newI then (fst e', Std $ ProgramChange chan iNum) : e' : es' +> else e' : es' + +The linearCP channel map just fills up channels left to right until it hits +the maximum number and then throws an error. Percussion is handled as a +special case. + +> type NumChannels = Int -- maximum number of channels (i.e. 0-15 is 16 channels) +> type PercChan = Int -- percussion channel, using indexing from zero + +> linearCP :: NumChannels -> PercChan -> ChannelMapFun +> linearCP cLim pChan i cMap = if i==Percussion then (pChan, (i,pChan):cMap) else +> let n = length $ filter ((/=Percussion). fst) cMap +> newChan = if n>=pChan then n+1 else n -- step over the percussion channel +> in if newChan < cLim then (newChan, (i, newChan) : cMap) else +> error ("Cannot use more than "++show cLim++" instruments.") + +For the dynamicCP channel map, new assignements are added in the left side +of the channel map/list. This means that the item farthest to the right +is the oldest and should be replaced when the table is full. Percussion +is handled separately. + +> dynamicCP :: NumChannels -> PercChan -> ChannelMapFun +> dynamicCP cLim pChan i cMap = +> if i==Percussion then (pChan, (i, pChan):cMap) else +> let cMapNoP = filter ((/=Percussion). fst) cMap +> extra = if length cMapNoP == length cMap then [] else [(Percussion, pChan)] +> newChan = snd $ last cMapNoP +> in if length cMapNoP < cLim - 1 then linearCP cLim pChan i cMap +> else (newChan, (i, newChan) : (take (length cMapNoP - 1) cMapNoP)++extra) + + +A predefined policy will send instruments to user-defined channels. If new +instruments are found that are not accounted for, an error is thrown. + +> predefinedCP :: ChannelMap -> ChannelMapFun +> predefinedCP cMapFixed i _ = case lookup i cMapFixed of +> Nothing -> error (show i ++ " is not included in the channel map.") +> Just c -> (c, cMapFixed) + +------------------------------- + | NFData instances for Midi | +------------------------------- + +> instance NFData FileType where +> rnf x = () + +> instance NFData TimeDiv where +> rnf (TicksPerBeat i) = rnf i +> rnf (TicksPerSecond i j) = rnf j `seq` rnf i + +> instance NFData Midi where +> rnf (Midi ft td ts) = rnf ft `seq` rnf td `seq` rnf ts + +> instance NFData Message where +> rnf (NoteOff c k v) = rnf c `seq` rnf k `seq` rnf v +> rnf (NoteOn c k v) = rnf c `seq` rnf k `seq` rnf v +> rnf (KeyPressure c k v) = rnf c `seq` rnf k `seq` rnf v +> rnf (ProgramChange c v) = rnf c `seq` rnf v +> rnf (ChannelPressure c v) = rnf c `seq` rnf v +> rnf (PitchWheel c v) = rnf c `seq` rnf v +> rnf (TempoChange t) = rnf t +> rnf x = () -- no other message types are currently used by Euterpea + +> instance NFData MidiMessage where +> rnf (Std m) = rnf m +> rnf (ANote c k v d) = rnf c `seq` rnf k `seq` rnf v `seq` rnf d + + +-------------------------------- + | NFData instances for Music | +-------------------------------- + +> instance NFData a => NFData (Music a) where +> rnf (a :+: b) = rnf a `seq` rnf b +> rnf (a :=: b) = rnf a `seq` rnf b +> rnf (Prim p) = rnf p +> rnf (Modify c m) = rnf c `seq` rnf m + +> instance NFData a => NFData (Primitive a) where +> rnf (Note d a) = rnf d `seq` rnf a +> rnf (Rest d) = rnf d + +> instance NFData Control where +> rnf (Tempo t) = rnf t +> rnf (Transpose t) = rnf t +> rnf (Instrument i) = rnf i +> rnf (Phrase xs) = rnf xs +> rnf (Custom s) = rnf s +> rnf (KeySig r m) = rnf r `seq` rnf m + +> instance NFData PitchClass where +> rnf p = () + +> instance NFData Mode where +> rnf x = () + +> instance NFData PhraseAttribute where +> rnf (Dyn d) = rnf d +> rnf (Tmp t) = rnf t +> rnf (Art a) = rnf a +> rnf (Orn o) = rnf o + +> instance NFData Dynamic where +> rnf (Accent r) = rnf r +> rnf (Crescendo r) = rnf r +> rnf (Diminuendo r) = rnf r +> rnf (StdLoudness x) = rnf x +> rnf (Loudness r) = rnf r + +> instance NFData StdLoudness where +> rnf x = () + +> instance NFData Articulation where +> rnf (Staccato r) = rnf r +> rnf (Legato r) = rnf r +> rnf x = () + +> instance NFData Ornament where +> rnf x = () + +> instance NFData Tempo where +> rnf (Ritardando r) = rnf r +> rnf (Accelerando r) = rnf r + +> instance NFData InstrumentName where +> rnf x = () + +> instance NFData NoteAttribute where +> rnf (Volume v) = rnf v +> rnf (Fingering f) = rnf f +> rnf (Dynamics d) = rnf d +> rnf (Params p) = rnf p diff --git a/Euterpea/IO/MIDI/ToMidi.hs b/Euterpea/IO/MIDI/ToMidi.hs deleted file mode 100644 --- a/Euterpea/IO/MIDI/ToMidi.hs +++ /dev/null @@ -1,167 +0,0 @@ -{-# LINE 8 "ToMidi.lhs" #-} --- This code was automatically generated by lhs2tex --code, from the file --- HSoM/ToMidi.lhs. (See HSoM/MakeCode.bat.) -{-# LINE 18 "ToMidi.lhs" #-} -module Euterpea.IO.MIDI.ToMidi(toMidi, UserPatchMap, defST, - defUpm, testMidi, testMidiA, - test, testA, writeMidi, writeMidiA, - play, playM, playA, - makeMidi, mToMF, gmUpm, gmTest) where - -import Euterpea.Music.Note.Music -import Euterpea.Music.Note.MoreMusic -import Euterpea.Music.Note.Performance -import Euterpea.IO.MIDI.GeneralMidi -import Euterpea.IO.MIDI.MidiIO -import Euterpea.IO.MIDI.ExportMidiFile -import Sound.PortMidi -import Data.List(partition) -import Data.Char(toLower,toUpper) -import Codec.Midi -{-# LINE 136 "ToMidi.lhs" #-} -type ProgNum = Int -{-# LINE 170 "ToMidi.lhs" #-} -type UserPatchMap = [(InstrumentName, Channel)] -{-# LINE 197 "ToMidi.lhs" #-} -makeGMMap :: [InstrumentName] -> UserPatchMap -makeGMMap ins = mkGMMap 0 ins - where mkGMMap _ [] = [] - mkGMMap n _ | n>=15 = - error "MakeGMMap: Too many instruments." - mkGMMap n (Percussion : ins) = - (Percussion, 9) : mkGMMap n ins - mkGMMap n (i : ins) = - (i, chanList !! n) : mkGMMap (n+1) ins - chanList = [0..8] ++ [10..15] -- channel 9 is for percussion -{-# LINE 219 "ToMidi.lhs" #-} -upmLookup :: UserPatchMap -> InstrumentName - -> (Channel, ProgNum) -upmLookup upm iName = (chan, toGM iName) - where chan = maybe (error ( "instrument " ++ show iName ++ - " not in patch map") ) - id (lookup iName upm) -{-# LINE 371 "ToMidi.lhs" #-} -toMidi :: Performance -> UserPatchMap -> Midi -toMidi pf upm = - let split = splitByInst pf - insts = map fst split - rightMap = if (allValid upm insts) then upm - else (makeGMMap insts) - in Midi (if length split == 1 then SingleTrack - else MultiTrack) - (TicksPerBeat division) - (map (fromAbsTime . performToMEvs rightMap) split) - -division = 96 :: Int -{-# LINE 388 "ToMidi.lhs" #-} -allValid :: UserPatchMap -> [InstrumentName] -> Bool -allValid upm = and . map (lookupB upm) - -lookupB :: UserPatchMap -> InstrumentName -> Bool -lookupB upm x = or (map ((== x) . fst) upm) -{-# LINE 401 "ToMidi.lhs" #-} -splitByInst :: Performance -> [(InstrumentName,Performance)] -splitByInst [] = [] -splitByInst pf = (i, pf1) : splitByInst pf2 - where i = eInst (head pf) - (pf1, pf2) = partition (\e -> eInst e == i) pf -{-# LINE 430 "ToMidi.lhs" #-} -type MEvent = (Ticks, Message) - -defST = 500000 - -performToMEvs :: UserPatchMap - -> (InstrumentName, Performance) - -> [MEvent] -performToMEvs upm (inm, pf) = - let (chan,progNum) = upmLookup upm inm - setupInst = (0, ProgramChange chan progNum) - setTempo = (0, TempoChange defST) - loop [] = [] - loop (e:es) = let (mev1,mev2) = mkMEvents chan e - in mev1 : insertMEvent mev2 (loop es) - in setupInst : setTempo : loop pf -{-# LINE 453 "ToMidi.lhs" #-} -mkMEvents :: Channel -> Event -> (MEvent,MEvent) -mkMEvents mChan (Event { eTime = t, ePitch = p, - eDur = d, eVol = v}) - = ( (toDelta t, NoteOn mChan p v'), - (toDelta (t+d), NoteOff mChan p v') ) - where v' = max 0 (min 127 (fromIntegral v)) - -toDelta t = round (t * 2.0 * fromIntegral division) -{-# LINE 477 "ToMidi.lhs" #-} -insertMEvent :: MEvent -> [MEvent] -> [MEvent] -insertMEvent mev1 [] = [mev1] -insertMEvent mev1@(t1,_) mevs@(mev2@(t2,_):mevs') = - if t1 <= t2 then mev1 : mevs - else mev2 : insertMEvent mev1 mevs' -{-# LINE 558 "ToMidi.lhs" #-} -defUpm :: UserPatchMap -defUpm = [(AcousticGrandPiano,0), - (Marimba,1), - (Vibraphone,2), - (AcousticBass,3), - (Flute,4), - (TenorSax,5), - (AcousticGuitarSteel,6), - (Viola,7), - (StringEnsemble1,8), - (AcousticGrandPiano,9)] - -- the GM name for drums is unimportant, only channel 9 -{-# LINE 579 "ToMidi.lhs" #-} -testMidi :: Performable a => Music a -> Midi -testMidi m = toMidi (defToPerf m) defUpm - -testMidiA :: Performable a => PMap Note1 -> Context Note1 -> Music a -> Midi -testMidiA pm con m = toMidi (toPerf pm con m) defUpm -{-# LINE 590 "ToMidi.lhs" #-} -test :: Performable a => Music a -> IO () -test m = exportMidiFile "test.mid" (testMidi m) - -testA :: Performable a => PMap Note1 -> Context Note1 -> Music a -> IO () -testA pm con m = exportMidiFile "test.mid" (testMidiA pm con m) - -writeMidi :: Performable a => FilePath -> Music a -> IO () -writeMidi fn = exportMidiFile fn . testMidi - -writeMidiA :: Performable a => - FilePath -> PMap Note1 -> Context Note1 -> Music a -> IO () -writeMidiA fn pm con m = exportMidiFile fn (testMidiA pm con m) -{-# LINE 609 "ToMidi.lhs" #-} -play :: Performable a => Music a -> IO () -play = playM . testMidi -{-# LINE 617 "ToMidi.lhs" #-} -playM :: Midi -> IO () -playM midi = do - initialize - (defaultOutput playMidi) midi - terminate - return () -{-# LINE 629 "ToMidi.lhs" #-} -playA :: Performable a => PMap Note1 -> Context Note1 - -> Music a -> IO () -playA pm con m = - let pf = fst $ perfDur pm con m - in playM (toMidi pf defUpm) -{-# LINE 641 "ToMidi.lhs" #-} -makeMidi :: (Music1, Context Note1, UserPatchMap) -> Midi -makeMidi (m,c,upm) = toMidi (perform defPMap c m) upm -{-# LINE 649 "ToMidi.lhs" #-} -mToMF :: PMap a -> Context a -> UserPatchMap -> FilePath -> Music a -> IO () -mToMF pmap c upm fn m = - let pf = perform pmap c m - mf = toMidi pf upm - in exportMidiFile fn mf -{-# LINE 666 "ToMidi.lhs" #-} -gmUpm :: UserPatchMap -gmUpm = map (\n -> (toEnum n, mod n 16 + 1)) [0..127] -{-# LINE 675 "ToMidi.lhs" #-} -gmTest :: Int -> IO () -gmTest i = let gMM = take 8 (drop (i*8) [0..127]) - mu = line (map simple gMM) - simple n = Modify (Instrument (toEnum n)) cMajArp - in mToMF defPMap defCon gmUpm "test.mid" mu - -cMaj = [ n 4 qn | n <- [c,e,g] ] -- octave 4, quarter notes -cMajArp = toMusic1 (line cMaj) diff --git a/Euterpea/IO/MIDI/ToMidi.lhs b/Euterpea/IO/MIDI/ToMidi.lhs new file mode 100644 --- /dev/null +++ b/Euterpea/IO/MIDI/ToMidi.lhs @@ -0,0 +1,123 @@ +> {-# LINE 8 "ToMidi.lhs" #-} + +> module Euterpea.IO.MIDI.ToMidi where + +> import Euterpea.Music +> import Euterpea.IO.MIDI.MEvent +> import Euterpea.IO.MIDI.GeneralMidi +> import Euterpea.IO.MIDI.MidiIO +> import Euterpea.IO.MIDI.ExportMidiFile +> import Sound.PortMidi +> import Data.List(partition) +> import Data.Char(toLower,toUpper) +> import Codec.Midi + +> type ProgNum = Int + +> type UserPatchMap = [(InstrumentName, Channel)] + +> makeGMMap :: [InstrumentName] -> UserPatchMap +> makeGMMap ins = mkGMMap 0 ins +> where mkGMMap _ [] = [] +> mkGMMap n _ | n>=15 = +> error "makeGMMap: too many instruments." +> mkGMMap n (Percussion : ins) = +> (Percussion, 9) : mkGMMap n ins +> mkGMMap n (i : ins) = +> (i, chanList !! n) : mkGMMap (n+1) ins +> chanList = [0..8] ++ [10..15] -- channel 9 is for percussion + +> upmLookup :: UserPatchMap -> InstrumentName +> -> (Channel, ProgNum) +> upmLookup upm iName = (chan, toGM iName) +> where chan = maybe (error ( "instrument " ++ show iName ++ +> " not in patch map") ) +> id (lookup iName upm) + +> toMidi :: [MEvent] -> Midi +> toMidi = toMidiUPM defUpm + +> toMidiUPM :: UserPatchMap -> [MEvent] -> Midi +> toMidiUPM upm pf = +> let split = splitByInst pf +> insts = map fst split +> rightMap = if (allValid upm insts) then upm +> else (makeGMMap insts) +> in Midi (if length split == 1 then SingleTrack +> else MultiTrack) +> (TicksPerBeat division) +> (map (fromAbsTime . mevsToMessages rightMap) split) + +> division = 96 :: Int + +> allValid :: UserPatchMap -> [InstrumentName] -> Bool +> allValid upm = and . map (lookupB upm) + +> lookupB :: UserPatchMap -> InstrumentName -> Bool +> lookupB upm x = or (map ((== x) . fst) upm) + +> splitByInst :: [MEvent] -> [(InstrumentName, [MEvent])] +> splitByInst [] = [] +> splitByInst pf = (i, pf1) : splitByInst pf2 +> where i = eInst (head pf) +> (pf1, pf2) = partition (\e -> eInst e == i) pf + +> type MidiEvent = (Ticks, Message) + +> defST = 500000 + +> mevsToMessages :: UserPatchMap +> -> (InstrumentName, [MEvent]) +> -> [MidiEvent] +> mevsToMessages upm (inm, pf) = +> let (chan,progNum) = upmLookup upm inm +> setupInst = (0, ProgramChange chan progNum) +> setTempo = (0, TempoChange defST) +> loop [] = [] +> loop (e:es) = let (mev1,mev2) = mkMEvents chan e +> in mev1 : insertMEvent mev2 (loop es) +> in setupInst : setTempo : loop pf + + +> mkMEvents :: Channel -> MEvent -> (MidiEvent,MidiEvent) +> mkMEvents mChan (MEvent { eTime = t, ePitch = p, +> eDur = d, eVol = v}) +> = ( (toDelta t, NoteOn mChan p v'), +> (toDelta (t+d), NoteOff mChan p v') ) +> where v' = max 0 (min 127 (fromIntegral v)) + +> toDelta t = round (t * 2.0 * fromIntegral division) + +> insertMEvent :: MidiEvent -> [MidiEvent] -> [MidiEvent] +> insertMEvent mev1 [] = [mev1] +> insertMEvent mev1@(t1,_) mevs@(mev2@(t2,_):mevs') = +> if t1 <= t2 then mev1 : mevs +> else mev2 : insertMEvent mev1 mevs' + +> defUpm :: UserPatchMap +> defUpm = [(AcousticGrandPiano,0), +> (Marimba,1), +> (Vibraphone,2), +> (AcousticBass,3), +> (Flute,4), +> (TenorSax,5), +> (AcousticGuitarSteel,6), +> (Viola,7), +> (StringEnsemble1,8), +> (AcousticGrandPiano,9)] +> -- the GM name for drums is unimportant, only channel 9 + + +> writeMidi :: ToMusic1 a => FilePath -> Music a -> IO () +> writeMidi fn m = exportMidiFile fn $ toMidi $ perform m + + play :: ToMusic1 a => Music a -> IO () + play = playM . toMidi . perform + + playM :: Midi -> IO () + playM midi = do + initialize + (defaultOutput playMidi) midi + terminate + return () + diff --git a/Euterpea/IO/MUI.hs b/Euterpea/IO/MUI.hs deleted file mode 100644 --- a/Euterpea/IO/MUI.hs +++ /dev/null @@ -1,71 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} - -module Euterpea.IO.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 Euterpea.IO.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 - -#if MIN_VERSION_UISF(0,4,0) -asyncV x = asyncVT x -#endif diff --git a/Euterpea/IO/MUI/FFT.hs b/Euterpea/IO/MUI/FFT.hs deleted file mode 100644 --- a/Euterpea/IO/MUI/FFT.hs +++ /dev/null @@ -1,57 +0,0 @@ --- Filename: fft.hs --- Created by: Daniel Winograd-Cort --- Created on: unknown --- Last Modified by: Daniel Winograd-Cort --- Last Modified on: 12/12/2013 - --- This module requires the array and pure-fft packages. - -{-# LANGUAGE Arrows #-} -module Euterpea.IO.MUI.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 - - diff --git a/Euterpea/IO/MUI/Guitar.hs b/Euterpea/IO/MUI/Guitar.hs deleted file mode 100644 --- a/Euterpea/IO/MUI/Guitar.hs +++ /dev/null @@ -1,212 +0,0 @@ -{-# LANGUAGE Arrows, CPP #-} -module Euterpea.IO.MUI.Guitar where -import FRP.UISF hiding ((~++)) -import FRP.UISF.UITypes -import Euterpea.IO.MIDI -import Euterpea.Music.Note.Music hiding (transpose) -import Euterpea.IO.MUI.InstrumentBase -import Euterpea.IO.MUI.MidiWidgets ((~++)) -import qualified Codec.Midi as Midi -import Data.Maybe -import qualified Data.Char as Char - -#if MIN_VERSION_UISF(0,4,0) -import FRP.UISF.Graphics -import FRP.UISF.Widget.Construction -import FRP.UISF.Widget -withColorC = withColor -#else -import qualified FRP.UISF.SOE as SOE -import FRP.UISF.SOE hiding (arc, ellipse) -import qualified FRP.UISF.Widget as W -import FRP.UISF.Widget hiding (pushed, popped, marked) -pushed = let [(to,bo),(ti,bi)] = W.pushed - in (to,ti,bi,bo) -popped = let [(to,bo),(ti,bi)] = W.popped - in (to,ti,bi,bo) -arc ((x,y),(w,h)) = SOE.arc (x,y) (x+w,y+h) -ellipse ((x,y),(w,h)) = SOE.ellipse (x,y) (x+w,y+h) -rectangleFilled = block -withColorC = withColor' -#endif - ---Note, only valid for standard US keyboards: ---Also, this is an ugly hack that can't stay ---it's mostly to test the new key events -toUpper :: Char -> Char -toUpper c = fromMaybe (Char.toUpper c) (lookup c keyMap) - where keyMap = [('`', '~'), ('1', '!'), ('2', '@'), ('3', '#'), ('4', '$'), - ('5', '%'), ('6', '^'), ('7', '&'), ('8', '*'), ('9', '('), - ('0', ')'), ('-', '_'), ('=', '+'), ('[', '{'), (']', '}'), - ('|', '\\'), ('\'', '\"'), (';', ':'), ('/', '?'), ('.', '>'), - (',', '<')] - -isUpper :: Char -> Bool -isUpper c = toUpper c == c - --- first fret's width and height -fw,fh,tw,th :: Int -(fw, fh) = (90, 45) -(tw, th) = (8, 16) - -type KeyType = Int -type GuitarKeyMap = [(String, Pitch, Char)] - --- Draws an individual fret - -#if MIN_VERSION_UISF(0,4,0) -drawFret :: (Color,Color,Color,Color) -> Rect -> Graphic -#endif -drawFret (to,ti,bi,bo) ((x, y), (w, h)) = - withColorC ti (line (x + 1, y + 1) (x + 1, y + h + 1)) // - withColorC bi (line (x + w - 2, y + 1) (x + w - 2, y + h + 1)) // - withColorC to (line (x, y) (x, y + h)) // - withColorC bo (line (x + w - 1, y) (x + w - 1, y + h)) - - --- Draws the string on top of each fret -drawString :: Bool -> Rect -> Graphic -drawString down ((x, y), (w, h)) = - withColor Black (if down then arc ((x,midY-2),(w, 4)) (-180) 180 - else line (x-1, y+ h `div` 2) (x+w, y+h `div` 2)) // - if down then withColor Blue $ ellipse ((midX - d, midY - d), (2*d, 2*d)) else nullGraphic - where d = 10 - midX = x + w `div` 2 - midY = y + h `div` 2 - --- Draws just the guitar head, not interactive - -drawHead :: Int -> UISF () () -drawHead n = topDown $ constA (repeat ()) >>> - concatA (map (mkBasicWidget layout . draw) [n,n-1..1]) >>> - constA () - where draw k ((x,y),(w,h)) = withColor Black $ line (x, y + h `div` 2 + 5 * (3 - k)) (x + w, y + h `div` 2) - layout = makeLayout (Fixed fw) (Fixed fh) - - ---drawHead :: Int -> UISF () () ---drawHead 0 = proc _ -> returnA -< () ---drawHead n = topDown $ proc _ -> do --- ui <- mkBasicWidget layout draw -< () --- ui' <- drawHead (n-1) -< () --- returnA -< () --- where draw ((x,y),(w,h)) = withColor Black $ line (x, y + h `div` 2 + 5 * (3 - n)) (x + w, y + h `div` 2) --- layout = Layout 0 0 fw fh fw fh - --- Given a character to respond to, and which fret it is, draws and displays a single interactive fret - -mkKey :: Char -> KeyType -> UISF KeyData KeyState -mkKey c kt = mkWidget iState d process draw where - iState = (KeyState False False False 127, Nothing) - - d = makeLayout (Fixed minw) (Fixed minh) - (minh, minw) = (fh, fw - kt * 3) - - draw box@((x,y),(w,h)) _ (kb, showNote) = - let isDown = isKeyDown kb - x' = x + (w - tw) `div` 2 + if isDown then 0 else -1 - y' = y + h `div` 5 + (h - th) `div` 2 + if isDown then 0 else -1 - drawNotation s = withColor Red $ text (x' + (1 - length s) * tw `div` 2, y' - th) s - in withColor Blue (text (x', y') [c]) - // maybe nullGraphic drawNotation showNote - // drawString isDown box - // drawFret popped box - - process kd (kb,_) box evt = (kb'', (kb'', notation kd), kb /= kb'') where - kb' = if isJust (pressed kd) then kb { song = fromJust $ pressed kd } else kb - kb'' = case evt of - Key c' ms down -> - if detectKey c' (hasShiftModifier ms) - then kb' { keypad = down, vel = 127 } - else kb' -#if MIN_VERSION_UISF(0,4,0) - Button pt LeftButton down -> -#else - Button pt True down -> -#endif - case (mouse kb', down, pt `inside` box) of - (False, True, True) -> kb' { mouse = True, vel = getVel pt box } - (True, False, True) -> kb' { mouse = False, vel = getVel pt box } - otherwise -> kb' - MouseMove pt -> - if pt `inside` box - then kb' - else kb' { mouse = False } - otherwise -> kb' - where getVel (u,v) ((x,y),(w,h)) = 127 - round (87 * (abs (fromIntegral u - fromIntegral (2 * x + w) / 2) / (fromIntegral w / 2))) - detectKey c' s = toUpper c == toUpper c' && isUpper c == s -- This line should be more robust - --- Makes all of the frets on a string, returning the combined list of their outputs - -mkKeys :: AbsPitch -> [(Char, KeyType, AbsPitch)] -> UISF (Bool, InstrumentData) (SEvent [(AbsPitch, Bool, Midi.Velocity)]) -mkKeys _ [] = proc _ -> returnA -< Nothing -mkKeys free ((c,kt,ap):ckas) = proc (pluck, instr) -> do - msg <- unique <<< mkKey c kt -< getKeyData ap instr - let on = maybe False isKeyPlay msg - ret | pluck = if on then [(ap, True, maybe 127 vel msg)] else [(free, True, 127)] - | otherwise = [(ap, False, maybe 0 vel msg)] - msgs <- mkKeys free ckas -< (pluck, instr) - returnA -< fmap (const ret) msg ~++ msgs - --- Creates the whole string, including the response to the strum key - -mkString :: (String, Pitch, Char) -> UISF InstrumentData (SEvent [(AbsPitch, Bool, Midi.Velocity)]) -mkString (frets, freePitch, p) = leftRight $ proc insData -> do - isPluck <- pluckString p -< () - msgs <- mkKeys freeap (zip3 frets [1..] [freeap+1..]) -< (isPluck, insData) - returnA -< msgs - where freeap = absPitch freePitch - --- Invisible widget that responds to a single character --- There should really be built-in behavior for this sort of thing - -pluckString :: Char -> UISF () Bool -pluckString c = mkWidget False nullLayout process draw where - draw ((x,y),(w,h)) _ down = - let x' = x + (w - tw) `div` 2 + if down then 0 else -1 - y' = y + (h - th) `div` 2 + if down then 0 else -1 - in withColor (if down then White else Black) $ rectangleFilled ((0,0),(10,10)) - - process _ s _ evt = (s', s', s /= s') where - s' = case evt of -#if MIN_VERSION_UISF(0,4,0) - Button pt LeftButton down -> down -#else - Button pt True down -> down -#endif - Key c' _ down -> - down && c == c' - _ -> s - --- Assembles the whole guitar according to a given key map and channel --- Requires a persistent instrument data object to be passed in. --- Any midi messages passed to the guitar will be played on all applicable frets --- Outputs its midi messages as generated by its inputs and user interaction - -guitar :: GuitarKeyMap -> Midi.Channel -> UISF (InstrumentData,EMM) EMM -guitar spcList chn = focusable $ leftRight $ proc (instr, emm) -> do - let emm' = fmap (setChannel chn) emm - h <- drawHead (length spcList) -< () - frets <- mkStrings spcList -< instr { keyPairs = fmap mmToPair emm' } - returnA -< fmap (pairToMsg chn) frets ~++ emm' - where mkStrings [] = proc _ -> returnA -< Nothing - mkStrings (spc:spcs) = topDown $ proc instrData -> do - msg <- mkString spc -< instrData - msgs <- mkStrings spcs -< instrData - returnA -< msg ~++ msgs - --- The default six string keymap. The first in the tuple determines how many frets --- will be displayed and what their activator keys are. The second in the tuple --- is the open pitch (that is, the note that is played when no frets are pressed) --- and the final entry is the strum key. - -string1, string2, string3, string4, string5, string6 :: (String, Pitch, Char) -string6 = ("1qaz__________", (E,5), '\b') -string5 = ("2wsx__________", (B,4), '=') -string4 = ("3edc__________", (G,4), '-') -string3 = ("4rfv__________", (D,4), '0') -string2 = ("5tgb__________", (A,3), '9') -string1 = ("6yhn__________", (E,3), '8') - -sixString :: GuitarKeyMap -sixString = reverse [string1, string2, string3, string4, string5, string6] diff --git a/Euterpea/IO/MUI/InstrumentBase.hs b/Euterpea/IO/MUI/InstrumentBase.hs deleted file mode 100644 --- a/Euterpea/IO/MUI/InstrumentBase.hs +++ /dev/null @@ -1,203 +0,0 @@ -{-# LANGUAGE Arrows #-} -module Euterpea.IO.MUI.InstrumentBase where -import qualified Codec.Midi as Midi -import FRP.UISF hiding ((~++)) -import Data.Maybe -import Control.Monad -import Euterpea.IO.MUI.MidiWidgets (musicToMsgs, (~++)) -import Euterpea.IO.MIDI -import Euterpea.Music.Note.Music hiding (transpose) -import Euterpea.Music.Note.Performance - -type EMM = SEvent [MidiMessage] - --- The KeyData structure is maintained on a per-key basis in each instrument. --- It is usually initialized by a call to getKeyData below -data KeyData = KeyData { - pressed :: Maybe Bool, - notation :: Maybe String, - offset :: Int -} deriving (Show, Eq) - --- KeyState carries the information about whether the key is being pressed or not, --- and carries the information regarding the velocity generated by the last event -data KeyState = KeyState { - keypad:: Bool, - mouse :: Bool, - song :: Bool, - vel :: Midi.Velocity -} deriving (Show, Eq) - --- InstrumentData is a settings structure for the active instrument. It takes in --- a bool that decides whether to show the pitch classes on the instrument, an --- AbsPitch to decide by how much to transpose the instrument, a bool that indicates --- whether a sustain pedal is being held down and a list describing the -data InstrumentData = InstrumentData { - showNotation::Bool, - keyPairs :: Maybe [(AbsPitch, Bool)], - transpose :: AbsPitch, - pedal :: Bool -} deriving (Show, Eq) - --- A simple predicate to determine whether a given key should be displayed as pressed -isKeyDown :: KeyState -> Bool -isKeyDown (KeyState False False False _) = False -isKeyDown _ = True - --- A simple predicate to determine whether a given key is being pressed by the user -isKeyPlay :: KeyState -> Bool -isKeyPlay (KeyState False False _ _) = False -isKeyPlay _ = True - --- A neutral InstrumentData structure. -defaultInstrumentData :: InstrumentData -defaultInstrumentData = InstrumentData False Nothing 0 False - ------------------------------ --- INSTRUMENT DATA WIDGETS -- ------------------------------ - --- Notation Widget -addNotation :: UISF InstrumentData InstrumentData -addNotation = proc inst -> do - notA <- checkbox "Notation" False -< () - returnA -< inst { showNotation = notA } - --- Transpose Widget -addTranspose :: UISF InstrumentData InstrumentData -addTranspose = proc inst -> do - tp <- withDisplay $ hiSlider 1 (-6,6) 0 -< () - returnA -< inst { transpose = tp } - --- Pedal Widget -addPedal :: UISF InstrumentData InstrumentData -addPedal = proc inst -> do - ped <- checkbox "Pedal" False -< () - returnA -< inst { pedal = ped } - ------------------------------ --- ECHO WIDGET -- ------------------------------ - --- This is a widget that adds an echo to a MidiMessage signal - -addEcho :: UISF EMM EMM -addEcho = title "Echo" $ leftRight $ proc m -> do - r <- title "Decay Rate" $ withDisplay (hSlider (0,0.9) 0.5) -< () - f <- title "Echoing Frequency" $ withDisplay (hSlider (1,10) 10) -< () - rec let m' = removeNull $ m ~++ s - s <- vdelay -< (1.0/f, fmap (mapMaybe (decay 0.1 r)) m') - returnA -< m' - -removeNull :: Maybe [MidiMessage] -> Maybe [MidiMessage] -removeNull Nothing = Nothing -removeNull (Just []) = Nothing -removeNull mm = mm - -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 (Midi.NoteOn c k v) -> f c k v dur - _ -> Nothing - ------------------------------ --- INSTRUMENT SELECT -- ------------------------------ - --- Sets the midi instrument on a given channel. Takes the channel and a starting instrument as an argument - -selectInstrument :: Midi.Channel -> Int -> UISF EMM EMM -selectInstrument chn i = title "Instrument" $ proc msg -> do - instrNum <- hiSlider 1 (0,127) i -< () - display -< (toEnum :: Int -> InstrumentName) instrNum - instrNum' <- unique -< instrNum - returnA -< fmap (\x -> [Std $ Midi.ProgramChange chn x]) instrNum' ~++ msg - ------------------------------ --- SONG SELECTION -- ------------------------------ - --- Takes an array of tuples of song names and Music values and creates a player for them --- Emits a midi signal that can be routed through other filters before being passed --- on to a midiOut sink. - -songPlayer :: [(String, Music Pitch)] -> UISF () EMM -songPlayer songList = proc _ -> do - i <- pickSong songList -< () - let song = fmap (\x -> snd $ songList !! x) i - let msgs = fmap (musicToMsgs False [] . toMusic1) song - (out, _) <- eventBuffer -< maybe NoBOp MergeInBuffer msgs - returnA -< out - -pickSong :: [(String, Music Pitch)] -> UISF () (SEvent Int) -pickSong [] = title "No Songs Imported" $ proc _ -> returnA -< Nothing -pickSong songList = title "Available Songs" $ leftRight $ proc _ -> do - i <- topDown $ radio (fst $ unzip songList) 0 -< () - playBtn <- edge <<< button "Play" -< () - returnA -< fmap (const i) playBtn - ------------------------------ --- OTHER HELPERS -- ------------------------------ - --- Converts a set of midi messages to a set of pitch and state pairs to be used --- in an InstrumentData structure - -mmToPair :: [MidiMessage] -> [(AbsPitch, Bool)] -mmToPair [] = [] -mmToPair (Std (Midi.NoteOn _ k _) : rest) = (k, True) : mmToPair rest -mmToPair (Std (Midi.NoteOff _ k _) : rest)= (k, False) : mmToPair rest -mmToPair (ANote {} :_) = error "ANote not implemented" -mmToPair (_:rest) = mmToPair rest - --- Given a channel, converts a list of pitches, states and velocities to a string of --- midi messages, the opposite of mmToPair - -pairToMsg :: Midi.Channel -> [(AbsPitch, Bool, Midi.Velocity)] -> [MidiMessage] -pairToMsg ch = map f where - f (ap, b, vel) | b = Std (Midi.NoteOn ch ap vel) - | not b = Std (Midi.NoteOff ch ap 0) - --- Given an absolute pitch, looks though the InstrumentData to create the related --- KeyData structure containing the pressed information, the string to use for --- pitch notation and the adjusted pitch - -getKeyData :: AbsPitch -> InstrumentData -> KeyData -getKeyData ap (InstrumentData isShow pairs trans _) = - KeyData (if isNothing pairs then Nothing - else Control.Monad.mplus (lookup ap (fromJust pairs)) Nothing) - (if isShow then Just (show $ fst $ pitch ap) else Nothing) - (ap + trans) - --- Looks through a string of midi messages and returns the first channel in a --- command, if it finds one. Counter to setChannel - -detectChannel :: [MidiMessage] -> Maybe Midi.Channel -detectChannel [] = Nothing -detectChannel (ANote c _ _ _:_) = Just c -detectChannel (Std (NoteOn c _ _):_) = Just c -detectChannel (Std (NoteOff c _ _):_) = Just c -detectChannel (Std (KeyPressure c _ _):_) = Just c -detectChannel (Std (ControlChange c _ _):_) = Just c -detectChannel (Std (ProgramChange c _):_) = Just c -detectChannel (Std (ChannelPressure c _):_) = Just c -detectChannel (Std (PitchWheel c _):_) = Just c -detectChannel (_:as) = detectChannel as - --- Sets all midi messages to a single channel. This will destroy any custom commands. --- Used inside the guitar and piano, which coerce their streams to their own channel. - -setChannel :: Int -> [MidiMessage] -> [MidiMessage] -setChannel c (ANote _ k v d:as) = ANote c k v d : setChannel c as -setChannel c (Std (NoteOn _ k v):as) = Std (NoteOn c k v) : setChannel c as -setChannel c (Std (NoteOff _ k v):as) = Std (NoteOff c k v) : setChannel c as -setChannel c (Std (KeyPressure _ k p):as) = Std (KeyPressure c k p) : setChannel c as -setChannel c (Std (ControlChange _ cn cv):as) = Std (ControlChange c cn cv) : setChannel c as -setChannel c (Std (ProgramChange _ p):as) = Std (ProgramChange c p) : setChannel c as -setChannel c (Std (ChannelPressure _ p):as) = Std (ChannelPressure c p) : setChannel c as -setChannel c (Std (PitchWheel _ p):as) = Std (PitchWheel c p) : setChannel c as -setChannel _ x = x diff --git a/Euterpea/IO/MUI/InstrumentWidgets.hs b/Euterpea/IO/MUI/InstrumentWidgets.hs deleted file mode 100644 --- a/Euterpea/IO/MUI/InstrumentWidgets.hs +++ /dev/null @@ -1,11 +0,0 @@ -module Euterpea.IO.MUI.InstrumentWidgets ( - PianoKeyMap, GuitarKeyMap, - KeyData, KeyState, InstrumentData, - defaultInstrumentData, defaultKeyLayout, defaultMap0, defaultMap1, defaultMap2, - addNotation, addTranspose, addPedal, addEcho, - selectInstrument, songPlayer, - piano, guitar, sixString -) where -import Euterpea.IO.MUI.InstrumentBase -import Euterpea.IO.MUI.Guitar -import Euterpea.IO.MUI.Piano diff --git a/Euterpea/IO/MUI/MidiWidgets.lhs b/Euterpea/IO/MUI/MidiWidgets.lhs deleted file mode 100644 --- a/Euterpea/IO/MUI/MidiWidgets.lhs +++ /dev/null @@ -1,386 +0,0 @@ -> {-# LANGUAGE RecursiveDo, Arrows, TupleSections #-} - -> module Euterpea.IO.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 -#if MIN_VERSION_UISF(0,4,0) -> , asyncMidi, asyncMidiOn -#endif -> ) where - -> import FRP.UISF hiding ((~++)) -> import Euterpea.IO.MIDI.MidiIO - -> import Control.Monad (liftM, forM_, when) - -> -- These four imports are just for musicToMsgs -> import Euterpea.IO.MIDI.GeneralMidi (toGM) -> import Euterpea.Music.Note.Performance (Music1, Event (..), perform, defPMap, defCon) -> import Euterpea.Music.Note.Music (InstrumentName) -> import Data.List (nub, elemIndex, sortBy) - -> -- 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.Concurrent (threadDelay, killThread) -> import Data.IORef - -> import Data.Monoid - - -#if MIN_VERSION_UISF(0,4,0) -> import FRP.UISF.Asynchrony -> import Data.Maybe (listToMaybe) -#endif - - -> (~++) :: SEvent [a] -> SEvent [a] -> SEvent [a] -> (~++) = mappend - - - - - -============================================================ -========================= 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 (~++) 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 ~++ 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 ~++ 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 ((~++) . 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 defPMap defCon 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 -> in title t $ proc _ -> do -> r <- radio (map (name . snd) devs) defaultChoice -< () -> returnA -< if r == -1 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 - - -#if MIN_VERSION_UISF(0,4,0) -> -- 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) - -asyncMidiHelper asy r (defb, defc) dd f = initialAIO (newIORef Nothing) go where --- >>> arr (\x -> if null x then Nothing else Just (last x)) --- >>> hold defc where --- go die = asy th ((r,defb),g) where - go die = asy (defb, defc) th (r,uncurry h) where - th tid = addTerminationProc $ do - writeIORef die (Just tid) - putStrLn "MIDI back-end closing..." --- g ((r,b),[]) = h r b --- g ((r,_),bs) = h r (last bs) - h r b = do - let (omt, r', c) = f (r, b) - 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) - continue <- readIORef die - maybe (return ()) killThread continue - when (td <= 0) (threadDelay dd) --- return ((r',b),c) - return (r',c) -#endif - diff --git a/Euterpea/IO/MUI/Piano.hs b/Euterpea/IO/MUI/Piano.hs deleted file mode 100644 --- a/Euterpea/IO/MUI/Piano.hs +++ /dev/null @@ -1,236 +0,0 @@ -{-# LANGUAGE Arrows, CPP #-} -module Euterpea.IO.MUI.Piano where -import FRP.UISF hiding ((~++)) -import FRP.UISF.UITypes -import Euterpea.Music.Note.Music hiding (transpose) -import Euterpea.IO.MUI.InstrumentBase -import Euterpea.IO.MUI.MidiWidgets ((~++)) -import qualified Codec.Midi as Midi -import Data.Maybe -import qualified Data.Char as Char - -#if MIN_VERSION_UISF(0,4,0) -import FRP.UISF.Graphics -import FRP.UISF.Widget.Construction -import FRP.UISF.Widget -withColorC = withColor -#else -import FRP.UISF.SOE -import qualified FRP.UISF.Widget as W -import FRP.UISF.Widget hiding (pushed, popped, marked) -pushed = let [(to,bo),(ti,bi)] = W.pushed - in (to,ti,bi,bo) -popped = let [(to,bo),(ti,bi)] = W.popped - in (to,ti,bi,bo) -rectangleFilled = block -withColorC = withColor' -#endif - - ---Note, only valid for standard US keyboards: ---Also, this is an ugly hack that can't stay ---it's mostly to test the new key events -toUpper :: Char -> Char -toUpper c = fromMaybe (Char.toUpper c) (lookup c keyMap) - where keyMap = [('`', '~'), ('1', '!'), ('2', '@'), ('3', '#'), ('4', '$'), - ('5', '%'), ('6', '^'), ('7', '&'), ('8', '*'), ('9', '('), - ('0', ')'), ('-', '_'), ('=', '+'), ('[', '{'), (']', '}'), - ('|', '\\'), ('\'', '\"'), (';', ':'), ('/', '?'), ('.', '>'), - (',', '<')] - -isUpper :: Char -> Bool -isUpper c = toUpper c == c - -data KeyType = White1 | White2 | White3 | Black1 deriving (Show, Eq) - -defaultKeyLayout :: [KeyType] -defaultKeyLayout = cycle [White1, Black1, White2, Black1, White3, White1, Black1, White2, Black1, White2, Black1, White3] - --- Width Height of White and Black notes -ww, wh, bw, bh, tw, th :: Int -(ww, wh) = (35, 100) -(bw, bh) = (25, 60) -(tw, th) = (8, 16) - -topW :: KeyType -> Int -topW Black1 = bw `div` 2 -topW White1 = ww - bw `div` 2 -topW White2 = ww - bw `div` 2 -topW White3 = ww - -insideKey :: KeyType -> Point -> Rect -> Bool -insideKey Black1 pt ((x, y), (w, h)) = pt `inside` ((x,y),(bw,bh)) -insideKey White1 pt ((x, y), (w, h)) = - let b1 = ((x,y), (ww - bw `div` 2, bh)) - b2 = ((x, y+bh), (ww, wh-bh)) - in (pt `inside` b1) || (pt `inside` b2) -insideKey White2 pt ((x, y), (w, h)) = - let b1 = ((x+bw `div` 2,y), (ww - bw, bh)) - b2 = ((x, y+bh), (ww, wh-bh)) - in (pt `inside` b1) || (pt `inside` b2) -insideKey White3 pt ((x, y), (w, h)) = - let b1 = ((x+bw `div` 2,y), (bw `div` 2, bh)) - b2 = ((x, y+bh), (ww, wh-bh)) - in (pt `inside` b1) || (pt `inside` b2) - -isBlack :: KeyType -> Bool -isBlack Black1 = True -isBlack _ = False - - --- ***************************************************************************** --- Drawing routines for each key type --- ***************************************************************************** -#if MIN_VERSION_UISF(0,4,0) -drawKey :: KeyType -> (Color,Color,Color,Color) -> Rect -> Graphic -#endif -drawKey White1 (to,ti,bi,bo) ((x, y), (w, h)) = - let val = x + w - bw `div` 2 - in withColorC ti (line (x + 1, y + 1) (x + 1, y + h - 2) // - line (x + 1, y + 1) (val - 3, y + 1) // - line (val - 3, y + 1 + bh) (x + w - 3, y + 1 + bh)) - // withColorC bi (line (x + 2, y + h - 2) (x + w - 2, y + h - 2) // - line (val - 3, y + 1) (val - 3, y + 1 + bh) // - line (x + w - 2, y + 1 + bh) (x + w - 2, y + h - 2)) - // withColorC to (line (x, y) (x, y + h - 1) // - line (x, y) (val - 2, y) // - line (val - 2, y + bh) (x + w - 2, y + bh)) - // withColorC bo (line (x + 1, y + h - 1) (x + w - 1, y + h - 1) // - line (val - 2, y) (val - 2, y + bh) // - line (x + w - 1, y + bh) (x + w - 1, y + h - 1)) - -drawKey White2 (to,ti,bi,bo) ((x, y), (w, h)) = - let valP = x + bw `div` 2 - valM = x + w - bw `div` 2 - in withColorC ti (line (valP + 3, y + 1) (valP + 3, y + bh) // - line (valP + 3, y + 1) (valM - 3, y + 1) // - line (x - 1, y + bh + 1) (valP - 1, y + bh + 1) // - line (valM - 3, y + bh + 1) (x + w - 3, y + bh + 1)) - // withColorC bi (line (x + 2, y + h - 2) (x + w - 2, y + h - 2) // - line (valM - 2, y + 1) (valM - 2, y + bh + 1) // - line (x + w - 2, y + bh + 1) (x + w - 2, y + h - 2)) - // withColorC to (line (valP + 2, y) (valP + 2, y + bh - 1) // - line (valP + 2, y) (valM - 2, y) // - line (x - 2, y + bh) (valP - 2, y + bh) // - line (valM - 2, y + bh) (x + w - 2, y + bh)) - // withColorC bo (line (x + 1, y + h - 1) (x + w - 1, y + h - 1) // - line (valM - 1, y) (valM - 1, y + bh) // - line (x + w - 1, y + bh) (x + w - 1, y + h - 1)) - -drawKey White3 (to,ti,bi,bo) ((x, y), (w, h)) = - let val = x + bw `div` 2 - in withColorC ti (line (val + 3, y + 1) (val + 3, y + bh) // - line (val + 3, y + 1) (x + w - 3, y + 1) // - line (x - 1, y + bh + 1) (val - 1, y + bh + 1)) - // withColorC bi (line (x + 2, y + h - 2) (x + w - 2, y + h - 2) // - line (x + w - 2, y + 1) (x + w - 2, y + bh + 1) // - line (x + w - 2, y + bh + 1) (x + w - 2, y + h - 2)) - // withColorC to (line (val + 2, y) (val + 2, y + bh - 1) // - line (val + 2, y) (x + w - 2, y) // - line (x - 2, y + bh) (val - 2, y + bh)) - // withColorC bo (line (x + 1, y + h - 1) (x + w - 1, y + h - 1) // - line (x + w - 1, y) (x + w - 1, y + bh) // - line (x + w - 1, y + bh) (x + w - 1, y + h - 1)) - -drawKey Black1 (to,ti,bi,bo) ((x, y), (w, h)) = - withColorC ti (line (x + 1, y + 1) (x + 1, y + h - 2) // - line (x + 1, y + 1) (x + w - 3, y + 1)) - // withColorC bi (line (x + 2, y + h - 2) (x + w - 2, y + h - 2) // - line (x + w - 2, y + 1) (x + w - 2, y + h - 2)) - // withColorC to (line (x, y) (x, y + h - 1) // - line (x, y) (x + w - 2, y)) - // withColorC bo (line (x + 1, y + h - 1) (x + w - 1, y + h - 1) // - line (x + w - 1, y) (x + w - 1, y + h - 1)) - - -colorKey :: KeyType -> Rect -> Graphic -colorKey Black1 r = withColor Black $ rectangleFilled r -colorKey White1 ((x,y), (w,h)) = withColor White $ - rectangleFilled ((x, y+bh), (ww, wh-bh)) - // rectangleFilled ((x,y), (ww - bw `div` 2, bh)) -colorKey White2 ((x,y), (w,h)) = withColor White $ - rectangleFilled ((x, y+bh), (ww, wh-bh)) - // rectangleFilled ((x+ bw `div` 2, y), (ww-bw, bh)) -colorKey White3 ((x,y), (w,h)) = withColor White $ - rectangleFilled ((x, y+bh), (ww, wh-bh)) - // rectangleFilled ((x+ bw `div` 2, y), (ww-bw `div` 2, bh)) - --- ***************************************************************************** --- Single-key widget: handles key/mouse input and check if the song is playing --- ***************************************************************************** -mkKey :: Char -> KeyType -> UISF KeyData KeyState -mkKey c kt = mkWidget iState d process draw where - iState = (KeyState False False False 127, Nothing) - - d = makeLayout (Fixed minw) (Fixed minh) - minw = topW kt - minh | isBlack kt = bh - | otherwise = wh - - draw rect inFocus (kb, showNote) = - let isDown = isKeyDown kb - b@((x,y),(w,h)) = realBBX rect - x' = x + (w - tw) `div` 2 + if isDown then 0 else -1 - y' = y + h `div` 3 + (h - th) `div` 2 + if isDown then 0 else -1 - drawNotation s = withColor Red $ text (x'+(1-length s)*tw `div` 2, y'- th + 2) s - in withColor (if isBlack kt then White else Black) (text (x',y') [c]) - // maybe nullGraphic drawNotation showNote - // withColor White (drawKey kt (if isDown then pushed else popped) b) - // colorKey kt b - realBBX ((x,y),(w,h)) = let (w', h') | isBlack kt = (bw,bh) - | otherwise = (ww,wh) - in ((x,y),(w',h')) - - process kd (kb,_) bbx evt = (kb'', (kb'', notation kd), kb /= kb'') where - kb' = if isJust (pressed kd) then kb { song = fromJust $ pressed kd } else kb - kb'' = case evt of - Key c' ms down -> - if detectKey c' (hasShiftModifier ms) - then kb' { keypad = down, vel = 127 } - else kb' -#if MIN_VERSION_UISF(0,4,0) - Button pt LeftButton down -> case (mouse kb', down, insideKey kt pt bbx) of -#else - Button pt True down -> case (mouse kb', down, insideKey kt pt bbx) of -#endif - (False, True, True) -> kb' { mouse = True, vel = getVel pt bbx } - (True, False, True) -> kb' { mouse = False, vel = getVel pt bbx } - otherwise -> kb' - MouseMove pt -> if insideKey kt pt bbx then kb' else kb' { mouse = False } - _ -> kb' - where getVel (u,v) ((x,y),(w,h)) = 40 + 87 * round (fromIntegral (v - y) / fromIntegral h) - detectKey c' s = toUpper c == toUpper c' && isUpper c == s -- This line should be more robust - --- ***************************************************************************** --- Group all keys together --- ***************************************************************************** - -mkKeys :: [(Char, KeyType, AbsPitch)] -> UISF InstrumentData (SEvent [(AbsPitch, Bool, Midi.Velocity)]) -mkKeys [] = constA Nothing -mkKeys ((c,kt,ap):ckas) = proc instr -> do - msg <- unique <<< mkKey c kt -< getKeyData ap instr - let on = maybe False isKeyPlay msg - ped = pedal instr - ret | not on && not ped = [(ap, False, maybe 0 vel msg)] - | on = [(ap, True, maybe 127 vel msg)] - | otherwise = [] - msgs <- mkKeys ckas -< instr - returnA -< fmap (const ret) msg ~++ msgs - --- ***************************************************************************** --- Main widget: piano that takes a map (string) of characters to map to notes --- and the pitch of the first note --- two default maps are provided so that two piano can be loaded concurrently --- ***************************************************************************** -type PianoKeyMap = (String, Pitch) -defaultMap1, defaultMap2, defaultMap0 :: PianoKeyMap -defaultMap1 = ("q2w3er5t6y7uQ@W#ER%T^Y&U", (C,2)) -defaultMap2 = ("zsxdcvgbhnjmZSXDCVGBHNJM", (C,3)) -defaultMap0 = (fst defaultMap1 ++ fst defaultMap2, (C,3)) - -piano :: PianoKeyMap -> Midi.Channel -> UISF (InstrumentData,EMM) EMM -piano (s,p) chn = focusable $ proc (instr,emm) -> do - let emm' = fmap (setChannel chn) emm - let instrData = instr { keyPairs = fmap mmToPair emm' } - keys <- leftRight $ mkKeys (zip3 s defaultKeyLayout (iterate (1+) (absPitch p))) -< instrData - returnA -< fmap (pairToMsg chn) keys ~++ emm' diff --git a/Euterpea/IO/MUI/UISFCompat.lhs b/Euterpea/IO/MUI/UISFCompat.lhs deleted file mode 100644 --- a/Euterpea/IO/MUI/UISFCompat.lhs +++ /dev/null @@ -1,36 +0,0 @@ - -> {-# LANGUAGE ExistentialQuantification, ScopedTypeVariables, FlexibleContexts, CPP #-} - -> module Euterpea.IO.MUI.UISFCompat where -> import FRP.UISF.AuxFunctions -> import FRP.UISF.UISF -> import Control.SF.SF -> import Control.Arrow.ArrowP -> import Euterpea.IO.Audio.Types -> import Control.DeepSeq -> import Control.Concurrent (killThread, ThreadId) - -#if MIN_VERSION_UISF(0,4,0) -> import FRP.UISF.Asynchrony -> asyncUISFV x = asyncVT x -#endif - -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 - diff --git a/Euterpea/Music.lhs b/Euterpea/Music.lhs new file mode 100644 --- /dev/null +++ b/Euterpea/Music.lhs @@ -0,0 +1,497 @@ + +> {-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-} + +> module Euterpea.Music where + +> infixr 5 :+:, :=: + +> type AbsPitch = Int +> type Octave = Int +> type Pitch = (PitchClass, Octave) +> type Dur = Rational +> data PitchClass = Cff | Cf | C | Dff | Cs | Df | Css | D | Eff | Ds +> | Ef | Fff | Dss | E | Ff | Es | F | Gff | Ess | Fs +> | Gf | Fss | G | Aff | Gs | Af | Gss | A | Bff | As +> | Bf | Ass | B | Bs | Bss +> deriving (Show, Eq, Ord, Read, Enum, Bounded) + +> data Primitive a = Note Dur a +> | Rest Dur +> deriving (Show, Eq, Ord) + +> data Music a = +> Prim (Primitive a) -- primitive value +> | Music a :+: Music a -- sequential composition +> | Music a :=: Music a -- parallel composition +> | Modify Control (Music a) -- modifier +> deriving (Show, Eq, Ord) + +> data Control = +> Tempo Rational -- scale the tempo +> | Transpose AbsPitch -- transposition +> | Instrument InstrumentName -- instrument label +> | Phrase [PhraseAttribute] -- phrase attributes +> | KeySig PitchClass Mode -- key signature and mode +> | Custom String -- for user-specified controls +> deriving (Show, Eq, Ord) + +> data Mode = Major | Minor +> deriving (Show, Eq, Ord) + +> data InstrumentName = +> AcousticGrandPiano | BrightAcousticPiano | ElectricGrandPiano +> | HonkyTonkPiano | RhodesPiano | ChorusedPiano +> | Harpsichord | Clavinet | Celesta +> | Glockenspiel | MusicBox | Vibraphone +> | Marimba | Xylophone | TubularBells +> | Dulcimer | HammondOrgan | PercussiveOrgan +> | RockOrgan | ChurchOrgan | ReedOrgan +> | Accordion | Harmonica | TangoAccordion +> | AcousticGuitarNylon | AcousticGuitarSteel | ElectricGuitarJazz +> | ElectricGuitarClean | ElectricGuitarMuted | OverdrivenGuitar +> | DistortionGuitar | GuitarHarmonics | AcousticBass +> | ElectricBassFingered | ElectricBassPicked | FretlessBass +> | SlapBass1 | SlapBass2 | SynthBass1 +> | SynthBass2 | Violin | Viola +> | Cello | Contrabass | TremoloStrings +> | PizzicatoStrings | OrchestralHarp | Timpani +> | StringEnsemble1 | StringEnsemble2 | SynthStrings1 +> | SynthStrings2 | ChoirAahs | VoiceOohs +> | SynthVoice | OrchestraHit | Trumpet +> | Trombone | Tuba | MutedTrumpet +> | FrenchHorn | BrassSection | SynthBrass1 +> | SynthBrass2 | SopranoSax | AltoSax +> | TenorSax | BaritoneSax | Oboe +> | Bassoon | EnglishHorn | Clarinet +> | Piccolo | Flute | Recorder +> | PanFlute | BlownBottle | Shakuhachi +> | Whistle | Ocarina | Lead1Square +> | Lead2Sawtooth | Lead3Calliope | Lead4Chiff +> | Lead5Charang | Lead6Voice | Lead7Fifths +> | Lead8BassLead | Pad1NewAge | Pad2Warm +> | Pad3Polysynth | Pad4Choir | Pad5Bowed +> | Pad6Metallic | Pad7Halo | Pad8Sweep +> | FX1Train | FX2Soundtrack | FX3Crystal +> | FX4Atmosphere | FX5Brightness | FX6Goblins +> | FX7Echoes | FX8SciFi | Sitar +> | Banjo | Shamisen | Koto +> | Kalimba | Bagpipe | Fiddle +> | Shanai | TinkleBell | Agogo +> | SteelDrums | Woodblock | TaikoDrum +> | MelodicDrum | SynthDrum | ReverseCymbal +> | GuitarFretNoise | BreathNoise | Seashore +> | BirdTweet | TelephoneRing | Helicopter +> | Applause | Gunshot | Percussion +> | CustomInstrument String +> deriving (Show, Eq, Ord) + +> data PhraseAttribute = Dyn Dynamic +> | Tmp Tempo +> | Art Articulation +> | Orn Ornament +> deriving (Show, Eq, Ord) + +> data Dynamic = Accent Rational | Crescendo Rational | Diminuendo Rational +> | StdLoudness StdLoudness | Loudness Rational +> deriving (Show, Eq, Ord) + +> data StdLoudness = PPP | PP | P | MP | SF | MF | NF | FF | FFF +> deriving (Show, Eq, Ord, Enum) + +> data Tempo = Ritardando Rational | Accelerando Rational +> deriving (Show, Eq, Ord) + +> data Articulation = Staccato Rational | Legato Rational | Slurred Rational +> | Tenuto | Marcato | Pedal | Fermata | FermataDown | Breath +> | DownBow | UpBow | Harmonic | Pizzicato | LeftPizz +> | BartokPizz | Swell | Wedge | Thumb | Stopped +> deriving (Show, Eq, Ord) + +> data Ornament = Trill | Mordent | InvMordent | DoubleMordent +> | Turn | TrilledTurn | ShortTrill +> | Arpeggio | ArpeggioUp | ArpeggioDown +> | Instruction String | Head NoteHead +> | DiatonicTrans Int +> deriving (Show, Eq, Ord) + +> data NoteHead = DiamondHead | SquareHead | XHead | TriangleHead +> | TremoloHead | SlashHead | ArtHarmonic | NoHead +> deriving (Show, Eq, Ord) + +> type Volume = Int + +> addVolume :: Volume -> Music Pitch -> Music (Pitch,Volume) +> addVolume v = mMap (\p -> (p,v)) + +> data NoteAttribute = +> Volume Int -- MIDI convention: 0=min, 127=max +> | Fingering Integer +> | Dynamics String +> | Params [Double] +> deriving (Eq, Show) + +> type Note1 = (Pitch, [NoteAttribute]) +> type Music1 = Music Note1 + + +A new type class to allow for musical polymorphism that ultimately +must be converted to Music1 to be converted to MIDI format through +the MEvent framework. + +> class ToMusic1 a where +> toMusic1 :: Music a -> Music1 + +> instance ToMusic1 Pitch where +> toMusic1 = mMap (\p -> (p, [])) + +> instance ToMusic1 (Pitch, Volume) where +> toMusic1 = mMap (\(p, v) -> (p, [Volume v])) + +> instance ToMusic1 (Note1) where +> toMusic1 = id + +> instance ToMusic1 (AbsPitch) where +> toMusic1 = mMap (\a -> (pitch a, [])) + +> note :: Dur -> a -> Music a +> note d p = Prim (Note d p) + +> rest :: Dur -> Music a +> rest d = Prim (Rest d) + +> tempo :: Dur -> Music a -> Music a +> tempo r m = Modify (Tempo r) m + +> transpose :: AbsPitch -> Music a -> Music a +> transpose i m = Modify (Transpose i) m + +> instrument :: InstrumentName -> Music a -> Music a +> instrument i m = Modify (Instrument i) m + +> phrase :: [PhraseAttribute] -> Music a -> Music a +> phrase pa m = Modify (Phrase pa) m + +> keysig :: PitchClass -> Mode -> Music a -> Music a +> keysig pc mo m = Modify (KeySig pc mo) m + +> cff,cf,c,cs,css,dff,df,d,ds,dss,eff,ef,e,es,ess,fff,ff,f, +> fs,fss,gff,gf,g,gs,gss,aff,af,a,as,ass,bff,bf,b,bs,bss :: +> Octave -> Dur -> Music Pitch + +> cff o d = note d (Cff, o); cf o d = note d (Cf, o) +> c o d = note d (C, o); cs o d = note d (Cs, o) +> css o d = note d (Css, o); dff o d = note d (Dff, o) +> df o d = note d (Df, o); d o d = note d (D, o) +> ds o d = note d (Ds, o); dss o d = note d (Dss, o) +> eff o d = note d (Eff, o); ef o d = note d (Ef, o) +> e o d = note d (E, o); es o d = note d (Es, o) +> ess o d = note d (Ess, o); fff o d = note d (Fff, o) +> ff o d = note d (Ff, o); f o d = note d (F, o) +> fs o d = note d (Fs, o); fss o d = note d (Fss, o) +> gff o d = note d (Gff, o); gf o d = note d (Gf, o) +> g o d = note d (G, o); gs o d = note d (Gs, o) +> gss o d = note d (Gss, o); aff o d = note d (Aff, o) +> af o d = note d (Af, o); a o d = note d (A, o) +> as o d = note d (As, o); ass o d = note d (Ass, o) +> bff o d = note d (Bff, o); bf o d = note d (Bf, o) +> b o d = note d (B, o); bs o d = note d (Bs, o) +> bss o d = note d (Bss, o) + + +> bn, wn, hn, qn, en, sn, tn, sfn, dwn, dhn, +> dqn, den, dsn, dtn, ddhn, ddqn, dden :: Dur + +> bnr, wnr, hnr, qnr, enr, snr, tnr, sfnr, dwnr, dhnr, +> dqnr, denr, dsnr, dtnr, ddhnr, ddqnr, ddenr :: Music Pitch + +> bn = 2; bnr = rest bn -- brevis rest +> wn = 1; wnr = rest wn -- whole note rest +> hn = 1/2; hnr = rest hn -- half note rest +> qn = 1/4; qnr = rest qn -- quarter note rest +> en = 1/8; enr = rest en -- eighth note rest +> sn = 1/16; snr = rest sn -- sixteenth note rest +> tn = 1/32; tnr = rest tn -- thirty-second note rest +> sfn = 1/64; sfnr = rest sfn -- sixty-fourth note rest + +> dwn = 3/2; dwnr = rest dwn -- dotted whole note rest +> dhn = 3/4; dhnr = rest dhn -- dotted half note rest +> dqn = 3/8; dqnr = rest dqn -- dotted quarter note rest +> den = 3/16; denr = rest den -- dotted eighth note rest +> dsn = 3/32; dsnr = rest dsn -- dotted sixteenth note rest +> dtn = 3/64; dtnr = rest dtn -- dotted thirty-second note rest + +> ddhn = 7/8; ddhnr = rest ddhn -- double-dotted half note rest +> ddqn = 7/16; ddqnr = rest ddqn -- double-dotted quarter note rest +> dden = 7/32; ddenr = rest dden -- double-dotted eighth note rest + +The conversion for Pitch and AbsPitch differs from previous versions +of Euterpea. In Euterpea 1.x, (C,5) was pitch number 60, which is not +the most common interpretation. While there is no universal standard +for which octave should be octave 0, it is far more common to have the +pitch number relationship that (C,4) = 60. Since this change has been +requested many times in previous versions of Euterpea, the following +standard is now in place as of version 2.0.0: + +pitch 0 = (C,-1) +pitch 60 = (C,4) +pitch 127 = (G,9) + +> absPitch :: Pitch -> AbsPitch +> absPitch (pc,oct) = 12*(oct+1) + pcToInt pc + +> pcToInt :: PitchClass -> Int +> pcToInt pc = case pc of +> Cff -> -2; Cf -> -1; C -> 0; Cs -> 1; Css -> 2; +> Dff -> 0; Df -> 1; D -> 2; Ds -> 3; Dss -> 4; +> Eff -> 2; Ef -> 3; E -> 4; Es -> 5; Ess -> 6; +> Fff -> 3; Ff -> 4; F -> 5; Fs -> 6; Fss -> 7; +> Gff -> 5; Gf -> 6; G -> 7; Gs -> 8; Gss -> 9; +> Aff -> 7; Af -> 8; A -> 9; As -> 10; Ass -> 11; +> Bff -> 9; Bf -> 10; B -> 11; Bs -> 12; Bss -> 13 + +> pitch :: AbsPitch -> Pitch +> pitch ap = +> let (oct, n) = divMod ap 12 +> in ([C,Cs,D,Ds,E,F,Fs,G,Gs,A,As,B] !! n, oct-1) + +> trans :: Int -> Pitch -> Pitch +> trans i p = pitch (absPitch p + i) + + + + + + +-- ================================================================================= +-- From MoreMusic.hs + +> line, chord :: [Music a] -> Music a +> line = foldr (:+:) (rest 0) +> chord = foldr (:=:) (rest 0) + +> line1, chord1 :: [Music a] -> Music a +> line1 = foldr1 (:+:) +> chord1 = foldr1 (:=:) + +> offset :: Dur -> Music a -> Music a +> offset d m = rest d :+: m + +> times :: Int -> Music a -> Music a +> times 0 m = rest 0 +> times n m = m :+: times (n-1) m + +> forever :: Music a -> Music a +> forever m = m :+: forever m + +> lineToList :: Music a -> [Music a] +> lineToList (Prim (Rest 0)) = [] +> lineToList (n :+: ns) = n : lineToList ns +> lineToList _ = +> error "lineToList: argument not created by function line" + +> invertAt :: Pitch -> Music Pitch -> Music Pitch +> invertAt pRef = mMap (\p -> pitch (2 * absPitch pRef - absPitch p)) + +> invertAt1 :: Pitch -> Music (Pitch, a) -> Music (Pitch, a) +> invertAt1 pRef = mMap (\(p,x) -> (pitch (2 * absPitch pRef - absPitch p),x)) + +> invert :: Music Pitch -> Music Pitch +> invert m = +> let pRef = mFold pFun (++) (++) (flip const) m +> in if null pRef then m -- no pitches in the structure! +> else invertAt (head pRef) m +> where pFun (Note d p) = [p] +> pFun _ = [] + +> invert1 :: Music (Pitch,a) -> Music (Pitch,a) +> invert1 m = +> let pRef = mFold pFun (++) (++) (flip const) m +> in if null pRef then m -- no pitches! +> else invertAt1 (head pRef) m +> where pFun (Note d (p,x)) = [p] +> pFun _ = [] + +> retro :: Music a -> Music a +> retro n@(Prim _) = n +> retro (Modify c m) = Modify c (retro m) +> retro (m1 :+: m2) = retro m2 :+: retro m1 +> retro (m1 :=: m2) = +> let d1 = dur m1 +> d2 = dur m2 +> in if d1>d2 then retro m1 :=: (rest (d1-d2) :+: retro m2) +> else (rest (d2-d1) :+: retro m1) :=: retro m2 + +> retroInvert, invertRetro :: Music Pitch -> Music Pitch +> retroInvert = retro . invert +> invertRetro = invert . retro + +> dur :: Music a -> Dur +> dur (Prim (Note d _)) = d +> dur (Prim (Rest d)) = d +> dur (m1 :+: m2) = dur m1 + dur m2 +> dur (m1 :=: m2) = dur m1 `max` dur m2 +> dur (Modify (Tempo r) m) = dur m / r +> dur (Modify _ m) = dur m + +> cut :: Dur -> Music a -> Music a +> cut d m | d <= 0 = rest 0 +> cut d (Prim (Note oldD p)) = note (min oldD d) p +> cut d (Prim (Rest oldD)) = rest (min oldD d) +> cut d (m1 :=: m2) = cut d m1 :=: cut d m2 +> cut d (m1 :+: m2) = let m'1 = cut d m1 +> m'2 = cut (d - dur m'1) m2 +> in m'1 :+: m'2 +> cut d (Modify (Tempo r) m) = tempo r (cut (d*r) m) +> cut d (Modify c m) = Modify c (cut d m) + + +> remove :: Dur -> Music a -> Music a +> remove d m | d <= 0 = m +> remove d (Prim (Note oldD p)) = note (max (oldD-d) 0) p +> remove d (Prim (Rest oldD)) = rest (max (oldD-d) 0) +> remove d (m1 :=: m2) = remove d m1 :=: remove d m2 +> remove d (m1 :+: m2) = let m'1 = remove d m1 +> m'2 = remove (d - dur m1) m2 +> in m'1 :+: m'2 +> remove d (Modify (Tempo r) m) = tempo r (remove (d*r) m) +> remove d (Modify c m) = Modify c (remove d m) + +> removeZeros :: Music a -> Music a +> removeZeros (Prim p) = Prim p +> removeZeros (m1 :+: m2) = +> let m'1 = removeZeros m1 +> m'2 = removeZeros m2 +> in case (m'1,m'2) of +> (Prim (Note 0 p), m) -> m +> (Prim (Rest 0 ), m) -> m +> (m, Prim (Note 0 p)) -> m +> (m, Prim (Rest 0 )) -> m +> (m1, m2) -> m1 :+: m2 +> removeZeros (m1 :=: m2) = +> let m'1 = removeZeros m1 +> m'2 = removeZeros m2 +> in case (m'1,m'2) of +> (Prim (Note 0 p), m) -> m +> (Prim (Rest 0 ), m) -> m +> (m, Prim (Note 0 p)) -> m +> (m, Prim (Rest 0 )) -> m +> (m1, m2) -> m1 :=: m2 +> removeZeros (Modify c m) = Modify c (removeZeros m) + +> type LazyDur = [Dur] +> durL :: Music a -> LazyDur +> durL m@(Prim _) = [dur m] +> durL (m1 :+: m2) = let d1 = durL m1 +> in d1 ++ map (+(last d1)) (durL m2) +> durL (m1 :=: m2) = mergeLD (durL m1) (durL m2) +> durL (Modify (Tempo r) m) = map (/r) (durL m) +> durL (Modify _ m) = durL m + +> mergeLD :: LazyDur -> LazyDur -> LazyDur +> mergeLD [] ld = ld +> mergeLD ld [] = ld +> mergeLD ld1@(d1:ds1) ld2@(d2:ds2) = +> if d1 else d2 : mergeLD ld1 ds2 + +> minL :: LazyDur -> Dur -> Dur +> minL [] d' = d' +> minL [d] d' = min d d' +> minL (d:ds) d' = if d < d' then minL ds d' else d' + +> cutL :: LazyDur -> Music a -> Music a +> cutL [] m = rest 0 +> cutL (d:ds) m | d <= 0 = cutL ds m +> cutL ld (Prim (Note oldD p)) = note (minL ld oldD) p +> cutL ld (Prim (Rest oldD)) = rest (minL ld oldD) +> cutL ld (m1 :=: m2) = cutL ld m1 :=: cutL ld m2 +> cutL ld (m1 :+: m2) = +> let m'1 = cutL ld m1 +> m'2 = cutL (map (\d -> d - dur m'1) ld) m2 +> in m'1 :+: m'2 +> cutL ld (Modify (Tempo r) m) = tempo r (cutL (map (*r) ld) m) +> cutL ld (Modify c m) = Modify c (cutL ld m) + +> (/=:) :: Music a -> Music a -> Music a +> m1 /=: m2 = cutL (durL m2) m1 :=: cutL (durL m1) m2 + +> data PercussionSound = +> AcousticBassDrum -- MIDI Key 35 +> | BassDrum1 -- MIDI Key 36 +> | SideStick -- ... +> | AcousticSnare | HandClap | ElectricSnare | LowFloorTom +> | ClosedHiHat | HighFloorTom | PedalHiHat | LowTom +> | OpenHiHat | LowMidTom | HiMidTom | CrashCymbal1 +> | HighTom | RideCymbal1 | ChineseCymbal | RideBell +> | Tambourine | SplashCymbal | Cowbell | CrashCymbal2 +> | Vibraslap | RideCymbal2 | HiBongo | LowBongo +> | MuteHiConga | OpenHiConga | LowConga | HighTimbale +> | LowTimbale | HighAgogo | LowAgogo | Cabasa +> | Maracas | ShortWhistle | LongWhistle | ShortGuiro +> | LongGuiro | Claves | HiWoodBlock | LowWoodBlock +> | MuteCuica | OpenCuica | MuteTriangle +> | OpenTriangle -- MIDI Key 82 +> deriving (Show,Eq,Ord,Enum) + +> perc :: PercussionSound -> Dur -> Music Pitch +> perc ps dur = instrument Percussion $ note dur (pitch (fromEnum ps + 35)) + + +> pMap :: (a -> b) -> Primitive a -> Primitive b +> pMap f (Note d x) = Note d (f x) +> pMap f (Rest d) = Rest d + +> mMap :: (a -> b) -> Music a -> Music b +> mMap f (Prim p) = Prim (pMap f p) +> mMap f (m1 :+: m2) = mMap f m1 :+: mMap f m2 +> mMap f (m1 :=: m2) = mMap f m1 :=: mMap f m2 +> mMap f (Modify c m) = Modify c (mMap f m) + +> instance Functor Primitive where +> fmap = pMap + +> instance Functor Music where +> fmap = mMap + + +> mFold :: (Primitive a -> b) -> (b->b->b) -> (b->b->b) -> +> (Control -> b -> b) -> Music a -> b +> mFold f (+:) (=:) g m = +> let rec = mFold f (+:) (=:) g +> in case m of +> Prim p -> f p +> m1 :+: m2 -> rec m1 +: rec m2 +> m1 :=: m2 -> rec m1 =: rec m2 +> Modify c m -> g c (rec m) + + +-- ========================================================================================= + +Sometimes we may wish to alter the internal structure of a Music value +rather than wrapping it with Modify. The following functions allow this. + +> shiftPitches :: AbsPitch -> Music Pitch -> Music Pitch +> shiftPitches k = mMap (trans k) + +> shiftPitches1 :: AbsPitch -> Music (Pitch, b) -> Music (Pitch, b) +> shiftPitches1 k = mMap (\(p,xs) -> (trans k p, xs)) + +> scaleDurations :: Rational -> Music a -> Music a +> scaleDurations r (Prim (Note d p)) = note (d/r) p +> scaleDurations r (Prim (Rest d)) = rest (d/r) +> scaleDurations r (m1 :+: m2) = scaleDurations r m1 :+: scaleDurations r m2 +> scaleDurations r (m1 :=: m2) = scaleDurations r m1 :=: scaleDurations r m2 +> scaleDurations r (Modify c m) = Modify c (scaleDurations r m) + +> changeInstrument :: InstrumentName -> Music a -> Music a +> changeInstrument i m = Modify (Instrument i) $ removeInstruments m + +> removeInstruments :: Music a -> Music a +> removeInstruments (Modify (Instrument i) m) = removeInstruments m +> removeInstruments (Modify c m) = Modify c $ removeInstruments m +> removeInstruments (m1 :+: m2) = removeInstruments m1 :+: removeInstruments m2 +> removeInstruments (m1 :=: m2) = removeInstruments m1 :=: removeInstruments m2 +> removeInstruments m = m + + + diff --git a/Euterpea/Music/Note/MoreMusic.hs b/Euterpea/Music/Note/MoreMusic.hs deleted file mode 100644 --- a/Euterpea/Music/Note/MoreMusic.hs +++ /dev/null @@ -1,302 +0,0 @@ -{-# LINE 8 "MoreMusic.lhs" #-} --- This code was automatically generated by lhs2tex --code, from the file --- HSoM/MoreMusic.lhs. (See HSoM/MakeCode.bat.) -{-# LINE 18 "MoreMusic.lhs" #-} -module Euterpea.Music.Note.MoreMusic where -import Euterpea.Music.Note.Music -{-# LINE 47 "MoreMusic.lhs" #-} -line, chord :: [Music a] -> Music a -line = foldr (:+:) (rest 0) -chord = foldr (:=:) (rest 0) - -line1, chord1 :: [Music a] -> Music a -line1 = foldr1 (:+:) -chord1 = foldr1 (:=:) -{-# LINE 66 "MoreMusic.lhs" #-} -delayM :: Dur -> Music a -> Music a -delayM d m = rest d :+: m -{-# LINE 76 "MoreMusic.lhs" #-} -timesM :: Int -> Music a -> Music a -timesM 0 m = rest 0 -timesM n m = m :+: timesM (n-1) m -{-# LINE 89 "MoreMusic.lhs" #-} -repeatM :: Music a -> Music a -repeatM m = m :+: repeatM m -{-# LINE 115 "MoreMusic.lhs" #-} -lineToList :: Music a -> [Music a] -lineToList (Prim (Rest 0)) = [] -lineToList (n :+: ns) = n : lineToList ns -lineToList _ = - error "lineToList: argument not created by function line" -{-# LINE 124 "MoreMusic.lhs" #-} -invert :: Music Pitch -> Music Pitch -invert m = - let l@(Prim (Note _ r) : _) = lineToList m - inv (Prim (Note d p)) = - note d (pitch (2 * absPitch r - absPitch p)) - inv (Prim (Rest d)) = rest d - in line (map inv l) -{-# LINE 147 "MoreMusic.lhs" #-} -retro, retroInvert, invertRetro :: Music Pitch -> Music Pitch -retro = line . reverse . lineToList -retroInvert = retro . invert -invertRetro = invert . retro -{-# LINE 224 "MoreMusic.lhs" #-} -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)) -{-# LINE 238 "MoreMusic.lhs" #-} -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 -{-# LINE 263 "MoreMusic.lhs" #-} -pr12 :: Music Pitch -pr12 = pr1 (C,4) :=: pr2 (G,4) -{-# LINE 274 "MoreMusic.lhs" #-} -(=:=) :: Dur -> Dur -> Music a -> Music a -old =:= new = tempo (new/old) -{-# LINE 289 "MoreMusic.lhs" #-} -dur :: Music a -> Dur -dur (Prim (Note d _)) = d -dur (Prim (Rest d)) = d -dur (m1 :+: m2) = dur m1 + dur m2 -dur (m1 :=: m2) = dur m1 `max` dur m2 -dur (Modify (Tempo r) m) = dur m / r -dur (Modify _ m) = dur m -{-# LINE 327 "MoreMusic.lhs" #-} -revM :: Music a -> Music a -revM n@(Prim _) = n -revM (Modify c m) = Modify c (revM m) -revM (m1 :+: m2) = revM m2 :+: revM m1 -revM (m1 :=: m2) = - let d1 = dur m1 - d2 = dur m2 - in if d1>d2 then revM m1 :=: (rest (d1-d2) :+: revM m2) - else (rest (d2-d1) :+: revM m1) :=: revM m2 -{-# LINE 359 "MoreMusic.lhs" #-} -takeM :: Dur -> Music a -> Music a -takeM d m | d <= 0 = rest 0 -takeM d (Prim (Note oldD p)) = note (min oldD d) p -takeM d (Prim (Rest oldD)) = rest (min oldD d) -takeM d (m1 :=: m2) = takeM d m1 :=: takeM d m2 -takeM d (m1 :+: m2) = let m'1 = takeM d m1 - m'2 = takeM (d - dur m'1) m2 - in m'1 :+: m'2 -takeM d (Modify (Tempo r) m) = tempo r (takeM (d*r) m) -takeM d (Modify c m) = Modify c (takeM d m) -{-# LINE 381 "MoreMusic.lhs" #-} -cut :: Dur -> Music a -> Music a -cut = takeM -{-# LINE 390 "MoreMusic.lhs" #-} -dropM :: Dur -> Music a -> Music a -dropM d m | d <= 0 = m -dropM d (Prim (Note oldD p)) = note (max (oldD-d) 0) p -dropM d (Prim (Rest oldD)) = rest (max (oldD-d) 0) -dropM d (m1 :=: m2) = dropM d m1 :=: dropM d m2 -dropM d (m1 :+: m2) = let m'1 = dropM d m1 - m'2 = dropM (d - dur m1) m2 - in m'1 :+: m'2 -dropM d (Modify (Tempo r) m) = tempo r (dropM (d*r) m) -dropM d (Modify c m) = Modify c (dropM d m) -{-# LINE 426 "MoreMusic.lhs" #-} -removeZeros :: Music a -> Music a -removeZeros (Prim p) = Prim p -removeZeros (m1 :+: m2) = - let m'1 = removeZeros m1 - m'2 = removeZeros m2 - in case (m'1,m'2) of - (Prim (Note 0 p), m) -> m - (Prim (Rest 0 ), m) -> m - (m, Prim (Note 0 p)) -> m - (m, Prim (Rest 0 )) -> m - (m1, m2) -> m1 :+: m2 -removeZeros (m1 :=: m2) = - let m'1 = removeZeros m1 - m'2 = removeZeros m2 - in case (m'1,m'2) of - (Prim (Note 0 p), m) -> m - (Prim (Rest 0 ), m) -> m - (m, Prim (Note 0 p)) -> m - (m, Prim (Rest 0 )) -> m - (m1, m2) -> m1 :=: m2 -removeZeros (Modify c m) = Modify c (removeZeros m) -{-# LINE 534 "MoreMusic.lhs" #-} -type LazyDur = [Dur] -{-# LINE 543 "MoreMusic.lhs" #-} -durL :: Music a -> LazyDur -durL m@(Prim _) = [dur m] -durL (m1 :+: m2) = let d1 = durL m1 - in d1 ++ map (+(last d1)) (durL m2) -durL (m1 :=: m2) = mergeLD (durL m1) (durL m2) -durL (Modify (Tempo r) m) = map (/r) (durL m) -durL (Modify _ m) = durL m -{-# LINE 553 "MoreMusic.lhs" #-} -mergeLD :: LazyDur -> LazyDur -> LazyDur -mergeLD [] ld = ld -mergeLD ld [] = ld -mergeLD ld1@(d1:ds1) ld2@(d2:ds2) = - if d1 Dur -> Dur -minL [] d' = d' -minL [d] d' = min d d' -minL (d:ds) d' = if d < d' then minL ds d' else d' -{-# LINE 571 "MoreMusic.lhs" #-} -takeML :: LazyDur -> Music a -> Music a -takeML [] m = rest 0 -takeML (d:ds) m | d <= 0 = takeML ds m -takeML ld (Prim (Note oldD p)) = note (minL ld oldD) p -takeML ld (Prim (Rest oldD)) = rest (minL ld oldD) -takeML ld (m1 :=: m2) = takeML ld m1 :=: takeML ld m2 -takeML ld (m1 :+: m2) = - let m'1 = takeML ld m1 - m'2 = takeML (map (\d -> d - dur m'1) ld) m2 - in m'1 :+: m'2 -takeML ld (Modify (Tempo r) m) = tempo r (takeML (map (*r) ld) m) -takeML ld (Modify c m) = Modify c (takeML ld m) -{-# LINE 589 "MoreMusic.lhs" #-} -(/=:) :: Music a -> Music a -> Music a -m1 /=: m2 = takeML (durL m2) m1 :=: takeML (durL m1) m2 -{-# LINE 688 "MoreMusic.lhs" #-} -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) -{-# LINE 710 "MoreMusic.lhs" #-} -trilln :: Int -> Int -> Music Pitch -> Music Pitch -trilln i nTimes m = trill i (dur m / fromIntegral nTimes) m -{-# LINE 715 "MoreMusic.lhs" #-} -trilln' :: Int -> Int -> Music Pitch -> Music Pitch -trilln' i nTimes m = trilln (negate i) nTimes (transpose i m) -{-# LINE 722 "MoreMusic.lhs" #-} -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 -{-# LINE 736 "MoreMusic.lhs" #-} -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 -{-# LINE 763 "MoreMusic.lhs" #-} -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" -{-# LINE 782 "MoreMusic.lhs" #-} -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" -{-# LINE 839 "MoreMusic.lhs" #-} -data PercussionSound = - AcousticBassDrum -- MIDI Key 35 - | BassDrum1 -- MIDI Key 36 - | SideStick -- ... - | AcousticSnare | HandClap | ElectricSnare | LowFloorTom - | ClosedHiHat | HighFloorTom | PedalHiHat | LowTom - | OpenHiHat | LowMidTom | HiMidTom | CrashCymbal1 - | HighTom | RideCymbal1 | ChineseCymbal | RideBell - | Tambourine | SplashCymbal | Cowbell | CrashCymbal2 - | Vibraslap | RideCymbal2 | HiBongo | LowBongo - | MuteHiConga | OpenHiConga | LowConga | HighTimbale - | LowTimbale | HighAgogo | LowAgogo | Cabasa - | Maracas | ShortWhistle | LongWhistle | ShortGuiro - | LongGuiro | Claves | HiWoodBlock | LowWoodBlock - | MuteCuica | OpenCuica | MuteTriangle - | OpenTriangle -- MIDI Key 82 - deriving (Show,Eq,Ord,Enum) -{-# LINE 869 "MoreMusic.lhs" #-} -perc :: PercussionSound -> Dur -> Music Pitch -perc ps dur = note dur (pitch (fromEnum ps + 35)) -{-# LINE 896 "MoreMusic.lhs" #-} -funkGroove :: Music Pitch -funkGroove - = let p1 = perc LowTom qn - p2 = perc AcousticSnare en - in tempo 3 $ instrument Percussion $ takeM 8 $ repeatM - ( ( p1 :+: qnr :+: p2 :+: qnr :+: p2 :+: - p1 :+: p1 :+: qnr :+: p2 :+: enr) - :=: roll en (perc ClosedHiHat 2) ) -{-# LINE 962 "MoreMusic.lhs" #-} -pMap :: (a -> b) -> Primitive a -> Primitive b -pMap f (Note d x) = Note d (f x) -pMap f (Rest d) = Rest d -{-# LINE 969 "MoreMusic.lhs" #-} -mMap :: (a -> b) -> Music a -> Music b -mMap f (Prim p) = Prim (pMap f p) -mMap f (m1 :+: m2) = mMap f m1 :+: mMap f m2 -mMap f (m1 :=: m2) = mMap f m1 :=: mMap f m2 -mMap f (Modify c m) = Modify c (mMap f m) -{-# LINE 982 "MoreMusic.lhs" #-} -type Volume = Int -{-# LINE 988 "MoreMusic.lhs" #-} -addVolume :: Volume -> Music Pitch -> Music (Pitch,Volume) -addVolume v = mMap (\p -> (p,v)) -{-# LINE 1022 "MoreMusic.lhs" #-} -data NoteAttribute = - Volume Int -- MIDI convention: 0=min, 127=max - | Fingering Integer - | Dynamics String - | Params [Double] - deriving (Eq, Show) -{-# LINE 1064 "MoreMusic.lhs" #-} -mFold :: (Primitive a -> b) -> (b->b->b) -> (b->b->b) -> - (Control -> b -> b) -> Music a -> b -mFold f (+:) (=:) g m = - let rec = mFold f (+:) (=:) g - in case m of - Prim p -> f p - m1 :+: m2 -> rec m1 +: rec m2 - m1 :=: m2 -> rec m1 =: rec m2 - Modify c m -> g c (rec m) -{-# LINE 1133 "MoreMusic.lhs" #-} -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)) -{-# LINE 1144 "MoreMusic.lhs" #-} -run, cascade, cascades, final :: Music Pitch -run', cascade', cascades', final' :: Music Pitch -{-# LINE 1149 "MoreMusic.lhs" #-} -run = rep (transpose 5) (delayM tn) 8 (c 4 tn) -cascade = rep (transpose 4) (delayM en) 8 run -cascades = rep id (delayM sn) 2 cascade -{-# LINE 1155 "MoreMusic.lhs" #-} -final = cascades :+: revM cascades -{-# LINE 1159 "MoreMusic.lhs" #-} -run' = rep (delayM tn) (transpose 5) 8 (c 4 tn) -cascade' = rep (delayM en) (transpose 4) 8 run' -cascades' = rep (delayM sn) id 2 cascade' -final' = cascades' :+: revM cascades' diff --git a/Euterpea/Music/Note/Music.hs b/Euterpea/Music/Note/Music.hs deleted file mode 100644 --- a/Euterpea/Music/Note/Music.hs +++ /dev/null @@ -1,225 +0,0 @@ -{-# LINE 8 "Music.lhs" #-} --- This code was automatically generated by lhs2tex --code, from the file --- HSoM/Music.lhs. (See HSoM/MakeCode.bat.) -{-# LINE 25 "Music.lhs" #-} -module Euterpea.Music.Note.Music where -infixr 5 :+:, :=: -{-# LINE 51 "Music.lhs" #-} -type Octave = Int -{-# LINE 63 "Music.lhs" #-} -type Pitch = (PitchClass, Octave) -{-# LINE 80 "Music.lhs" #-} -type Dur = Rational -{-# LINE 116 "Music.lhs" #-} -data PitchClass = Cff | Cf | C | Dff | Cs | Df | Css | D | Eff | Ds - | Ef | Fff | Dss | E | Ff | Es | F | Gff | Ess | Fs - | Gf | Fss | G | Aff | Gs | Af | Gss | A | Bff | As - | Bf | Ass | B | Bs | Bss - deriving (Show, Eq, Ord, Read, Enum, Bounded) -{-# LINE 218 "Music.lhs" #-} -data Primitive a = Note Dur a - | Rest Dur - deriving (Show, Eq, Ord) -{-# LINE 271 "Music.lhs" #-} -data Music a = - Prim (Primitive a) -- primitive value - | Music a :+: Music a -- sequential composition - | Music a :=: Music a -- parallel composition - | Modify Control (Music a) -- modifier - deriving (Show, Eq, Ord) -{-# LINE 390 "Music.lhs" #-} -data Control = - Tempo Rational -- scale the tempo - | Transpose AbsPitch -- transposition - | Instrument InstrumentName -- instrument label - | Phrase [PhraseAttribute] -- phrase attributes - | Player PlayerName -- player label - | KeySig PitchClass Mode -- key signature and mode - deriving (Show, Eq, Ord) - -type PlayerName = String -data Mode = Major | Minor - deriving (Show, Eq, Ord) -{-# LINE 420 "Music.lhs" #-} -data InstrumentName = - AcousticGrandPiano | BrightAcousticPiano | ElectricGrandPiano - | HonkyTonkPiano | RhodesPiano | ChorusedPiano - | Harpsichord | Clavinet | Celesta - | Glockenspiel | MusicBox | Vibraphone - | Marimba | Xylophone | TubularBells - | Dulcimer | HammondOrgan | PercussiveOrgan - | RockOrgan | ChurchOrgan | ReedOrgan - | Accordion | Harmonica | TangoAccordion - | AcousticGuitarNylon | AcousticGuitarSteel | ElectricGuitarJazz - | ElectricGuitarClean | ElectricGuitarMuted | OverdrivenGuitar - | DistortionGuitar | GuitarHarmonics | AcousticBass - | ElectricBassFingered | ElectricBassPicked | FretlessBass - | SlapBass1 | SlapBass2 | SynthBass1 - | SynthBass2 | Violin | Viola - | Cello | Contrabass | TremoloStrings - | PizzicatoStrings | OrchestralHarp | Timpani - | StringEnsemble1 | StringEnsemble2 | SynthStrings1 - | SynthStrings2 | ChoirAahs | VoiceOohs - | SynthVoice | OrchestraHit | Trumpet - | Trombone | Tuba | MutedTrumpet - | FrenchHorn | BrassSection | SynthBrass1 - | SynthBrass2 | SopranoSax | AltoSax - | TenorSax | BaritoneSax | Oboe - | Bassoon | EnglishHorn | Clarinet - | Piccolo | Flute | Recorder - | PanFlute | BlownBottle | Shakuhachi - | Whistle | Ocarina | Lead1Square - | Lead2Sawtooth | Lead3Calliope | Lead4Chiff - | Lead5Charang | Lead6Voice | Lead7Fifths - | Lead8BassLead | Pad1NewAge | Pad2Warm - | Pad3Polysynth | Pad4Choir | Pad5Bowed - | Pad6Metallic | Pad7Halo | Pad8Sweep - | FX1Train | FX2Soundtrack | FX3Crystal - | FX4Atmosphere | FX5Brightness | FX6Goblins - | FX7Echoes | FX8SciFi | Sitar - | Banjo | Shamisen | Koto - | Kalimba | Bagpipe | Fiddle - | Shanai | TinkleBell | Agogo - | SteelDrums | Woodblock | TaikoDrum - | MelodicDrum | SynthDrum | ReverseCymbal - | GuitarFretNoise | BreathNoise | Seashore - | BirdTweet | TelephoneRing | Helicopter - | Applause | Gunshot | Percussion - | Custom String -{-# LINE 469 "Music.lhs" #-} - deriving (Show, Eq, Ord) -{-# LINE 479 "Music.lhs" #-} -data PhraseAttribute = Dyn Dynamic - | Tmp Tempo - | Art Articulation - | Orn Ornament - deriving (Show, Eq, Ord) - -data Dynamic = Accent Rational | Crescendo Rational | Diminuendo Rational - | StdLoudness StdLoudness | Loudness Rational - deriving (Show, Eq, Ord) - -data StdLoudness = PPP | PP | P | MP | SF | MF | NF | FF | FFF - deriving (Show, Eq, Ord, Enum) - -data Tempo = Ritardando Rational | Accelerando Rational - deriving (Show, Eq, Ord) - -data Articulation = Staccato Rational | Legato Rational | Slurred Rational - | Tenuto | Marcato | Pedal | Fermata | FermataDown | Breath - | DownBow | UpBow | Harmonic | Pizzicato | LeftPizz - | BartokPizz | Swell | Wedge | Thumb | Stopped - deriving (Show, Eq, Ord) - -data Ornament = Trill | Mordent | InvMordent | DoubleMordent - | Turn | TrilledTurn | ShortTrill - | Arpeggio | ArpeggioUp | ArpeggioDown - | Instruction String | Head NoteHead - | DiatonicTrans Int - deriving (Show, Eq, Ord) - -data NoteHead = DiamondHead | SquareHead | XHead | TriangleHead - | TremoloHead | SlashHead | ArtHarmonic | NoHead - deriving (Show, Eq, Ord) -{-# LINE 535 "Music.lhs" #-} -note :: Dur -> a -> Music a -note d p = Prim (Note d p) - -rest :: Dur -> Music a -rest d = Prim (Rest d) - -tempo :: Dur -> Music a -> Music a -tempo r m = Modify (Tempo r) m - -transpose :: AbsPitch -> Music a -> Music a -transpose i m = Modify (Transpose i) m - -instrument :: InstrumentName -> Music a -> Music a -instrument i m = Modify (Instrument i) m - -phrase :: [PhraseAttribute] -> Music a -> Music a -phrase pa m = Modify (Phrase pa) m - -player :: PlayerName -> Music a -> Music a -player pn m = Modify (Player pn) m - -keysig :: PitchClass -> Mode -> Music a -> Music a -keysig pc mo m = Modify (KeySig pc mo) m -{-# LINE 592 "Music.lhs" #-} -cff,cf,c,cs,css,dff,df,d,ds,dss,eff,ef,e,es,ess,fff,ff,f, - fs,fss,gff,gf,g,gs,gss,aff,af,a,as,ass,bff,bf,b,bs,bss :: - Octave -> Dur -> Music Pitch - -cff o d = note d (Cff, o); cf o d = note d (Cf, o) -c o d = note d (C, o); cs o d = note d (Cs, o) -css o d = note d (Css, o); dff o d = note d (Dff, o) -df o d = note d (Df, o); d o d = note d (D, o) -ds o d = note d (Ds, o); dss o d = note d (Dss, o) -eff o d = note d (Eff, o); ef o d = note d (Ef, o) -e o d = note d (E, o); es o d = note d (Es, o) -ess o d = note d (Ess, o); fff o d = note d (Fff, o) -ff o d = note d (Ff, o); f o d = note d (F, o) -fs o d = note d (Fs, o); fss o d = note d (Fss, o) -gff o d = note d (Gff, o); gf o d = note d (Gf, o) -g o d = note d (G, o); gs o d = note d (Gs, o) -gss o d = note d (Gss, o); aff o d = note d (Aff, o) -af o d = note d (Af, o); a o d = note d (A, o) -as o d = note d (As, o); ass o d = note d (Ass, o) -bff o d = note d (Bff, o); bf o d = note d (Bf, o) -b o d = note d (B, o); bs o d = note d (Bs, o) -bss o d = note d (Bss, o) -{-# LINE 622 "Music.lhs" #-} -bn, wn, hn, qn, en, sn, tn, sfn, dwn, dhn, - dqn, den, dsn, dtn, ddhn, ddqn, dden :: Dur - -bnr, wnr, hnr, qnr, enr, snr, tnr, sfnr, dwnr, dhnr, - dqnr, denr, dsnr, dtnr, ddhnr, ddqnr, ddenr :: Music Pitch - -bn = 2; bnr = rest bn -- brevis rest -wn = 1; wnr = rest wn -- whole note rest -hn = 1/2; hnr = rest hn -- half note rest -qn = 1/4; qnr = rest qn -- quarter note rest -en = 1/8; enr = rest en -- eighth note rest -sn = 1/16; snr = rest sn -- sixteenth note rest -tn = 1/32; tnr = rest tn -- thirty-second note rest -sfn = 1/64; sfnr = rest sfn -- sixty-fourth note rest - -dwn = 3/2; dwnr = rest dwn -- dotted whole note rest -dhn = 3/4; dhnr = rest dhn -- dotted half note rest -dqn = 3/8; dqnr = rest dqn -- dotted quarter note rest -den = 3/16; denr = rest den -- dotted eighth note rest -dsn = 3/32; dsnr = rest dsn -- dotted sixteenth note rest -dtn = 3/64; dtnr = rest dtn -- dotted thirty-second note rest - -ddhn = 7/8; ddhnr = rest ddhn -- double-dotted half note rest -ddqn = 7/16; ddqnr = rest ddqn -- double-dotted quarter note rest -dden = 7/32; ddenr = rest dden -- double-dotted eighth note rest -{-# LINE 662 "Music.lhs" #-} -t251 :: Music Pitch -t251 = let dMinor = d 4 wn :=: f 4 wn :=: a 4 wn - gMajor = g 4 wn :=: b 4 wn :=: d 5 wn - cMajor = c 4 bn :=: e 4 bn :=: g 4 bn - in dMinor :+: gMajor :+: cMajor -{-# LINE 804 "Music.lhs" #-} -type AbsPitch = Int -{-# LINE 810 "Music.lhs" #-} -absPitch :: Pitch -> AbsPitch -absPitch (pc,oct) = 12*oct + pcToInt pc -{-# LINE 864 "Music.lhs" #-} -pcToInt :: PitchClass -> Int -pcToInt pc = case pc of - Cff -> -2; Cf -> -1; C -> 0; Cs -> 1; Css -> 2; - Dff -> 0; Df -> 1; D -> 2; Ds -> 3; Dss -> 4; - Eff -> 2; Ef -> 3; E -> 4; Es -> 5; Ess -> 6; - Fff -> 3; Ff -> 4; F -> 5; Fs -> 6; Fss -> 7; - Gff -> 5; Gf -> 6; G -> 7; Gs -> 8; Gss -> 9; - Aff -> 7; Af -> 8; A -> 9; As -> 10; Ass -> 11; - Bff -> 9; Bf -> 10; B -> 11; Bs -> 12; Bss -> 13 -{-# LINE 895 "Music.lhs" #-} -pitch :: AbsPitch -> Pitch -pitch ap = - let (oct, n) = divMod ap 12 - in ([C,Cs,D,Ds,E,F,Fs,G,Gs,A,As,B] !! n, oct) -{-# LINE 918 "Music.lhs" #-} -trans :: Int -> Pitch -> Pitch -trans i p = pitch (absPitch p + i) diff --git a/Euterpea/Music/Note/Performance.hs b/Euterpea/Music/Note/Performance.hs deleted file mode 100644 --- a/Euterpea/Music/Note/Performance.hs +++ /dev/null @@ -1,211 +0,0 @@ -{-# LINE 8 "Performance.lhs" #-} --- This code was automatically generated by lhs2tex --code, from the file --- HSoM/Performance.lhs. (See HSoM/MakeCode.bat.) -{-# LINE 18 "Performance.lhs" #-} -{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-} - -module Euterpea.Music.Note.Performance where - -import Euterpea.Music.Note.Music -import Euterpea.Music.Note.MoreMusic -{-# LINE 55 "Performance.lhs" #-} -type Performance = [Event] - -data Event = Event { eTime :: PTime, - eInst :: InstrumentName, - ePitch :: AbsPitch, - eDur :: DurT, - eVol :: Volume, - eParams :: [Double]} - deriving (Show,Eq,Ord) -{-# LINE 73 "Performance.lhs" #-} -type PTime = Rational -type DurT = Rational -{-# LINE 143 "Performance.lhs" #-} -data Context a = Context { cTime :: PTime, - cPlayer :: Player a, - cInst :: InstrumentName, - cDur :: DurT, - cPch :: AbsPitch, - cVol :: Volume, - cKey :: (PitchClass, Mode) } - deriving Show -{-# LINE 164 "Performance.lhs" #-} -metro :: Int -> Dur -> DurT -metro setting dur = 60 / (fromIntegral setting * dur) -{-# LINE 191 "Performance.lhs" #-} -type PMap a = PlayerName -> Player a -{-# LINE 339 "Performance.lhs" #-} -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 -{-# LINE 351 "Performance.lhs" #-} -perform :: PMap a -> Context a -> Music a -> Performance -perform 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 (Player pn) m -> perf pm (c {cPlayer = pm pn}) m - Modify (Phrase pas) m -> interpPhrase pl pm c pas m -{-# LINE 474 "Performance.lhs" #-} -type Note1 = (Pitch, [NoteAttribute]) -type Music1 = Music Note1 -{-# LINE 480 "Performance.lhs" #-} -toMusic1 :: Music Pitch -> Music1 -toMusic1 = mMap (\p -> (p, [])) - -toMusic1' :: Music (Pitch, Volume) -> Music1 -toMusic1' = mMap (\(p, v) -> (p, [Volume v])) -{-# LINE 507 "Performance.lhs" #-} -data Player a = MkPlayer { pName :: PlayerName, - playNote :: NoteFun a, - interpPhrase :: PhraseFun a, - notatePlayer :: NotateFun a } - -type NoteFun a = Context a -> Dur -> a -> Performance -type PhraseFun a = PMap a -> Context a -> [PhraseAttribute] - -> Music a -> (Performance, DurT) -type NotateFun a = () - -instance Show a => Show (Player a) where - show p = "Player " ++ pName p -{-# LINE 535 "Performance.lhs" #-} -defPlayer :: Player Note1 -defPlayer = MkPlayer - { pName = "Default", - playNote = defPlayNote defNasHandler, - interpPhrase = defInterpPhrase defPasHandler, - notatePlayer = () } -{-# LINE 554 "Performance.lhs" #-} -defPlayNote :: (Context (Pitch,[a]) -> a -> Event-> Event) - -> NoteFun (Pitch, [a]) -defPlayNote nasHandler - c@(Context cTime cPlayer cInst cDur cPch cVol cKey) d (p,nas) = - let initEv = Event { eTime = cTime, eInst = cInst, - eDur = d * cDur, eVol = cVol, - ePitch = absPitch p + cPch, - eParams = [] } - in [ foldr (nasHandler c) initEv nas ] - -defNasHandler :: Context a -> NoteAttribute -> Event -> Event -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 -{-# LINE 686 "Performance.lhs" #-} -defPMap :: PMap Note1 -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 } -{-# LINE 815 "Performance.lhs" #-} -fancyPlayer :: Player (Pitch, [NoteAttribute]) -fancyPlayer = MkPlayer { pName = "Fancy", - playNote = defPlayNote defNasHandler, - interpPhrase = fancyInterpPhrase, - notatePlayer = () } - -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@Event {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@Event {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 -{-# LINE 879 "Performance.lhs" #-} -class Performable a where - perfDur :: PMap Note1 -> Context Note1 -> Music a -> (Performance, DurT) -{-# LINE 888 "Performance.lhs" #-} -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 diff --git a/Euterpea/Music/Signal/SpectrumAnalysis.hs b/Euterpea/Music/Signal/SpectrumAnalysis.hs deleted file mode 100644 --- a/Euterpea/Music/Signal/SpectrumAnalysis.hs +++ /dev/null @@ -1,63 +0,0 @@ -{-# LINE 8 "SpectrumAnalysis.lhs" #-} --- This code was automatically generated by lhs2tex --code, from the file --- HSoM/SpectrumAnalysis.lhs. (See HSoM/MakeCode.bat.) -{-# LINE 18 "SpectrumAnalysis.lhs" #-} -{-# LANGUAGE Arrows #-} - -module Euterpea.Music.Signal.SpectrumAnalysis where - -import Euterpea -import Euterpea.Experimental (fftA) - -import Data.Complex (Complex ((:+)), polar) -import Data.Maybe (listToMaybe, catMaybes) -{-# LINE 560 "SpectrumAnalysis.lhs" #-} -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] ] -{-# LINE 583 "SpectrumAnalysis.lhs" #-} -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) -{-# LINE 610 "SpectrumAnalysis.lhs" #-} -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 ' ') -{-# LINE 679 "SpectrumAnalysis.lhs" #-} -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) diff --git a/HSoM/Additive.lhs b/HSoM/Additive.lhs deleted file mode 100644 --- a/HSoM/Additive.lhs +++ /dev/null @@ -1,965 +0,0 @@ -%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- - -%include lhs2TeX.fmt -%include myFormat.fmt - -\out{ -\begin{code} --- This code was automatically generated by lhs2tex --code, from the file --- HSoM/Additive.lhs. (See HSoM/MakeCode.bat.) - -\end{code} -} - -\chapter{Additive and Subtractive Synthesis} -\label{ch:additive} - -\begin{code} -{-# LANGUAGE Arrows #-} - -module Euterpea.Examples.Additive where -import Euterpea -\end{code} - -There are many techniques for synthesizing sound. In this chapter we -will discuss two of them: \emph{additive synthesis} and -\emph{subtractive synthesis}. In practice it is rare for either of -these, or any of the ones discussed in future chapters, to be utilized -alone---a typical application may in fact employ all of them. But it -is helpful to \emph{study} them in isolation, so that the sound -designer has a suitably rich toolbox of techniques at his or her -disposal. - -\emph{Additive synthesis} is, conceptually at least, the simplest of -the many sound synthesis techniques. Simply put, the idea is to add -signals (usually sine waves of differing amplitudes, frequencies and -phases) together to form a sound of interest. It is based on -Fourier's theorem as discussed in the previous chapter, and indeed is -sometimes called \emph{Fourier synthesis}. - -\emph{Subtractive synthesis} is the dual of additive synthesis. The -basic ideas is to start with a signal rich in harmonoc content, and -seletively ``remove'' signals to create a desired effect. - -In understanding the difference between the two, it is helpful to -consider the following analogy to art: -\begin{itemize} -\item Additive synthesis is like painting a picture---each stroke of - the brush, each color, each shape, each texture, and so on, adds to - the artist's conception of the final artistic artifact. -\item In contract, subtractive synthesis is like creating a sculpture - from stone---each stroke of the chisel takes away material that is - unwanted, eventually revealing the artist's conception of what the - artistic artifact should be. -\end{itemize} - -Additive synthesis in the context of Euterpea will be discussed in -Section \ref{sec:additive}, and substractive synthesis in Section -\ref{sec:subtractive}. - -\section{Additive Synthesis} -\label{sec:additive} - -\subsection{Preliminaries} - -When doing pure additive synthesis it is often convenient to work with -a \emph{list of signal sources} whose elements are eventually summed -together to form a result. To facilitate this, we define a few -auxiliary functions, as shown in Figure~\ref{fig:foldSF}. - -|constSF s sf| simply lifts the value |s| to the signal function -level, and composes that with |sf|, thus yielding a signal source. - -|foldSF f b sfs| is analogous to |foldr| for lists: it returns the -signal source |constA b| if the list is empty, and otherwise uses |f| -to combine the results, pointwise, from the right. In other words, if -|sfs| has the form: -\begin{spec} -[sf1, sf2, ..., sfn] -\end{spec} -%% sf1 : sf2 : ... : sfn : [] -then the result will be: -\begin{spec} -proc () -> do - s1 <- sf1 -< () - s2 <- sf2 -< () - ... - sn <- sfn -< () - outA -< f s1 (f s2 ( ... (f sn b))) -\end{spec} - -\begin{figure} -\begin{spec} -constSF :: Clock c => a -> SigFun c a b -> SigFun c () b -constSF s sf = constA s >>> sf - -foldSF :: Clock c => - (a -> b -> b) -> b -> [SigFun c () a] -> SigFun c () b -foldSF f b sfs = - foldr g (constA b) sfs where - g sfa sfb = - proc () -> do - s1 <- sfa -< () - s2 <- sfb -< () - outA -< f s1 s2 -\end{spec} -\caption{Working With Lists of Signal Sources} -\label{fig:foldSF} -\end{figure} - -\syn{|constSF| and |foldSF| are actually predefined in Euterpea, but - with slightly more general types: -\begin{spec} -constSF :: Arrow a => b -> a b d -> a c d -foldSF :: Arrow a => (b -> c -> c) -> c -> [a () b] -> a () c -\end{spec} -The more specific types shown in Figure~\ref{fig:foldSF} reflect how -we will use the functions in this chapter.} - -\subsection{Overtone Synthsis} - -Perhaps the simplest form of additive synthesis is combining a sine -wave with some of its overtones to create a rich sound that is closer -in harmonic content to that of a real instrument, as discussed in -Chapter \ref{ch:signals}. Indeed, in Chapter \ref{ch:sigfuns} we saw -several ways to do this using built-in Euterpea signal functions. -For example, recall the function: -\begin{spec} -oscPartials :: Clock c => - Table -> Double -> SigFun c (Double,Int) Double -\end{spec} -|oscPartials tab ph| is a signal function whose pair of dynamic inputs -determines the frequency, as well as the number of harmonics of that -frequency, of the output. So this is a ``built-in'' notion of -additive synthesis. A problem with this approach in modelling a -conventional instrument is that the partials all have the same -strength, which does not reflect the harmonic content of most physical -instruments. - -A more sophisticated approach, also described in Chapter -\ref{ch:sigfuns}, is based on various ways to build look-up tables. -In particular, this function was defined: -\begin{spec} -tableSines3 :: - TableSize -> [(PartialNum, PartialStrength, PhaseOffset)] -> Table -\end{spec} -Recall that |tableSines3 size triples| is a table of size |size| that -represents a sinusoidal wave and an arbitrary number of partials, -whose relationship to the fundamental frequency, amplitude, and phase -are determined by each of the triples in |triples|. - -\subsection{Resonance and Standing Waves} -\label{sec:resonance} - -As we know from Fourier's Theorem, any periodic signal can be -represented as a sum of a fundemental frequency and multiples of that -fundamental frequency. We also know that a musical instrument's sound -consists primarily of the sum of a fundamental frequency (the -preceived pitch) and some of the multiples of that pitch (called -harmonics, partials, or overtones). But what is it that makes a -musical instrument behave this way in the first place? Answering this -question can help us in understanding how to use additive synthesis to -generate an instrument sound, but becomes even more important in -Chapter~\ref{physical-modeling} where we attempt to model the physical -attributes of a particular instrument. - -\subsubsection{String Instruments} -\label{sec:string-instruments} - -To answer this question, let's start with a simple string, fixed at -both ends. Now imagine that energy is inserted at some point along -the string---perhaps by a finger pluck, a guitar pick, a violin bow, -or the hammer on a piano. This energy will cause the string to -vibrate in some way. The energy will flow along the string as a wave, -just like a pebble dropped in water, except that the energy only flows -in one dimension, i.e.\ only along the orientation of the string. How -fast the wave travels will depend on the string material and how taut -it is. For example, the tauter the string, the faster the wave -travels. - -Because the ends of the string are fixed, however, the string can only -vibrate in certain ways, which are called \emph{modes}, or -\emph{resonances}. The most obvious mode for a string is shown in -Figure~\ref{fig:string-mode}a, where the center of the string is -moving up and down, say, and the end-points do not move at all. -Energy that is not directly contributing to a particular mode is -quickly absorbed by the fixed endpoints. A mode is sometimes called a -"standing wave" since it appears to be standing still---it does not -seem to be moving up or down the string. But another way to think of -it is that the energy in the string is being \emph{reflected back} at -each endpoint of the string, and those reflections reinforce each -other to form the standing wave. - -%% Now, when this energy wave hits the end of the string, i.e.\ where -%% it is fixed, it has to go somewhere. If the fixed point is -%% sufficiently firm, that energy will therefore be reflected back -%% along the string, like a ball bouncing off of a wall---it has -%% nowhere else to go. And like waves in the water, those waves -%% traveling in opposite directions on the string just pass through -%% one another. - -Eventually, of course, even the energy in a mode will dissipate, for -three reasons: (1) since the ends of the string are never perfectly -fixed, the reflections are not perfect either, and thus some energy is -absorbed, (2) the movement of the string creates friction in the -string material, generating heat and also absorbing energy, and (3) -the transverse vibration of the string induces a longitudinal -vibration in the air---i.e.\ the sound we hear---and that also absorbs -some energy. - -%% However, some of the reflected energy will actually -%% \emph{reinforce} energy traveling in the other direction, and will -%% thus take much longer to die out. This is what forms what is -%% called a "standing wave," because the perfect alignment of these -%% supporting waves depends precisely on the length and tautness of of -%% the string, and so appears to "stand still." It is also what -%% accounts for the "resonant frequency," i.e.\ the perceived pitch. - -To better understand the nature of modes, suppose a pulse of energy is -introduced at one end of the string. If $v$ is the velocity of the -resulting wave traveling along the string, and $\lambda$ is the string -length, then it takes $\lambda/v$ seconds for a wave to travel the -length of the string, and $p = 2\lambda/v$ for it to travel up and -back. So if the pulse is repeated every $p$ seconds, it will -reinforce the previous pulse. If we think of $p$ as the period of a -periodic signal, its frequency in Hertz is the \emph{reciprocol} of -the period $p$, namely: -\[ f_0 = v / (2\lambda) \] -Indeed, this is the frequency of the mode shown in -Figure~\ref{fig:string-mode}a, and corresponds to the fundamental -frequency, i.e.\ the observed pitch. - -\begin{figure}[hbtp] -\centering -\includegraphics[height=8.5in]{pics/DPlots/StringModes.eps} -\caption{The Modes of a Stringed Instrument} -\label{fig:string-mode} -\end{figure} - -But note that this is not the only possible mode---another is shown in -Figure~\ref{fig:string-mode}b. This mode can be interpreted as -repeating the pulse of energy inserted at the end of the string every -$p/2$ seconds, thus corresponding to a frequency of: -\[ f_1 = 1/(p/2) = v / \lambda = 2f_0 \] -In other words, this is the first overtone. - -Indeed, each subsequent mode corresponds to an overtone, and can be -derived in the same way. A pulse of energy every $p/n$ seconds -corresponds to the (n-1)th overtone with frequency $nf_0$ Hz. -Figure~\ref{fig:string-mode} shows these derivations for the first -four modes; i.e.\ the fundamental plus three overtones. - -Note: The higher overtones generally---but not always---decay more -quickly primarily because they are generated by a quicker bending of -the string, causing more friction and a quicker loss of energy. - -%% We can plot this phonomenon as shown in -%% Figure~\ref{fig:string-resonance}. At the top of the figure is the -%% string, fixed at both ends. The first plot below that corresponds to -%% the fundamental resonant frequency. Further below are the first -%% couple of partials. - -\subsubsection{Wind Instruments} -\label{sec:wind-instruments} - -Resonances in other musical instruments behave similarly. But in the -case of a wind instrument, there a couple of important differences. -First of all, the resonance happens within the air itelf, rather than -a string. For example, a clarinet can be thought of as a -\emph{cylindical tube} closed at one end. The closed end is the -mouthpiece, and the open end is called the "bell." The closed end, -like the fixed end of a string, reflects energy directly back in the -opposite direction. But because the open end is open, it behaves -differently. In particular, as energy (a wave) escapes the open end, -its pressure is dissipated into the air. This causes a pressure drop -that induces a negative pressure---i.e.\ a vacumm---in the opposite -direction, causing the wave to reflect back, \emph{but inverted}! - -%% A wave traveling toward the mouthpiece, on the other hand, is like -%% the fixed end of a string---it is reflected back uninverted. - -Unfortuntely, we cannot easily visualize the standing wave in a -clarinet, partly because the air is invisible, but also because, (1) -the wave is \emph{longitudinal}, whereas for a string it is -transverse, and (2) as just discussed, the open end inverts the signal -upon reflection. The best we can do is create a transverse -representation. For example, Figure~\ref{fig:clarinet-mode}a -represents the fundamental mode, or fundamantal frequency. Note that -the left, closed end looks the same as for a fixed string---i.e.\ it -is at the zero crossing of the sine wave. But the right end is -different---it is intended to depict the inversion at the open end of -the clarinet as the maximum absolute value of the sine wave. If the -signal comes in at +1, it is inverted to the value -1, and so on. - -Analogously to our detailed analysis of a string, we can analyze a -clarinet's acoustic behavior as follows: Suppose a pulse of energy is -introduced at the mouthpiece (i.e.\ closed end). If $v$ is the -velocity of sound in the air, and $\lambda$ is the length of the -clarinet, that wave appears at the open end in $\lambda/v$ seconds. -Its \emph{inverted} reflection then appears back at the mouthpiece in -$2*\lambda/v$ seconds. But because it is inverted, \emph{it will -cancel out another pulse emitted $2*\lambda/v$ seconds after the -first!} On the other hand, suppose we let that reflection bounce off -the closed end, travel back to the open end to be inverted a second -time, and then return to the closed end. Two inversions are like no -inversion at all, and so if we were to insert another pulse of energy -at that moment, the two signals will be "in synch." In other words, -if we repeat the pulse every $4\lambda/v$ seconds, the peaks and the -troughs of the signals line up, and they will reinforce one another. -This corresponds to a frequency of: -\[ f_0 = v / (4\lambda) \] -and is in fact the fundamental mode, i.e.\ fundamental frequency, of -the clarinet. This situation corresponds precisely to -Figure~\ref{fig:clarinet-mode}a. - -\begin{figure}[hbtp] -\centering -\includegraphics[height=8.5in]{pics/DPlots/ClarinetModes.eps} -\vspace{ -.2in} -\caption{The Modes of a Clarinet Seen as a Cylindrical Tube} -\label{fig:clarinet-mode} -\end{figure} - -Now here is the interesting part: If we were to double the pulse rate -in hopes of generating the first overtone, we arrive precisely at the -situation we were in above: the signals cancel out. Thus, \emph{a -clarinet has no first overtone!} On the other hand, if we triple the -pulse rate, the signals line up again, corresponding to a frequency -of: -\[ f_1 = v / ((4/3)\lambda) = (3v)/(4\lambda) = 3f_0 \] -This is the clarinet's second mode, and corresponds to -Figure~\ref{fig:clarinet-mode}b. - -By a similar argument, it can be shown that all the even overtones of -a clarinet don't exist (or, equivalently, have zero amplitude), -whereas all of the odd overtones do exist. -Figure~\ref{fig:clarinet-mode} shows the first three modes of a -clarinet, corresponding to the fundamental frequency, and third and -fifth overtones. (Note, by the way, the similarity of this to the -spectral content of a square wave.) - -[Todo: discuss other wind instruments] - -%% Quote from somewhere: A clarinet is an example of a cylindrical -%% bore instrument closed at one end. Hence, the normal resonant -%% modes must have a pressure maximum at the closed end (the -%% mouthpiece) and a pressure minimum near the first open key (or the -%% bell). These conditions result in the presence of only odd -%% harmonics in the sound. This contrasts to the saxophone or oboe, -%% which have a conical bore and hence include the even harmonics. - -%% Consider changing the cylindrical tube diagrams so that the signals -%% are shifted by 90 degrees, with the idea that the ``zero crossing'' -%% corresponds to minimal energy, and is thus at the open end, not at -%% the mouthpiece. On the other hand, the current figure has a nice -%% analogy to a jump rope fixed at one end, and ``shaken'' at the -%% other. - -\begin{exercise}{\em -If $\omega = 2\pi f$ is the fundamental radial frequency, the sound of -a sustained note for a typical clarinet can be approximated \cite{} by: -\begin{eqnarray*} -s(t) & = & \sin(\omega t)\ +\ 0.75\sin(3\omega t)\ +\ 0.5\sin(5\omega t) + - 0.14\sin(7\omega t)\ \\ - & & +\ 0.5\sin(9\omega t)\ +\ 0.12\sin(11\omega t)\ +\ - 0.17\sin(13\omega t) -\end{eqnarray*} -Define an instrument |clarinet :: Instr (Mono AudRate)| that simulates -this sound. Add an envelope to it to make it more realistic. Then -test it with a simple melody.} -\end{exercise} - -\subsection{Deviating from Pure Overtones} - -Sometimes, however, these built-in functions don't achieve exactly -what we want. In that case, we can define our own, customized notion -of additive synthesis, in whatever way we desire. For a simple -example, traditional harmony is the simultaneous playing of more than -one note at a time, and thus an instance of additive synthesis. More -interestingly, richer sounds can be created by using slightly -``out-of-tune'' overtones; that is, overtones that are not an exact -multiple of the fundamental frequency. For example: -\begin{code} --- TBD -\end{code} -This creates a kind of ``chorusing'' effect, very ``electronic'' in -nature. - -Some real instruments in fact exhibit this kind of behavior, and -sometimes the degree of being ``out of tune'' is not quite fixed. -Here's a variation of the above example where the detuning varies -sinusoidally: -\begin{code} --- TBD -\end{code} - -\subsection{A Bell Sound} - -Synthesizing a bell or gong sound is a good example of ``brute force'' -additive synthesis. Physically, a bell or gong can be thought of as a -bunch of concentric rings, each having a different resonant frequency -because they differ in diameter depending on the shape of the bell. -Some of the rings will be more dominant than others, but the important -thing to note is that these resonant frequencies often do not have an -integral relationship with each other, and sometimes the higher -frequencies can be quite strong, rather than rolling off significantly -as with many other instruments. Indeed, it is sometime difficult to -say exactly what the pitch of a particular bell is (especially large -bells), so complex is its sound. Of course, the pitch of a bell can -be controlled by mimimizing the taper of its shape (especially for -small bells), thus giving it more of a pitched sound. - -In any case, a pitched instrument representing a bell sound can be -designed using additive synthesis by using the instrument's absolute -pitch to create a series of partials that are conspicuously -non-integral multiples of the fundamental. If this sound is then -shaped by an envelope having a sharp rise time and a relatively slow, -exponentially decreasing decay, we get a decent result. A Euterpea -program to achieve this is shown in Figure~\ref{fig:bell1}. Note the -use of |map| to create the list of partials, and |foldSF| to add them -together. Also note that some of the partials are expressed as -\emph{fractions} of the fundamental---i.e.\ their frequencies are less -than that of the fundamental! - -\begin{figure} -\begin{code} -bell1 :: Instr (Mono AudRate) - typecomment(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 = tableSinesN 4096 [1] - -bellTest1 = outFile "bell1.wav" 6 (bell1 6 (absPitch (C,5)) 100 []) -\end{code} -\caption{A Bell Instrument} -\label{fig:bell1} -\end{figure} - -\out{ -\begin{code} -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 - -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)] - -bellTest1' = outFile "bell'1.wav" 6 (bell'1 6 (absPitch (C,5)) 100 []) -\end{code} -} - -The reader might wonder why we don't just use one of Euterpea's table -generating functions, such as |tableSines3| discussed above, to -generate a table with all the desired partials. The problem is, even -though the |PartialNum| argument to |tableSines3| is a |Double|, the -normal intent is that the partial numbers all be integral. To see -why, suppose 1.5 were one of the partial numbers---then 1.5 cycles of -a sine wave would be written into the table. But the whole point of -wavetable lookup synthesis is to repeatedly cycle through the table, -which means that this 1.5 cycle would get repeated, since the -wavetable is a periodic representation of the desired sound. The -situation gets worse with partials such as 4.07, 3.75, 2.74, 0.56, and -so on. - -In any case, we can do even better than |bell1|. An important aspect -of a bell sound that is not captured by the program in -Figure~\ref{fig:bell1} is that the higher-frequency partials tend to -decay more quickly than the lower ones. We can remedy this by giving -each partial its own envelope (recall Section \ref{sec:envelopes}), and -making the duration of the envelope inversely proportional to the -partial number. Such a more sophisticated instrument is shown in -Figure~\ref{fig:bell2}. This results in a much more pleasing and -realistic sound. - -\begin{figure} -\begin{code} -bell2 :: Instr (Mono AudRate) - typecomment(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 - -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 - -bellTest2 = outFile "bell2.wav" 6 (bell2 6 (absPitch (C,5)) 100 []) -\end{code} -\caption{A More Sophisticated Bell Instrument} -\label{fig:bell2} -\end{figure} - -\vspace{.1in}\hrule - -\begin{exercise}{\em -A problem with the more sophisticated bell sound in -Figure~\ref{fig:bell2} is that the duration of the resulting sound -exceeds the specified duration of the note, because some of the -partial numbers are less than one. Fix this.} -\end{exercise} - -\begin{exercise}{\em -Neither of the bell sounds shown in Figures~\ref{fig:bell1} and -\ref{fig:bell2} actually contain the fundamental frequency---i.e. a -partial number of 1.0. Yet they contain the partials at the integer -multiples 2 and 3. How does this affect the result? What happens if -you add in the fundamental?} -\end{exercise} - -\begin{exercise}{\em -Use the idea of the ``more sophisticated bell'' to synthesize sounds -other than a bell. In particular, try using only integral multiples -of the fundamental frequency.} -\end{exercise} - -\vspace{.1in}\hrule - -\out{ ---------------------------------------------------------- -sine f r = - proc () -> do - a1 <- osc f1 0 -< f*r - outA -< a1 - -loop :: [AudSF () Double] -> AudSF () Double -loop [] = constA 0 -loop (sf:sfs) = - proc () -> do - a1 <- sf -< () - a2 <- loop sfs -< () - outA -< a1 + a2 -------------------------------------------------------------------- } - -\section{Subtractive Synthesis} -\label{sec:subtractive} - -As mentioned in the introduction to this chapter, subtractive -synthesis involves starting with a harmonically rich sound source, and -selectively taking away sounds to create a desired effect. In signal -processing terms, we ``take away'' sounds using \emph{filters}. - -\subsection{Filters} - -Filters can be arbitrarily complex, but are characterized by a -\emph{transfer function} that captures, in the frequency domain, how -much of each frequency component of the input is transferred to the -output. Figure \ref{fig:filter-types} shows the general transfer -function for the four most common forms of filters: - -\begin{figure}[hbtp] -\centering -\includegraphics[height=7.5in]{pics/DPlots/FilterTypes.eps} -\vspace{ -.2in} -\caption{Transfer Functions for Four Common Filter Types} -\label{fig:filter-types} -\end{figure} - -\begin{enumerate} -\item -A \emph{low-pass} filter passes low frequencies and rejects -(i.e.\ attenuates) high frequencies. -\item -A \emph{high-pass} filter passes high frequencies and rejects -(i.e.\ attenuates) low frequencies. -\item -A \emph{band-pass} filter passes a particular band of frequencies -while rejecting others. -\item -A \emph{band-reject} (or \emph{band-stop}, or \emph{notch}) filter -rejects a particular band of frequencies, while passing others. -\end{enumerate} -It should be clear that filters can be combined in sequence or in -parallel to achieve more complex transfer functions. For example, a -low-pass and a high-pass filter can be combined in sequence to create -a band-pass filter, and can be combined in parallel to create a -band-reject filter. - -In the case of a low-pass or high-pass filter, the \emph{cut-off - frequency} is usually defined as the point at which the signal is -attenuated by 6dB. A similar strategy is used to define the upper and -lower bounds of the band that is passed by a band-pass filter or -rejected by a band-reject filter, except that the band is usually -specified using a \emph{center frequency} (the midpoint of the band) -and a \emph{bandwidth} {the width of the band). - -It is important to realize that not all filters of a particular type -are alike. Two low-pass filters, for example, may, of course, have -different cutoff frequencies, but even if the cutoff frequencies are -the same, the ``steepness'' of the cutoff curves may be different (a -filter with an ideal step curve for its transfer function does not -exist), and the other parts of the curve might not be the same---they -are never completely flat or even linear, and might not even be -monotonically increasing or decreasing. (Although the diagrams in -Figure~\ref{fig:filter-types} at least do not show a step curve, they -are stll over-simplified in the smoothness and flatness of the -curves.) Furthermore, all filters have some degree of \emph{phase - distortion}, which is to say that the transferred phase angle can -vary with frequency. - -In the digital domain, filters are often described using -\emph{recurrence equations} of varying degrees, and there is an -elegant theory of filter design that can help predict and therefore -control the various characteristics mentioned above. However, this -theory is beyond the scope of this textbook. A good book on digital -signal processing will elaborate on these issues in detail. - -\subsection{Euterpea's Filters} -\label{sec:euterpea-filters} - -Instead of designing our own filters, we will use a set of pre-defined -filters in Euterpea that are adequate for most sound synthesis -applications. Their type sinatures are shown in -Figure~\ref{fig:euterpea-filters}. As you can see, each of the filter -types discussed previously is included, but their use requires a bit -more explanation. - -\begin{figure} -\begin{spec} -filterLowPass, filterHighPass, filterLowPassBW, filterHighPassBW :: - Clock p => SigFun p (Double, Double) Double - -filterBandPass, filterBandStop :: - Clock p => Int -> SigFun p (Double, Double, Double) Double - -filterBandPassBW, filterBandStopBW :: - Clock p => SigFun p (Double, Double, Double) Double -\end{spec} -\caption{Euterpea's Filters} -\label{fig:euterpea-filters} -\end{figure} - -First of all, all of the filters ending in ``|BW|'' are what are called -\emph{Butterworth filters}, which are based on a second-order filter -design that represents a good balance of filter characteristics: a -good cutoff steepness, little phase distortion, and a reasonably flat -response in both the pass and reject regions. Those filters without -the |BW| suffix are first-order filters whose characteristics are not -quite as good as the Butterworth filters, but are computationally more -efficient. - -In addition, the following points help explain the details of specific -Euterpea filters: -\begin{itemize} -\item -|filterLowPass| is a signal function whose input is a pair consisting -of the signal being filtered, and the cutoff frequency (in that -order). Note that this means the cutoff frequency can be varied -dynamically. |filterHighPass|, |filterLowPassBW|, and -|filterHighPassBW| behave analogously. -\item -|filterBandPassBW| is a signal function taking a triple as input: the -signal being filtered, the center frequency of the band, and the width -of the band, in that order. For example: -\begin{spec} -... -filterBandPassBW -< (s, 2000, 100) -... -\end{spec} -will pass the frequencies in |s| that are in the range 1950 to 2050 -Hz, and reject the others. |filterBandStop| behaves analogously. -\item -|filterBandPass| and |filterBandStop| also behave analogously, except -that they take a static |Int| argument, let's call it |m|, that has -the following effect on the magnitude of the output: -\begin{itemize} -\item -|m = 0| signifies no scaling of the output signal. -\item -|m = 1| signifies a peak response factor of 1; i.e.\ all -frequencies other than the center frequency are attenuated in accordance with -a normalized response curve. -\item -|m = 2| raises the response factor so that the output signal's overall -RMS value equals 1. -\end{itemize} -\end{itemize} - -\subsection{Noisy Sources} - -Returning to the art metaphor at the beginning of this chapter, -filters are like the chisels and other tools that a sculptor might use -to fashion his or her work. But what about the block of stone that -the sculptor begins with? What is the sound synthesis analogy to -that? - -The answer is some kind of a ``noisy signal.'' It does not have to be -pure noise in a signal processing sense, but in general its frequency -spectrum will be rather broad and dense. Indeed, we have already seen -(but not discussed) one way to do this in Euterpea: Recall the table -generators |tableSines|, |tableSinesN|, |tableSines3|, and -|tableSines3N|. When used with |osc|, these can generate very dense -series of partials, which in the limit sound like pure noise. - -In addition, Euterpea provides three sources of pure noise, that is, -noise derived from a random number generator: |noiseWhite|, -|noiseBLI|, and |noiseBLH|. More specifically: -\begin{enumerate} -\item -|noiseWhite :: Clock p => Int -> SigFun p () Double| \\ -|noiseWhite n| is a signal source that generates uniform white noise -with an RMS value of $1/\sqrt{2}$, where |n| is the ``seed'' of the -underlying random number generator. -\item -|noiseBLI :: Clock p => Int -> SigFun p Double Double| \\ -|noiseBLI n| is like |noiseWhite n| except that the signal samples are -generated at a rate controlled by the (dynamic) input signal -(presumably less than 44.1kHz), with interpolation performed between -samples. Such a signal is called ``band-limited'' because the slower -rate prevents spectral content higher than half the rate. -\item -|noiseBLH :: Clock p => Int -> SigFun p Double Double| \\ -|noiseBLH| is like |noiseBLI| but does not interpolate between -samples; rather, it ``holds'' the value fo the last sample. -\end{enumerate} - -\subsection{Examples} - -\begin{code} -sineTable :: Table -sineTable = tableSinesN 4096 [1] - -env1 :: AudSF () Double -env1 = envExpon 20 10 10000 -\end{code} - -\out{ -\end{spec} -doAll :: IO () -doAll = do tLow; tHi; tLowBW; tHiBW - tBP; tBS; tBPBW; tBSBW - tBP'; tBS'; tBPBW'; tBSBW' - test1; test2; test3; test4 - test5; test6; test7; test8 - test9 - return () -\end{spec} -} - -|envExpon| is better than |envLine| for sweeping a range of -frequencies, because our ears hear pitches logarithmically. To -demonstrate: - -\begin{code} -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) -\end{code} - -Helper function for filter tests: - -\begin{code} -sfTest1 :: AudSF (Double,Double) Double -> Instr (Mono AudRate) - typecomment(AudSF (Double,Double) Double -> ) - typecomment(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 -\end{code} - -Tests for low and highpass filters: - -\begin{code} -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 [] -\end{code} - -Tests for bandpass and bandstop filters (varying center frequency): - -\begin{code} -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 [] -\end{code} - -Pure white noise: - -\begin{code} -noise1 :: Instr (Mono AudRate) - typecomment(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 []) -\end{code} - -Tests for bandpass and bandstop filters (varying bandwidth): - -\begin{code} -env2 :: AudSF () Double -env2 = envExpon 1 10 2000 - -sfTest2 :: AudSF (Double,Double,Double) Double -> Instr (Mono AudRate) - typecomment(AudSF (Double,Double,Double) Double -> ) - typecomment(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 -\end{code} - -\begin{code} -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 [] -\end{code} - -Bandlimited noise: - -\begin{code} -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 []) -\end{code} - -Simple subtractive synthesis: - -\begin{code} -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 []) -\end{code} - -Howling wind: - -\begin{code} -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 []) -\end{code} - -Dense partials ("buzz") - -\begin{code} -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 []) -\end{code} - -Dense partials filtered and Shaped: - -\begin{code} -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 []) -\end{code} - -Sci-Fi-1: - -\begin{code} -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 []) -\end{code} - -Sci-Fi-2: - -\begin{code} -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 []) -\end{code} -` diff --git a/HSoM/Algebra.lhs b/HSoM/Algebra.lhs deleted file mode 100644 --- a/HSoM/Algebra.lhs +++ /dev/null @@ -1,583 +0,0 @@ -%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- - -%% Todo: -%% -- Add exercise to prove mel1 = mel2 from Intro - -%include lhs2TeX.fmt -%include myFormat.fmt - -\chapter{An Algebra of Music} -\label{ch:algebra} - -In this chapter we will explore a number of properties of the |Music| -data type and functions defined on it, properties that collectively -form an \emph{algebra of music} \cite{PTM-PADL}. With this algebra we -can reason about, transform, and optimize computer music programs in a -meaning preserving way. - -\section{Musical Equivalance} - -\index{algebraic properties} -Suppose we have two values |m1 :: Music Pitch| and |m2 :: Music Pitch|, -and we want to know if they are equal. If we treat them simply as -Haskell values, we could easily write a function that compares their -structures recursively to see if they are the same at every level, all -the way down to the |Primitive| rests and notes. This is in fact what -the Haskell function |(==)| does. For example, if: -\begin{spec} -m1 = c 4 en :+: d 4 qn -m2 = revM (revM m1) -\end{spec} -Then |m1 == m2| is |True|. - -Unfortunately, as we saw in the last chapter, if we reverse a parallel -composition, things do not work out as well. For example: -\begin{spec} -revM (revM (c 4 en :=: d 4 qn)) -==> (rest 0 :+: c 4 en :+: rest en) :=: d 4 qn -\end{spec} - -In addition, as we discussed briefly in Chapter \ref{ch:intro}, there -are musical properties for which standard Haskell equivalence is -insufficient to capture. For example, we would expect the following -two musical values to \emph{sound} the same, regardless of the actual -values of |m1|, |m2|, and |m3|: -\begin{spec} -(m1 :+: m2) :+: m3 -m1 :+: (m2 :+: m3) -\end{spec} -In other words, we expect the operator |(:+:)| to be \emph{associative}. - -The problem is that, as data structures, these two values are -\emph{not} equal in general, in fact there are no finite values that -can be assigned to |m1|, |m2|, and |m3| to make them -equal.\footnote{If |m1 = m1 :+: m2| and |m3 = m2 :+: m3| then the two - expressions are equal, but these are infinite values that cannot - be reversed or even performed.} - -The obvious way out of this dilemma is to define a new notion of -equality that captures the fact that the \emph{performances} are the -same---i.e.\ if two things \emph{sound} the same, they must be -musically equivalent. And thus we define a formal notion of musical -equivalence: - -\paragraph*{Definition:} -Two musical values |m1| and |m2| are \emph{equivalent}, written \newline -|m1 === m2|, if and only if: -\[ (\forall|pm,c|)\ \ |perf pm c m1 = perf pm c m2| \] - -We will study a number of properties in this chapter that capture -musical equivalences, similar in spirit to the associativity of -|(:+:)| above. Each of them can be thought of as an \emph{axiom}, and -the set of valid axioms collectively forms an \emph{algebra of music}. -By proving the validity of each axiom we not only confirm our -intuitions about how music is interpreted, but also gain confidence -that our |perform| function actually does the right thing. -Furthermore, with these axioms in hand, we can \emph{transform} -musical values in meaning-preserving ways. - -Speaking of the |perform| function, recall from Chapter -\ref{ch:performance} that we defined \emph{two} versions of |perform|, -and the definition above uses the function |perf|, which includes the -duration of a musical value in its result. The following Lemma -captures the connection between these functions: - -\begin{lemma} -\label{lem:perf} -{\em -For all |pm|, |c|, and |m|: -\begin{spec} -perf pm c m = (perform pm c m, dur m * cDur c) -\end{spec} -where |perform| is the function defined in Figure \ref{fig:perform}. -} -\end{lemma} - -To see the importance of including duration in the definition of -equivalence, we first note that if two musical values are equivalent, -we should be able to substitute one for the other in any valid musical -context. But if duration is not taken into account, then all rests -are equivalent (because their performances are just the empty list). -This means that, for example, |m1 :+: rest 1 :+: m2| is equivalent to -|m1 :+: rest 2 :+: m2|, which is surely not what we want.\footnote{A - more striking example of this point is John Cage's composition - \emph{4'33''}, which consists basically of four minutes and - thirty-three seconds of silence \cite{}.} - -Note that we could have defined |perf| as above, i.e.\ in terms of -|perform| and |dur|, but as mentioned in Section \ref{sec:performance} -it would have been computationally inefficient to do so. On the other -hand, if the Lemma above is true, then our proofs might be simpler if -we first proved the property using |perform|, and then using |dur|. -That is, to prove |m1 === m2| we need to prove: -\begin{spec} -perf pm c m1 = perf pm c m2 -\end{spec} -Instead of doing this directly using the definition of |perf|, we -could instead prove both of the following: -\begin{spec} -perform pm c m1 = perform pm c m2 -dur m1 = dur m2 -\end{spec} - -\subsection{Literal Player} - -The only problem with this strategy for defining musical equivalence -is that the notion of a \emph{player} can create situations where -certain properties that we would like to hold, in fact do not. After -all, a player may interpret a note or phrase in whatever way it (or he -or she) may desire. For example, it seems that this property should -hold: -\begin{spec} -tempo 1 m === m -\end{spec} -However, a certain (rather perverse) player might interpret anything -tagged with a |Tempo| modifier as an empty performance---in which case -the above property will fail! To solve this problem, we assume that... - -\section{Some Simple Axioms} - -% \setcounter{axiom}{0} - -Let's look at a few simple axioms, and see how we can prove each of -them using the proof techniques that we have developed so far. - -(Note: In the remainder of this chapter we will use the functions -|tempo r| and |trans p| to represent their unfolded versions, |Modify -(Tempo r)| and |Modify (Transpose t)|, respectively. In the proofs we -will not bother with the intermediate steps of unfolding these -functions.) - -Here is the first axiom that we will consider: -\begin{axiom}{\em -For any |r1|, |r2|, and |m|: -\begin{spec} -tempo r1 (tempo r2 m) === tempo (r1*r2) m -\end{spec} -} -\end{axiom} -In other words, \emph{tempo scaling is multiplicative}. - -We can prove this by calculation, starting with the definition of -musical equivalence. For clarity we will first prove the property for -|perform|, and then for |dur|, as suggested in the last section: -\begin{spec} -let dt = cDur c - -perform pm c (tempo r1 (tempo r2 m)) -==> { unfold perform } -perform pm (c {cDur = dt/r1}) (tempo r2 m) -==> { unfold perform } -perform pm (c {cDur = (dt/r1)/r2}) m -==> { arithmetic } -perform pm (c {cDur = dt/(r1*r2)}) m -==> { fold perform } -perform pm c (tempo (r1*r2) m) -\end{spec} - -\begin{spec} -dur (tempo r1 (tempo r2 m)) -==> { unfold dur } -dur (tempo r2 m) / r1 -==> { unfold dur } -(dur m / r2) / r1 -==> {arithmetic } -dur m / (r1*r2) -==> { fold dur } -dur (tempo (r1*r2) m) -\end{spec} - -Here is another useful axiom and its proof: -\begin{axiom}{\em -For any |r|, |m1|, and |m2|: -\begin{spec} -tempo r (m1 :+: m2) === tempo r m1 :+: tempo r m2 -\end{spec} -} -\end{axiom} -In other words, {\em tempo scaling distributes over sequential -composition}. - -{\noindent \bf Proof:} - -\begin{spec} -let t = cTime c; dt = cDur c - t1 = t + dur m1 * (dt/r) - t2 = t + (dur m1 / r) * dt - t3 = t + dur (tempo r m1) * dt - -perform pm c (tempo r (m1 :+: m2)) -==> { unfold perform } -perform pm (c {cDur = dt/r}) (m1 :+: m2) -==> { unfold perform } -perform pm (c {cDur = dt/r}) m1 - ++ perform pm (c {cTime = t1, cDur = dt/r}) m2 -==> { fold perform } -perform pm c (tempo r m1) - ++ perform pm (c {cTime = t1}) (tempo r m2) -==> { arithmetic } -perform pm c (tempo r m1) - ++ perform pm (c {cTime = t2}) (tempo r m2) -==> { fold dur } -perform pm c (tempo r m1) - ++ perform pm (c {cTime = t3}) (tempo r m2) -==> { fold perform } -perform pm c (tempo r m1 :+: tempo r m2) -\end{spec} - -\begin{spec} -dur (tempo r (m1 :+: m2)) -==> dur (m1 :+: m2) / r -==> (dur m1 + dur m2) / r -==> dur m1 / r + dur m2 / r -==> dur (tempo r m1) + dur (tempo r m2) -==> dur (tempo r m1 :+: tempo r m2) -\end{spec} - -An even simpler axiom is given by: -\begin{axiom}{\em -For any |m|, |tempo 1 m === m|. -} -\end{axiom} -In other words, {\em unit tempo scaling is the identity function for -type} |Music|. - -{\noindent\bf Proof:} - -\begin{spec} -let dt = cDur c - -perform pm c (tempo 1) m) -==> { unfold perform } -perform pm (c {cDur = dt/1}) m -==> { arithmetic } -perform pm c m -\end{spec} - -\begin{spec} -dur (tempo 1) m) -==> dur m / 1 -==> dur m -\end{spec} - -Note that the above three proofs, being used to establish axioms, all -involve the definitions of |perform| and |dur|. In contrast, we can -also establish {\em theorems} whose proofs involve only the axioms. -For example, Axioms 1, 2, and 3 are all needed to prove the following: - -\begin{theorem}{\em -For any |r|, |m1|, and |m2|: -\begin{spec} -tempo r m1 :+: m2 === tempo r (m1 :+: tempo (1/r) m2) -\end{spec} -} -\end{theorem} - -{\noindent\bf Proof:} - -\begin{spec} -tempo r m1 :+: m2 -==> { Axiom 3 } -tempo r m1 :+: tempo 1 m2 -==> { arithmetic } -tempo r m1 :+: tempo (r*(1/r)) m2 -==> { Axiom 1 } -tempo r m1 :+: tempo r (tempo (1/r) m2) -==> { Axiom 2 } -tempo r (m1 :+: tempo (1/r) m2) -\end{spec} - -%% This theorem justifies the equivalence of the two phrases shown in -%% Figure \ref{equiv}. - -%% \begin{figure*} -%% \vspace*{1in} -%% \centerline{ -%% \epsfysize=.6in -%% \epsfbox{Pics/equiv.eps} -%% } -%% \caption{Equivalent Phrases} -%% \label{equiv} -%% \end{figure*} - -\section{The Fundamental Axiom Set} - -There are many other useful axioms, but we do not have room to include -all of their proofs here. They are listed below, which include the axioms -from the previous section as special cases, and the proofs are left as -exercises. - -\begin{axiom}{\em -|Tempo| is {\em multiplicative} and |Transpose| is {\em -additive}. That is, for any |r1|, |r2|, |p1|, |p2|, and -|m|: -\begin{spec} -tempo r1 (tempo r2 m) === tempo (r1*r2) m - -trans p1 (trans p2 m) === trans (p1+p2) m -\end{spec} -} -\end{axiom} - -\begin{axiom}{\em -Function composition is {\em commutative} with respect to both tempo -scaling and transposition. That is, for any |r1|, |r2|, |p1| -and |p2|: -\begin{spec} -tempo r1 . tempo r2 === tempo r2 . tempo r1 - -trans p1 . trans p2 === trans p2 . trans p1 - -tempo r1 . trans p1 === trans p1 . tempo r1 -\end{spec} -} -\end{axiom} - -\begin{axiom}{\em -Tempo scaling and transposition are {\em distributive} over both -sequential and parallel composition. That is, for any |r|, -|p|, |m1|, and |m2|: -\begin{spec} -tempo r (m1 :+: m2) === tempo r m1 :+: tempo r m2 - -tempo r (m1 :=: m2) === tempo r m1 :=: tempo r m2 - -trans p (m1 :+: m2) === trans p m1 :+: trans p m2 - -trans p (m1 :=: m2) === trans p m1 :=: trans p m2 -\end{spec} -} -\end{axiom} - -\begin{axiom}{\em -Sequential and parallel composition are {\em associative}. That is, -for any |m0|, |m1|, and |m2|: -\begin{spec} -m0 :+: (m1 :+: m2) === (m0 :+: m1) :+: m2 - -m0 :=: (m1 :=: m2) === (m0 :=: m1) :=: m2 -\end{spec} -} -\end{axiom} - -\begin{axiom}{\em -Parallel composition is {\em commutative}. That is, for any |m0| -and |m1|: -\begin{spec} -m0 :=: m1 === m1 :=: m0 -\end{spec} -} -\end{axiom} - -\begin{axiom}{\em -|rest 0| is a {\em unit} for |tempo| and |trans|, and a {\em -zero} for sequential and parallel composition. That is, for any -|r|, |p|, and |m|: -\begin{spec} -tempo r (rest 0) === rest 0 - -trans p (rest 0) === rest 0 - -m :+: rest 0 === m === rest 0 :+: m - -m :=: rest 0 === m === rest 0 :=: m -\end{spec} -} -\end{axiom} - -\begin{axiom}{\em -A rest can be used to ``pad'' a parallel composition. That is, for -any |m1|, |m2|, such that |diff = dur m1 > dur m2 >= 0|, and any |d <= -diff|: -\begin{spec} -m1 :=: m2 === m1 :=: (m2 :+: rest d) -\end{spec} -\label{ax:pad} -} -\end{axiom} - -\begin{axiom}{\em -There is a duality between |(:+:)| and |(:=:)|, namely that, for any -|m0|, |m1|, |m2|, and |m3| such that |dur m0 = dur m2|: -\begin{spec} -(m0 :+: m1) :=: (m2 :+: m3) === (m0 :=: m2) :+: (m1 :=: m3) -\end{spec} -} -\end{axiom} - -\vspace{.1in}\hrule - -\begin{exercise}{\em -Prove Lemma \ref{lem:perf}.} -\end{exercise} - -\begin{exercise}{\em -Establish the validity of each of the above axioms.} -\end{exercise} - -\begin{exercise}{\em -Recall the polyphonic and contrapuntal melodies |mel1| and |mel2| from -Chapter~\ref{ch:intro}. Prove that |mel1 === mel2|.} -\end{exercise} - -\vspace{.1in}\hrule - -\section{An Algebraic Semantics} - -Discuss formal semantics. Denotational, operational (relate to -``proof by calculation''), and algebraic. - -Soundness and Completeness. - -\cite{PTM-PADL} - -\section{Other Musical Properties} - -Aside from the axioms discussed so far, there are many other -properties of |Music| values and its various operators, just as we saw -in Chapter~\ref{ch:induction} for lists. For example, this property -of |map| taken from Figure~\ref{fig:list-props1}: -\begin{spec} -map (f . g) = map f . map g -\end{spec} -suggests and analogous property for |mMap|: -\begin{spec} -map (f . g) = map f . map g -\end{spec} -Not all of the properties in Figures~\ref{fig:list-props1} and -\ref{fig:list-props2} have analogous musical renditions, and there -are also others that are special only to |Music| values. -Figure~\ref{fig:music-props} summarizes the most important of these -properties, including the one above. Note that some of the properties -are expressed as strict equality---that is, the left-hand and -right-hand sides are equivalent as Haskell values. But others are -expressed using musical equivalence---that is, using |(===)|. We -leave the proofs of all these properties as an exercise. - -\begin{figure} -\cbox{ -\begin{minipage}{4.75in} -{\bf Properties of |mMap|:} - -\vspace{0.1in} -\begin{spec} -mMap (\x->x) = \x->x -mMap (f . g) = mMap f . mMap g -mMap f . dropM d = dropM d . mMap f -mMap f . takeM d = takeM d . mMap f -\end{spec} - -\vspace{0.1in} -{\bf Properties of |takeM| and |dropM|:} - -\vspace{0.1in} For all non-negative |d1| and |d2|: -\begin{spec} -takeM d1 . takeM d2 = takeM (min d1 d2) -dropM d1 . dropM d2 = dropM (d1 + d2) -takeM d1 . dropM d2 = dropM d1 . takeM (d1 + d2) -\end{spec} -For all non-negative |d1| and |d2| such that |d2 >= d1|: -\begin{spec} -dropM d1 . takeM d2 = takeM (d2 - d1) . dropM d1 -\end{spec} - -\vspace{0.1in} -{\bf Properties of |revM|:} - -\vspace{0.1in} For all finite-duration |m|: -\begin{spec} -revM (revM m) === m -revM (takeM d m) === dropM (dur m - d) (revM m) -revM (dropM d m) === takeM (dur m - d) (revM m) -takeM d (revM m) === revM (dropM (dur m - d) m) -dropM d (revM m) === revM (takeM (dur m - d) m) -\end{spec} - -\vspace{0.1in} -{\bf Properties of |dur|:} - -\vspace{0.1in} -\begin{spec} -dur (revM m) = dur m -dur (takeM d m) = min d (dur m) -dur (dropM d m) = max 0 (dur m - d) -\end{spec} -\end{minipage}} -\caption{Useful Properties of Other Musical Functions} -\label{fig:music-props} -\end{figure} - -\vspace{.1in}\hrule - -\begin{exercise}{\em -Prove that |timesM a m :+: timesM b m === timesM (a+b) m|.} -\end{exercise} - -\begin{exercise}{\em -Prove as many of the axioms from Figure~\ref{fig:music-props} as you -can.} -\end{exercise} - -\out{ -Proof that revM (revM m) === m: - -revM (revM (Prim p)) -==> revM (Prim p) -==> Prim p - -revM (revM (Modify c m)) -==> revM (Modify c (revM m)) -==> Modify c (revM (revM m)) -==> Modify c m - -revM (revM (m1 :+: m2)) -==> revM (revM m2 :+: revM m1) -==> revM (revM m1) :+: revM (revM m2) -==> m1 :+: m2 - -revM (revM (m1 :=: m2)) -==> revM (let d1 = dur m1; d2 = dur m2 - in if d1>d2 - then revM m1 :=: (rest (d1 − d2) :+: revM m2) - else (rest (d2 − d1) :+: revM m1) :=: revM m2 ) -==> let d1 = dur m1; d2 = dur m2 - in if d1>d2 - then revM (revM m1 :=: (rest (d1−d2) :+: revM m2)) - else revM ((rest (d2−d1) :+: revM m1) :=: revM m2) -==> let d1 = dur m1; d2 = dur m2 - in if d1>d2 - then revM (revM m1 :=: (rest (d1−d2) :+: revM m2)) - else revM ((rest (d2−d1) :+: revM m1) :=: revM m2) - -Taking each branch of the conditional separately, first assume d1>d2: - -revM (revM m1 :=: (rest (d1−d2) :+: revM m2)) -==> let d1' = dur (revM m1) - d2' = dur (rest (d1−d2) :+: revM m2) - in if d1'>d2' - then revM (revM m1) :=: (rest (d1'-d2') :+: - revM (rest (d1−d2) :+: revM m2)) - else (rest (d2'-d1') :+: revM (revM m1)) :=: - revM (rest (d1−d2) :+: revM m2) -==> let d1' = dur m1 = d1 - d2' = (d1−d2) + d2 = d1 - in if d1'>d2' - then revM (revM m1) :=: (rest (d1'-d2') :+: - revM (rest (d1−d2) :+: revM m2)) - else (rest (d2'-d1') :+: revM (revM m1)) :=: - revM (rest (d1−d2) :+: revM m2) -==> (rest (d2'-d1') :+: revM (revM m1)) :=: revM (rest (d1−d2) :+: revM m2) -==> (rest 0 :+: revM (revM m1)) :=: revM (rest (d2−d1) :+: revM m2) -=== revM (revM m1) :=: revM (rest (d1−d2) :+: revM m2) -==> m1 :=: revM (rest (d1−d2) :+: revM m2) -==> m1 :=: (revM (revM m2) :+: revM (rest (d1−d2))) -==> m1 :=: (m2 :+: revM (rest (d1−d2))) -==> m1 :=: (m2 :+: rest (d1−d2)) -=== m1 :=: m2 - -Note: The last step relies on Axiom \ref{ax:pad}. - -The other branch of the conditional follows similarly. -} - -\vspace{.1in}\hrule diff --git a/HSoM/Bitans.lhs b/HSoM/Bitans.lhs deleted file mode 100644 --- a/HSoM/Bitans.lhs +++ /dev/null @@ -1,112 +0,0 @@ -%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- - -%include lhs2TeX.fmt -%include myFormat.fmt - -\chapter{Built-in Types Are Not Special} -\label{ch:bitans} - -\index{type} -Throughout this text we have introduced many ``built-in'' types such -as lists, tuples, integers, and characters. We have also shown how -new user-defined types can be defined. Aside from special syntax, you -might be wondering if the built-in types are in any way more special -than the user-defined ones. The answer is {\em no}. The special -syntax is for convenience and for consistency with historical -convention, but has no semantic consequence. - -We can emphasize this point by considering what the type -declarations would look like for these built-in types if in fact we -were allowed to use the special syntax in defining them. For example, -the \indexwdhs{Char} type might be written as: -\begin{spec} -data Char = 'a' | 'b' | 'c' | ... -- This is not valid - | 'A' | 'B' | 'C' | ... -- Haskell code! - | '1' | '2' | '3' | ... -\end{spec} -These constructor names are not syntactically valid; to fix them we -would have to write something like: -\begin{spec} -data Char = Ca | Cb | Cc | ... - | CA | CB | CC | ... - | C1 | C2 | C3 | ... -\end{spec} -Even though these constructors are actually more concise, they are -quite unconventional for representing characters, and thus the special -syntax is used instead. - -In any case, writing ``pseudo-Haskell'' code in this way helps us to -see through the special syntax. We see now that \hs{Char} is just a -data type consisting of a large number of nullary (meaning they take -no arguments) constructors. Thinking of \hs{Char} in this way makes -it clear why, for example, we can pattern-match against characters; -i.e., we would expect to be able to do so for any of a data type's -constructors. - -Similarly, using pseudo-Haskell, we could define \indexwdhs{Int} and -\indexwdhs{Integer} by: -\begin{spec} - -- more pseudo-code: -data Int = (-2^29) | ... | -1 | 0 | 1 | ... | (2^29-1) -data Integer = ... -2 | -1 | 0 | 1 | 2 ... -\end{spec} -(Recall that $-2^{29}$ to $2^{29-1}$ is the minimum range for the -\hs{Int} data type.) \hs{Int} is clearly a much larger enumeration -than \hs{Char}, but it's still finite! In contrast, the pseudo-code -for \hs{Integer} (the type of arbitrary precision integers) is -intended to convey an {\em infinite} enumeration (and in that sense -only, the \hs{Integer} data type {\em is} somewhat special). - -\index{unit type} -Haskell has a data type called \hs{unit} which has exactly one value: -\hs{()}. The name of this data type is also written \hs{()}. This is -trivially expressed in Haskell pseudo-code: -\begin{spec} -data () = () -- more pseudo-code -\end{spec} -Tuples are also easy to define playing this game: -\index{tuples} -\begin{spec} -data (a,b) = (a,b) -- more pseudo-code -data (a,b,c) = (a,b,c) -data (a,b,c,d) = (a,b,c,d) -\end{spec} -and so on. Each declaration above defines a tuple type of a -particular length, with parentheses playing a role in both the -expression syntax (as data constructor) and type-expression syntax (as -type constructor). By ``and so on'' we mean that there are an -infinite number of such declarations, reflecting the fact that tuples -of all finite lengths are allowed in Haskell. - -The list data type is also easily handled in pseudo-Haskell, and more -interestingly, it is recursive: -\begin{spec} -data [a] = [] | a : [a] -- more pseudo-code -infixr 5 : -\end{spec} -We can now see clearly what we described about lists earlier: \hs{[]} -is the empty list, and \hs{(:)} is the infix list constructor; thus -\hs{[1,2,3]} must be equivalent to the list \hs{1:2:3:[]}. (Note that -\hs{(:)} is right associative.) The type of \hs{[]} is \hs{[a]}, and -the type of \hs{(:)} is \hs{a->[a]->[a]}. - -\syn{The way \hs{(:)} is defined here is actually legal syntax---\indexwd{infix -constructors} are permitted in \hs{data} declarations, and are -distinguished from infix operators (for pattern-matching purposes) by -the fact that they must begin with a colon (a property trivially -satisfied by ``\hs{:}'').} - -At this point the reader should note carefully the differences between -tuples and lists, which the above definitions make abundantly clear. -In particular, note the recursive nature of the list type whose -elements are homogeneous and of arbitrary length, and the -non-recursive nature of a (particular) tuple type whose elements are -heterogeneous and of fixed length. The typing rules for tuples and -lists should now also be clear: - -For \hs{(e1,e2,...,en)}, $n\geq2$, if \hs{Ti} is the type of \hs{ei}, -then the type of the tuple is \hs{(T1,T2,...,Tn)}. - -For \hs{[e1,e2,...,en]},$n\geq0$, each \hs{ei} must have the same type -$T$, and the type of the list is \hs{[T]}. - diff --git a/HSoM/Class-tour.lhs b/HSoM/Class-tour.lhs deleted file mode 100644 --- a/HSoM/Class-tour.lhs +++ /dev/null @@ -1,602 +0,0 @@ -%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- - -%include lhs2TeX.fmt -%include myFormat.fmt - -\chapter{Haskell's Standard Type Classes} -\label{ch:class-tour} - -This provides a ``tour'' through the predefined standard type classes -in Haskell, as was done for lists in Chapter \ref{ch:list-tour}. We -have simplified these classes somewhat by omitting some of the less -interesting methods; the Haskell Report and Standard Library Report -contain more complete descriptions. - -% Haskell's standard classes form the somewhat imposing inclusion -% structure shown in Figure \ref{tut-classes-figure}. At the top of the -% figure, we see \hs{Eq} with its subclass \hs{Ord} below it. These were -% defined in the previous section. - -\section{The Ordered Class} -\label{sec:ord-class} - -The equality class \hs{Eq} was defined precisely in Chapter -\ref{ch:qualified-types}, along with a simplified version of the class -\indexwdhs{Ord}. Here is its full specification of class \hs{Ord}; -note the many default methods. \indexhs{max} \indexhs{min} -\indexhs{compare} \indexhs{(<=)} \indexhs{(<)} \indexhs{(>=)} \indexhs{(>)} -\begin{spec} -class (Eq a) => Ord a where - compare :: a -> a -> Ordering - (<), (<=), (>=), (>) :: a -> a -> Bool - max, min :: a -> a -> a - - compare x y - | x == y = EQ - | x <= y = LT - | otherwise = GT - - x <= y = compare x y /= GT - x < y = compare x y == LT - x >= y = compare x y /= LT - x > y = compare x y == GT - - max x y - | x >= y = x - | otherwise = y - min x y - | x < y = x - | otherwise = y -data Ordering = LT | EQ | GT - deriving (Eq, Ord, Enum, Read, Show, Bounded) -\end{spec} - -Note that the default method for \hs{compare} is defined in terms of -\hs{(<=)}, and that the default method for \hs{(<=)} is defined in -terms of \hs{compare}. This means that an instance of \hs{Ord} should -contain a method for at least one of these for everything to be well -defined. (Using \hs{compare} can be more efficient for complex -types.) This is a common idea in designing a type class. - -\section{The Enumeration Class} -\label{sec:enum-class} - -Class \indexwdhs{Enum} has a set of operations that underlie the syntactic -sugar of {\em arithmetic sequences}; for example, the arithmetic -sequence \hs{[1,3..]} is actually shorthand for \hs{enumFromThen 1 3}. -If this is true, then we should be able to generate arithmetic -sequences for any type that is an instance of \hs{Enum}. This -includes not only most numeric types, but also \hs{Char}, so that, for -instance, \hs{['a'..'z']} denotes the list of lower-case letters in -alphabetical order. Furthermore, a user-defined enumerated type such -as \hs{Color}: -\begin{spec} -data Color = Red | Orange | Yellow | Green | Blue | Indigo | Violet -\end{spec} -can easily be given an \hs{Enum} instance declaration, after which we -can calculate the following results: -\begin{spec} -[Red .. Violet] ===> [ Red, Orange, Yellow, Green, - Blue, Indigo, Violet] -[Red, Yellow ..] ===> [ Red, Yellow, Blue, Violet] -fromEnum Green ===> 3 -toEnum 5 :: Color ===> Indigo -\end{spec} -Indeed, the derived instance will give this result. Note that the -sequences are still {\em arithmetic} in the sense that the increment -between values is constant, even though the values are not numbers. - -The complete definition of the \hs{Enum} class is given below: - -\newpage -\indexhs{toEnum} -\indexhs{fromEnum} -\indexhs{enumFrom} -\indexhs{enumFromThen} -\indexhs{enumFromTo} -\indexhs{enumFromThenTo} -\begin{spec} -class Enum a where - succ, pred :: a -> a - toEnum :: Int -> a - fromEnum :: a -> Int - enumFrom :: a -> [a] -- [n..] - enumFromThen :: a -> a -> [a] -- [n,n'..] - enumFromTo :: a -> a -> [a] -- [n..m] - enumFromThenTo :: a -> a -> a -> [a] -- [n,n'..m] - - -- Minimal complete definition: toEnum, fromEnum - succ = toEnum . (+1) . fromEnum - pred = toEnum . (subtract 1) . fromEnum - enumFrom x = map toEnum [fromEnum x ..] - enumFromThen x y = map toEnum [fromEnum x, fromEnum y .. ] - enumFromTo x y = map toEnum [fromEnum x .. fromEnum y] - enumFromThenTo x y z = - map toEnum [fromEnum x, fromEnum y .. fromEnum z] -\end{spec} -The six default methods are sufficient for most applications, so when -writing your own instance declaration it is usually sufficient to only -provide methods for the remaining two operations: \hs{toEnum} and -\hs{fromEnum}. - -In terms of arithmetic sequences, the expressions on the left below -are equivalent to those on the right: - -\begin{tabular}{rl} -\hs{enumFrom n} & \hs{[n..]} \\ -\hs{enumFromThen n n'} & \hs{[n,n'..]} \\ -\hs{enumFromTo n m} & \hs{[n..m]} \\ -\hs{enumFromThenTo n n' m} & \hs{[n,n'..m]}\\ -\end{tabular} - -\section{The Bounded Class} -\label{sec:bounded-class} - -The class \hs{Bounded} captures data types that are linearly bounded -in some way; i.e.\ they have both a minimum value and a maximum value. -\indexhs{Bounded} -\indexhs{minBound} -\indexhs{maxBound} -\begin{spec} -class Bounded a where - minBound :: a - maxBound :: a -\end{spec} -\section{The Show Class} -\label{sec:show-class} - -Instances of the class \indexwdhs{Show} are those types that can be -converted to character strings. This is useful, for example, when -writing a representation of a value to the standard output area or to -a file. The class \indexwdhs{Read} works in the other direction: it -provides operations for parsing character strings to obtain the values -that they represent. In this section we will look at the \hs{Show} -class; in the next we will look at \hs{Read}. - -For efficiency reasons the primitive operations in these classes are -somewhat esoteric, but they provide good lessons in both algorithm and -software design, so we will look at them in some detail. - -First, let's look at one of the higher-level functions that is defined -in terms of the lower-level primitives: -\begin{spec} -show :: (Show a) => a -> String -\end{spec} -Naturally enough, \indexwdhs{show} takes a value of any type that is a -member of \hs{Show}, and returns its representation as a string. For -example, \hs{show (2+2)} yields the string \hs{"4"}, as does -\hs{show (6-2)} and \hs{show} applied to any other expression whose -value is \hs{4}. - -Furthermore, we can construct strings such as: -\begin{spec} -"The sum of " ++ show x ++ " and " ++ show y ++ " is " - ++ show (x+y) ++ "." -\end{spec} -with no difficulty. In particular, because \hs{(++)} is right -associative, the number of steps to construct this string is directly -proportional to its total length, and we can't expect to do any better -than that. (Since \hs{(++)} needs to reconstruct its left argument, -if it were left associative the above expression would repeatedly -reconstruct the same sub-string on each application of \hs{(++)}. If -the total string length were $n$, then in the worst case the number of -steps needed to do this would be proportional to $n^2$, instead of -proportional to $n$ in the case where \hs{(++)} is right associative.) - -Unfortunately, this strategy breaks down when construction of the list -is nested. A particularly nasty version of this problem arises for -tree-shaped data structures. Consider a function \hs{showTree} that -converts a value of type \hs{Tree} into a string, as in: -\begin{spec} -showTree (Branch (Branch (Leaf 2) (Leaf 3)) (Leaf 4)) -===> "< <2|3>|4>" -\end{spec} -We can define this behavior straightforwardly as follows: -\begin{spec} -showTree :: (Show a) => Tree a -> String -showTree (Leaf x) - = show x -showTree (Branch l r) - = "<" ++ showTree l ++ "|" ++ showTree r ++ ">" -\end{spec} -Each of the recursive calls to \hs{showTree} introduces more -applications of \hs{(++)}, but since they are nested, a large amount -of list reconstruction takes place (similar to the problem that would -arise if \hs{(++)} were left associative). If the tree being -converted has size $n$, then in the worst case the number of steps -needed to perform this conversion is proportional to $n^2$. This is -no good! - -To restore linear complexity, suppose we had a function -\indexwdhs{shows}: -\begin{spec} -shows :: (Show a) => a -> String -> String -\end{spec} -which takes a showable value and a string and returns that string with -the value's representation concatenated at the front. For example, we -would expect \hs{shows (2+2) "hello"} to return the string -\hs{"4hello"}. The string argument should be thought of as an -``\indexwd{accumulator}'' for the final result. - -Using \hs{shows} we can define a more efficient version of -\hs{showTree} which, like \hs{shows}, has a string accumulator -argument. Let's call this function \hs{showsTree}: -\begin{spec} -showsTree :: (Show a) => Tree a -> String -> String -showsTree (Leaf x) s - = shows x s -showsTree (Branch l r) s - = "<" ++ showsTree l ("|" ++ showsTree r (">" ++ s)) -\end{spec} -This function requires a number of steps directly proportional to the -size of the tree, thus solving our efficiency problem. To see why -this is so, note that the accumulator argument \hs{s} is never -reconstructed. It is simply passed as an argument in one recursive -call to \hs{shows} or \hs{showsTree}, and is incrementally extended to -its left using \hs{(++)}. - -\hs{showTree} can now be re-defined in terms of \hs{showsTree} using an -empty accumulator: -\begin{spec} -showTree t = showsTree t "" -\end{spec} - -\begin{exercise}\em -Prove that this version of \hs{showTree} is equivalent to the old. -\end{exercise} - -Although this solves our efficiency problem, the presentation of this -function (and others like it) can be improved somewhat. First, let's -create a type synonym (part of the Standard Prelude): -\indexhs{ShowS} -\begin{spec} -type ShowS = String -> String -\end{spec} - -% This is the type of a function that returns a string representation of -% something followed by an accumulator string. - -Second, we can avoid carrying accumulators around, and also avoid -amassing parentheses at the right end of long sequences of -concatenations, by using functional composition: -\begin{spec} -showsTree :: (Show a) => Tree a -> ShowS -showsTree (Leaf x) - = shows x -showsTree (Branch l r) - = ("<"++) . showsTree l . ("|"++) . showsTree r . (">"++) -\end{spec} - -\syn{This can be simplified slightly more by noting that \hs{("c"++)} -is equivalent to \hs{('c':)} for any character \hs{c}.} - -Something more important than just tidying up the code has come about -by this transformation: We have raised the presentation from an {\em -object level} (in this case, strings) to a {\em function level}. You -can read the type signature of \hs{showsTree} as saying that -\hs{showsTree} maps a tree into a {\em showing function}. Functions -like \hs{("<"++)} and \hs{("a string" ++)} are primitive showing -functions, and we build up more complex ones by function composition. - -The actual \hs{Show} class in Haskell has two additional levels of -complexity (and functionality): (1) the ability to specify the {\em -precedence} of a string being generated, which is important when -\hs{show}ing a data type that has infix constructors, since it -determines when parentheses are needed, and (2) a function for -\hs{show}ing a {\em list} of values of the type under consideration, -since lists have special syntax in Haskell and are so commonly used -that they deserve special treatment. The full definition of the -\hs{Show} class is given by: -\indexhs{showsPrec} -\indexhs{showList} -\begin{spec} -class Show a where - showsPrec :: Int -> a -> ShowS - showList :: [a] -> ShowS - - showList [] = showString "[]" - showList (x:xs) = showChar '[' . shows x . showl xs - where showl [] = showChar ']' - showl (x:xs) = showString ", " . shows x . showl xs -\end{spec} -Note the default method for \hs{showList}, and its ``function level'' -style of definition. - -In addition to this class declaration the Standard Prelude defines the -following functions, which return us to where we started our journey -in this section: -\indexhs{shows} -\indexhs{show} -\begin{spec} -shows :: (Show a) => a -> ShowS -shows = showsPrec 0 - -show :: (Show a) => a -> String -show x = shows x "" -\end{spec} - -Some details about \hs{showsPrec} can be found in the Haskell Report, -but if you are not displaying constructors in infix notation, the -precedence can be ignored. Furthermore, the default method for -\hs{showList} is perfectly good for most uses of lists that you will -encounter. Thus, for example, we can finish our \hs{Tree} example by -declaring it to be an instance of the class \hs{Show} very simply as: -\begin{spec} -instance (Show a) => Show (Tree a) where - showsPrec n = showsTree -\end{spec} - -\section{The Read Class} -\label{sec:read-class} -\indexhs{Read} - -Now that we can convert trees into strings, let's turn to the inverse -problem: converting strings into trees. The basic idea is to define a -{\em \indexwd{parser}} for a type \hs{a}, which at first glance seems as if it -should be a function of type \hs{String -> a}. This simple approach -has two problems, however: (1) it's possible that the string is -ambiguous, leading to more than one way to interpret it as a value of -type \hs{a}, and (2) it's possible that only a prefix of the string -will parse correctly. Thus we choose instead to return a list of -\hs{(a, String)} pairs as the result of a parse. If all goes well we -will always get a singleton list such as \hs{[(v,"")]} as the result -of a parse, but we cannot count on it (in fact, when recursively -parsing sub-strings, we will expect a singleton list with a {\em -non-empty} trailing string). - -The Standard Prelude provides a type synonym for parsers of the kind -just described: -\indexhs{ReadS} -\begin{spec} -type ReadS a = String -> [(a,String)] -\end{spec} -and also defines a function \indexwdhs{reads} that by analogy is -similar to \hs{shows}: -\begin{spec} -reads :: (Read a) => ReadS a -\end{spec} -We will return later to the precise definition of this function, but -for now let's use it to define a parser for the \hs{Tree} data type, -whose string representation is as described in the previous section. -List comprehensions give us a convenient idiom for constructing such -parsers:\footnote{An even more elegant approach to parsing uses monads -and parser combinators. These are part of a standard parsing library -distributed with most Haskell systems.} -\begin{spec} -readsTree :: (Read a) => ReadS (Tree a) -readsTree ('<':s) = [(Branch l r, u) | (l, '|':t) <- readsTree s, - (r, '>':u) <- readsTree t ] -readsTree s = [(Leaf x, t) | (x,t) <- reads s] -\end{spec} -Let's take a moment to examine this function definition in detail. -There are two main cases to consider: If the string has the form -\hs{'<':s} we should have the representation of a branch, in which -case parsing \hs{s} as a tree should yield a left branch \hs{l} -followed by a string of the form \hs{'|':t}; parsing \hs{t} as a tree -should then yield the right branch \hs{r} followed by a string of the -form \hs{'>':u}. The resulting tree \hs{Branch l r} is then returned, -along with the trailing string \hs{u}. Note the expressive power we -get from the combination of pattern matching and list comprehension. - -If the initial string is not of the form \hs{'<':s}, then we must -have a leaf, in which case the string is parsed using the generic -\hs{reads} function, and the result is directly returned. - -If we accept on faith for the moment that there is a \hs{Read} -instance for \hs{Int} that behaves as one would expect, e.g.: -\begin{spec} -(reads "5 golden rings") :: [(Int,String)] -===> [(5, " golden rings")] -\end{spec} -then you should be able to verify the following calculations: -\begin{spec} -readsTree "< <1|2>|3>" -===> [(Branch (Branch (Leaf 1) (Leaf 2)) (Leaf 1)), "")] - -readsTree "<1|2" ===> [] -\end{spec} -There are a couple of shortcomings, however, in our definition of -\hs{readsTree}. One is that the parser is quite rigid in that it -allows no ``white space'' (such as extra spaces, tabs, or line feeds) -before or between the elements of the tree representation. The other -is that the way we parse our punctuation symbols (\hs{'<'}, \hs{'|'}, -and \hs{'>'}) is quite different from the way we parse leaf values and -sub-trees. This lack of uniformity makes the function definition -harder to read. - -We can address both of these problems by using a {\em lexical -analyzer}, which parses a string into primitive ``lexemes" defined by -some rules about the string construction. The Standard Prelude -defines a lexical analyzer: -\indexhs{lex} -\begin{spec} -lex :: ReadS String -\end{spec} -whose lexical rules are those of the Haskell language, which can be -found in the Haskell Report. For our purposes, an informal -explanation is sufficient: - -\hs{lex} normally returns a singleton list containing a pair of -strings: the first string is the first lexeme in the input string, and -the second string is the remainder of the input. White space -- -including Haskell comments -- is completely ignored. If the input -string is empty or contains only white-space and comments, \hs{lex} -returns \hs{[("","")]}; if the input is not empty in this sense, but -also does not begin with a valid lexeme after any leading white-space, -\hs{lex} returns \hs{[]}. - -Using this lexical analyzer, our tree parser can be rewritten as: -\begin{spec} -readsTree :: (Read a) => ReadS (Tree a) -readsTree s = [(Branch l r, x) | ("<", t) <- lex s, - (l, u) <- readsTree t, - ("|", v) <- lex u, - (r, w) <- readsTree v, - (">", x) <- lex w ] - ++ - [(Leaf x, t) | (x, t) <- reads s ] -\end{spec} -This definition solves both problems mentioned earlier: white-space is -suitably ignored, and parsing of sub-strings has a more uniform -structure. - -To tie all of this together, let's first look at the definition of the -class \hs{Read} in the Standard Prelude: -\indexhs{readsPrec} -\indexhs{readList} -\indexhs{readParen} -\begin{spec} -class Read a where - readsPrec :: Int -> ReadS a - readList :: ReadS [a] - - readList = readParen False (\r -> [pr | ("[",s) <- lex r, - pr <- readl s]) - where readl s = [([],t) | ("]",t) <- lex s] ++ - [(x:xs,u) | (x,t) <- reads s, - (xs,u) <- readl' t] - readl' s = [([],t) | ("]",t) <- lex s] ++ - [(x:xs,v) | (",",t) <- lex s, - (x,u) <- reads t, - (xs,v) <- readl' u] - -readParen :: Bool -> ReadS a -> ReadS a -readParen b g = if b then mandatory else optional - where optional r = g r ++ mandatory r - mandatory r = [(x,u) | ("(",s) <- lex r, - sc (x,t) <- optional s, - (")",u) <- lex t ] -\end{spec} -The default method for \hs{readList} is rather tedious, but otherwise -straightforward. -\indexhs{reads} -\indexhs{read} - -\hs{reads} can now be defined, along with an even higher-level -function, \hs{read}: -\begin{spec} -reads :: (Read a) => ReadS a -reads = readsPrec 0 - -read :: (Read a) => String -> a -read s = case [x | (x,t) <- reads s, ("","") <- lex t] of - [x] -> x - [] -> error "PreludeText.read: no parse" - _ -> error "PreludeText.read: ambiguous parse" -\end{spec} -The definition of \hs{reads} (like \hs{shows}) should not be -surprising. The definition of \hs{read} assumes that exactly one -parse is expected, and thus causes a run-time error if there is no -unique parse or if the input contains anything more than a -representation of exactly one value of type \hs{a} (and possibly -comments and white-space). - -You can test that the \hs{Read} and \hs{Show} instances for a -particular type are working correctly by applying \hs{(read . show)} -to a value in that type, which in most situations should be the -identity function. - -\section{The Index Class} -\label{sec:index-class} -\indexhs{Ix} -\indexhs{range} -\indexhs{index} -\indexhs{inRange} - -The Standard Prelude defines a type class of array indices: -\begin{spec} -class (Ord a) => Ix a where - range :: (a,a) -> [a] - index :: (a,a) -> a -> Int - inRange :: (a,a) -> a -> Bool -\end{spec} -Arrays are defined elsewhere, but the index class is useful for other -things besides arrays, so I will describe it here. - -Instance declarations are provided for \hs{Int}, \hs{Integer}, -\hs{Char}, \hs{Bool}, and tuples of \hs{Ix} types; in addition, -instances may be automatically derived for enumerated and tuple types. -You should think of the primitive types as vector indices, and tuple -types as indices of multidimensional rectangular arrays. Note that -the first argument of each of the operations of class \hs{Ix} is a -pair of indices; these are typically the {\em bounds} (first and last -indices) of an array. For example, the bounds of a 10-element, -zero-origin vector with \hs{Int} indices would be \hs{(0,9)}, while a -100 by 100 1-origin matrix might have the bounds -\hs{((1,1),(100,100))}. (In many other languages, such bounds would -be written in a form like \hs{1:100, 1:100}, but the present form fits -the type system better, since each bound is of the same type as a -general index.) - -The \hs{range} operation takes a bounds pair and produces the list of -indices lying between those bounds, in index order. For example, -\begin{spec} -range (0,4) ===> [0,1,2,3,4] -range ((0,0),(1,2)) ===> [(0,0), (0,1), (0,2), (1,0), (1,1), (1,2)] -\end{spec} -The \hs{inRange} predicate determines whether an index lies between a -given pair of bounds. (For a tuple type, this test is performed -componentwise, and then combined with \hs{(&&)}.) Finally, the -\hs{index} operation determines the (zero-based) position of an index -within a bounded range; for example: -\begin{spec} -index (1,9) 2 ===> 1 -index ((0,0),(1,2)) (1,1) ===> 4 -\end{spec} -\section{The Numeric Classes} -\label{sec:numeric-classes} - -The \indexwdhs{Num} class and the numeric class hierarchy were briefly -described in Section \ref{sec:standard-type-classes}. Figure -\ref{fig:numeric-class-decls} gives the full class declarations. - -\begin{figure} -\begin{spec} -class (Eq a, Show a) => Num a where - (+), (-), (*) :: a -> a -> a - negate :: a -> a - abs, signum :: a -> a - fromInteger :: Integer -> a - -class (Num a, Ord a) => Real a where - toRational :: a -> Rational - -class (Real a, Enum a) => Integral a where - quot, rem, div, mod :: a -> a -> a - quotRem, divMod :: a -> a -> (a,a) - toInteger :: a -> Integer - -class (Num a) => Fractional a where - (/) :: a -> a -> a - recip :: a -> a - fromRational :: Rational -> a - -class (Fractional a) => Floating a where - pi :: a - exp, log, sqrt :: a -> a - (**), logBase :: a -> a -> a - sin, cos, tan :: a -> a - asin, acos, atan :: a -> a - sinh, cosh, tanh :: a -> a - asinh, acosh, atanh :: a -> a - -class (Real a, Fractional a) => RealFrac a where - properFraction :: (Integral b) => a -> (b,a) - truncate, round :: (Integral b) => a -> b - ceiling, floor :: (Integral b) => a -> b - -class (RealFrac a, Floating a) => RealFloat a where - floatRadix :: a -> Integer - floatDigits :: a -> Int - floatRange :: a -> (Int,Int) - decodeFloat :: a -> (Integer,Int) - encodeFloat :: Integer -> Int -> a - exponent :: a -> Int - significand :: a -> a - scaleFloat :: Int -> a -> a - isNaN, isInfinite, isDenormalized, isNegativeZero, isIEEE - :: a -> Bool -\end{spec} -\caption{Standard Numeric Classes} -\label{fig:numeric-class-decls} -\end{figure} diff --git a/HSoM/HSoM.bib b/HSoM/HSoM.bib deleted file mode 100644 --- a/HSoM/HSoM.bib +++ /dev/null @@ -1,659 +0,0 @@ -@Article{Leak07, - author = "Paul Liu and Paul Hudak", - title = "Plugging a Space Leak With an Arrow", - journal = "Electronic Notes in Theoretical Computer Science", - publisher = "Elsevier", - volume = "193", - pages = "29--45", - month = nov, - year = "2007" -} - -@InProceedings{Paterson2001, - author = "Ross Paterson", - title = "A New Notation for Arrows", - booktitle = "{ICFP'01}: International Conference on Functional - Programming", - pages = "229--240", - year = 2001, - address = "Firenze, Italy" -} - -@Article{Hughes2000, - author = "John Hughes", - title = "Generalising Monads to Arrows", - journal = "Science of Computer Programming", - year = 2000, - volume = 37, - pages = "67--111", - month = may -} - -@techreport{csound - ,author={Vercoe, B.} - ,title={Csound: A Manual for the Audio Processing System - and Supporting Programs} - ,institution={MIT Media Lab} - ,year=1986 - } - -@article{backus:fortran78 - ,author={Backus, J.} - ,title={The history of {FORTRAN} {I}, {II}, and {III}} - ,journal={ACM Sigplan Notices} - ,volume=13 - ,number=8 - ,year=1978 - ,month=Aug - ,pages={165-180} - } - -@article{mccarthy78 - ,author={McCarthy, J.} - ,title={History of {L}isp} - ,journal={ACM Sigplan Notices} - ,volume=13 - ,number=8 - ,year=1978 - ,month=Aug - ,pages={217-223} - } - -@article{algol - ,author={de Morgan, R.M. and Hill, I.D. and Wichmann, B.A.} - ,title={Modified Report on the Algorithmic Language {ALGOL} 60} - ,journal={Computer Journal} - ,volume=19 - ,number=4 - ,year=1976 - ,pages={364-379} - } - -@article{haskell-tutorial - ,author={Hudak, P. and Fasel, J.} - ,title={A Gentle Introduction to {H}askell} - ,journal={ACM SIGPLAN Notices} - ,volume=27 - ,number=5 - ,month=May - ,year=1992 - } - -@techreport{turn76 - ,key={turner} - ,author={Turner, D.A.} - ,title={{SASL} language manual} - ,institution={University of St. Andrews} - ,year=1976 - } - -@InProceedings{turn85 - ,key={turner} - ,author={Turner, D.A.} - ,title={Miranda: a non-strict functional language with polymorphic types} - ,booktitle={Functional Programming Languages and Computer Architecture} - ,month=Sep - ,year=1985 - ,publisher={Springer-Verlag LNCS 201} - ,pages={1-16} - } - -@book{K&R - ,author = "Brian W. Kernighan and Dennis M. Ritchie" - ,title = "The C Programming Language" - ,publisher = {Prentice-Hall} - ,year = 1978 - } - -@misc{cobol - ,key={Cobol} - ,title={{A}merican {N}ational {S}tandard {COBOL} ({ANS} {X}3.23-1968)} - ,organization={American National Standards Institue, New York} - ,year=1968 - } - -@misc{ada - ,key={Ada} - ,title={Rationale for the Design of the {A}da Programming Language} - ,organization={United States Department of Defense} - ,journal={ACM Sigplan Notices} - ,volume=14 - ,number=6 - ,year=1979 - ,month=Jun - } - -@Article{r3rs - ,author = "Rees, J. and Clinger, W." - ,title = "Revised$^3$ Report on the Algorithmic Language {S}cheme" - ,journal = "SIGPLAN Notices" - ,year = "1986" - ,volume = "21" - ,number = "12" - ,pages = "37-79" -} - -@book{ML-definition - ,author={Milner, R. and Tofte, M. and Harper, R.} - ,title={The Definition of Standard ML} - ,publisher={The MIT Press} - ,address={Cambridge, MA} - ,year=1990 - } - -@article{hindley69 - ,key={hindley} - ,author={Hindley, R.} - ,title={The Principal Type Scheme of an Object in Combinatory Logic} - ,journal={Transactions of the American Mathematical Society} - ,volume=146 - ,year=1969 - ,month=Dec - ,pages={29-60} - } - - @article{milner78 - ,key={milner} - ,author={Milner, R.A.} - ,title={A Theory of Type Polymorphism in Programming} - ,journal={Journal of Computer and System Sciences} - ,volume=17 - ,number=3 - ,year=1978 - ,month=Dec - ,pages={348-375} - } - -@article{huda89a - ,author={Hudak, P.} - ,title={Conception, Evolution, and Application of Functional - Programming Languages} - ,journal={ACM Computing Surveys} - ,volume=21 - ,number=3 - ,year=1989 - ,pages={359-411} - } - -@book{Hofstadter - ,author={Hofstadter, D.R.} - ,title={G\"{o}del, Escher, Bach: an Eternal Golden Braid} - ,publisher={Vintage} - ,address={New York} - ,year=1979 - } - -@book{Quine - ,author={Quine, W.V.O.} - ,title={The Ways of Paradox, and Other Essays} - ,publisher={Random House} - ,address={New York} - ,year=1966 - } - -@book{graphics-bible - ,author={Foley, J.D. and van Dam, A. and Feiner, S.K. and Hughes, J.F.} - ,title={Computer Graphics -- Principles and Practice, 2nd Edition} - ,publisher={Addison-Wesley} - ,address={Reading, MA} - ,year=1996 - } - -@book{papp80 - ,key={Pappert} - ,author={Pappert, S.} - ,title={Mindstorms: Children, Computers and Powerful Ideas} - ,publisher={Basic Books} - ,place={New York} - ,year=1980 - } - -@book{karel - ,author={Pattis, R.E.} - ,title={Karel the Robot - -- A Gentle Intoduction to the Art of Programming with Pascal} - ,publisher={John Wiley} - ,address={New York} - ,year=1981 - } - -@book{Wiitala - ,author={Wiitala, S.A.} - ,title={Discrete Mathematics -- A Unified Approach} - ,publisher={McGraw-Hill} - ,address={New York} - ,year=1987 - } - -@inproceedings{wadler-popl92 - ,author={Wadler, P.} - ,title={The Essence of Functional Programming} - ,booktitle={Proceedings 19th Symposium on Principles of Programming - Languages} - ,organization={ACM} - ,month=Jan - ,year=1992 - ,pages={1-14} - } - -@inproceedings{moggi89 - ,author={Moggi, E.} - ,title={Computational Lambda-Calculus and Monads} - ,booktitle={Proceedings of Symposium on Logic in Computer Science} - ,organization={IEEE} - ,year=1989 - ,month=Jun - ,pages={14--23} - } - -@inproceedings{peytonjoneswadler-popl93 - ,author={Peyton Jones, S. and Wadler, P.} - ,title={Imperative Functional Programming} - ,booktitle={Proceedings 20th Symposium on Principles of Programming - Languages} - ,organization={ACM} - ,month=Jan - ,year=1993 - ,note={71--84} - } - -@book{pierce-ct - ,author={Pierce, B.} - ,title={Basic Category Theory for Computer Scientists} - ,publisher={MIT Press} - ,address={Cambridge, MA} - ,year=1991 - } - -@book{birdwadler88 - ,author={Bird, R. and Wadler, P.} - ,title={Introduction to Functional Programming} - ,publisher={Prentice Hall} - ,address={New York} - ,year=1988 - } - -@book{bird98 - ,author={Bird, R.} - ,title={Introduction to Functional Programming using Haskell - (second edition)} - ,publisher={Prentice Hall} - ,address={London} - ,year=1998 - } - -@inproceedings{Fran - ,author={Elliott, C. and Hudak, P.} - ,title={Functional Reactive Animation} - ,booktitle={International Conference on Functional Programming} - ,month=Jun - ,year=1997 - ,pages={163--173} - } - -@inproceedings{fran-dsl - ,author={Elliott, C.} - ,title={Modeling Interactive {3D} and Multimedia Animation - with an Embedded Language} - ,booktitle={Proceedings of the first conference on - Domain-Specific Languages} - ,organization={USENIX} - ,year=1997 - ,month=Oct - ,pages={285-296} - } - -@inproceedings{icra99 - ,author={Peterson, J. and Hager, G. and Hudak, P.} - ,title={A Language for Declarative Robotic Programming} - ,booktitle={International Conference on Robotics and Automation} - ,year=1999 - ,pages={} - } - -@InProceedings{padl99 - ,author = "Peterson, J. and Hudak, P. and Elliott, C." - ,title = "Lambda in Motion: Controlling Robots With Haskell" - ,booktitle = "First International Workshop on - Practical Aspects of Declarative Languages" - ,organization = "SIGPLAN" - ,month = Jan - ,year = "1999" -} - -@article{Arya86 - ,author={Arya, K.} - ,title={A Functional Approach To Animation} - ,journal={Computer Graphics Forum} - ,volume=5 - ,number=4 - ,month=Dec - ,year=1986 - ,pages={297--311} - } - -@inproceedings{arya89 - ,author={Arya, K.} - ,title={Processes in a Functional Animation System} - ,booktitle={Proceedings of the Conference on Functional Programming - Languages and Computer Architecture} - ,organization={ACM/IFIP} - ,year=1989 - ,pages={382-395} - } - -@inproceedings{Escher88 - ,author={Zilles, S.N. and Lucas, P. and Linden, T.M. and Lotspiech, J.B. - and Harbury, A.R.} - ,title={The {E}scher Document Imaging Model} - ,booktitle={Proceedings of the ACM Conference on - Document Processing Systems} - ,month=Dec - ,year=1988 - ,pages={159-168} - } - -@inproceedings{HaggisGraphics95 - ,author={Finne, S. and Peyton Jones, S.} - ,title={Pictures: A Simple Structured Graphics Model} - ,booktitle={Proceedings of Glasgow Functional Programming Workshop} - ,month=Jul - ,year=1995 - ,pages={} - } - -@techreport{LucasZilles87 - ,author={Lucas, P. and Zilles, S.N.} - ,title={Graphics in an Applicative Context} - ,institution={IBM Almaden Research Center} - ,type={Technical Report} - ,number={} - ,month=Jul - ,year=1987 - } - -@inproceedings{Schecht94 - ,author={Schechter, G. and Elliott, C. and Yeung, R. and Abi-Ezzi, S.} - ,title={Functional 3{D} Graphics in {C}++ -- - With an Object-Oriented, Multiple Dispatching Implementation} - ,booktitle={Proceedings of the 1994 Eurographics Object-Oriented - Graphics Workshop} - ,organization={Eurographics, Springer Verlag} - ,year=1994 - ,pages={} - } - -@inproceedings{henderson82 - ,author={Henderson, P.} - ,title={Functional Geometry} - ,booktitle={Proceedings of the 1982 ACM Symposium on Lisp and - Functional Programmming} - ,organization={ACM} - ,year=1982 - ,pages={179--187} - } - -@inproceedings{haskore-tutorial - ,author={Paul Hudak} - ,title={Haskore Music Tutorial} - ,booktitle={Second International School on Advanced Functional Programming} - ,publisher={Springer Verlag, LNCS 1129} - ,year=1996 - ,month=Aug - ,pages={38-68} - } - -@article{haskore - ,author={Paul Hudak and Tom Makucevich and - Syam Gadde and Bo Whong} - ,title={Haskore Music Notation -- An Algebra of Music} - ,month=May - ,year=1996 - ,volume=6 - ,number=3 - ,pages={465--483} - ,journal={Journal of Functional Programming} - } - -@inproceedings{grame94 - ,author={Orlarey, O. and Fober, D. and Letz, S. and Bilton, M.} - ,title={Lambda Calculus and Music Calculi} - ,booktitle={Proceedings of International Computer Music Conference} - ,organization={Int'l Computer Music Association} - ,year=1994 - } - -@incollection{fugue - ,author={Dannenberg, R.B. and Fraley, C.L. and Velikonja, P.} - ,title={A Functional Language for Sound Synthesis with - Behavioral Abstraction and Lazy Evaluation} - ,booktitle={Computer Generated Music} - ,publisher={IEEE Computer Society Press} - ,year=1992 - ,editor={Denis Baggi} - } - -@book{dijkstra - ,author = "Dijkstra, E.W." - ,title = "A Discipline of Programming" - ,publisher = {Prentice-Hall} - ,year = 1976 -} - -@book{java - ,author={Gosling, J. and Joy, B. and Steele, G.} - ,title={The Java Language Specification} - ,publisher={Addison-Wesley} - ,address={Reading, MA} - ,year=1996 - } - -@article{scho24 - ,key={schonfinkel} - ,author={Sch\"{o}nfinkel, M.} - ,title={Uber die bausteine der mathematischen logik} - ,journal={Mathematische Annalen} - ,volume=92 - ,year=1924 - ,pages={305} - } - -@book{church41 - ,key={church} - ,author={Church, A.} - ,title={The Calculi of Lambda Conversion} - ,publisher={Princeton University Press} - ,address={Princeton, NJ} - ,year=1941 - } - -@book{Barnsley - ,author={Barnsley, M.} - ,title={Fractals Everywhere} - ,publisher={Academic Press} - ,address={New York} - ,year=1993 - } - -@incollection{haskore-fop - ,author={Paul Hudak} - ,title={Describing and Interpreting Music in {H}askell} - ,booktitle={The Fun of Programming} - ,chapter=4 - ,editors={Jeremy Gibbons and Oege de Moor} - ,year=2003 - ,publisher={Palgrave} - } - -@book{soe - ,author={Paul Hudak} - ,title={The Haskell School of Expression -- - Learning Functional Programming through Multimedia} - ,isbn={0521644089} - ,publisher={Cambridge University Press} - ,address={New York} - ,year=2000 - } - -@article{haskell98, - author = {Simon {Peyton Jones} and others}, - title = {The {Haskell} 98 Language and Libraries: The Revised Report}, - journal = {Journal of Functional Programming}, - volume = 13, - number = 1, - pages = {0--255}, - month = {Jan}, - year = 2003, - url = {www.haskell.org/definition}, -} - -@book{Corea94, - author = {Chick Corea}, - title = {Children's Songs -- 20 Pieces for Keyboard (ED 7254)}, - year = {1994}, - publisher = {Schott}, - ISBN = {978-3-7957-9588-7}, - address = {Mainz} -} - -@book{Cage433 - ,author={Cage, John} - ,title={Silence: Lectures and Writings} - ,year={1961,1986} - ,publisher={Wesleyan University Press} - ,address={Middletown, CT} - ,ISBN={0-8195-6028-6} -} - -@book{Moore90 - ,author={Moore, F. Richard} - ,title={Elements of Computer Music} - ,year={1990} - ,publisher={Prentice-Hall} - ,address={Englewood Cliffs, NJ} -} - -@inproceedings{AFP2002 - ,author={Paul Hudak and Antony Courtney and Henrik Nilsson and - John Peterson} - ,title={Arrows, Robots, and Functional Reactive Programming} - ,booktitle={Summer School on Advanced Functional Programming, - Oxford University} - ,publisher={Springer Verlag, LNCS 2638} - ,year=2003} - -@InProceedings{fruit, - author = "Antony Courtney and Conal Elliott", - title = "Genuinely Functional User Interfaces", - booktitle = "Proc. of the 2001 Haskell Workshop", - year = 2001, - month = "September", -} - -@misc{MIDI - ,author={MIDI Manufacturers Association} - ,title={Complete MIDI 1.0 Detailed Specification} - ,published={MIDI Manufacturers Association} - ,ISBN={0-9728831-0-X} - ,address={La Habre, CA} - ,year={1995-2013} - ,url={http://www.midi.org/techspecs/} -} - -@misc{General-MIDI - ,author={MIDI Manufacturers Association} - ,title={General MIDI 1, 2 and Lite Specifications} - ,published={MIDI Manufacturers Association} - ,address={La Habre, CA} - ,year={1995-2013} - ,url={http://www.midi.org/techspecs/} -} - -@InProceedings{PTM-PADL, - author = "Paul Hudak", - title = "An Algebraic Theory of Polymorphic Temporal Media", - booktitle = "Proceedings of {PADL'04}: 6th International Workshop on - Practical Aspects of Declarative Languages", - publisher = "Springer Verlag LNCS 3057", - pages = "1-15", - month = jun, - year = 2004 - } - -@phdthesis{courtney-phd - ,author={Antony Courtney} - ,title={Modelling User Interfaces in a Functional Language} - ,school={Department of Computer Science, Yale University} - ,month=May - ,year=2004 - } - -@misc{nelson-bifurcate - ,author={Gary Lee Nelson} - ,title={Bifurcate me, baby!} - ,year={1995} - ,school={Oberline College} -} - -@article{shepard - ,author={Roger N. Shepard} - ,month={December} - ,year=1964 - ,title={Circularity in Judgements of Relative Pitch} - ,journal={Journal of the Acoustical Society of America} - ,volume=36 - ,number=12 - ,pages={2346-2353} -} - -@article{Chowning73 - ,author={John M. Chowning} - ,title={The Synthesis of Complex Audio Spectra - by Means of Frequency Modulation} - ,year=1973 - ,journal={Journal of Audio Engineering Society} - ,volume=21 - ,number=7 - ,pages={526-534} -} - -@article{Karplus-Strong83 - ,author={Kevin Karplus and Alex Strong} - ,title={Digital Synthesis of Plucked String and Drum Timbres} - ,journal={Computer Music Journal} - ,publisher={MIT Press} - ,volume=7 - ,number=2 - ,year=1983 - ,pages={43-55} -} - -@book{Cook2002 - ,author={Perry Cook} - ,title={Real Sound Synthesis for Interactive Applications} - ,year={2002} - ,publisher={A.K. Peters Press} - ,address={Natick MA, USA} -} - -@techreport{WinogradCort-TR1446, - author = {Winograd-Cort, Daniel and Liu, Hai and Hudak, Paul}, - title = {Virtualizing {R}eal-{W}orld {O}bjects in {FRP}}, - institution = {Yale University}, - year = {2011}, - month = {July}, - number = {YALEU/DCS/RR-1446} -} - -@InProceedings{WinogradCort2012HS, - author = {Winograd-Cort, Daniel and Hudak, Paul}, - title = {Wormholes: {I}ntroducing {E}ffects to {FRP}}, - booktitle = {Haskell Symposium}, - pages = {91--103}, - numpages = {13}, - publisher = {{ACM}}, - year = {2012}, - location = {Copenhagen, Denmark}, - month = {September} -} - diff --git a/HSoM/HSoM.lhs b/HSoM/HSoM.lhs deleted file mode 100644 --- a/HSoM/HSoM.lhs +++ /dev/null @@ -1,316 +0,0 @@ -%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- - -\documentclass[11pt,fleqn,oneside]{book} % - -\newcommand{\HSoMVersion}{2.6 (January 2014)} - -%% \usepackage[pdftex,bookmarks=true]{hyperref} - -\usepackage{amssymb} -\usepackage{amsmath} -\usepackage{nicefrac} -\usepackage{hyperref} -\usepackage{suffix} - -%% pdftex] - -\hypersetup{ - pdfauthor={Paul Hudak}, - pdftitle={The Haskell School of Music}, - colorlinks, - citecolor={magenta}, - bookmarks={true}, - pdfstartview={Fit}, - pdfpagelayout={SinglePage} -} - -\usepackage{graphicx} -\usepackage{epsfig} -\usepackage{subfigure} -\usepackage{shading} -\usepackage{enumerate} -\usepackage{url} -%% \usepackage{diagrams} - -% If using --poly -\usepackage{polytable} -\usepackage{lazylist} - -% The (working) code can be extracted from each section via: -% > lhs2TeX --code fileName.lhs > code.hs -% -% Pre-processing of each section for LaTeX should be done via: -% > lhs2TeX --poly fileName.lhs > fileName.tex - -% The following should be at the top of each section for lhs2TeX: -% -%include lhs2TeX.fmt -%include myFormat.fmt - -\setlength{\parskip}{0.05in} - -% theorem-like environments -\newtheorem{axiom}{Axiom}[section] -\newtheorem{theorem}{Theorem}[section] -\newtheorem{corollary}{Corollary}[section] -\newtheorem{definition}{Definition}[section] -\newtheorem{lemma}{Lemma}[section] -\newtheorem{example}{Example}[section] -\newtheorem{exercise}{Exercise}[chapter] -% \newtheorem{proof}{Proof}[section] - -% \newcommand{\lb}{[\hspace*{-.4 mm}[} -% \newcommand{\rb}{]\hspace*{-.4 mm}]} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% All this indexing should change to be more %%%% -%%%% standard and to use lhs2tex for formatting %%%% - -% new commands used for the index: -\newcommand{\indexwd}[1]{#1\index{#1}} -\newcommand{\indexwdhs}[1]{\ihs{#1}\index{#1@@\protect\ihs{#1}}} -\newcommand{\indexwdkw}[1]{\hkw{#1}\index{#1@@\protect\hkw{#1}}} -\newcommand{\indexhs}[1]{\index{#1@@\protect\ihs{#1}}} -\newcommand{\indexkw}[1]{\index{#1@@\protect\hkw{#1}}} -\newcommand{\indexamb}[2]{\index{#1@@\protect\ihs{#1} (#2)}} - -% the following are two hacks because we're no longer using Mark -% Jones' preprocessor -% \newcommand{\ihs}[1]{\hs{#1}} -\newcommand{\ihs}[1]{{\em #1}} -\newcommand{\hkw}[1]{{\bf #1}} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -\newcommand{\out}[1]{} -\newcommand{\prh}[1]{{\bf #1}} -\newcommand{\todo}[1]{} -%% \newcommand{\todo}[1]{{\bf [To do:} #1 {\bf ]}} -\newcommand{\red}{\Longrightarrow} - -\newcommand{\syn}[1]{\begin{quote} - \parashade[0.9]{roundcorners}{\gdef\outlineboxwidth{.5} - {\small\sf {\bf Details:} #1}} - \end{quote}} - -\newcommand{\cbox}[1]{\begin{quote} - \parashade[1.0]{roundcorners}{\gdef\outlineboxwidth{.5} - {#1}} - \end{quote}} - -%% The following few commands are for supporting chapter authors -%% code was taken from: -%% http://tex.stackexchange.com/questions/156862/displaying-author-for-each-chapter-in-book -\newcommand\chapterauthor[1]{\authortoc{#1}\printchapterauthor{#1}} - -\newcommand{\printchapterauthor}[1]{ - {\parindent0pt\vspace*{-25pt} - \linespread{1.1}\large\scshape#1 - \par\nobreak\vspace*{35pt}} -} -\newcommand{\authortoc}[1]{ - \addtocontents{toc}{\vskip-10pt} - \addtocontents{toc}{ - \protect\contentsline{chapter} - {\hskip1.3em\mdseries\scshape\protect\scriptsize#1}{}{}} - \addtocontents{toc}{\vskip5pt} -} - -%--------------------------------------------------------------------- -%--------------------------------------------------------------------- -% These lines should not be necessary, but they are included because -% images are occasionally missing from the repository. -\LetLtxMacro\latexincludegraphics\includegraphics -\renewcommand{\includegraphics}[2][]{% -\IfFileExists{#2}{\latexincludegraphics[#1]{#2}} - {\framebox[1.1\width]{Image not in repository!}}} -%--------------------------------------------------------------------- -%--------------------------------------------------------------------- - -\begin{document} - -%--------------------------------------------------------------------- - -\frontmatter - -\begin{titlepage} - -\vspace*{.1in} - -\begin{center} -{\huge\sl The Haskell School of Music}\\[.2in] -{\Large --- From Signals to Symphonies ---} -\end{center} -\vspace{0.5in} - -\centerline{ -\epsfysize=3in -\epsfbox{pics/muse_euterpe.eps} -} - -\vspace{.1in} -\begin{center} -%% {\Large\bf by}\\[.3in] -{\Large\bf Paul Hudak}\\[.2in] -{\large\bf Yale University}\\ -{\large\bf Department of Computer Science}\\[.5in] -{\large\bf Version \HSoMVersion} -\end{center} - -\end{titlepage} - -\newpage - -\vspace*{3.0in} -\fbox{ -\begin{minipage}{5in} -\begin{center} -\vspace{.1in} -{\sl The Haskell School of Music}\\ -{\sl --- From Signals to Symphonies ---}\\[.1in] -{\sl Paul Hudak}\\[.1in] -{\sl Yale University}\\ -{\sl Department of Computer Science}\\ -{\sl New Haven, CT, USA}\\ -{\sl Version \HSoMVersion}\\[.1in] -Copyright \copyright\ Paul Hudak\\ -January 2011, 2012, 2013, 2014\\ -All rights reserved. No part of this publication may be reproduced or -distributed in any form or by any means, or stored in a data base or -retrieval system, without the prior written permission of the author. -\vspace{.1in}\\ -Cover image: \emph{Euterpe}, the Greek Muse of Music\\ -(attribution unknown)\\[.1in] -%% \vspace{.1in} -\end{center} -\end{minipage} -} - -\newpage - -\setcounter{tocdepth}{1}% Set contents to display Chapters and Sections and nothing deeper -\tableofcontents -\addcontentsline{toc}{chapter}{Table of Contents}% Add ToC to ToC (and bookmarks) - -\listoffigures -\addcontentsline{toc}{chapter}{List of Figures}% Add LoF to ToC (and bookmarks) - -\listoftables -\addcontentsline{toc}{chapter}{List of Tables}% Add LoT to ToC (and bookmarks) - -% Preface -\include{Preface} - -%--------------------------------------------------------------------- - -\mainmatter - -% An Overview of Computer Music, Euterpea, and Haskell -\include{Intro} - -% Simple Music -\include{Music} - -% Polymorphic and Higher-order Functions -\include{Poly} - -% A Musical Interlude -\include{Interlude} - -% Syntactic Magic -\include{Syntax} - -% More Music -\include{MoreMusic} - -% Qualified Types and Type Classes -\include{QualifiedTypes} - -% Interpretation and Performance -\include{Performance} - -% Self-Similar Music -\include{SelfSimilar} - -% Proof by Induction -\include{Induction} - -% An Algebra of Music -\include{Algebra} - -% Musical L-Systems -\include{LSystems} - -% Random Numbers, Probability Distributions, and Markov Chains -\include{RandomMusic} - -% From Performance to Midi -\include{ToMidi} - -% Basic Input/Output -\include{IO} - -% Higher-Order Types and Monads -\include{Monads} - -% Musical User Interface -\include{MUI} - -% Sound and Signals -\include{Signals} - -% Euterpea Signal Functions -\include{SigFuns} - -% Spectrum Analysis -\include{SpectrumAnalysis} - -% Additive and Subtractive Synthesis -\include{Additive} - -% Amplitude and Frequency Modulation -\include{AMAndFM} - -% Physical Modelling -\include{PhysicalModelling} - -% Effects -\include{Effects} - -% Programming with Streams -% \include{streams} - -% Communicating With the Outside World -% \include{ioproc} - -% --------------------------------------------------------------------- -% \backmatter - -\phantomsection\addcontentsline{toc}{part}{Appendix}% Add appendix to ToC (and bookmarks) -\part*{Appendix} -\appendix - -% Tour of PreludeList -\include{List-tour} - -% A Tour of Haskell's Standard Type Classes -\include{Class-tour} - -% Built-In Types Are Not Special -\include{Bitans} - -% Pattern-Matching Details -\include{Patterns} - -\clearpage - -% Bibliography -\bibliographystyle{alpha} -\phantomsection\addcontentsline{toc}{part}{Bibliography}% Add references to ToC (and bookmarks) -\bibliography{HSoM} - -% Index -% \printindex - -\end{document} diff --git a/HSoM/IO.lhs b/HSoM/IO.lhs deleted file mode 100644 --- a/HSoM/IO.lhs +++ /dev/null @@ -1,283 +0,0 @@ -%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- - -%include lhs2TeX.fmt -%include myFormat.fmt - -\chapter{Basic Input/Output} -\label{ch:IO} - -\begin{code} - -\end{code} - -So far the only input/output (IO) that we have seen in Euterpea is the -use of the |play| function to generate the MIDI output corresponding -to a |Music| value. But we have said very little about the |play| -function itself. What is its type? How does it work? How does one -do IO in a purely functional language such as Haskell? Our goal in -this chapter is to answer these questions. Then in -Chapter~\ref{ch:MUI} we will describe an elegant way to do IO -involving a ``musical user interface,'' or \emph{MUI}. - -%% In doing so we will introduce a key idea in Haskell, namely -%% \emph{monads}. - -\section{IO in Haskell} -\label{sec:IO} -\index{action (IO)} - -The Haskell Report defines the result of a program to be the value of -the variable \indexwdhs{main} in the module \indexwdhs{Main}. This is -a mere technicality, however, only having relevance when you compile a -program as a stand-alone executable (see the GHC documentation for a -discussion of how to do that). - -The way most people run Haskell programs, especially during program -development, is through the GHCi command prompt. As you know, the -GHCi implementation of Haskell allows you to type whatever expression -you wish to the command prompt, and it will evaluate it for you. - -In both cases, the Haskell system ``executes a program'' by evaluating -an expression, which (for a well-behaved program) eventually yields a -value. The system must then display that value on your computer -screen in some way that makes sense to you. GHC does this by -insisting that the type of the value be an instance of the |Show| -class---in which case it ``shows'' the result by converting it to a -string using the |show| function (recall the discussion in Section -\ref{sec:qualified-types}). So an integer is printed as an integer, a -string as a string, a list as a list, and so on. We will refer to the -area of the computer screen where this result is printed as the {\em - standard output area}, which may vary from one implementation to -another. - -But what if a program is intended to write to a file? Or print a file -on a printer? Or, the main topic of this book, to play some music -through the computer's sound card, or an external MIDI device? These -are examples of {\em output}, and there are related questions about -{\em input}: for example, how does a program receive input from the -computer keyboard or mouse, or receive input from a MIDI keyboard? - -In general, how does Haskell's ``expression-oriented'' notion of -``computation by calculation'' accommodate these various kinds of -input and output? - -The answer is fairly simple: in Haskell there is a special kind of -value called an {\em action}. When a Haskell system evaluates an -expression that yields an action, it knows not to try to display the -result in the standard output area, but rather to ``take the -appropriate action.'' There are primitive actions---such as writing a -single character to a file or receiving a single character from a MIDI -keyboard---as well as compound actions---such as printing an entire -string to a file or playing an entire piece of music. Haskell -expressions that evaluate to actions are commonly called {\em - commands}. - -%% since they command the Haskell system to perform some kind of action. -%% Haskell functions that yield actions when they are applied are also -%% commonly called commands. - -% \footnote{The Haskell Report does not use the terms ``action'' or -% ``command'' to describe IO, but I find that using these special names -% helps clarify the presentation.} - -\indexhs{IO} \indexhs{return} - -Some commands return a value for subsequent use by the program: a -character from the keyboard, for instance. A command that returns a -value of type |T| has type |IO T|. If no useful value is returned, -the command has type |IO ()|. The simplest example of a command is -|return x|, which for a value |x :: T| immediately returns |x| and has -type |IO T|. - -\index{unit type} \index{()} -\syn{The type |()| is called the {\em unit type}, and has exactly -one value, which is also written |()|. Thus |return ()| has -type |IO ()|, and is often called a ``noop'' because it is an -operation that does nothing and returns no useful result. Despite the -negative connotation, it is used quite often!} - -Remember that all expressions in Haskell must be well-typed before a -program is run, so a Haskell implementation knows ahead of time, by -looking at the type, that it is evaluating a command, and is thus -ready to ``take action.'' - -\section{|do| Syntax} - -To make these ideas clearer, let's consider a few examples. One -useful IO command is \indexwdhs{putStr}, which prints a string -argument to the standard output area, and has type -|String -> IO ()|. The |()| simply indicates that there is no -useful result returned from this action; its sole purpose is to print -its argument to the standard output area. So the program: -\begin{spec} -module Main where -main = putStr "Hello World\n" -\end{spec} -is the canonical ``Hello World'' program that is often the first -program that people write in a new language. - -Suppose now that we want to perform {\em two} actions, such as first -writing to a file named |"testFile.txt"|, then printing to the -standard output area. Haskell has a special keyword, |do|, to -denote the beginning of a sequence of commands such as this, and so we -can write: \indexkw{do} -\begin{spec} -do writeFile "testFile.txt" "Hello File System" - putStr "Hello World\n" -\end{spec} -where the file-writing function \indexwdhs{writeFile} has type: -\begin{spec} -writeFile :: FilePath -> String -> IO () -type FilePath = String -\end{spec} - -\indexhs{FilePath} -\syn{A |do| expression allows one to sequence an arbitrary number of -commands, each of type |IO ()|, using layout to distinguish them -(just as in a |let| or |where| expression). When used in this -way, the result of a |do| expression also has type |IO ()|.} - -So far we have only used actions having type |IO ()|; i.e.\ output -actions. But what about input? As above, we will consider input from -both the user and the file system. - -To receive a line of input from the user (which will be typed in the -{\em standard input area} of the computer screen, usually the same as -the standard output area) we can use the function: -\begin{spec} -getLine :: IO String -\end{spec} -\indexhs{getLine} -Suppose, for example, that we wish to read a line of input using this -function, and then write that line (a string) to a file. To do this -we write the compound command: -\begin{spec} -do s <- getLine - writeFile "testFile.txt" s -\end{spec} - -\syn{Note the syntax for binding |s| to the result of executing the - |getLine| command---when doing this in your program, you will have - to type {\tt <-}. Since the type of |getLine| is |IO String|, the - type of |s| is |String|. Its value is then used in the next line as - an argument to the |writeFile| command.} - -Similarly, we can read the entire contents of a file using the command -|readFile :: FilePath -> IO String|, and then print the result to -standard output: -\begin{spec} -do s <- readFile "testFile.txt" - putStr s -\end{spec} - -\syn{Any type that is an instance of the |Monad| type class can be - used with the |do| syntax to sequence actions. The |Monad| class is - discussed in detail in Chapter \ref{ch:monads}. It suffices to say - for now that the |IO| type is an instance of the |Monad| class.} - -\section{Actions are Just Values} -\label{sec:actions-are-value} - -There are many other commands available for file, system, and user IO, -some in the Standard Prelude, and some in various libraries (such as -|IO|, |Directory|, |System|, and |Time|). We will not discuss many of -these here, other than the MIDI IO commands described in -Section~\ref{sec:midi-io}. - -Before that, however, we wish to emphasize that, despite the special -|do| syntax, Haskell's IO commands are no different in status from -any other Haskell function or value. For example, it is possible to -create a {\em list} of actions, such as: -\begin{spec} -actionList = [ putStr "Hello World\n", - writeFile "testFile.txt" "Hello File System", - putStr "File successfully written." ] -\end{spec} -However, a list of actions is just a list of values: they actually do -not {\em do} anything until they are sequenced appropriately using a -|do| expression, and then returned as the value of the overall program -(either as the variable |main| in the module |Main|, or typed at the -GHCi prompt). Still, it is often convenient to place actions into a -list as above, and the Haskell provides some useful functions for -turning them into single commands. In particular, the function -\indexhs{sequence\_} |sequence_| in the Standard Prelude, when used -with IO, has type: -\begin{spec} -sequence_ :: [IO a] -> IO () -\end{spec} -and can thus be applied to the |actionList| above to yield the -single command: -\begin{spec} -main :: IO () -main = sequence_ actionList -\end{spec} - -For a more interesting example of this idea, we first note that -Haskell's strings are really just {\em lists of characters}. Indeed, -|String| is a type synonym for a list of characters: -\begin{spec} -type String = [Char] -\end{spec} -Because strings are used so often, Haskell allows you to write -|"Hello"| instead of |['H', 'e', 'l', 'l', 'o']|. But keep in -mind that this is just syntax---strings really are just lists of -characters, and these two ways of writing them are identical from -Haskell's perspective. - -(Earlier the type synonym |FilePath| was defined for |String|. This -shows that type synonyms can be created using other type synonyms.) - -Now back to the example. From the function |putChar :: Char -> IO ()|, -which prints a single character to the standard output area, we can -define the function |putStr| used earlier, which prints an entire -string. To do this, let's first define a function that converts a -list of characters (i.e.\ a string) into a list of IO actions: -\indexhs{putCharList} -%% \begin{spec} -%% putCharList :: String -> [IO ()] -%% putCharList [] = [] -%% putCharList (c:cs) = putChar c : putCharList cs -%% \end{spec} -\begin{spec} -putCharList :: String -> [IO ()] -putCharList = map putChar -\end{spec} - -With this, \indexwdhs{putStr} is easily defined: -\begin{spec} -putStr :: String -> IO () -putStr = sequence_ . putCharList -\end{spec} -Or, more succinctly: -\begin{spec} -putStr :: String -> IO () -putStr = sequence_ . map putStr -\end{spec} - -%% Note that the expression |putCharList s| is a list of actions, and -%% |sequence_| is used to turn them into a single (compound) command, -%% just as we did earlier. - -Of course, |putStr| can also be defined directly as a recursive -function, which we do here just to emphasize that actions are just -values, so we can use all of the functional programming skills that we -normally use: -\begin{spec} -putStr :: String -> IO () -putStr [] = return () -putStr (c:cs) = do putChar c - putStr cs -\end{spec} - -IO processing in Haskell is consistent with everything we have learned -about programming with expressions and reasoning through calculation, -although that may not be completely obvious yet. Indeed, it turns out -that a |do| expression is just syntax for a more primitive way of -combining actions using functions, namely a \emph{monad}, to be -revealed in full in Chapter \ref{ch:monads}. - -\section{Reading and Writing MIDI Files} -\label{sec:midi-io} - -[TODO: Explain MIDI-file IO functions defined in |Codec.Midi|, -as well as the Euterpea functions for writing MIDI files.] diff --git a/HSoM/Induction.lhs b/HSoM/Induction.lhs deleted file mode 100644 --- a/HSoM/Induction.lhs +++ /dev/null @@ -1,1110 +0,0 @@ -%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- - -%include lhs2TeX.fmt -%include myFormat.fmt - -\chapter{Proof by Induction} -\label{ch:induction} - -In this chapter we will study a powerful proof technique based on -\emph{mathematical induction}. With it we will be able to prove -complex and important properties of programs that cannot be -accomplished with proof-by-calculation alone. The inductive proof -method is one of the most powerful and common methods for proving -program properties. - -\section{Induction and Recursion} -\index{induction} \index{recursion} - -\emph{Induction} is very closely related to \emph{recursion}. In -fact, in certain contexts the terms are used interchangeably; in -others, one is preferred over the other primarily for historical -reasons. Think of them as being duals of one another: induction is -used to describe the process of starting with something small and -simple, and building up from there, whereas recursion describes the -process of starting with something large and complex, and working -backward to the simplest case. - -For example, although we have previously used the phrase -\emph{recursive data type}, in fact data types are often described -\emph{inductively}, such as a list: -\begin{quote} -A \emph{list} is either empty, or it is a pair consisting of a value -and another list. -\end{quote} -On the other hand, we usually describe functions that manipulate -lists, such as |map| and |foldr|, as being recursive. This is -because when you apply a function such as |map|, you apply it -initially to the whole list, and work backwards toward |[]|. - -But these differences between induction and recursion run no deeper: -they are really just two sides of the same coin. - -This chapter is about \emph{inductive properties} of programs (but -based on the above argument could just as rightly be called -\emph{recursive properties}) that are not usually proven via -calculation alone. Proving inductive properties usually involves the -inductive nature of data types and the recursive nature of functions -defined on the data types. - -As an example, suppose that |p| is an inductive property of a list. -In other words, |p(l)| for some list |l| is either true or false (no -middle ground!). To prove this property inductively, we do so based -on the length of the list: starting with length 0, we first prove -|p([])| (using our standard method of proof-by-calculation). - -Now for the key step: assume for the moment that |p(xs)| is true for -any list |xs| whose length is less than or equal to |n|. Then if we -can prove (via calculation) that |p(x:xs)| is true for any |x|---i.e.\ -that |p| is true for lists of length |n+1|---then the claim is that -|p| is true for lists of \emph{any} (finite) length. - -Why is this so? Well, from the first step above we know that |p| is -true for length 0, so the second step tells us that it is also true for -length 1. But if it is true for length 1 then it must also be true for -length 2; similarly for lengths 3, 4, etc.\ So |p| is true for lists -of any length! - -(It it important to realize, however, that a property being true for -every finite list does not necessarily imply that it is true for every -infinite list. The property ``the list is finite'' is a perfect -example of this! We will see how to prove properties of infinite lists -in Chapter \ref{ch:streams}.) \index{list!infinite} - -To summarize, to prove a property |p| by induction on the length of a -list, we proceed in two steps: -\begin{enumerate} -\item Prove |p([])| (this is called the \emph{base case}). -\item Assume that |p(xs)| is true (this is called the \emph{induction -hypothesis}, and prove that |p(x:xs)| is true (this is called the -\emph{induction step}). -\end{enumerate} - -\section{Examples of List Induction} -\label{sec:list-examples} - -Ok, enough talk, let's see this idea in action. Recall in Section -\ref{sec:poly-types} the following property about \indexwdhs{foldr}: -\[(\forall|xs|)\ \ |foldr (:) [] xs ===> xs|\] -We will prove this by induction on the length of |xs|. Following -the ideas above, we begin with the base case by proving the property -for length 0; i.e.\ for |xs = []|: -\begin{spec} -foldr (:) [] [] -==> { unfold foldr } -[] -\end{spec} -This step is immediate from the definition of |foldr|. Now for -the induction step: we first \emph{assume} that the property is true -for all lists |xs| of length |n|, and then prove the property for -list |x:xs|. Again proceeding by calculation: -\begin{spec} -foldr (:) [] (x:xs) -==> { unfold foldr } -x : foldr (:) [] xs -==> { induction hypothesis } -x : xs -\end{spec} -And we are done; the induction hypothesis is what justifies the second -step. - -Now let's do something a bit harder. Suppose we are interested in -proving the following property: -\[(\forall|xs,ys|)\ \ |length (xs ++ ys) = length xs + length ys|\] -Our first problem is to decide which list to perform the induction -over. A little thought (in particular, a look at how the definitions -of \indexwdhs{length} and |(++)| are structured) should convince you that -|xs| is the right choice. (If you do not see this, you are -encouraged to try the proof by induction over the length of |ys|!) -Again following the ideas above, we begin with the base case by -proving the property for length 0; i.e.\ for |xs = []|: -\begin{spec} -length ([] ++ ys) -==> { unfold (++) } -length ys -==> { fold (+) } -0 + length ys -==> { fold length } -length [] + length ys -\end{spec} -For the induction step, we first assume that the property is true for -all lists |xs| of length |n|, and then prove the property for list -|x:xs|. Again proceeding by calculation: -\begin{spec} -length ((x:xs) ++ ys) -==> { unfold (++) } -length (x : (xs ++ ys)) -==> { unfold length } -1 + length (xs ++ ys) -==> { induction hypothesis } -1 + (length xs + length ys) -==> { associativity of (+) } -(1 + length xs) + length ys -==> { fold length } -length (x:xs) + length ys -\end{spec} -And we are done. The transition from the 3rd line to the 4th is where -the induction hypothesis is used. - -\section{Proving Function Equivalences} - -At this point it is a simple matter to return to Chapter~\ref{ch:poly} -and supply the proofs that functions defined using |map| and |fold| -are equivalent to the recursively defined versions. In particular, -recall these two definitions of |toAbsPitches|: -\begin{spec} -toAbsPitches1 [] = [] -toAbsPitches1 (p:ps) = absPitch p : toAbsPitches1 ps - -toAbsPitches2 = map absPitch -\end{spec} -We want to prove that |toAbsPitches1 = toAbsPitches2|. To do so, we -use the extensionality principle (briefly discussed in -Section~\ref{sec:currying-simplification}), which says that two -functions are equal if, when applied to the same value, they always -yield the same result. We can change the specification slightly to -reflect this. For any finite list |ps|, we want to prove: -\begin{spec} -toAbsPitches1 ps = toAbsPitches2 ps -\end{spec} - -We proceed by induction, starting with the base case |ps = []|: -\begin{spec} -toAbsPitches1 [] -==> [] -==> map absPitch [] -==> toAbsPitches2 [] -\end{spec} -Next we assume that |toAbsPitches1 ps = toAbsPitches2 ps| holds, and -try to prove that |toAbsPitches1 (p:ps) = toAbsPitches2 (p:ps)|: -\begin{spec} -toAbsPitches1 (p:ps) -==> absPitch p : toAbsPitches1 ps -==> absPitch p : toAbsPitches2 ps -==> absPitch p : map absPitch ps -==> map absPitch (p:ps) -\end{spec} -Note the use of the induction hypothesis in the second step. - -%% The proof that the two versions of |toPitches| given in -%% Chapter~\ref{ch:poly} is very similar, and is left as an exercise. - -For a proof involving |foldr|, recall from Chapter~\ref{ch:poly} this -recursive definition of |line|: -\begin{spec} -line1 [] = rest 0 -line1 (m:ms) = m :+: line1 ms -\end{spec} -and this non-recursive version: -\begin{spec} -line2 = foldr (:+:) (rest 0) -\end{spec} -We can prove that these two functions are equivalent by induction. -First the base case: -\begin{spec} -line1 [] -==> rest 0 -==> foldr (:+:) (rest 0) [] -==> line2 [] -\end{spec} -Then the induction step: -\begin{spec} -line1 (m:ms) -==> m :+: line1 ms -==> m :+: line2 ms -==> m :+: foldr (:+:) (rest 0) ms -==> foldr (:+:) (rest 0) (m:ms) -==> line2 (m:ms) -\end{spec} - -The proofs of equivalence of the definitions of |toPitches|, |chord|, -|maxPitch|, and |hList| from Chapter~\ref{ch:poly} are similar, and -left as an exercise. - -\vspace{.1in}\hrule - -\begin{exercise}{\em -From Chapter~\ref{ch:poly}, prove that the original recursive versions -of the following functions are equivalent to the versions using |map| -or |fold|: |toPitches|, |chord|, |maxPitch|, and |hList|.} -\end{exercise} - -\vspace{.1in}\hrule - -\subsection{[Advanced] Reverse} - -The proofs of function equivalence in the last section were fairly -straightforward. For something more challenging, consider the -definition of \indexwdhs{reverse} given in Section \ref{sec:reverse}: -\begin{spec} -reverse1 [] = [] -reverse1 (x:xs) = reverse1 xs ++ [x] -\end{spec} -and the version given in Section \ref{sec:currying}: -\begin{spec} -reverse2 xs = foldl (flip (:)) [] xs -\end{spec} -We would like to show that these are the same; i.e.\ that -|reverse1 xs = reverse2 xs| for any finite list |xs|. In -carrying out this proof one new idea will be demonstrated, namely - the need for an \emph{auxiliary property} -which is proved independently of the main result. - -%% the first being that induction can be used to prove the equivalence of -%% two programs. The second is - -The base case is easy, as it often is: -\begin{spec} -reverse1 [] -==> [] -==> foldl (flip (:)) [] [] -==> reverse2 [] -\end{spec} -Assume now that |reverse1 xs = reverse2 xs|. The induction step -proceeds as follows: -\begin{spec} -reverse1 (x:xs) -==> reverse1 xs ++ [x] -==> reverse2 xs ++ [x] -==> foldl (flip (:)) [] xs ++ [x] -==> ??? -\end{spec} -But now what do we do? Intuitively, it seems that the following -property, which we will call property (1), should hold: -\begin{spec} -foldl (flip (:)) [] xs ++ [x] -==> foldl (flip (:)) [] (x:xs) -\end{spec} -in which case we could complete the proof as follows: -\begin{spec} -... -==> foldl (flip (:)) [] xs ++ [x] -==> foldl (flip (:)) [] (x:xs) -==> reverse2 (x:xs) -\end{spec} - -The ability to see that if we could just prove one thing, then perhaps -we could prove another, is a useful skill in conducting proofs. In -this case we have reduced the overall problem to one of proving -property (1), which simplifies the structure of the proof, although -not necessarily the difficulty. These auxiliary properties are often -called \emph{lemmas} in mathematics, and in many cases their proofs -become the most important contributions, since they are often at the -heart of a problem. - -In fact if you try to prove property (1) directly, you will run into a -problem, namely that it is not \emph{general} enough. So first let's -generalize property (1) (while renaming |x| to |y|), as follows: -\index{generalization} -\begin{spec} -foldl (flip (:)) ys xs ++ [y] -==> foldl (flip (:)) (ys++[y]) xs -\end{spec} -Let's call this property (2). If (2) is true for any finite |xs| -and |ys|, then property (1) is also true, because: -\begin{spec} -foldl (flip (:)) [] xs ++ [x] -==> { property (2) } -foldl (flip (:)) ([]++[x]) xs -==> { unfold (++) } -foldl (flip (:)) [x] xs -==> { fold (flip (:)) } -foldl (flip (:)) (flip (:) [] x) xs -==> { fold foldl } -foldl (flip (:)) [] (x:xs) -\end{spec} - -You are encouraged to try proving property (1) directly, in which case -you will likely come to the same conclusion, namely that the property -needs to be generalized. This is not always easy to see, but is -sometimes an important step is constructing a proof, because, despite -being somewhat counterintuitive, it is often the case that making a -property more general (and therefore more powerful) makes it easier to -prove. - -In any case, how do we prove property (2)? Using induction, of -course! Setting |xs| to |[]|, the base case is easy: -\begin{spec} -foldl (flip (:)) ys [] ++ [y] -==> { unfold foldl } -ys++[y] -==> { fold foldl } -foldl (flip (:)) (ys++[y]) [] -\end{spec} -and the induction step proceeds as follows: -\begin{spec} -foldl (flip (:)) ys (x:xs) ++ [y] -==> { unfold foldl } -foldl (flip (:)) (flip (:) ys x) xs ++ [y] -==> { unfold flip } -foldl (flip (:)) (x:ys) xs ++ [y] -==> { induction hypothesis } -foldl (flip (:)) ((x:ys)++[y]) xs -==> { unfold (++) } -foldl (flip (:)) (x:(ys++[y])) xs -==> { fold foldl } -foldl (flip (:)) (ys++[y]) (x:xs) -\end{spec} - -\out{ -Here is why the generalization is needed. If we just try to prove: - -foldl (flip (:)) [] xs ++ [x] -==> foldl (flip (:)) [x] xs - -Then the base case is fine: - -foldl (flip (:)) [] [] ++ [x] -==> { unfold foldl } -[]++[x] -==> { unfold (++) } -[x] -==> { fold foldl } -foldl (flip (:)) [x] [] - -But the induction step runs into trouble: - -foldl (flip (:)) [] (x:xs) ++ [y] -==> { unfold foldl } -foldl (flip (:)) (flip (:) [] x) xs ++ [y] -==> { unfold flip } -foldl (flip (:)) [x] xs ++ [y] -==> ??? - -What now? We are stuck. In particular, we cannot apply the induction -hypothesis because foldl's third argument is |[x]| and not |[]|. -} - -\section{Useful Properties on Lists} -\label{sec:list-properties} - -There are many useful properties of functions on lists that require -inductive proofs. Figures \ref{fig:list-props1} and -\ref{fig:list-props2} list a number of them involving functions used -in this text, but their proofs are left as exercises (except for one; -see below). You may assume that these properties are true, and use -them freely in proving other properties of your programs. In fact, -some of these properties can be used to simplify the proof that -|reverse1| and |reverse2| are the same; see if you can find -them!\footnote{More thorough discussions of these properties and their - proofs may be found in \cite{birdwadler88,bird98}.} - -(Note, by the way, that in the first rule for |map| in Figure -\ref{fig:list-props1}, the type of |\x -> x| on the left-hand -side is |a->b|, whereas on the right-hand side it is |[a]->[b]|; -i.e. these are really two different functions.) - -\begin{figure} -\cbox{ -\begin{minipage}{4.75in} -{\bf Properties of |map|:} - -\begin{spec} -map (\x->x) = \x->x -map (f . g) = map f . map g -map f . tail = tail . map f -map f . reverse = reverse . map f -map f . concat = concat . map (map f) -map f (xs ++ ys) = map f xs ++ map f ys -\end{spec} -For all strict |f|: -\begin{spec} -f . head = head . map f -\end{spec} -\vspace{0.1in} - -{\bf Properties of the |fold| functions:} - -\begin{enumerate} -\item If |op| is associative, and |e `op` x = x| and |x `op` e = x| -for all |x|, then for all finite |xs|: -\begin{spec} -foldr op e xs = foldl op e xs -\end{spec} -\item If the following are true: -\begin{spec} -x `op1` (y `op2` z) = (x `op1` y) `op2` z -x `op1` e = e `op2` x -\end{spec} -then for all finite |xs|: -\begin{spec} -foldr op1 e xs = foldl op2 e xs -\end{spec} -\item For all finite |xs|: -\begin{spec} -foldr op e xs = foldl (flip op) e (reverse xs) -\end{spec} -\end{enumerate} -\end{minipage}} -\caption{Some Useful Properties of |map| and |fold|.} -\label{fig:list-props1} -\end{figure} - -\begin{figure} -\cbox{ -\begin{minipage}{4.75in} -{\bf Properties of |(++)|:} - -\vspace{0.1in} For all |xs|, |ys|, and |zs|: -\begin{spec} -(xs ++ ys) ++ zs = xs ++ (ys ++ zs) -xs ++ [] = [] ++ xs = xs -\end{spec} - -\vspace{0.1in} -{\bf Properties of |take| and |drop|:} - -\vspace{0.1in} -\begin{spec} -take m . take n = take (min m n) -drop m . drop n = drop (m + n) -take m . drop n = drop n . take (m + n) -\end{spec} -For all non-negative |m| and |n| such that $n \geq m$: -\begin{spec} -drop m . take n = take (n - m) . drop m -\end{spec} -For all non-negative |m| and |n|, and finite |xs|: -\begin{spec} -take n xs ++ drop n xs = xs -\end{spec} - -\vspace{0.1in} -{\bf Properties of |reverse|:} - -\vspace{0.1in} For all finite |xs|: -\begin{spec} -reverse (reverse xs) = xs -head (reverse xs) = last xs -last (reverse xs) = head xs -\end{spec} -\end{minipage}} -\caption{Useful Properties of Other Functions Over Lists} -\label{fig:list-props2} -\end{figure} - -\subsection{[Advanced] Function Strictness} - -\index{function!strict} \index{bottom} -Note that the last rule for |map| in Figure \ref{fig:list-props1} -is only valid for \emph{strict} functions. A function |f| is said to -be strict if |f bottom| $=$ |bottom|. Recall from Section -\ref{sec:expressions} that |bottom| is the value associated with a -non-terminating computation. So another way to think about a strict -function is that it is one that, when applied to a non-terminating -computation, results in a non-terminating computation. For example, -the successor function |(+1)| is strict, because |(+1) bottom| -$=$ |bottom + 1| $=$ |bottom|. In other words, if you apply -|(+1)| to a non-terminating computation, you end up with a -non-terminating computation. - -Not all functions in Haskell are strict, and we have to be careful to -say on which argument a function is strict. For example, |(+)| is -strict on both of its arguments, which is why the section |(+1)| is -also strict. On the other hand, the constant function: -\begin{spec} -const x y = x -\end{spec} -is strict on its first argument (why?), but not its second, because -|const x bottom| $=$ |x|, for any |x|. - -\indexhs{(\&\&)} -\syn{Understanding strictness requires a careful understanding of -Haskell's pattern-matching rules. For example, consider the -definition of |(&&)| from the Standard Prelude: -\begin{spec} -(&&) :: Bool -> Bool -> Bool -True && x = x -False && _ = False -\end{spec} - -\index{pattern!matching} -When choosing a pattern to match, Haskell starts with the top, -left-most pattern, and works to the right and downward. So in the -above, |(&&)| first evaluates its left argument. If that value is -|True|, then the first equation succeeds, and the second argument -gets evaluated because that is the value that is returned. But if the -first argument is |False|, the second equation succeeds. In -particular, \emph{it does not bother to evaluate the second argument at -all}, and simply returns |False| as the answer. This means that -|(&&)| is strict in its first argument, but not its second. - -A more detailed discussion of pattern matching is found in Appendix -\ref{ch:patterns}. -} - -Let's now look more closely at the last law for |map|, which says -that for all strict |f|: -\begin{spec} -f . head = head . map f -\end{spec} -Let's try to prove this property, starting with the base case, but -ignoring for now the strictness constraint on |f|: -\begin{spec} -f (head []) -==> f bottom -\end{spec} -|head []| is an error, which you will recall has value |bottom|. -So you can see immediately that the issue of strictness might play a -role in the proof, because without knowing anything about |f|, -there is no further calculation to be done here. Similarly, if we -start with the right-hand side: -\begin{spec} -head (map f []) -==> head [] -==> bottom -\end{spec} -It should be clear that for the base case to be true, it must be that -|f bottom| $=$ |bottom|; i.e., |f| must be strict. Thus we -have essentially ``discovered'' the constraint on the theorem through -the process of trying to prove it! (This is not an uncommon -phenomenon.) - -The induction step is less problematic: -\begin{spec} -f (head (x:xs)) -==> f x -==> head (f x : map f xs) -==> head (map f (x:xs)) -\end{spec} -and we are done. - -\vspace{.1in}\hrule - -\begin{exercise}{\em -Prove as many of the properties in Figures \ref{fig:list-props1} and -\ref{fig:list-props2} as you can.} -\end{exercise} - -\begin{exercise}{\em -Which of the following functions are strict (if the function takes -more than one argument, specify on which arguments it is strict): -|reverse|, |simple|, |map|, |tail|, |dur|, |revM|, -|(&&)|, |(True &&)|, |(False &&)|, and -the following function: -\begin{spec} -ifFun :: Bool -> a -> a -> a -ifFun pred cons alt = if pred then cons else alt -\end{spec} -} -\end{exercise} - -\vspace{.1in}\hrule -\vspace{.1in} - -\section{Induction on the Music Data Type} -\label{sec:induction-others} - -Proof by induction is not limited to lists. In particular, we can use -it to reason about |Music| values. - -For example, recall this property intuitively conjectured in -Section~\ref{sec:music-fold}: -\begin{spec} -mFold Prim (:+:) (:=:) Modify m = m -\end{spec} -To prove this, we again use the extensionality principle, and then -proceed by induction. But what is the base case? Recall that the -|Music| data type is defined as: - -\begin{spec} -data Music a = - Prim (Primitive a) - | Music a :+: Music a - | Music a :=: Music a - | Modify Control (Music a) -\end{spec} -The only constructor that does not take a |Music| value as an argument -is |Prim|, so that in fact is the only base case. - -So, starting with this base case: -\begin{spec} -mFold Prim (:+:) (:=:) Modify (Prim p) -==> Prim p -==> id (Prim p) -\end{spec} -That was easy! Next, we develop an induction step for each of the -three non-base cases: -\begin{spec} -mFold Prim (:+:) (:=:) Modify (m1 :+: m2) -==> mFold Prim (:+:) (:=:) Modify m1 :+: - mFold Prim (:+:) (:=:) Modify m2 -==> m1 :+: m2 -==> id (m1 :+: m2) -\end{spec} - -\begin{spec} -mFold Prim (:+:) (:=:) Modify (m1 :=: m2) -==> mFold Prim (:+:) (:=:) Modify m1 :=: - mFold Prim (:+:) (:=:) Modify m2 -==> m1 :=: m2 -==> id (m1 :=: m2) -\end{spec} - -\begin{spec} -mFold Prim (:+:) (:=:) Modify (Modify c m) -==> Modify c (mFold Prim (:+:) (:=:) Modify m) -==> Modify c m -==> id (Modify c m) -\end{spec} -These three steps were quite easy as well, but is not something we -could have done without induction. - -For something more challenging, let's consider the following: -\begin{spec} -dur (revM m) = dur m -\end{spec} -%% , if dur m /= bottom -%% The side condition adds an extra twist to this problem. -Again we proceed by induction, starting with the base case: -\begin{spec} -dur (revM (Prim p)) -==> dur (Prim p) -\end{spec} -Sequential composition is straightforward: -\begin{spec} -dur (revM (m1 :+: m2)) -==> dur (revM m2 :+: revM m1) -==> dur (revM m2) + dur (revM m1) -==> dur m2 + dur m1 -==> dur m1 + dur m2 -==> dur (m1 :+: m2) -\end{spec} - -But things get more complex with parallel composition: -\begin{spec} -dur (revM (m1 :=: m2)) -==> dur ( let d1 = dur m1 - d2 = dur m2 - in if d1>d2 then revM m1 :=: (rest (d1-d2) :+: revM m2) - else (rest (d2-d1) :+: revM m1) :=: revM m2) -==> let d1 = dur m1 - d2 = dur m2 - in if d1>d2 then dur (revM m1 :=: (rest (d1-d2) :+: revM m2)) - else dur ((rest (d2-d1) :+: revM m1) :=: revM m2) -... -\end{spec} -At this point, to make things easier to understand, we will consider -each branch of the conditional in turn. First the consequent branch: -\begin{spec} -dur (revM m1 :=: (rest (d1-d2) :+: revM m2)) -==> max (dur (revM m1)) (dur (rest (d1-d2) :+: revM m2)) -==> max (dur m1) (dur (rest (d1-d2) :+: revM m2)) -==> max (dur m1) (dur (rest (d1-d2)) + dur (revM m2)) -==> max (dur m1) ((d1-d2) + dur m2) -==> max (dur m1) (dur m1) -==> dur m1 -\end{spec} -And then the alternative: -\begin{spec} -dur ((rest (d2-d1) :+: revM m1) :=: revM m2) -==> max (dur ((rest (d2-d1) :+: revM m1)) (dur (revM m2)) -==> max (dur ((rest (d2-d1) :+: revM m1)) (dur m2) -==> max (dur (rest (d2-d1)) + dur (revM m1)) (dur m2) -==> max ((d2-d1) + dur m1) (dur m2) -==> max (dur m2) (dur m2) -==> dur m2 -\end{spec} - -Now we can continue the proof from above: -\begin{spec} -... -==> let d1 = dur m1 - d2 = dur m2 - in if d1>d2 then dur m1 - else dur m2 -==> max (dur m1) (dur m2) -==> dur (m1 :=: m2) -\end{spec} - -The final inductive step involves the |Modify| constructor, but recall -that |dur| treats a |Tempo| modification specially, and thus we treat -it specially as well: -\begin{spec} -dur (revM (Modify (Tempo r) m)) -==> dur (Modify (Tempo r) (revM m)) -==> dur (revM m) / r -==> dur m / r -==> dur (Modify (Tempo r) m) -\end{spec} -Finally, we consider the case that |c /= Tempo r|: -\begin{spec} -dur (revM (Modify c m)) -==> dur (Modify c (revM m)) -==> Modify c (dur (revM m)) -==> Modify c (dur m) -==> dur (Modify c m) -\end{spec} -And we are done. - -\vspace{.1in}\hrule -\vspace{.1in} - -\begin{exercise}{\em -Recall Exercises \ref{ex:chrom} and \ref{ex:mkscale}. Prove that, if -|p2 >= p1|: -\begin{spec} -chrom p1 p2 = mkScale p1 (take (absPitch p2 - absPitch p1) - (repeat 1)) -\end{spec} -using the lemma: -\begin{spec} -[m..n] = scanl (+) m (take (n-m) (repeat 1)) -\end{spec} -} -\end{exercise} - -%% \begin{exercise}{\em -%% Prove that:} -%% \begin{code} -%% mFold (:+:) (:=:) Prim Modify = id -%% \end{code} -%% \end{exercise} - -\begin{exercise}{\em -Prove the following facts involving |dur|:} -\begin{spec} -dur (timesM n m) = n * dur m -dur (takeM d m) = d, if d <= dur m -\end{spec} -%% dur (revM m) = dur m, if dur m /= bottom -\end{exercise} - -\begin{exercise}{\em -Prove the following facts involving |mMap|:} -\begin{spec} -mMap id m = m -mMap f (mMap g m) = mMap (f . g) m -\end{spec} -\end{exercise} - -\begin{exercise}{\em -Prove that, for all |pmap|, |c|, and |m|: -\begin{spec} -perf pmap c m = (perform pmap c m, dur m) -\end{spec} -where |perform| is the function defined in Figure \ref{fig:perform}. -} -\end{exercise} - -\vspace{.1in}\hrule -\vspace{.1in} - -\subsection{The Need for Musical Equivalence} - -In Chapter \ref{ch:intro} we discussed the need for a notion of -\emph{musical equivalence}, noting that, for example, |m :+: rest 0| -``sounds the same'' as |m|, even if the two |Music| values are not -equal as Haskell values. That same issue can strike us here as we try -to prove intuitively natural properties such as: -\begin{spec} -revM (revM m) = m -\end{spec} -To see why this property cannot be proved without a notion of musical -equivalence, note that: -\begin{spec} -revM (revM (c 4 en :=: d 4 qn)) -===> revM ((rest en :+: c 4 en) :=: d 4 qn) -===> (rest 0 :+: c 4 en :+: rest en) :=: d 4 qn -\end{spec} -Clearly the last line above is not equal, as a Haskell value, to |c 4 -en :=: d 4 qn|. But somehow we need to show that these two values -``sound the same'' as musical values. In the next chapter we will -formally develop the notion of musical equivalence, and with it be -able to prove the validity of our intuitions regarding |revM|, as well -as many other important musical properties. - -\section{[Advanced] Induction on Other Data Types} - -Proof by induction can be used to reason about many data types. For -example, we can use it to reason about natural -numbers.\footnote{Indeed, one could argue that a proof by induction - over finite lists is really an induction over natural numbers, since - it is an induction over the \emph{length} of the list, which is a - natural number.} Suppose we define an exponentiation function as -follows: \index{|(^)|} -\begin{spec} -(^) :: Integer -> Integer -> Integer -x^0 = 1 -x^n = x * x^(n-1) -\end{spec} - -\syn{|(*)| is defined in the Standard Prelude to have precedence -level 7, and recall that if no |infix| declaration is given for an -operator it defaults to \indexwd{precedence} level 9, which means that -|(^)| has precedence level 9, which is higher than that for -|(*)|. Therefore no parentheses are needed to disambiguate the -last line in the definition above, which corresponds nicely to -mathematical convention.} - -Now suppose that we want to prove that: -\[(\forall x, n\geq0, m\geq0)\ \ |x^(n+m) = x^n * x^m|\] -We proceed by induction on |n|, beginning with |n=0|: -\begin{spec} -x^(0+m) -==> x^m -==> 1 * (x^m) -==> x^0 * x^m -\end{spec} - -Next we assume that the property is true for numbers less than or -equal to |n|, and prove it for |n+1|: -\begin{spec} -x^((n+1)+m) -==> x * x^(n+m) -==> x * (x^n * x^m) -==> (x * x^n) * x^m -==> x^(n+1) * x^m -\end{spec} -and we are done. - -Or are we? What if, in the definition of |(^)|, |x| or |n| -is \emph{negative}? Since a negative integer is not a natural number, -we could dispense with the problem by saying that these situations -fall beyond the bounds of the property we are trying to prove. But -let's look a little closer. If |x| is negative, the property we -are trying to prove still holds (why?). But if |n| is negative, -|x^n| will not terminate (why?). As diligent programmers we may -wish to defend against the latter situation by writing: -\begin{spec} -(^) :: Integer -> Integer -> Integer -x^0 = 1 -x^n | n<0 = error "negative exponent" - | otherwise = x * x^(n-1) -\end{spec} -If we consider non-terminating computations and ones that produce an -error to both have the same value, namely |bottom|, then these two -versions of |(^)| are equivalent. Pragmatically, however, the -latter is clearly superior. - -Note that the above definition will test for |n<0| on every -recursive call, when actually the only call in which it could happen -is the first. Therefore a slightly more efficient version of this -program would be: - -\begin{spec} -(^) :: Integer -> Integer -> Integer -x^n | n<0 = error "negative exponent" - | otherwise = f x n - where f x 0 = 1 - f x n = x * f x (n-1) -\end{spec} -Proving the property stated earlier for this version of the program is -straightforward, with one minor distinction: what we really need to -prove is that the property is true for |f|; that is: -\[(\forall x, n\geq0, m\geq0)\ \ |f x (n+m) = f x n * f x m|\] -from which the proof for the whole function follows trivially. - -\subsection{A More Efficient Exponentiation Function} - -\index{efficiency} -But in fact there is a more serious inefficiency in our exponentiation -function: we are not taking advantage of the fact that, for any even -number $n$, $x^n = (x*x)^{n/2}$. Using this fact, here is a more -clever way to accomplish the exponentiation task, using the names -|(^!)| and |ff| for our functions to distinguish them from the -previous versions: -\begin{spec} -(^!) :: Integer -> Integer -> Integer -x^!n | n<0 = error "negative exponent" - | otherwise = ff x n - where ff x n | n==0 = 1 - | even n = ff (x*x) (n `quot` 2) - | otherwise = x * ff x (n-1) -\end{spec} - -\syn{\indexwdhs{quot} is Haskell's \emph{quotient} operator, which -returns the integer quotient of the first argument divided by the -second, rounded toward zero.} - -You should convince yourself that, intuitively at least, this version -of exponentiation is not only correct, but also more efficient. More -precisely, |(^)| executes a number of steps proportional to |n|, -whereas |(^!)| executes a number of steps proportional to the -$\log_2$ of |n|. The Standard Prelude defines |(^)| similarly -to the way in which |(^!)| is defined here. - -Since intuition is not always reliable, let's \emph{prove} that this -version is equivalent to the old. That is, we wish to prove that -|x^n = x^!n| for all |x| and |n|. - -A quick look at the two definitions reveals that what we really need -to prove is that |f x n = ff x n|, from which it follows -immediately that |x^n = x^!n|. We do this by induction on |n|, -beginning with the base case |n=0|: -\begin{spec} -f x 0 ==> 1 ==> ff x 0 -\end{spec} -so the base case holds trivially. The induction step, however, is -considerably more complicated. We must consider two cases: |n+1| -is either even, or it is odd. If it is odd, we can show that: -\begin{spec} -f x (n+1) -==> x * f x n -==> x * ff x n -==> ff x (n+1) -\end{spec} -and we are done (note the use of the induction hypothesis in the -second step). - -If |n+1| is even, we might try proceeding in a similar way: -\begin{spec} -f x (n+1) -==> x * f x n -==> x * ff x n -\end{spec} -But now what shall we do? Since |n| is odd, we might try -unfolding the call to |ff|: -\begin{spec} -x * ff x n -==> x * (x * ff x (n-1)) -\end{spec} -but this does not seem to be getting us anywhere. Furthermore, -\emph{folding} the call to |ff| (as we did in the odd case) would -involve \emph{doubling} |n| and taking the square root of |x|, -neither of which seems like a good idea! - -We could also try going in the other direction: -\begin{spec} -ff x (n+1) -==> ff (x*x) ((n+1) `quot` 2) -==> f (x*x) ((n+1) `quot` 2) -\end{spec} -The use of the induction hypothesis in the second step needs to be -justified, because the first argument to |f| has changed from -|x| to |x*x|. But recall that the induction hypothesis states -that for \emph{all} values |x|, and all natural numbers up to |n|, -|f x n| is the same as |ff x n|. So this is OK. - -But even allowing this, we seem to be stuck again! - -Instead of pushing this line of reasoning further, let's pursue a -different tact based on the (valid) assumption that if |m| is even, -then: -\[ |m = m `quot` 2 + m `quot` 2| \] -Let's use this fact together with the property that we proved in the -last section: -\begin{spec} -f x (n+1) -==> f x ((n+1) `quot` 2 + (n+1) `quot` 2) -==> f x ((n+1) `quot` 2) * f x ((n+1) `quot` 2) -\end{spec} -Next, as with the proof in the last section involving |reverse|, -let's make an assumption about a property that will help us along. -Specifically, what if we could prove that |f x n * f x n| is equal -to |f (x*x) n|? If so, we could proceed as follows: -\begin{spec} -f x ((n+1) `quot` 2) * f x ((n+1) `quot` 2) -==> f (x*x) ((n+1) `quot` 2) -==> ff (x*x) ((n+1) `quot` 2) -==> ff x (n+1) -\end{spec} -and we are finally done. Note the use of the induction hypothesis in -the second step, as justified earlier. The proof of the auxiliary -property is not difficult, but also requires induction; it is shown in -Figure \ref{fig:exp-lemma}. - -\begin{figure} -\cbox{ -\begin{minipage}{4.75in} -Base case (|n=0|): -\begin{spec} -f x 0 * f x 0 -==> 1 * 1 -==> 1 -==> f (x*x) 0 -\end{spec} -Induction step (|n+1|): -\begin{spec} -f x (n+1) * f x (n+1) -==> (x * f x n) * (x * f x n) -==> (x*x) * (f x n * f x n) -==> (x*x) * f (x*x) n -==> f (x*x) (n+1) -\end{spec} -\end{minipage}} -\caption{Proof that |f x n * f x n = f (x*x) n|.} -\label{fig:exp-lemma} -\end{figure} - -Aside from improving efficiency, one of the pleasant outcomes of -proving that |(^)| and |(^!)| are equivalent is that -\emph{anything that we prove about one function will be true for the - other}. For example, the validity of the property that we proved -earlier: -\[ |x^(n+m) = x^n * x^m| \] -immediately implies the validity of: -\[ |x^!(n+m) = x^!n * x^!m| \] -Although |(^!)| is more efficient than |(^)|, it is also more -complicated, so it makes sense to try proving new properties for -|(^)|, since the proofs will likely be easier. - -The moral of this story is that you should not throw away old code that -is simpler but less efficient than a newer version. That old code can -serve at least two good purposes: First, if it is simpler, it is -likely to be easier to understand, and thus serves a useful role in -documenting your effort. Second, as we have just discussed, if it is -provably equivalent to the new code, then it can be used to simplify -the task of proving properties about the new code. - -\vspace{.1in}\hrule - -\begin{exercise}\em -The function |(^!)| can be made more efficient by noting that in -the last line of the definition of |ff|, |n| is odd, and -therefore |n-1| must be even, so the test for |n| being even on -the next recursive call could be avoided. Redefine |(^!)| so that -it avoids this (minor) inefficiency. -\end{exercise} - -\begin{exercise}\em -Consider this definition of the \emph{factorial} function:\footnote{The -factorial function is defined mathematically as: -\[\mathit{factorial}(n) = - \left\{ \begin{array}{ll} - 1 & \mbox{if $n=0$} \\ - n * \mathit{factorial} (n-1) & \mbox{otherwise} - \end{array} - \right. -\] } -\begin{spec} -fac1 :: Integer -> Integer -fac1 0 = 1 -fac1 n = n * fac1 (n-1) -\end{spec} -and this alternative definition that uses an ``accumulator:'' -\begin{spec} -fac2 :: Integer -> Integer -fac2 n = fac' n 1 - where fac' 0 acc = acc - fac' n acc = fac' (n-1) (n*acc) -\end{spec} -Prove that |fac1 = fac2|. -\end{exercise} - -\vspace{.1in}\hrule - -\out{ - -There are several points that you should remember about this proof process: -\begin{enumerate} -\item Two programs can be proved equivalent using induction. -\item It is often the case that auxiliary properties are needed to -prove certain properties, whose proofs in turn can be treated -separately. -\item The most obvious proof strategy is not always best. -\end{enumerate} - -Indeed, the full definition of |(^)| as given in the Standard -Prelude is: -\begin{spec} -(^) :: (Num a, Integral b) => a -> b -> a -x ^ 0 = 1 -x ^ n | n > 0 = f x (n-1) x - where f _ 0 y = y - f x n y = g x n - where g x n | even n = g (x*x) (n `quot` 2) - | otherwise = f x (n-1) (x*y) -_ ^ _ = error "Prelude.^: negative exponent" -\end{spec} -} diff --git a/HSoM/Interlude.lhs b/HSoM/Interlude.lhs deleted file mode 100644 --- a/HSoM/Interlude.lhs +++ /dev/null @@ -1,451 +0,0 @@ -%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- - -%include lhs2TeX.fmt -%include myFormat.fmt - -\out{ -\begin{code} --- This code was automatically generated by lhs2tex --code, from the file --- HSoM/Interlude.lhs. (See HSoM/MakeCode.bat.) - -\end{code} -} - -\chapter{A Musical Interlude} -\label{ch:interlude} - -At this point enough detail about Haskell and Euterpea has been -covered that it is worth developing a small but full application or -two. In this chapter an existing composition will be transcribed into -Euterpea, thus exemplifying how to express conventional musical ideas -in Euterpea. Then a simple form of algorithmic composition will be -presented, where it will become apparent that more exotic things can -be easily expressed as well. - -But before tackling either of these, Haskell's \emph{modules} will be -described in more detail. - -\section{Modules} -\label{sec:modules} - -Haskell programs are partitioned into \emph{modules} that capture -common types, functions, etc.\ that naturally comprise an application. -The first part of a module is called the module \emph{header}, which -declares what the name of the module is, and what other modules -it might import. For this chapter the module's name is |Interlude|, -into which the module |Euterpea| is imported: -\indexkw{module} -\begin{spec} -module Interlude where -import Euterpea -\end{spec} - -\syn{Module names must always be capitalized (just like type names).} - -Maintaining the name space of modules in a large software system can -be a daunting task. So Haskell provides a way to structure module -names \emph{hierachically}. Indeed, because the |Interlude| module is -part of the overall Euterpea library, the actual module declaration -that is used is: -\begin{spec} -module Euterpea.Examples.Interlude where -import Euterpea -\end{spec} -This says that the |Interlude| module is part of the |Examples| folder -in the overall |Euterpea| library. In general, these hierarchical -names correspond to the folder (directory) structure of a particular -implementation. Similarly, the name of the file containing the module -is generally the same as the module name, plus the file extension (in -this case, the name of the file is |Interlude.lhs|). - -If we wish to use this module in another module |M|, say, it may be -imported into |M|, just as was done above in importing |Euterpea| into -|Interlude|: -\begin{spec} -module M where -import Euterpea.Examples.Interlude -\end{spec} -This will make available in |M| all of the names of functions, types, -and so on that are defined at the top-level of |Interlude|. - -\index{module!interface} -\index{module!\hkw{import}} \indexkw{import} - -But this is not always what the programmer would like. Another -purpose of a module is to manage the overall name space of an -application. Modules allow us to structure an application in such a -way that only the functionality intended for the end user is -visible---everything else needed to implement the system is -effectively hidden. In the case of |Interlude|, there are only two -names whose visibillity is desirable: |childSong6|, and |prefix|. -This can be achieved by writing the module header as follows: -\begin{spec} -module Euterpea.Examples.Interlude(childSong6, prefix) where -import Euterpea -\end{spec} -This set of visible names is sometimes called the \emph{export list} -of the module. If the list is omitted, as was done initially, then -\emph{all} names defined at the top level of the module are exported. - -Although explicit type signatures in export lists are -not allowed, it is sometime useful to add them as comments, at least, -as in: -\begin{code} -module Euterpea.Examples.Interlude - ( childSong6, -- :: Music Pitch, - prefix -- :: [Music a] -> Music a) - ) where -import Euterpea -\end{code} -In this case the list of names is sometimes called the {\em interface} -to the module. - -There are several other rules concerning the import and export of -names to and from modules. Rather than introduce them all at once, -they will be introduced as needed in future chapters. - -\begin{figure*} -\IfFileExists{pics/ChildSong6.eps}{ - \centerline{ - \epsfysize=7in - \epsfbox{pics/ChildSong6.eps}} -}{ -% We use a parbox here to make sure that the figure takes up a full page, -% just like ChildSong6, so that page numbers will remain consistent. - \parbox[c][8in][c]{\textwidth}{\center{\framebox[1.1\width]{Image omitted due to repository space issues.}}} -} -\caption{Excerpt from Chick Corea's \emph{Children's Songs No.\ 6}} -\label{fig:childsong6} -\end{figure*} - -\section{Transcribing an Existing Score} - -Figure \ref{fig:childsong6} shows the first 28 bars of Chick Corea's -\emph{Children's Songs No.\ 6}, written for electric piano -\cite{Corea94}. Analyzing the structure of this tune explores several -basic issues that arise in the transcription of an existing score into -Euterpea, including repeating phrases, grace notes, triplets, tempo, -and specifying an instrument. To begin, however, we will define a -couple of auxiliary functions to make our job easier. - -\subsection{Auxiliary Functions} - -For starters, note that there are several repeating patterns of notes -in this composition, each enclosed in a rectangle in Figure -\ref{fig:childsong6}. In fact, the bass line consists \emph{entirely} -of three repeating phrases. In anticipation of this, a function can -be defined that repeats a phrase a particular number of times: -\begin{spec} - -timesM :: Int -> Music a -> Music a -timesM 0 m = rest 0 -timesM n m = m :+: timesM (n-1) m -\end{spec} - -\syn{Note that pattern-matching can be used on numbers. As mentioned - earlier, when there is more than one equation that defines a - function, the first equation is tried first. If it fails, the - second equation is tried, and so on. In the case above, if the - first argument to |timesM| is not 0, the first equation will fail. - The second equation is then tried, which always succeeds. -} - -%% An expression \hs{if pred then cons else alt} is called a {\em -%% conditional expression}. If \hs{pred} (called the {\em -%% predicate}) evaluates to |True|, then \hs{cons} (called the {\em -%% consequence}) is the result; if \hs{pred} evaluates to |False|, -%% then \hs{alt} (called the {\em alternative}) is the result. - -So, for example, |timesM 3 b1| will repeat the baseline |b1| (to be -defined shortly) three times. - -To motivate the second auxiliary function, note in Figure -\ref{fig:childsong6} that there are many melodic lines that consist of -a sequence of consecutive notes having the same duration (for example -eighth notes in the melody, and dotted quarter notes in the bass). To -avoid having to write each of these durations explicitly, we will -define a function that specifies them just once. To do this, recall -that |a 4 qn| is a concert A quarter note. Then note that, because of -currying, |a 4| is a function that can be applied to any -duration---i.e.\ its type is |Dur -> Music a|. In other words, it is -a note whose duration has not been specified yet. - -With this thought in mind, we can return to the original problem and -define a function that takes a duration and a \emph{list} of notes with -the aforementioned type, returning a |Music| value with the duration -attached to each note appropriately. In Haskell: - -\begin{code} - -addDur :: Dur -> [Dur -> Music a] -> Music a -addDur d ns = let f n = n d - in line (map f ns) -\end{code} -(Compare this idea with Exercise \ref{ex:fuse} in Chapter -\ref{ch:poly}.) - -Finally, a function to add a grace note to a note is defined. Grace -notes can approach the principal note from above or below; sometimes -starting a half-step away, and sometimes a whole step; and having a -rhythmic interpretation that is to a large extent up to the performer. -In the case of the six uses of grace notes in \emph{Children's Songs - No.\ 6}, we will assume that the grace note begins on the downbeat -of the principal note, and thus its duration will subtract from that -of the principal note. We will also assume that the grace note -duration is 1/8 of that of the principal note. Thus the goal is to -define a function: -\begin{code} -graceNote :: Int -> Music Pitch -> Music Pitch -\end{code} -such that |graceNote n (note d p)| is a |Music| value consisting of -two notes, the first being the grace note whose duration is -$\nicefrac{d}{8}$ and whose pitch is |n| semitones higher (or lower if -|n| is negative) than |p|, and the second being the principal note at -pitch |p| but now with duration $\nicefrac{7d}{8}$. In Haskell: -\begin{code} -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." -\end{code} -Note that pattern-matching is performed against the nested -constructors of |Prim| and |Note|---we cannot match against the -application of a function such as |note|. Also note the error -message---programs are not expected to ever apply |graceNote| to -something other than a single note. - -(In Chapter~\ref{ch:more-music} a slightly more general form of -|graceNote| will be defined.) - -The only special cases that will not be handled using auxiliary -functions are the single staccato on note four of bar fifteen, and the -single portamento on note three of bar sixteen. These situations will -be addressed differently in a later chapter. - -\subsection{Bass Line} - -With these auxilary functions now defined, the base line in -Figure~\ref{fig:childsong6} can be defined by first noting the three -repeating phrases (enclosed in rectangular boxes), which can be -captured as follows: -\begin{code} - -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] -\end{code} - -Using |timesM| it is then easy to define the entire 28 bars of the -base line: -\begin{code} -bassLine = timesM 3 b1 :+: timesM 2 b2 :+: - timesM 4 b3 :+: timesM 5 b1 -\end{code} - -\subsection{Main Voice} - -The upper voice of this composition is a bit more tedious to define, -but is still straightforward. At the highest level, it consists of -the phrase |v1| in the first two bars (in the rectangular box) -repeated three times, followed by the remaining melody, which will be -named |v2|: -\begin{code} -mainVoice = timesM 3 v1 :+: v2 -\end{code} - -The repeating phrase |v1| is defined by: -\begin{code} -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] -\end{code} -Note the treatment of the grace note. - -The remainder of the main voice, |v2|, is defined in seven pieces: -\begin{code} -v2 = v2a :+: v2b :+: v2c :+: v2d :+: v2e :+: v2f :+: v2g -\end{code} -with each of the pieces defined in Figure \ref{fig:bars7-28}. Note that: -\begin{itemize} -\item The phrases are divided so as to (for the most part) line up - with bar lines, for convenience. But it may be that this is not the - best way to organize the music---for example, we could argue that - the last two notes in bar 20 form a ``pick-up'' to the phrase that - follows, and thus more logically fall with that following phrase. - The organization of the Euterpea code in this way is at the - discretion of the composer. - -\item The stacatto is treated by playing the qurater note as an eighth - note; the portamento is ignored. As mentioned earlier, these - ornamentations will be addressed differently in a later chapter. - -\item The triplet of eighth notes in bar 25 is addressed by scaling the - tempo by a factor of |3/2|. -\end{itemize} - -\begin{figure} -\cbox{\small -\begin{code} -v2a = line [ cs 5 (dhn+dhn), d 5 dhn, - f 5 hn, gs 5 qn, fs 5 (hn+en), g 5 en] -- bars 7-11 -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] -- bars 12-13 -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] - -- bars 14-16 -v2d = addDur en [ fs 5, cs 5, e 5, cs 5, - a 4, as 4, d 5, e 5, fs 5] -- bars 17-18.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 ] - -- bars 18.5-20 -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] -- bars 21-23 -v2g = tempo (3/2) (line [cs 5 en, d 5 en, cs 5 en]) :+: - b 4 (3*dhn+hn) -- bars 24-28 -\end{code}} -\caption{Bars 7-28} -\label{fig:bars7-28} -\end{figure} - -\subsection{Putting It All Together} - -In the Preface to \emph{Children's Songs -- 20 Pieces for Keyboard} -\cite{Corea94}, Chick Corea notes that, ``Songs 1 through 15 were -composed for the Fender Rhodes.'' Therefore the MIDI instrument -|RhodesPiano| is a logical choice for the transcription of his -composition. Furthermore, note in the score that a dotted half-note -is specified to have a metronome value of 69. By default, the |play| -function in Euterpea uses a tempo equivalent to a quarter note having -a metronome value of 120. Therefore the tempo should be scaled by a -factor of |(dhn/qn)*(69/120)|. - -These two observations lead to the final definition of the -transcription of \emph{Children's Songs No.\ 6} into Euterpea: -\begin{code} -childSong6 :: Music Pitch -childSong6 = let t = (dhn/qn)*(69/120) - in instrument RhodesPiano - (tempo t (bassLine :=: mainVoice)) -\end{code} -The intent is that this is the only value that will be of interest to -users of this module, and thus |childSong6| is the only name exported -from this section of the module, as discussed in Section -\ref{sec:modules}. - -This example can be played through the command |play childSong6|. - -\vspace{.1in}\hrule - -\begin{exercise}{\em -Find a simple piece of music written by your favorite composer, and -transcribe it into Euterpea. In doing so, look for repeating patterns, -transposed phrases, etc.\ and reflect this in your code, thus revealing -deeper structural aspects of the music than that found in common -practice notation.} -\end{exercise} - -\vspace{.1in}\hrule - -\section{Simple Algorithmic Composition} -\label{sec:alg-comp} - -\emph{Algorithmic composition} is the process of designing an -algorithm (or heuristic) for generating music. There are unlimited -possibilites, with some trying to duplicate a particular style of -music, others exploring more exotic styles; some based on traditional -notions of music theory, others not; some completely deterministic, -others probabilistic; and some requiring user interaction, others being -completely automatic. Some even are based simply on ``interpreting'' -data---like New York Stock Exchange numbers---in interesting ways! In -this textbook a number of algorithmic composition techniques are -explored, but the possibilities are endless---hopefully what is -presented will motivate the reader to invent new, exciting algorithmic -composition techniques. - -To give a very tiny glimpse into algorithmic composition, we end this -chapter with a very simple example. We will call this example -``prefix,'' for reasons that will become clear shortly. - -The user of this algorithm provides an initial melody (or ``motif'') -represented as a list of notes. The main idea is to play every proper -(meaning non-empty) prefix of the given melody in succession. So the -first thing we do is define a polymorphic function |prefixes :: [a] -> -[[a]]| that returns all proper prefixes of a list: -\begin{code} -prefixes :: [a] -> [[a]] -prefixes [] = [] -prefixes (x:xs) = let f pf = x:pf - in [x] : map f (prefixes xs) -\end{code} -We can use this to play all prefixes of a given melody |mel| in -succession as follows: -\begin{spec} -play (line (concat (prefixes mel))) -\end{spec} - -But let's do a bit more. Let's create two voices (each using a -different instrument), one voice being the reverse of the other, and -play them in parallel. And then let's play the whole thing once, then -transposed up a perfect fourth (i.e.\ five semitones), then repeat the -whole thing a final time. And, let's package it all into one -function: -\begin{code} -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 -\end{code} - -Here are two melodies (differing only in rhythm) that you can try with -this algorithm: -\begin{code} -mel1 = [c 5 en, e 5 sn, g 5 en, b 5 sn, a 5 en, f 5 sn, d 5 en, b 4 sn, c 5 en] -mel2 = [c 5 sn, e 5 sn, g 5 sn, b 5 sn, a 5 sn, f 5 sn, d 5 sn, b 4 sn, c 5 sn] -\end{code} -Although not very sophisticated at all, |prefix| can generate some -interesting music from a very small seed. - -Another typical approach to algorithmic composition is to specify some -constraints on the solution space, and then generate lots of solutions -that satisfy those constraints. The user can then choose one of the -solutions based on aesthetic preferences. - -As a simple example of this, how do we choose the original melody in -the prefix program above? We could require that all solutions be a -multiple of some preferred meter. For example, in triple meter (say, -$\nicefrac{3}{4}$ time) we might wish for the solutions to be -multiples of 3 quarter-note beats (i.e. one measure), or in -$\nicefrac{4}{4}$ time, multiples of 4 beats. In this way the result -is always an integer number of measures. If the original melody -consists of notes all of the same duration, say one beat, then the -prefixes, when played sequentially, will have a total duration that is -the sum of the numbers 1 through |n|, where |n| is the length of melody -in beats. That sum is $\nicefrac{n*(n+1)}{2}$. The first ten sums in -this series are: -\[1, 3, 6, 10, 15, 21, 28, 36, 45, 55, ...\] -The second, third, fifth, sixth, eighth, and ninth of these are -divisible by 3, and the seventh and eighth are divisible by 4. When -rendering the result we could then, for exaple, place an accent on the -first note in each of these implied measures, thus giving the result -more of a musical feel. (Placing an accent on a note will be -explained in Chapters \ref{ch:more-music} and \ref{ch:performane}.) - -\vspace{.1in}\hrule - -\begin{exercise}{\em -Try using |prefix| on your own melodies. Indeed, note that the list of notes -could in general be a list of any |Music| values.} -\end{exercise} - -\begin{exercise}{\em -Try making the following changes to |prefix|: -\begin{enumerate} -\item Use different instruments. -\item Change the definition of |m| in some way. -\item Compose the result in a different way. -\end{enumerate} } -\end{exercise} - -\vspace{.1in}\hrule diff --git a/HSoM/Intro.lhs b/HSoM/Intro.lhs deleted file mode 100644 --- a/HSoM/Intro.lhs +++ /dev/null @@ -1,1508 +0,0 @@ -%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- - -%include lhs2TeX.fmt -%include myFormat.fmt - -\chapter[Computer Music, Euterpea, and Haskell]{Overview of - Computer Music, Euterpea, and Haskell} -\label{ch:intro} - -Computers are everywhere. And so is music! Although some might think -of the two as being at best distant relatives, in fact they share many -deep properties. Music comes from the soul, and is inspired by the -heart, yet it has the mathematical rigor of computers. Computers have -mathematical rigor of course, yet the most creative ideas in -mathematics and computer science come from the soul, just like music. -Both disciplines demand both left-brain and right-brain skills. It -always surprises me how many computer scientists and mathematicians -have a serious interest in music. It seems that those with a strong -affinity or acuity in one of these disciplines is often strong in the -other as well. - -It is quite natural then to consider how the two might interact. In -fact there is a long history of interactions between music and -mathematics, dating back to the Greeks' construction of musical scales -based on arithmetic relationships, and including many classical -composers use of mathematical structures, the formal harmonic analysis -of music, and many modern music composition techniques. Advanced -music theory uses ideas from diverse branches of mathematics such as -number theory, abstract algebra, topology, category theory, calculus, -and so on. - -There is also a long history of efforts to combine computers and -music. Most consumer electronics today are digital, as are most forms -of audio processing and recording. But in addition, digital musical -instruments provide new modes of expression, notation software and -sequencers have become standard tools for the working musician, and -those with the most computer science savvy use computers to explore -new modes of composition, transformation, performance, and analysis. - -This textbook explores the fundamentals of computer music using a -language-centric approach. In particular, the functional programming -language \emph{Haskell} is used to express all of the computer music -concepts. Thus a by-product of learning computer music concepts will -be learning how to program in Haskell. The core musical ideas are -collected into a Haskell library called \emph{Euterpea}. The name -``Euterpea'' is derived from \emph{Euterpe}, who was one of the nine -Greek muses, or goddesses of the arts, specifically the muse of music. -A hypothetical picture of Euterpe graces the cover of this textbook. - -\section{The Note vs. Signal Dichotomy} - -The field of computer music has grown astronomically over the past -several decades, and the material can be structured and organized -along several dimensions. A dimension that proves particulary useful -with respect to a programming language is one that separates -\emph{high-level} musical concerns from \emph{low-level} musical -concerns. Since a ``high-level'' programming language---namely -Haskell---is used to program at both of these musical levels, to avoid -confusion the terms \emph{note level} and \emph{signal level} will be -used in the musical dimension. - -At the \emph{note level}, a \emph{note} (i.e.\ pitch and duration) is -the lowest musical entity that is considered, and everything else is -built up from there. At this level, in addition to conventional -representations of music, we can study interesting aspects of -so-called \emph{algorithmic composition}, including the use of -fractals, grammar-based systems, stochastic processes, and so on. -From this basis we can also study the harmonic and rhythmic -\emph{analysis} of music, although that is not currently an emphasis -in this textbook. Haskell facilitates programming at this level -through its powerful data abstraction facilities, higher-order -functions, and declarative semantics. - -In contrast, at the \emph{signal level} the focus is on the actual -sound generated in a computer music application, and thus a -\emph{signal} is the lowest entity that is considered. Sound is -concretely represented in a digital computer by a discrete sampling of -the continuous audio signal, at a high enough rate that human ears -cannot distinguish the discrete from the continuous, usually 44,100 -samples per second (the standard sampling rate used for CDs, mp3 -files, and so on). But in Euterpea, these details are hidden: signals -are treated abstractly as continuous quantities. This greatly eases -the burden of programming with sequences of discrete values. At the -signal level, we can study sound synthesis techniques (to simulate -the sound of a conventional instrument, say, or something completely -artificial), audio processing (e.g.\ determining the frequency -spectrum of a signal), and special effects (reverb, panning, -distortion, and so on). - -Suppose for a moment that a musician is playing music using a -metro\-nome set at 96, which corresponds to 96 beats per minute. That -means that one beat takes $\nicefrac{60}{96}$ = 0.625 seconds. At a -stereo sampling rate of 44,100 samples per second, that in turn -translates into $2\times 0.625\times 44,100$ = 55,125 samples, and -each sample typically occupies several bytes of computer memory. This -is typical of the minimum memory requirements of a computation at the -signal level. In contrast, at the note level, we only need some kind -of operator or data structure that says ``play this note,'' which -requires a total of only a small handful of bytes. This dramatic -difference highlights one of the key computational differences between -programming at the note level versus the signal level. - -Of course, many computer music applications involve both the note -level \emph{and} the signal level, and indeed there needs to be a -mechanism to mediate between the two. Although such mediation can -take many forms, it is for the most part straightforward. Which is -another reason why the distinction between the note level and the -signal level is so natural. - -This textbook begins with a treatment of the note level -(Chapters~\ref{ch:intro}-\ref{ch:MUI}) and follows with a treatment of -the signal level (Chapters~\ref{ch:signals}-\ref{ch:additive}). If -you are interested only in the signal level, you could skip -Chapters~\ref{ch:performance}-\ref{ch:MUI}. - -\section{Basic Principles of Programming} - -Programming, in its broadest sense, is \emph{problem solving}. It -begins by recognizing problems that can and should be solved using a -digital computer. Thus the first step in programming is answering the -question, ``What problem am I trying to solve?'' - -% ``Solving the wrong problem'' is a phrase often heard in many -% contexts, and we certainly do not want to be victims of that crime. - -% \footnote{Of course, not all problems fall into this category, and -% some problems are solved (or are attempted to be solved) using -% computers that probably should not be. But I will avoid this -% digression.} - -Once the problem is understood, a solution must be found. This may -not be easy, of course, and in fact you may discover several -solutions, so a way to measure success is needed. There are various -dimensions in which to do this, including correctness (``Will I get -the right answer?'') and efficiency (``Will it run fast enough, or use -too much memory?''). But the distinction of which solution is better -is not always clear, since the number of dimensions can be large, and -programs will often excel in one dimension and do poorly in others. -For example, there may be one solution that is fastest, one that uses -the least amount of memory, and one that is easiest to understand. -Deciding which to choose can be difficult, and is one of the more -interesting challenges in programming. - -The last measure of success mentioned above---clarity of a -program---is somewhat elusive: difficult to quantify and measure. -Nevertheless, in large software systems clarity is an especially -important goal, since such systems are worked on by many people over -long periods of time, and evolve considerably as they mature. Having -easy-to-understand code makes it much easier to modify. - -In the area of computer music, there is another reason why clarity is -important: namely, that the code often represents the author's thought -process, musical intent, and artistic choices. A conventional -musical score does not say much about what the composer thought as she -wrote the music, but a program often does. So when you write your -programs, write them for others to see, and aim for elegance and beauty, -just like the musical result that you desire. - -Programming is itself a creative process. Sometimes programming -solutions (or artistic creations) come to mind all at once, with -little effort. More often, however, they are discovered only after -lots of hard work! We may write a program, modify it, throw it away -and start over, give up, start again, and so on. It is important to -realize that such hard work and reworking of programs is the norm, and -in fact you are encouraged to get into the habit of doing so. Do not -always be satisfied with your first solution, and always be prepared -to go back and change or even throw away those parts of your program -that you are not happy with. - -\section{Computation by Calculation} -\index{computation by calculation} - -It is helpful when learning a new programming language to have a good -grasp of how programs in that language are executed---in other words, -an understanding of what a program \emph{means}. The execution of -Haskell programs is perhaps best understood as \emph{computation by - calculation}. Programs in Haskell can be viewed as \emph{functions} -whose input is that of the problem being solved, and whose output is -the desired result---and the behavior of functions can be effectively -understood as computation by calculation. - -An example involving numbers might help to demonstrate these ideas. -Numbers are used in many applications, and computer music is no -exception. For example, integers might be used to represent pitch, -and floating-point numbers might be used to perform calculations -involving frequency or amplitude. - -Suppose we wish to perform an arithmetic calculation such as -$3\times(9+5)$. In Haskell this would be written as |3*(9+5)|, since -most standard computer keyboards and text editors do not recognize the -special symbol $\times$. The result can be calculated as follows: -\begin{spec} -3*(9+5) -==> 3*14 -==> 42 -\end{spec} -It turns out that this is not the only way to compute the result, as -evidenced by this alternative calculation:\footnote{This assumes that - multiplication distributes over addition in the number system being - used, a point that will be returned to later in the text.} -\begin{spec} -3*(9+5) -==> 3*9 + 3*5 -==> 27 + 3*5 -==> 27+15 -==> 42 -\end{spec} -\index{efficiency}% - -Even though this calculation takes two extra steps, it at least gives -the same, correct answer. Indeed, an important property of each and -every program written in Haskell is that it will always yield the same -answer when given the same inputs, regardless of the order chosen to -perform the calculations.\footnote{This is true as long as a - non-terminating sequence of calculations is not chosen, another - issue that will be addressed later.} This is precisely the -mathematical definition of a \emph{function}: for the same inputs, it -always yields the same output. - -On the other hand, the first calculation above required fewer steps -than the second, and thus it is said to be more \emph{efficient}. -Efficiency in both space (amount of memory used) and time (number of -steps executed) is important when searching for solutions to problems. -Of course, if the computation returns the wrong answer, efficiency is -a moot point. In general it is best to search first for an elegant -(and correct!) solution to a problem, and later refine it for better -performance. This strategy is sometimes summarized as, ``Get it right -first!'' - -The above calculations are fairly trivial, but much more sophisticated -computations will be introduced soon enough. For starters---and to -introduce the idea of a Haskell function---the arithmetic operations -performed in the previous example can be \emph{generalized} by -defining a function to perform them for any numbers |x|, |y|, and |z|: -\indexhs{simple} -\begin{spec} -simple x y z = x*(y+z) -\end{spec} -This equation defines |simple| as a function of three -\emph{arguments}, |x|, |y|, and |z|. In mathematical notation this -definition might be written differently, such as one of the following: -\[\begin{array}{l} -{\it simple}(x,y,z) = x\times(y+z)\\ -{\it simple}(x,y,z) = x\cdot(y+z)\\ -{\it simple}(x,y,z) = x(y+z) -\end{array}\] -In any case, it should be clear that ``|simple 3 9 5|'' is the same -as ``|3*(9+5)|.'' In fact the proper way to calculate the result is: -\begin{spec} -simple 3 9 5 -==> 3*(9+5) -==> 3*14 -==> 42 -\end{spec} -\index{unfold (in a calculation)} -The first step in this calculation is an example of \emph{unfolding} a -function definition: 3 is substituted for |x|, 9 for |y|, and 5 -for |z| on the right-hand side of the definition of |simple|. -This is an entirely mechanical process, not unlike what the computer -actually does to execute the program. - -|simple 3 9 5| is said to \emph{evaluate} to 42. To express the fact -that an expression $e$ evaluates (via zero, one, or possibly many more -steps) to the value $v$, we will write $e \Longrightarrow v$ (this arrow -is longer than that used earlier). So we can say directly, for -example, that |simple 3 9 5 ===> 42|, which should be read ``|simple 3 -9 5| evaluates to 42.'' - -With |simple| now suitably defined, we can repeat the sequence of -arithmetic calculations as often as we like, using different values -for the arguments to |simple|. For example, -|simple 4 3 2 ===> 20|. - -We can also use calculation to \emph{prove properties} about -programs. For example, it should be clear that for any |a|, |b|, and -|c|, |simple a b c| should yield the same result as |simple a c b|. -For a proof of this, we calculate \emph{symbolically}; that is, -using the symbols |a|, |b|, and |c| rather than concrete numbers such -as 3, 5, and 9: -\begin{spec} -simple a b c -==> a*(b+c) -==> a*(c+b) -==> simple a c b -\end{spec} -Note that the same notation is used for these symbolic steps as for -concrete ones. In particular, the arrow in the notation reflects the -direction of formal reasoning, and nothing more. In general, if |e1 -==> e2|, then it is also true that |e2 ==> e1|. - -These symbolic steps are also referred to as as ``calculations,'' even -though the computer will not typically perform them when executing a -program (although it might perform them \emph{before} a program is run -if it thinks that it might make the program run faster). The second -step in the calculation above relies on the commutativity of addition -(namely that, for any numbers $x$ and $y$, $x+y=y+x$). The third step -is the reverse of an unfold step, and is appropriately called a -\emph{fold} calculation. \index{fold (in a calculation)} It would be -particularly strange if a computer performed this step while executing -a program, since it does not seem to be headed toward a final answer. -But for proving properties about programs, such ``backward reasoning'' -is quite important. - -When we wish to spell out the justification for each step, whether -symbolic or concrete, a calculation can be annotated with more detail, -as in: -\begin{spec} -simple a b c -==> { unfold } -a*(b+c) -==> { commutativity } -a*(c+b) -==> { fold } -simple a c b -\end{spec} -In most cases, however, this will not be necessary. - -Proving properties of programs is another theme that will be repeated -often in this text. Computer music applications often have some kind -of a mathematical basis, and that mathematics must be reflected -somewhere in our programs. But how do we know if we got it right? -Proof by calculation is one way to connect the problem specification -with the program solution. - -More broadly speaking, as the world begins to rely more and more on -computers to accomplish not just ordinary tasks such as writing term -papers, sending email, and social networking, but also life-critical -tasks such as controlling medical procedures and guiding spacecraft, -then the correctness of programs gains in importance. Proving complex -properties of large, complex programs is not easy---and rarely if ever -done in practice---but that should not deter us from proving simpler -properties of the whole system, or complex properties of parts of the -system, since such proofs may uncover errors, and if not, will at -least give us confidence in our effort. - -If you are someone who is already an experienced programmer, the idea -of computing \emph{everything} by calculation may seem odd at best, -and na\"{i}ve at worst. How do we write to a file, play a sound, -draw a picture, or respond to mouse-clicks? If you are wondering -about these things, it is hoped that you have patience reading the -early chapters, and that you find delight in reading the later -chapters where the full power of this approach begins to shine. - -In many ways this first chapter is the most difficult, since it -contains the highest density of new concepts. If the reader has -trouble with some of the concepts in this overview chapter, keep in -mind that most of them will be revisited in later chapters. And do not -hesitate to return to this chapter later to re-read difficult -sections; they will likely be much easier to grasp at that time. - -\syn{In the remainder of this textbook the need will often arise to - explain some aspect of Haskell in more detail, without distracting - too much from the primary line of discourse. In those circumstances - the explanations will be offset in a shaded box such as this one, - proceeded with the word ``Details.''} - -\vspace{.1in}\hrule - -\begin{exercise}{\em -Write out all of the steps in the calculation of the value of -\begin{spec} -simple (simple 2 3 4) 5 6 -\end{spec} -} -\end{exercise} - -\begin{exercise}{\em -Prove by calculation that |simple (a-b) a b ===>| $a^2 - b^2$.} -\end{exercise} - -\vspace{.1in}\hrule - -\section{Expressions and Values} -\label{sec:expressions} - -In Haskell, the entities on which calculations are performed are -called \emph{\indexwd{expressions}}, and the entities that result from -a calculation---i.e.\ ``the answers''---are called -\emph{\indexwd{values}}. It is helpful to think of a value just as an -expression on which no more calculation can be carried out---every -value is an expression, but not the other way around. - -Examples of expressions include \emph{atomic} (meaning, indivisible) -values such as the integer |42| and the character |'a'|, which are -examples of two \emph{primitive} atomic values in Haskell. The next -chapter introduces examples of \emph{constructor} atomic values, such -as the musical notes |C|, |D|, |Ef|, |Fs|, etc., which in standard -music notation are written C, D, E$\flat$, F$\sharp$, etc., and are -pronounced C, D, E-flat, F-sharp, etc. (In music theory, note names -are called \emph{pitch classes}.). - -In addition, there are \emph{structured} expressions (i.e., made from -smaller pieces) such as the \emph{\indexwd{list}} of pitches -|[C,D,Ef]|, the character/number \emph{\indexwd{pair}} |('b',4)| -(lists and pairs are different in a subtle way, to be described -later), and the string |"Euterpea"|. Each of these structured -expressions is also a value, since by themselves there is no further -calculation that can be carried out. As another example, |1+2| is an -expression, and one step of calculation yields the expression |3|, -which is a value, since no more calculations can be performed. As a -final example, as was expained earlier, the expression |simple 3 9 5| -evaluates to the value 42. - -Sometimes, however, an expression has only a never-ending -sequence of calculations. For example, if |x| is defined as: -\begin{spec} -x = x + 1 -\end{spec} -then here is what happens when trying to calculate the value of |x|: -\begin{spec} -x -==> x + 1 -==> (x + 1) + 1 -==> ((x + 1) + 1) + 1 -==> (((x + 1) + 1) + 1) + 1 -... -\end{spec} -Similarly, if a function |f| is defined as: -\begin{spec} -f x = f (x-1) -\end{spec} -then an expression such as |f 42| runs into a similar problem: -\begin{spec} -f 42 -==> f 41 -==> f 40 -==> f 39 -... -\end{spec} -Both of these clearly result in a never-ending sequence of -calculations. Such expressions are said to not terminate, or -\emph{diverge}. In such cases the symbol |bottom|\index{bottom}, -pronounced ``bottom,'' is used to denote the value of the expression. -This means that every diverging computation in Haskell denotes the -same |bottom| value,\footnote{Technically, each type has its own - version of |bottom|.} reflecting the fact that, from an observer's -point of view, there is nothing to distinguish one diverging -computation from another. - -\section{Types} - -Every expression (and therefore every value) also has an associated -\emph{\indexwd{type}}. It is helpful to think of types as sets of -expressions (or values), in which members of the same set have much in -common. Examples include the primitive atomic types -\indexwdhs{Integer} (the set of all integers) and \indexwdhs{Char} -(the set of all characters), the user-defined atomic type |PitchClass| -(the set of all pitch classes, i.e.\ note names), as well as the -structured types |[Integer]| and |[PitchClass]| (the sets of all lists -of integers and lists of pitch classes, respectively), and |String| -(the set of all Haskell strings). - -The association of an expression or value with its type is very -useful, and there is a special way of expressing it in Haskell. -Using the examples of values and types above: -\begin{spec} -D :: PitchClass -42 :: Integer -'a' :: Char -"Euterpea" :: String -[C,D,Ef] :: [PitchClass] -('b',4) :: (Char,Integer) -\end{spec} -\indexhs{::} -Each association of an expression with its type is called a \emph{type - signature}. - -\index{case sensitivity} - -\syn{Note that the names of specific types are capitalized, such as - |Integer| and |Char|, as are the names of some atomic values such as - |D| and |Fs|. These will never be confused in context, since things - to the right of ``|::|'' are types, and things to the left are - values. Note also that user-defined names of values are \emph{not} - capitalized, such as |simple| and |x|. This is not just a - convention: it is required when programming in Haskell. In - addition, the case of the other characters matters, too. For - example, |test|, |teSt|, and |tEST| are all distinct names for - values, as are |Test|, |TeST|, and |TEST| for types.} - -\syn{Literal characters are written enclosed in single forward quotes - (apostrophes), as in |'a'|, |'A'|, |'b'|, |','|, |'!'|, |' '| (a - space), and so on. (There are some exceptions, however; see the - Haskell Report for details.) Strings are written enclosed in double - quote characters, as in |"Euterpea"| above. The connection between - characters and strings will be explained in a later chapter. - -The ``|::|'' should be read ``has type,'' as in ``42 has type -|Integer|.'' Note that square braces are used both to construct a -list value (the left-hand side of |(::)| above), and to describe its -type (the right-hand side above). Analogously, the round braces used -for pairs are used in the same way. But also note that all of the -elements in a list, however long, must have the same type, whereas the -elements of a pair can have different types.} - -Haskell's \emph{type system} ensures that Haskell programs are -\emph{\indexwd{well-typed}}; that is, that the programmer has not -mismatched types in some way. For example, it does not make much -sense to add together two characters, so the expression |'a' + 'b'| is -\emph{\indexwd{ill-typed}}. The best news is that Haskell's type -system will tell you if your program is well-typed \emph{before you run - it}. This is a big advantage, since most programming errors are -manifested as type errors. - -%% The idea of dividing the world of values into types should be a -%% familiar idea to most people. We do it all of the time for just about -%% every kind of object you can think of. Take boxes, for example. Just -%% as we have integers and reals, lists and tuples, etc., we also have -%% large boxes and small boxes, cardboard boxes and wooden boxes, and so -%% on. And just as we have lists of integers and lists of characters, we -%% also have boxes of nails and boxes of shoes. And just as we would not -%% expect to be able to take the square of a list, or add two characters, -%% we would not expect to be able to use a box to pay for our groceries. - -%% Types help us to make sense of the world by organizing it into groups -%% of common shape, size, functionality, etc. The same is true for -%% programming, where types help us to organize values into groups of -%% common shape, size, and functionality, amongst other things. Of -%% course, the kinds of commonality between values will not be the same -%% as those between objects in the real world, and in general we will be -%% more restricted---and more formal---about just what we can say about -%% types and how we say it. - -% Nevertheless, the analogy holds. - -\section{Function Types and Type Signatures} - -\index{function!type||(} What should the \indexwd{type} of a function -be? It seems that it should at least convey the fact that a function -takes values of one type---|T1|, say---as input, and returns values of -(possibly) some other type---|T2|, say---as output. In Haskell this -is written |T1 -> T2|, and such a function is said to ``map values of -type |T1| to values of type |T2|.''\footnote{In mathematics |T1| is - called the \emph{domain} of the function, and |T2| the - \emph{range}.} If there is more than one argument, the notation is -extended with more arrows. For example, if the intent is that the -function |simple| defined in the previous section has type -|Integer->Integer->Integer->Integer|, we can include a type signature -with the definition of |simple|: \index{type!signature} -\begin{spec} -simple :: Integer -> Integer -> Integer -> Integer -simple x y z = x*(y+z) -\end{spec} -\syn{When writing Haskell programs using a typical text editor, there - typically will not be nice fonts and arrows as in |Integer -> - Integer|. Rather, you will have to type {\tt Integer -> Integer}.} - -\index{type!inference} Haskell's type system also ensures that -user-supplied type signatures such as this one are correct. Actually, -Haskell's type system is powerful enough to allow us to avoid writing -any type signatures at all, in which case the type system is said to -\emph{infer} the correct types.\footnote{There are a few exceptions to - this rule, and in the case of |simple| the inferred type is actually - a bit more general than that written above. Both of these points - will be returned to later.} Nevertheless, judicious placement of -type signatures, as was done for |simple|, is a good habit, since type -signatures are an effective form of documentation and help bring -programming errors to light. In fact, it is a good habit to first -write down the type of each function you are planning to define, as a -first approximation to its full specification---a way to grasp its -overall functionality before delving into its details. - -\index{function!application} -The normal use of a function is referred to as \emph{function - application}. For example, |simple 3 9 5| is the application of -the function |simple| to the arguments 3, 9, and 5. Some -functions, such as |(+)|, are applied using what is known as -\emph{\indexwd{infix} syntax}; that is, the function is written -between the two arguments rather than in front of them (compare -|x+y| to |f x y|). - -\syn{Infix functions are often called \emph{\indexwd{operators}}, and -are distinguished by the fact that they do not contain any numbers or -letters of the alphabet. Thus |^!| and |*#:| are infix -operators, whereas |thisIsAFunction| and |f9g| are not (but are -still valid names for functions or other values). The only exception -to this is that the symbol \emph{'} is considered to be alphanumeric; -thus |f'| and |one's| are valid names, but not operators. - -In Haskell, when referring to an infix operator as a value, it is enclosed -in parentheses, such as when declaring its type, as in: -\begin{spec} -(+) :: Integer -> Integer -> Integer -\end{spec} -Also, when trying to understand an expression such as |f x + g y|, -there is a simple rule to remember: function application \emph{always} -has ``higher \indexwd{precedence}'' than operator application, so that -|f x + g y| is the same as |(f x) + (g y)|. - -Despite all of these syntactic differences, however, operators are -still just functions.} -\index{function!type||)} - -\vspace{.1in}\hrule - -\begin{exercise}{\em -Identify the well-typed expressions in the following, and, for each, -give its proper type: -\begin{spec} -[ A, B, C ] -[ D, 42 ] -( -42, Ef ) -[ ('a',3), ('b',5) ] -simple 'a' 'b' 'c' -( simple 1 2 3, simple ) -["I","love","Euterpea"] -\end{spec} -For those expressions that are ill-typed, explain why. -} -\end{exercise} -\out{ -\begin{spec} -[ (2,3), (4,5) ] -[ D, 42 ] -( Ef, -42 ) -simple 'a' 'b' 'c' -( simple 1 2 3, simple ) -["hello","world"] -\end{spec} -} - -\vspace{.1in}\hrule - -\section{Abstraction, Abstraction, Abstraction} -\label{sec:abstraction} -\index{abstraction||(} - -The title of this section is the answer to the question: ``What are -the three most important ideas in programming?'' Webster defines the -verb ``abstract'' as follows: -\begin{quote} -{\bf abstract}, \emph{vt} (1) remove, separate (2) to consider apart -from application to a particular instance. -\end{quote} -In programming this happens when a pattern repeats itself and we wish -to ``separate'' that pattern from the ``particular instances'' in -which it appears. In this textbook this process is called the -\emph{abstraction principle}.\index{abstraction!principle} The -following sections introduce several different kinds of abstraction, -using examples involving both simple numbers and arithmetic (things -everyone should be familiar with) as well as musical examples (that -are specific to Euterpea). - -\subsection{Naming} -\index{abstraction!naming||(} - -One of the most basic ideas in programming---for that matter, in every -day life---is to \emph{name} things. For example, we may wish to give -a name to the value of $\pi$, since it is inconvenient to retype (or -remember) the value of $\pi$ beyond a small number of digits. In -mathematics the greek letter $\pi$ in fact \emph{is} the name for this -value, but unfortunately we do not have the luxury of using greek -letters on standard computer keyboards and/or text editors. So in -Haskell we write: -\begin{spec} -pi :: Double -pi = 3.141592653589793 -\end{spec} -to associate the name |pi| with the number 3.141592653589793. The -type signature in the first line declares |pi| to be a -\emph{double-precision floating-point number}, which mathematically -and in Haskell is distinct from an integer.\footnote{We will have more - to say about floating-point numbers later.} Now the name |pi| can be -used in expressions whenever it is in scope; it is an abstract -representation, if you will, of the number 3.141592653589793. -Furthermore, if there is ever a need to change a named value (which -hopefully will not ever happen for |pi|, but could certainly happen -for other values), we would only have to change it in one place, -instead of in the possibly large number of places where it is used. - -For a simple musical example, note first that in music theory, a -\emph{pitch} consists of a \emph{pitch class} and an \emph{octave}. -For example, in Euterpea we simply write |(A,4)| to represent the -pitch class |A| in the fourth octave. This particular note is called -``concert A'' (because it is often used as the note to which an -orchestra tunes its instruments) or ``A440'' (because its frequency is -440 cycles per second). Because this particular pitch is so common, -it may be desirable to give it a name, which is easily done in -Haskell, as was done above for $\pi$: -\begin{spec} -concertA, a440 :: (PitchClass, Octave) -concertA = (A,4) -- concert A -a440 = (A,4) -- A440 -\end{spec} - -\syn{This example demonstrates the use of program {\em - \indexwd{comments}}. Any text to the right of ``{\tt --}'' till - the end of the line is considered to be a programmer comment, and is - effectively ignored. Haskell also permits {\em nested} comments - that have the form |{- this is a comment -}| and can appear anywhere - in a program, including across multiple lines.} - -This example demonstrates the (perhaps obvious) fact that several -different names can be given to the same value---just as your brother -John might have the nickname ``Moose.'' Also note that the name -|concertA| requires more typing than |(A,4)|; nevertheless, it has -more mnemonic value, and, if mistyped, will more likely result in a -syntax error. For example, if you type ``|concrtA|'' by mistake, you -will likely get an error saying, ``Undefined variable,'' whereas if -you type ``|(A,5)|'' you will not. - -\syn{This example also demonstrates that two names having the same - type can be combined into the same type signature, separated by a - comma. Note finally, as a reminder, that these are names of values, - and thus they both begin with a lowercase letter.} - -Consider now a problem whose solution requires writing some larger -expression more than once. For example: -\begin{spec} -x :: Float -x = f (pi*r**2) + g (pi*r**2) -\end{spec} - -\syn{|(**)| is Haskell's floating-point exponentiation operator. Thus - |pi*r**2| is analogous to $\pi r^2$ in mathematics. |(**)| has - higher precedence than |(*)| and the other binary arithmetic - operators in Haskell.} - -Note in the definition of |x| that the expression |pi*r**2| -(presumably representing the area of a circle whose radius is |r|) is -repeated---it has two instances---and thus, applying the abstraction -principle, it can be separated from these instances. From the -previous examples, doing this is straightforward---it is called -\emph{naming}---so we might choose to rewrite the single equation -above as two: -\begin{spec} -area = pi*r**2 -x = f area + g area -\end{spec} -If, however, the definition of |area| is not intended for use -elsewhere in the program, then it is advantageous to ``hide'' it -within the definition of |x|. This will avoid cluttering up the -namespace, and prevents |area| from clashing with some other value -named |area|. To achieve this, we could simply use a \indexwdkw{let} -expression: -\begin{spec} -x = let area = pi*r**2 - in f area + g area -\end{spec} -A {\bf let} expression restricts the \emph{visibility} of the names -that it creates to the internal workings of the {\bf let} expression -itself. For example, if we were to write: -\begin{spec} -area = 42 -x = let area = pi*r**2 - in f area + g area -\end{spec} -then there is no conflict of names---the ``outer'' |area| is -completely different from the ``inner'' one enclosed in the {\bf let} -expression. Think of the inner |area| as analogous to the first name -of someone in your household. If your brother's name is ``John'' he -will not be confused with John Thompson who lives down the street when -you say, ``John spilled the milk.'' - -So you can see that naming---using either top-level equations or -equations within a {\bf let} expression---is an example of the -abstraction principle in action. -%% It is often the case, of course, that we \emph{anticipate} the need for -%% abstraction; for example, directly writing down the final solution -%% above, because we knew that we would need to use the expression -%% |a-b+2| more than once. -\index{abstraction!naming||)} - -\syn{An equation such as |c = 42| is called a -\emph{\indexwd{binding}}. A simple rule to remember when programming in -Haskell is never to give more than one binding for the same name in a -context where the names can be confused, whether at the top level of -your program or nestled within a |let| expression. For example, -this is not allowed: -\begin{spec} -a = 42 -a = 43 -\end{spec} -nor is this: -\begin{spec} -a = 42 -b = 43 -a = 44 -\end{spec} -} - -% (On the other hand, as you will soon see, functions can be defined -% with multiple equations, each defining the function's behavior on a -% different kind of argument. But in such cases all of the equations -% for the same function must appear together (one after the other).) - -\subsection{Functional Abstraction} -\label{sec:fun-abstract} -\index{abstraction!functional||(} - -The design of functions such as |simple| can be viewed as the -abstraction principle in action. To see this using the example above -involving the area of a circle, suppose the original program looked -like this: -\begin{spec} -x :: Float -x = f (pi*r1**2) + g (pi*r2**2) -\end{spec} -Note that there are now two areas involved---one of a circle whose -radius is |r1|, the other |r2|. Now the expressions in parentheses -have a \emph{repeating pattern of operations}. In discerning the -nature of a repeating pattern it is sometimes helpful to first identify -those things that are \emph{not} repeating, i.e.\ those things that -are \emph{changing}. In the case above, it is the radius that is -changing. A repeating pattern of operations can be abstracted as a -\emph{function} that takes the changing values as arguments. Using -the function name |areaF| (for ``area function'') we can write: -\begin{spec} -x = let areaF r = pi*r**2 - in f (areaF r1) + g (areaF r2) -\end{spec} -This is a simple generalization of the previous example, where the -function now takes the ``variable quantity''---in this case the -radius---as an argument. A very simple proof by calculation, in which -|areaF| is unfolded where it is used, can be given to demonstrate that -this program is equivalent to the old. - -This application of the abstraction principle is called -\emph{functional abstraction}, since a sequence of operations is -abstracted as a \emph{function} such as |areaF|. - -For a musical example, a few more concepts from Euterpea are first -introduced, concepts that are addressed more formally in the next -chapter: -\begin{enumerate} -\item -In music theory a \emph{note} is a \emph{pitch} combined with a -\emph{duration}. Duration is measured in beats, and in Euterpea has -type |Dur|. A note whose duration is one beat is called a whole note, -one with duration $\nicefrac{1}{2}$ is called a half note, and so on. -A note in Euterpea is the smallest entity, besides a rest, that is -actually a performable piece of music, and its type is |Music Pitch| -(other variations of this type will be introduced in later chapters). - -\item -In Euterpea there are functions: -\begin{spec} -note :: Dur -> Pitch -> Music Pitch -rest :: Dur -> Music Pitch -\end{spec} -such that |note d p| is a note whose duration is |d| and pitch is |p|, -and |rest d| is a rest with duration |d|. For example, |note (1/4) -(A,4)| is a quarter note concert A. - -\item -In Euterpea the following infix operators combine smaller |Music| -values into larger ones: -\begin{spec} -(:+:) :: Music Pitch -> Music Pitch -> Music Pitch -(:=:) :: Music Pitch -> Music Pitch -> Music Pitch -\end{spec} -Intuitively: -\begin{itemize} -\item |m1 :+: m2| is the music value that represents the playing of - |m1| followed by |m2|. -\item |m1 :=: m2| is the music value that represents the playing of - |m1| and |m2| simultaneously. -\end{itemize} - -\item -Eutperepa also has a function |trans :: Int -> Pitch -> Pitch| -such that |trans i p| is a pitch that is |i| semitones (half steps, or -steps on a piano) higher than |p|. -\end{enumerate} - -Now for the example. Consider the simple melody: -\begin{spec} -note qn p1 :+: note qn p2 :+: note qn p3 -\end{spec} -where |qn| is a quarter note: -\begin{spec} -qn = 1/4 -\end{spec} -Suppose we wish to harmonize each note with a note played a minor -third lower. In music theory, a minor third corresponds to three -semitones, and thus the harmonized melody can be written as: -\begin{spec} -mel = (note qn p1 :=: note qn (trans (-3) p1)) !:+: - (note qn p2 :=: note qn (trans (-3) p2)) !:+: - (note qn p3 :=: note qn (trans (-3) p3)) -\end{spec} - -Note as in the previous example a repeating pattern of -operations---namely, the operations that harmonize a single note with -a note three semitones below it. As before, to abstract a sequence of -operations such as this, a function can be defined that takes the -``variable quantities''---in this case the pitch---as arguments. We -can take this one step further, however, by noting that in some other -context we might wish to vary the duration. Recognizing this is to -\emph{anticipate} the need for abstraction. Calling this function -|hNote| (for ``harmonize note'') we can then write: -\begin{spec} -hNote :: Dur -> Pitch -> Music Pitch -hNote d p = note d p :=: note d (trans (-3) p) -\end{spec} -There are three instances of the pattern in |mel|, each of which can -be replaced with an application of |hNote|. This leads to: -\begin{spec} -mel :: Music Pitch -mel = hNote qn p1 :+: hNote qn p2 :+: hNote qn p3 -\end{spec} -Again using the idea of unfolding described earlier in this chapter, -it is easy to prove that this definition is equivalent to the previous -one. - -As with |areaF|, this use of |hNote| is an example of functional -abstraction. In a sense, functional abstraction can be seen as a -generalization of naming. That is, |area r1| is just a name for -|pi*r1**2|, |hNote d p| is just a name for |note d p :=: note d -(trans (-3) p)|, and so on. Stated another way, named quantities -such as |area|, |pi|, |concertA|, and |a440| defined earlier can be -thought of as functions with no arguments. - -Of course, the definition of |hNote| could also be hidden within |mel| -using a |let| expression as was done in the previous example: -\begin{spec} -mel :: Music Pitch -mel = let hNote d p = note d p :=: note d (trans (-3) p) - in hNote qn p1 :+: hNote qn p2 :+: hNote qn p3 -\end{spec} - -\subsection{Data Abstraction} -\label{sec:basic-list-abstraction} -\index{abstraction!data||(} - -The value of |mel| is the sequential composition of three harmonized -notes. But what if in another situation we must compose together -five harmonized notes, or in other situations even more? In -situations where the number of values is uncertain, it is useful to -represent them in a \emph{data structure}. For the example at hand, a -good choice of data structure is a \emph{\indexwd{list}}, briefly -introduced earlier, that can have any length. The use of a data -structure motivated by the abstraction principle is one form of -\emph{data abstraction}. - -Imagine now an entire list of pitches, whose length is not known at the -time the program is written. What now? It seems that a function is -needed to convert a list of pitches into a sequential composition of -harmonized notes. Before defining such a function, however, there is -a bit more to say about lists. - -Earlier the example |[C,D,Ef]| was given, a list of pitch classes -whose type is thus |[PitchClass]|. A list with \emph{no} elements -is---not surprisingly---written |[]|, and is called the \emph{empty - list}. - -To add a single element |x| to the front of a list |xs|, we write -|x:xs| in Haskell. (Note the naming convention used here; |xs| is the -plural of |x|, and should be read that way.) For example, |C : -[D,Ef]| is the same as |[C,D,Ef]|. In fact, this list is equivalent -to |C:(D:(Ef:[]))|, which can also be written |C:D:Ef:[]| since the -infix operator |(:)| is right associative. \index{associativity} - -\syn{In mathematics we rarely worry about whether the notation - $a+b+c$ stands for $(a+b)+c$ (in which case $+$ would be ``left - associative'') or $a+(b+c)$ (in which case $+$ would ``right - associative''). This is because in situations where the parentheses - are left out it is usually the case that the operator is - \emph{mathematically} associative, meaning that it does not matter - which interpretation is chosen. If the interpretation \emph{does} - matter, mathematicians will include parentheses to make it clear. - Furthermore, in mathematics there is an implicit assumption that - some operators have higher \emph{precedence} than others; for - example, $2\times a + b$ is interpreted as $(2\times a) + b$, not $2 - \times (a+b)$. - -In many programming languages, including Haskell, each operator is -defined to have a particular precedence level and to be left -associative, right associative, or to have no associativity at all. -For arithmetic operators, mathematical convention is usually followed; -for example, |2*a+b| is interpreted as |(2*a)+b| in Haskell. The -predefined list-forming operator |(:)| is defined to be right -associative. Just as in mathematics, this associativity can be -overridden by using parentheses: thus |(a:b):c| is a valid Haskell -expression (assuming that it is well-typed; it must be a list of -lists), and is very different from |a:b:c|. A way to specify the -precedence and associativity of user-defined operators will be -discussed in a later chapter.} - -%% [consider eliminating the next paragraph] - -%% Examples of predefined functions defined on lists in Haskell include -%% \indexwdhs{head} and \indexwdhs{tail}, which return the ``head'' and -%% ``tail'' of a list, respectively. That is, |head (x:xs) ==> x| and -%% |tail (x:xs) ==> xs| (we will define these two functions formally -%% in Section \ref{sec:poly-types}). Another example is the function -%% |(++)| which \emph{concatenates}, or \emph{appends}, together its two -%% list arguments. For example, -%% |[1,2,3] ++ [4,5,6] ==> [1,2,3,4,5,6]| (|(++)| will be defined -%% in Section \ref{sec:append}). \indexhs{(++)} - -Returning now to the problem of defining a function (call it |hList|) -to turn a list of pitches into a sequential composition of harmonized -notes, we should first express what its type should be: -\begin{spec} -hList :: Dur -> [Pitch] -> Music Pitch -\end{spec} -To define its proper behavior, it is helpful to consider, one by one, -all possible cases that could arise on the input. First off, the list -could be empty, in which case the sequential composition should be a -|Music Pitch| value that has zero duration. So: -\begin{spec} -hList d [] = rest 0 -\end{spec} - -The other possibility is that the list \emph{is not} empty---i.e.\ it -contains at least one element, say |p|, followed by the rest of the -elements, say |ps|. In this case the result should be the -harmonization of |p| followed by the sequential composition of the -harmonization of |ps|. Thus: -\begin{spec} -hList d (p:ps) = hNote d p :+: hList d ps -\end{spec} -Note that this part of the definition of |hList| is -\emph{recursive}---it refers to itself! But the original -problem---the harmonization of |p:ps|---has been reduced to the -harmonization of |p| (previously captured in the function |hNote|) and -the harmonization of |ps| (a slightly smaller problem than the -original one). - -Combining these two equations with the type signature yields the -complete definition of the function |hList|: -\begin{spec} -hList :: Dur -> [Pitch] -> Music Pitch -hList d [] = rest 0 -hList d (p:ps) = hNote d p :+: hList d ps -\end{spec} -\index{pattern!matching} - -Recursion is a powerful technique that will be used many times in this -textbook. It is also an example of a general problem-solving -technique where a large problem is broken down into several smaller -but similar problems; solving these smaller problems one-by-one leads -to a solution to the larger problem. \index{recursion} - -\syn{Although intuitive, this example highlights an important aspect -of Haskell: \emph{pattern matching}. The left-hand sides of -the equations contain \emph{patterns} such as |[]| and |x:xs|. -When a function is applied, these patterns are \emph{matched} against -the argument values in a fairly intuitive way (|[]| only matches -the empty list, and |p:ps| will successfully match any list with at -least one element, while naming the first element |p| and the rest -of the list |ps|). If the match succeeds, the right-hand side is -evaluated and returned as the result of the application. If it fails, -the next equation is tried, and if all equations fail, an error -results. All of the equations that define a particular function must -appear together, one after the other. - -Defining functions by pattern matching is quite common in Haskell, and -you should eventually become familiar with the various kinds of -patterns that are allowed; see Appendix \ref{ch:patterns} for a -concise summary.} \index{pattern} - -%% This is called a \emph{recursive} function definition since |hList| -%% ``refers to itself'' on the right-hand side of the second equation. - -Given this definition of |hList| the definition of |mel| can be -rewritten as: -\begin{spec} -mel = hList qn [p1, p2, p3] -\end{spec} - -We can prove that this definition is equivalent to the old via -calculation: -\begin{spec} -mel = hList qn [p1, p2, p3] -==> hList qn (p1:p2:p3:[]) -==> hNote qn p1 :+: hList qn (p2:p3:[]) -==> hNote qn p1 :+: hNote qn p2 :+: hList qn (p3:[]) -==> hNote qn p1 :+: hNote qn p2 :+: hNote qn p3 :+: hList qn [] -==> hNote qn p1 :+: hNote qn p2 :+: hNote qn p3 :+: rest 0 -\end{spec} -The first step above is not really a calculation, but rather a -rewriting of the list syntax. The remaining calculations each -represent an unfolding of |hList|. -\index{abstraction!data||)} -\index{abstraction||)} - -Lists are perhaps the most commonly used data structure in Haskell, -and there is a rich library of functions that operate on them. In -subsequent chapters lists will be used in a variety of interesting -computer music applications. - -\vspace{.1in}\hrule - -\begin{exercise}{\em -Modify the definitions of |hNote| and |hList| so that they each take -an extra argument that specifies the interval of harmonization (rather -than being fixed at -3). Rewrite the definition of |mel| to take these -changes into account.} -\end{exercise} - -\vspace{.1in}\hrule - -\section{Haskell Equality vs.\ Euterpean Equality} - -The astute reader will have objected to the proof just completed, -arguing that the original version of |mel|: -\begin{spec} -hNote qn p1 :+: hNote qn p2 :+: hNote qn p3 -\end{spec} -is not the same as the terminus of the above proof: -\begin{spec} -hNote qn p1 :+: hNote qn p2 :+: hNote qn p3 :+: rest 0 -\end{spec} -Indeed, that reader would be right! As Haskell values, these -expressions are \emph{not} equal, and if you printed each of them you -would get different results. So what happened? Did proof by -calculation fail? - -No, proof by calculation did not fail, since, as just pointed out, -as Haskell values these two expressions are not the same, and proof by -calculation is based on the equality of Haskell values. The problem -is that a ``deeper'' notion of equivalence is needed, one based on the -notion of \emph{musical} equality. Adding a rest of zero duration to -the beginning or end of any piece of music should not change what we -\emph{hear}, and therefore it seems that the above two expressions are -\emph{musically} equivalent. But it is unreasonable to expect Haskell -to figure this out for the programmer! - -As an analogy, consider the use of an ordered list to represent a set -(which is unordered). The Haskell values |[x1,x2]| and |[x2,x1]| are -not equal, yet in a program that ``interprets'' them as sets, they -\emph{are} equal. - -The way this problem is approached in Euterpea is to formally define a -notion of \emph{musical interpretation}, from which the notion -of \emph{musical equivalence} is defined. This leads to a kind of -``algebra of music'' that includes, among others, the following axiom: -\begin{spec} -m :+: rest 0 === m -\end{spec} -The operator |(===)| should be read, ``is musically equivalent to.'' -With this axiom it is easy to see that the original two expressions -above \emph{are} in fact musically equivalent. - -For a more extreme example of this idea, and to entice the reader to -learn more about musical equivalence in later chapters, note that -|mel|, given pitches |p1 = Ef|, |p2 = F|, |p3 = G|, and duration |d = -1/4|, generates the harmonized melody shown in Figure \ref{fig:mel}; -we can write this concretely in Euterpea as: -\begin{spec} -mel1 = (note (1/4) (Ef, 4) :=: note (1/4) (C,4)) !:+: - (note (1/4) (F, 4) :=: note (1/4) (D,4)) !:+: - (note (1/4) (G, 4) :=: note (1/4) (E,4)) -\end{spec} -The definition of |mel1| can then be seen as a \emph{polyphonic} -interpretation of the musical phrase in Figure \ref{fig:mel}, where -each pair of notes is seen as a harmonic unit. In contrast, a -\emph{contrapuntal} interpretation sees two independent \emph{lines}, -or \emph{voices}, in this case the line $\langle$E$\flat$,F,G$\rangle$ -and the line $\langle$C,D,E$\rangle$. In Euterpea we can write this -as: -\begin{spec} -mel2 = (note (1/4) (Ef, 4) :+: note (1/4) (F,4) :+: note (1/4) (G,4)) - :=: - (note (1/4) (C, 4) :+: note (1/4) (D,4) :+: note (1/4) (E,4)) -\end{spec} -|mel1| and |mel2| are clearly not equal as Haskell values. Yet if -they are played, they will \emph{sound} the same---they are, in the -sense described earlier, \emph{musically equivalent}. But proving -these two phrases musically equivalent will require far more than a -simple axiom involving |rest 0|. In fact this can be done in an -elegant way, using the algebra of music developed in Chapter -\ref{ch:algebra}. - -\begin{figure*} -%% \includegraphics{pics/threenoteharm.pdf} -\centerline{ -\epsfysize=0.6in -\epsfbox{pics/threenoteharm.eps} -} -\caption{Polyphonic vs.\ Contrapuntal Interpretation} -\label{fig:mel} -\end{figure*} - -\section{Code Reuse and Modularity} -\label{sec:code-reuse} - -There does not seem to be much repetition in the last definition of -|hList|, so perhaps the end of the abstraction process has been -reached. In fact, it is worth considering how much progress has been -made. The original definition: -\begin{spec} -mel = (note qn p1 :=: note qn (trans (-3) p1)) !:+: - (note qn p2 :=: note qn (trans (-3) p2)) !:+: - (note qn p3 :=: note qn (trans (-3) p3)) -\end{spec} -was replaced with: -\begin{spec} -mel = hList qn [p1, p2, p3] -\end{spec} -But additionally, definitions for the auxiliary functions |hNote| and -|hList| were introduced: -\begin{spec} -hNote :: Dur -> Pitch -> Music Pitch -hNote d p = note d p :=: note d (trans (-3) p) - -hList :: Dur -> [Pitch] -> Music Pitch -hList d [] = rest 0 -hList d (p:ps) = hNote d p :+: hList d ps -\end{spec} -In terms of code size, the final program is actually larger than the -original! So has the program improved in any way? - -Things have certainly gotten better from the standpoint of ``removing -repeating patterns,'' and we could argue that the resulting program -therefore is easier to understand. But there is more. Now that -auxiliary functions such as |hNote| and |hList| have been defined, we -can \emph{reuse} them in other contexts. Being able to reuse code is -also called \emph{\indexwd{modularity}}, since the reused components -are like little modules, or building blocks, that can form the -foundation of many applications.\footnote{``Code reuse'' and - ``modularity'' are important software engineering principles.} In a -later chapter, techniques will be introduced---most notably, -\emph{higher-order functions} and \emph{polymorphism}---for improving -the modularity of this example even more, and substantially increasing -the ability to reuse code. - -\section{[Advanced] Programming with Numbers} -\label{sec:numbers-caveat} -\index{number systems||(} - -In computer music programming, it is often necessary to program with -numbers. For example, it is often convenient to represent pitch on a -simple absolute scale using integer values. And when computing with -analog signals that represent a particular sound wave, it is necessary -to use floating point numbers as an approximation to the reals. So it -is a good idea to understand precisely how numbers are represented -inside a computer, and within a particular language such as Haskell. - -In mathematics there are many different kinds of number systems. For -example, there are integers, natural numbers (i.e.\ non-negative -integers), real numbers, rational numbers, and complex numbers. These -number systems possess many useful properties, such as the fact that -multiplication and addition are commutative, and that multiplication -distributes over addition. You have undoubtedly learned many of these -properties in your studies, and have used them often in algebra, -geometry, trigonometry, physics, and so on. - -Unfortunately, each of these number systems places great demands on -computer systems. In particular, a number can in general require an -\emph{arbitrary amount of memory} to represent it. Clearly, for -example, an irrational number such as $\pi$ cannot be represented -exactly; the best we can do is approximate it, or possibly write a -program that computes it to whatever (finite) precision is needed in a -given application. But even integers (and therefore rational numbers) -present problems, since any given integer can be arbitrarily large. - -Most programming languages do not deal with these problems very well. -In fact, most programming languages do not have exact forms of many of -these number systems. Haskell does slightly better than most, in that -it has exact forms of integers (the type \indexwdhs{Integer}) as well -as rational numbers (the type \indexwdhs{Rational}, defined in the -Ratio Library). But in Haskell and most other languages there is no -exact form of real numbers, for example, which are instead -approximated by \emph{floating-point numbers} with either single-word -precision (\indexwdhs{Float} in Haskell) or double-word precision -(\indexwdhs{Double}). Even worse, the behavior of arithmetic -operations on floating-point numbers can vary somewhat depending on -what kind of computer is being used, although hardware standardization -in recent years has reduced the degree of this problem. - -The bottom line is that, as simple as they may seem, great care must -be taken when programming with numbers. Many computer errors, some -quite serious and renowned, were rooted in numerical incongruities. -The field of mathematics known as \emph{ \indexwd{numerical analysis}} is -concerned precisely with these problems, and programming with -floating-point numbers in sophisticated applications often requires a -good understanding of numerical analysis to devise proper algorithms -and write correct programs. - -As a simple example of this problem, consider the distributive law, -expressed here as a calculation in Haskell, and used earlier in -this chapter in calculations involving the function |simple|: -\begin{spec} -a*(b+c) ==> a*b + a*c -\end{spec} -For most floating-point numbers, this law is perfectly valid. For -example, in the GHC implementation of Haskell, the expressions -|pi*(3+4) :: Float| and |pi*3+pi*4 :: Float| both yield the same -result: 21.99115. But funny things can happen when the magnitude of -|b+c| differs significantly from the magnitude of either |b| or -|c|. For example, the following two calculations are from GHC: -\begin{spec} -5*(-0.123456 + 0.123457) :: Float ==> 4.991889e-6 -5*(-0.123456) + 5*(0.123457) :: Float ==> 5.00679e-6 -\end{spec} -Although the discrepancy here is small, its very existence is -worrisome, and in certain situations it could be disastrous. The -precise behavior of floating-point numbers will not be discussed -further in this textbook. Just remember that they are -\emph{approximations} to the real numbers. If real-number accuracy is -important to your application, further study of the nature of -floating-point numbers is probably warranted. - -On the other hand, the distributive law (and many others) is valid in -Haskell for the exact data types |Integer| and |Ratio Integer| -(i.e.\ rationals). Although the representation of an |Integer| in -Haskell is not normally something to be concerned about, it should be -clear that the representation must be allowed to grow to an arbitrary -size. For example, Haskell has no problem with the following number: -\begin{spec} -veryBigNumber :: Integer -veryBigNumber = 43208345720348593219876512372134059 -\end{spec} -and such numbers can be added, multiplied, etc.\ without any loss of -accuracy. However, such numbers cannot fit into a single word of -computer memory, most of which are limited to 32 or 64 bits. Worse, -since the computer system does not know ahead of time exactly how many -words will be required, it must devise a dynamic scheme to allow just -the right number of words to be used in each case. The overhead of -implementing this idea unfortunately causes programs to run slower. - -For this reason, Haskell (and most other languages) provides another -integer data type called \indexwdhs{Int} that has maximum and minimum -values that depend on the word-size of the particular computer being -used. In other words, every value of type |Int| fits into one word of -memory, and the primitive machine instructions for binary numbers can -be used to manipulate them efficiently.\footnote{The Haskell Report - requires that every implementation support |Int|s at least in the - range $-2^{29}$ to $2^{29}-1$, inclusive. The GHC implementation - running on a 32-bit processor, for example, supports the range - $-2^{31}$ to $2^{31}-1$.} Unfortunately, this means that -\emph{overflow} or \emph{underflow} errors could occur when an |Int| -value exceeds either the maximum or minimum values. Sadly, most -implementations of Haskell (as well as most other languages) do not -tell you when this happens. For example, in GHC running on a 32-bit -processor, the following |Int| value: -\begin{spec} -i :: Int -i = 1234567890 -\end{spec} -works just fine, but if you multiply it by two, GHC returns the value -|-1825831516|! This is because twice |i| exceeds the maximum allowed -value, so the resulting bits become nonsensical,\footnote{Actually, - these bits are perfectly sensible in the following way: the 32-bit - binary representation of |i| is 01001001100101100000001011010010, - and twice that is 10010011001011000000010110100100. But the latter - number is seen as negative because the 32nd bit (the highest-order - bit on the CPU on which this was run) is a one, which means it is a - negative number in ``twos-complement'' representation. The - twos-complement of this number is in turn - 01101100110100111111101001011100, whose decimal representation is - 1825831516.} and are interpreted in this case as a negative number -of the given magnitude. - -This is alarming! Indeed, why should anyone ever use |Int| when -|Integer| is available? The answer, as implied earlier, is -efficiency, but clearly care should be taken when making this choice. -If you are indexing into a list, for example, and you are confident -that you are not performing index calculations that might result in -the above kind of error, then |Int| should work just fine, since a -list longer than $2^{31}$ will not fit into memory anyway! But if you -are calculating the number of microseconds in some large time -interval, or counting the number of people living on earth, then -|Integer| would most likely be a better choice. Choose your number -data types wisely! - -In this textbook the numeric data types |Integer|, |Int|, |Float|, -|Double|, |Rational|, and |Complex| will be used for a variety of -different applications; for a discussion of the other number types, -consult the Haskell Report. As these data types are used, there will -be little discussion about their properties---this is not, after all, -a book on numerical analysis---but a warning will be cast whenever -reasoning about, for example, floating-point numbers, in a way that -might not be technically sound. \index{number systems||)} - -%% --- - -\out{ -\section{Qualified Types} -\label{sec:qualified-types} - -A polymorphic type such as |(a->a)| can be viewed as shorthand for -$\forall($|a|$)|a->a|$, which can be read ``\emph{for all} types |a|, -functions mapping elements of type |a| to elements of type |a|.'' -Note the emphasis on ``\emph{for all}.'' - -In practice, however, there are times when we would prefer to limit a -polymorphic type to a smaller number of possibilities. A good example -is a function such as |(+)|. It is probably not a good idea to limit -|(+)| to a \emph{single} (that is, \emph{monomorphic}) type such as -|Integer->Integer->Integer|, since there are other kinds of -numbers---such as rational and floating-point numbers---that we would -like to perform addition on as well. Nor is it a good idea to have a -different addition function for each type of number that we wish to -add, since that would require giving each a different name, such as -|addInteger|, |addRational|, |addFloat|, etc. And, unfortunately, -giving |(+)| a type such as |a->a->a| will not work, since this would -imply that we could add things other than numbers, such as -characters, pitch classes, lists, tuples, functions, and any type that -you might define on your own! - -\index{type!qualified} \index{class} - -Haskell provides a solution to this problem through the use of {\em - qualified types}. Conceptually, it is helpful to think of a -qualified type just as a polymorphic type, except that in place of -``\emph{for all} types |a|'' it will be possible to say ``for all -types |a| \emph{that are members of the type class} |C|,'' where the -type class |C| can be thought of as a set of types. For example, -suppose there is a type class \indexwdhs{Num} with members |Integer|, -|Rational|, and |Float|. Then an accurate type for |(+)| is -$\forall($|a|$\in$|Num|$)$|a -> a -> a|. But in Haskell, instead of -writing $\forall(|a|\in|Num|)\cdots$, the notation |Num a =>|$\cdots$ -is used. So the proper type signature for |(+)| is: -\begin{spec} -(+) :: Num a => a -> a -> a -\end{spec} -which should be read: ``for all types |a| that are members of the type -class |Num|, |(+)| has type |a -> a -> a|.'' Members of a type class -are also called \emph{instances} of the class, and these two terms -will be used interchangeably in the remainder of the text. The |Num a -=>|$\cdots$ part of the type signature is often called a -\emph{context}, or \emph{constraint}. - -\index{class} -\syn{It is important not to confuse |Num| with a data type or a -constructor within a data type, even though the same syntax -(``|Num a|'') is used. |Num| is a \emph{type class}, and the -context of its use (namely, to the left of a |=>|) is always -sufficient to determine this fact.} - -\begin{figure} -\begin{tabular}{||||l||l||l||||} \hline -{\bf Type} & {\bf Key} & {\bf Key} \\ -{\bf Class} & {\bf functions} & {\bf instances} \\ -\hline -|Num| & |(+),(-),(*) :: Num a => a->a->a| & |Integer, Int, Float, Double,| \\ - & |negate :: Num a => a->a| & |Rational| \\ - -\hline -|Eq| & |(==),(/=) :: Eq a => a->a->Bool| & |Integer, Int, Float, Double,| \\ -&& |Rational, Char, Bool, ... | \\ -\hline -|Ord| & |(>),(<),(>=),(<=) ::| & |Integer, Int, Float, Double,| \\ - & \ \ \ \ |Ord a => a->a->Bool| & |Rational, Char, Bool, ... | \\ - & |max,min :: Ord a => a->a->Bool| & \\ -\hline -|Enum| & |succ,pred :: Enum a => a->a| & |Integer, Int, Float, Double,| \\ - & also enables arithmetic sequences & |Rational, Char, Bool, ... | \\ -\hline -|Show| & |show :: Show a => a -> String| & Almost every type except \\ - & & for functions \\ -\hline -|Read| & |read :: Read a => String -> a| & Almost every type except \\ - & & for functions \\ -\hline -\end{tabular} -\caption{Common Type Classes and Their Instances} -\label{fig:common-type-classes} -\end{figure} - -Recall now the type signature previously given for |simple|: -\begin{spec} -simple :: Integer -> Integer -> Integer -> Integer -simple x y z = x*(y+z) -\end{spec} -Note that |simple| uses the operator |(+)| discussed above. It also -uses |(*)|, whose type is the same as that for |(+)|: -\begin{spec} -(*) :: Num a => a -> a -> a -\end{spec} -This suggests that a more general type for |simple| is: -\begin{spec} -simple :: Num a => a -> a -> a -> a -simple x y z = x*(y+z) -\end{spec} -Indeed, this is the preferred, most general type that can be given for -|simple|. It can now be used with any type that is a member of the -|Num| class, which includes |Integer|, |Int|, |Rational|, |Float| and -|Double|, among others. - -The ability to qualify polymorphic types is a unique feature of -Haskell, and, as you will soon see, provides great expressiveness. In -particular, you will see that it is possible to define your own type -class and its members. For now, all you need to know is that some -functions and operators are predefined to be instances of certain -type classes, such as |(+)| and |(*)| above. Table -\ref{fig:common-type-classes} shows a number of others. For example, -the |Show| class allows us to convert values to strings: -\begin{spec} -show D ==> "D" -show concertA ==> "(A,4)" -show (simple 3 9 5) ==> "42" -\end{spec} -The |Read| class allows us to go the other way around: -\begin{spec} -read "D" ==> D -read "(A,4)" ==> (A,4) -read "42" ==> 42 -\end{spec} -The |Eq| class allows testing values for equality: -\begin{spec} -simple 3 9 5 == 42 ==> True -concertA == (A,5) ==> False -\end{spec} -And the |Ord| class has relational operators for types whose values -can be ordered: -\begin{spec} -simple 3 9 5 > 41 ==> True -max 42 27 ==> 42 -'a' < 'b' ==> True -\end{spec} -The |Enum| class allows us to use \emph{arithmetic sequences}, which -will be explained in a later chapter. -} diff --git a/HSoM/LSystems.lhs b/HSoM/LSystems.lhs deleted file mode 100644 --- a/HSoM/LSystems.lhs +++ /dev/null @@ -1,485 +0,0 @@ -%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- - -%include lhs2TeX.fmt -%include myFormat.fmt - -\out{ -\begin{code} --- This code was automatically generated by lhs2tex --code, from the file --- HSoM/LSystems.lhs. (See HSoM/MakeCode.bat.) - -\end{code} -} - -\chapter[L-Systems and Generative Grammars] -{Musical L-Systems and Generative Grammars} -\label{ch:lsystems} - -\begin{code} -module Euterpea.Examples.LSystems where - -import Euterpea -import Data.List hiding (transpose) -import System.Random -\end{code} - -\section{Generative Grammars} -\label{sec:grammars} - -A \emph{grammar} describes a \emph{formal language}. One can either -design a \emph{recognizer} (or \emph{parser}) for that language, or -design a \emph{generator} that generates sentences in that language. -We are interested in using grammars to generate music, and thus we are -only interested in generative grammars. - -A generative grammar is a four-tuple $(N,T,n,P)$, where: -\begin{itemize} -\item $N$ is the set of \emph{non-terminal symbols}. -\item $T$ is the set of \emph{terminal symbols}. -\item $n$ is the \emph{initial symbol}. -\item $P$ is a set of \emph{production rules}, where each production - rule is a pair $(X,Y)$, often written $X \rightarrow Y$. $X$ and - $Y$ are sentences (or \emph{sentential forms}) formed over the - alphabet $N \cup T$, and $X$ contains at least one non-terminal. -\end{itemize} - -A \emph{Lindenmayer system}, or \emph{L-system}, is an example of a -generative grammer, but is different in two ways: -\begin{enumerate} -\item The \emph{sequence} of sentences is as important as the - individual sentences, and -\item A new sentence is generated from the previous one by applying as - many productions as possible on each step---a kind of ``parallel - production.'' -\end{enumerate} - -Lindenmayer was a biologist and mathematician, and he used L-systems -to describe the growth of certain biological organisms (such as -plants, and in particular algae). - -We will limit our discussion to L-systems that have the following -additional characteristics: -\begin{enumerate} -\item They are \emph{context-free}: the left-hand side of each - production (i.e.\ $X$ above) is a single non-terminal. -\item No distinction is made between terminals and non-terminals (with - no loss of expressive power---why?). -\end{enumerate} - -We will consider both \emph{deterministic} and \emph{non-deterministic} -grammars. A deterministic grammar has exactly one production -corresponding to each non-terminal symbol in the alphabet, whereas a -non-deterministic grammar may have more than one, and thus we will -need some way to choose between them. - -\subsection{A Simple Implementation} - -A framework for simple, context-free, deterministic grammars can be -designed in Haskell as follows. We represent the set of productions -as a list of symbol/list-of-symbol pairs: -\begin{code} - -data DetGrammar a = DetGrammar a -- start symbol - [(a,[a])] -- productions - deriving Show -\end{code} -To generate a succession of ``sentential forms,'' we need to define a -function that, given a grammar, returns a list of lists of symbols: -\begin{code} -detGenerate :: Eq a => DetGrammar a -> [[a]] -detGenerate (DetGrammar st ps) = iterate (concatMap f) [st] - where f a = maybe [a] id (lookup a ps) -\end{code} - -\syn{|maybe| is a convenient function for conditionally giving a - result based on the structure of a value of type |Maybe a|. It is - defined in the Standard Prelude as: -\begin{spec} -maybe :: b -> (a -> b) -> Maybe a -> b -maybe _ f (Just x) = f x -maybe z _ Nothing = z -\end{spec} - -|lookup :: Eq a => a -> [(a,b)] -> Maybe b| is a convenient function -for finding the value associated with a given key in an association -list. For example: -\begin{spec} -lookup 'b' [('a',0),('b',1),('c',2)] ==> Just 1 -lookup 'd' [('a',0),('b',1),('c',2)] ==> Nothing -\end{spec} -} -%% |lookup| is defined in the Standard Prelude as: -%% \begin{spec} -%% lookup :: (Eq a) => a -> [(a,b)] -> Maybe b -%% lookup _ [] = Nothing -%% lookup key ((x,y):xys) -%% | key == x = Just y -%% | otherwise = lookup key xys -%% \end{spec} - -Note that we expand each symbol ``in parallel'' at each step, using -|concatMap|. The repetition of this process at each step is achieved -using |iterate|. Note also that a list of productions is essentially -an \emph{association list}, and thus the |Data.List| library function -|lookup| works quite well in finding the production rule that we seek. -Finally, note once again how the use of higher-order functions makes -this definition concise yet efficient. - -As an example of the use of this simple program, a Lindenmayer grammer -for red algae (taken from \cite{}) is given by: -\begin{code} -redAlgae = DetGrammar 'a' - [ ('a',"b|c"), ('b',"b"), ('c',"b|d"), - ('d',"e\\d"), ('e',"f"), ('f',"g"), - ('g',"h(a)"), ('h',"h"), ('|',"|"), - ('(',"("), (')',")"), ('/',"\\"), - ('\\',"/") - ] -\end{code} -%% a -> bc -%% c -> bd -%% d -> e\d -%% e -> f -%% f -> g -%% g -> h(a) -%% \ -> / -%% / -> \ - -\syn{Recall that |'\\'| is how the backslash character is written in - Haskell, because a single backslash is the ``escape'' character for - writing special characters such as newline (|'\n'|), tab (|'\t'|), - and so on. Since the backslash is used in this way, it also is a - special character, and must be escaped using itself, i.e.\ |'\\'|. } - -Then |detGenerate redAlgae| gives us the result that we want---or, to -make it look nicer, we could do: -\begin{code} -t n g = sequence_ (map putStrLn (take n (detGenerate g))) -\end{code} -For example, |t 10 redAlgae| yields: -\begin{verbatim} -a -b|c -b|b|d -b|b|e\d -b|b|f/e\d -b|b|g\f/e\d -b|b|h(a)/g\f/e\d -b|b|h(b|c)\h(a)/g\f/e\d -b|b|h(b|b|d)/h(b|c)\h(a)/g\f/e\d -b|b|h(b|b|e\d)\h(b|b|d)/h(b|c)\h(a)/g\f/e\d -\end{verbatim} - -\todo{Include a graphical rendering of the red algae.} - -\vspace{.1in}\hrule - -\begin{exercise}{\em -Define a function |strToMusic :: AbsPitch -> Dur -> String -> Music -Pitch| that interprets the strings generated by |redAlgae| as music. -Specifically, |strToMusic ap d str| interprets the string |str| in the -following way: -\begin{enumerate} -\item -Characters |'a'| through |'h'| are interpreted as notes, each with -duration |d| and absolute pitches |ap|, |ap+2|, |ap+4|, |ap+5|, -|ap+7|, |ap+9|, |ap+11|, and |ap+12|, respectively (i.e.\ a major -scale). -\item -|'||'| is interpreted as a no-op. -\item -|'/'| and |'\\'| are both interpreted as a rest of length |d|. -\item -|'('| is interpreted as a transposition by 5 semitones (a perfect fourth). -\item -|')'| is interpreted as a transposition by -5 semitones. -\end{enumerate} } -\end{exercise} - -\begin{exercise}{\em Design a function |testDet :: Grammar a -> Bool| - such that |testDet g| is |True| if |g| has exactly one rule for - each of its symbols; i.e.\ it is deterministic. Then modify the - |generate| function above so that it returns an error if a grammer - not satisfying this constraint is given as argument.} -\end{exercise} - -\vspace{.1in}\hrule - -\subsection{A More General Implementation} - -The design given in the last section only captures deterministic -context-free grammars, and the generator considers only parallel -productions that are charactersitic of L-Systems. - -We would also like to consider non-deterministic grammars, where a -user can specify the probability that a particular rule is selected, -as well as possibly non-context free (i.e.\ context sensitive) -grammars. Thus we will represent a generative grammar a bit more -abstractly, as a data structure that has a starting sentence in an -(implicit, polymorphic) alphabet, and a list of production rules: -\begin{code} -data Grammar a = Grammar a -- start sentence - (Rules a) -- production rules - deriving Show -\end{code} -The production rules are instructions for converting sentences in the -alphabet to other sentences in the alphabet. A rule set is either a -set of uniformly distributed rules (meaning that those with the same -left-hand side have an equal probability of being chosen), or a set of -stochastic rules (each of which is paired with a probabilty). A -specific rule consists of a left-hand side and a right-hand side. -\begin{code} -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 -\end{code} - -One of the key sub-problems that we will have to solve is how to -probabilistically select a rule from a set of rules, and use that rule -to expand a non-terminal. We define the following type to capture -this process: -\begin{code} -type ReplFun a = [[(Rule a, Prob)]] -> (a, [Rand]) -> (a, [Rand]) -type Rand = Double -\end{code} -The idea here is that a function |f :: ReplFun a| is such that |f rules -(s,rands)| will return a new sentence |s'| in which each symbol in |s| -has been replaced according to some rule in |rules| (which are grouped -by common left-hand side). Each rule is chosen probabilitically based -on the random numbers in |rands|, and thus the result also includes a -new list of random numbers to account for those ``consumed'' by the -replacement process. - -With such a function in hand, we can now define a function that, given -a grammar, generates an infinite list of the sentences produced by -this replacement process. Because the process is non-deterministic, -we also pass a seed (an integer) to generate the initial pseudo-random -number sequence to give us repeatable results. -\begin{code} -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.") -\end{code} - -|toStoRules| converts a list of uniformly distributed rules to an -equivalent list of stochastic rules. Each set of uniform rules with -the same LHS is converted to a set of stochastic rules in which the -probability of each rule is one divided by the number of uniform -rules. - -\begin{code} -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) -\end{code} - -\syn{|groupBy :: (a->a->Bool) -> [a] -> [[a]]| is a |Data.List| - library function that behaves as follows: |groupBy eqfn xs| returns - a list of lists such that all elements in each sublist are ``equal'' - in the sense defined by |eqfn|.} - -|checkProbs| takes a list of production rules and checks whether, for -every rule with the same LHS, the probabilities sum to one (plus or -minus some epsilon, currenty set to |0.001|). -\begin{code} -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 -\end{code} - -|generate| takes a replacement function, a list of rules, a starting -sentence, and a source of random numbers. It returns an infinite list -of sentences. -\begin{code} -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) -\end{code} - -A key aspect of the |generate| algorithm above is to compute the -\emph{probability density} of each successive rule, which is -basically the sum of its probability plus the probabilities of all -rules that precede it. - -\section{An L-System Grammar for Music} -\label{sec:musical-lsystem} - -The previous section gave a generative framework for a generic -grammar. For a musical L-system we will define a specific grammar, -whose sentences are defined as follows. A musical L-system sentence -is either: -\begin{itemize} -\item A non-terminal symbol |N a|. -\item A sequential composition |s1 :+ s2|. -\item A functional composition |s1 :. s2|. -\item The symbol |Id|, which will eventually be interpeted as the - identity function. -\end{itemize} -We capture this in the |LSys| data type: -\begin{code} -data LSys a = N a - | LSys a :+ LSys a - | LSys a :. LSys a - | Id - deriving (Eq, Ord, Show) -\end{code} -The idea here is that sentences generated from this grammar are -relative to a starting note, and thus the above constructions will be -interpreted as functions that take that starting note as an argument. -This will all become clear shortly, but first we need to define a -replacement function for this grammar. - -We will treat |(:+)| and |(:.)| as binary branches, and recursively -traverse each of their arguments. We will treat |Id| as a constant that -never gets replaced. Most importantly, each non-terminal of the form -|N x| could each be the left-hand side of a rule, so we call the -function |getNewRHS| to generate the replacement term for it. - -\begin{code} -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) -\end{code} - -%% Note the use of |filter| to select only the rules whose left-hand -%% side matches the non-terminal. - -|getNewRHS| is defined as: -\begin{code} -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" -\end{code} - -\syn{|find :: (a->Bool) -> [a] -> Maybe a| is another |Data.List| - function that returns the first element of a list that satisfies a - predicate, or |Nothing| if there is no such element.} - -\subsection{Examples} - -The final step is to interpret the resulting sentence (i.e.\ a value -of type |LSys a|) as music. As mentioned earlier, the intent of the -|LSys| design is that a value is interpreted as a \emph{function} that -is applied to a single note (or, more generally, a single |Music| -value). The specific constructors are interpreted as follows: -\begin{code} -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" -\end{code} - -For example, we could define the following interpretation rules: -\begin{code} -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 -\end{code} -In other words, |inc| transposes the music up by one semitone, |dec| -transposes it down by a semitone, and |same| does nothing. - -Now let's build an actual grammar. |sc| increments a note followed by -its decrement---the two notes are one whole tone apart: -\begin{code} -sc = inc :+ dec -\end{code} - -Now let's define a bunch of rules as follows: -\begin{code} -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 -\end{code} -and the corresponding grammar: -\begin{code} -g1 = Grammar same (Uni [r1b, r1a, r2b, r2a, r3a, r3b]) -\end{code} - -Finally, we generate a sentence at some particular level, and -interpret it as music: -\begin{code} -t1 n = instrument Vibraphone $ - interpret (gen replFun g1 42 !! n) ir (c 5 tn) -\end{code} -\out{$ } -Try ``|play (t1 3)|'' or ``|play (t1 4)|'' to hear the result. - -\vspace{.1in}\hrule - -\begin{exercise}{\em -Play with the L-System grammar defined above. Change the production -rules. Add probabilities to the rules, i.e.\ change it into a |Sto| -grammar. Change the random number seed. Change the depth of -recursion. And also try changing the ``musical seed'' (i.e.\ the note -|c 5 tn|).} -\end{exercise} - -\begin{exercise}{\em -Define a new L-System structure. In particular, (a) define a new -version of |LSys| (for example, add a parallel constructor) and its -associated interpretation, and/or (b) define a new version of |LFun| -(perhaps add something to control the volume) and its associated -interpretation. Then define some grammars with the new design to -generate interesting music.} -\end{exercise} - -\vspace{.1in}\hrule - - diff --git a/HSoM/List-tour.lhs b/HSoM/List-tour.lhs deleted file mode 100644 --- a/HSoM/List-tour.lhs +++ /dev/null @@ -1,521 +0,0 @@ -%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- - -%include lhs2TeX.fmt -%include myFormat.fmt - -\chapter{The PreludeList Module} -\label{ch:list-tour} - -The use of lists is particularly common when programming in Haskell, -and thus, not surprisingly, there are many pre-defined polymorphic -functions for lists. The list data type itself, plus some of the most -useful functions on it, are contained in the Standard Prelude's -\hs{PreludeList} module, which we will look at in detail in this -chapter. There is also a Standard Library module called \hs{List} -that has additional useful functions. It is a good idea to become -familiar with both modules. \indexamb{List}{library} -\indexhs{PreludeList} - -Although this chapter may feel like a long list of ``Haskell -features,'' the functions described here capture many common patterns -of list usage that have been discovered by functional programmers over -many years of trials and tribulations. In many ways higher-order -declarative programming with lists takes the place of lower-level -imperative control structures in more conventional languages. By -becoming familiar with these list functions you will be able to more -quickly and confidently develop your own applications using lists. -Furthermore, if all of us do this, we will have a common vocabulary -with which to understand each others' programs. Finally, by reading -through the code in this module you will develop a good feel for how -to write proper function definitions in Haskell. - -It is not necessary for you to understand the details of every -function, but you should try to get a sense for what is available so -that you can return later when your programming needs demand it. In -the long run you are well-advised to read the rest of the Standard -Prelude as well as the various Standard Libraries, to discover a host -of other functions and data types that you might someday find useful -in your own work. - -\section{The PreludeList Module} - -To get a feel for the \hs{PreludeList} module, let's first look at its -module declaration: -\begin{spec} -module PreludeList ( - map, (++), filter, concat, - head, last, tail, init, null, length, (!!), - foldl, foldl1, scanl, scanl1, foldr, foldr1, scanr, scanr1, - iterate, repeat, replicate, cycle, - take, drop, splitAt, takeWhile, dropWhile, span, break, - lines, words, unlines, unwords, reverse, and, or, - any, all, elem, notElem, lookup, - sum, product, maximum, minimum, concatMap, - zip, zip3, zipWith, zipWith3, unzip, unzip3) - where - -import qualified Char(isSpace) - -infixl 9 !! -infixr 5 ++ -infix 4 `elem`, `notElem` -\end{spec} -We will not discuss all of the functions listed above, but will cover -most of them (and some were discussed in previous chapters). - -\section{Simple List Selector Functions} -\label{sec:list-selectors} - -\indexwdhs{head} and \indexwdhs{tail} extract the first element and remaining -elements, respectively, from a list, which must be non-empty. -\indexwdhs{last} and \indexwdhs{init} are the dual functions that work from the end -of a list, rather than from the beginning. -\begin{spec} -head :: [a] -> a -head (x:_) = x -head [] = error "PreludeList.head: empty list" - -last :: [a] -> a -last [x] = x -last (_:xs) = last xs -last [] = error "PreludeList.last: empty list" - -tail :: [a] -> [a] -tail (_:xs) = xs -tail [] = error "PreludeList.tail: empty list" - -init :: [a] -> [a] -init [x] = [] -init (x:xs) = x : init xs -init [] = error "PreludeList.init: empty list" -\end{spec} -Although \hs{head} and \hs{tail} were previously discussed in Section -\ref{sec:poly-types}, the definitions here include an equation -describing their behaviors under erroneous situations---such as -selecting the head of an empty list---in which case the \hs{error} -function is called. It is a good idea to include such an equation for -any definition in which you have not covered every possible case in -pattern-matching; i.e.\ if it is possible that the pattern-matching -could ``run off the end'' of the set of equations. The string -argument that you supply to the \hs{error} function should be detailed -enough that you can easily track down the precise location of the -error in your program. - -\syn{If such an error equation is omitted, and then during -pattern-matching all equations fail, most Haskell systems will invoke -the \indexwdhs{error} function anyway, but most likely with a string that -will be less informative than one you can supply on your own.} - -The \indexwdhs{null} function tests to see if a list is empty. -\begin{spec} -null :: [a] -> Bool -null [] = True -null (_:_) = False -\end{spec} - -\section{Index-Based Selector Functions} -\label{sec:list-index-fns} - -To select the $n$th element from a list, with the first element being -the $0$th element, we can use the indexing function \hs{(!!)}: -\index{list!indexing} -\begin{spec} -(!!) :: [a] -> Int -> a -(x:_) !! 0 = x -(_:xs) !! n | n > 0 = xs !! (n-1) -(_:_) !! _ = error "PreludeList.!!: negative index" -[] !! _ = error "PreludeList.!!: index too large" -\end{spec} -\syn{Note the definition of two error conditions; be sure that you -understand under what conditions these two equations would succeed. -In particular, recall that equations are matched in top-down order: -the first to match is the one that is chosen.} - -\hs{take n xs} returns the prefix of \hs{xs} of length \hs{n}, or -\hs{xs} itself if \hs{n > length xs}. Similarly, \hs{drop n xs} returns -the suffix of \hs{xs} after the first \hs{n} elements, or \hs{[]} if -\hs{n > length xs}. Finally, \hs{splitAt n xs} is equivalent to -\hs{(take n xs, drop n xs)}. -\indexhs{take} -\indexhs{drop} -\indexhs{splitAt} -\indexhs{length} -\begin{spec} -take :: Int -> [a] -> [a] -take 0 _ = [] -take _ [] = [] -take n (x:xs) | n > 0 = x : take (n-1) xs -take _ _ = - error "PreludeList.take: negative argument" - -drop :: Int -> [a] -> [a] -drop 0 xs = xs -drop _ [] = [] -drop n (_:xs) | n > 0 = drop (n-1) xs -drop _ _ = - error "PreludeList.drop: negative argument" - -splitAt :: Int -> [a] -> ([a],[a]) -splitAt 0 xs = ([],xs) -splitAt _ [] = ([],[]) -splitAt n (x:xs) | n > 0 = (x:xs',xs'') - where (xs',xs'') = splitAt (n-1) xs -splitAt _ _ = - error "PreludeList.splitAt: negative argument" - -length :: [a] -> Int -length [] = 0 -length (_:l) = 1 + length l -\end{spec} -For example: -\begin{spec} -take 3 [0, 1 .. 5] ==> [0,1,2] -drop 3 [0, 1 .. 5] ==> [3,4,5] -splitAt 3 [0, 1 .. 5] ==> ([0,1,2],[3,4,5]) -\end{spec} - -\section{Predicate-Based Selector Functions} -\label{sec:list-pred-fns} -\indexhs{takeWhile} -\indexhs{dropWhile} -\indexhs{span} -\indexhs{break} - -\hs{takeWhile p xs} returns the longest (possibly empty) prefix of -\hs{xs}, all of whose elements satisfy the predicate \hs{p}. -\hs{dropWhile p xs} returns the remaining suffix. Finally, -\hs{span p xs} is equivalent to \hs{(takeWhile p xs, dropWhile p xs)}, -while \hs{break p} uses the negation of \hs{p}. -\begin{spec} -takeWhile :: (a -> Bool) -> [a] -> [a] -takeWhile p [] = [] -takeWhile p (x:xs) - | p x = x : takeWhile p xs - | otherwise = [] - -dropWhile :: (a -> Bool) -> [a] -> [a] -dropWhile p [] = [] -dropWhile p xs@(x:xs') - | p x = dropWhile p xs' - | otherwise = xs - -span, break :: (a -> Bool) -> [a] -> ([a],[a]) -span p [] = ([],[]) -span p xs@(x:xs') - | p x = (x:xs',xs'') where (xs',xs'') = span p xs - | otherwise = (xs,[]) - -break p = span (not . p) -\end{spec} -\indexwdhs{filter} removes all elements not satisfying a predicate: -\begin{spec} -filter :: (a -> Bool) -> [a] -> [a] -filter p [] = [] -filter p (x:xs) | p x = x : filter p xs - | otherwise = filter p xs -\end{spec} - -\section{Fold-like Functions} - -\indexwdhs{foldl1} and \indexwdhs{foldr1} are variants of -\indexwdhs{foldl} and \indexwdhs{foldr} that have no starting value -argument, and thus must be applied to non-empty lists. -\begin{spec} -foldl :: (a -> b -> a) -> a -> [b] -> a -foldl f z [] = z -foldl f z (x:xs) = foldl f (f z x) xs - -foldl1 :: (a -> a -> a) -> [a] -> a -foldl1 f (x:xs) = foldl f x xs -foldl1 _ [] = error "PreludeList.foldl1: empty list" - -foldr :: (a -> b -> b) -> b -> [a] -> b -foldr f z [] = z -foldr f z (x:xs) = f x (foldr f z xs) - -foldr1 :: (a -> a -> a) -> [a] -> a -foldr1 f [x] = x -foldr1 f (x:xs) = f x (foldr1 f xs) -foldr1 _ [] = error "PreludeList.foldr1: empty list" -\end{spec} -\hs{foldl1} and \hs{foldr1} are best used in cases where an empty list -makes no sense for the application. For example, computing the -maximum or mimimum element of a list does not make sense if the list -is empty. Thus \hs{foldl1 max} is a proper function to compute the -maximum element of a list. - -\hs{scanl} is similar to \hs{foldl}, but returns a list of successive -reduced values from the left: -\begin{spec} -scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...] -\end{spec} -For example: -\begin{spec} -scanl (+) 0 [1,2,3] ==> [0,1,3,6] -\end{spec} -Note that \hs{last (scanl f z xs) = foldl f z xs}. \hs{scanl1} is -similar, but without the starting element: -\begin{spec} -scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...] -\end{spec} -Here are the full definitions: -\indexhs{scanl} -\indexhs{scanl1} -\indexhs{scanr} -\indexhs{scanr1} -\begin{spec} -scanl :: (a -> b -> a) -> a -> [b] -> [a] -scanl f q xs = q : (case xs of - [] -> [] - x:xs -> scanl f (f q x) xs) -scanl1 :: (a -> a -> a) -> [a] -> [a] -scanl1 f (x:xs) = scanl f x xs -scanl1 _ [] = error "PreludeList.scanl1: empty list" - -scanr :: (a -> b -> b) -> b -> [a] -> [b] -scanr f q0 [] = [q0] -scanr f q0 (x:xs) = f x q : qs - where qs@(q:_) = scanr f q0 xs - -scanr1 :: (a -> a -> a) -> [a] -> [a] -scanr1 f [x] = [x] -scanr1 f (x:xs) = f x q : qs - where qs@(q:_) = scanr1 f xs -scanr1 _ [] = error "PreludeList.scanr1: empty list" -\end{spec} - -\section{List Generators} -\label{sec:list-generators} - -There are some functions which are very useful for generating lists -from scratch in interesting ways. To start, \hs{iterate f x} returns -an {\em infinite list} of repeated applications of \hs{f} to \hs{x}. -That is: \indexhs{iterate} -\begin{spec} -iterate f x ==> [x, f x, f (f x), ...] -\end{spec} -The ``infinite'' nature of this list may at first seem alarming, but -in fact is one of the more powerful and useful features of Haskell. - -[say more] -\begin{spec} -iterate :: (a -> a) -> a -> [a] -iterate f x = x : iterate f (f x) -\end{spec} -\hs{repeat x} is an infinite list, with {x} the value of every -element. \hs{replicate n x} is a list of length \hs{n} with \hs{x} -the value of every element. And \hs{cycle} ties a finite list into a -circular one, or equivalently, the infinite repetition of the original -list. -\indexhs{repeat} -\indexhs{replicate} -\indexhs{cycle} -\begin{spec} -repeat :: a -> [a] -repeat x = xs where xs = x:xs - -replicate :: Int -> a -> [a] -replicate n x = take n (repeat x) - -cycle :: [a] -> [a] -cycle [] = error "Prelude.cycle: empty list" -cycle xs = xs' where xs' = xs ++ xs' -\end{spec} - -\section{String-Based Functions} -\label{sec:list-string-fns} - -Recall that strings in Haskell are just lists of characters. -Manipulating strings (i.e.\ text) is a very common practice, so it -makes sense that Haskell would have a few pre-defined functions to -make this easier for you. - -\indexwdhs{lines} breaks a string at every newline character (written -as \hs{'\n'} in Haskell), thus yielding a {\em list} of strings, each -of which contains no newline characters. Similary, \indexwdhs{words} -breaks a string up into a list of words, which were delimited by white -space. Finally, \indexwdhs{unlines} and \indexwdhs{unwords} are the -inverse operations: \hs{unlines} joins lines with terminating newline -characters, and \hs{unwords} joins words with separating spaces. -(Because of the potential presence of multiple spaces and newline -characters, however, these pairs of functions are not true inverses of -each other.) -\begin{spec} -lines :: String -> [String] -lines "" = [] -lines s = let (l, s') = break (== '\n') s - in l : case s' of - [] -> [] - (_:s'') -> lines s'' - -words :: String -> [String] -words s = case dropWhile Char.isSpace s of - "" -> [] - s' -> w : words s'' - where (w, s'') = break Char.isSpace s' - -unlines :: [String] -> String -unlines = concatMap (++ "\n") - -unwords :: [String] -> String -unwords [] = "" -unwords ws = foldr1 (\w s -> w ++ ' ':s) ws -\end{spec} - -\indexwdhs{reverse} reverses the elements in a finite list. -\begin{spec} -reverse :: [a] -[a] -reverse = foldl (flip (:)) [] -\end{spec} - -\section{Boolean List Functions} -\label{sec:list-boolean-fns} - -\indexwdhs{and} and \indexwdhs{or} compute the logical ``and'' and -``or,'' respectively, of all of the elements in a list of Boolean -values. -\begin{spec} -and, or :: [Bool] -> Bool -and = foldr (&&) True -or = foldr (||) False -\end{spec} -Applied to a predicate and a list, \indexwdhs{any} determines if any -element of the list satisfies the predicate. An analogous behavior -holds for \indexwdhs{all}. -\begin{spec} -any, all :: (a -> Bool) -> [a] -> Bool -any p = or . map p -all p = and . map p -\end{spec} - -\section{List Membership Functions} - -\indexwdhs{elem} is the list membership predicate, usually written in -infix form, e.g., \hs{x `elem` xs} (which is why it was given a fixity -declaration at the beginning of the module). \indexwdhs{notElem} is -the negation of this function. -\begin{spec} -elem, notElem :: (Eq a) => a -> [a] -> Bool -elem x = any (== x) -notElem x = all (/= x) -\end{spec} -It is common to store ``key/value'' pairs in a list, and to access the -list by finding the value associated with a given key (for this reason -the list is often called an {\em association list}). The function -\indexwdhs{lookup} looks up a key in an association list, returning -\hs{Nothing} if it is not found, or \hs{Just y} if \hs{y} is the -value associated with the key. -\begin{spec} -lookup :: (Eq a) => a -> [(a,b)] -> Maybe b -lookup key [] = Nothing -lookup key ((x,y):xys) - | key == x = Just y - | otherwise = lookup key xys -\end{spec} - -\section{Arithmetic on Lists} - -\indexwdhs{sum} and \indexwdhs{product} compute the sum and product, -respectively, of a finite list of numbers. -\begin{spec} -sum, product :: (Num a) => [a] -> a -sum = foldl (+) 0 -product = foldl (*) 1 -\end{spec} -\indexwdhs{maximum} and \indexwdhs{minimum} return the maximum and -minimum value, respectively from a non-empty, finite list whose -element type is ordered. -\begin{spec} -maximum, minimum :: (Ord a) => [a] -> a -maximum [] = error "Prelude.maximum: empty list" -maximum xs = foldl1 max xs - -minimum [] = error "Prelude.minimum: empty list" -minimum xs = foldl1 min xs -\end{spec} -Note that even though \hs{foldl1} is used in the definition, a test is -made for the empty list to give an error message that more accurately -reflects the source of the problem. - -\section{List Combining Functions} -\label{sec:list-combining-fns} - -\hs{map} and \hs{(++)} were defined in previous chapters, but -are repeated here for completeness: \indexhs{map} \indexhs{(++)} -\begin{spec} -map :: (a -> b) -> [a] -> [a] -map f [] = [] -map f (x:xs) = f x : map f xs - -(++) :: [a] -> [a] -> [a] -[] ++ ys = ys -(x:xs) ++ ys = x : (xs ++ ys) -\end{spec} -\indexwdhs{concat} appends together a list of lists: -\begin{spec} -concat :: [[a]] -> [a] -concat xss = foldr (++) [] xss -\end{spec} -\indexwdhs{concatMap} does what it says: it concatenates the result of -mapping a function down a list. -\begin{spec} -concatMap :: (a -> [b]) -> [a] -> [b] -concatMap f = concat . map f -\end{spec} -\indexwdhs{zip} takes two lists and returns a list of corresponding -pairs. If one input list is short, excess elements of the longer list -are discarded. \indexwdhs{zip3} takes three lists and returns a list -of triples. (``Zips'' for larger tuples are contained in the List -Library.) -\begin{spec} -zip :: [a] -> [b] -> [(a,b)] -zip = zipWith (,) - -zip3 :: [a] -> [b] -> [c] -> [(a,b,c)] -zip3 = zipWith3 (,,) -\end{spec} -\syn{The functions \indexwdhs{(,)} and \indexwdhs{(,,)} are the pairing -and tripling functions, respectively: -\begin{spec} -(,) ==> \x y -> (x,y) -(,,) ==> \x y z -> (x,y,z) -\end{spec} -} - -The \indexwdhs{zipWith} family generalises the \hs{zip} and \hs{map} -families (or, in a sense, combines them) by applying a function (given -as the first argument) to each pair (or triple, etc.) of values. For -example, \hs{zipWith (+)} is applied to two lists to produce the list -of corresponding sums. \indexhs{zipWith3} -\begin{spec} -zipWith :: (a->b->c) -> [a]->[b]->[c] -zipWith z (a:as) (b:bs) - = z a b : zipWith z as bs -zipWith _ _ _ = [] - -zipWith3 :: (a->b->c->d) -> [a]->[b]->[c]->[d] -zipWith3 z (a:as) (b:bs) (c:cs) - = z a b c : zipWith3 z as bs cs -zipWith3 _ _ _ _ = [] -\end{spec} -The following two functions perform the inverse operations of \hs{zip} -and \hs{zip3}, respectively. -\indexhs{unzip} -\indexhs{unzip3} -\begin{spec} -unzip :: [(a,b)] -> ([a],[b]) -unzip = foldr (\(a,b) ~(as,bs) -> (a:as,b:bs)) ([],[]) - -unzip3 :: [(a,b,c)] -> ([a],[b],[c]) -unzip3 = foldr (\(a,b,c) ~(as,bs,cs) -> (a:as,b:bs,c:cs)) - ([],[],[]) -\end{spec} - -% \begin{exercise}\em -% Write at least two (stylistically different) definitions for a -% factorial function in Haskell. Include the fact that, pragmatically -% speaking, we would expect an {\em error} to result if the function is -% applied to a negative argument. -% \end{exercise} - - diff --git a/HSoM/MUI.lhs b/HSoM/MUI.lhs deleted file mode 100644 --- a/HSoM/MUI.lhs +++ /dev/null @@ -1,2155 +0,0 @@ -%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- - -%include lhs2TeX.fmt -%include myFormat.fmt - -\out{ -\begin{code} --- This code was automatically generated by lhs2tex --code, from the file --- HSoM/MUI.lhs. (See HSoM/MakeCode.bat.) - -\end{code} -} - -\chapter{Musical User Interface} -\chapterauthor{Daniel Winograd-Cort} -\label{ch:MUI} - -\noindent\begin{code} -{-# LANGUAGE Arrows #-} - -module Euterpea.Examples.MUI where -import Euterpea -\end{code} -\out{\begin{code} -import Data.Maybe (mapMaybe) -import Euterpea.Experimental -import FRP.UISF.Graphics (withColor', rgbE, rectangleFilled) -import FRP.UISF.Widget.Construction (mkWidget) - -\end{code}} - - -This module is not part of the standard Euterpea module hierarchy -(i.e.\ those modules that get imported by the header command ``|import -Euterpea|''), but it can be found in the |Examples| folder in the -Euterpea distribution, and can be imported into another module by the -header command: -\begin{spec} -import Euterpea.Examples.MUI -\end{spec} - -\syn{To use the \emph{arrow syntax} described in this chapter, it is - necessary to use the following compiler pragma in GHC: -\begin{spec} -{-# LANGUAGE Arrows #-} -\end{spec} -} - -%% In addition, the ``TupleSections'' pragma permits the use of tuple -%% sections---for example, |(,42)| is the same as the function -%% |\x->(x,42)|. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% Introduction %%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\section{Introduction} - -Many music software packages have a graphical user interface (aka -``GUI'') that provides varying degrees of functionality to the user. -In Euterpea a basic set of widgets is provided that are collectively -referred to as the \emph{musical user interface}, or MUI. -This interface is quite different from -the GUI interfaces found in most conventional languages, and is built -around the concepts of \emph{signal functions} and \emph{arrows} -\cite{AFP2002,Hughes2000}.\footnote{The - Euterpea MUI is built using the arrow-based GUI library \emph{UISF}, - which is its own standalone package. UISF, in turn, borrows concepts - from \emph{Fruit} \cite{fruit,courtney-phd}.} -Signal functions are an abstraction of the -time-varying values inherent in an interactive system such as a GUI or -Euterpea's MUI. Signal functions are provided for creating graphical -sliders, pushbuttons, and so on for input; textual displays, -graphs, and graphic images for output; and textboxes, virtual keyboards, -and more for combinations of input and output. -In addition to these graphical widgets, the MUI also -provides an interface to standard MIDI input and output devices. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% Introduction - Basic Concepts %%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\section{Basic Concepts} - -A \emph{signal} is a time-varying quantity. Conceptually, at least, -most things in our world, and many things that we program with, are -time-varying. The position of a mouse is time-varying. So is the -voltage used to control a motor in a robot arm. Even an animation can -be thought of as a time-varying image. - -A \emph{signal function} is an abstract function that converts one -signal into another. Using the examples above, a signal function may -add an offset to a time-varying mouse position, filter -out noise from the time-varying voltage for a robot motor, or speed -up or slow down an animation. - -Perhaps the simplest way to understand Euterpea's approach to -programming with signals is to think of it as a language for -expressing \emph{signal processing diagrams} (or equivalently, -electrical circuits). We can think of the lines in a typical signal -processing diagram as signals, and the boxes that convert one signal -into another as signal functions. For example, this very simple -diagram has two signals, |x| and |y|, and one signal function, -|sigfun|: -\begin{center} - \includegraphics[scale=0.80]{pics/frp-circuit} -\end{center} -Using Haskell's \emph{arrow syntax} \cite{Hughes2000,Paterson2001}, -this diagram can be expressed as a code fragment in Euterpea simply -as: -\begin{spec} -y <- sigfun -< x -\end{spec} -\syn{The syntax |<-| and |-<| is typeset here in an attractive way, - but the user will have to type \verb+<-+ and \verb+-<+, - respectively, in her source file.} - -In summary, the arrow syntax provides a convenient way to compose -signal functions together---i.e.\ to wire together the boxes that make -up a signal processing diagram. - -%% \section{Signals} -%% \label{sec:signals} - -%% A value of type |Signal T| is a time-varying value of type |T|. For -%% example, |Signal Float| is a time-varying floating-point number, -%% |Signal AbsPitch| is a time-varing absolute pitch, and so on. -%% Abstractly, we can think of a signal as a function: -%% \begin{spec} -%% Signal a = Time -> a -%% \end{spec} -%% where |Time| is some suitable representation of time. - -%% %% (currently |Double| in Euterpea). - -%% However, this is not how signals are actually implemented in Euterpea, -%% indeed the above is not even valid Haskell syntax. Nevertheless it is -%% helpful to think of signals in this way. Indeed, for pedagogical -%% purposes, we can go one step further and write the above as a Haskell -%% data declaration: -%% \begin{spec} -%% data Signal a = Sig (Time -> a) -%% \end{spec} -%% and then describe in more detail how signals are manipulated once this -%% concrete representation is in hand. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% Introduction - The Type of a Signal Function %%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{The Type of a Signal Function} -\label{sec:sigfun-type} - -Polymorphically speaking, a signal function has type |SF a b|, -which should be read, ``the type of signal functions that convert -signals of type |a| into signals of type |b|.'' - -%% Keep in mind that a signal function is an \emph{abstract function}, -%% meaning that its actual representation in Eutperpea is hidden. And -%% there are no values that directly represent \emph{signals} in -%% Euterpea---there are only signal \emph{functions}. So you cannot -%% simply apply a signal function to an argument like an ordinary -%% function. That, in fact, is the purpose of the arrow syntax. - -For example, suppose the signal function |sigfun| used earlier has type -|SF T1 T2|, for some types |T1| and |T2|. In that case, and -using the example above, |x| will have type |T1|, and |y| will -have type |T2|. Although signal functions act on signals, the arrow -notation allows us to manipulate the instantaneous values of the -signals, such as |x| and |y| above, directly. - -A signal function whose type is of the form |SF () b| essentially -takes no input, but produces some output of type |b|. Because of this -we often refer to such a signal function as a \emph{signal source}. -Similarly, a signal function of type |SF a ()| is called a -\emph{signal sink}---it takes input, but produces no output. Signal -sinks are essentially a form of output to the real world. - -We can also create and use signal functions that operate on signals of -tuples. For example, a signal function |exp :: SF (Double, Double) -Double| that raises the first argument in a tuple to the power of its -second, at every point in time, could be used as follows: -\begin{spec} -z <- exp -< (x,y) -\end{spec} - -As mentioned earlier, a signal function is ``abstract,'' in the sense -that it cannot be applied like an ordinary function. Indeed, |SF| is -an instance of the |Arrow| type class in Haskell, which only provides -operations to \emph{compose} one signal function with another in -several ways. The |Arrow| class and how all this works for signal -functions will be described in Chapter~\ref{ch:arrows}. For -now, it suffices to say that programming in this style can be -awkward and that Haskell provides the arrow syntax described above -to make the programming easier and more natural. - -A Euterpea MUI program expresses the composition of a possibly large -number of signal functions into a composite signal function that is -then ``run'' at the top level by a suitable interpreter. A good -analogy for this idea is a state or IO monad, where the state is -hidden, and a program consists of a linear sequencing of actions that -are eventually run by an interpreter or the operating system. But in -fact arrows are more general than monads, and in particular the -composition of signal functions does not have to be completely linear, -as will be illustrated shortly. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% Introduction - |proc| Declarations %%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{|proc| Declarations} - -Arrows and arrow syntax will be described in more detail in -Chapter~\ref{ch:arrows}. For now, keep in mind that |<-| and |-<| are -part of the \emph{syntax}, and are not simply binary operators. -Indeed, we cannot just write the earlier code fragments anywhere. They -have to be within an enclosing |proc| construct whose result type is -that of a signal function. The |proc| construct begins with the -keyword |proc| along with a formal parameter, analogous to an -anonymous function. For example, a signal function that takes a -signal of type |Double| and adds 1 to it at every point in time, and -then applies |sigfun| to the resulting signal, can be written: -\begin{spec} -proc y -> do - x <- sigfun -< y+1 - outA -< x -\end{spec} -|outA| is a special signal function that specifies the output of the -signal function being defined. - -\syn{The |do| keyword in arrow syntax introduces layout, just as it - does in monad syntax.} - -Note the analogy of this code to the following snippet involving -an ordinary anonymous function: -\begin{spec} -\ y -> - let x = sigfun' (y+1) - in x -\end{spec} -The important difference, however, is that |sigfun| works on a signal, -i.e.\ a time-varying quantity. To make the analogy a little stronger, -we could imagine a signal being implemented as a stream of discrete -values. In which case, to achieve the effect of the arrow code given -d, we would have to write something like this: -\begin{spec} -\ ys -> - let xs = sigfun'' (map (+1) ys) - in xs -\end{spec} -The arrow syntax allows us to avoid worrying about the streams -themselves. - -%% It also has other important advantages that are beyond the scope of -%% the current discussion. - -%% Arrow syntax is just that---syntactic sugar that is expanded into a -%% set of conventional functions that work just as well, but are more -%% cumbersome to program with (just as with monad syntax). This -%% syntactic expansion will be described in more detail in -%% Chapter~\ref{ch:arrows}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% Introduction - Four Useful Functions %%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{Four Useful Functions} -\label{sec:useful-funs} - -There are four useful auxiliary functions that will make writing -signal functions a bit easier. The first two essentially ``lift'' -constants and functions from the Haskell level to the arrow (signal -function) level: -\begin{spec} -arr :: (a -> b) -> SF a b -constA :: b -> SF () b -\end{spec} -For example, a signal function that adds one to every sample of its -input can be written simply as |arr (+1)|, and a signal function that -returns the constant 440 as its result can be written |constA 440| -(and is a signal source, as defined earlier). - -The other two functions allow us to \emph{compose} signal functions: -\begin{spec} -(>>>) :: SF a b -> SF b c -> SF a c -(<<<) :: SF b c -> SF a b -> SF a c -\end{spec} -|(<<<)| is analogous to Haskell's standard composition operator |(.)|, -whereas |(>>>)| is like ``reverse composition.'' - -As an example that combines both of the ideas above, recall the very -first example given in this chapter: -\begin{spec} -proc y -> do - x <- sigfun -< y+1 - outA -< x -\end{spec} -which essentially applies |sigfun| to one plus the input. This signal -function can be written more succinctly as either |arr (+1) >>> sigfun| or -|sigfun <<< arr (+1)|. - -The functions |(>>>)|, |(<<<)|, and |arr| are actually generic -operators on arrows, and thus to use them one may import them from -the |Arrow| library. However, Euterpea reexports them automatically -so we need not do this. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% Introduction - Events %%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{Events} -\label{sec:events} - -Although signals are a nice abstraction of time-varying entities, and -the world is arguably full of such entities, there are some things -that happen at discrete points in time, like a mouse click, or a MIDI -keyboard press, and so on. We call these \emph{events}. To represent -events, and have them coexist with signals, recall the |Maybe| type -defined in the Standard Prelude: -\begin{spec} -data Maybe a = Nothing | Just a -\end{spec} -Conceptually, we define an event simply as a value of type |Maybe a|, -for some type |a|. We say that the value associated with an event is -``attached to'' or ``carried by'' that event. - -However, to fit this into the signal function paradigm, we imagine -\emph{signals of events}---in other words, \emph{event streams}. So a -signal function that takes events of type |Maybe T1| as input, and -emits events of type |Maybe T2|, would have type |SF (Maybe T1) (Maybe -T2)|. When there is no event, an event stream will have the -instantaneous value |Nothing|, and when an event occurs, it will have -the value |Just x| for some value x. - -For convenience Euterpea defines a type synonym for events: -\begin{spec} -type SEvent a = Maybe a -\end{spec} -The name |SEvent| is used to distinguish it from performance |Event| -as defined in Chapter~\ref{ch:performance}. ``|SEvent|'' can be read -as ``signal event.'' - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% Introduction - Feedback %%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{Feedback} - -If we think about signal functions and arrows as signal processing -diagrams, then so far, we have only considered how to connect them -so that the streams all flow in the same direction. However, there -may be times that we want to feed an output of one signal function -back in as one of its inputs, thus creating a loop. - -%% TODO: This might be a good place to have a diagram of a loop - -How can a signal function depend on its own output? At some point -in the loop, we need to introduce a \emph{delay} function. Euterpea -has a few different delay functions that we will decribe in more detail -later in this chapter (Section~\ref{ch:mui:sec:delays}), but for now, -we will casually introduce the simplest of these: |fcdelay|. -\begin{spec} -fcdelay :: b -> DeltaT -> SF b b -\end{spec} -The name |fcdelay| stands for ``fixed continuous delay'', and it -delays a continuous signal for a fixed amount of time. (Note that -|DeltaT| is a type synonym for |Double| and represents a change in -time, or $\delta t$.) Thus, the signal function |fcdelay b t| will -delay its input signal for |t| seconds, emitting the constant signal -|b| for the first |t| seconds. - -With a delay at the ready, we can create a loop in a signal function -by using the |rec| keyword in the arrow syntax. This keyword behaves -much like it does in monadic |do| syntax and allows us to use a signal -before we have defined it. - -For instance, we can create a signal function that will count how many -seconds have gone by since it started running: -\begin{spec} -secondCounter :: SF () Integer -secondCounter = proc () -> do - rec count <- fcdelay 0 1 -< count + 1 - outA -< count -\end{spec} - -\syn{The |rec| keyword comes from an extension to arrows called - \emph{arrow loop}. To use the same ability outside of the arrow - syntax requires the |loop| operator: -\begin{spec} -loop :: SF (b, d) (c, d) -> SF b c -\end{spec}} - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% Introduction - [Advanced] Why Arrows? %%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{[Advanced] Why Arrows?} - -It is possible, and fairly natural, to define signal functions -directly, say as an abstract type |Signal T|, and then define -functions to add, multiply, take the sine of, and so on, signals -represented in this way. For example, |Signal Float| would be the -type of a time-varying floating-point number, |Signal AbsPitch| would -be the type of a time-varying absolute pitch, and so on. Then given -|s1,s2 :: Signal Float| we might simply write |s1 + s2|, |s1 * s2|, -and |sin s1| as examples of applying the above operations. Haskell's -numeric type class hierarchy makes this particularly easy to do. -Indeed, several domain-specific languages based on this approach have -been designed, beginning with the language \emph{Fran} \cite{Fran} -that was designed for writing computer animation programs. - -But years of experience and theoretical study have revealed that such -an approach leads to a language with subtle time- and -space-leaks,\footnote{A time-leak in a real-time system occurs - whenever a time-dependent computation falls behind the current time - because its value or effect is not needed yet, but then requires - ``catching up'' at a later point in time. This catching up process - can take an arbitrarily long time, and may consume additional space - as well. It can destroy any hope for real-time behavior if not - managed properly.} for reasons that are beyond the scope of this -textbook \cite{Leak07}. - -Perhaps surprisingly, these problems can be avoided by using arrows. -Programming in this style gives the user access to signal functions, -and the individual values that comprise a signal, but not to the -actual signal itself. By not giving the user direct access to -signals, and providing a disciplined way to compose signal functions -(namely arrow syntax), time- and space-leaks are avoided. In fact, -the resulting framework is highly amenable to optimization, although -this requires using special features in Haskell, as described in -Chapter \ref{ch:arrows}. - -%% Although we like to think of signals as continuous, time-varying -%% quantities, in practice we know that they are sampled representations -%% of continous quantities, as discussed earlier. It is often important, -%% in a given context, to know what that sampling rate is. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% The UISF Arrow %%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\section{The UISF Arrow} -\label{sec:UI} - -|SF| as used in this chapter so far is an instance of the |Arrow| -class, but is not the actual type used for constructing MUIs. The -core component of Euterpea's MUI is the \emph{user interface signal - function}, captured by the type |UISF|, which is also an instance of -the |Arrow| class. So instead of |SF|, in the remainder of this -chapter we will use |UISF|, but all of the previous discussion about -signal functions and arrows still applies. - -Using |UISF|, we can create ``graphical widgets'' using a style very -similar to the way we wired signal functions earlier. However, -instead of having values of type |SF a b|, we will use values of type -|UISF a b|. Just like |SF|, the |UISF| type is fully abstract -(meaning its implementation is hidden) and, being an instance of the -|Arrow| class, can be used with arrow syntax. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% The UISF Arrow - Graphical Input and Output Widgets %%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{Graphical Input and Output Widgets} - -Euterpea's basic widgets are shown in Figure \ref{fig:widgets}. Note -that each of them is, ultimately, a value of type |UISF a b|, for some -input type |a| and output type |b|, and therefore may be used with the -arrow syntax to help coordinate their functionality. The names and -type signatures of these functions suggest their functionality, which -we elaborate in more detail below: - -\begin{figure} -\cbox{ -\begin{spec} -label :: String -> UISF a a -displayStr :: UISF String () -display :: Show a => UISF a () -withDisplay :: Show b => UISF a b -> UISF a b -textbox :: UISF String String -textboxE :: String -> UISF (SEvent String) String -radio :: [String] -> Int -> UISF () Int -button :: String -> UISF () Bool -checkbox :: String -> Bool -> UISF () Bool -checkGroup :: [(String, a)] -> UISF () [a] -listbox :: (Eq a, Show a) => UISF ([a], Int) Int -hSlider, vSlider :: RealFrac a => (a, a) -> a -> UISF () a -hiSlider, viSlider :: Integral a => a -> (a, a) -> a -> UISF () a -\end{spec}} -\caption{Basic MUI Input/Output Widgets} -\label{fig:widgets} -\end{figure} - -\begin{itemize} -\item -A simple (static) text string can be displayed using: -\begin{spec} -label :: String -> UISF a a -\end{spec} - -\item -Alternatively, a time-varying string can be be displayed using: -\begin{spec} -displayStr :: UISF String () -\end{spec} - -For convenience, Euterpea defines the following useful variations of -|displayStr|: -\begin{spec} -display :: Show a => UISF a () -display = arr show >>> displayStr - -withDisplay :: Show b => UISF a b -> UISF a b -withDisplay sf = proc a -> do - b <- sf -< a - display -< b - outA -< b -\end{spec} -|display| allows us to display anything that is ``|Show|able.'' -|withDisplay| is an example of a \emph{signal function transformer}: -it takes a signal function and attaches a display widget to it that -displays the value of its time-varying output. - -\item -A textbox that functions for both input and output can be created -using: -\begin{spec} -textbox :: UISF String String -\end{spec} -A |textbox| in Euterpea is notable because it is ``bidirectional.'' -That is, the time-varying input is displayed, and the user can -interact with it by typing or deleting, the result being the -time-varying output. In practice, the textbox is used almost -exclusively with the |rec| keyword and a |delay| operator. -For example, a code snippet from a -MUI that uses |textbox| may look like this: -\begin{spec} -rec str <- textbox <<< delay "Initial text" -< str -\end{spec} - -Because of this common usage, there is a variant of the textbox: -\begin{spec} -textboxE :: String -> UISF (SEvent String) String -\end{spec} -A |textboxE| widget encapsulates the recursion and delay internally. -Thus, its initial value is given by its static argument, and its input -stream is an event stream that will update the displayed text when there -is an event and leave it unchanged otherwise. - -\item -|radio|, |button|, and |checkbox| are three kinds of ``pushbuttons.'' -A |button| (or |checkbox|) is pressed and unpressed (or checked -and \newline -unchecked) independently of others. In contrast, a |radio| button is -dependent upon other radio buttons---specifically, only one can be -``on'' at a time, so pressing one will turn off the others. The -string argument to these functions is the label attached to the -button. |radio| takes a list of strings, each being the label of one -of the buttons in the mutually-exclusive group; indeed the length of -the list determines how many buttons are in the group. - -The |checkGroup| widget creates a group of |checkbox|es. As its static -argument, it takes a list of pairs of strings and values. For each pair, -one |checkbox| is created with the associated string as its label. Rather -than simply returning |True| or |False| for each checked box, it returns a -list of the values associated with each label as its output stream. - -\item -The |listbox| widget creates a pane with selectable text entries. -The input stream is the list of entries as well as which entry is -currently selected, and the output stream is the index of the newly -selected entry. In many ways, this widget functions much like the -|radio| widget except that it is stylistically different, it is dynamic, -and, like the |textbox| widget, it is bidirectional. - -\item -|hSlider|, |vSlider|, |hiSlider| and |viSlider| are four kinds of -``sliders''---a graphical widget that looks like a slider control -as found on a hardware device. The first two yield floating-point -numbers in a given range, and are oriented horizontally and -vertically, respectively, whereas the latter two return integral -numbers. For the integral sliders, the first argument is the size of -the step taken when the slider is clicked at any point on either side -of the slider ``handle.'' In each of the four cases, the other two -arguments are the range and initial setting of the slider, -respectively. -\end{itemize} - -As a simple example, here is a MUI that has a single slider -representing absolute pitch, and a display widget that displays the -pitch corresponding to the current setting of the slider: -\begin{code} -ui0 :: UISF () () -ui0 = proc _ -> do - ap <- hiSlider 1 (0,100) 0 -< () - display -< pitch ap - -\end{code} -Note how the use of signal functions makes this dynamic MUI trivial to -write. But using the functions defines in -Section~\ref{sec:useful-funs} it can be defined even more succinctly -as: -\begin{spec} -ui0 = hiSlider 1 (0,100) 0 >>> arr pitch >>> display -\end{spec} - -We can execute this example using the function: -\begin{spec} -runMUI' :: UI () () -> IO () -\end{spec} -So our first running example of a MUI is: -\begin{code} -mui0 = runMUI' ui0 - -\end{code} -The resulting MUI, once the slider has been moved a bit, is shown in -Figure \ref{fig:simple-mui}(a). - -\syn{ - Any MUI widgets have the capacity to be \emph{focusable}, which is - particularly relevant for graphical widgets. When a focusable widget - is ``in focus,'' not only can it update its appearance, but any key - presses from the computer keyboard become visible to it as input - events. This means that keyboard controls are possible with MUI - widgets. Obviously, typing will affect the value of a textbox - widget, but also, for instance, the arrow keys as well as the - ``Home'' and - ``End'' keys will affect the value of a slider widget. Focus can - be shifted between widgets by clicking on them with the mouse as - well as by using ``Tab'' and ``Shift+Tab'' to cycle focus through - focusable widgets.} - -\begin{figure}[hbtp] -\centering -\subfigure[Very Simple]{ -\includegraphics[height=2.3in]{pics/mui0.eps} -} -\subfigure[With Titles and Sizing]{ -\includegraphics[height=2.3in]{pics/mui1.eps} -} -\subfigure[With Alternate (left-to-right) Layout]{ -\includegraphics[height=2.3in]{pics/mui2.eps} -} -\caption{Several Simple MUIs} -\label{fig:simple-mui} -\end{figure} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% The UISF Arrow - Widget Transformers %%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{Widget Transformers} -\label{ch:mui:sec:wt} - -Figure \ref{fig:layout-widgets} shows a set of ``widget -transformers''---functions that take UISF values as input, and return -modified UISF values as output. - -\begin{figure} -\cbox{ -\begin{spec} -title :: String -> UISF a b -> UISF a b -setLayout :: Layout -> UISF a b -> UISF a b -setSize :: (Int, Int) -> UISF a b -> UISF a b -pad :: (Int, Int, Int, Int) -> UISF a b -> UISF a b -topDown, bottomUp, leftRight, rightLeft :: UISF a b -> UISF a b - -makeLayout :: LayoutType -> LayoutType -> Layout -data LayoutType = Stretchy { minSize :: Int } - | Fixed { fixedSize :: Int } -\end{spec}} -\caption{MUI Layout Widget Transformers} -\label{fig:layout-widgets} -\end{figure} - -\begin{itemize} -\item -|title| simply attaches a title (a string) to a UISF, and |setLayout| -establishes a new layout for a UISF. The general way to make a new -layout is to use |makeLayout|, which takes layout information for -first the horizontal dimension and then the vertical. A dimension can -be either stretchy (with a minimum size in pixels but that will expand -to fill the space it is given) or fixed (measured in pixels). - -The |setSize| function is a convenient function for setting the layout -of a widget when both dimensions need to be fixed. It is defined as: -\begin{spec} -setSize (w,h) = setLayout (makeLayout (Fixed w) (Fixed h)) -\end{spec} - -For example we can modify the previous example to both set a fixed -layout for the overall widget, and attach titles to both the slider -and display: -\begin{code} -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 - -\end{code} %% $ -This MUI is shown in Figure \ref{fig:simple-mui}(b). - -\item -|pad (w,n,e,s) ui| adds |w| pixels of space to the ``west'' of the UISF -|ui|, and |n|, |e|, and |s| pixels of space to the north, east, and -south, respectively. - -\item -The remaining four functions are used to control the relative layout -of the widgets within a UISF. By default widgets are arranged -top-to-bottom, but, for example, we could modify the previous UISF -program to arrange the two widgets left-to-right: -\begin{code} -ui2 :: UISF () () -ui2 = leftRight $ - proc _ -> do - ap <- title "Absolute Pitch" (hiSlider 1 (0,100) 0) -< () - title "Pitch" display -< pitch ap - -mui2 = runMUI' ui2 - -\end{code} -This MUI is shown in Figure \ref{fig:simple-mui}(c). -\end{itemize} - -Widget transformers can be nested (as demonstrated in some later -examples), so a fair amount of flexibility is available. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% The UISF Arrow - MIDI Input and Output %%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{MIDI Input and Output} -\label{ch:mui:sec:midiinout} -% TODO: This (and the deviceID) section may need to be rewritten -% FIXME: Even if it stays basically the same, the following code uses -% the "unique" mediator, which hasn't been introduced yet. - -An important application of events in Euterpea is real-time, -interactive MIDI. There are two main UISF signal functions that handle -MIDI, one for input and the other for output, but neither of them -displays anything graphically: -\begin{spec} -midiIn :: UISF ( Maybe InputDeviceID) - ( SEvent [MidiMessage]) -midiOut :: UISF ( Maybe OutputDeviceID, - SEvent [MidiMessage]) () -\end{spec} -Except for the input and output deviceIDs (about which more will be said shortly), -these signal functions are fairly straightforward: |midiOut| takes a -stream of |MidiMessage| events and sends them to the MIDI output -device (thus a signal sink), whereas |midiIn| generates a stream of -|MidiMessage| events corresponding to the messages sent by the MIDI -input device (thus a signal source)\footnote{Technically, this is - not a proper signal source because it accepts an input stream of - |Maybe InputDeviceID|, but the way in which it generates MIDI - messages makes it feel very much like a source.}. -In both cases, note that the -events carry \emph{lists} of MIDI messages, thus accounting for the -possibility of simultaneous events. - -The |MidiMessage| data type is defined as: -\begin{spec} -data MidiMessage = ANote { channel :: Channel, key :: Key, - velocity :: Velocity, duration :: Time } - | Std Message - deriving Show -\end{spec} -A |MidiMessage| is either an |ANote|, which allows us to specify a -note with duration, or is a standard MIDI |Message|. MIDI does not -have a notion of duration, but rather has separate |NoteOn| and -|NoteOff| messages. With |ANote|, the design above is a bit more -convenient, although what happens ``behind the scenes'' is that each -|ANote| is transformed into a |NoteOn| and |NoteOff| event. - -The |Message| data type is described in Chapter~\ref{ch:midi}, and is -defined in the |Codec.Midi| module. Its most important functionality -is summarized here: -\begin{spec} -data Message = - -- Channel Messages - NoteOff { channel :: Channel, key :: Key, velocity :: Velocity } - | NoteOn { channel :: Channel, key :: Key, velocity :: Velocity } - | ProgramChange { channel :: Channel, preset :: Preset } - | ... - -- Meta Messages - | TempoChange Tempo | - | ... - deriving (Show,Eq) -\end{spec} - -%% data Message = -%% -- Channel Messages -%% NoteOff { channel :: !Channel, key :: !Key, velocity :: !Velocity } -%% | NoteOn { channel :: !Channel, key :: !Key, velocity :: !Velocity } -%% | ProgramChange { channel :: !Channel, preset :: !Preset } -%% | ... -%% -- Meta Messages -%% | TempoChange !Tempo | -%% | ... -%% deriving (Show,Eq) - -MIDI's notion of a ``key'' is the key pressed on a MIDI instrument, -not to be confused with ``key'' as in ``key signature.'' Also, MIDI's -notion of ``velocity'' is the rate at which the key is pressed, and is -roughly equivalent to what we have been calling ``volume.'' So, for -example, a MIDI message |NoteOn c k v| plays MIDI key |k| on MIDI -channel |c| with velocity |v|. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% The UISF Arrow - MIDI Device IDs %%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{MIDI Device IDs} -\label{ch:mui:sec:mididevs} - -Before we can create an example using |midiIn| or |midiOut|, we first -must consider their other arguments: |InputDeviceID| and -|OutputDeviceID|. -The MIDI device ID is a system-dependent concept that -provides an operating system with a simple way to uniquely identify -various MIDI devices that may be attached to a computer. Indeed, as -devices are dynamically connected and disconnected from a computer, -the mapping of these IDs to a particular device may change. -Thus, the only way to get an input or output device ID is by selection -with one of the following widgets: -\begin{spec} -selectInput :: UISF () (Maybe InputDeviceID) -selectOutput :: UISF () (Maybe OutputDeviceID) -\end{spec} -Each of these widgets automatically queries the operating system to -obtain a list of connected MIDI devices, and then displays the list as -a set of radio buttons, allowing the user to select one of them. In -the event that there are no available devices, the widget can then -return |Nothing|. -%% This makes wiring up the user choice very easy. - -With these functions, we can now create an example using MIDI output. -Let's modify our previous MUI -program to output an |ANote| message every time the absolute pitch -changes: -\begin{code} -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 - -\end{code} -The |unique| signal function used here is an example of a -\emph{mediator}, or a signal function that mediates between continuous -and discrete signals. We will explore more mediators in -Section~\ref{ch:mui:sec:mediators}, but in this case, note that -|unique| will generate an event whenever its input, the continuous -absolute pitch stream, changes. Each of those events, named |uap| above, -carries the new absolute pitch, and that pitch is used directly as the -MIDI key field in |ANote|. - -To understand how that last part is done on the |midiOut| line, -recall that |fmap| is the -primary method in the |Functor| class as described in -Section~\ref{sec:functor-class}, and the |Maybe| type is an instance -of |Functor|. Therefore, since |SEvent| is a type synonym for -|Maybe|, the use of |fmap| above is valid---and all it does is apply -the functional argument to the value ``attached to'' the event, which -in this case is an absolute pitch. - -For an example using MIDI input as well, here is a simple program that -copies each MIDI message verbatim from the selected input device to -the selected output device: - -\begin{code} -ui4 :: UISF () () -ui4 = proc _ -> do - mi <- selectInput -< () - mo <- selectOutput -< () - m <- midiIn -< mi - midiOut -< (mo, m) - -mui4 = runMUI' ui4 - -\end{code} - -Since determining device IDs for both input and output is common, we -define a simple signal function to do both: -\begin{code} -getDeviceIDs = topDown $ - proc () -> do - mi <- selectInput -< () - mo <- selectOutput -< () - outA -< (mi,mo) - -\end{code} - - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% The UISF Arrow - Putting It All Together %%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{Putting It All Together} -\label{sec:runmui} - -Recall that a Haskell program must eventually be a value of type |IO -()|, and thus we need a function to turn a |UISF| value into a |IO| -value---i.e.\ the UISF needs to be ``run.'' We can do this using one of -the following two functions, the first of which we have already been -using: -\begin{spec} -runMUI' :: UISF () () -> IO () -runMUI :: UIParams -> UISF () () -> IO () -\end{spec} -Executing |runMUI' ui| or |runMUI params ui| will create a single MUI -window whose behavior is governed by the argument |ui :: UISF () ()|. -The additional |UIParams| argument of |runMUI| -contains parameters that can affect the -appearance and performance of the MUI window that is created. -There is a default value of |UIParams| that is typical for regular -MUI usage, and |runMUI'| is defined using it: -\begin{spec} -defaultMUIParams :: UIParams -runMUI' = runMUI defaultMUIParams -\end{spec} -When using |runMUI|, it is advisable to simply modify the -default value rather than building a whole new |UIParams| value. The -easiest way to do this is with Haskell's \emph{record syntax}. - -There are many fields of data in a value of type |UIParams|, but we -will focus only on the |uiTitle| and |uiSize|, which will control the -value displayed in the title bar of the graphical window and the initial -size of the window respectively. Thus, the title is a |String| -value and the size is a |Dimension| value (where |Dimension| is a type -synonym for |(Int, Int)|, which in turn represents a width and height -measured in pixels). By default, the size is |(300,300)| and the title -is |"MUI"|, but we can change these like so: -\begin{code} -mui'4 = runMUI (defaultMUIParams - { uiTitle = "MIDI Input / Output UI", - uiSize = (200,200)}) - ui4 -\end{code} -This version of |mui4| (from the previous subsection) will run -identically to the original except for the fact that its title -will read ``MIDI Input / Output UI'' and its initial size will -be smaller. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% Non-Widget Signal Functions %%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\section{Non-Widget Signal Functions} - -All of the signal functions we have seen so far are effectful widgets. -That is, they all do something graphical or audible when they are -used. For regular computation, we have been using pure functions -(which we can insert arbitrarily in arrow syntax or lift with |arr| -otherwise). However, there are signal functions that are important -and useful which have no visible effects. We will look at a few -different types of these signal functions in this section. - -\syn{Note that the mediators and folds in the next two subsections -are generic signal functions, and are not restricted to use only -in MUIs. To highlight this, we present them with the |SF| type -rather than the |UISF| type. However, they can be (and often are) -used as |UISF|s in MUIs. - -The timers and delay functions in Subsections~\ref{ch:mui:sec:timers} -and \ref{ch:mui:sec:delays} -require the MUI's internal notion of time, and so we present those -directly with the |UISF| type.} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% Non-Widget Signal Functions - Mediators %%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{Mediators} -\label{ch:mui:sec:mediators} - -In order to use event streams in the context of continuous signals, -Euterpea defines a set of functions that mediate between the -continuous and the discrete. These ``mediators,'' as well as some -functions that deal exclusively with events, are shown in -Figure~\ref{fig:mediators} along with their type signatures and brief -descriptions. Their use will be better understood through some -examples that follow in Section~\ref{ch:mui:sec:examples}. - -\begin{figure} -%% in signal processing this is called an ``edge -%% detector,'' and thus the name chosen here. -\cbox{\small -\begin{spec} -unique :: Eq a => SF a (SEvent a) - -- Generates an event whenever the input changes - -edge :: SF Bool (SEvent ()) - -- Generates an event whenever the input changes from |False| to |True| - -hold :: a -> SF (SEvent a) a - -- |hold x| begins as value |x|, but changes to the subsequent values - -- attached to each of its input events - -accum :: a -> SF (SEvent (a -> a)) a - -- |accum x| starts with the value |x|, but then applies the function - -- attached to the first event to |x| to get the next value, and so on - -now :: SF () (SEvent ()) - -- Creates a single event ``now'' and forever after does nothing. - -evMap :: SF a b -> SF (SEvent a) (SEvent b) - -- Lifts a continuous signal function into one that handles events - -\end{spec}} -\caption{Mediators Between the Continuous and the Discrete} -\label{fig:mediators} -\end{figure} - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% Non-Widget Signal Functions - Folds %%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{Folds} - -In traditional functional programming, a folding, or reducing, operation -is one that joins together a set of data. The typical case would be -an operation that operates over a list of data, such as a function that -sums all elements of a list of numbers. - -There are a few different ways given in Euterpea to fold together -signal functions to create new ones: -\begin{spec} -maybeA :: SF () c -> SF b c -> SF (Maybe b) c -concatA :: [SF b c] -> SF [b] [c] -runDynamic :: SF b c -> SF [b] [c] -\end{spec} - -\begin{itemize} -\item -|maybeA| is a fold over the |Maybe| (or |SEvent|) data type. The -signal function |maybeA n j| accepts as input a stream of |Maybe b| -values; at any given moment, if those values are |Nothing|, then the -signal function behaves like |n|, and if they are |Just b|, then it -behaves like |j|. - -\item -The |concatA| fold takes a list of signal functions and converts them -to a single signal function whose streaming values are themselves -lists. For example, perhaps we want to display a bunch of buttons -to a user in a MUI window. Rather than coding them in one at a time, -we can use |concatA| to fold them into one operation that will return -their results altogether in a list. In essence, we are -\emph{concat}enating the signal functions together. - -\item -The |runDynamic| signal function is similar to |concatA| except that -it takes a single signal function as an argument rather than a list. -What, then, does it fold over? Instead of folding over the static -signal function list, it folds over the |[b]| list that it accepts -as its input streaming argument. -\end{itemize} - -The |concatA| and |runDynamic| signal functions are definitely similar, -but they are also -subtly different. With |concatA|, there can be many different signal -functions that are grouped together, but with |runDynamic|, there is -only one. However, |runDynamic| may have a variable number of -internally running signal functions at runtime because that number -depends on a streaming argument. |concatA| is fixed once it is -created. - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% Non-Widget Signal Functions - Timers %%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{Timers} -\label{ch:mui:sec:timers} - -The Euterpea MUI has an implicit notion of elapsed time, but it can -be made explicit by the following signal source: -\begin{spec} -getTime :: UISF () Time -\end{spec} -where |Time| is a type synonym for |Double|. - -Although the explicit time may be desired, some MUI widgets depend -on the time implicitly. For example, the -following signal function creates a \emph{timer}: -\begin{spec} -timer :: UISF DeltaT (SEvent ()) -\end{spec} -In practice, |timer -< i| takes a signal |i| that represents the timer -interval (in seconds), and generates an event stream, where each pair -of consecutive events is separated by the timer interval. Note that -the timer interval is itself a signal, so the timer output can have -varying frequency. - -%% Note also that, since |timer| does not have any graphical or audio -%% representation, it is not actually of type |UISF|. Rather, it is a -%% generic |ArrowInit|. However, as |UISF| is an instance of -%% |ArrowInit|, we can use |timer| in our MUIs. - -To see how a timer might be used, let's modify our MUI working example -from earlier so that, instead of playing a note every time the absolute -pitch changes, we will output a note continuously, at a rate controlled -by a second slider: -\begin{code} -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) - --- Pitch Player with Timer -mui5 = runMUI' ui5 - -\end{code} -Note that the rate of |tick|s is controlled by the second slider---a -larger slider value causes a smaller time between ticks, and thus a -higher frequency, or tempo. - -In some cases, the simple unit events of the |timer| are not enough. -Rather, we would like each event to be different while we progress -through a predetermined sequence. To do this, we can use the -|genEvents| signal function: -\begin{spec} -genEvents :: [b] -> UISF DeltaT (SEvent b) -\end{spec} -Just like |timer|, this signal function will output events -at a variable frequency, but each successive event will contain -the next value in the given list. When every value of the list -|lst| has been emitted, |genEvents lst| will never again produce -an event. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% Non-Widget Signal Functions - Delays %%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{Delays} -\label{ch:mui:sec:delays} - - -Another way in which a widget can use time implicitly is in a -\emph{delay}. Euterpea comes with five different delaying widgets, -which each serve a specific role depending on whether the streams -are continuous or event-based and if the delay is a fixed length or -can be variable: -\cbox{ -\begin{spec} -delay :: b -> UISF b b -fcdelay :: b -> DeltaT -> UISF b b -fdelay :: DeltaT -> UISF (SEvent b) (SEvent b) -vdelay :: UISF (DeltaT, SEvent b) (SEvent b) -vcdelay :: DeltaT -> b -> UISF (DeltaT, b) b -\end{spec}} - -To start, we will examine the most straightforward one. The -|delay| function creates what is called a ``unit delay'', which -can be thought of as a delay by the shortest amount of time possible. -This delay should be treated in the same way that one may treat a -$\delta t$ in calculus; that is, although one can assume that a delay -takes place, the amount of time delayed approaches zero. -Thus, in practice, this should be used only in continuous cases and -should only be used as a means to initialize arrow feedback. - -The rest of the delay operators delay by some amount of actual time, -and we will look at each in turn. -|fcdelay b t| will emit the constant value |b| for the first |t| -seconds of the output stream and will from then on emit its input -stream delayed by |t| seconds. The name comes from ``fixed continuous -delay.'' - -One potential problem with |fcdelay| is that it makes no guarantees -that every instantaneous value on the input stream will be seen in the -output stream. This should not be a problem for continuous signals, -but for an event stream, it could mean that entire events are accidentally -skipped over. Therefore, there is a specialized delay for event streams: -|fdelay t| guarantees that every input event will be emitted, but in -order to achieve this, it is not as strict about timing---that is, -some events may end up being over delayed. Due to the nature of -events, we no longer need an initial value for output: for the first -|t| second, there will simply be no events emitted. - -We can make both of the above delay widgets a little more complicated -by introducing the idea of a variable delay. For instance, we can -expand the capabilities of |fdelay| into |vdelay|. -Now, the delay time is part of the signal, and it can change -dynamically. Regardless, this event-based version will still -guarantee that every input event will be emitted. ``|vdelay|'' -can be read ``variable delay.'' - -For the variable continuous version, we must add one extra input -parameter to prevent a possible space leak. Thus, the first argument -to |vcdelay| is -the maximum amount that the widget can delay. Due to the variable -nature of |vcdelay|, some portions of the input signal may be omitted -entirely from the output signal while others may even be outputted -more than once. Thus, once again, it is highly advised to use -|vdelay| rather than |vcdelay| when dealing with event-based signals. - - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% Musical Examples %%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\section{Musical Examples} -\label{ch:mui:sec:examples} - -In this section we work through three larger musical examples that use -Euterpea's MUI in interesting ways. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% Musical Examples - Chord Builder %%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{Chord Builder} - -This MUI will display a collection of chord types (Maj, Maj7, Maj9, -min, min7, min9, and so on), one of which is selectable via a radio -button. Then when a key is pressed on a MIDI keyboard, the selected -chord is built and played using that key as the root. - -To begin, we define a ``database'' that associates chord types with -their intervals starting with the root note: -\begin{code} -chordIntervals :: [ (String, [Int]) ] -chordIntervals = [ ("Maj", [4,3,5]), ("Maj7", [4,3,4,1]), - ("Maj9", [4,3,4,3]), ("Maj6", [4,3,2,3]), - ("min", [3,4,5]), ("min7", [3,4,3,2]), - ("min9", [3,4,3,4]), ("min7b5", [3,3,4,2]), - ("mMaj7", [3,4,4,1]), ("dim", [3,3,3]), - ("dim7", [3,3,3,3]), ("Dom7", [4,3,3,2]), - ("Dom9", [4,3,3,4]), ("Dom7b9", [4,3,3,3]) ] - -\end{code} -We will display the list of chords on the screen as radio buttons for -the user to click on. - -The |toChord| function takes an input MIDI message as the root note, -and the index of the selected chord, and outputs the notes of the -selected chord. -\begin{code} -toChord :: Int -> MidiMessage -> [MidiMessage] -toChord i m = - case m of - Std (NoteOn c k v) -> f NoteOn c k v - Std (NoteOff c k v) -> f NoteOff c k v - _ -> [] - where f g c k v = map (\k' -> Std (g c k' v)) - (scanl (+) k (snd (chordIntervals !! i))) - -\end{code} - -\syn{|scanl :: (a->b->a) -> a -> [b] -> [a]| is a standard Haskell - function that is like |foldl :: (a->b->a) -> a -> [b] -> a|, - except that every intermediate result is returned, collected - together in a list.} - -The overall MUI is laid out 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 types. We take the name of each chord type -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 then sent to the Midi output -device. - -\begin{code} -buildChord :: UISF () () -buildChord = leftRight $ - proc _ -> do - (mi, mo) <- getDeviceIDs -< () - m <- midiIn -< mi - i <- topDown $ title "Chord Type" $ - radio (fst (unzip chordIntervals)) 0 -< () - midiOut -< (mo, fmap (concatMap $ toChord i) m) - -chordBuilder = runMUI (defaultMUIParams - { uiTitle = "Chord Builder", - uiSize = (600,400)}) - buildChord -\end{code} - -\syn{|unzip :: [(a,b)] -> ([a],[b])| is a standard Haskell function - that does the opposite of |zip :: [a] -> [b] -> [(a,b)]|. - - |concatMap :: (a -> [b]) -> [a] -> [b]| is another standard Haskell - function that acts as a combination of |map| and |concat|. It maps - the given function over the given list and then concatenates all of - the outputs into a single output list.} - -Figure \ref{fig:chordbuilder} shows this MUI in action. - -\begin{figure}[hbtp] -\centering -\includegraphics[height=2.3in]{pics/chordBuilder.eps} -\caption{A Chord Builder MUI} -\label{fig:chordbuilder} -\end{figure} - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% Musical Examples - Chaotic Composition %%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{Chaotic Composition} -\label{ch:mui:sec:chatoiccomp} - -In this section we describe a UISF that borrows some ideas from Gary -Lee Nelson's composition ``Bifurcate Me, Baby!'' -\cite{nelson-bifurcate}. - -The basic idea is to evaluate a formula called the \emph{logistic - growth function}, from a branch of mathematics called chaos theory, -at different points and convert the values to musical notes. The -growth function is given by the recurrence equation: -\[ x_{n+1} = r x_n (1 - x_n) \] - -Mathematically, 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 stabilizes to a -certain value, but as $r$ increases, the period doubles, quadruples, -and eventually leads to chaos. It is one of the classic examples of -chaotic behavior. - -We can capture the growth rate equation above in Haskell by defining a -function that, given a rate |r| and current population |x|, generates -the next population: -\begin{code} -grow :: Double -> Double -> Double -grow r x = r * x * (1-x) - -\end{code} - -To generate a time-varying population, the |accum| signal function -comes in handy. |accum| is one of the mediators mentioned in -Section~\ref{ch:mui:sec:mediators}: it takes an initial value and an -event signal -carrying a modifying function, and it updates the current value by -applying the function to it. -\begin{spec} - ... - r <- title "Growth rate" $ withDisplay (hSlider (2.4, 4.0) 2.4) -< () - pop <- accum 0.1 -< fmap (const (grow r)) tick - ... -\end{spec} %% $ - -The |tick| above is the ``clock tick'' that drives the simulation. -We wish to define a signal |tick| that pulsates at a given frequency -specified by a slider. -\begin{spec} - ... - f <- title "Frequency" $ withDisplay (hSlider (1, 10) 1) -< () - tick <- timer -< 1/f - ... -\end{spec} %% $ - -We also need a simple function that maps a population value to a -musical note. As usual, this can be done in a variety of ways---here -is one way: -\begin{code} -popToNote :: Double -> [MidiMessage] -popToNote x = [ANote 0 n 64 0.05] - where n = truncate (x * 127) - -\end{code} - -Finally, to play the note at every tick, we simply apply |popToNote| -to every value in the time-varying population |pop|. |fmap| makes -this straightforward. Putting it all together, we arrive at: -\begin{code} -bifurcateUI :: UISF () () -bifurcateUI = proc _ -> do - mo <- selectOutput -< () - f <- title "Frequency" $ withDisplay (hSlider (1, 10) 1) -< () - tick <- timer -< 1/f - r <- title "Growth rate" $ withDisplay (hSlider (2.4, 4.0) 2.4) -< () - pop <- accum 0.1 -< fmap (const (grow r)) tick - _ <- title "Population" $ display -< pop - midiOut -< (mo, fmap (const (popToNote pop)) tick) - -bifurcate = runMUI (defaultMUIParams - { uiTitle = "Bifurcate!", - uiSize = (300,500)}) - bifurcateUI - -\end{code} - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% Musical Examples - MIDI Echo Effect %%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{MIDI Echo Effect} - -As a final example we present a program that receives 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. Recall -that the function |vdelay| takes a time signal, the amount of time -to delay, and an input signal, and returns a delayed version of the -input signal. - -There are two signals we want to attenuate, or ``decay.'' 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. First 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 processed further as follows. - -The MIDI messages and the -current decay rate are processed with |decay|, which softens each -note in the list of messages. Specifically, |decay| works by -reducing the velocity of each note by the given rate and removing -the note if the velocity drops to 0. The resulting signal is -then delayed by the amount of time determined by another slider |f|, -producing signal |s|. Signal |s| is then merged with |m| in order to -define |m'| (note that |~++| is a Euterpea function that -merges event lists), thus closing the loop of the recursive signal. -Finally, |m'| is sent to the output device. - -\begin{code} -echoUI :: UISF () () -echoUI = proc _ -> do - (mi, mo) <- getDeviceIDs -< () - m <- midiIn -< mi - r <- title "Decay rate" $ withDisplay (hSlider (0, 0.9) 0.5) -< () - f <- title "Echoing frequency" $ withDisplay (hSlider (1, 10) 10) -< () - - rec s <- vdelay -< (1/f, fmap (mapMaybe (decay 0.1 r)) m') - let m' = m ~++ s - - midiOut -< (mo, m') - -echo = runMUI' echoUI - -\end{code} - -\begin{code} - -decay :: Time -> Double -> MidiMessage -> Maybe MidiMessage -decay dur r m = - let f c k v d = if v > 0 - then let v' = truncate (fromIntegral v * r) - in Just (ANote c k v' 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 -\end{code} - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% Special Purpose and Custom Widgets %%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\section{Special Purpose and Custom Widgets} - -Although the widgets and signal functions described so far -enable the creation of many basic MUIs, there are times when -something more specific is required. -Thus, in this section, we will look at some special purpose -widgets as well as some functions that aid in the creation of custom -widgets. - -Some of the functions described in this subsection are included in -Euterpea by default, but others require extra imports of specific -Euterpea modules. We will note this where applicable. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% Custom Widgets - Realtime graphs, histograms %%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{Realtime graphs, histograms} - -So far, the only way to display the value of a stream in the MUI is -to use the |display| widget. Although this is often enough, there -may be times when another view is more enlightening. For instance, -if the stream represents a sound wave, then rather than displaying the -instantaneous values of the wave as numbers, we may wish to see them -graphed. - -Euterpea provides support for a few different widgets that will graph -streaming data visually. -\begin{spec} -realtimeGraph :: RealFrac a => Layout - -> Time -> Color -> UISF [(a,Time)] () -histogram :: RealFrac a => Layout - -> UISF (SEvent [a]) () -histogramWithScale :: RealFrac a => Layout - -> UISF (SEvent [(a,String)]) () -\end{spec} -Note that each of these three functions requires a |Layout| argument -(recall the |Layout| data type from Section~\ref{ch:mui:sec:wt}); -this is because the layout of a graph is not as easily inferred as that -for, say, a button. - -We will walk through the descriptions of each of these widgets: -\begin{itemize} -\item -|realtimeGraph l t c| will produce a graph widget with layout -|l|. This graph will accept as input a stream of events of pairs -of values and time\footnote{These events are represented as a list - rather than using the |SEvent| type because there may be more than - one event at the same time. The absence of any events would be - indicated by an empty list.}. -The values are plotted vertically in color |c|, and the horizontal -axis represents time, where the width of the graph represents an -amount of time |t|. - -\item -The histogram widgets' input are events that each contain a complete -set of data. The data are plotted as a histogram within the given -layout. For the histogram with the scale, each value must be paired -with a |String| representing its label, and the labels are printed -under the plot. -\end{itemize} - -These widgets will prove useful when we are dealing with sound -signals directly in future chapters. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% Custom Widgets - More MIDI Widgets %%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{More MIDI Widgets} - -In Sections~\ref{ch:mui:sec:midiinout} and \ref{ch:mui:sec:mididevs}, -we presented simple widgets for selecting devices and polling and -playing midi messages. However, these widgets allow for only one -input device and one output device at a time. For a more complex -scenario where multiple devices are to be used simultaneously, we -have the following four widgets: - -\begin{spec} -midiInM :: UISF [InputDeviceID] (SEvent [MidiMessage]) -midiOutM :: UISF [(OutputDeviceID, SEvent [MidiMessage])] () -selectInputM :: UISF () [InputDeviceID] -selectOutputM :: UISF () [OutputDeviceID] -\end{spec} - -The M on the end can be read as ``Multiple.'' These widgets can -be used just like their singular counterparts to handle MIDI, -except that they allow for multiple simultaneous device usage. - -We can add even more behavior into the midi output widgets by -considering a \emph{buffered} output. When using |midiOut| (or -|midiOutM|), all of the MIDI messages sent to the device are -immediately played, but sometimes, we would prefer to queue -messages up for playback later. We can do this with the following -two midi output widgets: -\begin{spec} -midiOutB :: UISF ( Maybe OutputDeviceID, - BufferOperation MidiMessage) Bool -midiOutMB :: UISF [ ( OutputDeviceID, - BufferOperation MidiMessage)] Bool -\end{spec} -Notice that these two widgets have a |Bool| output stream; this stream -is |True| when the buffer is empty and there is nothing queued up to -play and |False| otherwise. -The |BufferOperation| data type gives information along with -the MIDI messages about when or how to play the messages. It is defined -as follows: -\begin{spec} -data BufferOperation b = - NoBOp - | ClearBuffer - | SkipAheadInBuffer DeltaT - | MergeInBuffer [(DeltaT, b)] - | AppendToBuffer [(DeltaT, b)] - | SetBufferPlayStatus Bool (BufferOperation b) - | SetBufferTempo Tempo (BufferOperation b) -\end{spec} -where -\begin{itemize} -\item |NoBOp| indicates that there is no new information for the buffer. -\item |ClearBuffer| erases the current buffer. -\item |SkipAheadInBuffer t| skips ahead in the buffer by |t| seconds. -\item |MergeInBuffer ms| merges messages |ms| into the buffer to play - concurrently with what is currently playing. -\item |AppendToBuffer ms| adds messages |ms| to the end of the buffer - to play immediately following whatever is playing. -\item |SetBufferPlayStatus p b| indicates whether the buffer should be - playing (|True|) or paused (|False|). -\item |SetBufferTempo t b| sets the play speed of the buffer to |t| - (the default is 1, indicating realtime). -\end{itemize} -Note that the final two options recursively take a buffer operation, -meaning that they can be attached to any other buffer operation as -additional modifications. - -\syn{The |midiOutB| and |midiOutMB| widgets are essentially the - regular |midiOut| widgets connected to an |eventBuffer|. The - |eventBuffer| signal function can also be used directly to buffer any - kind of data that fits into the |BufferOperation| format. It can be - brought into scope by importing FRP.UISF.AuxFunctions.} - -In practice, the most common time to use the buffered midi output -widgets as opposed to the regular ones is when dealing with |Music| -values. Thus, Euterpea.IO.MUI.MidiWidgets also exports the following -function: -\begin{spec} -musicToMsgs :: Maybe [InstrumentName] -> Music1 - -> [(DeltaT, MidiMessage)] -\end{spec} -The first argument should be a |Just| value if the |Music1| value is -infinite and |Nothing| otherwise. If it is a |Just| value, then its -value should be the override for the instrument channels. - -The |musicToMsgs| function will convert a |Music1| value into a format -that can be easily sent to the buffered midi widget. Once converted -in this way, it can be wrapped by |MergeInBuffer| or |AppendToBuffer| -to be sent to the buffer. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% Custom Widgets - Virtual Instruments %%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{Virtual Instruments} -Euterpea provides two special widgets that create virtual instruments -that the user can interact with: a piano and a guitar. These two -widgets are not fully supported by Euterpea at present, so to bring -them into scope, we will need to import Euterpea.Experimental. -\begin{spec} -import Euterpea.Experimental -\end{spec} - -\syn{Euterpea's Experimental package contains functions and features -that are still in process. They may be unreliable, and they are likely -to change in future versions of Euterpea. Thus, feel free to experiment -with them, but use them with caution.} - -The piano and guitar are virtual instruments in the -MUI that look and behave like a piano keyboard or guitar strings: the strings can be -plucked or the piano keys pressed with either the mouse or keyboard, and -the output is in the form of MIDI messages. Note that these widgets do -not actually produce any sound. Thus, in most cases, the output should -then be sent to a MIDI output widget. - -The two widgets have the following similar types: -\begin{spec} -guitar :: GuitarKeyMap -> Midi.Channel - -> UISF (InstrumentData, SEvent [MidiMessage]) - (SEvent [MidiMessage]) -piano :: PianoKeyMap -> Midi.Channel - -> UISF (InstrumentData, SEvent [MidiMessage]) - (SEvent [MidiMessage]) -\end{spec} -Given a key mapping and a MIDI channel, the functions make the virtual -instrument widgets. The widgets themselves accept an |InstrumentData| -argument, which contains some settings for the instrument, and a stream -of input MIDI messages, and they produce a stream of MIDI messages. They -do not make any sound themselves---these widgets are purely visual. - -Let's look at how these widgets work in a little more detail. First, -the widgets take a key map, either a |GuitarKeyMap| or a |PianoKeyMap|. -These maps indicate what keyboard keys one can use to play the -instruments with a standard computer keyboard. These are customizable -values, but we provide a couple for use with a qwerty keyboard: -\begin{itemize} -\item |defaultMap1| treats the characters from Q to U as one octave - from C2 to B3. The black notes are predictably at 2, 3, 5, 6, and 7. - Holding a shift key while pressing the same keys plays the notes one - octave higher. -\item |defaultMap2| is the same as |defaultMap1| except that it uses - the bottom two rows of the keyboard, with Z through M as the white - keys and S through J (but not F) as black keys. Once again, hold - shift for the higher octave. -\item |defaultMap0| is for a four octave keyboard and uses both maps - in sequence. -\end{itemize} -For the guitar, we provide |sixString|, a mapping using the first -six columns of keys (e.g. 1, Q, A, Z would be the first column) to -represent the six strings of the guitar. - -The next argument to making a virtual instrument widget is a MIDI -channel. Because they can create MIDI messages from just a mouse -click, these widgets need -information about what MIDI channel the messages should use. The -|Midi.Channel| type is brought in from |Codec.Midi|, and it is a type -synonym for |Int|---really, any number from 0 to 127 is probably an okay -candidate, but it depends on what channels your MIDI devices support. - -The streaming input to the widgets includes both MIDI messages (which -will visually ``play'' on the instrument) as well as a value of -|InstrumentData|. By default, one should use the value -|defaultInstrumentData|, but this can be modified with the following -three widgets: -\begin{spec} -addNotation :: UISF InstrumentData InstrumentData -addTranspose :: UISF InstrumentData InstrumentData -addPedal :: UISF InstrumentData InstrumentData -\end{spec} -Each one will create a checkbox or slider to allow for adding -notation (visual text that indicates what keys are what on the -instrument), transposition (the ability to raise or lower the notes -by some amount) or pedal (only used for the piano). - -Now that we have some idea of how the widgets work, let's create a -sample MUI that uses them both. - -\begin{code} -gAndPUI :: UISF () () -gAndPUI = proc _ -> do - (mi, mo) <- getDeviceIDs -< () - m <- midiIn -< mi - settings <- addNotation -< defaultInstrumentData - outG <- guitar sixString 1 -< (settings, Nothing) - outP <- piano defaultMap0 0 -< (settings, m) - midiOut -< (mo, outG ~++ outP) - -gAndP = runMUI (defaultMUIParams { uiSize=(1050,700), - uiTitle="Guitar and Piano"}) - gAndPUI -\end{code} - -This MUI will provide a checkbox for whether it should display -notation or not and then shows both virtual instruments. Any messages -played on the input MIDI device will be shown and heard as if played -on the virtual piano. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% Custom Widgets - A Graphical Canvas %%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{A Graphical Canvas} -\label{sec:canvas} - -In addition to the standard musical widgets, the musical user interface -provides support for arbitrary graphical output. It does this via the -|canvas| widget, which allows the user to ``paint'' graphics right into -the MUI: -\begin{spec} -canvas :: Dimension -> UISF (Event Graphic) () -canvas' :: Layout -> (a -> Dimension -> Graphic) -> UISF (Event a) () -\end{spec} -The main |canvas| widget takes a fixed size and displays in the MUI -the most recent |Graphic| it received. The |canvas'| function is a -little more complex as it can handle a changing size: rather than a -fixed dimension, it accepts a layout and a function that, when given -the dimension (which is generated at runtime based on the window size), -can produce the appropriate graphic. - -In either case, the user is responsible for generating the graphic -that should be shown by generating a value of type |Graphic|. However, -Euterpea does not export |Graphic| constructors by default, -so we will need to add the following import to our file: -\begin{spec} -import FRP.UISF.SOE -\end{spec} -The name of this import, SOE, comes from the book The Haskell School -of Expression, the predecessor to this text. Rather than go into -detail about the various types of graphics one can create with this -import, we will leave it to the reader to read this other text or to -look at the documentation directly. Instead, we will only point out -three functions as we will use them in our upcoming example: -\begin{spec} -rectangleFilled :: Rect -> Graphic -rgbE :: Int -> Int -> Int -> RGB -withColor' :: RGB -> Graphic -> Graphic -\end{spec} -The |rectangleFilled| function takes a |Rect|, which is a pair of -a point representing the bottom left corner and a width and height, -and constructs a rectangle bounded by the |Rect|. -The |rgbE| function produces an |RGB| color -from red, green, and blue values, and |withColor'| applies the given -|RGB| color to the given |Graphic|. - -In the following example, we will create three sliders to control -the red, green, and blue values, and then we will use these to create -a simple color swatch out of the |canvas| widget. - -\begin{code} -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 -\end{code} - -We use the |polygon| function to create a simple box, and then we color -it with the data from the sliders. Whenever the color changes, we redraw -the box by sending a new |Graphic| event to the |canvas| widget. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% Custom Widgets - [Advanced] mkWidget %%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{[Advanced] mkWidget} - -In some cases, even the |canvas| widget is not powerful enough, and -we would like to create our own custom widget. For this, there is -the |mkWidget| function. To bring this into scope, we must import -UISF's widget module directly: -\begin{spec} -import FRP.UISF.Widget (mkWidget) -\end{spec} - -The type of |mkWidget| is as follows: -\begin{spec} -mkWidget :: s - -> Layout - -> (a -> s -> Rect -> UIEvent -> (b, s, DirtyBit)) - -> (Rect -> Bool -> s -> Graphic) - -> UISF a b -\end{spec} -This widget building function takes arguments particularly desgined -to make a realtime, interactive widget. The arguments work like so: -\begin{itemize} -\item The first argument is an initial state for the widget. The - widget will be able to internally keep track of state, and the - value that it should start with is given here. -\item The second argument is the layout of the widget. -\item The third argument is the computation that this layout performs. - Given an instantaneous value of the streaming input, the current - state, the rectangle describing the current allotted dimensions, - and the current |UIEvent|\footnote{The |UIEvent| can contain - information like mouse clicks or key presses. For complete - documentation on |UIEvent|, look to the FRP.UISF documentation.}, - it should produce an output value, a new state, and a |DirtyBit|, - which is a boolean value indicating whether the visual representation - of the widget will change. -\item The final argument is the drawing routine. Given the rectangle - describing the current allotted dimensions for the widget (the same - as given to the computation function), a boolean indicating whether - this widget is in focus, and the state, it produces the graphic - that this widget will appear as. -\end{itemize} - -The specifics of |mkWidget| are beyond the scope of this text, and -those interested in making their own widgets are encouraged to look -at the documentation of the UISF package. However, as a demonstration -of its use, here we will show the definition of |canvas| using -|mkWidget|. -\begin{spec} -canvas (w, h) = mkWidget nullGraphic layout process draw - where - layout = makeLayout (Fixed w) (Fixed h) - draw ((x,y),(w,h)) _ = translateGraphic (x,y) - process (Just g) _ _ _ = ((), g, True) - process Nothing g _ _ = ((), g, False) -\end{spec} - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% Advanced Topics %%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\section{Advanced Topics} -In the final section of this chapter, we will explore some advanced -topics related to the MUI. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% Advanced Topics - Banana brackets %%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{Banana brackets} - -When dealing with layout, we have so far shown two ways to apply the -various layout transformers (e.g.\ |topDown|, |leftRight|, etc.) to -signal functions. One way involves using the transformer on the -whole signal function by applying it on the first line like so: -\begin{spec} -... = leftRight $ proc _ -> do ... -\end{spec} -The other option is to apply the transformation in-line for the signal -function it should act upon: -\begin{spec} -... - x <- topDown mySF -< y -... -\end{spec} -However, the situation is not so clear cut, and at times, we may -want a sub-portion of our signal function to have a different layout -flow than the rest. - -For example, assume we have a signal function -that should have four buttons. The second and third buttons should -be left-right aligned, but vertically, they together should be between -the first and second. One way we may try to write this is like so: -\begin{code} -ui6 = topDown $ proc _ -> do - b1 <- button "Button 1" -< () - (b2, b3) <- leftRight (proc _ -> do - b2 <- button "Button 2" -< () - b3 <- button "Button 3" -< () - returnA -< (b2, b3)) -< () - b4 <- button "Button 4" -< () - display -< b1 || b2 || b3 || b4 -\end{code} -This looks a little funny, especially because we have an extra arrow -tail (the |-<| part) after the inner |returnA| on the sixth line, but -it gets the job done. - -However, what if we wanted to do something with the value |b1| within -the inner |proc| part? In its current state, |b1| is not in scope in -there. We can add it to the scope, but we would have to explicitly -accept that value from the outer scope. It would look like so: -\begin{code} -ui'6 = topDown $ proc _ -> do - b1 <- button "Button 1" -< () - (b2, b3) <- leftRight (proc b1 -> do - b2 <- button "Button 2" -< () - display -< b1 - b3 <- button "Button 3" -< () - returnA -< (b2, b3)) -< b1 - b4 <- button "Button 4" -< () - display -< b1 || b2 || b3 || b4 -\end{code} -This is getting hard to deal with! Fortunately, there is an arrow -syntax feature to help us with this known as \emph{banana brackets}. - -Banana brackets are a component of the arrow syntax that allows one -to apply a function to one or more arrow commands without losing the -scope of the arrow syntax. To use, one writes in the form: -\begin{spec} -(| f cmd1 cmd2 ... |) -\end{spec} -where |f| is a function on arrow commands -and |cmd1|, |cmd2|, etc.\ are arrow commands. - -\syn{An \emph{arrow command} is the portion of arrow syntax that - contains the arrow and the input but not the binding to output. - Generally, this looks like |sf -< x|, but if it starts with |do|, - then it can be an entire arrow in itself (albeit, one that does - not start with |proc _ -> |).} - -Banana brackets preserve the original arrow scope, so we can rewrite -our example to: -\begin{code} -ui''6 = proc () -> do - b1 <- button "Button 1" -< () - (b2, b3) <- (| leftRight (do - b2 <- button "Button 2" -< () - display -< b1 - b3 <- button "Button 3" -< () - returnA -< (b2, b3)) |) - b4 <- button "Button 4" -< () - display -< b1 || b2 || b3 || b4 -\end{code} -Note that we no longer need the |proc _ ->| in the third line nor -do we have an arrow tail on the seventh line. That said, banana -brackets do have a limitation in that the variables used internally -are not exposed outside; that is, we still need the seventh line to -explicitly return |b2| and |b3| in order to bind them to the outer -scope in the third line so that they are visible when displayed on the -last line. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% Advanced Topics - General I/O From Within a MUI %%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{General I/O From Within a MUI} -\label{sec:mui-general-io} - -So far, through specific widgets, we have shown how to perform specific -effects through the MUI: one can poll MIDI devices, send MIDI output, -display graphics on the screen, and so on. However, -the MUI is capable of arbitrary |IO| actions. In general, arbitrary -|IO| actions can be dangerous, so the functions that allow them are -relegated to Euterpea.Experimental, and they should be used with care. - -The first arbitrary |IO| arrow to consider is: -\begin{spec} -initialAIO :: IO d -> (d -> UISF b c) -> UISF b c -\end{spec} -This function allows an |IO| action to be performed upon MUI -initialization, the result of which is used to finish constructing -the widget. Thus, its name can be read as ``initial Arrow IO.'' - -In practice one might use |initialAIO| to do something like read the -contents of a file to be used at runtime. For instance, if we had a -file called ``songData'' that contained data we would like to use in -the MUI, we could use the following function: -\begin{spec} -initialAIO (readFile "songData") - (\x -> now >>> arr (fmap $ const x)) - :: UISF () (SEvent String) -\end{spec} -This function will read the file and then produce a single event -containing the contents of the file when the MUI first starts. - -Performing an initial action is simple and useful, but at times, we -would like the freedom to perform actions mid-execution as well, and -for that, we have the following six functions: -\begin{spec} -uisfSource :: IO c -> UISF () c -uisfSink :: (b -> IO ()) -> UISF b () -uisfPipe :: (b -> IO c) -> UISF b c -uisfSourceE :: IO c -> UISF (SEvent ()) (SEvent c) -uisfSinkE :: (b -> IO ()) -> UISF (SEvent b) (SEvent ()) -uisfPipeE :: (b -> IO c) -> UISF (SEvent b) (SEvent c) -\end{spec} -The first three of these are for continuous-type actions and the -last three are for event-based actions. As an example of a continuous -action, one could consider a stream of random numbers: -\begin{spec} -uisfSource randomIO :: Random r => UISF () r -\end{spec} - -Most |IO| actions are better handled by the event-based functions. -For instance, we could update our file reading widget from earlier -so that it is capable of reading a dynamically named file, and it can -perform more than one read at runtime: -\begin{spec} -uisfPipeE readFile :: UISF (SEvent FilePath) (SEvent String) -\end{spec} -Whenever this signal function is given an event containing a file, -it reads the file and returns an event containing the contents. - -\syn{This sort of arbitrary |IO| access that the functions from this - subsection allow can have negative effects on a program ranging from - unusual behavior to performance problems to crashing. Research has - been done to handle these problems, and a promising solution using - what are called \emph{resource types} has been proposed - \cite{WinogradCort-TR1446, WinogradCort2012HS}. - However, Euterpea does not implement resource types, so it is left to - the programmer to be exceptionally careful to use these appropriately.} - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% Advanced Topics - Asynchrony %%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{Asynchrony} - -Although we have discussed the MUI as being able to act both -continuously and discretely (event-based) depending on the required -circumstances, in actual fact, the system is entirely built in a -discrete way. When run, the MUI does many calculations per second -to create the illusion of continuity, and as long as this sample -rate is high enough, the illusion persists without any problem. - -However, there are two primary ways in which the illusion of continuity -fails: -\begin{itemize} -\item Computations can be sensitive to the sampling rate itself such - that a low enough rate will cause poor behavior. -\item Computations can be sensitive to the variability of the sampling - rate such that drastic differences in the rate can cause poor - behavior. -\end{itemize} -These are two subtly different problems, and we will address both with -subtly different forms of \emph{asynchrony}. - -The idea of using asynchrony is to allow these sensitive computations -to run separately from the MUI process so that they are unaffected by -the MUI's sampling rate and are allowed to set and use their own -arbitrary rate. We achieve this with the following functions: -\begin{spec} -asyncUISFE . toAutomaton :: NFData b => - SF a b -> UISF (SEvent a) (SEvent b) -clockedSFToUISF :: (NFData b, Clock c) => - DeltaT -> SigFun c a b -> UISF a [(b, Time)] -\end{spec} -Note that the |SF| and |SigFun| types will be discussed further in -Chapter~\ref{ch:sigfuns}), but they are both arrows, and thus we can -lift pure functions of type |a -> b| to them with the |arr| function. -These two functions are designed to address the two different sampling -rate pitfalls we raised above. - -\begin{itemize} -\item |asyncUISFE . toAutomaton| is technically a composition of - two functions, but in Euterpea, it would be rare to use them apart. - Together, they are used to deal with the scenario where a computation - takes a long time to compute (or perhaps blocks internally, delaying - its completion). This slow computation may have deleterious effects - on the MUI, causing it to become unresponsive and slow, so we allow - it to run asynchronously. The computation is lifted into the discrete, - event realm, and for each input event given to it, a corresponding - output event will be created eventually. Of course, the output - event will likely not be generated immediately, but it will be - generated eventually, and the ordering of output events will match - the ordering of input events. -\item The |clockedSFToUISF| function can convert a signal function - with a fixed, virtual clockrate to a realtime UISF. The first - input parameter is a buffer size in seconds that indicates how - far ahead of real time the signal function is allowed to get, but - the goal is to allow it to run at a fixed clockrate as close to - realtime as possible. Thus, the output stream is a list of pairs - providing the output values along with the timestamp for when they - were generated. This should contain the right number of samples to - approach real time, but on slow computers or when the virtual - clockrate is exceptionally high, it will lag behind. This can be - checked and monitored by checking the length of the output list - and the time associated with the final element of the list on - each time step. -\end{itemize} - -Rather than show an example here, we will wait until -Chapter~\ref{ch:spectrum-analysis} once the |SigFun| type has been -introduced. An example that uses |clockedSFToUISF| can be found at -the end of the chapter in Figure~\ref{fig:fft-mui} - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% Exercises %%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\vspace{.1in}\hrule - -\begin{exercise}{\em -Define a MUI that has a text box in which the user can type a pitch -using the normal syntax |(C,4)|, |(D,5)|, etc., and a pushbutton -labelled ``Play'' that, when pushed, will play the pitch appearing in -the textbox. - -Hint: use the Haskell function |reads :: Read a => String -> -[(a,String)]| to parse the input.} -\end{exercise} - -\begin{exercise}{\em -Modify the previous example so that it has \emph{two} textboxes, and -plays both notes simultaneously when the pushbutton is pressed.} -\end{exercise} - -\begin{exercise}{\em -Modify the previous example so that, in place of the pushbutton, the -pitches are played at a rate specified by a horizontal slider.} -\end{exercise} - -\begin{exercise}{\em -Define a MUI for a pseudo-keyboard that has radio buttons to choose -one of the 12 pitches in the conventional chromatic scale. Every time -a new pitch is selected, that note is played.} -\end{exercise} - -\begin{exercise}{\em -Modify the previous example so that an integral slider is used to -specify the octave in which the pitch is played.} -\end{exercise} - -\begin{exercise}{\em -Leon Gruenbaum describes a ``Samchillian Tip Tip Tip Cheeepeeeee,'' a -MIDI keyboard based on intervals rather than fixed pitches. Your job -is to define a ``Cheepie Samchillian'' as a MUI that has the following -features: -\begin{itemize} -\item -A three-element radio button to choose between three scales: -chromatic, major, and whole-tone. -\item -Nine pushbuttons, corresponding to intervals (within the selected -scale) of 0, +1, +2, +3, +4, -1, -2, -3, and -4. -\end{itemize} } -\end{exercise} - -\vspace{.1in}\hrule diff --git a/HSoM/Monads.lhs b/HSoM/Monads.lhs deleted file mode 100644 --- a/HSoM/Monads.lhs +++ /dev/null @@ -1,863 +0,0 @@ -%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- - -%include lhs2TeX.fmt -%include myFormat.fmt - -\out{ -\begin{code} --- This code was automatically generated by lhs2tex --code, from the file --- HSoM/MUI.lhs. (See HSoM/MakeCode.bat.) - -\end{code} -} - -\chapter{Higher-Order Types and Monads} -\label{ch:monads} - -\index{type!higher-order} -\index{type!constructor} - -All of the types that we have considered thus far in this text have -been \emph{first order}. For example, the type constructor |Music| -has so far always been paired with an argument, as in |Music - Pitch|. This is because |Music| by itself is a \emph{type - constructor}: something that takes a type as an argument and returns -a type as a result. There are no \emph{values} in Haskell that have -this type, but such ``higher-order types'' can be used in type class -declarations in useful ways, as we shall see in this chapter. - -\section{The Functor Class} -\label{sec:functors} - -To begin, consider the |Functor| class described previously in -Section~\ref{sec:functor-class}, and defined in the Standard -Prelude:\footnote{The term \emph{functor} (as well as the term - \emph{monad} to be introduced shortly) comes from a branch of - abstract mathematics known as \emph{category theory} - \cite{pierce-ct}. This reflects the strong mathematical principles - that underly Haskell, but otherwise does not concern us here; i.e., - you do not need to know anything about category theory to understand - Haskell's functors and monads.} \indexhs{fmap} -\begin{spec} -class Functor f where - fmap :: (a -> b) -> f a -> f b -\end{spec} - -\syn{Type applications are written in the same manner as function -applications, and are also left associative: the type |T a b| is -equivalent to |((T a) b)|.} - -There is something new here: the type variable |f| is applied to other -type variables, as in |f a| and |f b|. Thus we would expect |f| to be -a \emph{type constructor} such as |Music| that can be applied to an -argument. Indeed, a suitable instance of |Functor| for |Music| is: -\begin{code} -instance Functor Music where - fmap f m = mMap f m -\end{code} -Similarly for |Primitive|: -\begin{code} -instance Functor Primitive where - fmap f p = pMap f p -\end{code} -%% \begin{code} -%% instance Functor Tree where -%% fmap f (Leaf x) = Leaf (f x) -%% fmap f (Branch t1 t2) = Branch (fmap f t1) (fmap f t2) -%% \end{code} - -Indeed, in retrospect, back in Chapter~\ref{ch:more-music} where we -defined |mMap| and |pMap|, we could have declared |Music| and -|Primitive| as instances of |Monad| directly, and avoided defining the -names |mMap| and |pMap| altogether: -\begin{spec} -instance Functor Music where - fmap f (Prim p) = Prim (fmap f p) - fmap f (m1 :+: m2) = fmap f m1 :+: fmap f m2 - fmap f (m1 :=: m2) = fmap f m1 :=: fmap f m2 - fmap f (Modify c m) = Modify c (fmap f m) - -instance Functor Primitive where - pMap :: (a -> b) -> Primitive a -> Primitive b - pMap f (Note d x) = Note d (f x) - pMap f (Rest d) = Rest d -\end{spec} - -In Haskell we write |Music Pitch| for a |Music| value instantiated on -|Pitch| values; |Music| is the type constructor. Similarly, we write -|[Int]| for lists instantiated on integers; but what is the type -constructor for lists? Because of Haskell's special syntax for the -list data type, there is also a special syntax for its type -constructor, namely |[]|. - -\syn{Similarly, for tuples the type constructors are |(,)|, |(,,)|, - |(,,,)|, and so on, and the type constructor for the function type - is |(->)|. This means that the following pairs of types are - equivalent: |[a]| and |[] a|, |f -> g| and |(->) f g|, |(a,b)| and - |(,) a b|, and so on.} - -This allows us to create an instance of |Functor| for lists, as -follows: -\begin{spec} -instance Functor [] where - fmap f [] = [] - fmap f (x:xs) = f x : fmap f xs -\end{spec} -Note the use of |[]| here in two ways: as a value in the list -data type, and as a type constructor as described above. - -Of course, the above declaration is equivalent to: -\begin{spec} -instance Functor [] where - fmap = map -\end{spec} -where |map| is the familiar function that we have been using since -Chapter \ref{ch:poly}. This instance is in fact predefined in the -Standard Prelude. - -One of the nice things about the |Functor| class, of course, is that -we can now use the same name, |fmap|, for lists, |Music|, and -|Primitive| values (and any other data type for which an instance of -|Functor| is declared). This could not have been done without -higher-order type constructors, and here demonstrates the ability to -handle generic ``container'' types, allowing functions such as |fmap| -to work uniformly over them. - -As mentioned in Section \ref{sec:tc-laws}, type classes often imply -a set of \emph{laws} which govern the use of the operators in the -class. In the case of the |Functor| class, the following laws are -expected to hold: -\begin{spec} -fmap id = id -fmap (f . g) = fmap f . fmap g -\end{spec} - -\syn{|id| is the \emph{identity function}, |\x->x|. Although -|id| is polymorphic, note that if its type on the left-hand side of -the equation above is |a->a|, then its type on the right must be -|t a -> t a|, for some type constructor |t| that is an instance -of |Functor|.} - -These laws ensure that the shape of the ``container type'' is -unchanged by |fmap|, and that the contents of the container are not -re-arranged by the mapping function. - -\vspace{.1in}\hrule - -\begin{exercise}{\em -Verify that the instances of |Functor| for lists, |Primitive|, and -|Music| are law-abiding.} -\end{exercise} - -\vspace{.1in}\hrule - -\section{The |Monad| Class} -\label{sec:monadic-classes} - -There are several classes in Haskell that are related to the notion of -a monad, which can be viewed as a generalization of the principles -that underly IO. Because of this, although the names of the classes -and methods may seem unusual, these ``monadic'' operations are rather -intuitive and useful for general programming.\footnote{Moggi - \cite{moggi89} was one of the first to point out the value of monads - in describing the semantics of programming languages, and Wadler - first popularized their use in functional programming - \cite{wadler-popl92,peytonjoneswadler-popl93}.} - -There are three classes associated with monads: |Functor| (which we -have discussed already), |Monad| (also defined in the Standard -Prelude), and |MonadPlus| (defined in |Control.Monad|). -\indexamb{Monad}{type class} \indexamb{Monad}{library} - -The |Monad| class defines four basic operators: |(>>=)| (often -pronounced ``bind''), |(>>)| (often pronounced ``sequence''), -|return|, and |fail|: -\begin{spec} -class Monad m where - (>>=) :: m a -> (a -> m b) -> m b - (>>) :: m a -> m b -> m b - return :: a -> m a - fail :: String -> m a - - m >> k = m >>= \_ -> k - fail s = error s -\end{spec} - -\syn{The two infix operators above are typeset nicely here; using a - text editor, you will have to type \verb+>>=+ and \verb+>>+ - instead.} - -The default methods for |(>>)| and |fail| define behaviors that -are almost always just what is needed. Therefore most instances of -|Monad| need only define |(>>=)| and |return|. - -Before studying examples of particular instances of |Monad|, we will -first reveal another secret in Haskell, namely that the |do| syntax is -actually shorthand for use of the monadic operators! The rules for -this are a bit more involved than those for other syntax we have seen, -but are still straightforward. The first rule is this: -\begin{spec} -do e ==> e -\end{spec} -So an expression such as |do putStr "Hello World"| is equivalent -to just \linebreak -|putStr "Hello World"|. - -The next rule is: -\begin{spec} -do e1; e2; ...; en -==> e1 >> do e2 ; ...; en -\end{spec} - -For example, combining this rule with the previous one means that: -\begin{spec} -do writeFile "testFile.txt" "Hello File System" - putStr "Hello World" -\end{spec} -is equivalent to: -\begin{spec} -writeFile "testFile.txt" "Hello File System" >> -putStr "Hello World" -\end{spec} -Note now that the sequencing of two commands is just the application -of the function |(>>)| to two values of type |IO ()|. There is -no magic here---it is all just functional programming! - -\syn{What is the type of |(>>)| above? From the type class -declaration we know that its most general type is: -\begin{spec} -(>>) :: Monad m => m a -> m b -> m b -\end{spec} - -However, in the case above, its two arguments both have type -|IO ()|, so the type of |(>>)| must be: -\begin{spec} -(>>) :: IO () -> IO () -> IO () -\end{spec} -That is, |m = IO|, |a = ()|, and |b = ()|. Thus the type of -the result is |IO ()|, as expected.} - -The rule for pattern matching is the most complex, because we must -deal with the situation where the pattern match fails: -\begin{spec} -do pat <- e1 ; e2 ; ...; en -==> let ok pat = do e2 ; ...; en - ok _ = fail "..." - in e1 >>= ok -\end{spec} -The right way to think of |(>>=)| above is simply this: it -``executes'' |e1|, and then applies |ok| to the result. What -happens after that is defined by |ok|: if the match succeeds, the -rest of the commands are executed, otherwise the operation |fail| -in the monad class is called, which in most cases (because of the -default method) results in an |error|. - -\syn{The string argument to |error| is a compiler-generated error -message, preferably giving some indication of the location of the -pattern-match failure.} - -A special case of the above rule is the case where the pattern |pat| -is just a name, in which case the match cannot fail, so the rule -simplifies to: -\begin{spec} -do x <- e1 ; e2 ; ...; en -==> e1 >>= \x -> do e2 ; ...; en -\end{spec} -The final rule deals with the |let| notation within a |do| -expression: -\begin{spec} -do let decllist ; e2 ; ...; en -==> let decllist in do e2 ; ...; en -\end{spec} -\indexkw{let} -\syn{Although we have not used this feature, note that a |let| -inside of a |do| can take multiple definitions, as implied by the -name |decllist|.} - -As mentioned earlier, because you already understand Haskell IO, you -should have a fair amount of intuition about what the monadic -operators do. Unfortuantely, we cannot look very closely at the -instance of |Monad| for the type |IO|, since it ultimately relies on -the state of the underlying operating system, which we do not have -direct access to other than through primitive operations that -communicate with it. Even then, these operations vary from system to -system. - -Nevertheless, a proper implementation of IO in Haskell is obliged to -obey the following \emph{\indexwd{monad laws}}: -\begin{spec} -return a >>= k = k a -m >>= return = m -m >>= (\x -> k x >>= h) = (m >>= k) >>= h -\end{spec} -The first of these laws expresses the fact that |return| simply -``sends'' its value to the next action. Likewise, the second law says -that if we immediately return the result of an action, we might as -well just let the action return the value itself. The third law is -the most complex, and essentially expresses an \emph{associativity} -property for the bind operator |(>>=)|. A special case of this -law applies to the sequence operator |(>>)|: -\begin{spec} -m1 >> (m2 >> m3) = (m1 >> m2) >> m3 -\end{spec} -in which case the associativity is more obvious. - -There is one other monad law, whose purpose is to connect the -|Monad| class to the |Functor| class, and therefore only applies -to types that are instances of both: -\begin{spec} -fmap f xs = xs >>= return . f -\end{spec} -We will see an example of this shortly. - -Of course, this law can also be expressed in |do| notation: -\begin{spec} -fmap f xs = do x <- xs ; return (f x) -\end{spec} -as can the previous ones for |do|: -\begin{spec} -do x <- return a ; k x = k a -do x <- m ; return x = m -do x <- m ; y <- k x ; h y = do y <- (do x <- m ; k x) ; h y -do m1 ; m2 ; m3 = do (do m1 ; m2) ; m3 -\end{spec} -So something like this: -\begin{spec} -do k <- getKey w - return k -\end{spec} -is equivalent to just |getKey w|, according to the second law above. -As a final example, the third law above allows us to transform this: -\begin{spec} -do k <- getKey w - n <- changeKey k - respond n -\end{spec} -into this: -\begin{spec} -let keyStuff = do k <- getKey w - changeKey k -in do n <- keyStuff - respond n -\end{spec} - -\vspace{.1in}\hrule - -\begin{exercise}{\em -Verify the associativity law for |(>>)|, starting with the -associativity law for |(>>=)|.} -\end{exercise} - -\vspace{.1in}\hrule - -\subsection{Other Instances of Monad} -\label{monad-instances} - -\paragraph*{|Maybe|} -\indexhs{Maybe} - -In addition to |IO|, the Standard Prelude's |Maybe| data type is -a predefined instance of |Monad|: -\begin{spec} -instance Monad Maybe where - Just x >>= k = k x - Nothing >>= k = Nothing - return = Just - fail s = Nothing -\end{spec} -\syn{|Maybe| is also a predefined instance of |Functor|: -\begin{spec} -instance Functor Maybe where - fmap f Nothing = Nothing - fmap f (Just x) = Just (f x) -\end{spec} -} - -When used with this instance, the types of the monad operators are: -\begin{spec} -(>>=) :: Maybe a -> (a -> Maybe b) -> Maybe b -return :: a -> Maybe a -\end{spec} -We leave as an exercise the task of proving that this instance is -law-abiding. - -To see how this might be used, consider a computation involving -functions |f :: Int -> Int|, |g :: Int -> Int|, and -|x :: Int|: -\begin{spec} -g (f x) -\end{spec} -Now suppose that each of the calculations using |f| and |g| -could in fact be erroneous, and thus the results are encoded using the -|Maybe| data type. Unfortunately this can become rather tedious to -program, since each result that might be an error must be checked -manually, as in: -\begin{spec} -case (f x) of - Nothing -> Nothing - Just y -> case (g y) of - Nothing -> Nothing - Just z -> z -\end{spec} -Alternatively, we could take advantage of |Maybe|'s membership in -the |Monad| class, and convert this into monadic form: -\begin{spec} -f x >>= \y -> -g y >>= \z -> -return z -\end{spec} -Or, using the more familiar |do| notation: -\begin{spec} -do y <- f x - z <- g y - return z -\end{spec} -Thus the tedium of the error check is ``hidden'' within the monad. In -this sense monads are a good example of the abstraction principle in -action (pardon the pun)! - -It is also worth noting the following simplification: -\begin{spec} -f x >>= \y -> -g y >>= \z -> -return z -==> { currying simplification } -f x >>= \y -> -g y >>= return -==> { monad law for return } -f x >>= \y -> -g y -==> { currying simplification } -f x >>= g -\end{spec} -So we started with |g (f x)| and ended with |f x >>= g|; this is -not too bad considering the alternative that we started with! - -For an even more pleasing result, we can define a monadic composition -operator: -\indexhs{composeM} -\begin{spec} -composeM :: Monad m => (b -> m c) -> (a -> m b) -> (a -> m c) -(g `composeM` f) x = f x >>= g -\end{spec} -in which case we started with |(g . f) x| and ended with -|(g `composeM` f) x|. - -\syn{Note the type of |composeM|. It demonstrates that -higher-order type constructors are also useful in type signatures.} - -%% \vspace{.1in}\hrule - -%% \begin{exercise}{\em -%% Recall in Section \ref{sec:picture-interaction} the use of the -%% |Maybe| data type in the function |adjust|. Rewrite this -%% function using monadic operations.} -%% \end{exercise} - -%% \vspace{.1in}\hrule - -\paragraph*{Lists} - -The list data type in Haskell is also a predefined instance of class -|Monad|: -\begin{spec} -instance Monad [] where - m >>= k = concat (map k m) - return x = [x] - fail x = [ ] -\end{spec} -\syn{Recall that |concat| takes a list of lists and concatenates them - all together. It is defined in the Standard Prelude as: -\begin{spec} -concat :: [[a]] -> [a] -concat xss = foldr (++) [] xss -\end{spec} -} - -The types of the monadic operators in this case are: -\begin{spec} -(>>=) :: [a] -> (b -> [b]) -> [b] -return :: a -> [a] -\end{spec} -The monadic functions in this context can be thought of as dealing -with ``multiple values.'' Monadic binding takes a set (list) of -values and applies a function to each of them, collecting all -generated values together. The |return| function creates a -singleton list, and |fail| an empty one. For example, -\begin{spec} -do x <- [1,2,3] - y <- [4,5,6] - return (x,y) -\end{spec} -returns the list: -\begin{spec} -[(1,4),(1,5),(1,6),(2,4),(2,5),(2,6),(3,4),(3,5),(3,6)] -\end{spec} -which happens to be the same list generated by: -\begin{spec} -[(x,y) | x <- [1,2,3], y <- [4,5,6]] -\end{spec} -\index{list comprehension} -So list comprehension syntax is in essence another kind of monad -syntax; indeed, they are not very different! (However, list -comprehensions can only be used with lists.) - -% The existence of list comprehensions in Haskell is why the list data -% type is not predefined as an instance of |Monad|. - -Note that if: -\begin{spec} -do x <- xs ; return (f x) -\end{spec} -is equivalent to: -\begin{spec} -[ f x | x <- xs ] -\end{spec} -(which is clearly just |map f xs|), then at least for the instance of -lists in |Monad|, the last monad law makes perfect sense: -\begin{spec} -fmap f xs = do x <- xs ; return (f x) -\end{spec} -Also note that the |Maybe| data type in monadic form behaves as a -sort of truncated list in monadic form: |Nothing| is the same as -|[]| and |Just x| is the same as |[x]|.) - -\vspace{.1in}\hrule - -\begin{exercise}{\em -Verify that all of the instance declarations in this section are -law-abiding.} -\end{exercise} - -\begin{exercise}{\em -Consider the \emph{identity data type} defined by: -\begin{spec} -data Id a = Id a -\end{spec} -Create an instance of |Monad| for |Id|, and prove that it is -law-abiding.} -\end{exercise} - -\vspace{.1in}\hrule - -\subsection{Other Monadic Operations} -\label{sec:other-monadic-ops} - -The Standard Prelude has several functions specifically designed for -use with monads; they are shown in Figure \ref{fig:monad-utilities}. -Indeed, one of these we have already used: |sequence_|. Any -mystery about how it works should be gone now; it is a very simple -fold of the sequencing operator |(>>)|, with |return ()| at the -end. Note also the definition of |sequence|, a generalization of -|sequence_| that returns a list of values of the intermediate -results. -\indexhs{sequence} -\indexhs{sequence\_} -\indexhs{mapM} -\indexhs{mapM\_} -\indexhs{(=<<)} - -Finally, recall from Section \ref{sec:actions-are-value} that |putStr| -can be defined as: -\begin{spec} -putStr :: String -> IO () -putStr s = sequence_ (map putChar s) -\end{spec} -Using |mapM_| from Figure \ref{fig:monad-utilities}, this can be -rewritten as: - -\indexhs{putStr} -\begin{spec} -putStr :: String -> IO () -putStr s = mapM_ putChar s -\end{spec} - -\begin{figure} -\cbox{ -\begin{spec} -sequence :: Monad m => [m a] -> m [a] -sequence = foldr mcons (return []) - where mcons p q = do x <- p - xs <- q - return (x:xs) - -sequence_ :: Monad m => [m a] -> m () -sequence_ = foldr (>>) (return ()) - -mapM :: Monad m => (a -> m b) -> [a] -> m [b] -mapM f as = sequence (map f as) - -mapM_ :: Monad m => (a -> m b) -> [a] -> m () -mapM_ f as = sequence_ (map f as) - -(=<<) :: Monad m => (a -> m b) -> m a -> m b -f =<< x = x >>= f -\end{spec}} -\caption{Monadic Utility Functions} -\label{fig:monad-utilities} -\end{figure} - -\section{The MonadPlus Class} -\label{sec:monad-plus} - -The class |MonadPlus|, defined in the Standard Library -|Control.Monad|, is used for monads that have a \emph{zero element} -and a \emph{plus operator}: \indexhs{mzero} \indexhs{mplus} -\begin{spec} -class Monad m => MonadPlus m where - mzero :: m a - mplus :: m a -> m a -> m a -\end{spec} -The zero element should obey the following laws: -\begin{spec} -m >>= (\x -> mzero) = mzero -mzero >>= m = mzero -\end{spec} -and the plus operator should obey these: -\begin{spec} -m `mplus` mzero = m -mzero `mplus` m = m -\end{spec} -By analogy to arithmetic, think of |mzero| as 0, |mplus| as -addition, and |(>>=)| as multiplication. The above laws should -then make more sense. - -For the |Maybe| data type, the zero and plus values are: -\begin{spec} -instance MonadPlus Maybe where - mzero = Nothing - Nothing `mplus` ys = ys - xs `mplus` ys = xs -\end{spec} -and for lists they are: -\begin{spec} -instance MonadPlus [] where - mzero = [] - mplus = (++) -\end{spec} -So you can see now that the familiar concatentation operation -|(++)| that we have been using all along for lists is just a -special case of the |mplus| operator. - -It is worth pointing out that the IO monad is not an instance of the -|MonadPlus| class, since it has no zero element. For if it did -have a zero element, then the IO action |putStr "Hello" >> zero| -should \emph{not} print the string |"Hello"|, according to the first -zero law above. But this is counter-intuitive, or at least is -certainly not what the designers of Haskell had in mind for IO. - -The |Monad| module in the Standard Library also includes several -other useful functions defined in terms of the monadic primitives. -You are encouraged to read these for possible use in your own -programs. - -\vspace{.1in}\hrule - -\begin{exercise}{\em -Verify that the instances of |MonadPlus| for the |Maybe| and -list data types are law-abiding.} -\end{exercise} - -\vspace{.1in}\hrule - -\section{State Monads} -\label{sec:state-monads} -\index{state monad} - -Monads are commonly used to simulate stateful, or imperative, -computations, in which the details of updating and passing around the -state are hidden within the mechanics of the monad. Generally -speaking, a \emph{state monad} has a type of the form: -\begin{spec} -data SM s a = SM (s -> (s,a)) -\end{spec} -where |s| is the state type, and |a| is the value type. The instance -of this type in |Monad| is given by: -\begin{spec} -instance Monad (SM s) where - return a - = SM $ \s0 -> (s0,a) - SM sm0 >>= fsm1 - = SM $ \s0 -> - let (s1,a1) = sm0 s0 - SM sm1 = fsm1 a1 - (s2,a2) = sm1 s1 - in (s2,a2) -\end{spec} -The last equation in the |let| expression could obviously be -eliminated, but it is written this way to stress the symmetry in the -treatment of the two commands. - -\syn{Note that |SM| is a type constructor that takes \emph{two} type - arguments. Applyiing it to one argument (as in |SM s| above) is a - kind of type-level currying, yielding a new type constructor that - takes one argument, as required by the |Monad| class.} - -A good example of a state monad, at least abstractly speaking, is -Haskell's |IO| type, where the state |s| can be thought of as the -``state of the world,'' such as the contents of the file system, the -image on a display, and the output of a printer. - -But what about creating our own state monad? As a simple example, -consider this definition of a |Tree| data type: -\begin{spec} -data Tree a = Leaf a | Branch (Tree a) (Tree a) - deriving Show -\end{spec} -Suppose now we wish to define a function |label :: Tree a -> Tree -Int| such that, for example, the value |test|: -\begin{spec} -test = let t = Branch (Leaf 'a') (Leaf 'b') - in label (Branch t t) -\end{spec} -evaluates to: -\begin{spec} -Branch (Branch (Leaf 0) (Leaf 1)) - (Branch (Leaf 2) (Leaf 3)) -\end{spec} -Without knowing anything about monads, this job is relatively easy: -\begin{spec} -label :: Tree a -> Tree Int -label t = snd (lab t 0) - -lab :: Tree a -> Int -> (Int, Tree Int) -lab (Leaf a) n - = (n+1, Leaf n) -lab (Branch t1 t2) n - = let (n1,t'1) = lab t1 n - (n2,t'2) = lab t2 n1 - in (n2, Branch t'1 t'2) -\end{spec} -Although simple, there is an undeniable tedium in ``threading'' the -value of |n| from one call to |lab| to the next. To solve this -problem, note that |lab t| has type |Int -> (Int, Tree Int)|, which is -in the right form for a state monad. Of course, we need a true data -type, and so we write: -\begin{spec} -newtype Label a = Label (Int -> (Int,a)) -\end{spec} - -\syn{A |newtype| declaration behaves just like a |data| declaration, - except that only one constructor is allowed on the right-hand side. - This allows the compiler to implement the datatype more efficiently, - since it ``knows'' that only one possibility exists. It is also - more type-safe than a type synonym, since, like |data|, it generates - a new type, rather than being a synonym for an existing type.} - -The |Monad| instance for |Label| is just like that for |SM| above: -\begin{spec} -instance Monad Label where - return a - = Label $ \s -> (s,a) - Label lt0 >>= flt1 - = Label $ \s0 -> - let (s1,a1) = lt0 s0 - Label lt1 = flt1 a1 - in lt1 s1 -\end{spec} - -Whereas the monad handles the threading of the state, we also need a -way to extract information from the state, as needed in a particular -application. In the case of labeling trees, we need to know what the -current value of the state (an |Int|) is, at each point that we -encounter a leaf. So we define: -\begin{spec} -getLabel :: Label Int -getLabel = Label $ \n -> (n+1,n) -\end{spec} % $ - -Now we can write the following monadic version of the labeling -function: -\begin{spec} -mlabel :: Tree a -> Tree Int -mlabel t = let Label lt = mlab t - in snd (lt 0) - -mlab :: Tree a -> Label (Tree Int) -mlab (Leaf a) - = do n <- getLabel - return (Leaf n) -mlab (Branch t1 t2) - = do t'1 <- mlab t1 - t'2 <- mlab t2 - return (Branch t'1 t'2) -\end{spec} -Note that the threading of the state has been completely eliminated -from |mlab|, as has the incrementing of the state, which has been -isolated in the function |getLabel|. - -As an example, this test case: -\begin{spec} -mtest = let t = Branch (Leaf 'a') (Leaf 'b') - in mlabel (Branch t t) -\end{spec} -generates the same result as the non-monadic version above. - -For this simple example you may decide that eliminating the threading -of state is not worth it. Indeed, in reality it has just been moved -from the definition of |lab| to the method declaration for |(>>=)|, -and the new version of the program is certainly longer than the old! -But the capture of repetitious code into one function is the whole -point of the abstraction principle, and hopefully you can imagine a -context where threading of state happens often, perhaps hundreds of -times, in which case the abstraction will surely pay off. IO is one -example of this (imagine threading the state of the world on every IO -command). - -\vspace{.1in}\hrule - -\begin{exercise}{\em -Recall the definition of |replFun| in Chapter~\ref{lsystems}, -Section~\ref{sec:musical-lsystem}. Note how it threads the random -number source through the program. Rewrite this function using a -state monad so that this threading is eliminated. } -\end{exercise} - -\vspace{.1in}\hrule - -\section{Type Class Type Errors} -\label{sec:class-reasoning} - -As you know, Haskell's type system detects ill-typed expressions. But -what about errors due to malformed types? The value |(+) 1 2 3| -results in a type error since |(+)| takes only two arguments. -Similarly, the type |Tree Int Int| should result in some sort of an -error since the |Tree| type constructor takes only a single argument. -So, how does Haskell detect malformed types? The answer is a second -type system which ensures the correctness of types! That is, each -type is assigned its own type---which is called its \emph{kind}---and -these \indexwd{kinds} are used to ensure that the type is used -correctly. - -There are only two kinds that we need to consider: -\begin{itemize} -\item The symbol $\ast$ represents the kind of type associated with -concrete data objects. That is, if the value |v| has type |t|, -then the kind of |t| must be $\ast$. - -\item If $\kappa_1$ and $\kappa_2$ are kinds, then -$\kappa_1\rightarrow\kappa_2$ is the kind of types that take a type of -kind $\kappa_1$ and return a type of kind $\kappa_2$. -\end{itemize} -The details of how kinds are used to detect malformed types are beyond -the scope of this text, but it is helpful to walk through a familiar -example: - -|Int| has kind $\ast$, as does the type |Tree Int|. The type -constructor |Tree|, however, has kind $\ast\rightarrow\ast$. -Instances of the |Functor| class must all have the kind -$\ast\rightarrow\ast$. Thus a kind error would result from a -declaration such as: -\begin{spec} -instance Functor Int where ... -\end{spec} -or -\begin{spec} -instance Functor (Tree Int) where ... -\end{spec} -Kinds do not appear directly in Haskell programs; the Haskell system -infers them without any need for ``kind declarations.'' Kinds stay in -the background of a Haskell program except when a kind error occurs, -in which case an error message may refer to the kind conflict. -Fortunately, kinds are simple enough that your Haskell system should -be able to provide descriptive error messages in most cases. diff --git a/HSoM/MoreMusic.lhs b/HSoM/MoreMusic.lhs deleted file mode 100644 --- a/HSoM/MoreMusic.lhs +++ /dev/null @@ -1,1260 +0,0 @@ -%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- - -%include lhs2TeX.fmt -%include myFormat.fmt - -\out{ -\begin{code} --- This code was automatically generated by lhs2tex --code, from the file --- HSoM/MoreMusic.lhs. (See HSoM/MakeCode.bat.) - -\end{code} -} - -\chapter{More Music} -\label{ch:more-music} - -\begin{code} -module Euterpea.Music.Note.MoreMusic where -import Euterpea.Music.Note.Music -\end{code} - -This chapter explores a number of simple musical ideas, and -contributes to a growing collection of Euterpea functions for -expressing those ideas. - -%% \section{Lines and Chords} -%% -%% Two common ideas in music are the construction of notes in a -%% horizontal fashion (a \emph{line} or \emph{melody}), and in a vertical -%% fashion (a \emph{chord}): -%% \begin{code} -%% line, chord :: [Music a] -> Music a -%% line = foldr1 (:+:) -%% chord = foldr1 (:=:) -%% \end{code} -%% From the notes in the C major triad in register 4, I can now construct -%% a C major arpeggio and chord as well: -%% \begin{code} -%% cMaj = [ n 4 qn [] | n <- [c,e,g] ] -- octave 4, quarter notes - -%% cMajArp = line cMaj -%% cMajChd = chord cMaj -%% \end{code} - -\out{ -\begin{code} -line, chord :: [Music a] -> Music a -line = foldr (:+:) (rest 0) -chord = foldr (:=:) (rest 0) - -line1, chord1 :: [Music a] -> Music a -line1 = foldr1 (:+:) -chord1 = foldr1 (:=:) -\end{code} -} - -\section{Delay and Repeat} - -%% Suppose that we wish to describe a melody |m| accompanied by -%% an identical voice a perfect 5th higher. In Euterpea we can simply write -%% |m :=: transpose 7 m|. - -We can delay the start of a music value simply by inserting a rest in -front of it, which can be packaged in a function as follows: -\begin{code} -delayM :: Dur -> Music a -> Music a -delayM d m = rest d :+: m -\end{code} -With |delayM| it is easy to write canon-like structures such as |m :=: -delayM d m|, a song written in rounds (see Exercise -\ref{ex:frere-jacques}), and so on. - -Recall from Chapter \ref{ch:interlude} the function |timesM| that -repeats a musical phrase a certain number of times: -\begin{code} - -timesM :: Int -> Music a -> Music a -timesM 0 m = rest 0 -timesM n m = m :+: timesM (n-1) m -\end{code} - -More interestingly, Haskell's non-strict semantics allows us to -define \emph{infinite} musical values. For example, a musical value -may be repeated \emph{ad nauseam} using this simple function: - -\pagebreak - -\begin{code} - -repeatM :: Music a -> Music a -repeatM m = m :+: repeatM m -\end{code} -Thus, for example, an infinite ostinato can be expressed in this way, -and then used in different contexts that automatically extract only -the portion that is actually needed. Functions that create such -contexts will be described shortly. - -\section{Inversion and Retrograde} - -The notions of inversion, retrograde, retrograde inversion, etc.\ as -used in twelve-tone theory are also easily captured in Euterpea. -These terms are usually applied only to a ``line'' of notes, i.e.\ a -melody (in twelve-tone theory it is called a ``row''). The -\emph{retrograde} of a line is simply its reverse---i.e.\ the notes -played in the reverse order. The \emph{inversion} of a line is with -respect to a given pitch (by convention usually the first pitch), -where the intervals between successive pitches are inverted, -i.e.\ negated. If the absolute pitch of the first note is |ap|, then -each pitch |p| is converted into an absolute pitch |ap - (absPitch p - -ap)|, in other words |2*ap - absPitch p|. - -To do all this in Haskell, a transformation from a line created by -|line| to a list is defined: -\begin{code} -lineToList :: Music a -> [Music a] -lineToList (Prim (Rest 0)) = [] -lineToList (n :+: ns) = n : lineToList ns -lineToList _ = - error "lineToList: argument not created by function line" -\end{code} - -Using this function it is then straightforward to define |invert|: -\begin{code} -invert :: Music Pitch -> Music Pitch -invert m = - let l@(Prim (Note _ r) : _) = lineToList m - inv (Prim (Note d p)) = - note d (pitch (2 * absPitch r - absPitch p)) - inv (Prim (Rest d)) = rest d - in line (map inv l) -\end{code} -%% invert m = line (map inv l) -%% where l@(Prim (Note _ r) : _) = lineToList m -%% inv (Prim (Note d p)) = -%% note d (pitch (2 * absPitch r - absPitch p)) -%% inv (Prim (Rest d)) = rest d - -\syn{The pattern |l@(Prim (Note _ r) : _)| is called an \emph{as - pattern}. It behaves just like the pattern |Prim (Note _ r) : _| - but additionally binds |l| to the value of a successful match to - that pattern. |l| can then be used wherever it is in scope, such as - in the last line of the function definition.} - -With |lineToList| and |invert| it is then easy to define the remaining -functions via composition: -\begin{code} -retro, retroInvert, invertRetro :: Music Pitch -> Music Pitch -retro = line . reverse . lineToList -retroInvert = retro . invert -invertRetro = invert . retro -\end{code} - -As an example of these concepts, Figure~\ref{fig:twelve-tone} shows a -simple melody (not a complete twelve-tone row) and four -transformations of it. - -\begin{figure*} -\centerline{ -\epsfysize=1in -\epsfbox{pics/TwelveToneTransformationsCropped.eps} -} -\caption{A Simple Melody and Four Transformations} -\label{fig:twelve-tone} -\end{figure*} - -\vspace{.1in}\hrule - -\begin{exercise}{\em -Show that |retro . retro|, |invert . invert|, and -|retroInvert . invertRetro| are the identity on values created by -|line|. (You may use the lemma that |reverse (reverse l) = l|.)} -\end{exercise} - -\begin{exercise}{\em -Define a function |properRow :: Music Pitch -> Bool| that determines -whether or not its argument is a ``proper'' twelve-tone row, meaning -that: (a) it must have exactly twelve notes, and (b) each unique pitch -class is used exactly once (regardless of the octave). Enharmonically -equivalent pitch classes are \emph{not} considered unique. You may -assume that the |Music Pitch| value is generated by the function -|line|, but note that rests are allowed.} -\end{exercise} - -\begin{exercise}{\em -Define a function |palin :: Music Pitch -> Bool| that determines -whether or not a given line (as generated by the |line| function) is a -palindrome or not. You should ignore rests, and disregard note -durations---the main question is whether or not the melody is a -palindrome.} -\end{exercise} - -\begin{exercise}{\em -Define a function |retroPitches :: Music Pitch -> Music Pitch| that -reverses the pitches in a line, but maintains the durations in the -same order from beginning to end. For example: -\begin{spec} -retroPitches (line [c 4 en, d 4 qn]) -===> (line [d 4 en, c 4 qn]) -\end{spec}} -\end{exercise} - -\vspace{.1in}\hrule - -\begin{figure*} -\centerline{ -\epsfysize=2.0in -\epsfbox{Pics/pr12.eps} -} -\caption{Nested Polyrhythms (top: |pr1|; bottom: |pr2|)} -\label{polyrhythms} -\end{figure*} - -\section{Polyrhythms} - -For some rhythmical ideas, first note that if |m| is a line of three -eighth notes, then |tempo (3/2) m| is a \emph{triplet} of eighth notes -(recall that this idea was used in Chapter \ref{ch:interlude}). In -fact |tempo| can be used to create quite complex rhythmical patterns. -For example, consider the ``nested polyrhythms'' shown in Figure -\ref{polyrhythms}. They can be expressed naturally in Euterpea as -follows (note the use of a |let| clause in |pr2| to capture recurring -phrases): -\begin{code} - -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)) -\end{code} - -\pagebreak - -\begin{code} -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 -\end{code} % $ -\syn{|take n lst| is the first |n| elements of the list |lst|. For - example: -\begin{spec} -take 3 [C,Cs,Df,D,Ds] ===> [C,Cs,Df] -\end{spec} -|repeat x| is the infinite list of the same value |x|. For example: -\begin{spec} -take 3 (repeat 42) ===> [42,42,42] -\end{spec} -} - -To play polyrhythms |pr1| and |pr2| in parallel using middle C -and middle G, respectively, we can write: -\begin{code} - -pr12 :: Music Pitch -pr12 = pr1 (C,4) :=: pr2 (G,4) -\end{code} - -\section{Symbolic Meter Changes} - -We can implement the notion of ``symbolic meter changes'' of the form -``oldnote = newnote'' (quarter note = dotted eighth, for example) by -defining an infix function: -\begin{code} - -(=:=) :: Dur -> Dur -> Music a -> Music a -old =:= new = tempo (new/old) -\end{code} -Of course, using the new function is not much shorter than using -|tempo| directly, but it may have mnemonic value. - -\pagebreak - -\section{Computing Duration} -\label{sec:duration} - -It is often desirable to compute the \emph{duration}, in whole notes, -of a musical value; we can do so as follows: -\begin{code} -dur :: Music a -> Dur -dur (Prim (Note d _)) = d -dur (Prim (Rest d)) = d -dur (m1 :+: m2) = dur m1 + dur m2 -dur (m1 :=: m2) = dur m1 `max` dur m2 -dur (Modify (Tempo r) m) = dur m / r -dur (Modify _ m) = dur m -\end{code} -The duration of a primitive value is obvious. The duration of -|m1 :+: m2| is the sum of the two, and the duration of |m1 :=: m2| is -the maximum of the two. The only tricky case is the duration of a -music value that is modified by the |Tempo| atttribute---in this case -the duration must be scaled appropriately. - -Note that the duration of a music value that is conceptually infinite -in duration will be |bottom|, since |dur| will not terminate. -(Similary, taking the length of an infinite list is |bottom|.) For -example: -\begin{spec} -dur (repeatM (a 4 qn)) -==> dur (a 4 qn :+: repeatM (a 4 qn)) -==> dur (a 4 qn) + dur (repeatM (a 4 qn)) -==> qn + dur (repeatM (a 4 qn)) -==> qn + qn + dur (repeatM (a 4 qn)) -==> ... -==> bottom -\end{spec} - -\section{Super-retrograde} -\label{sec:reverse-music} - -Using |dur| we can define a function |revM| that reverses any |Music| -value whose duration is finite (and is thus considerably more useful -than |retro| defined earlier): - -\pagebreak - -\begin{code} -revM :: Music a -> Music a -revM n@(Prim _) = n -revM (Modify c m) = Modify c (revM m) -revM (m1 :+: m2) = revM m2 :+: revM m1 -revM (m1 :=: m2) = - let d1 = dur m1 - d2 = dur m2 - in if d1>d2 then revM m1 :=: (rest (d1-d2) :+: revM m2) - else (rest (d2-d1) :+: revM m1) :=: revM m2 -\end{code} - -The first three cases are easy, but the last case is a bit tricky. -The parallel constructor |(:=:)| implicitly begins each of its music -values at the same time. But if one is shorter than the other, then, -when reversed, a \emph{rest} must be inserted before the shorter one, -to account for the difference. - -Note that |revM| of a |Music| value whose duration is infinite is -|bottom|. (Analogously, reversing an infinite list is |bottom|.) - -\section{|takeM| and |dropM|} -\label{sec:take-and-drop} - -Two other useful operations on |Music| values is the ability to -``take'' the first so many beats (in whole notes), discarding the -rest, and conversely, the ability to ``drop'' the first so many beats, -returning what is left. We will first define a function |takeM :: Dur --> Music a -> Music a| such that |takeM d m| is a \emph{prefix} of |m| -having duration |d|. In other words, it ``takes'' only the first |d| -beats (in whole notes) of |m|. We can define this function as -follows: -\begin{code} - -takeM :: Dur -> Music a -> Music a -takeM d m | d <= 0 = rest 0 -takeM d (Prim (Note oldD p)) = note (min oldD d) p -takeM d (Prim (Rest oldD)) = rest (min oldD d) -takeM d (m1 :=: m2) = takeM d m1 :=: takeM d m2 -takeM d (m1 :+: m2) = let m'1 = takeM d m1 - m'2 = takeM (d - dur m'1) m2 - in m'1 :+: m'2 -takeM d (Modify (Tempo r) m) = tempo r (takeM (d*r) m) -takeM d (Modify c m) = Modify c (takeM d m) -\end{code} -This definition is fairly straightforward, except for the case of -sequential composition, where two cases arise: (1) if |d| is greater -than |dur m1|, then we return \emph{all} of |m1| (i.e.\ |m'1 = m1|), -followed by |d - dur m'1| beats of |m2|, and (2) if |d| is less than -|dur m1|, then we return |d| beats of |m1| (i.e. |m'1|), followed by -nothing (since |d - dur m'1| will be zero). Note that this strategy -will work even if |m1| or |m2| is infinite. -\out{ -For backward compatibility: -\begin{code} -cut :: Dur -> Music a -> Music a -cut = takeM -\end{code} -} - -Similarly, we can define a function |dropM :: Dur -> Music a -> Music -a| such that |dropM d m| is a \emph{suffix} of |m| where the first |d| -beats (in whole notes) of |m| have been ``dropped:'' -\begin{code} -dropM :: Dur -> Music a -> Music a -dropM d m | d <= 0 = m -dropM d (Prim (Note oldD p)) = note (max (oldD-d) 0) p -dropM d (Prim (Rest oldD)) = rest (max (oldD-d) 0) -dropM d (m1 :=: m2) = dropM d m1 :=: dropM d m2 -dropM d (m1 :+: m2) = let m'1 = dropM d m1 - m'2 = dropM (d - dur m1) m2 - in m'1 :+: m'2 -dropM d (Modify (Tempo r) m) = tempo r (dropM (d*r) m) -dropM d (Modify c m) = Modify c (dropM d m) -\end{code} -This definition is also straightforward, except for the case of -sequential composition. Again, two cases arise: (1) if |d| is greater -than |dur m1|, then we drop |m1| altogether (i.e.\ |m'1| will be |rest -0|), and simply drop |d - dur m1| from |m2|, and (2) if |d| is less -than |dur m1|, then we return |m'1| followed by all of |m2| (since |d -- dur m1| will be negative). This definition too will work for -infinite values of |m1| or |m2|. - -\section{Removing Zeros} -\label{sec:zeros} - -Note that functions such as |timesM|, |line|, |revM|, |takeM| and -|dropM| occasionally insert rests of zero duration, and in the case of -|takeM| and |dropM|, may insert notes of zero duration. Doing this -makes the code simpler and more elegant, and since we cannot hear the -effect of the zero-duration events, the musical result is the same. - -On the other hand, these extraneous notes and rests (which we will -call ``zeros'') can be annoying when viewing the textual (rather than -audible) representation of the result. To alleviate this problem, we -define a function that removes them from a given |Music| value: - -\pagebreak - -\begin{code} -removeZeros :: Music a -> Music a -removeZeros (Prim p) = Prim p -removeZeros (m1 :+: m2) = - let m'1 = removeZeros m1 - m'2 = removeZeros m2 - in case (m'1,m'2) of - (Prim (Note 0 p), m) -> m - (Prim (Rest 0 ), m) -> m - (m, Prim (Note 0 p)) -> m - (m, Prim (Rest 0 )) -> m - (m1, m2) -> m1 :+: m2 -removeZeros (m1 :=: m2) = - let m'1 = removeZeros m1 - m'2 = removeZeros m2 - in case (m'1,m'2) of - (Prim (Note 0 p), m) -> m - (Prim (Rest 0 ), m) -> m - (m, Prim (Note 0 p)) -> m - (m, Prim (Rest 0 )) -> m - (m1, m2) -> m1 :=: m2 -removeZeros (Modify c m) = Modify c (removeZeros m) -\end{code} - -\syn{A |case| expression can only match against one value. To match - against more than one value, we can place them in a tuple of the - appropriate length. In the case above, |removeZeros| matches - against |m'1| and |m'2| by placing them in a pair |(m'1,m'2)|.} - -This function depends on the ``musical axioms'' that if |m1| in either -|m1 :+: m2| or |m1 :=: m2| is a zero, then the latter expressions are -equivalent to just |m2|. Similarly, if |m2| is a zero, they are -equivalent to just |m1|. Although intuitive, a formal proof of these -axioms is deferred until Chapter \ref{ch:algebra}. - -As an example of using |removeZeros|, consider the |Music| value: -\begin{spec} -m = c 4 en :+: repeatM (d 4 en) -\end{spec} - -\pagebreak - -Then note that: -\begin{spec} -takeM hn (dropM hn m) -===> -Prim (Note (0 % 1) (C,4)) :+: (Prim (Note (0 % 1) (D,4)) :+: -(Prim (Note (0 % 1) (D,4)) :+: (Prim (Note (0 % 1) (D,4)) :+: -(Prim (Note (1 % 8) (D,4)) :+: (Prim (Note (1 % 8) (D,4)) :+: -(Prim (Note (1 % 8) (D,4)) :+: (Prim (Note (1 % 8) (D,4)) :+: -Prim (Rest (0 % 1))))))))) -\end{spec} -Note the zero-duration notes and rests. But if we apply |removeZeros| -to the result we get: -\begin{spec} -removeZeros (takeM hn (dropM hn m)) -===> -Prim (Note (1 % 8) (D,4)) :+: (Prim (Note (1 % 8) (D,4)) :+: -(Prim (Note (1 % 8) (D,4)) :+: Prim (Note (1 % 8) (D,4)))) -\end{spec} -Both the zero-duration rests and notes have been removed. - -\section{Truncating Parallel Composition} -\label{sec:truncate} - -The duration of |m1 :=: m2| is the maximum of the durations of |m1| -and |m2| (and thus if one is infinite, so is the result). However, -sometimes it is useful to have the result be of duration equal to the -\emph{shorter} of the two. Defining a function to achieve this is not -as easy as it sounds, since it may require truncating the longer one -in the middle of a note (or notes), and it may be that one (or both) -of the |Music| values is infinite. - -The goal is to define a ``truncating parallel composition'' operator -|(/=:) :: Music a -> Music a -> Music a|. Using |takeM|, we can make -an initial attempt at a suitable definition for |(/=:)| as follows: -\begin{spec} -(/=:) :: Music a -> Music a -> Music a -m1 /=: m2 = takeM (dur m2) m1 :=: takeM (dur m1) m2 -\end{spec} -%% (min (dur m1) (dur m2)) (m1 :=: m2) - -Unfortunately, whereas |takeM| can handle infinite-duration music -values, |(/=:)| cannot. This is because |(/=:)| computes the duration -of both of its arguments, but if one of them, say |m1|, has infinite -duration, then |dur m1 ==> bottom|. If, in a particular context, we -know that only one of the two arguments is infinite, and we know which -one (say |m1|), it is always possible to write: -\begin{spec} -takeM (dur m2) m1 :=: m2 -\end{spec} -But somehow this seems unsatisfactory. - -\subsection{Lazy Evaluation to the Rescue} -\label{sec:lazy-rescue} - -The root of this problem is that |dur| uses a conventional number -type, namely the type |Rational| (which is a ratio of |Integer|s), to -compute with, which does not have a value for infinity (|bottom| is -not the same as infinity!). But what if we were to somehow compute -the duration \emph{lazily}---meaning that we only compute that much of -the duration that is needed to perform some arithmetic result of -interest. In particular, if we have one number |n| that we know is -``at least'' |x|, and another number |m| that is exactly |y|, then if -|x>y|, we know that |n>m|, even if |n|'s actual value is infinity! - -To realize this idea, let's first define a type synonym for ``lazy -durations:'' -\begin{code} -type LazyDur = [Dur] -\end{code} -The intent is that a value |d :: LazyDur| is a non-decreasing list of -durations such that the last element in the list is the actual -duration, and an infinite list implies an infinite duration. - -Now let's define a new verion of |dur| that computes the |LazyDur| of -its argument: -\begin{code} -durL :: Music a -> LazyDur -durL m@(Prim _) = [dur m] -durL (m1 :+: m2) = let d1 = durL m1 - in d1 ++ map (+(last d1)) (durL m2) -durL (m1 :=: m2) = mergeLD (durL m1) (durL m2) -durL (Modify (Tempo r) m) = map (/r) (durL m) -durL (Modify _ m) = durL m -\end{code} -where |mergeLD| merges two |LazyDur| values into one: -\begin{code} -mergeLD :: LazyDur -> LazyDur -> LazyDur -mergeLD [] ld = ld -mergeLD ld [] = ld -mergeLD ld1@(d1:ds1) ld2@(d2:ds2) = - if d1 Dur -> Dur -minL [] d' = d' -minL [d] d' = min d d' -minL (d:ds) d' = if d < d' then minL ds d' else d' -\end{code} -And with |minL| we can then define a new version of |takeM|: -\begin{code} -takeML :: LazyDur -> Music a -> Music a -takeML [] m = rest 0 -takeML (d:ds) m | d <= 0 = takeML ds m -takeML ld (Prim (Note oldD p)) = note (minL ld oldD) p -takeML ld (Prim (Rest oldD)) = rest (minL ld oldD) -takeML ld (m1 :=: m2) = takeML ld m1 :=: takeML ld m2 -takeML ld (m1 :+: m2) = - let m'1 = takeML ld m1 - m'2 = takeML (map (\d -> d - dur m'1) ld) m2 - in m'1 :+: m'2 -takeML ld (Modify (Tempo r) m) = tempo r (takeML (map (*r) ld) m) -takeML ld (Modify c m) = Modify c (takeML ld m) -\end{code} -Compare this definition with that of |takeM|---they are very similar. - -Finally, we can define a correct (meaning it works properly on -infinite |Music| values) version of |(/=:)| as follows: -\begin{code} -(/=:) :: Music a -> Music a -> Music a -m1 /=: m2 = takeML (durL m2) m1 :=: takeML (durL m1) m2 -\end{code} - -Whew! This may seem like a lot of effort, but the new code is -actually not much different from the old, and now we can freely use -|(/=:)| without worrying about which if any of its arguments are -infinite. - -\out{ -A potential generalization of these ideas: - -Let's represent numbers as a non-empty list of monotonically -increasing numbers whose last number is the limit: - -newtype ANum a = ANum [a] - deriving (Eq, Show) - -instance Num a => Num (ANum a) where - ANum xs + ANum ys = ANum (nLift (+) xs ys) ---ANum xs - ANum ys = ANum (nLift (-) xs ys) -- not valid!!! - ANum xs - ANum ys = ANum (nSub xs ys) - ANum xs * ANum ys = ANum (nLift (*) xs ys) - abs (ANum xs) = ANum (map abs xs) - signum (ANum xs) = ANum (map signum xs) - fromInteger x = ANum [fromInteger x] - -nLift op [x] ys = map (x `op`) ys -nLift op xs [y] = map (`op` y) xs -nLift op (x:xs) (y:ys) = (x `op` y) : nLift op xs ys - -nSub [x] ys = map (x-) ys -nSub xs [y] = map (subtract y) xs -nSub (x:xs) (y:ys) = nSub xs ys - -ANum [x] =* ANum [y] = x == y -ANum (x:xs) =* ANum (y:ys) = ANum xs =* ANum ys - -ANum [x] >* ANum (y:ys) = if x<=y then False else ANum [x] >* ANum ys -ANum (x:xs) >* ANum [y] = if x>y then True else ANum xs >* ANum [y] -ANum (x:xs) >* ANum (y:ys) = ANum xs >* ANum ys - -an1 >=* an2 = an1 >* an2 || an1 =* an2 -an1 <* an2 = not (an1 >=* an2) -an1 <=* an2 = not (an1 >* an2) - -The reason that subtraction cannot be handled like addition or -multiplication is that, if one number is at least x and another number -is at least y, we cannot conclude ANYTHING about the difference -between them. - -Here are the merge functions for the parallel short constructor: - -mergeS :: Performance -> Performance -> Performance - -mergeS a@(e1:es1)) b@(e2:es2)) = - if e1 < e2 then foo e1 es1 b - else foo e2 a es2 -merge [] es2 = [] -merge es1 [] = [] - -foo e es1 es2 = - let pf = mergeS es1 es2 - dft = eTime (head pf) - eTime e - d = min (eDur e) (aDur pf + dft) - in e { eDur = d } : pf - - -aDur es = Anum (foo 0 es) - where foo d [] = d - foo d (e:es) = -} - -\vspace{.1in}\hrule - -\begin{exercise}{\em -Try using |(/=:)| with some infinite |Music| values (such as created -by |repeatM|) to assure yourself that it works properly. When using -it with \emph{two} infinite values, it should return an infinite -value, which you can test by applying |takeM| to the result.} -\end{exercise} - -\vspace{.1in}\hrule - -\section{Trills} -\label{sec:trills} - -A \emph{trill} is an ornament that alternates rapidly between two -(usually adjacent) pitches. Two versions of a trill function will be -defined, both of which take the starting note and an interval for the -trill note as arguments (the interval is usually one or two, but can -actually be anything). One version will additionally have an argument -that specifies how long each trill note should be, whereas the other -will have an argument that specifies how many trills should occur. In -both cases the total duration will be the same as the duration of the -original note. - -Here is the first trill function: -\begin{code} -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." -\end{code} -Using this function it is simple to define a version that starts on the -trill note rather than the start note: -\begin{code} -trill' :: Int -> Dur -> Music Pitch -> Music Pitch -trill' i sDur m = trill (negate i) sDur (transpose i m) -\end{code} - -The second way to define a trill is in terms of the number of -subdivided notes to be included in the trill. We can use the first -trill function to define this new one: -\begin{code} -trilln :: Int -> Int -> Music Pitch -> Music Pitch -trilln i nTimes m = trill i (dur m / fromIntegral nTimes) m -\end{code} -This, too, can be made to start on the other note. -\begin{code} -trilln' :: Int -> Int -> Music Pitch -> Music Pitch -trilln' i nTimes m = trilln (negate i) nTimes (transpose i m) -\end{code} - -Finally, a |roll| can be implemented as a trill whose interval is -zero. This feature is particularly useful for percussion. -\begin{code} -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 -\end{code} - -Figure \ref{fig:ssf} shows a nice use of the trill functions in -encoding the opening lines of John Philip Sousa's \emph{Stars and - Stripes Forever}. - -\begin{figure} -\cbox{ -\begin{code} -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 - -\end{code}} -\caption{Trills in \emph{Stars and Stripes Forever}} -\label{fig:ssf} -\end{figure} - -\syn{|ssfMel| uses a |where| clause, which is similar to a |let| - expression, except that the equations appear after the result, - rather than before.} - -\section{Grace Notes} -\label{sec:grace-notes} - -Recall from Chapter \ref{ch:interlude} the function |graceNote| to -generate grace notes. A more general version is defined below, which -takes a |Rational| argument that specifies that fraction of the -principal note's duration to be used for the grace note's duration: -\begin{code} -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" -\end{code} -Thus |grace n r (note d p)| is a |Music| value consisting of two -notes, the first being the grace note whose duration is |r*d| and -whose pitch is |n| semitones higher (or lower if |n| is negative) than -|p|, and the second being the principal note at pitch |p| but now with -duration |(1-r)*d|. - -Note that |grace| places the downbeat of the grace note at the point -written for the principal note. Sometimes the interpretation of a -grace note is such that the downbeat of the principal note is to be -unchanged. In that case, the grace note reduces the duration of the -\emph{previous} note. We can define a function |grace2| that takes -two notes as arguments, and places the grace note appropriately: -\begin{code} -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" -\end{code} - -\vspace{.1in}\hrule -\begin{exercise}{\em -Related to trills and grace notes in Western classical music are the -notions of \emph{mordent}, \emph{turn}, and \emph{appoggiatura}. -Define functions to realize these musical ornamentations.} -\end{exercise} - -\vspace{.1in}\hrule - -\section{Percussion} -\label{sec:percussion} - -Percussion is a difficult notion to represent in the abstract. On one -hand, a percussion instrument is just another instrument, so why -should it be treated differently? On the other hand, even common -practice notation treats it specially, although it has much in common -with non-percussive notation. The MIDI standard is equally ambiguous -about the treatment of percussion: on one hand, percussion sounds are -chosen by specifying an octave and pitch, just like any other -instrument; on the other hand, these pitches have no tonal meaning -whatsoever: they are just a convenient way to select from a large -number of percussion sounds. Indeed, part of the General MIDI -Standard is a set of names for commonly used percussion sounds. - -\begin{figure} -\cbox{\small -\begin{spec} -data PercussionSound = - AcousticBassDrum -- MIDI Key 35 - | BassDrum1 -- MIDI Key 36 - | SideStick -- ... - | AcousticSnare | HandClap | ElectricSnare | LowFloorTom - | ClosedHiHat | HighFloorTom | PedalHiHat | LowTom - | OpenHiHat | LowMidTom | HiMidTom | CrashCymbal1 - | HighTom | RideCymbal1 | ChineseCymbal | RideBell - | Tambourine | SplashCymbal | Cowbell | CrashCymbal2 - | Vibraslap | RideCymbal2 | HiBongo | LowBongo - | MuteHiConga | OpenHiConga | LowConga | HighTimbale - | LowTimbale | HighAgogo | LowAgogo | Cabasa - | Maracas | ShortWhistle | LongWhistle | ShortGuiro - | LongGuiro | Claves | HiWoodBlock | LowWoodBlock - | MuteCuica | OpenCuica | MuteTriangle - | OpenTriangle -- MIDI Key 82 -\end{spec}} -\caption{General MIDI Percussion Names} -\label{fig:percussion} -\end{figure} -\out{ -\begin{code} -data PercussionSound = - AcousticBassDrum -- MIDI Key 35 - | BassDrum1 -- MIDI Key 36 - | SideStick -- ... - | AcousticSnare | HandClap | ElectricSnare | LowFloorTom - | ClosedHiHat | HighFloorTom | PedalHiHat | LowTom - | OpenHiHat | LowMidTom | HiMidTom | CrashCymbal1 - | HighTom | RideCymbal1 | ChineseCymbal | RideBell - | Tambourine | SplashCymbal | Cowbell | CrashCymbal2 - | Vibraslap | RideCymbal2 | HiBongo | LowBongo - | MuteHiConga | OpenHiConga | LowConga | HighTimbale - | LowTimbale | HighAgogo | LowAgogo | Cabasa - | Maracas | ShortWhistle | LongWhistle | ShortGuiro - | LongGuiro | Claves | HiWoodBlock | LowWoodBlock - | MuteCuica | OpenCuica | MuteTriangle - | OpenTriangle -- MIDI Key 82 - deriving (Show,Eq,Ord,Enum) -\end{code} -} - -Since MIDI is such a popular platform, it is worth defining some handy -functions for using the General MIDI Standard. In Figure -\ref{fig:percussion} a data type is defined that borrows its -constructor names from the General MIDI standard. The comments -reflecting the ``MIDI Key'' numbers will be explained later, but -basically a MIDI Key is the equivalent of an absolute pitch in -Euterpea terminology. So all that remains to be done is a way to -convert these percussion sound names into a |Music| value; i.e.\ a -|Note|: -\begin{code} - -perc :: PercussionSound -> Dur -> Music Pitch -perc ps dur = note dur (pitch (fromEnum ps + 35)) -\end{code} - -\syn{|fromEnum| is an operator in the |Enum| class, which is all about - enumerations, and will be discussed in more detail in - Chapter~\ref{ch:qualified-types}. A data type that is a member of - this class can be \emph{enumerated}---i.e.\ the elements of the data - type can be listed in order. |fromEnum| maps each value to its - index in this enumeration. Thus |fromEnum AcousticBassDrum| is 0, - |fromEnum BassDrum1| is 1, and so on.} - -If a |Music| value returned from |perc| is played using a piano sound, -then you will get a piano sound. But if you specify the instrument -|Percussion|, MIDI knows to play the apppropriate |PercussionSound|. - -Recall the |InstrumentName| data type from Chapter~\ref{ch:music}. -If a |Music| value returned from |perc| is played using, say, the -|AcousticGrandPiano| instrument, then you will hear an acounstic grand -piano sound at the appropriate pitch. But if you specify the -|Percussion| instrument, then you will hear the percussion sound that -was specified as an argument to |perc|. - -For example, here are eight bars of a simple rock or ``funk groove'' -that uses |perc| and |roll|: -\begin{code} -funkGroove :: Music Pitch -funkGroove - = let p1 = perc LowTom qn - p2 = perc AcousticSnare en - in tempo 3 $ instrument Percussion $ takeM 8 $ repeatM - ( ( p1 :+: qnr :+: p2 :+: qnr :+: p2 :+: - p1 :+: p1 :+: qnr :+: p2 :+: enr) - :=: roll en (perc ClosedHiHat 2) ) -\end{code} % $ - -\out{ We can go one step further by defining a ``percussion - datatype:'' -\begin{spec} - data Percussion = Perc Dur [NoteAttribute] -- percussion - | Pause Dur -- rest - | Roll Dur Dur [NoteAttribute] -- roll w/duration - | Rolln Int Dur [NoteAttribute] -- roll w/number of strokes -\end{spec} -whose interpretation is given by: -\begin{spec} - percLine :: PercussionSound -> [Percussion] -> Music a - percLine dsnd l = Instr "Drums" (foldr (dlAux dsnd) (Rest 0) l) where - dlAux dsnd (N dur na) = perc dsnd dur na :+: xs - dlAux dsnd (R dur) = Rest dur :+: xs - dlAux dsnd (Roll sDur dur na) = roll sDur (perc dsnd dur na) :+: xs - dlAux dsnd (Rolln nTimes dur na) = rolln nTimes (perc dsnd dur na) - :+: dlAux dsnd xs -\end{spec} -} - -\vspace{.1in}\hrule - -\begin{exercise}{\em -Write a program that generates all of the General MIDI percussion -sounds, playing through each of them one at a time.} -\end{exercise} - -\begin{exercise}{\em -Find a drum beat that you like, and express it in Euterpea. Then use -|repeatM|, |takeM|, and |(:=:)| to add a simple melody to it.} -\end{exercise} - -\vspace{.1in}\hrule - -\section{A Map for Music} -\label{sec:music-map} - -Recall from Chapter \ref{ch:poly} the definition of |map|: -\begin{spec} -map :: (a -> b) -> [a] -> [b] -map f [] = [] -map f (x:xs) = f x : map f xs -\end{spec} -This function is defined on the list data type. Is there something -analogous for |Music|? I.e.\ a function:\footnote{The name |mapM| - would perhaps have been a better choice here, to be consistent with - previous names. However, |mapM| is a predefined function in Haskell, - and thus |mMap| is used instead. Similarly, Haskell's |Monad| - library defines a function |foldM|, and thus in the next section - the name |mFold| is used instead.} -\begin{spec} -mMap :: (a -> b) -> Music a -> Music b -\end{spec} -Such a function is indeed straightforward to define, but it helps to -first define a map-like function for the |Primitive| type: -\begin{code} - -pMap :: (a -> b) -> Primitive a -> Primitive b -pMap f (Note d x) = Note d (f x) -pMap f (Rest d) = Rest d -\end{code} -With |pMap| in hand we can now define |mMap|: -\begin{code} -mMap :: (a -> b) -> Music a -> Music b -mMap f (Prim p) = Prim (pMap f p) -mMap f (m1 :+: m2) = mMap f m1 :+: mMap f m2 -mMap f (m1 :=: m2) = mMap f m1 :=: mMap f m2 -mMap f (Modify c m) = Modify c (mMap f m) -\end{code} -Just as |map f xs| for lists replaces each polymorphic element |x| in -|xs| with |f x|, |mMap f m| for |Music| replaces each polymorphic -element |p| in |m| with |f p|. - -As an example of how |mMap| can be used, let's introduces a |Volume| -type for a note: -\begin{code} -type Volume = Int -\end{code} -The goal is to convert a value of type |Music Pitch| into a value of -type |Music (Pitch,Volume)|---that is, to pair each pitch with a -volume attribute. We can define a function to do so as follows: -\begin{code} -addVolume :: Volume -> Music Pitch -> Music (Pitch,Volume) -addVolume v = mMap (\p -> (p,v)) -\end{code} -For MIDI, the variable |v| can range from 0 (softest) to 127 (loudest). - -For example, compare the loudness of these two phrases: -\begin{spec} -m1, m2 :: Music (Pitch,Volume) -m1 = addVolume 100 (c 4 qn :+: d 4 qn :+: e 4 qn :+: c 4 qn) -m2 = addVolume 30 (c 4 qn :+: d 4 qn :+: e 4 qn :+: c 4 qn) -\end{spec} -using the |play| function. (Recall from Section~\ref{auxiliaries} -that the type of the argument to |play| must be made clear, as is done -here with the type signature.) - -%% Currently the |play| function in Euterpea does not know how to play a -%% value of type |Music (Pitch,Volume)|, but it does know how to play a -%% value of type |Music (Pitch, [NoteAttribute])|. The |NoteAtttribute| -%% data type is not defined until Chapter~\ref{ch:performance}, but for -%% now it suffices to know that one of its constructors is |Volume|, and -%% thus we can define a function -%% \begin{code} -%% addVol :: Volume -> Music Pitch -> Music (Pitch, [NoteAttribute]) -%% addVol v = mMap (\p -> (p, [Volume v])) -%% \end{code} -%% So if you wish to hear the effect of adding volume to a |Music| value, -%% use |addVol|, not |addVolume|.) - -\syn{Note that the name |Volume| is used both as a type synonym and as - a constructor---Haskell allows this, since they can always be - distinguished by context.} - -\out{ -\begin{code} -data NoteAttribute = - Volume Int -- MIDI convention: 0=min, 127=max - | Fingering Integer - | Dynamics String - | Params [Double] - deriving (Eq, Show) -\end{code} -} - -\vspace{.1in}\hrule - -\begin{exercise}{\em -Using |mMap|, define a function: -\begin{spec} -scaleVolume :: Rational -> Music (Pitch,Volume) - -> Music (Pitch,Volume) -\end{spec} -such that |scaleVolume s m| scales the volume of each note in |m| by -the factor |s|. - -(This problem requires multiplying a |Rational| number by an |Int| -(i.e.\ |Volume|). To do this, some coercions between number types are -needed, which in Haskell is done using \emph{qualified types}, which -are discussed in Chapter~\ref{ch:qualified-types}. For now, you can -simply do the following: If |v| is the volume of a note, then -|round (s * fromIntegral v)| is the desired scaled volume.)} -\end{exercise} - -\vspace{.1in}\hrule - -\pagebreak - -\section{A Fold for Music} -\label{sec:music-fold} - -We can also define a fold-like operator for |Music|. But whereas the -list data type has only two constructors (the nullary constructor |[]| -and the binary constructor |(:)|), |Music| has \emph{four} -constructors (|Prim|, (:+:), (:=:), and |Modify|). Thus the following -function takes four arguments in addition to the |Music| value it is -transforming, instead of two: -\begin{code} -mFold :: (Primitive a -> b) -> (b->b->b) -> (b->b->b) -> - (Control -> b -> b) -> Music a -> b -mFold f (+:) (=:) g m = - let rec = mFold f (+:) (=:) g - in case m of - Prim p -> f p - m1 :+: m2 -> rec m1 +: rec m2 - m1 :=: m2 -> rec m1 =: rec m2 - Modify c m -> g c (rec m) -\end{code} -This somewhat unwieldy function basically takes apart a |Music| value -and puts it back together with different constructors. Indeed, note -that: -\begin{spec} -mFold Prim (:+:) (:=:) Modify m == m -\end{spec} -Although intuitive, proving this property requires induction, a proof -technique discussed in Chapter \ref{ch:induction}. - -To see how |mFold| might be used, note first of all that it is more -general than |mMap|---indeed, |mMap| can be defined in terms of -|mFold| like this: -\begin{spec} -mMap :: (a -> b) -> Music a -> Music b -mMap f = mFold g (:+:) (:=:) Modify where - g (Note d x) = note d (f x) - g (Rest d) = rest d -\end{spec} - -More interestingly, we can use |mFold| to more succinctly define -functions such as |dur| from Section \ref{sec:duration}: -\begin{spec} -dur :: Music a -> Dur -dur = mFold getDur (+) max modDur where - getDur (Note d _) = d - getDur (Rest d) = d - modDur (Tempo r) d = d/r - modDur _ d = d -\end{spec} - -\vspace{.1in}\hrule - -\begin{exercise}{\em -Redefine |revM| from Section \ref{sec:reverse-music} using |mFold|.} -\end{exercise} - -\begin{exercise}{\em -Define a function |insideOut| that inverts the role of serial and -parallel composition in a |Music| value. Using |insideOut|, see if -you can (a) find a non-trivial value |m :: Music Pitch| such that |m| -is ``musically equivalent'' to (i.e. sounds the same as) |insideOut m| -and (b) find a value |m :: Music Pitch| such that |m :+: insideOut m -:+: m| sounds interesting. (You are free to define what ``sounds -interesting'' means.)} -\end{exercise} - -\vspace{.1in}\hrule - -\section{Crazy Recursion} - -With all the functions and data types that have been defined, and the -power of recursion and higher-order functions well understood, we can -start to do some wild and crazy things with music. Here is just one -such idea. - -The goal is to define a function to recursively apply transformations -|f| (to elements in a sequence) and |g| (to accumulated phrases) some -specified number of times: -\begin{code} -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)) -\end{code} -With this simple function we can create some interesting phrases of -music with very little code. For example, |rep| can be used three -times, nested together, to create a ``cascade'' of sounds: - -\out{ -\begin{code} -run, cascade, cascades, final :: Music Pitch -run', cascade', cascades', final' :: Music Pitch -\end{code} -} -\begin{code} -run = rep (transpose 5) (delayM tn) 8 (c 4 tn) -cascade = rep (transpose 4) (delayM en) 8 run -cascades = rep id (delayM sn) 2 cascade -\end{code} -We can then make the cascade run up, and then down: -\begin{code} -final = cascades :+: revM cascades -\end{code} -What happens if the |f| and |g| arguments are reversed? -\begin{code} -run' = rep (delayM tn) (transpose 5) 8 (c 4 tn) -cascade' = rep (delayM en) (transpose 4) 8 run' -cascades' = rep (delayM sn) id 2 cascade' -final' = cascades' :+: revM cascades' -\end{code} - -\vspace{.1in}\hrule - -\pagebreak - -\begin{exercise}{\em -Consider this sequence of 8 numbers: -\begin{spec} -s1 = [ 1, 5, 3, 6, 5, 0, 1, 1 ] -\end{spec} -We might interpret this as a sequence of pitches, i.e.\ a melody. -Another way to represent this sequence is as a sequence of 7 intervals: -\begin{spec} -s2 = [ 4, -2, 3, -1, -5, 1, 0 ] -\end{spec} -Together with the starting pitch (i.e.\ 1), this sequence of intervals -can be used to reconstruct the original melody. But, with a suitable -transposition to eliminate negative numbers, it can also be viewed as -another melody. Indeed, we can repeat the process: |s2| can be -represented by this sequence of 6 intervals: -\begin{spec} -s3 = [ -6, 5, -4, -4, 6, -1 ] -\end{spec} -Together with the starting number (i.e.\ 4), |s3| can be used to -reconstruct |s2|. Continuing the process: -\begin{spec} -s4 = [ 11, -9, 0, 10, -7 ] -s5 = [ -20, 9, 10, -17 ] -s6 = [ 29, 1, -27 ] -s7 = [ -28, -28 ] -s8 = [ 0 ] -\end{spec} -Now, if we take the first element of each of these sequences to form -this 8-number sequence: -\begin{spec} -ic = [ 0, -28, 29, -20, 11, -6, 4, 1 ] -\end{spec} -then it alone can be used to re-create the original 8-number sequence -in its entirety. Of course, it can also be used as the original -melody was used, and we could derive another 8-note sequence from -it---and so on. The list |ic| will be referred to as the ``interval -closure'' of the original list |s1|. - -Your job is to: -\begin{enumerate}[a)] -\item -Define a function |toIntervals| that takes a list of |n| numbers, and -generates a list of |n| lists, such that the $i^{th}$ list is the sequence -$s_i$ as defined above. - -\item -Define a function |getHeads| that takes a list of |n| lists and -returns a list of |n| numbers such that the $i^{th}$ element is the -head of the $i^{th}$ list. - -\item -Compose the above two functions in a suitable way to define a function -|intervalClosure| that takes an |n|-element list and returns its -interval closure. - -\item -Define a function |intervalClosures| that takes an |n|-element list and -returns an infinite sequence of interval closures. - -\item -Now for the open-ended part of this exercise: Interpret the outputs of -any of the functions above to create some ``interesting'' music. -\end{enumerate} -} -\end{exercise} - -\begin{exercise}{\em -Write a Euterpea program that sounds like an infinitely descending (in -pitch) sequence of musical lines. Each descending line should fade -into the audible range as it begins its descent, and then fade out as -it descends further. So the beginning and end of each line will be -difficult to hear. And there will be many such lines, each starting -at a different time, some perhaps descending a little faster than -others, or perhaps using different instrument sounds, and so on. The -effect will be that as the music is listened to, everything will seem -to be falling, falling, falling with no end, but no beginning either. -(This illusion is called the \emph{Shepard Tone}, or \emph{Shepard - Scale}, first introduced by Roger Shepard in 1964 \cite{shepard}.) - -Use high-order functions, recursion, and whatever other abstraction -techniques you have learned to write an elegant solution to this -problem. Try to parameterize things in such a way that, for example, -with a simple change, you could generate an infinite \emph{ascension} -as well. The |Volume| constructor in the |NoteAttribute| type, as -used in the definition of |addVol|, should be used to set the volumes.} -\end{exercise} - -\begin{exercise}{\em -Do something wild and crazy with Euterpea.} -\end{exercise} - -\vspace{.1in}\hrule diff --git a/HSoM/Music.lhs b/HSoM/Music.lhs deleted file mode 100644 --- a/HSoM/Music.lhs +++ /dev/null @@ -1,958 +0,0 @@ -%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- - -%include lhs2TeX.fmt -%include myFormat.fmt - -\out{ -\begin{code} --- This code was automatically generated by lhs2tex --code, from the file --- HSoM/Music.lhs. (See HSoM/MakeCode.bat.) - -\end{code} -} - -%% ToDo: -%% Introduce "play" and the Performable class soon after introducing -%% the Music type. -%% -%% Also reformat data decls so that the constructors line up vertically. - -\chapter{Simple Music} -\label{ch:music} - -\out{ -\begin{code} -module Euterpea.Music.Note.Music where -infixr 5 :+:, :=: -\end{code} -} -\begin{spec} -module Euterpea.Music.Note.Music where -infixr 5 !:+:, :=: -\end{spec} - -The previous chapters introduced some of the fundamental ideas of -functional programming in Haskell. Also introduced were several of -Euterpea's functions and operators, such as |note|, |rest|, |(:+:)|, -|(:=:)|, and |trans|. This chapter will reveal the actual definitions -of these functions and operators, thus exposing Euterpea's underlying -structure and overall design at the note level. In addition, a number -of other musical ideas will be developed, and in the process more -Haskell features will be introduced as well. - -\section{Preliminaries} - -Sometimes it is convenient to use a built-in Haskell data type to -directly represent some concept of interest. For example, we may -wish to use |Int| to represent \emph{octaves}, where by convention -octave 4 corresponds to the octave containing middle C on the piano. -We can express this in Haskell using a \emph{type synonym}: -\begin{code} - -type Octave = Int -\end{code} -A type synonym does not create a new data type---it just gives a new -name to an existing type. Type synonyms can be defined not just for -atomic types such as |Int|, but also for structured types such as -pairs. For example, as discussed in the last chapter, in music theory -a pitch is defined as a pair, consisting of a \emph{pitch class} and -an \emph{octave}. Assuming the existence of a data type called -|PitchClass| (which we will return to shortly), we can write the -following type synonym: -\begin{code} -type Pitch = (PitchClass, Octave) -\end{code} -For example, concert A (i.e.\ A440) corresponds to the pitch |(A,4) :: -Pitch|, and the lowest and highest notes on a piano correspond to -|(A,0) :: Pitch| and |(C,8) :: Pitch|, respectively. - -%% For convenience we could define a Haskell variable with that value as -%% follows: -%% \begin{spec} -%% a4 :: Pitch -%% a4 = (A,4) -- concert A -%% \end{spec} - -Another important musical concept is \emph{duration}. Rather than use -either integers or floating-point numbers, Euterpea uses \emph{rational} -numbers to denote duration: -\begin{code} -type Dur = Rational -\end{code} -|Rational| is the data type of rational numbers expressed as ratios of -|Integer|s in Haskell. The choice of |Rational| is somewhat -subjective, but is justified by three observations: (1) many durations -are expressed as ratios in music theory (5:4 rhythm, quarter notes, -dotted notes, and so on), (2) |Rational| numbers are exact (unlike -floating point numbers), which is important in many computer music -applications, and (3) irrational durations are rarely needed. - -%% (Alternatively, we could have used |Ratio Int|.) - -Rational numbers in Haskell are printed by GHC in the form |n%d|, -where |n| is the numerator, and |d| is the denominator. Even a whole -number, say the number 42, will print as |42%1| if it is a |Rational| -number. To create a |Rational| number in a program, however, once it -is given the proper type, we can use the normal division operator, as -in the following definition of a quarter note: -\begin{spec} -qn :: Dur -qn = 1/4 -- quarter note -\end{spec} - -So far so good. But what about |PitchClass|? We might try to use -integers to represent pitch classes as well, but this is not very -elegant---ideally we would like to write something that looks more -like the conventional pitch class names C, C$\sharp$, D$\flat$, D, -etc.\ The solution is to use an \emph{algebraic data type} in Haskell: -\begin{spec} -data PitchClass = Cff | Cf | C | Dff | Cs | Df | Css | D | Eff | Ds - | Ef | Fff | Dss | E | Ff | Es | F | Gff | Ess | Fs - | Gf | Fss | G | Aff | Gs | Af | Gss | A | Bff | As - | Bf | Ass | B | Bs | Bss -\end{spec} -\out{ -\begin{code} -data PitchClass = Cff | Cf | C | Dff | Cs | Df | Css | D | Eff | Ds - | Ef | Fff | Dss | E | Ff | Es | F | Gff | Ess | Fs - | Gf | Fss | G | Aff | Gs | Af | Gss | A | Bff | As - | Bf | Ass | B | Bs | Bss - deriving (Show, Eq, Ord, Read, Enum, Bounded) -\end{code} -} - -\syn{All of the names to the right of the equal sign in a |data| - declaration are called \emph{constructors}, and must be capitalized. - In this way they are syntactically distinguished from ordinary - values. This distinction is useful since only constructors can be - used in the pattern matching that is part of a function definition, - as will be described shortly. - - %% The last line, |deriving (Eq,Ord,Show,Read,Enum)|, tells Haskell to - %% make |PitchClass| an instance of these five type classes, and to - %% automatically derive definitions of the operators associated with - %% those type classes. (Recall the discussion of qualified types and - %% type classes in Section \ref{sec:qualified-types}.) -} - -%% However, we will not discuss type classes in detail until Chapter -%% \ref{ch:qualified-types}. For now, here are just two examples of the -%% capabilities this provides: -%% \begin{enumerate} -%% \item The |Eq| class has an operator |(==)| that allows us to test -%% for the equality of two pitch classes. For example, |Cf == Gs| -%% returns |False|. -%% \item The |Ord| class has an operator |(>)| that allows us to -%% compare values acording to the order that they appear in the data -%% type declaration. For example, |D > C| returns |True|. -%% \end{enumerate} - - -The |PitchClass| data type declaration essentially enumerates 35 pitch -class names (five for each of the note names A through G). Note that -both double-sharps and double-flats are included, resulting in many -enharmonics (i.e., two notes that ``sound the same,'' such as -G$\sharp$ and A$\flat$). - -(The order of the pitch classes may seem a bit odd, but the idea is -that if a pitch class |pc1| is to the left of a pitch class |pc2|, -then |pc1|'s pitch is ``lower than'' that of |pc2|. This idea will be -formalized and exploited in Chapter~\ref{sec:qualified-types}.) - -%% which may be important in certain applications. - -Keep in mind that |PitchClass| is a completely new, user-defined data -type that is not equal to any other. This is what distinguishes a -|data| declaration from a |type| declaration. As another example of -the use of a |data| declaration to define a simple enumerated type, -Haskell's Boolean data type, called |Bool|, is predefined in Haskell -simply as: -\begin{spec} -data Bool = False | True -\end{spec} - -\section{Notes, Music, and Polymorphism} -\label{sec:music} - -We can of course define other data types for other purposes. For -example, we will want to define the notion of a \emph{note} and a -\emph{rest}. Both of these can be thought of as ``primitive'' musical -values, and thus as a first attempt we might write: -\begin{spec} -data Primitive = Note Dur Pitch - | Rest Dur -\end{spec} -%% deriving (Show, Eq, Ord) -Analogously to our previous data type declarations, the above -declaration says that a |Primitive| is either a |Note| or a |Rest|. -However, it is different in that the constructors |Note| and |Rest| -take arguments, like functions do. In the case of |Note|, it takes two -arguments, whose types are |Dur| and |Pitch|, respectively, whereas -|Rest| takes one argument, a value of type |Dur|. In other words, -the types of |Note| and |Rest| are: -\begin{spec} -Note :: Dur -> Pitch -> Primitive -Rest :: Dur -> Primitive -\end{spec} -For example, |Note qn a440| is concert A played as a quarter note, and -|Rest 1| is a whole-note rest. - -This definition is not completely satisfactory, however, because we -may wish to attach other information to a note, such as its loudness, -or some other annotation or articulation. Furthermore, the pitch -itself may actually be a percussive sound, having no true pitch at -all. To resolve this, Euterpea uses an important concept in Haskell, -namely \emph{polymorphism}---the ability to parameterize, or abstract, -over types (\emph{poly} means \emph{many} and \emph{morphism} refers -to the structure, or \emph{form}, of objects). - -|Primitive| can be redefined as a \emph{polymorphic data type} as -follows. Instead of fixing the type of the pitch of a note, it is -left unspecified through the use of a \emph{type variable}: -\begin{spec} -data Primitive a = Note Dur a - | Rest Dur -\end{spec} -\out{ -\begin{code} -data Primitive a = Note Dur a - | Rest Dur - deriving (Show, Eq, Ord) -\end{code} -} -Note that the type variable |a| is used as an argument to |Primitive|, -and then used in the body of the declaration---just like a variable in -a function. This version of |Primitive| is more general than the -previous version---indeed, note that |Primitive Pitch| is the same as -(or, technically, is \emph{isomorphic to}) the previous version of -|Primitive|. But additionally, |Primitive| is now more flexible than -the previous version, since, for example, we can add loudness by -pairing loudness with pitch, as in |Primitive (Pitch, Loudness)|. -Other concrete instances of this idea will be introduced later. - -\syn{Type variables such as |a| above must begin with a lower-case - letter, to distinguish them from concrete types such as |Dur| or - |Pitch|. Since |Primitive| takes an argument, it is called a - \emph{type constructor}, wherease |Note| and |Rest| are just called - constructors (or value constructors).} - -Another way to interpret this data declaration is to say that for any -type |a|, this declaration declares the types of its constructors to -be: -\begin{spec} -Note :: Dur -> a -> Primitive a -Rest :: Dur -> Primitive a -\end{spec} -Even though |Note| and |Rest| are called data constructors, they are -still functions, and they have a type. Since they both have type -variables in their type signatures, they are examples of -\emph{polymorphic functions}. - -It is helpful to think of polymorphism as applying the abstraction -principle at the type level---indeed it is often called \emph{type - abstraction}. Many more examples of both polymorphic functions and -polymorphic data types will be explored in detail in -Chapter~\ref{ch:poly}. - -So far Euterpea's primitive notes and rests have been introduced---but -how do we combine many notes and rests into a larger composition? To -achieve this, Euterpea defines another polymorphic data type, perhaps -the most important data type used in this textbook, which defines the -fundamental structure of a note-level musical entity: -\begin{spec} -data Music a = - Prim (Primitive a) -- primitive value - | Music a :+: Music a -- sequential composition - | Music a :=: Music a -- parallel composition - | Modify Control (Music a) -- modifier - \end{spec} -\out{ -\begin{code} -data Music a = - Prim (Primitive a) -- primitive value - | Music a :+: Music a -- sequential composition - | Music a :=: Music a -- parallel composition - | Modify Control (Music a) -- modifier - deriving (Show, Eq, Ord) -\end{code} -} -Following the reasoning above, the types of these constructors are: -\begin{spec} -Prim :: Primitive a -> Music a -(:+:) :: Music a -> Music a -> Music a -(:=:) :: Music a -> Music a -> Music a -Modify :: Control -> Music a -> Music a -\end{spec} -These four constructors then are also polymorphic functions. - -%% | Music a /=: Music a -- parallel composition -%% (short) - -%% The first line here looks odd: the name |Primitive| appears -%% twice. The first occurence, however, is the name of a new -%% \emph{constructor} in the |Music| data type, whereas the second is -%% the name of the existing \emph{data type} defined above. Haskell -%% allows using the same name to define a constructor and a data type, -%% since they can never be confused: the context in which they are used -%% will always be sufficient to distinguish them. - -\syn{ - \index{infix constructors} - Note the use of the \emph{infix constructors} |(:+:)| and |(:=:)|. - Infix constructors are just like infix operators in Haskell, but - they must begin with a colon. This syntactic distinction makes it - clear when pattern matching is intended, and is analogous to the - distinction between ordinary names (which must begin with a - lower-case character) and constructor names (which must begin with - an upper-case character). - - The observant reader will also recall that at the very beginning of - this chapter---corresponding to the module containing all the code in - this chapter---the following line appeared: - \begin{spec} - infixr 5 !:+:, :=: - \end{spec} - This is called a \emph{fixity declaration}. The ``|r|'' after the - word ``|infix|'' means that the specified operators---in this case - |(:+:)| and |(:=:)|---are to have \emph{right} associativity, and the - ``5'' specifies their \emph{precedence level} (these operators will - bind more tightly than an operator with a lower precedence). -} - -\newpage -The |Music| data type declaration essentially says that a value of type -|Music a| has one of four possible forms: -\begin{itemize} -\item |Prim p|, where |p| is a primitive value of type |Primitive a|, - for some type |a|. For example: -\begin{spec} -a440m :: Music Pitch -a440m = Prim (Note qn a440) -\end{spec} -is the musical value corresponding to a quarter-note rendition of -concert A. - -\item |m1 :+: m2| is the \emph{sequential composition} of |m1| and -|m2|; i.e.\ |m1| and |m2| are played in sequence. - -\item |m1 :=: m2| is the \emph{parallel composition} of |m1| and |m2|; - i.e.\ |m1| and |m2| are played simultaneously. The duration of the - result is the duration of the longer of |m1| and |m2|. - - (Recall that these last two operators were introduced in the last - chapter. You can see now that they are actually constructors of an - algebraic data type.) - -%% \item |m1 /=: m2| is also a parallel composition of |m1| and |m2|, but -%% its duration is that of the shorter of |m1| and |m2|. - -\item |Modify cntrl m| is an ``annotated'' version of |m| in which the - control parameter |cntrl| specifies some way in which |m| is to be - modified. -\end{itemize} - -\index{type!recursive} \syn{Note that |Music a| is defined in terms of - |Music a|, and thus the data type is said to be \emph{recursive} - (analogous to a recursive function). It is also often called an - \emph{inductive} data type, since it is, in essence, an inductive - definition of an infinite number of values, each of which can be - arbitrarily complex.} - -It is convenient to represent these musical ideas as a recursive -datatype because it allows us to not only \emph{construct} musical -values, but also take them apart, analyze their structure, print them -in a structure-preserving way, transform them, interpret them for -performance purposes, and so on. Many examples of these kinds of -processes will be seen in this textbook. - -The |Control| data type is used by the |Modify| constructor to -annotate a |Music| value with a \emph{tempo change}, a -\emph{transposition}, a \emph{phrase attribute}, a \emph{player name}, -or an \emph{instrument}. This data type is unimportant at the moment, -but for completeness here is its full definition: - -\pagebreak - -\begin{spec} -data Control = - Tempo Rational -- scale the tempo - | Transpose AbsPitch -- transposition - | Instrument InstrumentName -- instrument label - | Phrase [PhraseAttribute] -- phrase attributes - | Player PlayerName -- player label - | KeySig PitchClass Mode -- key signature and mode - -type PlayerName = String -data Mode = Major | Minor -\end{spec} -\out{ -\begin{code} -data Control = - Tempo Rational -- scale the tempo - | Transpose AbsPitch -- transposition - | Instrument InstrumentName -- instrument label - | Phrase [PhraseAttribute] -- phrase attributes - | Player PlayerName -- player label - | KeySig PitchClass Mode -- key signature and mode - deriving (Show, Eq, Ord) - -type PlayerName = String -data Mode = Major | Minor - deriving (Show, Eq, Ord) -\end{code} -} - -|AbsPitch| (``absolute pitch,'' to be defined in Section -\ref{sec:abspitch}) is just a type synonym for |Int|. Instrument -names are borrowed from the General MIDI standard -\cite{MIDI,General-MIDI}, and are captured as an algebraic data type -in Figure \ref{fig:instrument-names}. Phrase attributes and the -concept of a ``player'' are closely related, but a full explanation is -deferred until Chapter \ref{ch:performance}. The |KeySig| constructor -attaches a key signature to a |Music| value, and is different -conceptually from transposition. - -%% are defined in Figure \ref{fig:phase-attributes}. The - -\begin{figure}{\small -\indexhs{InstrumentName} -\begin{code} -data InstrumentName = - AcousticGrandPiano | BrightAcousticPiano | ElectricGrandPiano - | HonkyTonkPiano | RhodesPiano | ChorusedPiano - | Harpsichord | Clavinet | Celesta - | Glockenspiel | MusicBox | Vibraphone - | Marimba | Xylophone | TubularBells - | Dulcimer | HammondOrgan | PercussiveOrgan - | RockOrgan | ChurchOrgan | ReedOrgan - | Accordion | Harmonica | TangoAccordion - | AcousticGuitarNylon | AcousticGuitarSteel | ElectricGuitarJazz - | ElectricGuitarClean | ElectricGuitarMuted | OverdrivenGuitar - | DistortionGuitar | GuitarHarmonics | AcousticBass - | ElectricBassFingered | ElectricBassPicked | FretlessBass - | SlapBass1 | SlapBass2 | SynthBass1 - | SynthBass2 | Violin | Viola - | Cello | Contrabass | TremoloStrings - | PizzicatoStrings | OrchestralHarp | Timpani - | StringEnsemble1 | StringEnsemble2 | SynthStrings1 - | SynthStrings2 | ChoirAahs | VoiceOohs - | SynthVoice | OrchestraHit | Trumpet - | Trombone | Tuba | MutedTrumpet - | FrenchHorn | BrassSection | SynthBrass1 - | SynthBrass2 | SopranoSax | AltoSax - | TenorSax | BaritoneSax | Oboe - | Bassoon | EnglishHorn | Clarinet - | Piccolo | Flute | Recorder - | PanFlute | BlownBottle | Shakuhachi - | Whistle | Ocarina | Lead1Square - | Lead2Sawtooth | Lead3Calliope | Lead4Chiff - | Lead5Charang | Lead6Voice | Lead7Fifths - | Lead8BassLead | Pad1NewAge | Pad2Warm - | Pad3Polysynth | Pad4Choir | Pad5Bowed - | Pad6Metallic | Pad7Halo | Pad8Sweep - | FX1Train | FX2Soundtrack | FX3Crystal - | FX4Atmosphere | FX5Brightness | FX6Goblins - | FX7Echoes | FX8SciFi | Sitar - | Banjo | Shamisen | Koto - | Kalimba | Bagpipe | Fiddle - | Shanai | TinkleBell | Agogo - | SteelDrums | Woodblock | TaikoDrum - | MelodicDrum | SynthDrum | ReverseCymbal - | GuitarFretNoise | BreathNoise | Seashore - | BirdTweet | TelephoneRing | Helicopter - | Applause | Gunshot | Percussion - | Custom String -\end{code} -} -\out{ -\begin{code} - deriving (Show, Eq, Ord) -\end{code} -} -\caption{General MIDI Instrument Names} -\label{fig:instrument-names} -\end{figure} - -\out{ -\begin{figure}{\small -\begin{code} -data PhraseAttribute = Dyn Dynamic - | Tmp Tempo - | Art Articulation - | Orn Ornament - deriving (Show, Eq, Ord) - -data Dynamic = Accent Rational | Crescendo Rational | Diminuendo Rational - | StdLoudness StdLoudness | Loudness Rational - deriving (Show, Eq, Ord) - -data StdLoudness = PPP | PP | P | MP | SF | MF | NF | FF | FFF - deriving (Show, Eq, Ord, Enum) - -data Tempo = Ritardando Rational | Accelerando Rational - deriving (Show, Eq, Ord) - -data Articulation = Staccato Rational | Legato Rational | Slurred Rational - | Tenuto | Marcato | Pedal | Fermata | FermataDown | Breath - | DownBow | UpBow | Harmonic | Pizzicato | LeftPizz - | BartokPizz | Swell | Wedge | Thumb | Stopped - deriving (Show, Eq, Ord) - -data Ornament = Trill | Mordent | InvMordent | DoubleMordent - | Turn | TrilledTurn | ShortTrill - | Arpeggio | ArpeggioUp | ArpeggioDown - | Instruction String | Head NoteHead - | DiatonicTrans Int - deriving (Show, Eq, Ord) - -data NoteHead = DiamondHead | SquareHead | XHead | TriangleHead - | TremoloHead | SlashHead | ArtHarmonic | NoHead - deriving (Show, Eq, Ord) - -\end{code}} -\caption{Phrase Attributes} -\label{fig:phase-attributes} -\end{figure} -} - -\section{Convenient Auxiliary Functions} -\label{auxiliaries} - -%% In anticipation of the need to translate between different number -%% types, we define the following coercion function: -%% \begin{code} -%% rtof :: Ratio Int -> Float -%% rtof r = float (numerator r) / float (denominator r) - -%% float :: Int -> Float -%% float = fromInteger . toInteger -%% \end{code} - -For convenience, and in anticipation of their frequent use, a number -of functions are defined in Euterpea to make it easier to write -certain kinds of musical values. For starters: -\begin{code} - -note :: Dur -> a -> Music a -note d p = Prim (Note d p) - -rest :: Dur -> Music a -rest d = Prim (Rest d) - -tempo :: Dur -> Music a -> Music a -tempo r m = Modify (Tempo r) m - -transpose :: AbsPitch -> Music a -> Music a -transpose i m = Modify (Transpose i) m - -instrument :: InstrumentName -> Music a -> Music a -instrument i m = Modify (Instrument i) m - -phrase :: [PhraseAttribute] -> Music a -> Music a -phrase pa m = Modify (Phrase pa) m - -player :: PlayerName -> Music a -> Music a -player pn m = Modify (Player pn) m - -keysig :: PitchClass -> Mode -> Music a -> Music a -keysig pc mo m = Modify (KeySig pc mo) m -\end{code} -Note that each of these functions is polymorphic, a trait inherited -from the data types that it uses. Also recall that the first two of -these functions were used in an example in the last chapter. - -We can also create simple names for familiar notes, durations, and -rests, as shown in Figures \ref{fig:note-names} and -\ref{fig:rest-names}. Despite the large number of them, these names -are sufficiently ``unusual'' that name clashes are unlikely. - -\syn{Figures \ref{fig:note-names} and \ref{fig:rest-names} demonstrate - that at the top level of a program, more than one equation can be - placed on one line, as long as they are separated by a semicolon. - This allows us to save vertical space on the page, and is useful - whenever each line is relatively short. The semicolon is not needed - at the end of a single equation, or at the end of the last equation - on a line. This convenient feature is part of Haskell's - \emph{layout} rule, and will be explained in more detail later. - -More than one equation can also be placed on one line in a |let| -expression, as demonstrated below: -\begin{spec} -let x = 1; y = 2 -in x + y -\end{spec} -} - -%% In fact this same rule may be used to override layout in any context, -%% how the layout rule can be overridden through the use of a semicolon. - -\begin{figure} -\cbox{\small -\begin{code} -cff,cf,c,cs,css,dff,df,d,ds,dss,eff,ef,e,es,ess,fff,ff,f, - fs,fss,gff,gf,g,gs,gss,aff,af,a,as,ass,bff,bf,b,bs,bss :: - Octave -> Dur -> Music Pitch - -cff o d = note d (Cff, o); cf o d = note d (Cf, o) -c o d = note d (C, o); cs o d = note d (Cs, o) -css o d = note d (Css, o); dff o d = note d (Dff, o) -df o d = note d (Df, o); d o d = note d (D, o) -ds o d = note d (Ds, o); dss o d = note d (Dss, o) -eff o d = note d (Eff, o); ef o d = note d (Ef, o) -e o d = note d (E, o); es o d = note d (Es, o) -ess o d = note d (Ess, o); fff o d = note d (Fff, o) -ff o d = note d (Ff, o); f o d = note d (F, o) -fs o d = note d (Fs, o); fss o d = note d (Fss, o) -gff o d = note d (Gff, o); gf o d = note d (Gf, o) -g o d = note d (G, o); gs o d = note d (Gs, o) -gss o d = note d (Gss, o); aff o d = note d (Aff, o) -af o d = note d (Af, o); a o d = note d (A, o) -as o d = note d (As, o); ass o d = note d (Ass, o) -bff o d = note d (Bff, o); bf o d = note d (Bf, o) -b o d = note d (B, o); bs o d = note d (Bs, o) -bss o d = note d (Bss, o) -\end{code}} -\caption{Convenient Note Names} -\label{fig:note-names} -\end{figure} - -\begin{figure} -\cbox{\small -\begin{code} - -bn, wn, hn, qn, en, sn, tn, sfn, dwn, dhn, - dqn, den, dsn, dtn, ddhn, ddqn, dden :: Dur - -bnr, wnr, hnr, qnr, enr, snr, tnr, sfnr, dwnr, dhnr, - dqnr, denr, dsnr, dtnr, ddhnr, ddqnr, ddenr :: Music Pitch - -bn = 2; bnr = rest bn -- brevis rest -wn = 1; wnr = rest wn -- whole note rest -hn = 1/2; hnr = rest hn -- half note rest -qn = 1/4; qnr = rest qn -- quarter note rest -en = 1/8; enr = rest en -- eighth note rest -sn = 1/16; snr = rest sn -- sixteenth note rest -tn = 1/32; tnr = rest tn -- thirty-second note rest -sfn = 1/64; sfnr = rest sfn -- sixty-fourth note rest - -dwn = 3/2; dwnr = rest dwn -- dotted whole note rest -dhn = 3/4; dhnr = rest dhn -- dotted half note rest -dqn = 3/8; dqnr = rest dqn -- dotted quarter note rest -den = 3/16; denr = rest den -- dotted eighth note rest -dsn = 3/32; dsnr = rest dsn -- dotted sixteenth note rest -dtn = 3/64; dtnr = rest dtn -- dotted thirty-second note rest - -ddhn = 7/8; ddhnr = rest ddhn -- double-dotted half note rest -ddqn = 7/16; ddqnr = rest ddqn -- double-dotted quarter note rest -dden = 7/32; ddenr = rest dden -- double-dotted eighth note rest -\end{code}} -\caption{Convenient Duration and Rest Names} -\label{fig:rest-names} -\end{figure} - -\subsection{A Simple Example} - -As a simple example, suppose we wish to generate a ii-V-I chord -progression in a particular major key. In music theory, such a chord -progression begins with a minor chord on the second degree of the major -scale, followed by a major chord on the fifth degree, and ending in a -major chord on the first degree. We can write this in Euterpea, using -triads in the key of C major, as follows: -\begin{code} -t251 :: Music Pitch -t251 = let dMinor = d 4 wn :=: f 4 wn :=: a 4 wn - gMajor = g 4 wn :=: b 4 wn :=: d 5 wn - cMajor = c 4 bn :=: e 4 bn :=: g 4 bn - in dMinor :+: gMajor :+: cMajor -\end{code} - -\syn{Note that more than one equation is allowed in a \indexwdkw{let} - expression, just like at the top level of a program. The first - characters of each equation, however, must line up vertically, and - if an equation takes more than one line then the subsequent lines - must be to the right of the first characters. For example, this is - legal: -\begin{spec} -let a = aLongName - + anEvenLongerName - b = 56 -in ... -\end{spec} -but neither of these are: -\begin{spec} -let a = aLongName - + anEvenLongerName - b = 56 -in ... - -let a = aLongName - + anEvenLongerName - b = 56 -in ... -\end{spec} -(The second line in the first example is too far to the left, as is -the third line in the second example.) - -Although this rule, called the {\em \indexwd{layout rule}}, may seem a -bit {\em ad hoc}, it avoids having to use special syntax (such as a -semicolon) to denote the end of one equation and the beginning of the -next, thus enhancing readability. In practice, use of layout is -rather intuitive. Just remember two things: - -First, the first character following |let| (and a few other keywords -that will be introduced later) is what determines the starting column -for the set of equations being written. Thus we can begin the -equations on the same line as the keyword, the next line, or whatever. - -Second, be sure that the starting column is further to the right -than the starting column associated with any immediately surrounding -|let| clause (otherwise it would be ambiguous). The ``termination'' of an -equation happens when something appears at or to the left of the -starting column associated with that equation.} - -We can play this simple example using Euterpea's |play| function -by simply typing: -\begin{spec} -play t251 -\end{spec} -at the GHCi command line. Default instruments and tempos are used to -convert |t251| into MIDI and then play the result through your -computer's standard sound card. - -\syn{It is important when using |play| that the type of its argument -is made clear. In the case of |t251|, it is clear from the type -signature in its definition. But for reasons to be explained in -Chapter~\ref{ch:qualified-types}, if we write even something very -simple such as |play (note qn (C,4))|, Haskell cannot infer exactly -what kind of number 4 is, and therefore cannot infer that |(C,4)| is -intended to be a |Pitch|. We can get around this either by writing: -\begin{spec} -m :: Pitch -m = note qn (C,4) -\end{spec} -in which case |play m| will work just fine, or we can include the type -signature ``in-line'' with the expression, as in |play (note qn -((C,4)::Pitch))|.} - -\vspace{.1in}\hrule - -\begin{exercise}{\em -The above example is fairly concrete, in that, for one, it is rooted -in C major, and furthermore it has a fixed tempo. Define a function -|twoFiveOne :: Pitch -> Dur -> Music Pitch| such that |twoFiveOne p d| -constructs a ii-V-I chord progression in the key whose major scale -begins on the pitch |p| (i.e.\ the first degree of the major scale on -which the progression is being constructed), where the duration of the -first two chords is each |d|, and the duration of the last chord is -|2*d|. - -To verify your code, prove by calculation that |twoFiveOne (C,4) wn = -t251|.} -\end{exercise} - -\begin{exercise}{\em -The |PitchClass| data type implies the use of standard Western -harmony, in particular the use of a \emph{twelve-tone equal temperament - scale}. But there are many other scale possibilities. For example, -the \emph{pentatonic blues scale} consists of five notes (thus -``pentatonic'') and, in the key of C, approximately corresponds to the -notes C, E$\flat$, F, G, and B$\flat$. More abstractly, let's call -these the root, minor third, fourth, fifth, and minor seventh, -respectively. Your job is to: -\begin{enumerate} -\item -Define a new algebraic data type called |BluesPitchClass| that -captures this scale (for example, you may wish to use the constructor -names |Ro|, |MT|, |Fo|, |Fi|, and |MS|). -\item -Define a type synonym |BluesPitch|, akin to |Pitch|. -\item -Define auxiliary functions |ro|, |mt|, |fo|, |fi|, and |ms|, akin to -those in Figure \ref{fig:note-names}, that make it easy to construct -notes of type |Music BluesPitch|. -\item -In order to play a value of type |Music BluesPitch| using MIDI, it -will have to be converted into a |Music Pitch| value. Define a -function |fromBlues :: Music BluesPitch -> Music Pitch| to do this, -using the ``approximate'' translation described at the beginning of -this exercise. - -Hint: To do this properly, you will have to pattern match against the -|Music| value, something like this: -\begin{spec} -fromBlues (Prim (Note d p)) = ... -fromBlues (Prim (Rest d)) = ... -fromBlues (m1 :+: m2) = ... -fromBlues (m1 :=: m2) = ... -fromBlues (Modify ...) = ... -\end{spec} -\item -Write out a few melodies of type |Music BluesPitch|, and play them -using |fromBlues| and |play|. -\end{enumerate} } -\end{exercise} - -\vspace{.1in}\hrule - -\section{Absolute Pitches} -\label{sec:abspitch} - -Treating pitches simply as integers is useful in many settings, so -Euterpea uses a type synonym to define the concept of an ``absolute -pitch:'' -\begin{code} -type AbsPitch = Int -\end{code} -The absolute pitch of a (relative) pitch can be defined mathematically -as 12 times the octave, plus the index of the pitch class. We can -express this in Haskell as follows: -\begin{code} -absPitch :: Pitch -> AbsPitch -absPitch (pc,oct) = 12*oct + pcToInt pc -\end{code} - -\syn{Note the use of pattern matching to match the argument of - |absPitch| to a pair.} - -|pcToInt| is a function that converts a particular pitch class to an -index, easily but tediously expressed as shown in Figure -\ref{fig:pcToInt}. But there is a subtlety: according to music theory -convention, pitches are assigned integers in the range 0 to 11, -i.e.\ modulo 12, starting on pitch class C. In other words, the index -of C is 0, C$\flat$ is 11, and B$\sharp$ is 0. However, that would -mean the absolute pitch of |(C,4)|, say, would be 48, whereas |(Cf,4)| -would be 59. Somehow the latter does not seem right---47 would be a -more logical choice. Therefore the definition in -Figure~\ref{fig:pcToInt} is written in such a way that the wrap-round -does not happen, i.e.\ numbers outside the range 0 to 11 are used. -With this definition, |absPitch (Cf,4)| yields 47, as desired. - -%% Should |Cf| be interpreted as 11 instead of -1, and |Bs| as 0 -%% instead of 12? I do not know. In most cases it will not matter, but -%% it is an interesting question. - -\begin{figure} -\cbox{\small -\begin{spec} -pcToInt :: PitchClass -> Int - -pcToInt Cff = -2; pcToInt Dff = 0; pcToInt Eff = 2 -pcToInt Cf = -1; pcToInt Df = 1; pcToInt Ef = 3 -pcToInt C = 0; pcToInt D = 2; pcToInt E = 4 -pcToInt Cs = 1; pcToInt Ds = 3; pcToInt Es = 5 -pcToInt Css = 2; pcToInt Dss = 4; pcToInt Ess = 6 - -pcToInt Fff = 3; pcToInt Gff = 5; pcToInt Aff = 7 -pcToInt Ff = 4; pcToInt Gf = 6; pcToInt Af = 8 -pcToInt F = 5; pcToInt G = 7; pcToInt A = 9 -pcToInt Fs = 6; pcToInt Gs = 8; pcToInt As = 10 -pcToInt Fss = 7; pcToInt Gss = 9; pcToInt Ass = 11 - -pcToInt Bff = 9 -pcToInt Bf = 10 -pcToInt B = 11 -pcToInt Bs = 12 -pcToInt Bss = 13 -\end{spec}} -\caption{Converting Pitch Classes to Integers} -\label{fig:pcToInt} -\end{figure} - -\syn{The repetition of ``|pcToInt|'' above can be avoided by using a - Haskell |case| expression, resulting in a more compact definition: -\begin{code} -pcToInt :: PitchClass -> Int -pcToInt pc = case pc of - Cff -> -2; Cf -> -1; C -> 0; Cs -> 1; Css -> 2; - Dff -> 0; Df -> 1; D -> 2; Ds -> 3; Dss -> 4; - Eff -> 2; Ef -> 3; E -> 4; Es -> 5; Ess -> 6; - Fff -> 3; Ff -> 4; F -> 5; Fs -> 6; Fss -> 7; - Gff -> 5; Gf -> 6; G -> 7; Gs -> 8; Gss -> 9; - Aff -> 7; Af -> 8; A -> 9; As -> 10; Ass -> 11; - Bff -> 9; Bf -> 10; B -> 11; Bs -> 12; Bss -> 13 -\end{code} -As you can see, a |case| expression allows multiple pattern-matches on -an expression without using equations. Note that layout applies to -the body of a case expression, and can be overriden as before using a -semicolon. (As in a function type signature, the right-pointing arrow -in a |case| expression must be typed as ``{\tt ->}'' on your -computer keyboard.) - -The body of a |case| expression observes layout just as a |let| -expression, including the fact that semicolons can be used, as above, -to place more than one pattern match on the same line.} - -Converting an absolute pitch to a pitch is a bit more tricky, because -of enharmonic equivalences. For example, the absolute pitch 15 might -correspond to either |(Ds,1)| or |(Ef,1)|. Euterpea takes the -approach of always returning a sharp in such ambiguous cases: -%%\begin{code} -%%pitch :: AbsPitch -> Pitch -%%pitch ap = ( [C,Cs,D,Ds,E,F,Fs,G,Gs,A,As,B] !! mod ap 12, -%% quot ap 12 ) -%%\end{code} -\begin{code} -pitch :: AbsPitch -> Pitch -pitch ap = - let (oct, n) = divMod ap 12 - in ([C,Cs,D,Ds,E,F,Fs,G,Gs,A,As,B] !! n, oct) -\end{code} - -\index{list!indexing} -\syn{|(!!)| is Haskell's zero-based list-indexing function; -|list !! n| returns the |(n+1)|th element in |list|. -|divMod x n| returns a pair |(q,r)|, where |q| is -the integer quotient of |x| divided by |n|, and |r| is the -value of |x| modulo |n|.} -%% |(!!)| behaves as follows: -%% \begin{spec} -%% infixl 9 !! -%% (!!) :: [a] -> Int -> a -%% (x:_) !! 0 = x -%% (_:xs) !! n | n > 0 = xs !! (n-1) -%% \end{spec} -Given |pitch| and |absPitch|, it is now easy to define a function -|trans| that transposes pitches: -%% (analogous to |Trans|, which transposes values of type |Music|) -\begin{code} -trans :: Int -> Pitch -> Pitch -trans i p = pitch (absPitch p + i) -\end{code} -With this definition, all of the operators and functions introduced in -the previous chapter have been covered. - -\vspace{.1in}\hrule - -\begin{exercise}{\em -Show that |abspitch (pitch ap) = ap|, and, up to enharmonic -equivalences, |pitch (abspitch p) = p|.} -\end{exercise} - -\begin{exercise}{\em -Show that |trans i (trans j p) = trans (i+j) p|.} -\end{exercise} - -\begin{exercise}{\em -|Transpose| is part of the |Control| data type, which in turn is part -of the |Music| data type. Its use in transposing a |Music| value is -thus a kind of ``annotation''---it doesn't really change the |Music| -value, it just annotates it as something that is transposed. - -Define instead a recursive function |transM :: AbsPitch -> Music Pitch --> Music Pitch| that actually changes each note in a |Music Pitch| -value by transposing it by the interval represented by the first -argument. - -Hint: To do this properly, you will have to pattern match against the -|Music| value, something like this: -\begin{spec} -transM ap (Prim (Note d p)) = ... -transM ap (Prim (Rest d)) = ... -transM ap (m1 :+: m2) = ... -transM ap (m1 :=: m2) = ... -transM ap (Modify ...) = ... -\end{spec} -} -\end{exercise} - -\vspace{.1in}\hrule diff --git a/HSoM/Patterns.lhs b/HSoM/Patterns.lhs deleted file mode 100644 --- a/HSoM/Patterns.lhs +++ /dev/null @@ -1,197 +0,0 @@ -%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- - -%include lhs2TeX.fmt -%include myFormat.fmt - -\chapter{Pattern-Matching Details} -\label{ch:patterns} - -\index{pattern!matching||(} -In this chapter we will look at Haskell's pattern-matching process in -greater detail. - -Haskell defines a fixed set of patterns for use in case expressions -and function definitions. Pattern matching is permitted using the -constructors of any type, whether user-defined or pre-defined in -Haskell. This includes tuples, strings, numbers, characters, etc. -For example, here's a contrived function that matches against a tuple -of ``constants:'' -\begin{spec} -contrived :: ([a], Char, (Int, Float), String, Bool) -> Bool -contrived ([], 'b', (1, 2.0), "hi", True) = False -\end{spec} -This example also demonstrates that {\em nesting} of patterns is -permitted (to arbitrary depth). - -Technically speaking, {\em formal parameters} to functions are also -patterns---it's just that they {\em never fail to match a value}. As -a ``side effect'' of a successful match, the formal parameter is bound -to the value it is being matched against. For this reason patterns in -any one equation are not allowed to have more than one occurrence of -the same formal parameter. -\index{pattern!refutable} -\index{pattern!irrefutable} - -A pattern that may fail to match is said to be {\em refutable}; for -example, the empty list \hs{[]} is refutable. Patterns such as formal -parameters that never fail to match are said to be {\em irrefutable}. -There are three other kinds of irrefutable patterns, which are -summarized below. - -\index{pattern!as-pattern} -\paragraph*{As-Patterns} Sometimes it is convenient to name a -pattern for use on the right-hand side of an equation. For example, a -function that duplicates the first element in a list might be written -as: -\begin{spec} -f (x:xs) = x:x:xs -\end{spec} -Note that \hs{x:xs} appears both as a pattern on the left-hand side, -and as an expression on the right-hand side. To improve readability, -we might prefer to write \hs{x:xs} just once, which we can achieve -using an {\em as-pattern} as follows:\footnote{Another advantage to -doing this is that a naive implementation might otherwise completely -reconstruct \hs{x:xs} rather than re-use the value being matched -against.} -\begin{spec} -f s@(x:xs) = x:s -\end{spec} -Technically speaking, as-patterns always result in a successful match, -although the sub-pattern (in this case \hs{x:xs}) could, of course, -fail. - -\index{pattern!wildcard} -\paragraph*{Wildcards} Another common situation is matching against -a value we really care nothing about. For example, the functions -\hs{head} and \hs{tail} can be written as: -\begin{spec} -head (x:_) = x -tail (_:xs) = xs -\end{spec} -in which we have ``advertised'' the fact that we don't care what a -certain part of the input is. Each wildcard will independently match -anything, but in contrast to a formal parameter, each will bind -nothing; for this reason more than one are allowed in an equation. - -\index{pattern!lazy} -\paragraph*{Lazy Patterns} -There is one other kind of pattern allowed in Haskell. It is called a -{\em lazy pattern}, and has the form \hs{~pat}. Lazy patterns are -{\em irrefutable}: matching a value $v$ against \hs{~pat} always -succeeds, regardless of \hs{pat}. Operationally speaking, if an -identifier in \hs{pat} is later ``used'' on the right-hand-side, it -will be bound to that portion of the value that would result if \hs{v} -were to successfully match \hs{pat}, and $\bot$ otherwise. - -Lazy patterns are useful in contexts where infinite data structures -are being defined recursively. For example, infinite lists are an -excellent vehicle for writing {\em simulation} programs, and in this -context the infinite lists are often called {\em streams}. -%% Streams were discussed at length in Chapter \ref{ch:streams}. - -\section*{Pattern-Matching Semantics} - -So far we have discussed how individual patterns are matched, how some -are refutable, some are irrefutable, etc. But what drives the overall -process? In what order are the matches attempted? What if none -succeed? This section addresses these questions. - -Pattern matching can either {\em fail}, {\em succeed} or {\em -diverge}. A successful match binds the formal parameters in the -pattern. Divergence occurs when a value needed by the pattern -diverges (i.e.\ is non-terminating) or results in an error ($\bot$). -The matching process itself occurs ``top-down, left-to-right.'' -Failure of a pattern anywhere in one equation results in failure of -the whole equation, and the next equation is then tried. If all -equations fail, the value of the function application is $\bot$, and -results in a run-time error. - -For example, if \hs{bot} is a divergent or erroneous computation, and -if \hs{[1,2]} is matched against \hs{[0,bot]}, then \hs{1} fails to -match \hs{0}, so the result is a failed match. But if \hs{[1,2]} is -matched against \hs{[bot,0]}, then matching \hs{1} against \hs{bot} -causes divergence (i.e.~$\bot$). - -\index{pattern!guard} - -The only other twist to this set of rules is that top-level patterns -may also have a boolean {\em guard}, as in this definition of a -function that forms an abstract version of a number's sign: -\begin{spec} -sign x | x > 0 = 1 - | x == 0 = 0 - | x < 0 = -1 -\end{spec} -Note here that a sequence of guards is given for a single pattern; as -with patterns, these guards are evaluated top-down, and the first that -evaluates to \hs{True} results in a successful match. - -\paragraph*{An Example} - -The pattern-matching rules can have subtle effects on the meaning of -functions. For example, consider this definition of \hs{take}: -\begin{spec} -take 0 _ = [] -take _ [] = [] -take n (x:xs) = x : take (n-1) xs -\end{spec} -and this slightly different version (the first 2 equations have been -reversed): -\begin{spec} -take1 _ [] = [] -take1 0 _ = [] -take1 n (x:xs) = x : take1 (n-1) xs -\end{spec} -Now note the following: -\[\begin{array}{lcl} - \hs{take 0 bot} &\ \ \ \red\ \ \ & \hs{[]} \\ - \hs{take1 0 bot} &\ \ \ \red\ \ \ & \bot \\[.1in] - \hs{take bot []} &\ \ \ \red\ \ \ & \bot \\ - \hs{take1 bot []} &\ \ \ \red\ \ \ & \hs{[]} -\end{array}\] -We see that \hs{take} is ``more defined'' with respect to its second -argument, whereas \hs{take1} is more defined with respect to its first. -It is difficult to say in this case which definition is better. Just -remember that in certain applications, it may make a difference. (The -Standard Prelude includes a definition corresponding to \hs{take}.) - -\section*{Case Expressions} -\indexkw{case} - -Pattern matching provides a way to ``dispatch control'' based on -structural properties of a value. However, in many circumstances we -don't wish to define a {\em function} every time we need to do this. -Haskell's {\em case expression} provides a way to solve this problem. -Indeed, the meaning of pattern matching in function definitions is -specified in the Haskell Report in terms of case expressions, which -are considered more primitive. In particular, a function definition -of the form: -\[\begin{array}{l} -\hs{f} p_{11} ... p_{1k} \hs{=} e_{1} \\ -... \\ -\hs{f} p_{n1} ... p_{nk} \hs{=} e_{n} -\end{array}\] -where each $p_{ij}$ is a pattern, is semantically equivalent to: -\[ \hs{f x1 x2 ... xk = case (x1, ..., xk) of} - \begin{array}[t]{l} - (p_{11}, ..., p_{1k}) \rightarrow e_{1} \\ - ... \\ - (p_{n1}, ..., p_{nk}) \rightarrow e_{n} - \end{array} -\] -where the \hs{xi} are new identifiers. For example, the -definition of \hs{take} given earlier is equivalent to: -\begin{spec} -take m ys = case (m,ys) of - (0,_) -> [] - (_,[]) -> [] - (n,x:xs) -> x : take (n-1) xs -\end{spec} -For type correctness, the types of the right-hand sides of a case -expression or set of equations comprising a function definition must -all be the same; more precisely, they must all share a common -principal type. - -The pattern-matching rules for case expressions are the same as we -have given for function definitions. -\index{pattern!matching||)} diff --git a/HSoM/Performance.lhs b/HSoM/Performance.lhs deleted file mode 100644 --- a/HSoM/Performance.lhs +++ /dev/null @@ -1,905 +0,0 @@ -%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- - -%include lhs2TeX.fmt -%include myFormat.fmt - -\out{ -\begin{code} --- This code was automatically generated by lhs2tex --code, from the file --- HSoM/Performance.lhs. (See HSoM/MakeCode.bat.) - -\end{code} -} - -\chapter{Interpretation and Performance} -\label{ch:performance} - -\begin{code} -{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-} - -module Euterpea.Music.Note.Performance where - -import Euterpea.Music.Note.Music -import Euterpea.Music.Note.MoreMusic -\end{code} - -\syn{The first line above is a GHC \emph{pragma} that, in this case, - relaxes certain constraints on instance declarations. Specifically, - instances cannot normally be declared for type synonyms---but the - above pragma overrides that constraint.} - -So far, our presentation of musical values in Haskell has been mostly -structural, i.e.\ \emph{syntactic}. Although we have given an -interpretation of the duration of |Music| values (as manifested in -|dur|, |takeM|, |dropM|, and so on), we have not given any deeper -musical interpretation. What do these musical values actually -\emph{mean}, i.e.\ what is their \emph{semantics}, or -\emph{interpretation}? The formal process of giving a semantic -interpretation to syntactic constructs is very common in computer -science, especially in programming language theory. But it is -obviously also common in music: the interpretation of music is the -very essence of musical performance. However, in conventional music -this process is usually informal, appealing to aesthetic judgments and -values. What we would like to do is make the process formal in -Euterpea---but still flexible, so that more than one interpretation is -possible, just as in the human performance of music. - -\section{Abstract Performance} -\label{sec:performance} - -To begin, we need to say exactly what an abstract \emph{performance} -is. Our approach is to consider a performance to be a time-ordered -sequence of musical \emph{events}, where each event captures the -playing of one individual note. In Haskell: -\begin{code} - -type Performance = [Event] - -data Event = Event { eTime :: PTime, - eInst :: InstrumentName, - ePitch :: AbsPitch, - eDur :: DurT, - eVol :: Volume, - eParams :: [Double]} - deriving (Show,Eq,Ord) -\end{code} -\begin{spec} -type PTime = Rational -type DurT = Rational -type Volume = Integer -\end{spec} -\out{ -\begin{code} -type PTime = Rational -type DurT = Rational -\end{code}} - -\index{field labels} -\syn{The data declaration for |Event| uses Haskell's \emph{field - label} syntax, also called \emph{record} syntax, and is equivalent to: -\begin{spec} -data Event = Event PTime InstrumentName - AbsPitch DurT Volume [Double] - deriving (Show,Eq,Ord) -\end{spec} -except that the former also defines ``field labels'' |eTime|, |eInst|, -|ePitch|, |eDur|, |eVol|, and |eParams|, which can be used to -create, update, and select from |Event| values.} - -\syn{For example, this equation: -\begin{spec} -e = Event 0 Cello 27 (1/4) 50 [] -\end{spec} -is equivalent to: -\begin{spec} -e = Event { eTime = 0, ePitch = 27, eDur = 1/4, - eInst = Cello, eVol = 50, eParams = [] } -\end{spec} -Although more verbose, the latter is also more descriptive, and the -order of the fields does not matter (indeed the order here is not the -same as above). - -Field labels can be used to \emph{select} fields from an |Event| -value; for example, using the value of |e| above, |eInst e => Cello|, -|eDur e => 1/4|, and so on. They can also be used to selectively -\emph{update} fields of an existing |Event| value. For example: -\begin{spec} -e { eInst = Flute } ==> Event 0 Flute 27 (1/4) 50 [] -\end{spec} -Finally, they can be used selectively in pattern matching: -\begin{spec} -f (Event { eDur = d, ePitch = p }) = ... d ... p ... -\end{spec} -Field labels do not change the basic nature of a data type; they are -simply a convenient syntax for referring to the components of a data -type by name rather than by position.} - -An event |Event {eTime = s, eInst = i, ePitch = p, eDur = d, eVol = - v}| captures the fact that at start time |s|, instrument |i| sounds -pitch |p| with volume |v| for a duration |d| (where now duration is -measured in seconds, rather than beats). (The |eParams| of an event -is for instruments other than MIDI, in particular instruments that we -might design on our using the techniques described in -Chapter~\ref{ch:sigfuns}. - -An abstract performance is the lowest of our music representations not -yet committed to MIDI or some other low-level computer music -representation. In Chapter~\ref{ch:midi} we will discuss how to map a -performance into MIDI. - -\subsection{Context} -\label{sec:context} - -To generate a complete performance of, i.e.\ give an interpretation -to, a musical value, we must know the time to begin the performance, -and the proper instrument, volume, starting pitch offset, and tempo. -We can think of this as the ``context'' in which a musical value is -interpreted. This context can be captured formally in Haskell as a -data type: - -\pagebreak - -\begin{code} - -data Context a = Context { cTime :: PTime, - cPlayer :: Player a, - cInst :: InstrumentName, - cDur :: DurT, - cPch :: AbsPitch, - cVol :: Volume, - cKey :: (PitchClass, Mode) } - deriving Show -\end{code} -When a |Music| value is interpreted, it will be given an inital -context, but as the |Music| value is recursively interpreted, the -context will be updated to reflect things like tempo change, -transposition, and so on. This will be made clear shortly. - -The |DurT| component of the context is the duration, in seconds, -of one whole note. To make it easier to compute, we can define a -``metronome'' function that, given a standard metronome marking (in -beats per minute) and the note type associated with one beat (quarter -note, eighth note, etc.) generates the duration of one whole note: -\begin{code} -metro :: Int -> Dur -> DurT -metro setting dur = 60 / (fromIntegral setting * dur) -\end{code} -Thus, for example, |metro 96 qn| creates a tempo of 96 quarter -notes per minute. - -\syn{|fromIntegral :: (Integral a, Num b) => a -> b| coerces a value - whose type is a member of the |Integral| class to a value whose type - is a member of the |Num| class. As used here, it is effectively - converting the |Int| value |setting| to a |Rational| value, because - |dur| is a |Rational| value, |Rational| is a member of the |Num| - class, and multiplication has type |(*) :: Num a => a->a->a|.} - -\subsection{Player Map} -\label{sec:player-map} - -In addition to the context, we also need to know what {\em player} to -use; that is, we need a mapping from each |PlayerName| (a string) in a -|Music| value to the actual player to be used.\footnote{We do not need - a mapping from |InstrumentName|s to instruments, since that is - handled in the translation from a performance into MIDI, which is - discussed in Chapter \ref{ch:midi}.} The details of what a player -is, and how it gives great flexibility to Euterpea, will be explained -later in this chapter (Section~\ref{sec:players}). For now, we simply -define a type synonym to capture the mapping of |PlayerName| to -|Player|: -\begin{code} - -type PMap a = PlayerName -> Player a -\end{code} - -\subsection{Interpretation} -\label{sec:perform} - -Finally, we are ready to give an interpretation to a piece of music, -which we do by defining a function |perform|, whose type is: -\begin{spec} -perform :: PMap a -> Context a -> Music a -> Performance -\end{spec} -So |perform pm c m| is the |Performance| that results from -interpreting |m| using player map |pm| in the initial context |c|. -Conceptually, |perform| is perhaps the most important function defined -in this textbook, and is shown in Figure \ref{fig:perform}. To help -in understanding the definition of |perform|, let's step through the -equations one at a time. - -\begin{figure} -\cbox{\small -\begin{spec} -perform :: PMap a -> Context a -> Music a -> Performance -perform pm - c@Context {cTime = t, cPlayer = pl, cDur = dt, cPch = k} m = - case m of - Prim (Note d p) -> playNote pl c d p - Prim (Rest d) -> [] - m1 :+: m2 -> - let c' = c {cTime = t + dur m1 * dt} - in perform pm c m1 ++ perform pm c' m2 - m1 :=: m2 -> merge (perform pm c m1) - (perform pm c m2) - Modify (Tempo r) m -> perform pm (c {cDur = dt / r}) m - Modify (Transpose p) m -> perform pm (c {cPch = k + p}) m - Modify (Instrument i) m -> perform pm (c {cInst = i}) m - Modify (KeySig pc mo) m -> perform pm (c {cKey = (pc,mo)}) m - Modify (Player pn) m -> perform pm (c {cPlayer = pm pn}) m - Modify (Phrase pa) m -> interpPhrase pl pm c pa m -\end{spec}} -\caption{An abstract |perform| function} -\label{fig:perform} -\end{figure} - -\begin{enumerate} -\item -The interpretation of a note is player dependent. This is handled in -|perform| using the |playNote| function, which takes the player as an -argument. Precisely how the |playNote| function works is described in -Section~\ref{sec:players}, but for now you can think of it as -returning a |Performance| (a list of events) with just one event: the -note being played. -\item -In the interpretation of |(:+:)|, note that the |Performance|s of the -two arguments are appended together, with the start time of the second -|Performance| delayed by the duration of the first (as captured in the -context |c'|). The function |dur| (defined in Section -\ref{sec:duration}) is used to compute this duration. Note that the -interpretation of |(:+:)| is well-defined even for infinite |Music| -values. -\item -In the interpretation of |(:=:)|, the |Performance|s derived from the -two arguments are merged into a time-ordered stream. The definition -of |merge| is given below: -\begin{spec} -merge :: Performance -> Performance -> Performance - -merge [] es2 = es2 -merge es1 [] = es1 -merge a@(e1:es1) b@(e2:es2) = - if e1 < e2 then e1 : merge es1 b - else e2 : merge a es2 -\end{spec} -Note that |merge| is esssentially the same as the |mergeLD| function -defined in Section~\ref{sec:lazy-rescue}. -\item -In the interpretation of |Modify|, first recall the definition of -|Control| from Chapter~\ref{sec:music}: -\begin{spec} -data Control = - Tempo Rational -- scale the tempo - | Transpose AbsPitch -- transposition - | Instrument InstrumentName -- instrument label - | Phrase [PhraseAttribute] -- phrase attributes - | Player PlayerName -- player label - | KeySig PitchClass Mode -- key signature and mode - deriving (Show, Eq, Ord) - -type PlayerName = String -data Mode = Major | Minor - deriving (Show, Eq, Ord) -\end{spec} -Each of these six constructors is handled by a separate equation in -the definition of |perform|. Note how the context is updated in each -case---the |Context|, in general, is the running ``state'' of the -performance, and gets updated in several different ways. - -Also of note is the treatment of |Phrase|. Like the playing of a -note, the playing of a phrase is player dependent. This is captured -through the function |interpPhrase|, which takes the player as an -argument. Like |playNote|, this too, along with the |PhraseAttribute| -data type, will be described in full detail in -Section~\ref{sec:players}. -\end{enumerate} - -Figure~\ref{fig:PerformBD} is a block diagram showing how |perform| -fits into the ``big picture'' of Euterpea. |Music| values are most -abstract, |Performance| values are less abstract, and MIDI or audio -streams are the least abstract. This chapter focuses on converting a -|Music| value into a |Performance|; subsequent chapters will focus on -translating a |Performance| into either MIDI (still at the ``note'' -level, and fairly straightforward) or audio (at the ``signal'' level, -and more complex). - -\begin{figure}[hbtp] -\centering -\includegraphics[height=4in]{pics/PerformBD.eps} -\caption{Block Diagram of Performance Concepts} -\label{fig:PerformBD} -\end{figure} - -%% For example, the interpretation of the |Tempo| constructor involves -%% scaling |dt| appropriately and updating the |DurT| field of the -%% context. - -\subsection{Efficiency Concerns} - -The use of |dur| in the treatment of |(:+:)| can, in the worst case, -result in a quadratic time complexity for |perform|. (Why?) A more -efficient solution is to have |perform| compute the duration directly, -returning it as part of its result. This version of |perform| is -shown in Figure \ref{fig:real-perform}. - -Aside from efficiency, there is a more abstract reason for including -duration in the result of |perform|. Namely, the performance of a -rest is not just nothing---it is a period of ``silence'' equal in -duration to that of the rest. Indeed, John Cage's famous composition -\emph{4' 33"}, in which the performer is instructed to play nothing, -would otherwise be meaningless.\footnote{In reality this piece is - meant to capture extemporaneously the sound of the environment - during that period of ``silence.'' \cite{Cage433}} - -Also note that |merge| compares entire events rather than just start -times. This is to ensure that it is commutative, a desirable -condition for some of the proofs used later in the text. Here is a -more efficient version of |merge| that will work just as well in -practice: -\begin{code} - -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 -\end{code} - -\begin{figure} -\cbox{\small -\begin{code} - -perform :: PMap a -> Context a -> Music a -> Performance -perform 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 (Player pn) m -> perf pm (c {cPlayer = pm pn}) m - Modify (Phrase pas) m -> interpPhrase pl pm c pas m - -\end{code}} -\caption{A more efficient |perform| function} -\label{fig:real-perform} -\end{figure} - -%% m1 /=: m2 -> -%% let (pf1,d1) = perf pm c m1 -%% (pf2,d2) = perf pm c m2 -%% in (merge pf1 pf2, max d1 d2) - -\section{Players} -\label{sec:players} - -%% \begin{spec} -%% module Players (module Players, module Music, module Performance) -%% where -%% import Music -%% import Performance -%% \end{spec} - -Recall from Section~\ref{sec:music} that the |Phrase| constructor in -the |Control| data type takes a list of |PhraseAttribute|s as an -argument: -\begin{spec} -data Control = ... - | Phrase [PhraseAttribute] -- phrase attributes - ... -\end{spec} -It is now time to unveil the definition of |PhraseAttribute|! Shown -fully in Figure \ref{fig:phrase-attributes}, these attributes give us -great flexibility in the interpretation process, because they can be -interpreted by different players in different ways. For example, how -should ``legato'' be interpreted in a performance? Or ``diminuendo?'' -Different human players interpret things in different ways, of course, -but even more fundamental is the fact that a pianist, for example, -realizes legato in a way fundamentally different from the way a -violinist does, because of differences in their instruments. -Similarly, diminuendo on a piano and diminuendo on a harpsichord are -very different concepts. - -\begin{figure} -\cbox{\small -\begin{spec} -data PhraseAttribute = Dyn Dynamic - | Tmp Tempo - | Art Articulation - | Orn Ornament - deriving (Show, Eq, Ord) - -data Dynamic = Accent Rational | Crescendo Rational - | Diminuendo Rational | StdLoudness StdLoudness - | Loudness Rational - deriving (Show, Eq, Ord) - -data StdLoudness = PPP | PP | P | MP | SF | MF | NF | FF | FFF - deriving (Show, Eq, Ord, Enum) - -data Tempo = Ritardando Rational | Accelerando Rational - deriving (Show, Eq, Ord) - -data Articulation = Staccato Rational | Legato Rational - | Slurred Rational | Tenuto | Marcato | Pedal - | Fermata | FermataDown | Breath | DownBow - | UpBow | Harmonic | Pizzicato | LeftPizz - | BartokPizz | Swell | Wedge | Thumb | Stopped - deriving (Show, Eq, Ord) - -data Ornament = Trill | Mordent | InvMordent | DoubleMordent - | Turn | TrilledTurn | ShortTrill - | Arpeggio | ArpeggioUp | ArpeggioDown - | Instruction String | Head NoteHead - | DiatonicTrans Int - deriving (Show, Eq, Ord) - -data NoteHead = DiamondHead | SquareHead | XHead | TriangleHead - | TremoloHead | SlashHead | ArtHarmonic | NoHead - deriving (Show, Eq, Ord) -\end{spec}} -\caption{Phrase Attributes} -\label{fig:phrase-attributes} -\end{figure} - -In addition to phrase attributes, Euterpea has a notion of \emph{note - attributes} that can similarly be interpreted in different ways by -different players. This is done by exploiting polymorphism to define -a version of |Music| that in addition to pitch, carries a list of note -attributes for each individual note: - -\begin{spec} -data NoteAttribute = - Volume Int -- MIDI convention: 0=min, 127=max - | Fingering Integer - | Dynamics String - | Params [Double] - deriving (Show, Eq) -\end{spec} -Our goal then is to define a player for music values of type: -\begin{code} -type Note1 = (Pitch, [NoteAttribute]) -type Music1 = Music Note1 -\end{code} -To facilitate the use of |Music1| values, Euterpea defines the -following simple coercion functions: -\begin{code} - -toMusic1 :: Music Pitch -> Music1 -toMusic1 = mMap (\p -> (p, [])) - -toMusic1' :: Music (Pitch, Volume) -> Music1 -toMusic1' = mMap (\(p, v) -> (p, [Volume v])) -\end{code} - -Finally, with a slight stretch of the imagination, we can even -consider the generation of a \emph{score} as a kind of player: exactly -how the music is notated on the written page may be a personal, -stylized process. For example, how many, and which staves should be -used to notate a particular instrument? - -%% As another example, the |Key| phrase attribute is needed to implement -%% a proper trill or turn, and also how to notate accidentals in a score. - -To handle these three different kinds of interpretation, Euterpea has -a notion of a \emph{player} that ``knows'' about differences with -respect to performance and notation. An Euterpean |Player| is a -four-tuple consisting of a name and three functions: one for -interpreting notes, one for phrases, and one for producing a properly -notated score: - -\pagebreak - -\begin{code} -data Player a = MkPlayer { pName :: PlayerName, - playNote :: NoteFun a, - interpPhrase :: PhraseFun a, - notatePlayer :: NotateFun a } - -type NoteFun a = Context a -> Dur -> a -> Performance -type PhraseFun a = PMap a -> Context a -> [PhraseAttribute] - -> Music a -> (Performance, DurT) -type NotateFun a = () - -instance Show a => Show (Player a) where - show p = "Player " ++ pName p -\end{code} -Note that |NotateFun| is just the unit type; this is because notation -is currently not implemented in Euterpea. Also note the instance -declaration for a |Player|---since its components are mostly -functions, which are not default instances of |Show|, we define a -simple way to return the |PlayerName|. - -\subsection{Example of Player Construction} - -In this section we define a ``default player'' called |defPlayer| (not -to be confused with a ``deaf player''!) for use when none other is -specified in a score; it also functions as a basis from which other -players can be derived. - -At the upper-most level, |defPlayer| is defined as a four-tuple: -\begin{code} -defPlayer :: Player Note1 -defPlayer = MkPlayer - { pName = "Default", - playNote = defPlayNote defNasHandler, - interpPhrase = defInterpPhrase defPasHandler, - notatePlayer = () } -\end{code} - -The remaining functions are defined in Figure -\ref{fig:default-Player}. Before reading this code, first review how -players are invoked by the |perform| function defined in the last -section; in particular, note the calls to |playNote| and -|interpPhrase|. We will define |defPlayer| to respond only to the -|Volume| note attribute and to the |Accent|, |Staccato|, and |Legato| -phrase attributes. - -\begin{figure} -\cbox{\small -\begin{code} -defPlayNote :: (Context (Pitch,[a]) -> a -> Event-> Event) - -> NoteFun (Pitch, [a]) -defPlayNote nasHandler - c@(Context cTime cPlayer cInst cDur cPch cVol cKey) d (p,nas) = - let initEv = Event { eTime = cTime, eInst = cInst, - eDur = d * cDur, eVol = cVol, - ePitch = absPitch p + cPch, - eParams = [] } - in [ foldr (nasHandler c) initEv nas ] - -defNasHandler :: Context a -> NoteAttribute -> Event -> Event -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 -\end{code}} -\caption{Definition of default player |defPlayer|.} -\label{fig:default-Player} -\end{figure} - -% defNotatePlayer :: a -> () -% defNotatePlayer _ = () - -Then note: -\begin{enumerate} -\item |defPlayNote| is the only function (even in the definition -of |perform|) that actually generates an event. It also modifies -that event based on an interpretation of each note attribute by the -function |defNasHandler|. - -\item |defNasHandler| only recognizes the |Volume| attribute, -which it uses to set the event volume accordingly. - -\item |defInterpPhrase| calls (mutually recursively) -|perform| to interpret a phrase, and then modifies the result based on -an interpretation of each phrase attribute by the function -|defPasHandler|. - -\item |defPasHandler| only recognizes the |Accent|, -|Staccato|, and |Legato| phrase attributes. For each of these it -uses the numeric argument as a ``scaling'' factor of the volume (for -|Accent|) and duration (for |Staccato| and |Legato|). Thus -|Modify (Phrase [Legato (5/4)]) m| effectively increases the duration -of each note in |m| by 25\% (without changing the tempo). -\end{enumerate} - -\subsection{Deriving New Players From Old Ones} -\label{sec:new-player} - -It should be clear that much of the code in Figure -\ref{fig:default-Player} can be re-used in defining a new player. -For example, to define a player |newPlayer| that interprets note -attributes just like |defPlayer| but behaves differently with -respect to certain phrase attributes, we could write: -\begin{spec} -newPlayer :: Player (Pitch, [NoteAttribute]) -newPlayer = MkPlayer - { pName = "NewPlayer", - playNote = defPlayNote defNasHandler, - interpPhrase = defInterpPhrase myPasHandler, - notatePlayer = () } -\end{spec} -and then supply a suitable definition of |myPasHandler|. Better yet, -we could just do this: -\begin{spec} -newPlayer :: Player (Pitch, [NoteAttribute]) -newPlayer = defPlayer - { pName = "NewPlayer", - interpPhrase = defInterpPhrase myPasHandler } -\end{spec} -This version uses the ``record update'' syntax to directly derive the -new player from |defPlayer|. - -The definition of |myPasHandler| can also re-use code, in the -following sense: suppose we wish to add an interpretation for -|Crescendo|, but otherwise have |myPasHandler| behave just like -|defPasHandler|. -\begin{spec} -myPasHandler :: PhraseAttribute -> Performance -> Performance -myPasHandler (Dyn (Crescendo x)) pf = ... -myPasHandler pa pf = defPasHandler pa pf -\end{spec} - -\todo{Explain more... in particular, how ``inheritance'' works.} - -\subsection{A Fancy Player} -\label{sec:fancy-player} - -Figure \ref{fancy-Player} defines a more sophisticated player called -|fancyPlayer| that knows all that |defPlayer| knows, and more. Note -that |Slurred| is different from |Legato| in that it does not extend -the duration of the {\em last} note(s). The behavior of |Ritardando -x| can be explained as follows. We would like to ``stretch'' the time -of each event by a factor from $0$ to $x$, linearly interpolated based -on how far along the musical phrase the event occurs. I.e., given a -start time $t_0$ for the first event in the phrase, total phrase -duration $D$, and event time $t$, the new event time $t'$ is given by: -\[ t' = (1 + \frac{t-t_0}{D}x)(t-t_0) + t_0 \] -Further, if $d$ is the duration of the event, then the end of -the event $t+d$ gets stretched to a new time $t_d'$ given by: -\[ t_d' = (1 + \frac{t+d-t_0}{D}x)(t+d-t_0) + t_0 \] -The difference $t_d' - t'$ gives us the new, stretched duration $d'$, -which after simplification is: -\[ d' = (1 + \frac{2(t-t_0)+d}{D}x)\ d \] -|Accelerando| behaves in exactly the same way, except that it -shortens event times rather than lengthening them. And a similar but -simpler strategy explains the behaviors of |Crescendo| and -|Diminuendo|. - -\pagebreak - -\section{Putting it all Together} - -The |play| function in Euterpea ueses a default player map and a -default context that are defined as follows: -\begin{code} - -defPMap :: PMap Note1 -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 } -\end{code} -Note that if anything other than a |"Fancy"| or |"Default"| player is -specified in the |Music| value, such as |player "Strange" m|, then the -default player |defPlayer| is used, and given the name |"Strange"|. - -If instead we wish to use our own player, say |newPlayer| defined -in Section \ref{sec:new-player}, then a new player map can be defined, -such as: -\begin{spec} -myPMap :: PlayerName -> Player Note1 -myPMap "NewPlayer" = newPlayer -myPMap p = defPMap p -\end{spec} - -Similarly, different versions of the context can be defined based on a -user's needs. - -We could, then, use these versions of player maps and contexts to -invoke the |perform| function to generate an abstract |Performance|. -Of course, we ultimately want to hear our music, not just see an -abstract |Performance| displayed on our computer screen. Recall -that |play|'s type signature is: -\begin{spec} -play :: Performable a => Music a -> IO () -\end{spec} -To allow using different player maps and contexts, Euterpea also has -a version of |play| called |playA| whose type signature is: -\begin{spec} -playA :: Performable a => - PMap Note1 -> Context Note1 -> Music a -> IO () -\end{spec} -For example, to play a |Music| value |m| using |myPMap| defined above -and the default context |defCon|, we can do: -\begin{spec} -playA myPMap defCon m -\end{spec} - -In later chapters we will learn more about |play|, and how it converts -a |Performance| into MIDI events that eventually are heard through -your computer's sound card. - -\vspace{.1in}\hrule - -\begin{exercise}{\em -Fill in the |...| in the definition of |myPasHandler| according to the -following strategy: Gradually scale the volume of each event in the -performance by a factor of |1| through |1+x|, using linear -interpolation.} -\end{exercise} - -\begin{exercise}{\em -Choose some of the other phrase attributes and provide interpretations -for them. - -(Hint: As in |fancyPlayer|, you may not be able to use the -``|pasHandler|'' approach to implement some of the phrase attributes. -For example, for a proper treatment of |Trill| (and similar ornaments) -you will need to access the |cKey| field in the context.)} -\end{exercise} - -\begin{exercise}{\em -Define a player |myPlayer| that appropriately handles the -|Pedal| articulation and both the |ArpeggioUp| and |ArpeggioDown| -ornamentations. You should define |myPlayer| as a derivative -of |defPlayer| or |newPlayer|.} -\end{exercise} - -\begin{exercise}{\em -Define a player |jazzMan| (or |jazzWoman| if you prefer) that plays a -melody using a jazz ``swing'' feel. Since there are different kinds -and degrees of swing, we can be more specific as follows: whenever -there is a sequence of two eighth notes, they should be interpreted -instead as a quarter note followed by an eighth note, but with tempo -3/2. So in essence, the first note is lengthened, and the second note -is shortened, so that the first note is twice as long as the second, -but they still take up the same amount of overall time. - -(Hint: There are several ways to solve this problem. One surprisingly -effective and straightforward solution is to implement |jazzMan| as a -|NoteFun|, not a |PhraseFun|. In jazz, if an eighth note falls on a -quarter-note beat it is said to fall on the ``downbeat,'' and the -eighth notes that are in between are said to fall on the ``upbeat.'' -For example, in the phrase |c 4 en :+: d 4 en :+: e 4 en :+: f 4 en|, -the C and E fall on the downbeat, and the D and F fall on the upbeat. -So to get a ``swing feel,'' the notes on the down beat need to be -lengthened, and ones on the upbeat need to be delayed and shortened. -Whether an event falls on a downbeat or upbeat can be determined from -the |cTime| and |cDur| of the context.)} -\end{exercise} - -\begin{exercise}{\em -Implement the ornamentation |DiatonicTrans|, which is intended to be a -``diatonic tranposition'' of a phrase within a particular key. The -argument to |DiatonicTrans| is an integer representing the number of -\emph{scale degrees} to do the transposition. For example, the -diatonic transposition of |c 4 en :+: d 4 en :+: e 4 en| in C major by -2 scale degrees should yield |e 4 en :+: f 4 en :+: g 4 en|, whereas -in G major should yield |e 4 en :+: fs 4 en :+: g 4 en|. - -(Hint: You will need to access the key from the context (using -|cKey|). Thus, as with |fancyPlayer|, you may not be able to use the -``|pasHandler|'' approach to solve this problem.)} -\end{exercise} - -%% but the trickier part is how to treat the |cPch| field. Once a -%% |Performance| is generated, you can think of each abolute pitch as -%% being relative to a zero offset.} - -\vspace{.1in}\hrule -\vspace{.1in} - -\begin{figure} -\todo{This code has errors and needs to be fixed.} -\cbox{\small -\begin{code} - -fancyPlayer :: Player (Pitch, [NoteAttribute]) -fancyPlayer = MkPlayer { pName = "Fancy", - playNote = defPlayNote defNasHandler, - interpPhrase = fancyInterpPhrase, - notatePlayer = () } - -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@Event {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@Event {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 -\end{code}} -\caption{Definition of Player |fancyPlayer|.} -\label{fancy-Player} -\end{figure} - -\out{ - -Generating Performances ------------------------ - -Make the default translation to Performance as a class in order to deal -with both Music Pitch and Music Note1: - -\begin{code} - -class Performable a where - perfDur :: PMap Note1 -> Context Note1 -> Music a -> (Performance, DurT) -\end{code} - -Using the defaults below, from a Music value we can generate a -Performance: - -\begin{code} - -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 -\end{code} - -} diff --git a/HSoM/Poly.lhs b/HSoM/Poly.lhs deleted file mode 100644 --- a/HSoM/Poly.lhs +++ /dev/null @@ -1,1187 +0,0 @@ -%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- - -%include lhs2TeX.fmt -%include myFormat.fmt - -\chapter[Polymorphic \& Higher-Order Functions] -{Polymorphic and Higher-Order Functions} -\label{ch:poly} - -Several examples of polymorphic data types were introduced in the last -couple of chapters. In this chapter the focus is on {\em polymorphic - functions}, which are most commonly defined over polymorphic data -types. - -The already familiar {\em list} is the protoypical example of a -polymorphic data type, and it will be studied in depth in this -chapter. Although lists have no direct musical connection, they are -perhaps the most commonly used data type in Haskell, and have many -applications in computer music programming. But in addition the -|Music| data type is polymorphic, and several new functions that -operate on it polymorphiccally will also be defined, - -(A more detailed discussion of predefined polymorphic functions that -operate on lists can be found in Appendix \ref{ch:list-tour}.) - -This chapter also introduces {\em higher-order functions}, which are -functions that take one or more functions as arguments or return a -function as a result (functions can also be placed in data -structures). Higher-order functions permit the elegant and concise -expression of many musical concepts. Together with polymorphism, -higher-order functions substantially increase the programmer's -expressive power and ability to reuse code. - -Both of these new ideas follow naturally the foundations that have -already been established. - -\section{Polymorphic Types} -\label{sec:poly-types} - -\index{polymorphism||(} \index{type!polymorphic||(} - -In previous chapters, examples of lists containing several different -kinds of elements---integers, characters, pitch classes, and so -on---were introduced, and we can well imagine situations requiring -lists of other element types. Sometimes, however, it is not necessary -to be so particular about the type of the elements. For example, -suppose we wish to define a function |length| that determines the -number of elements in a list. It does not really matter whether the -list contains integers, pitch classes, or even other lists---we can -imagine computing the length in exactly the same way in each case. -The obvious definition is: \indexhs{length} -\begin{spec} -length [] = 0 -length (x:xs) = 1 + length xs -\end{spec} -This recursive definition is self-explanatory. Indeed, we can read -the equations as saying: ``The length of the empty list is 0, and the -length of a list whose first element is |x| and remainder is |xs| is 1 -plus the length of |xs|.'' - -But what should the type of |length| be? Intuitively, we would like -to say that, for {\em any} type |a|, the type of |length| is |[a] -> -Integer|. In mathematics we might write this as: -\begin{spec} -length :: (forall a) [a] -> Integer -\end{spec} -But in Haskell this is written simply as: -\begin{spec} -length :: [a] -> Integer -\end{spec} -In other words, the universal quantification of the type variable |a| -is implicit. -\index{type!variable} -\syn{Generic names for types, such as |a| above, are called {\em -type variables}, and are uncapitalized to distinguish them from -concrete types such as |Integer|.} - -So |length| can be applied to a list containing elements of {\em -any} type. For example: -\begin{code} -length [1,2,3] ===> 3 -length [C,D,Ef ] ===> 3 -length [[1],[],[2,3,4]] ===> 3 -\end{code} -%% length "def" ===> 3 - -Note that the type of the argument to |length| in the last example -is |[[Integer]]|; that is, a list of lists of integers. - -Here are two other examples of polymorphic list functions, which -happen to be predefined in Haskell: -\indexhs{head} -\indexhs{tail} -\begin{spec} -head :: [a] -> a -head (x:_) = x - -tail :: [a] -> [a] -tail (_:xs) = xs -\end{spec} -\syn{The |_| on the left-hand side of these equations is called a - \emph{wildcard} pattern. It matches any value, and binds no - variables. It is useful as a way of documenting the fact that we - do not care about the value in that part of the pattern. Note - that we could (perhaps should) have used a wildcard in place of the - variable |x| in the definition of |length|. } - -These two functions take the ``head'' and ``tail,'' respectively, of -any non-empty list. For example: -\begin{spec} -head [ 1, 2, 3 ] ==> 1 -head [ C, D, Ef ] ==> C -tail [ 1, 2, 3 ] ==> [ 2, 3 ] -tail [ C, D, Ef ] ==> [ D, Ef ] -\end{spec} -Note that, for any non-empty list |xs|, |head| and |tail| obey the -following law: -\begin{spec} -head xs : tail xs = xs -\end{spec} - -Functions such as |length|, |head|, and |tail| are said to be -{\em polymorphic}. Polymorphic functions arise naturally when -defining functions on lists and other polymorphic data types, -including the |Music| data type defined in the last chapter. - -%% In the remainder of this chapter we will continue studying polymorphic -%% lists, but in Chapter \ref{ch:trees}, for example, we will look at -%% another polymorphic data structure, namely a {\em tree}. - -\index{type!polymorphic||)} -\index{polymorphism||)} - -\section{Abstraction Over Recursive Definitions} -\label{sec:rec-abstraction} - -Given a list of pitches, suppose we wish to convert each pitch into -an absolute pitch. We could define a function: -\begin{code} -toAbsPitches :: [Pitch] -> [AbsPitch] -toAbsPitches [] = [] -toAbsPitches (p:ps) = absPitch p : toAbsPitches ps -\end{code} - -We might also want to convert a list of absolute pitches to a list of -pitches: -\begin{code} -toPitches :: [AbsPitch] -> [Pitch] -toPitches [] = [] -toPitches (a:as) = pitch a : toPitches as -\end{code} - -These two functions are different, but share something in common: -there is a repeating pattern of operations. But the pattern is not -quite like any of the examples studied earlier, and therefore it is -unclear how to apply the abstraction principle. What distinguishes -this situation is that there is a repeating pattern of {\em - recursion}. - -In discerning the nature of a repeating pattern, recall that it is -sometimes helpful to first identify those things that {\em are not} -repeating---i.e.\ those things that are {\em changing}---since these -will be the sources of {\em parameterization}: those values that must -be passed as arguments to the abstracted function. In the case above, -these changing values are the functions |absPitch| and |pitch|; -consider them instances of a new name, |f|. Rewriting either of the -above functions as a new function---call it |map|---that takes an -extra argument |f|, yields: -\begin{spec} -map f [] = [] -map f (x:xs) = f x : map f xs -\end{spec} -This recursive pattern of operations is so common that |map| is -predefined in Haskell (and is why the name |map| was chosen in the -first place). - -With |map|, we can now redefine |toAbsPitches| and |toPitches| as: -\indexhs{map} -\begin{spec} -toAbsPitches :: [Pitch] -> [AbsPitch] -toAbsPitches ps = map absPitch ps - -toPitches :: [AbsPitch] -> [Pitch] -toPitches as = map pitch as -\end{spec} -Note that these definitions are non-recursive; the common pattern of -recursion has been abstracted away and isolated in the definition of -|map|. They are also very succinct; so much so, that it seems -unnecessary to create new names for these functions at all! One of -the powers of higher-order functions is that they permit concise yet -easy-to-understand definitions such as this, and you will see many -similar examples throughout the remainder of the text. - -A proof that the new versions of these two functions are equivalent to -the old ones can be done via calculation, but requires a proof -technique called {\em induction}, because of the recursive nature of -the original function definitions. Inductive proofs are discussed in -detail, including for these two examples, in Chapter -\ref{ch:induction}. - -\subsection{Map is Polymorphic} - -What should the type of |map| be? Looking first at its use in -|toAbsPitches|, note that it takes the function |absPitch :: Pitch -> -AbsPitch| as its first argument and a list of |Pitch|s as its second -argument, returning a list of |AbsPitch|s as its result. So its type -must be: -\begin{spec} -map :: (Pitch -> AbsPitch) -> [Pitch] -> [AbsPitch] -\end{spec} -Yet a similar analysis of its use in |toPitches| reveals that -|map|'s type should be: -\begin{spec} -map :: (AbsPitch -> Pitch) -> [AbsPitch] -> [Pitch] -\end{spec} -This apparent anomaly can be resolved by noting that |map|, like -|length|, |head|, and |tail|, does not really care what its -list element types are, {\em as long as its functional argument can be -applied to them}. Indeed, |map| is {\em polymorphic}, and its most -general type is: -\begin{spec} -map :: (a -> b) -> [a] -> [b] -\end{spec} -This can be read: ``|map| is a function that takes a function from -any type |a| to any type |b|, and a list of |a|'s, and -returns a list of |b|'s.'' The correspondence between the two -|a|'s and between the two |b|'s is important: a function that -converts |Int|'s to |Char|'s, for example, cannot be mapped over -a list of |Char|'s. It is easy to see that in the case of -|toAbsPitches|, |a| is instantiated as |Pitch| and |b| as -|AbsPitch|, whereas in |toPitches|, |a| and |b| are -instantiated as |AbsPitch| and |Pitch|, respectively. - -Note, as we did in Section \ref{sec:music}, that the above reasoning -can be viewed as the abstraction principle at work at the type level. - -\syn{In Chapter \ref{ch:intro} it was mentioned that every expression - in Haskell has an associated type. But with polymorphism, we might - wonder if there is just one type for every expression. For example, - |map| could have any of these types: -\begin{spec} -(a->b) -> [a] -> [b] -(Integer->b) -> [Integer] -> [b] -(a->Float) -> [a] -> [Float] -(Char->Char) -> [Char] -> [Char] -\end{spec} -and so on, depending on how it will be used. However, notice that the -first of these types is in some fundamental sense more general than -the other three. In fact, every expression in Haskell has a unique -type known as its \index{type!principal}{\em principal type}: the -least general type that captures all valid uses of the expression. -The first type above is the principal type of |map|, since it captures -all valid uses of |map|, yet is less general than, for example, the -type |a->b->c|. As another example, the principal type of |head| is -|[a]->a|; the types |[b]->a|, |b->a|, or even |a| are too general, -whereas something like |[Integer]->Integer| is too specific. (The -existence of unique principal types is the hallmark feature of the -{\em Hindley-Milner type system} \cite{hindley69,milner78} that forms -the basis of the type systems of Haskell, ML \cite{ML-definition} and -several other functional languages \cite{huda89a}.)} -\index{Hindley-Milner type system} - -\subsection{Using map} - -%% Now that we can picture |map| as a polymorphic function, it is -%% useful to look back on some of the examples we have worked through to -%% see if there are any situations where |map| might have been useful. -%% For example, recall from Section \ref{sec:basic-list-abstraction} the -%% definition of |totalArea|: -%% \begin{spec} -%% totalArea = listSum [circleArea r1, circleArea r2, circleArea r3] -%% \end{spec} -%% It should be clear that this can be rewritten as: -%% \begin{spec} -%% totalArea = listSum (map circleArea [r1,r2,r3]) -%% \end{spec} -%% A simple calculation is all that is needed to show that these are the -%% same: -%% \begin{spec} -%% map circleArea [r1, r2, r3] -%% ==> circleArea r1 : map circleArea [r2, r3] -%% ==> circleArea r1 : circleArea r2 : map circleArea [r3] -%% ==> circleArea r1 : circleArea r2 : circleArea r3 : map circleArea [] -%% ==> circleArea r1 : circleArea r2 : circleArea r3 : [] -%% ==> [circleArea r1, circleArea r2, circleArea r3] -%% \end{spec} - -For a musical example involving |map|, consider the task of generating -a six-note whole-tone scale starting at a given pitch:\footnote{A - whole-tone scale is a sequence of six ascending notes, with each - adjacent pair of notes separated by two semitones, i.e.\ a whole - note.} -\begin{code} -wts :: Pitch -> [Music Pitch] -wts p = let f ap = note qn (pitch (absPitch p + ap)) - in map f [0,2,4,6,8] -\end{code} -For example: -\begin{spec} -wts a440 -===> [ note qn (A,4), note qn (B,4), note qn (C#,4), - note qn (D#,4), note qn (F,4), note qn (G,4) ] -\end{spec} - -%% \syn{A list |[a,b..c]| is called an -%% {\em \indexwd{arithmetic sequence}}, and is special syntax for the -%% list |[a, a+d, a+2*d, ..., c]| where |d = b-a|.} - -\vspace{.1in}\hrule - -\begin{exercise}{\em -Using |map|, define: -\begin{enumerate} -\item A function |f1 :: Int -> [Pitch] -> [Pitch]| that transposes - each pitch in its second argument by the amount specified in its - first argument. -\item A function |f2 :: [Dur] -> [Music a]| that turns a list - of durations into a list of rests, each having the corresponding - duration. -\item A function |f3 :: [Music Pitch] -> [Music Pitch]| that - takes a list of music values (that are assumed to be single notes), - and for each such note, halves its duration and places a rest of - that same duration after it. For example: -\begin{spec} -f3 [c 4 qn, d 4 en, e 4 hn] -===> [c 4 en :+: rest en, d 4 sn :+: rest sn, e 4 qn :+: rest qn] -\end{spec} - You can think of this as giving a staccato interpretation of the - notes. -\end{enumerate} } -\end{exercise} - -\vspace{.1in}\hrule - -\section{Append} -\label{sec:append} - -Consider now the problem of {\em concatenating} or {\em - appending} two lists together; that is, creating a third list that -consists of all of the elements from the first list followed by all of -the elements of the second. Once again the type of list elements does -not matter, so we can define this as a polymorphic infix operator -|(++)|: \indexhs{(++)} -\begin{spec} -(++) :: [a] -> [a] -> [a] -\end{spec} -For example, here are two uses of |(++)| on different types: -\begin{spec} -[1,2,3] ++ [4,5,6] ===> [1,2,3,4,5,6] -[C,E,G] ++ [D,F,A] ===> [C,E,G,D,F,A] -\end{spec} - -As usual, we can approach this problem by considering the various -possibilities that could arise as input. But in the case of |(++)| -there are {\em two} inputs---so which should be considered first? In -general this is not an easy question to answer, so we could just try -the first list first: it could be empty, or non-empty. If it is empty -the answer is easy: -\begin{spec} -[] ++ ys = ys -\end{spec} -and if it is not empty the answer is also straightforward: -\begin{spec} -(x:xs) ++ ys = x : (xs++ys) -\end{spec} -Note the recursive use of |(++)|. The full definition is thus: -\begin{spec} -(++) :: [a] -> [a] -> [a] -[] ++ ys = ys -(x:xs) ++ ys = x : (xs++ys) -\end{spec} - -\syn{Note that an infix operator can be defined just as any other - function, including pattern-matching, except that on the - left-hand-side it is written using its infix syntax. - -Also be aware that this textbook takes liberty in typesetting by -displaying the append operator as |++|. When you type your code, -however, you will need to write {\tt ++}. Recall that infix operators -in Haskell must not contain any numbers or letters of the alphabet, -and also must not begin with a colon (because those are reserved to be -infix constructors).} - -If we were to consider instead the second list first, then the -first equation would still be easy: -\begin{spec} -xs ++ [] = xs -\end{spec} -but the second is not so obvious: -\begin{spec} -xs ++ (y:ys) = ?? -\end{spec} -So it seems that the right choice was made to begin with. - -Like |map|, the concatenation operator |(++)| is used so often that it -is predefined in Haskell. - -\subsection{[Advanced] The Efficiency and Fixity of Append} - -In Chapter \ref{ch:induction} the following simple property about -|(++)| will be proved: -\begin{spec} -(xs ++ ys) ++ zs = xs ++ (ys ++ zs) -\end{spec} -That is, |(++)| is {\em associative}. - -\index{efficiency} -But what about the efficiency of the left-hand and right-hand sides of -this equation? It is easy to see via calculation that appending two -lists together takes a number of steps proportional to the length of -the first list (indeed the second list is not evaluated at all). For -example: -\begin{spec} -[1,2,3] ++ xs -==> 1 : ([2,3] ++ xs) -==> 1 : 2 : ([3] ++ xs) -==> 1 : 2 : 3 : ([] ++ xs) -==> 1 : 2 : 3 : xs -\end{spec} -Therefore the evaluation of |xs ++ (ys ++ zs)| takes a number of -steps proportional to the length of |xs| plus the length of -|ys|. But what about |(xs ++ ys) ++ zs|? The leftmost append -will take a number of steps proportional to the length of |xs|, but -then the rightmost append will require a number of steps proportional -to the length of |xs| plus the length of |ys|, for a total cost -of: -\begin{spec} -2 * length xs + length ys -\end{spec} -Thus |xs ++ (ys ++ zs)| is more efficient than |(xs ++ ys) ++ zs|. -This is why the Standard Prelude defines the fixity of |(++)| as: -\begin{spec} -infixr 5 !++ -\end{spec} -In other words, if you just write |xs ++ ys ++ zs|, you will get the -most efficient association, namely the right association |xs ++ (ys ++ -zs)|. In the next section a more dramatic example of this property -will be introduced. - -\section{Fold} -\label{sec:fold} -\indexhs{fold} - -Suppose we wish to take a list of notes (each of type |Music a|) and -convert them into a \emph{line}, or \emph{melody}. We can define a -recursive function to do this as follows: -\begin{spec} -line :: [Music a] -> Music a -line [] = rest 0 -line (m:ms) = m :+: line ms -\end{spec} -Note that this function is polymorphic---the first example so far, in -fact, of a polymorphic function involving the |Music| data type. - -We might also wish to have a function |chord| that operates in an -analogous way, but using |(:=:)| instead of |(:+:)|: -\begin{spec} -chord :: [Music a] -> Music a -chord [] = rest 0 -chord (m:ms) = m :=: chord ms -\end{spec} -This function is also polymorphic. - -In a completely different context we might wish to compute the highest -pitch in a list of pitches, which we might capture in the following -way: -\begin{code} -maxPitch :: [Pitch] -> Pitch -maxPitch [] = pitch 0 -maxPitch (p:ps) = p !!! maxPitch ps -\end{code} -where |(!!!)| is defined as: -\begin{code} -p1 !!! p2 = if absPitch p1 > absPitch p2 then p1 else p2 -\end{code} - -\indexkw{if then else} -\index{conditional expression} -\syn{An expression |if pred then cons else alt| is called a {\em -conditional expression}. If |pred| (called the {\em predicate}) is -true, then |cons| (called the {\em consequence}) is the result; if -|pred| is false, then |alt| (called the {\em alternative}) is -the result.} - -Once again we have a situation where several definitions share -something in common: a repeating recursive pattern. Using the process -used earlier to discover |map|, we first identify those things that -are changing. There are two situations: the |rest 0| and |pitch 0| -values (for which the generic name |init|, for ``initial value,'' will -be used), and the |(:+:)|, |(:=:)|, and |(!!!)| operators (for which -the generic name |op|, for ``operator,'' will be used). Now rewriting -any of the above three functions as a new function---call it -|fold|---that takes extra arguments |op| and |init|, we arrive -at:\footnote{The use of the name ``|fold|'' for this function is - historical (within the functional programming community), and has - nothing to do with the use of ``fold'' and ``unfold'' in - Chapter~\ref{ch:intro} to describe steps in a calculation.} -\begin{spec} -fold op init [] = init -fold op init (x:xs) = x `op` fold op init xs -\end{spec} -\syn{Any normal binary function name can be used as an infix operator - by enclosing it in backquotes; |x `f` y| is equivalent to |f x y|. - Using infix application here for |op| better reflects the - structure of the repeating pattern that is being abstracted, but - could also have been written |op x (fold op init xs)|.} - -With this definition of |fold| we can now rewrite the definitions of -\indexwdhs{line}, \indexwdhs{chord}, and \indexwdhs{maxPitch} as: -\begin{code} -line, chord :: [Music a] -> Music a -line ms = fold (:+:) (rest 0) ms -chord ms = fold (:=:) (rest 0) ms -\end{code} - -\begin{spec} -maxPitch :: [Pitch] -> Pitch -maxPitch ps = fold (!!!) (pitch 0) ps -\end{spec} - -\syn{Just as we can turn a function into an operator by enclosing it - in backquotes, we can turn an operator into a function by enclosing - it in parentheses. This is required in order to pass an operator as - a value to another function, as in the examples above. (If we wrote - |fold !!! 0 ps| instead of |fold (!!!) 0 ps| it would look like we - were trying to apply |(!!!)| to |fold| and |0 ps|, which is - nonsensical and ill-typed.)} - -In Chapter \ref{ch:induction} we will use induction to prove that -these new definitions are equivalent to the old. - -|fold|, like |map|, is a highly useful---reusable---function, as will -be seen through several other examples later in the text. Indeed, it -too is polymorphic, for note that it does not depend on the type of -the list elements. Its most general type---somewhat trickier than -that for |map|---is: -\begin{spec} -fold :: (a->b->b) -> b -> [a] -> b -\end{spec} -This allows us to use |fold| whenever we need to ``collapse'' a -list of elements using a binary (i.e.\ two-argument) operator. - -As a final example, recall the definition of |hList| from Chapter -\ref{ch:intro}: -\begin{spec} -hList :: Dur -> [Pitch] -> Music Pitch -hList d [] = rest 0 -hList d (p:ps) = hNote d p :+: hList d ps -\end{spec} -A little thought should convince the reader that this can be rewritten as: -\begin{spec} -hList d ps = let f p = hNote d p - in line (map f ps) -\end{spec} -This version is more modular, in that it avoids explicit recursion, -and is instead built up from smaller building blocks, namely |line| -(which uses |fold|) and |map|. - -\subsection{Haskell's Folds} - -Haskell actually defines two versions of |fold| in the Standard -Prelude. The first is called \indexwdhs{foldr} -(``fold-from-the-right'') whose definition is the same as that of -|fold| given earlier: -\begin{spec} -foldr :: (a->b->b) -> b -> [a] -> b -foldr op init [] = init -foldr op init (x:xs) = x `op` foldr op init xs -\end{spec} -A good way to think about |foldr| is that it replaces all -occurrences of the list operator |(:)| with its first argument (a -function), and replaces |[]| with its second argument. In other -words: -\begin{spec} -foldr op init (x1 : x2 : ... : xn : []) -===> x1 `op` (x2 `op` (...(xn `op` init)...)) -\end{spec} -This might help in better understanding the type of |foldr|, and also -explains its name: the list is ``folded from the right.'' Stated -another way, for any list |xs|, the following always -holds:\footnote{This will be formally proved in Chapter - \ref{ch:induction}.} -\begin{spec} -foldr (:) [] xs ===> xs -\end{spec} -Haskell's second version of |fold| is called \indexwdhs{foldl}: -\begin{spec} -foldl :: (b->a->b) -> b -> [a] -> b -foldl op init [] = init -foldl op init (x:xs) = foldl op (init `op` x) xs -\end{spec} -A good way to think about |foldl| is to imagine ``folding the list -from the left:'' -\begin{spec} -foldl op init (x1 : x2 : ... : xn : []) -===> (...((init `op` x1) `op` x2)...) `op` xn -\end{spec} - -\subsection{[Advanced] Why Two Folds?} - -Note that if we had used |foldl| instead of |foldr| in the -definitions given earlier then not much would change; |foldr| and -|foldl| would give the same result. Indeed, judging from their types, it -looks like the only difference between |foldr| and |foldl| is -that the operator takes its arguments in a different order. - -So why does Haskell have two versions of |fold|? It turns out that -there are situations where using one is more efficient, and possibly -``more defined'' (that is, the function terminates on more values of -its input domain) than the other. \index{efficiency} - -Probably the simplest example of this is a generalization of the -associativity of |(++)| discussed in the last section. Suppose -we wish to collapse a list of lists into one list. The Standard -Prelude defines the polymorphic function \indexwdhs{concat} for this -purpose: -\begin{spec} -concat :: [[a]] -> [a] -concat xss = foldr (++) [] xss -\end{spec} -For example: -\begin{spec} -concat [[1],[3,4],[],[5,6]] -===> [1]++([3,4]++([]++([5,6]++[]))) -===> [1,3,4,5,6] -\end{spec} -More generally, we have that: -\begin{spec} -concat [xs1,xs2,...,xsn] -==> foldr (++) [] [xs1,xs2,...,xsn] -===> xs1 ++ (xs2 ++ ( ... (xn ++ [])) ... ) -\end{spec} -The total cost of this computation is proportional to the sum of the -lengths of all of the lists. If each list has the same length -|len|, and there are |n| lists, then this cost is |(n-1)*len|. - -On the other hand, if we had defined |concat| this way: -\begin{spec} -slowConcat xss = foldl (++) [] xss -\end{spec} -then: -\begin{spec} -slowConcat [xs1,xs2,...,xsn] -==> foldl (++) [] [xs1,xs2,...,xsn] -===> ( ... (([] ++ x1) ++ x2) ... ) ++ xn -\end{spec} -If each list has the same length |len|, then the cost of this -computation will be: -\begin{spec} -len + (len+len) + (len+len+len) + ... + (n-1)*len -= n*(n-1)*len/2 -\end{spec} -which is considerably worse than |(n-1)*len|. Thus the choice of -|foldr| in the definition of |concat| is quite important. - -Similar examples can be given to demonstrate that |foldl| is -sometimes more efficient than |foldr|. On the other hand, in many -cases the choice does not matter at all (consider, for example, -|(+)|). The moral of all this is that care must be taken in the -choice between |foldr| and |foldl| if efficiency is a concern. - -% (consider, for example, |flip (++)|!) - -\subsection{Fold for Non-empty Lists} - -In certain contexts it may be understood that the functions |line| and -|chord| should not be applied to an empty list. For such situations -the Standard Prelude provides functions |foldr1| and |foldl1|, which -return an error if applied to an empty list. And thus we may also -desire to define versions of |line| and |chord| that adopt this -behavior: - -\pagebreak - -\begin{code} -line1, chord1 :: [Music a] -> Music a -line1 ms = foldr1 (:+:) ms -chord1 ms = foldr1 (:=:) ms -\end{code} -Note that |foldr1| and |foldl1| do not take an |init| argument. - -In the case of |maxPitch| we could go a step further and say that the -previous definition is in fact flawed, for who is to say what the -maximum pitch of an empty list is? The choice of 0 was indeed -arbitrary, and in a way it is nonsensical---how can 0 be the maximum -if it is not even in the list? In such situations we might wish to -define only one function, and to have that function return an error -when presented with an empty list. For consistency with |line| and -|chord|, however, that function is defined here with a new name: -\begin{code} -maxPitch1 :: [Pitch] -> Pitch -maxPitch1 ps = foldr1 (!!!) ps -\end{code} - -\section{[Advanced] A Final Example: Reverse} -\label{sec:reverse} - -As a final example of a useful list function, consider the problem of -{\em reversing} a list, which will be captured in a function called -\indexwdhs{reverse}. This could be useful, for example, when -constructing the \emph{retrograde} of a musical passage, i.e.\ the -music as if it were played backwards. For example, |reverse -[C,D,Ef]| is |[Ef,D,C]|. - -Thus |reverse| takes a single list argument, whose possibilities -are the normal ones for a list: it is either empty, or it is not. And -thus: -\begin{spec} -reverse :: [a] -> [a] -reverse [] = [] -reverse (x:xs) = reverse xs ++ [x] -\end{spec} -This, in fact, is a perfectly good definition for |reverse|---it is -certainly clear---except for one small problem: it is terribly -inefficient! To see why, first recall that the number of steps needed -to compute |xs ++ ys| is proportional to the length of |xs|. -Now suppose that the list argument to |reverse| has length $n$. -The recursive call to |reverse| will return a list of length $n-1$, -which is the first argument to |(++)|. Thus the cost to reverse a -list of length of $n$ will be proportional to $n-1$ plus the cost to -reverse a list of length $n-1$. So the total cost is proportional to -$(n-1)+(n-2)+\cdots+1 = n(n-1)/2$, which in turn is proportional to -the square of $n$. - -Can we do better than this? In fact, yes. - -There is another algorithm for reversing a list, which can be -described intuitively as follows: take the first element, and put it -at the front of an empty auxiliary list; then take the next element -and add it to the front of the auxiliary list (thus the auxiliary list -now consists of the first two elements in the original list, but in -reverse order); then do this again and again until the end of the -original list is reached. At that point the auxiliary list will be -the reverse of the original one. - -This algorithm can be expressed recursively, but the auxiliary list -implies the need for a function that takes {\em two} arguments---the -original list and the auxiliary one---yet |reverse| only takes one. -This can be solved by creating an auxiliary function |rev|: -\begin{spec} -reverse xs = let rev acc [] = acc - rev acc (x:xs) = rev (x:acc) xs - in rev [] xs -\end{spec} -The auxiliary list is the first argument to |rev|, and is called -|acc| since it behaves as an ``accumulator'' of the intermediate -results. Note how it is returned as the final result once the end of -the original list is reached. -\index{accumulator} - -A little thought should convince the reader that this function does -not have the quadratic ($n^2$) behavior of the first algorithm, and -indeed can be shown to execute a number of steps that is directly -proportional to the length of the list, which we can hardly expect to -improve upon. - -But now, compare the definition of |rev| with the definition of -|foldl|: -\begin{spec} -foldl op init [] = init -foldl op init (x:xs) = foldl op (init `op` x) xs -\end{spec} -They are somewhat similar. In fact, suppose we were to slightly -revise the definition of |rev| as follows: -\begin{spec} -rev op acc [] = acc -rev op acc (x:xs) = rev op (acc `op` x) xs -\end{spec} -Now |rev| looks strongly like |foldl|, and the question becomes -whether or not there is a function that can be substituted for |op| -that would make the latter definition of |rev| equivalent to the -former one. Indeed there is: -\begin{spec} -revOp a b = b : a -\end{spec} -For note that: -\begin{spec} -acc `revOp` x -==> revOp acc x -==> x : acc -\end{spec} -So |reverse| can be rewritten as: -\begin{spec} -reverse xs = let rev op acc [] = acc - rev op acc (x:xs) = rev op (acc `op` x) xs - in rev revOp [] xs -\end{spec} -which is the same as: -\begin{spec} -reverse xs = foldl revOp [] xs -\end{spec} - -If all of this seems like magic, well, you are starting to see the -beauty of functional programming! - -\section{Currying} -\label{sec:currying} - -\index{function!currying||(} -We can improve further upon some of the definitions given in this -chapter using a technique called \emph{currying simplification}. To -understand this idea, first look closer at the notation used to write -function applications, such as |simple x y z|. Although, as noted -earlier, this is similar to the mathematical notation -$\mathit{simple}(x,y,z)$, in fact there is an important difference, -namely that |simple x y z| is actually shorthand for |(((simple x) y) -z)|. In other words, function application is {\em left associative}, -taking one argument at a time. - -\index{function!application} -Now look at the expression |(((simple x) y) z)| a bit closer: there is -an application of |simple| to |x|, the result of which is applied to -|y|; so |(simple x)| must be a function! The result of this -application, |((simple x) y)|, is then applied to |z|, so |((simple x) -y)| must also be a function! - -Since each of these intermediate applications yields a function, it -seems perfectly reasonable to define a function such as: -\begin{spec} -multSumByFive = simple 5 -\end{spec} -What is |simple 5|? From the above argument it is clear that it must -be a function. And from the definition of |simple| in Section -\ref{ch:intro} we might guess that this function takes two arguments, -and returns 5 times their sum. Indeed, we can {\em calculate} this -result as follows: -\begin{spec} -multSumByFive a b -==> (simple 5) a b -==> simple 5 a b -==> 5*(a+b) -\end{spec} -\index{Curry, Haskell B.} -The intermediate step with parentheses is included just for clarity. -This method of applying functions to one argument at a time, yielding -intermediate functions along the way, is called {\em currying}, after -the logician Haskell B.\ Curry who popularized the idea.\footnote{It -was actually Sch\"{o}nfinkel who first called attention to this idea -\cite{scho24}, but the word ``sch\"{o}nfinkelling'' is rather a -mouthful!} It is helpful to look at the types of the intermediate -functions as arguments are applied: -\begin{spec} -simple :: Float -> Float -> Float -> Float -simple 5 :: Float -> Float -> Float -simple 5 a :: Float -> Float -simple 5 a b :: Float -\end{spec} - -For a musical example of this idea, recall the function |note :: Dur --> Pitch -> Music Pitch|. So |note qn| is a function that, given a -pitch, yields a quarter note rendition of that pitch. A common use of -this idea is simplifying something like: -\begin{spec} -note qn p1 :+: note qn p2 :+: ... :+: note qn pn -\end{spec} -to: -\begin{spec} -line (map (note qn) [ p1, p2, ..., pn ]) -\end{spec} -Indeed, this idea is used extentively in the larger example in the -next chapter. - -\subsection{Currying Simplification} -\label{sec:currying-simplification} - -We can also use currying to improve some of the previous function -definitions as follows. Suppose that the values of |f x| and |g x| -are the same, for all values of |x|. Then it seems clear that the -functions |f| and |g| are equivalent.\footnote{In mathematics, we - would say that the two functions are \emph{extensionally - equivalent}.} So, if we wish to define |f| in terms of |g|, -instead of writing: -\begin{spec} -f x = g x -\end{spec} -We could instead simply write: -\begin{spec} -f = g -\end{spec} - -We can apply this reasoning to the definitions of |line| and |chord| -from Section \ref{sec:fold}: -\begin{spec} -line ms = fold (:+:) (rest 0) ms -chord ms = fold (:=:) (rest 0) ms -\end{spec} -Since function application is left associative, we can rewrite these as: -\begin{spec} -line ms = (fold (:+:) (rest 0)) ms -chord ms = (fold (:=:) (rest 0)) ms -\end{spec} -But now applying the same reasoning here as was used for |f| and |g| -above means that we can write these simply as: -\begin{spec} -line = fold (:+:) (rest 0) -chord = fold (:=:) (rest 0) -\end{spec} - -Similarly, the definitions of |toAbsPitches| and |toPitches| from -Section \ref{sec:rec-abstraction}: -\begin{spec} -toAbsPitches ps = map absPitch ps -toPitches as = map pitch as -\end{spec} -can be rewritten as: -\begin{spec} -toAbsPitches = map absPitch -toPitches = map pitch -\end{spec} - -Furthermore, the definition |hList|, most recently defined as: -\begin{spec} -hList d ps = let f p = hNote d p - in line (map f ps) -\end{spec} -can be rewritten as: -\begin{spec} -hList d ps = let f = hNote d - in line (map f ps) -\end{spec} -and since the definition of |f| is now so simple, we might as well -``in-line'' it: -\begin{spec} -hList d ps = line (map (hNote d) ps) -\end{spec} - -This kind of simplification will be referred to as ``currying -simplification'' or just ``currying.''\footnote{In the Lambda Calculus - this is called ``eta contraction.''} - -\syn{Some care should be taken when using this simplification idea. - In particular, note that an equation such as |f x = g x y x| - cannot be simplified to |f = g x y|, since then the remaining - |x| on the right-hand side would become undefined!} - -\subsection{[Advanced] Simplification of |reverse|} - -Here is a more interesting example, in which currying simplification -is used three times. Recall from Section \ref{sec:reverse} the -definition of |reverse| using |foldl|: -\begin{spec} -reverse xs = let revOp acc x = x : acc - in foldl revOp [] xs -\end{spec} -Using the polymorphic function \indexwdhs{flip} which is defined in the -Standard Prelude as: -\begin{spec} -flip :: (a -> b -> c) -> (b -> a -> c) -flip f x y = f y x -\end{spec} -it should be clear that |revOp| can be rewritten as: -\begin{spec} -revOp acc x = flip (:) acc x -\end{spec} -But now currying simplification can be used twice to reveal that: -\begin{spec} -revOp = flip (:) -\end{spec} -This, along with a third use of currying, allows us to rewrite the -definition of \indexwdhs{reverse} simply as: -\begin{spec} -reverse = foldl (flip (:)) [] -\end{spec} -This is in fact the way |reverse| is defined in the Standard Prelude. - -\vspace{.1in}\hrule - -\begin{exercise}{\em -Show that |flip (flip f)| is the same as |f|.} -\end{exercise} - -\begin{exercise}{\em -What is the type of |ys| in: -\begin{spec} -xs = [1,2,3] :: [Integer] -ys = map (+) xs -\end{spec} -} -\end{exercise} - -\begin{exercise}{\em -Define a function |applyEach| that, given a list of functions, -applies each to some given value. For example: -\begin{spec} -applyEach [simple 2 2, (+3)] 5 ===> [14, 8] -\end{spec} -where |simple| is as defined in Chapter \ref{ch:intro}.} -\end{exercise} - -\begin{exercise}{\em -Define a function |applyAll| that, given a list of functions -|[f1, f2, ..., fn]| and a value |v|, returns the result -|f1 (f2 (...(fn v)...))|. For example: -\begin{spec} -applyAll [simple 2 2, (+3)] 5 ===> 20 -\end{spec} -} -\end{exercise} - -\begin{exercise}{\em -Recall the discussion about the efficiency of |(++)| and -|concat| in Chapter \ref{ch:poly}. Which of the following -functions is more efficient, and why? -\begin{spec} -appendr, appendl :: [[a]] -> [a] -appendr = foldr (flip (++)) [] -appendl = foldl (flip (++)) [] -\end{spec} -} -\end{exercise} - -\vspace{.1in}\hrule - -\index{function!currying||)} - -\section{Errors} -\label{sec:errors} - -The last section suggested the idea of ``returning an error'' when the -argument to |foldr1| is the empty list. As you might imagine, there -are other situations where an error result is also warranted. - -\index{errors}\index{bottom} -There are many ways to deal with such situations, depending on the -application, but sometimes all we want to do is stop the program, -signalling to the user that some kind of an error has occurred. -In Haskell this is done with the Standard Prelude function -\indexhs{error}|error :: String -> a|. Note that |error| is -polymorphic, meaning that it can be used with any data type. The -value of the expression |error s| is |bottom|, the completely -undefined, or ``bottom'' value that was discussed in Section -\ref{sec:expressions}. As an example of its use, here is the -definition of |foldr1| from the Standard Prelude: -\begin{spec} -foldr1 :: (a -> a -> a) -> [a] -> a -foldr1 f [x] = x -foldr1 f (x:xs) = f x (foldr1 f xs) -foldr1 f [] = error "Prelude.foldr1: empty list" -\end{spec} -Thus if the anomalous situation arises, the program will terminate -immediately, and the string |"Prelude.foldr1: empty list"| will be -printed. - -%% \syn{Strings, i.e.\ sequences of characters, were briefly introduced -%% in Chapter \ref{ch:intro}. They are written between double quotes, -%% as in |"Hello World"|. -%% %% When typed on your computer, however, it will look a little -%% %% differently, as in {\tt "Hello World"} (the double-quote -%% %% character is the same at both ends of the string). -%% Strings have type \indexwdhs{String}. The |"\n"| at the end of -%% the string above is a ``newline'' character; that is, if another -%% string were printed just after this one, it would appear beginning -%% on the next line, rather than just after ``Hello World.''} - -\vspace{.1in}\hrule - -\begin{exercise}{\em -Rewrite the definition of |length| non-recursively.} -\end{exercise} - -\begin{exercise}{\em -Define a function that behaves as each of the following: -\begin{enumerate}[a)] -\item Doubles each number in a list. For example: -\begin{spec} -doubleEach [1,2,3] ===> [2,4,6] -\end{spec} -\item Pairs each element in a list with that number and one plus -that number. For example: -\begin{spec} -pairAndOne [1,2,3] ===> [(1,2),(2,3),(3,4)] -\end{spec} -\item Adds together each pair of numbers in a list. For example: -\begin{spec} -addEachPair [(1,2),(3,4),(5,6)] ===> [3,7,11] -\end{spec} -\item Adds ``pointwise'' the elements of a list of pairs. For example: -\begin{spec} -addPairsPointwise [(1,2),(3,4),(5,6)] ===> (9,12) -\end{spec} -\end{enumerate} -} -\end{exercise} - -\begin{exercise}{\em -Define a polymorphic function |fuse :: [Dur] -> [Dur -> Music a] -> -[Music a]| that combines a list of durations with a list of notes -lacking a duration, to create a list of complete notes. For example: -\begin{spec} -fuse [qn, hn, sn] [c 4, d 4, e 4] -===> [c 4 qn, d 4 hn, e 4 sn] -\end{spec} -You may signal an error if the lists have unequal lengths. } -\label{ex:fuse} -\end{exercise} - -In the next two exercises, give both recursive and (if possible) -non-recursive definitions, and be sure to include type signatures. - -\begin{exercise}{\em -Define a function |maxAbsPitch| that determines the maximum absolute -pitch of a list of absolute pitches. Define |minAbsPitch| -analogously. Both functions should return an error if applied to the -empty list.} -\end{exercise} - -\begin{exercise} -\label{ex:chrom}{\em -Define a function |chrom :: Pitch -> Pitch -> Music Pitch| such that -|chrom p1 p2| is a chromatic scale of quarter-notes whose first pitch -is |p1| and last pitch is |p2|. If |p1 > p2|, the scale should be -descending, otherwise it should be ascending. If |p1 == p2|, then the -scale should contain just one note. (A chromatic scale is one whose -successive pitches are separated by one absolute pitch (i.e.\ one -semitone)).} -\end{exercise} - -\begin{exercise} -\label{ex:mkscale}{\em -Abstractly, a scale can be described by the intervals between -successive notes. For example, the 7-note major scale can be defined -as the sequence of 6 intervals |[2,2,1,2,2,2]|, and the 12-note -chromatic scale by the 11 intervals |[1,1,1,1,1,1,1,1,1,1,1]|. Define -a function |mkScale :: Pitch -> [Int] -> Music Pitch| such that -|mkScale p ints| is the scale beginning at pitch |p| and having the -intervallic structure |ints|.} -\end{exercise} - -\begin{exercise}{\em -Define an enumerated data type that captures each of the standard -major scale modes: Ionian, Dorian, Phrygian, Lydian, Mixolydian, -Aeolian, and Locrian. Then define a function |genScale| that, given -one of these contructors, generates a scale in the intervalic form -described in Exercise \ref{ex:mkscale}.} -\end{exercise} - -\begin{exercise}{\em -Write the melody of ``Fr\`{e}re Jacques'' (or, ``Are You Sleeping'') -in Euterpea. Try to make it as succinct as possible. Then, using -functions already defined, generate a traditional four-part round, -i.e.\ four identical voices, each delayed successively by two -measures. Use a different instrument to realize each voice.} -\label{ex:frere-jacques} -\end{exercise} - -\begin{exercise}{\em -Freddie the Frog wants to communicate privately with his girlfriend -Francine by {\em encrypting} messages sent to her. Frog brains are -not that large, so they agree on this simple strategy: each character -in the text shall be converted to the character ``one greater'' than -it, based on the representation described below (with wrap-around from -255 to 0). Define functions |encrypt| and |decrypt| that will -allow Freddie and Francine to communicate using this strategy.} -\end{exercise} - -\syn{Characters are often represented inside a computer as some kind - of an integer; in the case of Haskell, a 16-bit unicode - representation is used. However, the standard keyboard is - adequately represented by a standard byte (eight bits), and thus we - only need to consider the first 256 codes in the unicode - representation. For the above exercise, you will want to use two - Haskell functions, |toEnum| and |fromEnum|. The first will convert - an integer into a character, the second will convert a character - into an integer.} - -\out{ -\begin{exercise}{\em -Suppose you are given a non-negative integer |amt| representing a -sum of money, and a list of coin denominations |[v1, v2, ..., vn]|, -each being a positive integer. Your job is to make change for -|amt| using the coins in the coin supply. Define a function -|makeChange| to solve this problem. For example, your function may -behave like this: -\begin{spec} -makeChange 99 [5,1] ==> [19,4] -\end{spec} -where |99| is the amount and |[5,1]| represents the types of coins -(say, nickels and pennies in US currency) that are available. The -answer |[19,4]| means that we can make the exact change with |19| -|5|-unit coins and |4| single-unit coins; this is the best possible -solution (in terms of the total number of coins). - -To make things slightly easier, you may assume that the list -representing the coin denominations is given in descending order, and -that the single-unit coin is always one of the coin types.} -\end{exercise} -} diff --git a/HSoM/Preface.lhs b/HSoM/Preface.lhs deleted file mode 100644 --- a/HSoM/Preface.lhs +++ /dev/null @@ -1,217 +0,0 @@ -%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- - -\chapter{Preface} - -In 2000 I wrote a book called \emph{The Haskell School of - Expression -- Learning Functional Programming through Multimedia} -\cite{soe}. In that book I used graphics, animation, music, and -robotics as a way to motivate learning how to program, and -specifically how to learn \emph{functional programming} using Haskell, -a purely functional programming language. Haskell \cite{haskell98} is -quite a bit different from conventional imperative or object-oriented -languages such as C, C$++$, Java, C\#, and so on. It takes a different -mind-set to program in such a language, and appeals to the -mathematically inclined and to those who seek purity and elegance in -their programs. Although Haskell was designed over twenty years ago, -it has only recently begun to catch on in a significant way, not just -because of its purity and elegance, but because with it you can solve -real-world problems quickly and efficiently, and with great economy of -code. - -I have also had a long, informal, yet passionate interest in music, -being an amateur jazz pianist and having played in several bands over -the years. About fifteen years ago, in an effort to combine work with -play, I and my students wrote a Haskell library called \emph{Haskore} -for expressing high-level computer music concepts in a purely -functional way \cite{haskore,haskore-tutorial,haskore-fop}. Indeed, -three of the chapters in \emph{The Haskell School of Expression} -summarize the basic ideas of this work. Soon after that, with the -help of another student, I designed a Haskell library called -\emph{HasSound} that was, essentially, a Haskell interface to -\emph{csound} \cite{csound} for doing sound synthesis and instrument -design. - -Thus, when I recently became responsible for the Music Track in the -new \emph{Computing and the Arts} major at Yale, and became -responsible for teaching not one, but two computer music courses in -the new curriculum, it was natural to base the course material on -Haskell. This current book is a rewrite of \emph{The Haskell School - of Expression} with a focus on computer music, based on, and greatly -improving upon, the ideas in Haskore and HasSound. The new Haskell -library that incorporates all of this is called \emph{Euterpea}. - -\index{Curry, Haskell B.} Haskell was named after the logician -Haskell B.\ Curry who, along with Alonzo Church, helped establish -the theoretical foundations of functional programming in the 1940's, -when digital computers were mostly just a gleam in researchers' eyes. -A curious historical fact is that Haskell Curry's father, Samuel Silas -Curry, helped found and direct a school in Boston called the {\em - School of Expression}. (This school eventually evolved into what is -now {\em Curry College}.) Since pure functional programming is -centered around the notion of an {\em expression}, I thought that {\em - The Haskell School of Expression} would be a good title for my first -book. And it was thus quite natural to choose \emph{The Haskell - School of Music} for my second! - -\section*{How To Read This Book} - -As mentioned earlier, there is a certain mind-set, a certain viewpoint -of the world, and a certain approach to problem solving that -collectively work best when programming in Haskell (this is true for -any programming paradigm). If you teach only Haskell language details -to a C programmer, he or she is likely to write ugly, incomprehensible -functional programs. But if you teach how to think differently, how -to see problems in a different light, functional solutions will come -easily, and elegant Haskell programs will result. As Samuel Silas -Curry once said: -\begin{quote} -All expression comes {\em from within outward}, from the center to the -surface, from a hidden source to outward manifestation. The study of -expression as a natural process brings you into contact with cause and -makes you feel the source of reality. -\end{quote} -What is especially beautiful about this quote is that music is also a -form of expression, although Curry was more likely talking about -writing and speaking. In addition, as has been noted by many, music -has many ties to mathematics. So for me, combining the elegant -mathematical nature of Haskell with that of music is as natural as -singing a nursery tune. - -Using a high-level language to express musical ideas is, of course, -not new. But Haskell is unique in its insistence on purity (no side -effects), and this alone makes it particularly suitable for expressing -musical ideas. By focusing on \emph{what} a musical entity is rather -than on \emph{how} to create it, we allow musical ideas to take their -natural form as Haskell expressions. Haskell's many abstraction -mechanisms allow us to write computer music programs that are elegant, -concise, yet powerful. We will consistently attempt to let the music -express itself as naturally as possible, without encoding it in terms -of irrelevant language details. - -Of course, my ultimate goal is not just to teach computer music -concepts. Along the way you will also learn Haskell. There is no -limit to what one might wish to do with computer music, and therefore -the better you are at programming, the more success you will have. -This is why I think that many languages designed specifically for -computer music---although fun to work with, easy to use, and cute in -concept---face the danger of being too limited in expressiveness. - -You do not need to know much, if any, music theory to read this book, -and you do not need to play an instrument. Of course, the more you -know about music, the more you will be able to apply the concepts -learned in this text in musically creative ways. - -My general approach to introducing computer music concepts is to first -provide an intuitive explanation, then a mathematically rigorous -definition, and finally fully executable Haskell code. -% It will often be the case that there is a close correspondence -% between the mathematical definition and the Haskell code. -In the process I introduce Haskell features as they are needed, rather -than all at once. I believe that this interleaving of concepts and -applications makes the material easier to digest. - -Another characteristic of my approach is that I do not hide any -details---I want Euterpea to be as transparent as possible! There are -no magical built-in operations, no special computer music commands or -values. This works out well for several reasons. First, there is in -fact nothing ugly or difficult to hide---so why hide anything at all? -Second, by reading the code, you will better and more quickly -understand Haskell. Finally, by stepping through the design process -with me, you may decide that you prefer a different approach---there -is, after all, no One True Way to express computer music ideas. I -expect that this process will position you well to write rich, -creative musical applications on your own. - -I encourage the seasoned programmer having experience only with -conventional imperative and/or object-oriented languages to read this -text with an open mind. Many things will be different, and will -likely feel awkward. There will be a tendency to rely on old habits -when writing new programs, and to ignore suggestions about how to -approach things differently. If you can manage to resist those -tendencies I am confident that you will have an enjoyable learning -experience. Those who succeed in this process often find that many -ideas about functional programming can be applied to imperative and -object-oriented languages as well, and that their imperative coding -style changes for the better. - -I also ask the experienced programmer to be patient while in the -earlier chapters I explain things like ``syntax,'' ``operator -precedence,'' etc., since it is my goal that this text should be -readable by someone having only modest prior programming experience. -With patience the more advanced ideas will appear soon enough. - -If you are a novice programmer, I suggest taking your time with the -book; work through the exercises, and don't rush things. If, however, -you don't fully grasp an idea, feel free to move on, but try to -re-read difficult material at a later time when you have seen more -examples of the concepts in action. For the most part this is a -``show by example'' textbook, and you should try to execute as many of -the programs in this text as you can, as well as every program that -you write. Learn-by-doing is the corollary to show-by-example. - -Finally, I note that some section titles are prefaced with the -parenthetical phrase, ``{\bf [Advanced]}''. These sections may be -skipped upon first reading, especially if the focus is on learning -computer music concepts, as opposed to programming concepts. - -\section*{Haskell Implementations} - -There are several implementations of Haskell, all available free on -the Internet through the Haskell users' website at -\url{http://haskell.org}. However, the one that has dominated all -others, and on which Euterpea is based, is \emph{\indexwd{GHC}}, an -easy-to-use and easy-to-install Haskell compiler and interpreter (see -\url{http://haskell.org/ghc}). GHC runs on a variety of platforms, -including PC's, various flavors of Unix, and Macs. The preferred way -to install GHC is through the \emph{Haskell Platform} -(\url{http://hackage.haskell.org/platform/}). Any text editor can be -used to create source files, but I prefer to use emacs (see -\url{http://www.gnu.org/software/emacs}), along with its Haskell mode -(see \url{http://projects.haskell.org/haskellmode-emacs/}). The -entire Euterpea library, including the source code from this textbook, -and installation instructions, can be found at -\url{http://haskell.cs.yale.edu}. - -\newpage - -\section*{Acknowledgements} - -I wish to thank my funding agencies---the National Science Foundation, -the Defense Advanced Research Projects Agency, and Microsoft -Research---for their generous support of research that contributed to -the foundations of Euterpea. Yale University has provided me a -stimulating and flexible environment to pursue my dreams for over -thirty years, and I am especially thankful for its recent support of -the Computing and the Arts initiative. - -Tom Makucevich, a talented computer music practitioner and composer in -New Haven, was the original motivator, and first user, of Haskore, -which preceded Euterpea. Watching him toil endlessly with low-level -csound programs was simply too much for me to bear! Several -undergraduate students at Yale contributed to the original design and -implementation of Haskore. I would like to thank in particular the -contributions of Syam Gadde and Bo Whong, who co-authored the original -paper on Haskore. Additionally, Matt Zamec helped me greatly in the -creation of HasSound. - -I wish to thank my more recent graduate students, in particular Hai -(Paul) Liu, Eric Cheng, Donya Quick, and Daniel Winograd-Cort for -their help in writing much of the code that constitutes the current -Euterpea library. In addition, many students in my computer music -classes at Yale provided valuable feedback through earlier drafts of -the manuscript. - -% Also thanks to Serge Lehuitouze and ... for their comments on the -% text. - -Finally, I wish to thank my wife, Cathy Van Dyke, my best friend and -ardent supporter, whose love, patience, and understanding have helped -me get through some bad times, and enjoy the good. - -\vspace{0.1in} -{\noindent}Happy Haskell Music Making! - -\vspace{0.1in} -{\noindent}Paul Hudak\newline -New Haven\newline -January 2012 diff --git a/HSoM/QualifiedTypes.lhs b/HSoM/QualifiedTypes.lhs deleted file mode 100644 --- a/HSoM/QualifiedTypes.lhs +++ /dev/null @@ -1,1069 +0,0 @@ -%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- - -%include lhs2TeX.fmt -%include myFormat.fmt - -\chapter{Qualified Types and Type Classes} -\label{ch:qualified-types} - -This chapter introduces the notions of \emph{qualified types} and -\emph{type classes}. These concepts can be viewed as a refinement of -the notion of polymorphism, and increase the ability to write modular -programs. - -\section{Motivation} -\label{sec:qualified-types} - -A polymorphic type such as |(a->a)| can be viewed as shorthand for -$\forall($|a|$)|a->a|$, which can be read ``\emph{for all} types |a|, -functions mapping elements of type |a| to elements of type |a|.'' -Note the emphasis on ``\emph{for all}.'' - -In practice, however, there are times when we would prefer to limit a -polymorphic type to a smaller number of possibilities. A good example -is a function such as |(+)|. It is probably not a good idea to limit -|(+)| to a \emph{single} (that is, \emph{monomorphic}) type such as -|Integer->Integer->Integer|, since there are other kinds of -numbers---such as rational and floating-point numbers---that we would -like to perform addition on as well. Nor is it a good idea to have a -different addition function for each number type, since that would -require giving each a different name, such as |addInteger|, -|addRational|, |addFloat|, etc. And, unfortunately, giving |(+)| a -type such as |a->a->a| will not work, since this would imply that we -could add things other than numbers, such as characters, pitch -classes, lists, tuples, functions, and any type that we might define -on our own! - -\index{type!qualified} \index{class} - -Haskell provides a solution to this problem through the use of {\em - qualified types}. Conceptually, it is helpful to think of a -qualified type just as a polymorphic type, except that in place of -``\emph{for all} types |a|'' it will be possible to say ``for all -types |a| \emph{that are members of the type class} |C|,'' where the -type class |C| can be thought of as a set of types. For example, -suppose there is a type class \indexwdhs{Num} with members |Integer|, -|Rational|, and |Float|. Then an accurate type for |(+)| would be -$\forall($|a|$\in$|Num|$)$|a -> a -> a|. But in Haskell, instead of -writing $\forall(|a|\in|Num|)\cdots$, the notation |Num a =>|$\cdots$ -is used. So the proper type signature for |(+)| is: -\begin{spec} -(+) :: Num a => a -> a -> a -\end{spec} -which should be read: ``for all types |a| that are members of the type -class |Num|, |(+)| has type |a -> a -> a|.'' Members of a type class -are also called \emph{instances} of the class, and these two terms -will be used interchangeably in the remainder of the text. The |Num a -=>|$\cdots$ part of the type signature is often called a -\emph{context}, or \emph{constraint}. - -\index{class} -\syn{It is important not to confuse |Num| with a data type or a -constructor within a data type, even though the same syntax -(``|Num a|'') is used. |Num| is a \emph{type class}, and the -context of its use (namely, to the left of a |=>|) is always -sufficient to determine this fact.} - -Recall now the type signature given for the function |simple| in -Chapter~\ref{ch:intro}: -\begin{spec} -simple :: Integer -> Integer -> Integer -> Integer -simple x y z = x*(y+z) -\end{spec} -Note that |simple| uses the operator |(+)| discussed above. It also -uses |(*)|, whose type is the same as that for |(+)|: -\begin{spec} -(*) :: Num a => a -> a -> a -\end{spec} -This suggests that a more general type for |simple| is: -\begin{spec} -simple :: Num a => a -> a -> a -> a -simple x y z = x*(y+z) -\end{spec} -Indeed, this is the preferred, most general type that can be given for -|simple|. It can now be used with any type that is a member of the -|Num| class, which includes |Integer|, |Int|, |Rational|, |Float| and -|Double|, among others. - -The ability to qualify polymorphic types is a unique feature of -Haskell, and, as we will soon see, provides great expressiveness. In -the following sections the idea is explored much more thoroughly, and -in particular it is shown how a programmer can define his or her own -type classes and their instances. To begin, let's take a closer look -at one of the pre-defined type classes in Haskell, having to do with -equality. - -\section{Equality} -\label{sec:equality} - -\index{equality} \emph{Equality} between two expressions |e1| and |e2| -in Haskell means that the value of |e1| is the same as the value of -|e2|. Another way to view equality is that we should be able to -substitute |e1| for |e2|, or vice versa, wherever they appear in a -program, without affecting the result of that program. - -In general, however, it is not possible for a program to determine the -equality of two expressions---consider, for example, determining the -equality of two infinite lists, two infinite |Music| values, or two -functions of type |Integer -> Integer|.\footnote{This is the same as - determining \emph{program equivalence}, a well-known example of an - \emph{undecideable problem} in the theory of computation.} The -ability to compute the equality of two values is called -\emph{computational equality}. Even though by the above simple -examples it is clear that computational equality is strictly weaker -than full equality, it is still an operation that we would like to -use in many ordinary programs. - -\indexhs{(==)} - -Haskell's operator for computational equality is |(==)|. Partly -because of the problem mentioned above, there are many types for which -we would like equality defined, but some for which it might not make -sense. For example, it is common to compare two characters, two -integers, two floating-point numbers, etc.\ On the other hand, -comparing the equality of infinite data structures, or functions, is -difficult, and in general not possible. Thus Haskell has a type class -called |Eq|, so that the equality operator |(==)| can be given the -qualified type: \indexhs{Eq} -\begin{spec} -(==) :: Eq a => a -> a -> Bool -\end{spec} - -In other words, |(==)| is a function that, for any type |a| in -the class |Eq|, tests two values of type |a| for equality, -returning a Boolean (|Bool|) value as a result. Amongst |Eq|'s -instances are the types \indexwdhs{Char} and \indexwdhs{Integer}, so -that the following calculations hold: -\begin{spec} -42 == 42 ==> True -42 == 43 ==> False -'a' == 'a' ==> True -'a' == 'b' ==> False -\end{spec} -Furthermore, the expression |42 ==| |'a'| is {\em -\indexwd{ill-typed}}; Haskell is clever enough to know when qualified -types are ill-formed. - -One of the nice things about qualified types is that they work in the -presence of ordinary polymorphism. In particular, the type -constraints can be made to propagate through polymorphic data types. -For example, because |Integer| and |Float| are members of -|Eq|, so are the types |(Integer,Char)|, |[Integer]|, -|[Float]|, etc. Thus: -\begin{spec} -[42,43] == [42,43] ==> True -[4.2,4.3] == [4.3,4.2] ==> False -(42,'a') == (42,'a') ==> True -\end{spec} -This will be elaborated upon in a later section. - -Type constraints also propagate through function definitions. For -example, consider this definition of the function |`elem`| that -tests for membership in a list: -\begin{spec} -x `elem` [] = False -x `elem` (y:ys) = x==y || x `elem` ys -\end{spec} - -\syn{|(`elem`)| is actually written |elem| in Haskell; i.e.\ it is a - normal function, not an infix operator. Of course it can be used - in an infix manner (and it often is) by enclosing it in backquotes.} - -Note the use of |(==)| on the right-hand side of the second -equation. The principal type for |(`elem`)| is thus: -\begin{spec} -`elem` :: Eq a => a -> [a] -> Bool -\end{spec} -This should be read, ``For every type |a| that is an instance of the -class |Eq|, |(`elem`)| has type |a->[a]->Bool|.'' This is exactly what -we would hope for---it expresses the fact that |(`elem`)| is not defined -on all types, just those for which computational equality is defined. - -The above type for |(`elem`)| is also its principal type, and Haskell -will infer this type if no signature is given. Indeed, if we were to -write the type signature: -\begin{spec} -(`elem`) :: a -> [a] -> Bool -\end{spec} -a type error would result, because this type is fundamentally -\emph{too general}, and the Haskell type system will complain. - -\syn{On the other hand, we could write: -\begin{spec} -(`elem`) :: Integer -> [Integer] -> Bool -\end{spec} -if we expect to use |(`elem`)| only on lists of integers. In other -words, using a type signature to constrain a value to be less general -than its principal type is Ok.} - -As another example of this idea, a function that squares its argument: -\begin{spec} -square x = x*x -\end{spec} -has principal type |Num a => a -> a|, since |(*)|, like -|(+)|, has type \newline -|Num a => a -> a -> a|. Thus: -\begin{spec} -square 42 ==> 1764 -square 4.2 ==> 17.64 -\end{spec} -The |Num| class will be discusssed in greater detail shortly. - -\section{Defining Our Own Type Classes} -\label{sec:type-class-decls} - -Haskell provides a mechanism whereby we can create our own qualified -types, by defining a new type class and specifying which types are -members, or ``instances'' of it. Indeed, the type classes |Num| -and |Eq| are not built-in as primitives in Haskell, but rather are -simply predefined in the Standard Prelude. - -To see how this is done, consider the |Eq| class. It is created by -the following \emph{type class declaration}: -\index{class!\hkw{class}} -\index{class!declaration} -\begin{spec} -class Eq a where - (==) :: a -> a -> Bool -\end{spec} -\index{class!operation} -The connection between |(==)| and |Eq| is important: the above -declaration should be read, ``a type |a| is an instance of the class -|Eq| only if there is an operation |(==)::a->a->Bool| defined on it.'' -|(==)| is called an \emph{operation} in the class |Eq|, and in general -more than one operation is allowed in a class. More examples of this -will be introduced shortly. - -\index{class!instance} -So far so good. But how do we specify which types are instances of -the class |Eq|, and the actual behavior of |(==)| on each of those -types? This is done with an \emph{instance declaration}. For example: -\begin{spec} -instance Eq Integer where - x == y = integerEq x y -\end{spec} -\index{class!method} - -The definition of |(==)| is called a \emph{method}. The function -|integerEq| happens to be the primitive function that compares -integers for equality, but in general any valid expression is allowed -on the right-hand side, just as for any other function definition. -The overall instance declaration is essentially saying: ``The type -|Integer| is an instance of the class |Eq|, and here is the method -corresponding to the operation |(==)|.'' Given this declaration, we -can now compare fixed-precision integers for equality using |(==)|. -Similarly: -\begin{spec} -instance Eq Float where - x == y = floatEq x y -\end{spec} -allows us to compare floating-point numbers using |(==)|. - -More importantly, datatypes that we have defined on our own can also -be made instances of the class |Eq|. Consider, for example, the -|PitchClass| data type defined in Chapter \ref{ch:music}: -\begin{spec} -data PitchClass = Cff | Cf | C | Dff | Cs | Df | Css | D | Eff | Ds - | Ef | Fff | Dss | E | Ff | Es | F | Gff | Ess | Fs - | Gf | Fss | G | Aff | Gs | Af | Gss | A | Bff | As - | Bf | Ass | B | Bs | Bss -\end{spec} -We can declare |PitchClass| to be an instance of |Eq| as follows: -\begin{spec} -instance Eq PitchClass where - Cff == Cff = True - Cf == Cf = True - C == C = True - ... - Bs == Bs = True - Bss == Bss = True - _ == _ = False -\end{spec} -where |...| refers to the other thirty equations needed to make this -definition complete. Indeed, this is rather tedious! It is not only -tedious, it is also dead obvious how |(==)| should be defined. - -\subsection{Derived Instances} -\label{sec:derived-instances} - -To alleviate the burden of defining instances such as above, Haskell -provides a convenient way to \emph{automatically derive} such instance -declarations from data type declarations, for certain predefined type -classes. This is done using a |deriving| clause. For example, in the -case of |PitchClass| we can simply write: -\begin{spec} - -data PitchClass = Cff | Cf | C | Dff | Cs | Df | Css | D | Eff | Ds - | Ef | Fff | Dss | E | Ff | Es | F | Gff | Ess | Fs - | Gf | Fss | G | Aff | Gs | Af | Gss | A | Bff | As - | Bf | Ass | B | Bs | Bss - deriving Eq -\end{spec} -With this declaration, Haskell will automatically derive the instance -declaration given above, so that |(==)| behaves in the way we would -expect it to. - -Consider now a polymorphic type, such as the |Primitive| type from -Chapter \ref{ch:music}: -\begin{spec} -data Primitive a = Note Dur a - | Rest Dur -\end{spec} -What should an instance for this type in the class |Eq| look like? -Here is a first attempt: -\begin{spec} -instance Eq (Primitive a) where - Note d1 x1 == Note d2 x2 = (d1==d2) && (x1==x2) - Rest d1 == Rest d2 = d1==d2 - _ == _ = False -\end{spec} -Note the use of |(==)| on the right-hand side, in several places. Two -of those places involve |Dur|, which a type synonym for |Rational|. -The |Rational| type is in fact a predefined instance of |Eq|, so all -is well there. (If it were not an instance of |Eq|, a type error -would result.) - -But what about the term |x1==x2|? |x1| and |x2| are values of the -polymorphic type |a|, but how do we know that equality is defined -on |a|, i.e.\ that the type |a| is an instance of |Eq|? In fact this -is not known in general. The simple fix is to add a constraint to the -instance declaration, as follows: -\begin{spec} -instance Eq a ==> Eq (Primitive a) where - Note d1 x1 == Note d2 x2 = (d1==d2) && (x1==x2) - Rest d1 == Rest d2 = d1==d2 - _ == _ = False -\end{spec} -This can be read, ``For any type |a| in the class |Eq|, the type -|Primitive a| is also in the class |Eq|, and here is the definition of -|(==)| for that type.'' Indeed, if we had written the original type -declaration like this: -\begin{spec} -data Primitive a = Note Dur a - | Rest Dur - deriving Eq -\end{spec} -then Haskell would have derived the above correct instance declaration -automatically. - -So, for example, |(==)| is defined on the type |Primitive Pitch|, -because |Pitch| is a type synonym for |(PitchClass, Octave)|, and (a) -|PitchClass| is an instance of |Eq| by the effort above, (b) |Octave| -is a synonym for |Int|, which is a predefined instance of |Eq|, and -(c) as mentioned earlier the pair type is a predefined instance of -|Eq|. Indeed, now that an instance for a polymorphic type has been -seen, we can understand what the predefined instance for polymorphic -pairs must look like, namely: -\begin{spec} -instance (Eq a, Eq b) => Eq (a,b) where - (x1,y1) == (x2,y2) = (x1==x2) && (y1==y2) -\end{spec} - -About the only thing not considered is a \emph{recursive} data type. -For example, recall the |Music| data type, also from Chapter -\ref{ch:music}: -\begin{spec} -data Music a = Prim (Primitive a) - | Music a :+: Music a - | Music a :=: Music a - | Modify Control (Music a) -\end{spec} -Its instance declaration for |Eq| seems obvious: -\begin{spec} -instance Eq a => Eq (Music a) where - Prim p1 == Prim p2 = p1==p2 - (m1 :+: m2) == (m3 :+: m4) = (m1 == m3) && (m2 == m4) - (m1 :=: m2) == (m3 :=: m4) = (m1 == m3) && (m2 == m4) - Modify c1 m1 == Modify c2 m2 = (c1 == c2) && (m1 == m2) -\end{spec} -Indeed, assuming that |Control| is an instance of |Eq|, this is just -what is expected, and can be automatically derived by adding a -|deriving| clause to the data type declaration for |Music|. - -\subsection{Default Methods} -\label{sec:default-methods} - -In reality, the class \indexwdhs{Eq} as defined in Haskell's Standard -Prelude is slightly richer than what is defined above. Here it is -in its exact form: \indexhs{(/=)} -\begin{spec} -class Eq a where - (==), (/=) :: a -> a -> Bool - x /= y = not (x == y) - x == y = not (x /= y) -\end{spec} -\index{class!default method} - -This is an example of a class with two operations, one for equality, -the other for inequality. It also demonstrates the use of a -\emph{default method}, one for each operator. If a method for a -particular operation is omitted in an instance declaration, then the -default one defined in the class declaration, if it exists, is used -instead. For example, all of the instances of |Eq| defined earlier -will work perfectly well with the above class declaration, yielding -just the right definition of inequality that we would expect: the -logical negation of equality. - -\syn{Both the inequality and the logical negation operators are shown - here using the mathematical notation, |/=| and |not|, respectively. - When writing your Haskell programs, you instead will have to use the - operator {\tt /=} and the function name {\tt not}, respectively.} - -A useful slogan that helps to distinguish type classes from ordinary -polymorphism is this: ``polymorphism captures similar structure over -different values, while type classes capture similar operations over -different structures.'' For example, a sequences of integers, -sequence of characters, etc.\ can be captured as a polymorphic |List|, -whereas equality of integers, equality of trees, etc.\ can be captured -by a type class such as |Eq|. - -\subsection{Inheritance} -\label{sec:inheritance} - -\index{class!inheritance} - -Haskell also supports a notion called \emph{inheritance}. For -example, we may wish to define a class \indexwdhs{Ord} that -``inherits'' all of the operations in |Eq|, but in addition has a set -of comparison operations and minimum and maximum functions (a fuller -definition of |Ord|, as taken from the Standard Prelude, is given in -Appendix \ref{ch:class-tour}): -\begin{spec} -class Eq a => Ord a where - (<), (<=), (>=), (>) :: a -> a -> Bool - max, min :: a -> a -> a -\end{spec} -\index{class!superclass} -\index{class!subclass} - -Note the constraint |Eq a =>| in the |class| declaration. |Eq| is a -\emph{superclass} of |Ord| (conversely, |Ord| is a \emph{subclass} of -|Eq|), and any type that is an instance of |Ord| must also be an -instance of |Eq|. The reason that this extra constraint makes sense -is that to perform comparisons such as |a<=b| and |a>=b| implies that -we know how to compute |a==b|. - -For example, following the strategy used for |Eq|, we could declare -|Music| an instance of |Ord| as follows (note the constraint |Ord a => -...|): -\begin{spec} -instance Ord a => Ord (Music a) where - Prim p1 < Prim p2 = p1 < p2 - (m1 :+: m2) < (m3 :+: m4) = (m1 [a] -> [a] -\end{spec} -This typing for |sort| would naturally arise through the use of -comparison operators such as |<| and |>=| in its definition. - -\syn{Haskell also permits \emph{multiple inheritance}, since classes -may have more than one superclass. Name conflicts are avoided by the -constraint that a particular operation can be a member of at most one -class in any given scope. For example, the declaration -\begin{spec} -class (Eq a, Show a) => C a where ... -\end{spec} -creates a class |C| that inherits operations from both |Eq| and -|Show|. - -% Contexts are also allowed in |data| declarations; see -% Section \ref{datatype-decls}. - -Finally, class methods may have additional class constraints on any -type variable except the one defining the current class. For example, -in this class: -\begin{spec} -class C a where - m :: Eq b => a -> b -\end{spec} -the method |m| requires that type |b| is in class |Eq|. -However, additional class constraints on type |a| are not allowed -in the method |m|; these would instead have to be part of the -overall constraint in the class declaration.} - -\section{Haskell's Standard Type Classes} -\label{sec:standard-type-classes} - -The Standard Prelude defines many useful type classes, including |Eq| -and |Ord|. They are described in detail in Appendix -\ref{ch:class-tour}. In addition, the Haskell Report and the Library -Report contain useful examples and discussions of type classes; you -are encouraged to read through them. - -Most of the standard type classes in Haskell are shown in -Figure~\ref{fig:common-type-classes}, along with their key instances. -Since each of these has various default mthods defined, also shown is -the minimal set of methods that must defined---the rest are taken care -of by the default methods. For example, for |Ord|, all we have to -provide is a definition for |(<=)|. - -The \indexwdhs{Num} class, which has been used implicitly throughout -much of the text, is described in more detail below. With this -explanation a few more of Haskell's secrets will be revealed. - -\begin{figure} -\begin{tabular}{||||l||l||l||||} \hline -{\bf Type} & {\bf Key} & {\bf Key} \\ -{\bf Class} & {\bf functions} & {\bf instances} \\ -\hline -|Num| & |(+),(-),(*) :: Num a => a->a->a| & |Integer, Int, Float, Double,| \\ - & |negate :: Num a => a->a| & |Rational| \\ - & minimal set: all but |(-)| or |negate| & \\ -\hline -|Eq| & |(==),(/=) :: Eq a => a->a->Bool| & |Integer, Int, Float, Double,| \\ - & & |Rational, Char, Bool, ... | \\ - & minimal set: either |(==)| or |(/=)| & \\ -\hline -|Ord| & |(>),(<),(>=),(<=) ::| & |Integer, Int, Float, Double,| \\ - & \ \ \ \ |Ord a => a->a->Bool| & |Rational, Char, Bool, ... | \\ - & |max,min :: Ord a => a->a->a | & \\ - & minimal set: |(<=)| & \\ -\hline -|Enum| & |succ,pred :: Enum a => a->a| & |Integer, Int, Float, Double,| \\ - & |fromEnum :: Enum a => a -> Int| & |Rational, Char, Bool, ... | \\ - & |toEnum :: Enum a => Int -> a | & \\ - & also enables arithmetic sequences & \\ - & minimal set: |toEnum| \& |fromEnum| & \\ -\hline -|Bounded| & |minBound,maxBound :: a| & |Int, Char, Bool| \\ -\hline -|Show| & |show :: Show a => a -> String| & Almost every type except \\ - & & for functions \\ -\hline -|Read| & |read :: Read a => String -> a| & Almost every type except \\ - & & for functions \\ -\hline -\end{tabular} -\caption{Common Type Classes and Their Instances} -\label{fig:common-type-classes} -\end{figure} - -\subsection{The |Num| Class} -\label{sec:num-class} - -As we already know, Haskell provides several kinds of numbers, some of -which have already been introduced: |Int|, |Integer|, |Rational|, and -|Float|. These numbers are instances of various type classes arranged -in a rather complicated hierarchy. The reason for this is that there -are many operations, such as |(+)|, |abs|, and |sin|, that are common -amongst some of these number types. For example, we would expect -|(+)| to be defined on every kind of number, whereas |sin| might only -be applicable to either single precision (|Float|) or double-precision -(|Double|) floating-point numbers. - -Control over which numerical operations are allowed and which are not -is the purpose of the numeric type class hierarchy. At the top of the -hierarchy, and therefore containing operations that are valid for all -numbers, is the class |Num|. It is defined as: -\begin{spec} -class (Eq a, Show a) => Num a where - (+), (-), (*) :: a -> a -> a - negate :: a -> a - abs, signum :: a -> a - fromInteger :: Integer -> a -\end{spec} -Note that |(/)| is \emph{not} an operation in this class. -|negate| is the negation function; \indexwdhs{abs} is the absolute -value function; and \indexwdhs{signum} is the sign function, which -returns |-1| if its argument is negative, |0| if it is |0|, -and |1| if it is positive. |fromInteger| converts an -|Integer| into a value of type |Num a => a|, which is useful for -certain coercion tasks. - -\indexamb{(-)}{negation} -\indexhs{negate} -\syn{Haskell also has a negation operator, which is Haskell's only -prefix operator. However, it is just shorthand for |negate|. That -is, |-e| in Haskell is shorthand for |negate e|. - -The operation \indexwdhs{fromInteger} also has a special purpose. How -is it that we can write the constant |42|, say, both in a context -requiring an |Int| and in one requiring a |Float| (say). Somehow -Haskell ``knows'' which version of |42| is required in a given -context. But, what is the type of |42| itself? The answer is that it -has type |Num a ==> a|, for some |a| to be determined by its context. -(If this seems strange, remember that |[]| by itself is also somewhat -ambiguous; it is a list, but a list of what? The most we can say -about its type is that it is |[a]| for some |a| yet to be determined.) - -The way this is achieved in Haskell is that literal numbers such as -|42| are actually considered to be shorthand for |fromInteger 42|. -Since |fromInteger| has type |Num a => Integer -> a|, then -|fromInteger 42| has type |Num a => a|.} - -The complete hierarchy of numeric classes is shown in Figure -\ref{fig:tc-hierarchy}; note that some of the classes are subclasses -of certain non-numeric classes, such as |Eq| and |Show|. The comments -below each class name refer to the Standard Prelude types that are -instances of that class. See Appendix \ref{ch:class-tour} for more -detail. - -\begin{figure} -\centerline{ -\epsfysize=7in -\epsfbox{Pics/classes.eps} -} -\caption{Numeric Class Hierarchy} -\label{fig:tc-hierarchy} -\end{figure} - -The Standard Prelude actually defines only the most basic numeric -types: |Int|, |Integer|, |Float| and |Double|. Other -numeric types such as rational numbers (|Ratio a|) and complex -numbers (|Complex a|) are defined in libraries. The connection -between these types and the numeric classes is given in Figure -\ref{fig:standard-numeric-types}. The instance declarations implied -by this table can be found in the Haskell Report. - -\begin{figure} -\begin{tabular}{lll} -{\bf Numeric Type} & {\bf Type Class} & {\bf Description} \\ -\hline \\ -|Int| & |Integral| & Fixed-precision integers \\ -|Integer| & |Integral| & Arbitrary-precision integers \\ -|Integral a =>| \\ -\ \ \ |Ratio a| & |RealFrac| & Rational numbers \\ -|Float| & |RealFloat|& Real floating-point, single precision\\ -|Double| & |RealFloat|& Real floating-point, double precision\\ -|RealFloat a =>| \\ -\ \ \ |Complex a| & |Floating| & Complex floating-point -\end{tabular} -\caption{Standard Numeric Types} -\label{fig:standard-numeric-types} -\end{figure} - -\subsection{The |Show| Class} - -It is very common to want to convert a data type value into a string. -In fact, it happens all the time when we interact with GHCi at the -command prompt, and GHCi will complain if it does not ``know'' how to -``show'' a value. The type of anything that GHCi prints must be an -instance of the |Show| class. - -\pagebreak - -Not all of the operations in the |Show| class will be discussed here, -in fact the only one of interest is |show|: -\begin{spec} -class Show a where - show :: a -> String - ... -\end{spec} -Instances of |Show| can be derived, so normally we do not have to worry -about the details of the definition of |show|. - -%% For example, the actual definition of the |Primitive| type that we -%% gave in Chapter \ref{ch:music} is: -%% \begin{spec} -%% data Primitive = Note Dur Pitch -%% | Rest Dur -%% deriving (Show, Eq, Ord) -%% \end{spec} - -Lists also have a |Show| instance, but it is not derived, since, -after all, lists have special syntax. Also, when |show| is applied to -a string such as |"Hello"|, it should generate a string that, when -printed, will look like |"Hello"|. This means that it must include -characters for the quotation marks themselves, which in Haskell is -achieved by prefixing the quotation mark with the ``escape'' character -$\backslash$. Given the following data declaration: -\begin{spec} -data Hello = Hello - deriving Show -\end{spec} -it is then instructive to ponder over the following calculations: -\begin{spec} -show Hello ===> "Hello" -show (show Hello) ===> show "Hello" ===> "\"Hello\"" -show (show (show Hello)) ===> "\"\\\"Hello\\\"\"" -\end{spec} -\syn{To refer to the escape character itself, it must also be escaped; -thus |"\\"| prints as $\backslash$.} - -For further pondering, consider the following program. See if you can -figure out what it does, and why!\footnote{The essence of this idea is -due to Willard Van Orman Quine \cite{Quine}, and its use in a computer -program is discussed by Hofstadter \cite{Hofstadter}. It was adapted -to Haskell by J\'{o}n Fairbairn.} -\begin{spec} -main = putStr (quine q) -quine s = s ++ show s -q = "main = putStr (quine q)\nquine s = s ++ show s\nq = " -\end{spec} - -\syn{The |"\n"| that appears twice in the string |q| is a ``newline'' - character; that is, when |q| is printed (or displayed on a console) - the string starting to the right of |"\n"| will appear on a new line.} - -Derived |Show| instances are possible for all types whose component -types also have |Show| instances. |Show| instances for most of -the standard types are provided in the Standard Prelude. - -%% Some types, such as the function type |(->)|, have a |Show| -%% instance that simply generates the string |"<>"|, but not -%% a corresponding |Read| instance. - -\subsection{The Functor Class} -\label{sec:functor-class} - -[Define |Functor| class, and show instances for lists, |Maybe|, - |Primitive|, |Music|, ...] - -TBD - -\section{Other Derived Instances} -\label{sec:other-derived-instances} - -\index{class!derived instance} -\index{class!\hkw{deriving}} -\indexkw{deriving} - -In addition to |Eq| and |Ord|, instances of \indexwdhs{Enum}, -\indexwdhs{Bounded}, \indexwdhs{Ix}, \indexwdhs{Read}, and -\indexwdhs{Show} (see Appendix \ref{ch:class-tour}) can also be -generated by the |deriving| clause. These type classes are widely -used in Haskell programming, making the deriving mechanism very -useful. - -The textual representation defined by a derived |Show| instance is -consistent with the appearance of constant Haskell expressions -(i.e.\ values) of the type involved. For example, from: -\begin{spec} -data Color = Black - | Blue - | Green - | Cyan - | Red - | Magenta - | Yellow - | White - deriving (Show, Eq, Ord, Enum, Bounded) -\end{spec} -we can expect that: -\begin{spec} -show [Red ..] -===> "[Black,Blue,Green,Cyan,Red,Magenta,Yellow,White]" -\end{spec} - -We can also expect that: -\begin{spec} -minBound :: Color ===> Black -maxBound :: Color ===> White -\end{spec} -Note that the type signature ``|:: Color|'' is given explicitly in -this case, because, out of any context, at least, Haskell does not -know the type for which you are trying to determine the minimum and -maximum bounds. - -Further details about derived instances can be found in the Haskell -Report. - -Many of the predefined data types in Haskell have |deriving| clauses, -even ones with special syntax. For example, if we could write a data -type declaration for lists (the reason we cannot do this is that -lists have special syntax, both at the value and type level) it would -look something like this: -\begin{spec} -data [a] = [] - | a : [a] - deriving (Eq, Ord) -\end{spec} -The derived |Eq| and |Ord| instances for lists are the usual -ones; in particular, character strings, as lists of characters, are -ordered as determined by the underlying |Char| type, with an -initial sub-string being less than a longer string; for example, -|"cat" < "catalog"| is |True|. - -In practice, |Eq| and |Ord| instances are almost always derived, -rather than user-defined. In fact, you should provide your own -definitions of equality and ordering predicates only with some -trepidation, being careful to maintain the expected algebraic -properties of equivalence relations and total orders, respectively -(more on this later). An intransitive |(==)| predicate, for example, -would be problematic, confusing readers of the program who expect -|(==)| to be transitive. Nevertheless, it is sometimes necessary to -provide |Eq| or |Ord| instances different from those that would be -derived. - -The data type declarations for |PitchClass|, |Primitive|, |Music| and -|Control| given in Chapter~\ref{ch:intro} are not the ones actually -used in Eutperpea. The actual definitions each use a |deriving| -clause, and are shown in Figure~\ref{fig:actual-datatypes}. The -|InstrumentName| data type from Chapter~\ref{ch:intro} also has a -deriving clause for |Show|, |Eq|, and |Ord| (but is ommitted here to -save space). - -\syn{When instances of more than one type class are derived for the - same data type, they appear grouped in parentheses as in - Figure~\ref{fig:actual-datatypes}. Also, in this case |Eq| - \emph{must} appear if |Ord| does (unless an explicit instance for - |Eq| is given), since |Eq| is a superclass of |Ord|.} - -\begin{figure} -\cbox{\small -\begin{spec} -data PitchClass = Cff | Cf | C | Dff | Cs | Df | Css | D | Eff | Ds - | Ef | Fff | Dss | E | Ff | Es | F | Gff | Ess | Fs - | Gf | Fss | G | Aff | Gs | Af | Gss | A | Bff | As - | Bf | Ass | B | Bs | Bss - deriving (Eq, Ord, Show, Read, Enum, Bounded) - -data Primitive a = Note Dur a - | Rest Dur - deriving (Show, Eq, Ord) - -data Music a = - Prim (Primitive a) -- primitive value - | Music a :+: Music a -- sequential composition - | Music a :=: Music a -- parallel composition - | Modify Control (Music a) -- modifier - deriving (Show, Eq, Ord) - -data Control = - Tempo Rational -- scale the tempo - | Transpose AbsPitch -- transposition - | Instrument InstrumentName -- instrument label - | Phrase [PhraseAttribute] -- phrase attributes - | Player PlayerName -- player label - deriving (Show, Eq, Ord) -\end{spec}} -\caption{Euterpea's Data Types with Deriving Clauses} -\label{fig:actual-datatypes} -\end{figure} - -Note that with single and double sharps and flats, there are many -enharmonic equivalences. Thus in the data declaration for -|PitchClass|, the constructors are ordered such that, if |pc1 < pc2|, -then |pcToInt pc1 <= pcToInt pc2|. - -For some examples, the |Show| class allows us to convert values to -strings: -\begin{spec} -show Cs ===> "Cs" -show concertA ===> "(A,4)" -\end{spec} -The |Read| class allows us to go the other way around: -\begin{spec} -read "Cs" ===> Cs -read "(A,4)" ===> (A,4) -\end{spec} -The |Eq| class allows testing values for equality: -\begin{spec} -concertA == a440 ===> True -concertA == (A,5) ===> False -\end{spec} -And the |Ord| class has relational operators for types whose values -can be ordered: -\begin{spec} -C < G ===> True -max C G ===> G -\end{spec} -The |Enum| class is for ``enummerable types.'' For example: -\begin{spec} -succ C ===> Dff -pred 1 ===> 0 -fromEnum C ===> 2 -toEnum 3 ===> Dff -\end{spec} -The |Enum| class is also the basis on which \emph{arithmetic - sequences} (defined earlier in Section -\ref{sec:arithmetic-sequences}) are defined. - -\section{The type of |play|} -\label{sec:play-type} - -Ever since the |play| function was introduced in -Chapter~\ref{ch:music}, we have been using it to ``play'' the results -of our |Music| values, i.e.\ to listen to their rendering through -MIDI. However, it is just a function like any other function in -Haskell, but we never discussed what its type is. In fact, here it -is: -\begin{spec} -play :: Performable a => Music a -> IO () -\end{spec} -The type of the result, |IO ()|, is the type of a \emph{command} in -Haskell, i.e.\ something that ``does I/O.'' We will have more to say -about this in a later chapter. - -But of more relevance to this chapter, note the constraint -|Performable a|. You might guess that |Performable| is a type class, -indeed it is the type class of ``performable values.'' If a type is a -member of (i.e.\ instance of) |Performable|, then it can be -``performed,'' i.e.\ rendered as sound. The point is, some things we -would not expect to be performable, for example a list or a character -or a function. So the type signature for |play| can be read, ``For -any type |T| that is a member of the class |Performable|, |play| has -type |Music T -> IO ()|.'' - -Currently the types |Pitch|, |(Pitch,Volume)|, and -|(Pitch,[NoteAttribute])| are members of the class |Performable|. -(The |NoteAttribute| data type will be introduced in -Chapter~\ref{ch:performance}.) Indeed, we have used |play| on the -first two of these types, i.e.\ on values of type |Music Pitch| and -|Music (Pitch,Volume)| in previous examples, and you might have -wondered how both could possibly be properly typed---hopefully now it -is clear. - -\section{Reasoning With Type Classes} -\label{sec:tc-laws} - -\index{class!laws} - -Type classes often imply a set of \emph{laws} that govern the use of -the operators in the class. For example, for the |Eq| class, we can -expect the following laws to hold for every instance of the class: -\begin{spec} -x == x -x == y =:> y == x -(x==y) && (y==z) =:> x == z -(x /= y) =:> not (x == y) -\end{spec} -where $\supseteq$ should be read ``implies -that.''\footnote{Mathematically, the first three of these laws are the - same as those for an \emph{equivalence relation}.} - -However, there is no way to guarantee these laws. A user may create -an instance of |Eq| that violates them, and in general Haskell has no -way to enforce them. Nevertheless, it is useful to state the laws of -interest for a particular class, and to state the expectation that all -instances of the class be ``law-abiding.'' Then as diligent -functional programmers, we should ensure that every instance that is -defined, whether for our own type class or someone else's, is in fact -law-abiding. \index{type!qualified} - -As another example, consider the |Ord| class, whose instances are -intended to be \emph{totally ordered}, which means that the following -laws should hold, for all |a|, |b|, and |c|: -\begin{spec} -a <= a -(a <= b) && (b <= c) =:> (a <= c) -(a <= b) && (b <= a) =:> (a == b) -(a /= b) =:> (a < b) || (b < a) -\end{spec} -Similar laws should hold for |(>)|. - -But alas, the instance of |Music| in the class |Ord| given in Section -\ref{sec:inheritance} does not satisfy all of these laws! To see why, -consider two |Primitive| values |p1| and |p2| such that |p1 < p2|. -Now consider these two |Music| values: -\begin{spec} -m1 = Prim p1 :+: Prim p2 -m2 = Prim p2 :+: Prim p1 -\end{spec} -Clearly |m1 == m2| is false, but the problem is, so are |m1 < m2| -and |m2 < m1|, thus violating the last law above. - -\index{lexicographic ordering} - -To fix the problem, a \emph{lexicographic ordering} should be used on -the |Music| type, such as used in a dictionary. For example, -``polygon'' comes before ``polymorphic,'' using a left-to-right -comparison of the letters. The new instance declaration looks like -this: -\begin{spec} -instance Ord a => Ord (Music a) where - Prim p1 < Prim p2 = p1 < p2 - Prim p1 < _ = True - (m1 :+: m2) < Prim _ = False - (m1 :+: m2) < (m3 :+: m4) = (m1 a -> Dur -takeT :: Temporal a => Dur -> a -> a -dropT :: Temporal a => Dur -> a -> a -\end{spec} -Then define instances of |Temporal| for the types |Music| and -|Primitive|. (Hint: this is not as hard as it sounds, because you can -\emph{reuse} some function names previously defined to do these sorts -of operations.) - -Can you think of other types that are temporal?} -\end{exercise} - -\begin{exercise}{\em -Functions are not members of the |Eq| class, because, in general, -determining whether two functions are equal is undecideable. But -functions whose domains are finite, and can be completely enumerated, -\emph{can} be tested for equality. We just need to test that each -function, when applied to each element in the domain, returns the same -result. - -Define an instance of |Eq| for functions. For this to be possible, -note that, if the function type is |a->b|, then: -\begin{itemize} -\item -the type |a| must be \emph{enumerable} (i.e.\ a member of the |Enum| class), -\item -the type |a| must be \emph{bounded} (i.e.\ a member of |Bounded| class), and -\item -the type |b| must admit \emph{equality} (i.e.\ be a member of the |Eq| -class). -\end{itemize} -These constraints must therefore be part of the instance declaration. - -Hint: using the minimum and maximum bounds of a type, enumerate all -the elements of that type using an arithmetic sequence (recall Section -\ref{sec:arithmetic-sequences}), which, despite its name, works for -any enumerable type. - -Test your implementation by defining some functions on existing -Euterpea types that are finite and bounded (such as |PitchClass| -and |Color|), or by defining some functions on your own data type(s).} -\end{exercise} - -\vspace{.1in}\hrule - diff --git a/HSoM/RandomMusic.lhs b/HSoM/RandomMusic.lhs deleted file mode 100644 --- a/HSoM/RandomMusic.lhs +++ /dev/null @@ -1,601 +0,0 @@ -%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- - -%include lhs2TeX.fmt -%include myFormat.fmt - -\out{ -\begin{code} --- This code was automatically generated by lhs2tex --code, from the file --- HSoM/RandomMusic.lhs. (See HSoM/MakeCode.bat.) - -\end{code} -} - -\chapter[Random Numbers ... and Markov Chains] -{Random Numbers, Probability Distributions, and Markov Chains} -\label{ch:random} - -\begin{code} -module Euterpea.Examples.RandomMusic where - -import Euterpea - -import System.Random -import System.Random.Distributions -import qualified Data.MarkovChain as M -\end{code} - -The use of randomness in composition can be justified by the somewhat -random, exploratory nature of the creative mind, and indeed it has -been used in computer music composition for many years. In this -chapter we will explore several sources of random numbers and how to -use them in generating simple melodies. With this foundation you will -hopefully be able to use randomness in more sophisticated ways in your -compositions. Music relying at least to some degree on randomness is -said to be \emph{stochastic}, or \emph{aleatoric}. - -\section{Random Numbers} -\label{sec:random} - -This section describes the basic functionality of Haskell's -|System.Random| module, which is a library for random numbers. The -library presents a fairly abstract interface that is structured in two -layers of type classes: one that captures the notion of a \emph{random - generator}, and one for using a random generator to create -\emph{random sequences}. - -We can create a random number generator using the built-in |mkStdGen| -function: -\begin{spec} -mkStdGen :: Int -> StdGen -\end{spec} -which takes an |Int| seed as argument, and returns a ``standard -generator'' of type |StdGen|. For example, we can define: -\begin{code} -sGen :: StdGen -sGen = mkStdGen 42 -\end{code} -We will use this single random generator quite extensively in the -remainder of this chapter. - -|StdGen| is an instance of |Show|, and thus its values can be -printed---but they appear in a rather strange way, basically as two -integers. Try typing |sGen| to the GHCi prompt. - -More importantly, |StdGen| is an instance of the |RandomGen| class: -\begin{spec} -class RandomGen g where - genRange :: g -> (Int, Int) - next :: g -> (Int, g) - split :: g -> (g, g) -\end{spec} -The reason that |Int|s are used here is that essentially all -pseudo-random number generator algorithms are based on a -fixed-precision binary number, such as |Int|. We will see later how -this can be coerced into other number types. - -For now, try applying the operators in the above class to the |sGen| -value above. The |next| function is particularly important, as it -generates the next random number in a sequence as well as a new random -number generator, which in turn can be used to generate the next -number, and so on. It should be clear that we can then create an -infinite list of random |Int|s like this: -\begin{code} -randInts :: StdGen -> [Int] -randInts g = let (x,g') = next g - in x : randInts g' -\end{code} -Look at the value |take 10 (randInts sGen)| to see a sample output. - -To support other number types, the |Random| library defines this type -class: -\begin{spec} -class Random a where - randomR :: RandomGen g => (a, a) -> g -> (a, g) - random :: RandomGen g => g -> (a, g) - - randomRs :: RandomGen g => (a, a) -> g -> [a] - randoms :: RandomGen g => g -> [a] - - randomRIO :: (a,a) -> IO a - randomIO :: IO a -\end{spec} -Built-in instances of |Random| are provided for |Int|, |Integer|, -|Float|, |Double|, |Bool|, and |Char|. - -The set of operators in the |Random| class is rather daunting, so -let's focus on just one of them for now, namely the third one, -|RandomRs|, which is also perhaps the most useful one. This function -takes a random number generator (such as |sGen|), along with a range -of values, and generates an infinite list of random numbers within the -given range (the pair representing the range is treated as a closed -interval). Here are several examples of this idea: -\begin{code} -randFloats :: [Float] -randFloats = randomRs (-1,1) sGen - -randIntegers :: [Integer] -randIntegers = randomRs (0,100) sGen - -randString :: String -randString = randomRs ('a','z') sGen -\end{code} -Recall that a string is a list of characters, so we choose here to use -the name |randString| for our infinite list of characters. If you -believe the story about a monkey typing a novel, then you might -believe that |randString| contains something interesting to read. - -So far we have used a seed to initialize our random number generators, -and this is good in the sense that it allows us to generate -repeatable, and therefore more easily testable, results. If instead -you prefer a non-repeatable result, in which you can think of the seed -as being the time of day when the program is executed, then you need -to use a function that is in the IO monad. The last two operators in -the |Random| class serve this purpose. For example, consider: -\begin{code} -randIO :: IO Float -randIO = randomRIO (0,1) -\end{code} -If you repeatedly type |randIO| at the GHCi prompt, it will return a -different random number every time. This is clearly not purely -``functional,'' and is why it is in the IO monad. As another example: -\begin{code} -randIO' :: IO () -randIO' = do r1 <- randomRIO (0,1) :: IO Float - r2 <- randomRIO (0,1) :: IO Float - print (r1 == r2) -\end{code} -will almost always return |False|, because the chance of two randomly -generated floating point numbers being the same is exceedingly small. -(The type signature is needed -to ensure that the value generated has an unambigous type.) - -\syn{|print :: Show a => a -> IO ()| converts any showable value into -a string, and displays the result in the standard output area.} - -\section{Probability Distributions} - -The random number generators described in the previous section are -assumed to be \emph{uniform}, meaning that the probability of -generating a number within a given interval is the same everywhere in -the range of the generator. For example, in the case of |Float| (that -purportedly represents \emph{continuous} real numbers), suppose we are -generating numbers in the range $0$ to $10$. Then we would expect the -probability of a number appearing in the range $2.3$-$2.4$ to be the -same as the probability of a number appearing in the range -$7.6$-$7.7$, namely $0.01$, or $1\%$ (i.e.\ $0.1/10$). In the case of -|Int| (a \emph{discrete} or \emph{integral} number type), we would -expect the probability of generating a 5 to be the same as generating -an 8. In both cases, we say that we have a \emph{uniform - distribution}. - -But we don't always want a uniform distribution. In generating music, -in fact, it's often the case that we want some kind of a non-uniform -distribution. Mathematically, the best way to describe a distribution -is by plotting how the probability changes over the range of values -that it produces. In the case of continuous numbers, this is called -the \emph{probability density function}, which has the property that -its integral over the full range of values is equal to $1$. - -The |System.Random.Distributions| library provides a number of -different probability distributions, which are described below. -Figure \ref{fig:distributions} shows the probability density functions -for each of othem. - -\begin{figure} -\centering -\subfigure[Linear]{ -\includegraphics[scale=0.9]{Pics/linear.eps} -} -\subfigure[Exponential]{ -\includegraphics[scale=0.9]{Pics/exponential.eps} -} -\subfigure[Bilateral exponential]{ -\includegraphics[scale=0.9]{Pics/bilexp.eps} -} -\subfigure[Gaussian]{ -\includegraphics[scale=0.9]{Pics/gaussian.eps} -} -\subfigure[Cauchy]{ -\includegraphics[scale=0.9]{Pics/cauchy.eps} -} -\subfigure[Poisson]{ -\includegraphics[scale=0.9]{Pics/poisson.eps} -} -\caption{Various Probability Density Functions} -\label{fig:distributions} -\end{figure} - -Here is a list and brief description of each random number generator: -\begin{description} -\item[linear] Generates a \emph{linearly} distributed random variable - between 0 and 1. The probability density function is given by: -\[ f(x) = \left\{ \begin{array}{ll} - 2(1-x) & \mbox{if $0 \leq x \leq 1$} \\ - 0 & \mbox{otherwise} - \end{array} - \right. -\] -The type signature is: -\begin{spec} -linear :: (RandomGen g, Floating a, Random a, Ord a) => - g -> (a,g) -\end{spec} -The mean value of the linear distribution is $1/3$. - -\item[exponential] Generates an \emph{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 conceptually $0$ to $\infty$, 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} \] -The type signature is: -\begin{spec} -exponential :: (RandomGen g, Floating a, Random a) => - a -> g -> (a,g) -\end{spec} -The first argument is the parameter $\lambda$. - -\item[bilateral exponential] Generates a random number with a - \emph{bilateral exponential} distribution. It is similar to - exponential, - but the mean of the distribution is 0 and 50\% of the results fall - between $-1/\lambda$ and $1/\lambda$. The probability density - function is given by: -\[ f(x) = \frac{1}{2}\lambda e^{-\lambda ||x||} \] -The type signature is: -\begin{spec} -bilExp :: (Floating a, Ord a, Random a, RandomGen g) => - a -> g -> (a,g) -\end{spec} - -\item[Gaussian] Generates a random number with a \emph{Gaussian}, also - called \emph{normal}, distribution, given mathematically by: -\[ f(x) = \frac{1}{\sigma\sqrt{2\pi}} - e^{-\frac{(x-\mu)^2}{2\sigma^2}} -\] -where $\sigma$ is the \emph{standard deviation}, and $\mu$ is the -\emph{mean}. The type signature is: -\begin{spec} -gaussian :: (Floating a, Random a, RandomGen g) => - a -> a -> g -> (a,g) -\end{spec} -The first argument is the standard deviation $\sigma$ and the second -is the mean $\mu$. Probabilistically, about 68.27\% of the numbers in -a Gaussian distribution fall within $\pm\sigma$ of the mean; about -$95.45\%$ are within $\pm 2\sigma$, and $99.73\%$ are within -$\pm 3\sigma$. - -\item[Cauchy] Generates a \emph{Cauchy}-distributed random variable. - The distribution is symmetric with a mean of 0. The density - function is given by: -\[ f(x) = \frac{\alpha}{\pi(\alpha^2 + x^2)} \] -As with the Gaussian distribution, it is unbounded both above and -below the mean, but at its extremes it approaches 0 more slowly than -the Gaussian. The type signature is: -\begin{spec} -cauchy :: (Floating a, Random a, RandomGen g) => - a -> g -> (a,g) -\end{spec} -The first argument corresponds to $\alpha$ above, and is called the -\emph{density}. - -\item[Poisson] Generates a \emph{Poisson}-distributed random variable. - The Poisson distribution is discrete, and generates only - non-negative numbers. $\lambda$ is the mean of the distribution. - If $\lambda$ is an integer, the probability that the result is - $j = \lambda-1$ is the same as that of $j = \lambda$. The - probability of generating the number $j$ is given by: -\[ P\{X=j\} = \frac{\lambda^j}{j!} e^{-\lambda} \] -The type signature is: -\begin{spec} -poisson :: ( Num t, Ord a, Floating a, Random a - RandomGen g ) => - a -> g -> (t, g) -\end{spec} - -\item[Custom] Sometimes it is useful to define one's own discrete - probability distribution function, and to generate random numbers - based on it. The function |frequency| does this---given a list of - weight-value pairs, it generates a value randomly picked from the - list, weighting the probability of choosing each value by the given - weight. -\begin{spec} -frequency :: (Floating w, Ord w, Random w, RandomGen g) => - [(w, a)] -> g -> (a,g) -\end{spec} -\end{description} - -\subsection{Random Melodies and Random Walks} - -Note that each of the non-uniform distribution random number -generators described in the last section takes zero or more parameters -as arguments, along with a uniform random number generator, and -returns a pair consisting of the next random number and a new -generator. In other words, the tail end of each type signature has -the form: -\begin{spec} -... -> g -> (a,g) -\end{spec} -where |g| is the type of the random number generator, and |a| is the -type of the next value generated. - -Given such a function, we can generate an infinite sequence of random -numbers with the given distribution in a way similar to what we did -earlier for |randInts|. In fact the following function is defined in -the |Distributions| library to make this easy: -\begin{spec} -rands :: (RandomGen g, Random a) => - (g -> (a,g)) -> g -> [a] -rands f g = x : rands f g' where (x,g') = f g -\end{spec} - -Let's work through a few musical examples. One thing we will need to -do is convert a floating point number to an absolute pitch: -\begin{code} -toAbsP1 :: Float -> AbsPitch -toAbsP1 x = round (40*x + 30) -\end{code} -This function converts a number in the range $0$ to $1$ into an -absolute pitch in the range $30$ to $70$. - -And as we have often done, we will also need to convert an absolute -pitch into a note, and a sequence of absolute pitches into a melody: -\begin{code} -mkNote1 :: AbsPitch -> Music Pitch -mkNote1 = note tn . pitch - -mkLine1 :: [AbsPitch] -> Music Pitch -mkLine1 rands = line (take 32 (map mkNote1 rands)) -\end{code} - -With these functions in hand, we can now generate sequences of random -numbers with a variety of distributions, and convert each of them into -a melody. For example: - -\pagebreak - -\begin{code} --- 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) -\end{code} - -\vspace{.1in}\hrule - -\begin{exercise}{\em -Try playing each of the above melodies, and listen to the musical -differences. For |lam|, try values of $0.1$, $1$, $5$, and $10$. For -|mu|, a value of $0.5$ will put the melody in the central part of the -scale range---then try values of $0.01$, $0.05$, and $0.1$ for |sig|.} -\end{exercise} - -\begin{exercise}{\em -Do the following: -\begin{itemize} -\item -Try using some of the other probability distributions to generate a -melody. -\item -Instead of using a chromatic scale, try using a diatonic or pentatonic -scale. -\item -Try using randomness to control parameters other than pitch---in -particular, duration and/or volume. -\end{itemize} -} -\end{exercise} - -\vspace{.1in}\hrule -\vspace{.1in} - -Another approach to generating a melody is sometimes called a -\emph{random walk}. The idea is to start on a particular note, and -treat the sequence of random numbers as \emph{intervals}, rather than -as pitches. To prevent the melody from wandering too far from the -starting pitch, one should use a probability distribution whose mean -is zero. This comes for free with something like the bilateral -exponential, and is easily obtained with a distribution that takes the -mean as a parameter (such as the Gaussian), but is also easily -achieved for other distributions by simply subtracting the mean. To -see these two situations, here are random melodic walks using first -a Gaussian and then an exponential distribution: -\begin{code} --- 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))) -\end{code} -Note that |toAbsP2| does something reasonable to interpret a -floating-point number as an interval, and |mkLine2| uses |scanl| to -generate a ``running sum'' that represents the melody line. - -\out{ --- Test code to see how accurate the mean is: -\begin{code} -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) -\end{code} -} - -%% \begin{exercise}{\em -%% Instead of ...} -%% \end{exercise} - -\section{Markov Chains} - -Each number in the random number sequences that we have described thus -far is \emph{independent} of any previous values in the sequence. -This is like flipping a coin---each flip has a 50\% chance of being -heads or tails, i.e.\ it is independent of any previous flips, even if -the last ten flips were all heads. - -Sometimes, however, we would like the probability of a new choice to -depend upon some number of previous choices. This is called a -\emph{conditional probability}. In a discrete system, if we look only -at the previous value to help determine the next value, then these -conditional probabilities can be conveniently represented in a matrix. -For example, if we are choosing between the pitches $C$, $D$, $E$, and -$F$, then Table \ref{fig:markov-table} might represent the conditional -probabilities of each possible outcome. The previous pitch is found -in the left column---thus note that the sum of each row is $1.0$. So, -for example, the probability of choosing a $D$ given that the previous -pitch was an $E$ is $0.6$, and the probability of an $F$ occurring -twice in succession is $0.2$. The resulting stochastic system is -called a \emph{Markov Chain}. - -\begin{table} -\begin{center} -\begin{tabular}{||l||l||l||l||l||} \hline - & |C| & |D| & |E| & |F| \\ \hline -|C| & 0.4 & 0.2 & 0.2 & 0.2 \\ \hline -|D| & 0.3 & 0.2 & 0.0 & 0.5 \\ \hline -|E| & 0.1 & 0.6 & 0.1 & 0.2 \\ \hline -|F| & 0.2 & 0.3 & 0.3 & 0.2 \\ \hline -\end{tabular} -\end{center} -\caption{Second-Order Markov Chain} -\label{fig:markov-table} -\end{table} - -This idea can of course be generalized to arbitrary numbers of -previous events, and in general an $(n+1)$-dimensional array can be -used to store the various conditional probabilities. The number of -previous values observed is called the \emph{order} of the Markov -Chain. - -[TO DO: write the Haskell code to implement this] - -\subsection{Training Data} - -Instead of generating the conditional probability table ourselves, -another approach is to use \emph{training data} from which the -conditional probabilities can be \emph{inferred}. This is handy for -music, because it means that we can feed in a bunch of melodies that -we like, including melodies written by the masters, and use that as a -stochastic basis for generating new melodies. - -[TO DO: Give some pointers to the literatue, in particular David - Cope's work.] - -The |Data.MarkovChain| library provides this functionality through a -function called |run|, whose type signature is: -\begin{spec} -run :: (Ord a, RandomGen g) => - Int -- order of Markov Chain - -> [a] -- training sequence (treated as circular list) - -> Int -- index to start within the training sequence - -> g -- random number generator - -> [a] -\end{spec} -The |runMulti| function is similar, except that it takes a list of -training sequences as input, and returns a list of lists as its -result, each being an independent random walk whose probabilities are -based on the training data. The following examples demonstrate how to -use these functions. - -\begin{code} --- 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)) -\end{code} - -\out{ -\begin{code} --- 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) -\end{code} -} - -Here are some things to try with the above definitions: -\begin{itemize} -\item -|mc ps0 0| will generate a completely random sequence, since it is a -``zeroth-order'' Markov Chain that does not look at any previous -output. -\item -|mc ps0 1| looks back one value, which is enough in the case of this -simple training sequence to generate an endless sequence of notes that -sounds just like the training data. Using any order higher than 1 -generates the same result. -\item -|mc ps1 1| also generates a result that sounds just like its training -data. -\item -|mc ps2 1|, on the other hand, has some (random) variety to it, -because the training data has more than one occurrence of most of the -notes. If we increase the order, however, the output will sound more -and more like the training data. -\item -|mcm [ps0,ps2] 1| and |mcm [ps1,ps2] 1| generate perhaps the most -interesting results yet, in which you can hear aspects of both the -ascending melodic nature of |ps0| and |ps1|, and the harmonic -structure of |ps2|. -\item -|mcm [ps1,reverse ps1] 1| has, not suprisingly, both ascending and -descending lines in it, as reflected in the training data. -\end{itemize} - -\vspace{.1in}\hrule - -\begin{exercise}{\em -Play with Markov Chains. Use them to generate more melodies, or to -control other aspects of the music, such as rhythm. Also consider -other kinds of training data rather than simply sequences of pitches.} -\end{exercise} - -\vspace{.1in}\hrule - - diff --git a/HSoM/SelfSimilar.lhs b/HSoM/SelfSimilar.lhs deleted file mode 100644 --- a/HSoM/SelfSimilar.lhs +++ /dev/null @@ -1,398 +0,0 @@ -%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- - -%include lhs2TeX.fmt -%include myFormat.fmt - -\out{ -\begin{code} --- This code was automatically generated by lhs2tex --code, from the file --- HSoM/SelfSimilar.lhs. (See HSoM/MakeCode.bat.) - -\end{code} -} - -\chapter{Self-Similar Music} -\label{ch:self-similar} - -\begin{code} -module Euterpea.Examples.SelfSimilar where -import Euterpea -\end{code} - -\index{self-similar music} -\index{fractal music} - -In this chapter we will explore the notion of \emph{self-similar} -music---i.e.\ musical structures that have patterns that repeat -themselves recursively in interesting ways. There are many approaches -to generating self-similar structures, the most well-known being -\emph{fractals}, which have been used to generate not just music, but -also graphical images. We will delay a general treatment of fractals, -however, and will instead focus on more specialized notions of -self-similarity, notions that we conceive of musically, and then -manifest as Haskell programs. - -\section{Self-Similar Melody} -\label{sec:self-sim-melody} - -Here is the first notion of self-similar music that we will consider: -Begin with a very simple melody of |n| notes. Now duplicate this -melody |n| times, playing each in succession, but first perform the -following transformations: transpose the |i|th melody by an amount -proportional to the pitch of the |i|th note in the original melody, -and scale its tempo by a factor proportional to the duration of the -|i|th note. For example, Figure \ref{fig:self-similar} shows the -result of applying this process once to a four-note melody (the first -four notes form the original melody). Now imagine that this process -is repeated infinitely often. For a melody whose notes are all -shorter than a whole note, it yields an infinitely dense melody of -infinitesimally shorter notes. To make the result playable, however, -we will stop the process at some pre-determined level. - -\begin{figure*} -\centerline{ -\epsfysize=2in -\epsfbox{pics/self-sim.eps} -} -\caption{An Example of Self-Similar Music} -\label{fig:self-similar} -\end{figure*} - -How can this be represented in Haskell? A {\em tree} seems like it -would be a logical choice; let's call it a |Cluster|: -\begin{code} - -data Cluster = Cluster SNote [Cluster] -type SNote = (Dur,AbsPitch) -\end{code} -This particular kind of tree happens to be called a {\em rose tree} -\cite{}. An |SNote| is just a ``simple note,'' a duration paired -with an absolute pitch. We prefer to stick with absolute pitches in -creating the self-similar structure, and will convert the result into -a normal |Music| value only after we are done. - -The sequence of |SNote|s at each level of the cluster is the -melodic fragment for that level. The very top cluster will contain a -``dummy'' note, whereas the next level will contain the original -melody, the next level will contain one iteration of the process -described above (e.g.\ the melody in Figure \ref{fig:self-similar}), -and so forth. - -To achieve this we will define a function |selfSim| that takes the -initial melody as argument and generates an infinitely deep cluster: -\indexhs{selfSim} -\begin{code} -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) -\end{code} -Note that |selfSim| itself is not recursive, but |mkCluster| is. This -code should be studied carefully. In particualr, the recursion in -|mkCluster| is different from what we have seen before, as it is not a -direct invocation of |mkCluster|, but rather it is a high-order -argument to |map| (which in turn invokes |mkCluster| an aribtrary -number of times). - -Next, we define a function to skim off the notes at the $n^{th}$ level, -or $n^{th}$ ``fringe,'' of a cluster: -\begin{code} -fringe :: Int -> Cluster -> [SNote] -fringe 0 (Cluster note cls) = [note] -fringe n (Cluster note cls) = concatMap (fringe (n-1)) cls -\end{code} - -\syn{|concatMap| is defined in the Standard Prelude as: -\begin{spec} -concatMap :: (a -> [b]) -> [a] -> [b] -concatMap f = concat . map f -\end{spec} -Recall that |concat| appends together a list of lists, and is -defined in the Prelude as: -\begin{spec} -concat :: [[a]] -> [a] -concat = foldr (++) [] -\end{spec} -} - -All that is left to do is convert this into a |Music| value that we -can play: -\begin{spec} -simToMusic :: [SNote] -> Music Pitch -simToMusic ss = let mkNote (d,ap) = note d (pitch ap) - in line (map mkNote ss) -\end{spec} -We can define this with a bit more elegance as follows: -\begin{code} -simToMusic :: [SNote] -> Music Pitch -simToMusic = line . map mkNote - -mkNote :: (Dur,AbsPitch) -> Music Pitch -mkNote (d,ap) = note d (pitch ap) -\end{code} -The increased modularity will allow us to reuse |mkNote| later in the -chapter. - -Putting it all together, we can define a function that takes an -initial pattern, a level, a number of pitches to transpose the result, -and a tempo scaling factor, to yield a final result: -\begin{code} -ss pat n tr te = - transpose tr $ tempo te $ simToMusic $ fringe n $ selfSim pat -\end{code} - -\subsection{Sample Compositions} - -Let's start with a melody with no rhythmic variation. -\begin{code} -m0 :: [SNote] -m0 = [(1,2),(1,0),(1,5),(1,7)] - -tm0 = instrument Vibraphone (ss m0 4 50 20) -\end{code} -One fun thing to do with music like this is to combine it with -variations of itself. For example: -\begin{code} -ttm0 = tm0 :=: transpose (12) (revM tm0) -\end{code} - -We could also try the opposite: a simple percussion instrument with no -melodic variation, i.e.\ all rhythm: -\begin{code} -m1 :: [SNote] -m1 = [(1,0),(0.5,0),(0.5,0)] - -tm1 = instrument Percussion (ss m1 4 43 2) -\end{code} -Note that the pitch is transposed by 43, which is the MIDI Key number -for a ``high floor tom'' (i.e.\ percussion sound -|HighFloorTom|---recall the discussion in Section -\ref{sec:percussion}). - -Here is a very simple melody, two different pitches and two different -durations: -\begin{code} -m2 :: [SNote] -m2 = [(dqn,0),(qn,4)] - -tm2 = ss m2 6 50 (1/50) -\end{code} - -Here are some more exotic compositions, combining both melody and -rhythm: -\begin{code} -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) (revM 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 -\end{code} % $ - -%% p3 = [(6/10,2),(13/10,5),(wn,0),(9/10,7)] -%% ss3 = ss p3 4 50 20 - -\newpage - -\vspace{.1in}\hrule - -\begin{exercise}{\em -Experiment with this idea futher, using other melodic seeds, exploring -different depths of the clusters, and so on.} -\end{exercise} - -\begin{exercise}{\em -Note that |concat| is defined as |foldr (++) []|, which means that it -takes a number of steps proportional to the sum of the lengths of the -lists being concatenated; we cannot do any better than this. (If -|foldl| were used instead, the number of steps would be proportional -to the number of lists times their average length.) - -However, |fringe| is not very efficient, for the following reason: -|concat| is being used over and over again, like this: -\begin{spec} -concat [ concat [ ... ], concat [ ... ], concat [ ... ] ] -\end{spec} -This causes a number of steps proportional to the depth of the tree -times the length of the sub-lists; clearly not optimal. - -Define a version of |fringe| that is linear in the total length of -the final list.} -\end{exercise} - -\vspace{.1in}\hrule - -\section{Self-Similar Harmony} -\label{sec:self-sim-harmony} - -In the last section we used a melody as a seed, and created longer -melodies from it. Another idea is to stack the melodies vertically. -Specifically, suppose we redefine |fringe| in such a way that it does -not concatenate the sub-clusters together: -\begin{code} - -fringe' :: Int -> Cluster -> [[SNote]] -fringe' 0 (Cluster note cls) = [[note]] -fringe' n (Cluster note cls) = map (fringe (n-1)) cls -\end{code} -Note that this strategy is only applied to the top level---below that -we use fringe. Thus the type of the result is |[[SNote]]|, i.e.\ a -list of lists of notes. - -We can convert the individual lists into melodies, and play the -melodies all together, like this: -\begin{code} -simToMusic' :: [[SNote]] -> Music Pitch -simToMusic' = chord . map (line . map mkNote) -\end{code} - -Finally, we can define a function akin to |ss| defined earlier: -\begin{code} -ss' pat n tr te = - transpose tr $ tempo te $ simToMusic' $ fringe' n $ selfSim pat -\end{code} - -Using some of the same patterns used earlier, here are some sample -compositions (with not necessarily a great outcome...): -\begin{code} -ss1 = ss' m2 4 50 (1/8) -ss2 = ss' m3 4 50 (1/2) -ss3 = ss' m4 3 50 2 -\end{code} -\out{ -p1 = [(hn,3),(qn,4),(qn,0),(wn,6)] -p2 = [(hn,0),(wn,4),(hn,7),(wn,5)] -p3 = [(6/10,2),(13/10,5),(wn,0),(9/10,7)] -p4 = [(hn,3),(hn,8),(hn,22),(qn,4),(qn,7),(qn,21), - (qn,0),(qn,5),(qn,15),(wn,6),(wn,9),(wn,19)] -} - -Here is a new one, based on a major triad: -\begin{code} -m5 = [(en,4),(sn,7),(en,0)] -ss5 = ss m5 4 45 (1/500) -ss6 = ss' m5 4 45 (1/1000) -\end{code} -Note the need to scale the tempo back drastically, due to the short -durations of the starting notes. - -\section{Other Self-Similar Structures} - -The reader will observe that our notion of ``self-similar harmony'' -does not involve changing the structure of the |Cluster| data -type, nor the algorithm for computing the sub-structures (as captured -in |selfSim|). All that we do is interpret the result differently. -This is a common characteristic of algorithmic music composition---the -same mathematical or computational structure is interpreted in -different ways to yield musically different results. - -For example, instead of the above strategy for playing melodies in -parallel, we could play entire levels of the |Cluster| in parallel, -where the number of levels that we choose is given as a parameter. If -alligned properly in time there will be a harmonic relationship -between the levels, which could yield pleasing results. - -The |Cluster| data type is conceptually useful in that is represents -the infinite solution space of self-simlar melodies. And it is -computationally useful in that it is computed to a desired depth only -once, and thus can be inspected and reused without recomputing each -level of the tree. This idea might be useful in the application -mentioned above, namely combining two or more levels of the result in -interesting ways. - -However, the |Cluster| data type is strictly unnecessary, in that, for -example, if we are interested in computing a specific level, we could -define a function that recursed to that level and gave the result -directly, without saving the intermediate levels. - -A final point about the notion of self-similarity captured in this -chapter is that the initial pattern is used as the basis with which to -transform each successive level. Another strategy would be to use the -entirety of each new level as the seed for transforming itself into -the next level. This will result in an exponential blow-up in the -size of each level, but may be worth pursuing---in some sense it is a -simpler notion of self-similarity than what we have used in this -chapter. - -All of the ideas in this section, and others, we leave as exercises for -the reader. - -\vspace{.1in}\hrule - -\begin{exercise}{\em -Experiment with the self-similar programs in this chapter. Compose an -interesting piece of music through a judicious choice of starting -melody, depth of recursion, instrumentation, etc.} -\end{exercise} - -\begin{exercise}{\em -Devise an interpretation of a |Cluster| that plays multiple levels of -the |Cluster| in parallel. Try to get the levels to align properly in -time so that each level has the same duration. You may choose to play -all the levels up to a certain depth in parallel, or levels within a -certain range, say levels 3 through 5.} -\end{exercise} - -\begin{exercise}{\em -Define an alternative version of |simToMusic| that interprets the music -differently. For example: -\begin{itemize} -\item Interpret the pitch as an index into a scale---e.g., as an index - into the C major scale, so that 0 corresponds to C, 1 to D, 2 to E, - 3 to F, ..., 6 to B, 7 to C in the next octave, and so on. - -\item Interpret the pitch as duration, and the duration as pitch. -\end{itemize} -} -\end{exercise} - -\begin{exercise}{\em -Modify the self-similar code in the following ways: -\begin{itemize} -\item -Add a Volume component to |SNote| (in other words, define it as a triple -instead of a pair), and redefine |addMult| so that it takes two of these -triples and combines them in a suitable way. Then modify the rest of -the code so that the result is a |Music1| value. With these -modifications, compose something interesting that highlights the -changes in volume. - -\item -Change the |AbsPitch| field in |SNote| to be a list of |AbsPitch|s, to -be interpreted ultimately as a chord. Figure out some way to combine -them in |addMult|, and compose something interesting. -\end{itemize} -} -\end{exercise} - -\begin{exercise}{\em -Devise some other variant of self-similar music, and encode it in -Haskell. In particular, consider structures that are different from -those generated by the |selfSim| function.} -\end{exercise} - -\begin{exercise}{\em -Define a function that gives the same result as |ss|, but without -using a data type such as |Cluster|.} -\end{exercise} - -\begin{exercise}{\em -Define a version of self-similarity similar to that defined in this -chapter, but that uses the entire melody generated at one level to -transform itself into the next level (rather than using the original -seed pattern).} -\end{exercise} - -\vspace{.1in}\hrule diff --git a/HSoM/SigFuns.lhs b/HSoM/SigFuns.lhs deleted file mode 100644 --- a/HSoM/SigFuns.lhs +++ /dev/null @@ -1,1086 +0,0 @@ -%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- - -%include lhs2TeX.fmt -%include myFormat.fmt - -\out{ -\begin{code} --- This code was automatically generated by lhs2tex --code, from the file --- HSoM/SigFuns.lhs. (See HSoM/MakeCode.bat.) - -\end{code} -} - -\chapter{Euterpea's Signal Functions} -\label{ch:sigfuns} - -\begin{code} -{-# LANGUAGE Arrows #-} - -module Euterpea.Examples.SigFuns where - -import Euterpea -import Control.Arrow ((>>>),(<<<),arr) -\end{code} - -\syn{The first line in the module header above is a \emph{compiler - pragma}, amd in this case is telling GHC to accept \emph{arrow - syntax}, which will be explained in Section~\ref{sec:sigfuns}.} - -In this chapter we show how the theoretical concepts involving -sound and signals studied in the last chapter are manifested in -Euterpea. The techniques learned will lay the groundwork for doing -two broad kinds of activities: \emph{sound synthesis} and \emph{audio - processing}. Sound synthesis might include creating the sound of a -footstep on dry leaves, simulating a conventional musical instrument, -creating an entirely new instrument sound, or composing a single -``soundscape'' that stands alone as a musical composition. Audio -processing includes such things as equalization, filtering, reverb, -special effects, and so on. In future chapters we will study various -techniques for achieving these goals. - -%% apply these concepts to particular computer music applications. - -\section{Signals and Signal Functions} -\label{sec:sigfuns} - -%% Conceptually, one could think of a signal as a value of type |Signal -%% T| that represents time-varying values of type |T|. For example, -%% |Signal Float| would be a time-varying floating-point number, |Signal -%% AbsPitch| would be a time-varing absolute pitch, and so on. -%% Abstractly, one could therefore think of a signal as a function: -%% \begin{spec} -%% Signal a ==== Time -> a -%% \end{spec} -%% where |Time| is some suitable representation of time. - -As we saw in Chapter \ref{ch:MUI}, it would seem natural to represent -a signal as an abstract type, say |Signal T| in Haskell, and then -define functions to add, multiply, take the sine of, and so on, -signals represented in this way. For example, |Signal Float| would be -the type of a time-varying floating-point number, |Signal AbsPitch| -would be the type of a time-varing absolute pitch, and so on. Then -given |s1,s2 :: Signal Float| we might simply write |s1 + s2|, |s1 * -s2|, and |sin s1| as examples of applying the above operations. -Haskell's numeric type class hierarchy would make this particularly -easy to do. Indeed, several domain-specific languages based on this -approach have been defined before, beginning with the language -\emph{Fran} \cite{Fran} that was designed for writing computer -animation programs. - -But years of experience and theoretical study have revealed that such -an approach leads to a language with subtle time- and -space-leaks,\footnote{A time-leak in a real-time system occurs - whenever a time-dependent computation falls behind the current time - because its value or effect is not needed yet, but then requires - ``catching up'' at a later point in time. This catching up process - can take an arbitrarily long time, and may consume additional space - as well. It can destroy any hope for real-time behavior if not - managed properly.} for reasons that are beyond the scope of this -textbook \cite{Leak07}. Therefore Euterpea takes a somewhat different -approach, as described below. - -%% Earlier versions of Fran, FAL \cite{SOE}, and FRP \cite{Yale-FRP} used -%% various methods to make this performance problem less of an issue, but -%% ultimately they all either suffered from the problem in one way or -%% another, or introduced other problems as a result of fixing it. - -Perhaps the simplest way to understand Euterpea's approach to -programming with signals is to think of it as a language for -expressing \emph{signal processing diagrams} (or equivalently, -electrical circuits). We refer to the lines in a typical signal -processing diagram as \emph{signals}, and the boxes that convert one -signal into another as \emph{signal functions}. For example, this -very simple diagram has two signals, |x| and |y|, and one signal -function, |sigfun|: -\begin{center} - \includegraphics[scale=0.70]{pics/frp-circuit} -\end{center} -Using Haskell's \emph{arrow syntax} \cite{Hughes2000,Paterson2001}, -this diagram can be expressed as a code fragment in Euterpea simply -as: -\begin{spec} -y <- sigfun -< x -\end{spec} -\syn{The syntax |<-| and |-<| is typeset here in an attractive way, - but the user will have to type \verb+<-+ and \verb+-<+, - respectively, in her source file.} - -Arrows and arrow syntax will be described in much more detail in -Chapter~\ref{ch:implementing-sigfuns}. For now, keep in mind that -|<-| and |-<| are part of the \emph{syntax}, and are not simply binary -operators. Indeed, we can't just write the above code fragment -anywhere. It has to be within an enclosing |proc| construct whose -result type is that of a signal function. The |proc| construct begins -with the keyword |proc| along with an argument, analogous to an -anonymous function. For example, a signal function that takes a -signal of type |Double| and adds 1 to every signal sample, and then -applies |sigfun| to the resulting signal, can be written: -\begin{spec} -proc y -> do - x <- sigfun -< y+1 - outA -< x -\end{spec} -\syn{The |do| keyword in arrow syntax introduces layout, just as it - does in monad syntax.} - -%% Also, modules that use the arrow syntax should have a -%% ``.as'' or ``.lhs'' (instead of ``.hs'') extension.} - -Note the analogy of this code to the following snippet involving -an ordinary anonymous function: -\begin{spec} -\ y -> - let x = sigfun (y+1) - in x -\end{spec} -The important difference, however, is that |sigfun| works on a signal, -which we can think of as a stream of values, whose representative -values at the ``point'' level are the variables |x| and |y| above. So -in reality we would have to write something like this: -\begin{spec} -\ ys -> - let xs = sigfun (map (+1) ys) - in xs -\end{spec} -to achieve the effect of the arrow code above. The arrow syntax -allows us to avoid worrying about the streams themselves. It also has -other important advantages that are beyond the scope of the current -discussion. - -Arrow syntax is just that-–-syntactic sugar that is expanded into a -set of conventional functions that work just as well, but are more -cumbersome to program with (just as with monad syntax). This -syntactic expansion will be described in more detail in -Chapter~\ref{ch:implementing-sigfuns}. To use the arrow syntax within -a ``.lhs'' file, one must declare a compiler flag in GHC at the very -beginning of the file, as follows: -\begin{spec} -{-# LANGUAGE Arrows #-} -\end{spec} - -%% We can also create and use signal functions that operate on tuples of -%% signals. For example, a signal function |exp :: SigFun (Double, -%% Double) Double| that raises its first argument to the power of its -%% second, at every point in time, could be used as follows: - -%% \begin{code} -%% z <- exp -< (x,y) -%% \end{code} - -\subsection{The Type of a Signal Function} -\label{sec:sigfun-type} - -Polymorphically speaking, a signal function has type: -\begin{spec} -Clock c => SigFun c a b -\end{spec} -which should be read, ``for some clock type (i.e.\ sampling rate) |c|, -this is the type of signal functions that convert signals of type |a| -into signals of type |b|.'' - -\out{ -\syn{|Signal| is actually not a good name for the type---it should - be something like |SignalFunction| or |SF| and will probably be - renamed in a soon-to-be-released version of Euterpea.} -} - -The type variable |c| indicates what clock rate is being used, and for -our purposes will always be one of two types: |AudRate| or |CtrRate| -(for \emph{audio rate} and \emph{control rate}, respectively). Being -able to express the sampling rate of a signal function is what we call -\emph{clock polymorphism}. Although we like to think of signals as -continuous, time-varying quantities, in practice we know that they are -sampled representations of continous quantities, as discussed in the -last chapter. However, some signals need to be sampled at a very high -rate---say, an audio signal---whereas other signals need not be -sampled at such a high rate---say, a signal representing the setting -of a slider. The problem is, we often want to mix signals sampled at -different rates; for example, the slider might control the volume of -the audio signal. - -One solution to this problem would be to simply sample everything at -the very highest rate, but this is computationally inefficient. A -better approach is to sample signals at their most appropriate rate, -and to perform coercions to ``up sample'' or ``down sample'' a signal -when it needs to be combined with a signal sampled at a different -rate. This is the approach used in Euterpea. - -More specifically, the base type of each signal into and out of a -signal function must satisfy the type class constraint |Clock c|, -where |c| is a \emph{clock type}. The |Clocked| class is defined as: -\begin{spec} -class Clock c where - rate :: c -> Double -\end{spec} -The single method |rate| allows the user to extract the sampling rate -from the type. In Euterpea, the |AudRate| is pre-defined to be 44.1 -kHz, and the |CtrRate| is set at 4.41 kHz. Here are the definitions -of |AudRate| and |CtrRate|, along with their instance declarations in -the |Clock| class, to achieve this: -\begin{spec} -data AudRate -data CtrRate - -instance Clock AudRate where - rate _ = 44100 - -instance Clock CtrRate where - rate _ = 4410 -\end{spec} -Because these two clock types are so often used, it is helpful to -define a couple of type synonyms: -\begin{spec} -type AudSF a b = SigFun AudRate a b -type CtrSF a b = SigFun CtrRate a b -\end{spec} - -From these definitions it should be clear how to define your own clock type. - -\syn{Note that |AudRate| and |CtrRate| have no constructors---they are - called \emph{empty} data types. More precisely, they are each - inhabited by exactly one value, namely |bottom|.} - -The sampling rate can be determined from a given clock type. -In this way, a coercion function can be written to change a signal -sampled at one rate to a signal sampled at some other rate. In -Euterpea, there are two such functions that are pre-defined: -\begin{spec} -coerce, upsample :: (Clock c1, Clock c2) => - SigFun c1 a b -> SigFun c2 a b -\end{spec} -The function |coerce| looks up the sampling rates of the input and -output signals from the type variables |c1| and |c2|. It then either -stretches the input stream by duplicating the same element or -contracts it by skipping elements. (It is also possible to define a -more accurate coercion function that performs interpolation, at the -expense of performance.) - -For simpler programs, the overhead of calling |coerce| might not be -worth the time saved by generating signals with lower resolution. -(Haskell’s fractional number implementation is relatively slow.) The -specialized coercion function |upsample| avoids this overhead, but -only works properly when the output rate is an integral multiple of -the input rate (which is true in the case of |AudRate| and |CtrRate|). - -Keep in mind that one does not have to commit a signal function to a -particular clock rate---it can be left \emph{polymorphic}. Then that -signal function will adapt its sampling rate to whatever is needed in -the context in which it is used. - -%% From a typing perspective, signal functions such as |sigfun| will have -%% a type of the form |SigFun T1 T2|, for some types |T1| and |T2|, in which -%% case |x| will have type |T1|, and |y| will have type |T2|. Although -%% signal functions act on signals, the arrow notation allows one to -%% manipulate the instantaneous values of the signals, such as |x| and -%% |y| above. Not suprisingly, the actual representation of the type SigFun -%% is hidden (i.e.\ |SigFun| is abstract), - -Also keep in mind that a signal function is an abstract function. You -cannot just apply it to an argument like an ordinary function---that -is the purpose of the arrow syntax. There are no values that directly -represent \emph{signals} in Euterpea---there are only signal -\emph{functions}. - -The arrow syntax provides a convenient way to compose signal functions -together---i.e.\ to wire together the boxes that make up a signal -processing diagram. By not giving the user direct access to signals, -and providing a disciplined way to compose signal functions (namely -arrow syntax), time- and space-leaks are avoided. In fact, the -resulting framwework is highly amenable to optimization, although this -requires using special features in Haskell, as described in Chapter -\ref{ch:implementing-sigfuns}. - -A signal function whose type is of the form |Clock c => SigFun c () b| -essentially takes no input, but produces some output of type |b|. -Because of this we often refer to such a signal function as a -\emph{signal source}. - -%% A Euterpea program program expresses the composition of a -%% possibly large number of signal functions into a composite signal -%% function that is then ``run'' at the top level by a suitable -%% interpreter. A good analogy for this idea is a state or IO monad, -%% where the state is hidden, and a program consists of a linear -%% sequencing of actions that are eventually run by an interpreter or the -%% operating system. But in fact arrows are more general than monads, -%% and in particular the composition of signal functions does not have to -%% be completely linear, as will be illustrated shortly. - -\subsection{Four Useful Functions} -\label{sec:useful-funs} - -There are four useful auxiliary functions that will make writing -signal functions a bit easier. The first two essentially ``lift'' -constants and functions from the Haskell level to the arrow (signal -function) level: -\begin{spec} -arr :: Clock c => (a -> b) -> SigFun c a b -constA :: Clock c => b -> SigFun c () b -\end{spec} -For example, a signal function that adds one to every sample of its -input can be written simply as |arr (+1)|, and a signal function that -returns the constant 440 as its result can be written |constA 440| -(and is a signal source, as defined earlier). - -\out{ -\begin{spec} -constA :: Clock c => b -> SigFun c a b -constA y = arr (\_ -> y) -\end{spec} -} - -The other two functions allow us to \emph{compose} signal functions: -\begin{spec} -(>>>) :: Clock clk => - SigFun clk a b -> SigFun clk b c -> SigFun clk a c -(<<<) :: Clock clk => - SigFun clk b c -> SigFun clk a b -> SigFun clk a c -\end{spec} -|(<<<)| is analogous to Haskell's standard composition operator |(.)|, -whereas |(>>>)| is like ``reverse composition.'' - -As an example that combines both of the ideas above, recall the very -first example given in this chapter: -\begin{spec} -proc y -> do - x <- sigfun -< y+1 - outA -< x -\end{spec} -which essentially applies |sigfun| to one plus the input. This signal -function can be written more succinctly as either |arr (+1) >>> sigfun| or -|sigfun <<< arr (+1)|. - -The functions |(>>>)|, |(<<<)|, and |arr| are actually generic -operators on arrows, and are defined in Haskell's |Arrow| library. -Euterpea imports them from there and adds them to the Euterpea -namespace, so they do not have to be explicitly imported by the user. - -\subsection{Some Simple Examples} -\label{sec:sigfun-examples} - -Let's now work through a few examples that focus on the behavior of -signal functions, so that we can get a feel for how they are used in -practice. Euterpea has many pre-defined signal functions, including -ones for sine waves, numeric computations, transcendental functions, -delay lines, filtering, noise generation, integration, and so on. -Many of these signal functions are inspired by csound \cite{csound}, -where they are called \emph{unit generators}. Some of them are not -signal functions \emph{per se}, but take a few fixed arguments to -yield a signal function, and it is important to understand this -distinction. - -For example, there are several pre-defined functions for generating -sine waves and periodic waveforms in Euterpea. Collectively these are -called \emph{oscillators}, a name taken from electronic circuit -design. They are summarized in Figure \ref{fig:oscillators}. - -\begin{figure} -\cbox{ -\begin{spec} -osc, oscI :: Clock c => - Table -> Double -> SigFun c Double Double -\end{spec} - -|osc tab ph| is a signal function whose input is a frequency, and -output is a signal having that frequency. The output is generated -using fixed-waveform table-lookup, using the table |tab|, starting -with initial offset (phase angle) |ph| expressed as a fraction of a -cycle (0 to 1). |oscI| is the same, but uses linear interpolation -between points. -\vspace{0.15in} - -\begin{spec} -oscFixed :: Clock c => - Double -> SigFun c () Double -\end{spec} - -|oscFixed freq| is a signal source whose sinusoidal output frequency -is |freq|. It uses a recurrence relation that requires only one multiply -and two add operations for each sample of output. -\vspace{0.15in} - -\begin{spec} -oscDur, oscDurI :: Clock c => - Table -> Double -> Double -> SigFun () Double -\end{spec} - -|oscDur tab del dur| samples just once through the table |tab| at a -rate determined by |dur|. For the first |del| seconds, the point of -scan will reside at the first location of the table; it will then move -through the table at a constant rate, reaching the end in another -|dur| seconds; from that time on (i.e.\ after |del + dur| seconds) it -will remain pointing at the last location. |oscDurI| is similar but -uses linear interpolation between points. -\vspace{0.15in} - -\begin{spec} -oscPartials :: Clock c => - Table -> Double -> SigFun c (Double,Int) Double -\end{spec} - -|oscPartials tab ph| is a signal function whose pair of inputs -determines the frequency (as with |osc|), as well as the number of -harmonics of that frequency, of the output. |tab| is the table that -is cycled through, and |ph| is the phase angle (as with |osc|). -} -\caption{Euterpea's Oscillators} -\label{fig:oscillators} -\end{figure} - -The two most common oscillators in Euterpea are: -\begin{spec} -osc :: Clock c => - Table -> Double -> SigFun c Double Double -oscFixed :: Clock c => - Double -> SigFun c () Double -\end{spec} -|osc| uses fixed-waveform table-lookup synthesis as described in -Section \ref{sec:wavetable}. The first argument is the fixed -wavetable; we will see shortly how such a table can be generated. The -second argument is the initial phase angle, represented as a fraction -between 0 and 1. The resulting signal function then converts a signal -representing the desired output frequency to a signal that has that -output frequency. - -|oscFixed| uses an efficient recurrence relation to compute a pure -sinusoidal wave; the mathematics of this are described in Section -\ref{sec:sine-recurrence}. In contrast with |osc|, its single -argument is the desired output frequency. The resulting signal -function is therefore a signal source (i.e.\ its input type is |()|). - -\todo{Discuss recurrence relations here or perhaps in the last chapter - where the fixed-waveform table-lookup method is described.} - -The key point here is that the frequency that is output by |osc| is an -\emph{input to the signal function}, and therefore can vary with time, -whereas the frequency output by |oscFixed| is a \emph{fixed argument}, -and cannot vary with time. To see this concretely, let's define a -signal source that generates a pure sine wave using |oscFixed| at a -fixed frequency, say 440 Hz: -\begin{code} -s1 :: Clock c => SigFun c () Double -s1 = proc () -> do - s <- oscFixed 440 -< () - outA -< s -\end{code} -Since the resulting signal |s| is directly returned through |outA|, -this example can also be written: -\begin{spec} -s1 = proc () -> do - oscFixed 440 -< () -\end{spec} -Alternatively, we could simply write |oscFixed 440|. - -To use |osc| instead, we first need to generate a wavetable that -represents one full cycle of a sine wave. We can do this using one of -Eutperpea's table generating functions, which are summarized in -Figure~\ref{fig:table-generators}. For example, using Euterpea's -|tableSinesN| function, we can define: -\begin{code} -tab1 :: Table -tab1 = tableSinesN 4096 [1] -\end{code} -This will generate a table of 4096 elements, consisting of one sine -wave whose peak amplitude is 1.0. Then we can define the following -signal source: -\begin{code} -s2 :: Clock c => SigFun c () Double -s2 = proc () -> do - osc tab1 0 -< 440 -\end{code} -Alternatively, we could use the |const| and composition operators to -write either |constA 440 >>> osc tab1 0| or |osc tab2 0 <<< constA -440|. |s1| and |s2| should be compared closely. - -\begin{figure} -\cbox{\small -\begin{spec} -type TableSize = Int -type PartialNum = Double -type PartialStrength = Double -type PhaseOffset = Double -type StartPt = Double -type SegLength = Double -type EndPt = Double -\end{spec} -\vspace{0.05in} - -\begin{spec} -tableLinear, tableLinearN :: - TableSize -> StartPt -> [(SegLength, EndPt)] -> Table -\end{spec} -|tableLinear size sp pts| is a table of size |size| whose starting -point is |(0,sp)| and that uses straight lines to move from that point -to, successively, each of the points in |pts|, which are -segment-length/endpoint pairs (segment lengths are projections along -the x-axis). |tableLinearN| is a normalized version of the result. -\vspace{0.15in} - -\begin{spec} -tableExpon, tableExponN :: - TableSize -> StartPt -> [(SegLength, EndPt)] -> Table -\end{spec} - -Just like |tableLinear| and |tableLinearN|, respectively, except that -exponential curves are used to connect the points. -\vspace{0.15in} - -\begin{spec} -tableSines3, tableSines3N :: - TableSize -> [(PartialNum, PartialStrength, PhaseOffset)] -> Table -\end{spec} - -|tableSines3 size triples| is a table of size |size| that represents a -sinusoidal wave and an arbitrary number of partials, whose -relationship to the fundamental frequency, amplitude, and phase are -determined by each of the triples in |triples|. |tableSines3N| is a -normalized version of the result. -\vspace{0.15in} - -\begin{spec} -tableSines, tableSinesN :: - TableSize -> [PartialStrength] -> Table -\end{spec} - -Like |tableSines3| and |tableSines3N|, respectively, except that the -second argument is an ordered list of the strengths of each partial, -starting with the fundamental. -\vspace{0.15in} - -\begin{spec} -tableBesselN :: - TableSize -> Double -> Table -\end{spec} - -|tableBesselN size x| is a table representing the log of a modified -Bessel function of the second kind, order 0, suitable for use in -amplitude-modulated FM. |x| is the x-interval (0 to |x|) over which -the function is defined. -} -\caption{Table Generating Functions} -\label{fig:table-generators} -\end{figure} - -Keep in mind that |oscFixed| only generates a sine wave, whereas |osc| -generates whatever is stored in the wavetable. Indeed, |tableSinesN| -actually creates a table that is the sum of a series of overtones, -i.e.\ multiples of the fundmental frequency (recall the discussion in -Section~\ref{sec:spectrum}). For example: -\begin{code} -tab2 = tableSinesN 4096 [1.0,0.5,0.33] -\end{code} -generates a waveform consisting of the fundamental frequency with -amplitude 1.0, the first overtone at amplitude 0.5, and the second -overtone at amplitude 0.33. So a more complex sound can be -synthesized just by changing the wavetable: -\begin{code} -s3 :: Clock c => SigFun c () Double -s3 = proc () -> do - osc tab2 0 -< 440 -\end{code} -To get the same effect using |oscFixed| we would have to write: -\begin{code} -s4 :: Clock c => SigFun c () Double -s4 = proc () -> do - f0 <- oscFixed 440 -< () - f1 <- oscFixed 880 -< () - f2 <- oscFixed 1320 -< () - outA -< (f0 + 0.5*f1 + 0.33*f2) / 1.83 -\end{code} -Not only is this more complex, it is less efficient. (The division by -1.83 is to normalize the result---if the peaks of the three signals -|f0|, |f1|, and |f2| align properly, the peak amplitude will be 1.83 -(or -1.83), which is outside the range $\pm 1.0$ and may cause -clipping (see discussion in Section~\ref{sec:generating-sound}). - -So far in these examples we have generated a signal whose fundamental -frequency is 440 Hz. But as mentioned, in the case of |osc|, the -input to the oscillator is a signal, and can therefore itself be -time-varying. As an example of this idea, let's implement -\emph{vibrato}---the performance effect whereby a musician slightly -varies the frequency of a note in a pulsating rhythm. On a string -instrument this is typically achieved by wiggling the finger on the -fingerboard, on a reed instrument by an adjustment of the breath and -emboucher to compress and relax the reed in a suitable way, and so on. - -Specifically, let's define a function: -\begin{spec} -vibrato :: Clock c => - Double -> Double -> SigFun c Double Double -\end{spec} -such that |vibrato f d| is a signal function that takes a frequency -argument (this is not a signal of a given frequency, it is the -frequency itself), and generates a signal at that frequency, but with -vibrato added, where |f| is the vibrato frequency, and |d| is the -vibrato depth. We will consider ``depth'' to be a measure of how many -Hz the input frequency is modulated. - -Intuitively, it seems as if we need \emph{two} oscillators, one to -generate the fundamental frequency of interest, and the other to -generate the vibrato (much lower in frequency). Here is a solution: -\begin{code} -vibrato :: Clock c => - Double -> Double -> SigFun c Double Double -vibrato vfrq dep = proc afrq -> do - vib <- osc tab1 0 -< vfrq - aud <- osc tab2 0 -< afrq + vib * dep - outA -< aud -\end{code} -Note that a pure sine wave is used for the vibrato signal, whereas -|tab2|, a sum of three sine waves, is chosen for the signal itself. - -For example, to play a 1000 Hz tone with a vibrato frequency of 5 Hz -and a depth of 20 Hz, we could write: -\begin{code} -s5 :: AudSF () Double -s5 = constA 1000 >>> vibrato 5 20 -\end{code} - -Vibrato is actually an example of a more general sound synthesis -technique called \emph{frequency modulation} (since one signal is -being used to vary, or modulate, the frequency of another signal), and -will be explained in more detail in Chapter~\ref{ch:fm}. Other -chapters include synthesis techniques such as additive and subtractive -synthesis, plucked instruments using waveguides, physical modeling, -granular synthesis, as well as audio processing techniques such as -filter design, reverb, and other effects. Now that we have a basic -understanding of signal functions, these techniques will be -straighforward to express in Euterpea. - -\section{Generating Sound} -\label{sec:generating-sound} - -Euterpea can execute some programs in real-time, but sufficiently -complex programs require writing the result to a file. The function -for achieving this is: -\begin{spec} -outFile :: (AudioSample a, Clock c) => - String -> Double -> SigFun c () a -> IO () -\end{spec} -%% outFile :: forall a p. (AudioSample a, Clock p) => -%% String -- ^ Filename to write to. -%% -> Double -- ^ Duration of the wav in seconds. -%% -> SigFun p () a -- ^ Signal representing the sound. -%% -> IO () -The first argument is the name of the WAV file to which the result is -written. The second argument is the duration of the result, in -seconds (remember that signals are conceptually infinite). The third -argument is a signal function that takes no input and generates a -signal of type |a| as output (i.e.\ a signal source), where |a| is -required to be an instance of the |AudioSample| type class, which -allows one to choose between mono, stereo, etc. - -For convenience, Euterpea defines these type synonyms: -\begin{spec} -type Mono p = SigFun p () Double -type Stereo p = SigFun p () (Double,Double) -\end{spec} - -For example, the IO command |outfile "test.wav" 5 sf| generates 5 -seconds of output from the signal function |sf|, and writes the result -to the file |"test.wav"|. If |sf| has type |Mono AudRate| -(i.e.\ |SigFun AudRate () Double| then the result will be monophonic; -if the type is |Stereo AudRate| (i.e.\ |SigFun AudRate () -(Double,Double)| the result will be stereophonic. - -%% |SigFun AudRate () (Double,Double,Double,Double)| yields -%% quadraphonic sound, and so on. - -One might think that |outFile| should be restricted to |AudRate|. -However, by allowing a signal of any clock rate to be written to a -file, one can use external tools to analyze the result of control -signals or other signals of interest as well. - -An important detail in writing WAV files with |outFile| is that care -must be taken to ensure that each sample falls in the range $\pm 1.0$. -If this range is exceeded, the output sound will be harshly distorted, -a phenomenon known as \emph{clipping}. The reason that clipping -sounds especially bad is that once the maximum limit is exceeded, the -subsequent samples are interpreted as the \emph{negation} of their -intended value---and thus the signal swings abruptly from its largest -possible value to its smallest possible value. Of course, signals -within your program may be well outside this range---it is only when -you are ready to write the result to a file that clipping needs to be -avoided. - -One can easily write signal functions that deal with clipping in one -way or another. For example here's one that simply returns the -maximum (positive) or mininum (negative) value if they are exceeded, -thus avoiding the abrupt change in magnitude described above, and -degenerating in the worst case to a square wave: -\begin{code} -simpleClip :: Clock c => SigFun c Double Double -simpleClip = arr f where - f x = if abs x <= 1.0 then x else signum x -\end{code} -\syn{|abs| is the absolute value function in Haskell, and |signum| - returns -1 for negative numbers, 0 for zero, and 1 for positive - numbers.} - -\todo{Define some signal functions to deal with time---for example - one that ``takes'' the first |t| seconds of a signal function, - returning zero for all times beyond that. We could write a special - function to do this, but using Occam's Razor suppose we have a signal - function |time :: Clock c => SigFun c () Double| that returns the - current time. Then we could write: -\begin{spec} -takeSF :: Clock c => Double -> SigFun c Double Double -takeSF t = proc x do - now <- time -< () - outA -< if now < t then x else 0 -\end{spec} -Indeed, time can be defined by: -\begin{code} -time :: Clock c => SigFun c () Double -time = integral <<< constA 1 -\end{code} - -Or, we could take a Yampa-like approach and use a ``switcher,'' but -then we'd need some switcher signal functions. There is a -collection-based switcher defined in |Euterpea.Audio.Render| called -|pSwitch|, but we might want something simpler. - -Even with all this, it seems desirable to have a ``debug'' function -that takes a time and a signal function, and returns a Boolean -indicating whether or not the signal function clipped or not during -that period of time. Again using Occam's razor, it seems best to -define a function |sfToList| that returns the infinite list underlying -a signal source. If we know the clock rate, then ``take''ing a -suitable prefix of this list will return the desired result. Then, -for example, |max (take 44100 (sfToList ss))| yields the maximum value -of the first 44100 samples of the signal source |ss|. One could then -use this to normalize the |ss|. - -Note that |sfToList| is not something that can be defined using -Euterpea as a library---it would have to be defined within -Euterpea's implementation of signal functions. -} - -\section{Instruments} -\label{sec:euterp-instruments} - -So far we have only considered signal functions as stand-alone values -whose output we can write to a WAV file. But how do we connect the -ideas in previous chapters about |Music| values, |Performance|s, and -so on, to the ideas presented in this chapter? This section presents -a bridge between the two worlds. - -\subsection{Turning a Signal Function into an Instrument} - -Suppose that we have a |Music| value that, previously, we would have -played using a MIDI instrument, and now we want to play using an -instrument that we have designed using signal functions. To do this, -first recall from Chapter~\ref{ch:music} that the |InstrumentName| -data type has a special constructor called |Custom|: -\begin{spec} -data InstrumentName = - AcousticGrandPiano - | BrightAcousticPiano - | ... - | Custom String - deriving (Show, Eq, Ord) -\end{spec} -With this constructor, names (represented as strings) can be given to -instruments that we have designed using signal functions. For -example: -\begin{code} -simpleInstr :: InstrumentName -simpleInstr = Custom "Simple Instrument" -\end{code} - -Now we need to define the instrument itself. Euterpea defines the -following type synonym: -\begin{spec} -type Instr a = Dur -> AbsPitch -> Volume -> [Double] -> a -\end{spec} -Although |Instr| is polymorphic, by far its most common instantiation -is the type |Instr (AufSF () Double)|. An instrument of this type is -a function that takes a duration, absolute pitch, volume, and a list -of parameters, and returns a signal source that generates the -resulting sound. - -The list of parameters (similar to the ``pfields'' in csound) are not -used by MIDI instruments, and thus have not been discussed until now. -They afford us unlimited expressiveness in controlling the sound of -our signal-function based instruments. Recall from -Chapter~\ref{ch:performance} the types: -\begin{spec} -type Music1 = Music Note1 -type Note1 = (Pitch, [NoteAttribute]) - -data NoteAttribute = - Volume Int - | Fingering Integer - | Dynamics String - | Params [Double] - deriving (Eq, Show) -\end{spec} -Using the |Params| constructor, each individual note in a |Music1| -value can be given a different list of parameters. It is up to the -instrument designer to decide how these parameters are used. - -There are three steps to playing a |Music| value using a user-defined -instrument. First, we must coerce our signal function into an -instrument having the proper type |Instr| as described above. For -example, let's turn the |vibrato| function from the last section into -a (rather primitive) instrument: -\begin{code} -myInstr :: Instr (AudSF () Double) - typecomment(Dur -> AbsPitch -> Volume -> [Double] -> (AudSF () Double)) -myInstr dur ap vol [vfrq,dep] = - proc () -> do - vib <- osc tab1 0 -< vfrq - aud <- osc tab2 0 -< apToHz ap + vib * dep - outA -< aud -\end{code} -Aside from the re-shuffling of arguments, note the use of the function -|apToHz|, which converts an absolute pitch into its corresponding -frequency: -\begin{spec} -apToHz :: Floating a => AbsPitch -> a -\end{spec} - -Next, we must connect our instrument name (used in the |Music| value) -to the instrument itself (such as defined above). This is achieved -using a simple association list, or \emph{instrument map}: -\begin{spec} -type InstrMap a = [(InstrumentName, Instr a)] -\end{spec} -Continuing the example started above: -\begin{code} -myInstrMap :: InstrMap (AudSF () Double) -myInstrMap = [(simpleInstr, myInstr)] -\end{code} - -Finally, we need a function that is analogous to |perform| from -Chapter~\ref{ch:performance}, except that instead of generating a -|Performance|, it creates a single signal function that will ``play'' -our |Music| value for us. In Euterpea that function is called -|renderSF|: -\begin{spec} -renderSF :: (Performable a, AudioSample b, Clock c) => - Music a -> - InstrMap (SigFun p () b) -> - (Double, SigFun p () b) -\end{spec} -The first element of the pair that is returned is the duration of the -|Music| value, just as is returned by |perform|. That way we know how -much of the signal function to render in order to hear the entire -composition. - -Using the simple melody |mel| in Figure~\ref{fig:reflections}, and the -simple vibrato instrument defined above, we can generate our result -and write it to a file, as follows: -\begin{code} -(dr, sf) = renderSF mel myInstrMap -main = outFile "simple.wav" dr sf -\end{code} -For clarity we show in Figure~\ref{fig:sf-instrument} all of the -pieces of this running example as one program. - -\begin{figure} -\cbox{ -\begin{code} -mel :: Music1 -mel = - let m = Euterpea.line [ na1 (c 4 en), na1 (ef 4 en), na1 (f 4 en), - na2 (af 4 qn), na1 (f 4 en), na1 (af 4 en), - na2 (bf 4 qn), na1 (af 4 en), na1 (bf 4 en), - na1 (c 5 en), na1 (ef 5 en), na1 (f 5 en), - na3 (af 5 wn) ] - na1 (Prim (Note d p)) = Prim (Note d (p,[Params [0, 0]])) - na2 (Prim (Note d p)) = Prim (Note d (p,[Params [5,10]])) - na3 (Prim (Note d p)) = Prim (Note d (p,[Params [5,20]])) - in instrument simpleInstr m -\end{code}} -\caption{A Simple Melody} -\label{fig:reflections} -\end{figure} - -\begin{figure} -\cbox{ -\begin{spec} -simpleInstr :: InstrumentName -simpleInstr = Custom "Simple Instrument" - -myInstr :: Instr (AudSF () Double) -myInstr dur ap vol [vfrq,dep] = - proc () -> do - vib <- osc tab1 0 -< vfrq - aud <- osc tab2 0 -< apToHz ap + vib * dep - outA -< aud - -myInstrMap :: InstrMap (AudSF () Double) -myInstrMap = [(simpleInstr, myInstr)] - -(d, sf) = renderSF mel myInstrMap -main = outFile "simple.wav" d sf -\end{spec}} -\caption{A Complete Example of a Signal-Function Based Instrument} -\label{fig:sf-instrument} -\end{figure} - -\subsection{Envelopes} -\label{sec:envelopes} - -Most instruments played by humans have a distinctive sound that is -partially dependent on how the performer plays a particular note. For -example, when a wind instrument is played (whether it be a flute, -saxophone, or trumpet), the note does not begin instantaneously---it -depends on how quickly and forcibly the performer blows into the -instrument. This is called the ``attack.'' Indeed, it is not -uncommon for the initial pulse of energy to generate a sound that is -louder than the ``sustained'' portion of the sound. And when the note -ends, the airflow does not stop instantaneously, so there is -variability in the ``release'' of the note. - -The overall variability in the loudness of a note can be simulated by -multiplying the output of a signal function by an \emph{envelope}, -which is a time-varying signal that captures the desired behavior. -Indeed, the \emph{ADSR envelope} (attack, decay, sustain, release) -introduced above is one of the most common envelopes used in practice. -It is shown pictorially in Figure \ref{fig:ADSR}. Before defining it -in Euterpea, however, we first describe a collection of simpler -envelopes. - -\begin{figure} -... -\caption{ADSR Envelope} -\label{fig:ADSR} -\end{figure} - -Figure~\ref{fig:line-envelopes} shows six pre-defined -envelope-generating functions. Read the code comments carefully to -understand what they do. - -\begin{figure} -\cbox{\small -\begin{spec} --- a linear envelope -envLine :: Clock p => - Double -> -- starting value - Double -> -- duration in seconds - Double -> -- value after dur seconds - SigFun p () Double - --- an exponential envelope -envExpon :: Clock p => - Double -> -- starting value; zero is illegal for exponentials - Double -> -- duration in seconds - Double -> -- value after dur seconds (must be non-zero - -- and agree in sign with first argument) - SigFun p () Double - --- a series of linear envelopes -envLineSeg :: Clock p => - [Double] -> -- list of points to trace through - [Double] -> -- list of durations for each line segment - -- (one element fewer than previous argument) - SigFun p () Double - --- a series of exponential envelopes -envExponSeg :: Clock p => - [Double] -> -- list of points to trace through - [Double] -> -- list of durations for each line segment - -- (one element fewer than previous argument) - SigFun p () Double - --- an ``attack/decay/release'' envelope; each segment is linear -envASR :: Clock p => - Double -> -- rise time in seconds - Double -> -- overall duration in seconds - Double -> -- decay time in seconds - SigFun p () Double - --- a more sophisticated ASR -envCSEnvlpx :: Clock p => - Double -> -- rise time in seconds - Double -> -- overall duration in seconds - Double -> -- decay time in seconds - Table -> -- table representing rise shape - Double -> -- attenuation factor, by which the last value - -- of the envlpx rise is modified during the - -- note's pseudo steady state - Double -> -- attenuation factor by which the closing - -- steady state value is reduced exponentially - -- over the decay period - SigFun p () Double -\end{spec}} -\caption{Envelopes} -\label{fig:line-envelopes} -\end{figure} - -Here are some additional comments regarding |envCSEnvplx|, easily the -most sophisticated of the envelope generators: -\begin{enumerate} -\item -The fifth argument to |envCSEnvplx|: A value greater than 1 causes -exponential growth; a value less than 1 causes exponential decay; a -value = 1 will maintain a true steady state at the last rise -value. The attenuation is not by a fixed rate (as in a piano), but is -sensitive to a note's duration. However, if this argument is less than -0 (or if steady state is less than 4 k-periods) a fixed attenuation -rate of |abs atss| per second is used. A value of 0 is illegal. -\item -The sixth arg to |envCSEnvplx|: Must be positive and is normally of the -order of 0.01. A large or excessively small value is apt to produce a -cutoff that is not audible. Values less than or equal to 0 are -disallowed. -\end{enumerate} - -\vspace{.1in}\hrule - -\begin{exercise}{\em -Using the Euterpea function |osc|, create a simple sinusoidal wave, -but using different table sizes, and different frequencies, and see if -you can hear the differences (report on what you hear). Use |outFile| -to write your results to a file, and be sure to use a decent set of -speakers or headphones.} -\end{exercise} - -\begin{exercise}{\em -The |vibrato| function varies a signal’s frequency at a given rate and -depth. Define an analogous function |tremolo| that varies the volume -at a given rate and depth. However, in a sense, |tremolo| is a kind -of envelope (infinite in duration), so define it as a signal source, -with which you can then shape whatever signal you wish. Consider the -``depth'' to be the fractional change to the volume; that is, a value -of 0 would result in no tremolo, a value of 0.1 would vary the -amplitude from 0.9 to 1.1, and so on. Test your result.} -\label{ex:tremolo} -\end{exercise} - -\begin{exercise}{\em -Define an ADSR (``attack/decay/sustain/release'') envelope generator -(i.e. a signal source) called |envADSR|, with type: -\begin{spec} -type DPair = (Double, Double) -- pair of duration and amplitude -envADSR :: DPair -> DPair -> DPair -> Double -> AudSF () Double -\end{spec} -The three |DPair| arguments are the duration and amplitude of the -attack, decay, and release ``phases,'' respectively, of the envelope. -The sustain phase should hold the last value of the decay phase. The -fourth argument is the duration of the entire envelope, and thus the -duration of the sustain phase should be that value minus the sum of -the durations of the other three phases. (Hint: use Euterpea’s -|envLineSeg| function.) Test your result. } -\end{exercise} - -\begin{exercise}{\em -Generate a signal that causes clipping, and listen to the result. -Then use |simpleClip| to ``clean it up'' somewhat---can you hear the -difference? Now write a more ambitious clipping function. In -particular, one that uses some kind of non-linear reduction in the -signal amplitude as it approaches plus or minus one (rather than -abruptly ``sticking'' at plus or minus one, as in |simpleClip|).} -\end{exercise} - -\begin{exercise}{\em -Define two instruments, each of type |Instr (AudSF () Double)|. These -can be as simple as you like, but each must take at least two -|Params|. Define an |InstrMap| that uses these, and then use -|renderSF| to ``drive'' your instruments from a |Music1| value. Test -your result.} -\end{exercise} - -\vspace{.1in}\hrule diff --git a/HSoM/Signals.lhs b/HSoM/Signals.lhs deleted file mode 100644 --- a/HSoM/Signals.lhs +++ /dev/null @@ -1,804 +0,0 @@ -%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- - -% ToDo: -% add remaining figures - -%include lhs2TeX.fmt -%include myFormat.fmt - -\chapter{Sound and Signals} -\label{ch:signals} - -In this chapter we study the fundamental nature of sound and its basic -mathematical representation as a signal. We also discuss discrete -digital representations of a signal, which form the basis of modern -sound synthesis and audio processing. - -% Taken from Chapter 2 of the text, and -% Blair School of Music (BSoM) http://www.computermusicresource.com/ - -\section{The Nature of Sound} -\label{sec:sound} - -Before studying digital audio, it's important that we first know what -\emph{sound} is. In essence, sound is the rapid compression and -relaxation of air, which travels as a \emph{wave} through the air from -the physical source of the sound to, ultimately, our ears. The -physical source of the sound could be the vibration of our vocal -chords (resulting in speech or singing), the vibration of a speaker -cone, the vibration of a car engine, the vibration of a string in a -piano or violin, the vibration of the reed in a saxophone or of -the lips when playing a trumpet, or even the (brief and chaotic) -vibrations that result when our hands come together as we clap. -The ``compression and relaxation'' of the air (or of a coiled spring) -is called a \emph{longitudinal} wave, in which the vibrations occur -parallel to the direction of travel of the wave. In contrast, a rope -that is fixed at one end and being shaken at the other, and a wave in -the ocean, are examples of a \emph{transverse} wave, in which the -rope's and water's movement is perpendicular to the direction the wave -is traveling. - -[Note: There are some great animations of these two kinds of waves at: -\newline - \verb|http://www.computermusicresource.com/what.is.sound.html|.] - -If the rate and amplitude of the sound are within a suitable range, we -can \emph{hear} the sound---i.e.\ it is \emph{audible sound}. -``Hearing'' results when the vibrating air waves cause our ear drum to -vibrate, in turn stimulating nerves that enter our brain. Sound above -our hearing range (i.e.\ vibration that is too quick to induce any -nerve impulses) is called \emph{ultrasonic sound}, and sound below our -hearing range is said to be \emph{infrasonic}. - -Staying within the analog world, sound can also be turned into an -\emph{electrical} signal using a \emph{microphone} (or ``mic'' for -short). Several common kinds of microphones are: -\begin{enumerate} -\item Carbon microphone. Based on the resistance of a pocket of - carbon particles that are compressed and relaxed by the sound waves - hitting a diaphram. -\item Condenser microphone. Based on the capacitance between two - diaphrams, one being vibrated by the sound. -\item Dynamic microphone. Based on the inductance of a coil of wire - suspended in a magnetic field (the inverse of a speaker). -\item Piezoelectric microphone. Based on the property of certain - crystals to induce current when they are bent. -\end{enumerate} - -\begin{figure}[hbtp] -\centering -\includegraphics[height=4in,angle=270]{pics/sinewave.eps} -\caption{A Sine Wave} -\label{fig:sine-wave} -\end{figure} - -Perhaps the most common and natural way to represent a wave -diagrammatically, whether it be a sound wave or electrical wave, -longitudinal or transverse, is as a \emph{graph} of its amplitude -vs.\ time. For example, Figure \ref{fig:sine-wave} shows a -\emph{sinusiodal wave} of 1000 cycles per second, with an amplitude -that varies beween +1 and -1. A sinusoidal wave follows precisely the -definition of the mathematical sine function, but also relates -strongly, as we shall soon see, to the vibration of sound produced by -most musical instruments. In the remainder of this text, we will -refer to a sinusoidal wave simply as a sine wave. - -%% \begin{figure*} -%% \centerline{ -%% \epsfysize=2in -%% \epsfbox{pics/sinewave.eps} -%% } -%% \caption{A Sine Wave} -%% \label{fig:sine-wave} -%% \end{figure*} - -%% Perhaps the most natural way to draw sound is the same as for an -%% electrical signal---that is, as a \emph{graph} of its amplitude -%% vs.\ time. For example, see Figure \ref{fig:signal-graph}. This same -%% representation can be used to represent both logitudinal and -%% transverse waves. - -\emph{Acoustics} is the study of the properties, in particular the -propagation and reflection, of sound. \emph{Psychoacoustics} is the -study of the mind's interpretation of sound, which is not always as -tidy as the physical properties that are manifest in acoustics. -Obviously both of these are important areas of study for music in -general, and therefore play an important role in generating or -simulating music with a computer. - -The speed of sound can vary considerably, depending on the material, -the temperature, the humidity, and so on. For example, in dry air at -room temperature (68 degrees Farenheit), sound travels at a rate of -1,125 feet (343 meters) per second, or 768 miles (1,236 kilometers) -per hour. Perhaps surprisingly, the speed of sound varies little with -respect to air pressure, although it does vary with temperature. - -The reflection and absorbtion of sound is a much more difficult topic, -since it depends so much on the material, the shape and thickness of -the material, and the frequency of the sound. Modeling well the -acoustics of a concert hall, for example, is quite challenging. To -understand how much such reflections can affect the overall sound that -we hear, consider a concert hall that is 200 feet long and 100 feet -wide. Based on the speed of sound given above, it will take a sound -wave $\nicefrac{2\times200}{1125} = 0.355$ seconds to travel from the -front of the room to the back of the room and back to the front again. -That $\nicefrac{1}{3}$ of a second, if loud enough, would result in a -significant distortion of the music, and corresponds to about one beat -with a metronome set at 168. - -With respect to our interpretation of music, sound has (at least) -three key properties: -\begin{enumerate} -\item \emph{Frequency} (perceived as \emph{pitch}). -\item \emph{Amplitude} (perceived as \emph{loudness}). -\item \emph{Spectrum} (perceived as \emph{timbre}). -\end{enumerate} -We discuss each of these in the sections that follow. - -%% \subsection{Review of Trigonometric Identities} - -%% In preparation for what follows, we quickly review some basic -%% properties of trigonometric functions that are useful for audio -%% processing. In general, all of the transcendental functions have a -%% use in audio processing and computer music applications, but our focus -%% here is on sine and cosine. - -\subsection{Frequency and Period} -\label{sec:frequency} - -The \emph{frequency} $f$ is simply the rate of the vibrations (or -repetitions, or cycles) of the sound, and is the inverse of the -\emph{period} (or duration, or wavelength) $p$ of each of the -vibrations: -\[ f = \frac{1}{p} \] -Frequency is measured in \emph{Hertz} (abbreviated Hz), where 1 Hz is -defined as one cycle per second. For example, the sound wave in -Figure \ref{fig:sine-wave} has a frequency of 1000 Hz (i.e.\ 1 kHz) -and a period of $\nicefrac{1}{1000}$ second (i.e.\ 1 ms). - -In trigonometry, functions like sine and cosine are typically applied -to angles that range from 0 to 360 degrees. In audio processing (and -signal processing in general) angles are instead usually measured in -\emph{radians}, where $2\pi$ radians is equal to $360^\circ$. Since -the sine function has a period of $2\pi$ and a frequency of -$\nicefrac{1}{2\pi}$, it repeats itself every $2\pi$ radians: -\[ \sin (2\pi k + \theta) = \sin \theta \] -for any integer $k$. - -But for our purposes it is better to parameterize these functions over -frequency as follows. Since $\sin(2\pi t)$ covers one full cycle in -one second, i.e.\ has a frequency of 1 Hz, it makes sense that -$\sin(2\pi f t)$ covers $f$ cycles in one second, i.e.\ has a frequency -of $f$. Indeed, in signal processing the quantity $\omega$ is defined -as: -\[ \omega = 2 \pi f \] -That is, a pure sine wave as a function of time behaves as -$\sin(\omega t)$. - -Finally, it is convenient to add a \emph{phase} (or \emph{phase - angle}) to our formula, which effectively shifts the sine wave in -time. The phase is usually represented by $\phi$. Adding a -multiplicative factor $A$ for amplitude (see next section), we arrive -at our final formula for a sine wave as a function of time: -\[ s(t) = A\sin(\omega t + \phi) \] -A negative value for $\phi$ has the effect of ``delaying'' the sine -wave, whereas a positive value has the effect of ``starting early.'' -Note also that this equation holds for negative values of $t$. - -All of the above can be related to cosine by recalling the following -identity: -\[ \sin(\omega t + \dfrac{\pi}{2}) = \cos(\omega t) \] -More generally: -\[ A \sin(\omega t + \phi) = a\cos(\omega t) + b\sin(\omega t) \] -Given $a$ and $b$ we can solve for $A$ and $\phi$: -\[\begin{array}{lcl} -A &=& \sqrt{a^2 + b^2} \\[.05in] -\phi &=& \tan^{-1} \dfrac{b}{a} -\end{array}\] -Given $A$ and $\phi$ we can also solve for $a$ and $b$: -\[\begin{array}{lcl} -a &=& A\cos(\phi) \\ -b &=& A\sin(\phi) -\end{array}\] - -\subsection{Amplitude and Loudness} -\label{sec:amplitude} - -Amplitude can be measured in several ways. The \emph{peak amplitude} -of a signal is its maximum deviation from zero; for example our sine -wave in Figure \ref{fig:sine-wave} has a peak amplitude of 1. But -different signals having the same peak amplitude have more or less -``energy,'' depending on their ``shape.'' For example, Figure -\ref{fig:rms} shows four kinds of signals: a sine wave, a square wave, -a sawtooth wave, and a triangular wave (whose names are suitably -descriptive). Each of them has a peak amplitude of 1. But, -intuitively, one would expect the square wave, for example, to have -more ``energy,'' or ``power,'' than a sine wave, because it is -``fatter.'' In fact, it's value is everywhere either +1 or -1. - -\begin{figure}[hbtp] -\centering -\includegraphics[height=3in,angle=270]{pics/sine_rms.eps} -\includegraphics[height=3in,angle=270]{pics/square_rms.eps} -\includegraphics[height=3in,angle=270]{pics/sawtooth_rms.eps} -\includegraphics[height=3in,angle=270]{pics/triangle_rms.eps} -\caption{RMS Amplitude for Different Signals} -\label{fig:rms} -\end{figure} - -To measure this characteristic of a signal, scientists and engineers -often refer to the \emph{root-mean-square} amplitude, or RMS. -Mathematically, the root-mean-square is the square root of the mean of -the squared values of a given quantity. If $x$ is a discrete quantity -given by the values $x_1, x_2, ..., x_n$, the formula for RMS is: - -\[ x_{\rm RMS} = \sqrt{\frac{x_1^2 + x_2^2 + ... + x_n^2}{n}} \] - -And if $f$ is continuous function, its RMS value over the interval $T_1 -\leq t \leq T_2$ is given by: - -\[ \sqrt{{\frac{1}{T_2-T_1}}\int_{-T_1}^{T_2}f(t)^2dt} \] - -For a sine wave, it can be shown that the RMS value is approximately -0.707 of the peak value. For a square wave, it is 1.0. And for both -a sawtooth wave and a triangular wave, it is approximately 0.577. -Figure \ref{fig:rms} shows these RMS values superimposed on each of -the four signals. - -Another way to measure amplitude is to use a relative logarithmic -scale that more aptly reflects how we hear sound. This is usually -done by measuring the sound level (usually in RMS) with respect to -some reference level. The number of \emph{decibels} (dB) of sound -is given by: -\[ S_{dB} = 10 \log_{10}\frac{S}{R} \] -where $S$ is the RMS sound level, and $R$ is the RMS reference -level. The accepted reference level for the human ear is $10^{-12}$ -watts per square meter, which is roughly the threshold of hearing. - -A related concept is the measure of how much useful information is in -a signal relative to the ``noise.'' The \emph{signal-to-noise ratio}, -or $\mathit{SNR}$, is defined as the ratio of the \emph{power} of each -of these signals, which is the square of the RMS value: -\[ \mathit{SNR} = \left(\frac{S}{N}\right)^2 \] -where $S$ and $N$ are the RMS values of the signal and noise, -respectively. As is often the case, it is better to express this on a -logarithmic scale, as follows: -\[\begin{array}{lcl} -\mathit{SNR}_{dB} &=& 10 \log_{10}\left(\dfrac{S}{N}\right)^2 \\[0.12in] - &=& 20 \log_{10}\dfrac{S}{N} -\end{array}\] - -The \emph{dynamic range} of a system is the difference between the -smallest and largest values that it can process. Because this range -is often very large, it is usually measured in decibels, which is a -logarithmic quantity. The ear, for example, has a truly remarkable -dynamic range---about 130 dB. To get some feel for this, silence -should be considered 0 dB, a whisper 30 dB, normal conversation about -60 dB, loud music 80 dB, a subway train 90 dB, and a jet plane taking -off or a very loud rock concert 120 dB or higher. - -Note that if you double the sound level, the decibels increase by -about 3 dB, whereas a million-fold increase corresponds to 60 dB: -\[\begin{array}{lclcl} -10 \log_{10}2 &=& 10 \times 0.301029996 &\cong& 3 \\ -10 \log_{10}10^6 &=& 10 \times 6 &=& 60 \\ -\end{array}\] -So the ear is truly adaptive! (The eye also has a large dynamic range -with respect to light intensity, but not quite as much as the ear, and -its response time is much slower.) - -\begin{figure}[hbtp] -\centering -\includegraphics[height=4in]{pics/equal_loudness_contour.eps} -\caption{Fletcher-Munson Equal Loudness Contour} -\label{fig:fletcher-munson} -\end{figure} - -Loudness is the perceived measure of amplitude, or volume, of sound, -and is thus subjective. It is most closely aligned with RMS -amplitude, with one important exception: loudness depends somewhat on -frequency! Of course that's obvious for really high and really low -frequencies (since at some point we can't hear them at all), but in -between things aren't constant either. Furthermore, no two humans are -the same. Figure \ref{fig:fletcher-munson} shows the -\emph{Fletcher-Munson Equal-Loudness Contour}, which reflects the -perceived equality of sound intensity by the average human ear with -respect to frequency. Note from this figure that: -\begin{itemize} -\item The human ear is less sensitive to low frequencies. -\item The maximum sensitivity is around 3-4 kHz, which roughly - corresponds to the resonance of the auditory canal. -\end{itemize} - -%% [See: \newline -%% \verb|http://hyperphysics.phy-astr.gsu.edu/Hbase/sound/earsens.html| -%% and -%% \verb|http://hyperphysics.phy-astr.gsu.edu/Hbase/hframe.html|] -%% \verb|http://www2.sfu.ca/sonic-studio/handbook/Equal_Loudness_Contours.html|.] - -Another important psychoacoustical property is captured in the -\emph{Weber\-Fechner Law}, which states that the \emph{just noticeable - difference} (jnd) in a quantity---i.e.\ the minimal change necessary -for humans to notice something in a cognitive sense---is a relative -constant, independent of the absolute level. That is, the ratio of -the change to the absolute measure of that quantity is constant: - -\[ \frac{\Delta q}{q} = k \] - -The jnd for loudness happens to be about 1 db, which is another -reason why the decibel scale is so convenient. 1 db corresponds to a -sound level ratio of 1.25892541. So, in order for a person to ``just -notice'' an increase in loudness, one has to increase the sound level -by about 25\%. If that seems high to you, it's because your ear is so -adaptive that you are not even aware of it. - -\subsection{Frequency Spectrum} -\label{sec:spectrum} - -Humans can hear sound approximately in the range 20 Hz to 20,000 Hz = -20 kHz. This is a dynamic range in frequency of a factor of 1000, or -30 dB. Different people can hear different degrees of this range (I -can hear very low tones well, but not very high ones). On a piano, -the fundamental frequency of the lowest note is 27.5 Hz, middle -(concert) A is 440 hz, and the top-most note is about 4 kHz. Later we -will learn that these notes also contain \emph{overtones}---multiples -of the fundamental frequency---that contribute to the \emph{timbre}, -or sound quality, that distinguishes one instrument from another. -(Overtones are also called \emph{harmonics} or \emph{partials}.) - -The \emph{phase}, or time delay, of a signal is important too, and -comes into play when we start mixing signals together, which can -happen naturally, deliberately, from reverberations (room acoustics), -and so on. Recall that a pure sine wave can be expressed as -$\sin(\omega t + \phi)$, where $\phi$ is the \emph{phase angle}. -Manipulating the phase angle is common in additive synthesis and -amplitude modulation, topics to be covered in later chapters. - -\begin{figure}[hbtp] -\centering -\includegraphics[height=3in,angle=270]{pics/sine_spect1.eps} -\begin{center} -(a) Spectral plot of pure sine wave -\end{center} -\includegraphics[height=3in,angle=270]{pics/sine_spect2.eps} -\begin{center} -(b) Spectral plot of a noisy sine wave -\end{center} -\includegraphics[height=3in,angle=270]{pics/sine_spect3.eps} -\begin{center} -(c) Spectral plot of a musical tone -\end{center} -\caption{Spectral Plots of Different Signals} -\label{fig:frequency-spectrum} -\end{figure} - -A key point is that most sounds do not consist of a single, pure sine -wave---rather, they are a combination of many frequencies, and at -varying phases relative to one another. Thus it is helpful to talk of -a signal's \emph{frequency spectrum}, or spectral content. If we have -a regular repetitive sound (called a \emph{periodic signal}) we can -plot its spectral content instead of its time-varying graph. For a -pure sine wave, this looks like an impulse function, as shown in -Figure \ref{fig:frequency-spectrum}a. - -But for a richer sound, it gets more complicated. First, the -distribution of the energy is not typically a pure impulse, meaning -that the signal might vary slightly above and below a particular -frequency, and thus its frequency spectrum typically looks more like -Figure \ref{fig:frequency-spectrum}b. - -In addition, a typical sound has many different frequencies associated -with it, not just one. Even for an instrument playing a single note, -this will include not just the perceived pitch, which is called the -\emph{fundamental frequency}, but also many \emph{overtones} (or -harmonics) which are multiples of the fundamental, as shown in Figure -\ref{fig:frequency-spectrum}c. The \emph{natural harmonic series} is -one that is approximated often in nature, and has a harmonically -decaying series of overtones. - -What's more, the articulation of a note by a performer on an -instrument causes these overtones to vary in relative size over time. -There are several ways to visualize this graphically, and Figure -\ref{fig:time-varying-spectrum} shows two of them. In -\ref{fig:time-varying-spectrum}a, shading is used to show the varying -amplitude over time. And in \ref{fig:time-varying-spectrum}b, a 3D -projection is used. - -\begin{figure}[hbtp] -\centering -\includegraphics[height=4in,angle=270]{pics/spectrum_map.eps} -\begin{center} -(a) Using shading -\end{center} -\includegraphics[height=4in,angle=270]{pics/spectrum_mesh.eps} -\begin{center} -(b) Using 3D projection -\end{center} -\caption{Time-Varying Spectral Plots} -\label{fig:time-varying-spectrum} -\end{figure} - -The precise blend of the overtones, their phases, and how they vary -over time, is primarily what distinguishes a particular note, say -concert A, on a piano from the same note on a guitar, a violin, a -saxophone, and so on. We will have much more to say about these -issues in later chapters. - -[See pictures at: -\newline - \verb|http://www.computermusicresource.com/spectrum.html|.] - -% This also relates to the envelope that “shapes” a sound. [see BSoM -% for more ideas on this] - -\section{Digital Audio} -\label{sec:digital-audio} - -The preceding discussion has assumed that sound is a continuous -quantity, which of course it is, and thus we represent it using -continuous mathematical functions. If we were using an analog -computer, we could continue with this representation, and create -electronic music accordingly. Indeed, the earliest electronic -synthesizers, such as the \emph{Moog synthesizer} of the 1960's, were -completely analog. - -However, most computers today are \emph{digital}, which require -representing sound (or signals in general) using digital values. The -simplest way to do this is to represent a continuous signal as a -\emph{sequence of discrete samples} of the signal of interest. An -\emph{analog-to-digital converter}, or ADC, is a device that converts -an instantaneous sample of a continuous signal into a binary value. -The microphone input on a computer, for example, connects to an ADC. - -Normally the discrete samples are taken at a fixed \emph{sampling - rate}. Choosing a proper sampling rate is quite important. If it -is too low, we will not acquire sufficient samples to adequately -represent the signal of interest. And if the rate is too high, it may -be an overkill, thus wasting precious computing resources (in both -time and memory consumption). Intuitively, it seems that the highest -frequency signal that we could represent using a sampling rate $r$ -would have a frequency of $\nicefrac{r}{2}$, in which case the result -would have the appearance of a square wave, as shown in Figure -\ref{fig:sample-rate}a. Indeed, it is easy to see that problems could -arise if we sampled at a rate significantly lower than the frequency -of the signal, as shown in Figures \ref{fig:sample-rate}b and -\ref{fig:sample-rate}c for sampling rates equal to, and one-half, of -the frequency of the signal of interest---in both cases the result is -a sampled signal of 0 Hz! - -\begin{figure}[hbtp] -\centering -\includegraphics[height=3.1in,angle=270]{pics/aliasing_2f.eps} -\begin{center} -(a) -\end{center} -\includegraphics[height=3.1in,angle=270]{pics/aliasing_f.eps} -\begin{center} -(b) -\end{center} -\includegraphics[height=3.1in,angle=270]{pics/aliasing_half-f.eps} -\begin{center} -(c) -\end{center} -\caption{Choice of Sampling Rate} -\label{fig:sample-rate} -\end{figure} - -Indeed, this observation is captured in what is known as the -\emph{Nyquist-Shannon Sampling Theorm} that, stated informally, says -that the accurate reproduction of an analog signal (no matter how -complicated) requires a sampling rate that is at least twice the -highest frequency of the signal of interest. - -For example, for audio signals, if the highest frequency humans can -hear is 20 kHz, then we need to sample at a rate of at least 40 kHz -for a faithful reproduction of sound. In fact, CD's are recorded at -44.1 kHz. But many people feel that this rate is too low, as some -people can hear beyond 20 kHz. Another recording studio standard is -48 kHz. Interestingly, a good analog tape recorder from generations -ago was able to record signals with frequency content even higher than -this---perhaps digital is not always better! - -\subsection{From Continuous to Discrete} -\label{sec:discrete} - -Recall the definition of a sine wave from Section \ref{sec:frequency}: -\[ s(t) = A\sin(\omega t + \phi) \] -We can easily and intuitively convert this to the discrete domain by -replacing the time $t$ with the quantity $\nicefrac{n}{r}$, where $n$ -is the integer index into the sequence of discrete samples, and $r$ is -the sampling rate discussed above. If we use $s[n]$ to denote the -$(n+1)^{\rm th}$ sample of the signal, we have: -\[ s[n] = A\sin\left(\frac{\omega n}{r} + \phi\right),\ \ \ \ \ \ \ \ - n = 0, 1, ..., \infty \] -Thus $s[n]$ corresponds to the signal's value at time $\nicefrac{n}{r}$. - -\subsection{Fixed-Waveform Table-Lookup Synthesis} -\label{sec:wavetable} - -One of the most fundamental questions in digital audio is how to -generate a sine wave as efficiently as possible, or, in general, how -to generate a fixed periodic signal of any form (sine wave, square -wave, sawtooth wave, even a sampled sound bite). A common and -efficient way to generate a periodic signal is through -\emph{fixed-waveform table-lookup synthesis}. The idea is very -simple: store in a table the samples of a desired periodic signal, and -then index through the table at a suitable rate to reproduce that -signal at some desired frequency. The table is often called a -\emph{wavetable}. - -In general, if we let: -\[\begin{array}{lcl} -L &=& {\rm table\ length} \\ -f &=& {\rm resulting\ frequency} \\ -i &=& {\rm indexing\ increment} \\ -r &=& {\rm sample\ rate} -\end{array}\] -then we have: -\[ f = \frac{i r}{L} \] - -For example, suppose the table contains 8196 samples. If the sample -rate is 44.1 kHz, how do we generate a tone of, say, 440 Hz? Plugging -in the numbers and solving the above equation for $i$, we get: -\[\begin{array}{lcl} -440 &=& \dfrac{i \times 44.1 {\rm kHz}}{8196} \\[.1in] -i &=& \dfrac{440 \times 8196}{44.1 {\rm kHz}} \\[.1in] - &=& 81.77 -\end{array}\] -So, if we were to sample approximately every 81.77$^{\rm th}$ value in -the table, we would generate a signal of 440 Hz. - -Now suppose the table $T$ is a vector, and $T[n]$ is the $n$th -element. Let's call the exact index increment $i$ into a continuous -signal the \emph{phase}, and the actual index into the corresponding -table the \emph{phase index} $p$. The computation of successive -values of the phase index and output signal $s$ is then captured by -these equations: -\[\begin{array}{lcl} -p_o &=& \lfloor \phi_0 + 0.5 \rfloor \\ -p_{n+1} &=& (p_n + i) \bmod L \\ -s_n &=& T [\ \lfloor p_n + 0.5 \rfloor\ ] -\end{array}\] -$\lfloor a+0.5 \rfloor$ denotes the floor of $a+0.5$, which effectively -rounds $a$ to the nearest integer. $\phi_0$ is the initial phase -angle (recall earlier discussion), so $p_0$ is the initial index into -the table that specifies where the fixed waveform should begin. - -Instead of rounding the index, one could do better by -\emph{interpolating} between values in the table, at the expense of -efficiency. In practice, rounding the index is often good enough. -Another way to increase accuracy is to simply increase the size of the -table. - -\subsection{Aliasing} -\label{sec:aliasing} - -Earlier we saw examples of problems that can arise if the sampling -rate is not high enough. We saw that if we sample a sine wave at -twice its frequency, we can suitably capture that frequency. If we -sample at exactly its frequency, we get 0 Hz. But what happens in -between? Consider a sampling rate ever-so-slightly higher or lower -than the sine wave's fundamental frequency-–-in both cases, this will -result in a frequency much lower than the original signal, as shown in -Figures \ref{fig:aliasing1} and \ref{fig:aliasing2}. This is -analogous to the effect of seeing spinning objects under fluorescent -or LED light, or old motion pictures of the spokes in the wheels of -horse-drawn carriages. - -\begin{figure}[hbtp] -\centering -\includegraphics[height=4in,angle=270]{pics/aliasing_lowf1.eps} -\includegraphics[height=4in,angle=270]{pics/aliasing_lowf2.eps} -\caption{Aliasing 1} -\label{fig:aliasing1} -\end{figure} - -\begin{figure}[hbtp] -\centering -\includegraphics[height=4in,angle=270]{pics/aliasing_lowf5.eps} -\includegraphics[height=4in,angle=270]{pics/aliasing_lowf6.eps} -\caption{Aliasing 2} -\label{fig:aliasing2} -\end{figure} - -These figures suggest the following. Suppose that $m$ is one-half the -sampling rate. Then: -\[\begin{array}{lll} -\hline \\ -{\rm Original\ signal} && {\rm Reproduced\ signal} \\ -\hline -0-m && 0-m \\ -m-2m && m-0 \\ -2m-3m && 0-m \\ -3m-4m && m-0 \\ -\cdots && \cdots \\ -\hline -\end{array}\] -This phenomenon is called \emph{aliasing}, or \emph{foldover} of the -signal onto itself. - -This is not good! In particular, it means that audio signals in the -ultrasonic range will get ``folded'' into the audible range. To solve -this problem, we can add an analog \emph{low-pass filter} in front of -the ADC--–usually called an \emph{anti-aliasing} filter---to eliminate -all but the audible sound before it is digitized. In practice, -however, this can be tricky. For example, a steep analog filter -introduces \emph{phase distortion} (i.e.\ frequency-dependent time -delays), and early digital recordings were notorious in the ``harsh -sound'' that resulted. This can be fixed by using a filter with less -steepness (but resulting in more aliasing), or using a time -correlation filter to compensate, or using a technique called -\emph{oversampling}, which is beyond the scope of this text. - -A similar problem occurs at the other end of the digital audio -process---i.e.\ when we reconstruct an analog signal from a digital -signal using a \emph{digital-to-analog converter}, or DAC. The -digital representation of a signal can be viewed mathematically as a -stepwise approximation to the real signal, as shown in Figure -\ref{fig:no-aliasing}, where the sampling rate is ten times the -frequency of interest. As discussed earlier, at the highest frequency -(i.e.\ at one-half the sampling rate), we get a square wave. As we -will see in Chapter~\ref{ch:spectrum-analysis}, a square wave can be -represented mathematically as the sum of an infinite sequence of sine -waves, consisting of the fundamental frequency and all of its odd -harmonics. These harmonics can enter the ultrasonic region, causing -potential havoc in the analog circuitry, or in a dog's ear (dogs can -hear frequencies much higher than humans). The solution is to add yet -another low-pass filter, called an \emph{anti-imaging} or -\emph{smoothing} filter to the output of the DAC. In effect, this -filter ``connects the dots,'' or interpolates, between successive -values of the stepwise approximation. - -\begin{figure}[hbtp] -\centering -\includegraphics[height=3.2in,angle=270]{pics/noaliasing.eps} -\caption{A Properly Sampled Signal} -\label{fig:no-aliasing} -\end{figure} - -In any case, a basic block diagram of a typical digital audio -system---from sound input to sound output---is shown in Figure -\ref{fig:DAW-block-diagram}. - -\begin{figure} -\centering -\includegraphics[height=4.0in]{pics/DAWBlockDiagram.eps} -\caption{Block Diagram of Typical Digital Audio System} -\label{fig:DAW-block-diagram} -\end{figure} - -\subsection{Quantization Error} -\label{sec:quantization} - -In terms of amplitude, remember that we are using digital numbers to -represent an analog signal. For conventional CD's, 16 bits of -precision are used. If we were to compute and then ``listen to'' the -round-off errors that are induced, we would hear subtle imperfections, -called \emph{quantization error}, or more commonly, ``noise.'' - -One might compare this to ``hiss'' on a tape recorder (which is due to -the molecular disarray of the magnetic recording medium), but there -are important differences. First of all, when there is no sound, -there is no quantization error in a digital signal, but there is still -hiss on a tape. Also, when the signal is very low and regular, the -quantization error becomes somewhat regular as well, and is thus -audible as something different from hiss. Indeed, it's only when the -signal is loud and complex that quantization error compares favorably -to tape hiss. - -One solution to the problem of low signal levels mentioned above is to -purposely introduce noise into the system to make the signal less -predictable. This fortuitous use of noise deserves a better name, and -indeed it is called \emph{dither}. - -\subsection{Dynamic Range} -\label{sec:dynamic-range} - -What is the dynamic range of an $n$-bit digital audio system? If we -think of quantization error as noise, it makes sense to -use the equation for $\mathit{SNR}_{dB}$ given in Section \ref{sec:amplitude}: - -\[ \mathit{SNR}_{dB} = 20 \log_{10}\frac{S}{N} \] - -But what should $N$ be, i.e.\ the quantization error? Given a signal -amplitude range of $\pm a$, with $n$ bits of resolution it is divided -into $\nicefrac{2a}{2^n}$ points. Therefore the dynamic range is: -\[\begin{array}{lcl} -20 \log_{10}\left(\dfrac{2a}{\nicefrac{2a}{2^n}}\right) - &=& 20 \times\log_{10}(2^n) \\ - &=& 20 \times n \times\log_{10} (2) \\[.02in] - &\approx& 20 \times n \times (0.3) \\[.02in] - &=& 6n -\end{array}\] -For example, a 16-bit digital audio system results in a dynamic range -of 96 dB, which is pretty good, although a 20-bit system yields 120 -dB, corresponding to the dynamic range of the human ear. - -\vspace{.1in}\hrule - -\begin{exercise}{\em -For each of the following, say whether it is a longitudinal wave or a -transverse wave: -\begin{itemize} -\item A vibrating violin string. -\item Stop-and-go traffic on a highway. -\item ``The wave'' in a crowd at a stadium. -\item ``Water hammer'' in the plumbing of your house. -\item The wave caused by a stone falling in a pond. -\item A radio wave. -\end{itemize} } -\end{exercise} - -\begin{exercise}{\em -You see a lightning strike, and 5 seconds later you hear the thunder. -How far away is the lightning? } -\end{exercise} - -\begin{exercise}{\em -You clap your hands in a canyon, and 2 seconds later you hear an echo. -How far away is the canyon wall? } -\end{exercise} - -\begin{exercise}{\em -By what factor must one increase the RMS level of a signal to yield a -10 dB increase in sound level? } -\end{exercise} - -\begin{exercise}{\em -A dog can hear in the range 60-45,000 Hz, and a bat 2,000-110,000 Hz. -In terms of the frequency response, what are the corresponding dynamic -ranges for these two animals, and how do they compare to that of -humans? } -\end{exercise} - -\begin{exercise}{\em -What is the maximum number of audible overtones in a note whose -fundamental frequency is 100 Hz? 500 Hz? 1500 Hz? 5 kHz? } -\end{exercise} - -\begin{exercise}{\em -Consider a continuous input signal whose frequency is f. Devise a -formula for the frequency r of the reproduced signal given a sample -rate s. } -\end{exercise} - -\begin{exercise}{\em -How much memory is needed to record 3 minutes of stereo sound using -16-bit samples taken at a rate of 44.1 kHz? } -\end{exercise} - -\begin{exercise}{\em -If we want the best possible sound, how large should the table be using -fixed-waveform table-lookup synthesis, in order to cover the audible -frequency range? } -\end{exercise} - -\begin{exercise}{\em -The Doppler effect occurs when a sound source is in motion. For -example, as a police car moves toward you its siren sounds higher than -it really is, and as it goes past you, it gets lower. How fast would -a police car have to go to change a siren whose frequency is the same -as concert A, to a pitch an octave higher? (i.e. twice the frequency) -At that speed, what frequency would we hear after the police car -passes us? } -\end{exercise} - -\vspace{.1in}\hrule - -\out{ ------------------------- - -Oversampling - -Oversampling is a simple “trick” that improves dynamic range as well -as anti-aliasing. The idea is to interpolate between digital samples. -This became popular in early CD players. - -More recently so-called “1-bit oversampling” has become popular. The -idea here is to represent signals using a single bit of quantization, -but sample at a much higher rate. This trade-off in “information -content” is well-known mathematically, and in practice it greatly -simplifies the anti-aliasing problem, because the filter that is -needed can be far less steep (since the higher rate takes us way out -of the audible range). - -} diff --git a/HSoM/SpectrumAnalysis.lhs b/HSoM/SpectrumAnalysis.lhs deleted file mode 100644 --- a/HSoM/SpectrumAnalysis.lhs +++ /dev/null @@ -1,986 +0,0 @@ -%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- - -%include lhs2TeX.fmt -%include myFormat.fmt - -\out{ -\begin{code} --- This code was automatically generated by lhs2tex --code, from the file --- HSoM/SpectrumAnalysis.lhs. (See HSoM/MakeCode.bat.) - -\end{code} -} - -\chapter{Spectrum Analysis} -\label{ch:spectrum-analysis} - -\begin{code} -{-# LANGUAGE Arrows #-} - -module Euterpea.Music.Signal.SpectrumAnalysis where - -import Euterpea -import Euterpea.Experimental (fftA) - -import Data.Complex (Complex ((:+)), polar) -import Data.Maybe (listToMaybe, catMaybes) - -\end{code} - -There are many situations where it is desirable to take an existing -sound signal---in particular one that is recorded by a -microphone---and analyze it for its spectral content. If one can do -this effectively, it is then possible (at least in theory) to recreate -the original sound, or to create novel variations of it. The thepry -behind this approach is based on \emph{Fourier's Theorem}, which -states that any periodic signal can be decomposed into a weighted sum -of (a potentially infinite number of) sine waves. In this chapter we -discuss the theory as well as the pragmatics for doing spectrum -analysis in Euterpea. - -\section{Fourier's Theorem} -\label{sec:fouriers-theorem} - -A \emph{periodic signal} is a signal that repeats itself infinitely -often. Mathematically, a signal $x$ is periodic if there exists a -real number $T$ such that for all integers $n$: -\[ x(t) = x(t + nT) \] -%% \[ (\exists\ T\! \in\! \mathbb{R}) (\forall n\! \in\! \mathbb{Z}): x(t) = x(t + nT) \] -%% where $\mathbb{R}$ is the set of real numbers and $\mathbb{Z}$ is the -%% set of integers. -$T$ is called the \emph{period}, which may be just a few microseconds, -a few seconds, or perhaps days---the only thing that matters is that -the signal repeats itself. Usually we want to find the smallest value -of $T$ that satisfies the above property. For example, a sine wave is -surely periodic; indeed, recall from Section \ref{sec:frequency} that: -\[ \sin (2\pi k + \theta) = \sin \theta \] -for any integer $k$. In this case, $T = 2\pi$, and it is the smallest -value that satisfies this property. - -But in what sense is, for example, a single musical note periodic? -Indeed it is not, unless it is repeated infinitely often, which would -not be very interesting musically. Yet something we would like to -know is the spectral content of that single note, or even of a small -portion of that note, within an entire composition. This is one of -the practical problems that we will address later in the chapter. - -%% In the case of audio, since humans cannot hear sound lower than -%% about 20 Hz, we need only concern ourselves with periodic signals -%% whose repetition period is less than 50 milliseconds -%% (\nicefrac{1}{20} of a second). - -Recall from Section \ref{sec:frequency} that a sine wave can be -represented by: $x(t) = A\sin(\omega t + \phi)$, where $A$ is the -amplitude, $\omega$ is the radian frequency, and $\phi$ is the phase -angle. Joseph Fourier, a french mathematician and physicist, showed -the following result. Any periodic signal $x(t)$ with period $T$ can -be represented as: -\begin{equation}\label{eq:fourier-series} -x(t) = C_0 + \sum_{n=1}^{\infty} C_n \cos(\omega_0 nt + \phi_n) -\end{equation} -This is called \emph{Fourier's Theorem}. $\omega_0 = -\nicefrac{2\pi}{T}$ is called the \emph{fundamental frequency}. Note -that the frequency of each cosine wave in the series is an integer -multiple of the fundamental frequency. The above equation is also -called the \emph{Fourier series} or \emph{harmonic series} (related, -but not to be confused with, the mathematical definition of harmonic -series, which has the precise form $1 + \nicefrac{1}{2} + -\nicefrac{1}{3} + \nicefrac{1}{4} + \cdots$). - -The trick, of course, is determining what the coefficients $C_0$, -$...$, $C_n$ and phase angles $\phi_1$, $...$, $\phi_n$ are. -Determining the above equation for a particular periodic signal is -called \emph{Fourier analysis}, and synthesizing a sound based on the -above equation is called \emph{Fourier synthesis}. Theoretically, at -least, we should be able to use Fourier analysis to decompose a sound -of interest into its composite sine waves, and then regenerate it by -artificially generating those composite sine waves and adding them -together (i.e.\ additive synthesis, to be described in -Chapter~\ref{ch:additive}). Of course, we also have to deal with the -fact that the representation may involve an \emph{infinite} number of -composite signals. - -As discussed somewhat in Chapter~\ref{ch:signals}, many naturally -occurring vibrations in nature---including the resonances of most -musical instruments---are characterized as having a fundamental -frequency (the perceived pitch) and some combination of multiples of -that frequency, which are often called \emph{harmonics}, -\emph{overtones} or \emph{partials}. So Fourier's Theorem seems to be -a good match for this musical application. - -\subsection{The Fourier Transform} - -When studying Fourier analysis, it is more convenient, mathematically, -to use \emph{complex exponentials}. We can relate working with -complex exponentials back to sines and cosines using \emph{Euler's - Formula}: -\[\begin{array}{lcl} -e^{j\theta} &=& cos(\theta) + j sin(\theta) \\[.05in] -cos(\theta) &=& \dfrac{1}{2} (e^{j\theta} + e^{-j\theta}) \\[.1in] -sin(\theta) &=& \dfrac{1}{2} (e^{j\theta} - e^{-j\theta}) -\end{array}\] - -For a periodic signal $x(t)$, which we consider to be a -function of time, we denote its \emph{Fourier transform} by -$\hat{x}(f)$, which is a function of frequency. Each point in -$\hat{x}$ is a complex number that represents the magnitude and phase -of the frequency $f$'s presence in $x(t)$. Using complex -exponentials, the formula for $\hat{x}(f)$ in terms of $x(t)$ is: -\[ \hat{x}(f) = \int_{-\infty}^{\infty} x(t) e^{-j\omega t} dt \] -where $\omega = 2\pi f$, and $j$ is the same as the imaginary unit $i$ -used in mathematics.\footnote{Historically, engineers prefer to use - the symbol $j$ rather than $i$, because $i$ is generally used to - represent current in an electrical circuit.} Intuitively, the -Fourier transform at a particular frequency $f$ is the integral of the -product of the original signal and a pure sinusiodal wave $e^{-j\omega - t}$. This latter process is related to the \emph{convolution} of -the two signals, and intuitively will be non-zero only when the signal -has some content of that pure signal in it. - -The above equation describes $\hat{x}$ in terms of $x$. We can also -go the other way around---defining $x$ in terms of $\hat{x}$: -\[ x(t) = \int_{-\infty}^{\infty} \hat{x}(f) e^{j\hat{\omega} f} df \] -where $\hat{\omega} = 2\pi t$. This is called the \emph{inverse} -Fourier transform. - -%% -2 pi i x e => -2 pi j t f => -j w t -%% 2 pi i x e => 2 pi j t f => -j what f - -If we expand the definitions of $\omega$ and $\hat{\omega}$ we can see - how similar these two equations are: -%% \[\begin{array}{lcl} -\begin{equation}\label{eq:ft} -\hat{x}(f) = \int_{-\infty}^{\infty} x(t) e^{-j2\pi f t} dt -\end{equation} -\begin{equation}\label{eq:ift} - x(t) = \int_{-\infty}^{\infty} \hat{x}(f) e^{ j2\pi f t} df -\end{equation} -%% \end{array}\] -These two equations, for the Fourier transform and its inverse, are -remarkable in their simplicity and power. They are also remarkable in -the following sense: \emph{no information is lost when converting from - one to the other}. In other words, a signal can be represented in -terms of its time-varying behavior or its spectral content---they are -equivalent! - -A function that has the property that $f(x) = f(-x)$ is called an -\emph{even} function; if $f(x) = - f(-x)$ it is said to be \emph{odd}. -It turns out that, perhaps surprisingly, \emph{any} function can be -expressed as the sum of a single even function and a single odd -function. This may help provide some intuition about the equations -for the Fourier transform, because the complex exponential -$e^{j2\pi f t}$ separates the waveform by which it is being multiplied -into its even and odd parts (recall Euler's formula). The real -(cosine) part affects only the even part of the input, and the -imaginary (sine) part affects only the odd part of the input. - -\subsection{Examples} - -Let's consider some examples, which are illustrated in -Figure~\ref{fig:fourier-transforms}: -\begin{itemize} -\item -Intuitively, the Fourier transform of a pure cosine wave should be an -impulse function---that is, the spectral content of a cosine wave -should be concentrated completely at the frequency of the cosine wave. -The only catch is that, when working in the complex domain, the -Fourier transform also yields the mirror image of the spectral -content, at a frequency that is the negation of the cosine wave's -frequency, as shown in Figure~\ref{fig:fourier-transforms}a. In other -words, in this case, $\hat{x}(f) = \hat{x}(-f)$, i.e.\ $\hat{x}$ is -even. So the spectral content is the \emph{real} part of the complex -number returned from the Fourier transform (recall Euler's formula). - -\item -In the case of a pure sine wave, we should expect a similar result. -The only catch now is that the spectral content is contained in the -\emph{imaginary} part of the complex number returned from the Fourier -transform (recall Euler's formula), and the mirror image is negated. -That is, $\hat{x}(f) = - \hat{x}(-f)$, i.e.\ $\hat{x}$ is odd. This -is illustrated in Figure~\ref{fig:fourier-transforms}b. - -\item -Conversely, consider what the spectral content of an impulse function -should be. Because an impulse function is infinitely ``sharp,'' it -would seem that its spectrum should contain energy at every point in -the frequency domain. Indeed, the Fourier transform of an impulse -function centered at zero is a constant, as shown in -Figure~\ref{fig:fourier-transforms}c. - -\item -Consider now the spectral content of a square wave. It can be shown -that the Fourier series representation of a square wave is the sum of -the square wave's fundamental frequency plus its harmonically -decreasing (in magnitude) odd harmonics. Specifically: -\begin{equation}\label{eq:square-wave-series} -sq(t) = \sum_{k=1}^{\infty} \frac{1}{k} \sin k\omega t,\quad {\rm for\ odd\ } k -\end{equation} -The spectral content of this signal in shown in -Figure~\ref{fig:fourier-transforms}d. -Figure~\ref{fig:square-wave-series} also shows partial reconstruction -of the square wave from a finite number of its composite signals. -\end{itemize} - -It is worth noting that the diagrams in -Figure~\ref{fig:fourier-transforms} make no assumptions about time or -frequency. Therefore, because the Fourier transform and its inverse -are true mathematical inverses, we can read the diagrams as time -domain / frequency domain pairs, or the other way around; i.e.\ as -frequency domain / time domain pairs. For example, interpreting the -diagram on the left of Figure~\ref{fig:fourier-transforms}a in the -frequency domain, is to say that it is the Fourier transform of the -signal on the right (interpreted in the time domain). - -\begin{figure}[hbtp] -\centering -\includegraphics[height=2.4in,angle=270]{pics/cosine1.eps} -\includegraphics[height=2.4in,angle=270]{pics/cosine2.eps} -\begin{center} -(a) Cosine wave -\end{center} -\includegraphics[height=2.4in,angle=270]{pics/sine1.eps} -\includegraphics[height=2.4in,angle=270]{pics/sine2.eps} -\begin{center} -(b) Sine wave -\end{center} -\includegraphics[height=2.4in,angle=270]{pics/pulse1.eps} -\includegraphics[height=2.4in,angle=270]{pics/pulse2.eps} -\begin{center} -(c) Impulse function -\end{center} -\includegraphics[height=2.4in,angle=270]{pics/square1.eps} -\includegraphics[height=2.4in,angle=270]{pics/square2.eps} -\begin{center} -(d) Square wave -\end{center} -\caption{Examples of Fourier Transforms} -\label{fig:fourier-transforms} -\end{figure} - -\begin{figure}[hbtp] -\centering -\includegraphics[height=2.4in,angle=270]{pics/19_2a.eps} -\begin{center} -(a) Sine wave -\end{center} -\includegraphics[height=2.4in,angle=270]{pics/19_2b.eps} -\begin{center} -(b) Sine wave + third harmonic -\end{center} -\includegraphics[height=2.4in,angle=270]{pics/19_2c.eps} -\begin{center} -(c) Sine wave + third and fifth harmonics -\end{center} -\includegraphics[height=2.4in,angle=270]{pics/19_2d.eps} -\begin{center} -(d) Sum of first eight terms of the Fourier series of a square wave -\end{center} -\caption{Generating a Square Wave from Odd Harmonics} -\label{fig:square-wave-series} -\end{figure} - -\section{The Discrete Fourier Transform} -\label{sec:DFT} - -Recall from Section \ref{sec:discrete} that we can move from the -continuous signal domain to the discrete domain by replacing the time -$t$ with the quantity $\nicefrac{n}{r}$, where $n$ is the integer -index into the sequence of discrete samples, and $r$ is the sampling -rate. Let us assume that we have done this for $x$, and we will use -square brackets to denote the difference. That is, $x[n]$ denotes the -$n^{\rm th}$ sample of the continuous signal $x(t)$, corresponding to -the value $x(\nicefrac{n}{r})$. - -We would now like to compute the \emph{Discrete Fourier Transform} -(DFT) of our discrete signal. But instead of being concerned about -the sampling rate (which can introduce aliasing, for example), our -concern turns to the \emph{number of samples} that we use in computing -the DFT---let's call this $N$. Intuitively, the integrals used in our -equations for the Fourier transform and its inverse should become sums -over the range $0 ... N-1$. This leads to a reformulation of our two -equations (\ref{eq:ft} and \ref{eq:ift}) as follows:\footnote{The - purpose of the factor $\nicefrac{1}{N}$ in Equation~\ref{eq:dft} is - to ensure that the DFT and the inverse DFT are in fact inverses of - each other. But it is just by convention that one equation has this - factor and the other does not---it would be sufficient if it were - done the other way around. In fact, all that matters is that the - product of the two coefficients be $\nicefrac{1}{N}$, and thus it - would also be sufficient for each equation to have the same - coefficient, namely $\nicefrac{1}{\sqrt{N}}$. Similarly, the - negative exponent in one equation and positive in the other is also - by convention---it would be sufficient to do it the other way - around.} -\begin{equation}\label{eq:dft} -\hat{x}[k] = \frac{1}{N}\sum_{n=0}^{N-1} - x[n] e^{-j\frac{2\pi k n}{N}},\ \ k = 0, 1, ..., N-1 -\end{equation} -%% Analogously, the equation for the inverse DFT is: -\begin{equation}\label{eq:idft} -x[n] = \sum_{k=0}^{N-1} - \hat{x}[k] e^{j\frac{2\pi k n}{N}},\ \ n = 0, 1, ..., N-1 -\end{equation} - -Despite all of the mathematics up to this point, the reader may now -realize that the discrete Fourier transform as expressed above is -amenable to implementation---for example it should not be difficult to -write Haskell functions that realize each of the above equations. But -before addressing implementation issues, let's discuss a bit more what -the results actually \emph{mean}. - -\subsection{Interpreting the Frequency Spectrum} -\label{sec:freq-spectrum} - -Just as $x[n]$ represents a sampled version of the continuous input -signal, $\hat{x}[k]$ represents a sampled version of the continous -frequency spectrum. Care must be taken when interpreting either of -these results, keeping in mind the Nyquist-Shannon Sampling Theorem -(recall Section~\ref{sec:digital-audio}) and aliasing -(Section~\ref{sec:aliasing}). - -Also recall that the result of a Fourier transform of a periodic -signal is a Fourier series (see Section~\ref{sec:fouriers-theorem}), -in which the signal being analyzed is expressed as multiples of a -fundamental frequency. In equation \ref{eq:dft} above, that -fundamental frequency is the inverse of the duration of the $N$ -samples, i.e.\ the inverse of $\nicefrac{N}{r}$, or $\nicefrac{r}{N}$. -For example, if the sampling rate is 44.1 kHz (the CD standard), then: -\begin{itemize} -%% \item If we take $N=44$ samples, then the fundamental frequency will -%% be (about) $r/N = 1000$ Hz. -\item If we take $N=441$ samples, then the fundamental frequency will - be $\nicefrac{r}{N} = 100$ Hz. -\item If we take $N=4410$ samples, then the fundamental frequency will - be $\nicefrac{r}{N} = 10$ Hz. -\item If we take $N=44100$ samples, then the fundamental frequency will - be $\nicefrac{r}{N} = 1$ Hz. -\end{itemize} -Thus, as would be expected, taking more samples yields a \emph{finer} -resolution of the frequency spectrum. On the other hand, note that if -we increase the sampling rate and keep the number of samples fixed, we -get a \emph{coarser} resolution of the spectrum---this also should be -expected, because if we increase the sampling rate we would expect to -have to look at more samples to get the same accuracy. - -Analogous to the Nyquist-Shannon Sampling Theorem, the representable -points in the resulting frequency spectrum lie in the range -$\pm\nicefrac{r}{2}$, i.e.\ between plus and minus one-half of the -sampling rate. For the above three cases, respectively, that means -the points are: -\begin{itemize} -%% \item -22 kHz, -21 kHz, ..., -1 kHz, 0, 1 kHz, ..., 21 kHz, 22kHz -%% \item -%% -22.05 kHz, -21.95 kHz, ..., -0.05 kHz, 0.05 kHz, ..., 21.95 kHz, 22.05 kHz -\item - -22.0 kHz, -21.9 kHz, ..., -0.1 kHz, 0, 0.1 kHz, ..., 21.9 kHz, 22.0 kHz -\item - -22.05 kHz, -22.04 kHz, ..., -10 Hz, 0, 10 Hz, ..., 22.04 kHz, 22.05 kHz -\item - -22.05 kHz, -22.049 kHz, ..., -1 Hz, 0, 1 Hz, ..., 22.049 kHz, 22.05 kHz -\end{itemize} -For practical purposes, the first of these is usually too coarse, the -third is too fine, and the middle one is useful for many applications. - -Note that the first range of frequencies above does not quite cover -the range $\pm\nicefrac{r}{2}$. But remember that this is a discrete -representation of the actual frequency spectrum, and the proper -interpretation would include the frequences $+\nicefrac{r}{2}$ and -$-\nicefrac{r}{2}$. - -Also note that there are $N+1$ points in each of the above ranges, not -$N$. Indeed, the more general question is, how do these points in the -frequency spectrum correspond to the indices $i = 0, 1, ..., N-1$ in -$\hat{x}[i]$? If we denote each of these frequencies as $f$, the -answer is that: -\begin{equation}\label{eq:f1} -f = \frac{ir}{N},\ \ \ \ i = 0, 1, ..., N-1 -\end{equation} -But note that this range of frequencies extends from $0$ to -$(N-1)(\nicefrac{r}{N})$, which exceeds the Nyquist-Shannon sampling -limit of $\nicefrac{r}{2}$. The way out of this dilemma is to realize -that the DFT assumes that the input signal is periodic in time, and -therefore the DFT is periodic in frequency. In other words, values of -$f$ for indices $i$ greater than $\nicefrac{N}{2}$ can be interpreted -as frequencies that are the \emph{negation} of the frequency given by -the formula above. Assuming even $N$, we can revise formula -\ref{eq:f1} as follows: -\begin{equation}\label{eq:f2} -f = \left\{ - \begin{array}{ll} - i\dfrac{r}{N}, & \quad i = 0, 1, ..., \dfrac{N}{2} \\[0.1in] - (i-N)\dfrac{r}{N} & \quad i = \dfrac{N}{2}, - \dfrac{N}{2}+1, ..., N-1 \\ - \end{array} \right. -\end{equation} -Note that when $i = \nicefrac{N}{2}$, both equations apply, yielding -$f = \nicefrac{r}{2}$ in the first case, and $f = -\nicefrac{r}{2}$ in -the second. Indeed, the magnitude of the DFT for each of these -frequencies is the same (see discussion in the next section), -reflecting the periodicity of the DFT, and thus is simply a form of -redundancy. - -%% \begin{itemize} -%% \item -%% $\hat{x}[i],\ i = 0, 1, 2, ..., \frac{N}{2}$ correspond to the -%% frequencies $0, \frac{r}{N}, \frac{2r}{N}, ..., \frac{r}{2}$. -%% \item -%% $\hat{x}[i],\ i = \frac{N}{2}, \frac{N}{2}+1, \frac{N}{2}+2, ..., N-1$ -%% correspond to the frequencies -%% $-\frac{r}{2}, -\frac{r}{2}+\frac{r}{N}, -\frac{r}{2}+\frac{2r}{N}, -%% ..., -\frac{r}{N}$. -%% \end{itemize} -%% ... This can be viewed s a kind of aliasing in the frequency domain. - -The above discussion has assumed a periodic signal whose fundamental -frequency is known, thus allowing us to parameterize the DFT with the -same fundamental frequency. In practice this rarely happens. That -is, the fundamental frequency of the DFT typically has no integral -relationship to the period of the periodic signal. This raises the -question, what happens to the frequencies that ``fall in the gaps'' -between the frequencies discussed above? The answer is that the -energy of that frequency component will be distributed amongst -neighboring points in a way that makes sense mathematically, although -the result may look a little funny compared to the ideal result (where -every frequency component is an integer multiple of the fundamental). -The important thing to remember is that these are digital -representations of the exact spectra, just as a digitized signal is -representative of an exact signal. Two digitized signals can look -very different (depending on sample rate, phase angle, and so on), yet -represent the same underlying signal---the same is true of a digitized -spectrum. - -In practice, for reasons of computational efficiency, $N$ is usually -chosen to be a power of two. We will return to this issue when we -discuss implementing the DFT. - -\subsection{Amplitude and Power of Spectrum} -\label{sec:amp-spectrum} - -We discussed above how each sample in the result of a DFT relates to a -point in the frequency spectrum of the input signal. But how do we -determine the amplitude and phase angle of each of those frequency -components? In general each sample in the result of a DFT is a -complex number, thus having both a real and imaginary part, of the -form $a + jb$. We can visualize this number as a point in the complex -Cartesian plane, where the abscissa (x-axis) represents the real part, -and the ordinate (y-axis) represents the imaginary part, as shown in -Figure~\ref{fig:complex-plane}. It is easy to see that the line from -the origin to the point of interest is a vector $A$, whose length is -the \emph{amplitude} of the frequency component in the spectrum: -\begin{equation}\label{eq:amplitude} -A = \sqrt{a^2 + b^2} -\end{equation} -The angle $\theta$ is the \emph{phase}, and it is easily defined from -the figure as: -\begin{equation}\label{eq:phase} -\theta = tan^{-1} \frac{b}{a} -\end{equation} -(This amplitude / phase pair is often called the \emph{polar} -representation of a complex number.) - -\begin{figure}[hbtp] -\centering -\includegraphics[height=2.4in]{pics/ComplexToPolar.eps} % angle=270 -\caption{Complex and Polar Coordinates} -\label{fig:complex-plane} -\end{figure} - -Recall from Section~\ref{sec:amplitude} that power is proportional to -the square of the amplitude. Since taking a square root adds -computational expense, the square root is often omitted from -Equation~\ref{eq:amplitude}, thus yielding a \emph{power spectrum} -instead of an \emph{amplitude spectrum}. - -One subtle aspect of the resulting DFT is how to interpret -\emph{negative} frequencies. In the case of having an input whose -samples are all real numbers (i.e.\ there are no imaginary -components), which is true for audio applications, the negative -spectrum is a mirror image of the positive spectrum, and the -amplitude/power is distributed evenly between the two. - -\subsection{A Haskell Implementation of the DFT} -\label{sec:haskell-dft} - -From equation \ref{eq:dft}, which defines the DFT mathematically, we -can write a Haskell program that implements the DFT. - -The first thing we need to do is understand how complex numbers are -handled in Haskell. They are captured in the |Complex| library, which -must be imported into any program that uses them. The type |Complex -T| is the type of complex numbers whose underlying numeric type is -|T|. We will use, for example, |Complex Double| for testing our DFT. -A complex number $a + jb$ is represented in Haskell as |a :+ b|, and -since |(:+)| is a constructor, such values can be pattern matched. - -\syn{Complex numbers in Haskell are captured in the |Complex| library, - in which complex numbers are defined as a polymorphic data type: -\begin{spec} -infix 6 :+ -data (RealFloat a) => Complex a = !a :+ !a -\end{spec} -The ``|!|'' in front of the type variables declares that the -constructor |(:+)| is strict in its arguments. For example, the -complex number $a + jb$ is represented by |a :+ b| in Haskell. One -can pattern match on complex number values to extract the real and -imaginary parts, or use one of the predefined selectors defined in the -|Complex| library: -\begin{spec} -realPart, imagPart :: RealFloat a => Complex a -> a -\end{spec} -The |Complex| library also defines the following functions: -\begin{spec} -conjugate :: RealFloat a => Complex a -> Complex a -mkPolar :: RealFloat a => a -> a -> Complex a -cis :: RealFloat a => a -> Complex a -polar :: RealFloat a => Complex a -> (a,a) -magnitude, phase :: RealFloat a => Complex a -> a -\end{spec} -The library also declares instances of |Complex| for the type classes -|Num|, |Fractional|, and |Floating|. -} - -Although not as efficient as arrays, for simplicity we choose to use -lists to represent the vectors that are the input and output of the -DFT. Thus if |xs| is the list that represents the signal $x$, then -|xs!!n| is the |n+1|$^{th}$ sample of that signal, and is equivalent -to $x[n]$. Furthermore, using list comprehensions, we can make the -Haskell code look very much like the mathematical definition captured -in Equation \ref{eq:dft}. Finally, we adopt the convention that the -length of the input signal is the number of samples that we will use -for the DFT. - -Probably the trickiest part of writing a Haskell program for the DFT -is dealing with the types! In particular, if you look closely at -Equation \ref{eq:dft} you will see that $N$ is used in three different -ways---as an integer (for indexing), as a real number (in the exponent -of $e$), and as a complex number (in the expression -$\nicefrac{1}{N}$). - -Here is a Haskell program that implements the DFT: -\begin{code} -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] ] -\end{code} -Note that |lenI|, |lenR|, and |lenC| are the integer, real, and -complex versions, respectively, of $N$. Otherwise the code is fairly -straightforward---note in particular how list comprehensions are used -to implement the ranges of $n$ and $k$ in Equation \ref{eq:dft}. - -To test our program, let's first create a couple of waveforms. For -example, recall that Equation \ref{eq:square-wave-series} defines the -Fourier series for a square wave. We can implement the first, first -two, and first three terms of this series, corresponding respectively -to Figures~\ref{fig:square-wave-series}a, -\ref{fig:square-wave-series}b, and \ref{fig:square-wave-series}c, by -the following Haskell code: -\begin{code} -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) -\end{code} -Thus |mkTerm num n| is the |n|$^{th}$ term in the series, using |num| -samples. - -Using the helper function |printComplexL| defined in -Figure~\ref{fig:pp-code}, which ``pretty prints'' a list of complex -numbers, we can look at the result of our DFT in a more readable -form.\footnote{``Pretty-printing'' real numbers is a subtle task. The - code in Figure~\ref{fig:pp-code} rounds the number to 10 decimal - places of accuracy, and inserts spaces before and after to line up - the decimal points and give a consistent string length. The - fractional part is not padded with zeros, since that would give a - false impression of its accuracy. (It is not necessary to - understand this code in order to understand the concepts in this - chapter.)} - -\begin{figure} -\begin{code} -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 ' ') -\end{code} -\caption{Helper Code for Pretty-Printing DFT Results} -\label{fig:pp-code} -\end{figure} - -For example, suppose we want to take the DFT of a 16-sample -representation of the first three terms of the square wave series. -Typing the following at the GHCi prompt: -\begin{spec} -printComplexL (dft (mkxc 16)) -\end{spec} -will yield the result of the DFT, pretty-printing each number as a -pair, along with its index: -{\small \begin{verbatim} - 0: ( 0.0 , 0.0 ) - 1: ( 0.0 , -0.5 ) - 2: ( 0.0 , 0.0 ) - 3: ( 0.0 , -0.1666666667 ) - 4: ( 0.0 , 0.0 ) - 5: ( 0.0 , -0.1 ) - 6: ( 0.0 , 0.0 ) - 7: ( 0.0 , 0.0 ) - 8: ( 0.0 , 0.0 ) - 9: ( 0.0 , 0.0 ) - 10: ( 0.0 , 0.0 ) - 11: ( 0.0 , 0.1 ) - 12: ( 0.0 , 0.0 ) - 13: ( 0.0 , 0.1666666667 ) - 14: ( 0.0 , 0.0 ) - 15: ( 0.0 , 0.5 ) -\end{verbatim} } - -Let's study this result more closely. For sake of argument, assume a -sample rate of 1.6 KHz. Then by construction using |mkxc|, our -square-wave input's fundamental frequency is 100 Hz. Similarly, -recall that the resolution of the DFT is |r/N|, which is also 100 Hz. - -Now compare the overall result to Figure -\ref{fig:fourier-transforms}b. Recalling also Equation \ref{eq:f2}, -we note that the above DFT results are non-zero precisely at 100, 300, -500, -500, -300, and -100 Hz. This is just what we would expect. -Furthermore, the amplitudes are one-half of the corresponding -harmonically decreasing weights dictated by Equation -\ref{eq:square-wave-series}, namely the values 1, $\nicefrac{1}{6}$, -and $\nicefrac{1}{10}$ (recall the discussion in Section -\ref{sec:amp-spectrum}). - -Let's do another example. We can create an impulse function as -follows: -\begin{code} -mkPulse :: Int -> [Complex Double] -mkPulse n = 100 : take (n-1) (repeat 0) -\end{code} -and print its DFT with the command: -\begin{spec} -printComplexL (dft (mkPulse 16)) -\end{spec} -whose effect is: -{\small \begin{verbatim} - 0: ( 6.25 , 0.0 ) - 1: ( 6.25 , 0.0 ) - 2: ( 6.25 , 0.0 ) - 3: ( 6.25 , 0.0 ) - 4: ( 6.25 , 0.0 ) - 5: ( 6.25 , 0.0 ) - 6: ( 6.25 , 0.0 ) - 7: ( 6.25 , 0.0 ) - 8: ( 6.25 , 0.0 ) - 9: ( 6.25 , 0.0 ) -10: ( 6.25 , 0.0 ) -11: ( 6.25 , 0.0 ) -12: ( 6.25 , 0.0 ) -13: ( 6.25 , 0.0 ) -14: ( 6.25 , 0.0 ) -15: ( 6.25 , 0.0 ) -\end{verbatim}} -Compare this to Figure \ref{fig:fourier-transforms}c, and note how the -original magnitude of the impulse (100) is distributed evenly among -the 16 points in the DFT ($100/16 = 6.25$). - -So far we have considered only input signals whose frequency -components are integral multiples of the DFT's resolution. This -rarely happens in practice, however, because music is simply too -complex, and noisy. As mentioned in \ref{sec:freq-spectrum}, the -energy of the signals that ``fall in the gaps'' is distributed among -neighboring points, although not in as simple a way as you might -think. To get some perspective on this, let's do one other example. -We define a function to generate a signal whose frequeny is $\pi$ -times the fundamental frequency: -%% We will modify the function |mkTerm| so that it creates a signal -%% 42\% higher than it used to be: -\begin{code} -x1 num = let f = pi * 2 * pi / fromIntegral num - in map (:+ 0) [ sin (f * fromIntegral i) - | i <- [0,1..num-1] ] -\end{code} -$\pi$ is an irrational number, but any number that ``falls in the -gaps'' between indices would do. We can see the result by typing the -command: -\begin{spec} -printComplexL (dft x1) -\end{spec} -which yields: -{\small \begin{verbatim} - 0: ( -7.9582433e-3 , 0.0 ) - 1: ( -5.8639942e-3 , -1.56630897e-2) - 2: ( 4.7412105e-3 , -4.56112124e-2) - 3: ( 0.1860052232 , -0.4318552865 ) - 4: ( -5.72962095e-2, 7.33993364e-2) - 5: ( -3.95845728e-2, 3.14378088e-2) - 6: ( -3.47994673e-2, 1.65400768e-2) - 7: ( -3.29813518e-2, 7.4048103e-3 ) - 8: ( -3.24834325e-2, 0.0 ) - 9: ( -3.29813518e-2, -7.4048103e-3 ) - 10: ( -3.47994673e-2, -1.65400768e-2) - 11: ( -3.95845728e-2, -3.14378088e-2) - 12: ( -5.72962095e-2, -7.33993364e-2) - 13: ( 0.1860052232 , 0.4318552865 ) - 14: ( 4.7412105e-3 , 4.56112124e-2) - 15: ( -5.8639942e-3 , 1.56630897e-2) -\end{verbatim}} -This is much more complicated than the previous examples! Not only do -the points in the spectrum seem to have varying amounts of energy, -they also have both non-zero real and non-zero imaginary components, -meaning that the magnitude and phase vary at each point. We can -define a function that converts a list of complex numbers into a list -of their polar representations as follows: -\begin{code} -mkPolars :: [Complex Double] -> [Complex Double] -mkPolars = map ((\(m,p)-> m:+p) . polar) -\end{code} -which we can then use to reprint our result: -\begin{spec} -printComplexL (mkPolars (dft x1)) -\end{spec} -{\small \begin{verbatim} - 0: ( 7.9582433e-3 , 3.1415926536 ) - 1: ( 1.67247961e-2, -1.9290259418 ) - 2: ( 4.58569709e-2, -1.4672199604 ) - 3: ( 0.470209455 , -1.1640975898 ) - 4: ( 9.31145435e-2, 2.2336013741 ) - 5: ( 5.05497204e-2, 2.4704023271 ) - 6: ( 3.85302097e-2, 2.6979021519 ) - 7: ( 3.38023784e-2, 2.9207398294 ) - 8: ( 3.24834325e-2, -3.1415926536 ) - 9: ( 3.38023784e-2, -2.9207398294 ) - 10: ( 3.85302097e-2, -2.6979021519 ) - 11: ( 5.05497204e-2, -2.4704023271 ) - 12: ( 9.31145435e-2, -2.2336013741 ) - 13: ( 0.470209455 , 1.1640975898 ) - 14: ( 4.58569709e-2, 1.4672199604 ) - 15: ( 1.67247961e-2, 1.9290259418 ) -\end{verbatim} } -If we focus on the magnitude (the first column), we can see that there -is a peak near index 3 (corresponding roughly to the frequency $\pi$), -with small amounts of energy elsewhere. - -\vspace{.1in}\hrule - -\begin{exercise}{\em -Write a Haskell function |idft| that implements the \emph{inverse} DFT -as captured in Equation~\ref{eq:ift}. Test your code by applying -|idft| to one of the signals used earlier in this section. In other -words, show empirically that, up to round-off errors, |idft (dft xs) -== xs|. } -\end{exercise} - -\begin{exercise}{\em -Use |dft| to analyze some of the signals generated using signal -functions defined in Chapter~\ref{ch:sigfuns}. } -\end{exercise} - -\todo{To do the above exercise we need to provide a function that - extracts |N| samples from a sigfun, and somehow keeps it in the - sigfun world. Perhaps something like: - -\begin{spec} -sample :: Rate -> Int -> Signal c a (Event (Table a)) -\end{spec} -such that |sample r n| is a sigfun that generates an event every |1/r| -seconds, each event being a table containing |n| samples of the -input. These tables may or may not overlap, depending on the -relationship between |r|, |n|, and the sampling rate. } - -\begin{exercise}{\em -Define a function |mkSqWave :: Int -> Int -> [Complex Double]| such -that |mkSqWave num n| is the sum of the first $n$ terms of the Fourier -series of a square wave, having $num$ samples in the result. } -\end{exercise} - -\begin{exercise}{\em -Prove mathematically that $x$ and $\hat{x}$ are inverses. Also prove, -using equational reasoning, that |dft| and |idft| are inverses. (For -the latter you may assume that Haskell numeric types obey the standard -axioms of real arithmetic.) } -\end{exercise} - -\vspace{.1in}\hrule - -\vspace{.1in} - -\section{The Fast Fourier Transform} -\label{sec:fft} - -In the last section a DFT program was developed in Haskell that was -easy to understand, being a faithful translation of Equation -\ref{eq:dft}. For pedogogical purposes, this effort served us well. -However, for practical purposes, the program is inherently -inefficient. - -To see why, think of $x[n]$ and $\hat{x}[k]$ as vectors. Thus, for -example, each element of $\hat{x}$ is the sum of $N$ multiplications -of a vector by a complex exponential (which can be represented as a -pair, the real and imaginary parts). And this overall process must be -repeated for each value of $k$, also $N$ times. Therefore the overall -time complexity of the implied algorithm is O($N^2$). For even -moderate values of $N$, this can be computationally intractable. (Our -choice of lists for the implementation of vectors makes the complexity -even worse, because of the linear-time complexity of indexing, but the -discussion below makes this a moot point.) - -Fortunately, there exists a much faster algorithm called the -\emph{Fast Fourier Transform}, or FFT, that reduces the complexity to -O($N\log N$). This difference is quite significant for large values -of $N$, and is the standard algorithm used in most signal processing -applications. We will not go into the details of the FFT algorithm, -other than to note that it is a divide-and-conquer algorithm that -depends on the vector size being a power of two.\footnote{The basic - FFT algorithm was invented by James Cooley and John Tukey in 1965.} - -%% \footnote{James Cooley and John Tukey are -%% usually credited with inventing the FFT in 1965, although it was -%% later discovered that Carl Friedrich Gauss proposed the same -%% algorithm around 1805.} - -Rather than developing our own program for the FFT, we will instead -use the Haskell library |Numeric.FFT| to import a function that will -do the job for us. Specifically: -\begin{spec} -fft :: ... -\end{spec} -With this function we could explore the use of the FFT on specific -iinput vectors, as we did earlier with |dft|. - -However, our ultimate goal is to have a version of FFT that works on -\emph{signals}. We would like to be able to specify the number of -samples as a power of two (which we can think of as the ``window -size''), the clock rate, and how often we would like to take a -snapshot of the current window (and thus successive windows may or may -not overlap). The resulting signal function takes a signal as input, -and outputs \emph{events} at the specified rate. Events are discussed -in more detail in Chapter~\ref{ch:MUI}. - -Indeed, Euterpea provide this functionality for us in a function -called |fftA|: -\begin{spec} -fftA :: Int -> Double -> Int -> SF Double (Event FFTData) -type FFTData = Map Double Double -\end{spec} -|SF| is a signal function type similar to |SigFun|, except that it is -targeted for use in the Musical User Interface (MUI) discussed in -detail in Chapter~\ref{ch:mui}, and thus, for example, does not have a -clock rate. |Map T1 T2| is an abstract type that maps values of type -|T1| to values of type |T2|, and is imported from |Data.Map|. - -|fftA winInt rate size| is a signal function that, every |winInt| -samples of the input, creates a window of size |2 ^ size|, and -computes the FFT of that window. For every such result, it issues an -|Event| that maps from frequency to magnitude (using the clock rate -|rate| to determine the proper mapping). - -Combining |fftA| with the MUI widgets discussed in -Chapter~\ref{ch:mui}, we can write a simple program that generates a -sine wave whose frequency is controlledd by a slider, and whose -real-time graph as well as its FFT are displayed. The program to do -this is shown in Figure~\ref{fig:fft-mui}. - -\begin{figure} -\begin{spec} -fftEx :: UISF () () -fftEx = proc _ -> do - f <- hSlider (1, 2000) 440 -< () - (d,_) <- clockedSFToUISF 100 simpleSig -< f - let (s, fft) = unzip d - _ <- histogram (500, 150) 20 -< listToMaybe (catMaybes fft) - _ <- realtimeGraph' (500, 150) 200 20 Black -< s - outA -< () - where - simpleSig :: SigFun CtrRate Double (Double, Event [Double]) - simpleSig = proc f -> do - s <- osc (tableSinesN 4096 [1]) 0 -< f - fftData <- fftA 100 256 -< s - outA -< (s, fftData) - -t0 = runMUI (500, 600) "fft Test" fftEx -\end{spec} -\caption{A Real-Time Display of FFT Results} -\label{fig:fft-mui} -\end{figure} - -%% fftEx :: UISF () () -%% fftEx = proc _ -> do -%% f <- hSlider (1, 2000) 440 -< () -%% (d,_) <- convertToUISF 100 simpleSig -< f -%% let (s,fft) = unzip d -%% _ <- histogram (500,150) 20 -< listToMaybe (catMaybes fft) -%% _ <- realtimeGraph' (500,150) 200 20 Black -< s -%% outA -< () -%% where -%% simpleSig :: SigFun CtrRate Double (Double, Event FFTData) -%% simpleSig = proc f -> do -%% s <- osc (tableSinesN 4096 [1]) 0 -< f -%% fft <- fftA 100 (rate (undefined :: CtrRate)) 8 -< s -%% outA -< (s, fft) - -%% t0 = runMUI (500,600) "fft Test" fftEx - -\section{Further Pragmatics} - -\todo{Discuss windowing.} - -\vspace{.1in}\hrule - -\begin{exercise}{\em -Modify the program in Figure~\ref{fig:fft-mui} in the following ways: -\begin{enumerate} -\item -Add a second slider, and use it to control the frequency of a second -oscillator. -\item -Let |s1| and |s2| be the names of the signals whose frequencies are -controlled by the first and second sliders, respectively. Instead of -displaying the FFT of just |s1|, try a variety of combinations of |s1| -and |s2|, such as |s1 + s2|, |s1 - s2|, |s1 * s2|, |1/s1 + 1/s2|, and -|s1 / s2|. Comment on the results. -\item -Use |s2| to control the frequency of |s1| (as was done with |vibrato| -in Chapter~\ref{ch:sigfuns}). Plot the fft of |s1| and comment on the -result. -\item -Instead of using |osc| to generate a pure sine wave, try using other -oscillators and/or table generators to create more complex tones, and -plot their FFT's. Comment on the results. -\end{enumerate} -} -\end{exercise} - -\vspace{.1in}\hrule - -\section{References} - -Most of the ideas in this chapter can be found in any good textbook on -signal processing. The particular arrangement of the material here, -in particular Figure~\ref{fig:fourier-transforms} and the development -and demonstration of a program for the DFT, is borrowed from the -excellent text \emph{Elements of Computer Music} by Moore -\cite{Moore90}. - diff --git a/HSoM/Syntax.lhs b/HSoM/Syntax.lhs deleted file mode 100644 --- a/HSoM/Syntax.lhs +++ /dev/null @@ -1,579 +0,0 @@ -%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- - -%include lhs2TeX.fmt -%include myFormat.fmt - -% To do: -% change glue.eps to include dotted box for f.g - -\chapter{Syntactic Magic} -\label{ch:hof} - -This chapter introduces several more of Haskell's syntactic devices -that faciliate writing concise and intuitive programs. These devices -will be used frequently in the remainder of the text. - -%% You have now seen several examples where functions are passed as -%% arguments to other functions, such as with |fold| and |map|. In -%% this chapter we will see several examples where functions are also -%% returned as values. This will lead to several techniques for -%% improving definitions that we have already written, techniques that we -%% will use often in the remainder of the text. - -\section{Sections} -\label{sec:sections} - -The use of currying was introduced in Chapter \ref{ch:poly} as a way -to simplify programs. This is a syntactic device that relies on the -way that normal functions are applied, and how those applications are -parsed. - -With a bit more syntax, we can also curry applications of infix -operators such as |(+)|. This syntax is called a {\em - \indexwd{section}}, and the idea is that, in an expression such as -|(x+y)|, we can omit either the |x| or the |y|, and the result (with -the parentheses still intact) is a function of that missing argument. -If {\em both} variables are omitted, it is a function of {\em two} -arguments. In other words, the expressions |(x+)|, |(+y)| and |(+)| -are equivalent, respectively, to the functions: -\begin{spec} -f1 y = x+y -f2 x = x+y -f3 x y = x+y -\end{spec} - -For example, suppose we wish to remove all absolute pitches greater -than 99 from a list, perhaps because everything above that value is -assumed to be unplayable. There is a pre-defined function in Haskell -that can help to achieve this: -\begin{spec} -filter :: (a -> Bool) -> [a] -> [a] -\end{spec} -|filter p xs| returns a list for which each element |x| satisfies the -predicate |p|; i.e.\ |p x| is |True|. - -Using |filter|, we can then write: -\begin{spec} -playable :: [AbsPitch] -> [AbsPitch] -playable xs = let test ap = ap < 100 - in filter test xs -\end{spec} -But using a section, we can write this more succinctly as: -\begin{spec} -playable :: [AbsPitch] -> [AbsPitch] -playable xs = filter (<100) xs -\end{spec} -which can be further simplified using currying: -\begin{spec} -playable :: [AbsPitch] -> [AbsPitch] -playable = filter (<100) -\end{spec} - -This is an extremely concise definition. As you gain experience with -higher-order functions you will not only be able to start writing -definitions such as this directly, but you will also start {\em - thinking} in ``higher-order'' terms. Many more examples of this -kind of reasoning will appear throughout the text. - -%% ... determine, for each absolute -%% pitch in a list, whether it is higher than 57 (which corresponds to -%% concert A). Instead of writing: - -%% \begin{spec} -%% gtConcertA :: [AbsPitch] -> [Bool] -%% gtConcertA xs = let test ap = ap > 57 -%% in map test xs -%% \end{spec} -%% we can simply write: -%% \begin{spec} -%% gtConcertA :: [AbsPitch] -> [Bool] -%% gtConcertA xs = map (>57) xs -%% \end{spec} -%% which can be further simplified using currying: -%% \begin{spec} -%% gtConcertA :: [AbsPitch] -> [Bool] -%% gtConcertA = map (>57) -%% \end{spec} - -\vspace{.1in}\hrule - -\begin{exercise}{\em -Define a function |twice| that, given a function |f|, returns a -function that applies |f| twice to its argument. For example: -\begin{spec} -(twice (+1)) 2 ==> 4 -\end{spec} -What is the principal type of |twice|? Describe what |twice twice| -does, and give an example of its use. Also consider the functions -|twice twice twice| and |twice (twice twice)|? } -\end{exercise} - -\begin{exercise}{\em -Generalize |twice| defined in the previous exercise by defining a -function |power| that takes a function |f| and an integer -|n|, and returns a function that applies the function |f| to its -argument |n| times. For example: -\begin{spec} -power (+2) 5 1 ===> 11 -\end{spec} -Use |power| in a musical context to define something useful. -} -\end{exercise} - -\vspace{.1in}\hrule - -\section{Anonymous Functions} -\label{sec:anonymous} - -\index{function!anonymous} - -Another way to define a function in Haskell is in some sense the most -fundamental: it is called an \emph{anonymous function}, or -\emph{lambda expression} (since the concept is drawn directly from -Church's lambda calculus \cite{church41}). The idea is that functions -are values, just like numbers and characters and strings, and -therefore there should be a way to create them without having to give -them a name. As a simple example, an anonymous function that -increments its numeric argument by one can be written |\x -> x+1|. -Anonymous functions are most useful in situations where you do not -wish to name them, which is why they are called ``anonymous.'' -Anonymity is a property also shared by sections, but sections can only -be derived from an existing infix operator. - -\syn{The typesetting used in this textbook prints an actual Greek - lambda character, but in writing |\x -> x+1| in your programs you - will have to type ``\verb!\x -> x+1!'' instead.} - -As another example, to raise the pitch of every element in a list of -pitches |ps| by an octave, we could write: -\begin{spec} -map (\p-> pitch (absPitch p + 12)) ps -\end{spec} -An even better example is an anonymous function that pattern-matches -its argument, as in the following, which doubles the duration of every -note in a list of notes |ns|: -\begin{spec} -map (\(Note d p) -> Note (2*d) p) ns -\end{spec} - -\syn{Anonymous functions can only perform one match against -an argument. That is, you cannot stack together several anonymous -functions to define one function, as you can with equations.} - -Anonymous functions are considered most fundamental because -definitions such as that for |simple| given in Chapter -\ref{ch:intro}: -\begin{spec} -simple x y z = x*(y+z) -\end{spec} -can be written instead as: -\begin{spec} -simple = \x y z -> x*(y+z) -\end{spec} -\syn{|\x y z -> exp| is shorthand for |\x -> \y-> \z -> exp|.} - -We can also use anonymous functions to explain precisely the behavior -of sections. In particular, note that: -\begin{spec} -(x+) ==> \y -> x+y -(+y) ==> \x -> x+y -(+) ==> \x y -> x+y -\end{spec} - -\vspace{.1in}\hrule - -\begin{exercise}{\em -Suppose we define a function \indexwdhs{fix} as: -\begin{spec} -fix f = f (fix f) -\end{spec} -What is the principal type of |fix|? (This is tricky!) Suppose -further that we have a recursive function: -\begin{spec} -remainder :: Integer -> Integer -> Integer -remainder a b = if a [Dur -> Music a] -> Music a -addDur d ns = let f n = n d - in line (map f ns) -\end{spec} -Here |ns| is a list of notes, each of which does not have a duration -yet assigned to it. If we think of this as a set, we might be led -to write the following solution in mathematical notation: -\[ \{ n\ d\ ||\ n \in ns \} \] -which can be read, ``the set of all notes |n d| such that |n| is an -element of |ns|.'' Indeed, using a Haskell \emph{list comprehension} -we can write almost exactly the same thing: -\begin{spec} -[ n d | n <- ns ] -\end{spec} -The difference, of course, is that the above expression generates an -(ordered) list in Haskell, not an (unordered) set in mathematics. - -List comprehensions allow us to rewrite the definition of |addDur| -much more succinctly and elegantly: -\begin{spec} -addDur :: Dur -> [Dur -> Music a] -> Music a -addDur d ns = line [ n d | n <- ns ] -\end{spec} - -\syn{Liberty is again taken in type-setting by using the symbol |<-| - to mean ``is an element of.'' When writing your programs, you will - have to type ``{\tt <-}'' instead. - -The expression |[ exp || x <- xs]| is actually shorthand for the -expression |map (\x -> exp) xs|. The form |x <- xs| is called a {\em - \indexwd{generator}}, and in general more than one is allowed, as -in: -\begin{spec} -[ (x,y) | x <- [0,1,2], y <- ['a','b'] ] -\end{spec} -which evaluates to the list: -\begin{spec} -[ (0,'a'), (0,'b'), (1,'a'), (1,'b'), (2,'a'), (2,'b') ] -\end{spec} -The order here is important; that is, note that the left-most -generator changes least quickly. - -It is also possible to \emph{filter} values as they are generated; for -example, we can modify the above example to eliminate the odd -integers in the first list: -\begin{spec} -[ (x,y) | x <- [0,1,2], even x, y <- ['a','b'] ] -\end{spec} -where |even n| returns |True| if |n| is even. This example evaluates -to: -\begin{spec} -[ (0,'a'), (0,'b'), (2,'a'), (2,'b') ] -\end{spec} -} - -\syn{When reasoning about list comprehensions (e.g.\ when doing proof - by calculation), we can use the following syntactic translation - into pure functions: -\begin{spec} -[ e | True ] = [ e ] -[ e | q ] = [ e | q, True ] -[ e | b, qs ] = if b then [ e | qs ] else [] -[ e | p <- xs, qs ] = let ok p = [ e | qs ] - ok _ = [] - in concatMap ok xs -[ e | let decls, qs ] = let decls in [ e | qs ] -\end{spec} -where |q| is a single qualifier, |qs| is a sequence of qualifiers, |b| -is a Boolean, |p| is a pattern, and |decls| is a sequence of variable -bindings (a feature of list comprehensions not explained earlier). -} -%% There are several other useful features of list comprehensions, but -%% they are not used in this text. Consult the Haskell Report for -%% details. - -\subsection{Arithmetic Sequences} -\label{sec:arithmetic-sequences} - -\index{arithmetic sequence} -Another convenient syntax for lists whose elements can be enumerated -is called an \emph{arithmetic sequence}. For example, the -arithmetic sequence |[1..10]| is equivalent to the list: -\begin{spec} -[1,2,3,4,5,6,7,8,9,10] -\end{spec} -There are actually four different versions of arithmetic sequences, -some of which generate \emph{infinite} lists (whose use will be -discussed in a later chapter). In the following, let |a=n'-n|: -\begin{spec} -[n..] -- infinite list |n|, |n+1|, |n+2|, ... -[n,n'..] -- infinite list |n|, |n+a|, |n+2*a|, ... -[n..m] -- finite list |n|, |n+1|, |n+2|, ..., |m| -[n,n'..m] -- finite list |n|, |n+a|, |n+2*a|, ..., |m| -\end{spec} - -Arithmetic sequences are discussed in greater detail in Appendix -\ref{ch:class-tour}. - -\vspace{.1in}\hrule - -\begin{exercise}{\em -Using list comprehensions, define a function: -\begin{spec} -apPairs :: [AbsPitch] -> [AbsPitch] -> [(AbsPitch,AbsPitch)] -\end{spec} -such that |apPairs aps1 aps2| is a list of all combinations of the -absolute pitches in |aps1| and |aps2|. Furthermore, for each pair -|(ap1,ap2)| in the result, the absolute value of |ap1-ap2| must be -greater than two and less than eight. - -Finally, write a function to turn the result of |apPairs| into a -|Music Pitch| value by playing each pair of pitches in parallel, and -stringing them all together sequentially. Try varying the rhythm by, -for example, using an eighth note when the first absolute pitch is -odd, and a sixteenth note when it is even, or some other criterion. - -Test your functions by using arithemtic sequences to generate the two -lists of arguments given to |apPairs|.} -\end{exercise} - -\vspace{.1in}\hrule - -\section{Function Composition} -\label{sec:function-composition} - -\begin{figure*} -\centerline{ -\epsfysize=0.75in -\epsfbox{Pics/glue.eps} -} -\caption{Gluing Two Functions Together} -\label{fig:glue} -\end{figure*} - -\index{function!composition||(} -An example of polymorphism that has nothing to do with data structures -arises from the desire to take two functions $f$ and $g$ and ``glue -them together,'' yielding another function $h$ that first applies $g$ -to its argument, and then applies $f$ to that result. This is called -function {\em composition} (just as in mathematics), and Haskell -pre-defines a simple infix operator |(.)| to achieve it, as follows: -\indexhs{(.)} -\begin{spec} -(.) :: (b->c) -> (a->b) -> a -> c -(f . g) x = f (g x) -\end{spec} -\syn{The symbol for function composition is typeset in this textbook - as |.|, which is consistent with mathematical convention. When - writing your programs, however, you will have to use a period, as in - ``\verb!f . g!''.} - -Note the type of the operator |(.)|; it is completely polymorphic. -Note also that the result of the first function to be applied---some -type |b|---must be the same as the type of the argument to the second -function to be applied. Pictorially, if we think of a function as a -black box that takes input at one end and returns some output at the -other, function composition is like connecting two boxes together, end -to end, as shown in Figure \ref{fig:glue}. - -The ability to compose functions using |(.)| is quite handy. For -example, recall the last version of |hList|: -\begin{spec} -hList d ps = line (map (hNote d) ps) -\end{spec} -We can do two simplifications here. First, rewrite the right-hand -side using function composition: -\begin{spec} -hList d ps = (line . map (hNote d)) ps -\end{spec} -Then, use currying simplification: -\begin{spec} -hList d = line . map (hNote d) -\end{spec} - -\section{Higher-Order Thinking} -\label{sec:higher-order-thinking} - -It is worth taking a deep breath here and contemplating what has been -done with |hList|, which has gone through quite a few transformations. -Here is the original definition given in Chapter \ref{ch:intro}: -\begin{spec} -hList d [] = rest 0 -hList d (p:ps) = hNote d p :+: hList d ps -\end{spec} -Compare this to the definition above. You may be distressed to think -that you have to go through all of these transformations just to write -a relatively simple function! There are two points to make about -this: First, you do not have to make \emph{any} of these -transformations if you do not want to. All of these versions of -|hList| are correct, and they all run about equally fast. They are -explained here for pedagogical purposes, so that you understand the -full power of Haskell. Second, with practice, you will find that you -can write the concise higher-order versions of many functions straight -away, without going through all of the steps presented here. - -As mentioned earlier, one thing that helps is to start {\em thinking} -in ``higher-order'' terms. To facilitate this way of thinking it is -helpful to write type signatures that reflect more closely their -higher-order nature. For example, recall these type signatures for -|map|, |filter|, and |(.)|: -\begin{spec} -map :: (a -> b) -> [a] -> [b] -filter :: (a -> Bool) -> [a] -> [a] -(.) :: (b->c) -> (a->b) -> a -> c -\end{spec} -Also recall that the arrow in function types is right associative. -Therefore, another completely equivalent way to write the above type -signatures is: -\begin{spec} -map :: (a -> b) -> ([a] -> [b]) -filter :: (a -> Bool) -> ([a] -> [a]) -(.) :: (b->c) -> (a->b) -> (a->c) -\end{spec} -Although equivalent, the latter versions emphasize the fact that each -of these functions returns a function as its result. |map| -essentially ``lifts'' a function on elements to a function on lists of -elements. |filter| converts a predicate into a function on lists. -And |(.)| returns a function that is the composition of its two -functional arguments. - -So for example, using higher-order thinking, |map (+12)| is a function -that transposes a list of absolute pitches by one octave. |filter -(<100)| is a function that removes all absolute pitches greater than -or equal to 100 (as discussed earlier). And therefore |map (+12) -. filter (<100)| first does the filtering, and then does the -transposition. All very consise and very natural using higher-order -thinking. - -In the remainder of this textbook definitions such as this will be -written directly, using a small set of rich polymorphic functions such -as |foldl|, |map|, |filter|, |(.)|, and a few other functions drawn -from the Standard Prelude and other standard libraries. - -%% For example, suppose we wish to define a -%% function that determines whether all of the elements in a list are -%% greater than zero, and one that determines if at least one is greater -%% than zero. The way to ``think about'' this is to raise ourselves up -%% to the list level, and to just compose functions that transform lists: -%% \begin{spec} -%% allOverZero, oneOverZero :: [Integer] -> Bool -%% allOverZero = and . posInts -%% oneOverZero = or . posInts -%% \end{spec} -%% \syn{|and :: [Bool] -> Bool| and |or :: [Bool] -> Bool| are predefined -%% functions that ``and'' and ``or'' together all of the elements in a -%% list, returning a single Boolean result. The |Bool| type is -%% predefined in Haskell simply as: -%% \begin{spec} -%% data Bool = False | True -%% \end{spec} -%% } -%% Indeed, note that the auxiliary function |posInts| is simple -%% enough that we could incorporate its definition directly, as in: -%% \begin{spec} -%% allOverZero, oneOverZero :: [Integer] -> Bool -%% allOverZero = and . map (>0) -%% oneOverZero = or . map (>0) -%% \end{spec} - -\section{Infix Function Application} - -Haskell predefines an infix operator to apply a function to a value: -\begin{spec} -f $ x = f x -\end{spec} % $ -At first glance this does not seem very useful---after all, why not -simply write |f x| instead of |f $ x|? % $ - -But in fact this operator has a very useful purpose: eliminating -parentheses! In the Standard Prelude, |($)| %% $ -is defined to be right associative, and to have the lowest precedence -level, via the fixity declaration: -\begin{spec} -infixr 0 $ -\end{spec} %% $ -Therefore, note that |f (g x)| is the same as |f $ g x| %% $ -(remember that normal function application always has higher -precedence than infix operator application), and |f (x+1)| is the same -as |f $ x + 1|. %% $ -This ``trick'' is especially useful when there is a sequence of -nested, parenthesized expresssions. For example, recall the following -definition from the last chapter: -\begin{spec} -childSong6 = let t = (dhn/qn)*(69/120) - in instrument RhodesPiano - (tempo t (bassLine :=: mainVoice)) -\end{spec} - -\pagebreak - -We can rewrite the last few lines a bit more clearly as follows: -\begin{spec} -childSong6 = let t = (dhn/qn)*(69/120) - in instrument RhodesPiano $ - tempo t $ - bassLine :=: mainVoice -\end{spec} -Or, on a single line, instead of: -\begin{spec} -instrument RhodesPiano (tempo t (bassLine :=: mainVoice)) -\end{spec} -we can write: -\begin{spec} -instrument RhodesPiano $ tempo t $ bassLine :=: mainVoice -\end{spec} - -\vspace{.1in}\hrule - -\begin{exercise}{\em -The last definition of |hList| still has an argument |d| on the -left-hand side, and one occurence of |d| on the right-hand side. Is -there some way to eliminate it using currying simplification? (Hint: -the answer is yes, but the solution is a bit perverse, and is not -recommended as a way to write your code!)} -\end{exercise} - -\out{ -hList d = line . map (hNote d) - = line . ((map . hNote) d) - = (.) line ((map . hNote) d) - = ((.) line . (map . hNote)) d - -hList = (.) line . (map . hNote) -} - -\begin{exercise}{\em -Use |line|, |map| and |($)| to give a concise definition of |addDur|.} -\end{exercise} % $ - -\begin{exercise}{\em -Rewrite this example: -\begin{spec} -map (\x-> (x+1)/2) xs -\end{spec} -using a composition of sections.} -\end{exercise} - -\begin{exercise}{\em -Consider the expression: -\begin{spec} -map f (map g xs) -\end{spec} -Rewrite this using function composition and a single call to |map|. -Then rewrite the earlier example: -\begin{spec} -map (\x-> (x+1)/2) xs -\end{spec} -as a ``map of a map'' (i.e.\ using two maps).} -\end{exercise} -\index{function!composition||)} - -\begin{exercise}{\em -Go back to any exercises prior to this chapter, and simplify your -solutions using ideas learned here.} -\end{exercise} - -\begin{exercise}{\em -Using higher-order functions introduced in this chapter, fill in the -two missing functions, |f1| and |f2|, in the evaluation below so that -it is valid: -\begin{spec} -f1 (f2 (*) [1, 2, 3, 4]) 5 ==> [5, 10, 15, 20] -\end{spec} -} -\end{exercise} - -\vspace{.1in}\hrule - diff --git a/HSoM/ToMidi.lhs b/HSoM/ToMidi.lhs deleted file mode 100644 --- a/HSoM/ToMidi.lhs +++ /dev/null @@ -1,686 +0,0 @@ -%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- - -%include lhs2TeX.fmt -%include myFormat.fmt - -\out{ -\begin{code} --- This code was automatically generated by lhs2tex --code, from the file --- HSoM/ToMidi.lhs. (See HSoM/MakeCode.bat.) - -\end{code} -} - -\chapter{From Performance to Midi} -\label{ch:midi} - -\begin{code} -module Euterpea.IO.MIDI.ToMidi(toMidi, UserPatchMap, defST, - defUpm, testMidi, testMidiA, - test, testA, writeMidi, writeMidiA, - play, playM, playA, - makeMidi, mToMF, gmUpm, gmTest) where - -import Euterpea.Music.Note.Music -import Euterpea.Music.Note.MoreMusic -import Euterpea.Music.Note.Performance -import Euterpea.IO.MIDI.GeneralMidi -import Euterpea.IO.MIDI.MidiIO -import Euterpea.IO.MIDI.ExportMidiFile -import Sound.PortMidi -import Data.List(partition) -import Data.Char(toLower,toUpper) -import Codec.Midi -\end{code} - -writeMidi :: (Performable a) => FilePath -> Music a -> IO () -writeMidi fn = exportMidiFile fn . testMidi - -writeMidiA :: (Performable a) => FilePath -> PMap Note1 -> Context -Note1 -> Music a -> IO () -writeMidiA fn pm con m = exportMidiFile fn (testMidiA pm con m) - -\indexwd{Midi} is shorthand for ``Musical Instrument Digital -Interface,'' and is a standard protocol for controlling electronic -musical instruments \cite{MIDI,General-MIDI}. This chapter describes -how to convert an abstract {\em performance} as defined in Chapter -\ref{ch:performance} into a \emph{standard Midi file} that can be -played on any modern PC with a standard sound card. - -\section{An Introduction to Midi} -\label{sec:midi} - -Midi is a standard adopted by most, if not all, manufacturers of -electronic instruments and personal computers. At its core is a -protocol for communicating \emph{musical events} (note on, note off, -etc.) and so-called \emph{meta events} (select synthesizer patch, -change tempo, etc.). Beyond the logical protocol, the Midi standard -also specifies electrical signal characteristics and cabling details, -as well as a \emph{standard Midi file} which any Midi-compatible -software package should be able to recognize. - -Most ``sound-blaster''-like sound cards on conventional PC's know -about Midi. However, the sound generated by such modules, and the -sound produced from the typically-scrawny speakers on most PC's, is -often quite poor. It is best to use an outboard keyboard or tone -generator, which are attached to a computer via a Midi interface and -cables. It is possible to connect several Midi instruments to the -same computer, with each assigned to a different \emph{channel}. -Modern keyboards and tone generators are quite good. Not only is the -sound excellent (when played on a good stereo system), but they are -also \emph{multi-timbral}, which means they are able to generate many -different sounds simultaneously, as well as \emph{polyphonic}, meaning -that simultaneous instantiations of the same sound are possible. - -%% Euterpea provides a way to specify a Midi channel number and General -%% Midi instrument selection for each |InstrumentName| in a Euterpea -%% composition. It also provides a means to generate a Standard Midi -%% File, which can then be played using any conventional Midi software. -%% Finally, it provides a way for existing Midi files to be read and -%% converted into a Music object in Euterpea. In this section the -%% top-level code needed by the user to invoke this functionality will be -%% described, along with the gory details. - -\subsection{General Midi} - -Over the years musicians and manufacturers decided that they also -wanted a standard way to refer to commonly used instrument sounds, -such as ``acoustic grand piano,'' ``electric piano,'' ``violin,'' and -``acoustic bass,'' as well as more exotic sounds such as ``chorus -aahs,'' ``voice oohs,'' ``bird tweet,'' and ``helicopter.'' A simple -standard known as \emph{General Midi} was developed to fill this role. -The General Midi standard establishes standard names for 128 common -instrument sounds (also called ``patches'') and assigns an integer -called the \emph{program number} (also called ``program change -number''), to each of them. The instrument names and their program -numbers are grouped into ``familes'' of instrument sounds, as shown in -Table \ref{fig:gm-families}. - -\begin{table} -%% \vspace{0.1in} \noindent -\begin{tabular}{||l||l||c||l||l||}\hline -\bf Family & \bf Program \# && \bf Family & \bf Program \# \\ -\hline \hline -Piano & 1-8 && Reed & 65-72 \\ \hline -Chromatic Percussion & 9-16 && Pipe & 73-80 \\ \hline -Organ & 17-24 && Synth Lead & 81-88 \\ \hline -Guitar & 25-32 && Synth Pad & 89-96 \\ \hline -Bass & 33-40 && Synth Effects & 97-104 \\ \hline -Strings & 41-48 && Ethnic & 105-112 \\ \hline -Ensemble & 49-56 && Percussive & 113-120 \\ \hline -Brass & 57-64 && Sound Effects & 121-128 \\ \hline -\hline -\end{tabular} -%% \vspace{0.1in} -\caption{General Midi Instrument Families} -\label{fig:gm-families} -\end{table} - -Now recall that in Chapter \ref{ch:music} we defined a set of -instruments via the |InstrumentName| data type (see Figure -\ref{fig:instrument-names}). All of the names chosen for that data -type come directly from the General Midi standard, except for two, -|Percussion| and |Custom|, which were added for convenience and -extensibility. By listing the constructors in the order that reflects -this assignment, we can derive an |Enum| instance for |InstrumentName| -that defines the method |toEnum| that essentially does the conversion -from instrument name to program number for us. We can then define a -function: -\begin{spec} -toGM :: InstrumentName -> ProgNum -toGM Percussion = 0 -toGM (Custom name) = 0 -toGM in = fromEnum in -\end{spec} -\begin{code} -type ProgNum = Int -\end{code} -that takes care of the two extra cases, which are simply assigned to -program number 0. - -The derived |Enum| instance also defines a function |fromEnum| that -converts program numbers to instrument names. We can then define: -\begin{spec} -fromGM :: ProgNum -> InstrumentName -fromGM pn | pn >= 0 && pn <= 127 = fromEnum pn -fromGM pn = error ("fromGM: " ++ show pn ++ - " is not a valid General Midi program number") -\end{spec} - -\syn{Design bug: Because the |IntrumentName| data type contains a - non-nullary constructor, namely |Custom|, the |Enum| instance cannot - be derived. For now it is defined in the module |GeneralMidi|, but - a better solution is to redefine |InstrumentName| in such a way as - to avoid this.} - -\subsection{Channels and Patch Maps} - -A Midi \emph{channel} is in essence a programmable instrument. You -can have up to 16 channels, numbered 0 through 15, each assigned a -different program number (corresponding to an instrument sound, see -above). All of the dynamic ``Note On'' and ``Note Off'' messages (to -be defined shortly) are tagged with a channel number, so up to 16 -different instruments can be controlled independently and -simultaneously. - -The assignment of Midi channels to instrument names is called a -\emph{patch map}, and we define a simple association list to capture -its structure: -\begin{code} -type UserPatchMap = [(InstrumentName, Channel)] -\end{code} -\begin{spec} -type Channel = Int -\end{spec} - -The only thing odd about Midi Channels is that General Midi specifies -that Channel 10 (9 in Euterpea's 0-based numbering) is dedicated to -\emph{percussion} (which is different from the ``percussive -instruments'' described in Table \ref{fig:gm-families}). When Channel -10 is used, any program number to which it is assigned is ignored, and -instead each note corresponds to a different percussion sound. In -particular, General Midi specifies that the notes corresponding to -Midi Keys 35 through 82 correspond to specific percussive sounds. -Indeed, recall that in Chapter \ref{ch:more-music} we in fact captured -these percussion sounds through the |PercussionSound| data type, and -we defined a way to convert such a sound into an absolute pitch -(i.e.\ |AbsPitch|). Euterpea's absolute pitches, by the way, are in -one-to-one correspondence with Midi Key nunmbers. - -Except for percussion, the Midi Channel used to represent a particular -instrument is completely arbitrary. Indeed, it is tedious to -explicitly define a new patch map every time the instrumentation of a -piece of music is changed. Therefore it is convenient to define a -function that automatically creates a |UserPatchMap| from a list of -instrument names: -\begin{code} -makeGMMap :: [InstrumentName] -> UserPatchMap -makeGMMap ins = mkGMMap 0 ins - where mkGMMap _ [] = [] - mkGMMap n _ | n>=15 = - error "MakeGMMap: Too many instruments." - mkGMMap n (Percussion : ins) = - (Percussion, 9) : mkGMMap n ins - mkGMMap n (i : ins) = - (i, chanList !! n) : mkGMMap (n+1) ins - chanList = [0..8] ++ [10..15] -- channel 9 is for percussion -\end{code} -Note that, since there are only 15 Midi channels plus percussion, we -can handle only 15 different instruments, and an error is signaled if -this limit is exceeded.\footnote{It is conceivable to define a - function to test whether or not two tracks can be combined with a - Program Change (tracks can be combined if they don't overlap), but - this remains for future work.} - -Finally, we define a function to look up an |InstrumentName| in a -\newline |UserPatchMap|, and return the associated channel as well as -its program number: -\begin{code} -upmLookup :: UserPatchMap -> InstrumentName - -> (Channel, ProgNum) -upmLookup upm iName = (chan, toGM iName) - where chan = maybe (error ( "instrument " ++ show iName ++ - " not in patch map") ) - id (lookup iName upm) -\end{code} - -%% Note that the function that does string matching ignores case, and -%% allows substring matches. For example, |"chur"| matches |"Church -%% Organ"|. Note also that the \emph{first} match succeeds, so using a -%% substring should be done with care to be sure that the correct -%% instrument is selected. - -\subsection{Standard Midi Files} - -The Midi standard defines the precise format of a \emph{standard Midi - file}. At the time when the Midi standard was first created, disk -space was at a premium, and thus a compact file structure was -important. Standard Midi files are thus defined at the bit and byte -level, and are quite compact. We are not interested in this low-level -representation (any more than we are interested in the signals that -run on Midi cables), and thus in Euterpea we take a more abstract -approach: We define an algebraic data type called |Midi| to capture -the abstract structure of a standard Midi file, and then define -functions to convert values of this data type to and from actual Midi -files. This separation of concerns makes the structure of the Midi -file clearer, makes debugging easier, and provides a natural path for -extending Euterpea's functionality with direct Midi capability. -% (discussed further in Chapter \ref{ch:reactivity}). - -\begin{figure} -\cbox{\small -\begin{spec} --- From the |Codec.Midi| module - -data Midi = Midi { fileType :: FileType, - timeDiv :: TimeDiv - tracks :: [Track Ticks] } - deriving (Eq, Show) - -data FileType = SingleTrack | MultiTrack | MultiPattern - deriving (Eq, Show) - -type Track a = [(a, Message)] - -data TimeDiv = TicksPerBeat Int -- 1 through ($2^{15}$ - 1) - | ... - deriving (Show,Eq) - -type Ticks = Int -- 0 through ($2^{28}$ - 1) -type Time = Double -type Channel = Int -- 0 through 15 -type Key = Int -- 0 through 127 -type Velocity = Int -- 0 through 127 -type Pressure = Int -- 0 through 127 -type Preset = Int -- 0 through 127 -type Tempo = Int -- microseconds per beat, 1 through ($2^{24}$ - 1) - -data Message = - -- Channel Messages - NoteOff { channel :: !Channel, key :: !Key, velocity :: !Velocity } - | NoteOn { channel :: !Channel, key :: !Key, velocity :: !Velocity } - | ProgramChange { channel :: !Channel, preset :: !Preset } - | ... - -- Meta Messages - | TempoChange !Tempo | - | ... - deriving (Show,Eq) - -fromAbsTime :: (Num a) => Track a -> Track a -fromAbsTime trk = zip ts' ms - where (ts,ms) = unzip trk - (_,ts') = mapAccumL (\acc t -> (t,t - acc)) 0 ts -\end{spec}} -\caption{Partial Definition of the |Midi| Data Type} -\label{fig:MidiFile} -\end{figure} - -We will not discuss the details of the functions that read and write -the actual Midi files; the interested reader may find them in the -modules |ReadMidi| and |OutputMidi|, respectively. Instead, we will -focus on the |Midi| data type, which is defined in the module -|Codec.Midi|. We do not need all of its functionality, and thus we -show in Figure \ref{fig:MidiFile} only those parts of the module -that we need for this chapter. Here are the salient points about this -data type and the structure of Midi files: -\begin{enumerate} -\item There are three types of Midi files: -\begin{itemize} -\item A Format 0, or |SingleTrack|, Midi file stores its information in - a single track of events, and is best used only for monophonic - music. -\item A Format 1, or |MultiTrack|, Midi file stores its information in - multiple tracks that are played simultaneously, where each track - normally corresponds to a single Midi Channel. -\item A Format 2, or |MultiPattern|, Midi file also has multiple - tracks, but they are temporally independent. -\end{itemize} -In this chapter we only use |SingleTrack| and |MultiTrack| Midi files, -depending on how many Channels we need. - -\item The \indexwdhs{TimeDiv} field refers to the \emph{time-code - division} used by the Midi file. We will always use 96 time - divisions, or ``ticks,'' per quarternote, and thus this field will - always be |TicksPerBeat 96|. - -\item The main body of a Midi file is a list of \indexwdhs{Track}s, - each of which in turn is a list of time-stamped (in number of ticks) - |Message|s (or ``events''). - -\item There are two kinds of \indexwdhs{Message}s: \emph{channel - messages} and \emph{meta messages}. Figure \ref{fig:MidiFile} shows - just those messages that we are interested in: -\begin{enumerate} -\item \indexhs{NoteOn} |NoteOn ch k v| turns on key (pitch) |k| - with velocity (volume) |v| on Midi channel |ch|. The velocity - is an integer in the range 0 to 127. -\item \indexhs{NoteOff} |NoteOff ch k v| performs a similar - function in turning the note off. -\item \indexhs{ProgChange} |ProgChange ch pr| sets the program - number for channel |ch| to |pr|. This is how an instrument is - selected. -\item \indexhs{SetTempo} |TempoChange t| sets the tempo to |t|, - which is the time, in microseconds, of one whole note. Using 120 - beats per minute as the norm, or 2 beats per second, that works out - to 500,000 microseconds per beat, which is the default value that we - will use. -\end{enumerate} -\end{enumerate} - -\section{Converting a Performance into Midi} - -Our goal is to convert a value of type |Performance| into a value of -type |Midi|. We can summarize the situation pictorially as follows -... - -%% \begin{verbatim} -%% *LoadMidi* *ReadMidi* -%% +------+ =loadMidiFile= +-----------+ =readMidi= +-----------+ -%% | Midi |----------------->| MidiFile |---------------->| Music | -%% | File | | data type | | data type | -%% | |<-----------------| |<----------------| | -%% +------+ +-----------+ *HaskToMidi* +-----------+ -%% *OutputMidi* *MidiFile* *Performance* *Basics* -%% =outputMidiFile= =makeMidi= -%% \end{verbatim} - -Given a |UserPatchMap|, a |Performance| is converted into a |Midi| -value by the |toMidi| function. If the given |UserPatchMap| is -invalid, it creates a new one using |makeGMMap| described earlier. -\begin{code} -toMidi :: Performance -> UserPatchMap -> Midi -toMidi pf upm = - let split = splitByInst pf - insts = map fst split - rightMap = if (allValid upm insts) then upm - else (makeGMMap insts) - in Midi (if length split == 1 then SingleTrack - else MultiTrack) - (TicksPerBeat division) - (map (fromAbsTime . performToMEvs rightMap) split) - -division = 96 :: Int -\end{code} - -The following function is used to test whether or not every instrument -in a list is found in a |UserPatchMap|: -\begin{code} -allValid :: UserPatchMap -> [InstrumentName] -> Bool -allValid upm = and . map (lookupB upm) - -lookupB :: UserPatchMap -> InstrumentName -> Bool -lookupB upm x = or (map ((== x) . fst) upm) -\end{code} -%% lookupB [] _ = False -%% lookupB ((y,_):ys) x = x == y || lookupB ys x - -The strategy is to associate each channel with a separate track. Thus -we first partition the event list into separate lists for each -instrument, and signal an error if there are more than 16: -\begin{code} -splitByInst :: Performance -> [(InstrumentName,Performance)] -splitByInst [] = [] -splitByInst pf = (i, pf1) : splitByInst pf2 - where i = eInst (head pf) - (pf1, pf2) = partition (\e -> eInst e == i) pf -\end{code} -Note how |partition| is used to group into |pf1| those events -that use the same instrument as the first event in the performance. -The rest of the events are collected into |pf2|, which is passed -recursively to |splitByInst|. - -\indexhs{partition} -\syn{|partition| takes a predicate and a list and returns a pair of - lists: those elements that satisfy the predicate, and those that do - not, respectively. |partition| is defined in the |List| - Library as: -\begin{spec} -partition :: (a -> Bool) -> [a] -> ([a],[a]) -partition p xs = - foldr select ([],[]) xs - where select x (ts,fs) | p x = (x:ts,fs) - | otherwise = (ts, x:fs) -\end{spec} -} - -The crux of the conversion process is in |performToMEvs|, which -converts a |Performance| into a stream of time-stamped messages, -i.e.\ a stream of |(Tick,Message)| pairs: -\begin{code} -type MEvent = (Ticks, Message) - -defST = 500000 - -performToMEvs :: UserPatchMap - -> (InstrumentName, Performance) - -> [MEvent] -performToMEvs upm (inm, pf) = - let (chan,progNum) = upmLookup upm inm - setupInst = (0, ProgramChange chan progNum) - setTempo = (0, TempoChange defST) - loop [] = [] - loop (e:es) = let (mev1,mev2) = mkMEvents chan e - in mev1 : insertMEvent mev2 (loop es) - in setupInst : setTempo : loop pf -\end{code} - -A source of incompatibilty between Euterpea and Midi is that Euterpea -represents notes with an onset and a duration, while Midi represents -them as two separate events, a note-on event and a note-off event. -Thus |MkMEvents| turns a Euterpea |Event| into two |MEvents|, a -|NoteOn| and a |NoteOff|. -\begin{code} -mkMEvents :: Channel -> Event -> (MEvent,MEvent) -mkMEvents mChan (Event { eTime = t, ePitch = p, - eDur = d, eVol = v}) - = ( (toDelta t, NoteOn mChan p v'), - (toDelta (t+d), NoteOff mChan p v') ) - where v' = max 0 (min 127 (fromIntegral v)) - -toDelta t = round (t * 2.0 * fromIntegral division) -\end{code} -The time-stamp associated with an event in Midi is called a {\em -delta-time}, and is the time at which the event should occur expressed -in time-code divisions since the beginning of the performance. Since -there are 96 time-code divisions per quarter note, there are 4 times -that many in a whole note; multiplying that by the time-stamp on one -of our |Event|s gives us the proper delta-time. - -In the code for |performToMEvs|, note that the location of the -first event returned from |mkMEvents| is obvious; it belongs just -where it was created. However, the second event must be inserted into -the proper place in the rest of the stream of events; there is no way -to know of its proper position ahead of time. The function -\indexwdhs{insertMEvent} is thus used to insert an |MEvent| into an -already time-ordered sequence of |MEvent|s. -\begin{code} -insertMEvent :: MEvent -> [MEvent] -> [MEvent] -insertMEvent mev1 [] = [mev1] -insertMEvent mev1@(t1,_) mevs@(mev2@(t2,_):mevs') = - if t1 <= t2 then mev1 : mevs - else mev2 : insertMEvent mev1 mevs' -\end{code} - -\section{Putting It All Together} - -\todo{Move the code for the |PerformanceDefault| type class, the - family of |play| functions, and so on, to this section.} - -%% We are almost done. All that remains is to write the |MidiFile| -%% value into a real file. The details of this are surprisingly ugly, -%% however, primarily because Midi files were invented at a time when -%% disk space was precious, and thus a compact bit-level representation -%% was chosen. Fortunately, there is a function in the |Euterpea| -%% library that solves this problem for us: \indexhs{outputMidiFile} -%% \begin{code} -%% outputMidiFile :: String -> MidiFile -> IO () -%% \end{code} - -%% To make this easier to use, let's define a function |test| that -%% converts a |Music| value using a default |Context| into a -%% |MidiFile| value, and then writes that to a file |"test.mid"|: -%% \begin{code} -%% test :: Music -> IO () -%% test m = outputMidiFile "test.mid" -%% (performToMidi (perform defCon m)) - -%% defCon :: Context -%% defCon = Context { cTime = 0, -%% cInst = AcousticGrandPiano, -%% cDur = metro 120 qn, -%% cKey = 0 } -%% \end{code} - -%% So if you type |test m| for some |Music| value |m|, it will -%% be converted to Midi and written to the file |"test.mid"|, which -%% you can then play using whatever Midi-file player is supplied with -%% your computer. If you are running the Hugs implementation of Haskell -%% on Windows 95/NT or Linux, you can invoke the standard media player -%% from Haskell by defining one of the following functions (for these to -%% work you must also import |system| from the Hugs module -%% |System|, via |import System (system)|): -%% \indexhs{testWin95} -%% \indexhs{testNT} -%% \indexhs{testLinux} - -%% \begin{code} -%% testWin95, testNT, testLinux :: Music -> IO () - -%% testWin95 m = do test m -%% system "mplayer test.mid" -%% return () - -%% testNT m = do test m -%% system "mplay32 test.mid" -%% return () - -%% testLinux m = do test m -%% system "playmidi -rf test.mid" -%% return () -%% \end{code} - -%% For example, typing: -%% \begin{code} -%% testNT funkGroove -%% \end{code} -%% using Hugs on an NT system will write the |funkGroove| example from -%% Chapter \ref{ch:music} into a Midi file and then automatically fire up -%% the media player so that you can hear the result. Try the above for -%% other examples from Chapter \ref{ch:music}, such as |cMajArp|, -%% |cMajChd|, |pr12|, |waterfall|, and |main|. - -\out{ - -A default UserPatchMap ----------------------- - -\begin{code} - -defUpm :: UserPatchMap -defUpm = [(AcousticGrandPiano,0), - (Marimba,1), - (Vibraphone,2), - (AcousticBass,3), - (Flute,4), - (TenorSax,5), - (AcousticGuitarSteel,6), - (Viola,7), - (StringEnsemble1,8), - (AcousticGrandPiano,9)] - -- the GM name for drums is unimportant, only channel 9 -\end{code} - -Generating MIDI values and MIDI files -------------------------------------- - -Generate a MIDI datatype: - -\begin{code} - -testMidi :: Performable a => Music a -> Midi -testMidi m = toMidi (defToPerf m) defUpm - -testMidiA :: Performable a => PMap Note1 -> Context Note1 -> Music a -> Midi -testMidiA pm con m = toMidi (toPerf pm con m) defUpm -\end{code} - -Generate a MIDI file: - -\begin{code} - -test :: Performable a => Music a -> IO () -test m = exportMidiFile "test.mid" (testMidi m) - -testA :: Performable a => PMap Note1 -> Context Note1 -> Music a -> IO () -testA pm con m = exportMidiFile "test.mid" (testMidiA pm con m) - -writeMidi :: Performable a => FilePath -> Music a -> IO () -writeMidi fn = exportMidiFile fn . testMidi - -writeMidiA :: Performable a => - FilePath -> PMap Note1 -> Context Note1 -> Music a -> IO () -writeMidiA fn pm con m = exportMidiFile fn (testMidiA pm con m) -\end{code} - -Alternatively, just run "play m", which will play the music -through the default Midi output device on your computer: - -\begin{code} - -play :: Performable a => Music a -> IO () -play = playM . testMidi -\end{code} - -Or play a Midi data directly: - -\begin{code} - -playM :: Midi -> IO () -playM midi = do - initialize - (defaultOutput playMidi) midi - terminate - return () -\end{code} - -A play function that takes a PMap and Context: - -\begin{code} - -playA :: Performable a => PMap Note1 -> Context Note1 - -> Music a -> IO () -playA pm con m = - let pf = fst $ perfDur pm con m - in playM (toMidi pf defUpm) -\end{code} %$ - -A more general function in the tradition of testMidi, makeMidi also -takes a Context and a UserPatchMap. - -\begin{code} - -makeMidi :: (Music1, Context Note1, UserPatchMap) -> Midi -makeMidi (m,c,upm) = toMidi (perform defPMap c m) upm -\end{code} - -The most general export function from Music to a Midi file. - -\begin{code} - -mToMF :: PMap a -> Context a -> UserPatchMap -> FilePath -> Music a -> IO () -mToMF pmap c upm fn m = - let pf = perform pmap c m - mf = toMidi pf upm - in exportMidiFile fn mf -\end{code} - -Some General Midi test functions (use with caution) ---------------------------------------------------- - -A General MIDI user patch map; i.e. one that maps GM instrument names -to themselves, using a channel that is the patch number modulo 16. -This is for use ONLY in the code that follows, o/w channel duplication -is possible, which will screw things up in general. - -\begin{code} - -gmUpm :: UserPatchMap -gmUpm = map (\n -> (toEnum n, mod n 16 + 1)) [0..127] -\end{code} - -Something to play each "instrument group" of 8 GM instruments; -this function will play a C major arpeggio on each instrument. - -\begin{code} - -gmTest :: Int -> IO () -gmTest i = let gMM = take 8 (drop (i*8) [0..127]) - mu = line (map simple gMM) - simple n = Modify (Instrument (toEnum n)) cMajArp - in mToMF defPMap defCon gmUpm "test.mid" mu - -cMaj = [ n 4 qn | n <- [c,e,g] ] -- octave 4, quarter notes -cMajArp = toMusic1 (line cMaj) -\end{code} - -} diff --git a/HSoM/myFormat.fmt b/HSoM/myFormat.fmt deleted file mode 100644 --- a/HSoM/myFormat.fmt +++ /dev/null @@ -1,229 +0,0 @@ -%if style /= newcode -%format typecomment(a) = "\texttt{--}\ " a -%format bottom = "\bot" -%format forall = "\forall" -%format == = "==" -%format /= = "\neq" -%format === = "\equiv" -%format ==== = "\cong" -%format ==> = "\Rightarrow" -%format ===> = "\Longrightarrow" -%format ^ = "\char94" -%format :+: = "\mathbin{:\!\!+\!\!:}" -%format !:+: = "\mathbin{\ :\!\!+\!\!:}" -%format +: = "\mathbin{+\!\!:}" -%format /=: = "\mathbin{/\!=:}" -%format :=/ = "\mathbin{:=\!\!/}" -%format !:=: = "\mathbin{\ :=:}" -%format :+ = "\mathbin{:\!\!+}" -%format :. = "\mathbin{:\!\!.}" -%format =:> = "\supseteq" -%format <* = "\mathbin{<\!\!*}" -%format >* = "\mathbin{>\!\!*}" -%format <=* = "\mathbin{\leq\!\!*}" -%format >=* = "\mathbin{\geq\!\!*}" -%format /=* = "\mathbin{\neq\!\!*}" -%format ==* = "\mathbin{==\!\!*}" -%format ->> = "\mathbin{-\!\!\!\gg}" -%format =>> = "\mathbin{=\!\gg}" -%format / = "\mathbin{\!/\!}" -%format !++ = "\mathbin{\ +\!\!\!+}" -%format ~++ = "\mathbin{\sim\!\!\!+\!\!\!+}" -%format -< = "\mathbin{-\!\!\!\prec}" -%format >>> = "\mathbin{>\!\!\!>\!\!\!>}" -%format <<< = "\mathbin{<\!\!\!<\!\!\!<}" -%format proc = "\mathbf{proc}" -%format rec = "\mathbf{rec}" -%format e1 -%format e2 -%format e3 -%format e4 -%format T1 -%format T2 -%format T3 -%format T4 -%format m0 -%format m1 -%format m2 -%format m3 -%format m4 -%format m5 -%format m6 -%format m'1 -%format m'2 -%format p0 -%format p1 -%format p2 -%format p3 -%format p4 -%format pr1 -%format pr2 -%format pr3 -%format pr4 -%format pr12 -%format pc1 -%format pc2 -%format d0 -%format d1 -%format d2 -%format d3 -%format d4 -%format d5 -%format d6 -%format x1 -%format x2 -%format x3 -%format x4 -%format y1 -%format y2 -%format xs1 -%format xs2 -%format xs3 -%format xs4 -%format v1 -%format v2 -%format v3 -%format v4 -%format v1a = "\Varid{v}_{1a}" -%format v1b = "\Varid{v}_{1b}" -%format v2a = "\Varid{v}_{2a}" -%format v2b = "\Varid{v}_{2b}" -%format v2c = "\Varid{v}_{2c}" -%format v2d = "\Varid{v}_{2d}" -%format v2e = "\Varid{v}_{2e}" -%format v2f = "\Varid{v}_{2f}" -%format v2g = "\Varid{v}_{2g}" -%format f0 -%format f1 -%format f2 -%format f3 -%format f4 -%format r1 -%format r2 -%format mel1 -%format mel2 -%format b1 -%format b2 -%format b3 -%format b4 -%format ma1 -%format ma2 -%format mb1 -%format mb2 -%format c1 -%format c2 -%format s0 -%format s1 -%format s2 -%format s3 -%format s4 -%format s5 -%format s6 -%format s7 -%format s8 -%format ss1 -%format ss2 -%format ss3 -%format ss4 -%format ss5 -%format ss6 -%format l1 -%format l2 -%format l3 -%format l4 -%format es1 -%format es2 -%format pf1 -%format pf2 -%format t0 -%format t1 -%format t2 -%format tm0 -%format ttm0 -%format tm1 -%format tm2 -%format tm3 -%format ttm3 -%format tm4 -%format tm5 -%format fac1 -%format fac2 -%format ui0 -%format ui1 -%format ui2 -%format ui3 -%format ui4 -%format ui5 -%format ui6 -%format ui'6 -%format ui''6 -%format mui0 -%format mui1 -%format mui2 -%format mui3 -%format mui4 -%format mui'4 -%format mui5 -%format mui6 -%format n1 -%format n2 -%format ns1 -%format ns2 -%format r1 -%format r2 -%format toAbsP1 -%format toAbsP2 -%format mkNote1 -%format mkNote2 -%format mkNote3 -%format mkLine1 -%format mkLine2 -%format mkLine3 -%format ps0 -%format ps1 -%format ps2 -%format na1 -%format na2 -%format na3 -%format ap1 -%format ap2 -%format aps1 -%format aps2 -%format tab1 -%format tab2 -%format M1 -%format M2 -%format ld1 -%format ld2 -%format ds1 -%format ds2 -%format toAbsPitches1 -%format toAbsPitches2 -%format line1 -%format line2 -%format reverse1 -%format reverse2 -%format op1 -%format a1 -%format a2 -%format fsm1 -%format sm0 -%format sm1 -%format t'1 -%format t'2 -%format lt0 -%format lt1 -%format flt1 -%format bell1 -%format bell'1 -%format bell2 -%format defaultMap0 -%format defaultMap1 -%format defaultMap2 -%format withColor' -%format cmd1 -%format cmd2 -%else -%format typecomment(a) = "-- " a -%endif - diff --git a/License b/License --- a/License +++ b/License @@ -1,4 +1,4 @@ -Copyright (c) 2008-2012 Paul Hudak +Copyright (c) 2008-2015 Euterpea authors This software is provided 'as-is', without any express or implied warranty. In no event will the authors be held liable for any damages diff --git a/ReadMe.txt b/ReadMe.txt --- a/ReadMe.txt +++ b/ReadMe.txt @@ -1,3 +1,5 @@ +Version 2.0.0 +Last modified: 31-Dec-2015 _____ _ | ___| | | | |__ _ _| |_ ___ _ __ _ __ ___ __ _ @@ -7,6 +9,16 @@ | | |_| +Authors: + Paul Hudak + Eric Cheng + Hai (Paul) Liu + Donya Quick + Dan Winograd-Cort + +Maintainers: + Donya Quick + Euterpea is a domain-specific language embedded in Haskell for computer music research, education, and development, providing both note-level and signal-level abstractions. It is a descendant @@ -15,169 +27,12 @@ wide-spectrum DSL, suitable for high-level music representation, algorithmic composition, and analysis; mid-level concepts such as MIDI; and low-level audio processing, sound synthesis, and instrument -design. It also includes a "musical user interface," a set of -computer-music specific GUI widgets such as keyboards, pushbuttons, -sliders, and so on. The performance of Euterpea is intended to be -as good as any other computer music language, with the goal of being -able to develop real-time applications, using both MIDI and a -high-performance back-end for real-time audio. - -See Liense for licensing information. - -Homepage: http://haskell.cs.yale.edu/ - - -============================ -==== Getting the Source ==== -============================ - -Currently (9/2/2015), the most up-to-date version of Euterpea is -available through GitHub at: - - https://github.com/Euterpea/Euterpea - -We recommend checking out the master version, as it should always be -kept stable. - -When we reach milestones, we will release stable versions to Hackage. - - -============================ -======= Installation ======= -============================ - -There is a stable version of Euterpea on Hackage, so one can easily -install Euterpea with: - cabal install euterpea - -For the most up to date version, install from source: - - 1) Clone the source from github - git clone https://github.com/Euterpea/Euterpea - - 2) cd into the Euterpea directory - cd Euterpea - - 3) install Euterpea with cabal - cabal install - ---------- Windows ---------- -There are currently no further steps or known issues installing on Windows. - - ----------- Linux ----------- -You may require additional steps to get MIDI sound output working on Linux. -First of all, we recommend using TiMidity (http://timidity.sourceforge.net/) -and either Freepats (http://freepats.zenvoid.org/) or PersonalCopy -(ftp://ftp.personalcopy.net/pub/Unison.sf2.gz) for MIDI support. -Make sure timidity is properly depending on the PersonalCopy soundfont -if you're using it. - -Make sure timidity is the default MIDI-Through port. The easiest way to -do this is probably to remove the default dummy port: -sudo rmmod snd_seq_dummy -Then, while Euterpea programs are running, you must have timidity running -in the background: -timidity -iA -Os & - - ---------- Mac OS X --------- -Euterpea is known to work fine on OS X (including Mavericks) when used with -GHC 7.8.3 & Haskell Platform 2014.2.0.0 or later. - -Once Euterpea is set up, you may require additional steps to get MIDI sound -output working. Download SimpleSynth and open it before you run ghci. It’s -a software MIDI synthesizer that plays MIDI output through the speaker. - -With GHC 7.8.3 or later, to run the GUI examples in ghci reliably, you need -to start gchi with -fno-ghci-sandbox, or set it within ghci as follows: - - ghci -fno-ghci-sandbox - *: :set -fno-ghci-sandbox - *: :m + Euterpea.Examples.MUI - *: mui5 - -With older versions of GHC, you may need the ``EnableGUI trick''. See -Euterpea/Examples/EnableGUI.hs for details. - - ------- Troubleshooting ----- -If you get errors about packages not being installed, make sure that cabal -binaries are in your `$PATH`. - -To add cabal binaries to your path first add -export PATH=$HOME/.cabal/bin:$PATH -to your .bashrc and then run -source ~/.bashrc -Now you should be able to successfully cabal install. - - -============================ -======= Building HSoM ====== -============================ - -This Euterpea distribution comes with the source code for the book: - - The Haskell School of Music, by Paul Hudak. - -Building the source into a PDF requires LaTeX as well as the package -lhs2TeX. Information about LaTeX can be found at - - http://www.latex-project.org/ - -and information about lhs2TeX can be found at - - http://www.andres-loeh.de/lhs2tex/ - -As lhs2TeX is available on Hackage, it can be installed with cabal: - - cabal install lhs2tex - -Once these are ready, building the book can be achieved by running the -batch script MakeTex.bat in the HSoM directory. This will compile the -lhs files into tex files, the tex files to a dvi, the dvi into a ps, and -finally the ps to a pdf. - -Note that the files of HSoM are Literate Haskell (lhs) files. As such, -they can be run directly with GHC. However, the batch script MakeCode.bat -will extract just the code. Although they can be regenerated, these -extracted files are already included with the Euterpea distribution, and -many are important files for the proper functioning of the library. - - -============================ -====== Getting Started ===== -============================ - -A good place to begin learning about Euterpea is from the text that -accompanies this distribution: The Haskell School of Music, by Paul Hudak. -The source files are available in the HSoM directory, and building them -to a PDF is described above. - -Using Euterpea is generally as easy as adding - - import Euterpea - -to the imports of your Haskell program. However, for specific advanced uses, -other specific imports can be appropriate. - -Lastly, the Euterpea.Examples subdirectory contains many examples of using -Euterpea in practice. These examples are designed to showcase Euterpea's -powers, but they may also be useful simply as a starting off point. - +design. -============================ -======== Information ======= -============================ +See License for licensing information. -Euterpea was created by: - Paul Hudak , - Eric Cheng , - Hai (Paul) Liu -and is currently maintained by - Paul Hudak , - Donya Quick , - Dan Winograd-Cort +Please send questions, comments, and bug reports to Donya Quick: +donyaquick@gmail.com -This file was last modified on 9/2/2015 -by Daniel Winograd-Cort +Installation instructions are available at: +http://www.euterpea.com diff --git a/System/Random/Distributions.hs b/System/Random/Distributions.hs deleted file mode 100644 --- a/System/Random/Distributions.hs +++ /dev/null @@ -1,135 +0,0 @@ --- 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 - diff --git a/Tests/RunAllTests.hs b/Tests/RunAllTests.hs deleted file mode 100644 --- a/Tests/RunAllTests.hs +++ /dev/null @@ -1,92 +0,0 @@ -module Main where -import Control.Monad -import System.Console.ANSI -import System.IO -import Data.IORef -import Test.QuickCheck -import Text.Printf -import EuterpeaTests -import Control.Concurrent - -totalTests = 1000 - --- Thank you, Rosetta Code! -colorStrLn :: ColorIntensity -> Color -> String -> IO () -colorStrLn fgi fg str = do - setSGR [SetColor Foreground fgi fg] - putStr str - setSGR [Reset] - putStrLn "" - -runTest :: MVar (String, Result) -> (String, IO Result) -> IO () -runTest result (s, a) = do - res <- a - putMVar result (s, res) - -printResults :: Int -> MVar (String, Result) -> Handle -> IORef Int -> IO () -printResults n result log failsR = replicateM_ n $ do - (s, res) <- takeMVar result - printf ("%-" ++ show (1 + maximum (map length ((fst . unzip) tests))) ++ "s ") s - case res of - Failure _ _ _ _ _ True _ _ -> colorStrLn Vivid Yellow "Interrupted" - Failure _ _ _ _ r _ _ o -> do - hPutStrLn log $ s ++ ":\n" ++ o ++ "\n" - colorStrLn Vivid Red r - atomicModifyIORef failsR (\x -> (x+1, ())) - _ -> colorStrLn Vivid Green $ "Passed " ++ show totalTests ++ " trials" - -main :: IO () -main = do - log <- openFile "error.log" WriteMode - failsR <- newIORef 0 - result <- newEmptyMVar - - mapM_ (forkIO . runTest result) tests - printResults (length tests) result log failsR - - fails <- readIORef failsR - hClose log - case fails of - 0 -> putStrLn "*** All tests passed!" - _ -> error $ "+++ " ++ show fails ++ " of " ++ show (length tests) ++ " tests failed. See error.log for details." - return () - -tests = [("AbsPitch_Pitch", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_AbsPitch_Pitch), - ("Trans_Composition", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Trans_Composition), - ("Retro_Composition", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Retro_Composition), - ("Invert_Composition", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Invert_Composition), - ("RetroInvert_Composition", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_RetroInvert_Composition), - ("Dur_Times_Composition", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Dur_Times_Composition), - ("Dur_Take_Composition", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Dur_Take_Composition), - ("Take_Repeat_Id", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Take_Repeat_Id), - ("Mmap_Id", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Mmap_Id), - ("Mmap_Function_Composition", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Mmap_Function_Composition), - ("TimesM_Seq", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_TimesM_Seq), - ("Mfold_Identity", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Mfold_Identity), - ("revM_SelfInverting", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_revM_SelfInverting), - ("revM_SelfInverting_weak", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_revM_SelfInverting_weak), - ("revM_DurationPreserving", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_revM_DurationPreserving), - ("Perf_Id", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Perf_Id), - ("Axiom_11_2_1", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_2_1), - ("Axiom_11_2_2", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_2_2), - ("Axiom_11_2_3", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_2_3), - ("Theorem_11_2_1", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Theorem_11_2_1), - ("Axiom_11_3_1a", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_1a), - ("Axiom_11_3_1b", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_1b), - ("Axiom_11_3_2a", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_2a), - ("Axiom_11_3_2b", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_2b), - ("Axiom_11_3_2c", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_2c), - ("Axiom_11_3_3a", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_3a), - ("Axiom_11_3_3b", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_3b), - ("Axiom_11_3_3c", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_3c), - ("Axiom_11_3_3d", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_3d), - ("Axiom_11_3_4a", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_4a), - ("Axiom_11_3_4b", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_4b), - ("Axiom_11_3_5", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_5), - ("Axiom_11_3_6a", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_6a), - ("Axiom_11_3_6b", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_6b), - ("Axiom_11_3_6c", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_6c), - ("Axiom_11_3_6d", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_6d), - ("Axiom_11_3_8", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_8), - ("Axiom_11_3_8_weak", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_8_weak)] -