module Music.Instrument.Guitar where
import Music.Diatonic
import Music.Diatonic.Note
import Music.Diatonic.Degree
import Music.Diatonic.Chord
import Music.Diatonic.Scale
import Data.List
import Data.Maybe
import Data.Char
import Control.Monad
import qualified Data.Set
import qualified Data.Map
import Music.Instrument.Piano
import Music.Instrument.Common
import Debug.Trace
findPositionPatterns
allowOpens
newNoteable
tuning
maxHeight
utilizeAllStrings
rootNoteLowest
selectionMask
utilizeAllNotes
strictIntervals
=
case getChords newNoteable of
Nothing ->
map (\c ->
filter (not . null) $
findPositionPatterns'
allowOpens
c
tuning
maxHeight
utilizeAllStrings
rootNoteLowest
selectionMask
utilizeAllNotes
strictIntervals
) [newNoteable]
Just chords ->
map (\c ->
filter (not . null) $
findPositionPatterns'
allowOpens
c
tuning
maxHeight
utilizeAllStrings
rootNoteLowest
selectionMask
utilizeAllNotes
strictIntervals
) chords
findPositionPatterns'
allowOpens
chord
tuning
maxHeight
utilizeAllStrings
rootNoteLowest
selectionMask
utilizeAllNotes
strictIntervals
=
map
(\x ->
findPositionPatterns''
allowOpens
chord
tuning
x
maxHeight
utilizeAllStrings
rootNoteLowest
selectionMask
utilizeAllNotes
strictIntervals
)
[0..]
findPositionPatterns''
allowOpens
chord
tuning
from
maxHeight
utilizeAllStrings
rootNoteLowest
selectionMask
utilizeAllNotes
strictSteps
=
applyIf
allowOpens
(nub . (++) openPatterns)
patterns
where
patterns =
findPositionPatterns'''
False
chord
tuning
from
maxHeight
utilizeAllStrings
rootNoteLowest
selectionMask
utilizeAllNotes
strictSteps
openPatterns =
filter
(isOpened maxHeight)
(
findPositionPatterns'''
True
chord
tuning
from
maxHeight
utilizeAllStrings
rootNoteLowest
selectionMask
utilizeAllNotes
strictSteps
)
getPositionPatternSpannedFrets positionPattern maxHeight
= applyIf isOpened' (0:) ((uncurry enumFromTo) range)
where
range = if isOpened' then (getPositionPatternMin prunedPositionPattern,getPositionPatternMin prunedPositionPattern + maxHeight)
else (getPositionPatternMin positionPattern,getPositionPatternMin positionPattern + maxHeight)
isOpened' = isOpened maxHeight positionPattern
prunedPositionPattern = map (filter (not.(==0))) positionPattern
isOpened maxHeight positionPattern = (>maxHeight) . getPositionPatternHeight $ positionPattern
findPositionPatterns'''
includeOpens
chord
tuning
from
maxHeight
utilizeAllStrings
rootNoteLowest
selectionMask
utilizeAllNotes
strictIntervals
= sequencer $ findPositionPatterns'''' includeOpens chord tuning from maxHeight strictIntervals
where
sequencer | requiresSequence' chord
= (\v -> ( filter (not . null . concat)
. (\x -> filter (\a -> length (strip a) == maximum (map length (map strip x))) x)
. applyIf utilizeAllStrings (filter (\x -> length (concat x) == length tuning))
. applyIf (isSlash chord) (filter (\x -> (nub $ sort $ drop 1 (concat (zipWith (\ps t -> map (tuningAndPosToNote t) ps) x tuning))) == (nub $ sort $ drop 1 $ newNotes chord)))
. applyIf utilizeAllNotes (filter (\x -> (nub $ sort $ concat (zipWith (\ps t -> map (tuningAndPosToNote t) ps) x tuning)) == (nub $ sort (newNotes chord))))
. applyIf rootNoteLowest (filter (\x -> take 1 (concat (zipWith (\ps t -> map (tuningAndPosToNote t) ps) x tuning)) == take 1 (newNotes chord)))
. applyIf (not utilizeAllStrings && (not . null $ selectionMask)) (filter (\x ->
or (
map (\selectionMask'' ->
all (\(a,b) -> if a then b /= [] else b == []) (zip selectionMask'' x)
) selectionMask
)
))
. sequence
) v)
. addEmpties
. deepenListOfLists
| otherwise = (:[])
strip = filter (not . null)
findPositionPatterns''''
includeOpens
chord
tuning
from
maxHeight
strictIntervals
=
map
(\interval ->
filter
(
if strictIntervals
then positionInInterval chord interval
else positionInNoteable chord interval
)
(applyIf
includeOpens
(nub . (0:))
(frettedGuitarStringPostionLength from maxHeight)
)
)
(notesToSteps tuning)
positionInInterval
intervalable
stringInterval
pos
=
any
(==(pos + stringInterval))
(getSteps $ lastIntervals intervalable)
positionInNoteable
noteable
stringInterval
pos
=
any
(superEquiv note)
(newNotes noteable)
where
note =
tuningAndPosToNote
stringTuning
pos
stringTuning = stepToNote stringInterval
frettedGuitarStringPostionLength from maxHeight = [from..(from+maxHeight1)]
getPositionPatternRange = liftM2 (,) getPositionPatternMin getPositionPatternMax
getPositionMultiPatternRange = liftM2 (,) getPositionMultiPatternMin getPositionMultiPatternMax
getPositionMultiPatternHeight = uncurry subtract . getPositionMultiPatternRange
getPositionPatternHeight = uncurry subtract . getPositionPatternRange
getPositionPatternMin = minimum . concat
getPositionPatternMax = maximum . concat
getPositionMultiPatternMax = getPositionPatternMax . concat
getPositionMultiPatternMin = getPositionPatternMin . concat
getPositionMultiPatternMinAdjusted maxHeight = getPositionPatternMinAdjusted maxHeight . concat
getPositionPatternMinAdjusted maxHeight positionPattern =
if isOpened maxHeight positionPattern then head . drop 1 . nub . sort . concat $ positionPattern
else getPositionPatternMin positionPattern
lightChord = [
[False,False,True,True,True,True]
,[False,False,False,True,True,True]
]
powerChord = [
[True,True,True,False,False,False]
,[False,True,True,True,False,False]
]
dropD = [D,A,D,G,B,E]
ukelele = [C,E,G,A]
standardTuning = [E,A,D,G,B,E]
fifthChord n = [n , applyNTimes sharp 7 n]
sus2 chord = (x:canonize(flat(flat y)):xs)
where (x:y:xs) = newNotes chord
sus4 chord = (x:canonize(sharp y):xs)
where (x:y:xs) = newNotes chord
superEquiv a b = equiv a b || equiv b a