module Haskore.Interface.MED.Text where
import qualified Haskore.Basic.Pitch as Pitch
import qualified Haskore.Music as Music
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, )
sieve :: Int -> [a] -> [a]
sieve k = map head . takeWhile (not . null) . iterate (drop k)
sliceHoriz :: Int -> [a] -> [[a]]
sliceHoriz n =
map (sieve n) . take n . iterate (drop 1)
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)
linesToNotes ::
[String]
-> [([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)