Hiho

I just wrote a short recipe how to install haskore from source o the
wiki:

http://www.haskell.org/haskellwiki/Haskore#Getting_started

Could someone explain how to use it now?

I got so far that most of old TestHaskore resides in
Haskore.Interface.MIDI.Render now. But I am confused about what and how
to import to build a simple piece of music.

I attach my first steps with haskore. With the 2000 version of
Haskore I could simply

  ghci Harmonies.hs

(provided we are in the src-folder of Haskore, and Harmonies.hs lies
next to the other modules)

and then

  play $ scale $ alteriert (C,4)

How can I play that with the current darcs-version !?

Thanks, Sebastian.
module Harmonies where

import TestHaskore
import Basics

trans' :: Pitch -> Int -> Pitch
trans' p i = trans i p

struct :: [Int] -> Pitch -> [Pitch]
struct offsets base = map (trans' base) offsets

melody :: [Dur] -> [Pitch] -> Music
melody ds ps = line [ Note p d [] | (d,p) <- zip ds ps ]

-- example special melody
tusch = melody [en, sn, sn, en, qn, en, en] [(C,6), (G,5), (G,5), (Gs,5), (G,5), (B,5), (C,6)]

-- scales and some constant examples
scale :: [Pitch] -> Music
scale ps = melody (replicate (1 + 2 * length ps) en) (ps++[trans 12 (ps!!0)] ++(reverse ps))

major = [0,2,4,5,7,9,11] :: [Int]
minor = [0,2,3,5,7,8,10] :: [Int]
minorharm = [0,2,3,5,7,8,11] :: [Int]
minormajor = [0,2,3,5,7,9,11] :: [Int]
gtht = [0,2,3,5,6,8,9,11] ::[Int]
htgt = [0,1,3,4,6,7,9,10] :: [Int]

-- derived scales using rotate:
rotate :: [Pitch] -> [Pitch]
rotate as = map (trans (-12)) (drop n as) ++ take n as
            where n = length as -1

kirchentonart :: Int -> Pitch -> [Pitch]
kirchentonart 0 b = struct major b
kirchentonart n b = rotate $ kirchentonart (n-1) b

lokrisch :: Pitch -> [Pitch]
lokrisch p = map (trans (-11)) (kirchentonart 1 p)

aeolisch :: Pitch -> [Pitch]
aeolisch p = map (trans (-9)) (kirchentonart 2 p)

mixo :: Pitch -> [Pitch]
mixo p = map (trans (-7)) (kirchentonart 3 p)

lydisch :: Pitch -> [Pitch]
lydisch p = map (trans (-5)) (kirchentonart 4 p)

phrygisch :: Pitch -> [Pitch]
phrygisch p = map (trans (-4)) (kirchentonart 5 p)

dorian :: Pitch -> [Pitch]
dorian p = map (trans (-2)) (kirchentonart 6 p)

alteriert :: Pitch -> [Pitch]
alteriert p = rotate $ struct minormajor $ trans' p 1

_______________________________________________
haskell-art mailing list
haskell-art@lists.lurk.org
http://lists.lurk.org/mailman/listinfo/haskell-art

Reply via email to