diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -127,7 +127,7 @@ getPageLines :: Integer -> Args -> Int getPageLines systemHeight args = let - pageHeight = 724 / 8.5 * 11 :: Double + pageHeight = sheetWidth / 8.5 * 11 :: Double defaultLines = round $ pageHeight / fromIntegral systemHeight in max 1 $ fromMaybe defaultLines $ pageLines args diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -6,6 +6,8 @@ It should go without saying, but please do not distribute content from songs you have purchased -- it is for your use only! +Download the latest Windows/Mac binaries from the [releases page](https://github.com/mtolly/jammittools/releases). + [Jammit]: https://www.jammit.com/ ## Usage diff --git a/jammittools.cabal b/jammittools.cabal --- a/jammittools.cabal +++ b/jammittools.cabal @@ -1,5 +1,5 @@ Name: jammittools -Version: 0.4.1.1 +Version: 0.5 Synopsis: Export sheet music and audio from Windows/Mac app Jammit Description: @@ -30,10 +30,12 @@ Sound.Jammit.Internal.Audio Sound.Jammit.Internal.Image Sound.Jammit.Internal.TempIO + Sound.Jammit.Internal.PropertyList hs-source-dirs: src build-depends: base >= 4.6.0.1 && < 5 - , property-list >= 0.1.0.4 && < 0.2 + , xml >= 1.3.14 && < 1.4 + , text >= 1.2.1.1 && < 1.3 , directory >= 1.2.0.1 && < 1.3 , filepath >= 1.3.0.1 && < 1.5 , containers >= 0.5.0.0 && < 0.6 @@ -59,7 +61,7 @@ , directory >= 1.2.0.1 && < 1.3 , filepath >= 1.3.0.1 && < 1.5 , boxes >= 0.1.3 && < 0.2 - , jammittools == 0.4.1.1 + , jammittools == 0.5 ghc-options: -Wall -O2 source-repository head diff --git a/src/Sound/Jammit/Base.hs b/src/Sound/Jammit/Base.hs --- a/src/Sound/Jammit/Base.hs +++ b/src/Sound/Jammit/Base.hs @@ -2,6 +2,7 @@ Basic types and functions for dealing with Jammit song packages. -} {-# LANGUAGE CPP #-} +{-# LANGUAGE RecordWildCards #-} module Sound.Jammit.Base ( Instrument(..) , Part(..) @@ -11,44 +12,49 @@ , titleToAudioPart , partToInstrument , audioPartToInstrument -, Info(..) -, Track(..) -, loadInfo -, loadTracks +, Info(..), loadInfo +, Track(..), loadTracks +, SkillLevel(..) , findJammitDir , songSubdirs +, Beat(..), loadBeats, loadGhost +, Section(..), loadSections +, findNotation, findTab, findAudio +, sheetWidth, sheetHeight ) where #if !MIN_VERSION_base(4,8,0) -import Control.Applicative ((<$>), (<*>)) +import Control.Applicative ((<$>)) #endif -import Control.Applicative (liftA2) -import Control.Arrow ((***)) -import Control.Exception (evaluate) -import Control.Monad (filterM, guard) -import Data.Char (toLower, toUpper) -import Data.Maybe (catMaybes) +import Control.Applicative ((<|>)) +import Control.Monad (filterM, guard, forM) +import Data.Char (toLower) import System.Environment (lookupEnv) -import Text.Read (readMaybe) - import qualified Data.Map as Map -import qualified Data.PropertyList as PL import qualified System.Directory as Dir import System.FilePath (()) import qualified System.Info as Info --- | The Enum instance corresponds to the number used in the "instrument" --- property, and the names (used by Show/Read) are capitalized versions of those --- used in the "skillLevel" property. +import Sound.Jammit.Internal.PropertyList + +-- | The 'Enum' instance corresponds to the number used in the 'instrument' +-- property, and the names (used by 'Show' and 'Read') are capitalized versions +-- of those used in the 'skillLevel' property. data Instrument = Guitar | Bass | Drums | Keyboard | Vocal deriving (Eq, Ord, Show, Read, Enum, Bounded) +-- | Used for both the "instrument" and "skillLevel" properties. +instance PropertyListItem Instrument where + fromPropertyList pl = plistToEnum pl <|> do + str <- fromPropertyList pl + lookup str [ (map toLower $ show inst, inst) | inst <- [minBound .. maxBound] ] + data Part = PartGuitar1 -- ^ Used for both Guitar and Guitar 1 | PartGuitar2 | PartBass | PartDrums1 -- ^ Used for both Drums and Drums 1 - | PartDrums2 -- ^ Rarely used. Seen in \"Space Truckin'\" + | PartDrums2 -- ^ Rarely used. Seen in \"Space Truckin\'\" | PartKeys1 -- ^ Used for both Keys and Keys 1 | PartKeys2 | PartPiano -- ^ Rarely used. Seen in \"The Answer Lies Within\" and \"Wait for Sleep\" @@ -59,13 +65,13 @@ deriving (Eq, Ord, Show, Read, Enum, Bounded) data AudioPart - = Only Part -- ^ An audio file for a single notated part. + = Only Part -- ^ An audio file for a single notated part. | Without Instrument -- ^ The backing track for an instrument package. deriving (Eq, Ord, Show, Read) data SheetPart = Notation Part -- ^ For any instrument, the notation sheet music. - | Tab Part -- ^ For guitar and bass, the tablature sheet music. + | Tab Part -- ^ For guitar and bass, the tablature sheet music. deriving (Eq, Ord, Show, Read) titleToPart :: String -> Maybe Part @@ -110,6 +116,22 @@ audioPartToInstrument (Only p) = partToInstrument p audioPartToInstrument (Without i) = i +data SkillLevel + = OneSkill Integer + | ManySkills [(Instrument, Integer)] + deriving (Eq, Ord, Show, Read) + +-- | Can be an integer, or a dict of instrument names to integers. +instance PropertyListItem SkillLevel where + fromPropertyList pl + = do + OneSkill <$> fromPropertyList pl + <|> do + dict <- fromPropertyList pl + fmap ManySkills $ forM (Map.toList dict) $ \(k, v) -> do + inst <- fromPropertyList $ String k + return (inst, v) + data Info = Info { album :: String , artist :: String @@ -122,7 +144,7 @@ , genre :: String , instrument :: Instrument , publishedBy :: String - , skillLevel :: Either Integer [(Instrument, Integer)] + , skillLevel :: SkillLevel , sku :: String , slow :: Double , title :: String @@ -130,73 +152,30 @@ , writtenBy :: String } deriving (Eq, Ord, Show, Read) -instance PL.PropertyListItem Info where - - fromPropertyList pl = PL.fromPlDict pl >>= \dict -> Info - <$> (Map.lookup "album" dict >>= PL.fromPlString) - <*> (Map.lookup "artist" dict >>= PL.fromPlString) - <*> (Map.lookup "bpm" dict >>= PL.fromPlString) - <*> (Map.lookup "copyright" dict >>= PL.fromPlString) - <*> (Map.lookup "countInBeats" dict >>= PL.fromPlInt ) - <*> (Map.lookup "courtesyOf" dict >>= PL.fromPlString) - <*> (Map.lookup "demo" dict >>= fromPlEnum ) - <*> (Map.lookup "explicit" dict >>= fromPlEnum ) - <*> (Map.lookup "genre" dict >>= PL.fromPlString) - <*> (Map.lookup "instrument" dict >>= fromPlEnum ) - <*> (Map.lookup "publishedBy" dict >>= PL.fromPlString) - <*> (Map.lookup "skillLevel" dict >>= fromPlSkills) - <*> (Map.lookup "sku" dict >>= PL.fromPlString) - <*> (Map.lookup "slow" dict >>= PL.fromPlReal ) - <*> (Map.lookup "title" dict >>= PL.fromPlString) - <*> (Map.lookup "version" dict >>= PL.fromPlInt ) - <*> (Map.lookup "writtenBy" dict >>= PL.fromPlString) - - toPropertyList info = PL.plDict $ Map.fromList - [ ("album" , PL.plString $ album info) - , ("artist" , PL.plString $ artist info) - , ("bpm" , PL.plString $ bpm info) - , ("copyright" , PL.plString $ copyright info) - , ("countInBeats", PL.plInt $ countInBeats info) - , ("courtesyOf" , PL.plString $ courtesyOf info) - , ("demo" , plEnum $ demo info) - , ("explicit" , plEnum $ explicit info) - , ("genre" , PL.plString $ genre info) - , ("instrument" , plEnum $ instrument info) - , ("publishedBy" , PL.plString $ publishedBy info) - , ("skillLevel" , plSkills $ skillLevel info) - , ("sku" , PL.plString $ sku info) - , ("slow" , PL.plReal $ slow info) - , ("title" , PL.plString $ title info) - , ("version" , PL.plInt $ version info) - , ("writtenBy" , PL.plString $ writtenBy info) - ] - -fromPlEnum :: (Enum a) => PL.PropertyList -> Maybe a -fromPlEnum pl = toEnum . fromIntegral <$> PL.fromPlInt pl - -plEnum :: (Enum a) => a -> PL.PropertyList -plEnum = PL.plInt . fromIntegral . fromEnum - -fromPlSkills - :: PL.PropertyList -> Maybe (Either Integer [(Instrument, Integer)]) -fromPlSkills pl = case (PL.fromPlInt pl, PL.fromPlDict pl) of - (Nothing, Nothing) -> Nothing - (Just i , _ ) -> Just $ Left i - (_ , Just d ) -> let - getSkill :: (String, PL.PropertyList) -> Maybe (Instrument, Integer) - getSkill (x, y) = liftA2 (,) (readMaybe $ capitalize x) (PL.fromPlInt y) - capitalize "" = "" - capitalize (c:cs) = toUpper c : map toLower cs - in fmap Right $ mapM getSkill $ Map.toList d - -plSkills :: Either Integer [(Instrument, Integer)] -> PL.PropertyList -plSkills (Left i ) = PL.plInt i -plSkills (Right sl) = PL.plDict $ - Map.fromList $ map (map toLower . show *** PL.plInt) sl +instance PropertyListItem Info where + fromPropertyList pl = do + dict <- fromPropertyList pl + album <- fromLookup "album" dict + artist <- fromLookup "artist" dict + bpm <- fromLookup "bpm" dict + copyright <- fromLookup "copyright" dict + countInBeats <- fromLookup "countInBeats" dict + courtesyOf <- fromLookup "courtesyOf" dict + demo <- fromLookup "demo" dict + explicit <- fromLookup "explicit" dict + genre <- fromLookup "genre" dict + instrument <- fromLookup "instrument" dict + publishedBy <- fromLookup "publishedBy" dict + skillLevel <- fromLookup "skillLevel" dict + sku <- fromLookup "sku" dict + slow <- fromLookup "slow" dict + title <- fromLookup "title" dict + version <- fromLookup "version" dict + writtenBy <- fromLookup "writtenBy" dict + return Info{..} loadInfo :: FilePath -> IO (Maybe Info) -loadInfo dir = - PL.fromPropertyList <$> readXmlPropertyListFromFile' (dir "info.plist") +loadInfo dir = fromPropertyList <$> readPropertyList (dir "info.plist") data Track = Track { trackClass :: String @@ -206,33 +185,18 @@ , trackTitle :: Maybe String } deriving (Eq, Ord, Show, Read) -instance PL.PropertyListItem Track where - - toPropertyList t = PL.plDict $ Map.fromList $ catMaybes - [ Just ("class" , PL.plString $ trackClass t) - , Just ("identifier" , PL.plString $ identifier t) - , (\i -> ("scoreSystemHeight" , PL.plInt i)) <$> scoreSystemHeight t - , (\i -> ("scoreSystemInterval", PL.plInt i)) <$> scoreSystemInterval t - , (\s -> ("title" , PL.plString s)) <$> trackTitle t - ] - - fromPropertyList pl = PL.fromPlDict pl >>= \d -> Track - <$> (Map.lookup "class" d >>= PL.fromPlString) - <*> (Map.lookup "identifier" d >>= PL.fromPlString) - <*> Just (Map.lookup "scoreSystemHeight" d >>= PL.fromPlInt ) - <*> Just (Map.lookup "scoreSystemInterval" d >>= PL.fromPlInt ) - <*> Just (Map.lookup "title" d >>= PL.fromPlString) +instance PropertyListItem Track where + fromPropertyList pl = do + dict <- fromPropertyList pl + trackClass <- fromLookup "class" dict + identifier <- fromLookup "identifier" dict + let scoreSystemHeight = fromLookup "scoreSystemHeight" dict + scoreSystemInterval = fromLookup "scoreSystemInterval" dict + trackTitle = fromLookup "title" dict + return Track{..} loadTracks :: FilePath -> IO (Maybe [Track]) -loadTracks dir = PL.listFromPropertyList <$> - readXmlPropertyListFromFile' (dir "tracks.plist") - --- | Reads strictly so as not to exhaust our allowed open files. -readXmlPropertyListFromFile' :: FilePath -> IO PL.PropertyList -readXmlPropertyListFromFile' f = do - str <- readFile f - _ <- evaluate $ length str - either fail return $ PL.readXmlPropertyList str +loadTracks dir = fromPropertyList <$> readPropertyList (dir "tracks.plist") -- | Tries to find the top-level Jammit library directory on Windows or -- Mac OS X. @@ -266,3 +230,82 @@ let here = [dir | isSong] subdirs <- lsAbsolute dir >>= filterM Dir.doesDirectoryExist (here ++) . concat <$> mapM songSubdirs subdirs + +data Beat = Beat + { isDownbeat :: Bool + , isGhostBeat :: Bool + , position :: Double + } deriving (Eq, Ord, Show, Read) + +instance PropertyListItem Beat where + fromPropertyList pl = do + dict <- fromPropertyList pl + isDownbeat <- fromLookup "isDownbeat" dict + isGhostBeat <- fromLookup "isGhostBeat" dict + position <- fromLookup "position" dict + return Beat{..} + +loadBeats :: FilePath -> IO (Maybe [Beat]) +loadBeats dir = fromPropertyList <$> readPropertyList (dir "beats.plist") + +loadGhost :: FilePath -> IO (Maybe [Beat]) +loadGhost dir = fromPropertyList <$> readPropertyList (dir "ghost.plist") + +data Section = Section + { sectionBeat :: Integer + , sectionNumber :: Integer + , sectionType :: Integer + } deriving (Eq, Ord, Show, Read) + +instance PropertyListItem Section where + fromPropertyList pl = do + dict <- fromPropertyList pl + sectionBeat <- fromLookup "beat" dict + sectionNumber <- fromLookup "number" dict + sectionType <- fromLookup "type" dict + return Section{..} + +loadSections :: FilePath -> IO (Maybe [Section]) +loadSections dir = fromPropertyList <$> readPropertyList (dir "sections.plist") + +{- +Known section types +=== in Erotomania === +0 pre-song +1 intro +2 verse +4 chorus +7 outro +9 post-song +13 b-section +17 interlude +23 c-section +25 guitar solo +36 transition +-} + +findImages :: String -> Track -> FilePath -> IO [FilePath] +findImages suffix trk dir = do + files <- Dir.getDirectoryContents dir + let image i = identifier trk ++ "_" ++ suffix ++ "_" ++ showTwo i + showTwo i = if i < 10 then '0' : show i else show i + return + [ dir file + | file <- map image ([0..99] :: [Int]) + , file `elem` files + ] + +findNotation, findTab :: Track -> FilePath -> IO [FilePath] +findNotation = findImages "jcfn" +findTab = findImages "jcft" + +findAudio :: Track -> FilePath -> IO (Maybe FilePath) +findAudio trk dir = let + file = dir identifier trk ++ "_jcfx" + in do + b <- Dir.doesFileExist file + return $ guard b >> Just file + +sheetWidth, sheetHeight :: (Num a) => a +sheetWidth = 724 +sheetHeight = 1024 diff --git a/src/Sound/Jammit/Internal/Image.hs b/src/Sound/Jammit/Internal/Image.hs --- a/src/Sound/Jammit/Internal/Image.hs +++ b/src/Sound/Jammit/Internal/Image.hs @@ -90,12 +90,21 @@ else go is x $ y - P.imageHeight i vertSplit :: Int -> P.Image P.PixelRGBA8 -> [P.Image P.PixelRGBA8] -vertSplit h img = map f $ takeWhile (< P.imageHeight img) [0, h ..] where - f yoff = P.generateImage - (g yoff) - (P.imageWidth img) - (min h $ P.imageHeight img - yoff) - g yoff x y = P.pixelAt img x $ y + yoff +vertSplit h img = if P.imageHeight img <= h + then [img] + else let + chunkSize = P.pixelBaseIndex img 0 h + first = P.Image + { P.imageWidth = P.imageWidth img + , P.imageHeight = h + , P.imageData = V.take chunkSize $ P.imageData img + } + rest = P.Image + { P.imageWidth = P.imageWidth img + , P.imageHeight = P.imageHeight img - h + , P.imageData = V.drop chunkSize $ P.imageData img + } + in first : vertSplit h rest imagePage :: PDF.JpegFile -> PDF.PDF () imagePage jpeg = do diff --git a/src/Sound/Jammit/Internal/PropertyList.hs b/src/Sound/Jammit/Internal/PropertyList.hs new file mode 100644 --- /dev/null +++ b/src/Sound/Jammit/Internal/PropertyList.hs @@ -0,0 +1,136 @@ +-- | A very simple, non-robust property list parser. +{-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE FlexibleInstances #-} +module Sound.Jammit.Internal.PropertyList +( readPropertyList +, PropertyList(..) +, PropertyListItem(..) +, plistToEnum +, fromLookup +) where + +import qualified Data.Text.IO as TIO +import Text.XML.Light +import qualified Data.Map as Map +import Text.Read (readMaybe) +import Data.Maybe (mapMaybe, fromJust) +import Data.Char (isSpace) +import Control.Monad (guard) + +#if !MIN_VERSION_base(4,8,0) +import Prelude hiding (mapM) +import Data.Traversable (mapM) +import Control.Applicative ((<$>)) +#endif + +data PropertyList + = String String + | Real Double + | Integer Integer + | Bool Bool + | Array [PropertyList] + | Dict (Map.Map String PropertyList) + -- not supported: date or data + deriving (Eq, Ord, Show, Read) + +asParent :: Element -> (String, [Element]) +asParent Element{ elName = QName{..}, .. } = (qName, getElements elContent) + +getElements :: [Content] -> [Element] +getElements = mapMaybe $ \case + Elem e -> Just e + _ -> Nothing + +asChild :: Element -> Maybe (String, String) +asChild Element{ elName = QName{..}, .. } = case elContent of + [Text CData{..}] -> Just (qName, cdData) + _ -> Nothing + +plist :: Element -> Maybe PropertyList +plist e = case asParent e of + ("plist", [x]) -> value x + _ -> Nothing + +value :: Element -> Maybe PropertyList +value e = case asParent e of + ("array", elts) -> Array <$> mapM value elts + ("dict" , elts) -> Dict . Map.fromList <$> go elts where + go (x : y : xs) = do + ("key", k) <- asChild x + v <- value y + ((k, v) :) <$> go xs + go [] = Just [] + go _ = Nothing + ("true" , []) -> Just $ Bool True + ("false", []) -> Just $ Bool False + _ -> asChild e >>= \case + ("string" , s) -> Just $ String $ trim s + ("real" , s) -> Real <$> readMaybe s + ("integer", s) -> Integer <$> readMaybe s + _ -> Nothing + where trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace + +-- | Reads strictly so as not to exhaust our allowed open files. +readPropertyList :: FilePath -> IO PropertyList +readPropertyList f = do + txt <- TIO.readFile f + case parseXMLDoc txt >>= plist of + Nothing -> error $ + "readPropertyList: failed to read property list from " ++ f + Just pl -> return pl + +-- | Only covers parsing values from property lists. +class PropertyListItem a where + fromPropertyList :: PropertyList -> Maybe a + listFromPropertyList :: PropertyList -> Maybe [a] + listFromPropertyList (Array xs) = mapM fromPropertyList xs + listFromPropertyList _ = Nothing + +instance PropertyListItem PropertyList where + fromPropertyList = Just + +instance PropertyListItem Char where + fromPropertyList (String [c]) = Just c + fromPropertyList _ = Nothing + listFromPropertyList (String s) = Just s + listFromPropertyList _ = Nothing + +instance (PropertyListItem a) => PropertyListItem [a] where + fromPropertyList = listFromPropertyList + +instance PropertyListItem Int where + fromPropertyList (Integer i) = Just $ fromIntegral i + fromPropertyList _ = Nothing + +instance PropertyListItem Integer where + fromPropertyList (Integer i) = Just i + fromPropertyList _ = Nothing + +instance PropertyListItem Double where + fromPropertyList (Real d) = Just d + fromPropertyList _ = Nothing + +instance (PropertyListItem a) => PropertyListItem (Map.Map String a) where + fromPropertyList (Dict d) = mapM fromPropertyList d + fromPropertyList _ = Nothing + +instance PropertyListItem Bool where + fromPropertyList (Bool b) = Just b + fromPropertyList (Integer 0) = Just False + fromPropertyList (Integer 1) = Just True + fromPropertyList _ = Nothing + +plistToEnum :: (Enum a, Bounded a) => PropertyList -> Maybe a +plistToEnum pl = let + minval = fromEnum $ minBound `asTypeOf` fromJust result + maxval = fromEnum $ maxBound `asTypeOf` fromJust result + result = do + n <- fromPropertyList pl + guard $ minval <= n && n <= maxval + return $ toEnum n + in result + +fromLookup :: (PropertyListItem a) => String -> Map.Map String PropertyList -> Maybe a +fromLookup s dict = Map.lookup s dict >>= fromPropertyList