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 (maxHeight-1) ) 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 _ = '*'