module Main where import qualified Hmpf.Monitor as M import Hmpf.ApplicationTypes import Hmpf.LCDProc import Hmpf.Control import Hmpf.Tree import Hmpf.MPDSession import Hmpf.LIRC import Hmpf.Keys import Hmpf.AudioScrobbler import Hmpf.Util (pick) import Hmpf.RelatedArtist import Hmpf.Config ----------------- import Control.Concurrent.MVar import Control.Concurrent import Data.List -- ( elemIndex ) import Data.Char ( toLower ) import Data.Time import System.IO import Control.Exception ( finally ) import qualified Control.Monad.State as S main :: IO () main = do hSetBuffering stdin NoBuffering hSetBuffering stdout NoBuffering runSession programme programme = do load "" Hmpf.LIRC.clear sm <- lower songMonitor scrm <- lower scrobblermonitor gen <- lower generation lc <- lower loadCache lift ( forkIO lc ) -- start thread to load cache lift ( forkIO (finally sm (putStrLn "Song monitor has failed"))) -- start thread to update play screen lift ( forkIO scrm ) -- start thread to send songs to Last.fm lift ( forkIO gen ) -- start thread to add auto-generated songs input input :: Session () input = do showMusic k <- lirc case k of TaskSwitcher -> randomAlbum Eject -> do b <- toggleAutogeneration let sw = ( toEnum . fromEnum $ b ) :: Switch alert "Auto-generated" ( "playlist :" ++ (show sw) ) Play -> play>>return() Stop -> stop>>return() Pause -> pause>>return() Timer -> sleep NextChapter -> nextSong >> return() PrevChapter -> previousSong >> return() FastForward -> fastforward >> return() Rewind -> rewind >> return() VolUp -> vol 10 >>= percent "Vol" >> return() VolDown -> vol (-10) >>= percent "Vol" >> return() Purple -> updatedb >> alert "Updating the" "music database" Enter -> selectFromPlaylist >> return () Red -> do alb <- selectAlbumByTrack case alb of Nothing-> return () Just alb' -> playAlbum alb' AppLauncher -> do alb <- selectAlbum case alb of Nothing -> return () Just alb' -> playAlbum alb' MultiMon -> do a <- selectArtist -- choose the artist case a of Nothing -> return () Just a' -> do alb <- selectAlbumByArtist a' -- choose the album maybe (return ()) playAlbum alb -- play the album _ -> return () input runSession :: Session a -> IO a runSession fn = do mv <- empty S.runStateT ( initialize >> M.initialize >> fn >>= closeSession ) mv >>= ( return . fst ) --Select an artist selectArtist :: Session (Maybe String) selectArtist = do as <- artists let ls = map (map toLower) $ as l <- selector ls -- Use the Maybe monad here just to be funky return ( do x <- l i <- elemIndex x ls return ( as !! i ) ) --Select an album selectAlbum :: Session (Maybe String) selectAlbum = do as <- albums let ls = map (map toLower) $ as l <- selector ls -- Use the Maybe monad here just to be funky return ( do x <- l i <- elemIndex x ls return ( as !! i ) ) --Select an album by artist selectAlbumByArtist :: String -> Session (Maybe String) selectAlbumByArtist artist = do as <- albumByArtist artist let ls = map (map toLower) $ as l <- selector ls -- Use the Maybe monad here just to be funky return ( do x <- l i <- elemIndex x ls return ( as !! i ) ) --Select an album by track selectAlbumByTrack:: Session (Maybe String) selectAlbumByTrack = do ts <- getTracks let ls = map (map toLower) $ ts l <- selector ls let l' = ( do x <- l i <- elemIndex x ls return ( ts !! i ) ) case l' of Nothing -> return Nothing Just l'' -> do albs <- ( Hmpf.MPDSession.albumByTrack l'') case albs of [] -> return Nothing (x:xs) -> return (Just x) randomAlbum :: Session () randomAlbum = do alb <- albums >>= (lift . pick) playAlbum alb Just sng <- currentsong alert alb (artist sng) lift (putStr $ (artist sng) ++ " -- ") lift (putStrLn alb) return () selectFromPlaylist :: Session () selectFromPlaylist = do sngs <- playlistinfo st <- status let ns = map (\(i,t) -> (show i) ++ ". " ++ t ) . zip [1..] . map title $ sngs c = case ( song st ) of Nothing -> 0 Just i -> i xs = (drop c ns) ++ ( take c ns) r <- selectByList xs case r of Nothing -> return () Just i' -> (command ( "play " ++ (show $ i' + c ) ) >> return () ) getTracks :: Session [String] getTracks = do ts <- tracks lift ( putStrLn . show . length $ ts) let ts' = filter badchars $ ts lift ( putStrLn . show . length $ ts') return ts' where badchars = foldr (\c -> \b -> (fromEnum c > 35) && b ) True sleep :: Session () sleep = do st <- get let t = (timer st + 10) `mod` 70 put (st { timer = t }) M.unscheduleAction "sleep" if t > 0 then M.scheduleAction "sleep" ( t * 60 ) (do command "stop" st' <- get put st' { timer = 0 } ) >> alert "Timer set" ( (show t) ++ " min" ) else alert "Timer off" ""