module Music.Instrument.GuitarRender 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 Debug.Trace
import Music.Instrument.Guitar (
findPositionPatterns
,getPositionMultiPatternMin
,getPositionPatternMinAdjusted
,getPositionPatternHeight
,getPositionPatternSpannedFrets
)
import Music.Instrument.Piano
import Music.Instrument.Common (
ControlAnnotation (..)
,tuningAndPosToNote
,abbreviateNote
,horizontalConcat
,applyIf
,insertAt
,NewNotes
)
maxFretHeight = 30
renderGuitarConcept
:: NewNotes a
=> Bool
-> ControlAnnotation
-> Bool
-> Bool
-> Bool
-> [Note]
-> a
-> Int
-> Int
-> Bool
-> Bool
-> [[Bool]]
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> [[String]]
renderGuitarConcept
allowOpens
controlAnnotation
annotateFrets
firstTuningLast
orientationVertical
tuning
chord
maxHeight
from
utilizeAllStrings
rootNoteLowest
selectionMask
renderAllFrets
renderPressedFrets
utilizeAllNotes
strictSteps
annotateChord
=
map head
$ map (
renderGuitarChord'
renderAllFrets
renderPressedFrets
controlAnnotation
annotateFrets
firstTuningLast
orientationVertical
tuning
maxHeight
from
annotateChord
)
positionPatternProgressions
where
positionPatternProgressions =
map (take maxFretHeight)
$ findPositionPatterns
allowOpens
chord
tuning
maxHeight
utilizeAllStrings
rootNoteLowest
selectionMask
utilizeAllNotes
strictSteps
renderGuitarChord'
renderAllFrets
renderPressedFrets
controlAnnotation
annotateFrets
firstTuningLast
orientationVertical
tuning
maxHeight
from
annotateChord
positionPatternsProgressions
=
drop from
$ map (renderGuitarChord''
renderAllFrets
renderPressedFrets
controlAnnotation
annotateFrets
firstTuningLast
orientationVertical
tuning
maxHeight
annotateChord
)
positionPatternsProgressions
renderGuitarChord''
renderAllFrets
renderPressedFrets
controlAnnotation
annotateFrets
firstTuningLast
orientationVertical
tuning
maxHeight
annotateChord
positionPatterns
= renderPositionPatternsRange
renderAllFrets
renderPressedFrets
annotateFrets
firstTuningLast
orientationVertical
controlAnnotation
tuning
maxHeight
positionPatterns
annotateChord
renderPositionPatternsRange
renderAllFrets
renderPressedFrets
annotateFrets
firstTuningLast
orientationVertical
controlAnnotation
tuning
maxHeight
positionPatterns'
annotateChord
=
map (renderPositionPattern
renderAllFrets
renderPressedFrets
annotateFrets
firstTuningLast
orientationVertical
controlAnnotation
tuning
minPosition
(maxHeight1)
)
positionPatterns'
where
minPosition = getPositionMultiPatternMin positionPatterns'
renderPositionPattern
renderAllFrets
renderPressedFrets
annotateFrets
firstTuningLast
orientationVertical
controlAnnotation
tuning
from
maxHeight
positionPattern
=
applyIf (minPositionAdjusted /= 0 && not renderAllFrets) ((++) ("Fret: " ++ show minPositionAdjusted ++ "\n"))
$ unlines
$ renderPositionPattern'
renderAllFrets
renderPressedFrets
annotateFrets
firstTuningLast
orientationVertical
controlAnnotation
tuning
from
maxHeight
positionPattern
where
minPositionAdjusted = getPositionPatternMinAdjusted maxHeight positionPattern
renderPositionPattern'
renderAllFrets
renderPressedFrets
annotateFrets
firstTuningLast
orientationVertical
controlAnnotation
tuning
from
maxHeight
positionPattern
=
applyIf orientationVertical (map reverse . Data.List.transpose) guitarStringTexts'
where
guitarStringTexts' = applyIf annotateFrets (++ (Data.List.transpose fretAnnotations)) guitarStringTexts''
fretAnnotations = map (overlayStringRight fretAnnotationPadding) fretAnnotations'
guitarStringTexts'' =
map (\(pos,stringIndex) ->
renderGuitarString
renderAllFrets
renderPressedFrets
(if firstTuningLast then stringIndex else compliment (length tuning) stringIndex)
orientationVertical
controlAnnotation
from
pos
(tuning'!!stringIndex)
positionPatternSpannedFrets
)
(zip (reverse positionPattern) stringIndicies)
overlayStringRight x y = map last $ Data.List.transpose [x,y]
fretAnnotationPadding = take maximumFretAnnotationLength (repeat ' ')
maximumFretAnnotationLength = maximum . map length $ fretAnnotations'
fretAnnotations' = concat $ intersperse [" "] $ map (map show) $ (consec positionPatternSpannedFrets)
stringIndicies = [0..]
guitarStringCount = length positionPattern
positionPatternSpannedFrets = if renderAllFrets then [0..maximum positionPatternSpannedFrets']
else positionPatternSpannedFrets'
positionPatternSpannedFrets' = getPositionPatternSpannedFrets positionPattern maxHeight
tuning' = reverse tuning
consec (x:xs) = consec' [x] xs
consec [] = []
consec' buf@(_:_) (x:xs) = if x last buf == 1 then consec' (buf++[x]) xs
else buf : consec' [x] (xs)
consec' buf [] = [buf]
firstGap [] = Nothing
firstGap xs = listToMaybe (take 1 $ map fst $ dropWhile (uncurry (==)) $ zip [head xs..] xs)
compliment m n = m n
renderGuitarString
renderAllFrets
renderPressedFrets
stringIndex
orientationVertical
controlAnnotation
from
positionIndices
stringTuning
positionPatternSpannedFrets
=
applyIf (not (positionPatternsGap == Nothing)) (addGap positionPatternsGap)
$ map (char stringIndex orientationVertical stringTuning positionIndices controlAnnotation)
(applyIf renderPressedFrets (filter (\i -> i `elem` positionIndices)) positionPatternSpannedFrets)
where
positionPatternsGap = firstGap positionPatternSpannedFrets
addGap (Just n) str = insertAt n (gapChar orientationVertical) str
gapChar orientationVertical | orientationVertical = '^'
| otherwise = 'S'
char stringIndex orientationVertical stringTuning positionIndices controlAnnotation index
| index `elem` positionIndices = fingeringChar stringIndex stringTuning index controlAnnotation
| otherwise = fretChar orientationVertical index
fingeringChar stringIndex stringTuning positionIndex controlAnnotation =
case controlAnnotation of
AnnotateNote -> abbreviateNote $ tuningAndPosToNote stringTuning positionIndex
AnnotateMarking -> fingeringCharUnannotated positionIndex
AnnotatePositionVertical -> head (show positionIndex)
AnnotatePositionHorizontal -> head (show stringIndex)
fretChar orientationVertical 0 | orientationVertical = '='
| otherwise = '|'
fretChar orientationVertical _ | orientationVertical = '-'
| otherwise = '-'
fingeringCharUnannotated 0 = 'o'
fingeringCharUnannotated _ = '*'