haskore-0.2.0.3/0000755000000000000000000000000011754016452011501 5ustar0000000000000000haskore-0.2.0.3/Makefile0000644000000000000000000002115511754016452013145 0ustar0000000000000000 # BasicWriteMidi.lhs, BasicMidiFile.lhs are stripped versions of # WriteMidi.lhs, MidiFile.lhs # ../ghc_add/IOExtensions.hs needs non-existing IOExts OBJECT_DIR := build/$(shell uname -s)-$(shell uname -m) INTERFACE_DIR := build/Interface #BUILD_DIR = `uname -s`-`uname -m` BASICS = Basic/Pitch.lhs Basic/Duration.lhs Basic/Tempo.lhs Basic/Interval.lhs Basic/Scale.lhs \ Composition/Trill.lhs Composition/Chord.lhs Composition/ChordType.lhs \ Composition/Drum.lhs Composition/Rhythm.lhs \ Melody.lhs Melody/Standard.lhs \ Music.lhs Music/Standard.lhs Music/Rhythmic.lhs Music/GeneralMIDI.lhs \ Performance/Player.lhs Performance/BackEnd.lhs \ Performance/Default.lhs Performance/Fancy.lhs \ Performance.lhs Performance/Context.hs \ General/Utility.lhs General/Map.hs \ General/LoopTreeTagged.lhs General/LoopTreeRecursive.lhs \ General/LoopTreeTaggedGen.lhs General/LoopTreeRecursiveGen.lhs \ Process/Optimization.lhs Process/Format.lhs \ Interface/MML.lhs Interface/MED/Text.hs MEDIA = Medium.hs Medium/Temporal.hs \ Medium/Plain/List.hs Medium/Plain/Binary.hs Medium/Plain/ContextFreeGrammar.lhs \ Medium/Controlled/List.hs Medium/LabeledControlled/List.hs Medium/Controlled.hs \ Medium/Controlled/ContextFreeGrammar.lhs MIDI = Interface/MIDI.lhs \ $(patsubst %, Interface/MIDI/%, \ InstrumentMap.lhs Note.lhs \ Read.lhs Write.lhs Render.lhs ) CSOUND = Interface/CSound.lhs \ $(patsubst %, Interface/CSound/%, \ Score.lhs InstrumentMap.lhs SoundMap.hs Note.lhs \ Generator.lhs Orchestra.lhs OrchestraFunction.lhs Tutorial.lhs) AUTOTRACK = $(patsubst %, Interface/AutoTrack/%.lhs, \ ChartBar ChordChart ChordSymbol EventChart \ Instrument ScaleChart Style Transposeable) AUTOTRACK_PROG = $(patsubst %, src/Haskore/Interface/AutoTrack/%.lhs, \ Main Option) EXAMPLES = $(patsubst %, Example/%, \ Miscellaneous.lhs \ Ssf.lhs NewResolutions.lhs \ ChildSong6.lhs Kantate147.hs WhiteChristmas.hs \ SelfSim.lhs Fractal.hs Flip.hs Guitar.lhs) MODULES = $(BASICS) $(EXAMPLES) $(MIDI) $(CSOUND) $(AUTOTRACK) MODULEPATH = src # http://www.gnu.org/software/automake/manual/make/Syntax-of-Functions.html#Syntax-of-Functions colon:= : empty:= space:= $(empty) $(empty) # exclude installed versions of Haskore, because we want to use the local one HUGS_PACKAGE_PATH = \ {Hugs}/libraries:{Hugs}/packages/*:$(subst $(space),$(colon),$(patsubst %,/usr/local/lib/hugs/packages/%,event-list midi markov-chain non-negative special-functors data-accessor transformers monoid-transformer explicit-exception binary utility-ht)) # $(subst $(space),$(colon),$(patsubst %,{Hugs}/packages/%,event-list midi markov-chain non-negative record-access)) GHC_MODULES = $(patsubst %, src/%, $(MEDIA) \ Test/Equivalence.lhs Test/Suite.lhs) \ $(patsubst %, src/Haskore/%, \ $(MODULES) ) GHC_DEPENDS = $(GHC_MODULES) # names of literate modules after removing literary information UNLIT_MODULES = $(patsubst %.lhs, %.hs, $(patsubst %.hs, , $(GHC_MODULES))) # names of all modules without literary information HS_MODULES = $(patsubst %.lhs, %.hs, $(GHC_MODULES)) STDINTERFACES = base/base haskell-src/haskell-src QuickCheck/QuickCheck STDPACKAGES = base mtl haskell-src network hosc hsc3 QuickCheck HUnit GHC_OPTIONS = -Wall -odir$(OBJECT_DIR) -hidir$(INTERFACE_DIR) \ -i:$(MODULEPATH):src/Test # -threaded # -hide-package Haskore # ignore modules compiled and registered by Cabal HUGS_MODULES = $(patsubst %, src/%, $(MEDIA)) \ $(patsubst %, src/Haskore/%, $(MODULES)) TEX_FILES = $(patsubst %, src/Doc/%, \ Tutorial.tex Discussion.tex Introduction.tex Macros.tex Related.tex \ Pics/haskore.tex Pics/midi.tex) PICS = equiv poly PDF_PICS = $(patsubst %, src/Doc/Pics/%.pdf, $(PICS)) .INTERMEDIATE: $(UNLIT_MODULES) PlayTmp.hs .PHONY: all clean distclean cabal-configure cabal-build compile ghc-all ghci hugs playmidi \ pdf autotrack-ps doc \ test test-compile test-hugs testcases debug \ fluid all: compile clean: -(cd build && rm -f `find . -name "*.hi"` `find . -name "*.o"`) -rm -f $(UNLIT_MODULES) -rm -f src/Doc/Pics/*.pdf -rm -f Tutorial.* distclean: clean -rm -f dist/doc/Tutorial.pdf test: test-compile testcases pdf autotrack-ps cabal-haddock compile: hugs ghc-all autotrack test-compile: test-hugs ghc-all autotrack # disable optimization for GHC-6.4 and NewResolutions cabal-configure: runhaskell Setup.lhs configure --user --disable-optimization cabal-build: cabal-configure runhaskell Setup.lhs build cabal-haddock: cabal-configure runhaskell Setup.lhs haddock ghc-all: $(GHC_DEPENDS) -mkdir $(OBJECT_DIR) ghc --make $(GHC_OPTIONS) $(GHC_DEPENDS) # start ghci using compiled objects from Cabal's 'dist/build' directory ghci: cabal-build ghci +RTS -M256m -c30 -RTS -Wall \ -odirdist/build -hidirdist/build -i:$(MODULEPATH):src/Test # start ghci using compiled objects from 'build' directory ghci-custom: cabal-configure $(GHC_DEPENDS) ghci-quick ghci-quick: ghci +RTS -M256m -c30 -RTS $(GHC_OPTIONS) $(GHC_DEPENDS) hugs: $(HUGS_MODULES) # this version wouldn't stop on a failure :-( # echo ":quit" | hugs $(HUGS_MODULES) # this worked as long as most of the modules were Haskell 98 compliant # hugs -P:$(MODULEPATH) $(HUGS_MODULES) # for hugs version 2002-11 # hugs +N -98 -h1000000 -P:$(MODULEPATH) $(HUGS_MODULES) # for hugs version 2005-03 hugs -98 -h1000000 -P$(MODULEPATH):$(HUGS_PACKAGE_PATH) $(HUGS_MODULES) test-hugs: $(HUGS_MODULES) # hugs @echo "***** If in test mode, enter :q in order to continue. *****" hugs -98 -h1000000 -P$(MODULEPATH):$(HUGS_PACKAGE_PATH) $(HUGS_MODULES) doc: $(HS_MODULES) haddock -B /usr/lib/ghc -o docs/html --dump-interface=docs/haskore.haddock -h \ $(HS_MODULES) # $(patsubst %, --use-package=%, $(STDPACKAGES)) \ olddoc: $(HS_MODULES) haddock -o docs/html --dump-interface=docs/haskore.haddock -h \ $(patsubst %, -i /usr/local/share/ghc-6.2/html/libraries/%.haddock, $(STDINTERFACES)) \ $(HS_MODULES) %.hs: %.lhs unlit $< $@ pdf: $(TEX_FILES) $(PDF_PICS) $(GHC_MODULES) # src/Doc needed for Tutorial.bbl TEXINPUTS=src:src/Doc:$(TEXINPUTS) pdflatex $< mkindex Tutorial TEXINPUTS=src:src/Doc:$(TEXINPUTS) pdflatex $< # the directory should coincide with the one created by Cabal mkdir -p dist/doc cp Tutorial.pdf dist/doc/Tutorial.pdf %.pdf: %.eps epstopdf $< testcases: src/Test/Suite.lhs src/Test/Equivalence.lhs -rm $(OBJECT_DIR)/Main.o ghc --make $(GHC_OPTIONS) -o $(OBJECT_DIR)/test $< $(OBJECT_DIR)/test +RTS -M32m -c30 -RTS # runhugs +N -98 -h2000000 -P:$(MODULEPATH) Test/Suite.lhs flip: src/Haskore/Example/FlipTest.hs ghc $(GHC_OPTIONS) -O --make -o $@ $< # $@ | timidity -B8,9 - autotrack: $(AUTOTRACK_PROG) $(GHC_DEPENDS) -rm $(OBJECT_DIR)/Main.o ghc $(GHC_OPTIONS) -i:src/Haskore/Interface/AutoTrack/ -O --make -o $@ $< autotrack-ps: cd src/Haskore/Interface/AutoTrack/ && make doc playmidi: # install in NEdit menu: # cd haskore_dir/src/ ; make playmidi MODULE=% # doesn't work, because Hugs supports only one visible module at the prompt # echo TestMidi.testTimidity `xargs echo` | hugs +N -98 -h1000000 -P:$(MODULEPATH) Interface/MIDI/TestMidi.lhs $(MODULE) echo module Main where > PlayTmp.hs echo import TestMidi >> PlayTmp.hs MODULE_LHS=`basename $(MODULE) .lhs` && echo import `basename $$MODULE_LHS .hs` >> PlayTmp.hs echo main = TestMidi.testTimidity '('`xargs echo`')' >> PlayTmp.hs runhugs +N -98 -h1000000 -P:$(MODULEPATH) PlayTmp.hs # start fluidsynth as server # search fluidsynth port with pmidi -l # play MIDI files using pmidi -p 128:0 src/Test/MIDI/ChildSong6.mid fluid: fluidsynth --verbose /usr/share/sounds/sf2/Vintage_Dreams_Waves_v2.sf2 jack: jackd -d alsa -r 44100 -n 3 -d hw:0 & # better start jack separately and then run 'make fluidjack' # because otherwise fluidsynth starts jack itself but with inappropriate settings # There is a difference to fluidsynth of Suse 9.2: # If you simply start fluidsynth, it will report incoming MIDI messages, # but you do not hear anything. # It seems that you must connect fluidsynth to JACK manually. # You can list the available JACK ports with # jack_lsp # Cf. http://ubuntuforums.org/archive/index.php/t-480233.html fluidjack: (usleep 3000000; make fluidconnect) & fluidsynth -a jack --verbose /usr/share/sounds/sf2/Vintage_Dreams_Waves_v2.sf2 fluidconnect: jack_connect fluidsynth:left alsa_pcm:playback_1 jack_connect fluidsynth:tight alsa_pcm:playback_2 timidity: timidity -iA -B1,8 debug: echo $(GHC_DEPENDS) haskore-0.2.0.3/Readme0000644000000000000000000000422011754016452012617 0ustar0000000000000000 Haskore Music System -------------------- This is a revised and extended version of Haskore from http://darcs.haskell.org/haskore/ which evolved from the February 2000 release, available from: http://haskell.org/haskore/ The features are: - music can be composed by programming Haskell - the music is output into MIDI files, CSound, or SuperCollider, or even rendered to an audio stream with http://darcs.haskell.org/synthesizer/ - CSound instruments can generated by programming Haskell, as well - all modules can be used with GHC, and many of them with Hugs For more details, refer to the Tutorial. For installation we recommend Cabal. $ ./Setup.lhs configure --user $ ./Setup.lhs build $ ./Setup.lhs haddock $ ./Setup.lhs install This way you have a usable Haskore installation. However most modules are written in literate style with LaTeX markup. There are no Haddock comments. You can build a PDF file which introduces you to the internals of Haskore. However it got a bit out of sync over the time, many parts are now extracted into separate packages. You can build the documentation using $ make pdf . Certainly you will want to try some examples. To this end you must have installed CSound or a MIDI player, respectively. $ make ghci # interactive session in GHC or $ make hugs # interactive session in Hugs ... *Main> :load Haskore.Interface.CSound.Tutorial ... *Haskore.Interface.CSound.Tutorial> test tut13 ... *Main> :load Haskore.Interface.MIDI.Render Haskore.Example.ChildSong6 ... *Haskore.Interface.MIDI.Render> playTimidity Haskore.Example.ChildSong6.song ... You can choose other MIDI players. Type *Haskore.Interface.MIDI.Render> :browse Haskore.Interface.MIDI.Render to see the alternatives. If you like to play via SuperCollider, install the haskore-supercollider package from http://darcs.haskell.org/haskore-supercollider and continue with its Readme file. Send requests, questions and comments to the original author of Haskore: Paul Hudak and the reviser: Henning Thielemann and for more discussion: http://lists.lurk.org/mailman/listinfo/haskell-art haskore-0.2.0.3/Setup.lhs0000644000000000000000000000011511754016452013306 0ustar0000000000000000#! /usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain haskore-0.2.0.3/haskore.cabal0000644000000000000000000001221611754016452014123 0ustar0000000000000000Name: haskore Version: 0.2.0.3 License: GPL License-File: LICENSE Author: Paul Hudak , Henning Thielemann Maintainer: Henning Thielemann Homepage: http://www.haskell.org/haskellwiki/Haskore Category: Sound, Music Synopsis: The Haskore Computer Music System Stability: Experimental Description: Compose music using programming features. Output in MIDI, CSound, SuperCollider or as an audio signal. Tested-With: GHC==6.8.2, GHC==6.10.4, GHC==6.12.3, Hugs==2006.9 Cabal-Version: >=1.6 Build-Type: Simple Extra-Source-Files: Makefile Readme src/Doc/Macros.tex src/Doc/Related.tex src/Doc/Discussion.tex src/Doc/Introduction.tex src/Doc/Tutorial.tex src/Doc/Tutorial.bbl src/Doc/Pics/equiv.eps src/Doc/Pics/haskore.tex src/Doc/Pics/midi.tex src/Doc/Pics/poly.eps src/Test/CSound/Makefile src/Test/MIDI/Makefile src/Haskore.lhs Source-Repository head type: darcs location: http://code.haskell.org/haskore/revised/core Source-Repository this type: darcs location: http://code.haskell.org/haskore/revised/core tag: 0.2.0.3 Flag splitBase description: Choose the new smaller, split-up base package. Flag buildTests description: Build test executables default: False Library Build-Depends: markov-chain >=0.0.1 && <0.1, midi >=0.2 && <0.3, event-list >=0.1 && <0.2, non-negative >=0.1 && <0.2, data-accessor >=0.2 && <0.3, utility-ht >=0.0.3 && <0.1, transformers >=0.0.1 && <0.4, bytestring >=0.9 && <0.11, haskell-src >=1.0 && <1.1, parsec >=2.1 && <3.2 If flag(splitBase) Build-Depends: base >=3 && <6, array >=0.1 && <1.0, containers >=0.1 && <1.0, random >=1.0 && <2.0, process >=1.0 && <1.2 Else Build-Depends: base >= 1.0 && < 2, special-functors >=1.0 && <1.1 GHC-Options: -Wall -- with GHC-6.4.1 and option -O2 the compilation of NewResolution needs too much heap, thus swapping Hs-Source-Dirs: src Exposed-Modules: Haskore.Basic.Duration Haskore.Basic.Dynamics Haskore.Basic.Interval Haskore.Basic.Pitch Haskore.Basic.Scale Haskore.Basic.Tempo Haskore.Composition.Chord Haskore.Composition.ChordType Haskore.Composition.Drum Haskore.Composition.Rhythm Haskore.Composition.Trill Haskore.Example.BesondrerTag Haskore.Example.ChildSong6 Haskore.Example.Detail Haskore.Example.Flip Haskore.Example.Fractal Haskore.Example.Guitar Haskore.Example.HeilandHimmel Haskore.Example.Kantate147 Haskore.Example.Miscellaneous Haskore.Example.NewResolutions Haskore.Example.Raenzlein Haskore.Example.SelfSim Haskore.Example.Ssf Haskore.Example.WhiteChristmas Haskore.Interface.AutoTrack.ChartBar Haskore.Interface.AutoTrack.ChordChart Haskore.Interface.AutoTrack.ChordSymbol Haskore.Interface.AutoTrack.EventChart Haskore.Interface.AutoTrack.Instrument Haskore.Interface.AutoTrack.ScaleChart Haskore.Interface.AutoTrack.Style Haskore.Interface.AutoTrack.Transposeable Haskore.Interface.CSound Haskore.Interface.CSound.Generator Haskore.Interface.CSound.InstrumentMap Haskore.Interface.CSound.Note Haskore.Interface.CSound.Orchestra Haskore.Interface.CSound.OrchestraFunction Haskore.Interface.CSound.Score Haskore.Interface.CSound.SoundMap Haskore.Interface.CSound.Tutorial Haskore.Interface.CSound.TutorialCustom -- needs 'parsec' package Haskore.Interface.MED.Text Haskore.Interface.MIDI Haskore.Interface.MIDI.InstrumentMap Haskore.Interface.MIDI.Note Haskore.Interface.MIDI.Read Haskore.Interface.MIDI.Render Haskore.Interface.MIDI.Write Haskore.Interface.MML Haskore.Melody Haskore.Melody.Standard Haskore.Music Haskore.Music.GeneralMIDI Haskore.Music.Rhythmic Haskore.Music.Standard Haskore.Performance Haskore.Performance.BackEnd Haskore.Performance.Context Haskore.Performance.Player Haskore.Performance.Default Haskore.Performance.Fancy Haskore.Process.Format Haskore.Process.Optimization Medium Medium.Temporal Medium.Plain.Binary Medium.Plain.List Medium.Plain.ContextFreeGrammar Medium.Controlled Medium.Controlled.List Medium.Controlled.ContextFreeGrammar Medium.LabeledControlled.List Other-Modules: Haskore.General.LoopTreeRecursive Haskore.General.LoopTreeRecursiveGen Haskore.General.LoopTreeTagged Haskore.General.LoopTreeTaggedGen Haskore.General.GraphRecursiveGen Haskore.General.GraphTaggedGen Haskore.General.LetRec Haskore.General.Map Haskore.General.TagDictionary Haskore.General.Utility Executable test If flag(buildTests) Build-Depends: QuickCheck >=1 && <2, HUnit >=1.2 && <1.3 Else Buildable: False Hs-Source-Dirs: src, src/Test Main-Is: Suite.lhs Other-Modules: Equivalence Executable autotrack Hs-Source-Dirs: src, src/Haskore/Interface/AutoTrack Main-Is: Haskore/Interface/AutoTrack/Main.lhs Other-Modules: Haskore.Interface.AutoTrack.Option haskore-0.2.0.3/LICENSE0000644000000000000000000010451311754016452012512 0ustar0000000000000000 GNU GENERAL PUBLIC LICENSE Version 3, 29 June 2007 Copyright (C) 2007 Free Software Foundation, Inc. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The GNU General Public License is a free, copyleft license for software and other kinds of works. The licenses for most software and other practical works are designed to take away your freedom to share and change the works. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change all versions of a program--to make sure it remains free software for all its users. We, the Free Software Foundation, use the GNU General Public License for most of our software; it applies also to any other work released this way by its authors. You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for them if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs, and that you know you can do these things. To protect your rights, we need to prevent others from denying you these rights or asking you to surrender the rights. Therefore, you have certain responsibilities if you distribute copies of the software, or if you modify it: responsibilities to respect the freedom of others. For example, if you distribute copies of such a program, whether gratis or for a fee, you must pass on to the recipients the same freedoms that you received. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. Developers that use the GNU GPL protect your rights with two steps: (1) assert copyright on the software, and (2) offer you this License giving you legal permission to copy, distribute and/or modify it. For the developers' and authors' protection, the GPL clearly explains that there is no warranty for this free software. For both users' and authors' sake, the GPL requires that modified versions be marked as changed, so that their problems will not be attributed erroneously to authors of previous versions. Some devices are designed to deny users access to install or run modified versions of the software inside them, although the manufacturer can do so. This is fundamentally incompatible with the aim of protecting users' freedom to change the software. The systematic pattern of such abuse occurs in the area of products for individuals to use, which is precisely where it is most unacceptable. Therefore, we have designed this version of the GPL to prohibit the practice for those products. If such problems arise substantially in other domains, we stand ready to extend this provision to those domains in future versions of the GPL, as needed to protect the freedom of users. Finally, every program is threatened constantly by software patents. States should not allow patents to restrict development and use of software on general-purpose computers, but in those that do, we wish to avoid the special danger that patents applied to a free program could make it effectively proprietary. To prevent this, the GPL assures that patents cannot be used to render the program non-free. The precise terms and conditions for copying, distribution and modification follow. TERMS AND CONDITIONS 0. Definitions. "This License" refers to version 3 of the GNU General Public License. "Copyright" also means copyright-like laws that apply to other kinds of works, such as semiconductor masks. "The Program" refers to any copyrightable work licensed under this License. Each licensee is addressed as "you". "Licensees" and "recipients" may be individuals or organizations. To "modify" a work means to copy from or adapt all or part of the work in a fashion requiring copyright permission, other than the making of an exact copy. The resulting work is called a "modified version" of the earlier work or a work "based on" the earlier work. A "covered work" means either the unmodified Program or a work based on the Program. To "propagate" a work means to do anything with it that, without permission, would make you directly or secondarily liable for infringement under applicable copyright law, except executing it on a computer or modifying a private copy. Propagation includes copying, distribution (with or without modification), making available to the public, and in some countries other activities as well. To "convey" a work means any kind of propagation that enables other parties to make or receive copies. Mere interaction with a user through a computer network, with no transfer of a copy, is not conveying. An interactive user interface displays "Appropriate Legal Notices" to the extent that it includes a convenient and prominently visible feature that (1) displays an appropriate copyright notice, and (2) tells the user that there is no warranty for the work (except to the extent that warranties are provided), that licensees may convey the work under this License, and how to view a copy of this License. If the interface presents a list of user commands or options, such as a menu, a prominent item in the list meets this criterion. 1. Source Code. The "source code" for a work means the preferred form of the work for making modifications to it. "Object code" means any non-source form of a work. A "Standard Interface" means an interface that either is an official standard defined by a recognized standards body, or, in the case of interfaces specified for a particular programming language, one that is widely used among developers working in that language. The "System Libraries" of an executable work include anything, other than the work as a whole, that (a) is included in the normal form of packaging a Major Component, but which is not part of that Major Component, and (b) serves only to enable use of the work with that Major Component, or to implement a Standard Interface for which an implementation is available to the public in source code form. A "Major Component", in this context, means a major essential component (kernel, window system, and so on) of the specific operating system (if any) on which the executable work runs, or a compiler used to produce the work, or an object code interpreter used to run it. The "Corresponding Source" for a work in object code form means all the source code needed to generate, install, and (for an executable work) run the object code and to modify the work, including scripts to control those activities. However, it does not include the work's System Libraries, or general-purpose tools or generally available free programs which are used unmodified in performing those activities but which are not part of the work. For example, Corresponding Source includes interface definition files associated with source files for the work, and the source code for shared libraries and dynamically linked subprograms that the work is specifically designed to require, such as by intimate data communication or control flow between those subprograms and other parts of the work. The Corresponding Source need not include anything that users can regenerate automatically from other parts of the Corresponding Source. The Corresponding Source for a work in source code form is that same work. 2. Basic Permissions. All rights granted under this License are granted for the term of copyright on the Program, and are irrevocable provided the stated conditions are met. This License explicitly affirms your unlimited permission to run the unmodified Program. The output from running a covered work is covered by this License only if the output, given its content, constitutes a covered work. This License acknowledges your rights of fair use or other equivalent, as provided by copyright law. You may make, run and propagate covered works that you do not convey, without conditions so long as your license otherwise remains in force. You may convey covered works to others for the sole purpose of having them make modifications exclusively for you, or provide you with facilities for running those works, provided that you comply with the terms of this License in conveying all material for which you do not control copyright. Those thus making or running the covered works for you must do so exclusively on your behalf, under your direction and control, on terms that prohibit them from making any copies of your copyrighted material outside their relationship with you. Conveying under any other circumstances is permitted solely under the conditions stated below. Sublicensing is not allowed; section 10 makes it unnecessary. 3. Protecting Users' Legal Rights From Anti-Circumvention Law. No covered work shall be deemed part of an effective technological measure under any applicable law fulfilling obligations under article 11 of the WIPO copyright treaty adopted on 20 December 1996, or similar laws prohibiting or restricting circumvention of such measures. When you convey a covered work, you waive any legal power to forbid circumvention of technological measures to the extent such circumvention is effected by exercising rights under this License with respect to the covered work, and you disclaim any intention to limit operation or modification of the work as a means of enforcing, against the work's users, your or third parties' legal rights to forbid circumvention of technological measures. 4. Conveying Verbatim Copies. You may convey verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice; keep intact all notices stating that this License and any non-permissive terms added in accord with section 7 apply to the code; keep intact all notices of the absence of any warranty; and give all recipients a copy of this License along with the Program. You may charge any price or no price for each copy that you convey, and you may offer support or warranty protection for a fee. 5. Conveying Modified Source Versions. You may convey a work based on the Program, or the modifications to produce it from the Program, in the form of source code under the terms of section 4, provided that you also meet all of these conditions: a) The work must carry prominent notices stating that you modified it, and giving a relevant date. b) The work must carry prominent notices stating that it is released under this License and any conditions added under section 7. This requirement modifies the requirement in section 4 to "keep intact all notices". c) You must license the entire work, as a whole, under this License to anyone who comes into possession of a copy. This License will therefore apply, along with any applicable section 7 additional terms, to the whole of the work, and all its parts, regardless of how they are packaged. This License gives no permission to license the work in any other way, but it does not invalidate such permission if you have separately received it. d) If the work has interactive user interfaces, each must display Appropriate Legal Notices; however, if the Program has interactive interfaces that do not display Appropriate Legal Notices, your work need not make them do so. A compilation of a covered work with other separate and independent works, which are not by their nature extensions of the covered work, and which are not combined with it such as to form a larger program, in or on a volume of a storage or distribution medium, is called an "aggregate" if the compilation and its resulting copyright are not used to limit the access or legal rights of the compilation's users beyond what the individual works permit. Inclusion of a covered work in an aggregate does not cause this License to apply to the other parts of the aggregate. 6. Conveying Non-Source Forms. You may convey a covered work in object code form under the terms of sections 4 and 5, provided that you also convey the machine-readable Corresponding Source under the terms of this License, in one of these ways: a) Convey the object code in, or embodied in, a physical product (including a physical distribution medium), accompanied by the Corresponding Source fixed on a durable physical medium customarily used for software interchange. b) Convey the object code in, or embodied in, a physical product (including a physical distribution medium), accompanied by a written offer, valid for at least three years and valid for as long as you offer spare parts or customer support for that product model, to give anyone who possesses the object code either (1) a copy of the Corresponding Source for all the software in the product that is covered by this License, on a durable physical medium customarily used for software interchange, for a price no more than your reasonable cost of physically performing this conveying of source, or (2) access to copy the Corresponding Source from a network server at no charge. c) Convey individual copies of the object code with a copy of the written offer to provide the Corresponding Source. This alternative is allowed only occasionally and noncommercially, and only if you received the object code with such an offer, in accord with subsection 6b. d) Convey the object code by offering access from a designated place (gratis or for a charge), and offer equivalent access to the Corresponding Source in the same way through the same place at no further charge. You need not require recipients to copy the Corresponding Source along with the object code. If the place to copy the object code is a network server, the Corresponding Source may be on a different server (operated by you or a third party) that supports equivalent copying facilities, provided you maintain clear directions next to the object code saying where to find the Corresponding Source. Regardless of what server hosts the Corresponding Source, you remain obligated to ensure that it is available for as long as needed to satisfy these requirements. e) Convey the object code using peer-to-peer transmission, provided you inform other peers where the object code and Corresponding Source of the work are being offered to the general public at no charge under subsection 6d. A separable portion of the object code, whose source code is excluded from the Corresponding Source as a System Library, need not be included in conveying the object code work. A "User Product" is either (1) a "consumer product", which means any tangible personal property which is normally used for personal, family, or household purposes, or (2) anything designed or sold for incorporation into a dwelling. In determining whether a product is a consumer product, doubtful cases shall be resolved in favor of coverage. For a particular product received by a particular user, "normally used" refers to a typical or common use of that class of product, regardless of the status of the particular user or of the way in which the particular user actually uses, or expects or is expected to use, the product. A product is a consumer product regardless of whether the product has substantial commercial, industrial or non-consumer uses, unless such uses represent the only significant mode of use of the product. "Installation Information" for a User Product means any methods, procedures, authorization keys, or other information required to install and execute modified versions of a covered work in that User Product from a modified version of its Corresponding Source. The information must suffice to ensure that the continued functioning of the modified object code is in no case prevented or interfered with solely because modification has been made. If you convey an object code work under this section in, or with, or specifically for use in, a User Product, and the conveying occurs as part of a transaction in which the right of possession and use of the User Product is transferred to the recipient in perpetuity or for a fixed term (regardless of how the transaction is characterized), the Corresponding Source conveyed under this section must be accompanied by the Installation Information. But this requirement does not apply if neither you nor any third party retains the ability to install modified object code on the User Product (for example, the work has been installed in ROM). The requirement to provide Installation Information does not include a requirement to continue to provide support service, warranty, or updates for a work that has been modified or installed by the recipient, or for the User Product in which it has been modified or installed. Access to a network may be denied when the modification itself materially and adversely affects the operation of the network or violates the rules and protocols for communication across the network. Corresponding Source conveyed, and Installation Information provided, in accord with this section must be in a format that is publicly documented (and with an implementation available to the public in source code form), and must require no special password or key for unpacking, reading or copying. 7. Additional Terms. "Additional permissions" are terms that supplement the terms of this License by making exceptions from one or more of its conditions. Additional permissions that are applicable to the entire Program shall be treated as though they were included in this License, to the extent that they are valid under applicable law. If additional permissions apply only to part of the Program, that part may be used separately under those permissions, but the entire Program remains governed by this License without regard to the additional permissions. When you convey a copy of a covered work, you may at your option remove any additional permissions from that copy, or from any part of it. (Additional permissions may be written to require their own removal in certain cases when you modify the work.) You may place additional permissions on material, added by you to a covered work, for which you have or can give appropriate copyright permission. Notwithstanding any other provision of this License, for material you add to a covered work, you may (if authorized by the copyright holders of that material) supplement the terms of this License with terms: a) Disclaiming warranty or limiting liability differently from the terms of sections 15 and 16 of this License; or b) Requiring preservation of specified reasonable legal notices or author attributions in that material or in the Appropriate Legal Notices displayed by works containing it; or c) Prohibiting misrepresentation of the origin of that material, or requiring that modified versions of such material be marked in reasonable ways as different from the original version; or d) Limiting the use for publicity purposes of names of licensors or authors of the material; or e) Declining to grant rights under trademark law for use of some trade names, trademarks, or service marks; or f) Requiring indemnification of licensors and authors of that material by anyone who conveys the material (or modified versions of it) with contractual assumptions of liability to the recipient, for any liability that these contractual assumptions directly impose on those licensors and authors. All other non-permissive additional terms are considered "further restrictions" within the meaning of section 10. If the Program as you received it, or any part of it, contains a notice stating that it is governed by this License along with a term that is a further restriction, you may remove that term. If a license document contains a further restriction but permits relicensing or conveying under this License, you may add to a covered work material governed by the terms of that license document, provided that the further restriction does not survive such relicensing or conveying. If you add terms to a covered work in accord with this section, you must place, in the relevant source files, a statement of the additional terms that apply to those files, or a notice indicating where to find the applicable terms. Additional terms, permissive or non-permissive, may be stated in the form of a separately written license, or stated as exceptions; the above requirements apply either way. 8. Termination. You may not propagate or modify a covered work except as expressly provided under this License. Any attempt otherwise to propagate or modify it is void, and will automatically terminate your rights under this License (including any patent licenses granted under the third paragraph of section 11). However, if you cease all violation of this License, then your license from a particular copyright holder is reinstated (a) provisionally, unless and until the copyright holder explicitly and finally terminates your license, and (b) permanently, if the copyright holder fails to notify you of the violation by some reasonable means prior to 60 days after the cessation. Moreover, your license from a particular copyright holder is reinstated permanently if the copyright holder notifies you of the violation by some reasonable means, this is the first time you have received notice of violation of this License (for any work) from that copyright holder, and you cure the violation prior to 30 days after your receipt of the notice. Termination of your rights under this section does not terminate the licenses of parties who have received copies or rights from you under this License. If your rights have been terminated and not permanently reinstated, you do not qualify to receive new licenses for the same material under section 10. 9. Acceptance Not Required for Having Copies. You are not required to accept this License in order to receive or run a copy of the Program. Ancillary propagation of a covered work occurring solely as a consequence of using peer-to-peer transmission to receive a copy likewise does not require acceptance. However, nothing other than this License grants you permission to propagate or modify any covered work. These actions infringe copyright if you do not accept this License. Therefore, by modifying or propagating a covered work, you indicate your acceptance of this License to do so. 10. Automatic Licensing of Downstream Recipients. Each time you convey a covered work, the recipient automatically receives a license from the original licensors, to run, modify and propagate that work, subject to this License. You are not responsible for enforcing compliance by third parties with this License. An "entity transaction" is a transaction transferring control of an organization, or substantially all assets of one, or subdividing an organization, or merging organizations. If propagation of a covered work results from an entity transaction, each party to that transaction who receives a copy of the work also receives whatever licenses to the work the party's predecessor in interest had or could give under the previous paragraph, plus a right to possession of the Corresponding Source of the work from the predecessor in interest, if the predecessor has it or can get it with reasonable efforts. You may not impose any further restrictions on the exercise of the rights granted or affirmed under this License. For example, you may not impose a license fee, royalty, or other charge for exercise of rights granted under this License, and you may not initiate litigation (including a cross-claim or counterclaim in a lawsuit) alleging that any patent claim is infringed by making, using, selling, offering for sale, or importing the Program or any portion of it. 11. Patents. A "contributor" is a copyright holder who authorizes use under this License of the Program or a work on which the Program is based. The work thus licensed is called the contributor's "contributor version". A contributor's "essential patent claims" are all patent claims owned or controlled by the contributor, whether already acquired or hereafter acquired, that would be infringed by some manner, permitted by this License, of making, using, or selling its contributor version, but do not include claims that would be infringed only as a consequence of further modification of the contributor version. For purposes of this definition, "control" includes the right to grant patent sublicenses in a manner consistent with the requirements of this License. Each contributor grants you a non-exclusive, worldwide, royalty-free patent license under the contributor's essential patent claims, to make, use, sell, offer for sale, import and otherwise run, modify and propagate the contents of its contributor version. In the following three paragraphs, a "patent license" is any express agreement or commitment, however denominated, not to enforce a patent (such as an express permission to practice a patent or covenant not to sue for patent infringement). To "grant" such a patent license to a party means to make such an agreement or commitment not to enforce a patent against the party. If you convey a covered work, knowingly relying on a patent license, and the Corresponding Source of the work is not available for anyone to copy, free of charge and under the terms of this License, through a publicly available network server or other readily accessible means, then you must either (1) cause the Corresponding Source to be so available, or (2) arrange to deprive yourself of the benefit of the patent license for this particular work, or (3) arrange, in a manner consistent with the requirements of this License, to extend the patent license to downstream recipients. "Knowingly relying" means you have actual knowledge that, but for the patent license, your conveying the covered work in a country, or your recipient's use of the covered work in a country, would infringe one or more identifiable patents in that country that you have reason to believe are valid. If, pursuant to or in connection with a single transaction or arrangement, you convey, or propagate by procuring conveyance of, a covered work, and grant a patent license to some of the parties receiving the covered work authorizing them to use, propagate, modify or convey a specific copy of the covered work, then the patent license you grant is automatically extended to all recipients of the covered work and works based on it. A patent license is "discriminatory" if it does not include within the scope of its coverage, prohibits the exercise of, or is conditioned on the non-exercise of one or more of the rights that are specifically granted under this License. You may not convey a covered work if you are a party to an arrangement with a third party that is in the business of distributing software, under which you make payment to the third party based on the extent of your activity of conveying the work, and under which the third party grants, to any of the parties who would receive the covered work from you, a discriminatory patent license (a) in connection with copies of the covered work conveyed by you (or copies made from those copies), or (b) primarily for and in connection with specific products or compilations that contain the covered work, unless you entered into that arrangement, or that patent license was granted, prior to 28 March 2007. Nothing in this License shall be construed as excluding or limiting any implied license or other defenses to infringement that may otherwise be available to you under applicable patent law. 12. No Surrender of Others' Freedom. If conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot convey a covered work so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not convey it at all. For example, if you agree to terms that obligate you to collect a royalty for further conveying from those to whom you convey the Program, the only way you could satisfy both those terms and this License would be to refrain entirely from conveying the Program. 13. Use with the GNU Affero General Public License. Notwithstanding any other provision of this License, you have permission to link or combine any covered work with a work licensed under version 3 of the GNU Affero General Public License into a single combined work, and to convey the resulting work. The terms of this License will continue to apply to the part which is the covered work, but the special requirements of the GNU Affero General Public License, section 13, concerning interaction through a network will apply to the combination as such. 14. Revised Versions of this License. The Free Software Foundation may publish revised and/or new versions of the GNU General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies that a certain numbered version of the GNU General Public License "or any later version" applies to it, you have the option of following the terms and conditions either of that numbered version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the GNU General Public License, you may choose any version ever published by the Free Software Foundation. If the Program specifies that a proxy can decide which future versions of the GNU General Public License can be used, that proxy's public statement of acceptance of a version permanently authorizes you to choose that version for the Program. Later license versions may give you additional or different permissions. However, no additional obligations are imposed on any author or copyright holder as a result of your choosing to follow a later version. 15. Disclaimer of Warranty. THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. Limitation of Liability. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. 17. Interpretation of Sections 15 and 16. If the disclaimer of warranty and limitation of liability provided above cannot be given local legal effect according to their terms, reviewing courts shall apply local law that most closely approximates an absolute waiver of all civil liability in connection with the Program, unless a warranty or assumption of liability accompanies a copy of the Program in return for a fee. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively state the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . Also add information on how to contact you by electronic and paper mail. If the program does terminal interaction, make it output a short notice like this when it starts in an interactive mode: Copyright (C) This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, your program's commands might be different; for a GUI interface, you would use an "about box". You should also get your employer (if you work as a programmer) or school, if any, to sign a "copyright disclaimer" for the program, if necessary. For more information on this, and how to apply and follow the GNU GPL, see . The GNU General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Lesser General Public License instead of this License. But first, please read . haskore-0.2.0.3/src/0000755000000000000000000000000011754016452012270 5ustar0000000000000000haskore-0.2.0.3/src/Medium.hs0000644000000000000000000000417711754016452014055 0ustar0000000000000000module Medium where import qualified Medium.Temporal as Temporal infixr 7 +:+ {- like multiplication -} infixr 6 =:= {- like addition -} class Construct medium where prim :: a -> medium a {- for easy compatibility with Haskore 2000 songs replace :+: by +:+ and :=: by =:= -} (+:+), (=:=) :: medium a -> medium a -> medium a serial, parallel :: Temporal.C a => [medium a] -> medium a serial1, parallel1 :: [medium a] -> medium a class Construct medium => C medium where {- Do actions on each (virtual) constructor, don't recourse. -} switchBinary :: (a -> b) -> (medium a -> medium a -> b) -> (medium a -> medium a -> b) -> (b -> medium a -> b) switchList :: (a -> b) -> ([medium a] -> b) -> ([medium a] -> b) -> medium a -> b {- A variant of fmap that does not only allow manipulation of primitives but also of the compositions. Though the structure must be preserved. -} mapList :: (Temporal.C b, Medium.C medium) => (a->b) -> ([medium b]->[medium b]) -> ([medium b]->[medium b]) -> medium a -> medium b mapList f g h = foldList (prim . f) (serial . g) (parallel . h) mapListFlat :: (Temporal.C b, Medium.C medium) => (a -> b) -> ([medium a] -> [medium b]) -> ([medium a] -> [medium b]) -> medium a -> medium b mapListFlat f g h = switchList (prim . f) (serial . g) (parallel . h) {- This is even more general than mapList -} foldList :: Medium.C medium => (a->b) -> ([b]->b) -> ([b]->b) -> medium a -> b foldList f g h = let recourse = map (foldList f g h) in switchList f (g . recourse) (h . recourse) foldBin :: Medium.C medium => (a->b) -> (b->b->b) -> (b->b->b) -> b -> medium a -> b foldBin f g h z = -- foldList f (foldr1 g) (foldr1 h) -- this implementation preserves the structure of the binary tree let recourse op x y = foldBin f g h z x `op` foldBin f g h z y in switchBinary f (recourse g) (recourse h) z listMediumFromAny :: (Construct dst, C src, Temporal.C a) => src a -> dst a listMediumFromAny = foldList prim serial parallel binaryMediumFromAny :: (Construct dst, C src) => dst a -> src a -> dst a binaryMediumFromAny z = foldBin prim (+:+) (=:=) z haskore-0.2.0.3/src/Haskore.lhs0000644000000000000000000000754711754016452014411 0ustar0000000000000000\section{The Architecture of Haskore} \figref{haskore} shows the overall structure of Haskore. Note the independence of high level structures from the ``music platform'' on which Haskore runs. Originally, the goal was for Haskore compositions to run equally well as conventional midi-files \cite{midi}, NeXT MusicKit score files \cite{musickit} \footnote{The NeXT music platform is obsolete.}, and CSound score files \cite{csound} \footnote{There also exists a translation to CSound for an earlier version of Haskore.}, and for Haskore compositions to be displayed and printed in traditional notation using the CMN (Common Music Notation) subsystem. \footnote{We have abandoned CMN entirely, as there are now better candidates for notation packages into which Haskore could be mapped.} In reality, three platforms are currently supported: MIDI, CSound, and some signal processing routines written in Haskell. For musical notation an interface to Lilypond is currently in progress. \begin{figure*} \centerline{ \input{Doc/Pics/haskore.tex} } \caption{Overall System Diagram} \figlabel{haskore} \end{figure*} In any case, the independence of abstract musical ideas from the concrete rendering platform is accomplished by having abstract notions of \keyword{musical object}, \keyword{player}, \keyword{instrument}, and \keyword{performance}. All of this resides in the box labeled ``Haskore'' in the diagram above. At the module level, Haskore is organized as follows: \begin{haskelllisting} > module Haskore ( > module Haskore.Music, > module Haskore.Performance, > module Haskore.Performance.Player, > module Haskore.Interface.MIDI.Write, > module Haskore.Interface.MIDI.Read, > module Haskore.Interface.MIDI.Render, > module Sound.MIDI.File.Save, > module Sound.MIDI.File.Load, > ) where > > import qualified Haskore.Music > import qualified Haskore.Performance > import qualified Haskore.Performance.Player > import qualified Haskore.Interface.MIDI.Write > import qualified Haskore.Interface.MIDI.Read > import qualified Haskore.Interface.MIDI.Render > import qualified Sound.MIDI.File.Save > import qualified Sound.MIDI.File.Load \end{haskelllisting} \begin{comment} > import Prelude hiding (repeat, reverse) \end{comment} This document was written in the \keyword{literate programming style}, and thus the \LaTeX\ manuscript file from which it was generated is an \keyword{executable Haskell program}. It can be compiled under \LaTeX\ in two ways: a basic mode provides all of the functionality that most users will need, and an extended mode in which various pieces of lower-level code are provided and documented as well (see file header for details). This version was compiled in \basic{basic}\extended{extended} mode. The document can be retrieved via WWW from: \url{http://haskell.org/haskore/} (consult the README file for details). It is also delivered with the standard joint Nottingham/Yale Hugs release. The Haskore code conforms to Haskell 1.4, and has been tested under the June, 1998 release of Hugs 1.4. Unfortunately Hugs does not yet support mutually recursive modules, so all references to the \module{Player} in this document are commented out, which in effect makes it part of \module{Performance} (with which it is mutually recursive). A final word before beginning: As various musical ideas are presented in this Haskore tutorial, I urge the reader to question the design decisions that are made. There is no supreme theory of music that dictates my decisions, and what I present is actually one of several versions that I have developed over the years (this version is much richer than the one described in \cite{haskore}; it is the ``Haskore in practice'' version alluded to in \secref{midi} of that paper). I believe that this version is suitable for many practical purposes, but the reader may wish to modify it to better satisfy her intuitions and/or application. haskore-0.2.0.3/src/Haskore/0000755000000000000000000000000011754016451013663 5ustar0000000000000000haskore-0.2.0.3/src/Haskore/Performance.lhs0000644000000000000000000003243211754016451016640 0ustar0000000000000000\subsection{Interpretation and Performance} \seclabel{performance} % import Player \begin{haskelllisting} > module Haskore.Performance where > > import Haskore.Music(PlayerName, PhraseAttribute) > import qualified Haskore.Basic.Duration as Dur > import qualified Haskore.Basic.Pitch as Pitch > import qualified Haskore.Music as Music > import qualified Data.EventList.Relative.TimeBody as TimeList > import qualified Data.EventList.Relative.TimeTime as TimeListPad > import qualified Data.EventList.Relative.TimeMixed as TimeListPad > import qualified Numeric.NonNegative.Class as NonNeg > import Haskore.General.Utility (maximum0, ) > import Data.Tuple.HT (mapPair, ) > import qualified Data.Record.HT as Record > import Data.Ord.HT (comparing, ) > import Control.Monad.Trans.Reader (Reader, runReader, ask, asks, local, ) > import Control.Applicative(WrappedMonad(WrapMonad), unwrapMonad, ) > import Data.Traversable(sequenceA) > import Data.List (foldl') > import Prelude hiding (Monad) \end{haskelllisting} Now that we have defined the structure of musical objects, let us turn to the issue of \keyword{performance}, which we define as a temporally ordered sequence of musical \keyword{events}: \begin{haskelllisting} > type T time dyn note = TimeList.T time (Event time dyn note) > type Padded time dyn note = TimeListPad.T time (Event time dyn note) \end{haskelllisting} The \type{Padded} performance has a trailing time value. It can be considered as the duration after the last event after which the performance finishes. This need not to be the duration of the last event, as in the case, where the last note is a short one, that is played while an earlier long note remains playing. Another exception is a performance which ends with a rest. \begin{haskelllisting} > data Event time dyn note = > Event {eventDur :: time, > eventDynamics :: dyn, > eventTranspose :: Pitch.Relative, > eventNote :: note} > deriving (Eq, Show) > > -- this order is just for the old test cases which rely on it > instance (Ord time, Ord dyn, Ord note) => > Ord (Event time dyn note) where > compare = > Record.compare > [comparing eventNote, > comparing eventDynamics, > comparing eventTranspose, > comparing eventDur] \end{haskelllisting} An event is the lowest of our music representations not yet committed to Midi, CSound, or the MusicKit. An event \code{Event \{eventDur = d, eventNote = n\}} captures the fact that the note \code{n} respecting all its attributes is played for a duration \code{d} (where now duration is measured in seconds, rather than beats). We introduce the type variables \type{time} and \type{dyn} here which are used for time and dynamics quantities. For every-day use where only efficiency counts you will infer these type variables with \type{Float} or \type{Double}. For testing the validity of axioms (see \secref{equivalence}) we need exact computation which can be achieved with \type{Rational}. To generate a complete performance of, i.e.\ give an interpretation to, a musical object, we must know the time to begin the performance, and the proper volume, key and tempo. We must also know what \keyword{player}s to use; that is, we need a mapping from the \code{PlayerName}s in an abstract musical object to the actual players to be used. (We don't yet need a mapping from abstract \code{Instr}s to instruments, since this is handled in the translation from a performance into, say, Midi, such as defined in \secref{midi}.) We can thus model a performer as a function \code{fromMusic} which maps all of this information and a musical object into a performance: \begin{haskelllisting} > fromMusic :: > (NonNeg.C time, RealFrac time, Ord dyn, Fractional dyn, Ord note) => > PlayerMap time dyn note -> Context time dyn note -> Music.T note -> T time dyn note > > type PlayerMap time dyn note = PlayerName -> Player time dyn note > data Context time dyn note = > Context {contextDur :: time, > contextPlayer :: Player time dyn note, > contextTranspose :: Pitch.Relative, > contextDynamics :: dyn} > deriving Show > type UpdateContext time dyn note a = > (a -> a) -> Context time dyn note -> Context time dyn note > > updatePlayer :: UpdateContext time dyn note (Player time dyn note) > updatePlayer f c = c {contextPlayer = f (contextPlayer c)} > updateDur :: UpdateContext time dyn note time > updateDur f c = c {contextDur = f (contextDur c)} > updateTranspose :: UpdateContext time dyn note Pitch.Relative > updateTranspose f c = c {contextTranspose = f (contextTranspose c)} > updateDynamics :: UpdateContext time dyn note dyn > updateDynamics f c = c {contextDynamics = f (contextDynamics c)} fromMusic pmap c@Context {contextStart = t, contextPlayer = pl, contextDur = dt, contextTranspose = k} m = case m of Note p d nas -> playNote pl c p d nas Rest d -> [] m1 :+: m2 -> fromMusic pmap c m1 ++ fromMusic pmap (c {contextStart = t + dur m1 * dt}) m2 m1 :=: m2 -> merge (fromMusic pmap c m1) (fromMusic pmap c m2) Tempo a m -> fromMusic pmap (c {contextDur = dt / fromRational a}) m Transpose p m -> fromMusic pmap (c {contextTranspose = k + p}) m Instrument nm m -> fromMusic pmap (c {cInst = nm}) m Player nm m -> fromMusic pmap (c {contextPlayer = pmap nm}) m Phrase pas m -> interpretPhrase pl pmap c pas m \end{haskelllisting} \begin{figure} \begin{haskelllisting} > fromMusic pmap c = fst . TimeListPad.viewTimeR . paddedFromMusic pmap c > > paddedFromMusic :: > (NonNeg.C time, RealFrac time, Ord dyn, Fractional dyn, Ord note) => > PlayerMap time dyn note -> Context time dyn note -> > Music.T note -> Padded time dyn note > paddedFromMusic pmap c = > TimeListPad.catMaybes . fst . flip runReader c . monadFromMusic pmap > > type PaddedWithRests time dyn note = > TimeListPad.T time (Maybe (Event time dyn note)) > > type Monad time dyn note = > Reader > (Context time dyn note) > (PaddedWithRests time dyn note, time) > sequenceReader :: [Reader r a] -> Reader r [a] > sequenceReader = unwrapMonad . sequenceA . map WrapMonad > combine :: > ([performance] -> performance, [time] -> time) -> > [Reader r (performance, time)] -> > Reader r (performance, time) > combine f = > fmap (mapPair f . unzip) . sequenceReader > monadFromMusic :: > (NonNeg.C time, RealFrac time, Ord dyn, Fractional dyn, Ord note) => > PlayerMap time dyn note -> Music.T note -> Monad time dyn note > > monadFromMusic pmap = > Music.foldList > (\d at -> flip fmap ask $ \c -> > let noteDur = Dur.toNumber d * contextDur c > events = > maybe > (TimeList.singleton 0 Nothing) > (TimeList.mapBody Just . > playNote (contextPlayer c) c d) at > in (TimeListPad.snocTime events noteDur, noteDur)) > (\ctrl -> > case ctrl of > Music.Tempo a -> local (updateDur (/ Dur.toNumber a)) > Music.Transpose p -> local (updateTranspose (+ p)) > Music.Player nm -> local (updatePlayer (const (pmap nm))) > Music.Phrase pa -> \m -> > asks contextPlayer >>= \pl -> interpretPhrase pl pa m) > (combine (TimeListPad.concat, sum)) > (combine (foldl' TimeListPad.merge (TimeListPad.pause 0), maximum0)) This implementation fails on mel = a 0 wn () +:+ b 0 wn () =:= rest qn +:+ mel > {- this does only work if the performance in the Monad does not have a Maybe for each note > monadFromMusicOld :: (Ord time, Fractional time, Ord note) => > PlayerMap time dyn note -> Music.T note -> > Reader (Context time dyn note) (Padded time dyn note, time) > > monadFromMusicOld pmap = > Music.foldList > (\d at -> flip fmap ask $ \c -> > let noteDur = fromRational d * contextDur c > in ((case at of > Just note -> playNote (contextPlayer c) c d note > Nothing -> [], > noteDur), noteDur)) > (\ctrl -> > case ctrl of > Music.Tempo a -> local (updateDur (/ fromRational a)) > Music.Transpose p -> local (updateTranspose (+ p)) > Music.Player nm -> local (updatePlayer (const (pmap nm))) > Music.Phrase pa -> \m -> > asks contextPlayer >>= \pl -> interpretPhrase pl pa m ) > (combine (TimeListPad.concat, sum)) > (combine (foldl' TimeListPad.merge ([], 0), maximum0)) > -} \end{haskelllisting} \caption{The ``real'' \code{fromMusic} function.} \figlabel{real-fromMusic} \end{figure} Some things to note: \begin{enumerate} \item The function \function{monadFromMusic} does not simply convert a music object to a performance but it converts a music to an action (\type{Reader} monad). Given a context we can start the action by \function{runReader} and we get an event. The way \function{monadFromMusic} works is to build a big action from many small actions. \item The \code{Context} is the running ``state'' of the performance, and gets updated in several different ways. For example, the interpretation of the \code{Tempo} constructor involves scaling the duration of a whole note appropriately and updating the \code{contextDur} field of the context. It's better not to manipulate the members of \code{Context} directly, but to use the abstractions from \code{PerformanceContext}. This way we can stay independent of the concrete definition of \code{Context}. (I would like to define this data structure in \code{PerformanceContext} but the current Haskell compilers have a complicated handling of mutually dependent modules.) \item Interpretation of notes and phrases is player dependent. Ultimately a single note is played by the \code{playNote} function, which takes the player as an argument. Similarly, phrase interpretation is also player dependent, reflected in the use of \code{interpretPhrase}. Precisely how these two functions work is described in \secref{players}. \item The \code{Dur} component of the context is the duration, in seconds, of one whole note. See \secref{tempo} for assisting functions. \item In the treatment of \code{Serial}, note that the sub-sequences are appended together, with the start time of the second argument delayed by the duration of the first. The function \code{dur} (defined in \secref{basic-examples}) is used to compute this duration. Note that this results in a quadratic time complexity for \code{fromMusic}. A more efficient solution is to have \code{fromMusic} compute the duration directly, returning it as part of its result. This version of \code{fromMusic} is shown in \figref{real-fromMusic}. \item In contrast, the sub-sequences derived from the arguments to \code{Parallel} are merged into a time-ordered stream. This is done with \function{merge} from the module \module{Data.EventList.Relative.TimeTime}. \end{enumerate} % equivalence of musical values \input{Test/Equivalence.lhs} % this section should be moved to the Player module % as soon as the Haskell interpreters support mutually recursive modules \subsection{Players} \seclabel{players} In the last section we saw how a performance involved the notion of a \keyword{player}. The reason for this is the same as for real players and their instruments: many of the note and phrase attributes (see \secref{phrasing}) are player and instrument dependent. For example, how should ``legato'' be interpreted in a performance? Or ``diminuendo''? Different 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 a harpsichord are different concepts. With a slight stretch of the imagination, we can even consider a ``notator'' of a score as a kind of player: exactly how the music is rendered 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? In any case, to handle these issues, Haskore has a notion of a \keyword{player} which ``knows'' about differences with respect to performance and notation. A Haskore player is a 4-tuple consisting of a name and three functions: one for interpreting notes, one for phrases, and one for producing a properly notated score. \begin{haskelllisting} > data Player time dyn note = > PlayerCons { name :: PlayerName, > playNote :: NoteFun time dyn note, > interpretPhrase :: PhraseFun time dyn note, > notatePlayer :: NotateFun } > > instance (Show time, Show dyn) => Show (Player time dyn note) where > show p = "Player.cons " ++ name p > type NoteFun time dyn note = > Context time dyn note -> Music.Dur -> note -> T time dyn note > type PhraseFun time dyn note = > PhraseAttribute -> Monad time dyn note -> Monad time dyn note > type NotateFun = () \end{haskelllisting} The last line above is because notation is currently not implemented. Note that both \code{NotateFun} and \code{PhraseFun} functions return a \code{Performance.T}. haskore-0.2.0.3/src/Haskore/Melody.lhs0000644000000000000000000001051211754016451015623 0ustar0000000000000000\begin{haskelllisting} > module Haskore.Melody where > import Haskore.Basic.Pitch hiding (T) > import qualified Haskore.Basic.Pitch as Pitch > import qualified Haskore.Basic.Duration as Duration > import qualified Haskore.Music as Music > import Data.Tuple.HT (mapSnd, ) > import qualified Medium > import qualified Data.List as List > import Data.Maybe(fromMaybe) > import qualified Data.Accessor.Basic as Accessor > data Note attr = Note {noteAttrs_ :: attr, notePitch_ :: Pitch.T} > deriving (Show, Eq, Ord) > type T attr = Music.T (Note attr) > noteAttrs :: Accessor.T (Note attr) attr > noteAttrs = > Accessor.fromSetGet (\x n -> n{noteAttrs_ = x}) noteAttrs_ > > notePitch :: Accessor.T (Note attr) Pitch.T > notePitch = > Accessor.fromSetGet (\x n -> n{notePitch_ = x}) notePitch_ > toMelodyNullAttr :: T attr -> T () > toMelodyNullAttr = > Music.mapNote (\(Note _ p) -> Note () p) \end{haskelllisting} For convenience, let's create simple names for familiar notes (\figref{note-names}), durations, and rests (\figref{durations-rests}). Despite the large number of them, these names are sufficiently ``unusual'' that name clashes are unlikely. \begin{figure}{\small \begin{haskelllisting} > note :: Pitch.T -> Duration.T -> attr -> T attr > note p d' nas = Medium.prim (Music.Atom d' (Just (Note nas p))) > > note' :: Pitch.Class -> Pitch.Octave -> > Duration.T -> attr -> T attr > note' = flip (curry note) > > cf,c,cs,df,d,ds,ef,e,es,ff,f,fs,gf,g,gs,af,a,as,bf,b,bs :: > Pitch.Octave -> Duration.T -> attr -> T attr > > cf = note' Cf; c = note' C; cs = note' Cs > df = note' Df; d = note' D; ds = note' Ds > ef = note' Ef; e = note' E; es = note' Es > ff = note' Ff; f = note' F; fs = note' Fs > gf = note' Gf; g = note' G; gs = note' Gs > af = note' Af; a = note' A; as = note' As > bf = note' Bf; b = note' B; bs = note' Bs \end{haskelllisting} } \caption{Convenient note construction functions.} \figlabel{note-names} \end{figure} \begin{comment} > {- > o0, o1, o2, o3, o4, o5, o6, o7, o8, o9, > s0, s1, s2, s3, s4, s5, s6, s7, s8, s9 :: > (Octave -> Duration.T -> attr -> T note) > -> (Duration.T -> attr -> T note) > o0 n = n 0; s0 n = n (- 1) > o1 n = n 1; s1 n = n (- 2) > o2 n = n 2; s2 n = n (- 3) > o3 n = n 3; s3 n = n (- 4) > o4 n = n 4; s4 n = n (- 5) > o5 n = n 5; s5 n = n (- 6) > o6 n = n 6; s6 n = n (- 7) > o7 n = n 7; s7 n = n (- 8) > o8 n = n 8; s8 n = n (- 9) > o9 n = n 9; s9 n = n (-10) > -} \end{comment} From the notes in the C major triad in register 4, I can now construct a C major arpeggio and chord as well: \begin{haskelllisting} > cMaj :: [T ()] > cMaj = map (\n -> n 4 Duration.qn ()) [c,e,g] -- octave 4, quarter notes > > cMajArp, cMajChd :: T () > cMajArp = Music.line cMaj > cMajChd = Music.chord cMaj \end{haskelllisting} It is also possible to retrieve the pitch from a melody note. But this should be avoided, since it must be dynamically checked, whether the Melody value actually contains one note. \begin{haskelllisting} > noteToPitch :: T attr -> Pitch.T > noteToPitch = > let err = error "leastVaryingInversions: melody must consist of a note" > in Accessor.get notePitch . > Music.switchList (const (fromMaybe err)) err err err \end{haskelllisting} \paragraph*{Inversion and Retrograde.} The notions of inversion, retrograde, retrograde inversion, etc. used in 12-tone theory are also easily captured in Haskore. First let's define a transformation from a line created by \code{line} to a list: \begin{haskelllisting} > invertNote :: Pitch.T -> Note attr -> Note attr > invertNote r = > Accessor.modify notePitch > (\ p -> Pitch.fromInt (2 * Pitch.toInt r - Pitch.toInt p)) > > retro, invert, retroInvert, invertRetro :: > [(d, Music.Atom (Note attr))] -> [(d, Music.Atom (Note attr))] > retro = List.reverse > invert l = let r = maybe > (error "invert: first atom must be a note") > (Accessor.get notePitch) > (snd (head l)) > in map (mapSnd (fmap (invertNote r))) l > retroInvert = retro . invert > invertRetro = invert . retro \end{haskelllisting} \begin{exercise} Show that ``\code{retro\ .\ retro}'', ``\code{invert\ .\ invert}'', and ``\code{retroInvert\ .\ invertRetro}'' are the identity on values created by \code{line}. \end{exercise} haskore-0.2.0.3/src/Haskore/Music.lhs0000644000000000000000000005422411754016451015462 0ustar0000000000000000\subsubsection{Music} \seclabel{music} \begin{haskelllisting} > module Haskore.Music where > import qualified Haskore.Basic.Pitch as Pitch > import qualified Haskore.Basic.Duration as Duration > import qualified Medium.Temporal as Temporal > import qualified Medium.Controlled as CtrlMedium > import qualified Medium.Controlled.List as CtrlMediumList > import qualified Medium > import Medium (prim, serial, parallel) > import Haskore.General.Utility (maximum0, ) > import Data.Tuple.HT (mapPair, mapSnd, ) > import Data.Maybe.HT (toMaybe, ) > import Data.Maybe (isJust, ) > import qualified Data.List as List \end{haskelllisting} Melodies consist essentially of the musical atoms notes and rests. \begin{haskelllisting} > type Dur = Duration.T > type Atom note = Maybe note \end{haskelllisting} If the atom is \code{Nothing} then it means a rest, if it is \code{Just} it contains a note. A note is described by its pitch and a list of \code{NoteAttribute}s (defined later). Both notes and rests have a duration of type \type{Dur}, which is a rational \secref{discussion:dur}. The duration is measured in ratios of whole notes. Notes and rests along with the duration are put into the \type{Primitive} type. \begin{haskelllisting} > data Primitive note = > Atom Dur (Atom note) -- a note or a rest > deriving (Show, Eq, Ord) \end{haskelllisting} A primitive can not only be an atom but also a controller as defined below. We had to make controllers alternatives of \constructor{Atom}s because the \type{Medium} type doesn't support them and it would damage the beauty of \type{Medium} if we add it at the same level as parallel and serial compositions. \begin{haskelllisting} > data Control = > Tempo DurRatio -- scale the tempo > | Transpose Pitch.Relative -- transposition > | Player PlayerName -- player label > | Phrase PhraseAttribute -- phrase attribute > deriving (Show, Eq, Ord) > > type DurRatio = Dur > type PlayerName = String > atom :: Dur -> Atom note -> T note > atom d' = prim . Atom d' > control :: Control -> T note -> T note > control ctrl = CtrlMedium.control ctrl > mkControl :: (a -> Control) -> (a -> T note -> T note) > mkControl ctrl = control . ctrl > changeTempo :: DurRatio -> T note -> T note > changeTempo = mkControl Tempo > transpose :: Pitch.Relative -> T note -> T note > transpose = mkControl Transpose > setPlayer :: PlayerName -> T note -> T note > setPlayer = mkControl Player > phrase :: PhraseAttribute -> T note -> T note > phrase = mkControl Phrase \end{haskelllisting} \begin{itemize} \item \code{changeTempo a m} scales the rate at which \code{m} is played (i.e.\ its tempo) by a factor of \code{a}. \item \code{transpose i m} transposes \code{m} by interval \code{i} (in semitones). \item \code{setPlayer pname m} declares that \code{m} is to be performed by player \code{pname}. \item \code{phrase pa m} declares that \code{m} is to be played using the phrase attribute (described later) \code{pa}. (cf. \secref{discussion:phrase}) \end{itemize} From these primitives we can build more complex musical objects. They are captured by the \code{Music.T} datatype: \footnote{I prefer to call these ``musical objects'' rather than ``musical values'' because the latter may be confused with musical aesthetics.} \begin{haskelllisting} > type T note = CtrlMediumList.T Control (Primitive note) > > infixr 7 +:+ {- like multiplication -} > infixr 6 =:= {- like addition -} > -- make them visible for importers of Music > (+:+), (=:=) :: T note -> T note -> T note > (+:+) = (Medium.+:+) > (=:=) = (Medium.=:=) \end{haskelllisting} \begin{itemize} \item Musical objects can be composed sequentially by \function{Medium.serial} or by \function{(+:+)}. That is both \code{serial [m0, m1]} and \code{m0 +:+ m1} denote that \code{m0} and \code{m1} are played in sequence. (cf. \secref{discussion:media}) \item Similarly \code{Medium.parallel} and \function{(=:=)} compose parallely. E.g.\ both \code{parallel [m0, m1]} and \code{m0 =:= m1} mean that \code{m0} and \code{m1} are played simultaneously. \end{itemize} It is convenient to represent these ideas in Haskell as a recursive datatype rather then simple function calls because we wish to not only construct musical objects, but also take them apart, analyze their structure, print them in a structure-preserving way, interpret them for performance purposes, etc. Nonetheless using functions that are mapped to constructors has the advantage that song descriptions can stay independent from a particular music data structure. % durations and formatting of durations \input{Haskore/Basic/Duration.lhs} \subsubsection{Rests} \seclabel{rests} \begin{figure} \begin{haskelllisting} > rest :: Dur -> T note > rest d' = prim (Atom d' Nothing) > > bnr, wnr, hnr, qnr, enr, snr, tnr, sfnr :: T note > dwnr, dhnr, dqnr, denr, dsnr, dtnr :: T note > ddhnr, ddqnr, ddenr :: T note > > bnr = rest Duration.bn -- brevis rest > wnr = rest Duration.wn -- whole note rest > hnr = rest Duration.hn -- half note rest > qnr = rest Duration.qn -- quarter note rest > enr = rest Duration.en -- eight note rest > snr = rest Duration.sn -- sixteenth note rest > tnr = rest Duration.tn -- thirty-second note rest > sfnr = rest Duration.sfn -- sixty-fourth note rest > > dwnr = rest Duration.dwn -- dotted whole note rest > dhnr = rest Duration.dhn -- dotted half note rest > dqnr = rest Duration.dqn -- dotted quarter note rest > denr = rest Duration.den -- dotted eighth note rest > dsnr = rest Duration.dsn -- dotted sixteenth note rest > dtnr = rest Duration.dtn -- dotted thirty-second note rest > > ddhnr = rest Duration.ddhn -- double-dotted half note rest > ddqnr = rest Duration.ddqn -- double-dotted quarter note rest > ddenr = rest Duration.dden -- double-dotted eighth note rest \end{haskelllisting} \caption{Convenient rest definitions.} \figlabel{durations-rests} \end{figure} \subsubsection{Some Simple Examples} \seclabel{basic-examples} With this modest beginning, we can already express quite a few musical relationships simply and effectively. \paragraph*{Lines and Chords.} Two common ideas in music are the construction of notes in a horizontal fashion (a \keyword{line} or \keyword{melody}), and in a vertical fashion (a \keyword{chord}): \begin{haskelllisting} > line, chord :: [T note] -> T note > line = serial > chord = parallel \end{haskelllisting} \paragraph*{Delay and Repeat.} Suppose now that we wish to describe a melody \code{m} accompanied by an identical voice a perfect 5th higher. In Haskore we simply write ``\code{m =:= transpose 7 m}''. Similarly, a canon-like structure involving \code{m} can be expressed as ``\code{m =:= delay d m}'', where: \begin{haskelllisting} > delay :: Dur -> T note -> T note > delay d' m = if d' == 0 then m else rest d' +:+ m \end{haskelllisting} Of course, Haskell's non-strict semantics also allows us to define infinite musical objects. For example, a musical object may be repeated \keyword{ad nauseum} using this simple function: \begin{haskelllisting} > repeat :: T note -> T note > repeat m = line (List.repeat m) \end{haskelllisting} Thus an infinite ostinato can be expressed in this way, and then used in different contexts that extract only the portion that's actually needed. A limitted loop can be defined the same way. \begin{haskelllisting} > replicate :: Int -> T note -> T note > replicate n m = line (List.replicate n m) \end{haskelllisting} \paragraph*{Determining Duration} It is sometimes desirable to compute the duration in beats of a musical object; we can do so as follows: \begin{haskelllisting} > dur :: T note -> Dur > dur = Temporal.dur > instance Temporal.C (Primitive note) where > dur (Atom d' _) = d' > none d' = Atom d' Nothing > instance Temporal.Control Control where > controlDur (Tempo t) d' = d' / t > controlDur _ d' = d' > anticontrolDur (Tempo t) d' = d' * t > anticontrolDur _ d' = d' \end{haskelllisting} However, this measurement ignores the temporal effects of phrases like ritardando. \paragraph*{Super-retrograde.} Using \code{dur} we can define a function \function{reverse} that reverses any \code{Music.T} value (and is thus considerably more useful than \code{retro} defined earlier). Note the tricky treatment of parallel compositions. Also note that this version wastes time. It computes the duration of smaller structures in the case of parallel compositions. When it descends into a structure of which it has computed the duration it computes the duration of its sub-structures again. This can lead to a quadratic time consumption. \begin{haskelllisting} > reverse :: T note -> T note > reverse = mapList > (,) > (flip const) > List.reverse > (\ms -> let durs = map dur ms > dmax = maximum0 durs > in zipWith (delay . (dmax -)) durs ms) \end{haskelllisting} \paragraph*{Truncating Parallel Composition} Note that the duration of \code{m0 =:= m1} is the maximum of the durations of {\\code{m0} and \code{m1} (and thus if one is infinite, so is the result). Sometimes we would rather have the result be of duration equal to the shorter of the two. This is not as easy as it sounds, since it may require interrupting the longer one in the middle of a note (or notes). We will define a ``truncating parallel composition'' operator \code{(/=:)}, but first we will define an auxiliary function \function{Music.take} such that \expression{Music.take d m} is the musical object \code{m} ``cut short'' to have at most duration \code{d}. The name matches the one of the \module{List} because the function is quite similar. \begin{haskelllisting} > take :: Dur -> T note -> T note > take newDur m = > if newDur < 0 > then error ("Music.take: newDur " ++ show newDur ++ " must be non-negative") > else snd (take' newDur m) > takeLine :: Dur -> [T note] -> [T note] > takeLine newDur = snd . takeLine' newDur > take' :: Dur -> T note -> (Dur, T note) > take' 0 = const (0, rest 0) > take' newDur = > switchList > (\oldDur at -> let takenDur = min oldDur newDur > in (takenDur, atom takenDur at)) > (\ctrl -> case ctrl of > Tempo t -> mapPair ((/t), changeTempo t) . > take' (newDur * t) > _ -> mapSnd (control ctrl) . > take' newDur) > (mapSnd line . takeLine' newDur) > (mapPair (maximum0,chord) . unzip . map (take' newDur)) > takeLine' :: Dur -> [T note] -> (Dur, [T note]) > takeLine' 0 _ = (0, []) > takeLine' _ [] = (0, []) > takeLine' newDur (m:ms) = > let m' = take' newDur m > ms' = takeLine' (newDur - fst m') ms > in (fst m' + fst ms', snd m' : snd ms') \end{haskelllisting} Note that \code{Music.take} is ready to handle a \type{Music.T} object of infinite length. The implementation of \function{takeLine'} and \function{take'} would be simpler if one does not compute the duration of the taken part of the music in \function{take'}. Instead one could compute the duration of the taken part where it is needed, i.e. after \function{takeLine'} calls \function{Music.take'}. The drawback of this simplification would be analogously to \function{Music.reverse}: The duration of sub-structures must be computed again and again, which results in quadratic runtime in the worst-case. With \code{Music.take}, the definition of \code{(/=:)} is now straightforward: \begin{haskelllisting} > (/=:) :: T note -> T note -> T note > m0 /=: m1 = Haskore.Music.take (min (dur m0) (dur m1)) (m0 =:= m1) \end{haskelllisting} Unfortunately, whereas \code{Music.take} can handle infinite-duration music values, \code{(/=:)} cannot. \begin{exercise} Define a version of \code{(/=:)} that shortens correctly when either or both of its arguments are infinite in duration. \end{exercise} For completeness we want to define a function somehow dual to \function{Music.take}. The \function{Music.drop} removes a prefix of the given duration from the music. Notes that begin in the removed part are lost. This is especially important for notes which start in the removed part and end in the remainder. They are replaced by rests. We would like to design \function{drop'} such that it returns the duration of the remaining music. This design fails for infinite music. Thus we return the duration of the part that was dropped. When going through a serial composition, if we could drop less from a music item than we wanted then the music item must have been gone completely and must drop subsequent items. If we dropped as much as we wanted we are ready. If we dropped more than we wanted this indicates an error. Remaining rests of zero duration, empty compositions and so on may be removed by subsequent optimizations. \begin{haskelllisting} > drop :: Dur -> T note -> T note > drop remDur = > if remDur < 0 > then error ("Music.drop: remDur " ++ show remDur ++ " must be non-negative") > else snd . drop' remDur > dropLine :: Dur -> [T note] -> [T note] > dropLine remDur = snd . dropLine' remDur > drop' :: Dur -> T note -> (Dur, T note) > drop' 0 = (,) 0 > drop' remDur = > switchList > (\oldDur _ -> let newDur = min oldDur remDur > in (newDur, rest (oldDur-newDur))) > (\ctrl -> case ctrl of > Tempo t -> mapPair ((/t), changeTempo t) . > drop' (remDur * t) > _ -> mapSnd (control ctrl) . > drop' remDur) > (mapSnd line . dropLine' remDur) > (mapPair (maximum0,chord) . unzip . map (drop' remDur)) > dropLine' :: Dur -> [T note] -> (Dur, [T note]) > dropLine' 0 m = (0, m) > dropLine' _ [] = (0, []) > dropLine' remDur (m:ms) = > let (dropped, m') = drop' remDur m > in case compare dropped remDur of > LT -> mapPair ((dropped+), id) (dropLine' (remDur - dropped) ms) > EQ -> (dropped, m' : ms) > GT -> error "dropLine': program error: dropped more than we wanted" \end{haskelllisting} Note that \function{mapPair} is prepared for infinite lists. We will now define functions for filtering out notes. This way you can e.g. extract all notes for a particular instrument. Non-matching notes are replaced by rests. You may want to merge them using \function{Optimization.rest}. \begin{haskelllisting} > filter :: (note -> Bool) -> T note -> T note > filter p = > fmap (\(Atom d' mn) -> Atom d' (mn >>= \n -> toMaybe (p n) n)) > -- fmap (\(Atom d' mn) -> Atom d' (listToMaybe $ filter p $ maybeToList mn)) > partition :: (note -> Bool) -> T note -> (T note, T note) > partition p = > foldList > (\ d' mn -> > mapPair > (atom d', atom d') > (if maybe False p mn > then (mn, Nothing) > else (Nothing, mn))) > (\k -> mapPair (control k, control k)) > (mapPair (line, line) . unzip) > (mapPair (chord, chord) . unzip) > partitionMaybe :: (noteA -> Maybe noteB) -> T noteA -> (T noteB, T noteA) > partitionMaybe f = > foldList > (\ d' mn -> > mapPair > (atom d', atom d') > (let m = mn >>= f > in if isJust m > then (m, Nothing) > else (Nothing, mn))) > (\k -> mapPair (control k, control k)) > (mapPair (line, line) . unzip) > (mapPair (chord, chord) . unzip) \end{haskelllisting} \paragraph*{Inspecting a \type{Music.T}} Here are some routines which specialize functions from \module{Medium} to \module{Music}. \begin{haskelllisting} > applyPrimitive :: > (Dur -> Atom note -> b) -> > Primitive note -> b > applyPrimitive fa (Atom d' at) = fa d' at > switchBinary :: > (Dur -> Atom note -> b) -> > (Control -> T note -> b) -> > (T note -> T note -> b) -> > (T note -> T note -> b) -> > b -> T note -> b > switchBinary fa fc fser fpar = > CtrlMedium.switchBinary (applyPrimitive fa) fser fpar fc > switchList :: > (Dur -> Atom note -> b) -> > (Control -> T note -> b) -> > ([T note] -> b) -> > ([T note] -> b) -> > T note -> b > switchList fa fc fser fpar = > CtrlMedium.switchList (applyPrimitive fa) fser fpar fc > foldBin :: > (Dur -> Atom note -> b) -> > (Control -> b -> b) -> > (b -> b -> b) -> > (b -> b -> b) -> > b -> T note -> b > foldBin fa fc fser fpar none' = > CtrlMedium.foldBin (applyPrimitive fa) fser fpar fc none' > foldList :: > (Dur -> Atom note -> b) -> > (Control -> b -> b) -> > ([b] -> b) -> > ([b] -> b) -> > T note -> b > foldList fa fc fser fpar = > CtrlMedium.foldList (applyPrimitive fa) fser fpar fc > mapListFlat :: > (Dur -> Atom noteA -> (Dur, Atom noteB)) -> > (Control -> T noteA -> T noteB) -> > ([T noteA] -> [T noteB]) -> > ([T noteA] -> [T noteB]) -> > T noteA -> T noteB > mapListFlat fa fc fser fpar = > CtrlMediumList.mapListFlat (uncurry Atom . applyPrimitive fa) fser fpar fc > mapList :: > (Dur -> Atom noteA -> (Dur, Atom noteB)) -> > (Control -> T noteB -> T noteB) -> > ([T noteB] -> [T noteB]) -> > ([T noteB] -> [T noteB]) -> > T noteA -> T noteB > mapList fa fc fser fpar = > CtrlMediumList.mapList (uncurry Atom . applyPrimitive fa) fser fpar fc > -- Could be an instance of fmap if Music.T would be an algebraic type. > mapNote :: (noteA -> noteB) -> T noteA -> T noteB > mapNote f' = fmap (\(Atom d' at) -> Atom d' (fmap f' at)) > {- > This is useful for duration dependend attributes, > and duration dependend instrument sounds. > However it seems to be more appropriate to pass the duration in seconds > to the sound generators rather than the relative duration. > -} > mapDurNote :: (Dur -> noteA -> noteB) -> T noteA -> T noteB > mapDurNote f' = fmap (\(Atom d' at) -> Atom d' (fmap (f' d') at)) \end{haskelllisting} \input{Haskore/Composition/Trill.lhs} \input{Haskore/Composition/Drum.lhs} % needs \code{roll} from Trill \subsubsection{Phrasing and Articulation} \seclabel{phrasing} The \code{Phrase} constructor permits one to annotate an entire musical object with a \code{PhraseAttribute}. This attribute datatype covers a wide range of attributions found in common practice notation, and is shown in \figref{attributes}. Beware that use of them requires the use of a player that knows how to interpret them! Players will be described in more detail in \secref{players}. \begin{figure} \begin{haskelllisting} > data PhraseAttribute = Dyn Dynamic > | Tmp Tempo > | Art Articulation > | Orn Ornament > deriving (Eq, Ord, Show) > > data Dynamic = Loudness Rational | Accent Rational > | Crescendo Rational | Diminuendo Rational > deriving (Eq, Ord, Show) > > data Tempo = Ritardando Rational | Accelerando Rational > deriving (Eq, Ord, Show) > > data Articulation = Staccato Dur | Legato Dur | Slurred Dur > | Tenuto | Marcato | Pedal | Fermata | FermataDown | Breath > | DownBow | UpBow | Harmonic | Pizzicato | LeftPizz > | BartokPizz | Swell | Wedge | Thumb | Stopped > deriving (Eq, Ord, Show) > > data Ornament = Trill | Mordent | InvMordent | DoubleMordent > | Turn | TrilledTurn | ShortTrill > | Arpeggio | ArpeggioUp | ArpeggioDown > | Instruction String | Head NoteHead > deriving (Eq, Ord, Show) > > -- this is more a note attribute than a phrase attribute > data NoteHead = DiamondHead | SquareHead | XHead | TriangleHead > | TremoloHead | SlashHead | ArtHarmonic | NoHead > deriving (Eq, Ord, Show) \end{haskelllisting} \caption{Note and Phrase Attributes.} \figlabel{attributes} \end{figure} Again, to stay independent from the underlying data structure we define some functions that simplify the application of several phrases. \begin{haskelllisting} > dynamic :: Dynamic -> T note -> T note > dynamic = phrase . Dyn > tempo :: Tempo -> T note -> T note > tempo = phrase . Tmp > articulation :: Articulation -> T note -> T note > articulation = phrase . Art > ornament :: Ornament -> T note -> T note > ornament = phrase . Orn > accent, crescendo, diminuendo, loudness1, > ritardando, accelerando :: > Rational -> T note -> T note > accent = dynamic . Accent > crescendo = dynamic . Crescendo > diminuendo = dynamic . Diminuendo > loudness1 = dynamic . Loudness > ritardando = tempo . Ritardando > accelerando = tempo . Accelerando > staccato, legato :: Dur -> T note -> T note > > staccato = articulation . Staccato > legato = articulation . Legato \end{haskelllisting} Note that some of the attributes are parameterized with a numeric value. This is used by a player to control the degree to which an articulation is to be applied. For example the articulations \constructor{Staccato}, \constructor{Legato}, \constructor{Slurred} describe the overlapping between notes. We would expect \code{Legato 1.2} to create more of a legato feel than \code{Legato 1.1}, and \code{Staccato 2} to be stronger than \code{Staccato 1}. The following constants represent default values for some of the parameterized attributes: \begin{haskelllisting} > defltLegato, defltStaccato, > defltAccent, bigAccent :: T note -> T note > > defltLegato = legato Duration.sn > defltStaccato = staccato Duration.sn > defltAccent = accent 1.2 > bigAccent = accent 1.5 \end{haskelllisting} To understand exactly how a player interprets an attribute requires knowing how players are defined. Haskore defines only a few simple players, so in fact many of the attributes in \figref{attributes} are to allow the user to give appropriate interpretations of them by her particular player. But before looking at the structure of players we will need to look at the notion of a \keyword{performance} (these two ideas are tightly linked, which is why the \code{Player} and \code{Performance} modules are mutually recursive). \begin{exercise} Find a simple piece of music written by your favorite composer, and transcribe it into Haskore. 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} \secref{chick} shows the first 28 bars of Chick Corea's ``Children's Song No.~6'' encoded in Haskore. haskore-0.2.0.3/src/Haskore/Process/0000755000000000000000000000000011754016452015302 5ustar0000000000000000haskore-0.2.0.3/src/Haskore/Process/Optimization.lhs0000644000000000000000000002050411754016452020501 0ustar0000000000000000 \subsection{Optimization} \seclabel{optimization} This module provides functions that simplify the structure of a \code{Music.T} according to the rules proven in \secref{equivalence} \begin{haskelllisting} > module Haskore.Process.Optimization where > import qualified Medium.Controlled.List as CtrlMediumList > import qualified Medium.Controlled as CtrlMedium > import qualified Haskore.Music as Music > import Medium.Controlled.List (serial, parallel, ) > import Data.List.HT (partitionMaybe, ) > import Data.Maybe.HT (toMaybe, ) > import Data.Maybe (catMaybes, fromMaybe, ) \end{haskelllisting} \code{Music.T} objects that come out of \code{ReadMidi.toMusic} almost always contain redundancies, like rests of zero duration and redundant instrument specifications. The function \function{Optimization.all} reduces the redundancy to make a \type{Music.T} file less cluttered and more efficient to use. \begin{haskelllisting} > all, rest, composition, duration, tempo, transpose, volume :: > Music.T note -> Music.T note > all = tempo . transpose . volume . singleton . composition . rest \end{haskelllisting} Remove rests of zero duration. \begin{haskelllisting} > rest = Music.mapList > (,) > (flip const) > (filter (not . isZeroRest)) > (filter (not . isZeroRest)) > isZeroRest :: Music.T note -> Bool > isZeroRest = > Music.switchList > (\d at -> d==0 && maybe True (const False) at) > (const (const False)) > (const False) > (const False) \end{haskelllisting} Remove empty parallel and serial compositions and controllers of empty music. \begin{haskelllisting} > composition = fromMaybe (Music.rest 0) . Music.foldList > (\d -> Just . Music.atom d) > (fmap . Music.control) > ((\ms -> toMaybe (not (null ms)) (serial ms)) . catMaybes) > ((\ms -> toMaybe (not (null ms)) (parallel ms)) . catMaybes) \end{haskelllisting} Remove any atom of zero duration. This is not really an optimization but a hack to get rid of MIDI NoteOn and NoteOff events at the same time point. \begin{haskelllisting} > duration = fromMaybe (Music.rest 0) . Music.foldList > (\d -> toMaybe (d /= 0) . Music.atom d) > (fmap . Music.control) > (Just . serial . catMaybes) > (Just . parallel . catMaybes) \end{haskelllisting} The control structures for tempo, transposition and change of instruments can be handled very similar using the following routines. The function \function{mergeControl'} checks if nested controllers are of the same kind. If they are then they are merged into one. The function would be much simpler if it would be implemented for specific constructors, but we want to stay independent from the particular data structure, which is already quite complex. \begin{haskelllisting} > mergeControl' :: > (Music.Control -> Maybe a) > -> (a -> Music.T note -> Music.T note) > -> (a -> a -> a) > -> Music.T note > -> Music.T note > mergeControl' extract control merge = > let fcSub c m = fmap (flip (,) m) (extract c) > fc' c0 m0 x0 = > maybe (Music.control c0 m0) > (\(x1,m1) -> control (merge x0 x1) m1) > (Music.switchList (const (const Nothing)) > fcSub (const Nothing) (const Nothing) m0) > fc c m = maybe (Music.control c m) > (fc' c m) > (extract c) > in Music.foldList > Music.atom fc Music.line Music.chord \end{haskelllisting} The following function collects neighboured controllers into groups, extracts controllers of a specific type and prepends a controller to the list of neighboured controllers, which has the total effect of the extracted controllers. This change of ordering is always possible because in the current set of controllers two neighboured controllers of different type commutes. E.g. it is \code{transpose n . changeTempo r == changeTempo r . transpose n} and thus the following simplification \code{transpose 1 . changeTempo 2 . transpose 3 == transpose 4 . changeTempo 2} is possible. \begin{haskelllisting} > mergeControl, mergeControlCompact :: > (Music.Control -> Maybe a) > -> (a -> Music.T note -> Music.T note) > -> (a -> a -> a) > -> Music.T note > -> Music.T note > mergeControlCompact extract control merge = > let collectControl = > Music.switchList > (\d n -> ([], Music.atom d n)) > (\c m -> let cm = collectControl m > in (c : fst cm, snd cm)) > ((,) [] . Music.line . map recourse) > ((,) [] . Music.chord . map recourse) > recourse m = > let cm = collectControl m > (xs, cs') = partitionMaybe extract (fst cm) > x = foldl1 merge xs > collectedCtrl = if null xs then id else control x > in collectedCtrl (foldr id (snd cm) (map Music.control cs')) > in recourse > -- more intuitive implementation > mergeControl extract control merge = > -- flattenControllers . > -- CtrlMediumList.mapControl > CtrlMedium.foldList > CtrlMediumList.prim > CtrlMediumList.serial > CtrlMediumList.parallel > (\cs cm -> > let (xs, cs') = partitionMaybe extract cs > collectedCtrl = > if null xs then id else control (foldl1 merge xs) > in collectedCtrl (foldr id cm (map Music.control cs'))) . > cumulateControllers > cumulateControllers :: > CtrlMediumList.T control a > -> CtrlMediumList.T [control] a > cumulateControllers = > CtrlMedium.foldList > CtrlMediumList.prim > CtrlMediumList.serial > CtrlMediumList.parallel > (\c m -> > let cm = CtrlMedium.control [c] m > in CtrlMedium.switchList > (const cm) > (const cm) > (const cm) > (\cs m' -> CtrlMedium.control (c:cs) m') > m) > flattenControllers :: > CtrlMediumList.T [control] a > -> CtrlMediumList.T control a > flattenControllers = > CtrlMedium.foldList > CtrlMediumList.prim > CtrlMediumList.serial > CtrlMediumList.parallel > (flip (foldr id) . map CtrlMedium.control) \end{haskelllisting} The function \function{removeNeutral} removes controllers that have no effect. \begin{haskelllisting} > removeNeutral :: (Music.Control -> Bool) -> Music.T note -> Music.T note > removeNeutral isNeutral = > let fc c m = if isNeutral c > then m > else Music.control c m > in Music.foldList Music.atom fc Music.line Music.chord \end{haskelllisting} Remove redundant \code{Tempo}s. \begin{haskelllisting} > tempo = > let maybeTempo (Music.Tempo t) = Just t > maybeTempo _ = Nothing > in removeNeutral (== Music.Tempo 1) . > mergeControl maybeTempo Music.changeTempo (*) \end{haskelllisting} Remove redundant \code{Transpose}s. \begin{haskelllisting} > transpose = > let maybeTranspose (Music.Transpose t) = Just t > maybeTranspose _ = Nothing > in removeNeutral (== Music.Transpose 0) . > mergeControl maybeTranspose Music.transpose (+) \end{haskelllisting} Change repeated Volume Note Attributes to Phrase Attributes. \begin{haskelllisting} > volume = > let maybeLoudness (Music.Phrase (Music.Dyn (Music.Loudness t))) = Just t > maybeLoudness _ = Nothing > in removeNeutral (== Music.Phrase (Music.Dyn (Music.Loudness 1))) . > mergeControl maybeLoudness Music.loudness1 (*) \end{haskelllisting} Eliminate \code{Serial} and \code{Parallel} composition if they contain only one member. This can be done very general for \type{CtrlMedium.T}. We have also a version which works on \type{Music.T}. Since the medium data type supports controllers there is no longer a real difference between these two functions. \begin{haskelllisting} > singletonMedium :: > CtrlMediumList.T control a -> CtrlMediumList.T control a > singletonMedium = > CtrlMedium.foldList CtrlMediumList.prim > (\ms -> case ms of {[x] -> x; _ -> serial ms}) > (\ms -> case ms of {[x] -> x; _ -> parallel ms}) > (CtrlMedium.control) > singleton :: Music.T note -> Music.T note > singleton = > Music.foldList Music.atom Music.control > (\ms -> case ms of {[x] -> x; _ -> Music.line ms}) > (\ms -> case ms of {[x] -> x; _ -> Music.chord ms}) \end{haskelllisting} haskore-0.2.0.3/src/Haskore/Process/Format.lhs0000644000000000000000000001624711754016452017254 0ustar0000000000000000 \subsection{Pretty printing Music} This module aims at formatting (pretty printing) of musical objects with Haskell syntax. This is particularly useful for converting algorithmically generated music into Haskell code that can be edited and furtherly developed. \begin{haskelllisting} > module Haskore.Process.Format where > > import qualified Language.Haskell.Pretty as Pretty > import qualified Language.Haskell.Syntax as Syntax > import qualified Language.Haskell.Parser as Parser > import qualified Haskore.Basic.Duration as Duration > import qualified Haskore.Music as Music > import qualified Haskore.Melody as Melody > import qualified Haskore.Melody.Standard as StdMelody > import qualified Medium.Controlled as CtrlMedium > import Medium.Controlled.ContextFreeGrammar as Grammar > import qualified Haskore.General.Map as Map > import qualified Data.Ratio as Ratio > import qualified Data.Char as Char > import Data.List(intersperse) \end{haskelllisting} Format a grammar as computed with the \module{Medium.Controlled.ContextFreeGrammar}. \begin{haskelllisting} > prettyGrammarMedium :: (Show prim, Show control) => > Grammar.T String control prim -> String > prettyGrammarMedium = prettyGrammar controlGen prim > prettyGrammarMelody :: > Grammar.T String Music.Control (Music.Primitive StdMelody.Note) -> String > prettyGrammarMelody = prettyGrammar control primMelody > prettyGrammar :: > (Int -> control -> (Int -> ShowS) -> ShowS) -> > (Int -> prim -> ShowS) -> > Grammar.T String control prim -> String > prettyGrammar controlSyntax primSyntax g = > let text = unlines (map (flip id "" . bind controlSyntax primSyntax) g) > Parser.ParseOk (Syntax.HsModule _ _ _ _ code) = > Parser.parseModule text > in unlines (map Pretty.prettyPrint code) -- show code \end{haskelllisting} Format a \code{Medium} object that contains references to other medium objects. \begin{haskelllisting} > bind :: > (Int -> control -> (Int -> ShowS) -> ShowS) -> > (Int -> prim -> ShowS) -> > (String, Grammar.TagMedium String control prim) -> ShowS > bind controlSyntax primSyntax (key, ms) = > showString key . showString " = " . tagMedium 0 controlSyntax primSyntax ms > tagMedium :: > Int -> > (Int -> control -> (Int -> ShowS) -> ShowS) -> > (Int -> prim -> ShowS) -> > Grammar.TagMedium String control prim -> ShowS > tagMedium prec controlSyntax primSyntax m = > let primSyntax' _ (Grammar.Call s) = showString s > primSyntax' prec' (Grammar.CallMulti n s) = > enclose prec' 0 > (showString "serial $ replicate " . showsPrec 10 n . > showString " " . showString s) > primSyntax' prec' (Grammar.Prim p) = primSyntax prec' p > in CtrlMedium.foldList > (flip primSyntax') > (listFunc "serial") > (listFunc "parallel") > (flip . flip controlSyntax) > m prec > list :: [Int -> ShowS] -> ShowS > list = foldr (.) (showString "]") . (showString "[" :) . > intersperse (showString ",") . map (flip id 0) > listFunc :: String -> [Int -> ShowS] -> Int -> ShowS > listFunc func ps prec = > enclose prec 10 (showString func . showString " " . list ps) > prim :: (Show p) => Int -> p -> ShowS > prim prec p = enclose prec 10 (showString "prim " . showsPrec 10 p) > dummySrcLoc :: Syntax.SrcLoc > dummySrcLoc = Syntax.SrcLoc {Syntax.srcFilename = "", > Syntax.srcLine = 0, > Syntax.srcColumn = 0} \end{haskelllisting} Of course we also want to format plain music, that is music without tags. \begin{haskelllisting} > prettyMelody :: StdMelody.T -> String > prettyMelody m = prettyExp (melody 0 m "") > prettyExp :: String -> String > prettyExp text = > let Parser.ParseOk (Syntax.HsModule _ _ _ _ > [Syntax.HsPatBind _ _ (Syntax.HsUnGuardedRhs code) _]) = > Parser.parseModule ("dummy = "++text) > in Pretty.prettyPrint code \end{haskelllisting} Now we go to define functions that handle the particular primitives of music. Note that \code{Control} information and \code{NoteAttribute}s are printed as atoms. \begin{haskelllisting} > melody :: Int -> StdMelody.T -> ShowS > melody prec m = > Music.foldList > (flip . flip atom) > (flip . flip control) > (listFunc "line") > (listFunc "chord") > m prec > primMelody :: Int -> Music.Primitive StdMelody.Note -> ShowS > primMelody prec (Music.Atom d at) = atom prec d at > atom :: Show attr => > Int -> Duration.T -> Music.Atom (Melody.Note attr) -> ShowS > atom prec d = maybe (rest prec d) (note prec d) > note :: Show attr => > Int -> Duration.T -> Melody.Note attr -> ShowS > note prec d (Melody.Note nas (o,pc)) = > enclose prec 10 (showString (map Char.toLower (show pc)) . > showString " " . showsPrec 10 o . > showString " " . durSyntax id "n" d . > showString " " . showsPrec 10 nas) > rest :: Int -> Duration.T -> ShowS > rest prec d = > durSyntax (\dStr -> enclose prec 10 (showString "rest " . dStr)) "nr" d > controlGen :: (Show control) => Int -> control -> (Int -> ShowS) -> ShowS > controlGen prec c m = > enclose prec 10 > (showString "control " . showsPrec 10 c . > showString " " . m 10) > control :: Int -> Music.Control -> (Int -> ShowS) -> ShowS > control prec c m = > let controlSyntax name arg = > enclose prec 10 > (showString name . showString " " . arg . showString " " . m 10) > in case c of > Music.Tempo d -> controlSyntax "changeTempo" (showDur 10 d) > Music.Transpose p -> controlSyntax "transpose" (showsPrec 10 p) > Music.Player p -> controlSyntax "setPlayer" (showsPrec 10 p) > Music.Phrase p -> controlSyntax "phrase" (showsPrec 10 p) \end{haskelllisting} Note that the call to \code{show} can't be moved from the \code{controlSyntax} calls in \code{control} to \code{controlSyntax} because that provokes a compiler problem, namely \begin{haskelllisting} Mismatched contexts When matching the contexts of the signatures for controlSyntax :: forall a. (Show a) => String -> a -> StdMelody.T -> Language.Haskell.Syntax.HsExp control :: Music.Primitive -> Language.Haskell.Syntax.HsExp The signature contexts in a mutually recursive group should all be identical When generalising the type(s) for controlSyntax, control \end{haskelllisting} \begin{haskelllisting} > durSyntax :: (ShowS -> ShowS) -> String -> Duration.T -> ShowS > durSyntax showRatio suffix d = > maybe > (showRatio (showDur 10 d)) > (\s -> showString (s++suffix)) > (Map.lookup Duration.nameDictionary d) > showDur :: Int -> Duration.T -> ShowS > showDur prec = > (\d -> enclose prec 7 > (shows (Ratio.numerator d) . > showString "%+" . > shows (Ratio.denominator d))) . > Duration.toRatio \end{haskelllisting} Enclose an expression in parentheses if the inner operator has at most the precedence of the outer operator. \begin{haskelllisting} > enclose :: Int -> Int -> ShowS -> ShowS > enclose outerPrec innerPrec = showParen (outerPrec >= innerPrec) \end{haskelllisting} haskore-0.2.0.3/src/Haskore/Melody/0000755000000000000000000000000011754016451015114 5ustar0000000000000000haskore-0.2.0.3/src/Haskore/Melody/Standard.lhs0000644000000000000000000000407411754016451017371 0ustar0000000000000000 \begin{haskelllisting} > module Haskore.Melody.Standard > (Note, T, NoteAttributes, fromMelodyNullAttr, > na, velocity1, vibrato, tremolo, > cf,c,cs,df,d,ds,ef,e,es,ff,f,fs,gf,g,gs,af,a,as,bf,b,bs) where > import Haskore.Melody > (cf,c,cs,df,d,ds,ef,e,es,ff,f,fs,gf,g,gs,af,a,as,bf,b,bs) > import qualified Haskore.Music as Music > import qualified Haskore.Melody as Melody > import qualified Data.Accessor.Basic as Accessor > import qualified Data.Accessor.Show as AccShow > type Note = Melody.Note NoteAttributes > type T = Melody.T NoteAttributes \end{haskelllisting} % | Dynamics String % | Fingering Int Recall that the \code{Note} constructor contained a field of \code{NoteAttribute}s. These are values that are attached to notes for the purpose of notation or musical interpretation. \begin{haskelllisting} > data NoteAttributes = > NoteAttributes { > velocity_ :: Rational, -- intensity of playing between 0 and 1 > vibrato_ :: (Rational, Rational), > tremolo_ :: (Rational, Rational) > } deriving (Eq, Ord) > > instance Show NoteAttributes where > showsPrec = > AccShow.showsPrec > [AccShow.field "velocity1" velocity1, > AccShow.field "vibrato" vibrato, > AccShow.field "tremolo" tremolo] > "na" na > > na :: NoteAttributes > na = NoteAttributes 1 (0,0) (0,0) > > velocity1 :: Accessor.T NoteAttributes Rational > velocity1 = > Accessor.fromSetGet (\v nas -> nas{velocity_ = v}) velocity_ > > vibrato :: Accessor.T NoteAttributes (Rational, Rational) > vibrato = > Accessor.fromSetGet (\v nas -> nas{vibrato_ = v}) vibrato_ > > tremolo :: Accessor.T NoteAttributes (Rational, Rational) > tremolo = > Accessor.fromSetGet (\v nas -> nas{tremolo_ = v}) tremolo_ \end{haskelllisting} \begin{haskelllisting} > fromMelodyNullAttr :: Melody.T () -> T > fromMelodyNullAttr = > Music.mapNote (\(Melody.Note _ p) -> Melody.Note na p) \end{haskelllisting} % Music.mapNote (Accessor.set Melody.noteAttrs na) haskore-0.2.0.3/src/Haskore/Interface/0000755000000000000000000000000011754016451015563 5ustar0000000000000000haskore-0.2.0.3/src/Haskore/Interface/MML.lhs0000644000000000000000000000572011754016451016724 0ustar0000000000000000\subsection{MML} \begin{haskelllisting} > module Haskore.Interface.MML where > import qualified Haskore.Basic.Pitch as Pitch > import qualified Haskore.Music as Music > import qualified Haskore.Melody as Melody > import Haskore.Basic.Duration((%+)) > import Control.Monad.Trans.State (State, state, evalState, ) \end{haskelllisting} I found some music notated in a language called MML. The description consists of strings. \begin{itemize} \item \code{l}$n$ determines the duration of subsequent notes: \code{l1} - whole note, \code{l2} - half note, \code{l4} - quarter note and so on. \item \code{>} switch to the octave above \item \code{<} switch to the octave below \item Lower case letter \code{a} - \code{g} play the note of the corresponding pitch class. \item \code{\#} (sharp) or \code{-} (flat) may follow a note name in order to increase or decrease, respectively, the pitch of the note by a semitone. \item An additional figure for the note duration may follow. \item \code{p} is pause. \end{itemize} See \module{Kantate147} for an example. %\url{http://www.student.oulu.fi/~vtatila/history_of_game_music.html} \begin{haskelllisting} > type Accum = (Music.Dur, Pitch.Octave) > barToMusic :: String -> Accum -> ([Melody.T ()], Accum) > barToMusic [] accum = ([], accum) > barToMusic (c:cs) (dur, oct) = > let charToDur dc = 1 %+ read (dc:[]) > prependAtom atom adur (ms, newAccum) = > (atom adur : ms, newAccum) > procNote ndur pitch c0s = > let mkNote c1s = prependAtom (flip (Melody.note (oct, pitch)) ()) > ndur (barToMusic c1s (dur, oct)) > in case c0s of > '#':c1s -> procNote ndur (succ pitch) c1s > '-':c1s -> procNote ndur (pred pitch) c1s > c1 :c1s -> if '0'<=c1 && c1<='9' > then procNote (charToDur c1) pitch c1s > else mkNote c0s > [] -> mkNote c0s > in case c of > 'c' -> procNote dur Pitch.C cs > 'd' -> procNote dur Pitch.D cs > 'e' -> procNote dur Pitch.E cs > 'f' -> procNote dur Pitch.F cs > 'g' -> procNote dur Pitch.G cs > 'a' -> procNote dur Pitch.A cs > 'b' -> procNote dur Pitch.B cs > 'p' -> let (c1:c1s) = cs > in prependAtom Music.rest (charToDur c1) > (barToMusic c1s (dur, oct)) > '<' -> barToMusic cs (dur, oct-1) > '>' -> barToMusic cs (dur, oct+1) > 'l' -> let (c1:c1s) = cs > in barToMusic c1s (charToDur c1, oct) > _ -> error ("unexpected character '"++[c]++"' in Haskore.Interface.MML description") > toMusicState :: String -> State Accum [Melody.T ()] > toMusicState s = state (barToMusic s) > toMusic :: Pitch.Octave -> String -> Melody.T () > toMusic oct s = Music.line (evalState (toMusicState s) (0, oct)) \end{haskelllisting} haskore-0.2.0.3/src/Haskore/Interface/CSound.lhs0000644000000000000000000000620711754016451017473 0ustar0000000000000000\subsection{CSound} \seclabel{csound} \newcommand\genparagraph[1]{ \hypertarget{csound-gen{#1}}{\subparagraph*{GEN{#1}.}} } \newcommand\refgen[1]{\hyperlink{csound-gen{#1}}{GEN{#1}}} \begin{haskelllisting} > module Haskore.Interface.CSound where \end{haskelllisting} [Note: if this module is loaded into Hugs98, the following error message may result: \begin{haskelllisting} Reading file "CSound.lhs": ERROR "CSound.lhs" (line 707): *** Cannot derive Eq OrcExp after 40 iterations. *** This may indicate that the problem is undecidable. However, *** you may still try to increase the cutoff limit using the -c *** option and then try again. (The current setting is -c40) \end{haskelllisting} This is apparently due to the size of the {\tt OrcExp} data type. For correct operation, start Hugs with a larger cutoff limit, such as {\tt -c1000}.] CSound is a software synthesizer that allows its user to create a virtually unlimited number of sounds and instruments. It is extremely portable because it is written entirely in C. Its strength lies mainly in the fact that all computations are performed in software, so it is not reliant on sophisticated musical hardware. The output of a CSound computation is a file representing the signal which can be played by an independent application, so there is no hard upper limit on computation time. This is important because many sophisticated signals take much longer to compute than to play. The purpose of this module is to create an interface between Haskore and CSound in order to give the Haskore user access to all the powerful features of a software sound synthesizer. CSound takes as input two plain text files: a \keyword{score} (.sco) file and an \keyword{orchestra} (.orc) file. The score file is similar to a Midi file, and the orchestra file defines one or more \keyword{instrument}s that are referenced from the score file (the orchestra file can thus be thought of as the software equivalent of Midi hardware). The CSound program takes these two files as input, and produces a \keyword{sound file} as output, usually in {\tt .wav} format. Sound files are generally much larger than Midi files, since they describe the actual sound to be generated, represented as a sequence of values (typically 44,100 of them for each second of music), which are converted directly into voltages that drive the audio speakers. Sound files can be played by any standard media player found on conventional PC's. Each of these files is described in detail in the following sections. Here are some common definitions: \begin{haskelllisting} > newtype Instrument = Instrument Int > deriving (Show, Eq) > instrument :: Int -> Instrument > instrument = Instrument > instruments :: [Instrument] > instruments = map instrument [1..] > instrumentToNumber :: Instrument -> Int > instrumentToNumber (Instrument n) = n > showInstrumentNumber :: Instrument -> String > showInstrumentNumber = show . instrumentToNumber > type Name = String > type Velocity = Float > type PField = Float > type Time = Float \end{haskelllisting} \input{Haskore/Interface/CSound/Score.lhs} \input{Haskore/Interface/CSound/Orchestra.lhs} haskore-0.2.0.3/src/Haskore/Interface/MIDI.lhs0000644000000000000000000000066411754016451017023 0ustar0000000000000000 > module Haskore.Interface.MIDI > (module Sound.MIDI.File, > module Haskore.Interface.MIDI.Read, > module Haskore.Interface.MIDI.Write, > module Sound.MIDI.File.Load, > module Sound.MIDI.File.Save) > where > > import Sound.MIDI.File > import Haskore.Interface.MIDI.Read > import Haskore.Interface.MIDI.Write > import Sound.MIDI.File.Load > import Sound.MIDI.File.Save haskore-0.2.0.3/src/Haskore/Interface/AutoTrack/0000755000000000000000000000000011754016452017461 5ustar0000000000000000haskore-0.2.0.3/src/Haskore/Interface/AutoTrack/EventChart.lhs0000644000000000000000000000312011754016451022227 0ustar0000000000000000% from AutoTrack by Stefan Ratschan \begin{haskelllisting} > module Haskore.Interface.AutoTrack.EventChart > (T(Cons), events, fromChordChart, fromChartBar) where > import qualified Haskore.Music as Music > import qualified Haskore.Interface.AutoTrack.ChartBar as ChartBar > import qualified Haskore.Interface.AutoTrack.ChordChart as ChordChart > import qualified Haskore.Interface.AutoTrack.ChordSymbol as ChordSymbol > import qualified Haskore.Interface.AutoTrack.Transposeable as Transposeable > import qualified Haskore.Basic.Duration as Dur > import qualified Data.List as List > import Data.Maybe(fromJust) \end{haskelllisting} Event charts are currently not used. An event chart represents a list of objects of a certain type and duration (the ``events''). \begin{haskelllisting} > data T e = Cons {events :: [ (Music.Dur, e) ] } deriving Show > fromChordChart :: ChordChart.T -> T ChordSymbol.T > fromChordChart (ChordChart.Cons c) = > Cons (concatMap (events . fromChartBar) c) > fromChartBar :: ChartBar.T -> T ChordSymbol.T > fromChartBar (ChartBar.Cons d l) = > let f c = (d / Dur.fromRatio (List.genericLength l), fromJust c) > in Cons (map f l) \end{haskelllisting} Transpose an event chart by a certain number of semitones \begin{haskelllisting} > instance (Transposeable.C a) => Transposeable.C (T a) where > transpose i = fmap (Transposeable.transpose i) \end{haskelllisting} Event charts can also act as functors: \begin{haskelllisting} > instance Functor T where > fmap f (Cons v) = Cons (map ( \(d, c) -> (d, f c) ) v) \end{haskelllisting} haskore-0.2.0.3/src/Haskore/Interface/AutoTrack/ChartBar.lhs0000644000000000000000000000521211754016451021656 0ustar0000000000000000% from AutoTrack by Stefan Ratschan \section{Chord-Symbol-, Scale- and other Charts} \label{sec:charts} \begin{haskelllisting} > module Haskore.Interface.AutoTrack.ChartBar > (T(Cons), dur, chords, readChordSymbol, > length) where > import qualified Haskore.Music as Music > import qualified Data.List as List > import qualified Haskore.Interface.AutoTrack.ChordSymbol as ChordSymbol > import qualified Haskore.Interface.AutoTrack.Transposeable as Transposeable > import Data.Char(isSpace, isAlpha) > import Haskore.Basic.Duration(wn, (%+), ) > import Prelude hiding (length) \end{haskelllisting} A bar consists of a time signature and a list of chord symbols. Bars have the following input syntax: \begin{verbatim} bar = { chord | timeSig | '%' | '_' } timeSig = '(' int '/' int ')' \end{verbatim} If no time signature is provided then a default is used (within chord chart the time signature of the bar before, and 4/4 for the first bar). The character '\%' is a short-cut for the chords just before. The character '\_' denotes a break. \begin{haskelllisting} > data T = Cons { > dur :: Music.Dur, > chords :: [ Maybe ChordSymbol.T ] > } deriving Show > > length :: Integral a => T -> a > length = fromIntegral . List.length . chords > instance Read T where > readsPrec _ = readChordSymbol wn Nothing > readChordSymbol :: Music.Dur -> Maybe ChordSymbol.T -> ReadS T > readChordSymbol oldSig oldChord (c:s) | isSpace c = readChordSymbol oldSig oldChord s > readChordSymbol _ oldChord s@('(':_) = > [ (Cons r b, r2) | (r, r1) <- readSig s, > (Cons _ b, r2) <- readChordSymbol r oldChord r1 ] > readChordSymbol oldSig (Just chord) ('%':r) = > [ (Cons oldSig (Just chord:b), r1) | (Cons _ b, r1) <- readChordSymbol oldSig (Just chord) r ] > readChordSymbol oldSig (Just _) ('_':r) = > [ (Cons oldSig (Nothing:b), r1) | (Cons _ b, r1) <- readChordSymbol oldSig Nothing r ] > readChordSymbol oldSig _ s@(d:_) | isAlpha d = > [ (Cons oldSig (Just c:b), r2) | (c, r1) <- reads s, > (Cons _ b, r2) <- readChordSymbol oldSig (Just c) r1 ] > readChordSymbol oldSig _ s = [ (Cons oldSig [], s) ] > > readSig :: ReadS Music.Dur > readSig s@('(':_) = > let readRatio s' = > [ (p%+q, r1) | > (p,'/':r) <- reads s', (q, r1) <- reads r ] > in readParen True readRatio s > readSig _ = [] \end{haskelllisting} Bars can be transposed. \begin{haskelllisting} > instance Transposeable.C T where > transpose i (Cons d l) = Cons d (fmap (fmap (Transposeable.transpose i)) l) \end{haskelllisting} haskore-0.2.0.3/src/Haskore/Interface/AutoTrack/Option.lhs0000644000000000000000000001117311754016452021444 0ustar0000000000000000% from AutoTrack by Stefan Ratschan For extracting the options from the command line we use the \texttt{GetOpt} package proviced by \texttt{ghc}. This is currently a little bit of a mess. It should be reimplemented using the technique described at \url{http://www.haskell.org/haskellwiki/GetOpt}. \begin{haskelllisting} > module Option(T, getAll) where > import qualified Haskore.Music.GeneralMIDI as MidiMusic > import qualified Haskore.Interface.AutoTrack.Style as Style > import qualified Haskore.Interface.AutoTrack.ChordChart as ChordChart > import System.Console.GetOpt (getOpt, usageInfo, > ArgDescr(NoArg, ReqArg), OptDescr(Option), ArgOrder(Permute)) > import System.Environment (getArgs) > import System.Exit (exitWith, ExitCode(ExitSuccess, ExitFailure)) > import Haskore.General.Utility (headWithDefault) > import Data.Maybe (listToMaybe, mapMaybe) > import Data.List (intersperse) > {- > Should be a record with one constructor and multiple fields, i.e. > data T = Cons {optError :: String, optTempo :: Integer, ...} > This should replace Tuple. > -} > data T = Error String > | Tempo Integer > | Style Style.T > | Transpose Int > | Choruses Int > | Help > isHelp :: T -> Bool > isHelp Help = True > isHelp _ = False > errorToMaybe :: T -> Maybe String > errorToMaybe (Option.Error m) = Just m > errorToMaybe _ = Nothing > -- should be [ OptDescr (T -> T) ] > options :: [ OptDescr T ] > options = [ Option [ 't' ] [ "tempo" ] (ReqArg tempoOption "TEMPO") "TEMPO of track", > Option [ 'r' ] [ "transpose" ] (ReqArg transposeOption "TRANSPOSE") "TRANSPOSE track", > Option [ 's' ] [ "style" ] (ReqArg styleOption "STYLE") "music STYLE", > Option [ 'c' ] [ "choruses" ] (ReqArg chorusesOption "CHORUSES") "number of CHORUSES", > Option [ 'h' ] [ "help" ] (NoArg Option.Help) "display usage" ] > tempoOption, transposeOption, styleOption, > chorusesOption :: String -> T > tempoOption = Option.Tempo . read > transposeOption = Option.Transpose . read > styles :: [(String, ChordChart.T -> MidiMusic.T)] > styles = [("jazz", Style.jazz), > ("bossa", Style.bossa), > ("takeFive", Style.takeFive), > ("rock", Style.rock), > ("harmonic", Style.harmonic)] > styleOption s = > maybe (Option.Error ("Unknown style '"++s++"'\n")) > Option.Style (lookup s styles) > chorusesOption = Choruses . read > usage :: String > usage = usageInfo "\nUsage: track [OPTION...] outfile\n" options ++ > "\nAvailable styles: " ++ concat (intersperse ", " (map fst styles)) ++ "\n\n" ++ > "This program is free software; you can redistribute it and/or\n" ++ > "modify it under the terms of the GNU General Public License\n" ++ > "as published by the Free Software Foundation; either version 2\n" ++ > "of the License, or (at your option) any later version.\n\n" ++ > "This program is distributed in the hope that it will be useful,\n" ++ > "but WITHOUT ANY WARRANTY; without even the implied warranty of\n" ++ > "MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n" ++ > "GNU General Public License for more details.\n" > processAll :: [String] -> IO [T] > processAll argv = > case (getOpt Permute options argv) of > (o,_,[] ) -> return o > (_,_,errs) -> fail (concat errs ++ usage) > getDefault :: (a -> Maybe b) -> [ a ] -> b -> b > getDefault b t def = headWithDefault def (mapMaybe b t) > getTempo :: T -> Maybe Integer > getTempo (Option.Tempo t) = Just t > getTempo _ = Nothing > getTrans, getChoruses :: T -> Maybe Int > getTrans (Option.Transpose t) = Just t > getTrans _ = Nothing > getChoruses (Option.Choruses c) = Just c > getChoruses _ = Nothing > getStyle :: T -> Maybe (ChordChart.T -> MidiMusic.T) > getStyle (Option.Style s) = Just s > getStyle _ = Nothing > type Tuple = (Integer, Style.T, Int, Int) > toTuple :: [ T ] -> Tuple > toTuple l = (getDefault getTempo l 120, > getDefault getStyle l Style.jazz, > getDefault getTrans l 0, > getDefault getChoruses l 5) > exit :: Bool -> String -> IO a > exit c m = do putStr (m ++ usage) > if c then exitWith ExitSuccess else exitWith (ExitFailure 1) > getError :: [ T ] -> Maybe String > getError = listToMaybe . mapMaybe errorToMaybe > getAll :: IO Tuple > getAll = do opts <- (getArgs >>= processAll) > if any isHelp opts > then exit True "" > else maybe (return (toTuple opts)) (exit False) (getError opts) \end{haskelllisting} haskore-0.2.0.3/src/Haskore/Interface/AutoTrack/ScaleChart.lhs0000644000000000000000000000114411754016451022201 0ustar0000000000000000% from AutoTrack by Stefan Ratschan \begin{haskelllisting} > module Haskore.Interface.AutoTrack.ScaleChart(T(Cons)) where > import qualified Haskore.Basic.Scale as Scale \end{haskelllisting} A certain type of event chart is a scale chart. \begin{haskelllisting} > newtype T = Cons Scale.T \end{haskelllisting} Conversion from chord chart to ScaleChart. This needs to be improved into a sophisticated scale analyzer. \begin{haskelllisting} fromChord :: (EventChart.T ChordSym) -> T fromChord (EventChart.C c) = let f d ch = (d, chordToScale ch) in Cons (map f c) \end{haskelllisting} haskore-0.2.0.3/src/Haskore/Interface/AutoTrack/Style.lhs0000644000000000000000000002740011754016451021273 0ustar0000000000000000% from AutoTrack by Stefan Ratschan \section{Styles} \begin{haskelllisting} > module Haskore.Interface.AutoTrack.Style > (T, playToStream, jazz, bossa, takeFive, rock, > thomasCarib, harmonic) where > import Data.Bool.HT (select, ) > import Data.List.HT (viewR, ) > import Haskore.Basic.Duration (en, qn, (%+), ) > import Haskore.Music ((+:+), (=:=), ) > import qualified Haskore.Composition.Rhythm as Rhythm > import qualified Haskore.Composition.Drum as Drum > import qualified Haskore.Basic.Duration as Dur > import qualified Haskore.Basic.Pitch as Pitch > import qualified Haskore.Music as Music > import qualified Haskore.Music.GeneralMIDI as MidiMusic > import qualified Haskore.Melody as Melody > import qualified Haskore.Interface.MIDI.Render as MidiRender > import qualified Sound.MIDI.File.Save as MidiSave > import qualified Haskore.Interface.AutoTrack.Transposeable as Transposeable > import qualified Haskore.Interface.AutoTrack.ChordSymbol as ChordSymbol > import qualified Haskore.Interface.AutoTrack.ChartBar as ChartBar > import qualified Haskore.Interface.AutoTrack.ChordChart as ChordChart > import qualified Haskore.Interface.AutoTrack.EventChart as EventChart > import qualified Haskore.Interface.AutoTrack.Instrument as Instrument > import qualified Data.ByteString.Lazy as B \end{haskelllisting} A style takes a chord chart and creates some music out of it. \begin{haskelllisting} > type T = ChordChart.T -> MidiMusic.T > type TMelody = ChordChart.T -> Melody.T () \end{haskelllisting} \subsection{Filtering music} Filtering certain parts from music, in order to introduce rests \emph{after} the creation of some music. The needed information can be encoded in several ways: \begin{enumerate} \item [ (Music.Dur, Music.Dur) ]: Place of rest, length of rest, sorted \item [ Music.Dur ]: Place to switch from rest to music, or other way round \item Music.Dur [ Bool ]: Some basic duration and then True implies music, False implies Rest \end{enumerate} We use the third possibility here, but use a helper function with a more general interface, which additionally specifies the length of the first list member (different from the basic duration). \begin{haskelllisting} > filterMusic :: Music.Dur -> [ Bool ] -> Music.T note -> Music.T note > filterMusic = fm 0 > fm :: Music.Dur -> Music.Dur -> [ Bool ] -> Music.T note -> Music.T note > fm fDur bDur plc = > Music.switchBinary > (\dur at -> case at of > (Just _) -> Music.atom (min dur (musicDur fDur bDur plc)) at > (Nothing) -> Music.rest dur) > (\ctrl m -> case ctrl of > (Music.Tempo t) -> Music.changeTempo t (fm (fDur*t) (bDur*t) plc m) > _ -> Music.control ctrl m) > (\m0 m1 -> let m0' = fm fDur bDur plc m0 > (rFDur, rPlc) = remLen bDur plc (Music.dur m0 - fDur) > m1' = fm rFDur bDur rPlc m1 > in m0' +:+ m1') > (\m0 m1 -> fm fDur bDur plc m0 =:= fm fDur bDur plc m1) > (Music.rest 0) > remLen :: Music.Dur -> [ Bool ] -> Music.Dur -> (Music.Dur, [ Bool ]) > remLen bDur plc len = > if bDur>len > then (bDur-len, plc) > else (len-bDur, tail plc) > musicDur :: (Num a) => a -> a -> [Bool] -> a > musicDur fDur bDir plc = > sum (zipWith const (fDur : repeat bDir) (takeWhile id plc)) > -- sum (map fst (takeWhile snd (zip (fDur : repeat bDir) plc))) \end{haskelllisting} \subsection{Playing Styles} Playing a chord chart and style into a stream of binary MIDI data. We abuse a String to store it. \begin{haskelllisting} > playToStream :: Int -> T -> Integer -> Int -> ChordChart.T -> B.ByteString > playToStream trans style tempo chornum chart = > let countin = Rhythm.countIn (ChartBar.dur (head (ChordChart.bars chart))) > choruses = Music.replicate chornum (style (Transposeable.transpose trans chart)) > music = Music.changeTempo (tempo%+60) (countin +:+ choruses) > in MidiSave.toByteString (MidiRender.generalMidiDeflt music) \end{haskelllisting} \subsection{Drum Fill} \begin{haskelllisting} > jazzFill :: Music.Dur -> MidiMusic.T > jazzFill d = > if d >= 2%+4 > then > let shuffle dr = > Rhythm.toShuffledMusicWithDrumUnit en dr . Rhythm.fromString > in Music.rest (d-2%+4) +:+ > (shuffle Drum.SplashCymbal "...x" =:= > shuffle Drum.AcousticBassDrum "...x" =:= > shuffle Drum.AcousticSnare ".xx.") > else error "jazzFill: d must be at least 2%+4" > endFill :: [ ChartBar.T ] -> MidiMusic.T > endFill l = > let Just (initLd,lastLd) = viewR $ map ChartBar.dur l > in Music.line (map Music.rest initLd) +:+ > jazzFill lastLd \end{haskelllisting} \subsection{Bass Lines} First some auxiliary function to play the bass note of a chord. \begin{haskelllisting} > bassFromMelody :: Melody.T () -> MidiMusic.T > bassFromMelody = > MidiMusic.fromMelodyNullAttr MidiMusic.AcousticBass > bassChoose :: (Music.Dur, ChordSymbol.T) -> Melody.T () > bassChoose (l, (ChordSymbol.Cons _ b _)) = bassNote l b > bassNote :: Music.Dur -> Pitch.Class -> Melody.T () > bassNote l b = > Melody.note (Instrument.bottomRange Instrument.bass b) l () \end{haskelllisting} \subsubsection{Chart Bass} This bass line style plays the root of a chord on every chord of a chord chart. \begin{haskelllisting} > evFromCC :: ChordChart.T -> [(Music.Dur, ChordSymbol.T)] > evFromCC = EventChart.events . EventChart.fromChordChart > chartBass :: TMelody > chartBass = > Music.line . map bassChoose . evFromCC \end{haskelllisting} \subsubsection{Quarter Bass} This bass line style plays the root of the current chord on every quarter note. It first creates chords on every beat, then maps bassChoose to it. Problem: Right now only works if all chords are on quarter notes! \begin{haskelllisting} > splitToDur :: Music.Dur -> [ ( Music.Dur, e ) ] -> [ ( Music.Dur, e ) ] > splitToDur sd = > concatMap (\(d,e) -> replicate (fromInteger (Dur.divide d sd)) (sd, e)) > quarterBass :: TMelody > quarterBass = > Music.line . map bassChoose . splitToDur (1%+4) . evFromCC > eighthBass :: TMelody > eighthBass = > Music.line . map bassChoose . splitToDur (1%+8) . evFromCC \end{haskelllisting} \subsubsection{Bossa Bass} A simple bass for Bossas using the bass note and its fifth. \begin{haskelllisting} > bossaBass :: TMelody > bossaBass = Music.line . map bossaBassC . evFromCC > bossaBassC :: (Music.Dur, ChordSymbol.T) -> Melody.T () > bossaBassC (l, ch@(ChordSymbol.Cons r _ _)) = > let r7 = Transposeable.transpose 7 r > bossa' = bassNote (3%+8) r +:+ bassNote (1%+8) r7 +:+ > bassNote (1%+2) r7 +:+ > bossaBassC (l - 1%+1, ch) > in select (bassChoose (l, ch)) > [(l >= 1%+1, bossa'), > (l >= 1%+2, bassNote (3%+8) r +:+ bassNote (1%+8) r)] \end{haskelllisting} \subsubsection{Walking Bass Line} Creating a good walking bass is a science in itself. There are numerous books which give various rules for creating good bass lines. The following code is still VERY experimental and just follows these basic rules: \begin{itemize} \item Create the root on the first quarter note of a chord, and \item create random quarter notes of the appropriate scale for the rest. \end{itemize} We do this by creating a walking bass line for every chord of a chart separately and then concatenating the created bass lines. \begin{haskelllisting} walking :: T walking = Music.line . map walkChord . evFromCC c \end{haskelllisting} Walking bass line for a single chord of a certain length. Take the root for the first note and random notes for the rest. \begin{haskelllisting} walkChord :: (Music.Dur, ChordSymbol.T) -> Melody.T () walkChord (d, ch) | (divisible d (1%+4)) = bassChoose ((1%+4), ch) +:+ walkRandom ((divide d (1%+4))-1) ch \end{haskelllisting} Create a random walking bass line of n quarter notes using chord ch. \begin{haskelllisting} walkRandom :: Int -> ChordSymbol.T -> Melody.T () walkRandom n ch = let scale = (chordToScale ch) choice = \n -> bassChooseR n (1%+4, scale) in line (map choice (take n (randList (length scale)))) bassChooseR :: Int -> (Music.Dur, Scale) -> Melody.T () bassChooseR n (d, s) = Melody.note d (pitch (s!!n)) () \end{haskelllisting} \subsection{Full Styles} The jazz style works for 3/4 and 4/4 measure. It currently does not yet use walking bass, but uses the quarter bass style above. \begin{haskelllisting} > jazzDrum :: Music.Dur -> MidiMusic.T > jazzDrum d = > select (error "jazzDrum supports only 3%+4 and 4%+4") > [(d==3%+4, Rhythm.jazzWaltzRideP Drum.RideCymbal2 =:= > Rhythm.jazzWaltzHiHatP Drum.PedalHiHat), > (d==4%+4, Music.replicate 2 > (Rhythm.jazzRideP Drum.RideCymbal2 =:= > Rhythm.backBeatP Drum.PedalHiHat))] > jazz :: T > jazz s = let drums = Music.line (map (jazzDrum . ChartBar.dur) (ChordChart.bars s)) =:= > endFill (ChordChart.bars s) > (bd, hc) = ChordChart.hasChord s > in filterMusic bd hc drums =:= > bassFromMelody (quarterBass s) > \end{haskelllisting} The bossa style just plays the usual bossa clave with the hi-hat on the backbeat and some simple bass. \begin{haskelllisting} > bossa :: T > bossa c = let drums = Music.repeat Rhythm.claveBossa =:= > Music.repeat Rhythm.ride =:= > Music.repeat (Rhythm.backBeatP Drum.PedalHiHat) > bass = bassFromMelody (bossaBass c) > in Music.take ((4 * ChordChart.length c) %+ 4) drums =:= bass \end{haskelllisting} The Take-Five style works for charts with 5/4 measures only. \begin{haskelllisting} > takeFiveBass :: ChartBar.T -> Melody.T () > takeFiveBass b = > if ChartBar.dur b == 5%+4 && length (ChartBar.chords b) <= 2 > then > let c=ChartBar.chords b > bass d Nothing = Music.rest d > bass d (Just x) = bassChoose (d, x) > in if length c == 2 > then bass (3%+4) (c!!0) +:+ bass (2%+4) (c!!1) > else bass (3%+4) (c!!0) +:+ bass (2%+4) (c!!0) > else error "takeFiveBass: only allowed for 5%+4 and maximally 2 chords per bar" > takeFive :: T > takeFive (ChordChart.Cons l) = > let rep pat = concat (replicate (length l) (Rhythm.fromString pat)) > hiHatR = rep "..x .x" > cymbalR = rep "x. xx x. x. xx" > in Rhythm.toMusicWithDrumUnit qn Drum.PedalHiHat hiHatR =:= > Rhythm.toShuffledMusicWithDrumUnit en Drum.RideCymbal2 cymbalR =:= > endFill l =:= > bassFromMelody (Music.line (map takeFiveBass l)) \end{haskelllisting} The rock style just plays the usual hi-hat eights, bass drum on downbeat, snare on backbeat. \begin{haskelllisting} > rock :: T > rock c = let drums = Music.repeat Rhythm.basicBassDrum =:= > Music.repeat Rhythm.basicSnare =:= > Music.repeat Rhythm.basicHiHat > bass = bassFromMelody (eighthBass c) > in Music.take ((4 * ChordChart.length c) %+ 4) drums =:= bass \end{haskelllisting} This style is not yet finished. \begin{haskelllisting} > thomasCarib :: T > thomasCarib c = > Rhythm.backBeatP Drum.PedalHiHat =:= > Rhythm.basicBassDrum =:= > Rhythm.toShuffledMusicWithDrumUnit en Drum.Claves > (Rhythm.fromString ".. .x .x x.") =:= > bassFromMelody (chartBass c) \end{haskelllisting} This is a rather simple style where the tones of a chord a played simultaneously. \begin{haskelllisting} > harmonic :: T > harmonic = > let chordSymbolToMusic (dur, cs) = Music.chord $ > map (\p -> Melody.note p dur ()) $ > ChordSymbol.toChord cs > in bassFromMelody . Music.line . > map chordSymbolToMusic . evFromCC \end{haskelllisting} haskore-0.2.0.3/src/Haskore/Interface/AutoTrack/ChordSymbol.lhs0000644000000000000000000000647111754016451022425 0ustar0000000000000000% from AutoTrack by Stefan Ratschan \section{Chord Symbols} \begin{haskelllisting} > module Haskore.Interface.AutoTrack.ChordSymbol > (T(Cons, root, chordType), > toChord, > toString, parse) where > import qualified Haskore.Interface.AutoTrack.Transposeable as Transposeable > import qualified Haskore.Basic.Pitch as Pitch > -- import qualified Haskore.Basic.Scale as Scale > import qualified Haskore.Composition.ChordType as ChordType > import qualified Text.ParserCombinators.ReadP as ReadP > import Text.ParserCombinators.ReadP (ReadP) > import Data.Tuple.HT (mapSnd, ) \end{haskelllisting} A chord symbol consists of its root, its bass note, and the description of the type of chord. The chord type description is currently in free (string) form and only used by some very experimental code. \begin{haskelllisting} > data T = Cons { root :: Pitch.Class, > bassnote :: Pitch.Class, > chordType :: ChordType.T } deriving Eq \end{haskelllisting} Now we define input and output of chord symbols. Note that we denote sharp and flat root notes by '\#' and 'b' respectively, instead of 's' and 'f' as in Haskore. \begin{haskelllisting} > instance Show T where > showsPrec _ ch = > ("(ChordSymbol "++) . > shows (root ch) . (" "++) . > shows (bassnote ch) . (" "++) . > shows (chordType ch) . (")"++) > instance Read T where > readsPrec _ = ReadP.readP_to_S parse > parse :: ReadP T > parse = > do r <- parsePitch > t <- ChordType.parse > b <- return r ReadP.+++ > (ReadP.char '/' >> parsePitch) > return (Cons r b t) > parsePitch :: ReadP Pitch.Class > parsePitch = ReadP.readS_to_P readSPitch > readSPitch :: ReadS Pitch.Class > readSPitch (p:'#':r) = continueReadS r (p:"s") > readSPitch (p:'b':r) = continueReadS r (p:"f") > readSPitch (p:r) = continueReadS r [p] > readSPitch "" = [] -- error "readSPitch: empty string" > continueReadS :: (Read a) => String -> ReadS a > continueReadS r p = map (mapSnd (++r)) (reads p) \end{haskelllisting} We also can transpose chord symbols. \begin{haskelllisting} > instance Transposeable.C T where > transpose i c = Cons (Transposeable.transpose i (root c)) > (Transposeable.transpose i (bassnote c)) > (chordType c) \end{haskelllisting} Now we are going to determine the according scale for various chords. Not that such ``default scales'' exist only for some few chords. We plan to implement a detailed scale analyzer for chord charts (see section~\ref{sec:charts}) in the future. \begin{haskelllisting} > {- > toScale :: T -> Scale.T > toScale (Cons {root=r, chordType=ct}) = > (case ct of > Type ThirdMajor FourthNone [] -> Scale.ionian > Type ThirdMinor FourthNone [] -> Scale.dorian > _ -> error ("ChordSymbol.toScale: unknown chord type " ++ show ct)) r > -} > > toChord :: T -> [Pitch.T] > toChord (Cons {root=r, chordType=ct}) = > map (flip Pitch.transpose (0,r)) (ChordType.toChord ct) > > toString :: T -> String > toString chord = > let rp = root chord > bp = bassnote chord > in Pitch.classFormat rp > (ChordType.toString (chordType chord)) > ++ if rp == bp then "" else "/"++Pitch.classFormat bp "" \end{haskelllisting} haskore-0.2.0.3/src/Haskore/Interface/AutoTrack/Transposeable.lhs0000644000000000000000000000111111754016451022764 0ustar0000000000000000% from AutoTrack by Stefan Ratschan \subsection{Class of transposeable objects} \begin{haskelllisting} > module Haskore.Interface.AutoTrack.Transposeable(C, transpose) where > import qualified Haskore.Basic.Pitch as Pitch \end{haskelllisting} \subsection{Haskore Additions} Here we turn to some stuff that really belongs into the Haskore core. First transposition of pitch classes: \begin{haskelllisting} > class C a where > transpose :: Int -> a -> a > instance C Pitch.Class where > transpose i pc = snd (Pitch.fromInt (Pitch.classToInt pc + i)) \end{haskelllisting} haskore-0.2.0.3/src/Haskore/Interface/AutoTrack/ChordChart.lhs0000644000000000000000000000603411754016451022214 0ustar0000000000000000% from AutoTrack by Stefan Ratschan \begin{haskelllisting} > module Haskore.Interface.AutoTrack.ChordChart > (T(Cons), bars, hasChord, > length, concat) where > import qualified Haskore.Music as Music > import qualified Haskore.Interface.AutoTrack.ChartBar as ChartBar > import qualified Haskore.Interface.AutoTrack.Transposeable as Transposeable > import qualified Haskore.Basic.Duration as Dur > import Haskore.Basic.Duration (wn, (%+), ) > import Data.Char(isSpace) > import qualified Data.List as List > import Prelude hiding (length, concat) \end{haskelllisting} Chord charts are lists of bars. They have the following input syntax: \begin{verbatim} chart = { (bar | '%') '|' } \end{verbatim} The character '\%' is a shortcut for the same bar as before. Comments can occur everywhere in the text. They start with "--" and continue till the end of the current line. \begin{haskelllisting} > data T = Cons {bars :: [ ChartBar.T ] } deriving Show > length :: Integral a => T -> a > length = fromIntegral . List.length . bars > instance Read T where > readsPrec _ = Haskore.Interface.AutoTrack.ChordChart.read > concat :: T -> T -> T > concat (Cons x) (Cons y) = Cons (x++y) > read :: ReadS T > read s = read1 (ChartBar.Cons wn []) (filterComment s) > filterComment :: String -> String > filterComment ('-':'-':r) = filterComment (tail (snd (break (=='\n') r))) > filterComment (c:r) = (c:filterComment r) > filterComment "" = "" > read1 :: ChartBar.T -> ReadS T > read1 lb (c:r) | isSpace c = > read1 lb (dropWhile isSpace r) > read1 lb ('%':r) = > [ (Cons (lb:br), r2) | > ('|':r1) <- [ dropWhile isSpace r ], > (Cons br, r2) <- read1 lb r1 ] > read1 (ChartBar.Cons sig _) s@(_:_) = > [ (Cons (b:br), r1) | > (b, ('|':r)) <- ChartBar.readChordSymbol sig Nothing s, > (Cons br, r1) <- read1 b r ] > read1 _ s = [ (Cons [], s) ] \end{haskelllisting} Chord charts can be transposed. \begin{haskelllisting} > instance Transposeable.C T where > transpose i (Cons c) = Cons (fmap (Transposeable.transpose i) c) \end{haskelllisting} We can extract a Boolean list from a chord chart that tells whether there is a chord at a certain position (hc[i] is true iff d*i has a chord). \begin{haskelllisting} > hasChord :: T -> (Music.Dur, [ Bool ] ) > hasChord c = > let g = barGCD c > in (g, hasChord1 g c) > hasChord1 :: Music.Dur -> T -> [ Bool ] > hasChord1 bDur (Cons c) = List.concat (map (hasChordBar bDur) c) > barUnit :: ChartBar.T -> Music.Dur -> Dur.Ratio > barUnit bar d = d * (1 %+ ChartBar.length bar) > hasChordBar :: Music.Dur -> ChartBar.T -> [ Bool ] > hasChordBar bDur bar@(ChartBar.Cons d chords) = > let times = > fromInteger > (Dur.divide (barUnit bar d) bDur) > createList = replicate times . maybe False (const True) > in concatMap createList chords > barGCD :: T -> Music.Dur > barGCD (Cons c) = > let chordDur bar = barUnit bar (ChartBar.dur bar) > in foldr1 Dur.gcd (map chordDur c) \end{haskelllisting} haskore-0.2.0.3/src/Haskore/Interface/AutoTrack/Instrument.lhs0000644000000000000000000000210311754016451022334 0ustar0000000000000000% from AutoTrack by Stefan Ratschan \section{Instruments} \begin{haskelllisting} > module Haskore.Interface.AutoTrack.Instrument > (T, bass, bottomRange, topRange) where > import qualified Haskore.Basic.Pitch as Pitch \end{haskelllisting} Here we store various information about instruments. Currently the only information is the range of an instrument (its highest possible and lowest possible note). \begin{haskelllisting} > data T = Cons { lowest, highest :: Pitch.T } > bass :: T > bass = Cons { lowest=(2, Pitch.E), highest=(7, Pitch.G) } -- ??? \end{haskelllisting} Create the deepest/highest note of a certain pitchclass, that an instrument can create. \begin{haskelllisting} > bottomRange :: T -> Pitch.Class -> Pitch.T > bottomRange instr cl = > let (boct, bcl) = lowest instr > in if cl > bcl > then (boct, cl) > else (boct+1, cl) > topRange :: T -> Pitch.Class -> Pitch.T > topRange instr cl = > let (boct, bcl) = highest instr > in if cl < bcl > then (boct, cl) > else (boct-1, cl) \end{haskelllisting} haskore-0.2.0.3/src/Haskore/Interface/AutoTrack/Main.lhs0000644000000000000000000001320711754016452021060 0ustar0000000000000000% from AutoTrack by Stefan Ratschan \documentclass[10pt]{article} \usepackage[a4paper, margin=3cm]{geometry} \usepackage{url} \usepackage{color} \definecolor{darkgrey}{rgb}{0.4,0.4,0.4} \definecolor{lightgrey}{rgb}{0.95,0.95,0.95} \usepackage{listings} \lstset{% language=Haskell, showstringspaces=false, basicstyle=\ttfamily, keywordstyle=\textbf, commentstyle=\highlightcomment, backgroundcolor=\color{lightgrey}} \newcommand\highlightcomment[1]{\textsl{\color{darkgrey}#1}} \lstnewenvironment{haskelllisting} {\lstset{language=Haskell,gobble=2,firstline=2}}{} \lstnewenvironment{haskellblock} {\mbox{}\\\lstset{language=Haskell}}{} \newcommand{\STitle}{\texttt{AutoTrack}} \title{\STitle} \author{Stefan Ratschan} \begin{document} \maketitle \section{Introduction} This software has a short term and a long term goal. The short term goal is a tool for creating practicing tracks for musicians. For this it is already usable: You feed it with some chord chart, tell it the style of music, and it outputs some MIDI file with a simple drum and bass track over these chords. The long term goal is a sophisticated high-level composing environment, especially useful for creating demos for bands. You should be able to make instructions like: Give me four bars of mainstream jazz over these chords, then switch to heavy-metal, using this melody and these chords, afterwards a short drum break, and so on. Under Microsoft Windows there are a lot of different programs for music production systems (Cubase, Band-In-A-Box, Finale). Instead of such WYSIWYG systems, the UNIX world has traditionally used language-based approaches in various application areas (e.g. \LaTeX for typesetting). The advantage of the first approach is that it is easier to learn, the advantage of the second approach is that it is more flexible (and one can always add a WYSIWYG interface afterwards). For this software we follow the second approach. In the area of music various languages for representing and creating music have been developed, see \cite{dannenberg:89}, \cite{collinge:84}, \cite{anderson:91} and \cite{cointe:84} for just a few examples. Most of the existing systems provide very general languages with an emphasis on gaining theorical insight, while the system, that is presented here, should be \emph{practical} and \emph{useful}. For writing the software, the library \texttt{Haskore} \cite{haskore} programmed in the functional programming language \texttt{Haskell} (see \cite{haskell, hudak:96} for further references) proved to be the perfect basis for such a system. Another author, Martin Schwenke \cite{schwenke}, is working on a similar system, aimed at a slightly different application area. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. This document consists of a (short) user-manual, and the literate source code. \section{User Manual} The program acts as a filter, which takes some chord chart from standard input, and writes the corresponding MIDI file to standard output. This output can be directly piped into some MIDI player. Information about run-time options can be obtained by calling the program with the \texttt{-h} option. The syntax of input files is as follows: \begin{haskelllisting} chart = { (bar | '%') '|' } bar = { chord | timeSig | '%' } timeSig = '(' int '/' int ')' \end{haskelllisting} Chords follow the usual syntax (e.g., like in the Real Book). The character \texttt{\%} acts as a short-cut for repeating the last bar or chord, respectively. Examples of chord charts come with the program distribution. \section{Main Program} We just extract the options from the command-line, and construct a string-to-string filter from the chord-chart and options. \begin{haskelllisting} > module Main where > import qualified Option > import qualified Haskore.Interface.AutoTrack.Style as Style > import Haskore.General.Utility (stringCharFromByte, ) > import qualified Data.ByteString.Lazy as B > main :: IO () > main = > do (t, s, r, c) <- Option.getAll > interact > (stringCharFromByte . B.unpack . > Style.playToStream r s t c . read) \end{haskelllisting} \input{ChartBar.lhs} \input{ChordChart.lhs} \input{EventChart.lhs} \input{ScaleChart.lhs} \input{Style.lhs} \input{ChordSymbol.lhs} \input{Instrument.lhs} %\input{Scales.lhs} %\input{Rhythm.lhs} \input{Transposeable.lhs} \input{Option.lhs} \section{Todo} \begin{itemize} \item rock style: electric bass \item humanize drums (tempo, single notes) \item modularize styles, make style creation simpler \item walking bass \item recording music / reading in MIDI files \item intros, codas, turnarounds etc. \item breaks (e.g. night in tunesia), rhythmic accents \item different styles within one theme (e.g., on green dolphin street) \item error messages on wrong chord charts (for example takeFive not in 5/4 measure) (prelude function "error") via Monads!!! \item more structured approach to parsing chord charts (either parsing tool/library, or via ReadS, or: treat EBNF rules as function definitions, EBNF operators as combinators); Even better: Try to get rid of a custom file format and to replace it by descriptions in pure Haskell code. \item various degrees of shuffle \end{itemize} \bibliographystyle{abbrv} \bibliography{composer} \end{document} haskore-0.2.0.3/src/Haskore/Interface/CSound/0000755000000000000000000000000011754016451016756 5ustar0000000000000000haskore-0.2.0.3/src/Haskore/Interface/CSound/Tutorial.lhs0000644000000000000000000016677111754016451021313 0ustar0000000000000000\subsubsection{Tutorial} \seclabel{csound-tut} \begin{haskelllisting} > module Haskore.Interface.CSound.Tutorial where > import Haskore.Interface.CSound.Orchestra > (SigExp, Mono(Mono), Stereo(Stereo), Output, Name, > pchToHz, dbToAmp, sigGen, rec, tableNumber, EvalRate(AR, CR), > osc, oscI, randomI, expon, reverb, vdelay, comb, lineSeg, > PluckDecayMethod(..), pluck, buzz) > import Haskore.Interface.CSound.Generator > (compSine1, compSine2, cubicSpline, lineSeg1) > import Haskore.Interface.CSound.Score as Score > import qualified Haskore.Interface.CSound.Orchestra as Orchestra > import qualified Haskore.Interface.CSound.SoundMap as SoundMap > import qualified Haskore.Interface.CSound as CSound > import qualified Haskore.Performance as Performance > import qualified Haskore.Performance.Context as Context > import qualified Haskore.Performance.Fancy as FancyPerformance > import qualified Haskore.Music as Music > import qualified Haskore.Music.Rhythmic as RhyMusic > import qualified Numeric.NonNegative.Wrapper as NonNeg > import Haskore.Basic.Duration > import Haskore.Music ((+:+), (=:=), qnr) > import Haskore.Melody as Melody > import System.Cmd (system, ) > import System.Exit (ExitCode, ) \end{haskelllisting} This brief tutorial is designed to introduce the user to the capabilities of the CSound software synthesizer and sound synthesis in general. \paragraph{Additive Synthesis} \seclabel{add-syn} The first part of the tutorial introduces \keyword{additive synthesis}. Additive synthesis is the most basic, yet the most powerful synthesis technique available, giving complete control over the sound waveform. The basic premiss behind additive sound synthesis is quite simple -- defining a complex sound by specifying each contributing sine wave. The computer is very good at generating pure tones, but these are not very interesting. However, any sound imaginable can be reproduced as a sum of pure tones. We can define an instrument of pure tones easily in Haskore. First we define a \keyword{Function table} containing a lone sine wave. We can do this using the \function{simpleSine} function defined in the \module{CSound.Orchestra} module: \begin{haskelllisting} > pureToneTN :: Score.Table > pureToneTN = 1 > pureToneTable :: SigExp > pureToneTable = tableNumber pureToneTN > pureTone :: Score.Statement > pureTone = Score.Table pureToneTN 0 8192 True (compSine1 [1.0]) > oscPure :: SigExp -> SigExp -> SigExp > oscPure = osc AR pureToneTable \end{haskelllisting} \code{pureToneTN} is the table number of the simple sine wave. We will adopt the convention in this tutorial that variables ending with \code{TN} represent table numbers. Recall that \function{compSine1} is defined in the module \module{CSound} as a sine wave generating routine (\refgen{10}). In order to have a complete score file, we also need a tune. Here is a simple example: \begin{haskelllisting} > type TutMelody params = Melody.T (TutAttr params) > > data TutAttr params = > TutAttr {attrVelocity :: Rational, > attrParameters :: params} > > tune1 :: TutMelody () > tune1 = Music.line (map ($ TutAttr 1.5 ()) > [ c 1 hn, e 1 hn, g 1 hn, > c 2 hn, a 1 hn, c 2 qn, > a 1 qn, g 1 dhn ] ++ [qnr]) \end{haskelllisting} The next step is to convert the melody into a music. In our simple tutorial we have only one instrument per song in all but one case. So we could skip this step, but we want to include it in order to show the general processing steps. We use the general data type for rhythmic music, with no drum definitions (null type \type{()}) and a custom instrument definition \type{Instrument}. We use only the instrument numbers 1 and 2 but the numbers are associated with different sounds in the examples. \begin{haskelllisting} > data Instrument = > Instr1p0 > | Instr2p0 > | Instr1p2 Float Float > | Instr1p4 Float Float Float Float > deriving (Eq, Ord, Show) > > musicFromMelody :: (params -> Instrument) -> > TutMelody params -> RhyMusic.T () Instrument > musicFromMelody instr = > RhyMusic.fromMelody > (\(TutAttr vel params) -> (vel, instr params)) \end{haskelllisting} The melody contains instrument specific parameters. They will be embedded in \type{Instrument} values by the following functions. These functions can be used as \code{instr} arguments to \function{musicFromMelody}. \begin{haskelllisting} > type Pair = (Float, Float) > type Quadruple = (Float, Float, Float, Float) > > attrToInstr1p0 :: () -> Instrument > attrToInstr1p0 () = Instr1p0 > > attrToInstr2p0 :: () -> Instrument > attrToInstr2p0 () = Instr2p0 > > attrToInstr1p2 :: Pair -> Instrument > attrToInstr1p2 = uncurry Instr1p2 > > attrToInstr1p4 :: Quadruple -> Instrument > attrToInstr1p4 (x,y,z,w) = Instr1p4 x y z w \end{haskelllisting} There is nothing special about the conversion from the music to the performance. \begin{haskelllisting} > performanceFromMusic :: RhyMusic.T () Instrument -> > Performance.T NonNeg.Float Float (RhyMusic.Note () Instrument) > performanceFromMusic = > FancyPerformance.fromMusicModifyContext (Context.setDur 1) \end{haskelllisting} Now we convert from the performance to the CSound score. To this end we must convert the instruments represented by \type{Instrument} to sound numbers and parameter fields. A \type{SoundMap.InstrumentTableWithAttributes out Instrument} must be generated for the conversion. The functions like \function{instrAssoc1p0} generate one entry for the table which assigns an instrument number and a sound algorithm to a constructor of \type{Instrument}. \begin{haskelllisting} > type TutOrchestra out = > (Orchestra.Header, SoundMap.InstrumentTableWithAttributes out Instrument) > instrNum1, instrNum2 :: CSound.Instrument > instrNum1 = CSound.instrument 1 > instrNum2 = CSound.instrument 2 > instrAssoc1p0 :: SoundMap.InstrumentSigExp out -> > SoundMap.InstrumentAssociation out Instrument > instrAssoc1p0 = > SoundMap.instrument instrNum1 > (\i -> do Instr1p0 <- Just i; Just ()) > > instrAssoc2p0 :: SoundMap.InstrumentSigExp out -> > SoundMap.InstrumentAssociation out Instrument > instrAssoc2p0 = > SoundMap.instrument instrNum2 > (\i -> do Instr2p0 <- Just i; Just ()) > > instrAssoc1p2 :: (SigExp -> SigExp -> SoundMap.InstrumentSigExp out) -> > SoundMap.InstrumentAssociation out Instrument > instrAssoc1p2 = > SoundMap.instrument2 instrNum1 > (\i -> do Instr1p2 x y <- Just i; Just (x,y)) > > instrAssoc1p4 :: (SigExp -> SigExp -> SigExp -> SigExp -> SoundMap.InstrumentSigExp out) -> > SoundMap.InstrumentAssociation out Instrument > instrAssoc1p4 = > SoundMap.instrument4 instrNum1 > (\i -> do Instr1p4 x y z w <- Just i; Just (x,y,z,w)) \end{haskelllisting} The function \function{scored} puts the chain from melody to CSound score together. Finally the function \function{example} collects music and instrument definitions, that is a complete example. \begin{haskelllisting} > scored :: TutOrchestra out -> (params -> Instrument) -> > TutMelody params -> Score.T > scored (_,sndMap) instr = > Score.fromRhythmicPerformanceWithAttributes > (error "no drum map defined") sndMap . > performanceFromMusic . > musicFromMelody instr > > example :: Name -> (TutOrchestra out -> Score.T) -> TutOrchestra out -> > (Name, Score.T, TutOrchestra out) > example name mkScore orc = (name, mkScore orc, orc) \end{haskelllisting} Let's define an instrument in the orchestra file that will use the function table \code{pureTone}: \begin{haskelllisting} > oe1 :: SoundMap.InstrumentSigExp Mono > oe1 _noteDur noteVel notePit = > let signal = oscPure (dbToAmp noteVel) (pchToHz notePit) > in Mono signal > > score1 orc = pureTone : scored orc attrToInstr1p0 tune1 \end{haskelllisting} This instrument will simply oscillate through the function table containing the sine wave at the appropriate frequency given by \code{notePit}, and the resulting sound will have an amplitude given by \code{noteVel}. Note that the \code{oe1} expression above is a \code{Mono}, not a complete \code{TutOrchestra}. We need to define a \keyword{header} and associate \code{oe1} with the instrument that's playing it: \begin{haskelllisting} > hdr :: Orchestra.Header > hdr = (44100, 4410) > > o1, o2, o3, o4, o7, o8, o9, o13, o14, o15, o19, o22 > :: TutOrchestra Mono > o5, o6, o10, o11, o12, o16, o17, o18, o20, o21 > :: TutOrchestra Stereo > > tut1, tut2, tut3, tut4, tut7, tut8, tut9, tut13, tut14, tut15, tut19, tut22 > :: (Name, Score.T, TutOrchestra Mono) > tut5, tut6, tut10, tut11, tut12, tut16, tut17, tut18, tut20, tut21 > :: (Name, Score.T, TutOrchestra Stereo) > > score1, score2, score3, score4, score5, score6, score7, score8, score9 > :: TutOrchestra out -> [Score.Statement] > > o1 = (hdr, [instrAssoc1p0 oe1]) \end{haskelllisting} The header above indicates that the audio signals are generated at 44,100 Hz (CD quality), the control signals are generated at 4,410 Hz, and there are 2 output channels for stereo sound. Now we have a complete score and orchestra that can be converted to a sound file by CSound and played as follows: \begin{haskelllisting} > csoundDir :: Name > csoundDir = "src/Test/CSound" > -- csoundDir = "C:/TEMP/csound" > > tut1 = example "tut01" score1 o1 \end{haskelllisting} If you listen to the tune, you will notice that it sounds very thin and uninteresting. Most musical sounds are not pure. Instead they usually contain a sine wave of dominant frequency, called a \keyword{fundamental}, and a number of other sine waves called \keyword{partials}. Partials with frequencies that are integer multiples of the fundamental are called \keyword{harmonics}. In musical terms, the first harmonic lies an octave above the fundamental, second harmonic a fifth above the first one, the third harmonic lies a major third above the second harmonic etc. This is the familiar \keyword{overtone series}. We can add harmonics to our sine wave instrument easily using the \function{compSine} function defined in the \module{CSound.Orchestra} module. The function takes a list of harmonic strengths as arguments. The following creates a function table containing the fundamental and the first two harmonics at two thirds and one third of the strength of the fundamental: \begin{haskelllisting} > twoHarmsTN :: Score.Table > twoHarmsTN = 2 > twoHarms :: Score.Statement > twoHarms = Score.Table twoHarmsTN 0 8192 True (compSine1 [1.0, 0.66, 0.33]) \end{haskelllisting} We can again proceed to create complete score and orchestra files as above: \begin{haskelllisting} > score2 orc = twoHarms : scored orc attrToInstr1p0 tune1 > > oe2 :: SoundMap.InstrumentSigExp Mono > oe2 _noteDur noteVel notePit = > let signal = osc AR (tableNumber twoHarmsTN) > (dbToAmp noteVel) (pchToHz notePit) > in Mono signal > > o2 = (hdr, [instrAssoc1p0 oe2]) > > tut2 = example "tut02" score2 o2 \end{haskelllisting} The orchestra file is the same as before -- a single oscillator scanning a function table at a given frequency and volume. This time, however, the tune will not sound as thin as before since the table now contains a function that is an addition of three sine waves. (Note that the same effect could be achieved using a simple sine wave table and three oscillators). Not all musical sounds contain harmonic partials exclusively, and never do we encounter instruments with static amplitude envelope like the ones we have seen so far. Most sounds, musical or not, evolve and change throughout their duration. Let's define an instrument containing both harmonic and nonharmonic partials, that starts at maximum amplitude with a straight line decay. We will use the function \function{compSine2} from the \module{CSound.Orchestra} module to create the function table. \function{compSine2} takes a list of triples as an argument. The triples specify the partial number as a multiple of the fundamental, relative partial strength, and initial phase offset: \begin{haskelllisting} > manySinesTN :: Score.Table > manySinesTN = 3 > manySinesTable :: SigExp > manySinesTable = tableNumber manySinesTN > manySines :: Score.Statement > manySines = Score.Table manySinesTN 0 8192 True (compSine2 [(0.5, 0.9, 0.0), > (1.0, 1.0, 0.0), (1.1, 0.7, 0.0), (2.0, 0.6, 0.0), > (2.5, 0.3, 0.0), (3.0, 0.33, 0.0), (5.0, 0.2, 0.0)]) \end{haskelllisting} Thus this complex will contain the second, third, and fifth harmonic, nonharmonic partials at frequencies of 1.1 and 2.5 times the fundamental, and a component at half the frequency of the fundamental. Their strengths relative to the fundamental are given by the second argument, and they all start in sync with zero offset. Now we can proceed as before to create score and orchestra files. We will define an \keyword{amplitude envelope} to apply to each note as we oscillate through the table. The amplitude envelope will be a straight line signal ramping from 1.0 to 0.0 over the duration of the note. This signal will be generated at \keyword{control rate} rather than audio rate, because the control rate is more than sufficient (the audio signal will change volume 4,410 times a second), and the slower rate will improve performance. \begin{haskelllisting} > score3 orc = manySines : scored orc attrToInstr1p0 tune1 > > lineCS :: EvalRate -> SigExp -> SigExp > -> SigExp -> SigExp > lineCS = Orchestra.line > > oe3 :: SoundMap.InstrumentSigExp Mono > oe3 noteDur noteVel notePit = > let ampEnv = lineCS CR 1.0 noteDur 0.0 > signal = osc AR manySinesTable > (ampEnv * dbToAmp noteVel) (pchToHz notePit) > in Mono signal > > o3 = (hdr, [instrAssoc1p0 oe3]) > > tut3 = example "tut03" score3 o3 \end{haskelllisting} Not only do musical sounds usually evolve in terms of overall amplitude, they also evolve their \keyword{spectra}. In other words, the contributing partials do not usually all have the same amplitude envelope, and so their contribution to the overall sound isn't static. Let us illustrate the point using the same set of partials as in the above example. Instead of creating a table containing a complex waveform, however, we will use multiple oscillators going through the simple sine wave table we created at the beginning of this tutorial at the appropriate frequencies. Thus instead of the partials being fused together, each can have its own amplitude envelope, making the sound evolve over time. The score will be score1, defined above. \begin{haskelllisting} > oe4 :: SoundMap.InstrumentSigExp Mono > oe4 noteDur noteVel notePit = > let pitch = pchToHz notePit > amp = dbToAmp noteVel > mkLine t = lineSeg CR 0 (noteDur*t) 1 [(noteDur * (1-t), 0)] > aenv1 = lineCS CR 1 noteDur 0 > aenv2 = mkLine 0.17 > aenv3 = mkLine 0.33 > aenv4 = mkLine 0.50 > aenv5 = mkLine 0.67 > aenv6 = mkLine 0.83 > aenv7 = lineCS CR 0 noteDur 1 > mkOsc ae p = oscPure (ae * amp) (pitch * p) > a1 = mkOsc aenv1 0.5 > a2 = mkOsc aenv2 1.0 > a3 = mkOsc aenv3 1.1 > a4 = mkOsc aenv4 2.0 > a5 = mkOsc aenv5 2.5 > a6 = mkOsc aenv6 3.0 > a7 = mkOsc aenv7 5.0 > out = 0.5 * (a1 + a2 + a3 + a4 + a5 + a6 + a7) > in Mono out > > o4 = (hdr, [instrAssoc1p0 oe4]) > > tut4 = example "tut04" score1 o4 \end{haskelllisting} So far, we have only used function tables to generate audio signals, but they can come very handy in \keyword{modifying} signals. Let us create a function table that we can use as an amplitude envelope to make our instrument more interesting. The envelope will contain an immediate sharp attack and decay, and then a second, more gradual one, so we'll have two attack/decay events per note. We'll use the cubic spline curve generating routine to do this: \begin{haskelllisting} > coolEnvTN :: Score.Table > coolEnvTN = 4 > coolEnvTable :: SigExp > coolEnvTable = tableNumber coolEnvTN > coolEnv :: Score.Statement > coolEnv = Score.Table coolEnvTN 0 8192 True > (cubicSpline 1 [(1692, 0.2), (3000, 1), (3500, 0)]) > oscCoolEnv :: SigExp -> SigExp -> SigExp > oscCoolEnv = osc CR coolEnvTable \end{haskelllisting} Let us also add some \keyword{p-fields} to the notes in our score. The two p-fields we add will be used for \keyword{panning} -- the first one will be the starting percentage of the left channel, the second one the ending percentage (1 means all left, 0 all right, 0.5 middle. Pfields of 1 and 0 will cause the note to pan completely from left to right for example) \begin{haskelllisting} > tune2 :: TutMelody Pair > tune2 = > let attr start end = TutAttr 1.4 (start, end) > in c 1 hn (attr 1.0 0.75) +:+ > e 1 hn (attr 0.75 0.5) +:+ > g 1 hn (attr 0.5 0.25) +:+ > c 2 hn (attr 0.25 0.0) +:+ > a 1 hn (attr 0.0 1.0) +:+ > c 2 qn (attr 0.0 0.0) +:+ > a 1 qn (attr 1.0 1.0) +:+ > (g 1 dhn (attr 1.0 0.0) =:= > g 1 dhn (attr 0.0 1.0))+:+ qnr \end{haskelllisting} So far we have limited ourselves to using only sine waves for our audio output, even though Csound places no such restrictions on us. Any repeating waveform, of any shape, can be used to produce pitched sounds. In essence, when we are adding sinewaves, we are changing the shape of the wave. For example, adding odd harmonics to a fundamental at strengths equal to the inverse of their partial number (ie. third harmonic would be 1/3 the strength of the fundamental, fifth harmonic 1/5 the fundamental etc) would produce a \keyword{square} wave which has a raspy sound to it. Another common waveform is the \keyword{sawtooth}, and the more mellow sounding \keyword{triangle}. The \module{CSound.Orchestra} module already contains functions to create these common waveforms. Let's use them to create tables that we can use in an instrument: \begin{haskelllisting} > triangleTN, squareTN, sawtoothTN :: Score.Table > triangleTN = 5 > squareTN = 6 > sawtoothTN = 7 > triangleT, squareT, sawtoothT :: Score.Statement > triangleT = triangle triangleTN > squareT = square squareTN > sawtoothT = sawtooth sawtoothTN > > score4 orc = squareT : triangleT : sawtoothT : coolEnv : > scored orc attrToInstr1p2 (Music.changeTempo 0.5 tune2) > > oe5 :: SigExp -> SigExp -> SoundMap.InstrumentSigExp Stereo > oe5 panStart panEnd noteDur noteVel notePit = > let pitch = pchToHz notePit > amp = dbToAmp noteVel > pan = lineCS CR panStart noteDur panEnd > oscF = 1 / noteDur > ampen = oscCoolEnv amp oscF > signal = osc AR (tableNumber squareTN) ampen pitch > left = signal * pan > right = signal * (1-pan) > in Stereo left right > > o5 = (hdr, [instrAssoc1p2 oe5]) > > tut5 = example "tut05" score4 o5 \end{haskelllisting} This will oscillate through a table containing the square wave. Check out the other waveforms too and see what they sound like. This can be done by specifying the table to be used in the orchestra file. As our last example of additive synthesis, we will introduce an orchestra with multiple instruments. The bass will be mostly in the left channel, and will be the same as the third example instrument in this section. It will play the tune two octaves below the instrument in the right channel, using an orchestra identical to \code{oe3} with the addition of the panning feature: \begin{haskelllisting} > score5 orc = manySines : pureTone : scored orc attrToInstr1p0 tune1 ++ > scored orc attrToInstr2p0 tune1 > > oe6 :: SoundMap.InstrumentSigExp Stereo > oe6 noteDur noteVel notePit = > let ampEnv = lineCS CR 1.0 noteDur 0.0 > signal = osc AR manySinesTable > (ampEnv * dbToAmp noteVel) (pchToHz (notePit - 2)) > left = 0.8 * signal > right = 0.2 * signal > in Stereo left right > > oe7 :: SoundMap.InstrumentSigExp Stereo > oe7 noteDur noteVel notePit = > let pitch = pchToHz notePit > amp = dbToAmp noteVel > mkLine t = lineSeg CR 0 (noteDur*t) 0.5 [(noteDur * (1-t), 0)] > aenv1 = lineCS CR 0.5 noteDur 0 > aenv2 = mkLine 0.17 > aenv3 = mkLine 0.33 > aenv4 = mkLine 0.50 > aenv5 = mkLine 0.67 > aenv6 = mkLine 0.83 > aenv7 = lineCS CR 0 noteDur 0.5 > mkOsc ae p = oscPure (ae * amp) (pitch * p) > a1 = mkOsc aenv1 0.5 > a2 = mkOsc aenv2 1.0 > a3 = mkOsc aenv3 1.1 > a4 = mkOsc aenv4 2.0 > a5 = mkOsc aenv5 2.5 > a6 = mkOsc aenv6 3.0 > a7 = mkOsc aenv7 5.0 > left = 0.2 * (a1 + a2 + a3 + a4 + a5 + a6 + a7) > right = 0.8 * (a1 + a2 + a3 + a4 + a5 + a6 + a7) > in Stereo left right > > o6 = (hdr, [instrAssoc1p0 oe6, instrAssoc2p0 oe7]) > > tut6 = example "tut06" score5 o6 \end{haskelllisting} Additive synthesis is the most powerful tool in computer music and sound synthesis in general. It can be used to create any sound imaginable, whether completely synthetic or a simulation of a real-world sound, and everyone interested in using the computer to synthesize sound should be well versed in it. The most significant drawback of additive synthesis is that it requires huge amounts of control data, and potentially thousands of oscillators. There are other synthesis techniques, such as \keyword{modulation synthesis}, that can be used to create rich and interesting timbres at a fraction of the cost of additive synthesis, though no other synthesis technique provides quite the same degree of control. \paragraph{Modulation Synthesis} \seclabel{mod-syn} While additive synthesis provides full control and great flexibility, it is quiet clear that the enormous amounts of control data make it impractical for even moderately complicated sounds. There is a class of synthesis techniques that use \keyword{modulation} to produce rich, time-varying timbres at a fraction of the storage and time cost of additive synthesis. The basic idea behind modulation synthesis is controlling the amplitude and/or frequency of the main periodic signal, called the \keyword{carrier}, by another periodic signal, called the \keyword{modulator}. The two main kinds of modulation synthesis are \keyword{amplitude modulation} and \keyword{frequency modulation} synthesis. Let's start our discussion with the simpler one of the two -- amplitude synthesis. We have already shown how to supply a time varying amplitude envelope to an oscillator. What would happen if this amplitude envelope was itself an oscillating signal? Supplying a low frequency ($<20$Hz) modulating signal would create a predictable effect -- we would hear the volume of the carrier signal go periodically up and down. However, as the modulator moves into the audible frequency range, the carrier changes timbre as new frequencies appear in the spectrum. The new frequencies are equal to the sum and difference of the carrier and modulator. So for example, if the frequency of the main signal (carrier) is C = 500Hz, and the frequency of the modulator is M = 100Hz, the audible frequencies will be the carrier C (500Hz), C + M (600Hz), and C - M (400Hz). The amplitude of the two new sidebands depends on the amplitude of the modulator, but will never exceed half the amplitude of the carrier. The following is a simple example that demonstrates amplitude modulation. The carrier will be a 10 second pure tone at 500Hz. The frequency of the modulator will increase linearly over the 10 second duration of the tone from 0 to 200 Hz. Initially, you will be able to hear the volume of the signal fluctuate, but after a couple of seconds the volume will seem constant as new frequencies appear. Let us first create the score file. It will contain a sine wave table, and a single note event: \begin{haskelllisting} > score6 _ = > pureTone : [ Score.Note instrNum1 0.0 10.0 (Cps 500.0) 10000.0 [] ] \end{haskelllisting} The orchestra will contain a single AM instrument. The carrier will simply oscillate through the sine wave table at frequency given by the note pitch (500Hz, see the score above), and amplitude given by the modulator. The modulator will oscillate through the same sine wave table at frequency ramping from 0 to 200Hz. The modulator should be a periodic signal that varies from 0 to the maximum volume of the carrier. Since the sine wave goes from -1 to 1, we will need to add 1 to it and half it, before multiplying it by the volume supplied by the note event. This will be the modulating signal, and the carrier's amplitude input. (note that we omit the conversion functions dbToAmp and notePit, since we supply the amplitude and frequency in their raw units in the score file) \begin{haskelllisting} > oe8 :: SoundMap.InstrumentSigExp Mono > oe8 noteDur noteVel notePit = > let modFreq = lineCS CR 0.0 noteDur 200.0 > modAmp = oscPure 1.0 modFreq > modSig = (modAmp + 1.0) * 0.5 * noteVel > carrier = oscPure modSig notePit > in Mono carrier > > o7 = (hdr, [instrAssoc1p0 oe8]) > > tut7 = example "tut07" score6 o7 \end{haskelllisting} Next synthesis technique on the palette is \keyword{frequency modulation}. As the name suggests, we modulate the frequency of the carrier. Frequency modulation is much more powerful and interesting than amplitude modulation, because instead of getting two sidebands, FM gives a {\em number} of spectral sidebands. Let us begin with an example of a simple FM. We will again use a single 10 second note and a 500Hz carrier. Remember that when we talked about amplitude modulation, the amplitude of the sidebands was dependent upon the amplitude of the modulator. In FM, the modulator amplitude plays a much bigger role, as we will see soon. To negate the effect of the modulator amplitude, we will keep the ratio of the modulator amplitude and frequency constant at 1.0 (we will explain shortly why). The frequency and amplitude of the modulator will ramp from 0 to 200 over the duration of the note. This time, though, unlike with AM, we will hear a whole series of sidebands. The orchestra is just as before, except we modulate the frequency instead of amplitude. \begin{haskelllisting} > oe9 :: SoundMap.InstrumentSigExp Mono > oe9 noteDur noteVel notePit = > let modFreq = lineCS CR 0.0 noteDur 200.0 > modAmp = modFreq > modSig = oscPure modAmp modFreq > carrier = oscPure noteVel (notePit + modSig) > in Mono carrier > > o8 = (hdr, [instrAssoc1p0 oe9]) > > tut8 = example "tut08" score6 o8 \end{haskelllisting} The sound produced by FM is a little richer but still very bland. Let us talk now about the role of the \keyword{depth} of the frequency modulation (the amplitude of the modulator). Unlike in AM, where we only had one spectral band on each side of the carrier frequency (ie we heard C, C+M, C-M), FM gives a much richer spectrum with many sidebands. The frequencies we hear are C, C+M, C-M, C+2M, C-2M, C+3M, C-3M etc. The amplitudes of the sidebands are determined by the \keyword{modulation index} I, which is the ratio between the amplitude (also referred to as depth) and frequency of the modulator (I = D / M). As a rule of thumb, the number of significant sideband pairs (at least 1% the volume of the carrier) is I+1. As I (and the number of sidebands) increases, energy is "stolen" from the carrier and distributed among the sidebands. Thus if I=1, we have 2 significant sideband pairs, and the audible frequencies will be C, C+M, C-M, C+2M, C-2M, with C, the carrier, being the dominant frequency. When I=5, we will have a much richer sound with about 6 significant sideband pairs, some of which will actually be louder than the carrier. Let us explore the effect of the modulation index in the following example. We will keep the frequency of the carrier and the modulator constant at 500Hz and 80 Hz respectively. The modulation index will be a stepwise function from 1 to 10, holding each value for one second. So in effect, during the first second (I = D/M = 1), the amplitude of the modulator will be the same as its frequency (80). During the second second (I = 2), the amplitude will be double the frequency (160), then it will go to 240, 320, etc: \begin{haskelllisting} > oe10 :: SoundMap.InstrumentSigExp Mono > oe10 _noteDur noteVel notePit = > let modInd = lineSeg CR 1 1 1 [(0,2), (1,2), (0,3), (1,3), (0,4), > (1,4), (0,5), (1,5), (0,6), (1,6), > (0,7), (1,7), (0,8), (0,9), (1,9), > (0,10), (1,10)] > modAmp = 80.0 * modInd > modSig = oscPure modAmp 80.0 > carrier = oscPure noteVel (notePit + modSig) > in Mono carrier > > o9 = (hdr, [instrAssoc1p0 oe10]) > > tut9 = example "tut09" score6 o9 \end{haskelllisting} Notice that when the modulation index gets high enough, some of the sidebands have negative frequencies. For example, when the modulation index is 7, there is a sideband present in the sound with a frequency C - 7M = 500 - 560 = -60Hz. The negative sidebands get reflected back into the audible spectrum but are \keyword{phase shifted} 180 degrees, so it is an inverse sine wave. This makes no difference when the wave is on its own, but when we add it to its inverse, the two will cancel out. Say we set the frequency of the carrier at 100Hz instead of 80Hz. Then at I=6, we would have present two sidebands of the same frequency - C-4M = 100Hz, and C-6M = -100Hz. When these two are added, they would cancel each other out (if they were the same amplitude; if not, the louder one would be attenuated by the amplitude of the softer one). The following flexible instrument will sum up simple FM. The frequency of the modulator will be determined by the C/M ratio supplied as p6 in the score file. The modulation index will be a linear slope going from 0 to p7 over the duration of each note. Let us also add panning control as in additive synthesis - p8 will be the initial left channel percentage, and p9 the final left channel percentage: \begin{haskelllisting} > oe11 :: SigExp -> SigExp -> SigExp -> SigExp -> SoundMap.InstrumentSigExp Stereo > oe11 modFreqRatio modIndEnd panStart panEnd noteDur noteVel notePit = > let carFreq = pchToHz notePit > carAmp = dbToAmp noteVel > modFreq = carFreq * modFreqRatio > modInd = lineCS CR 0 noteDur modIndEnd > modAmp = modFreq * modInd > modSig = oscPure modAmp modFreq > carrier = oscPure carAmp (carFreq + modSig) > mainAmp = oscCoolEnv 1.0 (1/noteDur) > pan = lineCS CR panStart noteDur panEnd > left = mainAmp * pan * carrier > right = mainAmp * (1 - pan) * carrier > in Stereo left right > > o10 = (hdr, [instrAssoc1p4 oe11]) \end{haskelllisting} Let's write a cool tune to show off this instrument. Let's keep it simple and play the chord progression Em - C - G - D a few times, each time changing some of the parameters: \begin{haskelllisting} > emChord, cChord, gChord, dChord :: > Float -> Float -> Float -> Float -> > TutMelody Quadruple > > quickChord :: > [Music.Dur -> TutAttr Quadruple -> TutMelody Quadruple] -> > Float -> Float -> Float -> Float -> > TutMelody Quadruple > quickChord ns x y z w = Music.chord $ > map (\p -> p wn (TutAttr 1.4 (x, y, z, w))) ns > > emChord = quickChord [e 0, g 0, b 0] > cChord = quickChord [c 0, e 0, g 0] > gChord = quickChord [g 0, b 0, d 1] > dChord = quickChord [d 0, fs 0, a 0] > > tune3 :: TutMelody Quadruple > tune3 = > Music.transpose (-12) $ > emChord 3.0 2.0 0.0 1.0 +:+ cChord 3.0 5.0 1.0 0.0 +:+ > gChord 3.0 8.0 0.0 1.0 +:+ dChord 3.0 12.0 1.0 0.0 +:+ > emChord 3.0 4.0 0.0 0.5 +:+ cChord 5.0 4.0 0.5 1.0 +:+ > gChord 8.0 4.0 1.0 0.5 +:+ dChord 10.0 4.0 0.5 0.0 +:+ > (emChord 4.0 6.0 1.0 0.0 =:= emChord 7.0 5.0 0.0 1.0) +:+ > (cChord 5.0 9.0 1.0 0.0 =:= cChord 9.0 5.0 0.0 1.0) +:+ > (gChord 5.0 5.0 1.0 0.0 =:= gChord 7.0 7.0 0.0 1.0) +:+ > (dChord 2.0 3.0 1.0 0.0 =:= dChord 7.0 15.0 0.0 1.0) \end{haskelllisting} Now we can create a score. It will contain two wave tables -- one containing the sine wave, and the other containing an amplitude envelope, which will be the table coolEnv which we have already seen before \begin{haskelllisting} > score7 orc = pureTone : coolEnv : > scored orc attrToInstr1p4 (Music.changeTempo 0.5 tune3) > > tut10 = example "tut10" score7 o10 \end{haskelllisting} Note that all of the above examples of frequency modulation use a single carrier and a single modulator, and both are oscillating through the simplest of waveforms -- a sine wave. Already we have achieved some very rich and interesting timbres using this simple technique, but the possibilities are unlimited when we start using different carrier and modulator waveshapes and multiple carriers and/or modulators. Let us include a couple more examples that will play the same chord progression as above with multiple carriers, and then with multiple modulators. The reason for using multiple carriers is to obtain {/em formant regions} in the spectrum of the sound. Recall that when we modulate a carrier frequency we get a spectrum with a central peak and a number of sidebands on either side of it. Multiple carriers introduce additional peaks and sidebands into the composite spectrum of the resulting sound. These extra peaks are called formant regions, and are characteristic of human voice and most musical instruments \begin{haskelllisting} > oe12 :: SigExp -> SigExp -> SigExp -> SigExp -> SoundMap.InstrumentSigExp Stereo > oe12 modFreqRatio modIndEnd panStart panEnd noteDur noteVel notePit = > let car1Freq = pchToHz notePit > car2Freq = pchToHz (notePit + 1) > car1Amp = dbToAmp noteVel > car2Amp = dbToAmp noteVel * 0.7 > modFreq = car1Freq * modFreqRatio > modInd = lineCS CR 0 noteDur modIndEnd > modAmp = modFreq * modInd > modSig = oscPure modAmp modFreq > carrier1 = oscPure car1Amp (car1Freq + modSig) > carrier2 = oscPure car2Amp (car2Freq + modSig) > mainAmp = oscCoolEnv 1.0 (1/noteDur) > pan = lineCS CR panStart noteDur panEnd > left = mainAmp * pan * (carrier1 + carrier2) > right = mainAmp * (1 - pan) * (carrier1 + carrier2) > in Stereo left right > > o11 = (hdr, [instrAssoc1p4 oe12]) > > tut11 = example "tut11" score7 o11 \end{haskelllisting} In the above example, there are two formant regions -- one is centered around the note pitch frequency provided by the score file, the other an octave above. Both are modulated in the same way by the same modulator. The sound is even richer than that obtained by simple FM. Let us now turn to multiple modulator FM. In this case, we use a signal to modify another signal, and the modified signal will itself become a modulator acting on the carrier. Thus the wave that wil be modulating the carrier is not a sine wave as above, but is itself a complex waveform resulting from simple FM. The spectrum of the sound will contain a central peak frequency, surrounded by a number of sidebands, but this time each sideband will itself also by surrounded by a number of sidebands of its own. So in effect we are talking about "double" modulation, where each sideband is a central peak in its own little spectrum. Multiple modulator FM thus provides extremely rich spectra \begin{haskelllisting} > oe13 :: SigExp -> SigExp -> SigExp -> SigExp -> SoundMap.InstrumentSigExp Stereo > oe13 modFreqRatio modIndEnd panStart panEnd noteDur noteVel notePit = > let carFreq = pchToHz notePit > carAmp = dbToAmp noteVel > mod1Freq = carFreq * modFreqRatio > mod2Freq = mod1Freq * 2.0 > modInd = lineCS CR 0 noteDur modIndEnd > mod1Amp = mod1Freq * modInd > mod2Amp = mod1Amp * 3.0 > mod1Sig = oscPure mod1Amp mod1Freq > mod2Sig = oscPure mod2Amp (mod2Freq + mod1Sig) > carrier = oscPure carAmp (carFreq + mod2Sig) > mainAmp = oscCoolEnv 1.0 (1/noteDur) > pan = lineCS CR panStart noteDur panEnd > left = mainAmp * pan * carrier > right = mainAmp * (1 - pan) * carrier > in Stereo left right > > o12 = (hdr, [instrAssoc1p4 oe13]) > > tut12 = example "tut12" score7 o12 \end{haskelllisting} In fact, the spectra produced by multiple modulator FM are so rich and complicated that even the moderate values used as arguments in our tune produce spectra that are saturated and otherworldly. And we did this while keeping the ratios of the two modulators frequencies and amplitudes constant; introducing dynamics in those ratios would produce even crazier results. It is quite amazing that from three simple sine waves, the purest of all tones, we can derive an unlimited number of timbres. Modulation synthesis is a very powerful tool and understanding how to use it can prove invaluable. The best way to learn how to use FM effectively is to dabble and experiment with different ratios, formant regions, dynamic relationships betweeen ratios, waveshapes, etc. The possibilities are limitless. \paragraph{Other Capabilities Of CSound} \seclabel{other} In our examples of additive and modulation synthesis we only used a limited number of functions and routines provided us by CSound, such as Osc (oscillator), Line and LineSig (line and line segment signal generators) etc. This tutorial intends to briefly explain the functionality of some of the other features of CSound. Remember that the CSound manual should be the ultimate reference when it comes to using these functions. Let us start with the two functions \function{buzz} and \function{genBuzz}. These functions will produce a set of harmonically related cosines. Thus they really implement simple additive synthesis, except that the number of partials can be varied dynamically through the duration of the note, rather than staying fixed as in simple additive synthesis. As an example, let us perform the tune defined at the very beginning of the tutorial using an instrument that will play each note by starting off with the fundamental and 70 harmonics, and ending with simply the sine wave fundamental (note that cosine and sine waves sound the same). We will use a straight line signal going from 70 to 0 over the duration of each note for the number of harmonics. The score used will be score1, and the orchestra will be: \begin{haskelllisting} > oe14 :: SoundMap.InstrumentSigExp Mono > oe14 noteDur noteVel notePit = > let numharms = lineCS CR 70 noteDur 0 > signal = buzz pureToneTable numharms > (dbToAmp noteVel) (pchToHz notePit) > in Mono signal > > o13 = (hdr, [instrAssoc1p0 oe14]) > > tut13 = example "tut13" score1 o13 \end{haskelllisting} Let's invert the line of the harmonics, and instead of going from 70 to 0, make it go from 0 to 70. This will produce an interesting effect quite different from the one just heard: \begin{haskelllisting} > oe15 :: SoundMap.InstrumentSigExp Mono > oe15 noteDur noteVel notePit = > let numharms = lineCS CR 0 noteDur 70 > signal = buzz pureToneTable numharms > (dbToAmp noteVel) (pchToHz notePit) > in Mono signal > > o14 = (hdr, [instrAssoc1p0 oe15]) > > tut14 = example "tut14" score1 o14 \end{haskelllisting} The \function{buzz} expression takes the overall amplitude, fundamental frequency, number of partials, and a sine wave table and generates a wave complex. In recent years there has been a lot of research conducted in the area of \keyword{physical modelling}. This technique attempts to approximate the sound of real world musical instruments through mathematical models. One of the most widespread, versatile and interesting of these models is the \keyword{Karplus-Strong algorithm} that simulates the sound of a plucked string. The algorithm starts off with a buffer containing a user-determined waveform. On every pass, the waveform is "smoothed out" and flattened by the algorithm to simulate the decay. There is a certain degree of randomness involved to make the string sound more natural. There are six different "smoothing methods" available in CSound, as mentioned in the CSound module. The \function{pluck} constructor accepts the note volume, pitch, the table number that is used to initialize the buffer, the smoothing method used, and two parameters that depend on the smoothing method. If zero is given as the initializing table number, the buffer starts off containing a random waveform (white noise). This is the best table when simulating a string instrument because of the randomness and percussive attack it produces when used with this algorithm, but you should experiment with other waveforms as well. Here is an example of what Pluck sounds like with a white noise buffer and the simple smoothing method. This method ignores the parameters, which we set to zero. \begin{haskelllisting} > oe16 :: SoundMap.InstrumentSigExp Mono > oe16 _noteDur noteVel notePit = > let signal = pluck 0 (pchToHz notePit) > PluckSimpleSmooth > (dbToAmp noteVel) (pchToHz notePit) > in Mono signal > > o15 = (hdr, [instrAssoc1p0 oe16]) > > tut15 = example "tut15" score1 o15 \end{haskelllisting} The second smoothing method is the \keyword{stretched smooth}, which works like the simple smooth above, except that the smoothing process is stretched by a factor determined by the first parameter. The second parameter is ignored. The third smoothing method is the \keyword{snare drum} method. The first parameter is the "roughness" parameter, with 0 resulting in a sound identical to simple smooth, 0.5 being the perfect snare drum, and 1.0 being the same as simple smooth again with reversed polarity (like a graph flipped around the x-axis). The fourth smoothing method is the \keyword{stretched drum} method which combines the roughness and stretch factors -- the first parameter is the roughness, the second is the stretch. The fifth method is \keyword{weighted average} -- it combines the current sample (ie. the current pass through the buffer) with the previous one, with their weights being determined by the parameters. This is a way to add slight reverb to the plucked sound. Finally, the last method filters the sound so it doesn't sound as bright. The parameters are ignored. You can modify the instrument \code{oe16} easily to listen to all these effects by simply replacing the variable \function{simpleSmooth} by \function{stretchSmooth, simpleDrum, stretchDrum, weightedSmooth} or \function{filterSmooth}. Here is another simple instrument example. This combines a snare drum sound with a stretched plucked string sound. The snare drum as a constant amplitude, while we apply an amplitude envelope to the string sound. The envelope is a spline curve with a hump in the middle, so both the attack and decay are gradual. The drum roughness factor is 0.3, so a pitch is still discernible (with a factor of 0.5 we would get a snare drum sound with no pitch, just a puff of white noise). The drum sound is shifted towards the left channel, while the string sound is shifted towards the right. \begin{haskelllisting} > midHumpTN :: Score.Table > midHumpTN = 8 > midHump :: Score.Statement > midHump = Score.Table midHumpTN 0 8192 True > (cubicSpline 0.0 [(4096, 1.0), (4096, 0.0)]) > > score8 orc = pureTone : midHump : scored orc attrToInstr1p0 tune1 > > oe17 :: SoundMap.InstrumentSigExp Stereo > oe17 noteDur noteVel notePit = > let string = pluck 0 (pchToHz notePit) > (PluckStretchSmooth 1.5) > (dbToAmp noteVel) (pchToHz notePit) > drum = pluck 0 (pchToHz notePit) > (PluckSimpleDrum 0.3) > 6000 (pchToHz notePit) > ampEnv = osc CR (tableNumber midHumpTN) 1.0 (1 / noteDur) > left = (0.65 * drum) + (0.35 * ampEnv * string) > right = (0.35 * drum) + (0.65 * ampEnv * string) > in Stereo left right > > o16 = (hdr, [instrAssoc1p0 oe17]) > > tut16 = example "tut16" score8 o16 \end{haskelllisting} Let us now turn our attention to the effects we can achieve using a \keyword{delay line}. Let's define a simple percussive instrument. It's strong attack let us easily perceive the reverberation. \begin{haskelllisting} > ping :: SigExp -> SigExp -> SigExp > ping noteVel notePit = > let ampEnv = expon CR 1.0 1.0 (1/100) > in osc AR manySinesTable > (ampEnv * dbToAmp noteVel) (pchToHz notePit) \end{haskelllisting} There is still the problem, that subsequent notes truncate preceding ones. This would suppress the reverb. In order to avoid this we add a \keyword{legato} effect to the music. That is we prolong the notes such that they overlap. \begin{haskelllisting} > score9 orc = manySines : scored orc attrToInstr1p0 (Music.legato 1 tune1) \end{haskelllisting} Here we take the ping sound and add a little echo to it using delay: \begin{haskelllisting} > oe18 :: SoundMap.InstrumentSigExp Stereo > oe18 _noteDur noteVel notePit = > let ping' = ping noteVel notePit > dping1 = Orchestra.delay 0.05 ping' > dping2 = Orchestra.delay 0.1 ping' > left = (0.65 * ping') + (0.35 * dping2) + (0.5 * dping1) > right = (0.35 * ping') + (0.65 * dping2) + (0.5 * dping1) > in Stereo left right > > o17 = (hdr, [instrAssoc1p0 oe18]) > > tut17 = example "tut17" score9 o17 \end{haskelllisting} The constructor \function{delay} establishes a \keyword{delay line}. A delay line is essentially a buffer that contains the signal to be delayed. The first argument to the \function{delay} constructor is the length of the delay (which determines the size of the buffer), and the second argument is the signal to be delayed. So for example, if the delay time is 1.0 seconds, and the sampling rate is 44,100 Hz (CD quality), then the delay line will be a buffer containing 44,100 samples of the delayed signal. The buffer is rewritten at the audio rate. Once \code{Delay t sig} writes t seconds of the signal \code{sig} into the buffer, the buffer can be \keyword{tapped} using the \function{delTap} or the \function{delTapI} constructors. \code{delTap t dline} will extract the signal from \code{dline} at time \code{t} seconds. In the exmaple above, we set up a delay line containing 0.1 seconds of the audio signal, then we tapped it twice -- once at 0.05 seconds and once at 0.1 seconds. The output signal is a combination of the original signal (left channel), the signal delayed by 0.05 seconds (middle), and the signal delayed by 0.1 seconds (right channel). CSound provides other ways to reverberate a signal besides the delay line just demonstrated. One such way is achieved via the Reverb constructor introduced in the \module{CSound.Orchestra} module. This constructor tries to emulate natural room reverb, and takes as arguments the signal to be reverberated, and the reverb time in seconds. This is the time it takes the signal to decay to 1/1000 its original amplitude. In this example we output both the original and the reverberated sound. \begin{haskelllisting} > oe19 :: SoundMap.InstrumentSigExp Stereo > oe19 _noteDur noteVel notePit = > let ping' = ping noteVel notePit > rev = reverb 0.3 ping' > left = (0.65 * ping') + (0.35 * rev) > right = (0.35 * ping') + (0.65 * rev) > in Stereo left right > > o18 = (hdr, [instrAssoc1p0 oe19]) > > tut18 = example "tut18" score9 o18 \end{haskelllisting} The other two reverb functions are \function{comb} and \function{alpass}. Each of these requires as arguments the signal to be reverberated, the reverb time as above, and echo loop density in seconds. Here is an example of an instrument using \function{comb}. \begin{haskelllisting} > oe20 :: SoundMap.InstrumentSigExp Mono > oe20 _noteDur noteVel notePit = > Mono (comb 0.22 4.0 (ping noteVel notePit)) > > o19 = (hdr, [instrAssoc1p0 oe20]) > > tut19 = example "tut19" score9 o19 \end{haskelllisting} Delay lines can be used for effects other than simple echo and reverberation. Once the delay line has been established, it can be tapped at times that vary at control or audio rates. This can be taken advantage of to produce effects like chorus, flanger, or the Doppler effect. Here is an example of the flanger effect. This instrument adds a slight flange to \code{oe11}. \begin{haskelllisting} > oe21 :: SigExp -> SigExp -> SigExp -> SigExp -> SoundMap.InstrumentSigExp Stereo > oe21 modFreqRatio modIndEnd panStart panEnd noteDur noteVel notePit = > let carFreq = pchToHz notePit > ampEnv = oscCoolEnv 1.0 (1/noteDur) > carAmp = dbToAmp noteVel * ampEnv > modFreq = carFreq * modFreqRatio > modInd = lineCS CR 0 noteDur modIndEnd > modAmp = modFreq * modInd > modSig = oscPure modAmp modFreq > carrier = oscPure carAmp (carFreq + modSig) > ftime = oscPure (1/10) 2 > flanger = ampEnv * vdelay 1 (0.5 + ftime) carrier > signal = carrier + flanger > pan = lineCS CR panStart noteDur panEnd > left = pan * signal > right = (1 - pan) * signal > in Stereo left right > > o20 = (hdr, [instrAssoc1p4 oe21]) > > tut20 = example "tut20" score7 o20 \end{haskelllisting} The last two examples use generic delay lines. That is we do not rely on special echo effects but build our own ones by delaying a signal, filtering it by low pass or high pass filters and feeding the result back to the delay function. \begin{haskelllisting} > lowPass, highPass :: EvalRate -> SigExp -> SigExp -> SigExp > lowPass rate cutOff sig = sigGen "tone" rate 1 [sig, cutOff] > highPass rate cutOff sig = sigGen "atone" rate 1 [sig, cutOff] > oe22 :: SoundMap.InstrumentSigExp Stereo > oe22 _noteDur noteVel notePit = > let ping' = ping noteVel notePit > left = rec (\x -> ping' + lowPass AR 500 (Orchestra.delay 0.311 x)) > right = rec (\x -> ping' + highPass AR 1000 (Orchestra.delay 0.271 x)) > in Stereo left right > > o21 = (hdr, [instrAssoc1p0 oe22]) > > tut21 = example "tut21" score9 o21 > oe23 :: SoundMap.InstrumentSigExp Mono > oe23 _noteDur noteVel notePit = > let ping' = ping noteVel notePit > rev = rec (\x -> ping' + > 0.7 * (lowPass AR 500 (Orchestra.delay 0.311 x) > + highPass AR 1000 (Orchestra.delay 0.271 x))) > in Mono rev > > o22 = (hdr, [instrAssoc1p0 oe23]) > > tut22 = example "tut22" score9 o22 \end{haskelllisting} This completes our discussion of sound synthesis and Csound. For more information, please consult the CSound manual or check out \url{http://mitpress.mit.edu/e-books/csound/frontpage.html} The function \function{applyOutFunc} applies sound expression function to the expressions which represent the parameter fields from 6 on. These are the fields where the additional instrument parameters are put by \function{CSound.Score.statementToWords}. \begin{haskelllisting} > test :: Output out => (Name, Score.T, TutOrchestra out) -> IO ExitCode > test = play csoundDir > > toOrchestra :: Output out => TutOrchestra out -> Orchestra.T out > toOrchestra (hd, instrs) = > Orchestra.Cons hd (SoundMap.instrumentTableToInstrBlocks instrs) > > play :: Output out => > FilePath -> (Name, Score.T, TutOrchestra out) -> IO ExitCode > play dir (name, s, o') = > let scorename = name ++ ".sco" > orchname = name ++ ".orc" > -- wavename = name ++ ".wav" > o = toOrchestra o' > -- (Orchestra.Cons (rate, _) _) = o > in do writeFile (dir++"/"++scorename) (Score.toString s) > writeFile (dir++"/"++orchname) (Orchestra.toString o) > {- > system ("cd "++dir++" ; csound32 -d -W -o " > ++ wavename ++ " " ++ orchname ++ " " ++ scorename > ++ " ; play " ++ wavename) > -} > system ("cd "++dir++" ; csound32 -d -A -o stdout -s " > ++ orchname ++ " " ++ scorename > ++ " | play -t aiff -") > {- > system ("cd "++dir++" ; csound32 -d -o stdout -s " > ++ orchname ++ " " ++ scorename > ++ " | play -r " ++ show rate ++ " -t sw -") > -} > {- > system ("cd "++dir++" ; csound32 -d -o dac " -- /dev/dsp makes some chaotic noise > ++ orchname ++ " " ++ scorename) > -} > {- > system (dir ++ "/csound.exe -W -o " ++ wavename > ++ " " ++ orchname ++ " " ++ scorename) > -} \end{haskelllisting} Here are some bonus instruments for your pleasure and enjoyment. The first ten instruments are lifted from \url{http://wings.buffalo.edu/academic/department/AandL/music/pub/accci/01/01_01_1b.txt.html} The tutorial explains how to add echo/reverb and other effects to the instruments if you need to. This instrument sounds like an electric piano and is really simple -- \function{pianoEnv} sets the amplitude envelope, and the sound waveform is just a series of 10 harmonics. To make the sound brighter, increase the weight of the upper harmonics. \begin{haskelllisting} > piano, reedy, flute > :: (Name, Score.T, TutOrchestra Mono) > pianoOrc, reedyOrc, fluteOrc > :: TutOrchestra Mono > pianoScore, reedyScore, fluteScore :: TutOrchestra out -> Score.T > pianoEnv, reedyEnv, fluteEnv, > pianoWave, reedyWave, fluteWave :: Score.Statement > pianoEnvTN, reedyEnvTN, fluteEnvTN, > pianoWaveTN, reedyWaveTN, fluteWaveTN :: Score.Table > pianoEnvTable, reedyEnvTable, fluteEnvTable, > pianoWaveTable, reedyWaveTable, fluteWaveTable :: SigExp > pianoEnvTN = 10; pianoEnvTable = tableNumber pianoEnvTN > pianoWaveTN = 11; pianoWaveTable = tableNumber pianoWaveTN > > pianoEnv = Score.Table pianoEnvTN 0 1024 True (lineSeg1 0 [(20, 0.99), > (380, 0.4), (400, 0.2), (224, 0)]) > pianoWave = Score.Table pianoWaveTN 0 1024 True (compSine1 [0.158, 0.316, > 1.0, 1.0, 0.282, 0.112, 0.063, 0.079, 0.126, 0.071]) > > pianoScore orc = pianoEnv : pianoWave : scored orc attrToInstr1p0 tune1 > > pianoOE :: SoundMap.InstrumentSigExp Mono > pianoOE noteDur noteVel notePit = > let ampEnv = osc CR pianoEnvTable (dbToAmp noteVel) (1/noteDur) > signal = osc AR pianoWaveTable ampEnv (pchToHz notePit) > in Mono signal > > pianoOrc = (hdr, [instrAssoc1p0 pianoOE]) > > piano = example "piano" pianoScore pianoOrc \end{haskelllisting} Here is another instrument with a reedy sound to it \begin{haskelllisting} > reedyEnvTN = 12; reedyEnvTable = tableNumber reedyEnvTN > reedyWaveTN = 13; reedyWaveTable = tableNumber reedyWaveTN > > reedyEnv = Score.Table reedyEnvTN 0 1024 True (lineSeg1 0 [(172, 1.0), > (170, 0.8), (170, 0.6), (170, 0.7), (170, 0.6), (172,0)]) > reedyWave = Score.Table reedyWaveTN 0 1024 True (compSine1 [0.4, 0.3, > 0.35, 0.5, 0.1, 0.2, 0.15, 0.0, 0.02, 0.05, 0.03]) > > reedyScore orc = reedyEnv : reedyWave : scored orc attrToInstr1p0 tune1 > > reedyOE :: SoundMap.InstrumentSigExp Mono > reedyOE noteDur noteVel notePit = > let ampEnv = osc CR reedyEnvTable (dbToAmp noteVel) (1/noteDur) > signal = osc AR reedyWaveTable ampEnv (pchToHz notePit) > in Mono signal > > reedyOrc = (hdr, [instrAssoc1p0 reedyOE]) > > reedy = example "reedy" reedyScore reedyOrc \end{haskelllisting} We can use a little trick to make it sound like several reeds playing by adding three signals that are slightly out of tune: \begin{haskelllisting} > reedy2OE :: SoundMap.InstrumentSigExp Stereo > reedy2OE noteDur noteVel notePit = > let ampEnv = osc CR reedyEnvTable (dbToAmp noteVel) (1/noteDur) > freq = pchToHz notePit > reedyOsc = osc AR reedyWaveTable > a1 = reedyOsc ampEnv freq > a2 = reedyOsc (ampEnv * 0.44) (freq + (0.023 * freq)) > a3 = reedyOsc (ampEnv * 0.26) (freq + (0.019 * freq)) > left = (a1 * 0.5) + (a2 * 0.35) + (a3 * 0.65) > right = (a1 * 0.5) + (a2 * 0.65) + (a3 * 0.35) > in Stereo left right > > reedy2Orc :: TutOrchestra Stereo > reedy2Orc = (hdr, [instrAssoc1p0 reedy2OE]) > > reedy2 :: (Name, Score.T, TutOrchestra Stereo) > reedy2 = example "reedy2" reedyScore reedy2Orc \end{haskelllisting} This instrument tries to emulate a flute sound by introducing random variations to the amplitude envelope. The score file passes in two parameters -- the first one is the depth of the random tremolo in percent of total amplitude. The tremolo is implemented using the \function{randomI} function, which generates a signal that interpolates between 2 random numbers over a certain number of samples that is specified by the second parameter. \begin{haskelllisting} > fluteTune :: TutMelody Pair > > fluteTune = Music.line > (map ($ TutAttr 1.6 (30, 40)) > [c 1 hn, e 1 hn, g 1 hn, c 2 hn, > a 1 hn, c 2 qn, a 1 qn, g 1 dhn] > ++ [qnr]) > > > fluteEnvTN = 14; fluteEnvTable = tableNumber fluteEnvTN > fluteWaveTN = 15; fluteWaveTable = tableNumber fluteWaveTN > > fluteEnv = Score.Table fluteEnvTN 0 1024 True (lineSeg1 0 [(100, 0.8), > (200, 0.9), (100, 0.7), (300, 0.2), (324, 0.0)]) > fluteWave = Score.Table fluteWaveTN 0 1024 True (compSine1 [1.0, 0.4, > 0.2, 0.1, 0.1, 0.05]) > > fluteScore orc = fluteEnv : fluteWave : scored orc attrToInstr1p2 fluteTune > > fluteOE :: SigExp -> SigExp -> SoundMap.InstrumentSigExp Mono > fluteOE depth numSam noteDur noteVel notePit = > let vol = dbToAmp noteVel > rand = randomI AR numSam (vol/100 * depth) > ampEnv = oscI AR fluteEnvTable > (rand + vol) (1 / noteDur) > signal = oscI AR fluteWaveTable > ampEnv (pchToHz notePit) > in Mono signal > > fluteOrc = (hdr, [instrAssoc1p2 fluteOE]) > > flute = example "flute" fluteScore fluteOrc \end{haskelllisting} Dirty hacks are going on here in order to pass the Phoneme values through all functions. \begin{haskelllisting} > voice' :: SigExp -> SigExp -> SigExp -> SigExp -> > SigExp -> SigExp -> SigExp -> SigExp -> SigExp > voice' vibWave wave gain vibAmp vibFreq amp freq phoneme = > sigGen "voice" AR 1 > [amp, freq, phoneme, gain, vibFreq, vibAmp, wave, vibWave] > data Phoneme = > Eee | Ihh | Ehh | Aaa | > Ahh | Aww | Ohh | Uhh | > Uuu | Ooo | Rrr | Lll | > Mmm | Nnn | Nng | Ngg | > Fff | Sss | Thh | Shh | > Xxx | Hee | Hoo | Hah | > Bbb | Ddd | Jjj | Ggg | > Vvv | Zzz | Thz | Zhh > deriving (Show, Eq, Ord, Enum) > voiceTune :: TutMelody Pair > voiceTune = Music.line > (map (\(n,ph) -> > n (TutAttr 1 (fromIntegral (fromEnum ph), 2))) > [(c 1 hn, Aaa), (e 1 hn, Ehh), (g 1 hn, Ohh), (c 2 hn, Ehh), > (a 1 hn, Eee), (c 2 qn, Aww), (a 1 qn, Aww), (g 1 dhn, Aaa)] > ++ [qnr]) > > > voiceVibWaveTN, voiceWaveTN :: Score.Table > voiceVibWaveTable, voiceWaveTable :: SigExp > voiceVibWaveTN = 14; voiceVibWaveTable = tableNumber voiceVibWaveTN > voiceWaveTN = 15; voiceWaveTable = tableNumber voiceWaveTN > > voiceWave, voiceVibWave :: Score.Statement > voiceWave = Score.Table voiceWaveTN 0 1024 True > (let width = 50 > in lineSeg1 0 [(width, 1), (width, 0), (1024-2*width, 0)]) > voiceVibWave = Score.Table voiceVibWaveTN 0 1024 True (compSine1 [1.0, 0.4]) > > voiceScore :: TutOrchestra out -> Score.T > voiceScore orc = > voiceVibWave : voiceWave : scored orc attrToInstr1p2 voiceTune > > voiceOE :: SigExp -> SigExp -> SoundMap.InstrumentSigExp Mono > voiceOE phoneme gain _noteDur noteVel notePit = > let vol = dbToAmp noteVel > signal = voice' voiceVibWaveTable voiceWaveTable > gain (3/100) 5 vol (pchToHz notePit) phoneme > in Mono signal > > voiceOrc :: TutOrchestra Mono > voiceOrc = (hdr, [instrAssoc1p2 voiceOE]) > > voice :: (Name, Score.T, TutOrchestra Mono) > voice = example "voice" voiceScore voiceOrc \end{haskelllisting} haskore-0.2.0.3/src/Haskore/Interface/CSound/Generator.lhs0000644000000000000000000002511111754016451021414 0ustar0000000000000000\paragraph{Function Tables} \seclabel{function-table} Each function table must have a unique integer ID (\type{Table}), creation time (usually 0), size (which must be a power of 2), and a {\tt Normalize} flag. Most tables in CSound are normalized, i.e.\ rescaled to a maximum absolute value of 1. The normalization process can be skipped by setting the {\tt Normalize} flag to {\tt False}. Such a table may be desirable to generate a control or modifying signal, but is not very useful for audio signal generation. Tables are simply arrays of floating point values. The values stored in the table are calculated by one of CSound's predefined \keyword{generating routines}, represented by the type {\tt Generator.T}: \begin{haskelllisting} > module Haskore.Interface.CSound.Generator where > > import Haskore.Interface.CSound (Time) > import Haskore.General.Utility > (flattenTuples2, flattenTuples3, flattenTuples4) > > data T = Routine Number [Parameter] > | SoundFile SFName SkipTime ChanNum > deriving Show > > type SFName = String > type SkipTime = Time > type ChanNum = Float > type Number = Int > type Parameter = Float \end{haskelllisting} {\tt Routine n args} refers to CSound's generating routine $n$ (an integer), called with floating point arguments {\tt args}. There is only one generating routine (called \refgen{01}) in CSound that takes an argument type other than floating point, and thus we represent this using the special constructor {\tt SoundFile}, whose functionality will be described shortly. Knowing which of CSound's generating routines to use and with what arguments can be a daunting task. The newest version of CSound (version 4.01) provides 23 different generating routines, and each one of them assigns special meanings to its arguments. To avoid having to reference routines using integer ids, the following functions are defined for the most often-used generating routines. A brief discussion of each routine is also included. For a full description of these and other routines, refer to the CSound manual or consult the following webpage: \url{http://www.leeds.ac.uk/music/Man/Csound/Function/GENS.html}. The user familiar with CSound is free to write helper functions like the ones below to capture other generating routines. \genparagraph{01} Transfers data from a soundfile into a function table. Recall that the size of the function table in CSound must be a power of two. If the soundfile is larger than the table size, reading stops when the table is full; if it is smaller, then the table is padded with zeros. One exception is allowed: if the file is of type AIFF and the table size is set to zero, the size of the function table is allocated dynamically as the number of points in the soundfile. The table is then unusable by normal oscillators, but can be used by a special {\tt SampOsc} constructor (discussed in \secref{orchestra-file}). The first argument passed to the \refgen{01} subroutine is a string containing the name of the source file. The second argument is skip time, which is the number of seconds into the file that the reading begins. Finally there is an argument for the channel number, with 0 meaning read all channels. \refgen{01} is represented in Haskore as {\tt SoundFile SFName SkipTime ChanNum}, as discussed earlier. To make the use of {\tt SoundFile} consistent with the use of other functions to be described shortly, we define a simple equivalent: \begin{haskelllisting} > soundFile :: SFName -> SkipTime -> ChanNum -> T > soundFile = SoundFile \end{haskelllisting} \genparagraph{02} Transfers data from its argument fields directly into the function table. We represent its functionality as follows: \begin{haskelllisting} > tableValues :: [Parameter] -> T > tableValues gas = Routine 2 gas \end{haskelllisting} \genparagraph{03} Fills the table by evaluating a polynomial over a specified interval and with given coefficients. For example, calling \refgen{03} with an interval of $(-1,1)$ and coefficients 5, 4, 3, 2, 0, 1 will generate values of the function $5+4x+3x^2+2x^3+x^5$ over the interval $-1$ to $1$. The number of values generated is equal to the size of the table. Let's express this by the following function: \begin{haskelllisting} > polynomial :: Interval -> Coefficients -> T > polynomial (x1,x2) cfs = Routine 3 (x1:x2:cfs) > > type Interval = (Float, Float) > type Coefficients = [Float] \end{haskelllisting} \genparagraph{05} Constructs a table from segments of exponential curves. The first argument is the starting point. The meaning of the subsequent arguments alternates between the length of a segment in samples, and the endpoint of the segment. The endpoint of one segment is the starting point of the next. The sum of all the segment lengths normally equals the size of the table: if it is less the table is padded with zeros, if it is more, only the first \type{TableSize} locations will be stored in the table. \begin{haskelllisting} > exponential1 :: StartPt -> [(SegLength, EndPt)] -> T > exponential1 sp xs = Routine 5 (sp : flattenTuples2 xs) > > type StartPt = Float > type SegLength = Float > type EndPt = Float \end{haskelllisting} \genparagraph{25} Similar to \refgen{05} in that it produces segments of exponential curves, but instead of representing the lengths of segments and their endpoints, its arguments represent $(x,y)$ coordinates in the table, and the subroutine produces curves between successive locations. The $x$-coordinates must be in increasing order. \begin{haskelllisting} > exponential2 :: [Point] -> T > exponential2 pts = Routine 25 (flattenTuples2 pts) > > type Point = (Float,Float) \end{haskelllisting} \genparagraph{06} Generates a table from segments of cubic polynomial functions, spanning three points at a time. We define a function {\tt cubic} with two arguments: a starting position and a list of segment length (in number of samples) and segment endpoint pairs. The endpoint of one segment is the starting point of the next. The meaning of the segment endpoint alternates between a local minimum/maximum and point of inflexion. Whether a point is a maximum or a minimum is determined by its relation to the next point of inflexion. Also note that for two successive minima or maxima, the inflexion points will be jagged, whereas for alternating maxima and minima, they will be smooth. The slope of the two segments is independent at the point of inflection and will likely vary. The starting point is a local minimum or maximum (if the following point is greater than the starting point, then the starting point is a minimum, otherwise it is a maximum). The first pair of numbers will in essence indicate the position of the first inflexion point in $(x,y)$ coordinates. The folowing pair will determine the next local minimum/maximum, followed by the second point of inflexion, etc. \begin{haskelllisting} > cubic :: StartPt -> [(SegLength, EndPt)] -> T > cubic sp pts = Routine 6 (sp : flattenTuples2 pts) \end{haskelllisting} \genparagraph{07} Similar to \refgen{05}, except that it generates straight lines instead of exponential curve segments. All other issues discussed about \refgen{05} also apply to \refgen{07}. We represent it as: \begin{haskelllisting} > lineSeg1 :: StartPt -> [(SegLength, EndPt)] -> T > lineSeg1 sp pts = Routine 7 (sp : flattenTuples2 pts) \end{haskelllisting} \genparagraph{27} As with \refgen{05} and \refgen{25}, produces straight line segments between points whose locations are given as $(x,y)$ coordinates, rather than a list of segment length, endpoint pairs. \begin{haskelllisting} > lineSeg2 :: [Point] -> T > lineSeg2 pts = Routine 27 (flattenTuples2 pts) \end{haskelllisting} \genparagraph{08} Produces a smooth piecewise cubic spline curve through the specified points. Neighboring segments have the same slope at the common points, and it is that of a parabola through that point and its two neighbors. The slope is zero at the ends. \begin{haskelllisting} > cubicSpline :: StartPt -> [(SegLength, EndPt)] -> T > cubicSpline sp pts = Routine 8 (sp : flattenTuples2 pts) \end{haskelllisting} \genparagraph{10} Produces a composite sinusoid. It takes a list of relative strengths of harmonic partials 1, 2, 3, etc. Partials not required should be given strength of zero. \begin{haskelllisting} > compSine1 :: [PStrength] -> T > compSine1 pss = Routine 10 pss > > type PStrength = Float \end{haskelllisting} \genparagraph{09} Also produces a composite sinusoid, but requires three arguments to specify each contributing partial. The arguments specify the partial number, which doesn't have to be an integer (i.e.\ inharmonic partials are allowed), the relative partial strength, and the initial phase offset of each partial, expressed in degrees. \begin{haskelllisting} > compSine2 :: [(PNum, PStrength, PhaseOffset)] -> T > compSine2 args = Routine 9 (flattenTuples3 args) > > type PNum = Float > type PhaseOffset = Float \end{haskelllisting} \genparagraph{19} Provides all of the functionality of \refgen{09}, but in addition a DC offset must be specified for each partial. The DC offset is a vertical displacement, so that a value of 2 will lift a 2-strength partial from range $[-2,2]$ to range $[0,4]$ before further scaling. \begin{haskelllisting} > compSine3 :: [(PNum, PStrength, PhaseOffset, DCOffset)] -> T > compSine3 args = Routine 19 (flattenTuples4 args) > > type DCOffset = Float \end{haskelllisting} \genparagraph{11} Produces an additive set of harmonic cosine partials, similar to \refgen{10}. We will represent it by a function that takes three arguments: the number of harmonics present, the lowest harmonic present, and a multiplier in an exponential series of harmonics amplitudes (if the $x$'th harmonic has strength coefficient of $A$, then the $(x+n)$'th harmonic will have a strength of $A*(r^n)$, where $r$ is the multiplier). \begin{haskelllisting} > cosineHarms :: NHarms -> LowestHarm -> Mult -> T > cosineHarms n l m = Routine 11 [fromIntegral n, fromIntegral l, m] > > type NHarms = Int > type LowestHarm = Int > type Mult = Float \end{haskelllisting} \genparagraph{21} Produces tables having selected random distributions. \begin{haskelllisting} > randomTable :: RandDist -> T > randomTable rd = Routine 21 [fromIntegral (fromEnum rd + 1)] > > data RandDist = > Uniform > | Linear > | Triangular > | Expon > | BiExpon > | Gaussian > | Cauchy > | PosCauchy > deriving (Eq, Ord, Enum, Show) \end{haskelllisting} \begin{haskelllisting} > toStatementWords :: T -> [String] > toStatementWords (Routine gn gas) = show gn : map show gas > toStatementWords (SoundFile nm st cn) = ["1", nm, show st, "0", show cn] \end{haskelllisting} haskore-0.2.0.3/src/Haskore/Interface/CSound/TutorialCustom.lhs0000644000000000000000000017151011754016451022471 0ustar0000000000000000\subsubsection{Tutorial} \seclabel{csound-tut} This tutorial is essentially the same like Tutorial.lhs but it uses less code from the CSound wrapper modules and shows how to implement custom routines for more flexibility. \begin{haskelllisting} > module Haskore.Interface.CSound.TutorialCustom where > import Haskore.Interface.CSound.Orchestra as Orchestra > hiding (Instrument) > import Haskore.Interface.CSound.Score as Score > import Haskore.Interface.CSound.Generator > (compSine1, compSine2, cubicSpline, lineSeg1) > import qualified Haskore.Interface.CSound as CSound > import qualified Haskore.Performance as Performance > import qualified Haskore.Performance.Context as Context > import qualified Haskore.Performance.Fancy as FancyPerformance > import qualified Haskore.Music as Music > import qualified Haskore.Music.Rhythmic as RhyMusic > import qualified Numeric.NonNegative.Wrapper as NonNeg > import Haskore.Basic.Duration > import Haskore.Music ((+:+), (=:=), qnr) > import Haskore.Melody as Melody > import System.Cmd (system, ) > import System.Exit (ExitCode, ) > lineCS :: EvalRate -> SigExp -> SigExp > -> SigExp -> SigExp > lineCS = Orchestra.line \end{haskelllisting} This brief tutorial is designed to introduce the user to the capabilities of the CSound software synthesizer and sound synthesis in general. \paragraph{Additive Synthesis} \seclabel{add-syn} The first part of the tutorial introduces \keyword{additive synthesis}. Additive synthesis is the most basic, yet the most powerful synthesis technique available, giving complete control over the sound waveform. The basic premiss behind additive sound synthesis is quite simple -- defining a complex sound by specifying each contributing sine wave. The computer is very good at generating pure tones, but these are not very interesting. However, any sound imaginable can be reproduced as a sum of pure tones. We can define an instrument of pure tones easily in Haskore. First we define a \keyword{Function table} containing a lone sine wave. We can do this using the \function{simpleSine} function defined in the \module{CSound.Orchestra} module: \begin{haskelllisting} > pureToneTN :: Score.Table > pureToneTN = 1 > pureToneTable :: SigExp > pureToneTable = tableNumber pureToneTN > pureTone :: Score.Statement > pureTone = Score.Table pureToneTN 0 8192 True (compSine1 [1.0]) > oscPure :: SigExp -> SigExp -> SigExp > oscPure = osc AR pureToneTable \end{haskelllisting} \code{pureToneTN} is the table number of the simple sine wave. We will adopt the convention in this tutorial that variables ending with \code{TN} represent table numbers. Recall that \function{compSine1} is defined in the module \module{CSound} as a sine wave generating routine (\refgen{10}). In order to have a complete score file, we also need a tune. Here is a simple example: \begin{haskelllisting} > type TutMelody params = Melody.T (TutAttr params) > > data TutAttr params = > TutAttr {attrVelocity :: Rational, > attrParameters :: params} > > tune1 :: TutMelody () > tune1 = Music.line (map ($ TutAttr 1.5 ()) > [ c 1 hn, e 1 hn, g 1 hn, > c 2 hn, a 1 hn, c 2 qn, > a 1 qn, g 1 dhn ] ++ [qnr]) \end{haskelllisting} The next step is to convert the melody into a music. In our simple tutorial we have only one instrument per song in all but one case. So we could skip this step, but we want to include it in order to show the general processing steps. We use the general data type for rhythmic music, with no drum definitions (null type \type{()}) and a custom instrument definition \type{Instrument}. We use only the instrument numbers 1 and 2 but the numbers are associated with different sounds in the examples. \begin{haskelllisting} > data Instrument = > Instr1p0 > | Instr2p0 > | Instr1p2 Float Float > | Instr1p4 Float Float Float Float > deriving (Eq, Ord, Show) > > musicFromMelody :: (params -> Instrument) -> > TutMelody params -> RhyMusic.T () Instrument > musicFromMelody instr = > Music.mapNote > (\(Melody.Note (TutAttr vel params) p) -> > RhyMusic.Note vel (RhyMusic.Tone (instr params) p)) \end{haskelllisting} The melody contains instrument specific parameters. They will be embedded in \type{Instrument} values by the following functions. These functions can be used as \code{instr} arguments to \function{musicFromMelody}. \begin{haskelllisting} > type Pair = (Float, Float) > type Quadruple = (Float, Float, Float, Float) > > attrToInstr1p0 :: () -> Instrument > attrToInstr1p0 () = Instr1p0 > > attrToInstr2p0 :: () -> Instrument > attrToInstr2p0 () = Instr2p0 > > attrToInstr1p2 :: Pair -> Instrument > attrToInstr1p2 = uncurry Instr1p2 > > attrToInstr1p4 :: Quadruple -> Instrument > attrToInstr1p4 (x,y,z,w) = Instr1p4 x y z w \end{haskelllisting} There is nothing special about the conversion from the music to the performance. \begin{haskelllisting} > performanceFromMusic :: RhyMusic.T () Instrument -> > Performance.T NonNeg.Float Float (RhyMusic.Note () Instrument) > performanceFromMusic = > FancyPerformance.fromMusicModifyContext (Context.setDur 1) \end{haskelllisting} Now we convert from the performance to the CSound score. To this end we must convert the instruments represented by \type{Instrument} to sound numbers and parameter fields. \begin{haskelllisting} > instrNum1, instrNum2 :: CSound.Instrument > instrNum1 = CSound.instrument 1 > instrNum2 = CSound.instrument 2 > > instrToNum :: Instrument -> ([CSound.PField], CSound.Instrument) > instrToNum (Instr1p0 ) = ([], instrNum1) > instrToNum (Instr2p0 ) = ([], instrNum2) > instrToNum (Instr1p2 x y ) = ([x,y], instrNum1) > instrToNum (Instr1p4 x y z w) = ([x,y,z,w], instrNum1) > > scoreFromPerformance :: > TutOrchestra out -> > Performance.T NonNeg.Float Float (RhyMusic.Note () Instrument) -> Score.T > scoreFromPerformance _ = > Score.fromRhythmicPerformanceMap > (error "no drum map defined") instrToNum \end{haskelllisting} We want to provide some more type safety by distinction between sound expressions with different number of parameters. In our tutorial have sounds are controlled by three different numbers of parameters: 0, 2, and 4. These variants are unified with the data type \type{OutFunc} which let us also define a specialised orchestra. \begin{haskelllisting} > data OutFunc out = > OutFunc0 out > | OutFunc2 (SigExp -> SigExp -> out) > | OutFunc4 (SigExp -> SigExp -> SigExp -> SigExp -> out) > > type TutOrchestra out = (Orchestra.Header, [(CSound.Instrument, OutFunc out)]) \end{haskelllisting} This special data type allows us to check dynamically whether the number of arguments specified in the music match the parameters expected in the orchestra. So define \function{scoreFromPerformanceSafe}, a safe variant of \function{scoreFromPerformance}. \begin{haskelllisting} > matchInstrOutFunc :: Instrument -> OutFunc out -> Bool > matchInstrOutFunc (Instr1p0 ) (OutFunc0 _) = True > matchInstrOutFunc (Instr2p0 ) (OutFunc0 _) = True > matchInstrOutFunc (Instr1p2 _ _ ) (OutFunc2 _) = True > matchInstrOutFunc (Instr1p4 _ _ _ _) (OutFunc4 _) = True > matchInstrOutFunc _ _ = False > > scoreFromPerformanceSafe :: > TutOrchestra out -> > Performance.T NonNeg.Float Float (RhyMusic.Note () Instrument) -> Score.T > scoreFromPerformanceSafe orc = > Score.fromRhythmicPerformanceMap (error "no drum map defined") > (\instr -> > let (params, num) = instrToNum instr > in maybe > (error ("CSound.Tutorial.scoreFromPerformance: " ++ > "instrument with number " ++ show instr ++ > " not in orchestra.")) > (\outFunc -> > if matchInstrOutFunc instr outFunc > then (params, num) > else error ("CSound.Tutorial.scoreFromPerformance: " ++ > "number of parameters of instrument " ++ > show instr ++ > " differ in instrMap and orchestra.")) > (lookup num (snd orc))) \end{haskelllisting} The function \function{scored} puts the chain from melody to CSound score together. Finally the function \function{example} collects music and instrument definitions, that is a complete example. \begin{haskelllisting} > scored :: TutOrchestra out -> (params -> Instrument) -> > TutMelody params -> Score.T > scored orc instr = > scoreFromPerformanceSafe orc . > performanceFromMusic . > musicFromMelody instr > > example :: Name -> (TutOrchestra out -> Score.T) -> TutOrchestra out -> > (Name, Score.T, TutOrchestra out) > example name mkScore orc = (name, mkScore orc, orc) \end{haskelllisting} Let's define an instrument in the orchestra file that will use the function table \code{pureTone}: \begin{haskelllisting} > oe1 :: Mono > oe1 = let signal = oscPure (dbToAmp noteVel) (pchToHz notePit) > in Mono signal > > score1 orc = pureTone : scored orc attrToInstr1p0 tune1 \end{haskelllisting} This instrument will simply oscillate through the function table containing the sine wave at the appropriate frequency given by \code{notePit}, and the resulting sound will have an amplitude given by \code{noteVel}. Note that the \code{oe1} expression above is a \code{Mono}, not a complete \code{TutOrchestra}. We need to define a \keyword{header} and associate \code{oe1} with the instrument that's playing it: \begin{haskelllisting} > hdr :: Orchestra.Header > hdr = (44100, 4410) > > o1, o2, o3, o4, o7, o8, o9, o13, o14, o15, o19, o22 > :: TutOrchestra Mono > o5, o6, o10, o11, o12, o16, o17, o18, o20, o21 > :: TutOrchestra Stereo > > tut1, tut2, tut3, tut4, tut7, tut8, tut9, tut13, tut14, tut15, tut19, tut22 > :: (Name, Score.T, TutOrchestra Mono) > tut5, tut6, tut10, tut11, tut12, tut16, tut17, tut18, tut20, tut21 > :: (Name, Score.T, TutOrchestra Stereo) > > score1, score2, score3, score4, score5, score6, score7, score8, score9 > :: TutOrchestra out -> [Score.Statement] > > o1 = let i = (instrNum1, OutFunc0 oe1) > in (hdr, [i]) \end{haskelllisting} The header above indicates that the audio signals are generated at 44,100 Hz (CD quality), the control signals are generated at 4,410 Hz, and there are 2 output channels for stereo sound. Now we have a complete score and orchestra that can be converted to a sound file by CSound and played as follows: \begin{haskelllisting} > csoundDir :: Name > csoundDir = "src/Test/CSound" > -- csoundDir = "C:/TEMP/csound" > > tut1 = example "tut01" score1 o1 \end{haskelllisting} If you listen to the tune, you will notice that it sounds very thin and uninteresting. Most musical sounds are not pure. Instead they usually contain a sine wave of dominant frequency, called a \keyword{fundamental}, and a number of other sine waves called \keyword{partials}. Partials with frequencies that are integer multiples of the fundamental are called \keyword{harmonics}. In musical terms, the first harmonic lies an octave above the fundamental, second harmonic a fifth above the first one, the third harmonic lies a major third above the second harmonic etc. This is the familiar \keyword{overtone series}. We can add harmonics to our sine wave instrument easily using the \function{compSine} function defined in the \module{CSound.Orchestra} module. The function takes a list of harmonic strengths as arguments. The following creates a function table containing the fundamental and the first two harmonics at two thirds and one third of the strength of the fundamental: \begin{haskelllisting} > twoHarmsTN :: Score.Table > twoHarmsTN = 2 > twoHarms :: Score.Statement > twoHarms = Score.Table twoHarmsTN 0 8192 True (compSine1 [1.0, 0.66, 0.33]) \end{haskelllisting} We can again proceed to create complete score and orchestra files as above: \begin{haskelllisting} > score2 orc = twoHarms : scored orc attrToInstr1p0 tune1 > > oe2 :: Mono > oe2 = let signal = osc AR (tableNumber twoHarmsTN) > (dbToAmp noteVel) (pchToHz notePit) > in Mono signal > > o2 = let i = (instrNum1, OutFunc0 oe2) > in (hdr, [i]) > > tut2 = example "tut02" score2 o2 \end{haskelllisting} The orchestra file is the same as before -- a single oscillator scanning a function table at a given frequency and volume. This time, however, the tune will not sound as thin as before since the table now contains a function that is an addition of three sine waves. (Note that the same effect could be achieved using a simple sine wave table and three oscillators). Not all musical sounds contain harmonic partials exclusively, and never do we encounter instruments with static amplitude envelope like the ones we have seen so far. Most sounds, musical or not, evolve and change throughout their duration. Let's define an instrument containing both harmonic and nonharmonic partials, that starts at maximum amplitude with a straight line decay. We will use the function \function{compSine2} from the \module{CSound.Orchestra} module to create the function table. \function{compSine2} takes a list of triples as an argument. The triples specify the partial number as a multiple of the fundamental, relative partial strength, and initial phase offset: \begin{haskelllisting} > manySinesTN :: Score.Table > manySinesTN = 3 > manySinesTable :: SigExp > manySinesTable = tableNumber manySinesTN > manySines :: Score.Statement > manySines = Score.Table manySinesTN 0 8192 True (compSine2 [(0.5, 0.9, 0.0), > (1.0, 1.0, 0.0), (1.1, 0.7, 0.0), (2.0, 0.6, 0.0), > (2.5, 0.3, 0.0), (3.0, 0.33, 0.0), (5.0, 0.2, 0.0)]) \end{haskelllisting} Thus this complex will contain the second, third, and fifth harmonic, nonharmonic partials at frequencies of 1.1 and 2.5 times the fundamental, and a component at half the frequency of the fundamental. Their strengths relative to the fundamental are given by the second argument, and they all start in sync with zero offset. Now we can proceed as before to create score and orchestra files. We will define an \keyword{amplitude envelope} to apply to each note as we oscillate through the table. The amplitude envelope will be a straight line signal ramping from 1.0 to 0.0 over the duration of the note. This signal will be generated at \keyword{control rate} rather than audio rate, because the control rate is more than sufficient (the audio signal will change volume 4,410 times a second), and the slower rate will improve performance. \begin{haskelllisting} > score3 orc = manySines : scored orc attrToInstr1p0 tune1 > > oe3 :: Mono > oe3 = let ampEnv = lineCS CR 1.0 noteDur 0.0 > signal = osc AR manySinesTable > (ampEnv * dbToAmp noteVel) (pchToHz notePit) > in Mono signal > > o3 = let i = (instrNum1, OutFunc0 oe3) > in (hdr, [i]) > > tut3 = example "tut03" score3 o3 \end{haskelllisting} Not only do musical sounds usually evolve in terms of overall amplitude, they also evolve their \keyword{spectra}. In other words, the contributing partials do not usually all have the same amplitude envelope, and so their contribution to the overall sound isn't static. Let us illustrate the point using the same set of partials as in the above example. Instead of creating a table containing a complex waveform, however, we will use multiple oscillators going through the simple sine wave table we created at the beginning of this tutorial at the appropriate frequencies. Thus instead of the partials being fused together, each can have its own amplitude envelope, making the sound evolve over time. The score will be score1, defined above. \begin{haskelllisting} > oe4 :: Mono > oe4 = let pitch = pchToHz notePit > amp = dbToAmp noteVel > mkLine t = lineSeg CR 0 (noteDur*t) 1 [(noteDur * (1-t), 0)] > aenv1 = lineCS CR 1 noteDur 0 > aenv2 = mkLine 0.17 > aenv3 = mkLine 0.33 > aenv4 = mkLine 0.50 > aenv5 = mkLine 0.67 > aenv6 = mkLine 0.83 > aenv7 = lineCS CR 0 noteDur 1 > mkOsc ae p = oscPure (ae * amp) (pitch * p) > a1 = mkOsc aenv1 0.5 > a2 = mkOsc aenv2 1.0 > a3 = mkOsc aenv3 1.1 > a4 = mkOsc aenv4 2.0 > a5 = mkOsc aenv5 2.5 > a6 = mkOsc aenv6 3.0 > a7 = mkOsc aenv7 5.0 > out = 0.5 * (a1 + a2 + a3 + a4 + a5 + a6 + a7) > in Mono out > > o4 = let i = (instrNum1, OutFunc0 oe4) > in (hdr, [i]) > > tut4 = example "tut04" score1 o4 \end{haskelllisting} So far, we have only used function tables to generate audio signals, but they can come very handy in \keyword{modifying} signals. Let us create a function table that we can use as an amplitude envelope to make our instrument more interesting. The envelope will contain an immediate sharp attack and decay, and then a second, more gradual one, so we'll have two attack/decay events per note. We'll use the cubic spline curve generating routine to do this: \begin{haskelllisting} > coolEnvTN :: Score.Table > coolEnvTN = 4 > coolEnvTable :: SigExp > coolEnvTable = tableNumber coolEnvTN > coolEnv :: Score.Statement > coolEnv = Score.Table coolEnvTN 0 8192 True > (cubicSpline 1 [(1692, 0.2), (3000, 1), (3500, 0)]) > oscCoolEnv :: SigExp -> SigExp -> SigExp > oscCoolEnv = osc CR coolEnvTable \end{haskelllisting} Let us also add some \keyword{p-fields} to the notes in our score. The two p-fields we add will be used for \keyword{panning} -- the first one will be the starting percentage of the left channel, the second one the ending percentage (1 means all left, 0 all right, 0.5 middle. Pfields of 1 and 0 will cause the note to pan completely from left to right for example) \begin{haskelllisting} > tune2 :: TutMelody Pair > tune2 = let attr start end = TutAttr 1.4 (start, end) > in c 1 hn (attr 1.0 0.75) +:+ > e 1 hn (attr 0.75 0.5) +:+ > g 1 hn (attr 0.5 0.25) +:+ > c 2 hn (attr 0.25 0.0) +:+ > a 1 hn (attr 0.0 1.0) +:+ > c 2 qn (attr 0.0 0.0) +:+ > a 1 qn (attr 1.0 1.0) +:+ > (g 1 dhn (attr 1.0 0.0) =:= > g 1 dhn (attr 0.0 1.0))+:+ qnr \end{haskelllisting} So far we have limited ourselves to using only sine waves for our audio output, even though Csound places no such restrictions on us. Any repeating waveform, of any shape, can be used to produce pitched sounds. In essence, when we are adding sinewaves, we are changing the shape of the wave. For example, adding odd harmonics to a fundamental at strengths equal to the inverse of their partial number (ie. third harmonic would be 1/3 the strength of the fundamental, fifth harmonic 1/5 the fundamental etc) would produce a \keyword{square} wave which has a raspy sound to it. Another common waveform is the \keyword{sawtooth}, and the more mellow sounding \keyword{triangle}. The \module{CSound.Orchestra} module already contains functions to create these common waveforms. Let's use them to create tables that we can use in an instrument: \begin{haskelllisting} > triangleTN, squareTN, sawtoothTN :: Score.Table > triangleTN = 5 > squareTN = 6 > sawtoothTN = 7 > triangleT, squareT, sawtoothT :: Score.Statement > triangleT = triangle triangleTN > squareT = square squareTN > sawtoothT = sawtooth sawtoothTN > > score4 orc = squareT : triangleT : sawtoothT : coolEnv : > scored orc attrToInstr1p2 (Music.changeTempo 0.5 tune2) > > oe5 :: SigExp -> SigExp -> Stereo > oe5 panStart panEnd = > let pitch = pchToHz notePit > amp = dbToAmp noteVel > pan = lineCS CR panStart noteDur panEnd > oscF = 1 / noteDur > ampen = oscCoolEnv amp oscF > signal = osc AR (tableNumber squareTN) ampen pitch > left = signal * pan > right = signal * (1-pan) > in Stereo left right > > o5 = let i = (instrNum1, OutFunc2 oe5) > in (hdr, [i]) > > tut5 = example "tut05" score4 o5 \end{haskelllisting} This will oscillate through a table containing the square wave. Check out the other waveforms too and see what they sound like. This can be done by specifying the table to be used in the orchestra file. As our last example of additive synthesis, we will introduce an orchestra with multiple instruments. The bass will be mostly in the left channel, and will be the same as the third example instrument in this section. It will play the tune two octaves below the instrument in the right channel, using an orchestra identical to \code{oe3} with the addition of the panning feature: \begin{haskelllisting} > score5 orc = manySines : pureTone : scored orc attrToInstr1p0 tune1 ++ > scored orc attrToInstr2p0 tune1 > > oe6 :: Stereo > oe6 = let ampEnv = lineCS CR 1.0 noteDur 0.0 > signal = osc AR manySinesTable > (ampEnv * dbToAmp noteVel) (pchToHz (notePit - 2)) > left = 0.8 * signal > right = 0.2 * signal > in Stereo left right > > oe7 :: Stereo > oe7 = let pitch = pchToHz notePit > amp = dbToAmp noteVel > mkLine t = lineSeg CR 0 (noteDur*t) 0.5 [(noteDur * (1-t), 0)] > aenv1 = lineCS CR 0.5 noteDur 0 > aenv2 = mkLine 0.17 > aenv3 = mkLine 0.33 > aenv4 = mkLine 0.50 > aenv5 = mkLine 0.67 > aenv6 = mkLine 0.83 > aenv7 = lineCS CR 0 noteDur 0.5 > mkOsc ae p = oscPure (ae * amp) (pitch * p) > a1 = mkOsc aenv1 0.5 > a2 = mkOsc aenv2 1.0 > a3 = mkOsc aenv3 1.1 > a4 = mkOsc aenv4 2.0 > a5 = mkOsc aenv5 2.5 > a6 = mkOsc aenv6 3.0 > a7 = mkOsc aenv7 5.0 > left = 0.2 * (a1 + a2 + a3 + a4 + a5 + a6 + a7) > right = 0.8 * (a1 + a2 + a3 + a4 + a5 + a6 + a7) > in Stereo left right > > o6 = let i1 = (instrNum1, OutFunc0 oe6) > i2 = (instrNum2, OutFunc0 oe7) > in (hdr, [i1, i2]) > > tut6 = example "tut06" score5 o6 \end{haskelllisting} Additive synthesis is the most powerful tool in computer music and sound synthesis in general. It can be used to create any sound imaginable, whether completely synthetic or a simulation of a real-world sound, and everyone interested in using the computer to synthesize sound should be well versed in it. The most significant drawback of additive synthesis is that it requires huge amounts of control data, and potentially thousands of oscillators. There are other synthesis techniques, such as \keyword{modulation synthesis}, that can be used to create rich and interesting timbres at a fraction of the cost of additive synthesis, though no other synthesis technique provides quite the same degree of control. \paragraph{Modulation Synthesis} \seclabel{mod-syn} While additive synthesis provides full control and great flexibility, it is quiet clear that the enormous amounts of control data make it impractical for even moderately complicated sounds. There is a class of synthesis techniques that use \keyword{modulation} to produce rich, time-varying timbres at a fraction of the storage and time cost of additive synthesis. The basic idea behind modulation synthesis is controlling the amplitude and/or frequency of the main periodic signal, called the \keyword{carrier}, by another periodic signal, called the \keyword{modulator}. The two main kinds of modulation synthesis are \keyword{amplitude modulation} and \keyword{frequency modulation} synthesis. Let's start our discussion with the simpler one of the two -- amplitude synthesis. We have already shown how to supply a time varying amplitude envelope to an oscillator. What would happen if this amplitude envelope was itself an oscillating signal? Supplying a low frequency ($<20$Hz) modulating signal would create a predictable effect -- we would hear the volume of the carrier signal go periodically up and down. However, as the modulator moves into the audible frequency range, the carrier changes timbre as new frequencies appear in the spectrum. The new frequencies are equal to the sum and difference of the carrier and modulator. So for example, if the frequency of the main signal (carrier) is C = 500Hz, and the frequency of the modulator is M = 100Hz, the audible frequencies will be the carrier C (500Hz), C + M (600Hz), and C - M (400Hz). The amplitude of the two new sidebands depends on the amplitude of the modulator, but will never exceed half the amplitude of the carrier. The following is a simple example that demonstrates amplitude modulation. The carrier will be a 10 second pure tone at 500Hz. The frequency of the modulator will increase linearly over the 10 second duration of the tone from 0 to 200 Hz. Initially, you will be able to hear the volume of the signal fluctuate, but after a couple of seconds the volume will seem constant as new frequencies appear. Let us first create the score file. It will contain a sine wave table, and a single note event: \begin{haskelllisting} > score6 _ = > pureTone : [ Score.Note instrNum1 0.0 10.0 (Cps 500.0) 10000.0 [] ] \end{haskelllisting} The orchestra will contain a single AM instrument. The carrier will simply oscillate through the sine wave table at frequency given by the note pitch (500Hz, see the score above), and amplitude given by the modulator. The modulator will oscillate through the same sine wave table at frequency ramping from 0 to 200Hz. The modulator should be a periodic signal that varies from 0 to the maximum volume of the carrier. Since the sine wave goes from -1 to 1, we will need to add 1 to it and half it, before multiplying it by the volume supplied by the note event. This will be the modulating signal, and the carrier's amplitude input. (note that we omit the conversion functions dbToAmp and notePit, since we supply the amplitude and frequency in their raw units in the score file) \begin{haskelllisting} > oe8 :: Mono > oe8 = let modFreq = lineCS CR 0.0 noteDur 200.0 > modAmp = oscPure 1.0 modFreq > modSig = (modAmp + 1.0) * 0.5 * noteVel > carrier = oscPure modSig notePit > in Mono carrier > > o7 = let i = (instrNum1, OutFunc0 oe8) > in (hdr, [i]) > > tut7 = example "tut07" score6 o7 \end{haskelllisting} Next synthesis technique on the palette is \keyword{frequency modulation}. As the name suggests, we modulate the frequency of the carrier. Frequency modulation is much more powerful and interesting than amplitude modulation, because instead of getting two sidebands, FM gives a {\em number} of spectral sidebands. Let us begin with an example of a simple FM. We will again use a single 10 second note and a 500Hz carrier. Remember that when we talked about amplitude modulation, the amplitude of the sidebands was dependent upon the amplitude of the modulator. In FM, the modulator amplitude plays a much bigger role, as we will see soon. To negate the effect of the modulator amplitude, we will keep the ratio of the modulator amplitude and frequency constant at 1.0 (we will explain shortly why). The frequency and amplitude of the modulator will ramp from 0 to 200 over the duration of the note. This time, though, unlike with AM, we will hear a whole series of sidebands. The orchestra is just as before, except we modulate the frequency instead of amplitude. \begin{haskelllisting} > oe9 :: Mono > oe9 = let modFreq = lineCS CR 0.0 noteDur 200.0 > modAmp = modFreq > modSig = oscPure modAmp modFreq > carrier = oscPure noteVel (notePit + modSig) > in Mono carrier > > o8 = let i = (instrNum1, OutFunc0 oe9) > in (hdr, [i]) > > tut8 = example "tut08" score6 o8 \end{haskelllisting} The sound produced by FM is a little richer but still very bland. Let us talk now about the role of the \keyword{depth} of the frequency modulation (the amplitude of the modulator). Unlike in AM, where we only had one spectral band on each side of the carrier frequency (ie we heard C, C+M, C-M), FM gives a much richer spectrum with many sidebands. The frequencies we hear are C, C+M, C-M, C+2M, C-2M, C+3M, C-3M etc. The amplitudes of the sidebands are determined by the \keyword{modulation index} I, which is the ratio between the amplitude (also referred to as depth) and frequency of the modulator (I = D / M). As a rule of thumb, the number of significant sideband pairs (at least 1% the volume of the carrier) is I+1. As I (and the number of sidebands) increases, energy is "stolen" from the carrier and distributed among the sidebands. Thus if I=1, we have 2 significant sideband pairs, and the audible frequencies will be C, C+M, C-M, C+2M, C-2M, with C, the carrier, being the dominant frequency. When I=5, we will have a much richer sound with about 6 significant sideband pairs, some of which will actually be louder than the carrier. Let us explore the effect of the modulation index in the following example. We will keep the frequency of the carrier and the modulator constant at 500Hz and 80 Hz respectively. The modulation index will be a stepwise function from 1 to 10, holding each value for one second. So in effect, during the first second (I = D/M = 1), the amplitude of the modulator will be the same as its frequency (80). During the second second (I = 2), the amplitude will be double the frequency (160), then it will go to 240, 320, etc: \begin{haskelllisting} > oe10 :: Mono > oe10 = let modInd = lineSeg CR 1 1 1 [(0,2), (1,2), (0,3), (1,3), (0,4), > (1,4), (0,5), (1,5), (0,6), (1,6), > (0,7), (1,7), (0,8), (0,9), (1,9), > (0,10), (1,10)] > modAmp = 80.0 * modInd > modSig = oscPure modAmp 80.0 > carrier = oscPure noteVel (notePit + modSig) > in Mono carrier > > o9 = let i = (instrNum1, OutFunc0 oe10) > in (hdr, [i]) > > tut9 = example "tut09" score6 o9 \end{haskelllisting} Notice that when the modulation index gets high enough, some of the sidebands have negative frequencies. For example, when the modulation index is 7, there is a sideband present in the sound with a frequency C - 7M = 500 - 560 = -60Hz. The negative sidebands get reflected back into the audible spectrum but are \keyword{phase shifted} 180 degrees, so it is an inverse sine wave. This makes no difference when the wave is on its own, but when we add it to its inverse, the two will cancel out. Say we set the frequency of the carrier at 100Hz instead of 80Hz. Then at I=6, we would have present two sidebands of the same frequency - C-4M = 100Hz, and C-6M = -100Hz. When these two are added, they would cancel each other out (if they were the same amplitude; if not, the louder one would be attenuated by the amplitude of the softer one). The following flexible instrument will sum up simple FM. The frequency of the modulator will be determined by the C/M ratio supplied as p6 in the score file. The modulation index will be a linear slope going from 0 to p7 over the duration of each note. Let us also add panning control as in additive synthesis - p8 will be the initial left channel percentage, and p9 the final left channel percentage: \begin{haskelllisting} > oe11 :: SigExp -> SigExp -> SigExp -> SigExp -> Stereo > oe11 modFreqRatio modIndEnd panStart panEnd = > let carFreq = pchToHz notePit > carAmp = dbToAmp noteVel > modFreq = carFreq * modFreqRatio > modInd = lineCS CR 0 noteDur modIndEnd > modAmp = modFreq * modInd > modSig = oscPure modAmp modFreq > carrier = oscPure carAmp (carFreq + modSig) > mainAmp = oscCoolEnv 1.0 (1/noteDur) > pan = lineCS CR panStart noteDur panEnd > left = mainAmp * pan * carrier > right = mainAmp * (1 - pan) * carrier > in Stereo left right > > o10 = let i = (instrNum1, OutFunc4 oe11) > in (hdr, [i]) \end{haskelllisting} Let's write a cool tune to show off this instrument. Let's keep it simple and play the chord progression Em - C - G - D a few times, each time changing some of the parameters: \begin{haskelllisting} > emChord, cChord, gChord, dChord :: > Float -> Float -> Float -> Float -> > TutMelody Quadruple > > quickChord :: > [Music.Dur -> TutAttr Quadruple -> TutMelody Quadruple] -> > Float -> Float -> Float -> Float -> > TutMelody Quadruple > quickChord ns x y z w = Music.chord $ > map (\p -> p wn (TutAttr 1.4 (x, y, z, w))) ns > > emChord = quickChord [e 0, g 0, b 0] > cChord = quickChord [c 0, e 0, g 0] > gChord = quickChord [g 0, b 0, d 1] > dChord = quickChord [d 0, fs 0, a 0] > > tune3 :: TutMelody Quadruple > tune3 = > Music.transpose (-12) $ > emChord 3.0 2.0 0.0 1.0 +:+ cChord 3.0 5.0 1.0 0.0 +:+ > gChord 3.0 8.0 0.0 1.0 +:+ dChord 3.0 12.0 1.0 0.0 +:+ > emChord 3.0 4.0 0.0 0.5 +:+ cChord 5.0 4.0 0.5 1.0 +:+ > gChord 8.0 4.0 1.0 0.5 +:+ dChord 10.0 4.0 0.5 0.0 +:+ > (emChord 4.0 6.0 1.0 0.0 =:= emChord 7.0 5.0 0.0 1.0) +:+ > (cChord 5.0 9.0 1.0 0.0 =:= cChord 9.0 5.0 0.0 1.0) +:+ > (gChord 5.0 5.0 1.0 0.0 =:= gChord 7.0 7.0 0.0 1.0) +:+ > (dChord 2.0 3.0 1.0 0.0 =:= dChord 7.0 15.0 0.0 1.0) \end{haskelllisting} Now we can create a score. It will contain two wave tables -- one containing the sine wave, and the other containing an amplitude envelope, which will be the table coolEnv which we have already seen before \begin{haskelllisting} > score7 orc = pureTone : coolEnv : > scored orc attrToInstr1p4 (Music.changeTempo 0.5 tune3) > > tut10 = example "tut10" score7 o10 \end{haskelllisting} Note that all of the above examples of frequency modulation use a single carrier and a single modulator, and both are oscillating through the simplest of waveforms -- a sine wave. Already we have achieved some very rich and interesting timbres using this simple technique, but the possibilities are unlimited when we start using different carrier and modulator waveshapes and multiple carriers and/or modulators. Let us include a couple more examples that will play the same chord progression as above with multiple carriers, and then with multiple modulators. The reason for using multiple carriers is to obtain {/em formant regions} in the spectrum of the sound. Recall that when we modulate a carrier frequency we get a spectrum with a central peak and a number of sidebands on either side of it. Multiple carriers introduce additional peaks and sidebands into the composite spectrum of the resulting sound. These extra peaks are called formant regions, and are characteristic of human voice and most musical instruments \begin{haskelllisting} > oe12 :: SigExp -> SigExp -> SigExp -> SigExp -> Stereo > oe12 modFreqRatio modIndEnd panStart panEnd = > let car1Freq = pchToHz notePit > car2Freq = pchToHz (notePit + 1) > car1Amp = dbToAmp noteVel > car2Amp = dbToAmp noteVel * 0.7 > modFreq = car1Freq * modFreqRatio > modInd = lineCS CR 0 noteDur modIndEnd > modAmp = modFreq * modInd > modSig = oscPure modAmp modFreq > carrier1 = oscPure car1Amp (car1Freq + modSig) > carrier2 = oscPure car2Amp (car2Freq + modSig) > mainAmp = oscCoolEnv 1.0 (1/noteDur) > pan = lineCS CR panStart noteDur panEnd > left = mainAmp * pan * (carrier1 + carrier2) > right = mainAmp * (1 - pan) * (carrier1 + carrier2) > in Stereo left right > > o11 = let i = (instrNum1, OutFunc4 oe12) > in (hdr, [i]) > > tut11 = example "tut11" score7 o11 \end{haskelllisting} In the above example, there are two formant regions -- one is centered around the note pitch frequency provided by the score file, the other an octave above. Both are modulated in the same way by the same modulator. The sound is even richer than that obtained by simple FM. Let us now turn to multiple modulator FM. In this case, we use a signal to modify another signal, and the modified signal will itself become a modulator acting on the carrier. Thus the wave that wil be modulating the carrier is not a sine wave as above, but is itself a complex waveform resulting from simple FM. The spectrum of the sound will contain a central peak frequency, surrounded by a number of sidebands, but this time each sideband will itself also by surrounded by a number of sidebands of its own. So in effect we are talking about "double" modulation, where each sideband is a central peak in its own little spectrum. Multiple modulator FM thus provides extremely rich spectra \begin{haskelllisting} > oe13 :: SigExp -> SigExp -> SigExp -> SigExp -> Stereo > oe13 modFreqRatio modIndEnd panStart panEnd = > let carFreq = pchToHz notePit > carAmp = dbToAmp noteVel > mod1Freq = carFreq * modFreqRatio > mod2Freq = mod1Freq * 2.0 > modInd = lineCS CR 0 noteDur modIndEnd > mod1Amp = mod1Freq * modInd > mod2Amp = mod1Amp * 3.0 > mod1Sig = oscPure mod1Amp mod1Freq > mod2Sig = oscPure mod2Amp (mod2Freq + mod1Sig) > carrier = oscPure carAmp (carFreq + mod2Sig) > mainAmp = oscCoolEnv 1.0 (1/noteDur) > pan = lineCS CR panStart noteDur panEnd > left = mainAmp * pan * carrier > right = mainAmp * (1 - pan) * carrier > in Stereo left right > > o12 = let i = (instrNum1, OutFunc4 oe13) > in (hdr, [i]) > > tut12 = example "tut12" score7 o12 \end{haskelllisting} In fact, the spectra produced by multiple modulator FM are so rich and complicated that even the moderate values used as arguments in our tune produce spectra that are saturated and otherworldly. And we did this while keeping the ratios of the two modulators frequencies and amplitudes constant; introducing dynamics in those ratios would produce even crazier results. It is quite amazing that from three simple sine waves, the purest of all tones, we can derive an unlimited number of timbres. Modulation synthesis is a very powerful tool and understanding how to use it can prove invaluable. The best way to learn how to use FM effectively is to dabble and experiment with different ratios, formant regions, dynamic relationships betweeen ratios, waveshapes, etc. The possibilities are limitless. \paragraph{Other Capabilities Of CSound} \seclabel{other} In our examples of additive and modulation synthesis we only used a limited number of functions and routines provided us by CSound, such as Osc (oscillator), Line and LineSig (line and line segment signal generators) etc. This tutorial intends to briefly explain the functionality of some of the other features of CSound. Remember that the CSound manual should be the ultimate reference when it comes to using these functions. Let us start with the two functions \function{buzz} and \function{genBuzz}. These functions will produce a set of harmonically related cosines. Thus they really implement simple additive synthesis, except that the number of partials can be varied dynamically through the duration of the note, rather than staying fixed as in simple additive synthesis. As an example, let us perform the tune defined at the very beginning of the tutorial using an instrument that will play each note by starting off with the fundamental and 70 harmonics, and ending with simply the sine wave fundamental (note that cosine and sine waves sound the same). We will use a straight line signal going from 70 to 0 over the duration of each note for the number of harmonics. The score used will be score1, and the orchestra will be: \begin{haskelllisting} > oe14 :: Mono > oe14 = let numharms = lineCS CR 70 noteDur 0 > signal = buzz pureToneTable numharms > (dbToAmp noteVel) (pchToHz notePit) > in Mono signal > > o13 = let i = (instrNum1, OutFunc0 oe14) > in (hdr, [i]) > > tut13 = example "tut13" score1 o13 \end{haskelllisting} Let's invert the line of the harmonics, and instead of going from 70 to 0, make it go from 0 to 70. This will produce an interesting effect quite different from the one just heard: \begin{haskelllisting} > oe15 :: Mono > oe15 = let numharms = lineCS CR 0 noteDur 70 > signal = buzz pureToneTable numharms > (dbToAmp noteVel) (pchToHz notePit) > in Mono signal > > o14 = let i = (instrNum1, OutFunc0 oe15) > in (hdr, [i]) > > tut14 = example "tut14" score1 o14 \end{haskelllisting} The \function{buzz} expression takes the overall amplitude, fundamental frequency, number of partials, and a sine wave table and generates a wave complex. In recent years there has been a lot of research conducted in the area of \keyword{physical modelling}. This technique attempts to approximate the sound of real world musical instruments through mathematical models. One of the most widespread, versatile and interesting of these models is the \keyword{Karplus-Strong algorithm} that simulates the sound of a plucked string. The algorithm starts off with a buffer containing a user-determined waveform. On every pass, the waveform is "smoothed out" and flattened by the algorithm to simulate the decay. There is a certain degree of randomness involved to make the string sound more natural. There are six different "smoothing methods" available in CSound, as mentioned in the CSound module. The \function{pluck} constructor accepts the note volume, pitch, the table number that is used to initialize the buffer, the smoothing method used, and two parameters that depend on the smoothing method. If zero is given as the initializing table number, the buffer starts off containing a random waveform (white noise). This is the best table when simulating a string instrument because of the randomness and percussive attack it produces when used with this algorithm, but you should experiment with other waveforms as well. Here is an example of what Pluck sounds like with a white noise buffer and the simple smoothing method. This method ignores the parameters, which we set to zero. \begin{haskelllisting} > oe16 :: Mono > oe16 = let signal = pluck 0 (pchToHz notePit) > PluckSimpleSmooth > (dbToAmp noteVel) (pchToHz notePit) > in Mono signal > > o15 = let i = (instrNum1, OutFunc0 oe16) > in (hdr, [i]) > > tut15 = example "tut15" score1 o15 \end{haskelllisting} The second smoothing method is the \keyword{stretched smooth}, which works like the simple smooth above, except that the smoothing process is stretched by a factor determined by the first parameter. The second parameter is ignored. The third smoothing method is the \keyword{snare drum} method. The first parameter is the "roughness" parameter, with 0 resulting in a sound identical to simple smooth, 0.5 being the perfect snare drum, and 1.0 being the same as simple smooth again with reversed polarity (like a graph flipped around the x-axis). The fourth smoothing method is the \keyword{stretched drum} method which combines the roughness and stretch factors -- the first parameter is the roughness, the second is the stretch. The fifth method is \keyword{weighted average} -- it combines the current sample (ie. the current pass through the buffer) with the previous one, with their weights being determined by the parameters. This is a way to add slight reverb to the plucked sound. Finally, the last method filters the sound so it doesn't sound as bright. The parameters are ignored. You can modify the instrument \code{oe16} easily to listen to all these effects by simply replacing the variable \function{simpleSmooth} by \function{stretchSmooth, simpleDrum, stretchDrum, weightedSmooth} or \function{filterSmooth}. Here is another simple instrument example. This combines a snare drum sound with a stretched plucked string sound. The snare drum as a constant amplitude, while we apply an amplitude envelope to the string sound. The envelope is a spline curve with a hump in the middle, so both the attack and decay are gradual. The drum roughness factor is 0.3, so a pitch is still discernible (with a factor of 0.5 we would get a snare drum sound with no pitch, just a puff of white noise). The drum sound is shifted towards the left channel, while the string sound is shifted towards the right. \begin{haskelllisting} > midHumpTN :: Score.Table > midHumpTN = 8 > midHump :: Score.Statement > midHump = Score.Table midHumpTN 0 8192 True > (cubicSpline 0.0 [(4096, 1.0), (4096, 0.0)]) > > score8 orc = pureTone : midHump : scored orc attrToInstr1p0 tune1 > > oe17 :: Stereo > oe17 = let string = pluck 0 (pchToHz notePit) > (PluckStretchSmooth 1.5) > (dbToAmp noteVel) (pchToHz notePit) > drum = pluck 0 (pchToHz notePit) > (PluckSimpleDrum 0.3) > 6000 (pchToHz notePit) > ampEnv = osc CR (tableNumber midHumpTN) 1.0 (1 / noteDur) > left = (0.65 * drum) + (0.35 * ampEnv * string) > right = (0.35 * drum) + (0.65 * ampEnv * string) > in Stereo left right > > o16 = let i = (instrNum1, OutFunc0 oe17) > in (hdr, [i]) > > tut16 = example "tut16" score8 o16 \end{haskelllisting} Let us now turn our attention to the effects we can achieve using a \keyword{delay line}. Let's define a simple percussive instrument. It's strong attack let us easily perceive the reverberation. \begin{haskelllisting} > ping :: SigExp > ping = > let ampEnv = expon CR 1.0 1.0 (1/100) > in osc AR manySinesTable > (ampEnv * dbToAmp noteVel) (pchToHz notePit) \end{haskelllisting} There is still the problem, that subsequent notes truncate preceding ones. This would suppress the reverb. In order to avoid this we add a \keyword{legato} effect to the music. That is we prolong the notes such that they overlap. \begin{haskelllisting} > score9 orc = manySines : scored orc attrToInstr1p0 (Music.legato 1 tune1) \end{haskelllisting} Here we take the ping sound and add a little echo to it using delay: \begin{haskelllisting} > oe18 :: Stereo > oe18 = let dping1 = Orchestra.delay 0.05 ping > dping2 = Orchestra.delay 0.1 ping > left = (0.65 * ping) + (0.35 * dping2) + (0.5 * dping1) > right = (0.35 * ping) + (0.65 * dping2) + (0.5 * dping1) > in Stereo left right > > o17 = let i = (instrNum1, OutFunc0 oe18) > in (hdr, [i]) > > tut17 = example "tut17" score9 o17 \end{haskelllisting} The constructor \function{delay} establishes a \keyword{delay line}. A delay line is essentially a buffer that contains the signal to be delayed. The first argument to the \function{delay} constructor is the length of the delay (which determines the size of the buffer), and the second argument is the signal to be delayed. So for example, if the delay time is 1.0 seconds, and the sampling rate is 44,100 Hz (CD quality), then the delay line will be a buffer containing 44,100 samples of the delayed signal. The buffer is rewritten at the audio rate. Once \code{Delay t sig} writes t seconds of the signal \code{sig} into the buffer, the buffer can be \keyword{tapped} using the \function{delTap} or the \function{delTapI} constructors. \code{delTap t dline} will extract the signal from \code{dline} at time \code{t} seconds. In the exmaple above, we set up a delay line containing 0.1 seconds of the audio signal, then we tapped it twice -- once at 0.05 seconds and once at 0.1 seconds. The output signal is a combination of the original signal (left channel), the signal delayed by 0.05 seconds (middle), and the signal delayed by 0.1 seconds (right channel). CSound provides other ways to reverberate a signal besides the delay line just demonstrated. One such way is achieved via the Reverb constructor introduced in the \module{CSound.Orchestra} module. This constructor tries to emulate natural room reverb, and takes as arguments the signal to be reverberated, and the reverb time in seconds. This is the time it takes the signal to decay to 1/1000 its original amplitude. In this example we output both the original and the reverberated sound. \begin{haskelllisting} > oe19 :: Stereo > oe19 = let rev = reverb 0.3 ping > left = (0.65 * ping) + (0.35 * rev) > right = (0.35 * ping) + (0.65 * rev) > in Stereo left right > > o18 = let i = (instrNum1, OutFunc0 oe19) > in (hdr, [i]) > > tut18 = example "tut18" score9 o18 \end{haskelllisting} The other two reverb functions are \function{comb} and \function{alpass}. Each of these requires as arguments the signal to be reverberated, the reverb time as above, and echo loop density in seconds. Here is an example of an instrument using \function{comb}. \begin{haskelllisting} > oe20 :: Mono > oe20 = Mono (comb 0.22 4.0 ping) > > o19 = let i = (instrNum1, OutFunc0 oe20) > in (hdr, [i]) > > tut19 = example "tut19" score9 o19 \end{haskelllisting} Delay lines can be used for effects other than simple echo and reverberation. Once the delay line has been established, it can be tapped at times that vary at control or audio rates. This can be taken advantage of to produce effects like chorus, flanger, or the Doppler effect. Here is an example of the flanger effect. This instrument adds a slight flange to \code{oe11}. \begin{haskelllisting} > oe21 :: SigExp -> SigExp -> SigExp -> SigExp -> Stereo > oe21 modFreqRatio modIndEnd panStart panEnd = > let carFreq = pchToHz notePit > ampEnv = oscCoolEnv 1.0 (1/noteDur) > carAmp = dbToAmp noteVel * ampEnv > modFreq = carFreq * modFreqRatio > modInd = lineCS CR 0 noteDur modIndEnd > modAmp = modFreq * modInd > modSig = oscPure modAmp modFreq > carrier = oscPure carAmp (carFreq + modSig) > ftime = oscPure (1/10) 2 > flanger = ampEnv * vdelay 1 (0.5 + ftime) carrier > signal = carrier + flanger > pan = lineCS CR panStart noteDur panEnd > left = pan * signal > right = (1 - pan) * signal > in Stereo left right > > o20 = let i = (instrNum1, OutFunc4 oe21) > in (hdr, [i]) > > tut20 = example "tut20" score7 o20 \end{haskelllisting} The last two examples use generic delay lines. That is we do not rely on special echo effects but build our own ones by delaying a signal, filtering it by low pass or high pass filters and feeding the result back to the delay function. \begin{haskelllisting} > lowPass, highPass :: EvalRate -> SigExp -> SigExp -> SigExp > lowPass rate cutOff sig = sigGen "tone" rate 1 [sig, cutOff] > highPass rate cutOff sig = sigGen "atone" rate 1 [sig, cutOff] > oe22 :: Stereo > oe22 = let left = rec (\x -> ping + lowPass AR 500 (Orchestra.delay 0.311 x)) > right = rec (\x -> ping + highPass AR 1000 (Orchestra.delay 0.271 x)) > in Stereo left right > > o21 = let i = (instrNum1, OutFunc0 oe22) > in (hdr, [i]) > > tut21 = example "tut21" score9 o21 > oe23 :: Mono > oe23 = let rev = rec (\x -> ping + > 0.7 * (lowPass AR 500 (Orchestra.delay 0.311 x) > + highPass AR 1000 (Orchestra.delay 0.271 x))) > in Mono rev > > o22 = let i = (instrNum1, OutFunc0 oe23) > in (hdr, [i]) > > tut22 = example "tut22" score9 o22 \end{haskelllisting} This completes our discussion of sound synthesis and Csound. For more information, please consult the CSound manual or check out \url{http://mitpress.mit.edu/e-books/csound/frontpage.html} The function \function{applyOutFunc} applies sound expression function to the expressions which represent the parameter fields from 6 on. These are the fields where the additional instrument parameters are put by \function{CSound.Score.statementToWords}. \begin{haskelllisting} > test :: Output out => (Name, Score.T, TutOrchestra out) -> IO ExitCode > test = play csoundDir > > applyOutFunc :: OutFunc out -> out > applyOutFunc (OutFunc0 o) = o > applyOutFunc (OutFunc2 o) = o p6 p7 > applyOutFunc (OutFunc4 o) = o p6 p7 p8 p9 > > toOrchestra :: Output out => TutOrchestra out -> Orchestra.T out > toOrchestra (hd, instrs) = > Orchestra.Cons hd (map (\(i, out) -> > InstrBlock i 0 (applyOutFunc out) []) instrs) > > play :: Output out => > FilePath -> (Name, Score.T, TutOrchestra out) -> IO ExitCode > play dir (name, s, o') = > let scorename = name ++ ".sco" > orchname = name ++ ".orc" > -- wavename = name ++ ".wav" > o = toOrchestra o' > -- (Orchestra.Cons (rate, _) _) = o > in do writeFile (dir++"/"++scorename) (Score.toString s) > writeFile (dir++"/"++orchname) (Orchestra.toString o) > {- > system ("cd "++dir++" ; csound32 -d -W -o " > ++ wavename ++ " " ++ orchname ++ " " ++ scorename > ++ " ; play " ++ wavename) > -} > system ("cd "++dir++" ; csound32 -d -A -o stdout -s " > ++ orchname ++ " " ++ scorename > ++ " | play -t aiff -") > {- > system ("cd "++dir++" ; csound32 -d -o stdout -s " > ++ orchname ++ " " ++ scorename > ++ " | play -r " ++ show rate ++ " -t sw -") > -} > {- > system ("cd "++dir++" ; csound32 -d -o dac " -- /dev/dsp makes some chaotic noise > ++ orchname ++ " " ++ scorename) > -} > {- > system (dir ++ "/csound.exe -W -o " ++ wavename > ++ " " ++ orchname ++ " " ++ scorename) > -} \end{haskelllisting} Here are some bonus instruments for your pleasure and enjoyment. The first ten instruments are lifted from \url{http://wings.buffalo.edu/academic/department/AandL/music/pub/accci/01/01_01_1b.txt.html} The tutorial explains how to add echo/reverb and other effects to the instruments if you need to. This instrument sounds like an electric piano and is really simple -- \function{pianoEnv} sets the amplitude envelope, and the sound waveform is just a series of 10 harmonics. To make the sound brighter, increase the weight of the upper harmonics. \begin{haskelllisting} > piano, reedy, flute > :: (Name, Score.T, TutOrchestra Mono) > pianoOrc, reedyOrc, fluteOrc > :: TutOrchestra Mono > pianoScore, reedyScore, fluteScore :: TutOrchestra out -> Score.T > pianoEnv, reedyEnv, fluteEnv, > pianoWave, reedyWave, fluteWave :: Score.Statement > pianoEnvTN, reedyEnvTN, fluteEnvTN, > pianoWaveTN, reedyWaveTN, fluteWaveTN :: Score.Table > pianoEnvTable, reedyEnvTable, fluteEnvTable, > pianoWaveTable, reedyWaveTable, fluteWaveTable :: SigExp > pianoEnvTN = 10; pianoEnvTable = tableNumber pianoEnvTN > pianoWaveTN = 11; pianoWaveTable = tableNumber pianoWaveTN > > pianoEnv = Score.Table pianoEnvTN 0 1024 True (lineSeg1 0 [(20, 0.99), > (380, 0.4), (400, 0.2), (224, 0)]) > pianoWave = Score.Table pianoWaveTN 0 1024 True (compSine1 [0.158, 0.316, > 1.0, 1.0, 0.282, 0.112, 0.063, 0.079, 0.126, 0.071]) > > pianoScore orc = pianoEnv : pianoWave : scored orc attrToInstr1p0 tune1 > > pianoOE :: Mono > pianoOE = let ampEnv = osc CR pianoEnvTable (dbToAmp noteVel) (1/noteDur) > signal = osc AR pianoWaveTable ampEnv (pchToHz notePit) > in Mono signal > > pianoOrc = let i = (instrNum1, OutFunc0 pianoOE) > in (hdr, [i]) > > piano = example "piano" pianoScore pianoOrc \end{haskelllisting} Here is another instrument with a reedy sound to it \begin{haskelllisting} > reedyEnvTN = 12; reedyEnvTable = tableNumber reedyEnvTN > reedyWaveTN = 13; reedyWaveTable = tableNumber reedyWaveTN > > reedyEnv = Score.Table reedyEnvTN 0 1024 True (lineSeg1 0 [(172, 1.0), > (170, 0.8), (170, 0.6), (170, 0.7), (170, 0.6), (172,0)]) > reedyWave = Score.Table reedyWaveTN 0 1024 True (compSine1 [0.4, 0.3, > 0.35, 0.5, 0.1, 0.2, 0.15, 0.0, 0.02, 0.05, 0.03]) > > reedyScore orc = reedyEnv : reedyWave : scored orc attrToInstr1p0 tune1 > > reedyOE :: Mono > reedyOE = let ampEnv = osc CR reedyEnvTable (dbToAmp noteVel) (1/noteDur) > signal = osc AR reedyWaveTable ampEnv (pchToHz notePit) > in Mono signal > > reedyOrc = let i = (instrNum1, OutFunc0 reedyOE) > in (hdr, [i]) > > reedy = example "reedy" reedyScore reedyOrc \end{haskelllisting} We can use a little trick to make it sound like several reeds playing by adding three signals that are slightly out of tune: \begin{haskelllisting} > reedy2OE :: Stereo > reedy2OE = let ampEnv = osc CR reedyEnvTable (dbToAmp noteVel) (1/noteDur) > freq = pchToHz notePit > reedyOsc = osc AR reedyWaveTable > a1 = reedyOsc ampEnv freq > a2 = reedyOsc (ampEnv * 0.44) (freq + (0.023 * freq)) > a3 = reedyOsc (ampEnv * 0.26) (freq + (0.019 * freq)) > left = (a1 * 0.5) + (a2 * 0.35) + (a3 * 0.65) > right = (a1 * 0.5) + (a2 * 0.65) + (a3 * 0.35) > in Stereo left right > > reedy2Orc :: TutOrchestra Stereo > reedy2Orc = let i = (instrNum1, OutFunc0 reedy2OE) > in (hdr, [i]) > > reedy2 :: (Name, Score.T, TutOrchestra Stereo) > reedy2 = example "reedy2" reedyScore reedy2Orc \end{haskelllisting} This instrument tries to emulate a flute sound by introducing random variations to the amplitude envelope. The score file passes in two parameters -- the first one is the depth of the random tremolo in percent of total amplitude. The tremolo is implemented using the \function{randomI} function, which generates a signal that interpolates between 2 random numbers over a certain number of samples that is specified by the second parameter. \begin{haskelllisting} > fluteTune :: TutMelody Pair > > fluteTune = Music.line > (map ($ TutAttr 1.6 (30, 40)) > [c 1 hn, e 1 hn, g 1 hn, c 2 hn, > a 1 hn, c 2 qn, a 1 qn, g 1 dhn] > ++ [qnr]) > > > fluteEnvTN = 14; fluteEnvTable = tableNumber fluteEnvTN > fluteWaveTN = 15; fluteWaveTable = tableNumber fluteWaveTN > > fluteEnv = Score.Table fluteEnvTN 0 1024 True (lineSeg1 0 [(100, 0.8), > (200, 0.9), (100, 0.7), (300, 0.2), (324, 0.0)]) > fluteWave = Score.Table fluteWaveTN 0 1024 True (compSine1 [1.0, 0.4, > 0.2, 0.1, 0.1, 0.05]) > > fluteScore orc = fluteEnv : fluteWave : scored orc attrToInstr1p2 fluteTune > > fluteOE :: SigExp -> SigExp -> Mono > fluteOE depth numSam = > let vol = dbToAmp noteVel > rand = randomI AR numSam (vol/100 * depth) > ampEnv = oscI AR fluteEnvTable > (rand + vol) (1 / noteDur) > signal = oscI AR fluteWaveTable > ampEnv (pchToHz notePit) > in Mono signal > > fluteOrc = let i = (instrNum1, OutFunc2 fluteOE) > in (hdr, [i]) > > flute = example "flute" fluteScore fluteOrc \end{haskelllisting} Dirty hacks are going on here in order to pass the Phoneme values through all functions. \begin{haskelllisting} > voice' :: SigExp -> SigExp -> SigExp -> SigExp -> > SigExp -> SigExp -> SigExp -> SigExp -> SigExp > voice' vibWave wave gain vibAmp vibFreq amp freq phoneme = > sigGen "voice" AR 1 > [amp, freq, phoneme, gain, vibFreq, vibAmp, wave, vibWave] > data Phoneme = > Eee | Ihh | Ehh | Aaa | > Ahh | Aww | Ohh | Uhh | > Uuu | Ooo | Rrr | Lll | > Mmm | Nnn | Nng | Ngg | > Fff | Sss | Thh | Shh | > Xxx | Hee | Hoo | Hah | > Bbb | Ddd | Jjj | Ggg | > Vvv | Zzz | Thz | Zhh > deriving (Show, Eq, Ord, Enum) > voiceTune :: TutMelody Pair > voiceTune = Music.line > (map (\(n,ph) -> > n (TutAttr 1 (fromIntegral (fromEnum ph), 2))) > [(c 1 hn, Aaa), (e 1 hn, Ehh), (g 1 hn, Ohh), (c 2 hn, Ehh), > (a 1 hn, Eee), (c 2 qn, Aww), (a 1 qn, Aww), (g 1 dhn, Aaa)] > ++ [qnr]) > > > voiceVibWaveTN, voiceWaveTN :: Score.Table > voiceVibWaveTable, voiceWaveTable :: SigExp > voiceVibWaveTN = 14; voiceVibWaveTable = tableNumber voiceVibWaveTN > voiceWaveTN = 15; voiceWaveTable = tableNumber voiceWaveTN > > voiceWave, voiceVibWave :: Score.Statement > voiceWave = Score.Table voiceWaveTN 0 1024 True > (let width = 50 > in lineSeg1 0 [(width, 1), (width, 0), (1024-2*width, 0)]) > voiceVibWave = Score.Table voiceVibWaveTN 0 1024 True (compSine1 [1.0, 0.4]) > > voiceScore :: TutOrchestra out -> Score.T > voiceScore orc = > voiceVibWave : voiceWave : scored orc attrToInstr1p2 voiceTune > > voiceOE :: SigExp -> SigExp -> Mono > voiceOE phoneme gain = > let vol = dbToAmp noteVel > signal = voice' voiceVibWaveTable voiceWaveTable > gain (3/100) 5 vol (pchToHz notePit) phoneme > in Mono signal > > voiceOrc :: TutOrchestra Mono > voiceOrc = let i = (instrNum1, OutFunc2 voiceOE) > in (hdr, [i]) > > voice :: (Name, Score.T, TutOrchestra Mono) > voice = example "voice" voiceScore voiceOrc \end{haskelllisting} haskore-0.2.0.3/src/Haskore/Interface/CSound/Note.lhs0000644000000000000000000000367711754016451020410 0ustar0000000000000000\subsubsection{The Score File} \seclabel{score-file} \begin{haskelllisting} > module Haskore.Interface.CSound.Note where > > import qualified Haskore.Basic.Pitch as Pitch > import qualified Haskore.Music.Rhythmic as RhyMusic > import qualified Haskore.Interface.CSound.InstrumentMap as InstrMap > import Haskore.Interface.CSound (Instrument, Velocity, PField) \end{haskelllisting} \begin{haskelllisting} > data T = > Cons { > parameters :: [PField], > velocity :: Velocity, > instrument :: Instrument, > pitch :: Maybe Pitch.Absolute > } > fromRhyNote :: RealFrac dyn => > InstrMap.ToSound drum -> > InstrMap.ToSound instr -> > dyn -> Pitch.Relative -> RhyMusic.Note drum instr -> T > fromRhyNote dMap iMap dyn trans (RhyMusic.Note vel body) = > let velCS = velocityFromStd dyn vel > in case body of > RhyMusic.Tone instr p -> > uncurry (flip Cons velCS) (iMap instr) > (Just (pitchFromStd trans p)) > RhyMusic.Drum drum -> > uncurry (flip Cons velCS) (dMap drum) Nothing > velocityFromStd :: RealFrac dyn => > dyn -> Rational -> Velocity > velocityFromStd dyn vel = > velocityToDb (fromRational (toRational dyn * vel)) > -- velocityToDb (realToFrac dyn * vel) > pitchFromStd :: Pitch.Relative -> Pitch.T -> Pitch.Absolute > pitchFromStd trans p = > let csoundP = Pitch.toInt p + zeroKey + trans > in if csoundP<0 > then error ("CSound.Note: pitch " ++ show csoundP ++ > " must not be negative") > else csoundP \end{haskelllisting} \begin{haskelllisting} > velocityToDb :: Float -> Float > velocityToDb = (50*) > > -- still unused, but it should be implemented this way > amplitudeToDb :: Float -> Float > amplitudeToDb v = 20 * logBase 10 v > {- Offset to map from Haskore's pitch 0 > to the corresponding pitch of CSound -} > zeroKey :: Int > zeroKey = 84 \end{haskelllisting} haskore-0.2.0.3/src/Haskore/Interface/CSound/Orchestra.lhs0000644000000000000000000020056411754016451021427 0ustar0000000000000000\subsubsection{The Orchestra File} \seclabel{orchestra-file} \newcommand\csoundfunc[1]{\textit{\texttt{#1}}} \begin{haskelllisting} > module Haskore.Interface.CSound.Orchestra ( > T(Cons), InstrBlock(..), Header, AudRate, CtrlRate, > -- SigTerm(ConstFloat, ConstInt, TableNumber, PField, Str, > -- Read, Tap, Result, Conditional, > -- Infix, Prefix, SigGen), > SigExp, DelayLine, Boolean, > -- DelayLine(DelayLine), Boolean(Operator, Comparison), > GlobalSig(Global), Output(..), Mono(Mono), Stereo(Stereo), Quad(Quad), > EvalRate(NR, CR, AR), Instrument, Name, > sigGen, tableNumber, readGlobal, rec, > > -- assorted functions > toString, saveIA, save, > channelCount, getMultipleOutputs, > > -- variables dealing with PFields > noteDur, notePit, noteVel, p1, p2, p3, p4, p5, p6, p7, p8, p9, pField, > > -- functions for dealing with Booleans and Conditional SigExps > (<*), (<=*), (>*), (>=*), (==*), (/=*), (&&*), (||*), ifthen, > constInt, constFloat, constEnum, > > -- functions for creating signal expressions > pchToHz, dbToAmp, line, expon, lineSeg, exponSeg, env, phasor, > IndexMode(..), tblLookup, tblLookupI, osc, oscI, > fmOsc, fmOscI, sampOsc, random, randomH, randomI, genBuzz, buzz, > pluck, PluckDecayMethod(..), delay, vdelay, comb, alpass, reverb, > delTap, delTapI, > > -- monad-related functions > Orc, mkSignal, addInstr, mkOrc, > > -- assorted examples > orc1, test, test1) where > > import Haskore.Interface.CSound > (Name, Instrument, instrument, instruments, showInstrumentNumber) > import Haskore.Interface.CSound.OrchestraFunction > > import qualified Haskore.General.LoopTreeRecursiveGen as TreeRec > import qualified Haskore.General.LoopTreeTaggedGen as TreeTag > import Control.Monad.Trans.State (State, state, modify, execState, ) > import Control.Applicative (liftA, liftA2, liftA3, pure) > import Data.Foldable (Foldable(foldMap)) > import Data.Traversable (Traversable(sequenceA)) > import qualified Data.Traversable as Traversable > import Haskore.General.Utility (flattenTuples2, ) > import Data.List.HT (partition, ) > import Data.Tuple.HT (mapSnd, ) > import Data.Maybe.HT (toMaybe, ) > import Data.Maybe (mapMaybe, ) > import Data.List (nub, intersperse, (\\), ) \end{haskelllisting} The orchestra file consists of two parts: a \keyword{header}, and one or more \keyword{instrument blocks}. The header sets global parameters controlling sampling rate and control rate. The instrument blocks define instruments, each identified by a unique integer ID, and containing statements modifying or generating various audio signals. Each note statement in a score file passes all its arguments---including the p-fields---to its corresponding instrument in the orchestra file. While some properties vary from note to note, and should therefore be designed as p-fields, many can be defined within the instrument; the choice is up to the user. The orchestra file is represented as: \begin{haskelllisting} > data Output out => > T out = Cons Header [InstrBlock out] deriving (Show, Eq) \end{haskelllisting} The orchestra header sets the audio rate, control rate, and number of output channels: \begin{haskelllisting} > type Header = (AudRate, CtrlRate) > > type AudRate = Int -- samples per second > type CtrlRate = Int -- samples per second \end{haskelllisting} Digital computers represent continuous analog audio waveforms as a sequence of discrete samples. The audio rate (\type{AudRate}) is the number of these samples calculated each second. Theoretically, the maximum frequency that can be represented is equal to one-half the audio rate. Audio CDs contain 44,100 samples per second of music, giving them a maximum sound frequency of 22,050 Hz, which is as high as most human ears are able to hear. Computing 44,100 values each second can be a demanding task for a CPU, even by today's standards. However, some signals used as inputs to other signal generating routines don't require such a high resolution, and can thus be generated at a lower rate. A good example of this is an amplitude envelope, which changes relatively slowly, and thus can be generated at a rate much lower than the audio rate. This rate is called the \keyword{control rate} (\type{CtrlRate}), and is set in the orchestra file header. The audio rate is usually a multiple of the control rate, but this is not a requirement. Each instrument block contains four things: a unique identifying integer; an expression giving the amount of extra time the instrument should be granted, usually used for reverb; an \type{Output} expression that gives the outputs in terms of \keyword{orchestra expressions}, called \type{SigExp}s; and a list of global signals and the \type{SigExp}s that are written out to those signals. \begin{haskelllisting} > type Reverb = SigExp > data InstrBlock a = > InstrBlock {instrBlockInstr :: Instrument, > instrBlockReverb :: Reverb, > instrBlockOutput :: a, > instrBlockGlobals :: [(GlobalSig, SigExp)]} > deriving (Show, Eq) \end{haskelllisting} Recall that \type{Instrument} is a type synonym for an \type{Int}. This value may be obtained from a string name and a name map using the function \code{getId :: NameMap -> Name -> Maybe Int} discussed earlier. \paragraph{Orchestra Expressions} The data type \type{SigExp} is the largest deviation that we will make from the actual CSound design. In CSound, instruments are defined using a sequence of statements that, in a piecemeal manner, define the various oscillators, summers, constants, etc.\ that make up an instrument. These pieces can be given names, and these names can be referenced from other statements. But despite this rather imperative, statement-oriented approach, it is acually completely functional. In other words, every CSound instrument can be rewritten as a single expression. It is this ``expression language'' that we capture in \type{SigExp}. A pleasant attribute of the result is that CSound's ad hoc naming mechanism is replaced with Haskell's conventional way of naming things. The entire \type{SigExp} data type declaration, as well as the declarations for related datatypes, is shown in \figref{SigExp}. In what follows, we describe each of the various constructors in turn. \begin{figure} {\scriptsize\vspace{-.7in} \begin{haskelllisting} > type Function = String > type OutCount = Integer > type Table = Int > > type Boolean = BooleanTerm SigExp > data BooleanTerm tree = > Operator Function (BooleanTerm tree) (BooleanTerm tree) > | Comparison Function tree tree > deriving (Show, Eq) > > data GlobalSig = > Global EvalRate (SigExp -> SigExp -> SigExp) Int > instance Show GlobalSig where > show (Global rt _ n) = "Global " ++ show rt ++ " " ++ show n > instance Eq GlobalSig where > Global r1 _ n1 == Global r2 _ n2 = r1 == r2 && n1 == n2 > > type DelayLine = DelayLineTerm SigExp > data DelayLineTerm tree = DelayLine tree tree > deriving (Show, Eq) > > data SigTerm tree = > ConstFloat Float > | ConstInt Int > | TableNumber Table > | PField Int > | Str String > | Read GlobalSig > | Tap Function (DelayLineTerm tree) [tree] > | Result (DelayLineTerm tree) > | Conditional (BooleanTerm tree) tree tree > | Infix Function tree tree > | Prefix Function tree > | SigGen Function EvalRate OutCount [tree] > | Index OutCount (SigTerm tree) > deriving (Show, Eq) > instance Functor BooleanTerm where > fmap f branch = > case branch of > Operator nm left right -> Operator nm (fmap f left) (fmap f right) > Comparison nm left right -> Comparison nm ( f left) ( f right) > > instance Functor DelayLineTerm where > fmap f (DelayLine x y) = DelayLine (f x) (f y) > instance Functor SigTerm where > fmap f branch = > case branch of > {- The first cases look like they could be handled > by returning just 'branch'. But this does not work, > because the result have a different type in general. -} > ConstFloat x -> ConstFloat x > ConstInt n -> ConstInt n > TableNumber t -> TableNumber t > PField n -> PField n > Str str -> Str str > Read t -> Read t > Tap nm del xs -> Tap nm (fmap f del) (map f xs) > Result del -> Result (fmap f del) > Conditional b true false -> > Conditional (fmap f b) (f true) (f false) > Infix nm left right -> Infix nm (f left) (f right) > Prefix nm arg -> Prefix nm (f arg) > SigGen nm rate cnt args -> > SigGen nm rate cnt (map f args) > Index cnt x -> Index cnt (fmap f x) > instance TreeTag.CollShow SigTerm where > collShowsPrec = showsPrec > instance TreeTag.CollEq SigTerm where > collEqual = (==) > type SigExp = TreeRec.T SigTerm > tableNumber :: Table -> SigExp > tableNumber n = TreeRec.Branch (TableNumber n) > readGlobal :: GlobalSig -> SigExp > readGlobal glob = TreeRec.Branch (Read glob) \end{haskelllisting} } \caption{The \type{SigExp} Data Type} \figlabel{SigExp} \end{figure} \subparagraph{Constants} \code{ConstFloat x} represents the floating-point constant \code{x}. \subparagraph{P-field Arguments} \code{pField n} refers to the $n$th p-field argument. Recall that all note characteristics, including pitch, volume, and duration, are passed into the orchestra file as p-fields. For example, to access the pitch, one would write \code{pField 4}. To make the access of these most common p-fields easier, we define the following constants: \begin{haskelllisting} > noteDur, notePit, noteVel :: SigExp > noteDur = pField 3 > notePit = pField 4 > noteVel = pField 5 > pField :: Int -> SigExp > pField n = TreeRec.Branch (PField n) \end{haskelllisting} It is also useful to define the following standard names, which are identical to those used in CSound: \begin{haskelllisting} > p1,p2,p3,p4,p5,p6,p7,p8,p9 :: SigExp > p1 = pField 1 > p2 = pField 2 > p3 = pField 3 > p4 = pField 4 > p5 = pField 5 > p6 = pField 6 > p7 = pField 7 > p8 = pField 8 > p9 = pField 9 \end{haskelllisting} \subparagraph{Strings} \code{Str s} represents a string argument in CSound --- a type of argument that is very rarely used, but is included here for the sake of completeness. \paragraph{Reading and Writing Global Signals} \code{Read g} is the counterpart to the \type{(GlobalSig, SigExp)} pairs in the \type{InstrBlock} statements, reading instead of writing global signals. Together, they allow for audio and control signals to be passed from instrument to instrument, and used for things like panning or overall envelopes. \paragraph{Logical and Conditional Statements} You probably noticed that \type{Boolean} was defined alongside \type{SigExp} in Figure \ref{SigExp-fig}. \type{Boolean} is a type of expression used in the \constructor{Conditional} \type{SigExp} --- basically, it's a comparison or some logical function of two comparisons. In other words, a \type{Boolean} is an expression that evaluates to a boolean. The syntax is fairly simple --- a \type{Boolean} is either a \constructor{Comparison}, a function comparing two \type{SigExp}s and returning a \type{Boolean}; or an \constructor{Operator}, a function from two \type{Boolean}s to a third \type{Boolean}, such as the logical ``and'' operator. Thus we can express, for example, a query about whether a certain p-value lies within a range by evaluating this expression: \begin{haskelllisting} Operator "&&" (Comparison "<" 1 p2) (Comparison "<" p2 3) \end{haskelllisting} The above expression will create a CSound expression that is true when p2 lies between 1 and 3. \type{Boolean}s can be used inside of a \constructor{Conditional} expression in order to choose one of two values based on the trueness or falseness of the \type{Boolean}. For example: \begin{haskelllisting} Conditional (Comparison ">" p1 p2) p1 p2 \end{haskelllisting} will return the maximum of the two values p1 and p2. We are including several functions that will perform this automatically: \begin{haskelllisting} > (<*), (<=*), (>*), (>=*), (==*), (/=*) :: > -- SigExp -> SigExp -> Boolean > TreeTerm term => > TreeRec.T term -> TreeRec.T term -> BooleanTerm (TreeRec.T term) > (<* ) = comparisonTerm "<" > (<=*) = comparisonTerm "<=" > (>* ) = comparisonTerm ">" > (>=*) = comparisonTerm ">=" > (==*) = comparisonTerm "==" > (/=*) = comparisonTerm "!=" > (&&*), (||*) :: Boolean -> Boolean -> Boolean > (&&*) = operator "&&" > (||*) = operator "||" > operator :: String -> Boolean -> Boolean -> Boolean > operator = Operator \end{haskelllisting} \subparagraph{Arithmetic and Transcendental Functions} Arithmetic functions are represented in various ways, depending on the type of function. The standard binary operators --- plus and times, for instance --- are infix operators, and so they can be crafted in this module using the Infix constructor, specifying the name of the function (the text used to express it in CSound) and the two arguments to the function. The other mathematical operators, such as \function{sin}, \function{log}, or \function{sqrt}, can be expressed with a \constructor{Prefix} constructor, passing the name of the function in CSound (usually the same as the name in Haskell, although not always) and the argument to the given function. Examples of this are: \begin{verbatim} Infix "+" (PField 1) (Prefix "sin" 1 (ConstFloat 3.0)) Prefix "sqrt" (Infix "*" (PField 3) (PField 4)) \end{verbatim} To facilitate the use of these arithmetic functions, we can make \type{SigExp} an instance of certain numeric type classes, thus providing more conventional names for the various operations. \begin{haskelllisting} > sigGen :: Function -> EvalRate -> OutCount -> [SigExp] -> SigExp > sigGen nm rate cnt args = TreeRec.Branch (SigGen nm rate cnt args) > constFloat :: Float -> SigExp > constFloat = TreeRec.Branch . ConstFloat > constInt :: Int -> SigExp > constInt = TreeRec.Branch . ConstInt > constEnum :: Enum a => a -> SigExp > constEnum = TreeRec.Branch . ConstInt . fromEnum > class TreeTerm term where > constTerm :: Float -> TreeRec.T term > prefixTerm :: Function -> TreeRec.T term -> TreeRec.T term > infixTerm :: Function -> TreeRec.T term -> TreeRec.T term -> TreeRec.T term > comparisonTerm :: Function -> TreeRec.T term -> TreeRec.T term -> > BooleanTerm (TreeRec.T term) > ifthen :: BooleanTerm (TreeRec.T term) -> > TreeRec.T term -> TreeRec.T term -> TreeRec.T term > instance TreeTerm SigTerm where > constTerm x = TreeRec.Branch (ConstFloat x) > prefixTerm nm x = TreeRec.Branch (Prefix nm x) > infixTerm nm x y = TreeRec.Branch (Infix nm x y) > comparisonTerm nm x y = Comparison nm x y > ifthen b x y = TreeRec.Branch (Conditional b x y) \end{haskelllisting} We can not request \code{term == SigTerm TreeRec.T} that's why we have to define the \code{TreeTerm} class and the instance for \code{SigTerm}. \begin{haskelllisting} > instance (TreeTag.CollShow term, TreeTag.CollEq term, > Functor term, TreeTerm term) => > Num (TreeRec.T term) where > (+) = infixTerm "+" > (-) = infixTerm "-" > (*) = infixTerm "*" > negate = prefixTerm "-" > abs = prefixTerm "abs" > signum x = ifthen (x <* 0) (-1) (ifthen (x >* 0) 1 0) > fromInteger = constTerm . fromInteger > instance (TreeTag.CollShow term, TreeTag.CollEq term, > Functor term, TreeTerm term) => > Fractional (TreeRec.T term) where > (/) = infixTerm "/" > fromRational = constTerm . fromRational > {- > fromRational x = > fromInteger (numerator x) / > fromInteger (denominator x) > -} > instance (TreeTag.CollShow term, TreeTag.CollEq term, > Functor term, TreeTerm term) => > Floating (TreeRec.T term) where > exp = prefixTerm "exp" > log = prefixTerm "log" > sqrt = prefixTerm "sqrt" > (**) = infixTerm "^" > pi = constTerm pi > sin = prefixTerm "sin" > cos = prefixTerm "cos" > tan = prefixTerm "tan" > asin = prefixTerm "sininv" > acos = prefixTerm "cosinv" > atan = prefixTerm "taninv" > sinh = prefixTerm "sinh" > cosh = prefixTerm "cosh" > tanh = prefixTerm "tanh" > asinh x = log (sqrt (x*x+1) + x) > acosh x = log (sqrt (x*x-1) + x) > atanh x = (log (1+x) - log (1-x)) / 2 \end{haskelllisting} Now we can write simpler code, such as: \code{noteDur + sin p6 ** 2}. \paragraph{Other \constructor{Prefix}s} \function{sin}, \function{log}, and \function{sqrt} aren't the only functions that use \constructor{Prefix} as a constructor --- \constructor{Prefix} is used for all functions in CSound that take a single argument and are represented like normal mathematical functions. Most of these functions are, indeed, mathematical, such as the function converting a CSound pitch value to the number of cycles per second, or the function converting decibels to the corresponding amplitude. For convenience, we will define a few common operators here: \begin{verbatim} > pchToHz, dbToAmp :: SigExp -> SigExp > pchToHz = prefixTerm "cpspch" > dbToAmp = prefixTerm "ampdb" \end{verbatim} Now, when we want to convert a pitch to its hertz value or a decibel level to the desired amplitude, we can simply say \code{pchToHz notePit} or \code{dbToAmp noteVel}. \paragraph{Signal Generation and Modification} The most sophisticated \type{SigExp} constructor is \function{sigGen}, which drives most of the functions used for signal generation and modification. The constructor takes four arguments: the name of the function to be used, such as \csoundfunc{envlpx} or \csoundfunc{oscili}; the rate of output; the number of outputs (covered in a later section); and a list of all the arguments to be passed. Most of these we have seen before. But what is the rate of output? Well, signals in CSound can be generated at three rates: the note rate (i.e., with, every note event), the control rate, and the audio rate (we discussed the latter two earlier). Many of the signal generating routines can produce signals at more than one rate, so the rate must be specified as an argument. The following simple data structure serves this purpose: \begin{haskelllisting} > data EvalRate = NR -- note rate > | CR -- control rate > | AR -- audio rate > deriving (Show, Eq, Ord) \end{haskelllisting} All right, so now we know what the arguments are. But what does the \function{sigGen} constructor actually do? Like the other kinds of \type{SigExp}s, it has an input and an output. In Haskore, it acts just the same as any other kind of function. But when written to a CSound Orchestra file, each \function{sigGen} receives a variable name that it is assigned to, and each \function{sigGen} is written to a single line of the CSound file. \function{sigGen}s can be used for all sorts of things --- CSound has a very large variety of functions, most of which are actually \function{sigGen}s. They can do anything from generating a simple sine wave to generating complex signals. Most of them, however, have to do with signal generation; hence the name \function{sigGen}. For the user's sake, we will outline a few of the CSound functions here: \begin{enumerate} \item The CSound statement \code{line evalrate start duration finish}, produces values along a straight line from \code{start} to \code{finish}. The values can be generated either at control or audio rate, and the line covers a period of time equal to \code{duration} seconds. We can translate this into CSound like so: \begin{haskelllisting} > line, expon :: EvalRate -> SigExp -> SigExp -> SigExp -> SigExp > line rate start duration finish = > sigGen "line" rate 1 [start, duration, finish] \end{haskelllisting} \item \csoundfunc{expon} is similar to \csoundfunc{line}, but the code \code{expon evalrate start duration finish} produces an exponential curve instead of a straight line. \begin{haskelllisting} > expon rate start duration finish = > sigGen "expon" rate 1 [start, duration, finish] \end{haskelllisting} \item If a more elaborate signal is required, one can use the CSound functions \csoundfunc{linseg} or \csoundfunc{expseg}, which take any odd number of arguments greater than or equal to three. The first three arguments work as before, but only for the first of a number of segments. The subsequent segment lengths and endpoints are given in the rest of the arguments. A signal containing both straight line and exponential segments can be obtained by adding a \csoundfunc{linseg} signal and \csoundfunc{expseg} signal together in an appropriate way. The Haskore code is more complicated for this, because there are an arbitrary but odd number of arguments. So we will give the first three arguments as we did with the \csoundfunc{line} and \csoundfunc{expon} functions, and then have a list of pairs, which will be flattened into an argument list: \begin{haskelllisting} > lineSeg, exponSeg :: EvalRate -> SigExp -> SigExp -> SigExp > -> [(SigExp, SigExp)] -> SigExp > lineSeg rate y0 x1 y1 lst = > sigGen "linseg" rate 1 ([y0, x1, y1] ++ flattenTuples2 lst) > exponSeg rate y0 x1 y1 lst = > sigGen "expseg" rate 1 ([y0, x1, y1] ++ flattenTuples2 lst) \end{haskelllisting} \item The Haskore code \code{env rate rshape sattn dattn steep dtime rtime durn sig} modifies the signal \code{sig} by applying an envelope to it.% \footnote{Although this function is widely-used in CSound, the same effect can be accomplished by creating a signal that is a combination of straight line and exponential curve segments, and multiplying it by the signal to be modified.} \code{rtime} and \code{dtime} are the rise time and decay time, respectively (in seconds), and \code{durn} is the overall duration. \code{rshape} is the identifier integer of a function table storing the rise shape. \code{sattn} is the pseudo-steady state attenuation factor. A value between 0 and 1 will cause the signal to exponentially decay over the steady period, a value greater than 1 will cause the signal to exponentially rise, and a value of 1 is a true steady state maintained at the last rise value. \code{steep}, whose value is usually between $-0.9$ and $+0.9$, influences the steepness of the exponential trajectory. \code{dattn} is the attenuation factor by which the closing steady state value is reduced exponentially over the decay period, with value usually around 0.01. In Haskore, this becomes a fairly simple function, going from an \type{EvalRate} and eight \type{SigExp}s to one single \type{SigExp}: \begin{haskelllisting} > env :: EvalRate -> SigExp -> SigExp -> SigExp -> SigExp -> SigExp > -> SigExp -> SigExp -> SigExp -> SigExp > env rate rshape sattn dattn steep dtime rtime durn sig = > sigGen "envlpx" rate 1 > [sig, rtime, durn, dtime, rshape, sattn, dattn, steep] \end{haskelllisting} \item Typing \code{phasor phase freq} into CSound generates a signal moving from 0 to 1 at a given frequency and starting at the given initial phase offset. When used properly as the index to a table lookup unit, the function can simulate the behavior of an oscillator. We implement it in Haskore thus: \begin{haskelllisting} > phasor :: EvalRate -> SigExp -> SigExp -> SigExp > phasor rate phase freq = sigGen "phasor" rate 1 [freq, phase] \end{haskelllisting} \item CSound table lookup functions \csoundfunc{table} and \csoundfunc{tablei} both take \code{index}, \code{table}, and \code{indexmode} arguments. The \code{indexmode} is either 0 or 1, differentiating between raw index and normalized index (zero to one); for convenience we define: \begin{haskelllisting} > data IndexMode = > RawIndex > | NormalIndex > deriving (Show, Eq, Enum) \end{haskelllisting} Both \csoundfunc{table} and \csoundfunc{tablei} return values stored in the specified table at the given index. The difference is that \csoundfunc{tablei} uses the fractional part of the index to interpolate between adjacent table entries, which generates a smoother signal at a small cost in execution time. The equivalent Haskore code to the CSound functions is: \begin{haskelllisting} > tblLookup, tblLookupI :: > EvalRate -> IndexMode -> SigExp -> SigExp -> SigExp > tblLookup rate mode table ix = > sigGen "table" rate 1 [ix, table, constEnum mode] > tblLookupI rate mode table ix = > sigGen "tablei" rate 1 [ix, table, constEnum mode] \end{haskelllisting} As mentioned, the output of \csoundfunc{phasor} can be used as input to a table lookup to simulate an oscillator whose frequency is controlled by the note pitch. This can be accomplished easily by the following piece of Haskore code: \begin{haskelllisting} oscil = let index = phasor AR (pchToHz notePit) 0.0 in tblLookupI AR NormalIndex table index \end{haskelllisting} where \code{table} is some given function table ID. If \code{oscil} is given as argument to an output constructor such as \constructor{MonoOut}, then this \type{Output} coupled with an instrument ID number (say, 1) produces a complete instrument block: \begin{haskelllisting} i1 = (1, MonoOut oscil) \end{haskelllisting} Adding a suitable \constructor{Header} would then give us a complete, though somewhat sparse, \type{CSound.Orchestra.T} value. \item Instead of the above design we could use one of the built-in CSound oscillators, \csoundfunc{oscil} and \csoundfunc{oscili}, which differ in the same way as \csoundfunc{table} and \csoundfunc{tablei}. Both CSound functions take the following arguments: raw amplitude, frequency, and the index of a table. The result is a signal that oscillates through the function table at the given frequency. Let the Haskore functions be as follows: \begin{haskelllisting} > osc, oscI :: EvalRate -> SigExp -> SigExp -> SigExp -> SigExp > osc rate table amp freq = sigGen "oscil" rate 1 [amp, freq, table] > oscI rate table amp freq = sigGen "oscili" rate 1 [amp, freq, table] \end{haskelllisting} Now, the following statement is equivalent to \function{osc}, defined above: \begin{haskelllisting} oscil' = oscI AR 1 (pchToHz notePit) table \end{haskelllisting} \item It is often desirable to use the output of one oscillator to modulate the frequency of another, a process known as \keyword{frequency modulation}. The Haskore code \code{fmOsc table modindex carfreq modfreq amp freq} produces a signal whose effective modulating frequency is \code{freq*modfreq}, and whose carrier frequency is \code{freq*carfreq}. \code{modindex} is the \keyword{index of modulation}, usually a value between 0 and 4, which determines the timbre of the resulting signal. \csoundfunc{oscili} behaves similarly to \csoundfunc{oscil}, except that it, like \csoundfunc{tablei} and \csoundfunc{oscili}, interpolates between values. Interestingly enough, these two functions are the first listed here that work at audio rate only; thus, we do not have to pass the rate as an argument to the helper function, because the rate is always \constructor{AR}. Thus, the Haskore code is: \begin{haskelllisting} > fmOsc, fmOscI :: SigExp -> SigExp -> SigExp -> SigExp -> SigExp > -> SigExp -> SigExp > fmOsc table modindex carfreq modfreq amp freq = > sigGen "foscil" AR 1 [amp, freq, carfreq, modfreq, modindex, table] > fmOscI table modindex carfreq modfreq amp freq = > sigGen "foscili" AR 1 [amp, freq, carfreq, modfreq, modindex, table] \end{haskelllisting} \item \code{sampOsc table amp freq} oscillates through a table containing an AIFF sampled sound segment. This is the only time a table can have a length that is not a power of two, as mentioned earlier. Like \function{fmOsc}, \function{sampOsc} can only generate values at the audio rate: \begin{haskelllisting} > sampOsc :: SigExp -> SigExp -> SigExp -> SigExp > sampOsc table amp freq = sigGen "loscil" AR 1 [amp, freq, table] \end{haskelllisting} \item The Haskore code \code{random rate amp} produces a random number series between \code{-amp} and \code{+amp} at either control or audio rate. \code{randomH rate quantRate amp} does the same but will hold each number for \code{quantRate} cycles before generating a new one. \code{randomI rate quantRate amp} will in addition provide straight line interpolation between successive numbers: \begin{haskelllisting} > random :: EvalRate -> SigExp -> SigExp > random rate amp = sigGen "rand" rate 1 [amp] > randomH, randomI :: EvalRate -> SigExp -> SigExp -> SigExp > randomH rate quantRate amp = sigGen "randh" rate 1 [amp, quantRate] > randomI rate quantRate amp = sigGen "randi" rate 1 [amp, quantRate] \end{haskelllisting} The remaining functions covered in this file only operate at audio rate, and thus their Haskore equivalents do not have \code{rate} arguments. \item \code{genBuzz table multiplier loharm numharms amp freq} generates a signal that is an additive set of harmonically related cosine partials. \code{freq} is the fundamental frequency, \code{numharms} is the number of harmonics, and \code{loharm} is the lowest harmonic present. The amplitude coefficients of the harmonics are given by the exponential series \code{a}, \code{a * multiplier}, \code{a * multiplier\^{}2}, $\ldots$, \code{a * multiplier\^{}(numharms-1)}. The value \code{a} is chosen so that the sum of the amplitudes is \code{amp}. \code{table} is a function table containing a cosine wave. \begin{haskelllisting} > genBuzz :: SigExp -> SigExp -> SigExp -> SigExp -> SigExp > -> SigExp -> SigExp > genBuzz table multiplier loharm numharms amp freq = > sigGen "gbuzz" AR 1 [amp, freq, numharms, loharm, multiplier, table] \end{haskelllisting} \item \function{buzz} is a special case of \function{genBuzz} in which \code{loharm = 1.0} and \code{multiplier = 1.0}. \code{table} is a function table containing a sine wave: \begin{haskelllisting} > buzz :: SigExp -> SigExp -> SigExp -> SigExp -> SigExp > buzz table numharms amp freq = > sigGen "buzz" AR 1 [amp, freq, numharms, table] \end{haskelllisting} Note that the above two constructors have an analog in the generating routine \refgen{11} and the related function \function{cosineHarms} (see \secref{function-table}). \function{cosineHarms} stores into a table the same waveform that would be generated by \function{buzz} or \function{genBuzz}. However, although \function{cosineHarms} is more efficient, it has fixed arguments and thus lacks the flexibility of \function{buzz} and \function{genBuzz} in being able to vary the argument values with time. \item \code{pluck table freq2 decayMethod amp freq} is an audio signal that simulates a plucked string or drum sound, constructed using the Karplus-Strong algorithm. The signal has amplitude \code{amp} and frequency \code{freq2}. It is produced by iterating through an internal buffer that initially contains a copy of \code{table} and is smoothed with frequency \code{freq} to simulate the natural decay of a plucked string. If 0.0 is used for \code{table}, then the initial buffer is filled with a random sequence. There are six possible decay modes: \begin{enumerate} \item \keyword{simple smoothing}, which ignores the two arguments; \item \keyword{stretched smoothing}, which stretches the smoothing time by a factor of \code{decarg1}, ignoring \code{decarg2}; \item \keyword{simple drum}, where \code{decarg1} is a ``roughness factor'' (0 for pitch, 1 for white noise; a value of 0.5 gives an optimal snare drum sound); \item \keyword{stretched drum}, which contains both roughness ({\tt decarg1}) and stretch (\code{decarg2}) factors; \item \keyword{weighted smoothing}, in which \code{decarg1} gives the weight of the current sample and \code{decarg2} the weight of the previous one (\code{decarg1+decarg2} must be $\leq1$); and \item \keyword{recursive filter smoothing}, which ignores both arguments. \end{enumerate} Here again are some helpful constants: \begin{haskelllisting} > data PluckDecayMethod = > PluckSimpleSmooth > | PluckStretchSmooth SigExp > | PluckSimpleDrum SigExp > | PluckStretchDrum SigExp SigExp > | PluckWeightedSmooth SigExp SigExp > | PluckFilterSmooth \end{haskelllisting} And here is the Haskore code for the CSound pluck function: \begin{haskelllisting} > pluck :: SigExp -> SigExp -> PluckDecayMethod > -> SigExp -> SigExp -> SigExp > pluck table freq2 decayMethod amp freq = > sigGen "pluck" AR 1 > ([amp, freq, freq2, table] ++ > case decayMethod of > PluckSimpleSmooth -> > [constInt 1] > PluckStretchSmooth stretch -> > [constInt 2, stretch] > PluckSimpleDrum roughness -> > [constInt 3, roughness] > PluckStretchDrum roughness stretch -> > [constInt 4, roughness, stretch] > PluckWeightedSmooth weightCur weightPrev -> > [constInt 5, weightCur, weightPrev] > PluckFilterSmooth -> > [constInt 6]) \end{haskelllisting} \item \code{delay delayTime sig} takes a signal \code{sig} and delays it by \code{delayTime} --- basically making it start \code{delayTime} later than it normally would have. This is a simple version of delay lines and delay taps, capable of performing all of the effects that don't involve feeding the result of a delay or a tap back into the input. This topic is more complicated and will be considered in the next section. In constrast to \function{delay}, the function \function{vdelay} also allows for a controlled delay. But for memory allocation reasons it must also know the maximum possible delay (in seconds). \begin{haskelllisting} > delay :: SigExp -> SigExp -> SigExp > delay delayTime sig = sigGen "delay" AR 1 [sig, delayTime] > vdelay :: SigExp -> SigExp -> SigExp -> SigExp > vdelay maxDelay delayTime sig = > sigGen "vdelay" AR 1 [sig, delayTime, maxDelay*1000] \end{haskelllisting} \item Reverberation can be added to a signal using the CSound functions \code{comb looptime revtime sig}, \code{alpass looptime revtime sig}, and \code{reverb revtime sig}. \code{revtime} is the time in seconds it takes a signal to decay to 1/1000th of its original amplitude, and \code{looptime} is the echo density. \code{comb} produces a ``colored'' reverb, \code{alpass} a ``flat'' reverb, and \code{reverb} a ``natural room'' reverb: \begin{haskelllisting} > comb :: SigExp -> SigExp -> SigExp -> SigExp > comb looptime revtime sig = > sigGen "comb" AR 1 [sig, revtime, looptime] > alpass :: SigExp -> SigExp -> SigExp -> SigExp > alpass looptime revtime sig = > sigGen "alpass" AR 1 [sig, revtime, looptime] > reverb :: SigExp -> SigExp -> SigExp > reverb revtime sig = > sigGen "reverb" AR 1 [sig, revtime] \end{haskelllisting} \end{enumerate} \subparagraph{Delay Lines and Tapping} \code{DelayLine deltime audiosig} establishes a digital delay line, where \code{audiosig} is the source, and \code{deltime} is the delay time in seconds. That \code{DelayLine} can either be simply read, by the \code{Result delayline} constructor, or tapped, by the \code{Tap tapname delayline args} constructor. The most common tap functions are \csoundfunc{deltap} and \csoundfunc{deltapi,} where \csoundfunc{deltapi} is the interpolating version of \csoundfunc{deltap}. Thus we will include helper functions for both of those functions: \begin{haskelllisting} > delTap, delTapI :: DelayLine -> SigExp -> SigExp > delTap dl tap = TreeRec.Branch (Tap "deltap" dl [tap]) > delTapI dl tap = TreeRec.Branch (Tap "deltapi" dl [tap]) \end{haskelllisting} \subparagraph{Recursive Statements} In some cases, the user may want their instrument to have certain special effects --- such as an infinite echo, going back and forth but getting fainter and fainter. It would seem logical that the user would, in that case, write something like this: \begin{haskelllisting} x = sig + delay (0.5 * x) 1.0 \end{haskelllisting} Unfortunately, the translation process cannot handle statements like that, and any kind of statement which is defined in terms of itself must be written a different way. {\em Within} Haskore, recursive statements are handled using three constructors: \constructor{Loop}, \constructor{Var}, and \constructor{Rec}. However, these three constructors are not available to the users, and so we offer a very simple solution: the \function{rec} function: \begin{haskelllisting} > rec :: (SigExp -> SigExp) -> SigExp > rec = TreeRec.recourse \end{haskelllisting} In order to perform the infinite echo listed above, we would write this code: \begin{haskelllisting} x = rec (\y -> sig + delay (0.5 * y) 1.0) \end{haskelllisting} Thus \function{rec}, in some ways, is a bit like \function{fix}, although it doesn't actually do the computation --- instead, it juggles some code around and passes the problem off to CSound. When the \type{SigExp} is processed, all \constructor{Rec} constructors are converted into a \type{SigExp} with \constructor{Loop} and \constructor{Var} constructors. Each \constructor{Loop} has some number of matching \constructor{Var} statements, with the same unique integer referring to both. This is done through the \function{runFix} function and its various helper functions: \begin{haskelllisting} > type SigFixed = TreeTag.T TreeRec.Tag SigTerm > > runFix, simpleFix :: SigExp -> SigFixed > runFix = addEqTree . TreeRec.toTaggedUnique 1 > {- some expressions need no loop unwinding, > toTagged does unwinding anyway, but with less overhead > and shared loop ids -} > simpleFix = TreeRec.toTagged 0 > > instance Foldable BooleanTerm where > foldMap = Traversable.foldMapDefault > > instance Traversable BooleanTerm where > sequenceA branch = > case branch of > Operator nm left right -> > liftA2 (Operator nm) (sequenceA left) (sequenceA right) > Comparison nm left right -> > liftA2 (Comparison nm) ( left) ( right) > > instance Foldable DelayLineTerm where > foldMap = Traversable.foldMapDefault > > instance Traversable DelayLineTerm where > sequenceA (DelayLine x y) = liftA2 DelayLine x y > > instance Foldable SigTerm where > foldMap = Traversable.foldMapDefault > > instance Traversable SigTerm where > sequenceA branch = > case branch of > {- compare with Functor instance -} > ConstFloat x -> pure $ ConstFloat x > ConstInt n -> pure $ ConstInt n > TableNumber t -> pure $ TableNumber t > PField n -> pure $ PField n > Str str -> pure $ Str str > Read t -> pure $ Read t > Tap nm del xs -> liftA2 (Tap nm) (sequenceA del) (sequenceA xs) > Result del -> liftA Result (sequenceA del) > Conditional b true false -> > liftA3 Conditional (sequenceA b) true false > Infix nm left right -> liftA2 (Infix nm) left right > Prefix nm arg -> liftA (Prefix nm) arg > SigGen nm rate cnt args -> > liftA (SigGen nm rate cnt) (sequenceA args) > Index cnt x -> liftA (Index cnt) (sequenceA x) > -- fixSig (Rec (LoopFunction f)) = > -- do n <- get; put (n + 1); fixSig (Loop n (addEq (f (Var n)))) > addEqTree :: SigFixed -> SigFixed > addEqTree (TreeTag.Branch x) = TreeTag.Branch (fmap addEqTree x) > addEqTree (TreeTag.Tag t x) = TreeTag.Tag t (addEqTree (addEq x)) > addEqTree (TreeTag.Loop t) = TreeTag.Loop t > addEq :: SigFixed -> SigFixed > addEq ex = > case ex of > TreeTag.Branch (SigGen _ _ _ _) -> ex > TreeTag.Branch (Tap _ _ _) -> ex > TreeTag.Branch (Result _) -> ex > _ -> TreeTag.Branch (SigGen "=" > (if CR == getRate ex > then CR else AR) 1 [ex]) > getRate :: SigFixed -> EvalRate > getRate (TreeTag.Branch branch) = getRateTerm branch > getRate (TreeTag.Tag _ arg) = getRate arg > getRate (TreeTag.Loop _) = error "getRate: undefined rate" > getRateTerm :: SigTerm SigFixed -> EvalRate > getRateTerm branch = > case branch of > Tap _ _ _ -> AR > Result _ -> AR > Conditional _ a b -> max (getRate a) (getRate b) > Infix _ a b -> max (getRate a) (getRate b) > Prefix _ arg -> getRate arg > SigGen _ rt _ _ -> rt > Index _ arg -> getRateTerm arg > _ -> NR \end{haskelllisting} Note that the \function{addEq} function is used to add an equal sign to the statement being looped, provided that the statement is not already one of the signal generating ones. Also note that if the rate of the statement is \constructor{NR}, the new rate will be \constructor{AR} --- this is because you cannot have an infinitely recursive statement at the note rate. Ideally, all \type{SigExp} statements should have \function{runFix} applied to them. So we have the \function{getFixedExpressions} function, used as a replacement to the standard \function{getChannels} of the \type{Output} class: \begin{haskelllisting} > getFixedExpressions :: Output a => a -> [SigFixed] > getFixedExpressions = map (aux . runFix) . getChannels > where aux ex = > if AR == getRate ex > then ex > else TreeTag.Branch (SigGen "=" AR 1 [ex]) \end{haskelllisting} \subparagraph{Signal Generators with Multiple Outputs} When looking through the CSound documentation, you may notice that there are certain functions, such as \csoundfunc{convolve} or \csoundfunc{babo} that do not have the same structure in CSound as the most of the rest of the functions. This is because those are two operators that actually return multiple outputs. While this type of function is not extremely common, we have included code that can, in fact, handle such functions. The third argument to the \function{sigGen} constructor actually specifies the number of arguments to be returned. In most cases, this should simply be set to one; in a few cases, such as \csoundfunc{convolve} or \csoundfunc{babo}, this should be set to however many outputs you want returned from the function. But how do you get to those outputs? Well, the \constructor{Index} constructor is used from within the code, but the user cannot access that. So we have the following function: \begin{haskelllisting} > getMultipleOutputs :: SigExp -> [SigExp] > getMultipleOutputs (TreeRec.Branch ex@(SigGen _ _ outCount _)) = > if outCount==1 > then error ("cannot get multiple outputs from a function with one output") > else map (TreeRec.Branch . flip Index ex) [1..outCount] > getMultipleOutputs _ = > error ("cannot get multiple outputs from a non-SigGen") \end{haskelllisting} Which can be called on any \function{sigGen} statement returning multiple arguments, and returns a list of the outputs. In other words, you could write something like this: \begin{haskelllisting} [a1, a2] = getMultipleOutputs (LineStatement "babo" AR 2 [sig, 0, 0, 0, 5, 5, 5]) \end{haskelllisting} Haskell would then pattern-match, and leave you with two variables, \code{a1} and \code{a2}. \paragraph{Output Operators} Now that we've got all of those interesting methods of signal generation under our belts, we need some way to make CSound play these interesting sound waves. Hence, the \keyword{output statements}, all of which must be instances of the {\tt Output} class: \begin{haskelllisting} > class (Show c, Eq c) => Output c where > getChannels :: c -> [SigExp] > getName :: c -> String > getChannelCount :: c -> Int \end{haskelllisting} The \function{getChannelCount} could be pre-defined with \code{length . getChannels} but this would require that we have actually an \type{Output} value at hand when calling \function{getChannelCount}. We have defined several common types of output, including \type{Mono}, which allows for the writing of one output channel; \type{Stereo}, which allows for two; and \type{Quad}, which, unsurprisingly, allows four: \begin{haskelllisting} > data Mono = Mono SigExp deriving (Show, Eq) > data Stereo = Stereo SigExp SigExp deriving (Show, Eq) > data Quad = Quad SigExp SigExp SigExp SigExp deriving (Show, Eq) > > instance Output Mono where > getChannels (Mono x) = [x] > getName _ = "out" > getChannelCount _ = 1 > > instance Output Stereo where > getChannels (Stereo x1 x2) = [x1, x2] > getName _ = "outs" > getChannelCount _ = 2 > > instance Output Quad where > getChannels (Quad x1 x2 x3 x4) = [x1, x2, x3, x4] > getName _ = "outq" > getChannelCount _ = 4 \end{haskelllisting} The user is welcome to add more by declaring them instances of the {\tt Output} class and then filling out the required methods. \paragraph{Converting Orchestra Values to Orchestra Files} We must now convert the \type{SigExp} values into a form which can be written into a CSound {\tt .sco} file. As mentioned earlier, each signal generation or modification statement in CSound assigns its result a string name. This name is used whenever another statement takes the signal as an argument. Names of signals generated at note rate must begin with the letter \csoundfunc{i}, control rate with letter \csoundfunc{k}, and audio rate with letter \csoundfunc{a}. The output statements do not generate a signal so they do not have a result name. \begin{figure} {\scriptsize\vspace{-.9in} \begin{haskelllisting} > mkList :: SigFixed -> [SigFixed] > mkList ex@(TreeTag.Branch n) = ex : mkListTerm n > mkList ex@(TreeTag.Tag _ x) = ex : mkList x > mkList (TreeTag.Loop _) = [] > mkListTerm :: SigTerm SigFixed -> [SigFixed] > mkListTerm term = > case term of > Tap _ dl lst -> mkListDL dl ++ mkListAll lst > Result dl -> mkListDL dl > Conditional a b c -> mkListBool a ++ mkListAll [b, c] > Infix _ a b -> mkListAll [a, b] > Prefix _ x -> mkList x > SigGen _ _ outCount lst -> > if outCount == 1 > then mkListAll lst > else map (TreeTag.Branch . flip Index term) [1..outCount] > ++ mkListAll lst > -- cf. getMultipleOutputs > Index _ expr -> mkListTerm expr > _ -> [] \end{haskelllisting} } \caption{The \function{mkList} Function} \figlabel{mkList} \end{figure} The function \function{mkList} is shown in \figref{mkList}, and generates a list containing every single sub-expression of the given \type{SigExp}. It uses the following auxiliary functions: \begin{haskelllisting} > type DelayLineFixed = DelayLineTerm SigFixed > type BooleanFixed = BooleanTerm SigFixed > mkListAll :: [SigFixed] -> [SigFixed] > mkListAll = concatMap mkList > mkListDL :: DelayLineFixed -> [SigFixed] > mkListDL (DelayLine x1 x2) = mkListAll [x1, x2] > mkListBool :: BooleanFixed -> [SigFixed] > mkListBool (Operator _ a b) = concatMap mkListBool [a, b] > mkListBool (Comparison _ a b) = mkListAll [a, b] > mkListOut :: Output a => InstrBlock a -> [SigFixed] > mkListOut (InstrBlock _ xtim chnls lst) = > mkListAll (simpleFix xtim : getFixedExpressions chnls ++ > map (simpleFix . snd) lst) > -- there should not be any loop to be unwind in lst \end{haskelllisting} Once we have the list of all of the expressions, we need to find the signal-generating ones, like \constructor{Tap}s and \function{sigGen}s, and convert them into a list of \type{StatementDef}s, with their associated rates. This is done using the function \function{getLineRates}. \begin{haskelllisting} > type LineFunctionRates = [(EvalRate, StatementDef)] > data StatementDef = StatementDef Function [SigFixed] > | TapDef Function DelayLineFixed [SigFixed] > | DelayDef DelayLineFixed > | DelayWriteDef DelayLineFixed > | MultiDef Function [SigFixed] > OutCount (SigTerm SigFixed) > | IndexDef OutCount (SigTerm SigFixed) > deriving (Show, Eq) > getLineRates :: [SigFixed] -> LineFunctionRates > getLineRates = mapMaybe aux > where > aux (TreeTag.Branch n) = > case n of > Tap nm dl lst -> Just (AR, TapDef nm dl lst) > Result dl -> Just (AR, DelayDef dl) > SigGen nm rt ct lst -> Just (rt, > if ct==1 > then StatementDef nm lst > else MultiDef nm lst ct n) > Index ct ex@(SigGen _ rt _ _) -> > Just (rt, IndexDef ct ex) > _ -> Nothing > aux _ = Nothing \end{haskelllisting} \type{DelayLine}s and \type{Tap}s are a rather complex problem in Haskore. In CSound, there is no such thing as an explicit delay line; you establish a delay line with a \csoundfunc{delayr} opcode, and then all taps that occur between that line and the matching \csoundfunc{delayw} line belong to that particular delay line. Thus the translation from the Haskore concept of delay lines to the CSound concept is somewhat difficult. Hence \function{procDelay} and its various helper functions, which gather all of the taps together and add the requisite \type{DelayWriteDef} to the end of them: \begin{haskelllisting} > procDelay :: LineFunctionRates -> LineFunctionRates > procDelay lst@((_, DelayDef dl) : _) = setUpDelays lst dl > procDelay lst@((_, TapDef _ dl _) : _) = setUpDelays lst dl > procDelay (hd : tl) = hd : procDelay tl > procDelay [] = [] > setUpDelays :: LineFunctionRates -> DelayLineFixed -> LineFunctionRates > setUpDelays lst dl = > let aux (_, DelayDef dl2) = dl == dl2 > aux (_, TapDef _ dl2 _) = dl == dl2 > aux _ = False > (dels, rest) = partition aux lst > in procTaps dels dl ++ procDelay rest > procTaps :: LineFunctionRates -> DelayLineFixed -> LineFunctionRates > procTaps lst dl = > [(AR, DelayDef dl)] ++ filter aux lst ++ [(AR, DelayWriteDef dl)] > where aux (_, TapDef _ _ _) = True > aux _ = False \end{haskelllisting} Putting all of the above together, here is a function that converts an \type{SigExp} into a list of proper name / \type{StatementDef} pairs. Each one of these will eventually result in one statement in the CSound orchestra file. (The result of \function{getLineRates} is reversed to ensure that a definition exists before it is used; and this must be done {\em before} \function{nub} is applied (which removes duplicates), for the same reason.) \begin{haskelllisting} > type StatementDefs = [(Name, StatementDef)] > extractFunctions :: [SigFixed] -> StatementDefs > extractFunctions = > zipWith giveName [1 ..] . nub . procDelay . reverse . getLineRates > giveName :: Int -> (EvalRate, StatementDef) -> (Name, StatementDef) > giveName n (er,x) = > let var = case er of > AR -> 'a' > CR -> 'k' > NR -> 'i' > in (var : show n, x) \end{haskelllisting} The functions that follow are used to write the orchestra file. \function{saveIA} is similar to \function{Score.saveIA}: it asks the user for a file name, opens the file, writes the given orchestra value to the file, and then closes the file. \begin{haskelllisting} > saveIA :: Output a => T a -> IO () > saveIA orch = > do putStr "\nName your orchestra file " > putStr "(.orc extension will be added): " > name <- getLine > save name orch > save :: Output a => FilePath -> T a -> IO () > save name orch = > writeFile (name ++ ".orc") (toString orch) \end{haskelllisting} \function{CSound.Orchestra.toString} splits the task of writing the orchestra into two parts: writing the header, and writing the instrument blocks. \begin{haskelllisting} > toString :: Output a => T a -> String > toString orc@(Cons hdr ibs) = > let glob = getGlobal ibs > in unlines $ > headerToString hdr (channelCount orc) ++ > maybe [] writeGlobalHeader glob ++ > concatMap instrBlockToString ibs ++ > maybe [] resetGlobals glob \end{haskelllisting} Writing the header is relatively simple, and is accomplished by the following function: \begin{haskelllisting} > headerToString :: Header -> Int -> [String] > headerToString (a,k) nc = > ["sr = " ++ show a, > "kr = " ++ show k, > "ksmps = " ++ show (fromIntegral a / fromIntegral k :: Double), > "nchnls = " ++ show nc] > channelCount :: Output a => T a -> Int > channelCount (Cons _ instrBlock) = > getChannelCount (instrBlockOutput (head instrBlock)) \end{haskelllisting} If the instance of \function{getChannelCount} does not rely on \function{getChannels} the \expression{instrBlock} can be empty. \function{instrBlockToString} writes a single instrument block. \begin{haskelllisting} > instrBlockToString :: Output a => InstrBlock a -> [String] > instrBlockToString ib@(InstrBlock num xtim _ _) = > let ses = mkListOut ib > noes = extractFunctions ses > lps = getLoops noes ses > in "" : > showInstrument num : > writeLoops lps ++ > concatMap (writeExp noes lps) noes ++ > writeOut noes lps ib ++ > (if xtim /= 0 > then ["xtratim " ++ showExp noes lps (simpleFix xtim)] > else []) ++ > "endin" : > [] > showInstrument :: Instrument -> String > showInstrument instr = "instr " ++ showInstrumentNumber instr \end{haskelllisting} \constructor{Loop} statements require special handling, including initialization at the top of each instrument and a special set of loop definitions which are also passed to most of the writing functions. This is handled by the following two functions: \begin{haskelllisting} > type LoopDefs = [(TreeRec.Tag, String)] > writeLoops :: LoopDefs -> [String] > writeLoops = map ((++ " init 0") . snd) > getLoops :: StatementDefs -> [SigFixed] -> LoopDefs > getLoops noes = > let extractTag (TreeTag.Tag n ex) = Just (n, ex) > extractTag _ = Nothing > in map (mapSnd (showExp noes [])) > . nub . mapMaybe extractTag > -- map and mapMaybe are separated for efficiency achieved by nub \end{haskelllisting} Globals, too, require special handling: they need both a header at the top of the CSound orchestra file, and an instrument in which to reset their values. Those requirements are fulfilled by the following functions, which are called from the \function{instrBlockToString} function. \begin{haskelllisting} > globalRate :: EvalRate -> String > globalRate AR = "a" > globalRate CR = "k" > globalRate NR = error ("you cannot use init-rate globals") > globalWrite, globalRead :: GlobalSig -> String > globalWrite (Global rate _ n) = "g" ++ globalRate rate ++ "w" ++ show n > globalRead (Global rate _ n) = "g" ++ globalRate rate ++ "r" ++ show n > resetGlobals :: ([GlobalSig], Instrument) -> [String] > resetGlobals (gs,num) = > let aux g = > (globalRead g ++ " = " ++ globalWrite g) : > (globalWrite g ++ " = 0") : > [] > in "" : > showInstrument num : > concatMap aux gs ++ > "endin" : > [] > numGlobalInstrs :: Output a => [InstrBlock a] -> Instrument > numGlobalInstrs lst = > head (instruments \\ map instrBlockInstr lst) > getGlobals :: Output a => [InstrBlock a] -> [GlobalSig] > getGlobals = concatMap (map fst . instrBlockGlobals) > getGlobal :: Output a => [InstrBlock a] -> Maybe ([GlobalSig], Instrument) > getGlobal lst = > let gs = getGlobals lst > in toMaybe (not (null gs)) (gs, numGlobalInstrs lst) > writeGlobalHeader :: ([GlobalSig], Instrument) -> [String] > writeGlobalHeader (gs,num) = > let globInit g = > (globalWrite g ++ " init 0") : > (globalRead g ++ " init 0") : > [] > contents = > concatMap globInit gs ++ > ("turnon " ++ showInstrumentNumber num) : > [] > in "" : contents ++ "" : [] > writeOutGlobals :: StatementDefs -> LoopDefs -> > [(GlobalSig, SigFixed)] -> [String] > writeOutGlobals noes lps = > let aux (g, oe) = > globalWrite g ++ " = " ++ globalWrite g ++ " + " ++ > writeArgs noes lps [oe] > in map aux \end{haskelllisting} Recall that after processing, the \type{SigExp} becomes a list of \code{(Name, StatementDef)} pairs. The last few functions write each of these named \type{StatementDef}s as a statement in the orchestra file. Whenever a signal generation/modification constructor is encountered in an argument list of another constructor, the argument's string name is used instead, as found in the list of \type{(Name, StatementDef)} pairs. \begin{figure} {\small \begin{haskelllisting} > writeOut :: Output a => StatementDefs -> LoopDefs -> InstrBlock a -> [String] > writeOut noes lps (InstrBlock _ _ chnls lst) = > (getName chnls ++ " " ++ writeArgs noes lps (getFixedExpressions chnls)) : > writeOutGlobals noes lps (map (mapSnd simpleFix) lst) > writeExp :: StatementDefs -> LoopDefs -> (Name, StatementDef) -> [String] > writeExp noes lps (name, stmt) = > case stmt of > StatementDef funcName args -> > [ifAllowedArgs funcName args > (name ++ " " ++ funcName ++ " " ++ writeArgs noes lps args)] > DelayDef (DelayLine _ del) -> > [name ++ " delayr " ++ showExp noes lps del] > TapDef funcName _ args -> > [ifAllowedArgs funcName args > (name ++ " " ++ funcName ++ " " ++ writeArgs noes lps args)] > DelayWriteDef (DelayLine sig _) -> > ["delayw " ++ showExp noes lps sig] > IndexDef _ _ -> [] > MultiDef funcName args outCount ex {- 'ex' is always a SigGen -} -> > [ifAllowedArgs funcName args > (concat (intersperse ", " > (map (\x -> showExp noes lps > (TreeTag.Branch (Index x ex))) > [1..outCount])) > ++ " " ++ funcName ++ " " ++ writeArgs noes lps args)] > > ifAllowedArgs :: String -> [SigFixed] -> String -> String > ifAllowedArgs funcName args str = > if allowedArgs argCountTable funcName (length args) > then str > else error ("writeExp: wrong number of arguments " ++ > "passed to function " ++ funcName) > writeArgs :: StatementDefs -> LoopDefs -> [SigFixed] -> String > writeArgs noes lps = > concat . intersperse ", " . map (showExp noes lps) \end{haskelllisting} } \caption{The Function \function{writeExp}} \figlabel{writeExp} \end{figure} \begin{figure} {\small \begin{haskelllisting} > showExp :: StatementDefs -> LoopDefs -> SigFixed -> String > showExp noes lps (TreeTag.Branch oe) = > case oe of > ConstFloat x -> show x > ConstInt n -> show n > TableNumber n -> show n > PField p -> "p" ++ show p > Str s -> show s > Read var -> globalRead var > Conditional b tr fa -> > "(" ++ showBool noes lps b ++ " ? " > ++ showExp noes lps tr ++ " : " > ++ showExp noes lps fa ++ ")" > Infix nm x1 x2 -> > "(" ++ showExp noes lps x1 ++ " " ++ nm ++ " " > ++ showExp noes lps x2 ++ ")" > Prefix nm x -> nm ++ "(" ++ showExp noes lps x ++ ")" > SigGen nm _ _ args -> > lookupDef noes (StatementDef nm args) oe > Result dl -> lookupDef noes (DelayDef dl) oe > Tap nm dl args -> lookupDef noes (TapDef nm dl args) oe > Index x ex -> lookupDef noes (IndexDef x ex) oe > showExp noes lps (TreeTag.Tag _ ex) = > showExp noes lps ex > showExp _ lps (TreeTag.Loop s) = > maybe (error "loop not found") id (lookup s lps) > lookupDef :: (Show a, Eq c) => [(b, c)] -> c -> a -> b > lookupDef noes def oe = > maybe (error ("showExp " ++ show oe ++ ": constructor not found\n")) > id (lookup def (map (\(x, y) -> (y, x)) noes)) > showBool :: StatementDefs -> LoopDefs -> BooleanFixed -> String > showBool noes lps bool = > case bool of > Operator name x1 x2 -> > "(" ++ showBool noes lps x1 ++ " " ++ name ++ " " > ++ showBool noes lps x2 ++ ")" > Comparison name x1 x2 -> > "(" ++ showExp noes lps x1 ++ " " ++ name ++ " " > ++ showExp noes lps x2 ++ ")" \end{haskelllisting} } \caption{The Function \function{showExp}} \figlabel{showExp} \end{figure} \paragraph{The \type{Orc} Monad} The global signals can be somewhat difficult to handle, especially when there are quite a few of them. After all, they must all be different; otherwise, the user may have two instruments writing completely different things to the same signal, and using the same signals for completely different things. However, there is an easier way to do this --- a monad that allows for a much simpler way of getting global signals: \begin{haskelllisting} > type Orc a b = State (OrcState a) b > data OrcState a = OrcState [InstrBlock a] Int deriving (Show, Eq) > mkSignalPlain :: EvalRate -> (SigExp -> SigExp -> SigExp) -> OrcState a > -> (GlobalSig, OrcState a) > mkSignalPlain rate func (OrcState ibs gCount) = > (Global rate func gCount, OrcState ibs (gCount + 1)) > mkSignal :: Output a => EvalRate -> (SigExp -> SigExp -> SigExp) > -> Orc a GlobalSig > mkSignal rate func = state (mkSignalPlain rate func) > addInstrPlain :: Output a => InstrBlock a -> OrcState a -> OrcState a > addInstrPlain ib (OrcState ibs gCount) = > OrcState (ibs ++ [ib]) gCount > addInstr :: Output a => InstrBlock a -> Orc a () > addInstr ib = modify (addInstrPlain ib) > runOrc :: Orc a () -> [InstrBlock a] > runOrc comp = > case execState comp (OrcState [] 1) of > (OrcState ibs _) -> ibs > mkOrc :: Output a => Header -> Orc a () -> T a > mkOrc hdr = Cons hdr . runOrc \end{haskelllisting} The user can call \function{mkSignal} to get a unique global line, or \function{addInstr} to add an instrument to the structure. For example: \begin{haskelllisting} > test :: IO () > test = > let a1 = oscI AR (tableNumber 1) 1000 440 > comp = > do h <- mkSignal AR (+) > addInstr (InstrBlock (instrument 1) 0 (Mono a1) [(h, a1)]) > addInstr (InstrBlock (instrument 2) 0 (Mono (readGlobal h)) []) > in saveIA (mkOrc (44100, 4410) comp) \end{haskelllisting} The above example has the first instrument writing a simple oscillation to the given audio-rate global signal, and then has the second instrument reading from the same global. \paragraph{An Orchestra Example} \figref{csound-orc-file} shows a typical CSound orchestra file. \figref{orc-def} shows how this same functionality would be achieved in Haskore using an \type{CSound.Orchestra.T} value. Finally, \figref{orc-file-result} shows the result of applying \function{Orchestra.saveIA} to \code{orc1} shown in \figref{orc-def}. Figures \ref{fig:csound-orc-file} and \ref{fig:orc-file-result} should be compared: you will note that except for name changes, they are the same, as they should be. \begin{figure} \begin{verbatim} sr = 48000 kr = 24000 ksmps = 2 nchnls = 2 instr 4 inote = cpspch(p5) k1 envlpx ampdb(p4), .001, p3, .05, 6, -.1, .01 k2 envlpx ampdb(p4), .0005, .1, .1, 6, -.05, .01 k3 envlpx ampdb(p4), .001, p3, p3, 6, -.3, .01 a1 oscili k1, inote, 1 a2 oscili k1, inote * 1.004, 1 a3 oscili k2, inote * 16, 1 a4 oscili k3, inote, 5 a5 oscili k3, inote * 1.004, 5 outs (a2 + a3 + a4) * .75, (a1 + a3 + a5) * .75 endin \end{verbatim} \caption{Sample CSound Orchestra File} \figlabel{csound-orc-file} \end{figure} \begin{figure} \begin{haskelllisting} > orc1 :: T Stereo > orc1 = > let hdr = (48000, 24000) > inote = pchToHz p5 > k1 = env CR 6 (-0.1) 0.01 0 0.05 0.001 p3 (dbToAmp p4) > k2 = env CR 6 (-0.05) 0.01 0 0.1 0.0005 0.1 (dbToAmp p4) > k3 = env CR 6 (-0.3) 0.01 0 p3 0.001 p3 (dbToAmp p4) > t1 = tableNumber 1 > t5 = tableNumber 5 > a1 = oscI AR t1 k1 inote > a2 = oscI AR t1 k1 (inote*1.004) > a3 = oscI AR t1 k2 (inote*16) > a4 = oscI AR t5 k3 inote > a5 = oscI AR t5 k3 (inote*1.004) > out = Stereo ((a2+a3+a4) * 0.75) ((a1+a3+a5) * 0.75) > ib = InstrBlock (instrument 4) 0 out [] > in Cons hdr [ib] > test1 :: StatementDefs > test1 = extractFunctions $ mkListOut (head ((\(Cons _ x) -> x) orc1)) \end{haskelllisting} \caption{Haskore Orchestra Definition} \figlabel{orc-def} \end{figure} \begin{figure} \begin{verbatim} sr = 48000 kr = 24000 ksmps = 2.0 nchnls = 2 instr 4 k1 envlpx ampdb(p4), 1.0e-3, p3, p3, 6.0, -(0.3), 1.0e-2, 0.0 a2 oscili k1, (cpspch(p5) * 1.004), 5 k3 envlpx ampdb(p4), 5.0e-4, 0.1, 0.1, 6.0, -(5.0e-2), 1.0e-2, 0.0 a4 oscili k3, (cpspch(p5) * 16.0), 1 k5 envlpx ampdb(p4), 1.0e-3, p3, 5.0e-2, 6.0, -(0.1), 1.0e-2, 0.0 a6 oscili k5, cpspch(p5), 1 a7 oscili k1, cpspch(p5), 5 a8 oscili k5, (cpspch(p5) * 1.004), 1 outs (((a8 + a4) + a7) * 0.75), (((a6 + a4) + a2) * 0.75) endin \end{verbatim} \caption{Result of \code{Orchestra.saveIA orc1}} \figlabel{orc-file-result} \end{figure} haskore-0.2.0.3/src/Haskore/Interface/CSound/Score.lhs0000644000000000000000000002523411754016451020547 0ustar0000000000000000\subsubsection{The Score File} \seclabel{score-file} \begin{haskelllisting} > module Haskore.Interface.CSound.Score where > > import Haskore.Interface.CSound (Instrument, showInstrumentNumber, PField, Time) > import qualified Haskore.Interface.CSound.Note as CSNote > import qualified Haskore.Interface.CSound.Generator as Generator > import Haskore.Interface.CSound.Generator > (compSine1, lineSeg1, randomTable, PStrength, RandDist(Uniform)) > > import qualified Haskore.Music.Rhythmic as RhyMusic > import qualified Haskore.Performance as Performance > import qualified Haskore.Performance.BackEnd as PerformanceBE > import qualified Haskore.Performance.Context as Context > import qualified Haskore.Performance.Fancy as FancyPf > import qualified Data.EventList.Relative.TimeBody as TimeList > import qualified Data.EventList.Absolute.TimeBody as TimeListAbs > import qualified Haskore.Basic.Pitch as Pitch > import qualified Haskore.Interface.CSound.InstrumentMap as InstrMap > import qualified Haskore.Interface.CSound.SoundMap as SoundMap > import qualified Numeric.NonNegative.Class as NonNeg \end{haskelllisting} We will represent a score file as a sequence of \keyword{score statements}: \begin{haskelllisting} > type T = [Statement] \end{haskelllisting} The {\tt Statement} data type is designed to simulate CSound's three kinds of score statements: \begin{enumerate} \item A \keyword{tempo} statement, which sets the tempo. In the absence of a tempo statement, the tempo defaults to 60 beats per minute. \item A \keyword{note event}, which defines the start time, pitch, duration (in beats), volume (in decibels), and instrument to play a note (and is thus more like a Haskore {\tt Event} than a Midi event, thus making the conversion to CSound easier than to Midi, as we shall see later). Each note event also contains a number of optional arguments called \keyword{p-fields}, which determine other properties of the note, and whose interpretation depends on the instrument that plays the note. This will be discussed further in a later section. \item \keyword{Function table} definitions. A function table is used by instruments to produce audio signals. For example, sequencing through a table containing a perfect sine wave will produce a very pure tone, while a table containing an elaborate polynomial will produce a complex sound with many overtones. The tables can also be used to produce control signals that modify other signals. Perhaps the simplest example of this is a tremolo or vibrato effect, but more complex sound effects, and FM (frequency modulation) synthesis in general, is possible. \end{enumerate} \begin{haskelllisting} > data Statement = Tempo Bpm > | Note Instrument StartTime Duration Pch Volume [PField] > | Table Table CreatTime TableSize Normalize Generator.T > deriving Show > > type Bpm = Int > type StartTime = Time > type Duration = Time > data Pch = AbsPch Pitch.Absolute | Cps Float deriving Show > type Volume = Float > type Table = Int > type CreatTime = Time > type TableSize = Int > type Normalize = Bool \end{haskelllisting} This is all rather straightforward, except for function table generation, which requires further explanation. \input{Haskore/Interface/CSound/Generator.lhs} \subparagraph*{Common Tables} For convenience, here are some common function tables, which take as argument the identifier integer: \begin{haskelllisting} > simpleSine, square, sawtooth, triangle, whiteNoise :: Table -> Statement > > simpleSine n = Table n 0 8192 True > (compSine1 [1]) > square n = Table n 0 1024 True > (lineSeg1 1 [(256, 1), (0, -1), (512, -1), (0, 1), (256, 1)]) > sawtooth n = Table n 0 1024 True > (lineSeg1 0 [(512, 1), (0, -1), (512, 0)]) > triangle n = Table n 0 1024 True > (lineSeg1 0 [(256, 1), (512, -1), (256, 0)]) > whiteNoise n = Table n 0 1024 True > (randomTable Uniform) \end{haskelllisting} The following function for a composite sine has an extra argument, a list of harmonic partial strengths: \begin{haskelllisting} > compSine :: Table -> [PStrength] -> Statement > compSine _ s = Table 6 0 8192 True (compSine1 s) \end{haskelllisting} \input{Haskore/Interface/CSound/InstrumentMap.lhs} \paragraph{Converting Haskore Music.T to a CSound Score File} To convert a {\tt Music.T} value into a CSound score file, we need to: \begin{enumerate} \item Convert the {\tt Music.T} value to a {\tt Performance.T}. \item Convert the {\tt Performance.T} value to a {\tt Score.T}. \item Write the {\tt Score.T} value to a CSound score file. \end{enumerate} We already know how to do the first step. Steps two and three will be achieved by the following two functions: \begin{haskelllisting} > fromPerformanceBE :: (NonNeg.C time, Num time) => > (time -> Time) -> > PerformanceBE.T time CSNote.T -> T > saveIA :: T -> IO () \end{haskelllisting} The three steps can be put together in whatever way the user wishes, but the most general way would be this: \begin{haskelllisting} > fromRhythmicMusic :: > (RealFrac time, NonNeg.C time, RealFrac dyn, Ord drum, Ord instr) => > Tables -> > (InstrMap.SoundTable drum, > InstrMap.SoundTable instr, > Context.T time dyn (RhyMusic.Note drum instr), > RhyMusic.T drum instr) -> T > fromRhythmicMusic tables (dMap, iMap, cont, m) = > tables ++ fromRhythmicPerformance dMap iMap > (Performance.fromMusic FancyPf.map cont m) > > type Tables = T \end{haskelllisting} The \type{Tables} argument is a user-defined set of function tables, represented as a sequence of {\tt Statement}s (specifically, {\tt Table} constructors). (See \secref{function-table}.) \subparagraph*{From Performance.T to Score.T} The translation between \type{Performance.Event}s and score \type{CSoundScore.Note}s is straightforward, the only tricky part being: \begin{itemize} \item The unit of time in a {\tt Performance.T} is the second, whereas in a {\tt Score.T} it is the beat. However, the default CSound tempo is 60 beats per minute, or one beat per second, as was already mentioned, and we use this default for our \keyword{score} files. Thus the two are equivalent, and no translation is necessary. \item CSound wants to get pitch information in the form 'a.b' but it interprets them very different. Sometimes it is considered as 'octave.pitchclass' sometimes it is considered as fraction frequency. We try to cope with it using the two-constructor type Pch. \item Like for MIDI data we must distinguish between Velocity and Volume. Velocity is instrument dependent and different velocities might result in different flavors of a sound. As a quick work-around we turn the velocity information into volume. Cf. {\tt dbamp} in the CSound manual. \end{itemize} \begin{haskelllisting} > fromPerformanceBE timeMap = > map (\(time, event) -> > noteToStatement timeMap time > (PerformanceBE.eventDur event) > (PerformanceBE.eventNote event)) . > TimeListAbs.toPairList . > TimeList.toAbsoluteEventList NonNeg.zero > > fromRhythmicPerformance :: > (RealFrac time, NonNeg.C time, RealFrac dyn, Ord drum, Ord instr) => > InstrMap.SoundTable drum -> > InstrMap.SoundTable instr -> > Performance.T time dyn (RhyMusic.Note drum instr) -> T > fromRhythmicPerformance dMap iMap = > fromPerformanceBE realToFrac . > PerformanceBE.fromPerformance > (CSNote.fromRhyNote > (InstrMap.lookup dMap) > (InstrMap.lookup iMap)) > > fromRhythmicPerformanceMap :: > (RealFrac time, NonNeg.C time, RealFrac dyn) => > InstrMap.ToSound drum -> > InstrMap.ToSound instr -> > Performance.T time dyn (RhyMusic.Note drum instr) -> T > fromRhythmicPerformanceMap dMap iMap = > fromPerformanceBE realToFrac . > PerformanceBE.fromPerformance (CSNote.fromRhyNote dMap iMap) > > fromRhythmicPerformanceWithAttributes :: > (RealFrac time, NonNeg.C time, RealFrac dyn) => > SoundMap.DrumTableWithAttributes out drum -> > SoundMap.InstrumentTableWithAttributes out instr -> > Performance.T time dyn (RhyMusic.Note drum instr) -> T > fromRhythmicPerformanceWithAttributes dMap iMap = > fromRhythmicPerformanceMap > (SoundMap.lookupDrum dMap) > (SoundMap.lookupInstrument iMap) > > noteToStatement :: > (time -> Time) -> time -> time -> > CSNote.T -> Statement > noteToStatement timeMap t d (CSNote.Cons pfs v i p) = > Note i (timeMap t) (timeMap d) > (maybe (Cps 0 {- dummy -}) AbsPch p) v pfs \end{haskelllisting} \subparagraph*{From Score to Score File} Now that we have a value of type {\tt Score}, we must write it into a plain text ASCII file with an extension {\tt .sco} in a way that CSound will recognize. This is done by the following function: \begin{haskelllisting} > saveIA s = > do putStr "\nName your score file " > putStr "(.sco extension will be added): " > name <- getLine > save (name ++ ".sco") s > save :: FilePath -> T -> IO () > save name s = writeFile (name ++ ".sco") (toString s) \end{haskelllisting} This function asks the user for the name of the score file, opens that file for writing, writes the score into the file using the function \function{toString}, and then closes the file. The score file is a plain text file containing one statement per line. Each statement consists of an opcode, which is a single letter that determines the action to be taken, and a number of arguments. The opcodes we will use are ``e'' for end of score, ``t'' to set tempo, ``f'' to create a function table, and ``i'' for note events. \begin{haskelllisting} > toString :: T -> String > toString s = unlines (map statementToString s ++ ["e"]) -- end of score \end{haskelllisting} Finally, the \function{statementToString} function: \begin{haskelllisting} > statementToString :: Statement -> String > statementToString = unwords . statementToWords > > statementToWords :: Statement -> [String] > statementToWords (Tempo t) = > ["t", "0", show t] > statementToWords (Note i st d p v pfs) = > ["i", showInstrumentNumber i, show st, show d, > pchToString p, show v] ++ map show pfs > statementToWords (Table t ct s n gr) = > ["f", show t, show ct, show s, > (if n then id else ('-':)) > (unwords (Generator.toStatementWords gr))] > > -- it's exciting whether CSound knows what we mean with the values > -- (0 < note) is for compatibility with older CSound example files > pchToString :: Pch -> String > pchToString (AbsPch ap) = > let (oct, note) = divMod ap 12 > in show oct ++ "." ++ > (if 0 < note && note < 10 then "0" else "") ++ > show note > pchToString (Cps freq) = show freq \end{haskelllisting} haskore-0.2.0.3/src/Haskore/Interface/CSound/OrchestraFunction.lhs0000644000000000000000000006251611754016451023140 0ustar0000000000000000> module Haskore.Interface.CSound.OrchestraFunction where > {- a fast variant of 'elem' > precondition: list must be sorted > This could be replaced by Data.Map when it is widely available. -} > elemSorted :: (Ord a) => a -> [a] -> Bool > elemSorted x ys = > case dropWhile (GT==) (map (compare x) ys) of > EQ:_ -> True > _ -> False > allowedArgs :: [(String, [Int])] -> String -> Int -> Bool > allowedArgs table name count = > maybe True (elemSorted count) (lookup name table) > -- This should be a Data.Map in future. > argCountTable :: [(String, [Int])] > argCountTable = [("=", [1]), > ("-", [1]), > ("a", [1]), > ("abs", [1]), > ("active", [1]), > ("adsr", [4, 5]), > ("adsyn", [4]), > ("adsynt", [6, 7]), > ("aftouch", [0..2]), > ("alpass", [3..5]), > ("ampdb", [1]), > ("ampdbfs", [1]), > ("ampmidi", [1, 2]), > ("areson", [3..5]), > ("aresonk", [3..5]), > ("atone", [2, 3]), > ("atonek", [2, 3]), > ("atonex", [2..4]), > ("babo", [7..9]), -- gives two outputs > ("balance", [2..4]), > ("bamboo", [2..8]), > ("bbcutm", [6..9]), > ("bbcuts", [7..10]), -- gives two outputs > ("betarand", [3]), > ("bexprnd", [1]), > ("biquad", [7, 8]), > ("biquada", [7, 8]), > ("birnd", [1]), > ("bqrez", [3..5]), > ("butterbp", [3, 4]), > ("butterbr", [3, 4]), > ("butterhp", [2, 3]), > ("butterlp", [2, 3]), > ("button", [1]), -- gui > ("buzz", [4, 5]), > ("cabasa", [2..5]), > ("cauchy", [1]), > ("cent", [1]), > ("chanctrl", [2..4]), > ("changed", [1..]), > ("checkbox", [1]), -- gui > ("clear", [1..]), -- no output > ("clfilt", [4..8]), > ("clip", [3, 4]), > ("clockoff", [1]), -- no output > ("clockon", [1]), -- no output > ("comb", [3..5]), > ("control", [1]), -- gui > ("convolve", [2, 3]), -- gives 1-4 outputs > ("cos", [1]), > ("cosh", [1]), > ("cosinv", [1]), > ("cps2pch", [2]), > ("cpsmidi", [0]), > ("cpsmidib", [0, 1]), > ("cpsoct", [1]), > ("cpspch", [1]), > ("cpstmid", [1]), > ("cpstun", [3]), > ("cpstuni", [2]), > ("cpsxpch", [4]), > ("cpuprc", [2]), -- no output > ("cross2", [6]), > ("crunch", [2..5]), > ("ctrl14", [5, 6]), > ("ctrl21", [6, 7]), > ("ctrl7", [4, 5]), > ("ctrlinit", [3, 5..65]), -- no output > ("cuserrnd", [3]), > ("dam", [6]), > ("db", [1]), > ("dbamp", [1]), > ("dbfsamp", [1]), > ("dcblock", [1, 2]), > ("dconv", [3]), > ("delay", [1, 2]), > ("delay1", [1, 2]), > ("delayr", [1]), > ("delayw", [1]), -- no output > ("deltap", [1]), > ("deltap3", [1]), > ("deltapi", [1]), > ("deltapn", [1]), > ("deltapx", [2]), > ("deltapxw", [3]), -- no output > ("diff", [1, 2]), > ("diskin", [2..6]), -- gives 1-4 outputs > ("dispfft", [3..6]), -- no output > ("display", [2..4]), -- no output > ("distort", [5]), > ("divz", [3]), > ("downsamp", [1, 2]), > ("dripwater", [2..8]), > ("dumpk", [4]), -- no output > -- several other dump functions with no output > ("duserrnd", [1]), > ("envlpx", [7, 8]), > ("envlpxr", [6..8]), > -- "event" cannot be created because strings are not OrcExps > ("exp", [1]), > ("expon", [3]), > ("exprand", [1]), > ("expseg", [3, 5..]), > ("expsega", [3, 5..]), > ("expsegr", [5, 7..]), > ("filelen", [1]), > ("filenchnls", [1]), > ("filepeak", [1, 2]), > ("filesr", [1]), > ("filter2", [3..]), > ("fin", [4..]), -- no output > ("fini", [4..]), -- no output > ("fink", [4..]), -- no output > ("fiopen", [2]), -- takes a string argument > ("flanger", [3, 4]), > ("flashtxt", [2]), -- no output, gui > -- several different gui elements occur here > ("fmb3", [11]), > ("fmbell", [11]), > ("fmmetal", [11]), > ("fmpercfl", [11]), > ("fmrhode", [11]), > ("fmvoice", [11]), > ("fmwurlie", [11]), > ("fof", [12..15]), > ("fof2", [14, 15]), > ("fofilter", [4, 5]), > ("fog", [13..16]), > ("fold", [2]), > ("follow", [2]), > ("follow2", [3]), > ("foscil", [6, 7]), > ("focsili", [6, 7]), > ("fout", [3..]), -- no output > ("fouti", [4..]), -- no output > ("foutir", [4..]), -- no output > ("foutk", [3..]), -- no output > ("fprintks", [2..]), -- no output > ("fprints", [2..]), -- no output > ("frac", [1]), > ("ftchnls", [1]), > ("ftgen", [5..]), > ("ftlen", [1]), > ("ftload", [3..]), > ("ftloadk", [4..]), > ("ftlptim", [1]), > ("ftmorf", [3]), -- no output > ("ftsave", [3..]), -- no output > ("ftsavek", [4..]), -- no output > ("ftsr", [1]), > ("gain", [2..4]), > ("gauss", [1]), > ("gbuzz", [6, 7]), > ("gogobel", [8]), > ("grain", [9, 10]), > ("grain2", [6..9]), > ("grain3", [11..13]), > ("granule", [17..23]), > ("guiro", [2..7]), > ("harmon", [8]), > ("hilbert", [1]), -- gives two outputs > ("hrtfer", [4]), -- gives two outputs, takes a string > ("hsboscil", [6..8]), > ("i", [1]), > ("ihold", [0]), -- no output > ("in", [0]), > ("in32", [0]), -- gives 32 outputs > ("inch", [1]), > ("inh", [0]), -- gives six outputs > ("init", [1]), > ("initc14", [4]), -- no output > ("initc21", [5]), -- no output > ("initc7", [3]), -- no output > ("ino", [0]), -- gives eight outputs > ("inq", [0]), -- gives four outputs > ("ins", [0]), -- gives two outputs > ("int", [1]), > ("integ", [1, 2]), > ("invalue", [1]), -- takes a string > ("inx", [0]), -- gives 16 outputs > ("inz", [1]), -- no output > ("jitter", [3]), > ("jitter2", [7]), > ("jspline", [3]), > ("ktableseg", [3, 5..]), -- no output > ("lfo", [2, 3]), > ("limit", [3]), > ("line", [3]), > ("linen", [4]), > ("linenr", [4]), > ("lineto", [2]), > ("linrand", [1]), > ("linseg", [3, 5..]), > ("linsegr", [5, 7..]), > ("locsend", [0]), -- gives 2 or 4 outputs > ("locsig", [4]), -- gives 2 or 4 outputs > ("log", [1]), > ("log10", [1]), > ("logbtwo", [1]), > ("loopseg", [4, 6..]), > ("lorenz", [8, 9]), -- gives three outputs > ("loscil", [3..10]), -- gives 1-2 outputs > ("loscil3", [3..10]), -- gives 1-2 outputs > ("lowpass2", [3, 4]), > ("lowres", [3, 4]), > ("lowresx", [3..5]), > ("lpf18", [3]), > ("lpfreson", [2]), > ("lphasor", [1..6]), > ("lpinterp", [3]), > ("lposcil", [5, 6]), > ("lposcil3", [5, 6]), > ("lpread", [2..4]), -- gives four outputs > ("lpreson", [1]), > ("lpshold", [4, 6..]), > ("lpslot", [1]), -- no output > ("mac", [2, 4..]), > ("maca", [1..]), > ("madsr", [4..6]), > ("mandel", [4]), -- gives two outputs > ("mandol", [7, 8]), > ("marimba", [9..11]), > ("massign", [2]), > ("maxalloc", [2]), -- no output > ("max_k", [3]), > ("mclock", [1]), -- no output > ("mdelay", [5]), -- no output > ("metro", [1, 2]), > ("midic14", [4, 5]), > ("midic21", [5, 6]), > ("midic7", [3, 4]), > ("midichannelaftertouch", [1..3]), -- no output > ("midichn", [0]), > ("midicontrolchange", [2..4]), -- no output > ("midictrl", [1..3]), > ("mididefault", [2]), -- no output > ("midiin", [0]), -- gives four outputs > ("midinoteoff", [2]), -- no output > ("midinoteoncps", [2]), -- no output > ("midinoteonkey", [2]), -- no output > ("midinoteonoct", [2]), -- no output > ("midinoteonpch", [2]), -- no output > ("midion", [3]), -- no output > ("midion2", [4]), -- no output > ("midiout", [4]), -- no output > ("midipitchbend", [1..3]), -- no output > ("midipolyaftertouch", [2..4]), -- no output > ("midiprogramchange", [1]), -- no output > ("mirror", [3]), > ("moog", [9]), > ("moogladder", [3, 4]), > ("moogvcf", [3..5]), > ("moscil", [5]), -- no output > ("mpulse", [2, 3]), > ("mrtmsg", [1]), -- no output > ("multitap", [1, 3..]), > ("mute", [1, 2]), -- no output > ("mxadsr", [4..6]), > ("nestedap", [5, 7, 9, 10]), > ("nlfilt", [6]), > ("noise", [2]), > ("noteoff", [3]), -- no output > ("noteon", [3]), -- no output > ("noteondur", [4]), -- no output > ("noteondur2", [4]), -- no output > ("notnum", [0]), > ("nreverb", [3..8]), > ("nrpn", [3]), -- no output > ("nsamp", [1]), > ("nstrnum", [1]), -- takes string > ("ntrpol", [3..5]), > ("octave", [1]), > ("octcps", [1]), > ("octmidi", [0]), > ("octmidib", [0, 1]), > ("octpch", [1]), > ("oscbnk", [19..26]), > ("oscil", [3, 4]), > ("oscil1", [4]), > ("oscil1i", [4]), > ("oscil3", [3, 4]), > ("oscili", [3, 4]), > ("oscilikt", [3..5]), > ("osciliktp", [3, 4]), > ("oscilikts", [5, 6]), > ("osciln", [4]), > ("oscils", [3, 4]), > ("oscilx", [4]), > ("out", [1]), -- no output > ("out32", [32]), -- no output > ("outc", [1..]), -- no output > ("outch", [2, 4..]), -- no output > ("outh", [6]), -- no output > ("outiat", [4]), -- no output > ("outic", [5]), -- no output > ("outic14", [6]), -- no output > ("outipat", [5]), -- no output > ("outipb", [4]), -- no output > ("outipc", [4]), -- no output > ("outkat", [4]), -- no output > ("outkc", [5]), -- no output > ("outkc14", [6]), -- no output > ("outkpat", [5]), -- no output > ("outkpb", [4]), -- no output > ("outkpc", [4]), -- no output > ("outo", [8]), -- no output > ("outq", [4]), -- no output > ("outq1", [1]), -- no output > ("outq2", [1]), -- no output > ("outq3", [1]), -- no output > ("outq4", [1]), -- no output > ("outs", [2]), -- no output > ("outs1", [1]), -- no output > ("outs2", [1]), -- no output > ("outvalue", [2]), -- no output, takes a string > ("outx", [16]), -- no output > ("outz", [1]), -- no output > ("p", [1]), > ("pan", [4..6]), -- gives four outputs > ("pareq", [4..6]), > ("pcauchy", [1]), > ("pchbend", [0..2]), > ("pchmidi", [0]), > ("pchmidib", [0, 1]), > ("pchoct", [1]), > ("peak", [1]), > ("pgmassign", [2]), -- no output, takes a string > ("phaser1", [4, 5]), > ("phaser2", [7]), > ("phasor", [1, 2]), > ("phasorbnk", [3, 4]), > ("pinkish", [1..5]), > ("pitch", [5..13]), -- gives two outputs > ("pitchamdf", [3..8]), -- gives two outputs > ("planet", [10..12]), -- gives three outputs > ("pluck", [5..7]), > ("poisson", [1]), > ("polyaft", [1..3]), > ("port", [2, 3]), > ("portk", [2, 3]), > ("poscil", [3, 4]), > ("poscil3", [3, 4]), > ("pow", [2, 3]), > ("powoftwo", [1]), > ("prealloc", [2]), -- no output, takes a string > ("print", [1..]), -- no output > ("printk", [2, 3]), -- no output > ("printk2", [1, 2]), -- no output > ("printks", [2..]), -- no output > ("prints", [1..]), -- no output > ("product", [2..]), > ("pset", [1..]), -- no output > ("pvadd", [5..10]), -- takes a string > ("pvbufread", [2]), -- no output > ("pvcross", [5, 6]), -- takes a string > ("pvinterp", [9]), -- takes a string > ("pvoc", [3..7]), -- takes a string > ("pvread", [3]), -- takes a string, gives two outputs > -- lots of pvoc functions > ("rand", [1..4]), > ("randh", [2..5]), > ("randi", [2..5]), > ("random", [2]), > ("randomh", [3]), > ("randomi", [3]), > ("readclock", [1]), > ("readk", [3, 4]), -- takes a string > -- several readk functions > ("reinit", [1]), -- no output > ("release", [0]), > ("repluck", [6]), > ("reson", [3..5]), > ("resonk", [3..5]), > ("resonr", [3..5]), > ("resonx", [3..6]), > ("resonxk", [3, 6]), > ("resony", [5..8]), > ("resonz", [3..5]), > ("reverb", [2, 3]), > ("rezzy", [3, 5]), > ("rms", [1..3]), > ("rnd", [1]), > ("rnd31", [2, 3]), > ("rspline", [4]), > ("rtclock", [0]), > ("s16b14", [1, 7..]), -- gives 16 outputs > ("s32b14", [1, 7..]), -- gives 32 outputs > ("samphold", [2..4]), > ("sandpaper", [2..5]), > ("scanhammer", [4]), -- no output > ("scans", [4, 5]), > ("scantable", [7]), > ("scanu", [18]), -- no output > ("schedkwhen", [6..]), -- no output > ("schedkwhennamed", [6..]), -- no output, takes a string > ("schedule", [3..]), -- no output, takes a string > ("schedwhen", [4..]), -- no output, takes a string > ("seed", [1]), -- no output > ("sekere", [2..5]), > ("semitone", [1]), > ("sense", [0]), > ("sensekey", [0]), > ("seqtime", [5]), > ("setctrl", [3]), -- gui, no output > ("setksmps", [1]), -- no output > ("sfilist", [1]), -- no output > ("sfinstr", [6..8]), -- gives two outputs > ("sfinstr3", [6..8]), -- gives two outputs > ("sfinstr3m", [6..8]), > ("sfinstrm", [6..8]), > ("sfload", [1]), -- takes a string > ("sfpassign", [2]), -- no output > ("sfplay", [5..7]), -- gives two outputs > ("sfplay3", [5..7]), -- gives two outputs > ("sfplay3m", [5..7]), > ("sfplaym", [5..7]), > ("sfplist", [1]), -- no output > ("sfpreset", [4]), > ("shaker", [5, 6]), > ("sin", [1]), > ("sinh", [1]), > ("sininv", [1]), > ("sleighbells", [2..8]), > ("slider16", [1, 6..]), -- gives 16 outputs > -- lots of sliders with multiple (eg, 32) outputs > ("sndwarp", [10]), -- gives 1-2 outputs > ("sndwarpst", [10]), -- gives 2-4 outputs > ("soundin", [1..4]), -- gives multiple outputs, takes a string > ("soundout", [2, 3]), -- takes a string, no output > ("space", [6]), -- gives four outputs > ("spat3d", [9, 10]), -- gives four outputs > ("spat3di", [7, 8]), -- gives four outputs > ("spat3dt", [8, 9]), -- no output > ("spdist", [4]), > ("specaddm", [2, 3]), > ("specdiff", [1]), > ("specdisp", [2, 3]), -- no output > ("specfilt", [2]), > ("spechist", [1]), > ("specptrk", [8..13]), -- gives two outputs > ("specscap", [3]), > ("specsum", [1, 2]), > ("spectrum", [4..9]), > ("splitrig", [5..]), -- no output > ("spsend", [0]), -- gives four outputs > ("sqrt", [1]), > ("statevar", [3, 5]), -- gives four outputs > ("stix", [2..5]), > ("streson", [3]), > ("strset", [2]), -- no output, takes a string > ("subinstr", [1..]), -- gives 1-8 outputs, takes a string > ("subinstrinit", [1..]), -- no output, takes a string > ("sum", [1..]), > ("svfilter", [3, 4]), -- gives three outputs > ("syncgrain", [8]), > ("table", [2..5]), > ("table3", [2..5]), > ("tablecopy", [2]), -- no output > ("tablegpw", [1]), -- no output > ("tablei", [2..5]), > ("tableicopy", [2]), -- no output > ("tableigpw", [1]), -- no output > ("tableikt", [2..5]), > ("tableimix", [9]), -- no output > ("tableiw", [3..6]), -- no output > ("tablekt", [2..5]), > ("tablemix", [9]), -- no output > ("tableng", [1]), > ("tablera", [3]), > ("tableseg", [3, 5..]), -- no output > ("tablew", [3..6]), -- no output > ("tablewa", [3]), > ("tablewkt", [3..6]), -- no output > ("tablexkt", [4..7]), > ("tablexseg", [3, 5..]), -- no output > ("tambourine", [2..8]), > ("tan", [1]), > ("tanh", [1]), > ("taninv", [1]), > ("taninv2", [2]), > ("tbvcf", [5, 6]), > ("tempest", [10..12]), > ("tempo", [2]), -- no output > ("tempoval", [0]), > ("timeinstk", [0]), > ("timeinsts", [0]), > ("timek", [0]), > ("times", [0]), > ("tival", [0]), > ("tlineto", [3]), > ("tone", [2, 3]), > ("tonek", [2, 3]), > ("tonex", [2..4]), > ("transeg", [4, 7..]), > ("trigger", [3]), > ("trigseq", [6..]), -- no output > ("trirand", [1]), > ("turnoff", [0]), -- no output > ("turnon", [1, 2]), -- no output > ("unirand", [1]), > ("upsamp", [1]), > ("urd", [1]), > ("vadd", [3]), > ("valpass", [4..6]), > ("vbap16", [2..4]), -- gives 16 outputs > -- various vbap functions that give outputs =/= 1 > ("vco", [4..10]), > ("vco2", [2..6]), > ("vco2ft", [2, 3]), > ("vco2ift", [2, 3]), > ("vco2init", [1..6]), > ("vcomb", [4..6]), > ("vdelay", [3, 4]), > ("vdelay3", [3, 4]), > ("vdelayx", [4, 5]), > ("vdelayxq", [7, 8]), -- gives four outputs > ("vdelayxs", [5, 6]), -- gives two outputs > ("vdelayxw", [4, 5]), > ("vdelayxwq", [7, 8]), -- gives four outputs > ("vdelayxqs", [5, 6]), -- gives two outputs > ("veloc", [0..2]), > ("vexp", [3]), -- no output > ("vexpseg", [5, 7..]), -- no output > ("vibes", [9]), > ("vibr", [3]), > ("vibrato", [9, 10]), > ("vincr", [2]), -- no output > ("vlowres", [5]), > ("vlinseg", [5, 7..]), -- no output > ("vmult", [3]), -- no output > ("voice", [8]), > ("vpow", [3]), -- no output > -- several functions for reading and writing vectors > ("vpvoc", [3..5]), -- takes a string > ("waveset", [2, 3]), > ("weibull", [2]), > ("wgbow", [7, 8]), > ("wgbowedbar", [5..9]), > ("wgbrass", [7, 8]), > ("wgclar", [9, 10]), > ("wgflute", [9..12]), > ("wgpluck", [7]), > ("wgpluck2", [5]), > ("wguide1", [4]), > ("wguide2", [7]), > ("wrap", [3]), > ("wterrain", [8]), > ("xadsr", [4, 5]), > ("xin", [0]), -- gives multiple outputs > ("xout", [1..]), -- no output > ("xscanmap", [3, 4]), -- gives two outputs > ("xscansmap", [5, 6]), -- no output > ("xscans", [4, 5]), > ("xscanu", [18]), -- no output > ("xtratim", [1]), -- no output > ("xyin", [5..7]), -- gives two outputs > ("zacl", [2]), -- no output > ("zakinit", [2]), -- no output > ("zamod", [2]), > ("zar", [1]), > ("zarg", [2]), > ("zaw", [2]), -- no output > ("zawm", [2, 3]), -- no output > ("zfilter2", [5..]), > ("zir", [1]), > ("ziw", [2]), -- no output > ("ziwm", [2, 3]), -- no output > ("zkcl", [2]), -- no output > ("zkmod", [2]), > ("zkr", [1]), > ("zkw", [2]), -- no output > ("zkwm", [2, 3]) -- no output > ] haskore-0.2.0.3/src/Haskore/Interface/CSound/SoundMap.hs0000644000000000000000000001542011754016451021042 0ustar0000000000000000-- cf. SuperCollider.SoundMap -- this module shall replace InstrumentMap in the long term module Haskore.Interface.CSound.SoundMap where import qualified Haskore.Interface.CSound.Orchestra as Orchestra import Haskore.Interface.CSound.Orchestra (SigExp, noteDur, noteVel, notePit, pField, ) import Haskore.Interface.CSound (PField, Instrument, ) import Data.Maybe.HT (toMaybe, ) import Data.Maybe (mapMaybe, ) type SoundId = Instrument type InstrumentId = SoundId type DrumId = SoundId type Attribute = PField type AttributeList = [Attribute] type ToSound instr = instr -> (AttributeList, SoundId) attributeControl :: Int -> SigExp attributeControl n = pField (6+n) type InstrumentTable out instr = [(instr, InstrumentSigExp out)] type InstrumentTableWithAttributes out instr = [InstrumentAssociation out instr] type InstrumentSigExp out = SigExp -> SigExp -> SigExp -> out data InstrumentAssociation out instr = InstrumentAssociation InstrumentId (instr -> Maybe AttributeList) out lookupInstrument :: InstrumentTableWithAttributes out instr -> ToSound instr lookupInstrument table instr = case mapMaybe (\(InstrumentAssociation name toAttributes _) -> fmap (\ps -> (ps,name)) (toAttributes instr)) table of [] -> error "SuperCollider.InstrumentMap.lookup: instrument not found" [x] -> x _ -> error "SuperCollider.InstrumentMap.lookup: multiple instruments found" instrumentTableToInstrBlocks :: InstrumentTableWithAttributes out instr -> [Orchestra.InstrBlock out] instrumentTableToInstrBlocks = map (\(InstrumentAssociation i _ out) -> Orchestra.InstrBlock i 0 out []) addInstrumentControls :: InstrumentSigExp out -> out addInstrumentControls graph = graph noteDur noteVel notePit instrumentAssociation :: (parameterTuple -> AttributeList) -> (graph -> InstrumentSigExp out) -> InstrumentId -> (instr -> Maybe parameterTuple) -> graph -> InstrumentAssociation out instr instrumentAssociation makeAttributeList makeInstrumentSigExp name select graph = InstrumentAssociation name (fmap makeAttributeList . select) (addInstrumentControls $ makeInstrumentSigExp graph) instrument :: InstrumentId -> (instr -> Maybe ()) -> (InstrumentSigExp out) -> InstrumentAssociation out instr instrument = instrumentAssociation (\() -> []) id -- simplified variant of 'instrument' for comparable @instrument@ types instrumentEq :: Eq instrument => InstrumentId -> instrument -> (InstrumentSigExp out) -> InstrumentAssociation out instrument instrumentEq name instrumentId = instrument name (\x -> toMaybe (instrumentId==x) ()) instrument1 :: InstrumentId -> (instr -> Maybe Attribute) -> (SigExp -> InstrumentSigExp out) -> InstrumentAssociation out instr instrument1 = instrumentAssociation (\p0 -> [p0]) (\graph -> graph (attributeControl 0)) instrument2 :: InstrumentId -> (instr -> Maybe (Attribute, Attribute)) -> (SigExp -> SigExp -> InstrumentSigExp out) -> InstrumentAssociation out instr instrument2 = instrumentAssociation (\(p0,p1) -> [p0,p1]) (\graph -> graph (attributeControl 0) (attributeControl 1)) instrument3 :: InstrumentId -> (instr -> Maybe (Attribute, Attribute, Attribute)) -> (SigExp -> SigExp -> SigExp -> InstrumentSigExp out) -> InstrumentAssociation out instr instrument3 = instrumentAssociation (\(p0,p1,p2) -> [p0,p1,p2]) (\graph -> graph (attributeControl 0) (attributeControl 1) (attributeControl 2)) instrument4 :: InstrumentId -> (instr -> Maybe (Attribute, Attribute, Attribute, Attribute)) -> (SigExp -> SigExp -> SigExp -> SigExp -> InstrumentSigExp out) -> InstrumentAssociation out instr instrument4 = instrumentAssociation (\(p0,p1,p2,p3) -> [p0,p1,p2,p3]) (\graph -> graph (attributeControl 0) (attributeControl 1) (attributeControl 2) (attributeControl 3)) type DrumTable out drum = [(drum, DrumSigExp out)] type DrumTableWithAttributes out drum = [DrumAssociation out drum] type DrumSigExp out = SigExp -> SigExp -> out data DrumAssociation out drum = DrumAssociation DrumId (drum -> Maybe AttributeList) out lookupDrum :: DrumTableWithAttributes out drum -> ToSound drum lookupDrum table drumId = case mapMaybe (\(DrumAssociation name toAttributes _) -> fmap (\ps -> (ps,name)) (toAttributes drumId)) table of [] -> error "SuperCollider.InstrumentMap.lookup: drum not found" [x] -> x _ -> error "SuperCollider.InstrumentMap.lookup: multiple drums found" drumTableToInstrBlocks :: DrumTableWithAttributes out instr -> [Orchestra.InstrBlock out] drumTableToInstrBlocks = map (\(DrumAssociation i _ out) -> Orchestra.InstrBlock i 0 out []) addDrumControls :: DrumSigExp out -> out addDrumControls graph = graph noteDur noteVel drumAssociation :: (parameterTuple -> AttributeList) -> (graph -> DrumSigExp out) -> DrumId -> (drum -> Maybe parameterTuple) -> graph -> DrumAssociation out drum drumAssociation makeAttributeList makeDrumSigExp name select graph = DrumAssociation name (fmap makeAttributeList . select) (addDrumControls $ makeDrumSigExp graph) drum :: DrumId -> (drum -> Maybe ()) -> (DrumSigExp out) -> DrumAssociation out drum drum = drumAssociation (\() -> []) id -- simplified variant of 'drum' for comparable @drum@ types drumEq :: Eq drum => DrumId -> drum -> (DrumSigExp out) -> DrumAssociation out drum drumEq name drumId = drum name (\x -> toMaybe (drumId==x) ()) drum1 :: DrumId -> (drum -> Maybe Attribute) -> (SigExp -> DrumSigExp out) -> DrumAssociation out drum drum1 = drumAssociation (\p0 -> [p0]) (\graph -> graph (attributeControl 0)) drum2 :: DrumId -> (drum -> Maybe (Attribute, Attribute)) -> (SigExp -> SigExp -> DrumSigExp out) -> DrumAssociation out drum drum2 = drumAssociation (\(p0,p1) -> [p0,p1]) (\graph -> graph (attributeControl 0) (attributeControl 1)) drum3 :: DrumId -> (drum -> Maybe (Attribute, Attribute, Attribute)) -> (SigExp -> SigExp -> SigExp -> DrumSigExp out) -> DrumAssociation out drum drum3 = drumAssociation (\(p0,p1,p2) -> [p0,p1,p2]) (\graph -> graph (attributeControl 0) (attributeControl 1) (attributeControl 2)) drum4 :: DrumId -> (drum -> Maybe (Attribute, Attribute, Attribute, Attribute)) -> (SigExp -> SigExp -> SigExp -> SigExp -> DrumSigExp out) -> DrumAssociation out drum drum4 = drumAssociation (\(p0,p1,p2,p3) -> [p0,p1,p2,p3]) (\graph -> graph (attributeControl 0) (attributeControl 1) (attributeControl 2) (attributeControl 3)) haskore-0.2.0.3/src/Haskore/Interface/CSound/InstrumentMap.lhs0000644000000000000000000000342611754016451022301 0ustar0000000000000000\paragraph{Naming Instruments and Tables} In CSound, each table and instrument has a unique identifying integer associated with it. Haskore, on the other hand, uses strings to name instruments. What we need is a way to convert Haskore instrument names to identifier integers that CSound can use. Similar to Haskore's player maps, we define a notion of a \keyword{CSound name map} for this purpose. \begin{haskelllisting} > module Haskore.Interface.CSound.InstrumentMap where > > import Haskore.Interface.CSound (PField, Instrument, instruments) > > import qualified Data.List as List > type SoundTable instr = [(instr, Instrument)] \end{haskelllisting} A name map can be provided directly in the form \code{[("name1", int1), ("name2", int2), ...]}, or the programmer can define auxiliary functions to make map construction easier. For example: \begin{haskelllisting} > tableFromInstruments :: [instr] -> SoundTable instr > tableFromInstruments nms = zip nms $ instruments \end{haskelllisting} The following function will add a name to an existing name map. If the name is already in the map, an error results. \begin{haskelllisting} > addToTable :: (Eq instr) => > instr -> Instrument -> SoundTable instr -> SoundTable instr > addToTable nm i instrMap = > if elem nm (map fst instrMap) > then ((nm,i) : instrMap) > else (error ("CSound.addToTable: instrument already in the map")) \end{haskelllisting} Note the use of the function \function{lookup} imported from \module{List}. \begin{haskelllisting} > type ToSound instr = instr -> ([PField], Instrument) > lookup :: (Eq instr) => SoundTable instr -> ToSound instr > lookup table instr = > maybe (error "CSound.InstrMap.lookup: instrument not found") > ((,) []) > (List.lookup instr table) \end{haskelllisting} haskore-0.2.0.3/src/Haskore/Interface/MIDI/0000755000000000000000000000000011754016451016305 5ustar0000000000000000haskore-0.2.0.3/src/Haskore/Interface/MIDI/Write.lhs0000644000000000000000000004345111754016451020116 0ustar0000000000000000\subsection{Midi} \seclabel{midi} Midi (``musical instrument digital interface'') is a standard protocol adopted by most, if not all, manufacturers of electronic instruments. At its core is a protocol for communicating \keyword{musical events} (note on, note off, key press, etc.) as well as so-called \keyword{meta events} (select synthesizer patch, change volume, etc.). Beyond the logical protocol, the Midi standard also specifies electrical signal characteristics and cabling details. In addition, it specifies what is known as a \keyword{standard Midi file} which any Midi-compatible software package should be able to recognize. Over the years musicians and manufacturers decided that they also wanted a standard way to refer to {\em common} or {\em general} instruments such as ``acoustic grand piano'', ``electric piano'', ``violin'', and ``acoustic bass'', as well as more exotic ones such as ``chorus aahs'', ``voice oohs'', ``bird tweet'', and ``helicopter''. A simple standard known as \keyword{General Midi} was developed to fill this role. It is nothing more than an agreed-upon list of instrument names along with a \keyword{program patch number} for each, a parameter in the Midi standard that is used to select a Midi instrument's sound. Most ``sound-blaster''-like sound cards on conventional PC's know about Midi, as well as General 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 a different \keyword{channel}. Modern keyboards and tone generators are quite amazing little beasts. Not only is the sound quite good (when played on a good stereo system), but they are also usually \keyword{multi-timbral}, which means they are able to generate many different sounds simultaneously, as well as \keyword{polyphonic}, meaning that simultaneous instantiations of the same sound are possible. If you decide to use the General Midi features of your sound-card, you need to know about another set of conventions known as ``General Midi''. The most important aspect of General Midi is that Channel 10 (9 in Haskore's 0-based numbering) is dedicated to \keyword{percussion}. Haskore provides a way to specify a Midi channel number and General Midi instrument selection for each \code{Instr} in a Haskore 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 \code{MidiMusic.T} object in Haskore. In this section the top-level code needed by the user to invoke this functionality will be described, along with the gory details. \begin{haskelllisting} > module Haskore.Interface.MIDI.Write > (fromRhythmicPerformance, fromRhythmicPerformanceMixed, > fromGMPerformance, fromGMPerformanceMixed, > fromGMPerformanceAuto, fromGMPerformanceMixedAuto, > fromRhythmicMusic, fromRhythmicMusicMixed, > fromGMMusic, fromGMMusicAuto, > fromGMMusicMixed, fromGMMusicMixedAuto, > volumeHaskoreToMIDI, volumeMIDIToHaskore) > where > import qualified Sound.MIDI.File as MidiFile > import qualified Sound.MIDI.File.Event as MidiFileEvent > import qualified Sound.MIDI.File.Event.Meta as MetaEvent > import qualified Sound.MIDI.Message.Channel as ChannelMsg > import qualified Sound.MIDI.Message.Channel.Voice as Voice > import qualified Haskore.Interface.MIDI.InstrumentMap as InstrMap > import qualified Haskore.Interface.MIDI.Note as MidiNote > import qualified Haskore.Music.GeneralMIDI as MidiMusic > import qualified Haskore.Music.Rhythmic as RhyMusic > import qualified Haskore.Performance as Performance > import qualified Haskore.Performance.Context as Context > import qualified Haskore.Performance.BackEnd as PerformanceBE > import qualified Haskore.Performance.Fancy as FancyPf > import qualified Data.EventList.Relative.TimeBody as TimeList > import qualified Data.EventList.Relative.MixedBody as TimeList > import qualified Data.EventList.Relative.BodyBody as BodyBodyList > import qualified Haskore.Basic.Pitch as Pitch > import qualified Numeric.NonNegative.Class as NonNeg > import qualified Haskore.General.Map as Map > import Data.Ord.HT (limit, ) > import Data.Maybe (mapMaybe, ) > import Control.Monad.Trans.State (state, evalState, ) > import Control.Monad (liftM, ) \end{haskelllisting} Instead of converting a Haskore \code{Performance.T} directly into a Midi file, Haskore first converts it into a datatype that {\em represents} a Midi file, which is then written to a file in a separate pass. This separation of concerns makes the structure of the Midi file clearer, makes debugging easier, and provides a natural path for extending Haskore's functionality with direct Midi capability. Here is the basic structure of the modules and functions: \begin{center} \input{src/Doc/Pics/midi} \end{center} Given instrument and drum maps (\secref{user-patch-map}), a performance is converted to a datatype representing a Standard Midi File of type 0 (\code{Mixed} - one track containing data of all channels) or type 1 (\code{Parallel} - tracks played simultaneously) using the \function{from*PerformanceMixed} and \function{from*Performance} functions, respectively. The ``\code{Mixed}'' mode is the only one which can be used in principle for infinite music, since the number of tracks is stored explicitly in the MIDI file which depends on the number of instruments actually used in the song. Nevertheless such a stream can not be written to a pipe (not to speak of a physical disk), since the binary MIDI file format stores lengths of tracks. The functions with names of the form \function{fromRhythmicPerformance*} convert from generic rhythmic music performances using appropriate tables. In contrast to that, for General MIDI music the instrument and drum maps are fixed. There are the two variants \function{fromGMPerformance*}, which allows explicit assignment of instruments to channels, and \function{fromGMPerformance*Auto}, which assigns the channels automatically one by one. \begin{haskelllisting} > type Perf time dyn drum instr = > Performance.T time dyn (RhyMusic.Note drum instr) > type NotePerfToBE dyn drum instr = > dyn -> Pitch.Relative -> > RhyMusic.Note drum instr -> MidiNote.T > getInstrument :: > Performance.Event time dyn (RhyMusic.Note drum instr) -> Maybe instr > getInstrument = > RhyMusic.maybeInstrument . RhyMusic.body . Performance.eventNote > fromRhythmicPerformance :: > (NonNeg.C time, RealFrac time, RealFrac dyn, > Eq drum, Eq instr) => > InstrMap.ChannelProgramPitchTable drum -> > InstrMap.ChannelProgramTable instr -> > Perf time dyn drum instr -> MidiFile.T > fromRhythmicPerformance dMap iMap = > fromRhythmicPerformanceBase > (const (MidiNote.fromRhyNote > (InstrMap.lookup dMap) (InstrMap.lookup iMap))) > fromGMPerformance :: > (NonNeg.C time, RealFrac time, RealFrac dyn) => > (MidiMusic.Instrument -> ChannelMsg.Channel) -> > Performance.T time dyn MidiMusic.Note -> MidiFile.T > fromGMPerformance cMap = > fromRhythmicPerformanceBase > (const (MidiNote.fromGMNote cMap)) > fromGMPerformanceAuto :: > (NonNeg.C time, RealFrac time, RealFrac dyn) => > Performance.T time dyn MidiMusic.Note -> MidiFile.T > fromGMPerformanceAuto = > fromRhythmicPerformanceBase > (\instrs -> MidiNote.fromGMNote > (InstrMap.fromInstruments instrs)) > fromRhythmicPerformanceBase :: > (NonNeg.C time, RealFrac time, Eq instr) => > ([instr] -> NotePerfToBE dyn drum instr) -> > Perf time dyn drum instr -> MidiFile.T > fromRhythmicPerformanceBase makeNoteMap pf = > let splitList = TimeList.slice getInstrument pf > noteMap = makeNoteMap (mapMaybe fst splitList) > {- noteMap will always lookup instruments in a map > although the instrument will be the same for each track. -} > pfBEs = map (PerformanceBE.fromPerformance noteMap) > (map snd splitList) > in MidiFile.Cons MidiFile.Parallel (MidiFile.Ticks division) > (map trackFromPfBE pfBEs) > fromRhythmicPerformanceMixed :: > (NonNeg.C time, RealFrac time, RealFrac dyn, Eq drum, Eq instr) => > InstrMap.ChannelProgramPitchTable drum -> > InstrMap.ChannelProgramTable instr -> > Perf time dyn drum instr -> MidiFile.T > fromRhythmicPerformanceMixed dMap iMap = > fromRhythmicPerformanceMixedBase > (MidiNote.fromRhyNote > (InstrMap.lookup dMap) (InstrMap.lookup iMap)) > fromGMPerformanceMixed :: > (NonNeg.C time, RealFrac time, RealFrac dyn) => > (MidiMusic.Instrument -> ChannelMsg.Channel) -> > Performance.T time dyn MidiMusic.Note -> MidiFile.T > fromGMPerformanceMixed cMap = > fromRhythmicPerformanceMixedBase (MidiNote.fromGMNote cMap) > fromGMPerformanceMixedAuto :: > (NonNeg.C time, RealFrac time, RealFrac dyn) => > Performance.T time dyn MidiMusic.Note -> MidiFile.T > fromGMPerformanceMixedAuto pf = > let instrs = mapMaybe fst (TimeList.slice getInstrument pf) > cMap = InstrMap.fromInstruments instrs > in fromRhythmicPerformanceMixedBase > (MidiNote.fromGMNote cMap) pf > fromRhythmicPerformanceMixedBase :: > (NonNeg.C time, RealFrac time, RealFrac dyn, Eq instr) => > NotePerfToBE dyn drum instr -> > Perf time dyn drum instr -> MidiFile.T > fromRhythmicPerformanceMixedBase noteMap pf = > MidiFile.Cons MidiFile.Mixed (MidiFile.Ticks division) > [trackFromPfBE (PerformanceBE.fromPerformance noteMap pf)] \end{haskelllisting} The more comfortable function \function{fromRhythmicMusic} turns a \code{MidiMusic.T} immediately into a \code{MidiFile.T}. Thus it needs also a \code{Context} and drum and instrument table. The signature of \function{fromGMMusic} is chosen so that it can be used as an inverse to \function{ReadMidi.toGMMusic}. The function \function{fromGMMusicAuto} is similar but doesn't need a \code{InstrMap.ChannelTable} because it creates one from the set of instruments actually used in the \code{MidiMusic.T}. \begin{haskelllisting} > fromRhythmicMusic, fromRhythmicMusicMixed :: > (NonNeg.C time, RealFrac time, RealFrac dyn, > Ord drum, Ord instr) => > (InstrMap.ChannelProgramPitchTable drum, > InstrMap.ChannelProgramTable instr, > Context.T time dyn (RhyMusic.Note drum instr), > RhyMusic.T drum instr) -> MidiFile.T > fromGMMusic, fromGMMusicMixed :: > (NonNeg.C time, RealFrac time, RealFrac dyn) => > (InstrMap.ChannelTable MidiMusic.Instr, > Context.T time dyn MidiMusic.Note, MidiMusic.T) -> MidiFile.T > fromGMMusicAuto, fromGMMusicMixedAuto :: > (NonNeg.C time, RealFrac time, RealFrac dyn) => > (Context.T time dyn MidiMusic.Note, MidiMusic.T) -> MidiFile.T > fromRhythmicMusic (dm,im,c,m) = > fromRhythmicMusicBase (fromRhythmicPerformance dm im) c m > fromRhythmicMusicMixed (dm,im,c,m) = > fromRhythmicMusicBase (fromRhythmicPerformanceMixed dm im) c m > fromGMMusic (cm,c,m) = > fromRhythmicMusicBase (fromGMPerformance (InstrMap.lookup cm)) c m > fromGMMusicMixed (cm,c,m) = > fromRhythmicMusicBase (fromGMPerformanceMixed (InstrMap.lookup cm)) c m > fromGMMusicAuto (c,m) = > fromRhythmicMusicBase fromGMPerformanceAuto c m > fromGMMusicMixedAuto (c,m) = > fromRhythmicMusicBase fromGMPerformanceMixedAuto c m > fromRhythmicMusicBase :: > (NonNeg.C time, RealFrac time, Fractional dyn, Ord dyn, > Ord drum, Ord instr) => > (Perf time dyn drum instr -> MidiFile.T) -> > Context.T time dyn (RhyMusic.Note drum instr) -> > RhyMusic.T drum instr -> MidiFile.T > fromRhythmicMusicBase p c m = p (Performance.fromMusic FancyPf.map c m) \end{haskelllisting} General Midi specific definitions are imported from \module{GeneralMidi} (see \secref{general-midi}). The Midi file datatype itself is imported from the module \module{MidiFile}, functions for writing it to files are found in the module \module{SaveMidi}, and functions for reading MIDI files come from the modules \module{LoadMidi} and \module{ReadMidi}. All these modules are described later in this section. \subsubsection{The Gory Details} Some preliminaries, otherwise known as constants: \begin{haskelllisting} > division :: MidiFile.Tempo > division = 96 -- time-code division: 96 ticks per quarter note \end{haskelllisting} When writing Type 1 Midi Files, we can associate each instrument with a separate track. So first we partition the event list into separate lists for each instrument. (Again, due to the limited number of MIDI channels, we can handle no more than 15 instruments.) The crux of the conversion process is \function{trackFromPfBE}, which converts a \type{Performance.T} into a stream of \type{Midi.Event}s. As said before, we can't use absolute times, but the difficulties with relatively timed events are handled by the \module{Data.EventList.Relative.TimeBody}. We first convert all Performance events to MIDI events preserving the time stamps from the Performance. In the second step we discretize the time stamps with \function{Data.EventList.Relative.TimeBody.resample}, yielding a perfect \type{Midi.Track}. On the one hand with this order of execution it may be that notes with equal duration can have slightly different durations in the MIDI file. On the other hand small rests between notes or small overlappings are avoided.% \footnote{It would be better to define \code{rate = 4*division}, since this would map a quarter note to \code{division} ticks, as stated by the MIDI File specification. For compensation \code{SetTempo} could be set to 250000, meaning a quarter second per quarter note, or one second per whole note.} We manage a \module{Map} which stores the active program number of each MIDI channel. If a note on a channel needs a new program or there was no note before, a \code{ProgChange} is inserted in the stream of MIDI events. The function \function{updateChannelMap} updates this map each time a note occurs and it returns the MIDI channel for the note and a \code{Maybe} that contains a program change if necessary. \begin{haskelllisting} > trackFromPfBE :: (NonNeg.C time, RealFrac time) => > PerformanceBE.T time MidiNote.T -> MidiFile.Track > trackFromPfBE = > uncurry TimeList.cons setTempo . > TimeList.mapBody MidiFileEvent.MIDIEvent . > TimeList.resample rate . > TimeList.foldr TimeList.consTime addEvent TimeList.empty . > progChanges > > setTempo :: (MidiFile.ElapsedTime, MidiFileEvent.T) > setTempo = > (0, MidiFileEvent.MetaEvent > (MetaEvent.SetTempo MetaEvent.defltTempo)) > > getChanProg :: MidiNote.T -> (ChannelMsg.Channel, Voice.Program) > getChanProg note = (MidiNote.channel note, MidiNote.program note) > > updateChannelMap :: > (ChannelMsg.Channel, Voice.Program) -> > Map.Map ChannelMsg.Channel Voice.Program -> > (Maybe ChannelMsg.T, > Map.Map ChannelMsg.Channel Voice.Program) > updateChannelMap (midiChan, progNum) cm = > if Just progNum == Map.lookup cm midiChan > then (Nothing, cm) > else (Just (ChannelMsg.Cons midiChan (ChannelMsg.Voice > (Voice.ProgramChange progNum))), > Map.insert midiChan progNum cm) > > progChanges :: > PerformanceBE.T time MidiNote.T > -> PerformanceBE.T time (MidiNote.T, Maybe ChannelMsg.T) > progChanges = > flip evalState Map.empty . > TimeList.mapBodyM > (\(PerformanceBE.Event dur note) -> > liftM (\mn -> PerformanceBE.Event dur (note, mn)) > (state (updateChannelMap (getChanProg note)))) > > rate :: (Num a) => a > rate = 2 * fromIntegral division > -- ^ would be correctly 4 and the setTempo should be 250000 \end{haskelllisting} A source of incompatibility between Haskore and Midi is that Haskore represents notes with an onset and a duration, while Midi represents them as two separate events, an note-on event and a note-off event. Thus \function{addEvent} turns a Haskore \type{Event} into two \type{ChannelMsg.T}s, a \code{NoteOn} and a \code{NoteOff}. The function \function{TimeList.insert} is used to insert a \code{NoteOff} into the sequence of following MIDI events. It looks a bit cumbersome to insert every single \code{NoteOff}. An alternative may be to \function{merge} the list of \code{NoteOn} events with the list of \code{NoteOff} events. This won't work because the second one isn't ordered. Instead one could merge the two-element lists defined by \code{NoteOn} and \code{NoteOff} for each note using \function{fold}. But there might be infinitely many notes \dots \begin{haskelllisting} > addEvent :: > (NonNeg.C time) => > PerformanceBE.Event time > (MidiNote.T, Maybe ChannelMsg.T) -> > TimeList.T time ChannelMsg.T -> > BodyBodyList.T time ChannelMsg.T > addEvent ev mevs = > let (note, progChange) > = PerformanceBE.eventNote ev > d = PerformanceBE.eventDur ev > (mec0, mec1) = MidiNote.toMIDIEvents note > in maybe (TimeList.consBody mec0) > (\pcME -> > TimeList.consBody pcME . > TimeList.cons NonNeg.zero mec0) > progChange > (TimeList.insert d mec1 mevs) \end{haskelllisting} % *** The MIDI volume handling is still missing. One cannot express the Volume in terms of the velocity! Thus we need some new event constructor for changed controller values. % *** \begin{haskelllisting} > volumeHaskoreToMIDI :: (RealFrac a, Floating a) => a -> Int > volumeHaskoreToMIDI v = round (limit (0,127) (64 + 16 * logBase 2 v)) > volumeMIDIToHaskore :: Floating a => Int -> a > volumeMIDIToHaskore v = 2 ** ((fromIntegral v - 64) / 16) \end{haskelllisting} haskore-0.2.0.3/src/Haskore/Interface/MIDI/Render.lhs0000644000000000000000000001225211754016451020236 0ustar0000000000000000\subsection{Convenient Functions for Getting Started With Haskore and MIDI} \seclabel{test-functions} {\small \begin{haskelllisting} > module Haskore.Interface.MIDI.Render where > import qualified Haskore.Interface.MIDI.Write as WriteMidi > import qualified Haskore.Interface.MIDI.InstrumentMap as InstrMap > import qualified Sound.MIDI.General as GeneralMidi > import qualified Sound.MIDI.File.Save as SaveMidi > import qualified Sound.MIDI.File as MidiFile > import qualified Sound.MIDI.Message.Channel as ChannelMsg > import qualified Haskore.Music.GeneralMIDI as MidiMusic > import qualified Haskore.Music.Rhythmic as RhyMusic > import qualified Haskore.Music as Music > import qualified Haskore.Melody as Melody > import qualified Haskore.Performance.Context as Context > import qualified Haskore.Performance.Fancy as FancyPerformance > import qualified Numeric.NonNegative.Class as NonNeg > import qualified Numeric.NonNegative.Wrapper as NonNegW > import System.Cmd (rawSystem, ) > import System.Exit (ExitCode, ) \end{haskelllisting} } Given a \code{Player.Map}, \code{Context.T}, \code{InstrMap.T}, and file name, we can write a \code{MidiMusic.T} value into a midi file: {\small \begin{haskelllisting} > fileFromRhythmicMusic :: > (Ord instr, Ord drum, NonNeg.C time, RealFrac time, RealFrac dyn) => > FilePath -> > (InstrMap.ChannelProgramPitchTable drum, > InstrMap.ChannelProgramTable instr, > Context.T time dyn (RhyMusic.Note drum instr), > RhyMusic.T drum instr) -> IO () > fileFromRhythmicMusic fn m = > SaveMidi.toFile fn (WriteMidi.fromRhythmicMusic m) \end{haskelllisting} } \subsubsection{Test routines} Using the defaults above, from a \code{MidiMusic.T} object, we can: \begin{enumerate} \item generate a \code{Performance.T} using \code{Haskore.Performance.Default.fancyFromMusic} \item generate a \code{MidiFile.T} data structure {\small \begin{haskelllisting} > midi :: MidiMusic.T -> MidiFile.T > midi = > WriteMidi.fromRhythmicPerformance [] InstrMap.defltGM . > FancyPerformance.floatFromMusic > generalMidi :: MidiMusic.T -> MidiFile.T > generalMidi = > WriteMidi.fromGMPerformanceAuto . > FancyPerformance.floatFromMusic > generalMidiDeflt :: MidiMusic.T -> MidiFile.T > generalMidiDeflt = > WriteMidi.fromGMPerformance (InstrMap.lookup InstrMap.defltCMap) . > FancyPerformance.floatFromMusic > mixedMidi :: MidiMusic.T -> MidiFile.T > mixedMidi = > WriteMidi.fromRhythmicPerformanceMixed [] InstrMap.defltGM . > FancyPerformance.floatFromMusic > mixedGeneralMidi :: MidiMusic.T -> MidiFile.T > mixedGeneralMidi = > WriteMidi.fromGMPerformanceMixedAuto . > FancyPerformance.floatFromMusic \end{haskelllisting} } \item generate a MIDI file {\small \begin{haskelllisting} > fileFromGeneralMIDIMusic :: FilePath -> MidiMusic.T -> IO () > fileFromGeneralMIDIMusic filename = SaveMidi.toFile filename . generalMidi \end{haskelllisting} } \item generate and play a MIDI file on Windows 95, Windows NT, or Linux {\small \begin{haskelllisting} > fileName :: FilePath > fileName = "test.mid" > play :: String -> [String] -> MidiMusic.T -> IO ExitCode > play cmd opts m = > do fileFromGeneralMIDIMusic fileName m > rawSystem cmd (opts ++ [fileName]) > > playWin95, playWinNT, > playLinux, playAlsa, playTimidity, playTimidityJack :: MidiMusic.T -> IO ExitCode > playWin95 = play "mplayer" [] > playWinNT = play "mplay32" [] > playLinux = play "playmidi" ["-rf"] > playAlsa = play "pmidi" ["-p 128:0"] > playTimidity = play "timidity" ["-B8,9"] > playTimidityJack = play "timidity" ["-Oj"] \end{haskelllisting} } \end{enumerate} Alternatively, just run \code{fileFromGeneralMIDIMusic "test.mid" m} manually, and then invoke the midi player on your system using \code{playTest}, defined below for NT: {\small \begin{haskelllisting} > playTest :: IO ExitCode > playTest = > rawSystem "mplay32" [fileName] \end{haskelllisting} } \subsubsection{Some General Midi test functions} Use these functions 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. {\small \begin{haskelllisting} > gmUpm :: InstrMap.ChannelProgramTable MidiMusic.Instr > gmUpm = > zipWith > (\instr chan -> > (instr, (chan, GeneralMidi.instrumentToProgram instr))) > GeneralMidi.instruments > (cycle $ map ChannelMsg.toChannel [0..15]) \end{haskelllisting} } Something to play each "instrument group" of 8 GM instruments; this function will play a C major arpeggio on each instrument. {\small \begin{haskelllisting} > gmTest :: Int -> IO () > gmTest i = > let gMM = take 8 (drop (i*8) GeneralMidi.instruments) > mu = Music.line (map simple gMM) > simple instr = MidiMusic.fromMelodyNullAttr instr Melody.cMajArp > in fileFromRhythmicMusic fileName > ([], gmUpm, FancyPerformance.context :: > Context.T NonNegW.Float Float MidiMusic.Note, mu) \end{haskelllisting} } haskore-0.2.0.3/src/Haskore/Interface/MIDI/Note.lhs0000644000000000000000000001323711754016451017730 0ustar0000000000000000 A MIDI note is an interim data structure which shall be stored in a \type{Performance.BackEnd.T} list of events. It stores each note as a single record, that is it is not split into note-on and note-off. \begin{haskelllisting} > module Haskore.Interface.MIDI.Note where > import qualified Haskore.Interface.MIDI.InstrumentMap as InstrMap > import qualified Sound.MIDI.General as GeneralMidi > import qualified Sound.MIDI.Message.Channel as ChannelMsg > import qualified Sound.MIDI.Message.Channel.Voice as Voice > import qualified Haskore.Music.GeneralMIDI as MidiMusic > import qualified Haskore.Music.Rhythmic as RhyMusic > import qualified Haskore.Basic.Pitch as Pitch > import Data.Ord.HT (limit, ) > import Data.Maybe.HT (toMaybe, ) > data T = > Cons { > velocityOn :: ChannelMsg.Velocity, > velocityOff :: ChannelMsg.Velocity, > channel :: ChannelMsg.Channel, > program :: ChannelMsg.Program, > pitch :: ChannelMsg.Pitch > } \end{haskelllisting} You can convert a MidiNote from and to a pair of MIDI events. This is used in \module{MIDI.Read} and \module{MIDI.Write}, respectively. \begin{haskelllisting} > fromMIDIEvents :: (ChannelMsg.T, ChannelMsg.T) -> Maybe T > fromMIDIEvents > (ChannelMsg.Cons c0 (ChannelMsg.Voice (Voice.NoteOn p0 v0)), > ChannelMsg.Cons c1 (ChannelMsg.Voice (Voice.NoteOff p1 v1))) = > let progErr = error ("program depends on channel settings - " ++ > "still not determined") > in toMaybe (c0 == c1 && p0 == p1) > (Cons v0 v1 c0 progErr p0) > fromMIDIEvents _ = Nothing > toMIDIEvents :: T -> (ChannelMsg.T, ChannelMsg.T) > toMIDIEvents note = > let chan = channel note > p = pitch note > vOn = velocityOn note > vOff = velocityOff note > me0 = ChannelMsg.Cons chan (ChannelMsg.Voice (Voice.NoteOn p vOn)) > me1 = ChannelMsg.Cons chan (ChannelMsg.Voice (Voice.NoteOff p vOff)) > in (me0, me1) \end{haskelllisting} A MidiNote can be constructed from several kinds of notes. Here are two instances for notes of generic rhythmic music and General MIDI notes. These converters are also the functions where the maps from instrument types to MIDI programs go into. The first set of functions is need for writing MIDI files. \begin{haskelllisting} > fromRhyNote :: RealFrac dyn => > InstrMap.ToChannelProgramPitch drum -> > InstrMap.ToChannelProgram instr -> > dyn -> Pitch.Relative -> RhyMusic.Note drum instr -> T > fromRhyNote dMap iMap dyn trans (RhyMusic.Note vel body) = > let velMidi = velocityFromStd dyn vel > in case body of > RhyMusic.Tone instr p -> > let (chan, prog) = iMap instr > in Cons velMidi velMidi > chan prog (pitchFromStd trans p) > RhyMusic.Drum drum -> > let (chan, prog, key) = dMap drum > in Cons velMidi velMidi chan prog key > fromGMNote :: RealFrac dyn => > InstrMap.ToChannel MidiMusic.Instr -> > dyn -> Pitch.Relative -> MidiMusic.Note -> T > fromGMNote iMap = > fromRhyNote > (\drum -> (GeneralMidi.drumChannel, > GeneralMidi.drumProgram, > GeneralMidi.drumToKey drum)) > (\instr -> (iMap instr, Voice.toProgram (fromEnum instr))) > velocityFromStd :: RealFrac dyn => > dyn -> Rational -> Voice.Velocity > velocityFromStd dyn vel = > Voice.toVelocity $ > round (limit (0, fromIntegral (Voice.fromVelocity Voice.maximumVelocity)) > (dyn * fromRational vel * > fromIntegral (Voice.fromVelocity Voice.normalVelocity))) > pitchFromStd :: Pitch.Relative -> Pitch.T -> Voice.Pitch > pitchFromStd trans p = > -- MIDI pitch is in range because of range checks on Pitch construction > Voice.increasePitch (Pitch.toInt p + trans) Voice.zeroKey \end{haskelllisting} The second set of functions is need for reading MIDI files. \begin{haskelllisting} > toRhyNote :: > InstrMap.FromChannelProgramPitch drum -> > InstrMap.FromChannelProgram instr -> > T -> RhyMusic.Note drum instr > toRhyNote dMap iMap (Cons v _ ch prog mp) = > let drum = dMap (ch, prog, mp) > instr = iMap (ch, prog) > in RhyMusic.Note (velocityToStd v) > (case (drum,instr) of > (Nothing, Nothing) -> > error "MidiNote.toRhyNote: channel+program not found" > (Just _, Just _) -> > error "MidiNote.toRhyNote: note can be drum or instrument" > (Just drum', Nothing) -> > RhyMusic.Drum drum' > (Nothing, Just instr') -> > RhyMusic.Tone instr' (pitchToStd mp)) > toGMNote :: T -> MidiMusic.Note > toGMNote = > toRhyNote > (\(ch, _, mp) -> > toMaybe (ch==GeneralMidi.drumChannel) > (GeneralMidi.drumFromKey mp)) > (\(ch, prog) -> > toMaybe (ch/=GeneralMidi.drumChannel) > (GeneralMidi.instrumentFromProgram prog)) \end{haskelllisting} Load the velocity. This shouldn't be mixed up with the volume. The volume which is controlled by the MIDI Volume controller simply scales the signal whereas the velocity is an instrument specific value that corresponds to the intensity with which the instrument is played. \begin{haskelllisting} > velocityToStd :: Fractional a => Voice.Velocity -> a > velocityToStd x = > fromIntegral (Voice.fromVelocity x) / > fromIntegral (Voice.fromVelocity Voice.normalVelocity) > pitchToStd :: Voice.Pitch -> Pitch.T > pitchToStd p = Pitch.fromInt (Voice.subtractPitch Voice.zeroKey p) \end{haskelllisting} haskore-0.2.0.3/src/Haskore/Interface/MIDI/Read.lhs0000644000000000000000000003660411754016451017701 0ustar0000000000000000\subsubsection{Reading Midi files} \seclabel{Haskore.Interface.MIDI.Read} Now that we have translated a raw Midi file into a \code{MidiFile.T} data type, we can translate that \code{MidiFile.T} into a \code{MidiMusic.T} object. \begin{haskelllisting} > module Haskore.Interface.MIDI.Read (toRhyMusic, toGMMusic, > {- debugging -} retrieveTracks) > where > > import qualified Haskore.Interface.MIDI.Note as MidiNote > import qualified Haskore.Interface.MIDI.InstrumentMap as InstrMap > import Sound.MIDI.File as MidiFile > import qualified Sound.MIDI.File.Event as MidiFileEvent > import qualified Sound.MIDI.Message.Channel as ChannelMsg > import qualified Sound.MIDI.Message.Channel.Voice as Voice > import qualified Sound.MIDI.General as GeneralMidi > import Sound.MIDI.File.Event (T(MIDIEvent, MetaEvent), ) > import Sound.MIDI.File.Event.Meta (T(SetTempo), defltTempo, ) > import Sound.MIDI.Message.Channel (Body(Voice), Channel, ) > import Sound.MIDI.Message.Channel.Voice (Program, ) > > import Haskore.Basic.Duration ((%+)) > import qualified Data.EventList.Relative.TimeBody as TimeList > import qualified Data.EventList.Relative.MixedBody as TimeList > import qualified Haskore.Music as Music > import qualified Haskore.Music.GeneralMIDI as MidiMusic > import qualified Haskore.Music.Rhythmic as RhyMusic > import qualified Haskore.Performance.Context as Context > import qualified Haskore.Performance.BackEnd as PfBE > import qualified Haskore.Performance.Default as DefltPf > import qualified Haskore.Process.Optimization as Optimization > import qualified Numeric.NonNegative.Class as NonNeg > import Haskore.Music > (line, chord, changeTempo, Dur, DurRatio) > import Data.Tuple.HT (mapPair, mapSnd, ) > import qualified Data.List.HT as ListHT > > import Haskore.General.Map (Map) > import qualified Haskore.General.Map as Map > import Data.Maybe (mapMaybe, fromMaybe) \end{haskelllisting} The main function. Note that we need drum and instrument maps in order to restore a \code{Context.T} as well as a \code{RhyMusic.T} object. \begin{haskelllisting} > toRhyMusic :: > (NonNeg.C time, Fractional time, Real time, Fractional dyn) => > InstrMap.ChannelProgramPitchTable drum -> > InstrMap.ChannelProgramTable instr -> > MidiFile.T -> > (Context.T time dyn (RhyMusic.Note drum instr), RhyMusic.T drum instr) > toRhyMusic dMap iMap mf@(MidiFile.Cons _ d trks) = > let cpm = makeCPM trks > m = Music.mapNote > (MidiNote.toRhyNote > (InstrMap.reverseLookupMaybe dMap) > (InstrMap.reverseLookupMaybe iMap)) > (format (readFullTrack d cpm) (MidiFile.explicitNoteOff mf)) > in (context, m) > toGMMusic :: > (NonNeg.C time, Fractional time, Real time, Fractional dyn) => > MidiFile.T -> (InstrMap.ChannelTable MidiMusic.Instr, > Context.T time dyn MidiMusic.Note, MidiMusic.T) > toGMMusic mf@(MidiFile.Cons _ d trks) = > let cpm = makeCPM trks > upm = map (\(ch, progNum) -> > (GeneralMidi.instrumentFromProgram progNum, ch)) > (Map.toList cpm) > m = Music.mapNote MidiNote.toGMNote > (format (readFullTrack d cpm) > (MidiFile.explicitNoteOff mf)) > in (upm, context, m) > context :: > (NonNeg.C time, Fractional time, Real time, Fractional dyn) => > Context.T time dyn note > context = > Context.setPlayer DefltPf.player $ > Context.setDur 2 $ > DefltPf.context > retrieveTracks :: MidiFile.T -> [[MidiMusic.T]] > retrieveTracks (MidiFile.Cons _ d trks) = > let cpm = makeCPM trks > in map (map (Music.mapNote MidiNote.toGMNote > . readTrack (MidiFile.ticksPerQuarterNote d) cpm . fst) > . prepareTrack) trks > type ChannelProgramMap = Map ChannelMsg.Channel Voice.Program > readFullTrack :: > Division -> ChannelProgramMap -> Track -> Music.T MidiNote.T > readFullTrack dv cpm = > let readTempoTrack (t,r) = > changeTempo r (readTrack (MidiFile.ticksPerQuarterNote dv) cpm t) > in Optimization.all . line . map readTempoTrack . prepareTrack > prepareTrack :: Track -> [(RichTrack, DurRatio)] > prepareTrack = > map (extractTempo defltTempo) . segmentBeforeSetTempo . > mergeNotes defltTempo . moveTempoToHead \end{haskelllisting} Make one big music out of the individual tracks of a MidiFile, using different composition types depending on the format of the MidiFile. \begin{haskelllisting} > format :: (Track -> Music.T note) -> MidiFile.T -> Music.T note > format tm (MidiFile.Cons typ _ trks) = > let trks' = map tm trks > in case typ of > MidiFile.Mixed -> > case trks' of > [trk] -> trk > _ -> error ("toRhyMusic: Only one track allowed for MIDI file type 0.") > MidiFile.Parallel -> chord trks' > MidiFile.Serial -> line trks' \end{haskelllisting} Look for Program Changes in the given tracks, in order to make a \code{ChannelProgramMap}. \begin{haskelllisting} > makeCPM :: [Track] -> ChannelProgramMap > makeCPM = > Map.fromList . concatMap (mapMaybe getPC . TimeList.getBodies) > > getPC :: MidiFileEvent.T -> Maybe (Channel, Program) > getPC ev = > do (ch, Voice.ProgramChange num) <- MidiFileEvent.maybeVoice ev > Just (ch, num) \end{haskelllisting} \code{moveTempoToHead} gets the information that occurs at the beginning of the piece: the default tempo and the default key signature. A \code{SetTempo} in the middle of the piece should translate to a tempo change (\code{Tempo r m}), but a \code{SetTempo} at time 0 should set the default tempo for the entire piece, by translating to \code{Context.T} tempo. It remains a matter of taste which tempo of several parallel tracks to use for the whole music. \code{moveTempoToHead} takes care of all events that occur at time 0 so that if any \code{SetTempo} appears at time 0, it is moved to the front of the list, so that it can be easily retrieved from the result of \code{segmentBeforeSetTempo}. \begin{haskelllisting} > moveTempoToHead :: Track -> Track > moveTempoToHead es = > let (tempo, track) = getHeadTempo es > in TimeList.cons 0 (MetaEvent (SetTempo tempo)) track > getHeadTempo :: Track -> (Tempo, Track) > getHeadTempo es = > maybe > (defltTempo, es) > (\ ~(me,rest) -> > case me of > MetaEvent (SetTempo tempo) -> (tempo, rest) > _ -> mapSnd (TimeList.cons 0 me) (getHeadTempo rest)) > (do ((0,me),rest) <- TimeList.viewL es > return (me,rest)) \end{haskelllisting} Manages the tempo changes in the piece. It translates each MidiFile \code{SetTempo} into a ratio between the new tempo and the tempo at the beginning. \begin{haskelllisting} > extractTempo :: Tempo -> RichTrack -> (RichTrack, DurRatio) > extractTempo d trk = > fromMaybe > (trk, 1) > (do ((_, Event (MetaEvent (SetTempo tempo))), rest) <- TimeList.viewL trk > return (rest, toInteger d %+ toInteger tempo)) \end{haskelllisting} \code{segmentBefore} is used to split a track into sub-tracks by tempo. We do not want to add this function to the \code{event-list} package, because the precise type would be \type{AlternatingList.Disparate (TimeList.T time body) (TimeList.Event time body)} and that's inconvenient for our application. \begin{haskelllisting} > segmentBefore :: > (body -> Bool) -> TimeList.T time body -> [TimeList.T time body] > segmentBefore p = > map TimeList.fromPairList . > ListHT.segmentBefore (p . snd) . > TimeList.toPairList \end{haskelllisting} \begin{haskelllisting} > isSetTempo :: RichEvent -> Bool > isSetTempo (Event (MetaEvent (SetTempo _))) = True > isSetTempo _ = False > segmentBeforeSetTempo :: RichTrack -> [RichTrack] > segmentBeforeSetTempo = segmentBefore isSetTempo \end{haskelllisting} \code{readTrack} is the heart of the \code{toRhyMusic} operation. It reads a track that has been processed by \code{mergeNotes}, and returns the track as \code{StdMusic.T}. A \code{RichEvent} consists either of a normal \code{MIDIEvent} or of a note, which in contrast to normal \code{MIDIEvent}s contains the information of corresponding \code{NoteOn} and \code{NoteOff} events. \begin{haskelllisting} > type RichTrack = TimeList.T ElapsedTime RichEvent > data RichEvent = > Event MidiFileEvent.T > | Note ElapsedTime MidiNote.T > readTrack :: Tempo -> ChannelProgramMap -> > RichTrack -> Music.T MidiNote.T > readTrack ticksPerQN cpm = > PfBE.toMusic . trackTimeToStd ticksPerQN > . richTrackToBE . applyProgChanges cpm \end{haskelllisting} Take the division in ticks per quarterNote and a duration value in number of ticks and converts that to a common note duration (such as quarter note, eighth note, etc.). \begin{haskelllisting} > fromTicks :: Tempo -> ElapsedTime -> Dur > fromTicks ticksPerQN d = > toInteger d %+ (toInteger ticksPerQN * quarter) > quarter :: Integer > quarter = 4 > trackTimeToStd :: Tempo -> > PfBE.T ElapsedTime note -> PfBE.T Dur note > trackTimeToStd ticksPerQN = > TimeList.mapBody > (\(PfBE.Event d n) -> PfBE.Event (fromTicks ticksPerQN d) n) > . TimeList.mapTime (fromTicks ticksPerQN) \end{haskelllisting} Look up an instrument name from a \code{ChannelProgramMap} given its channel number. \begin{haskelllisting} > lookupChannelProg :: ChannelProgramMap -> Channel -> Program > lookupChannelProg cpm = > Map.findWithDefault cpm > (error "Invalid channel in user patch map") \end{haskelllisting} Implement a \keyword{Program Change}: a change in the \code{ChannelProgramMap} in which a channel changes from one instrument to another. \begin{haskelllisting} > progChange :: Channel -> Program -> ChannelProgramMap -> ChannelProgramMap > progChange = Map.insert > -- progChange ch num cpm = Map.insert ch num cpm \end{haskelllisting} Process all \code{ProgramChange} events in a track. That is, manage a patch map and insert in the appropriate program numbers into the \type{MidiNote.T}s. The function works the following way: Split the track into pieces, each beginning with a program change. Compute the patch maps that are active after each program change. Apply these patch maps to the track parts. \begin{haskelllisting} > isProgChange :: RichEvent -> Bool > isProgChange (Event ev) = > maybe False (const True) (getPC ev) > isProgChange _ = False > applyProgChanges :: ChannelProgramMap -> RichTrack -> RichTrack > applyProgChanges cpm track = > let parts@(_:pcParts) = segmentBefore isProgChange track > {- > updateCPM (Event (MIDIEvent ch (ProgramChange prog))) = > progChange ch prog > updateCPM _ = error "TimeList.collectCoincident is buggy" > -} > updateCPM = > TimeList.switchL > (error "TimeList.collectCoincident is buggy") > (\ (_, Event ev) _ -> > maybe > (error "after segmentation, each part should start with ProgramChange event") > (uncurry progChange) > (getPC ev)) > cpms = > scanl (flip id) cpm (map updateCPM pcParts) > setProg localCPM (Note d n) = > Note d (n{MidiNote.program = > lookupChannelProg localCPM (MidiNote.channel n)}) > setProg _ e = e > in TimeList.concat (zipWith (TimeList.mapBody . setProg) cpms parts) \end{haskelllisting} Remove meta events from \type{RichTrack}, thus converting to a back-end performance. \begin{haskelllisting} > richNoteToBE :: RichEvent -> PfBE.Event ElapsedTime MidiNote.T > richNoteToBE (Note d n) = PfBE.Event d n > richNoteToBE _ = error "richNoteToBE: only Note constructor allowed" > isRichNote :: RichEvent -> Bool > isRichNote (Note _ _) = True > isRichNote _ = False > richTrackToBE :: RichTrack -> PfBE.T ElapsedTime MidiNote.T > richTrackToBE = > TimeList.mapBody richNoteToBE . fst > . TimeList.partition isRichNote \end{haskelllisting} The \code{mergeNotes} function changes the order of the events in a track so that they can be handled by readTrack: each \code{NoteOff} is put directly after its corresponding \code{NoteOn}. Its first and second arguments are the elapsed time and value (in microseconds per quarter note) of the \code{SetTempo} currently in effect. \begin{haskelllisting} > mergeNotes :: Tempo -> Track -> RichTrack > mergeNotes stv = > TimeList.mapTimeTail > (TimeList.switchBodyL $ \ e rest -> > uncurry TimeList.consBody $ > let deflt = (Event e, mergeNotes stv rest) > in case e of > MetaEvent (SetTempo newStv) -> > (Event e, mergeNotes newStv rest) > MIDIEvent chmsg@(ChannelMsg.Cons _ (Voice msg)) -> > if Voice.isNoteOn msg > then mapPair > (uncurry Note, mergeNotes stv) > (searchNoteOff 0 stv 1 chmsg rest) > else > if Voice.isNoteOff msg > then error "NoteOff before NoteOn" > else deflt > _ -> deflt) \end{haskelllisting} The function \code{searchNoteOff} takes a track and looks through the list of events to find the \code{NoteOff} corresponding to the given \code{NoteOn}. A \code{NoteOff} corresponds to an earlier \code{NoteOn} if it is the first in the track to have the same channel and pitch. If between \code{NoteOn} and \code{NoteOff} are \code{SetTempo} events, it calculates what the elapsed-time is, expressed in the current tempo. This function takes a ridiculous number of arguments, I know, but I don't think it can do without any of the information. Maybe there is a simpler way. \begin{haskelllisting} > searchNoteOff :: > Double {- ^ time interval between NoteOn and now, > in terms of the tempo at the NoteOn -} > -> Tempo -> Double {- ^ SetTempo values: the one at the NoteOn and > the ratio between the current tempo and the first one. -} > -> ChannelMsg.T {- ^ channel and pitch of NoteOn (NoteOff must match) -} > -> Track {- ^ the track to be searched -} > -> ((ElapsedTime, MidiNote.T), Track) > -- ^ the needed event and the remainder of the track > > searchNoteOff int ost str chm0 = > TimeList.switchL > (error "ReadMidi.searchNoteOff: no corresponding NoteOff") > (\(t1, mev1) es -> > maybe > -- if MIDI events don't match, then recourse > (mapSnd (TimeList.cons t1 mev1) $ > searchNoteOff (addInterval str t1 int) ost > (case mev1 of > -- respect tempo changes > MetaEvent (SetTempo nst) -> > fromIntegral ost / fromIntegral nst > _ -> str) > chm0 es) > -- if MIDI events match, construct a MidiNote.T > (\note -> > let d = round (addInterval str t1 int) > in ((d, note), TimeList.delay t1 es)) > -- check whether NoteOn and NoteOff matches > (do chm1 <- MidiFileEvent.maybeMIDIEvent mev1 > MidiNote.fromMIDIEvents (chm0, chm1))) > addInterval :: Double -> ElapsedTime -> Double -> Double > addInterval str t int = int + fromIntegral t * str \end{haskelllisting} haskore-0.2.0.3/src/Haskore/Interface/MIDI/InstrumentMap.lhs0000644000000000000000000001476411754016451021637 0ustar0000000000000000\subsubsection{Instrument map} \seclabel{user-patch-map} \begin{haskelllisting} > module Haskore.Interface.MIDI.InstrumentMap where > import Haskore.Music.Standard(Instr) > import qualified Sound.MIDI.Message.Channel as ChannelMsg > import qualified Sound.MIDI.General as GeneralMidi > import qualified Haskore.General.Map as Map > import qualified Data.List as List > import Data.Tuple.HT (swap, ) > import Data.Char (toLower, ) > import Data.Maybe (fromMaybe, ) \end{haskelllisting} A \type{InstrumentMap.ChannelProgramTable} is a user-supplied table for mapping instrument names (\type{Instr}s) to Midi channels and General Midi patch names. The patch names are by default General Midi names, although the user can also provide a \type{PatchMap} for mapping Patch Names to unconventional Midi Program Change numbers. \begin{haskelllisting} > type ChannelTable instr = > [(instr, ChannelMsg.Channel)] > type ChannelProgramTable instr = > [(instr, (ChannelMsg.Channel, ChannelMsg.Program))] > type ChannelProgramPitchTable instr = > [(instr, (ChannelMsg.Channel, ChannelMsg.Program, ChannelMsg.Pitch))] > > type ToChannel instr = > instr -> ChannelMsg.Channel > type ToChannelProgram instr = > instr -> (ChannelMsg.Channel, ChannelMsg.Program) > type ToChannelProgramPitch instr = > instr -> (ChannelMsg.Channel, ChannelMsg.Program, ChannelMsg.Pitch) > > type FromChannel instr = > ChannelMsg.Channel -> Maybe instr > type FromChannelProgram instr = > (ChannelMsg.Channel, ChannelMsg.Program) -> Maybe instr > type FromChannelProgramPitch instr = > (ChannelMsg.Channel, ChannelMsg.Program, ChannelMsg.Pitch) -> Maybe instr \end{haskelllisting} The \function{allValid} is used to test whether or not every instrument in a list is found in a \type{InstrumentMap.ChannelProgramTable}. \begin{haskelllisting} > repair :: [Instr] -> ChannelProgramTable Instr -> ChannelProgramTable Instr > repair insts pMap = > if allValid pMap insts > then pMap > else tableFromInstruments insts > > allValid :: ChannelProgramTable Instr -> [Instr] -> Bool > allValid upm = all (\x -> any (partialMatch x . fst) upm) \end{haskelllisting} If a Haskore user only uses General Midi instrument names as \type{Instr}s, we can define a function that automatically creates a \type{InstrumentMap.ChannelProgramTable} from these names. Note that, since there are only 15 Midi channels plus percussion, we can handle only 15 instruments. Perhaps in the future a function could be written to test whether or not two tracks can be combined with a Program Change (tracks can be combined if they don't overlap). \begin{haskelllisting} > tableFromInstruments :: [Instr] -> ChannelProgramTable Instr > tableFromInstruments instrs = > zip instrs (assignChannels GeneralMidi.instrumentChannels instrs) > -- 10th channel (#9) is for percussion > assignChannels :: [ChannelMsg.Channel] -> [Instr] -> > [(ChannelMsg.Channel, ChannelMsg.Program)] > assignChannels _ [] = [] > assignChannels [] _ = > error "Too many instruments; not enough MIDI channels." > assignChannels chans@(c:cs) (i:is) = > let percList = ["percussion", "perc", "drum", "drums"] > in if map toLower i `elem` percList > then (GeneralMidi.drumChannel, GeneralMidi.drumProgram) > : assignChannels chans is > else (c, fromMaybe > (error ("unknown instrument <<" ++ i ++ ">>")) > (GeneralMidi.instrumentNameToProgram i)) > : assignChannels cs is > fromInstruments :: Ord instr => [instr] -> ToChannel instr > fromInstruments instrs = > let fm = Map.fromList (zip instrs GeneralMidi.instrumentChannels) > in Map.findWithDefault fm (error "More instruments than channels") \end{haskelllisting} The following functions lookup \type{Instr}s in \type{InstrumentMap.ChannelProgramTable}s to recover channel and program change numbers. Note that the function that does string matching ignores case, and that instrument name and search pattern match if one is a prefix of the other one. For example, \code{"chur"} matches \code{"Church Organ"}. Note also that the {\em first} match succeeds, so using a substring should be done with care to be sure that the correct instrument is selected. \begin{haskelllisting} > partialMatch :: Instr -> Instr -> Bool > partialMatch "piano" "Acoustic Grand Piano" = True > partialMatch s1 s2 = > let s1' = map toLower s1 > s2' = map toLower s2 > in all (uncurry (==)) (zip s1' s2') > > lookupIName :: [(Instr, a)] -> Instr -> a > lookupIName ys x = > maybe (error ("InstrumentMap.lookupIName: Instrument " ++ x ++ " unknown")) > snd (List.find (partialMatch x . fst) ys) > > lookup :: Eq instr => [(instr, a)] -> instr -> a > lookup ys x = > fromMaybe (error ("InstrumentMap.lookup: Instrument unknown")) > (List.lookup x ys) \end{haskelllisting} \begin{haskelllisting} > reverseLookupMaybe :: Eq a => [(instr, a)] -> a -> Maybe instr > reverseLookupMaybe ys x = > List.lookup x (map swap ys) > reverseLookup :: Eq a => [(instr, a)] -> a -> instr > reverseLookup ys x = > let instr = reverseLookupMaybe ys x > err = error "InstrumentMap.reverseLookup: channel+program not found" > in fromMaybe err instr \end{haskelllisting} A default \type{InstrumentMap.ChannelProgramTable}. Note: the PC sound card I'm using is limited to 9 instruments. \begin{haskelllisting} > defltTable :: [(Instr, ChannelMsg.Channel, GeneralMidi.Instrument)] > defltTable = > map (\(instr,chan,gmInstr) -> (instr, ChannelMsg.toChannel chan, gmInstr)) > [("piano", 1, GeneralMidi.AcousticGrandPiano), > ("vibes", 2, GeneralMidi.Vibraphone), > ("bass", 3, GeneralMidi.AcousticBass), > ("flute", 4, GeneralMidi.Flute), > ("sax", 5, GeneralMidi.TenorSax), > ("guitar", 6, GeneralMidi.AcousticGuitarSteel), > ("violin", 7, GeneralMidi.Viola), > ("violins", 8, GeneralMidi.StringEnsemble1), > ("drums", 9, GeneralMidi.AcousticGrandPiano)] > -- the GM name for drums is unimportant, only channel 9 > deflt :: ChannelProgramTable Instr > deflt = > map (\(iName, chan, gmName) -> > (iName, (chan, GeneralMidi.instrumentToProgram gmName))) defltTable > defltGM :: ChannelProgramTable GeneralMidi.Instrument > defltGM = > map (\(_, chan, gmName) -> > (gmName, (chan, GeneralMidi.instrumentToProgram gmName))) defltTable > defltCMap :: [(GeneralMidi.Instrument, ChannelMsg.Channel)] > defltCMap = > map (\(_, chan, gmName) -> (gmName, chan)) defltTable \end{haskelllisting} haskore-0.2.0.3/src/Haskore/Interface/MED/0000755000000000000000000000000011754016451016170 5ustar0000000000000000haskore-0.2.0.3/src/Haskore/Interface/MED/Text.hs0000644000000000000000000001014511754016451017451 0ustar0000000000000000{- | Import Music from text printed by OctaMED. It will be certainly easy to adapt that for other trackers like SoundTracker, NoiseTracker, DigiBooster, FastTracker. Take care that you use B not H note name. -} module Haskore.Interface.MED.Text where import qualified Haskore.Basic.Pitch as Pitch import qualified Haskore.Melody as Melody import qualified Haskore.Process.Format as Fmt import qualified Text.ParserCombinators.Parsec.Combinator as ParseComb import qualified Text.ParserCombinators.Parsec.Char as Parse import Text.ParserCombinators.Parsec.Char (CharParser) import Text.ParserCombinators.Parsec.Prim ((<|>), parse) import Haskore.General.Utility (splitBy) import Haskore.Basic.Duration((%+)) import Data.Char (ord) import Data.Maybe (isJust) import qualified Data.List as List import Control.Monad (liftM2, ) {- | should be moved to Utility -} sieve :: Int -> [a] -> [a] sieve k = map head . takeWhile (not . null) . iterate (drop k) {- | should be moved to Utility -} sliceHoriz :: Int -> [a] -> [[a]] sliceHoriz n = map (sieve n) . take n . iterate (drop 1) {- | should be moved to Utility -} sliceVert :: Int -> [a] -> [[a]] sliceVert n = map (take n) . takeWhile (not . null) . iterate (drop n) type Instrument = Int splitBlocks :: [String] -> [[String]] splitBlocks = map (takeWhile (not . List.isPrefixOf "\f") . tail) . filter ((replicate 33 '=' ==) . head) . List.init . List.tails cellToNote :: String -> (Maybe (Pitch.T,Instrument), String) cellToNote = either (error . show) id . parse parseCell "cell" parseDigit :: CharParser () Int parseDigit = fmap (\c -> ord c - ord '0') Parse.digit parseNote :: CharParser () (Maybe (Pitch.T,Instrument)) parseNote = (do pitchClass <- liftM2 (\ bc m -> read(bc:m)) (Parse.satisfy (\p -> 'A' <= p && p <= 'G')) ((Parse.char '-' >> return "") <|> (Parse.char '#' >> return "s")) octave <- parseDigit instr <- liftM2 (\ instrH instrL -> instrH*32+instrL) ((Parse.char ' ' >> return 0) <|> parseDigit) (parseDigit <|> (fmap (\c -> ord c - ord 'A' + 10) (Parse.satisfy (\p -> 'A' <= p && p <= 'V')))) return (Just ((octave,pitchClass), instr))) <|> (do _ <- Parse.char '-' _ <- ParseComb.count 4 ParseComb.anyToken return Nothing) parseCell :: CharParser () (Maybe (Pitch.T,Instrument), String) parseCell = liftM2 (,) parseNote (ParseComb.count 4 ParseComb.anyToken) columnToNotes :: [String] -> ([String], [(Pitch.T, Instrument, [String])]) columnToNotes cells = let notes = splitBy (isJust . fst) . map cellToNote $ cells procNote ((Just (pitch,instr), cmd) : rest) = (pitch, instr, cmd : map snd rest) procNote _ = error "each note must start with Just" in case notes of pause@((Nothing, _) : _) : rest -> (map snd pause, map procNote rest) _ -> ([], map procNote notes) {- | Convert a block of a song to a list of notes. -} linesToNotes :: [String] {- ^ lines of a block -} -> [([String], [(Pitch.T, Instrument, [String])])] linesToNotes = map columnToNotes . List.transpose . map (sliceVert 10 . drop 4) columnToSimpleSerial :: Integer -> ([String], [(Pitch.T, Instrument, [String])]) -> ShowS columnToSimpleSerial whole (rest, melody) = (if null rest then id else Fmt.rest 5 (List.genericLength rest %+ whole) . showString " : ") . foldr (.) (showString "[]") (map (\(pitch,_instr,cmds) -> Fmt.note 5 (List.genericLength cmds %+ whole) (Melody.Note () pitch) . showString " : ") melody) {- mapM print . map (map (($"") . columnToSimpleSerial 16) . linesToNotes) . splitBlocks . lines =<< readFile "/data2/AmigaEnvironment/Partitions/Data/Songs/Meine/Air.1.txt" -} {- Convert a block of a song to Music. blockToMusic :: Int {- ^ length of a whole note -} -> String {- ^ textual representation of a block -} -> [[(Pitch.T, Instrument, [String])]] blockToMusic whole text = -} haskore-0.2.0.3/src/Haskore/Example/0000755000000000000000000000000011754016451015256 5ustar0000000000000000haskore-0.2.0.3/src/Haskore/Example/WhiteChristmas.hs0000644000000000000000000000714111754016451020553 0ustar0000000000000000 {- Demonstrate handling of chords and drums -} module Haskore.Example.WhiteChristmas where import qualified Haskore.Composition.Drum as Drum import qualified Haskore.Composition.Chord as Chord import Haskore.Basic.Dynamics (Velocity) import Haskore.Melody.Standard as Melody import Haskore.Music.GeneralMIDI as MidiMusic import qualified Haskore.Music as Music import Haskore.Basic.Pitch (Class(..)) import qualified Data.Accessor.Basic as Accessor vline :: [NoteAttributes -> Melody.T] -> Melody.T vline l = line (map ($ Melody.na) l) melody, strings :: Melody.T melody = line [m1, m2, m3a, m4a, m1, m2, m3b, m4b] strings = line (map chord (Chord.leastVaryingInversions ((1,C),(1,C)) (s1 ++ s2 ++ s3 ++ s4a ++ s1 ++ s2 ++ s3 ++ s4b))) m1, m2, m3a, m4a, m3b, m4b :: Melody.T m1 = vline [e 1 hn, f 1 en, e 1 en, ds 1 en, e 1 en, f 1 hn, fs 1 en, g 1 dqn] m2 = enr +:+ vline [a 1 en, b 1 en, c 2 en, d 2 en, c 2 en, b 1 en, a 1 en, g 1 hn] m3a = qnr +:+ vline [c 1 en, d 1 en, e 1 qn, e 1 qn, e 1 en, a 1 qn, g 1 en, c 1 qn, c 1 qn, c 1 en, g 1 qn] m4a = vline [f 1 en, e 1 hn, f 1 en, e 1 en, d 1 en, c 1 en, d 1 hn, g 0 hn] m3b = qnr +:+ vline [c 1 en, d 1 en, e 1 qn, e 1 qn, e 1 en, a 1 qn, g 1 en, c 2 dhn] m4b = vline [c 1 en, d 1 en, e 1 qn, e 1 qn, a 1 en, g 1 en, a 0 en, b 0 en, c 1 hn] v :: NoteAttributes v = vel 0.25 vel :: Velocity -> NoteAttributes vel vl = Accessor.set Melody.velocity1 vl Melody.na s1, s2, s3, s4a, s4b :: [Chord.Generic NoteAttributes] s1 = [ Chord.generic C Chord.majorInt wn v, Chord.generic D Chord.minorInt hn v, Chord.generic G Chord.majorInt hn v ] s2 = [ Chord.generic F Chord.majorInt wn v, Chord.generic C Chord.majorInt hn v, Chord.generic G Chord.sustainedFourthInt qn v, Chord.generic G Chord.majorInt qn v ] s3 = [ Chord.generic C Chord.majorInt qn v, Chord.generic E Chord.minorInt qn v, Chord.generic C Chord.dominantSeventhInt hn v, Chord.generic F Chord.majorInt hn v, Chord.generic F Chord.minorInt hn v ] s4a =[ Chord.generic C Chord.majorInt hn v, Chord.generic D Chord.minorInt qn v, Chord.generic D Chord.majorInt qn v, Chord.generic G Chord.sustainedFourthInt hn v, Chord.generic G Chord.majorInt hn v ] s4b =[ Chord.generic C Chord.majorInt hn v, Chord.generic G Chord.majorInt hn v, Chord.generic C Chord.majorInt hn v ] bassdrum, snare, hihat :: Dur -> MidiMusic.T bassdrum durat = Drum.toMusic MidiMusic.AcousticBassDrum durat (vel 2) snare durat = Drum.toMusic MidiMusic.AcousticSnare durat (vel 1) hihat durat = Drum.toMusic MidiMusic.OpenHiHat durat (vel 1.5) rhythm :: MidiMusic.T rhythm = line [bassdrum en, hihat sn, hihat sn, snare en, hihat sn, hihat sn, bassdrum en, hihat sn, hihat sn, snare sn, hihat sn, hihat sn, hihat sn] song :: MidiMusic.T song = MidiMusic.changeTempo 1.2 $ MidiMusic.fromStdMelody MidiMusic.StringEnsemble1 (transpose 12 strings) =:= MidiMusic.fromStdMelody MidiMusic.AcousticGrandPiano (transpose 12 melody) =:= Music.line (replicate 16 rhythm) haskore-0.2.0.3/src/Haskore/Example/Guitar.lhs0000644000000000000000000001605111754016451017224 0ustar0000000000000000\subsection{Guitar} \seclabel{guitar} In this section we want to develop a simulation of a guitar. This clearly demonstrates the power of our music-by-programming approach. After writing some routines for doing the mechanical stuff we can describe the music concisely as a sequence of chords. \begin{haskelllisting} > module Haskore.Example.Guitar where > > import qualified Haskore.Basic.Pitch as Pitch > import Haskore.Basic.Pitch (Class(..)) > import qualified Haskore.Basic.Duration as Dur > -- import Haskore.Melody.Standard as StdMelody > import Haskore.Music.GeneralMIDI as MidiMusic > import Haskore.Music.Rhythmic as RhyMusic > import qualified Haskore.Melody as Melody > import qualified Haskore.Music as Music > > import qualified Data.List as List \end{haskelllisting} % import qualified Haskore.Performance.Fancy as FancyPerformance On a guitar a chord is not played as an immediate sequence of the constituting notes, but the order and the number of occurences of each tone is adapted to the guitar and the possibilities of the player. We want to automatically design a sequence of tones that represents a given chord. Our approach is simple: For every string we choose the lowest possible note which occurs in the chord. This way we may miss notes of the chord, but we have a good approximation. If a chord consists of more than six notes, we have to ignore some notes definitely. For given pitches of all guitar strings and the pitch classes of a chord, \function{mapChordToString} compute the tones that are played on each string of the guitar. \begin{haskelllisting} > mapChordToString :: [Pitch.T] -> [Pitch.Class] -> [Pitch.T] > mapChordToString strs chrd = > map (choosePitchForString chrd) strs > > choosePitchForString :: [Pitch.Class] -> Pitch.T -> Pitch.T > choosePitchForString chrd str@(_,pc) = > let diff x = mod (Pitch.classToInt x - Pitch.classToInt pc) 12 > smallestDiff = minimum (map diff chrd) > in Pitch.transpose smallestDiff str > > stringPitches :: [Pitch.T] > stringPitches = > reverse [(-2,E), (-2,A), (-1,D), (-1,G), (-1,B), (0,E)] \end{haskelllisting} Once we obtain the tones that are played on a guitar we want to arrange them into a guitar like melody. We distinguish between up strokes and down strokes, which are often played alternatingly. According to the stroke direction, the low notes are played slightly before the high ones and vice versa. We define the respective delays for each string. Since both direction are perceived differently, we have to prefetch the down strokes a bit. \begin{haskelllisting} > data Direction = > Up > | Down > > delayTime :: Dur > delayTime = en/15 > > dirDelays :: Direction -> [Dur.Offset] > dirDelays dir = > map (Dur.toRatio delayTime *) > (case dir of > Up -> [0..5] > Down -> [2,1..(-3)]) \end{haskelllisting} Here is the only creative part: The essential description of the guitar music. \begin{haskelllisting} > type UpDownPattern = [(Dur, Direction)] > > udp, udpInter, udpLast :: UpDownPattern > udp = [(qn,Up), (en,Down), (qn,Up), (en,Down), (qn, Up)] > udpInter = [(qn,Up), (en,Down), (qn,Up), (en,Down), (en,Up), (en,Down)] > udpLast = [(qn,Up), (en,Down), (qn,Up), (en,Down), (qn+wn,Up)] > > chords :: [([Pitch.Class], UpDownPattern)] > chords = > [([C,E,G], udp), > ([C,E,G,Bf], udp), > ([F,A,C], udp), > ([F,Af,C], udpInter), > ([C,E,G], udp), > ([G,B,D], udp), > ([C,F,G], udp), > ([C,E,G], udpLast)] \end{haskelllisting} The next step is to arrange the notes corresponding to the chords. \begin{haskelllisting} > type DelayedNote = (Dur.Offset, (Dur, Maybe Pitch.T)) > > chordToPattern :: [Pitch.Class] -> UpDownPattern -> [[DelayedNote]] > chordToPattern chrd = > map (\(dur,ord) -> > zipWith > (\delay p -> (delay, (dur, Just p))) > (dirDelays ord) > (mapChordToString stringPitches chrd)) > > guitarEvents :: [[DelayedNote]] > guitarEvents = > concatMap (uncurry chordToPattern) chords \end{haskelllisting} We want to simulate the guitar by a parallel composition of six strings. The sound of each string finishes when the next sound on the string is played. Thus we have to compute the time each string oscillates. Finally we want to obtain this pattern of events: \begin{verbatim} o o o o o o o o o o o o o o o o o o \end{verbatim} \begin{haskelllisting} > delayNotes :: [DelayedNote] -> [Melody.T ()] > delayNotes m = > let zero = (0, (0, Nothing)) > in zipWith > (\(d0, (dur, at)) (d1, _) -> > Music.atom (Dur.add (d1-d0) dur) > (fmap (Melody.Note ()) at)) > (zero : m) (m ++ [zero]) > > stringMelodies :: [Melody.T ()] > stringMelodies = > map (line . delayNotes) (List.transpose guitarEvents) > > parallelSong :: [instr] -> RhyMusic.T drum instr > parallelSong instrs = > changeTempo 2 (chord (zipWith RhyMusic.fromMelodyNullAttr > instrs stringMelodies)) > > parallelSongMIDI :: MidiMusic.T > parallelSongMIDI = > transpose 12 (parallelSong (repeat MidiMusic.ElectricGuitarClean)) \end{haskelllisting} Unfortunately the Guitar music appears to be slightly longer than it is on the note sheet. To workaround that we use notes of very short duration but very long legato. For simplicity this simulation is not as precise as the one above. We don't prefetch the down strokes and we do not exactly care for the correct length of the string sounds. The resulting MIDI files does still not sound satisfyingly because notes of equal pitch overlap, which is not properly supported by MIDI. \begin{verbatim} <-----------------> <--------------> \end{verbatim} The end of the first note terminates the second one, which is not intended. Of course, you can play the MidiMusic using other back ends. \begin{haskelllisting} > chordWithLegatoPattern :: > [RhyMusic.T drum instr] -> UpDownPattern -> RhyMusic.T drum instr > chordWithLegatoPattern tones pattern = > let beat (dur, dir) = > legato dur > (line (case dir of {Up -> tones; Down -> reverse tones}) +:+ > Music.rest (dur - delayTime * List.genericLength tones)) > in line (map beat pattern) > > > > legatoSong :: [instr] -> RhyMusic.T drum instr > legatoSong instrs = > changeTempo 2 (line (map > (uncurry > (chordWithLegatoPattern . > zipWith RhyMusic.fromMelodyNullAttr instrs . > map (Music.atom delayTime . Just . Melody.Note ()) . > mapChordToString stringPitches)) > chords)) > > legatoSongMIDI :: MidiMusic.T > legatoSongMIDI = > transpose 12 (legatoSong (repeat MidiMusic.ElectricGuitarClean)) \end{haskelllisting} % let strings = map (RhyMusic.fromStdMelody MidiMusic.ElectricGuitarClean) [a 0 delayTime [], b 0 delayTime [], c 0 delayTime []] % chordWithLegatoPattern strings udp % FancyPerformance.floatFromMusic (chordWithLegatoPattern strings udp) haskore-0.2.0.3/src/Haskore/Example/NewResolutions.lhs0000644000000000000000000002751711754016451021002 0ustar0000000000000000% GHC-6.4.1 runs out of memory with optimization. % Unfortunately we cannot override Cabal's option here, % so you have to configure with --disable-optimization % {-# OPTIONS_GHC -Onot #-} New Resolutions by Jean-Luc Ponty, Scott O'Neil, and John Garvin > module Haskore.Example.NewResolutions where > import qualified Haskore.Basic.Pitch as Pitch > import qualified Haskore.Basic.Tempo as Tempo > import qualified Haskore.Interface.MIDI.Write as WriteMidi > import qualified Sound.MIDI.File.Save as SaveMidi > import qualified Sound.MIDI.File as MidiFile > import qualified Haskore.Performance.Context as Context > import qualified Haskore.Performance.Fancy as FancyPf > import Haskore.Basic.Duration((%+)) > import Haskore.Basic.Pitch > import Haskore.Basic.Interval as Interval > import qualified Haskore.Music as Music > import Haskore.Melody as Melody > import Haskore.Melody.Standard as StdMelody > import Haskore.Music.GeneralMIDI as MidiMusic > import qualified Haskore.Music.Rhythmic as RhyMusic > import qualified Data.List as List > import qualified Numeric.NonNegative.Wrapper as NonNeg > import qualified Data.Accessor.Basic as Accessor > piano, marimba, xylo, vib, glock :: MidiMusic.Instr > piano = MidiMusic.AcousticGrandPiano > marimba = MidiMusic.Marimba > xylo = MidiMusic.Xylophone > vib = MidiMusic.Vibraphone > glock = MidiMusic.Glockenspiel > pattern, melPattern, > melody1, bellPart, vibesLine, vibesPart, > melody2, vibeLine3, vibePart3, > melody3, endRun :: StdMelody.T > part1, part2, part3, bridge, ending, harmony3 :: MidiMusic.T > comp2 :: (c -> d) -> (a -> b -> c) -> (a -> b -> d) > comp2 func = ((func .) .) % comp2 func1 func0 = curry (func1 . uncurry func0) > arpeggio :: [Int] -> Pitch.T -> Dur -> StdMelody.T > arpeggio trs p d' = line (map (\tr -> note (Pitch.transpose tr p) d' na) trs) > minArpegUp, minArpegDown, majArpegDown, six3ArpegDown > :: Pitch.T -> Dur -> StdMelody.T > minArpegUp = arpeggio [unison, minorThird, fifth, octave] > minArpegDown = arpeggio [octave, fifth, minorThird, unison] > majArpegDown = arpeggio [octave, fifth, majorThird, unison] > six3ArpegDown = arpeggio [octave, majorSixth, majorThird, unison] > pattern = minArpegUp (5,D) sn > +:+ minArpegDown (5,C) sn > +:+ minArpegUp (4,A) sn > +:+ minArpegDown (4,G) sn > +:+ minArpegUp (4,F) sn > +:+ d 5 sn na +:+ a 4 sn na +:+ f 4 sn na +:+ a 4 sn na > melPattern = d 6 en na +:+ c 6 en na +:+ d 6 en na > +:+ snr > +:+ a 5 en na +:+ g 5 en na +:+ a 5 en na > melody1 = melPattern +:+ enr +:+ d 5 sn na > +:+ f 5 sn na +:+ g 5 en na +:+ f 5 sn na +:+ d 5 en na +:+ c 5 en na > +:+ d 5 en na +:+ melPattern +:+ d 5 sn na > +:+ f 5 sn na +:+ f 5 sn na +:+ g 5 sn na +:+ f 5 sn na > +:+ d 5 sn na +:+ c 5 en na +:+ d 5 den na > +:+ melPattern +:+ d 5 sn na > +:+ f 5 sn na +:+ g 5 sn na +:+ f 5 sn na +:+ d 5 en na > +:+ c 5 sn na +:+ d 5 en na > +:+ d 6 en na +:+ c 6 en na +:+ d 6 den na +:+ c 6 en na > +:+ a 5 en na +:+ c 6 en na +:+ a 5 sn na +:+ g 5 en na > +:+ f 5 en na +:+ af 5 en na > +:+ g 5 sn na +:+ f 5 sn na +:+ d 5 sn na +:+ c 5 sn na > -- last note removed to make fit with pattern > bellPart = d 7 en na +:+ f 7 en na +:+ c 7 en na +:+ d 7 en na > +:+ a 6 en na +:+ c 7 en na +:+ g 6 en na +:+ a 6 en na > +:+ f 6 en na +:+ g 6 en na > +:+ d 6 sn na +:+ f 6 sn na +:+ a 6 sn na +:+ c 7 sn na > vibesLine = d 5 qn na +:+ c 5 qn na +:+ a 4 qn na > +:+ g 4 qn na +:+ f 4 qn na +:+ d 4 qn na > vibesPart = vibesLine =:= Music.transpose 12 vibesLine > cMajorScale, gMajorScale, dPentMinScale :: [Pitch.T] > cMajorScale = [(0,C), (0,D), (0,E), (0,F), (0,G), (0,A), (0,B)] > gMajorScale = [(0,G), (0,A), (0,B), (1,C), (1,D), (1,E), (1,Fs)] > dPentMinScale = [(0,D), (0,F), (0,G), (0,A), (1,C)] > prevNote, nextNote :: [Pitch.T] -> Pitch.T -> Pitch.T > prevNote [] _ = error ("Scale empty") > prevNote [_] _ = error ("Note not found in scale") > prevNote ((n,y):ys) (oct,p) | y == p = let (m,x) = last ys > in (oct + m - n - 1, x) > prevNote ((m,x):(n,y):xys) (oct,p) | y == p = (oct + m - n, x) > | otherwise = prevNote ((n,y):xys) (oct,p) > nextNote scale n = nextNote' (head scale) scale n > nextNote' :: Pitch.T -> [Pitch.T] -> Pitch.T -> Pitch.T > nextNote' _ [] _ = error ("Scale empty") > nextNote' (fstO,fstP) [(m,x)] (oct,p) > | x == p = (oct - m + fstO + 1, fstP) > | otherwise = error ("Note not found in scale") > nextNote' fst' ((m,x):(n,y):xys) (oct,p) > | x == p = (oct - m + n, y) > | otherwise = nextNote' fst' ((n,y):xys) (oct,p) > back2Note :: [Pitch.T] -> Pitch.T -> Pitch.T > back2Note s = prevNote s . prevNote s > nextNR, prevNR, back2NR :: Pitch.T -> Pitch.T > nextNR = nextNote dPentMinScale > prevNR = prevNote dPentMinScale > back2NR = back2Note dPentMinScale > makeSN, diddle :: Pitch.T -> StdMelody.T > makeSN p = note p sn na > diddle p = line $ snr : map makeSN [p, prevNR p, p] > melody2 = d 6 sn na +:+ d 6 en na +:+ c 6 en na +:+ d 6 sn na +:+ c 6 en na > +:+ a 5 en na +:+ g 5 sn na +:+ f 5 sn na > +:+ g 5 sn na +:+ f 5 sn na +:+ d 5 sn na +:+ f 5 sn na > +:+ diddle (5,D) +:+ diddle (5,C) > +:+ diddle (6,D) +:+ diddle (6,C) +:+ diddle (5,A) > +:+ diddle (5,G) +:+ diddle (5,F) +:+ diddle (5,D) > +:+ snr +:+ d 6 en na +:+ c 6 en na +:+ d 6 den na > +:+ c 6 en na +:+ a 5 en na +:+ g 5 den na > +:+ f 5 en na +:+ g 5 en na +:+ f 5 sn na > +:+ g 5 sn na +:+ f 5 sn na +:+ d 5 sn na +:+ c 5 sn na > +:+ d 5 den na +:+ d 6 en na +:+ c 6 den na +:+ a 5 en na +:+ g 5 den na > +:+ f 5 en na +:+ d 5 den na +:+ c 5 en na +:+ d 5 qn na > part1 = MidiMusic.fromStdMelody marimba (loudness1 0.7 pattern) > +:+ > MidiMusic.fromStdMelody xylo (loudness1 1.2 melody1) > =:= MidiMusic.fromStdMelody marimba (loudness1 0.7 (Music.replicate 4 pattern)) > bridge = MidiMusic.fromStdMelody xylo (d 5 hn (Accessor.set velocity1 1.2 na)) > =:= (Music.replicate 2 $ > MidiMusic.fromStdMelody marimba (loudness1 0.6 (Music.transpose (-12) bellPart)) > =:= MidiMusic.fromStdMelody vib (loudness1 0.4 vibesPart) > =:= MidiMusic.fromStdMelody glock (loudness1 0.8 bellPart)) > part2 = MidiMusic.fromStdMelody xylo (loudness1 1.2 melody2) > =:= MidiMusic.fromStdMelody marimba (loudness1 0.7 (Music.replicate 3 pattern > +:+ minArpegUp (5,D) sn > +:+ minArpegDown (5,C) sn > +:+ minArpegUp (4,A) sn > +:+ minArpegDown (4,G) sn > +:+ minArpegUp (4,F) sn > +:+ d 5 sn na)) > =:= Music.replicate 4 (MidiMusic.fromStdMelody vib (loudness1 0.4 vibesPart)) > run1, run2, run3 :: Pitch.T -> Dur -> StdMelody.T > run1 = arpeggio [unison, minorThird, fifth, > minorSeventh, octave, octaveMinorThird, > octaveFifth, octaveMinorThird, octave, > minorSeventh, fifth, minorThird] > part3Pattern :: (Num t) => > ((t, Pitch.Class) -> Dur -> StdMelody.T) -> MidiMusic.T > part3Pattern el = MidiMusic.fromStdMelody piano $ > el (4,D) sn +:+ el (4,C) sn +:+ el (4,D) sn +:+ el (4,F) sn > run2 = Music.replicate 2 `comp2` > arpeggio [fifth, minorSeventh, octave, > octaveMinorThird, octave, minorSeventh] > run3 = Music.replicate 3 `comp2` > arpeggio [octaveMinorThird, octave, minorSeventh, fifth] > vibeLine3 = let el p = arpeggio [octave, fifth, minorSeventh, octave] p den > in el (4,D) +:+ el (4,C) +:+ el (4,D) > +:+ f 5 den na +:+ c 5 den na > +:+ ef 5 en na +:+ f 5 en na +:+ af 5 en na > vibePart3 = vibeLine3 =:= Music.transpose 12 vibeLine3 > melody3 = a 5 (11%+16) na +:+ f 6 sn na > +:+ ef 6 en na +:+ d 6 en na +:+ c 6 en na +:+ g 5 dqn na > +:+ Music.replicate 3 (a 5 sn na +:+ f 6 en na) +:+ a 5 en na > +:+ f 6 en na +:+ af 5 en na +:+ f 6 en na +:+ af 5 en na > +:+ minArpegDown (5,F) sn +:+ snr > +:+ majArpegDown (5,F) sn +:+ snr > +:+ six3ArpegDown (5,F) sn +:+ snr +:+ f 6 sn na +:+ d 6 sn na > +:+ ef 6 sn na +:+ d 6 sn na +:+ c 6 sn na +:+ g 5 sn na +:+ snr > +:+ majArpegDown (5,Ef) sn +:+ snr +:+ ef 6 sn na +:+ c 6 sn na > +:+ majArpegDown (5,F) sn +:+ snr > +:+ six3ArpegDown (5,F) sn +:+ snr +:+ f 6 sn na +:+ d 6 sn na > +:+ minArpegDown (5,F) sn +:+ snr > +:+ minArpegDown (5,F) sn +:+ af 5 sn na +:+ c 6 sn na +:+ f 6 sn na > +:+ line (map (Music.replicate 2) [f 6 sn na, d 6 sn na, c 6 sn na, > a 5 sn na, g 5 sn na, f 5 sn na]) > +:+ ef 5 sn na +:+ f 5 sn na +:+ g 5 sn na +:+ bf 5 sn na > +:+ c 6 sn na +:+ d 6 sn na +:+ ef 6 sn na +:+ d 6 sn na > +:+ c 6 sn na +:+ bf 5 sn na +:+ a 5 sn na +:+ g 5 sn na > +:+ Music.replicate 4 (a 5 sn na +:+ a 5 sn na +:+ g 5 sn na) > +:+ Music.replicate 2 (af 5 sn na +:+ af 5 sn na +:+ g 5 sn na) > +:+ Music.replicate 2 (af 5 sn na +:+ g 5 sn na +:+ f 5 sn na) > +:+ a 5 dqn na > +:+ f 6 sn na +:+ d 6 sn na +:+ c 6 sn na > +:+ a 5 sn na +:+ g 5 sn na +:+ f 5 sn na > +:+ g 5 sn na +:+ bf 5 sn na +:+ ef 6 dqn na > +:+ bf 6 den na +:+ bf 6 sn na > +:+ a 6 en na +:+ a 6 sn na +:+ g 6 en na +:+ g 6 sn na > +:+ f 6 den na +:+ a 5 sn na +:+ c 6 sn na +:+ d 6 sn na > +:+ f 6 den na +:+ f 6 sn na +:+ d 6 sn na +:+ c 6 sn na > +:+ af 5 sn na +:+ af 5 sn na +:+ g 5 sn na > +:+ f 5 sn na +:+ d 5 sn na +:+ c 5 sn na > harmony3 = loudness1 0.6 (part3Pattern run1 > =:= part3Pattern run2 > =:= Music.transpose 12 (part3Pattern run3)) > =:= loudness1 0.5 (MidiMusic.fromStdMelody vib vibePart3) > part3 = loudness1 0.6 (part3Pattern run1) > +:+ (loudness1 0.6 (part3Pattern run1) > =:= loudness1 0.9 (part3Pattern run2)) > +:+ (loudness1 0.6 ((part3Pattern run1) > =:= (part3Pattern run2)) > =:= loudness1 1.0 (Music.transpose 12 (part3Pattern run3))) > +:+ loudness1 0.6 (part3Pattern run1 > =:= part3Pattern run2 > =:= Music.transpose 12 (part3Pattern run3)) > =:= loudness1 0.7 (MidiMusic.fromStdMelody vib vibePart3) > +:+ (Music.replicate 4 harmony3 =:= > loudness1 1.0 (MidiMusic.fromStdMelody xylo melody3 =:= > MidiMusic.fromStdMelody marimba melody3)) > all3Insts :: StdMelody.T -> MidiMusic.T > all3Insts m = chord [MidiMusic.fromStdMelody marimba m, > MidiMusic.fromStdMelody xylo m, > MidiMusic.fromStdMelody vib m] > endEl :: Pitch.T -> StdMelody.T > endEl p = line $ map makeSN [p, back2NR p, prevNR p, p] > endRun = line $ map endEl $ List.take 10 $ iterate nextNR (5,D) > ending = all3Insts $ > d 5 qn na > +:+ loudness1 1.2 (endRun +:+ d 7 sn na) > song :: MidiMusic.T > song = Music.transpose (-48) $ line [part1, bridge, part2, part3, ending] > > -- context :: Context.T NonNeg.Float Float MidiMusic.Note -- rejected by Hugs > context :: Context.T NonNeg.Float Float (RhyMusic.Note MidiMusic.Drum MidiMusic.Instr) > context = > Context.setDur (Tempo.metro 120 qn) $ > FancyPf.context > > midi :: MidiFile.T > midi = WriteMidi.fromGMMusicAuto (context, song) > > main :: IO () > main = SaveMidi.toFile "newresolutions.mid" midi haskore-0.2.0.3/src/Haskore/Example/Kantate147.hs0000644000000000000000000002034011754016451017434 0ustar0000000000000000module Haskore.Example.Kantate147 where {- Kantate 147 by Johann Sebastian Bach -} import qualified Haskore.Basic.Pitch as Pitch import qualified Haskore.Basic.Tempo as Tempo import qualified Haskore.Music as Music import Haskore.Music (line, chord, (=:=)) import qualified Haskore.Melody as Melody import qualified Haskore.Music.GeneralMIDI as MidiMusic import Haskore.Basic.Duration (qn, (%+), ) import qualified Haskore.Performance.Context as Context import qualified Haskore.Performance.Default as DefltPf import qualified Numeric.NonNegative.Wrapper as NonNeg import qualified Haskore.Interface.MML as MML -- import qualified Medium.Controlled.List as CtrlMedium import qualified Medium.Controlled.ContextFreeGrammar as Grammar import qualified Data.MarkovChain as MarkovChain import qualified Haskore.Interface.MIDI.Write as WriteMidi import qualified Haskore.Interface.MIDI.InstrumentMap as InstrumentMap import qualified Sound.MIDI.File.Save as SaveMidi import qualified Sound.MIDI.File as MidiFile import qualified Data.List as List import Control.Monad.Trans.State (state, evalState, ) import System.Random (mkStdGen, split, ) initOctaves :: [Pitch.Octave] initOctaves = [1, 0, 2, 2] songMML :: [(String, String, String, String)] songMML = [ ("l2g>ge", "l2p2de", "l2p2l6g3f#g3a", "l6p6gab>dcced"), ("ec", "a>dc", "e3f#g3de3cdedcf#", "a3>da3ga3f#", "f#gadf#a>ce", "d3f#g3f#g3a", "bgab>dcced"), ("ed", "geced", "a3f#g3ec", "e>dcg6d3gb3>dg3d", "gb>dgdd"), ("g>f#e", "dc"), ("f#ed", "agf#", "a1b", "d1d"), ("ef#g", "gag", "bag", "c1d3d6", "al6d3ef#3g", "l6adef#aga>cp3d6d3d6", "f#3a6f#3d6d6", "a3>cccdcced"), ("be", "gdcdcdcge", "b>de", "dg3f#g3a", "gbab>dcced"), ("ec", "a>dc", "e3f#g3de3cdedcf#", "a3>f#a3ga3f#", "f#gadf#a>ce", "d3f#g3f#g3a", "bgab>dcced"), ("ed", "geced", "a3f#g3ec", "e>dcf#e", "dc", "l2g1g"), ("f#ed", "agf#", "d1d", "a1b"), ("ef#g", "gag", "c1d3d", "al6d3ef#3g", "l6ddef#aga>cd6d3d6", "f#3af#3dd", "a3>cccc", "bgab>dcced"), ("be", "gdcdcc8dcge", "l2b>de", "l6g3dg3f#g3a", "gbab>dcced"), ("ec", "a>dc", "e3f#g3de3cdedcf#", "a3>da3ga3f#", "f#gadf#a>ce", "d3f#g3f#g3a", "bgab>dcced"), ("ed", "geced", "a3f#g3ec", "e>dcg6f#3e6", "dp3g6d3e6", "gb3>dg3dgdc#"), ("dca4g4f4e4", "ea", ">c1c", "a>cce", "aag#", "c8d8dcdfd", "ef#", "al6a3g#a3b", "a>cceddfe"), ("cfe", "afc", ">c3c3c"), ("dd#e", "df#e", "a3g#a3f#d", "fedcab", "cl2c1d", "a>ceap3l2d"), (">ccag", "e1e", "l6ecdegfgb-a"), ("fdg", "df#g", "dd4e8f8d", "a>ccc3d", "a>ccd6", "gp3d6d3d6", "c3c3d3ge", "dde", "l2b1>c", "bgab>dcced"), ("ec", "a>dc", "ccdedcd3d", "l6a3c#d3ef#3g", "f#def#aga>cd6d3d6", "f#3af#3dd", "a3>cccc", "bgab>dcced"), ("be", "gdcdcc8dcg6d3g6", "gl6dg3d", "gb>dgda"), ("g1g2", "dp3g6e3c6", "d3b>c2", "fddedd6e6", "c3cda6f#3d6", "a2a3f#d3f#", ">ccge", "dde", "g3dg3f#g3a", "bgab>dcced"), ("ec", "a>dcdedcf#", "a3>da3ga3f#", "f#gadf#a>ce", "d3f#g3f#g3a", "bgab>dcced"), ("ed", "gec", "e>dc Music.Atom (dr * (3%+4)) at) songTrackwise in Grammar.fromMedium (map (("part"++) . show) [(0 :: Int) ..]) 4 songConvDurs {- Try to create new music by reordering the notes using Markov chains. -} markovChain :: Melody.T () markovChain = let tracks = map concat musicTracks gs = evalState (sequence (repeat (state split))) (mkStdGen 147) chains = zipWith (\track g -> line (MarkovChain.run 3 track 0 g)) tracks gs in chains !! 2 =:= chains !! 3 markovChainMidi :: MidiFile.T markovChainMidi = toMidi (Music.take 100 markovChain) ----- Player details cm :: InstrumentMap.ChannelTable MidiMusic.Instrument cm = [(MidiMusic.ChurchOrgan, MidiMusic.toChannel 1), (MidiMusic.Viola, MidiMusic.toChannel 2)] context :: Context.T NonNeg.Float Float MidiMusic.Note context = Context.setDur (Tempo.metro 105 qn) $ DefltPf.context toMidi :: Melody.T () -> MidiFile.T toMidi m = WriteMidi.fromGMMusic (cm, context, MidiMusic.fromMelodyNullAttr MidiMusic.ChurchOrgan m) midi :: MidiFile.T midi = toMidi song main :: IO () main = SaveMidi.toFile "test.mid" midi haskore-0.2.0.3/src/Haskore/Example/Raenzlein.hs0000644000000000000000000000572211754016451017547 0ustar0000000000000000module Haskore.Example.Raenzlein where {- Heute wollen wir das Ränzlein schnüren -} import Haskore.Melody.Standard as Melody import Haskore.Music.GeneralMIDI as MidiMusic import qualified Haskore.Music as Music import qualified Haskore.Composition.Chord as Chord import Haskore.Basic.Pitch (Class(..)) import qualified Data.Accessor.Basic as Accessor vline :: [NoteAttributes -> Melody.T] -> Melody.T vline = line . map ($ Melody.na) mel0 :: Melody.T mel0 = vline [bf 0 en, d 1 en, f 1 dqn, f 1 en, f 1 en, f 1 en, g 1 en, a 1 en] verse, refrain, strings :: Melody.T verse = mel0 +:+ vline [bf 1 hn, f 1 qn, g 1 en, f 1 en, f 1 dqn, ef 1 en, ef 1 en, g 1 en, f 1 en, ef 1 en, d 1 hn] +:+ qnr +:+ mel0 +:+ vline [bf 1 qn, d 2 qn, d 2 qn, bf 1 en, d 2 en, c 2 dqn, a 1 en, c 2 en, bf 1 en, a 1 en, g 1 en, f 1 hn] +:+ qnr refrain = vline [f 1 den, g 1 sn, f 1 hn, ef 1 qn, g 1 den, a 1 sn, g 1 hn, f 1 qn, f 1 en, f 1 en, g 1 qn, f 1 qn, ef 1 qn, d 1 qn, c 1 hn] +:+ qnr +:+ Music.replicate 2 (vline [bf 0 en, d 1 en, f 1 dqn, g 1 en, f 1 qn, bf 1 en, a 1 en, g 1 dqn, a 1 en, g 1 qn, ef 2 en, ef 2 en, d 2 dqn, bf 1 en, c 2 den, c 2 sn, c 2 en, a 1 en, bf 1 hn] +:+ qnr) melody :: Melody.T melody = verse +:+ refrain v :: NoteAttributes v = Accessor.set Melody.velocity1 0.4 Melody.na s1, s2 :: [Chord.Generic NoteAttributes] s1 = Chord.generic Bf Chord.majorInt hn v : Chord.generic F Chord.majorInt hn v : Chord.generic Bf Chord.majorInt wn v : Chord.generic F Chord.dominantSeventhInt wn v : Chord.generic Bf Chord.majorInt dwn v : Chord.generic F Chord.majorInt hn v : Chord.generic Bf Chord.majorInt wn v : Chord.generic F Chord.majorInt hn v : Chord.generic C Chord.dominantSeventhInt hn v : Chord.generic F Chord.majorInt wn v : Chord.generic F Chord.dominantSeventhInt wn v : Chord.generic Bf Chord.majorInt wn v : Chord.generic Ef Chord.majorInt qn v : Chord.generic Bf Chord.majorInt qn v : Chord.generic F Chord.dominantSeventhInt qn v : Chord.generic Bf Chord.majorInt qn v : Chord.generic F Chord.majorInt wn v : [] s2 = Chord.generic Bf Chord.majorInt wn v : Chord.generic Ef Chord.majorInt wn v : Chord.generic Bf Chord.majorInt hn v : Chord.generic F Chord.dominantSeventhInt hn v : Chord.generic Bf Chord.majorInt wn v : [] strings = qnr +:+ line (map chord (Chord.leastVaryingInversions ((1,C),(1,C)) (s1 ++ s2 ++ s2))) song :: MidiMusic.T song = changeTempo (2) (MidiMusic.fromStdMelody MidiMusic.AcousticGrandPiano (transpose 24 melody) =:= MidiMusic.fromStdMelody MidiMusic.StringEnsemble1 (transpose 12 strings)) haskore-0.2.0.3/src/Haskore/Example/SelfSim.lhs0000644000000000000000000000617011754016451017334 0ustar0000000000000000\subsection{Self-Similar (Fractal) Music.T} \seclabel{self-similar} \begin{haskelllisting} > module Haskore.Example.SelfSim where > > import qualified Haskore.Basic.Pitch as Pitch > import qualified Haskore.Melody as Melody > import qualified Haskore.Music as Music > import Haskore.Music.GeneralMIDI as MidiMusic > import qualified Haskore.Interface.MIDI.Render as Render > import qualified Sound.MIDI.File as MidiFile \end{haskelllisting} An example of self-similar, or fractal, music. \begin{haskelllisting} > data Cluster = Cl SNote [Cluster] -- this is called a Rose tree > type Pat = [SNote] > type SNote = [(Pitch.Absolute,Dur)] -- i.e. a chord > > sim :: Pat -> [Cluster] > sim pat = map mkCluster pat > where mkCluster notes = Cl notes (map (mkCluster . addmult notes) pat) > > > addmult :: (Num a, Num b) => [(a, b)] -> [(a, b)] -> [(a, b)] > addmult pds iss = zipWith addmult' pds iss > where addmult' (p,d) (i,s) = (p+i,d*s) > > simFringe :: (Num a, Eq a) => a -> Pat -> [SNote] > simFringe n pat = fringe n (Cl [(0,0)] (sim pat)) > > fringe :: (Num a, Eq a) => a -> Cluster -> [SNote] > fringe 0 (Cl n _) = [n] > fringe m (Cl _ cls) = concatMap (fringe (m-1)) cls > > -- this just converts the result to Haskore: > simToHask :: [[(Pitch.Absolute, Music.Dur)]] -> Melody.T () > simToHask s = let mkNote (p,d) = Melody.note (Pitch.fromInt p) d () > in line (map (chord . map mkNote) s) > > -- and here are some examples of it being applied: > > sim4 :: Int -> Melody.T () > sim1, sim2, sim12, sim3, sim4s :: Int -> MidiMusic.T > t6, t7, t8, t9, t10 :: MidiFile.T > > sim1 n = MidiMusic.fromMelodyNullAttr MidiMusic.AcousticBass > (transpose (-12) > (changeTempo 4 (simToHask (simFringe n pat1)))) > t6 = Render.generalMidiDeflt (sim1 4) > > sim2 n = MidiMusic.fromMelodyNullAttr MidiMusic.AcousticGrandPiano > (transpose 5 > (changeTempo 4 (simToHask (simFringe n pat2)))) > t7 = Render.generalMidiDeflt (sim2 4) > > sim12 n = sim1 n =:= sim2 n > t8 = Render.generalMidiDeflt (sim12 4) > > sim3 n = MidiMusic.fromMelodyNullAttr MidiMusic.Vibraphone > (transpose 0 > (changeTempo 4 (simToHask (simFringe n pat3)))) > t9 = Render.generalMidiDeflt (sim3 3) > > sim4 n = (transpose 12 > (changeTempo 2 (simToHask (simFringe n pat4')))) > > sim4s n = let s = sim4 n > l1 = MidiMusic.fromMelodyNullAttr MidiMusic.Flute s > l2 = MidiMusic.fromMelodyNullAttr MidiMusic.AcousticBass > (transpose (-36) (Music.reverse s)) > in l1 =:= l2 > > ss :: MidiMusic.T > ss = sim4s 3 > durss :: Music.Dur > durss = Music.dur ss > > t10 = Render.generalMidiDeflt ss > > pat1, pat2, pat3, pat4, pat4' :: [SNote] > pat1 = [[(0,1.0)],[(4,0.5)],[(7,1.0)],[(5,0.5)]] > pat2 = [[(0,0.5)],[(4,1.0)],[(7,0.5)],[(5,1.0)]] > pat3 = [[(2,0.6)],[(5,1.3)],[(0,1.0)],[(7,0.9)]] > pat4' = [[(3,0.5)],[(4,0.25)],[(0,0.25)],[(6,1.0)]] > pat4 = [[(3,0.5),(8,0.5),(22,0.5)],[(4,0.25),(7,0.25),(21,0.25)], > [(0,0.25),(5,0.25),(15,0.25)],[(6,1.0),(9,1.0),(19,1.0)]] \end{haskelllisting} haskore-0.2.0.3/src/Haskore/Example/ChildSong6.lhs0000644000000000000000000000476111754016451017736 0ustar0000000000000000\subsection{Children's Song No. 6} \seclabel{chick} This is a partial encoding of Chick Corea's ``Children's Song No. 6''. \begin{haskelllisting} > module Haskore.Example.ChildSong6 where > import Haskore.Melody.Standard as Melody > import Haskore.Music.GeneralMIDI as MidiMusic > import qualified Haskore.Music as Music \end{haskelllisting} note updaters for mappings \begin{haskelllisting} > fd :: t -> (t -> NoteAttributes -> m) -> m > fd dur n = n dur v > > vel :: (NoteAttributes -> m) -> m > vel n = n v > > v :: NoteAttributes > v = Melody.na > > lmap :: (a -> Melody.T) -> [a] -> Melody.T > lmap func l = line (map func l) > > > bassLine, mainVoice :: Melody.T > song :: MidiMusic.T \end{haskelllisting} Baseline: \begin{haskelllisting} > b1, b2, b3 :: Melody.T > b1 = lmap (fd dqn) [b 3, fs 4, g 4, fs 4] > b2 = lmap (fd dqn) [b 3, es 4, fs 4, es 4] > b3 = lmap (fd dqn) [as 3, fs 4, g 4, fs 4] > > bassLine = > Music.loudness1 (10/13) > (line [Music.replicate 3 b1, Music.replicate 2 b2, > Music.replicate 4 b3, Music.replicate 5 b1]) \end{haskelllisting} Main Voice: \begin{haskelllisting} > v1, v1a, v1b :: Melody.T > v1 = v1a +:+ v1b > v1a = lmap (fd en) [a 5, e 5, d 5, fs 5, cs 5, b 4, e 5, b 4] > v1b = lmap vel [cs 5 tn, d 5 (qn-tn), cs 5 en, b 4 en] > > v2, v2a, v2b, v2c, v2d, v2e, v2f :: Melody.T > v2 = line [v2a, v2b, v2c, v2d, v2e, v2f] > v2a = lmap vel [cs 5 (dhn+dhn), d 5 dhn, > f 5 hn, gs 5 qn, fs 5 (hn+en), g 5 en] > v2b = lmap (fd en) [fs 5, e 5, cs 5, as 4] +:+ a 4 dqn v +:+ > lmap (fd en) [as 4, cs 5, fs 5, e 5, fs 5, g 5, as 5] > v2c = lmap vel [cs 6 (hn+en), d 6 en, cs 6 en, e 5 en] +:+ enr +:+ > lmap vel [as 5 en, a 5 en, g 5 en, d 5 qn, c 5 en, cs 5 en] > v2d = lmap (fd en) [fs 5, cs 5, e 5, cs 5, a 4, as 4, d 5, e 5, fs 5] +:+ > lmap vel [fs 5 tn, e 5 (qn-tn), d 5 en, e 5 tn, d 5 (qn-tn), > cs 5 en, d 5 tn, cs 5 (qn-tn), b 4 (en+hn)] > v2e = lmap vel [cs 5 en, b 4 en, 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] > v2f = changeTempo (3/2) (lmap vel [cs 5 en, d 5 en, cs 5 en]) +:+ b 4 (3*dhn+hn) v > > mainVoice = Music.replicate 3 v1 +:+ v2 \end{haskelllisting} Putting it all together: \begin{haskelllisting} > song = MidiMusic.fromStdMelody MidiMusic.AcousticGrandPiano > (transpose (-48) (changeTempo 3 > (bassLine =:= mainVoice))) \end{haskelllisting} haskore-0.2.0.3/src/Haskore/Example/Fractal.hs0000644000000000000000000000467511754016451017202 0ustar0000000000000000module Haskore.Example.Fractal where import Prelude hiding (init) import System.Random (randomRs, mkStdGen) import Data.Array (Array, (!), listArray, bounds) import qualified Haskore.Basic.Pitch as Pitch import qualified Haskore.Music as Music import qualified Haskore.Melody as Melody import Haskore.Music((+:+)) import qualified Haskore.Basic.Duration as Dur type Vector a = [a] type Matrix a = [Vector a] type AT a = Vector a -> Vector a type IFS a = Array Int (AT a) -- First define some general matrix operations. -- These will facilitate moving to higher dimensions later. vadd :: Num a => Vector a -> Vector a -> Vector a vadd = zipWith (+) vvmult :: Num a => Vector a -> Vector a -> a vvmult v1 v2 = sum (zipWith (*) v1 v2) mvmult :: Num a => Matrix a -> Vector a -> Vector a mvmult m v = map (vvmult v) m cvmult :: Num a => a -> Vector a -> Vector a cvmult z = map (z*) --------------------------------------------------------------------- {- The following simulates the Iterated Function System for the Sierpinski Triangle as described in Barnsley's "Desktop Fractal Design Handbook". -} -- First the affine transformations: w0, w1, w2 :: Fractional a => AT a w0 v = (cvmult 0.01 ([[50,0],[0,50],[50,0]] `mvmult` v)) `vadd` [8,8,8] w1 v = (cvmult 0.01 ([[50,0],[0,50],[50,0]] `mvmult` v)) `vadd` [30,16,2] w2 v = (cvmult 0.01 ([[50,0],[0,50],[50,0]] `mvmult` v)) `vadd` [20,40,30] init0 :: Num a => Vector a init0 = [0,0,0] -- Now we have an Iterated Function System: ws :: Fractional a => IFS a ws = let wl = [w0,w1,w2] in listArray (0, length wl - 1) wl -- And here is the result: result :: [Vector Rational] result = let ws' = ws -- make it monomorph f init r = (ws'!r) init in scanl f init0 (randomRs (bounds ws') (mkStdGen 215)) -- (read "42" :: StdGen) -- where "randomRs" computes a list of random indices in the range 0-2, -- which simulates flipping the coin in Barnsley. -------- mkNote :: [Rational] -> Melody.T () mkNote [a,b,c] = Music.rest (Dur.fromRatio (b/20)) +:+ Melody.note (Pitch.fromInt (round a)) (Dur.fromRatio (c/20)) () mkNote _ = error "mkNote: Need three components." {- Of course, a triple would be the better type but that would complicate the vector computation. -} sourceToMusic :: [[Rational]] -> Melody.T () sourceToMusic s = Music.chord (map mkNote s) song :: Melody.T () song = Music.transpose (-12) (sourceToMusic (take 128 result)) haskore-0.2.0.3/src/Haskore/Example/Miscellaneous.lhs0000644000000000000000000002250711754016451020577 0ustar0000000000000000\subsection{Haskore in Action} \seclabel{examples} \begin{haskelllisting} > module Haskore.Example.Miscellaneous where > > import Haskore.Composition.Trill as Trill > import Haskore.Composition.Drum as Drum > > import qualified Haskore.Music as Music > import Haskore.Music (rest, delay, (/=:)) > import Haskore.Music.GeneralMIDI as MidiMusic > import qualified Haskore.Music.Rhythmic as RhyMusic > import qualified Haskore.Melody as Melody > import Haskore.Melody.Standard as StdMelody > import qualified Haskore.Performance.Context as Context > import qualified Haskore.Interface.MIDI.InstrumentMap as InstrMap > import qualified Haskore.Interface.MIDI.Write as WriteMidi > import qualified Haskore.Interface.MIDI.Read as ReadMidi > import qualified Haskore.Interface.MIDI.Render as Render > import qualified Sound.MIDI.File.Save as SaveMidi > import qualified Sound.MIDI.File.Load as LoadMidi > import qualified Sound.MIDI.File as MidiFile > import qualified Sound.MIDI.General as GeneralMidi > import qualified Haskore.Example.SelfSim as SelfSim > import qualified Haskore.Example.ChildSong6 as ChildSong6 > import qualified Haskore.Example.Ssf as Ssf > import Haskore.Basic.Duration ((%+)) > import qualified Numeric.NonNegative.Wrapper as NonNeg > import Data.Tuple.HT (fst3, snd3, thd3, ) > t0, t1, t2, t3, t4, t5, > t10s, t12, t12a, t13, t13a, t13b, t13c, t13d, t13e, > t14, t14b, t14c, t14d, cs6, ssf0 :: MidiFile.T > piano, vibes, flute :: GeneralMidi.Instrument > piano = GeneralMidi.AcousticGrandPiano > vibes = GeneralMidi.Vibraphone > flute = GeneralMidi.Flute \end{haskelllisting} Simple examples of Haskore in action. Note that this module also imports modules ChildSong6, SelfSim, and Ssf. \vspace{2ex} \hrule{\hfill} From the tutorial, try things such as pr12, cMajArp, cMajChd, etc. and try applying inversions, retrogrades, etc. on the same examples. Also try \code{ChildSong.song}. For example: \begin{haskelllisting} > t0 = Render.generalMidiDeflt ChildSong6.song \end{haskelllisting} \hrule{\hfill} C Major scale for use in examples below: \begin{haskelllisting} > cms', cms :: Melody.T () > cms' = line (map (\n -> n en ()) > [c 0, d 0, e 0, f 0, g 0, a 0, b 0, c 1]) > cms = changeTempo 2 cms' > drumScale :: MidiMusic.T > drumScale = > line (map (\n -> Drum.toMusicDefaultAttr (toEnum (n+13)) sn) > [0,2,4,5,7,9,11,12]) \end{haskelllisting} Test of various articulations and dynamics: \begin{haskelllisting} > t1 = Render.generalMidi > (staccato (sn/10) drumScale +:+ > drumScale +:+ > legato (sn/10) drumScale ) > > temp, mu2 :: MidiMusic.T > temp = MidiMusic.fromMelodyNullAttr piano (crescendo 4.0 (c 0 en ())) > > mu2 = MidiMusic.fromMelodyNullAttr vibes > (diminuendo 0.75 cms +:+ > crescendo 0.75 (loudness1 0.25 cms)) > t2 = Render.generalMidiDeflt mu2 > > t3 = Render.generalMidiDeflt (MidiMusic.fromMelodyNullAttr flute > (accelerando 0.3 cms +:+ > ritardando 0.6 cms )) \end{haskelllisting} \hrule{\hfill} A function to recursively apply transformations \code{f'} (to elements in a sequence) and \code{g'} (to accumulated phrases): \begin{haskelllisting} > rep :: (Music.T note -> Music.T note) > -> (Music.T note -> Music.T note) > -> Int -> Music.T note -> Music.T note > rep _ _ 0 _ = rest 0 > rep f' g' n m = m =:= g' (rep f' g' (n-1) (f' m)) \end{haskelllisting} An example using "rep" three times, recursively, to create a "cascade" of sounds. \begin{haskelllisting} > run, cascade, cascades :: Melody.T () > run = rep (transpose 5) (delay tn) 8 (c 0 tn ()) > cascade = rep (transpose 4) (delay en) 8 run > cascades = rep id (delay sn) 2 cascade > > t4' :: Melody.T () -> MidiFile.T > t4' x = Render.generalMidiDeflt (MidiMusic.fromMelodyNullAttr piano x) > t4 = Render.generalMidiDeflt (MidiMusic.fromMelodyNullAttr piano > (cascades +:+ Music.reverse cascades)) \end{haskelllisting} What happens if we simply reverse the \code{f} and \code{g} arguments? \begin{haskelllisting} > run', cascade', cascades' :: Melody.T () > run' = rep (delay tn) (transpose 5) 4 (c 0 tn ()) > cascade' = rep (delay en) (transpose 4) 6 run' > cascades' = rep (delay sn) id 2 cascade' > t5 = Render.generalMidiDeflt (MidiMusic.fromMelodyNullAttr piano cascades') \end{haskelllisting} \hrule{\hfill} Example from the SelfSim module. \begin{haskelllisting} > t10s = Render.generalMidiDeflt (rep (delay SelfSim.durss) (transpose 4) 2 SelfSim.ss) \end{haskelllisting} \hrule{\hfill} Example from the ChildSong6 module. \begin{haskelllisting} > cs6 = Render.generalMidiDeflt ChildSong6.song \end{haskelllisting} \hrule{\hfill} Example from the Ssf (Stars and Stripes Forever) module. \begin{haskelllisting} > ssf0 = Render.generalMidiDeflt Ssf.song \end{haskelllisting} \hrule{\hfill} Midi percussion test. Plays all "notes" in a range. (Requires adding an instrument for percussion to the \code{InstrMap}.) \begin{haskelllisting} > drums :: GeneralMidi.Drum -> GeneralMidi.Drum -> MidiMusic.T > drums dr0 dr1 = > line (map (\drm -> Drum.toMusicDefaultAttr drm sn) [dr0..dr1]) > > t11 :: GeneralMidi.Drum -> GeneralMidi.Drum -> MidiFile.T > t11 dr0 dr1 = Render.generalMidiDeflt (drums dr0 dr1) \end{haskelllisting} \hrule{\hfill} Test of \function{Music.take} and shorten. \begin{haskelllisting} > t12 = Render.generalMidiDeflt (Music.take 4 ChildSong6.song) > t12a = > Render.generalMidiDeflt > (MidiMusic.fromMelodyNullAttr piano cms /=: ChildSong6.song) \end{haskelllisting} \hrule{\hfill} Tests of the trill functions. \begin{haskelllisting} > t13note :: MidiMusic.T > t13note = MidiMusic.fromMelodyNullAttr piano (c 1 qn ()) > t13 = Render.generalMidiDeflt (trill 1 sn t13note) > t13a = Render.generalMidiDeflt (trill' 2 dqn t13note) > t13b = Render.generalMidiDeflt (trillN 1 5 t13note) > t13c = Render.generalMidiDeflt (trillN' 3 7 t13note) > t13d = Render.generalMidiDeflt (roll tn t13note) > t13e = Render.generalMidiDeflt (changeTempo (2/3) (transpose 2 (trillN' 2 7 t13note))) \end{haskelllisting} \hrule{\hfill} Tests of drum. \begin{haskelllisting} > t14 = Render.generalMidiDeflt (Drum.toMusicDefaultAttr AcousticSnare qn) \end{haskelllisting} A "funk groove" \begin{haskelllisting} > t14b = let p1 = Drum.toMusicDefaultAttr LowTom qn > p2 = Drum.toMusicDefaultAttr AcousticSnare en > in Render.generalMidiDeflt (changeTempo 3 (Music.replicate 4 > (line [p1, qnr, p2, qnr, p2, > p1, p1, qnr, p2, enr] > =:= roll en (Drum.toMusicDefaultAttr ClosedHiHat 2)))) \end{haskelllisting} A "jazz groove" \begin{haskelllisting} > t14c = let p1 = Drum.toMusicDefaultAttr CrashCymbal2 qn > p2 = Drum.toMusicDefaultAttr AcousticSnare en > p3 = Drum.toMusicDefaultAttr LowTom qn > in Render.generalMidiDeflt (changeTempo 3 (Music.replicate 8 > ((p1 +:+ changeTempo (3%+2) (p2 +:+ enr +:+ p2)) > =:= (p3 +:+ qnr)) )) > t14d = let p1 = Drum.toMusicDefaultAttr LowTom en > p2 = Drum.toMusicDefaultAttr AcousticSnare hn > in Render.generalMidiDeflt(line [roll tn p1, > p1, > p1, > rest en, > roll tn p1, > p1, > p1, > rest qn, > roll tn p2, > p1, > p1] ) \end{haskelllisting} \hrule{\hfill} \paragraph{Tests of the MIDI interface.} \code{MidiMusic.T} into a MIDI file. \begin{haskelllisting} > tab :: MidiMusic.T -> IO () > tab m = SaveMidi.toFile "test.mid" (Render.generalMidiDeflt m) \end{haskelllisting} \code{MidiMusic.T} to a MidiFile datatype and back to Music. \begin{haskelllisting} > type StdContext = > Context.T NonNeg.Float Float (RhyMusic.Note MidiMusic.Drum MidiMusic.Instr) > -- type StdContext = Pf.Context NonNeg.Float Float MidiMusic.Note -- rejected by Hugs > type MidiArrange = > (InstrMap.ChannelTable MidiMusic.Instr, StdContext, MidiMusic.T) > tad :: MidiMusic.T -> MidiArrange > tad = ReadMidi.toGMMusic . Render.generalMidiDeflt \end{haskelllisting} A MIDI file to a MidiFile datatype and back to a MIDI file. \begin{haskelllisting} > tcb, tc, tcd, tcdab :: FilePath -> IO () > tcb file = LoadMidi.fromFile file >>= SaveMidi.toFile "test.mid" \end{haskelllisting} MIDI file to MidiFile datatype. \begin{haskelllisting} > tc file = LoadMidi.fromFile file >>= print \end{haskelllisting} MIDI file to \code{MidiMusic.T}, a \code{InstrMap}, and a \code{Context}. \begin{haskelllisting} > tcd file = do > x <- fmap ReadMidi.toGMMusic > (LoadMidi.fromFile file) > print $ fst3 (x::MidiArrange) > print $ snd3 x > print $ thd3 x \end{haskelllisting} A MIDI file to \code{MidiMusic.T} and back to a MIDI file. \begin{haskelllisting} > tcdab file = > LoadMidi.fromFile file >>= > (SaveMidi.toFile "test.mid" . WriteMidi.fromGMMusic . > (id::MidiArrange -> MidiArrange) . ReadMidi.toGMMusic) \end{haskelllisting} haskore-0.2.0.3/src/Haskore/Example/Ssf.lhs0000644000000000000000000000246411754016451016527 0ustar0000000000000000The first phrase of the flute part of "Stars and Stripes Forever." \begin{haskelllisting} > module Haskore.Example.Ssf where > import Haskore.Composition.Trill as Trill > import Haskore.Melody as Melody > import Haskore.Music.GeneralMIDI as MidiMusic > > shortLegato :: Melody.T () -> Melody.T () > shortLegato = legato (sn/10) > > m1, m2, m3, m4 :: [Melody.T ()] > m1 = [ trillN 2 5 (bf 2 en ()), > defltStaccato (line [ef 3 en (), > ef 2 en (), > ef 3 en ()])] > > m2 = [shortLegato (line [bf 2 sn (), > c 3 sn (), > bf 2 sn (), > g 2 sn ()]), > defltStaccato (line [ef 2 en (), > bf 1 en ()])] > > m3 = [shortLegato (line [ef 2 sn (), > f 2 sn (), > g 2 sn (), > af 2 sn ()]), > defltStaccato (line [bf 2 en (), > ef 3 en ()])] > > m4 = [ trill 2 tn (bf 2 qn ()), > bf 2 sn (), > denr] > > melody :: Melody.T () > melody = line (m1 ++ m2 ++ m3 ++ m4) > song :: MidiMusic.T > song = MidiMusic.fromMelodyNullAttr MidiMusic.Flute (changeTempo 2 melody) haskore-0.2.0.3/src/Haskore/Example/Flip.hs0000644000000000000000000000547711754016451016521 0ustar0000000000000000module Haskore.Example.Flip where import Haskore.Melody as Melody import Haskore.Music.GeneralMIDI as MidiMusic import Data.Array (Array, (!), listArray) import qualified Data.List as List {- flipSeq 2 !! n = parity of number of 1's in binary representation of n. http://www.research.att.com/cgi-bin/access.cgi/as/njas/sequences/eisA.cgi?Anum=A010060 -} flipSeq :: Int -> [Int] flipSeq n = let incList m = map (\x -> mod (x+m) n) recourse y = let z = concatMap (flip incList y) [1..(n-1)] in z ++ recourse (y++z) in [0] ++ recourse [0] {- based on Helmut Podhaisky's implementation it must be flipSeq2 == flipSeq 2 -} flipSeq2 :: [Int] flipSeq2 = let recourse y = let z = map (1-) y in z ++ recourse (y++z) in [0] ++ recourse [0] noteArray :: [() -> Melody.T ()] -> Array Int (Melody.T ()) noteArray ns = listArray (0, length ns - 1) (map (\n -> n ()) ns) makeSong :: [() -> Melody.T ()] -> Melody.T () makeSong ms = line (map (noteArray ms ! ) (flipSeq (length ms))) song, song1, core, core1 :: Melody.T () song = changeTempo 8 core core = makeSong [e 1 qn, g 1 qn, c 2 qn, e 2 qn] song1 = changeTempo 8 core1 core1 = let rep = 16 in line $ zipWith (!) (cycle (List.replicate rep (noteArray [e 1 qn, a 1 qn, c 2 qn, e 2 qn]) ++ List.replicate rep (noteArray [g 1 qn, c 2 qn, e 2 qn, g 2 qn]) ++ List.replicate rep (noteArray [a 1 qn, d 2 qn, f 2 qn, a 2 qn]) ++ List.replicate rep (noteArray [a 1 qn, c 2 qn, f 2 qn, a 2 qn]) ++ List.replicate rep (noteArray [a 1 qn, c 2 qn, e 2 qn, a 2 qn]))) (flipSeq 4) {- If you divide the stream into blocks of size n each block will contain each of the indices of {0,..,n-1} exactly once. Thus you can also choose musical atoms of different length for generating rythms. -} song2, core2 :: MidiMusic.T song2 = changeTempo 4 core2 core2 = let rep = 16 flipper = MidiMusic.fromMelodyNullAttr MidiMusic.AcousticGrandPiano $ line $ zipWith (!) (cycle (List.replicate rep (noteArray [e 1 dqn, a 1 en, c 2 qn, e 2 qn]) ++ List.replicate rep (noteArray [g 1 dqn, c 2 en, e 2 qn, g 2 qn]) ++ List.replicate rep (noteArray [a 1 dqn, d 2 en, f 2 qn, a 2 qn]) ++ List.replicate rep (noteArray [a 1 dqn, c 2 en, f 2 qn, a 2 qn]) ++ List.replicate rep (noteArray [a 1 dqn, c 2 en, e 2 qn, a 2 qn]) ++ List.replicate rep (noteArray [a 1 dqn, c 2 en, e 2 qn, a 2 qn]))) (flipSeq 4) bassLine = MidiMusic.fromMelodyNullAttr MidiMusic.Viola $ transpose (-12) $ line $ cycle $ concatMap (List.replicate 8) $ List.map ($ ()) [a 0 hn, c 1 hn, d 1 hn, f 1 hn, a 1 hn, a 0 hn] in flipper =:= bassLine haskore-0.2.0.3/src/Haskore/Example/Detail.hs0000644000000000000000000000436311754016451017022 0ustar0000000000000000{- | Create chord patterns with controlable level of details. -} module Haskore.Example.Detail where import qualified Haskore.Basic.Pitch as Pitch import Haskore.Basic.Pitch (Class(..)) import qualified Haskore.Melody as Melody import qualified Haskore.Music.GeneralMIDI as MidiMusic import qualified Haskore.Music as Music import qualified System.Random as Random import System.Random (RandomGen, randomR, mkStdGen, ) import Control.Monad.Trans.State (State, state, evalState, ) import Data.Maybe.HT (toMaybe, ) import qualified Data.List as List levels :: [[Pitch.T]] levels = ((0,C) : []) : ((0,C) : (1,C) : []) : ((0,C) : (1,C) : (0,G) : []) : ((0,C) : (1,C) : (0,G) : (0,E) : []) : ((0,C) : (1,C) : (0,G) : (0,E) : (0,D) : (0,F) : []) : [] {- candidate for Utility cf. Data.MarkovChain.randomItem -} randomItem :: (RandomGen g) => [a] -> State g a randomItem x = fmap (x!!) (randomRState (0, length x - 1)) {- | 'System.Random.randomR' wrapped in a State monad. -} randomRState :: (RandomGen g) => (Int,Int) -> State g Int randomRState bnds = state (randomR bnds) merge :: [a] -> [a] -> [a] merge xs ys = concat (zipWith (\x y -> [x,y]) xs ys) dyadicPattern :: [Pitch.T] dyadicPattern = foldl1 merge $ zipWith (\g level -> flip evalState g (sequence (repeat (randomItem level)))) (List.unfoldr (Just . Random.split) (mkStdGen 925)) $ levels simpleSong :: MidiMusic.T simpleSong = Music.changeTempo 2 $ Music.take 10 $ MidiMusic.fromMelodyNullAttr MidiMusic.AcousticGrandPiano $ MidiMusic.line $ List.map (\p -> Melody.note p MidiMusic.sn ()) dyadicPattern dyadicLevelPattern :: [(Int, Pitch.T)] dyadicLevelPattern = foldl1 merge $ zipWith3 (\g i level -> map ((,) i) $ flip evalState g (sequence (repeat (randomItem level)))) (List.unfoldr (Just . Random.split) (mkStdGen 925)) [0..] $ levels song :: MidiMusic.T song = Music.changeTempo 2 $ MidiMusic.fromMelodyNullAttr MidiMusic.AcousticGrandPiano $ MidiMusic.line $ List.map (maybe MidiMusic.snr (\p -> Melody.note p MidiMusic.sn ())) $ List.zipWith (\li (l,p) -> toMaybe (l<=li) p) (concatMap (replicate (2 * 2 ^ length levels)) [0 .. length levels]) $ dyadicLevelPattern haskore-0.2.0.3/src/Haskore/Example/HeilandHimmel.hs0000644000000000000000000000457611754016451020326 0ustar0000000000000000{- | Christman song "O Heiland, reiß die Himmel auf" from "Du wurdest meine Sonne - Heft I: Advents- und Weihnachtslieder in einfachen Sätzen" Evangelische Verlagsanstalt Berlin fileFromGeneralMIDIMusic "heiland.mid" song -} module Haskore.Example.HeilandHimmel where import Haskore.Melody.Standard as Melody import Haskore.Music.GeneralMIDI as MidiMusic noAttr :: [Melody.NoteAttributes -> Melody.T] -> Melody.T noAttr = line . map ($ na) melody0, melody1, melody2, melody3, bass0, bass1, bass2, bass3 :: Melody.T melody0 = d 0 qn na +:+ (d 0 hn na =:= f 0 hn na) +:+ (e 0 qn na =:= g 0 qn na) +:+ ((f 0 qn na +:+ e 0 qn na) =:= a 0 hn na) +:+ d 0 qn na +:+ (d 0 hn na +:+ cs 0 qn na =:= f 0 qn na +:+ e 0 hn na) +:+ d 0 dhn na bass0 = noAttr $ [d 1 qn, d 1 qn, c 1 qn, bf 0 qn, a 0 hn, bf 0 qn, bf 0 qn, g 0 qn, a 0 qn, d 0 qn, a 0 qn, d 1 qn] melody1 = (f 0 qn na =:= a 0 qn na) +:+ (e 0 qn na =:= a 0 qn na) +:+ (d 0 qn na =:= b 0 qn na) +:+ ((c 0 qn na +:+ d 0 qn na) =:= c 1 hn na) +:+ f 0 qn na +:+ (f 0 hn na +:+ e 0 qn na =:= a 0 qn na +:+ g 0 hn na) +:+ f 0 dhn na bass1 = noAttr $ [d 1 qn, c 1 qn, b 0 qn, a 0 hn, d 1 qn, d 1 qn, bf 0 qn, c 1 qn, f 0 qn, c 1 qn, f 1 qn] melody2 = (g 0 hn na =:= c 1 qn na +:+ c 1 qn na) +:+ (f 0 qn na =:= c 1 qn na) +:+ (e 0 qn na +:+ g 0 qn na =:= c 1 hn na) +:+ a 0 qn na +:+ (a 0 qn na +:+ g 0 qn na =:= d 1 hn na) +:+ (f 0 qn na =:= d 1 qn na) +:+ (f 0 qn na +:+ d 0 qn na +:+ e 0 qn na =:= c 1 qn na) bass2 = noAttr $ [f 1 qn, e 1 qn, d 1 qn, c 1 qn, e 1 qn, f 1 qn, bf 0 dhn, c 1 qn, g 0 qn, c 0 qn] melody3 = (f 0 qn na =:= a 0 qn na) +:+ (e 0 qn na =:= a 0 qn na) +:+ (d 0 qn na =:= g 0 qn na) +:+ (d 0 qn na +:+ cs 0 qn na =:= a 0 hn na) +:+ (d 0 qn na =:= f 0 qn na) +:+ (d 0 hn na +:+ cs 0 qn na =:= g 0 qn na +:+ e 0 hn na) +:+ d 0 qn na bass3 = noAttr $ [d 0 hn, e 0 qn, a 0 hn, bf 0 qn, bf 0 qn, g 0 qn, a 0 qn, d 0 hn] melody :: Melody.T melody = melody0 +:+ melody1 +:+ melody2 +:+ melody3 bass :: Melody.T bass = bass0 +:+ bass1 +:+ bass2 +:+ bass3 song :: MidiMusic.T song = changeTempo 1.5 $ MidiMusic.fromStdMelody MidiMusic.PercussiveOrgan (transpose ( 12) melody) =:= MidiMusic.fromStdMelody MidiMusic.StringEnsemble1 (transpose (-12) bass) haskore-0.2.0.3/src/Haskore/Example/BesondrerTag.hs0000644000000000000000000000242511754016451020174 0ustar0000000000000000module Haskore.Example.BesondrerTag where import Haskore.Melody.Standard as Melody import Haskore.Music.GeneralMIDI as MidiMusic import qualified Haskore.Music as Music noAttr :: [Melody.NoteAttributes -> Melody.T] -> Melody.T noAttr = line . map ($ na) bar0, bar1, bass0, bass1 :: Melody.T bar0 = noAttr $ [b 0 qn, g 0 qn, a 0 qn, d 1 en, c 1 en, b 0 qn, a 0 en, g 0 en, a 0 hn, g 0 dqn, fs 0 en, e 0 en, fs 0 en, g 0 qn, a 0 qn, b 0 qn, a 0 hn, g 0 hn] bass0 = noAttr $ [g 1 hn, d 1 hn, e 1 hn, d 1 hn, e 1 hn, c 1 hn, d 1 hn, d 1 hn, g 1 hn, g 1 hn, fs 1 hn, e 1 hn, d 1 hn, b 0 hn, c 1 hn, cs 1 hn, d 1 hn, g 1 hn] bar1 = noAttr $ [d 0 dqn, d 0 en, e 0 qn, fs 0 qn, g 0 qn, a 0 en, g 0 en, fs 0 qn, d 0 qn, g 0 dqn, g 0 en, a 0 qn, b 0 qn, c 1 qn, b 0 qn, a 0 hn, g 0 hn] bass1 = noAttr $ [d 1 hn, c 1 qn, a 0 qn, e 1 qn, cs 1 qn, d 1 qn, c 1 qn, b 0 hn, c 1 qn, cs 1 qn, d 1 hn, d 1 hn, g 1 hn] melody :: Melody.T melody = Music.replicate 2 bar0 +:+ bar1 bass :: Melody.T bass = bass0 +:+ bass1 song :: MidiMusic.T song = changeTempo 2 (MidiMusic.fromStdMelody MidiMusic.AcousticGrandPiano (transpose ( 24) melody) =:= MidiMusic.fromStdMelody MidiMusic.StringEnsemble1 (transpose (-12) bass)) haskore-0.2.0.3/src/Haskore/Basic/0000755000000000000000000000000011754016451014704 5ustar0000000000000000haskore-0.2.0.3/src/Haskore/Basic/Tempo.lhs0000644000000000000000000001164711754016451016511 0ustar0000000000000000\subsubsection{Tempo} \seclabel{tempo} \begin{haskelllisting} > module Haskore.Basic.Tempo where > import qualified Haskore.Basic.Pitch as Pitch > import Haskore.Basic.Duration (qn, en, sn, (%+), ) > import qualified Haskore.Music as Music > import Haskore.Music(changeTempo, line, (+:+), (=:=), ) > import qualified Haskore.Melody as Melody > import qualified Haskore.Basic.Duration as Dur > import qualified Data.List as List \end{haskelllisting} \paragraph*{Set tempo.} To make it easier to initialize the duration element of a \code{PerformanceContext.T} (see \secref{performance}), 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{haskelllisting} > metro :: Fractional a => a -> Music.Dur -> a > metro setting dur = 60 / (setting * Dur.toNumber dur) \end{haskelllisting} Additionally we define some common tempos and some range of interpretation as in \figref{tempos}. This means, the tempo Andante may vary between \code{fst andanteRange} and \code{snd andanteRange} beats per minute. For example, \code{metro andante qn} creates a tempo of 92 quarter notes per minute. \begin{figure} %larghissimoRange = ( 30, 40) -- as slow as reasonably possible %adagiettoRange = ( 70, 80) -- slightly faster than adagio %allegrettoRange = (110,150) -- not quite allegro \begin{haskelllisting} > largoRange, larghettoRange, adagioRange, andanteRange, > moderatoRange, allegroRange, prestoRange, prestissimoRange > :: Fractional a => (a,a) > > largoRange = ( 40, 60) -- slowly and broadly > larghettoRange = ( 60, 68) -- a little less slow than largo > adagioRange = ( 66, 76) -- slowly > andanteRange = ( 76,108) -- at a walking pace > moderatoRange = (108,120) -- at a moderate tempo > allegroRange = (120,168) -- quickly > prestoRange = (168,200) -- fast > prestissimoRange = (200,208) -- very fast > > > largo, larghetto, adagio, andante, moderato, allegro, > presto, prestissimo :: Fractional a => a > > average :: Fractional a => a -> a -> a > average x y = (x+y)/2 > > largo = uncurry average largoRange > larghetto = uncurry average larghettoRange > adagio = uncurry average adagioRange > andante = uncurry average andanteRange > moderato = uncurry average moderatoRange > allegro = uncurry average allegroRange > presto = uncurry average prestoRange > prestissimo = uncurry average prestissimoRange \end{haskelllisting} \caption{Common names for tempo.} \figlabel{tempos} \end{figure} % http://en.wikipedia.org/wiki/Tempo % http://groups.google.de/groups?q=adagio+andante+allegro+bpm&hl=de&lr=&ie=UTF-8&selm=25919-385E77EA-28%40storefull-615.iap.bryant.webtv.net&rnum=5 \begin{figure*} \centerline{ \includegraphics[height=2.0in]{Doc/Pics/poly} } \caption{Nested Polyrhythms} \figlabel{polyrhythms} \end{figure*} \paragraph*{Polyrhythms.} For some rhythmical ideas, consider first a simple \keyword{triplet} of eighth notes; it can be expressed as ``\code{Tempo (3\%2) m}'', where \code{m} is a line of three eighth notes. In fact \code{Tempo} can be used to create quite complex rhythmical patterns. For example, consider the ``nested polyrhythms'' shown in \figref{polyrhythms}. They can be expressed quite naturally in Haskore as follows (note the use of the \code{where} clause in \code{pr2} to capture recurring phrases): \begin{haskelllisting} > pr1, pr2 :: Pitch.T -> Melody.T () > pr1 p = > changeTempo (5%+6) > (changeTempo (4%+3) > (line [mkLn 1 p qn, > changeTempo (3%+2) > (line [mkLn 3 p en, > mkLn 2 p sn, > mkLn 1 p qn] ), > mkLn 1 p qn]) +:+ > changeTempo (3%+2) (mkLn 6 p en)) > > pr2 p = > changeTempo (7%+6) > (line [m1, > changeTempo (5%+4) (mkLn 5 p en), > m1, > mkLn 2 p en]) > where m1 = changeTempo (5%+4) (changeTempo (3%+2) m2 +:+ m2) > m2 = mkLn 3 p en > > mkLn :: Int -> Pitch.T -> Music.Dur -> Melody.T () > mkLn n p d = line (take n (List.repeat (Melody.note p d ()))) \end{haskelllisting} To play polyrhythms \code{pr1} and \code{pr2} in parallel using middle C and middle G, respectively, we would do the following (middle C is in the 5th octave): \begin{haskelllisting} > pr12 :: Melody.T () > pr12 = pr1 (5, Pitch.C) =:= pr2 (5, Pitch.G) \end{haskelllisting} \paragraph*{Symbolic Meter Changes} We can implement a notion of ``symbolic meter changes'' of the form ``oldnote = newnote'' (quarter note = dotted eighth, for example) by defining a function: \begin{haskelllisting} > (=/=) :: Music.Dur -> Music.Dur -> Music.T note -> Music.T note > old =/= new = changeTempo (new/old) \end{haskelllisting} Of course, using the new function is not much longer than using \code{changeTempo} directly, but it may have nemonic value. haskore-0.2.0.3/src/Haskore/Basic/Pitch.lhs0000644000000000000000000000676511754016451016501 0ustar0000000000000000\subsubsection{Pitch} \seclabel{pitch} Perhaps the most basic musical idea is that of a \keyword{pitch}, which consists of an \keyword{octave} and a \keyword{pitch class} (i.e. one of 12 semi-tones, cf. \secref{discussion:pitch}): \begin{haskelllisting} > module Haskore.Basic.Pitch where > import Data.Ix(Ix) > type T = (Octave, Class) > data Class = Cf | C | Cs | Df | D | Ds | Ef | E | Es | Ff | F | Fs > | Gf | G | Gs | Af | A | As | Bf | B | Bs > deriving (Eq,Ord,Ix,Enum,Show,Read) > type Octave = Int \end{haskelllisting} So a \type{Pitch.T} is a pair consisting of a pitch class and an octave. Octaves are just integers, but we define a datatype for pitch classes, since distinguishing enharmonics (such as $G^\#$ and $A^b$) may be important (especially for notation). \figref{note-freqs} shows the meaning of the some \type{Pitch.T} values. \begin{figure} \begin{center} \begin{tabular}{llr} $A_2$ & \code{(-3,A)} & 27.5 Hz \\ $A_1$ & \code{(-2,A)} & 55.0 Hz \\ $A $ & \code{(-1,A)} & 110.0 Hz \\ $a $ & \code{( 0,A)} & 220.0 Hz \\ $a^1$ & \code{( 1,A)} & 440.0 Hz \\ $a^2$ & \code{( 2,A)} & 880.0 Hz \end{tabular} \end{center} \caption{Note names, Haskore representations and frequencies.} \figlabel{note-freqs} \end{figure} Treating pitches simply as integers is useful in many settings, so let's also define some functions for converting between \type{Pitch.T} values and \type{Pitch.Absolute} values (integers): \begin{haskelllisting} > type Absolute = Int > type Relative = Int > > toInt :: T -> Absolute > toInt (oct,pc) = 12*oct + classToInt pc > > fromInt :: Absolute -> T > fromInt ap = > let (oct, n) = divMod ap 12 > in (oct, [C,Cs,D,Ds,E,F,Fs,G,Gs,A,As,B] !! n) > > classToInt :: Class -> Relative > classToInt pc = case pc of > Cf -> -1; C -> 0; Cs -> 1 -- or should Cf be 11? > Df -> 1; D -> 2; Ds -> 3 > Ef -> 3; E -> 4; Es -> 5 > Ff -> 4; F -> 5; Fs -> 6 > Gf -> 6; G -> 7; Gs -> 8 > Af -> 8; A -> 9; As -> 10 > Bf -> 10; B -> 11; Bs -> 12 -- or should Bs be 0? \end{haskelllisting} Now two functions for parsing and formatting pitch classes in a more human way, that is using '\#' and 'b' suffixes instead of 's' and 'f'. We do not simply use \begin{haskelllisting} > classParse :: ReadS Class > classParse (p:'#':r) = reads (p:'s':r) > classParse (p:'b':r) = reads (p:'f':r) > classParse r = reads r > classFormat :: Class -> ShowS > classFormat pc = > let (p:r) = show pc > in (p:) . > case r of > [] -> id > 's':[] -> ('#':) > 'f':[] -> ('b':) > _ -> error ("classFormat: Pitch.Class.show must not return suffixes" ++ > " other than 's' and 'f'") \end{haskelllisting} Using \type{Pitch.Absolute} we can compute the frequency associated with a pitch: \begin{haskelllisting} > intToFreq :: Floating a => Absolute -> a > intToFreq ap = 440 * 2 ** (fromIntegral (ap - toInt (1,A)) / 12) \end{haskelllisting} We can also define a function \function{Pitch.transpose}, which transposes pitches (analogous to \function{Music.transpose}, which transposes values of type \type{Music.T}): \begin{haskelllisting} > transpose :: Relative -> T -> T > transpose i p = fromInt (toInt p + i) \end{haskelllisting} \begin{exercise} Show that\ \ \code{toInt\ .\ fromInt = id}, and, up to enharmonic equivalences,\newline \code{fromInt\ .\ toInt = id}. \end{exercise} \begin{exercise} Show that\ \ \code{transpose i (transpose j p) = transpose (i+j) p}. \end{exercise} haskore-0.2.0.3/src/Haskore/Basic/Dynamics.lhs0000644000000000000000000000214411754016451017164 0ustar0000000000000000\subsubsection{Dynamics} \seclabel{dynamics} \begin{haskelllisting} > module Haskore.Basic.Dynamics where \end{haskelllisting} These definitions contradict to the rest of Haskore where the normal Velocity is 1 and the default player makes crescendo relative to the starting velocity. According the MIDI specification the velocity shall be a logarithmic scale, thus it should be additive, thus the normal velocity is 0. \begin{haskelllisting} > type Velocity = Rational > type T = Rational > normal, mp, p, pp, ppp, mf, f, ff, fff, > -- levels of softness > mezzoPiano, piano, pianissimo, pianoPianissimo, > -- levels of loudness > mezzoForte, forte, fortissimo, forteFortissimo :: Velocity > normal = 0 > mezzoPiano = -1 > piano = -3 > pianissimo = -5 > pianoPianissimo = -7 > mezzoForte = 1 > forte = 3 > fortissimo = 5 > forteFortissimo = 7 > mp = mezzoPiano > p = piano > pp = pianissimo > ppp = pianoPianissimo > mf = mezzoForte > f = forte > ff = fortissimo > fff = forteFortissimo \end{haskelllisting} Cf. MIDI 1.0 Detailed Specification, Document Version 4.2, February 1996, page 10 haskore-0.2.0.3/src/Haskore/Basic/Duration.lhs0000644000000000000000000000651611754016451017211 0ustar0000000000000000\subsubsection{Duration} \seclabel{duration} \begin{haskelllisting} > module Haskore.Basic.Duration where > import qualified Medium.Temporal as TemporalMedium > import Data.Ratio((%)) > import qualified Haskore.General.Utility as Utility > import Haskore.General.Map (Map) > import qualified Haskore.General.Map as Map > import qualified Numeric.NonNegative.Wrapper as NonNeg \end{haskelllisting} \begin{haskelllisting} > type T = TemporalMedium.Dur > type Ratio = T > type Offset = Rational > infixl 7 %+ > (%+) :: Integer -> Integer -> T > (%+) x y = fromRatio (x%y) > fromRatio :: Rational -> T > fromRatio = NonNeg.fromNumberMsg "Duration.fromRatio" > toRatio :: T -> Rational > toRatio = NonNeg.toNumber > toNumber :: Fractional a => T -> a > toNumber = fromRational . NonNeg.toNumber > scale :: Ratio -> T -> T > scale = (*) > add :: Offset -> T -> T > add d = NonNeg.fromNumberMsg "Duration.add" . (d+) . toRatio \end{haskelllisting} \function{add} may have undefined result. \begin{haskelllisting} > divide :: T -> T -> Integer > divide r1 r2 = Utility.divide (toRatio r1) (toRatio r2) > divisible :: T -> T -> Bool > divisible r1 r2 = Utility.divisible (toRatio r1) (toRatio r2) > gcd :: T -> T -> T > gcd r1 r2 = fromRatio (Utility.gcdDur (toRatio r1) (toRatio r2)) \end{haskelllisting} \begin{haskelllisting} > dotted, doubleDotted :: T -> T > dotted = ((3%+2) *) > doubleDotted = ((7%+4) *) > > bn, wn, hn, qn, en, sn, tn, sfn :: T > dwn, dhn, dqn, den, dsn, dtn :: T > ddhn, ddqn, dden :: T > > bn = 2 -- brevis > wn = 1 -- whole note > hn = 1%+ 2 -- half note > qn = 1%+ 4 -- quarter note > en = 1%+ 8 -- eight note > sn = 1%+16 -- sixteenth note > tn = 1%+32 -- thirty-second note > sfn = 1%+64 -- sixty-fourth note > > dwn = dotted wn -- dotted whole note > dhn = dotted hn -- dotted half note > dqn = dotted qn -- dotted quarter note > den = dotted en -- dotted eighth note > dsn = dotted sn -- dotted sixteenth note > dtn = dotted tn -- dotted thirty-second note > > ddhn = doubleDotted hn -- double-dotted half note > ddqn = doubleDotted qn -- double-dotted quarter note > dden = doubleDotted en -- double-dotted eighth note \end{haskelllisting} \begin{haskelllisting} > nameDictionary :: Map T String > nameDictionary = > let names = "b" : "w" : "h" : "q" : "e" : "s" : "t" : "sf" : [] > durs = zip (iterate (/2) 2) names > ddurs = map (\(d,s) -> (dotted d, "d" ++s)) durs > dddurs = map (\(d,s) -> (doubleDotted d, "dd"++s)) durs > in Map.fromList $ > durs ++ > take 6 (drop 1 ddurs) ++ > take 3 (drop 2 dddurs) > {- | > Converts @1%4@ to @\"qn\"@ and so on. > -} > toString :: T -> String > toString dur = > maybe > ("(" ++ show dur ++ ")") > (++"n") > (Map.lookup nameDictionary dur) \end{haskelllisting} Check proper formatting. \begin{haskelllisting} > propToString :: Bool > propToString = > all (\(dur,name) -> toString dur == name) $ > (bn, "bn") : (wn, "wn") : (hn, "hn") : (qn, "qn") : > (en, "en") : (sn, "sn") : (tn, "tn") : (sfn, "sfn") : > (dwn, "dwn") : (dhn, "dhn") : (dqn, "dqn") : > (den, "den") : (dsn, "dsn") : (dtn, "dtn") : > (ddhn, "ddhn") : (ddqn, "ddqn") : (dden, "dden") : [] \end{haskelllisting} haskore-0.2.0.3/src/Haskore/Basic/Scale.lhs0000644000000000000000000000530711754016451016450 0ustar0000000000000000% from AutoTrack by Stefan Ratschan \subsubsection{Scales} \begin{haskelllisting} > module Haskore.Basic.Scale > (T, ionian, dorian, phrygian, lydian, mixolydian, > aeolian, lokrian, altered, htwt, wtht, > ionianRel, dorianRel, phrygianRel, lydianRel, mixolydianRel, > aeolianRel, lokrianRel, alteredRel, htwtRel, wthtRel, > > fromOffsets, fromIntervals, continue) where > import qualified Haskore.Basic.Pitch as Pitch > import Control.Monad(liftM2) \end{haskelllisting} Some of the following code is taken from the EasyScale implementation of Martin Schwenke. \begin{haskelllisting} > type T = [Pitch.Absolute] > type Intervals = [Pitch.Relative] \end{haskelllisting} Make a scale given a list of absolute pitches, usually starting at 0, and a \type{Pitch.Class} representing the root note of the scale. \begin{haskelllisting} > fromOffsets :: [Pitch.Absolute] -> Pitch.Class -> T > fromOffsets ns pc > = map (+ Pitch.classToInt pc) ns \end{haskelllisting} Create a scale from a list of intervals between successive notes. \begin{haskelllisting} > fromIntervals :: Intervals -> Pitch.Class -> T > fromIntervals = fromOffsets . scanl (+) 0 \end{haskelllisting} Continue a scale to all octaves. \begin{haskelllisting} > continue :: T -> T > continue = liftM2 (+) (iterate (12+) 0) \end{haskelllisting} Now some general useful scales from music theory. \begin{haskelllisting} > ionianRel, dorianRel, phrygianRel, lydianRel, mixolydianRel, > aeolianRel, lokrianRel, alteredRel, htwtRel, > wthtRel :: Intervals > ionianRel = [ 2, 2, 1, 2, 2, 2, 1 ] > dorianRel = [ 2, 1, 2, 2, 2, 1, 2 ] > phrygianRel = [ 1, 2, 2, 2, 1, 2, 2 ] > lydianRel = [ 2, 2, 2, 1, 2, 2, 1 ] > mixolydianRel = [ 2, 2, 1, 2, 2, 1, 2 ] > aeolianRel = [ 2, 1, 2, 2, 1, 2, 2 ] > lokrianRel = [ 1, 2, 2, 1, 2, 2, 2 ] > alteredRel = [ 1, 2, 1, 2, 2, 2, 2 ] > htwtRel = [ 1, 2, 1, 2, 1, 2, 1, 2 ] > wthtRel = [ 2, 1, 2, 1, 2, 1, 2, 1 ] > ionian, dorian, phrygian, lydian, mixolydian, > aeolian, lokrian, altered, htwt, > wtht :: Pitch.Class -> T > ionian = fromIntervals ionianRel > dorian = fromIntervals dorianRel > phrygian = fromIntervals phrygianRel > lydian = fromIntervals lydianRel > mixolydian = fromIntervals mixolydianRel > aeolian = fromIntervals aeolianRel > lokrian = fromIntervals lokrianRel > altered = fromIntervals alteredRel > htwt = fromIntervals htwtRel > wtht = fromIntervals wthtRel \end{haskelllisting} Example: Alternatively to applying \function{continue} to a scale you can create an infinitely increasing scale using the definition by intervals, e.g. \code{fromIntervals (cycle ionianRel) Pitch.C}. haskore-0.2.0.3/src/Haskore/Basic/Interval.lhs0000644000000000000000000000267111754016451017206 0ustar0000000000000000\subsubsection{Intervals} \seclabel{intervals} % \url{http://en.wikipedia.org/wiki/Interval_(music)} In music theory, an interval is the difference (a ratio or logarithmic measure) in pitch between two notes and often refers to those two notes themselves (otherwise known as a dyad). Here we list some common names for some possible intervals. \begin{haskelllisting} > module Haskore.Basic.Interval where > unison, minorSecond, majorSecond, minorThird, majorThird, > fourth, fifth, minorSixth, majorSixth, minorSeventh, majorSeventh, > octave, octaveMinorSecond, octaveMajorSecond, octaveMinorThird, > octaveMajorThird, octaveFourth, octaveFifth, octaveMinorSixth, > octaveMajorSixth, octaveMinorSeventh, octaveMajorSeventh :: Integral a => a > unison = 0 > minorSecond = 1 > majorSecond = 2 > minorThird = 3 > majorThird = 4 > fourth = 5 > fifth = 7 > minorSixth = 8 > majorSixth = 9 > minorSeventh = 10 > majorSeventh = 11 > octave = 12 > octaveMinorSecond = octave + minorSecond > octaveMajorSecond = octave + majorSecond > octaveMinorThird = octave + minorThird > octaveMajorThird = octave + majorThird > octaveFourth = octave + fourth > octaveFifth = octave + fifth > octaveMinorSixth = octave + minorSixth > octaveMajorSixth = octave + majorSixth > octaveMinorSeventh = octave + minorSeventh > octaveMajorSeventh = octave + majorSeventh \end{haskelllisting} haskore-0.2.0.3/src/Haskore/General/0000755000000000000000000000000011754016452015241 5ustar0000000000000000haskore-0.2.0.3/src/Haskore/General/Map.hs0000644000000000000000000000530211754016452016312 0ustar0000000000000000module Haskore.General.Map (Map, (!), (\\), null, size, member, lookup, findWithDefault, empty, singleton, insert, insertWith, insertWithKey, insertLookupWithKey, delete, adjust, adjustWithKey, update, updateWithKey, updateLookupWithKey, union, unionWith, unionWithKey, unions, unionsWith, difference, differenceWith, differenceWithKey, intersection, intersectionWith, intersectionWithKey, map, mapWithKey, mapAccum, mapAccumWithKey, mapKeys, mapKeysWith, mapKeysMonotonic, fold, foldWithKey, elems, keys, keysSet, assocs, toList, fromList, fromListWith, fromListWithKey, toAscList, fromAscList, fromAscListWith, fromAscListWithKey, fromDistinctAscList, filter, filterWithKey, partition, partitionWithKey, split, splitLookup, isSubmapOf, isSubmapOfBy, isProperSubmapOf, isProperSubmapOfBy, lookupIndex, findIndex, elemAt, updateAt, deleteAt, findMin, findMax, deleteMin, deleteMax, deleteFindMin, deleteFindMax, updateMin, updateMax, updateMinWithKey, updateMaxWithKey, showTree, showTreeWith, valid) where import qualified Data.Map as Map import Data.Map (Map, (!), (\\), null, size, member, empty, singleton, insert, insertWith, insertWithKey, insertLookupWithKey, delete, adjust, adjustWithKey, update, updateWithKey, updateLookupWithKey, union, unionWith, unionWithKey, unions, unionsWith, difference, differenceWith, differenceWithKey, intersection, intersectionWith, intersectionWithKey, map, mapWithKey, mapAccum, mapAccumWithKey, mapKeys, mapKeysWith, mapKeysMonotonic, fold, foldWithKey, elems, keys, keysSet, assocs, toList, fromList, fromListWith, fromListWithKey, toAscList, fromAscList, fromAscListWith, fromAscListWithKey, fromDistinctAscList, filter, filterWithKey, partition, partitionWithKey, split, splitLookup, isSubmapOf, isSubmapOfBy, isProperSubmapOf, isProperSubmapOfBy, elemAt, updateAt, deleteAt, findMin, findMax, deleteMin, deleteMax, deleteFindMin, deleteFindMax, updateMin, updateMax, updateMinWithKey, updateMaxWithKey, showTree, showTreeWith, valid) import Prelude hiding (lookup, map, filter, null) {- The signatures of the lookup functions in Data.Map are very unfortunate. We replace them by more usable ones here. -} lookup :: Ord k => Map k a -> k -> Maybe a lookup = flip Map.lookup findWithDefault :: Ord k => Map k a -> a -> k -> a findWithDefault dict deflt key = Map.findWithDefault deflt key dict lookupIndex :: Ord k => Map k a -> k -> Maybe Int lookupIndex = flip Map.lookupIndex findIndex :: Ord k => Map k a -> k -> Int findIndex = flip Map.findIndex haskore-0.2.0.3/src/Haskore/General/LoopTreeTaggedGen.lhs0000644000000000000000000000445411754016452021257 0ustar0000000000000000> module Haskore.General.LoopTreeTaggedGen where > import qualified Haskore.General.TagDictionary as Dict Similar to \module{Haskore.General.LoopTreeTagged}, but here the sub-trees are organized in general collection types \type{coll}. Actually we do not want to use generic collections, like Set or so, but we want to store custom data plus sub-trees in \type{coll} type objects. > data T tag coll = > Branch (coll (T tag coll)) > | Tag tag (T tag coll) -- mark a point where we want return to later > | Loop tag -- return to a marked point > -- deriving (Eq, Show) In order to avoid non-standard instance class contexts, undecidable instances and other mess, we define the classes CollEq and CollShow, which allow implementation of Eq and Show instances for collections without making assumptions about the collection members. Coding CollEq and CollShow instances for collections is quite boring because this is mainly replication of code that would be otherwise generated automatically due to a 'deriving' clause. (Proposed by Roberto Zunino 2006-03-11 in haskell-cafe@haskell.org) > class CollEq coll where > collEqual :: Eq tag => coll (T tag coll) -> coll (T tag coll) -> Bool > class CollShow coll where > collShowsPrec :: Show tag => Int -> coll (T tag coll) -> ShowS > instance (Eq tag, CollEq coll) => Eq (T tag coll) where > Branch x0 == Branch x1 = collEqual x0 x1 > Tag tag0 x0 == Tag tag1 x1 = tag0 == tag1 && x0 == x1 > Loop i0 == Loop i1 = i0 == i1 > _ == _ = False > instance (Show tag, CollShow coll) => Show (T tag coll) where > showsPrec p branch = showParen (p>10) > (case branch of > Branch x -> showString "Branch " . collShowsPrec 11 x > Tag i e -> showString "Tag " . showsPrec 11 i > . showString " " . showsPrec 11 e > Loop i -> showString "Loop " . showsPrec 11 i) > unwind :: (Ord tag, Functor coll) => T tag coll -> T tag coll > unwind = > let aux tags branch = > case branch of > Branch x -> Branch (fmap (aux tags) x) > Tag tag sub -> let e' = aux (Dict.insert tag e' tags) sub > in e' > Loop tag -> Dict.lookup tags tag > in aux Dict.empty haskore-0.2.0.3/src/Haskore/General/TagDictionary.hs0000644000000000000000000000106411754016452020337 0ustar0000000000000000{- | For use in Tree and Graph modules. -} module Haskore.General.TagDictionary (T, empty, insert, lookup, singleton) where import Haskore.General.Map (Map, empty, singleton) import qualified Haskore.General.Map as Map import Prelude hiding (lookup) type T tag tree = Map tag tree insert :: Ord tag => tag -> tree -> Map tag tree -> Map tag tree insert = Map.insertWith (error "TagDictionary.insert: multiple definition of tag") lookup :: (Ord tag) => Map tag tree -> tag -> tree lookup dict = Map.findWithDefault dict (error "unknown loop tag") haskore-0.2.0.3/src/Haskore/General/GraphTaggedGen.lhs0000644000000000000000000000343411754016452020564 0ustar0000000000000000> module Haskore.General.GraphTaggedGen where > import qualified Haskore.General.TagDictionary as Dict This is a generalization from \module{Haskore.General.LoopTreeTaggedGen} to general graphs. The addition to that module is ``sharing''. It doesn't seem to be worthwile to put everything into a tree based structure. Instead we maintain a dictionary of sharing branches, where we split the signal either for feedback or for forward sharing. The dictionary structure should be shared with \module{Haskore.General.LoopTreeTagged}. > type T tag coll = Dict.T tag (Tree tag coll) > data Tree tag coll = > Branch (coll (Tree tag coll)) > | Reference tag {- continue at one root of the dictionary, > this can mean feedback or sharing -} > -- deriving (Eq, Show) Cf. \module{Haskore.General.LoopTreeTaggedGen}. > class CollEq coll where > collEqual :: Eq tag => coll (Tree tag coll) -> coll (Tree tag coll) -> Bool > class CollShow coll where > collShowsPrec :: Show tag => Int -> coll (Tree tag coll) -> ShowS > instance (Eq tag, CollEq coll) => Eq (Tree tag coll) where > Branch x0 == Branch x1 = collEqual x0 x1 > Reference i0 == Reference i1 = i0 == i1 > _ == _ = False > instance (Show tag, CollShow coll) => Show (Tree tag coll) where > showsPrec p branch = showParen (p>10) > (case branch of > Branch x -> showString "Branch " . collShowsPrec 11 x > Reference i -> showString "Reference " . showsPrec 11 i) > unwind :: (Ord tag, Functor coll) => T tag coll -> T tag coll > unwind dict = > let aux branch = > case branch of > Branch x -> Branch (fmap aux x) > Reference tag -> Dict.lookup newDict tag > newDict = fmap aux dict > in newDict haskore-0.2.0.3/src/Haskore/General/LoopTreeRecursiveGen.lhs0000644000000000000000000000544011754016452022027 0ustar0000000000000000> module Haskore.General.LoopTreeRecursiveGen where > import qualified Haskore.General.LoopTreeTaggedGen as LTTG > import qualified Haskore.General.TagDictionary as Dict > import Data.Traversable(Traversable) > import qualified Data.Traversable as Traversable > import Control.Monad.Trans.State(StateT, evalState, put, get) > import Control.Monad (liftM, ) The Loop constructor should not be used by users. It is only necessary for interim results of 'toTagged'. With the type \code{data ListTree a b = ListTree a [b]}, a \type{LoopTreeRecursiveGen.T (ListTree a)} is isomoprhic to \type{LoopTreeRecursive.T a}. 'Tag' is a fixed type instead of a type variable since it is only needed for internal issues. > data T coll = > Branch (coll (T coll)) > | Recurse (Fix (T coll)) -- function with a fix-point > | Loop Tag -- tag needed for resolving Recurse by 'unwind' > > type Fix a = a -> a > type Tag = Int > recourse :: Fix (T coll) -> T coll > recourse = Recurse > toTagged :: (Functor coll) => Tag -> T coll -> LTTG.T Tag coll > toTagged n branch = > case branch of > Branch x -> LTTG.Branch (fmap (toTagged n) x) > Recurse fe -> LTTG.Tag n (toTagged (succ n) (fe (Loop n))) > Loop m -> LTTG.Loop m > toTaggedUnique :: (Traversable coll) => Tag -> T coll -> LTTG.T Tag coll > toTaggedUnique n branch = evalState (toTaggedState branch) n > toTaggedState :: (Traversable coll, Enum tag, Monad m) => > T coll -> StateT tag m (LTTG.T tag coll) > toTaggedState branch = > case branch of > Branch x -> liftM LTTG.Branch (Traversable.mapM toTaggedState x) > Recurse fe -> do n <- get > put (succ n) > liftM (LTTG.Tag n) > (toTaggedState (fe (Loop $ fromEnum n))) > Loop m -> return (LTTG.Loop $ toEnum m) > fromTagged :: (Functor coll) => LTTG.T Tag coll -> T coll > fromTagged = > let conv tags branch = > case branch of > LTTG.Branch x -> Branch (fmap (conv tags) x) > LTTG.Tag tag x -> Recurse (\y -> conv > (Dict.insert tag y tags) x) > LTTG.Loop tag -> Dict.lookup tags tag > in conv Dict.empty > instance (Functor coll, LTTG.CollEq coll) => Eq (T coll) where > x == y = toTagged 0 x == toTagged 0 y > > instance (Functor coll, LTTG.CollShow coll) => Show (T coll) where > showsPrec p x = showString "fromTagged " . > showParen (p>10) (showsPrec 11 (toTagged 0 x)) Unwinding, i.e. computing fixpoints: > unwind :: (Functor coll) => T coll -> T coll > unwind (Branch x) = Branch (fmap unwind x) > unwind (Recurse fe) = x where x = unwind (fe x) > unwind (Loop _) = error "unwind: no loop allowed in a tree" haskore-0.2.0.3/src/Haskore/General/GraphRecursiveGen.lhs0000644000000000000000000000706711754016452021346 0ustar0000000000000000> module Haskore.General.GraphRecursiveGen where > import qualified Haskore.General.GraphTaggedGen as GTG > import qualified Haskore.General.TagDictionary as Dict > import Data.Traversable(Traversable) > import qualified Data.Traversable as Traversable > import Control.Monad.Trans.RWS (RWS, evalRWS, put, get, tell, ) > import Control.Monad (liftM, ) This is a generalization of \module{Haskore.General.LoopTreeTaggedGen}. It adds a constructor for sharing interim results. > data T coll = > Branch (coll (T coll)) > | Recurse (Fix (T coll)) -- function with a fix-point > | Share (T coll) (T coll -> T coll) > -- share a sub-expression among deeper sub-expressions > | Reference Tag -- tag needed for resolving Recurse and Share by 'unwind' > > type Fix a = a -> a > type Tag = Int > recourse :: Fix (T coll) -> T coll > recourse = Recurse > share :: (T coll) -> (T coll -> T coll) -> T coll > share = Share Implement this one let x = f y y = g x in h x y with recursion, but without sharing: h (recourse (f . g)) (recourse (g . f)) with recursion of tuples: uncurry h $ recourse (\(x,y) -> (f y, g x)) with recursion and sharing: share (f y) (\x -> share (g x) (\y -> h x y)) -- wrong! > toTaggedUnique :: (Traversable coll) => Tag -> T coll -> GTG.T Tag coll > toTaggedUnique n branch = snd $ evalRWS (toTaggedState branch) () n > toTaggedState :: (Traversable coll) => > T coll -> RWS () (GTG.T Tag coll) Tag (GTG.Tree Tag coll) > toTaggedState branch = > case branch of > Branch x -> liftM GTG.Branch (Traversable.mapM toTaggedState x) > Recurse fe -> do t <- get > put (succ t) > tree <- toTaggedState (fe (Reference t)) > tell (Dict.singleton t tree) > return tree > Share x fe -> do t <- get > put (succ t) > sharedTree <- toTaggedState x > tell (Dict.singleton t sharedTree) > toTaggedState (fe (Reference t)) > Reference t -> return (GTG.Reference t) > {- > fromTagged :: (Eq tag, Functor coll) => GTG.T tag coll -> [T coll] > fromTagged = > let aux branch = > case branch of > Branch x -> Branch (fmap aux x) > Reference tag -> fromMaybe > (error ("unknown reference tag")) > (lookup tag newDict) > newDict = map (\(tag, tree) -> (tag, aux tree)) dict > in newDict > let conv tags branch = > case branch of > GTG.Branch x -> Branch (fmap (conv tags) x) > GTG.Tag tag x -> Recurse (\y -> conv > (LTT.addUnique (tag,y) tags) x) > GTG.Loop tag -> fromMaybe (error ("unknown loop tag")) > (lookup tag tags) > in conv [] > -} > instance (Traversable coll, GTG.CollEq coll) => Eq (T coll) where > x == y = toTaggedUnique 0 x == toTaggedUnique 0 y > > instance (Traversable coll, GTG.CollShow coll) => Show (T coll) where > showsPrec p x = showString "fromTagged " . > showParen (p>10) (showsPrec 11 (toTaggedUnique 0 x)) Unwinding, i.e. computing fixpoints: > unwind :: (Functor coll) => T coll -> T coll > unwind (Branch x) = Branch (fmap unwind x) > unwind (Recurse fe) = x where x = unwind (fe x) > unwind (Reference _) = error "unwind: no loop allowed in a tree" > unwind (Share x fe) = fe (unwind x) haskore-0.2.0.3/src/Haskore/General/LetRec.hs0000644000000000000000000000272211754016452016756 0ustar0000000000000000module Haskore.General.LetRec where import Data.Tuple.HT (mapFst, mapSnd, ) import qualified Data.Map as Map data Expr = Const String | Append Expr Expr | Var Var deriving (Show) type Var = Int type Count = Int knot :: (Count, ([Expr], (Expr, a)) -> ([Expr], (Expr, b))) -> (Count, ([Expr], a) -> ([Expr], b)) knot (count, f) = (succ count, \(equs0, a) -> let (equs1, (rhs, b)) = f (equs0, (Var count, a)) in (rhs : equs1, b)) beginKnot :: (a -> b) -> (Count, ([Expr], a) -> ([Expr], b)) beginKnot f = (0, mapSnd f) endKnot :: (Count, ([Expr], a) -> ([Expr], b)) -> (a -> ([Expr], b)) endKnot f a = snd f ([], a) exampleLet :: (Expr, (Expr, ())) -> (Expr, (Expr, Expr)) exampleLet (a,(b,())) = (Append (Const "ab") b, (Append (Const "c") a, a)) {- Maybe we can replace manual repeated application of 'knot' by a type class method. -} exampleEqus :: ([Expr], Expr) exampleEqus = mapFst reverse $ endKnot (knot (knot (beginKnot exampleLet))) () exampleResult :: String exampleResult = let mapExpr = Map.fromAscList $ zip [0..] $ fst exampleEqus resolve x = case x of Const str -> str Append a b -> resolve a ++ resolve b Var n -> Map.findWithDefault (error $ "unknown variable id " ++ show n ++ " - bug in 'knot'?") n mapRes mapRes = fmap resolve mapExpr in resolve $ snd exampleEqus haskore-0.2.0.3/src/Haskore/General/LoopTreeRecursive.lhs0000644000000000000000000000737111754016452021402 0ustar0000000000000000> module Haskore.General.LoopTreeRecursive where > import qualified Haskore.General.LoopTreeTagged as LTT > import qualified Haskore.General.TagDictionary as Dict > import Control.Monad.Trans.State(StateT, evalState, put, get, ) > import Control.Monad (liftM, ) Loop now needs an ID because there may be more than one of them. > data T a = > Branch a [T a] > | Recurse (Fix (T a)) -- function with a fix-point > | Loop Tag -- tag needed for resolving Recurse by 'unwind' > > type Fix a = a -> a > type Tag = Int > example0 :: T Char > example0 = Recurse (\x -> Branch 'a' [Recurse (\y -> Branch 'b' [y]), x]) > example1 :: T Char > example1 = > Branch 'a' > [Recurse (\x -> Branch 'b' [x]), > Recurse (\y -> Branch 'c' [y])] Implement two interleaved recursions. let x = f y y = g x z z = h y in z > exampleLeapFrog :: T Char > exampleLeapFrog = > Recurse (\z -> Branch 'h' [ > Recurse (\y -> Branch 'g' [ > Branch 'f' [y],z])]) This data structure is very safe to use, that is, it is not possible to loop to undefined tags as in \code{LoopTreeTagged}. But some operations are easier to perform on the tagged variant. Especially we can not inspect the structure of the \code{Recurse} function immediately. Instead we have to place a \code{Loop} marker inside the tree produced by the \code{Recurse} function. In order to turn such a marked tree back into a \code{Recurse} function we have to maintain a dictionary. This is obviously not very efficient. Intensive operations should be applied to the tagged tree. We provide the conversions now. The function \function{toTagged} uses duplicate tags in different branches. They do not cause confusion but reduce data dependencies. > toTagged :: Tag -> T a -> LTT.T Tag a > toTagged n branch = > case branch of > Branch x s -> LTT.Branch x (map (toTagged n) s) > Recurse fe -> LTT.Tag n (toTagged (succ n) (fe (Loop n))) > Loop m -> LTT.Loop m The function \function{toTaggedUnique} employs a State in order to assign tags that are unique overall the whole tree. > toTaggedUnique :: Tag -> T a -> LTT.T Tag a > toTaggedUnique n branch = evalState (toTaggedState branch) n > toTaggedState :: (Enum tag, Monad m) => T a -> StateT tag m (LTT.T tag a) > toTaggedState branch = > case branch of > Branch x s -> liftM (LTT.Branch x) (mapM toTaggedState s) > Recurse fe -> do n <- get > put (succ n) > liftM (LTT.Tag n) > (toTaggedState (fe (Loop (fromEnum n)))) > Loop m -> return (LTT.Loop (toEnum m)) > fromTagged :: (Ord tag) => LTT.T tag a -> T a > fromTagged = > let conv tags branch = > case branch of > LTT.Branch x s -> Branch x (map (conv tags) s) > LTT.Tag tag x -> Recurse (\y -> conv > (Dict.insert tag y tags) x) > LTT.Loop tag -> Dict.lookup tags tag > in conv Dict.empty To check equality of and show Trees, we need to supply unique Tags to each recursive loop, which we do via a simple counter. > instance Eq a => Eq (T a) where > x == y = toTagged 0 x == toTagged 0 y > > instance Show a => Show (T a) where > show = show . toTaggedUnique 0 > > instance Functor T where > fmap f = fromTagged . fmap f . toTagged 0 Unwinding (i.e. computing fixpoints): > unwind :: T a -> T a > unwind (Branch x s) = Branch x (map unwind s) > unwind (Recurse fe) = x where x = unwind (fe x) > unwind (Loop _) = error "unwind: no loop allowed in a tree" The 2nd equation above is analogous to: fix f = x where x = f x And these two equations could also be written as: fix f = f (fix f) unwind (Rec fe) = unwind (fe (Rec fe)) haskore-0.2.0.3/src/Haskore/General/LoopTreeTagged.lhs0000644000000000000000000000373511754016452020626 0ustar0000000000000000> module Haskore.General.LoopTreeTagged where > import qualified Haskore.General.TagDictionary as Dict > data T tag a = > Branch a [T tag a] > | Tag tag (T tag a) -- mark a point where we want return to later > | Loop tag -- return to a marked point > deriving (Eq, Show) The tag for \code{Tag} must be unique, but multiple use in \code{Loop} is allowed. Vice versa tags for \code{Loop} must be defined by a \code{Tag} constructor. > example0 :: T Int Char > example0 = Tag 0 (Branch 'a' [Tag 1 (Branch 'b' [Loop 1]), Loop 0]) \begin{comment} Eq and Show instance (Eq tag, Eq a) => Eq (T tag a) where Branch x xSub == Branch y ySub = x == y && xSub == ySub Tag xTag xSub == Tag yTag ySub = xTag == yTag && xSub == ySub Loop xTag == Loop yTag = xTag == yTag _ == _ = False instance (Show tag, Show a) => Show (T tag a) where show (Const x) = "(Const " ++ show x ++ ")" show (Add e1 e2) = "(Add " ++ show e1 ++ " " ++ show e2 ++ ")" show (Tag i e) = "(Tag " ++ show i ++ " " ++ show e ++ ")" show (Loop i) = "(Loop " ++ show i ++ ")" \end{comment} MapE: > mapE :: (a -> b) -> T tag a -> T tag b > mapE f = > let aux branch = > case branch of > Branch x sub -> Branch (f x) (map aux sub) > Tag tag sub -> Tag tag (aux sub) > Loop tag -> Loop tag > in aux > instance Functor (T tag) where > fmap = mapE Replace all loops by the corresponding super-trees. Internally the compiler should translate this into loops, again, but this cannot be observed by the Haskell code anymore. > unwind :: (Ord tag) => T tag a -> T tag a > unwind = > let aux tags branch = > case branch of > Branch x sub -> Branch x (map (aux tags) sub) > Tag tag sub -> let e' = aux (Dict.insert tag e' tags) sub > in e' > Loop tag -> Dict.lookup tags tag > in aux Dict.empty haskore-0.2.0.3/src/Haskore/General/Utility.lhs0000644000000000000000000001522711754016452017423 0ustar0000000000000000\subsection{Utility functions} \begin{haskelllisting} > module Haskore.General.Utility where > > import Control.Monad.Trans.State (state, runState, ) > import System.Random (RandomGen, randomR, randomRs, mkStdGen, ) > import Data.List.HT (segmentBefore, partition, ) > import Data.List (foldl', ) > import Data.Ratio ((%), denominator, numerator, Ratio, ) > import Data.Maybe (fromMaybe, listToMaybe, ) > import Data.Char (ord, chr, ) > import Data.Word (Word8, ) > import qualified Haskore.General.Map as Map \end{haskelllisting} \function{splitBy} takes a boolean test and a list; it divides up the list and turns it into a {\em list of sub-lists}; each sub-list consists of \begin{enumerate} \item one element for which the test is true (or the first element in the list), and \item all elements after that element for which the test is false. \end{enumerate} For example, \code{splitBy (>10) [27, 0, 2, 1, 15, 3, 42, 4]} yields \code{[ [27,0,2,1], [15,3], [42,4] ]}. \begin{haskelllisting} > splitBy :: (a -> Bool) -> [a] -> [[a]] > splitBy p = dropWhile null . segmentBefore p \end{haskelllisting} \function{segmentBefore} will have at most one empty list at the beginning, which is dropped by \function{dropWhile}. It should have signature segmentBefore :: (a -> Bool) -> [a] -> ([a], [(a, [a])]) or even better segmentBefore :: (a -> Bool) -> [a] -> AlternatingListUniform.T a [a] and could be implemented using Uniform.fromEitherList A variant of \function{foldr} and \function{foldr1} which works only for non-empty lists and initializes the accumulator depending on the last element of the list. \begin{haskelllisting} > foldrf :: (a -> b -> b) -> (a -> b) -> [a] -> b > foldrf f g = > let aux [] = error "foldrf: list must be non-empty" > aux (x:[]) = g x > aux (x:xs) = f x (aux xs) > in aux \end{haskelllisting} Randomly permutate a list. For this purpose we generate a random \type{Bool} value for each item of the list which specifies in what sublist it is inserted. Both sublists are then concatenated hereafter. By repeating this procedure several times the list should be somehow randomly ordered. Some notes about perfect shuffling from Oleg: \url{http://okmij.org/ftp/Haskell/misc.html#perfect-shuffle} \begin{haskelllisting} > shuffle :: RandomGen g => [a] -> g -> ([a],g) > shuffle x g0 = > let (choices,g1) = > runState (mapM (const (state (randomR (False,True)))) x) g0 > xc = zip x choices > in (map fst (uncurry (++) (partition snd xc)), g1) \end{haskelllisting} \function{flattenTuples2} flattens a list of pairs into a list. Similarly, \function{flattenTuples3} flattens a list of 3-tuples into a list, and so on. \begin{haskelllisting} > flattenTuples2 :: [(a,a)] -> [a] > flattenTuples3 :: [(a,a,a)] -> [a] > flattenTuples4 :: [(a,a,a,a)] -> [a] > > flattenTuples2 = concatMap (\(x,y) -> [x,y]) > flattenTuples3 = concatMap (\(x,y,z) -> [x,y,z]) > flattenTuples4 = concatMap (\(x,y,z,w) -> [x,y,z,w]) \end{haskelllisting} Choose the first element from a list, and return the default value, if the list is empty. \begin{haskelllisting} > headWithDefault :: a -> [a] -> a > headWithDefault deflt = fromMaybe deflt . listToMaybe \end{haskelllisting} Implementation with the partial function \function{head}, which is a bad thing. \begin{haskelllisting} headWithDefault deflt xs = head (xs ++ [deflt]) \end{haskelllisting} Compare \begin{haskelllisting} let (x,y) = splitInit [0..] in (last x, y) \end{haskelllisting} and \begin{haskelllisting} let as = [0..]; (x,y) = (init as, last as) in (last x, y) \end{haskelllisting} Variants of \function{zip} and \function{zip3} which check that all argument lists have the same length. \begin{haskelllisting} > zipWithMatch :: (a -> b -> c) -> [a] -> [b] -> [c] > zipWithMatch f (x:xs) (y:ys) = f x y : zipWithMatch f xs ys > zipWithMatch _ [] [] = [] > zipWithMatch _ _ _ = error "zipWithMatch: lengths of lists differ" > zipWithMatch3 :: (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d] > zipWithMatch3 f (x:xs) (y:ys) (z:zs) = f x y z : zipWithMatch3 f xs ys zs > zipWithMatch3 _ [] [] [] = [] > zipWithMatch3 _ _ _ _ = error "zipWithMatch3: lengths of lists differ" \end{haskelllisting} This is a variant of \function{maximum} which returns at least zero, i.e. always a non-negative number. This is necessary for determining the length of a parallel music composition where the empty list has zero duration. \begin{haskelllisting} > maximum0 :: (Ord a, Num a) => [a] -> a > maximum0 = foldl' max 0 \end{haskelllisting} Convert a mapping (i.e. list of pairs) to a function, and use this for a translation function, which translates every character in a by replacing it by looking it up in l2 and replacing it with the according character in l2. \begin{haskelllisting} > translate :: (Ord a) => [ a ] -> [ a ] -> [ a ] -> [ a ] > translate l1 l2 a = > if length l1 == length l2 > then let table = Map.fromList (zip l1 l2) > in map (\x -> Map.findWithDefault table x x) a > else error "translate: lists must have equal lengths" \end{haskelllisting} A random list of integers between 0 and n. \begin{haskelllisting} > randList :: Int -> [ Int ] > randList n = randomRs (0, n) (mkStdGen 0) \end{haskelllisting} Is one rational divisible by another one (i.e., is it a integer multiple of it)? \begin{haskelllisting} > divisible :: Integral a => Ratio a -> Ratio a -> Bool > divisible r1 r2 = > 0 == mod (numerator r1 * denominator r2) > (numerator r2 * denominator r1) \end{haskelllisting} Do the division. \begin{haskelllisting} > divide :: Integral a => Ratio a -> Ratio a -> a > divide r1 r2 = > let (q, r) = divideModulus r1 r2 > in if r == 0 > then q > else error "Utility.divide: rationals are indivisible" > modulus :: Integral a => Ratio a -> Ratio a -> Ratio a > modulus r1 r2 = snd (divideModulus r1 r2) > divideModulus :: Integral a => Ratio a -> Ratio a -> (a, Ratio a) > divideModulus r1 r2 = > let (q, r) = divMod (numerator r1 * denominator r2) > (numerator r2 * denominator r1) > in (q, r % (denominator r1 * denominator r2)) \end{haskelllisting} Also the GCD can be generalized to ratios: \begin{haskelllisting} > gcdDur :: Integral a => Ratio a -> Ratio a -> Ratio a > gcdDur x1 x2 = > let a = numerator x1 > b = denominator x1 > c = numerator x2 > d = denominator x2 > in gcd a c % lcm b d \end{haskelllisting} \begin{haskelllisting} > type ByteList = [Word8] > stringCharFromByte :: ByteList -> String > stringCharFromByte = map (chr . fromIntegral) > stringByteFromChar :: String -> ByteList > stringByteFromChar = map (fromIntegral . ord) \end{haskelllisting} haskore-0.2.0.3/src/Haskore/Music/0000755000000000000000000000000011754016451014743 5ustar0000000000000000haskore-0.2.0.3/src/Haskore/Music/Rhythmic.lhs0000644000000000000000000000764011754016451017251 0ustar0000000000000000A common instance of Music.T. It represents rhythmic music, that is melodies plus drums. The types for melody instruments and drums can be chosen freely. They may be plain strings, enumerations or parametrized instrument descriptions. \begin{haskelllisting} > module Haskore.Music.Rhythmic > (T, Note(..), NoteBody(..), > maybeInstrument, > noteFromAttrs, noteFromStdMelodyNote, noteFromMelodyNote, > fromStdMelody, fromMelodyNullAttr, fromMelody, > > bn, wn, hn, qn, en, sn, tn, sfn, > dwn, dhn, dqn, den, dsn, dtn, > ddhn, ddqn, dden, > bnr, wnr, hnr, qnr, enr, snr, tnr, sfnr, > dwnr, dhnr, dqnr, denr, dsnr, dtnr, > ddhnr, ddqnr, ddenr, > line, chord, changeTempo, transpose, phrase, > (Music.+:+), (Music.=:=), Dur, > > PhraseAttribute(..), Dynamic(..), > Tempo(..), Articulation(..), Ornament(..), NoteHead(..), > accent, crescendo, diminuendo, loudness1, > ritardando, accelerando, staccato, legato, > defltLegato, defltStaccato, > defltAccent, bigAccent) where > import qualified Haskore.Basic.Pitch as Pitch > import Haskore.Basic.Duration hiding (T) > import Haskore.Music hiding (T, partitionMaybe) > import qualified Haskore.Music as Music > import qualified Haskore.Melody as Melody > import qualified Haskore.Melody.Standard as StdMelody > import qualified Data.Accessor.Basic as Accessor > import qualified Data.Record.HT as Record > import Data.Ord.HT (comparing, ) > data Note drum instr = > Note {velocity :: Rational, > body :: NoteBody drum instr} > deriving (Show, Eq) \end{haskelllisting} A note of a rhythmic music can be either a tone of a melody instrument or a drum. Every effect, which has no pitch, is considered as a drum. Naturally \code{Tone}s are affected by transposition whereas \code{Drum}s are not. \begin{haskelllisting} > data NoteBody drum instr = > Tone {instrument :: instr, > pitch :: Pitch.T} > | Drum {drum :: drum} > deriving (Show, Eq, Ord) > -- this order is just for the old test cases which rely on it > instance (Ord instr, Ord drum) => Ord (Note drum instr) where > compare = > Record.compare > [comparing body, > comparing velocity] > type T drum instr = Music.T (Note drum instr) > maybeInstrument :: NoteBody drum instr -> Maybe instr > maybeInstrument (Tone instr _) = Just instr > maybeInstrument (Drum _) = Nothing \end{haskelllisting} A rhythmic music can be created by assigning an instrument to a melody. The function \function{fromStdMelody} does this while preserving common note attributes, and the function \function{fromMelodyNullAttr} ignores the note attributes. This is useful in case no additional attributes are needed. In this case the \type{attr} type variable can be the null type \type{()}. \begin{haskelllisting} > noteFromAttrs :: StdMelody.NoteAttributes -> > NoteBody drum instr -> Note drum instr > noteFromAttrs nas = > Note (Accessor.get StdMelody.velocity1 nas) > noteFromStdMelodyNote :: instr -> StdMelody.Note -> Note drum instr > noteFromStdMelodyNote instr (Melody.Note nas p) = > noteFromAttrs nas (Tone instr p) > noteFromMelodyNote :: > (attr -> (Rational,instr)) -> > Melody.Note attr -> Note drum instr > noteFromMelodyNote attrToInstr (Melody.Note x p) = > let (vel,instr) = attrToInstr x > in Note vel (Tone instr p) > fromStdMelody :: instr -> StdMelody.T -> T drum instr > fromStdMelody instr = Music.mapNote (noteFromStdMelodyNote instr) > -- | ignores the note attributes > fromMelodyNullAttr :: instr -> Melody.T () -> T drum instr > fromMelodyNullAttr instr = > fromStdMelody instr . StdMelody.fromMelodyNullAttr > -- fromMelody (const (1,instr)) > fromMelody :: > (attr -> (Rational,instr)) -> Melody.T attr -> T drum instr > fromMelody attrToInstr = > Music.mapNote (noteFromMelodyNote attrToInstr) \end{haskelllisting} haskore-0.2.0.3/src/Haskore/Music/GeneralMIDI.lhs0000644000000000000000000000337011754016451017476 0ustar0000000000000000A common instance of Music.T. > module Haskore.Music.GeneralMIDI > (T, Note, NoteBody, Instr, > RhyMusic.velocity, RhyMusic.body, > RhyMusic.instrument, RhyMusic.pitch, RhyMusic.drum, > RhyMusic.noteFromStdMelodyNote, > fromStdMelody, fromMelodyNullAttr, > > GM.Instrument(..), GM.Drum(..), > toProgram, toChannel, > > bn, wn, hn, qn, en, sn, tn, sfn, > dwn, dhn, dqn, den, dsn, dtn, > ddhn, ddqn, dden, > bnr, wnr, hnr, qnr, enr, snr, tnr, sfnr, > dwnr, dhnr, dqnr, denr, dsnr, dtnr, > ddhnr, ddqnr, ddenr, > line, chord, changeTempo, transpose, phrase, > (Music.+:+), (Music.=:=), Dur, > > PhraseAttribute(..), Dynamic(..), > Tempo(..), Articulation(..), Ornament(..), NoteHead(..), > accent, crescendo, diminuendo, loudness1, > ritardando, accelerando, staccato, legato, > defltLegato, defltStaccato, > defltAccent, bigAccent) where > import qualified Sound.MIDI.General as GM > import Sound.MIDI.Message.Channel (toChannel, toProgram, ) > import Haskore.Basic.Duration hiding (T) > import Haskore.Music as Music hiding (T) > import qualified Haskore.Music.Rhythmic as RhyMusic > import qualified Haskore.Melody as Melody > import qualified Haskore.Melody.Standard as StdMelody > type Instr = GM.Instrument > type Drum = GM.Drum > type Note = RhyMusic.Note Drum Instr > type NoteBody = RhyMusic.NoteBody Drum Instr > type T = RhyMusic.T Drum Instr > -- | in contrast to RhyMusic.fromStdMelody it has fixed instrument type > fromStdMelody :: Instr -> StdMelody.T -> T > fromStdMelody = RhyMusic.fromStdMelody > fromMelodyNullAttr :: Instr -> Melody.T () -> T > fromMelodyNullAttr = RhyMusic.fromMelodyNullAttr haskore-0.2.0.3/src/Haskore/Music/Standard.lhs0000644000000000000000000000307411754016451017217 0ustar0000000000000000A common instance of Music.T. > module Haskore.Music.Standard > (T, Note, NoteBody, Instr, Drum, > RhyMusic.velocity, RhyMusic.body, > RhyMusic.instrument, RhyMusic.pitch, RhyMusic.drum, > RhyMusic.noteFromStdMelodyNote, > fromStdMelody, fromMelodyNullAttr, > > bn, wn, hn, qn, en, sn, tn, sfn, > dwn, dhn, dqn, den, dsn, dtn, > ddhn, ddqn, dden, > bnr, wnr, hnr, qnr, enr, snr, tnr, sfnr, > dwnr, dhnr, dqnr, denr, dsnr, dtnr, > ddhnr, ddqnr, ddenr, > line, chord, changeTempo, transpose, phrase, > (Music.+:+), (Music.=:=), Dur, > > PhraseAttribute(..), Dynamic(..), > Tempo(..), Articulation(..), Ornament(..), NoteHead(..), > accent, crescendo, diminuendo, loudness1, > ritardando, accelerando, staccato, legato, > defltLegato, defltStaccato, > defltAccent, bigAccent) where > import Haskore.Basic.Duration hiding (T) > import Haskore.Music as Music hiding (T) > import qualified Haskore.Music.Rhythmic as RhyMusic > import qualified Haskore.Melody as Melody > import qualified Haskore.Melody.Standard as StdMelody > type Instr = String > type Drum = String > type Note = RhyMusic.Note Drum Instr > type NoteBody = RhyMusic.NoteBody Drum Instr > type T = RhyMusic.T Drum Instr > -- | in contrast to RhyMusic.fromStdMelody it has fixed instrument type > fromStdMelody :: Instr -> StdMelody.T -> T > fromStdMelody = RhyMusic.fromStdMelody > fromMelodyNullAttr :: Instr -> Melody.T () -> T > fromMelodyNullAttr = RhyMusic.fromMelodyNullAttr haskore-0.2.0.3/src/Haskore/Composition/0000755000000000000000000000000011754016451016166 5ustar0000000000000000haskore-0.2.0.3/src/Haskore/Composition/ChordType.lhs0000644000000000000000000001462111754016451020603 0ustar0000000000000000 \begin{haskelllisting} > module Haskore.Composition.ChordType > (T, toChord, parse, fromString, toString) where > > import qualified Haskore.Composition.Chord as Chord > import qualified Haskore.Basic.Pitch as Pitch > import qualified Text.ParserCombinators.ReadP as ReadP > import Text.ParserCombinators.ReadP (ReadP) > import qualified Data.Array as Array > import Data.Array(Array, Ix, (!), ) > import Data.Tuple.HT (mapSnd, ) > import Control.Monad (liftM2, liftM3, ) \end{haskelllisting} % http://www.geocities.com/melatefet/chordsr.htm \begin{haskelllisting} > data T = Cons Third Fourth [Fifth] > deriving (Show, Eq) > > toChord :: T -> Chord.T > toChord (Cons third fourth fifth) = > scanl (\p (rel,rp) -> if rel then p+rp else rp) 0 > (foldl (flip fifthToSteps) > (fourthToSteps third fourth > (thirdToSteps third)) fifth) > thirdToSteps :: Third -> [Pitch.Relative] > thirdToSteps third = > case third of > ThirdMajor -> [4,3] > ThirdAugmentedFifth -> [4,4] > ThirdDiminishedFifth -> [4,2] > ThirdMinor -> [3,4] > ThirdMinorAugmentedFifth -> [3,5] > ThirdMinorDiminishedFifth -> [3,3] > ThirdDiminished -> [3,3] > ThirdSustained2 -> [2,5] > ThirdSustained4 -> [5,2] > ThirdDiminishedAugmented -> [3,3,3] > absP, relP :: Pitch.Relative -> (Bool,Pitch.Relative) > absP = (,) False > relP = (,) True > fourthToSteps :: > Third -> Fourth -> [Pitch.Relative] -> [(Bool,Pitch.Relative)] > -- (True,p) - p relative pitch to the previous note in the chord > -- (False,p) - p absolute pitch > fourthToSteps third fourth ps = > let bps = map relP ps > in case fourth of > FourthNone -> bps > FourthSecond -> bps++[absP 2] > FourthSixth -> bps++[absP 9] > FourthSixthNineth -> bps++[absP 9, relP 5] > FourthSeventh -> > if third==ThirdDiminished > then bps++[relP 3] > else bps++[absP 10] > FourthMajorSeventh -> bps++[absP 11] > FourthNineth -> bps++[relP 10, absP 2] > FourthMajorNineth -> bps++[absP 11, relP 3] > FourthEleventh -> [absP 7, relP 3, relP 4, absP 5] > FourthThirteenth -> [absP (head ps), relP 5, absP 2, absP 10] > updateNode :: Int -> a -> (a -> a) -> [a] -> [a] > updateNode n deflt f xs = > let (x0,x1) = splitAt n xs > in x0 ++ case x1 of > [] -> [f deflt] > (y:ys) -> f y : ys > incPitch :: Int -> Pitch.Relative -> Pitch.Relative -> > [(Bool,Pitch.Relative)] -> [(Bool,Pitch.Relative)] > incPitch n deflt inc = > updateNode n (False,deflt) (mapSnd (inc+)) > fifthToSteps :: Fifth -> [(Bool,Pitch.Relative)] -> [(Bool,Pitch.Relative)] > fifthToSteps fifth = > case fifth of > FifthAugmentedThird -> incPitch 0 undefined 1 . > incPitch 1 undefined (-1) > FifthDiminishedFifth -> incPitch 1 undefined (-1) > FifthAugmentedFifth -> incPitch 1 undefined 1 > FifthMajorSeventh -> incPitch 2 10 1 > FifthMinorNineth -> incPitch 3 14 (-1) > FifthMajorNineth -> incPitch 3 14 1 > FifthAugmentedEleventh -> incPitch 3 17 1 \end{haskelllisting} \begin{haskelllisting} > data Third = > ThirdMajor > | ThirdAugmentedFifth > | ThirdDiminishedFifth > | ThirdMinor > | ThirdMinorAugmentedFifth > | ThirdMinorDiminishedFifth > | ThirdDiminished > | ThirdSustained2 > | ThirdSustained4 > | ThirdDiminishedAugmented > deriving (Show, Eq, Ord, Ix) > > data Fourth = > FourthNone > | FourthSecond > | FourthSixth > | FourthSixthNineth > | FourthSeventh > | FourthMajorSeventh > | FourthNineth > | FourthMajorNineth > | FourthEleventh > | FourthThirteenth > deriving (Show, Eq, Ord, Ix) > > data Fifth = > FifthAugmentedThird > | FifthDiminishedFifth > | FifthAugmentedFifth > | FifthMajorSeventh > | FifthMinorNineth > | FifthMajorNineth > | FifthAugmentedEleventh > deriving (Show, Eq, Ord, Ix) > > toString :: T -> String > toString (Cons third fourth fifthList) = > thirdsArray!third ++ > fourthsArray!fourth ++ > concatMap (fifthsArray!) fifthList > > intervalToArray :: (Ix a) => [(a,[String])] -> Array a String > intervalToArray xs = > Array.array (fst (head xs), fst (last xs)) > (map (mapSnd head) xs) > > thirdsArray :: Array Third String > thirdsArray = intervalToArray thirds > > fourthsArray :: Array Fourth String > fourthsArray = intervalToArray fourths > > fifthsArray :: Array Fifth String > fifthsArray = intervalToArray fifths > > fromString :: String -> T > fromString = > fst . head . filter (null . snd) . ReadP.readP_to_S parse > > -- copy of GHC-6.4's ReadP.many function > readPmany :: ReadP a -> ReadP [a] > readPmany p = return [] ReadP.+++ liftM2 (:) p (readPmany p) > > parse :: ReadP T > parse = > liftM3 Cons > (parseInterval thirds) > (parseInterval fourths) > (readPmany (parseInterval fifths)) > > parseInterval :: [(a,[String])] -> ReadP a > parseInterval = > ReadP.choice . map (uncurry parseIntervalAlternatives) > > parseIntervalAlternatives :: a -> [String] -> ReadP a > parseIntervalAlternatives x sym = > ReadP.choice (map ReadP.string sym) >> return x > > thirds :: [(Third,[String])] > thirds = [ > (ThirdMajor, ["", "maj"]), > (ThirdAugmentedFifth, ["+", "aug"]), > (ThirdDiminishedFifth, ["-"]), > (ThirdMinor, ["m"]), > (ThirdMinorAugmentedFifth, ["m+"]), > (ThirdMinorDiminishedFifth, ["m-"]), > (ThirdDiminished, ["0", "dim"]), > (ThirdSustained2, ["sus2"]), > (ThirdSustained4, ["sus4", "4"]), > (ThirdDiminishedAugmented, ["0+"]) > ] > fourths :: [(Fourth,[String])] > fourths = [ > (FourthNone, [""]), > (FourthSecond, ["2"]), > (FourthSixth, ["6"]), > (FourthSixthNineth, ["6/9"]), > (FourthSeventh, ["7"]), > (FourthMajorSeventh, ["M7", "Ma7"]), -- "maj7" collides with "maj"++"7" > (FourthNineth, ["9"]), > (FourthMajorNineth, ["M9"]), > (FourthEleventh, ["11"]), > (FourthThirteenth, ["13"]) > ] > fifths :: [(Fifth,[String])] > fifths = [ > (FifthAugmentedThird, ["3+"]), > (FifthDiminishedFifth, ["-5", "5-"]), > (FifthAugmentedFifth, ["+5", "5+", "-6", "6-"]), > (FifthMajorSeventh, ["7+"]), > (FifthMinorNineth, ["-9"]), > (FifthMajorNineth, ["+9"]), > (FifthAugmentedEleventh, ["+11"]) > ] \end{haskelllisting} haskore-0.2.0.3/src/Haskore/Composition/Trill.lhs0000644000000000000000000000535411754016451017773 0ustar0000000000000000\subsubsection{Trills} \begin{haskelllisting} > module Haskore.Composition.Trill where > > import qualified Haskore.Music as Music \end{haskelllisting} A \keyword{trill} is an ornament that alternates rapidly between two (usually adjacent) pitches. Let's implement a trill as a function that take a note as an argument and returns a series of notes whose durations add up to the same duration as as the given note. A trill alternates between the given note and another note, usually the note above it in the scale. Therefore, it must know what other note to use. So that the structure of \function{trill} remains parallel across different keys, we'll implement the other note in terms of its interval from the given note in half steps. Usually, the note is either a half-step above (interval = 1) or a whole-step above (interval = 2). Using negative numbers, a trill that goes to lower notes can even be implemented. Also, the trill needs to know how fast to alternate between the two notes. One way is simply to specify the type of smaller note to use. (Another implementation will be discussed later.) So, our \function{trill} has the following type: \begin{haskelllisting} > trill :: Int -> Music.Dur -> Music.T note -> Music.T note \end{haskelllisting} Its implementation: \begin{haskelllisting} > trill i d m = > let atom = Music.take d m > in Music.line (Music.takeLine (Music.dur m) > (cycle [atom, Music.transpose i atom])) \end{haskelllisting} Since the function uses \function{Music.tranpose} one can even trill more complex objects like chords. The next version of \function{trill} starts on the second note, rather than the given note. It is simple to define a function that starts on the other note: \begin{haskelllisting} > trill' :: Int -> Music.Dur -> Music.T note -> Music.T note > trill' i sDur m = > trill (negate i) sDur (Music.transpose i m) \end{haskelllisting} Another way to define a trill is in terms of the number of subdivided notes to be included in the trill. \begin{haskelllisting} > trillN :: Int -> Integer -> Music.T note -> Music.T note > trillN i nTimes m = > trill i (Music.dur m / fromIntegral nTimes) m \end{haskelllisting} This, too, can be made to start on the other note. \begin{haskelllisting} > trillN' :: Int -> Integer -> Music.T note -> Music.T note > trillN' i nTimes m = > trillN (negate i) nTimes (Music.transpose i m) \end{haskelllisting} Finally, a \function{roll} can be implemented as a trill whose interval is zero. This feature is particularly useful for percussion. \begin{haskelllisting} > roll :: Music.Dur -> Music.T note -> Music.T note > rollN :: Integer -> Music.T note -> Music.T note > > roll d = trill 0 d > rollN nTimes = trillN 0 nTimes \end{haskelllisting} haskore-0.2.0.3/src/Haskore/Composition/Drum.lhs0000644000000000000000000000751311754016451017613 0ustar0000000000000000\subsubsection{Percussion} Percussion is a difficult notion to represent in the abstract, since in a way, 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, even though 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 notes 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{haskelllisting} > module Haskore.Composition.Drum > (T, GM.Drum(..), Element(..), na, > toMusic, toMusicDefaultAttr, > lineToMusic, elementToMusic, funkGroove) where > import Haskore.Composition.Trill > import qualified Haskore.Basic.Duration as Duration > import Haskore.Basic.Duration (qn, en, ) > import Haskore.Music (qnr, enr, (=:=), changeTempo, rest, ) > import Haskore.Melody.Standard (NoteAttributes, na, ) > import qualified Haskore.Music as Music > import qualified Haskore.Music.GeneralMIDI as MidiMusic > import qualified Haskore.Music.Rhythmic as RhyMusic > import qualified Sound.MIDI.General as GM > type T = GM.Drum \end{haskelllisting} Since Midi is such a popular platform, we can at least define some handy functions for using the General Midi Standard. We start by defining the datatype shown in \figref{percussion}, which 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 Haskore terminology. We will not adapt the MIDI treatment of drums in Haskore since it makes no sense, e.g. to transpose drums by increasing the key number. Thus we defined a special constructor for drums in \type{RhyMusic.T}. We will now give a function which constructs a \type{RhyMusic.T} for a given value specifying a drum: \begin{haskelllisting} > toMusic :: drum -> Duration.T -> NoteAttributes -> RhyMusic.T drum instr > toMusic drm dr nas = > Music.atom dr (Just (RhyMusic.noteFromAttrs nas (RhyMusic.Drum drm))) > toMusicDefaultAttr :: > drum -> Duration.T -> RhyMusic.T drum instr > toMusicDefaultAttr drm dr = toMusic drm dr na \end{haskelllisting} For example, here are eight bars of a simple rock or ``funk groove'' that uses \function{Drum.toMusic} and \function{Drum.roll}: \begin{haskelllisting} > funkGroove :: MidiMusic.T > funkGroove = > let p1 = toMusic GM.LowTom qn na > p2 = toMusic GM.AcousticSnare en na > in changeTempo 3 (Music.take 8 (Music.repeat > ( (Music.line [p1, qnr, p2, qnr, p2, > p1, p1, qnr, p2, enr]) > =:= roll en (toMusic GM.ClosedHiHat 2 na) ) > )) \end{haskelllisting} We can go one step further by defining our own little ``percussion datatype'': \begin{haskelllisting} > data Element = > R Duration.T -- rest > | N Duration.T NoteAttributes -- note > | Roll Duration.T Duration.T NoteAttributes -- roll w/duration > | Rolln Integer Duration.T NoteAttributes -- roll w/number of strokes > > lineToMusic :: T -> [Element] -> MidiMusic.T > lineToMusic dsnd = > Music.line . map (elementToMusic dsnd) > elementToMusic :: T -> Element -> MidiMusic.T > elementToMusic dsnd el = > let drum = toMusic dsnd > in case el of > R dur -> rest dur > N dur nas -> drum dur nas > Roll sDur dur nas -> roll sDur (drum dur nas) > Rolln nTimes dur nas -> rollN nTimes (drum dur nas) \end{haskelllisting} haskore-0.2.0.3/src/Haskore/Composition/Rhythm.lhs0000644000000000000000000001500311754016451020150 0ustar0000000000000000% from AutoTrack by Stefan Ratschan \section{Rhythm} \begin{haskelllisting} > module Haskore.Composition.Rhythm where > > import qualified Haskore.Composition.Drum as Drum > import qualified Haskore.Basic.Duration as Dur > import qualified Haskore.Music as Music > import qualified Haskore.Music.GeneralMIDI as MidiMusic > import qualified Haskore.Music.Rhythmic as RhyMusic > import Haskore.Basic.Duration (qn, en, sn, (%+), ) > import Data.List.HT (mapAdjacent, ) > import Data.Bool.HT (select, ) > import Data.Char (isSpace, ) \end{haskelllisting} There are many different possibilities for dealing with the notion of rhythm. Some of them are: \begin{itemize} \item Modeling it as a succession of notes and rests of equal length \item Allowing notes and rests to be of different (integer or rational) lengths \item Dealing with rhythm on the level of the \texttt{RhyMusic.T} data type, without any special data type for modeling rhythm \end{itemize} We will use the first possibility here. The third possibility has been used in Martin Schwenke's \texttt{DrumMachine} module. As explained above we think of rhythm as a succession of notes and rests of equal length. For this we use lists of booleans, where \texttt{True} means that a note is played, and \texttt{False} means that no note is played (i.e. a rest). \begin{haskelllisting} > type T = [ Bool ] \end{haskelllisting} By default the basic rhythmical unit is one sixteenth note. The \texttt{Rhythm.T} data-type does not depend on this, it only comes into the game when we convert rhythms to music. \begin{haskelllisting} > unit :: Music.Dur > unit = sn \end{haskelllisting} We provide two ways of creating rhythms: \begin{itemize} \item From strings, where an 'x' means that some note is played at this place, and any other character means that no note is played, while white spaces are ignored. \item From ordered lists of integers, where every integer means that at the place with this number we have a note (the first place is zero). On all the other places we have rests. \end{itemize} \begin{haskelllisting} > fromString :: String -> T > fromString = map ('x'==) . filter (not . isSpace) > fromPositions :: [ Int ] -> T > fromPositions l = > let hitAfter x = replicate (x-1) False ++ [ True ] > checkPos d = > if d>0 > then d > else error ("fromPositions: list of time events must increase strictly monotonously") > in concatMap hitAfter (mapAdjacent ((checkPos .) . subtract) ((-1):l)) \end{haskelllisting} Now we want to convert rhythms to music. We do this using two data types, which one can immediately convert to music via function application. \begin{haskelllisting} > type ToMusicWithMusic drum instr = RhyMusic.T drum instr -> T -> RhyMusic.T drum instr > type ToMusicWithDrum drum instr = drum -> T -> RhyMusic.T drum instr > toMusicWithMusic :: ToMusicWithMusic drum instr > toMusicWithMusic m r = > let play b = if b then m else Music.rest (Music.dur m) > in Music.line (map play r) > toMusicWithDrum :: ToMusicWithDrum drum instr > toMusicWithDrum = toMusicWithDrumUnit unit \end{haskelllisting} Sometimes we also want to specify a basic rhythmical unit which is different from the default one. \begin{haskelllisting} > toMusicWithDrumUnit :: Music.Dur -> ToMusicWithDrum drum instr > toMusicWithDrumUnit d p = toMusicWithMusic (Drum.toMusic p d Drum.na) \end{haskelllisting} Finally one can also create shuffled music from rhythms. \begin{haskelllisting} > toShuffledMusicWithDrum :: ToMusicWithDrum drum instr > toShuffledMusicWithDrum = toShuffledMusicWithDrumUnit unit > toShuffledMusicWithDrumUnit :: Music.Dur -> ToMusicWithDrum drum instr > toShuffledMusicWithDrumUnit d p r = > let stretch = 1%+3 > dstr = Dur.scale (1+stretch) d > dcompr = Dur.scale (1-stretch) d > play b = > if b > then flip (Drum.toMusic p) Drum.na > else Music.rest > in Music.line (zipWith play r (cycle [dstr, dcompr])) \end{haskelllisting} Some basic rhythms: \begin{haskelllisting} > tickR, downBeatR, backBeatR, claveR, claveRumbaR, > claveBossaR, clave5, clave7, jazzRideR, > jazzWaltzRideR, jazzWaltzHiHatR :: T > tickR = fromString "x" > downBeatR = fromString "x." > backBeatR = fromString ".x" > claveR = fromString "x..x..x. ..x.x..." > claveRumbaR = fromString "x..x...x ..x.x..." > claveBossaR = fromString "x..x..x. ..x..x.." > clave5 = fromString "..x.x" > clave7 = fromString ".x.x..x" > jazzRideR = fromString "x.xx" > jazzWaltzRideR = fromString "x.xxx." > jazzWaltzHiHatR = fromString "..x" > countInR :: Music.Dur -> T > countInR d = > select (error "countIn not defined for this measure") > [(d == 4%+4, fromString "x.x.xxxx"), > (d == 5%+4, fromString "x..x.xxxxx"), > (Dur.divisible d qn, > let b = fromInteger (Dur.divide d qn) > in True : replicate (b-1) False ++ replicate b True)] \end{haskelllisting} In one more step in the conversion to music we fix the basic rhythmical unit and shuffle/straight. \begin{haskelllisting} > tickP, claveP, claveRumbaP, claveBossaP, jazzRideP, > jazzWaltzRideP, jazzWaltzHiHatP, downBeatP, > backBeatP :: drum -> RhyMusic.T drum instr > tickP = flip (toMusicWithDrumUnit en) tickR > claveP = flip (toMusicWithDrumUnit en) claveR > claveRumbaP = flip (toMusicWithDrumUnit en) claveRumbaR > claveBossaP = flip (toMusicWithDrumUnit en) claveBossaR > jazzRideP = flip (toShuffledMusicWithDrumUnit en) jazzRideR > jazzWaltzRideP = flip (toShuffledMusicWithDrumUnit en) jazzWaltzRideR > jazzWaltzHiHatP = flip (toMusicWithDrumUnit qn) jazzWaltzHiHatR > downBeatP = flip (toMusicWithDrumUnit qn) downBeatR > backBeatP = flip (toMusicWithDrumUnit qn) backBeatR \end{haskelllisting} And now we assign these rhythms to instruments. \begin{haskelllisting} > click, clave, claveRumba, claveBossa, metro5, metro7, > basicBassDrum, basicSnare, basicHiHat, ride :: MidiMusic.T > click = Music.repeat (tickP Drum.Claves) > clave = claveP Drum.Claves > claveRumba = claveRumbaP Drum.Claves > claveBossa = claveBossaP Drum.Claves > metro5 = toMusicWithDrumUnit qn Drum.Claves (cycle clave5) > metro7 = toMusicWithDrumUnit qn Drum.Claves (cycle clave7) > basicBassDrum = downBeatP Drum.AcousticBassDrum > basicSnare = backBeatP Drum.AcousticSnare > basicHiHat = tickP Drum.ClosedHiHat > ride = tickP Drum.RideCymbal2 > countIn :: Music.Dur -> MidiMusic.T > countIn m = toMusicWithDrumUnit qn Drum.Claves (countInR m) \end{haskelllisting} haskore-0.2.0.3/src/Haskore/Composition/Chord.lhs0000644000000000000000000003373211754016451017745 0ustar0000000000000000\subsubsection{Chords} \seclabel{chords} Earlier I described how to represent chords as values of type \code{Music.T}. However, sometimes it is convenient to treat chords more abstractly. Rather than think of a chord in terms of its actual notes, it is useful to think of it in terms of its chord ``quality'', coupled with the key it is played in and the particular voicing used. For example, we can describe a chord as being a ``major triad in root position, with root middle C''. Several approaches have been put forth for representing this information, and we cannot cover all of them here. Rather, I will describe two basic representations, leaving other alternatives to the skill and imagination of the reader.\footnote{For example, Forte prescribes normal forms for chords in an atonal setting \cite{forte}.} First, one could use a \keyword{pitch} representation, where each note is represented as its distance from some fixed pitch. \code{0} is the obvious fixed pitch to use, and thus, for example, \code{[0,4,7]} represents a major triad in root position. The first zero is in some sense redundant, of course, but it serves to remind us that the chord is in ``normal form''. For example, when forming and transforming chords, we may end up with a representation such as \code{[2,6,9]}, which is not normalized; its normal form is in fact \code{[0,4,7]}. Thus we define: \begin{quote} A chord is in \keyword{pitch normal form} if the first pitch is zero, and the subsequent pitches are monotonically increasing. \end{quote} One could also represent a chord \keyword{intervalically}; i.e.~as a sequence of intervals. A major triad in root position, for example, would be represented as \code{[4,3,-7]}, where the last interval ``returns'' us to the ``origin''. Like the \code{0} in the pitch representation, the last interval is redundant, but allows us to define another sense of normal form: \begin{quote} A chord is in \keyword{interval normal form} if the intervals are all greater than zero, except for the last which must be equal to the negation of the sum of the others. \end{quote} In either case, we can define a chord type as: \begin{haskelllisting} > module Haskore.Composition.Chord where > > import qualified Haskore.Music as Music > import qualified Haskore.Melody as Melody > import qualified Haskore.Basic.Pitch as Pitch > import qualified Haskore.Basic.Interval as I > import Haskore.General.Utility (foldrf, ) > import Data.Ord.HT (comparing, ) > import Data.List.HT (viewR, ) > import Data.List (genericLength, minimumBy, ) > > type T = [Pitch.Relative] \end{haskelllisting} We might ask whether there is some advantage, computationally, of using one of these representations over the other. However, there is an invertible linear transformation between them, as defined by the following functions, and thus there is in fact little advantage of one over the other: \begin{haskelllisting} > pitchToInterval :: T -> T > pitchToInterval [] = error "pitchToInterval: Chord must be non-empty." > pitchToInterval ch@(p:ps) = > zipWith (-) (ps++[p]) ch > > intervalToPitch :: T -> T > intervalToPitch [] = error "intervalToPitch: Chord must be non-empty." > intervalToPitch ch = > let Just (chInit, chLast) = viewR (scanl (+) 0 ch) > in if chLast==0 > then chInit > else error "intervalToPitch: intervals do not sum-up to zero." \end{haskelllisting} \begin{exercise} Show that \code{pitchToInterval} and \code{intervalToPitch} are \keyword{inverses} in the following sense: for any chord \code{ch1} in pitch normal form, and \code{ch2} in interval normal form, each of length at least two: \begin{center} \code{intervalToPitch (pitchToInterval ch1) = ch1}\\ \code{pitchToInterval (intervalToPitch ch2) = ch2} \end{center} \end{exercise} Another operation we may wish to perform is a test for \keyword{equality} on chords, which can be done at many levels: based only on chord quality, taking inversion into account, absolute equality, etc. Since the above normal forms guarantee a unique representation, equality of chords with respect to chord quality and inversion is simple: it is just the standard (overloaded) equality operator on lists. On the other hand, to measure equality based on chord quality alone, we need to account for the notion of an \keyword{inversion}. Using the pitch representation, the inversion of a chord can be defined as follows: \begin{haskelllisting} > pitchInvert, intervalInvert :: T -> T > pitchInvert (0:p2:ps) = 0 : map (subtract p2) ps ++ [12-p2] > pitchInvert _ = > error "pitchInvert: Pitch chord representation must start with a zero." \end{haskelllisting} Although we could also directly define a function to invert a chord given in interval representation, we will simply define it in terms of functions already defined: \begin{haskelllisting} > intervalInvert = pitchToInterval . pitchInvert . intervalToPitch \end{haskelllisting} % pitchInvert [0,4,7] => [4,7,0] => [0,3,-4] => [0,3,8] % intervalInvert [4,3,-7] => [3,-7,4] => [3,5,4] => [3,5,-8] We can now determine whether a chord in normal form has the same quality (but possibly different inversion) as another chord in normal form, as follows: simply test whether one chord is equal either to the other chord or to one of its inversions. Since there is only a finite number of inversions, this is well defined. In Haskell: \begin{haskelllisting} > samePitch, sameInterval :: T -> T -> Bool > samePitch ch1 ch2 = > let invs = take (length ch1) (iterate pitchInvert ch1) > in ch2 `elem` invs > > sameInterval ch1 ch2 = > let invs = take (length ch1) (iterate intervalInvert ch1) > in ch2 `elem` invs \end{haskelllisting} For example, \code{samePitch [0,4,7] [0,5,9]} returns \code{True} (since \code{[0,5,9]} is the pitch normal form for the second inversion of \code{[0,4,7]}). Here we provide a list of some common types of chords. %\begin{figure} \begin{haskelllisting} > majorInt, minorInt, majorSeventhInt, minorSeventhInt, > dominantSeventhInt, minorMajorSeventhInt, > sustainedFourthInt :: [Pitch.Relative] > majorInt = [I.unison, I.majorThird, I.fifth] > minorInt = [I.unison, I.minorThird, I.fifth] > majorSeventhInt = [I.unison, I.majorThird, I.fifth, I.majorSeventh] > minorSeventhInt = [I.unison, I.minorThird, I.fifth, I.minorSeventh] > dominantSeventhInt = [I.unison, I.majorThird, I.fifth, I.minorSeventh] > minorMajorSeventhInt = [I.unison, I.minorThird, I.fifth, I.majorSeventh] > sustainedFourthInt = [I.unison, I.fourth, I.fifth] > type Inversion = Int > fromIntervals :: > [Pitch.Relative] -> Inversion -> Music.T note -> [Music.T note] > fromIntervals int inv m = > let err = error ("Chord.fromInterval: inversion number " > ++ show inv ++ " too large") > in map (flip Music.transpose m) (zipWith const > (drop inv (init (int ++ map (12+) int) ++ repeat err)) int) > major, minor, majorSeventh, minorSeventh, dominantSeventh, > minorMajorSeventh, sustainedFourth :: > Inversion -> Music.T note -> [Music.T note] > major = fromIntervals majorInt > minor = fromIntervals minorInt > majorSeventh = fromIntervals majorSeventhInt > minorSeventh = fromIntervals minorSeventhInt > dominantSeventh = fromIntervals dominantSeventhInt > minorMajorSeventh = fromIntervals minorMajorSeventhInt > sustainedFourth = fromIntervals sustainedFourthInt \end{haskelllisting} %\caption{Common chords.} %\figlabel{chords} %\end{figure} We want to offer a special service: The computer shall find out inversions for chords in a sequence such that the overall pitch does not vary so much. A very simple approach is to compute the ``center'' of a chord, that is the average of all pitches. We do now try to keep the center as close as possible to an overall trend. This is especially easy because for a chord of $n$ notes the change to the next inversion moves the center of the chord by $\frac{12}{n}$ tones. The function gets the inversion of the first and the last chord and the list of chords represented by the base note and the intervals of all notes of the chord. \begin{haskelllisting} > data Generic attr = Generic { > genericPitchClass :: Pitch.Class, > genericIntervals :: T, > genericDur :: Music.Dur, > genericAttr :: attr} > > type Boundary = (Pitch.T, Pitch.T) > > generic :: Pitch.Class -> T -> Music.Dur -> attr -> Generic attr > generic = Generic > > leastVaryingInversions :: > Boundary -> [Generic attr] -> [[Melody.T attr]] > leastVaryingInversions (begin,end) gs = > let beginCenter = fromIntegral (Pitch.toInt begin) > endCenter = fromIntegral (Pitch.toInt end) > steep = (endCenter - beginCenter) / (genericLength gs - 1) > trend = map (\k -> beginCenter + steep * fromIntegral k) > [0 .. (length gs - 1)] > invs = zipWith > (\g t -> round (matchingInversion g t)) > gs trend > in zipWith genericToNotes invs gs > > inversionIncrement :: T -> Double > inversionIncrement ps = 12 / genericLength ps > > matchingInversion :: Generic attr -> Double -> Double > matchingInversion g dst = > let c = chordCenter g > inc = inversionIncrement (genericIntervals g) > in (dst-c)/inc > > mean :: [Pitch.Relative] -> Double > mean ps = sum (map fromIntegral ps) / genericLength ps > > chordCenter :: Generic attr -> Double > chordCenter (Generic pc ps _ _) = > fromIntegral (Pitch.classToInt pc) + mean ps > > boundaryCenter :: (Pitch.Octave,Inversion) -> Generic attr -> Double > boundaryCenter (oct,inv) g = > 12 * fromIntegral oct + chordCenter g + > fromIntegral inv * inversionIncrement (genericIntervals g) > > invert :: Inversion -> T -> T > invert inv ps = > let (q,r) = divMod inv (length ps) > in zipWith (+) ps > (replicate r (12*(q+1)) ++ repeat (12*q)) > > genericToNotes :: Inversion -> Generic attr -> [Melody.T attr] > genericToNotes inv (Generic pc ps dur attr) = > map (\t -> Melody.note (Pitch.transpose t (0,pc)) dur attr) > (invert inv ps) \end{haskelllisting} A more complicated algorithm will also work for other definitions of variation. We compute the mean pitch for every chord and minimize the variation of the pitch. The variation is defined here as the sum of the squared differences of successive chords. This leads to a shortest ways search in a graph where each inversion of a chord is a node and each possible neighbourhood of inversions is an edge. The nodes for the inversions of a chord and the nodes for the inversions of the succeeding chord build a complete bi-partite graph. First we write a shortest ways search algorithm that is specialised to our problem. In each step we process one chord. We construct a list of inversions, where each inversion is associated with the optimal way from the beginning chord to this inversion and its variation. This list passed to the processing of the next chord. For reasons of simplicity we process the list backwards. The inputs of the algorithm are a distance function and the list of concurrent inversions for each chord. The first element of the list contains all starting inversions, the last element contains all ending inversions. If you want a definitive start and end inversion, use one-element lists. The output is the list of the optimal inversion for each chord. More precisely it is a list of all optimal ways, where for each starting inversion there is one optimal way to the closest ending inversion. \begin{haskelllisting} > shortestWays :: (Num b, Ord b) => > (a -> a -> b) -> [[a]] -> [(b,[a])] > shortestWays dist = > foldrf (processZone dist) (map (\x->(0,[x]))) > processZone :: (Num b, Ord b) => > (a -> a -> b) -> [a] -> [(b,[a])] -> [(b,[a])] > processZone dist srcs ways = > let distToWay src (d,dst:_) = d + dist src dst > distToWay _ (_,[]) = > error "processZone: list is never empty if called from shortestWays" > in map (\src -> minimumBy (comparing fst) > (map (\way -> (distToWay src way, src : snd way)) ways)) srcs > propShortestWays :: Int -> Int -> Bool > propShortestWays n k = > let sws = shortestWays (\x y -> (x-y)^(2::Int)) > (replicate n [0..(n*k)] ++ [[0]]) > in head sws == (0, replicate (n+1) 0) && > last sws == (n*k^(2::Int), reverse [0,k..n*k]) \end{haskelllisting} This routine could be made more efficient because the centers of the chords with different inversions are equidistant. \begin{haskelllisting} > leastVaryingInversionsSW :: > Boundary -> [Generic attr] -> [[Melody.T attr]] > leastVaryingInversionsSW bnd gs = > let dist (_,c0) (_,c1) = (c0-c1)^(2::Int) > [(_,invs)] = > shortestWays dist > (inversionCenters bnd gs) > in zipWith (\(inv,_) -> genericToNotes inv) invs gs > > inversionCenters :: Boundary -> [Generic attr] -> [[(Inversion,Double)]] > inversionCenters (begin,end) gs = > let margin = 7 > beginCenter = fromIntegral (Pitch.toInt begin) > endCenter = fromIntegral (Pitch.toInt end) > lower = min beginCenter endCenter - margin > upper = max beginCenter endCenter + margin > inversions g = > let c = chordCenter g > inc = inversionIncrement (genericIntervals g) > invs :: [Inversion] > invs = [floor ((lower-c)/inc) .. > ceiling ((upper-c)/inc)] > in map (\inv -> (inv, c + inc * fromIntegral inv)) invs > boundInv g center = > (round (matchingInversion g center), center) > in [[boundInv (head gs) beginCenter]] ++ > map inversions (tail (init gs)) ++ > [[boundInv (last gs) endCenter]] \end{haskelllisting} Now two helper functions for creating a harmonic and a melodic chord, that is chords of notes of the same length in sequentially or simultaneously. \begin{haskelllisting} > melodicGen, harmonicGen :: attr -> Music.Dur -> > [Music.Dur -> attr -> Melody.T attr] -> Melody.T attr > melodicGen attr d = Music.line . map (\n -> n d attr) > harmonicGen attr d = Music.chord . map (\n -> n d attr) \end{haskelllisting} haskore-0.2.0.3/src/Haskore/Performance/0000755000000000000000000000000011754016451016124 5ustar0000000000000000haskore-0.2.0.3/src/Haskore/Performance/Default.lhs0000644000000000000000000001704511754016451020227 0ustar0000000000000000\subsection{Conversion functions with default settings} \seclabel{default-performance} \subsubsection{Examples of Player Construction} A ``default player'' called \function{Default.player} (not to be confused with ``deaf player''!) is defined for use when none other is specified in the score; it also functions as a base from which other players can be derived. \function{Default.player} responds only to the \constructor{Velocity} note attribute and to the \constructor{Accent}, \constructor{Staccato}, and \constructor{Legato} phrase attributes. It is defined in \figref{default-Player}. Before reading this code, recall how players are invoked by the \function{Performance.fromMusic} function defined in the last section; in particular, note the calls to \function{playNote} and \function{interpretPhase} defined above. Then note: \begin{enumerate} \item \function{defltPlayNote} is the only function (even in the definition of \function{Performance.fromMusic}) that actually generates an event. It also modifies that event based on an interpretation of each note attribute by the function \function{defltNasHandler}. \item \function{defltNasHandler} only recognizes the \constructor{Velocity} attribute, which it uses to set the event velocity accordingly. \item \function{defltInterpPhrase} calls (mutually recursively) \function{Performance.fromMusic} to interpret a phrase, and then modifies the result based on an interpretation of each phrase attribute by the function \function{defltInterpPhrase}. \item \function{defltInterpPhrase} only recognizes the \constructor{Accent}, \constructor{Staccato}, and \constructor{Legato} phrase attributes. For each of these it uses the numeric argument as a ``scaling'' factor of the volume (for \constructor{Accent}) and duration (for \constructor{Staccato} and \constructor{Legato}). Thus \expression{(Phrase (Legato 1.1) m)} effectively increases the duration of each note in \expression{m} by 10\% (without changing the tempo). \end{enumerate} It should be clear that much of the code in Figure \ref{default-Player} can be re-used in defining a new player. For example, to define a player \function{weird} that interprets note attributes just like \function{Default.player} but behaves differently with respect to phrase attributes, we could write: \begin{haskelllisting} weird :: T weird = Performance.PlayerCons { pname = "Weirdo", playNote = defltPlayNote defltNasHandler, interpretPhrase = liftM . myPhraseInterpreter notatePlayer = defltNotatePlayer () } \end{haskelllisting} and then supply a suitable definition of \function{myPhraseInterpreter}. That definition could also re-use code, in the following sense: suppose we wish to add an interpretation for \constructor{Crescendo}, but otherwise have \function{myPhraseInterpreter} behave just like \function{defltInterpPhrase}. \begin{haskelllisting} myPhraseInterpreter :: PhraseAttribute -> Performance.T time dyn note -> Performance.T time dyn note myPhraseInterpreter (Dyn (Crescendo x)) pf = ... myPhraseInterpreter pa pf = defltInterpPhrase pa pf \end{haskelllisting} \begin{exercise} Fill in the \expression{...} in the definition of \function{myPhraseInterpreter} according to the following strategy: Assume $0<\expression{x}<1$. Gradually scale the volume of each event by a factor of $1.0$ through $1.0+\expression{x}$, using linear interpolation. \end{exercise} \begin{exercise} Choose some of the other phrase attributes and provide interpretations of them, such as \constructor{Diminuendo}, \constructor{Slurred}, \constructor{Trill}, etc. (The \function{trill} functions from \secref{basic-examples} may be useful here.) \end{exercise} {\small \begin{haskelllisting} > module Haskore.Performance.Default where > import qualified Haskore.Music as Music > import qualified Haskore.Performance as Performance > import qualified Haskore.Performance.Context as Context > import qualified Haskore.Performance.Player as Player > import qualified Data.EventList.Relative.TimeBody as TimeList > import qualified Haskore.Basic.Tempo as Tempo > import qualified Haskore.Basic.Duration as Dur > import qualified Numeric.NonNegative.Class as NonNeg > import qualified Numeric.NonNegative.Wrapper as NonNegW > import Prelude hiding (map) \end{haskelllisting} } \begin{figure} {\small \begin{haskelllisting} > -- default is a reserved keyword > player :: > (NonNeg.C time, Fractional time, Real time, Fractional dyn) => > Player.T time dyn note > player = map "Default" > > -- a default PMap that makes everything into a Default.player > map :: > (NonNeg.C time, Fractional time, Real time, Fractional dyn) => > Player.Name -> Player.T time dyn note > map pname = > Performance.PlayerCons { > Performance.name = pname, > Performance.playNote = playNote, > Performance.interpretPhrase = interpretPhrase, > Performance.notatePlayer = notatePlayer () > } > > playNote :: (Fractional time, Real time) => > Performance.NoteFun time dyn note > playNote > (Performance.Context curDur _ curKey curVelocity) d note = > TimeList.singleton 0 > (Performance.Event { > Performance.eventDur = Dur.toNumber d * curDur, > Performance.eventTranspose = curKey, > Performance.eventDynamics = curVelocity, > Performance.eventNote = note } ) > > interpretPhrase :: > (NonNeg.C time, Fractional time, Fractional dyn) => > Performance.PhraseFun time dyn note > interpretPhrase (Music.Dyn (Music.Accent x)) = Player.accent x > interpretPhrase (Music.Art (Music.Staccato x)) = Player.staccatoAbs x > interpretPhrase (Music.Art (Music.Legato x)) = Player.legatoAbs x > interpretPhrase _ = id > > notatePlayer :: () -> Performance.NotateFun > notatePlayer _ = () > context :: > (NonNeg.C time, Fractional time, Real time, Fractional dyn) => > Context.T time dyn note > context = > Performance.Context { > Performance.contextPlayer = player, > Performance.contextDur = Tempo.metro 60 Dur.qn, > Performance.contextTranspose = 0, > Performance.contextDynamics = 1 > } \end{haskelllisting} } \caption{Definition of default Player \function{Default.player}.} \figlabel{default-Player} \end{figure} {\small \begin{haskelllisting} > fromMusic :: > (Ord note, NonNeg.C time, RealFrac time, Fractional dyn, Ord dyn) => > Music.T note -> Performance.T time dyn note > fromMusic = > Performance.fromMusic map context > > fromMusicModifyContext :: > (Ord note, NonNeg.C time, RealFrac time, Fractional dyn, Ord dyn) => > (Context.T time dyn note -> Context.T time dyn note) -> > Music.T note -> > Performance.T time dyn note > fromMusicModifyContext update = > Performance.fromMusic > map > (update context) > > floatFromMusic :: (Ord note) => > Music.T note -> Performance.T NonNegW.Float Float note > floatFromMusic = fromMusic > > paddedFromMusic :: > (Ord note, NonNeg.C time, RealFrac time, Fractional dyn, Ord dyn) => > Music.T note -> Performance.Padded time dyn note > paddedFromMusic = > Performance.paddedFromMusic map context > > paddedFromMusicModifyContext :: > (Ord note, NonNeg.C time, RealFrac time, Fractional dyn, Ord dyn) => > (Context.T time dyn note -> Context.T time dyn note) -> > Music.T note -> > Performance.T time dyn note > paddedFromMusicModifyContext update = > Performance.fromMusic > map > (update context) \end{haskelllisting} } haskore-0.2.0.3/src/Haskore/Performance/BackEnd.lhs0000644000000000000000000001123511754016451020125 0ustar0000000000000000\subsection{Connect Performance to a Back-End} \seclabel{performance-backend} \begin{haskelllisting} > module Haskore.Performance.BackEnd where > > import qualified Haskore.Performance as Pf > import qualified Haskore.Music as Music > import qualified Haskore.Basic.Pitch as Pitch > import qualified Data.EventList.Relative.TimeBody as TimeList > import qualified Data.EventList.Relative.TimeTime as TimeListPad > import Haskore.Music ((=:=), (+:+)) \end{haskelllisting} The performance data structure is still bound to music specific data. We still have to convert that into back-end specific data, such as MIDI events, CSound statements, SuperCollider messages or other. The new data type \type{Performance.BackEnd.T} is similar to \type{Performance.T}, but does not contain transposition or dynamics information any longer. Also music-specific data is converted to back-end specific data. Later we have to provide converters from each type of music to each back-end. This requires combinatorial amount of implementation work but it is the most flexible way to do so. We expect only a few general types of music which fit to many back-ends, and many music types specialised to features of a particular back-end. It would be certainly less work to have an universal intermediate, but this restricts the flexibility. \begin{haskelllisting} > type T time note = TimeList.T time (Event time note) > type Padded time note = TimeListPad.T time (Event time note) > > data Event time note = > Event {eventDur :: time, > eventNote :: note} > deriving (Eq, Ord, Show) \end{haskelllisting} Now we provide a function which simplifies conversion from a \type{Performance.Event} to a \type{Performance.BackEnd.Event} in case that this conversion does not depend on the event time and duration. \begin{haskelllisting} > instance Functor (Event time) where > fmap f e = e{eventNote = f (eventNote e)} > mapTime :: (time0 -> time1) -> T time0 note -> T time1 note > mapTime f = > TimeList.mapBody > (\ev -> ev{eventDur = f (eventDur ev)}) . > TimeList.mapTime f > mapTimePadded :: > (time0 -> time1) -> Padded time0 note -> Padded time1 note > mapTimePadded f = > TimeListPad.mapBody > (\ev -> ev{eventDur = f (eventDur ev)}) . > TimeListPad.mapTime f > eventFromPerformanceEvent :: > (dyn -> Pitch.Relative -> note -> backEndNote) -> > Pf.Event time dyn note -> Event time backEndNote > eventFromPerformanceEvent f = > \ (Pf.Event dur vel trans note) > -> Event dur (f vel trans note) > fromPerformance :: > (dyn -> Pitch.Relative -> note -> backEndNote) -> > Pf.T time dyn note -> T time backEndNote > fromPerformance = TimeList.mapBody . eventFromPerformanceEvent > fromPaddedPerformance :: > (dyn -> Pitch.Relative -> note -> backEndNote) -> > Pf.Padded time dyn note -> Padded time backEndNote > fromPaddedPerformance = TimeListPad.mapBody . eventFromPerformanceEvent \end{haskelllisting} For symmetry we also provide a function which converts a performance back to a music. This operation is not uniquely defined, and a satisfying implementation is a music theoretical challenge. A sophisticated algorithm would have to make assumptions about the structure of ``common'' music. So you will be able to construct examples of music that fool such an algorithm. The opposite extreme is a version which simply maps the stream of notes to a big parallel composition where each parallel channel consists of one note. (The normal form as described in Hudak's Temporal Media paper.) The following implementation tries to avoid obviously unnecessary parallelism by watching for non-overlapping notes. Nevertheless the conversion of general polyphonic music yields a music that is not very nicely structured. So, don't rely on the structure of the restored music, only assume that this functions reverts the performance generation. \begin{haskelllisting} > toMusic :: T Music.Dur note -> Music.T note > toMusic = > TimeList.switchL > (Music.rest 0) > (\ (t0, Event d mn) es0 -> > let n = if d>=0 > then Music.atom d (Just mn) > else error "Performance.toMusic: note of negative duration" > rmd = > TimeList.switchL n > (\(t1, re1) es1 -> > if t1 >= d > then n +:+ toMusic (TimeList.cons (t1-d) re1 es1) > else n =:= toMusic es0) > es0 > in case compare t0 0 of > EQ -> rmd > GT -> Music.rest t0 +:+ rmd > LT -> error "Performance.toMusic: events in wrong order") \end{haskelllisting} haskore-0.2.0.3/src/Haskore/Performance/Context.hs0000644000000000000000000000315011754016451020103 0ustar0000000000000000module Haskore.Performance.Context (T, setPlayer, setDur, setTranspose, setDynamics, getPlayer, getDur, getTranspose, getDynamics, Pf.updatePlayer, Pf.updateDur, Pf.updateTranspose, Pf.updateDynamics, contextPlayer, contextDur, contextTranspose, contextDynamics, ) where import qualified Haskore.Basic.Pitch as Pitch -- import qualified Haskore.Music as Music import qualified Haskore.Performance as Pf import qualified Haskore.Performance.Player as Player import Haskore.Performance(Context(..)) -- import qualified Numeric.NonNegative.Class as NonNeg {- If the Haskell compilers would support mutual depending modules the Context data type would be declared here instead of in Performance. -} type T time dyn note = Pf.Context time dyn note type SetContext time dyn note a = a -> T time dyn note -> T time dyn note setPlayer :: SetContext time dyn note (Player.T time dyn note) setPlayer = Pf.updatePlayer . const setDur :: SetContext time dyn note time setDur = Pf.updateDur . const setTranspose :: SetContext time dyn note Pitch.Relative setTranspose = Pf.updateTranspose . const setDynamics :: SetContext time dyn note dyn setDynamics = Pf.updateDynamics . const type GetContext time dyn note a = T time dyn note -> a getPlayer :: GetContext time dyn note (Player.T time dyn note) getPlayer = Pf.contextPlayer getDur :: GetContext time dyn note time getDur = Pf.contextDur getTranspose :: GetContext time dyn note Pitch.Relative getTranspose = Pf.contextTranspose getDynamics :: GetContext time dyn note dyn getDynamics = Pf.contextDynamics haskore-0.2.0.3/src/Haskore/Performance/Player.lhs0000644000000000000000000001352111754016451020072 0ustar0000000000000000 \begin{haskelllisting} > module Haskore.Performance.Player where > > import Haskore.Music (PhraseAttribute, ) > import qualified Haskore.Music as Music > -- import qualified Haskore.Performance.Context as Context > -- this import would cause a cycle > import qualified Haskore.Performance as Pf > -- import qualified Data.EventList.Relative.TimeBody as TimeList > import qualified Data.EventList.Relative.TimeTime as TimeListPad > import qualified Data.EventList.Relative.TimeMixed as TimeListPad > import qualified Haskore.Basic.Duration as Dur > import qualified Numeric.NonNegative.Class as NonNeg > import Haskore.Performance (eventDur, eventDynamics, ) > import Data.Tuple.HT (mapFst, ) > import Control.Monad.Trans.Reader(Reader, asks, ) > import Control.Monad (liftM, ) > > type T time dyn note = Pf.Player time dyn note > -- constructors can't be renamed, we might use a function instead > -- cons = Pf.PlayerCons > > type Name = Music.PlayerName > type Map time dyn note = Pf.PlayerMap time dyn note > > > type PhraseInterpreter time dyn note = > PhraseAttribute -> (Pf.T time dyn note, time) -> (Pf.T time dyn note, time) > > type EventModifier time dyn note = > Pf.Event time dyn note -> Pf.Event time dyn note > > changeVelocity :: Num dyn => (dyn -> dyn) -> > EventModifier time dyn note > changeVelocity f = > (\e -> e {eventDynamics = f (eventDynamics e)}) > > changeDur :: Num time => (time -> time) -> > EventModifier time dyn note > changeDur f = > (\e -> e {eventDur = f (eventDur e)}) \end{haskelllisting} \figref{fancy-Player} defines a relatively sophisticated player called \function{fancyPlayer} that knows all that \function{Player.deflt} knows, and much more. All three articulations \constructor{Staccato}, \constructor{Legato}, \constructor{Slurred} are interpreted as changing the duration of the notes proportionally. That's why they have the suffix \code{Rel} for {\em relative}. \begin{itemize} \item The function \function{legatoRel} takes a ratio of each note's duration. In order to obtain a real Legato effect the value must be larger than 1. \item The function \function{slurredRel} is similar to \function{legatoRel} but it doesn't extend the duration of the {\em last} note(s). \item The function \function{staccatoRel} divides the note durations by constant factor. In order to obtain a real Staccato effect the value must be larger than 1. \end{itemize} \begin{haskelllisting} > staccatoRel, legatoRel, slurredRel :: (NonNeg.C time, Fractional time) => > Dur.T -> Pf.Monad time dyn note -> Pf.Monad time dyn note > staccatoRel x = mapEvents (changeDur (/ Dur.toNumber x)) > legatoRel x = mapEvents (changeDur (* Dur.toNumber x)) > slurredRel x = mapInitEvents (changeDur (* Dur.toNumber x)) > mapInitEvents :: (NonNeg.C time, Num time) => > EventModifier time dyn note -> > Pf.Monad time dyn note -> Pf.Monad time dyn note > mapInitEvents f = > let -- modify durations of all notes except those with the latest start time > aux = > TimeListPad.flatten . > TimeListPad.mapTimeInit > (TimeListPad.mapBodyInit > (TimeListPad.mapBody (map (fmap f)))) . > TimeListPad.collectCoincident > in liftM (mapFst aux) > mapEvents :: EventModifier time dyn note -> > Pf.Monad time dyn note -> Pf.Monad time dyn note > mapEvents f = liftM (mapFst (TimeListPad.mapBody (fmap f))) \end{haskelllisting} In contrast to the relative interpretations above, we feel that somehow absolute changes are more useful. That's why we make these functions the default for the fancy player. These function expect regular note durations, that is ratios of a whole note. \begin{itemize} \item The functions \function{legatoAbs} and \function{slurredAbs} prolong notes by a fix amount. That is the overlap (if no rests are between) is constant. \item \function{staccatoAbs} replaces the note durations by a fix amount. \end{itemize} \begin{haskelllisting} > staccatoAbs, legatoAbs, slurredAbs :: (NonNeg.C time, Fractional time) => > Dur.T -> Pf.Monad time dyn note -> Pf.Monad time dyn note > staccatoAbs dur pf = > getDurModifier const dur >>= flip mapEvents pf > legatoAbs dur pf = > getDurModifier (+) dur >>= flip mapEvents pf > slurredAbs dur pf = > getDurModifier (+) dur >>= flip mapInitEvents pf > > getDurModifier :: (Fractional time) => > (time -> time -> time) -> Dur.T -> > Reader (Pf.Context time dyn note) (EventModifier time dyn note) > getDurModifier f dur = > do tempo <- asks Pf.contextDur > return (changeDur (f (Dur.toNumber dur * tempo))) \end{haskelllisting} The behavior of \expression{(Ritardando x)} can be explained as follows. We'd 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' = \left(1 + \frac{t-t_0}{D}\cdot x\right)\cdot(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' = \left(1 + \frac{t+d-t_0}{D}\cdot x\right)\cdot(t+d-t_0) + t_0 \] The difference $t_d' - t'$ gives us the new, stretched duration $d'$, which after simplification is: \[ d' = \left(1 + \frac{2\cdot(t-t_0)+d}{D}\cdot x\right)\cdot d \] \constructor{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 \constructor{Crescendo} and \constructor{Diminuendo}. \begin{haskelllisting} > accent :: (Fractional dyn) => > Rational -> Pf.Monad time dyn note -> Pf.Monad time dyn note > accent x = mapEvents (changeVelocity (fromRational x +)) \end{haskelllisting} haskore-0.2.0.3/src/Haskore/Performance/Fancy.lhs0000644000000000000000000002003411754016451017673 0ustar0000000000000000\subsection{Conversion functions with default settings} \seclabel{fancy-performance} {\small \begin{haskelllisting} > module Haskore.Performance.Fancy where > import qualified Haskore.Music as Music > import qualified Haskore.Performance as Performance > import qualified Haskore.Performance.Context as Context > import qualified Haskore.Performance.Player as Player > import qualified Haskore.Performance.Default as DefltPf > import Haskore.Performance (eventDur, ) > -- import qualified Data.EventList.Relative.TimeBody as TimeList > -- import qualified Data.EventList.Relative.TimeTime as TimeListPad > import qualified Data.EventList.Relative.MixedTime as TimeListPad > import qualified Data.EventList.Relative.BodyTime as BodyTimeList > import Control.Monad.Trans.State (state, evalState, ) > import Control.Monad.Trans.Reader (local, ) > > import qualified Numeric.NonNegative.Class as NonNeg > import qualified Numeric.NonNegative.Wrapper as NonNegW > import Prelude hiding (map) \end{haskelllisting} } \begin{figure} {\small \begin{haskelllisting} > player :: (NonNeg.C time, Fractional time, Real time, Fractional dyn) => > Player.T time dyn note > player = map "Fancy" > > -- a PMap that makes everything into a fancyPlayer > map :: > (NonNeg.C time, Fractional time, Real time, Fractional dyn) => > String -> Player.T time dyn note > map pname = > Performance.PlayerCons { > Performance.name = pname, > Performance.playNote = DefltPf.playNote, > Performance.interpretPhrase = fancyInterpretPhrase, > Performance.notatePlayer = DefltPf.notatePlayer () > } > > processPerformance :: (Num time) => > (time -> > (time -> time -> time, > time -> Performance.Event time dyn note -> Performance.Event time dyn note, > time)) -> > (Performance.PaddedWithRests time dyn note, time) -> > (Performance.PaddedWithRests time dyn note, time) > processPerformance f (pf, dur) = > let (fTime, fEvent, newDur) = f dur > procPf = > flip evalState 0 . > BodyTimeList.mapM > (\dt -> state $ \t -> (fTime t dt, t+dt)) > (\ev -> state $ \t -> (fmap (fEvent t) ev, t)) > in (TimeListPad.mapTimeTail procPf pf, newDur) > > fancyInterpretDynamic :: > (Fractional time, Real time, Fractional dyn) => > Music.Dynamic -> Performance.Monad time dyn note -> Performance.Monad time dyn note > fancyInterpretDynamic dyn = > let loud x = local (Performance.updateDynamics (fromRational x *)) > inflate add x dur = > let r = fromRational x / realToFrac dur > in (const id, > \t -> Player.changeVelocity (add (realToFrac t * r)), > dur) > in case dyn of > Music.Accent x -> Player.accent x > Music.Loudness x -> loud x > Music.Crescendo x -> fmap (processPerformance (inflate (+) x)) > Music.Diminuendo x -> fmap (processPerformance (inflate subtract x)) > -- Music.Crescendo x -> fmap (processPerformance (inflate x)) > -- Music.Diminuendo x -> fmap (processPerformance (inflate (-x))) > > fancyInterpretTempo :: (Fractional time, Real time) => > Music.Tempo -> Performance.Monad time dyn note -> Performance.Monad time dyn note > fancyInterpretTempo tmp = > let stretch add x dur = > let x' = fromRational x > r = x' / dur > fac t dt = add 1 (r * (2*t + dt)) > in (\t dt -> dt * fac t dt, > \t (e@Performance.Event {eventDur = d}) -> > e{eventDur = d * fac t d }, > dur * add 1 x') > in case tmp of > Music.Ritardando x -> fmap (processPerformance (stretch (+) x)) > Music.Accelerando x -> fmap (processPerformance (stretch (-) x)) > -- Music.Accelerando x -> fmap (processPerformance (stretch (\a b -> if a>=b then a-b else 0) x)) > fancyInterpretArticulation :: (NonNeg.C time, Fractional time) => > Music.Articulation -> Performance.Monad time dyn note -> Performance.Monad time dyn note > fancyInterpretArticulation art = > case art of > Music.Staccato x -> Player.staccatoAbs x > Music.Legato x -> Player.legatoAbs x > Music.Slurred x -> Player.slurredAbs x > _ -> id > {- Remaining articulations: > Tenuto | Marcato | Pedal | Fermata | FermataDown > | Breath | DownBow | UpBow | Harmonic | Pizzicato > | LeftPizz | BartokPizz | Swell | Wedge | Thumb | Stopped -} > fancyInterpretOrnament :: (Fractional time, Real time) => > Music.Ornament -> Performance.Monad time dyn note -> Performance.Monad time dyn note > fancyInterpretOrnament _orn = id > {- Remaining ornamenations: > Trill | Mordent | InvMordent | DoubleMordent | Turn > | TrilledTurn | ShortTrill | Arpeggio | ArpeggioUp > | ArpeggioDown | Instruction String | Head NoteHead -} > {- Design Problem: To do these right we need to keep the KEY SIGNATURE > around so that we can determine, for example, what the trill note is. > Alternatively, provide an argument to Trill to carry this info. -} > fancyInterpretPhrase :: > (NonNeg.C time, Fractional time, Real time, Fractional dyn) => > Performance.PhraseFun time dyn note > fancyInterpretPhrase pa = > case pa of > Music.Dyn dyn -> fancyInterpretDynamic dyn > Music.Tmp tmp -> fancyInterpretTempo tmp > Music.Art art -> fancyInterpretArticulation art > Music.Orn orn -> fancyInterpretOrnament orn > context :: > (NonNeg.C time, Fractional time, Real time, Fractional dyn) => > Context.T time dyn note > context = DefltPf.context {Performance.contextPlayer = player} \end{haskelllisting} } \caption{Definition of Player \function{Fancy.player}.} \figlabel{fancy-Player} \end{figure} {\small \begin{haskelllisting} > fromMusic :: > (Ord note, NonNeg.C time, RealFrac time, Fractional dyn, Ord dyn) => > Music.T note -> Performance.T time dyn note > fromMusic = > Performance.fromMusic map context > > fromMusicModifyContext :: > (Ord note, NonNeg.C time, RealFrac time, Fractional dyn, Ord dyn) => > (Context.T time dyn note -> Context.T time dyn note) -> > Music.T note -> > Performance.T time dyn note > fromMusicModifyContext update = > Performance.fromMusic > map > (update context) > > floatFromMusic :: (Ord note) => > Music.T note -> Performance.T NonNegW.Float Float note > floatFromMusic = fromMusic > > paddedFromMusic :: > (Ord note, NonNeg.C time, RealFrac time, Fractional dyn, Ord dyn) => > Music.T note -> Performance.Padded time dyn note > paddedFromMusic = > Performance.paddedFromMusic map context > > doublePaddedFromMusic :: > (Ord note) => > Music.T note -> Performance.Padded NonNegW.Double Double note > doublePaddedFromMusic = > Performance.paddedFromMusic map context > > paddedFromMusicModifyContext :: > (Ord note, NonNeg.C time, RealFrac time, Fractional dyn, Ord dyn) => > (Context.T time dyn note -> Context.T time dyn note) -> > Music.T note -> > Performance.T time dyn note > paddedFromMusicModifyContext update = > Performance.fromMusic > map > (update context) \end{haskelllisting} } % fromRhythmicMusic :: (Ord drum, Ord instr, RealFrac time) => % RhyMusic.T drum instr -> Performance.T time (RhyMusic.Note drum instr) % fromRhythmicMusic = % Performance.fromMusic map context % % floatFromRhythmicMusic :: (Ord drum, Ord instr) => % RhyMusic.T drum instr -> Performance.T Float (RhyMusic.Note drum instr) % floatFromRhythmicMusic = fromRhythmicMusic % % stateFromRhythmicMusic :: % (Ord drum, Ord instr, Fractional time, Real time) => % (RhyMusic.T drum instr) -> % ((Performance.T time (RhyMusic.Note drum instr), time), % Context.T time (RhyMusic.Note drum instr)) % stateFromRhythmicMusic m = % runState (Performance.monadFromMusic map m) context % monadFromMusic :: % (Ord note, RealFrac time) => % Music.T note -> % ((Performance.T time dyn note, time), % Context.T time dyn note) % monadFromMusic m = % runReader (Performance.monadFromMusic map m) context haskore-0.2.0.3/src/Test/0000755000000000000000000000000011754016452013207 5ustar0000000000000000haskore-0.2.0.3/src/Test/Equivalence.lhs0000644000000000000000000003570711754016452016174 0ustar0000000000000000\subsubsection{Equivalence of Literal Performances} \seclabel{equivalence} \newcommand\equivalent{$\ \ \equiv\ \ $} A \keyword{literal performance} is one in which no aesthetic interpretation is given to a musical object. The function \function{Pf.fromMusic} in fact yields a literal performance; aesthetic nuances must be expressed explicitly using note and phrase attributes. There are many musical objects whose literal performances we expect to be \keyword{equivalent}. For example, the following two musical objects are certainly not equal as data structures, but we would expect their literal performances to be identical: \begin{center} \code{(m0 +:+\ m1) +:+\ (m2 +:+\ m3)} \\ \code{m0 +:+\ m1 +:+\ m2 +:+\ m3} \end{center} Thus we define a notion of equivalence: \begin{definition} Two musical objects \code{m0} and \code{m1} are \keyword{equivalent}, written \code{m0}$\ \equiv\ $\code{m1}, if and only if: \begin{center} ($\forall$\code{imap,c})\quad \code{Pf.fromMusic imap c m0 = Pf.fromMusic imap c m1} \end{center} where ``\code{=}'' is equality on values (which in Haskell is defined by the underlying equational logic). \end{definition} One of the most useful things we can do with this notion of equivalence is establish the validity of certain \keyword{transformations} on musical objects. A transformation is {\em valid} if the result of the transformation is equivalent (in the sense defined above) to the original musical object; i.e.\ it is ``meaning preserving''. Some of these connections are used in the \module{Optimization} (\secref{optimization}) in order to simplify a musical data structure. The most basic of these transformation we treat as \keyword{axioms} in an \keyword{algebra of music}. For example: \begin{axiom} For any \code{r0}, \code{r1}, and \code{m}: \begin{center} \code{changeTempo r0 (changeTempo r1 m)} \equivalent \code{changeTempo (r0*r1) m} \end{center} \end{axiom} To prove this axiom, we use conventional equational reasoning (for clarity we omit \code{imap}, simplify the context to just \code{dt}, and omit \code{fromRational}): \begin{proof} \begin{haskellblock} Pf.fromMusic dt (changeTempo r0 (changeTempo r1 m)) = Pf.fromMusic (dt / r0) (changeTempo r1 m) -- unfolding Pf.fromMusic = Pf.fromMusic ((dt / r0) / r1) m -- unfolding Pf.fromMusic = Pf.fromMusic (dt / (r0 * r1)) m -- simple arithmetic = Pf.fromMusic dt (changeTempo (r0*r1) m) -- folding Pf.fromMusic \end{haskellblock} \end{proof} Here is another useful transformation and its validity proof (for clarity in the proof we omit \code{imap} and simplify the context to just \code{(t,dt)}): \begin{axiom} For any \code{r}, \code{m0}, and \code{m1}: \begin{center} \code{changeTempo r (m0 +:+\ m1)} \equivalent \code{changeTempo r m0 +:+\ changeTempo r m1} \end{center} \end{axiom} In other words, {\em tempo scaling distributes over sequential composition}. \begin{proof} \begin{haskellblock} Pf.fromMusic (t,dt) (changeTempo r (m0 +:+ m1)) = Pf.fromMusic (t,dt/r) (m0 +:+ m1) -- unfolding Pf.fromMusic = Pf.fromMusic (t,dt/r) m0 ++ Pf.fromMusic (t',dt/r) m1 -- unfolding Pf.fromMusic = Pf.fromMusic (t,dt) (changeTempo r m0) ++ Pf.fromMusic (t',dt) (changeTempo r m1) -- folding Pf.fromMusic where t' = t + dur m0 * dt/r = Pf.fromMusic (t,dt) (changeTempo r m0) ++ Pf.fromMusic (t'',dt) (changeTempo r m1) -- folding dur where t'' = t + dur (changeTempo r m0) * dt = Pf.fromMusic (t,dt) (changeTempo r m0 +:+ changeTempo r m1) -- folding Pf.fromMusic \end{haskellblock} \end{proof} An even simpler axiom is given by: \begin{axiom} For any \code{m}: \begin{center} \code{changeTempo 1 m} \equivalent \code{m} \end{center} \end{axiom} In other words, {\em unit tempo scaling is the identity}. \begin{proof} \begin{haskellblock} Pf.fromMusic (t,dt) (changeTempo 1 m) = Pf.fromMusic (t,dt/1) m -- unfolding Pf.fromMusic = Pf.fromMusic (t,dt) m -- simple arithmetic \end{haskellblock} \end{proof} Note that the above proofs, being used to establish axioms, all involve the definition of \function{Pf.fromMusic}. 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} For any \code{r}, \code{m0}, and \code{m1}: \begin{center} \code{changeTempo r m0 +:+\ m1} \equivalent \code{changeTempo r (m0 +:+\ changeTempo (recip r) m1)} \end{center} \begin{comment} % propTempoPartialSerial :: % Dur.Ratio -> MidiMusic.T -> MidiMusic.T -> Property % propTempoPartialSerial r m0 m1 = % r > 0 ==> % changeTempo r m0 +:+ m1 =?= % changeTempo r (m0 +:+ changeTempo (recip r) m1) \end{comment} \end{theorem} \begin{proof} \begin{haskellblock} changeTempo r (m0 +:+ changeTempo (recip r) m1) = changeTempo r m0 +:+ changeTempo r (changeTempo (recip r) m1) -- by Axiom 1 = changeTempo r m0 +:+ changeTempo (r * recip r) m1 -- by Axiom 2 = changeTempo r m0 +:+ changeTempo 1 m1 -- simple arithmetic = changeTempo r m0 +:+ m1 -- by Axiom 3 \end{haskellblock} \end{proof} For example, this fact justifies the equivalence of the two phrases shown in \figref{equiv}. \begin{figure*} \centerline{ \includegraphics[height=0.6in]{Doc/Pics/equiv} } \caption{Equivalent Phrases} \figlabel{equiv} \end{figure*} Many other interesting transformations of Haskore musical objects can be stated and proved correct using equational reasoning. We leave as an exercise for the reader the proof of the following axioms (which include the above axioms as special cases). The following axioms are additionally given in a way which allows automatic tests using the QuickCheck package. \url{http://www.cs.chalmers.se/~rjmh/QuickCheck/} The properties are formulated as functions but they can translated one-by-one from the axioms stated in mathematical notation. \begin{haskelllisting} > module Equivalence where > import Haskore.Music hiding (repeat, reverse, dur) > import qualified Haskore.Music.GeneralMIDI as MidiMusic > -- should also work for general RhyMusic but is a bit more cumbersome > import qualified Haskore.Performance as Performance > import qualified Haskore.Performance.Default as DefltPf > import qualified Haskore.Performance.Player as Player > import qualified Haskore.Basic.Duration as Dur > import qualified Data.EventList.Relative.TimeTime as TimeListPad > import qualified Numeric.NonNegative.Wrapper as NonNeg > import Data.Tuple.HT (mapFst, ) > import Control.Monad.Trans.Reader (runReader, ) > import Test.QuickCheck \end{haskelllisting} We define operators \function{=?=} and \function{==?==} which play the role of our previously defined equivalence sign ``$\equiv$''. The operator \function{=?=} compares plain pieces of music, whereas the operator \function{==?==} compares functions mapping to music. We will use the second one mainly in order to compare music transformers like \function{changeTempo} and \function{transpose}. \begin{haskelllisting} > infix 4 =?=, ==?== > (=?=) :: MidiMusic.T -> MidiMusic.T -> Bool > (=?=) m0 m1 = > let pl = DefltPf.map :: Player.Map NonNeg.Rational Rational MidiMusic.Note > perform m = > mapFst TimeListPad.catMaybes $ > runReader (Performance.monadFromMusic pl m) DefltPf.context > in perform m0 == perform m1 > (==?==) :: (a -> MidiMusic.T) -> (a -> MidiMusic.T) -> (a -> Bool) > (==?==) fm0 fm1 x = fm0 x =?= fm1 x \end{haskelllisting} Here we repeat one of the simple axioms, now also with a test function ready for quick-checking. \begin{axiom} Changing the tempo by $1$ and transposing by $0$ are identities. That is: \begin{center} \code{changeTempo 1} \equivalent \code{id} \\ \code{transpose 0} \equivalent \code{id} \end{center} \begin{haskelllisting} > propTempoNeutral, propTransposeNeutral :: MidiMusic.T -> Bool > propTempoNeutral = changeTempo 1 ==?== id > propTransposeNeutral = transpose 0 ==?== id \end{haskelllisting} \end{axiom} The first QuickCheck test function reads as: ``The property of a neutral tempo change is that changing the tempo by one is equivalent to the identity function.'' It says everything we want to state and not more. It is available in a machine readable form ready both for static provers and for tests by execution. QuickCheck will call these functions on several randomly generated pieces of music. These songs might sound awful, so they should be exotically enough in order to check whether our axioms are not only true for common music. \begin{axiom} \function{changeTempo} is \keyword{multiplicative} and \function{transpose} is \keyword{additive}. That is, for any \code{r0}, \code{r1}, \code{p0}, \code{p1}: \begin{center} \code{changeTempo r0 . changeTempo r1} \equivalent \code{changeTempo (r0*r1)}\\ \code{transpose p0 . transpose p1} \equivalent \code{transpose (p0+p1)} \end{center} \begin{haskelllisting} > propTempoTempo :: > Dur.Ratio -> Dur.Ratio -> MidiMusic.T -> Property > propTempoTempo r0 r1 m = > r0 > 0 && r1 > 0 ==> > (changeTempo r0 . changeTempo r1 ==?== > changeTempo (r0*r1)) m > propTransposeTranspose :: > Int -> Int -> MidiMusic.T -> Bool > propTransposeTranspose p0 p1 = > transpose p0 . transpose p1 ==?== transpose (p0+p1) \end{haskelllisting} \end{axiom} The first equation needs the precondition of non-zero tempo changes. Changing the tempo to zero causes a division by zero when \function{Pf.fromMusic} recomputes the duration of a whole note. Because of the precondition we can no longer have \type{Bool} as function value but we must use \type{Property} which stores not only the result of the test but also if the precondition was fulfilled. Test cases where the precondition fail do not count in the maximum number of tests performed per test function. \begin{axiom} Function composition is \keyword{commutative} with respect to both tempo scaling and transposition. That is, for any \code{r0}, \code{r1}, \code{p0} and \code{p1}: \begin{center} \code{changeTempo r0 .\ changeTempo r1} \equivalent \code{changeTempo r1 .\ changeTempo r0}\\ \code{transpose p0 .\ transpose p1} \equivalent \code{transpose p1 .\ transpose p0}\\ \code{changeTempo r0 .\ transpose p0} \equivalent \code{transpose p0 .\ changeTempo r0}\\ \end{center} \begin{haskelllisting} > propTempoCommutativity :: Dur.Ratio -> Dur.Ratio -> MidiMusic.T -> Property > propTempoCommutativity r0 r1 m = > r0 > 0 && r1 > 0 ==> > (changeTempo r0 . changeTempo r1 ==?== > changeTempo r1 . changeTempo r0) m > propTransposeCommutativity :: Int -> Int -> MidiMusic.T -> Bool > propTransposeCommutativity p0 p1 = > transpose p0 . transpose p1 ==?== transpose p1 . transpose p0 > propTempoTransposeCommutativity :: > Dur.Ratio -> Int -> MidiMusic.T -> Property > propTempoTransposeCommutativity r p m = > r > 0 ==> > (changeTempo r . transpose p ==?== > transpose p . changeTempo r) m \end{haskelllisting} \end{axiom} \begin{axiom} Tempo scaling and transposition are \keyword{distributive} over both sequential and parallel composition. That is, for any \code{r}, \code{p}, \code{m0}, and \code{m1}: \begin{center} \code{changeTempo r (m0 +:+\ m1)} \equivalent \code{changeTempo r m0 +:+\ changeTempo r m1}\\ \code{changeTempo r (m0 =:=\ m1)} \equivalent \code{changeTempo r m0 =:=\ changeTempo r m1}\\ \code{transpose p (m0 +:+\ m1)} \equivalent \code{transpose p m0 +:+\ transpose p m1}\\ \code{transpose p (m0 =:=\ m1)} \equivalent \code{transpose p m0 =:=\ transpose p m1} \end{center} \begin{haskelllisting} > propTempoSerial, propTempoParallel :: > Dur.Ratio -> MidiMusic.T -> MidiMusic.T -> Property > propTempoSerial r m0 m1 = > r > 0 ==> > changeTempo r (m0 +:+ m1) =?= > changeTempo r m0 +:+ changeTempo r m1 > propTempoParallel r m0 m1 = > r > 0 ==> > changeTempo r (m0 =:= m1) =?= > changeTempo r m0 =:= changeTempo r m1 > propTransposeSerial, propTransposeParallel :: > Int -> MidiMusic.T -> MidiMusic.T -> Bool > propTransposeSerial p m0 m1 = > transpose p (m0 +:+ m1) =?= transpose p m0 +:+ transpose p m1 > propTransposeParallel p m0 m1 = > transpose p (m0 =:= m1) =?= transpose p m0 =:= transpose p m1 \end{haskelllisting} \end{axiom} \begin{comment} Counter example for propTempoParallel: r = 1 m0 = c 0 0 [] m1 = d 0 0 [] =:= (d 0 0 [] +:+ c 0 0 []) This leads to different results because (=:=) merges parallel compositions in the operands. This is suppressed if an identity like (changeTempo 1) or (transpose 0) is inserted. \end{comment} \begin{axiom} Sequential and parallel composition are \keyword{associative}. That is, for any \code{m0}, \code{m1}, and \code{m2}: \begin{center} \code{m0 +:+\ (m1 +:+\ m2)} \equivalent \code{(m0 +:+\ m1) +:+\ m2}\\ \code{m0 =:=\ (m1 =:=\ m2)} \equivalent \code{(m0 =:=\ m1) =:=\ m2} \end{center} \begin{haskelllisting} > propSerialAssociativity, propParallelAssociativity :: > MidiMusic.T -> MidiMusic.T -> MidiMusic.T -> Bool > propSerialAssociativity m0 m1 m2 = > m0 +:+ (m1 +:+ m2) =?= (m0 +:+ m1) +:+ m2 > propParallelAssociativity m0 m1 m2 = > m0 =:= (m1 =:= m2) =?= (m0 =:= m1) =:= m2 \end{haskelllisting} \end{axiom} \begin{axiom} Parallel composition is \keyword{commutative}. That is, for any \code{m0} and \code{m1}: \begin{center} \code{m0 =:=\ m1} \equivalent \code{m1 =:=\ m0} \end{center} \begin{haskelllisting} > propParallelCommutativity :: > MidiMusic.T -> MidiMusic.T -> Bool > propParallelCommutativity m0 m1 = > m0 =:= m1 =?= m1 =:= m0 \end{haskelllisting} \end{axiom} \begin{comment} Counter example: m0 = d 0 0 [] m1 = d 0 0 [] +:+ c 0 0 [] When mergeing using sorting the 'c' must be performed before any 'd' because all three notes start at the same time. But in contrast to that we obtain: Performance.fromMusic (m0 =:= m1) -> [d, d, c] Performance.fromMusic (m1 =:= m0) -> [d, c, d] \end{comment} \begin{axiom} \code{Rest 0} is a \keyword{unit} for \function{changeTempo} and \function{transpose}, and a \keyword{zero} for sequential and parallel composition. That is, for any \code{r}, \code{p}, and \code{m}: \begin{center} \code{changeTempo r (Rest 0)} \equivalent \code{Rest 0}\\ \code{transpose p (Rest 0)} \equivalent \code{Rest 0}\\ \code{m +:+\ Rest 0} \equivalent \code{m} \equivalent \code{Rest 0 +:+\ m}\\ \code{m =:=\ Rest 0} \equivalent \code{m} \equivalent \code{Rest 0 =:=\ m} \end{center} \begin{haskelllisting} > propTempoRest0 :: Dur.Ratio -> Property > propTempoRest0 r = > r > 0 ==> > changeTempo r (rest 0) =?= rest 0 > propTransposeRest0 :: Int -> Bool > propTransposeRest0 p = transpose p (rest 0) =?= rest 0 > propSerialNeutral0, propSerialParallel0, > propSerialNeutral1, propSerialParallel1 :: > MidiMusic.T -> Bool > propSerialNeutral0 m = m +:+ rest 0 =?= m > propSerialNeutral1 m = rest 0 +:+ m =?= m > propSerialParallel0 m = m =:= rest 0 =?= m > propSerialParallel1 m = rest 0 =:= m =?= m \end{haskelllisting} \end{axiom} \begin{exercise} Establish the validity of each of the above axioms. \end{exercise} haskore-0.2.0.3/src/Test/Suite.lhs0000644000000000000000000012030211754016452015006 0ustar0000000000000000A module that automatically tests the function of several modules. We use the (standard) package QuickCheck for automatic tests on randomly generated data and we use HUnit as a framework to run all tests. Because of the lack of a package structure we included the required modules from the HUnit project in Haskore. The module must have the name \code{Main} in order to be run by \code{runhugs}. > module Main where > import Equivalence((=?=), (==?==), ) > import qualified Equivalence > import qualified Medium.Controlled as CtrlMedium > import qualified Medium.Controlled.List as CtrlMediumList > import qualified Medium.Temporal as Temporal > import qualified Medium > import qualified Control.Monad.HT as M > import qualified Data.List as List > import Data.Ratio (Ratio, (%), ) > import Data.Maybe (isJust, ) > import Data.Maybe.HT (toMaybe, ) > import System.Random(StdGen, mkStdGen, randomR, ) > import Control.Monad (liftM, liftM2, replicateM, when, ) > import Haskore.General.Utility (shuffle, maximum0, ) > import Haskore.Music hiding (repeat, reverse, ) > import Haskore.Melody as Melody > import Haskore.Basic.Duration (wn, qn, en, (%+), ) > import qualified Haskore.Music as Music > import qualified Haskore.Melody.Standard as StdMelody > import qualified Haskore.Music.GeneralMIDI as MidiMusic > import qualified Haskore.Music.Rhythmic as RhyMusic > import qualified Haskore.Basic.Pitch as Pitch > import qualified Haskore.Basic.Duration as Duration > import qualified Haskore.Performance as Performance > import qualified Haskore.Performance.Fancy as FancyPerformance > import qualified Haskore.Performance.Default as DefaultPerformance > import qualified Haskore.Performance.Context as Context > import qualified Haskore.Performance.BackEnd as PfBE > import qualified Haskore.Process.Optimization as Optimization > import qualified Haskore.Example.SelfSim as SelfSim > import qualified Haskore.Example.Flip as Flip > import qualified Haskore.Example.ChildSong6 as ChildSong6 > import qualified Haskore.Example.Ssf as Ssf > import qualified Haskore.Example.Fractal as Fractal > import qualified Haskore.Example.Kantate147 as Kantate147 > import qualified Haskore.Example.NewResolutions as NewResolutions > import Haskore.Example.Guitar as Guitar > import Haskore.Example.Miscellaneous > import qualified Haskore.Interface.MIDI.Render as Render > import qualified Haskore.Interface.MIDI.Write as WriteMidi > import qualified Haskore.Interface.MIDI.Read as ReadMidi > import qualified Haskore.Interface.MIDI.InstrumentMap as InstrMap > import qualified Sound.MIDI.File as MidiFile > import qualified Sound.MIDI.File.Save as SaveMidi > import qualified Sound.MIDI.File.Load as LoadMidi > import qualified Sound.MIDI.Parser.Report as MidiReport > import qualified Sound.MIDI.File.Event as MidiEvent > import qualified Sound.MIDI.File.Event.Meta as MetaEvent > import qualified Sound.MIDI.Message.Channel as ChannelMsg > import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg > import qualified Haskore.Interface.CSound.Orchestra as CSOrchestra > import qualified Haskore.Interface.CSound.Score as CSScore > import qualified Haskore.Interface.CSound.Tutorial as CSTutorial > import qualified Medium.Controlled.ContextFreeGrammar as Grammar > import qualified Haskore.Process.Format as MusicFormat > import qualified Data.EventList.Relative.TimeBody as TimeList > import qualified Numeric.NonNegative.Class as NonNeg > import qualified Numeric.NonNegative.Wrapper as NonNegW > import Numeric.NonNegative.Class ((-|)) > import Test.QuickCheck > (Property, (==>), Arbitrary, resize, arbitrary, sized, choose, > Testable, Gen, oneof, frequency, ) > import qualified Test.QuickCheck as QC > import qualified Test.QuickCheck.Batch as QCB > import qualified Test.HUnit as HUnit > import qualified Test.HUnit.Text as HUnitText > import qualified Data.Accessor.Basic as Accessor > import System.Cmd (system, ) > import qualified System.Exit as Exit > import qualified Data.ByteString.Lazy as B import Debug.Trace (trace) > midiDir, csoundDir :: FilePath > midiDir = "src/Test/MIDI/" > csoundDir = "src/Test/CSound/" > hugsPath :: String > hugsPath = ":src:src/Haskore" Some functions for connecting QuickCheck with HUnit. > isTestSuccessful :: QCB.TestResult -> Bool > isTestSuccessful (QCB.TestOk _ _ _) = True > isTestSuccessful _ = False > showResult :: QCB.TestResult -> String > showResult (QCB.TestOk _ _ _) = "ok" > showResult (QCB.TestExausted _ _ _) = "exhausted" > showResult (QCB.TestFailed msg n) = "failed at test " ++ show n ++ " with the arguments\n" ++ unlines msg > showResult (QCB.TestAborted _) = "aborted" > testUnit :: Testable a => String -> a -> HUnit.Test > testUnit = testUnitOpt QCB.defOpt > testUnitOpt :: Testable a => QCB.TestOptions -> String -> a -> HUnit.Test > testUnitOpt opt label t = > HUnit.TestLabel label (HUnit.TestCase ( > do result <- QCB.run t opt > HUnit.assertBool (showResult result) (isTestSuccessful result) > )) > sortLines :: String -> String > sortLines = unlines . List.sort . lines > diffFilesIA :: FilePath -> FilePath -> IO () > diffFilesIA file0 file1 = > system ("kompare "++file0++" "++file1) >> return () > -- system ("tkdiff "++file0++" "++file1) >> return () > diffIA :: String -> String -> IO Bool > diffIA orig new = > let file0 = "/tmp/orig.txt" > file1 = "/tmp/new.txt" > dif = orig/=new > in when dif > (do writeFile file0 orig > writeFile file1 new > diffFilesIA file0 file1) >> > return (not dif) > assertEqualText :: String -> String -> String -> HUnit.Assertion > assertEqualText preface expected actual = > let msg = (if null preface then "" else preface ++ "\n") ++ > "expected: " ++ show expected ++ "\n but got: " ++ show actual > in when (actual /= expected) > -- (diffIA expected actual >> > (diffIA (sortLines expected) (sortLines actual) >> > HUnit.assertFailure msg) These tests checks if the MIDI files generated for several examples is still the same as these generated by the version of 2000. > sortMidi :: MidiFile.T -> MidiFile.T > sortMidi = MidiFile.progChangeBeforeSetTempo . MidiFile.sortEvents > testMidiBin :: FilePath -> MidiFile.T -> HUnit.Test > testMidiBin name stream = > HUnit.TestLabel name (HUnit.TestList > (testSaveMidi name stream : testReadMidi name : [])) > testSaveMidi :: FilePath -> MidiFile.T -> HUnit.Test > testSaveMidi name stream = HUnit.TestCase $ > do > -- diffMidiBin name (sortMidi stream) > let path = midiDir++name++".mid" > let new = SaveMidi.toByteString (sortMidi stream) > -- B.writeFile path new > orig <- B.readFile path > -- putStrLn (show (length orig) ++ " -- " ++ show (length stream)) > HUnit.assertEqual "saveMidi" orig new > equalMidi :: MidiFile.T -> MidiFile.T -> IO Bool > equalMidi x y = > -- diffIA (MidiFile.showLines x) (MidiFile.showLines y) >> > return (x == y) > diffGenMidiBin :: (MidiFile.T -> String) -> FilePath -> MidiFile.T -> IO Bool > diffGenMidiBin showFunc name new = > do > orig <- LoadMidi.fromFile (midiDir++name++".mid") > diffIA (showFunc orig) (showFunc new) > diffMidiBin :: FilePath -> MidiFile.T -> IO Bool > diffMidiBin = diffGenMidiBin MidiFile.showLines Sorts the NoteOn and NoteOff MIDI events in the tracks. Their order depends on rounding issues of performance time stamps. > diffSortMidiBin :: FilePath -> MidiFile.T -> IO Bool > diffSortMidiBin = diffGenMidiBin (MidiFile.showLines . MidiFile.sortEvents) Sorts the lines of the formatted output and thus tolerates changes in the order. This post-processing is heavier than diffSortMidiBin. > diffSortMidiBin' :: FilePath -> MidiFile.T -> IO Bool > diffSortMidiBin' = diffGenMidiBin (sortLines . MidiFile.showLines) > writeMusic :: > (InstrMap.ChannelTable MidiMusic.Instrument, > Context.T NonNegW.Float Float MidiMusic.Note, MidiMusic.T) > -> MidiFile.T > writeMusic = WriteMidi.fromGMMusic > testMidiStruct :: String -> MidiFile.T -> MidiFile.T -> HUnit.Assertion > testMidiStruct name origFile newFile = > -- diffSortMidiBin name newFile >> > HUnit.assertEqual > ("WriteMidi.fromMusic for "++name) > origFile > (MidiFile.sortEvents newFile) Test the ReadMidi.toGMMusic function by reading and writing a test file. > testReadMidi :: FilePath -> HUnit.Test > testReadMidi name = HUnit.TestCase $ > do > contents <- B.readFile (midiDir++name++".mid") > let midiFile = > either (error "on reading back MIDI") id $ > MidiReport.result $ > LoadMidi.maybeFromByteString contents > let midiFileRewritten = sortMidi $ writeMusic $ ReadMidi.toGMMusic midiFile > HUnit.assertEqual > "loadMidi" > contents > (SaveMidi.toByteString midiFile) > -- diffMidiBin name (MidiFile.sortEvents (writeMusic (ReadMidi.toGMMusic midiFile))) > {- Notes of zero duration bring note events out of order > if sorted with MidiFile.sortEvents. > What can we do against that? -} > HUnit.assertEqual > "ReadMidi.toGMMusic[0]" > midiFile > midiFileRewritten > > HUnit.assertEqual > "ReadMidi.toGMMusic[1]" > {- > (return (SaveMidi.toByteString (MidiFile.sortEvents midiFile) > == SaveMidi.toByteString midiFileRewritten)) > -} > contents > (SaveMidi.toByteString midiFileRewritten) > -- sorting necessary for test14b > testReadMidiPure :: MidiFile.T -> HUnit.Assertion > testReadMidiPure midiFile = > do > _ <- diffIA > (MidiFile.showLines (MidiFile.sortEvents midiFile)) > (MidiFile.showLines (MidiFile.sortEvents > (writeMusic (ReadMidi.toGMMusic midiFile)))) > HUnit.assertEqual > ("ReadMidi.toGMMusic test") > (MidiFile.sortEvents midiFile) > (MidiFile.sortEvents (writeMusic (ReadMidi.toGMMusic midiFile))) > setInstrMidi :: MidiFile.T > setInstrMidi = > Render.generalMidi $ > MidiMusic.fromMelodyNullAttr MidiMusic.Marimba (c 0 qn ()) +:+ > MidiMusic.fromMelodyNullAttr MidiMusic.Xylophone (e 0 qn ()) > midiPitch :: Int -> VoiceMsg.Pitch > midiPitch = VoiceMsg.toPitch > channel :: Int -> ChannelMsg.Channel > channel = ChannelMsg.toChannel > vel :: VoiceMsg.Velocity > vel = VoiceMsg.normalVelocity > voiceMsg :: VoiceMsg.T -> MidiEvent.T > voiceMsg msg = > MidiEvent.MIDIEvent $ ChannelMsg.Cons (channel 0) $ > ChannelMsg.Voice $ msg > noteOn :: VoiceMsg.Pitch -> MidiEvent.T > noteOn p = > voiceMsg $ VoiceMsg.NoteOn p vel > noteOff :: VoiceMsg.Pitch -> MidiEvent.T > noteOff p = > voiceMsg $ VoiceMsg.NoteOff p vel > program :: VoiceMsg.Program -> MidiEvent.T > program pgm = > voiceMsg $ VoiceMsg.ProgramChange pgm > setTempo :: NonNegW.Int -> MidiEvent.T > setTempo = MidiEvent.MetaEvent . MetaEvent.SetTempo > setTempoMidi :: MidiFile.T > setTempoMidi = > MidiFile.Cons MidiFile.Mixed (MidiFile.Ticks 12) > [TimeList.cons 0 (program (VoiceMsg.toProgram 0)) $ > TimeList.cons 0 (setTempo 1000000) $ > TimeList.cons 0 (noteOn (midiPitch 60)) $ > TimeList.cons 12 (noteOff (midiPitch 60)) $ > TimeList.cons 0 (setTempo 500000) $ > TimeList.cons 0 (noteOn (midiPitch 60)) $ > TimeList.cons 24 (noteOff (midiPitch 60)) $ > TimeList.cons 0 (setTempo 2000000) $ > TimeList.cons 0 (noteOn (midiPitch 60)) $ > TimeList.cons 12 (noteOff (midiPitch 60)) $ > TimeList.empty] > setTempoMusic :: > (InstrMap.ChannelTable MidiMusic.Instrument, > Context.T NonNegW.Float Float MidiMusic.Note, MidiMusic.T) > setTempoMusic = ReadMidi.toGMMusic setTempoMidi The velocities of the original tests were too strong. MIDI spec says that a non-velocity-sensitive instrument gets velocity value 64. > hackVelocities :: MidiFile.T -> MidiFile.T > hackVelocities = MidiFile.changeVelocity (127/64) The tempo of the original files was made with 500000 microseconds as unit. > hackTempo :: MidiFile.T -> MidiFile.T > hackTempo = MidiFile.resampleTime (1/2) > testMIDI :: HUnit.Test > testMIDI = > HUnit.TestLabel "comparison with MIDI files generated by former Haskore versions" > (HUnit.TestList (map (uncurry testMidiBin) ( > ("test01", hackVelocities t1) : > ("test02", t2) : > ("test03", t3) : > ("test04", t4) : > ("test05", t5) : > ("test06", hackVelocities SelfSim.t6) : > ("test07", hackVelocities SelfSim.t7) : > ("test08", SelfSim.t8) : > ("test10", hackVelocities SelfSim.t10) : > ("test13", hackVelocities t13) : > ("test13a", hackVelocities t13a) : > ("test13b", hackVelocities t13b) : > ("test13c", hackVelocities t13c) : > ("test13d", hackVelocities t13d) : > ("test13e", hackVelocities t13e) : > ("test14", hackVelocities t14) : > ("test14b", t14b) : > ("test14c", hackVelocities t14c) : > ("test14d", hackVelocities t14d) : > ("Flip0", Render.generalMidiDeflt (Music.take 1 (withPiano Flip.song))) : > ("Flip1", Render.generalMidiDeflt (Music.take 5 (withPiano Flip.song1))) : > ("Flip2", Render.generalMidi (Music.take 7 Flip.song2)) : > ("Fractal", Render.generalMidiDeflt (Optimization.duration (withPiano Fractal.song))) : > ("Ssf", Render.generalMidiDeflt Ssf.song) : > ("ChildSong6", Render.generalMidiDeflt ChildSong6.song) : > ("NewResolutions", NewResolutions.midi) : > ("Kantate147", Kantate147.midi) : > -- ("GuitarLegato", Render.generalMidi Guitar.legatoSongMIDI) : > ("GuitarParallel", Render.generalMidi Guitar.parallelSongMIDI) : > []))) Check generations of CSound files. > testTutCSound :: > CSOrchestra.Output out => > (String, CSScore.T, CSTutorial.TutOrchestra out) -> HUnit.Assertion > testTutCSound = processTutCSound verifyResult Three actions can be taken on a file to be compared with an old version. All three share the same signature. > verifyResult, diffResult, updateResult :: > String -> FilePath -> String -> HUnit.Assertion The simple test if the new version is equal to the old one. If not, emit an HUnit exception. > verifyResult title fn str = > readFile fn >>= > flip (assertEqualText title) str > -- HUnit.assertEqual title str If the tests fail it can be useful to see the difference in detail by calling 'kompare' or 'tkdiff'. > diffResult _ fn str = > do str1 <- readFile fn > when (str1/=str) > (writeFile "/tmp/test" str >> > diffFilesIA fn "/tmp/test") In case the changes are intended you can just overwrite the old files with the new ones. > updateResult _ fn str = writeFile fn str > processTutCSound :: CSOrchestra.Output out => > (String -> FilePath -> String -> HUnit.Assertion) -> > (String, CSScore.T, CSTutorial.TutOrchestra out) -> HUnit.Assertion > processTutCSound proc (name, newScore, newOrchestra) = > do > proc > ("CSound orchestra: " ++ name) > (csoundDir++name++".orc") > (CSOrchestra.toString (CSTutorial.toOrchestra newOrchestra)) > > proc > ("CSound score: " ++ name) > (csoundDir++name++".sco") > (CSScore.toString newScore) > processCSound :: CSOrchestra.Output out => > (String -> FilePath -> String -> HUnit.Assertion) -> > (String, CSScore.T, CSOrchestra.T out) -> HUnit.Assertion > processCSound proc (name, newScore, newOrchestra) = > do > proc > ("CSound orchestra: " ++ name) > (csoundDir++name++".orc") > (CSOrchestra.toString newOrchestra) > > proc > ("CSound score: " ++ name) > (csoundDir++name++".sco") > (CSScore.toString newScore) > diffCSound :: CSOrchestra.Output out => > (String, CSScore.T, CSOrchestra.T out) -> IO () > diffCSound (name, newScore, newOrchestra) = > let orcName = csoundDir++name++".orc" > scoName = csoundDir++name++".sco" > tmpName = "/tmp/test" > in do > CSOrchestra.save tmpName newOrchestra > diffFilesIA orcName (tmpName++".orc") > CSScore.save tmpName newScore > diffFilesIA scoName (tmpName++".sco") > diffSortCSound :: CSOrchestra.Output out => > (String, CSScore.T, CSOrchestra.T out) -> IO () > diffSortCSound (name, newScore, newOrchestra) = > let orcName = csoundDir++name++".orc" > scoName = csoundDir++name++".sco" > in do > origOrchestra <- readFile orcName > _ <- diffIA (sortLines origOrchestra) > (sortLines $ CSOrchestra.toString newOrchestra) > origScore <- readFile scoName > _ <- diffIA (sortLines origScore) > (sortLines $ CSScore.toString newScore) > return () Compare with several files former versions have produced. > testCSounds :: HUnit.Test > testCSounds = > HUnit.TestLabel "comparison with csound files generated by former Haskore versions" > (HUnit.TestList (map HUnit.TestCase ( > testTutCSound CSTutorial.tut1 : > testTutCSound CSTutorial.tut2 : > testTutCSound CSTutorial.tut3 : > testTutCSound CSTutorial.tut4 : > testTutCSound CSTutorial.tut5 : > testTutCSound CSTutorial.tut6 : > testTutCSound CSTutorial.tut7 : > testTutCSound CSTutorial.tut8 : > testTutCSound CSTutorial.tut9 : > testTutCSound CSTutorial.tut10 : > testTutCSound CSTutorial.tut11 : > testTutCSound CSTutorial.tut12 : > testTutCSound CSTutorial.tut13 : > testTutCSound CSTutorial.tut14 : > testTutCSound CSTutorial.tut15 : > testTutCSound CSTutorial.tut16 : > testTutCSound CSTutorial.tut17 : > testTutCSound CSTutorial.tut18 : > testTutCSound CSTutorial.tut19 : > testTutCSound CSTutorial.tut20 : > testTutCSound CSTutorial.tut21 : > testTutCSound CSTutorial.tut22 : > testTutCSound CSTutorial.piano : > testTutCSound CSTutorial.reedy : > testTutCSound CSTutorial.reedy2 : > testTutCSound CSTutorial.flute : > []))) These tests check for certain bugs that have already removed and will hopefully never return! It should be possible get a prefix of some representation of infinite music. We define a function which asks for some character of the string representation. If the implementations are ill, we'll get lost in an infinite loop. > withPiano :: Melody.T () -> MidiMusic.T > withPiano = MidiMusic.fromMelodyNullAttr MidiMusic.AcousticGrandPiano > performanceFromMIDIMusic :: > MidiMusic.T -> Performance.T NonNegW.Rational Rational MidiMusic.Note > performanceFromMIDIMusic = > FancyPerformance.fromMusic > testShowInf :: Show a => Int -> a -> Bool > testShowInf n x = show x !! n /= '\000' > testInfinitePerformance :: [HUnit.Test] > testInfinitePerformance = > let -- an infinite rest loop won't eventually result in an empty list > -- p = Render.performance (line (repeat wnr)) > m = withPiano (line (repeat (a 0 wn ()))) > p = performanceFromMIDIMusic m > midi = Render.generalMidiDeflt m > in [HUnit.TestCase > (HUnit.assertBool "performance" (testShowInf 80 p)), > HUnit.TestCase > (HUnit.assertBool "MIDI file" (testShowInf 200 midi))] If the definition of (+:+) is improper the check will fail on infinite application. > testInfiniteConcat :: HUnit.Test > testInfiniteConcat = > let m = foldr1 (+:+) (repeat (a 0 wn ())) > in HUnit.TestCase > (HUnit.assertBool "application of (+:+)" (testShowInf 100 m)) Check if the partition of infinite streams works properly. This one fails mel = a 0 wn () +:+ b 0 wn () =:= rest qn +:+ mel whereas this one works mel = a 0 wn () +:+ b 0 wn () =:= rest qn +:+ repeat (c 0 wn ()) *Main> let mel = a 0 wn () +:+ b 0 wn () =:= rest wn +:+ undefined *Main> mel Parallel [Serial [Primitive (Atom (1%1) (Just (Note {noteAttrs = (), notePitch = (0,A)}))),Primitive (Atom (1%1) (Just (Note {noteAttrs = (), notePitch = (0,B)})))],Serial [Primitive (Atom (1%1) Nothing)*** Exception: Prelude.undefined *Main> performanceFromMIDIMusic (withPiano mel) *** Exception: Prelude.undefined *Main> Control.Monad.Reader.runReader (Performance.monadFromMusic Haskore.Performance.Player.defltMap mel) Context.deflt > testInfinitePartition :: HUnit.Test > testInfinitePartition = > let -- mel = a 0 wn () +:+ b 1 wn () =:= line [rest qn, mel] > mel = a 0 wn () +:+ b 1 wn () =:= rest qn +:+ mel > p = ((1,Pitch.A)<=) . Accessor.get Melody.notePitch > (melA, melB) = Music.partition p mel > pfA = performanceFromMIDIMusic (withPiano melA) > pfB = performanceFromMIDIMusic (withPiano melB) > in HUnit.TestCase > (HUnit.assertBool "partition" > (testShowInf 200 pfA && testShowInf 200 pfB)) > testInfinitePerformancePartition :: HUnit.Test > testInfinitePerformancePartition = > let m = withPiano (Music.repeat (a 0 wn () +:+ b 0 wn ())) > pf = performanceFromMIDIMusic m > p = ((0,Pitch.A)<=) . MidiMusic.pitch . > MidiMusic.body . Performance.eventNote > pfs = TimeList.partition p pf > in HUnit.TestCase > (HUnit.assertBool "partition" (testShowInf 200 pfs)) > testInfinity :: HUnit.Test > testInfinity = HUnit.TestLabel "infinite music" (HUnit.TestList > (testInfiniteConcat : > testInfinitePartition : > testInfinitePerformancePartition : > testInfinitePerformance)) \function{randomTree} generates a somehow random tree of notes. We use an ascending sequence of pitches, because MIDI can't distinguish between parallel notes of the same pitch. \begin{haskelllisting} > randomTree :: Pitch.Absolute -> StdGen -> Melody.T () > randomTree p g0 = > let (d', g1) = randomR (0, 6) g0 > (opn, g2) = randomR (0, length ops - 1) g1 > (tmpNum, g3) = randomR (1, 4) g2 > (tmpDen, g4) = randomR (1, 4) g3 > ops = [(+:+), flip (+:+), (=:=), > \m0 m1 -> changeTempo (tmpNum%+tmpDen) (m0+:+m1)] > in (ops !! opn) > (note (Pitch.fromInt p) (d'%+4) ()) > (randomTree (succ p) g4) > instance Arbitrary note => Arbitrary (Music.Primitive note) where > arbitrary = arbitraryPrimitive > coarbitrary = undefined > arbitraryPrimitive :: Arbitrary note => Gen (Music.Primitive note) > arbitraryPrimitive = > liftM2 Music.Atom > (liftM2 (%+) (choose (1,8)) (choose (1,8))) > (frequency > [(3, liftM Just arbitrary), > (1, return Nothing)]) > instance Arbitrary Music.Control where > arbitrary = > oneof > [liftM Music.Tempo > (M.until (0<) (resize 20 arbitrary)), > liftM Music.Transpose (resize 20 arbitrary)] > coarbitrary = undefined > instance Arbitrary attr => Arbitrary (Melody.Note attr) where > arbitrary = > liftM2 (\attr n -> (Melody.Note attr > (Pitch.fromInt (mod n 100)))) > arbitrary (resize 100 arbitrary) > coarbitrary = undefined > {- > chooseEnum :: (Enum a, Bounded a) => Gen a > chooseEnum = > let fromEnumGen :: Enum a => Gen a -> a -> Int > fromEnumGen _ = fromEnum > gen = liftM toEnum > (choose (fromEnumGen gen minBound, fromEnumGen gen maxBound)) > in gen > -} > instance (Arbitrary instr, Arbitrary drum) => > Arbitrary (RhyMusic.NoteBody drum instr) where > arbitrary = > liftM2 RhyMusic.Tone > arbitrary > (liftM (\n -> Pitch.fromInt (mod n 100)) (resize 100 arbitrary)) > coarbitrary = undefined > instance (Arbitrary instr, Arbitrary drum) => > Arbitrary (RhyMusic.Note drum instr) where > arbitrary = > liftM2 RhyMusic.Note > (liftM abs arbitrary) > arbitrary > coarbitrary = undefined > instance (NonNeg.C time, Arbitrary time, Arbitrary note) => > Arbitrary (PfBE.Event time note) where > arbitrary = liftM2 PfBE.Event arbitrary arbitrary > coarbitrary = undefined > -- we need this e.g. for Equivalence.propTempoRest0 > instance (Integral a, Arbitrary a) => Arbitrary (Ratio a) where > -- arbitrary = liftM2 (%+) arbitrary (M.until (0/=) arbitrary) > {- M.until (0/=) leads to infinite loop in some cases, > probably because of 'size' reduced to zero. -} > arbitrary = > liftM2 (\numer denom -> numer % (if denom==0 then 1 else denom)) > arbitrary arbitrary > coarbitrary = undefined > {- > instance Arbitrary Char where > arbitrary = > frequency > [(26, choose ('a','z')), > (26, choose ('A','Z')), > (10, choose ('0','9'))] > coarbitrary = undefined > -} > instance (Temporal.C a, Arbitrary a, Arbitrary control) => > Arbitrary (CtrlMediumList.T control a) where > arbitrary = > let sizedTree 0 = liftM Medium.prim arbitrary > sizedTree n = > let subTree m = replicateM m (resize (div n m) arbitrary) > in frequency > [(3, liftM Medium.prim arbitrary), > (1, liftM Medium.serial (choose (0,n) >>= subTree)), > (1, liftM Medium.parallel (choose (0,n) >>= subTree)), > (1, liftM2 CtrlMedium.control arbitrary arbitrary)] > in sized sizedTree > {- > arbitrary = > let sizedTree 0 = liftM Medium.List.Prim arbitrary > sizedTree n = > let halfTree = sizedTree (div n 2) > in frequency > [(3, liftM Medium.List.Prim arbitrary), > (1, liftM2 (Medium.+:+) halfTree halfTree), > (1, liftM2 (Medium.=:=) halfTree halfTree)] > in sized sizedTree > -} > coarbitrary = undefined \end{haskelllisting} > propBackEndPerformance :: > PfBE.T NonNegW.Rational MidiMusic.Note -> Bool > propBackEndPerformance p = > let performanceFromMusic :: MidiMusic.T -> PfBE.T NonNegW.Rational MidiMusic.Note > performanceFromMusic = > PfBE.fromPerformance (const (const id)) . > (flip asTypeOf (undefined :: > Performance.T NonNegW.Rational Rational MidiMusic.Note)) . > DefaultPerformance.fromMusicModifyContext (Context.setDur 1) > in TimeList.normalize p == > TimeList.normalize (performanceFromMusic (PfBE.toMusic p)) > testPerformance :: HUnit.Test > testPerformance = > HUnit.TestLabel "performance" > (testUnit "backend" propBackEndPerformance) Check certain properties of \function{Music.take}. > propTakeDurFinite, propDropDurFinite, > propTakeDurInfinite, propDropDurInfinite, > propTakeDurInfinite', propDropDurInfinite', > propTakeTooLong, propDropTooLong :: Dur -> MidiMusic.T -> Property > propTakeDurFinite d' m = > d' >= 0 ==> > dur (Music.take d' m) == min d' (dur m) > propDropDurFinite d' m = > d' >= 0 ==> > dur (Music.drop d' m) == dur m -| d' The following two properties are only true if the music has infinite duration. We construct an infinite music by cycling all serial compositions of the music. In order to get something for cycling we have to preserve the existence of a serial composition. Empty compositions are also bad for \function{cycle} but instead of checking for them we optimize them away. I hope that the optimization won't destroy some interesting pathologic examples. > propTakeDurInfinite d' m = > let mOpt = Optimization.composition m > in d' >= 0 && atLeastOneSerial mOpt ==> > dur (Music.take d' (cycleMusic mOpt)) == d' > propDropDurInfinite d' m = > let mOpt = Optimization.composition m > in d' >= 0 && atLeastOneSerial mOpt ==> > dur (Music.take 1 (Music.drop d' (cycleMusic mOpt))) == 1 The preconditions are fulfilled too seldomly. > propTakeDurInfinite' d' m = > d' >= 0 && nonEmptySerials m && atLeastOneSerial m ==> > dur (Music.take d' (cycleMusic m)) == d' > propDropDurInfinite' d' m = > d' >= 0 && nonEmptySerials m && atLeastOneSerial m ==> > dur (Music.take 1 (Music.drop d' (cycleMusic m))) == 1 > propTakeTooLong d' m = > d' >= 0 ==> > Music.take (dur m + d') m =?= m > propDropTooLong d' m = > d' >= 0 ==> > Music.drop (dur m + d') m =?= rest 0 Check if the serial compositions in a music are non-empty, otherwise \function{cycle} fails. > nonEmptySerials :: MidiMusic.T -> Bool > nonEmptySerials = isJust . > Music.foldList > (const . Just) (flip const) > (\s -> sequence s >>= ((\d' -> toMaybe (d'/=0) d') . sum)) > (liftM maximum0 . sequence) This fails for the music (line [chord []]) Music.foldList (const (const True)) (flip const) or and Check if a music contains at least one serial composition, otherwise the music won't become infinite using \function{cycleMusic}. > atLeastOneSerial :: MidiMusic.T -> Bool > atLeastOneSerial = > Music.foldList (const (const False)) (flip const) (const True) or Make music infinite by cycling serial compositions. > cycleMusic :: MidiMusic.T -> MidiMusic.T > cycleMusic = Music.mapList (,) (flip const) cycle id > testTakeDrop :: HUnit.Test > testTakeDrop = > -- testUnitBig = testUnitOpt QCB.defOpt{QCB.no_of_tests=10000} > HUnit.TestLabel "take, drop" (HUnit.TestList ( > testUnit "take/dur/finite" propTakeDurFinite : > testUnit "drop/dur/finite" propDropDurFinite : > testUnit "take/dur/infinite" propTakeDurInfinite : > testUnit "drop/dur/infinite" propDropDurInfinite : > testUnit "take/too long" propTakeTooLong : > testUnit "drop/too long" propDropTooLong : > [])) Check certain properties of \function{Music.reverse}. > propReverse :: MidiMusic.T -> Bool > propReverse = Music.reverse . Music.reverse ==?== id > testReverse :: HUnit.Test > testReverse = > HUnit.TestLabel "reverse" (testUnit "inverse" propReverse) Check properties of \function{Music.filter} et al. > pitchTest :: Pitch.Absolute -> RhyMusic.Note drum instr -> Bool > pitchTest pitch = > (pitch<=) . Pitch.toInt . MidiMusic.pitch . MidiMusic.body > propFilterPartition, propParallelPartition, propPartitionMaybe :: > Pitch.Absolute -> MidiMusic.T -> Bool > propFilterPartition pitch m = > let p = pitchTest pitch > in Music.partition p m == > (Music.filter p m, Music.filter (not . p) m) > propParallelPartition pitch = > let p = pitchTest pitch > in id ==?== uncurry (=:=) . Music.partition p > propPartitionMaybe pitch m = > let p = pitchTest pitch > in Music.partition p m == > Music.partitionMaybe (\n -> toMaybe (p n) n) m > testFilter :: HUnit.Test > testFilter = > HUnit.TestLabel "filter" (HUnit.TestList ( > testUnit "filter partition" propFilterPartition : > testUnit "parallel partition" propParallelPartition : > testUnit "partition maybe" propPartitionMaybe : > [])) Check if \module{Optimization} simplifies some examples according to the laws given in \secref{equivalence}. > propOptAll, propOptRest, propOptComposition, propOptDuration, > propOptTempo, propOptTranspose, propOptVolume > :: MidiMusic.T -> Bool > propOptAll = id ==?== Optimization.all > propOptRest = id ==?== Optimization.rest > propOptComposition = id ==?== Optimization.composition > propOptDuration = id ==?== Optimization.duration > propOptTempo = id ==?== Optimization.tempo > propOptTranspose = id ==?== Optimization.transpose > propOptVolume = id ==?== Optimization.volume > testOptimization :: HUnit.Test > testOptimization = > let controls0 = > [Music.changeTempo 3, > Music.changeTempo 1, > Music.changeTempo (1/3), > Music.transpose 1, > Music.transpose 2, > Music.transpose 3] > controls1 = > [Music.changeTempo 2, > Music.changeTempo 3, > Music.changeTempo 5, > -- Music.phrase (Music.Accent 1.01), > Music.transpose (-3), > Music.transpose ( 0), > Music.transpose ( 3)] > mixer ctrls g' = List.take 10 (map fst > (iterate (uncurry shuffle) (ctrls,g'))) > rcs0 = mixer controls0 (mkStdGen 142) > rcs1 = mixer controls1 (mkStdGen 857) > mOrig cs0 cs1 = > foldr id > (c 1 en () =:= rest qn =:= foldr id (a 0 qn () +:+ rest 0) cs1) > cs0 > mOptOrigs = map Optimization.all (zipWith mOrig rcs0 rcs1) > mOpt = > Music.transpose 6 > (chord [c 1 en (), qnr, Music.changeTempo 30 (a 0 qn ())]) > in {- > mapM (putStrLn . MusicFormat.prettyMelody) mOptOrigs >> > putStrLn (MusicFormat.prettyMelody mOpt) >> > -} > HUnit.TestLabel "optimization" (HUnit.TestList ( > HUnit.TestCase (HUnit.assertBool "shuffled controls" > (all (mOpt ==) mOptOrigs)) : > testUnit "all" propOptAll : > testUnit "rest" propOptRest : > testUnit "composition" propOptComposition : > testUnit "duration" propOptDuration : > testUnit "tempo" propOptTempo : > testUnit "transpose" propOptTranspose : > testUnit "volume" propOptVolume : > [])) Check if the precedence of serial composition is higher than that of parallel composition. > testPrecedence :: HUnit.Test > testPrecedence = > HUnit.TestLabel "precedence" (HUnit.TestList [ > HUnit.TestCase > (HUnit.assertBool "+:+/=:=" > ( c 0 wn () +:+ e 0 wn () =:= g 0 wn () == > (c 0 wn () +:+ e 0 wn ()) =:= g 0 wn ())), > HUnit.TestCase > (HUnit.assertBool "=:=/+:+" > (c 0 wn () =:= e 0 wn () +:+ g 0 wn () == > c 0 wn () =:= (e 0 wn () +:+ g 0 wn ())))]) Test for structure analysis. To check the integrity of the structure analysis we turn a song into grammar and expand it again. The original song and the expanded one should be literally equivalent. \begin{haskelllisting} > grammarExample0, grammarExample1 :: Melody.T () > grammarExample0 = Music.take 17 Flip.core > grammarExample1 = line (List.take 20 (cycle [c 0 qn (), e 0 wn (), g 0 wn ()])) > propGrammar :: MidiMusic.T -> Bool > propGrammar = > id ==?== Grammar.toMedium . > Grammar.fromMedium (map (("part"++).(:[])) ['A'..]) 2 > testGrammar :: HUnit.Test > testGrammar = > let test name m0 = > HUnit.TestCase > (HUnit.assertBool name (propGrammar (withPiano m0))) > in {- diffIA (MidiFile.showLines (Render.generalMidiDeflt m0)) > (MidiFile.showLines (Render.generalMidiDeflt m1)) >> > diffIA (MidiFile.showLines (MidiFile.sortEvents (Render.generalMidiDeflt Kantate147.song))) > (MidiFile.showLines (MidiFile.sortEvents (Render.generalMidiDeflt (Grammar.toMedium Kantate147.grammar)))) >> -} > HUnit.TestLabel "structure analysis" (HUnit.TestList [ > test "example0" grammarExample0, > test "example1" grammarExample1, > -- testUnit "inverse" propGrammar, > HUnit.TestCase > (HUnit.assertBool "kantate147" > (withPiano (changeTempo (4%+3) Kantate147.song) =?= > withPiano (Grammar.toMedium Kantate147.grammar)))]) \end{haskelllisting} Check if a music is properly formatted, that is check if the output is syntactically correct and if the generated module generates the same MIDI file as we obtain directly. \begin{haskelllisting} > ctrlMusic :: Melody.T () > ctrlMusic = > let n0 = c 1 (1/23) () > n1 = c 1 qn () > r0 = rest (1/23) > r1 = rest qn > in changeTempo (2/3) (n0 +:+ r0) =:= transpose 3 (n1 +:+ r1) =:= > chord [changeTempo (2/3) n0, transpose (-3) n1, > changeTempo 7 r0, transpose 4 r1] > testFormatMusic :: HUnit.Test > testFormatMusic = HUnit.TestCase $ > do writeFile "GeneratedTest.hs" (unlines > ["module GeneratedTest where", > "import Haskore.Basic.Duration((%+))", > "import Haskore.Music", > "import Haskore.Melody.Standard", > "import Haskore.Music.GeneralMIDI as MidiMusic", > "import Haskore.Interface.MIDI.Render as Render", > "main = Render.fileFromGeneralMIDIMusic \"test.mid\" song", > "song = MidiMusic.fromStdMelody MidiMusic.AcousticGrandPiano $ " ++ > MusicFormat.prettyMelody > (StdMelody.fromMelodyNullAttr ctrlMusic)]) > exitCode <- > if False > then system ("echo 'main\n:q' | hugs -98 -P"++hugsPath++" GeneratedTest") > else system ("ghc -e main -i"++hugsPath++" GeneratedTest") > HUnit.assertEqual > "running Haskell interpreter" > exitCode > Exit.ExitSuccess > midi <- B.readFile "test.mid" > let expectedMidi = > SaveMidi.toByteString (Render.generalMidi (withPiano ctrlMusic)) > -- B.writeFile "expected.mid" expectedMidi > HUnit.assertEqual > "formatting music" > expectedMidi > midi > testFormat :: HUnit.Test > testFormat = > HUnit.TestLabel "composition" $ HUnit.TestList $ > testFormatMusic : > HUnit.TestCase > (HUnit.assertBool "formatting duration" Duration.propToString) : > [] \end{haskelllisting} \begin{haskelllisting} > testComposition :: HUnit.Test > testComposition = > HUnit.TestLabel "composition" (HUnit.TestList ( > HUnit.TestLabel "tempo" (HUnit.TestList ( > testUnit "neutral" Equivalence.propTempoNeutral : > testUnit "fuse" Equivalence.propTempoTempo : > testUnit "commutativity" Equivalence.propTempoCommutativity : > testUnit "transpose/commutativity" > Equivalence.propTempoTransposeCommutativity : > testUnit "serial" Equivalence.propTempoSerial : > testUnit "parallel" Equivalence.propTempoParallel : > testUnit "rest0" Equivalence.propTempoRest0 : > [])) : > HUnit.TestLabel "transpose" (HUnit.TestList ( > testUnit "neutral" Equivalence.propTransposeNeutral : > testUnit "fuse" Equivalence.propTransposeTranspose : > testUnit "commutativity" Equivalence.propTransposeCommutativity : > testUnit "serial" Equivalence.propTransposeSerial : > testUnit "parallel" Equivalence.propTransposeParallel : > testUnit "rest0" Equivalence.propTransposeRest0 : > [])) : > HUnit.TestLabel "serial" (HUnit.TestList ( > testUnit "associativity" Equivalence.propSerialAssociativity : > testUnit "neutral0" Equivalence.propSerialNeutral0 : > testUnit "neutral1" Equivalence.propSerialNeutral1 : > testUnit "parallel0" Equivalence.propSerialParallel0 : > testUnit "parallel1" Equivalence.propSerialParallel1 : > [])) : > HUnit.TestLabel "parallel" (HUnit.TestList ( > testUnit "associativity" Equivalence.propParallelAssociativity : > testUnit "commutativity" Equivalence.propParallelCommutativity : > [])) : > [])) \end{haskelllisting} \begin{haskelllisting} > allTests :: HUnit.Test > allTests = > HUnit.TestList $ > testComposition : > testTakeDrop : > testReverse : > testFilter : > testOptimization : > testInfinity : > testPrecedence : > testPerformance : > testGrammar : > testFormat : > testCSounds : > testMIDI : > [] \end{haskelllisting} \begin{haskelllisting} > main :: IO () > main = > do > when False $ > mapM_ putStrLn $ > zipWith (\num path -> show num ++ " - " ++ HUnitText.showPath path) > [(1::Int)..] $ > HUnit.testCasePaths allTests > -- putStrLn "tests disabled" > counts <- HUnitText.runTestTT allTests > when (HUnit.errors counts + HUnit.failures counts > 0) > (error "Test suite encountered errors.") \end{haskelllisting} haskore-0.2.0.3/src/Test/CSound/0000755000000000000000000000000011754016452014402 5ustar0000000000000000haskore-0.2.0.3/src/Test/CSound/Makefile0000644000000000000000000000020311754016452016035 0ustar0000000000000000%.wav: %.orc %.sco csound -W -b 1024 -d -m 0 -o $@ $^ play-%: %.orc %.sco OPCODEDIR=/usr/lib/csound/plugins csound -n -o dac $^ haskore-0.2.0.3/src/Test/MIDI/0000755000000000000000000000000011754016452013731 5ustar0000000000000000haskore-0.2.0.3/src/Test/MIDI/Makefile0000644000000000000000000000027011754016452015370 0ustar0000000000000000%.wav: %.mid timidity -A800 -Ow -o $@ $< Raenzlein.wav: Raenzlein.mid timidity -A800 -K -12 -Ow -o $@ $< WhiteChristmas.wav: WhiteChristmas.mid timidity -A800 -K -12 -Ow -o $@ $< haskore-0.2.0.3/src/Doc/0000755000000000000000000000000011754016452012775 5ustar0000000000000000haskore-0.2.0.3/src/Doc/Tutorial.tex0000644000000000000000000001232511754016452015325 0ustar0000000000000000% For DVIWindo: \documentclass[11pt,fleqn]{article} \usepackage{comment} \usepackage{doc} % .ind (index) files use macros like \pfill, \scan@allowedfalse \usepackage{makeidx} \makeindex \usepackage{color} \usepackage{tikz} \usetikzlibrary{positioning,shapes} \usepackage{graphicx} \graphicspath{{.}{Pics/}} \usepackage{ifpdf} \ifx\pdfoutput\undefined \pdffalse \else \pdfoutput=1 \pdftrue \fi \definecolor{brown}{rgb}{0.7,0.2,0} \definecolor{darkgreen}{rgb}{0,0.6,0.1} \definecolor{darkgrey}{rgb}{0.4,0.4,0.4} \definecolor{lightgrey}{rgb}{0.95,0.95,0.95} \usepackage{times} \usepackage[T1]{fontenc} \usepackage{listings} \usepackage{amsbsy} % \poor man's bold \pmb % keywordstyle=\pmb, % keywordstyle=\color{brown}, \lstset{% language=Haskell, frame=single, framerule=1pt, showstringspaces=false, basicstyle=\footnotesize\ttfamily, keywordstyle=\textbf, commentstyle=\highlightcomment, backgroundcolor=\color{lightgrey} } \newcommand\highlightcomment[1]{\textsl{\color{darkgrey}#1}} \lstnewenvironment{haskelllisting} {\lstset{language=Haskell,gobble=2,firstline=2}}{} \lstnewenvironment{haskellblock} {\mbox{}\\\lstset{language=Haskell}}{} \ifpdf %% pdflatex: *.tex -> *.pdf \usepackage[pdftex, colorlinks=true, urlcolor=blue, linkcolor=brown, citecolor=darkgreen, pdfstartview=FitH, bookmarks, pdftitle={Haskore Music Tutorial}, pdfsubject={Haskore -- Music composition DSL for Haskell}, pdfkeywords={Haskell, DSL, Functional Programming}, pdfauthor={Paul Hudak} ]{hyperref} \pdfimageresolution=288 \pdfcompresslevel=9 \usepackage{thumbpdf} \else \usepackage[ colorlinks=true, urlcolor=blue, linkcolor=brown ]{hyperref} \fi % Old Latex: % \documentstyle[epsf,11pt]{article} % %\input texnansi %\input lcdlatex.tex %\input epsfsafe.tex \textheight=8.5in \textwidth=6.5in \topmargin=-.3in \oddsidemargin=0in \evensidemargin=0in \parskip=6pt plus2pt minus2pt % Use these for extended mode: \newcommand{\extended}[1]{#1} \newcommand{\basic}[1]{} % Use these for basic mode: % \newcommand{\extended}[1]{} % \newcommand{\basic}[1]{#1} \input{Doc/Macros} \sloppy % prevent keywords from stitching out off the text block \begin{document} \title{Haskore Music Tutorial} \author{Paul Hudak\\ Yale University\\ Department of Computer Science\\ New Haven, CT 06520\\ \href{mailto:paul.hudak@yale.edu}{paul.hudak@yale.edu}} \date{February 14, 1997\\ (Revised November 1998)\\ (Revised February 2000)\\ (Constantly mixed up in 2004 - 2007 by \href{mailto:haskore@henning-thielemann.de}{Henning Thielemann} :-)} \maketitle \pagebreak \tableofcontents \pagebreak % the introduction \input{Doc/Introduction.tex} % the structure of Haskore \input{Haskore.lhs} \section{Creation of Music} \subsection{Composing Music} % pitch definitions and conversions \input{Haskore/Basic/Pitch.lhs} % the basics \input{Haskore/Music.lhs} % some common interval names \input{Haskore/Basic/Interval.lhs} % a brief treatise on chords \input{Haskore/Composition/Chord.lhs} % some common scales \input{Haskore/Basic/Scale.lhs} % tempo handling \input{Haskore/Basic/Tempo.lhs} % all about performance and players \input{Haskore/Performance.lhs} % moved to Performance.lhs %\input{Equivalence.tex} \input{Haskore/Performance/Player.lhs} \input{Haskore/Performance/Default.lhs} \input{Haskore/Performance/Fancy.lhs} \section{Interfaces to other musical software} % all about performance and players \input{Haskore/Performance/BackEnd.lhs} % translating a performance into Midi \basic{\input{Haskore/Interface/BasicMIDI/Write.lhs}} \extended{\input{Haskore/Interface/MIDI/Write.lhs}} \input{Haskore/Interface/MIDI/InstrumentMap.lhs} % the MidiFile datatype \basic{\input{Haskore/Interface/BasicMIDI/File.lhs}} % \extended{\input{Haskore/Interface/MIDI/File.lhs}} For a description of the MIDI file type and its loading and saving to disk, see the \texttt{midi} package. % storing Midi in files % \input{Haskore/Interface/MIDI/Save.lhs} % loading Midi files % \input{Haskore/Interface/MIDI/Load.lhs} % translating Midi to Haskore \input{Haskore/Interface/MIDI/Read.lhs} % table of General Midi assignments % \input{Haskore/Interface/MIDI/General.lhs} % CSound \input{Haskore/Interface/CSound.lhs} \input{Haskore/Interface/CSound/Tutorial.lhs} % MML \input{Haskore/Interface/MML.lhs} \section{Processing and Analysis} \input{Haskore/Process/Optimization.lhs} \input{Medium/Controlled/ContextFreeGrammar.lhs} \subsection{Markov Chains} Markov chains are now available in a package called \texttt{markov-chain}. \input{Haskore/Process/Format.lhs} % related work \input{Doc/Related.tex} \pagebreak \appendix \section{Helper modules} % random test routines \input{Haskore/Interface/MIDI/Render.lhs} % utility functions \input{Haskore/General/Utility.lhs} \section{Examples} % random examples \input{Haskore/Example/Miscellaneous.lhs} % Chick Corea's Child Song 6 \input{Haskore/Example/ChildSong6.lhs} % some self-similar (fractal) music \input{Haskore/Example/SelfSim.lhs} % simulating a guitar \input{Haskore/Example/Guitar.lhs} % discussion about design decisions \input{Doc/Discussion} \pagebreak \bibliographystyle{alpha} \bibliography{src/Doc/old} \pagebreak \printindex \end{document} haskore-0.2.0.3/src/Doc/Tutorial.bbl0000644000000000000000000000745511754016452015274 0ustar0000000000000000\begin{thebibliography}{HMGW96} \bibitem[AK92]{formula} D.P. Anderson and R.~Kuivila. \newblock Formula: A programming language for expressive computer music. \newblock In Denis Baggi, editor, {\em Computer Generated Music}. IEEE Computer Society Press, 1992. \bibitem[Ary94]{arya94} K.~Arya. \newblock A functional animation starter-kit. \newblock {\em Journal of Functional Programming}, 4(1):1--18, 1994. \bibitem[Bal92]{balaban92} M.~Balaban. \newblock Music structures: Interleaving the temporal and hierarchical aspects of music. \newblock In M.~Balaban, K.~Ebcioglu, and O.~Laske, editors, {\em Understanding Music With AI}, pages 110--139. AAAI Press, 1992. \bibitem[BW88]{birdwadler88} R.~Bird and P.~Wadler. \newblock {\em Introduction to Functional Programming}. \newblock Prentice Hall, New York, 1988. \bibitem[Col84]{moxie} D.~Collinge. \newblock Moxie: A languge for computer music performance. \newblock In {\em Proc. Int'l Computer Music Conference}, pages 217--220. Computer Music Association, 1984. \bibitem[CR84]{formes} P.~Cointe and X.~Rodet. \newblock Formes: an object and time oriented system for music composition and synthesis. \newblock In {\em Proceedings of the 1984 ACM Symposium on Lisp and Functional Programmming}, pages 85--95. ACM, 1984. \bibitem[Dan89]{canon} R.B. Dannenberg. \newblock The {C}anon score language. \newblock {\em Computer Music Journal}, 13(1):47--56, 1989. \bibitem[DFV92]{fugue} R.B. Dannenberg, C.L. Fraley, and P.~Velikonja. \newblock A functional language for sound synthesis with behavioral abstraction and lazy evaluation. \newblock In Denis Baggi, editor, {\em Computer Generated Music}. IEEE Computer Society Press, 1992. \bibitem[For73]{forte} A.~Forte. \newblock {\em The Structure of Atonal Music}. \newblock Yale University Press, New Haven, CT, 1973. \bibitem[HB95]{hudakberger95} P.~Hudak and J.~Berger. \newblock A model of performance, interaction, and improvisation. \newblock In {\em Proceedings of International Computer Music Conference}. Int'l Computer Music Association, 1995. \bibitem[Hen82]{henderson82} P.~Henderson. \newblock Functional geometry. \newblock In {\em Proceedings of the 1982 ACM Symposium on Lisp and Functional Programmming}. ACM, 1982. \bibitem[HF92]{haskell-tutorial} P.~Hudak and J.~Fasel. \newblock A gentle introduction to {H}askell. \newblock {\em ACM SIGPLAN Notices}, 27(5), May 1992. \bibitem[HMGW96]{haskore} P.~Hudak, T.~Makucevich, S.~Gadde, and B.~Whong. \newblock Haskore music notation -- an algebra of music. \newblock {\em Journal of Functional Programming}, 6(3), June 1996. \newblock available via\\ \url{ftp://nebula.systemsz.cs.yale.edu/pub/yale-fp/papers/haskore/hmn-lhs.ps}. \bibitem[HS92]{scoresynth} G.~Haus and A.~Sametti. \newblock Scoresynth: A system for the synthesis of music scores based on petri nets and a music algebra. \newblock In Denis Baggi, editor, {\em Computer Generated Music}. IEEE Computer Society Press, 1992. \bibitem[IMA90]{midi} Midi 1.0 detailed specification: Document version 4.1.1, February 1990. \bibitem[JB91]{musickit} D.~Jaffe and L.~Boynton. \newblock An overview of the sound and music kits for the {NeXT} computer. \newblock In S.T. Pope, editor, {\em The Well-Tempered Object}, pages 107--118. MIT Press, 1991. \bibitem[OFLB94]{grame94} O.~Orlarey, D.~Fober, S.~Letz, and M.~Bilton. \newblock Lambda calculus and music calculi. \newblock In {\em Proceedings of International Computer Music Conference}. Int'l Computer Music Association, 1994. \bibitem[Sch83]{pla} B.~Schottstaedt. \newblock Pla: A composer's idea of a language. \newblock {\em Computer Music Journal}, 7(1):11--20, 1983. \bibitem[Ver86]{csound} B.~Vercoe. \newblock Csound: A manual for the audio processing system and supporting programs. \newblock Technical report, MIT Media Lab, 1986. \end{thebibliography} haskore-0.2.0.3/src/Doc/Introduction.tex0000644000000000000000000000637711754016452016215 0ustar0000000000000000\section{Introduction} \seclabel{intro} {\em Haskore} is a collection of Haskell modules designed for expressing musical structures in the high-level, declarative style of \keyword{functional programming}. In Haskore, musical objects consist of primitive notions such as notes and rests, operations to transform musical objects such as transpose and tempo-scaling, and operations to combine musical objects to form more complex ones, such as concurrent and sequential composition. From these simple roots, much richer musical ideas can easily be developed. Haskore is a means for describing {\em music}---in particular Western Music---rather than {\em sound}. It is not a vehicle for synthesizing sound produced by musical instruments, for example, although it does capture the way certain (real or imagined) instruments permit control of dynamics and articulation. Haskore also defines a notion of \keyword{literal performance} through which \keyword{observationally equivalent} musical objects can be determined. From this basis many useful properties can be proved, such as commutative, associative, and distributive properties of various operators. An \keyword{algebra of music} thus surfaces. In fact a key aspect of Haskore is that objects represent both \keyword{abstract musical ideas} and their \keyword{concrete implementations}. This means that when we prove some property about an object, that property is true about the music in the abstract {\em and} about its implementation. Similarly, transformations that preserve musical meaning also preserve the behavior of their implementations. For this reason Haskell is often called an \keyword{executable specification language}; i.e.~programs serve the role of mathematical specifications that are directly executable. Building on the results of the functional programming community's Haskell effort has several important advantages: First, and most obvious, we can avoid the difficulties involved in new programming language design, and at the same time take advantage of the many years of effort that went into the design of Haskell. Second, the resulting system is both \keyword{extensible} (the user is free to add new features in substantive, creative ways) and \keyword{modifiable} (if the user doesn't like our approach to a particular musical idea, she is free to change it). In the remainder of this paper I assume that the reader is familar with the basics of functional programming and Haskell in particular. If not, I encourage reading at least {\em A Gentle Introduction to Haskell} \cite{haskell-tutorial} before proceeding. I also assume some familiarity with \keyword{equational reasoning}; an excellent introductory text on this is \cite{birdwadler88}. \subsection{Acknowledgements} Many students have contributed to Haskore over the years, doing for credit what I didn't have the spare time to do! I am indebted to them all: Amar Chaudhary, Syam Gadde, Bo Whong, and John Garvin, in particular. Thanks also to Alastair Reid for implementing the first Midi-file writer, to Stefan Ratschan for porting Haskore to GHC, and to Matt Zamec for help with the Csound compatibility module. I would also like to express sincere thanks to my friend and talented New Haven composer, Tom Makucevich, for being Haskore's most faithful user. haskore-0.2.0.3/src/Doc/Discussion.tex0000644000000000000000000002605311754016452015650 0ustar0000000000000000\section{Design discussion} This section presents the advantages and disadvantages of several design decisions that has been made. \paragraph*{Principal type \code{T}} Analogously to Modula-3 we use the following naming scheme: A module has the name of the principal type and the type itself has the name \code{T}. If there is only one constructor for that type its name is \code{Cons}. If the main object of a module is a type class, its name is \code{C}. A function in a module don't need a prefix related to the principal type. Many functions can be considered as conversion functions. They should be named \code{TargetType.fromSourceType} or \code{SourceType.toTargetType}. If there is a choice, the first form is prefered. This does better fit to the order of functions and their arguments. Compare \code{a = A.fromB b} and \code{a = B.toA b}. A programmer using such a module is encouraged to import it with qualified identifiers. This way the programmer may abbreviate the module name to its convenience. \paragraph*{\code{Music.T}} The data structure should be hidden. The user should use \code{changeTempo} and similar functions instead of the constructors \code{Tempo} etc. This way the definition of a \code{Music.T} stays independent from the actual data structure \code{Music.T}. Then \code{changeTempo} can be implemented silently using a constructor or using a mapping function. \paragraph*{\code{Medium.T}} \seclabel{discussion:media} The idea of extracting the structure of animation movies and music into an abstract data structure is taken from Paul Hudak's paper ``An Algebraic Theory of Polymorphic Temporal Media''. The temporial media data structure \code{Medium.T} is used here as the basis type for Haskore's Music. \subparagraph*{Binary composition vs. List composition} There are two natural representations for temporal media. We have implemented both of them: \begin{enumerate} \item \code{Medium.Plain.Binary} uses binary constructors \code{:+:}, \code{:=:} \item \code{Medium.Plain.List} uses List constructors \code{Serial}, \code{Parallel} \end{enumerate} Both of these modules provide the functions \code{foldBinFlat} and \code{foldListFlat} which apply binary functions or list functions, respectively, to \code{Medium.T}. Import your prefered module to \code{Medium}. Each of these data structures has its advantages: \code{Medium.Binary.T} \begin{itemize} \item There is only one way to represent a zero object, which must be a single media primitive (\code{Prim}). \item You need only a few constructors for serial and parallel compositions. \end{itemize} \code{Medium.List.T} \begin{itemize} \item Zero objects can be represented without a particalur zero primitives. \item You can represent two different zero objects, an empty parallelism and an empty serialism. Both can be interpreted as limits of compositions of decreasing size. \item You can store music with an internal structure which is lost in a performance. E.g. a serial composition of serial compositions will sound identical to a flattened serial composition, but the separation might contain additional information. \end{itemize} In my (Henning's) opinion \code{Music.T} is for representing musical ideas and \code{Performance.T} is for representing the sound of a song. Thus it is ok and even useful if there are several ways to represent the same sound impression (\code{Performance.T}) in different ways (\code{Music.T}), just like it is possible to write very different \LaTeX{} code which results in the same page graphics. The same style of text may have different meanings which can be seen only in the \LaTeX{} source code. Analogously music can be structured more detailed than one can hear. \subparagraph*{Algebraic structure} The type \code{Medium.T} almost forms an algebraic ring where \code{=:=} is like a sum (commutative) and \code{+:+} is like a product (non-commutative). Unfortunately \code{Medium.T} is not really a ring: There are no inverse elements with respect to addition (\code{=:=}). Further \code{=:=} is not distributive with respect to \code{+:+} because \code{x} is different from \code{x =:= x}. There is also a problem if the durations of the parallel music objects differ. I.e. if \code{dur y /= dur z} then \code{x +:+ (y =:= z)} is different from \code{(x +:+ y) =:= (x +:+ z)} even if \code{x == x =:= x} holds. So it is probably better not to make \code{Medium.T} an instance of a \code{Ring} type class. (In Prelude 98 the class \code{Num} is quite a \code{Ring} type class.) \paragraph*{Relative times in \code{Performance.T}} \seclabel{discussion:performance-reltime} Absolute times for events disallow infinite streams of music. The time information becomes more and more inaccurate and finally there is an overflow or no change in time. Relative times make synchronization difficult, especially many small time differences are critical. But since the \code{Music.T} is inherently based on time differences one cannot get rid of sum rounding errors. The problem can only be weakened by more precise floating point formats. \paragraph*{Type variable for time and dynamics in \code{Performance.T}} In the original design of Haskore \type{Float} was the only fractional type used for time and volume measures in \type{Performance.T}. This is good with respect to efficiency. But rounding errors make it almost impossible to test literal equivalence (\secref{equivalence}) between different music expressions. In order to match both applications I introduced type variables \type{time} and \type{dyn} which is now floating all around. It also needs some explicit type hints in some cases where the performance is only an interim step. In future \type{Music.T} itself might get a \type{time} type parameter. We should certainly declare types for every-day use such as \type{CommonMusic.T} which instantiates \type{Music.T} with \type{Double} or so. \paragraph*{Unification of Rests and Notes} Since rests and notes share the property of the duration, the constructor \code{Music.Atom} is used which handles the duration and the particalur music primitive, namely Rest and Note. All functions concerning duration (\code{dur}, \code{cut}) don't need to interpret the musical primitive. \paragraph*{Pitch} \seclabel{discussion:pitch} With the definition \code{Pitch = (Octave, PitchClass)} (swapped order with respect to original Haskore) the order on \code{Pitch} equals the order on pitches. Functions like \code{o0}, \code{o1}, \code{o2} etc. may support this order for short style functional note definitions. It should be e.g. \code{o0 g == g 0}. Alternatively one can put this into a duration function like \code{qn'}, \code{en'}, etc. Then it must hold e.g. \code{qn' 0 g == g 0 qn} The problem is that the range of notes of the enumeration \code{PitchClass} overlaps with notes from neighbouring octaves. Overlapping \code{PitchClass}es, e.g. \code{(0,Bs) < (1,Cf)} although \code{absPitch (0,Bs) > absPitch (1,Cf)} The musical naming of notes is a bit unlogical. The range is not from A to G but from C to B. Further on there are two octaves with note names without indices (e.g. $A$ and $a$). Both octaves are candidates for a ``zero'' octave. We define that octave $0$ is the one which contains $a$. \paragraph*{Absolute pitch} Find a definition for the absolute pitch that will be commonly used for MIDI, CSound, and Signal output. Yamaha-SY35 manual says: \begin{itemize} \item Note \$00 - (-2,C) \item Note \$7F - ( 8,G) \end{itemize} But which A is 440 Hz? By playing around with the Multi key range I found out that the keyboard ranges from (1,C) to (6,C) (in MIDI terms). The frequencies of the instruments played at the same note are not equal. :-( Many of them have (3,A) (MIDI) = 440 Hz, but some are an octave below, some are an octave above. In CSound it was (8,A) = 440 Hz in original Haskore. Very confusing. \paragraph*{Volume vs. Velocity} MIDI distinguishes Volume and Velocity. Volume is related to the physical amplitude, i.e. if we want to change the Volume of a sound we simply amplify the sound by a constant factor. In contrast to that Velocity means the speed with which a key is pressed or released. This is most oftenly interpreted as the force with which an instrument is played. This distinction is very sensible and is reflected in \code{Music.T}. Velocity is inherently related to the beginning and the end of a note, whereas the Volume can be changed everywhere. All phrases related to dynamics are mapped to velocities and not to volumes, since one cannot change the volume of natural instruments without changing the force to play them (and thus changing their timbre). The control of Volume is to be added later, together with controllers like pitch bender, frequency modulation and so on. \paragraph*{Global instrument setting vs. note attribute} In the original version of Haskore, there was an \code{Instr} constructor that set the instrument used in the enclosed piece of music. I found that changing an instrument by surrounding a piece of music with a special constructor is not very natural. On which parts of the piece it has an effect or if it has an effect at all depends on \code{Instr} statements within the piece of music. To assert that instruments are set once and only once and that setting an instrument has an effect, we distinguish between (instrument-less) melodies and music (with instrument information) now. In a melody we store only notes and rests, in a music we store an instrument for any note. Even more since the instrument is stored for each note this can be interpreted as an instrument event, where some instruments support note pitches and others not (sound effects) or other attributes (velocity). \paragraph*{PhraseFun} The original Haskore version used \code{PhraseFun}s of the type \code{Music.T -> (Performance.T, Dur)}. This way it was a bit cumbersome to combine different phrases. In principle all \code{PhraseFun}s could be of type \code{(Performance.T, Dur) -> (Performance.T, Dur)} This would be a more clean design but lacks some efficiency because e.g. the Loudness can be controlled by changing the default velocity of the performance context. This is much more efficient (even more if Loudness phrases are cascaded) than modifying a performance afterwards. Now the performance is no longer generated as-is, but it is enclosed in a state monad, that manages the \type{Performance.Context}. The \code{PhraseFun}s are now of type \code{Performance.PState -> Performance.PState} which is both clean and efficient. \paragraph*{Phrase} \seclabel{discussion:phrase} The original version of Haskore used a list of \code{PhraseAttribute}s for the \code{Phrase} constructor. Now it allows only one attribute in order to make the order of application transparent to the user. %\paragraph*{InstrumentMap} %\seclabel{discussion:user-patch-map} %The current implementation of \code{InstrumentMap.T} \paragraph*{Type of \code{Music.Dur}} \seclabel{discussion:dur} Durations are represented as rational numbers; specifically, as ratios of two Haskell \code{Integer} values. Previous versions of Haskore used floating-point numbers, but rational numbers are more precise and allow quick-checking of music composition properties. haskore-0.2.0.3/src/Doc/Related.tex0000644000000000000000000000654611754016452015112 0ustar0000000000000000\section{Related and Future Research} \seclabel{related} Many proposals have been put forth for programming languages targeted for computer music composition \cite{canon,pla,moxie,formula,fugue,scoresynth,formes,grame94}, % common-music so many in fact that it would be difficult to describe them all here. None of them (perhaps surprisingly) are based on a {\em pure} functional language, with one exception: the recent work done by Orlarey et al.\ at GRAME \cite{grame94}, which uses a pure lambda calculus approach to music description, and bears some resemblance to our effort. There are some other related approaches based on variants of Lisp, most notably Dannenberg's \keyword{Fugue} language \cite{fugue}, in which operators similar to ours can be found but where the emphasis is more on instrument synthesis rather than note-oriented composition. Fugue also highlights the utility of lazy evaluation in certain contexts, but extra effort is needed to make this work in Lisp, whereas in a non-strict language such as Haskell it essentially comes ``for free''. Other efforts based on Lisp utilize Lisp primarily as a convenient vehicle for ``embedded language design,'' and the applicative nature of Lisp is not exploited well (for example, in Common Music the user will find a large number of macros which are difficult if not impossible to use in a functional style). We are not aware of any computer music language that has been shown to exhibit the kinds of algebraic properties that we have demonstrated for Haskore. Indeed, none of the languages that we have investigated make a useful distinction between music and performance, a property that we find especially attractive about the Haskore design. On the other hand, Balaban describes an abstract notion (apparently not yet a programming language) of ``music structure,'' and provides various operators that look similar to ours \cite{balaban92}. In addition, she describes an operation called {\em flatten} that resembles our literal interpretation {\tt perform}. It would be interesting to translate her ideas into Haskell; the match would likely be good. Perhaps surprisingly, the work that we find most closely related to ours is not about music at all: it is Henderson's \keyword{functional geometry}, a functional language approach to generating computer graphics \cite{henderson82}. There we find a structure that is in spirit very similar to ours: most importantly, a clear distinction between object \keyword{description} and \keyword{interpretation} (which in this paper we have been calling musical objects and their performance). A similar structure can be found in Arya's \keyword{functional animation} work \cite{arya94}. There are many interesting avenues to pursue with this research. On the theoretical side, we need a deeper investigation of the algebraic structure of music, and would like to express certain modern theories of music in Haskore. The possibility of expressing other scale types instead of the thus far unstated assumption of standard equal temperament scales is another area of investigation. On the practical side, the potential of a graphical interface to Haskore is appealing. We are also interested in extending the methodology to sound synthesis. Our primary goal currently, however, is to continue using Haskore as a vehicle for interesting algorithmic composition (for example, see \cite{hudakberger95}). haskore-0.2.0.3/src/Doc/Macros.tex0000644000000000000000000000331311754016452014743 0ustar0000000000000000 \usepackage{amsthm} \swapnumbers %\numberwithin{definition}{section} \newtheorem{prop}{Proposition} \newtheorem{axiom}[prop]{Axiom} \newtheorem{theorem}[prop]{Theorem} \newtheorem{exercise}[prop]{Exercise} \theoremstyle{definition} \newtheorem{definition}[prop]{Definition} \newcommand{\ignore}[1]{} \newcommand{\out}[1]{} %\newcommand{\code}[1]{\texttt{#1}} \newcommand{\code}[1]{{\tt #1}} % overrides italics \newcommand{\type}[1]{\code{#1}} \newcommand{\constructor}[1]{\code{#1}} \newcommand{\function}[1]{\code{#1}} \newcommand{\expression}[1]{\code{#1}} \newcommand{\module}[1]{module \texttt{#1}} \newcommand \keyword[1]{\emph{#1}\index{#1}} \newcommand \keywordref[2]{#2\index{#2} (\dfnref{#1})} \newcommand \eqnlabel[1]{\yesnumber\label{eqn:#1}} % set tag and declare label \newcommand \dfnlabel[1]{\label{dfn:#1}} \newcommand \thmlabel[1]{\label{thm:#1}} \newcommand \lemlabel[1]{\label{lem:#1}} \newcommand \rmklabel[1]{\label{rmk:#1}} \newcommand \seclabel[1]{\label{sec:#1}} \newcommand \tablabel[1]{\label{tab:#1}} \newcommand \figlabel[1]{\label{fig:#1}} \newcommand \eqnref[1]{(\ref{eqn:#1})} % reference to an equation (number surrounded by parentheses) \newcommand \meqnref[1]{\text{(\ref{eqn:#1})}} % reference to an equation for use in math mode, only necessary for pdflatex \newcommand \dfnref[1]{Definition~\ref{dfn:#1}} \newcommand \thmref[1]{Theorem~\ref{thm:#1}} % reference to a theorem \newcommand \lemref[1]{Lemma~\ref{lem:#1}} \newcommand \rmkref[1]{Remark~\ref{rmk:#1}} \newcommand \secref[1]{Section~\ref{sec:#1}} % reference to a section \newcommand \tabref[1]{Table~\ref{tab:#1}} % reference to a table \newcommand \figref[1]{Figure~\ref{fig:#1}} % reference to a figure haskore-0.2.0.3/src/Doc/Pics/0000755000000000000000000000000011754016452013673 5ustar0000000000000000haskore-0.2.0.3/src/Doc/Pics/equiv.eps0000644000000000000000000002665411754016452015552 0ustar0000000000000000%!PS-Adobe-2.0 EPSF-2.0 %%Title: %%Creator: Diagram %%CreationDate: Thu Sep 8 10:36:49 1994 %%For: hudak %%DocumentFonts: (atend) %%Pages: 0 0 %%BoundingBox: 0 0 236 51 %%NXNextStepVersion: 3.0 %%EndComments %%BeginProcSet: /usr/lib/NextStep/printPackage.ps 3.0 %! % NeXT Printing Package % Version: 3.1 % Copyright: 1988, NeXT, Inc. /__NXdef{1 index where{pop pop pop}{def}ifelse}bind def /__NXbdef{1 index where{pop pop pop}{bind def}ifelse}bind def /UserObjects 10 array __NXdef /defineuserobject{ exch dup 1 add dup UserObjects length gt{ array dup 0 UserObjects putinterval /UserObjects exch def }{pop}ifelse UserObjects exch 3 -1 roll put }__NXbdef /undefineuserobject{UserObjects exch null put}__NXbdef /execuserobject{UserObjects exch get exec}__NXbdef /__NXRectPath{4 2 roll moveto 1 index 0 rlineto 0 exch rlineto neg 0 rlineto closepath}__NXbdef /__NXProcessRectArgs{ 1 index type /arraytype eq{ exch 0 4 2 index length 1 sub{ dup 3 add 1 exch{1 index exch get exch}for 5 1 roll 5 index exec }for pop pop }{exec}ifelse }__NXbdef /rectfill{gsave newpath {__NXRectPath fill} __NXProcessRectArgs grestore}__NXbdef /rectclip{newpath {__NXRectPath} __NXProcessRectArgs clip newpath}__NXbdef /rectstroke{ gsave newpath dup type /arraytype eq{dup length 6 eq}{false}ifelse{ {gsave __NXRectPath null concat stroke grestore} dup length array cvx copy dup 2 4 -1 roll put __NXProcessRectArgs }{{__NXRectPath stroke} __NXProcessRectArgs}ifelse grestore }__NXbdef /_NXLevel2 systemdict /languagelevel known {languagelevel 2 ge}{false}ifelse __NXdef /xyshow{ 0 1 3 index length 1 sub{ currentpoint 4 index 3 index 1 getinterval show 3 index 3 index 2 mul 1 add get add exch 3 index 3 index 2 mul get add exch moveto pop }for pop pop }__NXbdef /xshow{ 0 1 3 index length 1 sub{ currentpoint 4 index 3 index 1 getinterval show exch 3 index 3 index get add exch moveto pop }for pop pop }__NXbdef /yshow{ 0 1 3 index length 1 sub{ currentpoint 4 index 3 index 1 getinterval show 3 index 3 index get add moveto pop }for pop pop }__NXbdef /arct{arcto pop pop pop pop}__NXbdef /setbbox{pop pop pop pop}__NXbdef /ucache{}__NXbdef /ucachestatus{mark 0 0 0 0 0}__NXbdef /setucacheparams{cleartomark}__NXbdef /uappend{systemdict begin cvx exec end}__NXbdef /ueofill{gsave newpath uappend eofill grestore}__NXbdef /ufill{gsave newpath uappend fill grestore}__NXbdef /ustroke{ gsave newpath dup length 6 eq {exch uappend concat}{uappend}ifelse stroke grestore }__NXbdef /__NXustrokepathMatrix dup where {pop pop}{matrix def}ifelse /ustrokepath{ newpath dup length 6 eq{ exch uappend __NXustrokepathMatrix currentmatrix exch concat strokepath setmatrix }{uappend strokepath}ifelse } __NXbdef /upath{ [exch {/ucache cvx}if pathbbox /setbbox cvx {/moveto cvx}{/lineto cvx}{/curveto cvx}{/closepath cvx}pathforall]cvx } __NXbdef /setstrokeadjust{pop}__NXbdef /currentstrokeadjust{false}__NXbdef /selectfont{exch findfont exch dup type /arraytype eq {makefont}{scalefont}ifelse setfont}__NXbdef /_NXCombineArrays{ counttomark dup 2 add index dup length 3 -1 roll { 2 index length sub dup 4 1 roll 1 index exch 4 -1 roll putinterval exch }repeat pop pop pop }__NXbdef /flushgraphics{}def /setwindowtype{pop pop}def /currentwindowtype{pop 0}def /setalpha{pop}def /currentalpha{1.0}def /hidecursor{}def /obscurecursor{}def /revealcursor{}def /setcursor{4 {pop}repeat}bind def /showcursor{}def /NextStepEncoding where not{ /NextStepEncoding StandardEncoding 256 array copy def 0 [129/Agrave/Aacute/Acircumflex/Atilde/Adieresis/Aring/Ccedilla/Egrave /Eacute/Ecircumflex/Edieresis/Igrave/Iacute/Icircumflex/Idieresis /Eth/Ntilde/Ograve/Oacute/Ocircumflex/Otilde/Odieresis/Ugrave/Uacute /Ucircumflex/Udieresis/Yacute/Thorn/mu/multiply/divide/copyright 176/registered 181/brokenbar 190/logicalnot 192/onesuperior 201/twosuperior 204/threesuperior 209/plusminus/onequarter/onehalf/threequarters/agrave /aacute/acircumflex/atilde/adieresis/aring/ccedilla/egrave/eacute /ecircumflex/edieresis/igrave 226/iacute 228/icircumflex/idieresis/eth /ntilde 236/ograve/oacute/ocircumflex/otilde/odieresis 242/ugrave/uacute /ucircumflex 246/udieresis/yacute 252/thorn/ydieresis] {dup type /nametype eq {NextStepEncoding 2 index 2 index put pop 1 add}{exch pop}ifelse }forall pop /NextStepEncoding NextStepEncoding readonly def /_NXfstr 128 string dup 0 (_NX) putinterval def /_NXfindfont /findfont load def /findfont{ % Because we can never let NextStepEncoding get into % SharedFontDirectory, we cannot reencode a font to NextStepEncoding % if we are in shared mode. So if currentshared is true, % we call the normal findfont and return that /currentshared where {pop currentshared} {false} ifelse {_NXfindfont} {dup _NXfstr 3 125 getinterval cvs length 3 add _NXfstr 0 3 -1 roll getinterval cvn exch FontDirectory 2 index known {pop FontDirectory exch get} {_NXfindfont dup /Encoding get StandardEncoding eq { dup length dict exch {1 index /FID ne {2 index 3 1 roll put}{pop pop}ifelse}forall dup /Encoding NextStepEncoding put definefont }{exch pop} ifelse }ifelse }ifelse }bind def }{pop}ifelse /_NXImageString {/__NXImageString where{pop}{/__NXImageString 4000 string __NXdef}ifelse __NXImageString}__NXbdef /_NXDoImageOp{ 3 dict begin /parr 5 array def 1 index{dup}{1}ifelse /chans exch def chans 2 add 2 roll parr 0 chans getinterval astore pop 5 index 4 index mul 2 index{1 sub 8 idiv 1 add mul}{mul 1 sub 8 idiv 1 add}ifelse 4 index mul /totbytes exch def pop exch pop gsave matrix invertmatrix concat 0.5 setgray 0 0 4 2 roll rectfill grestore {0 1 chans 1 sub{parr exch get exec length totbytes exch sub /totbytes exch def}for totbytes 0 le{exit}if}loop end }__NXbdef /alphaimage{1 add _NXDoImageOp}def _NXLevel2{ /NXCalibratedRGBColorSpace where{pop}{ /NXCalibratedRGBColorSpace {mark /NXCalibratedRGB /ColorSpace findresource exch pop}stopped {cleartomark /NXCalibratedRGB[/CIEBasedABC 2 dict dup begin /MatrixLMN[.4124 .2126 .0193 .3576 .7152 .1192 .1805 .0722 .9505]def /WhitePoint[.9505 1 1.089] def end] /ColorSpace defineresource}if def}ifelse /nxsetrgbcolor{NXCalibratedRGBColorSpace setcolorspace setcolor}__NXbdef /nxsetgray{dup dup nxsetrgbcolor}__NXbdef /_NXCalibratedImage{exch{array astore dup length true}{false}ifelse 8 -1 roll{NXCalibratedRGBColorSpace setcolorspace}if 8 dict dup 9 1 roll begin /ImageType 1 def /MultipleDataSources exch def currentcolorspace 0 get /Indexed eq{pop /Decode[0 2 6 index exp 1 sub]def} {2 mul dup array /Decode exch def 1 sub 0 1 3 -1 roll{Decode exch dup 2 mod put}for}ifelse /DataSource exch def /ImageMatrix exch def /BitsPerComponent exch def /Height exch def /Width exch def end image}__NXbdef } { /setcmykcolor{ 1.0 exch sub dup dup 6 -1 roll sub dup 0 lt{pop 0}if 5 1 roll 4 -1 roll sub dup 0 lt{pop 0}if 3 1 roll exch sub dup 0 lt{pop 0}if setrgbcolor}__NXbdef /currentcmykcolor{currentrgbcolor 3{1.0 exch sub 3 1 roll}repeat 0}__NXbdef /colorimage{2 copy 3 ne or{_NXDoImageOp}{4 index dup 8 ne exch 4 ne and{_NXDoImageOp}{ pop pop save 6 1 roll 12 dict begin/Proc exch def/Res 0 string def /Alloc{2 index length mul 2 add dup 2 index load length gt{1.2 mul round cvi string def}{pop pop}ifelse}def 1 index 8 eq{/Unpack{.34 Alloc}def}{ /Wid 4 index 3 mul def exch pop 8 exch/Str1 0 string def/Lim Wid def /Unpack{.67 Alloc/Str1 2 Alloc 0 exch Lim exch {dup -4 bitshift 17 mul Str1 exch 4 index exch put 15 and 17 mul Str1 exch 3 index 1 add exch put 2 sub dup 0 le{0 lt Wid exch{exch 1 sub exch}if}if exch 2 add exch }forall/Lim exch def Str1 exch 0 exch getinterval }def }ifelse /Ops[{.3 mul add 1}{.59 mul add 2}{.11 mul add round cvi Res exch 2 index exch put 1 add 0.0 0}]def/Val 0.0 def/Phase 0 def {0 Val Phase Proc/Res Unpack{exch Ops exch get exec}forall/Phase exch def/Val exch def Res exch 0 exch getinterval} image end restore}ifelse}ifelse }__NXbdef /nxsetrgbcolor{setrgbcolor}__NXbdef /nxsetgray{setgray}__NXbdef /setpattern{pop .5 setgray}__NXbdef /_NXCalibratedImage{dup 1 eq {pop pop image}{colorimage}ifelse pop}__NXbdef } ifelse /_NXSetCMYKOrRGB where{pop}{ mark{systemdict /currentwindow get exec}stopped {{pop pop pop setcmykcolor}}{{nxsetrgbcolor pop pop pop pop}}ifelse /_NXSetCMYKOrRGB exch def cleartomark }ifelse %%EndProcSet gsave /__NXbasematrix matrix currentmatrix def grestore %%EndProlog %%BeginSetup %%EndSetup gsave 0 0 236 51 rectclip [1 0 0 -1 -156.280014 67] concat 156.280014 16 235 51 rectclip 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 330.280029 28 352.280029 28 setbbox 330.280029 28 moveto 352.280029 28 lineto end stroke grestore 0 setlinejoin gsave /Helvetica findfont 24 scalefont [1 0 0 -1 0 0] makefont 120 exch defineuserobject 120 execuserobject setfont 0 nxsetgray gsave 324 17 35 49 rectclip /Sonata findfont 24 scalefont [1 0 0 -1 0 0] makefont 156 exch defineuserobject 156 execuserobject setfont 0 nxsetgray 324 51 moveto (q q q) show grestore grestore gsave 156 execuserobject setfont 0 nxsetgray gsave 367 17 9 41 rectclip 156 execuserobject setfont 0 nxsetgray 367 51 moveto (q) show grestore grestore 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 323.279999 20 383.890015 20 setbbox 323.279999 20 moveto 383.890015 20 lineto end stroke grestore 0 setlinejoin 1 nxsetgray 345 12 16 15 rectfill gsave 156 execuserobject setfont 0 nxsetgray gsave 347 16 12 11 rectclip /Helvetica findfont 12 scalefont [1 0 0 -1 0 0] makefont 10 exch defineuserobject 10 execuserobject setfont 0 nxsetgray 349 24 moveto (3) show grestore grestore 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 383.890015 20 383.890015 28.029984 setbbox 383.890015 20 moveto 383.890015 28.029984 lineto end stroke grestore 0 setlinejoin 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 323.279999 20 323.279999 28.029984 setbbox 323.279999 20 moveto 323.279999 28.029984 lineto end stroke grestore 0 setlinejoin gsave 10 execuserobject setfont 0 nxsetgray /Helvetica-Bold findfont 12 scalefont [1 0 0 -1 0 0] makefont 157 exch defineuserobject 157 execuserobject setfont 0 nxsetgray 379 51 moveto (.) show grestore gsave 157 execuserobject setfont 0 nxsetgray gsave 207 17 9 41 rectclip 156 execuserobject setfont 0 nxsetgray 207 51 moveto (q) show grestore grestore 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 158.279999 20 193.890015 20 setbbox 158.279999 20 moveto 193.890015 20 lineto end stroke grestore 0 setlinejoin 1 nxsetgray 168 12 16 15 rectfill gsave 156 execuserobject setfont 0 nxsetgray gsave 170 16 12 11 rectclip 10 execuserobject setfont 0 nxsetgray 172 24 moveto (3) show grestore grestore 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 193.890015 20 193.890015 28.029984 setbbox 193.890015 20 moveto 193.890015 28.029984 lineto end stroke grestore 0 setlinejoin 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 158.279999 20 158.279999 28.029984 setbbox 158.279999 20 moveto 158.279999 28.029984 lineto end stroke grestore 0 setlinejoin 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 165.280014 28 187.280014 28 setbbox 165.280014 28 moveto 187.280014 28 lineto end stroke grestore 0 setlinejoin gsave 10 execuserobject setfont 0 nxsetgray gsave 159 17 35 49 rectclip 156 execuserobject setfont 0 nxsetgray 159 51 moveto (q q q) show grestore grestore gsave 156 execuserobject setfont 0 nxsetgray 120 execuserobject setfont 0 nxsetgray 260 47 moveto (=) show grestore grestore %%Trailer %%DocumentFonts: Sonata %%+ Helvetica-Bold %%+ Helvetica haskore-0.2.0.3/src/Doc/Pics/haskore.tex0000644000000000000000000000750211754016452016055 0ustar0000000000000000\begin{tikzpicture}[ solid/.style={rectangle, draw, thick, minimum height=1cm, text width=3cm, text badly centered}, clear/.style={rectangle, minimum height=0.5cm, text width=3cm, text badly centered}, broken/.style={rectangle, draw, dashed, minimum height=1cm, text width=3cm, text badly centered}, dashy/.style={ellipse, draw, dashed, minimum height=1.8cm, text width=3cm, text badly centered} ] %% Haskore, on top \draw (5.25,0) node[solid] (haskore) { \textbf{Haskore} }; \draw (5.25,0) node[dashy] { }; %% Second row, translators \draw (0,-2) node[solid] (hsk2mid) { \small Haskore~$\rightarrow$~MIDI \\ Translator }; \draw (3.5,-2) node[solid] (hsk2csn) { \small Haskore~$\rightarrow$~CSound \\ Translator}; \draw (7.0,-2) node[solid] (hsk2mkt) { \small Haskore~$\rightarrow$~MusicKit Translator}; \draw (10.5,-2) node[solid] (hsk2cmn) { \small Haskore~$\rightarrow$~Notation Translator }; \draw (0,-3.25) node[clear] (midifile) { \small Standard MIDI~File }; \draw (3.5,-3.25) node[clear] (scorefile) { \small CSound Score File }; \draw (7.0,-3.25) node[clear] (mkitfile) { \small MusicKit ScoreFile }; \draw (10.5,-3.25) node[clear] (cmncode) { \small CMN Code }; %% Third row, helpers \draw (0,-4.5) node[solid] (midiplay) { \small MIDI File Player }; \draw (3.5,-4.5) node[solid] (csound) { \small CSound }; \draw (7.0,-4.5) node[solid] (musickit) { \small MusicKit }; \draw (10.5,-4.5) node[solid] (cmn) { \small CMN }; \draw (0,-5.75) node[clear] (midi) { \small MIDI }; \draw (3.5,-5.75) node[clear] (sndfile) { \small \texttt{.snd} File }; \draw (10.5,-5.75) node[clear] (notated) { \small Notated score }; %% Last row, results \draw (0,-7) node[broken] (instruments) { \small MIDI Instruments }; \draw (3.5,-7) node[solid] (snd) { \small Sound File Player }; \draw [very thick,->] (haskore) to (hsk2mid.north); \draw [very thick,->] (haskore) to (hsk2csn.north); \draw [very thick,->] (haskore) to (hsk2mkt.north); \draw [very thick,->] (haskore) to (hsk2cmn.north); \draw [very thick,-] (hsk2mid.south) to (midifile.north); \draw [very thick,-] (hsk2csn.south) to (scorefile.north); \draw [very thick,-] (hsk2mkt.south) to (mkitfile.north); \draw [very thick,-] (hsk2cmn.south) to (cmncode.north); \draw [very thick,->] (midifile.south) to (midiplay.north); \draw [very thick,->] (scorefile.south) to (csound.north); \draw [very thick,->] (mkitfile.south) to (musickit.north); \draw [very thick,->] (cmncode.south) to (cmn.north); \draw [very thick,-] (midiplay.south) to (midi.north); \draw [very thick,-] (csound.south) to (sndfile.north); \draw [very thick,->] (cmn.south) to (notated.north); \draw [very thick,->] (midi.south) to (instruments.north); \draw [very thick,->] (sndfile.south) to (snd.north); \end{tikzpicture} haskore-0.2.0.3/src/Doc/Pics/midi.tex0000644000000000000000000000272311754016452015343 0ustar0000000000000000\begin{tikzpicture}[ solid/.style={rectangle, draw, thick, minimum height=1cm, text width=2cm, text badly centered}, clear/.style={rectangle, minimum height=0.5cm, text width=2.5cm, text badly centered} ] \draw (0,0) node[solid] (midifile) { \small MIDI File }; \draw (3.0,0) node[clear] (stream) { \small \texttt{Stream} }; \draw (6.0,0) node[solid] (datatype) { \small \texttt{MidiFile} data~type}; \draw (8.8,0) node[clear] (performance) { \small \texttt{Performance} }; \draw (12.0,0) node[solid] (musictype) { \small \texttt{Music} data~type}; \draw [thick,->] (midifile.15) to node[above] { \small \texttt{Load.fromFile} } (datatype.165); \draw [thick,<-] (midifile.-15) to node[below] { \small \texttt{Save.toFile} } (datatype.-165); \draw [thick,->] (datatype.15) to node[above] { \small \texttt{Read.toMusic} } (musictype.165); \draw [thick,<-] (datatype.-15) to node[below] { \small \texttt{Write.fromMusic} } (musictype.-165); \end{tikzpicture} haskore-0.2.0.3/src/Doc/Pics/poly.eps0000644000000000000000000005023211754016452015371 0ustar0000000000000000%!PS-Adobe-2.0 EPSF-2.0 %%Title: %%Creator: Diagram %%CreationDate: Mon Sep 5 13:19:42 1994 %%For: hudak %%DocumentFonts: (atend) %%Pages: 0 0 %%BoundingBox: 0 0 296 202 %%NXNextStepVersion: 3.0 %%EndComments %%BeginProcSet: /usr/lib/NextStep/printPackage.ps 3.0 %! % NeXT Printing Package % Version: 3.1 % Copyright: 1988, NeXT, Inc. /__NXdef{1 index where{pop pop pop}{def}ifelse}bind def /__NXbdef{1 index where{pop pop pop}{bind def}ifelse}bind def /UserObjects 10 array __NXdef /defineuserobject{ exch dup 1 add dup UserObjects length gt{ array dup 0 UserObjects putinterval /UserObjects exch def }{pop}ifelse UserObjects exch 3 -1 roll put }__NXbdef /undefineuserobject{UserObjects exch null put}__NXbdef /execuserobject{UserObjects exch get exec}__NXbdef /__NXRectPath{4 2 roll moveto 1 index 0 rlineto 0 exch rlineto neg 0 rlineto closepath}__NXbdef /__NXProcessRectArgs{ 1 index type /arraytype eq{ exch 0 4 2 index length 1 sub{ dup 3 add 1 exch{1 index exch get exch}for 5 1 roll 5 index exec }for pop pop }{exec}ifelse }__NXbdef /rectfill{gsave newpath {__NXRectPath fill} __NXProcessRectArgs grestore}__NXbdef /rectclip{newpath {__NXRectPath} __NXProcessRectArgs clip newpath}__NXbdef /rectstroke{ gsave newpath dup type /arraytype eq{dup length 6 eq}{false}ifelse{ {gsave __NXRectPath null concat stroke grestore} dup length array cvx copy dup 2 4 -1 roll put __NXProcessRectArgs }{{__NXRectPath stroke} __NXProcessRectArgs}ifelse grestore }__NXbdef /_NXLevel2 systemdict /languagelevel known {languagelevel 2 ge}{false}ifelse __NXdef /xyshow{ 0 1 3 index length 1 sub{ currentpoint 4 index 3 index 1 getinterval show 3 index 3 index 2 mul 1 add get add exch 3 index 3 index 2 mul get add exch moveto pop }for pop pop }__NXbdef /xshow{ 0 1 3 index length 1 sub{ currentpoint 4 index 3 index 1 getinterval show exch 3 index 3 index get add exch moveto pop }for pop pop }__NXbdef /yshow{ 0 1 3 index length 1 sub{ currentpoint 4 index 3 index 1 getinterval show 3 index 3 index get add moveto pop }for pop pop }__NXbdef /arct{arcto pop pop pop pop}__NXbdef /setbbox{pop pop pop pop}__NXbdef /ucache{}__NXbdef /ucachestatus{mark 0 0 0 0 0}__NXbdef /setucacheparams{cleartomark}__NXbdef /uappend{systemdict begin cvx exec end}__NXbdef /ueofill{gsave newpath uappend eofill grestore}__NXbdef /ufill{gsave newpath uappend fill grestore}__NXbdef /ustroke{ gsave newpath dup length 6 eq {exch uappend concat}{uappend}ifelse stroke grestore }__NXbdef /__NXustrokepathMatrix dup where {pop pop}{matrix def}ifelse /ustrokepath{ newpath dup length 6 eq{ exch uappend __NXustrokepathMatrix currentmatrix exch concat strokepath setmatrix }{uappend strokepath}ifelse } __NXbdef /upath{ [exch {/ucache cvx}if pathbbox /setbbox cvx {/moveto cvx}{/lineto cvx}{/curveto cvx}{/closepath cvx}pathforall]cvx } __NXbdef /setstrokeadjust{pop}__NXbdef /currentstrokeadjust{false}__NXbdef /selectfont{exch findfont exch dup type /arraytype eq {makefont}{scalefont}ifelse setfont}__NXbdef /_NXCombineArrays{ counttomark dup 2 add index dup length 3 -1 roll { 2 index length sub dup 4 1 roll 1 index exch 4 -1 roll putinterval exch }repeat pop pop pop }__NXbdef /flushgraphics{}def /setwindowtype{pop pop}def /currentwindowtype{pop 0}def /setalpha{pop}def /currentalpha{1.0}def /hidecursor{}def /obscurecursor{}def /revealcursor{}def /setcursor{4 {pop}repeat}bind def /showcursor{}def /NextStepEncoding where not{ /NextStepEncoding StandardEncoding 256 array copy def 0 [129/Agrave/Aacute/Acircumflex/Atilde/Adieresis/Aring/Ccedilla/Egrave /Eacute/Ecircumflex/Edieresis/Igrave/Iacute/Icircumflex/Idieresis /Eth/Ntilde/Ograve/Oacute/Ocircumflex/Otilde/Odieresis/Ugrave/Uacute /Ucircumflex/Udieresis/Yacute/Thorn/mu/multiply/divide/copyright 176/registered 181/brokenbar 190/logicalnot 192/onesuperior 201/twosuperior 204/threesuperior 209/plusminus/onequarter/onehalf/threequarters/agrave /aacute/acircumflex/atilde/adieresis/aring/ccedilla/egrave/eacute /ecircumflex/edieresis/igrave 226/iacute 228/icircumflex/idieresis/eth /ntilde 236/ograve/oacute/ocircumflex/otilde/odieresis 242/ugrave/uacute /ucircumflex 246/udieresis/yacute 252/thorn/ydieresis] {dup type /nametype eq {NextStepEncoding 2 index 2 index put pop 1 add}{exch pop}ifelse }forall pop /NextStepEncoding NextStepEncoding readonly def /_NXfstr 128 string dup 0 (_NX) putinterval def /_NXfindfont /findfont load def /findfont{ % Because we can never let NextStepEncoding get into % SharedFontDirectory, we cannot reencode a font to NextStepEncoding % if we are in shared mode. So if currentshared is true, % we call the normal findfont and return that /currentshared where {pop currentshared} {false} ifelse {_NXfindfont} {dup _NXfstr 3 125 getinterval cvs length 3 add _NXfstr 0 3 -1 roll getinterval cvn exch FontDirectory 2 index known {pop FontDirectory exch get} {_NXfindfont dup /Encoding get StandardEncoding eq { dup length dict exch {1 index /FID ne {2 index 3 1 roll put}{pop pop}ifelse}forall dup /Encoding NextStepEncoding put definefont }{exch pop} ifelse }ifelse }ifelse }bind def }{pop}ifelse /_NXImageString {/__NXImageString where{pop}{/__NXImageString 4000 string __NXdef}ifelse __NXImageString}__NXbdef /_NXDoImageOp{ 3 dict begin /parr 5 array def 1 index{dup}{1}ifelse /chans exch def chans 2 add 2 roll parr 0 chans getinterval astore pop 5 index 4 index mul 2 index{1 sub 8 idiv 1 add mul}{mul 1 sub 8 idiv 1 add}ifelse 4 index mul /totbytes exch def pop exch pop gsave matrix invertmatrix concat 0.5 setgray 0 0 4 2 roll rectfill grestore {0 1 chans 1 sub{parr exch get exec length totbytes exch sub /totbytes exch def}for totbytes 0 le{exit}if}loop end }__NXbdef /alphaimage{1 add _NXDoImageOp}def _NXLevel2{ /NXCalibratedRGBColorSpace where{pop}{ /NXCalibratedRGBColorSpace {mark /NXCalibratedRGB /ColorSpace findresource exch pop}stopped {cleartomark /NXCalibratedRGB[/CIEBasedABC 2 dict dup begin /MatrixLMN[.4124 .2126 .0193 .3576 .7152 .1192 .1805 .0722 .9505]def /WhitePoint[.9505 1 1.089] def end] /ColorSpace defineresource}if def}ifelse /nxsetrgbcolor{NXCalibratedRGBColorSpace setcolorspace setcolor}__NXbdef /nxsetgray{dup dup nxsetrgbcolor}__NXbdef /_NXCalibratedImage{exch{array astore dup length true}{false}ifelse 8 -1 roll{NXCalibratedRGBColorSpace setcolorspace}if 8 dict dup 9 1 roll begin /ImageType 1 def /MultipleDataSources exch def currentcolorspace 0 get /Indexed eq{pop /Decode[0 2 6 index exp 1 sub]def} {2 mul dup array /Decode exch def 1 sub 0 1 3 -1 roll{Decode exch dup 2 mod put}for}ifelse /DataSource exch def /ImageMatrix exch def /BitsPerComponent exch def /Height exch def /Width exch def end image}__NXbdef } { /setcmykcolor{ 1.0 exch sub dup dup 6 -1 roll sub dup 0 lt{pop 0}if 5 1 roll 4 -1 roll sub dup 0 lt{pop 0}if 3 1 roll exch sub dup 0 lt{pop 0}if setrgbcolor}__NXbdef /currentcmykcolor{currentrgbcolor 3{1.0 exch sub 3 1 roll}repeat 0}__NXbdef /colorimage{2 copy 3 ne or{_NXDoImageOp}{4 index dup 8 ne exch 4 ne and{_NXDoImageOp}{ pop pop save 6 1 roll 12 dict begin/Proc exch def/Res 0 string def /Alloc{2 index length mul 2 add dup 2 index load length gt{1.2 mul round cvi string def}{pop pop}ifelse}def 1 index 8 eq{/Unpack{.34 Alloc}def}{ /Wid 4 index 3 mul def exch pop 8 exch/Str1 0 string def/Lim Wid def /Unpack{.67 Alloc/Str1 2 Alloc 0 exch Lim exch {dup -4 bitshift 17 mul Str1 exch 4 index exch put 15 and 17 mul Str1 exch 3 index 1 add exch put 2 sub dup 0 le{0 lt Wid exch{exch 1 sub exch}if}if exch 2 add exch }forall/Lim exch def Str1 exch 0 exch getinterval }def }ifelse /Ops[{.3 mul add 1}{.59 mul add 2}{.11 mul add round cvi Res exch 2 index exch put 1 add 0.0 0}]def/Val 0.0 def/Phase 0 def {0 Val Phase Proc/Res Unpack{exch Ops exch get exec}forall/Phase exch def/Val exch def Res exch 0 exch getinterval} image end restore}ifelse}ifelse }__NXbdef /nxsetrgbcolor{setrgbcolor}__NXbdef /nxsetgray{setgray}__NXbdef /setpattern{pop .5 setgray}__NXbdef /_NXCalibratedImage{dup 1 eq {pop pop image}{colorimage}ifelse pop}__NXbdef } ifelse /_NXSetCMYKOrRGB where{pop}{ mark{systemdict /currentwindow get exec}stopped {{pop pop pop setcmykcolor}}{{nxsetrgbcolor pop pop pop pop}}ifelse /_NXSetCMYKOrRGB exch def cleartomark }ifelse %%EndProcSet gsave /__NXbasematrix matrix currentmatrix def grestore %%EndProlog %%BeginSetup %%EndSetup gsave 0 0 296 202 rectclip [1 0 0 -1 -119 208] concat 119 6 296 202 rectclip gsave /Helvetica findfont 12 scalefont [1 0 0 -1 0 0] makefont 10 exch defineuserobject 10 execuserobject setfont 0 nxsetgray gsave 191 43 9 41 rectclip /Sonata findfont 24 scalefont [1 0 0 -1 0 0] makefont 80 exch defineuserobject 80 execuserobject setfont 0 nxsetgray 191 77 moveto (q) show grestore grestore 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 215 54 227 54 setbbox 215 54 moveto 227 54 lineto end stroke grestore 0 setlinejoin gsave 80 execuserobject setfont 0 nxsetgray gsave 209 43 26 49 rectclip 80 execuserobject setfont 0 nxsetgray 209 77 moveto (q q) show grestore grestore gsave 80 execuserobject setfont 0 nxsetgray gsave 236 43 33 43 rectclip 80 execuserobject setfont 0 nxsetgray 236 77 moveto (q q q) show grestore grestore 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 242 54 264 54 setbbox 242 54 moveto 264 54 lineto end stroke grestore 0 setlinejoin 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 254 59 264 59 setbbox 254 59 moveto 264 59 lineto end stroke grestore 0 setlinejoin gsave 80 execuserobject setfont 0 nxsetgray gsave 272 43 9 41 rectclip 80 execuserobject setfont 0 nxsetgray 272 77 moveto (q) show grestore grestore gsave 80 execuserobject setfont 0 nxsetgray gsave 290 43 9 41 rectclip 80 execuserobject setfont 0 nxsetgray 290 77 moveto (q) show grestore grestore 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 323 54 335 54 setbbox 323 54 moveto 335 54 lineto end stroke grestore 0 setlinejoin gsave 80 execuserobject setfont 0 nxsetgray gsave 317 43 26 49 rectclip 80 execuserobject setfont 0 nxsetgray 317 77 moveto (q q) show grestore grestore 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 350 54 362 54 setbbox 350 54 moveto 362 54 lineto end stroke grestore 0 setlinejoin gsave 80 execuserobject setfont 0 nxsetgray gsave 344 43 26 49 rectclip 80 execuserobject setfont 0 nxsetgray 344 77 moveto (q q) show grestore grestore 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 377 54 389 54 setbbox 377 54 moveto 389 54 lineto end stroke grestore 0 setlinejoin gsave 80 execuserobject setfont 0 nxsetgray gsave 371 43 26 49 rectclip 80 execuserobject setfont 0 nxsetgray 371 77 moveto (q q) show grestore grestore 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 208 45 284.279999 46 setbbox 208 46 moveto 284.279999 45 lineto end stroke grestore 0 setlinejoin 1 nxsetgray 232 38 28 15 rectfill gsave 80 execuserobject setfont 0 nxsetgray 10 execuserobject setfont 0 nxsetgray 237 50 moveto (3:2) show grestore 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 284.279999 45 284.279999 55.029999 setbbox 284.279999 45 moveto 284.279999 55.029999 lineto end stroke grestore 0 setlinejoin 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 208 46 208 54.029999 setbbox 208 46 moveto 208 54.029999 lineto end stroke grestore 0 setlinejoin 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 188 35 302.779999 35 setbbox 188 35 moveto 302.779999 35 lineto end stroke grestore 0 setlinejoin 1 nxsetgray 232 27 26 15 rectfill gsave 10 execuserobject setfont 0 nxsetgray 10 execuserobject setfont 0 nxsetgray 236 39 moveto (4:3) show grestore 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 302.779999 35 302.779999 43.029999 setbbox 302.779999 35 moveto 302.779999 43.029999 lineto end stroke grestore 0 setlinejoin 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 188 35 188 43.029999 setbbox 188 35 moveto 188 43.029999 lineto end stroke grestore 0 setlinejoin 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 316 35 394.790009 35 setbbox 316 35 moveto 394.790009 35 lineto end stroke grestore 0 setlinejoin 1 nxsetgray 342 27 26 15 rectfill gsave 10 execuserobject setfont 0 nxsetgray 10 execuserobject setfont 0 nxsetgray 346 39 moveto (3:2) show grestore 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 394.790009 35 394.790009 43.029999 setbbox 394.790009 35 moveto 394.790009 43.029999 lineto end stroke grestore 0 setlinejoin 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 316 35 316 43.029999 setbbox 316 35 moveto 316 43.029999 lineto end stroke grestore 0 setlinejoin 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 177 22 406.549988 22 setbbox 177 22 moveto 406.549988 22 lineto end stroke grestore 0 setlinejoin 1 nxsetgray 278 14 26 15 rectfill gsave 10 execuserobject setfont 0 nxsetgray 10 execuserobject setfont 0 nxsetgray 282 26 moveto (5:6) show grestore 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 406.549988 22 406.549988 30.030001 setbbox 406.549988 22 moveto 406.549988 30.030001 lineto end stroke grestore 0 setlinejoin 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 177 22 177 30.030001 setbbox 177 22 moveto 177 30.030001 lineto end stroke grestore 0 setlinejoin 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 173.279999 149 246.229996 149 setbbox 173.279999 149 moveto 246.229996 149 lineto end stroke grestore 0 setlinejoin 1 nxsetgray 196 141 26 15 rectfill gsave 10 execuserobject setfont 0 nxsetgray 10 execuserobject setfont 0 nxsetgray 200 153 moveto (5:4) show grestore 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 246.229996 149 246.229996 157.029999 setbbox 246.229996 149 moveto 246.229996 157.029999 lineto end stroke grestore 0 setlinejoin 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 173.279999 149 173.279999 157.029999 setbbox 173.279999 149 moveto 173.279999 157.029999 lineto end stroke grestore 0 setlinejoin 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 177.279999 161 212.889999 161 setbbox 177.279999 161 moveto 212.889999 161 lineto end stroke grestore 0 setlinejoin 1 nxsetgray 187 153 16 15 rectfill gsave 10 execuserobject setfont 0 nxsetgray 10 execuserobject setfont 0 nxsetgray 191 165 moveto (3) show grestore 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 212.889999 161 212.889999 169.029999 setbbox 212.889999 161 moveto 212.889999 169.029999 lineto end stroke grestore 0 setlinejoin 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 177.279999 161 177.279999 169.029999 setbbox 177.279999 161 moveto 177.279999 169.029999 lineto end stroke grestore 0 setlinejoin 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 313.279999 161 348.890015 161 setbbox 313.279999 161 moveto 348.890015 161 lineto end stroke grestore 0 setlinejoin 1 nxsetgray 323 153 16 15 rectfill gsave 10 execuserobject setfont 0 nxsetgray 10 execuserobject setfont 0 nxsetgray 327 165 moveto (3) show grestore 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 348.890015 161 348.890015 169.029999 setbbox 348.890015 161 moveto 348.890015 169.029999 lineto end stroke grestore 0 setlinejoin 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 313.279999 161 313.279999 169.029999 setbbox 313.279999 161 moveto 313.279999 169.029999 lineto end stroke grestore 0 setlinejoin 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 319.279999 169 341.279999 169 setbbox 319.279999 169 moveto 341.279999 169 lineto end stroke grestore 0 setlinejoin gsave 10 execuserobject setfont 0 nxsetgray gsave 313 158 35 49 rectclip 80 execuserobject setfont 0 nxsetgray 313 192 moveto (q q q) show grestore grestore 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 220.279999 169 242.279999 169 setbbox 220.279999 169 moveto 242.279999 169 lineto end stroke grestore 0 setlinejoin gsave 80 execuserobject setfont 0 nxsetgray gsave 214 158 35 49 rectclip 80 execuserobject setfont 0 nxsetgray 214 192 moveto (q q q) show grestore grestore 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 184.279999 169 206.279999 169 setbbox 184.279999 169 moveto 206.279999 169 lineto end stroke grestore 0 setlinejoin gsave 80 execuserobject setfont 0 nxsetgray gsave 178 158 35 49 rectclip 80 execuserobject setfont 0 nxsetgray 178 192 moveto (q q q) show grestore grestore gsave 80 execuserobject setfont 0 nxsetgray gsave 250 158 59 43 rectclip 80 execuserobject setfont 0 nxsetgray 250 192 moveto (q q q q q) show grestore grestore 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 257.279999 169 301.279999 169 setbbox 257.279999 169 moveto 301.279999 169 lineto end stroke grestore 0 setlinejoin 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 355.279999 169 377.279999 169 setbbox 355.279999 169 moveto 377.279999 169 lineto end stroke grestore 0 setlinejoin gsave 80 execuserobject setfont 0 nxsetgray gsave 349 158 35 49 rectclip 80 execuserobject setfont 0 nxsetgray 349 192 moveto (q q q) show grestore grestore 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 391.279999 169 403.279999 169 setbbox 391.279999 169 moveto 403.279999 169 lineto end stroke grestore 0 setlinejoin gsave 80 execuserobject setfont 0 nxsetgray gsave 385 158 26 49 rectclip 80 execuserobject setfont 0 nxsetgray 385 192 moveto (q q) show grestore grestore 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 252.279999 149 305.769989 149 setbbox 252.279999 149 moveto 305.769989 149 lineto end stroke grestore 0 setlinejoin 1 nxsetgray 266 141 26 15 rectfill gsave 80 execuserobject setfont 0 nxsetgray 10 execuserobject setfont 0 nxsetgray 270 153 moveto (5:4) show grestore 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 305.769989 149 305.769989 157.029999 setbbox 305.769989 149 moveto 305.769989 157.029999 lineto end stroke grestore 0 setlinejoin 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 252.279999 149 252.279999 157.029999 setbbox 252.279999 149 moveto 252.279999 157.029999 lineto end stroke grestore 0 setlinejoin 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 311.279999 149 382.279999 149 setbbox 311.279999 149 moveto 382.279999 149 lineto end stroke grestore 0 setlinejoin 1 nxsetgray 333 141 26 15 rectfill gsave 10 execuserobject setfont 0 nxsetgray 10 execuserobject setfont 0 nxsetgray 337 153 moveto (5:4) show grestore 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 382.279999 149 382.279999 157.029999 setbbox 382.279999 149 moveto 382.279999 157.029999 lineto end stroke grestore 0 setlinejoin 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 311.279999 149 311.279999 157.029999 setbbox 311.279999 149 moveto 311.279999 157.029999 lineto end stroke grestore 0 setlinejoin 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 169.279999 135 408.559998 135 setbbox 169.279999 135 moveto 408.559998 135 lineto end stroke grestore 0 setlinejoin 1 nxsetgray 275 127 26 15 rectfill gsave 10 execuserobject setfont 0 nxsetgray 10 execuserobject setfont 0 nxsetgray 279 139 moveto (7:6) show grestore 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 408.559998 135 408.559998 143.029999 setbbox 408.559998 135 moveto 408.559998 143.029999 lineto end stroke grestore 0 setlinejoin 0 nxsetgray 1 setlinewidth 2 setlinejoin gsave newpath systemdict begin 169.279999 135 169.279999 143.029999 setbbox 169.279999 135 moveto 169.279999 143.029999 lineto end stroke grestore 0 setlinejoin gsave 10 execuserobject setfont 0 nxsetgray /Helvetica-Bold findfont 12 scalefont [1 0 0 -1 0 0] makefont 81 exch defineuserobject 81 execuserobject setfont 0 nxsetgray 122 56 moveto (pr1) show grestore gsave 81 execuserobject setfont 0 nxsetgray 81 execuserobject setfont 0 nxsetgray 122 169 moveto (pr2) show grestore gsave 81 execuserobject setfont 0 nxsetgray 10 execuserobject setfont 0 nxsetgray 279 19 moveto ( .) show grestore grestore %%Trailer %%DocumentFonts: Sonata %%+ Helvetica-Bold %%+ Helvetica haskore-0.2.0.3/src/Medium/0000755000000000000000000000000011754016452013510 5ustar0000000000000000haskore-0.2.0.3/src/Medium/Controlled.hs0000644000000000000000000000346011754016452016154 0ustar0000000000000000module Medium.Controlled where -- import qualified Medium -- import qualified Medium.Temporal as Temporal class C medium where control :: (control -> medium control a -> medium control a) {- Do actions on each (virtual) constructor, don't recourse. -} switchBinary :: (a -> b) -> (medium control a -> medium control a -> b) -> (medium control a -> medium control a -> b) -> (control -> medium control a -> b) -> (b -> medium control a -> b) switchList :: (a -> b) -> ([medium control a] -> b) -> ([medium control a] -> b) -> (control -> medium control a -> b) -> medium control a -> b {- {- A variant of fmap that does not only allow manipulation of primitives but also of the compositions. Though the structure must be preserved. -} mapList :: (Medium.Temporal.C b, Medium.C medium) => (a->b) -> ([medium b]->[medium b]) -> ([medium b]->[medium b]) -> medium a -> medium b mapList f g h = foldList (prim . f) (serial . g) (parallel . h) mapListFlat :: (Medium.Temporal.C b, Medium.C medium) => (a -> b) -> ([medium a] -> [medium b]) -> ([medium a] -> [medium b]) -> medium a -> medium b mapListFlat f g h = switchList (prim . f) (serial . g) (parallel . h) -} {- This is even more general than mapList -} foldList :: C medium => (a->b) -> ([b]->b) -> ([b]->b) -> (c->b->b) -> medium c a -> b foldList f g h k = let recourse = foldList f g h k recurseAll = map recourse in switchList f (g . recurseAll) (h . recurseAll) (\c -> k c . recourse) foldBin :: C medium => (a->b) -> (b->b->b) -> (b->b->b) -> (c->b->b) -> b -> medium c a -> b foldBin f g h k z = let recourse = foldBin f g h k z recurseAll op x y = recourse x `op` recourse y in switchBinary f (recurseAll g) (recurseAll h) (\c -> k c . recourse) z haskore-0.2.0.3/src/Medium/Temporal.hs0000644000000000000000000000042511754016452015630 0ustar0000000000000000module Medium.Temporal where import qualified Numeric.NonNegative.Wrapper as NonNeg type Dur = NonNeg.Rational class C a where dur :: a -> Dur none :: Dur -> a class Control control where controlDur :: control -> Dur -> Dur anticontrolDur :: control -> Dur -> Dur haskore-0.2.0.3/src/Medium/LabeledControlled/0000755000000000000000000000000011754016452017066 5ustar0000000000000000haskore-0.2.0.3/src/Medium/LabeledControlled/List.hs0000644000000000000000000001031211754016452020332 0ustar0000000000000000module Medium.LabeledControlled.List where import qualified Medium.Controlled.List as CtrlMediumList import qualified Medium.Controlled as CtrlMedium import qualified Medium -- import qualified Medium.Temporal as Temporal -- import Haskore.General.Utility(maximum0) import Control.Applicative (liftA, ) import Data.Foldable (Foldable(foldMap)) import Data.Traversable (Traversable(sequenceA)) import qualified Data.Traversable as Traversable {- | Medium type with a label (e.g. the duration of the represented music), a controller constructor and direct support for rests. -} data T label control content = Cons {label :: label, structure :: Structure label control content} deriving (Show, Eq, Ord {- for use in FiniteMap -}) data Structure label control content = Primitive content -- ^ primitive content | Serial [T label control content] -- ^ sequential composition | Parallel [T label control content] -- ^ parallel composition | Control control (T label control content) -- ^ controller deriving (Show, Eq, Ord {- for use in FiniteMap -}) class Label label where emptyLabel :: label -- error "We can not automatically assign a label to primitives created by the generic Medium.primitive method" foldLabelSerial :: [label] -> label foldLabelParallel :: [label] -> label serialLabel, parallelLabel :: Label label => [T label control content] -> T label control content serialLabel xs = Cons (foldLabelSerial (map label xs)) (Serial xs) parallelLabel xs = Cons (foldLabelParallel (map label xs)) (Parallel xs) instance (Label label) => Medium.Construct (T label control) where prim = Cons emptyLabel . Primitive {- If the operands are also Serials or Parallels the lists are joined, since most times the operators are used to construct lists. This definition works also infinite application of (+:+). -} (+:+) x y = serialLabel (serialToList x ++ serialToList y) (=:=) x y = parallelLabel (parallelToList x ++ parallelToList y) serial1 = serialLabel parallel1 = parallelLabel serial = serialLabel parallel = parallelLabel switchList :: (label -> b -> c) -> (a -> b) -> ([T label control a] -> b) -> ([T label control a] -> b) -> (control -> T label control a -> b) -> (T label control a -> c) switchList lab f g h k (Cons l s) = lab l $ case s of Primitive x -> f x Serial m -> g m Parallel m -> h m Control c m -> k c m foldList :: (label -> b -> c) -> (a -> b) -> ([c] -> b) -> ([c] -> b) -> (control -> c -> b) -> (T label control a -> c) foldList lab f g h k = let recourse = foldList lab f g h k in switchList lab f (g . map recourse) (h . map recourse) (\c -> k c . recourse) fromControlledMediumList :: Label label => (a -> (label, b)) -> (control -> T label control b -> label) -> CtrlMediumList.T control a -> T label control b fromControlledMediumList f k = CtrlMedium.foldList ((\(lab,x) -> Cons lab (Primitive x)) . f) serialLabel parallelLabel (\c x -> Cons (k c x) (Control c x)) mapLabel :: (i -> j) -> (T i control a -> T j control a) mapLabel f = foldList (Cons . f) Primitive Serial Parallel Control instance Functor (T i control) where fmap f = foldList Cons (Primitive . f) Serial Parallel Control -- fmap = Traversable.fmapDefault instance Foldable (T i control) where foldMap = Traversable.foldMapDefault instance Traversable (T i control) where sequenceA = foldList (liftA . Cons) (liftA Primitive) (liftA Serial . sequenceA) (liftA Parallel . sequenceA) (liftA . Control) {- instance (Temporal.C a) => Temporal.C (T a) where dur = Medium.foldList Temporal.dur sum maximum0 none = Medium.prim . Temporal.none -} {- This behaves identical to Medium.Binary, if the top most constructor is no serial composition it returns a single element list. -} serialToList, parallelToList :: T label control a -> [T label control a] serialToList (Cons _ (Serial ns)) = ns serialToList n = [n] parallelToList (Cons _ (Parallel ns)) = ns parallelToList n = [n] haskore-0.2.0.3/src/Medium/Controlled/0000755000000000000000000000000011754016452015615 5ustar0000000000000000haskore-0.2.0.3/src/Medium/Controlled/ContextFreeGrammar.lhs0000644000000000000000000001176511754016452022074 0ustar0000000000000000 \subsection{Structure Analysis} This module contains a function which builds a hierarchical music object from a serial one. This is achieved by searching for long common infixes. A common infix is replaced by a single object at each occurence. This module proofs the sophistication of the separation between general arrangement of some objects as provided by the \module{Medium} and the special needs of music provided by the \module{Music}. It's possible to formulate these algorithms without the knowledge of Music and we can insert the type \code{Tag} to distinguish between media primitives and macro calls. The only drawback is that it is not possible to descend into controlled sub-structures, like Tempo and Trans. \begin{haskelllisting} > module Medium.Controlled.ContextFreeGrammar > (T, Tag(..), TagMedium, fromMedium, toMedium) where > import qualified Medium.Controlled.List as CtrlMediumList > import qualified Medium.Controlled as CtrlMedium > import Medium.Plain.ContextFreeGrammar > (Tag(..), joinTag, replaceInfix, > whileM, smallestCycle, maximumCommonInfixMulti) > import Medium (prim, serial1, parallel1) > import Data.Maybe (fromJust) > import qualified Haskore.General.Map as Map > import Control.Monad.Trans.State (state, execState) \end{haskelllisting} Condense all common infixes down to length 'thres'. The infixes are replaced by some marks using the constructor Left. They can be considered as macros or as non-terminals in a grammar. The normal primitives are preserved with constructor Right. We end up with a context-free grammar of the media. \begin{haskelllisting} > type TagMedium key control prim = CtrlMediumList.T control (Tag key prim) > type T key control prim = [(key, TagMedium key control prim)] > fromMedium :: (Ord key, Ord control, Ord prim) => > [key] -> Int -> CtrlMediumList.T control prim -> T key control prim > fromMedium (key:keys) thres m = > let action = whileM (>= thres) (map (state . condense) keys) > -- action = sequence (take 1 (map (state . condense) keys)) > in reverse $ execState action [(key, fmap Prim m)] > fromMedium _ _ _ = > error ("No key given."++ > " Please provide an infinite or at least huge number of macro names.") \end{haskelllisting} The inverse of \code{fromMedium}: Expand all macros. Cyclic macro references shouldn't be a problem if it is possible to resolve the dependencies. We manage the grammar in the dictionary \code{dict}. Now a naive way for expanding the macros is to recourse into each macro call manually using lookups to \code{dict}. This would imply that we need new memory for each expansion of the same macro. We have chosen a different approach: We map \code{dict} to a new dictionary \code{dict'} which contains the expanded versions of each Medium. For expansion we don't use repeated lookups to \code{dict} but we use only one lookup to \code{dict'} -- which contains the fully expanded version of the considered Medium. This method is rather the same as if you write Haskell values that invokes each other. The function \code{expand} computes the expansion for each key and the function \code{toMedium} computes the expansion of the first macro. Thus \code{toMedium} quite inverts \code{fromMedium}. \begin{haskelllisting} > toMedium :: (Show key, Ord key, Ord prim) => > T key control prim -> CtrlMediumList.T control prim > toMedium = snd . head . expand > expand :: (Show key, Ord key, Ord prim) => > T key control prim -> [(key, CtrlMediumList.T control prim)] > expand grammar = > let notFound key = error ("The non-terminal '" ++ show key ++ "' is unknown.") > dict = Map.fromList grammar > dict' = Map.map (CtrlMedium.foldList expandSub serial1 parallel1 > CtrlMedium.control) dict > expandSub (Prim p) = prim p > expandSub (Call key) = > Map.findWithDefault dict' (notFound key) key > expandSub (CallMulti n key) = > serial1 (replicate n (Map.findWithDefault dict' (notFound key) key)) > in map (fromJust . Map.lookup (Map.mapWithKey (,) dict') . fst) grammar \end{haskelllisting} Find the longest common infix over all parts of the music and replace it in all of them. \begin{haskelllisting} > condense :: (Ord key, Ord control, Ord prim) => > key > -> T key control prim > -> (Int, T key control prim) > condense key x = > let getSerials = CtrlMedium.switchList > (const []) > (\xs -> xs : concatMap getSerials xs) > (\xs -> concatMap getSerials xs) > (const getSerials) > infx = smallestCycle (maximumCommonInfixMulti length > (concatMap (getSerials . snd) x)) > absorbSingleton _ [m] = m > absorbSingleton collect ms = collect ms > replaceRec = CtrlMedium.foldList prim > (absorbSingleton serial1 . map joinTag . replaceInfix key infx) > (absorbSingleton parallel1) > (CtrlMedium.control) > in (length infx, (key, serial1 infx) : map (\(k, ms) -> (k, replaceRec ms)) x) \end{haskelllisting} haskore-0.2.0.3/src/Medium/Controlled/List.hs0000644000000000000000000000740611754016452017073 0ustar0000000000000000module Medium.Controlled.List where import qualified Medium.Controlled as CtrlMedium import qualified Medium.Plain.List as ListMedium import qualified Medium import qualified Medium.Temporal as Temporal import Haskore.General.Utility(maximum0) import Control.Applicative (liftA, ) import Data.Foldable (Foldable(foldMap)) import Data.Traversable (Traversable(sequenceA)) import qualified Data.Traversable as Traversable {- | Medium type with a controller constructor. -} data T control content = Primitive content -- ^ primitive content | Serial [T control content] -- ^ sequential composition | Parallel [T control content] -- ^ parallel composition | Control control (T control content) -- ^ controller deriving (Show, Eq, Ord {- for use in FiniteMap -}) instance Medium.Construct (T control) where prim = Primitive (+:+) x y = serial (serialToList x ++ serialToList y) (=:=) x y = parallel (parallelToList x ++ parallelToList y) serial = serial parallel = parallel serial1 = serial parallel1 = parallel instance CtrlMedium.C T where control = Control switchBinary f _ _ _ _ (Primitive x) = f x switchBinary _ g _ _ _ (Serial (m:ms)) = g m (Serial ms) switchBinary _ _ h _ _ (Parallel (m:ms)) = h m (Parallel ms) switchBinary _ _ _ k _ (Control c m) = k c m switchBinary _ _ _ _ z _ = z switchList f _ _ _ (Primitive x) = f x switchList _ g _ _ (Serial m) = g m switchList _ _ h _ (Parallel m) = h m switchList _ _ _ k (Control c m) = k c m instance Functor (T control) where fmap f = CtrlMedium.foldList (Primitive . f) Serial Parallel Control -- fmap = Traversable.fmapDefault instance Foldable (T control) where foldMap = Traversable.foldMapDefault instance Traversable (T control) where sequenceA = CtrlMedium.foldList (liftA Primitive) (liftA Serial . sequenceA) (liftA Parallel . sequenceA) (liftA . Control) instance (Temporal.C a, Temporal.Control control) => Temporal.C (T control a) where dur = CtrlMedium.foldList Temporal.dur sum maximum0 Temporal.controlDur none = Primitive . Temporal.none {- This behaves identical to Medium.Binary, if the top most constructor is no serial composition it returns a single element list. -} serialToList, parallelToList :: T control a -> [T control a] serialToList (Serial ns) = ns serialToList n = [n] parallelToList (Parallel ns) = ns parallelToList n = [n] prim :: a -> T control a prim = Primitive serial, parallel :: [T control a] -> T control a serial = Serial parallel = Parallel fromMedium :: (Medium.C src) => src a -> T control a fromMedium = Medium.foldList Primitive Serial Parallel toMediumList :: T control a -> ListMedium.T a toMediumList = CtrlMedium.foldList ListMedium.Primitive ListMedium.Serial ListMedium.Parallel (flip const) {- A variant of fmap that does not only allow manipulation of primitives but also of the compositions. Though the structure must be preserved. -} mapList :: (a -> b) -> ([T control b] -> [T control b]) -> ([T control b] -> [T control b]) -> (control -> T control b -> T control b) -> T control a -> T control b mapList f g h k = CtrlMedium.foldList (Primitive . f) (Serial . g) (Parallel . h) (\c -> Control c . k c) mapListFlat :: (a -> b) -> ([T control a] -> [T control b]) -> ([T control a] -> [T control b]) -> (control -> T control a -> T control b) -> T control a -> T control b mapListFlat f g h k = CtrlMedium.switchList (Primitive . f) (Serial . g) (Parallel . h) (\c -> Control c . k c) mapControl :: (c0 -> c1) -> T c0 a -> T c1 a mapControl f = CtrlMedium.foldList Primitive Serial Parallel (Control . f) haskore-0.2.0.3/src/Medium/Plain/0000755000000000000000000000000011754016452014553 5ustar0000000000000000haskore-0.2.0.3/src/Medium/Plain/Binary.hs0000644000000000000000000000370311754016452016336 0ustar0000000000000000module Medium.Plain.Binary where import Medium ((+:+), (=:=)) import qualified Medium import qualified Medium.Temporal as Temporal import Control.Applicative (liftA, liftA2, ) import Data.Foldable (Foldable(foldMap)) import Data.Traversable (Traversable(sequenceA)) import qualified Data.Traversable as Traversable infixr 7 :+: {- like multiplication -} infixr 6 :=: {- like addition -} data T a = Primitive a | T a :+: T a -- sequential composition | T a :=: T a -- parallel composition deriving (Show, Eq, Ord {- for use in FiniteMap -}) instance Medium.Construct T where prim = Primitive (+:+) = (:+:) (=:=) = (:=:) serial [] = Primitive (Temporal.none 0) serial m = foldr1 (+:+) m parallel [] = Primitive (Temporal.none 0) parallel m = foldr1 (=:=) m serial1 = foldr1 (+:+) parallel1 = foldr1 (=:=) instance Medium.C T where switchBinary f _ _ _ (Primitive x) = f x switchBinary _ g _ _ (m0:+:m1) = g m0 m1 switchBinary _ _ h _ (m0:=:m1) = h m0 m1 switchList f _ _ (Primitive x) = f x switchList _ g _ m@(_ :+: _) = g (serialS m []) switchList _ _ h m@(_ :=: _) = h (parallelS m []) errorNone :: a errorNone = error "Program bug: This data structure does not contain empty things." instance Functor T where fmap f = Medium.foldBin (Primitive . f) (:+:) (:=:) errorNone -- fmap = Traversable.fmapDefault instance Foldable T where foldMap = Traversable.foldMapDefault instance Traversable T where sequenceA = Medium.foldBin (liftA Primitive) (liftA2 (:+:)) (liftA2 (:=:)) errorNone instance Temporal.C a => Temporal.C (T a) where dur = Medium.foldBin Temporal.dur (+) max errorNone none = Medium.prim . Temporal.none serialS, parallelS :: T a -> [T a] -> [T a] serialS (m0 :+: m1) = serialS m0 . serialS m1 serialS m0 = (m0 :) parallelS (m0 :=: m1) = parallelS m0 . parallelS m1 parallelS m0 = (m0 :) haskore-0.2.0.3/src/Medium/Plain/ContextFreeGrammar.lhs0000644000000000000000000001777711754016452021043 0ustar0000000000000000 \subsection{Structure Analysis} This module contains a function which builds a hierarchical music object from a serial one. This is achieved by searching for long common infixes. A common infix is replaced by a single object at each occurence. This module proofs the sophistication of the separation between general arrangement of some objects as provided by the \module{Medium} and the special needs of music provided by the \module{Music}. It's possible to formulate these algorithms without the knowledge of Music and we can insert the type \code{Tag} to distinguish between media primitives and macro calls. The only drawback is that it is not possible to descend into controlled sub-structures, like Tempo and Trans. \begin{haskelllisting} > module Medium.Plain.ContextFreeGrammar where > import Data.List.HT (tails, mapAdjacent, ) > import Data.List (sort, isPrefixOf, findIndex, ) > import Data.Maybe (fromJust, ) > import qualified Haskore.General.Map as Map > import qualified Data.List.Key as Key > import Control.Monad.Trans.State (StateT, put, get, state, execState, ) > import Medium (prim, serial1, parallel1) > import qualified Medium > import qualified Medium.Plain.List as ListMedium \end{haskelllisting} Condense all common infixes down to length 'thres'. The infixes are replaced by some marks using the constructor Left. They can be considered as macros or as non-terminals in a grammar. The normal primitives are preserved with constructor Right. We end up with a context-free grammar of the media. \begin{haskelllisting} > data Tag key prim = > Prim prim > | Call key > | CallMulti Int key > deriving (Eq, Ord, Show) > type TagMedium key prim = ListMedium.T (Tag key prim) > -- True is for cyclic infixes > type T key prim = [(key, TagMedium key prim)] > fromMedium :: (Ord key, Ord prim) => > [key] -> Int -> ListMedium.T prim -> T key prim > fromMedium (key:keys) thres m = > let action = whileM (>= thres) (map (state . condense) keys) > -- action = sequence (take 1 (map (State . condense) keys)) > in reverse $ execState action [(key, fmap Prim m)] > fromMedium _ _ _ = > error ("No key given."++ > " Please provide an infinite or at least huge number of macro names.") \end{haskelllisting} The inverse of \code{fromMedium}: Expand all macros. Cyclic macro references shouldn't be a problem if it is possible to resolve the dependencies. We manage the grammar in the dictionary \code{dict}. Now a naive way for expanding the macros is to recourse into each macro call manually using lookups to \code{dict}. This would imply that we need new memory for each expansion of the same macro. We have chosen a different approach: We map \code{dict} to a new dictionary \code{dict'} which contains the expanded versions of each Medium. For expansion we don't use repeated lookups to \code{dict} but we use only one lookup to \code{dict'} -- which contains the fully expanded version of the considered Medium. This method is rather the same as if you write Haskell values that invokes each other. The function \code{expand} computes the expansion for each key and the function \code{toMedium} computes the expansion of the first macro. Thus \code{toMedium} quite inverts \code{fromMedium}. \begin{haskelllisting} > toMedium :: (Show key, Ord key, Ord prim) => > T key prim -> ListMedium.T prim > toMedium = snd . head . expand > expand :: (Show key, Ord key, Ord prim) => > T key prim -> [(key, ListMedium.T prim)] > expand grammar = > let notFound key = error ("The non-terminal '" ++ show key ++ "' is unknown.") > dict = Map.fromList grammar > dict' = Map.map (Medium.foldList expandSub serial1 parallel1) dict > expandSub (Prim p) = prim p > expandSub (Call key) = > Map.findWithDefault dict' (notFound key) key > expandSub (CallMulti n key) = > serial1 (replicate n (Map.findWithDefault dict' (notFound key) key)) > in map (fromJust . Map.lookup (Map.mapWithKey (,) dict') . fst) grammar \end{haskelllisting} Do monadic actions until the condition \code{p} fails. This is implemented for State Monads, because in plain Monads one could not reset the state and thus the state wouldn't be that after the last successful (with respect to the predicate \code{p}) action. \begin{haskelllisting} > whileM :: (Monad m) => (a -> Bool) -> [StateT s m a] -> StateT s m [a] > whileM _ [] = return [] > whileM p (m:ms) = > do s <- get > x <- m > if p x then whileM p ms >>= return . (x:) > else put s -- reset to the old state > >> return [] \end{haskelllisting} Find the longest common infix over all parts of the music and replace it in all of them. \begin{haskelllisting} > condense :: (Ord key, Ord prim) => > key > -> T key prim > -> (Int, T key prim) > condense key x = > let getSerials = Medium.switchList > (const []) > (\xs -> xs : concatMap getSerials xs) > (\xs -> concatMap getSerials xs) > infx = smallestCycle (maximumCommonInfixMulti length > (concatMap (getSerials . snd) x)) > absorbSingleton _ [m] = m > absorbSingleton collect ms = collect ms > replaceRec = Medium.foldList prim > (absorbSingleton serial1 . map joinTag . replaceInfix key infx) > (absorbSingleton parallel1) > in (length infx, (key, serial1 infx) : map (\(k, ms) -> (k, replaceRec ms)) x) > joinTag :: Medium.Construct medium => > Tag key (medium (Tag key prim)) -> medium (Tag key prim) > joinTag (Prim m) = m > joinTag (Call k) = prim (Call k) > joinTag (CallMulti n k) = prim (CallMulti n k) \end{haskelllisting} Replace all occurences of the infix by its key. Collect accumulated occurences in one \code{CallMulti}. \begin{haskelllisting} > replaceInfix :: (Eq a, Eq b) => > a > -> [b] > -> [b] > -> [Tag a b] > replaceInfix key infx sequ = > let recourse [] = [] > recourse xa@(x:xs) = > let pref = commonPrefix (cycle infx) xa > (num, r) = divMod (length pref) (length infx) > len = length pref - r > in if num == 0 > then Prim x : recourse xs > else ((if num == 1 then Call key else CallMulti num key) > : recourse (drop len xa)) > in recourse sequ \end{haskelllisting} A common infix indicates a loop if its occurences overlap. We can detect this by checking if there is a suffix of our list which is also a prefix of this list. \begin{haskelllisting} > isCyclic :: Eq a => [a] -> Bool > isCyclic x = any (flip isPrefixOf x) (init (tail (tails x))) \end{haskelllisting} Find the shortest list \code{y}, where \code{x} is a prefix of \code{cycle y}. If \code{x} has no loop, then \code{x == y}. \begin{haskelllisting} > smallestCycle :: Eq a => [a] -> [a] > smallestCycle x = > take (1 + fromJust (findIndex (flip isPrefixOf x) (tail (tails x)))) x \end{haskelllisting} Finding common infixes is a prominent application of suffix trees. But since I don't have an implementation of suffix trees I'll stick to a sorted list of suffices. \begin{haskelllisting} > maximumCommonInfix :: (Ord a, Ord b) => ([a] -> b) -> [a] -> [a] > maximumCommonInfix mag = > Key.maximum mag . > mapAdjacent commonPrefix . > sort . tails \end{haskelllisting} Find common infixes across multiple strings. This could be a nice application of generalized suffix trees. \begin{haskelllisting} > maximumCommonInfixMulti :: (Ord a, Ord b) => ([a] -> b) -> [[a]] -> [a] > maximumCommonInfixMulti mag = > Key.maximum mag . > mapAdjacent commonPrefix . > sort . concatMap tails \end{haskelllisting} Find the longest common prefix. (Two implementations that may be used for testing.) \begin{haskelllisting} > commonPrefix :: Eq a => [a] -> [a] -> [a] > commonPrefix xs ys = > map fst $ takeWhile (uncurry (==)) $ zip xs ys > commonPrefixRec :: Eq a => [a] -> [a] -> [a] > commonPrefixRec (x:xs) (y:ys) = > if x == y > then x : commonPrefix xs ys > else [] > commonPrefixRec _ _ = [] \end{haskelllisting} haskore-0.2.0.3/src/Medium/Plain/List.hs0000644000000000000000000000420211754016452016020 0ustar0000000000000000module Medium.Plain.List where import qualified Medium import qualified Medium.Temporal as Temporal import Haskore.General.Utility(maximum0) import Control.Applicative (liftA, ) import Data.Foldable (Foldable(foldMap)) import Data.Traversable (Traversable(sequenceA)) import qualified Data.Traversable as Traversable data T a = Primitive a | Serial [T a] -- sequential composition | Parallel [T a] -- parallel composition deriving (Show, Eq, Ord {- for use in FiniteMap -}) instance Medium.Construct T where prim = Primitive {- If the operands are also Serials or Parallels the lists are joined, since most times the operators are used to construct lists. This definition works also for infinite application of (+:+). -} (+:+) x y = Serial (serialToList x ++ serialToList y) (=:=) x y = Parallel (parallelToList x ++ parallelToList y) serial = Serial parallel = Parallel serial1 = Serial parallel1 = Parallel instance Medium.C T where switchBinary f _ _ _ (Primitive x) = f x switchBinary _ g _ _ (Serial (m:ms)) = g m (Serial ms) switchBinary _ _ h _ (Parallel (m:ms)) = h m (Parallel ms) switchBinary _ _ _ z _ = z switchList f _ _ (Primitive x) = f x switchList _ g _ (Serial m) = g m switchList _ _ h (Parallel m) = h m instance Functor T where fmap f = Medium.foldList (Primitive . f) Serial Parallel -- fmap = Traversable.fmapDefault instance Foldable T where foldMap = Traversable.foldMapDefault instance Traversable T where sequenceA = Medium.foldList (liftA Primitive) (liftA Serial . sequenceA) (liftA Parallel . sequenceA) instance (Temporal.C a) => Temporal.C (T a) where dur = Medium.foldList Temporal.dur sum maximum0 none = Medium.prim . Temporal.none {- This behaves identical to Medium.Plain.Binary, if the top most constructor is no serial composition it returns a single element list. -} serialToList, parallelToList :: T a -> [T a] serialToList (Serial ns) = ns serialToList n = [n] parallelToList (Parallel ns) = ns parallelToList n = [n]