pgdl 8.0 → 8.1

raw patch · 6 files changed

+36/−20 lines, 6 files

Files

pgdl.cabal +1/−1
src/AskScene.hs +2/−2
src/Main.hs +3/−0
src/PrsVid.hs +1/−1
src/RealWorld.hs +8/−4
src/UI.hs +21/−12

pgdl.cabal view

@@ -1,6 +1,6 @@  name:                pgdl-version:             8.0+version:             8.1 license:             PublicDomain license-file:        LICENSE author:              sifmelcara

src/AskScene.hs view

@@ -20,9 +20,9 @@     downB <- newButton "Yes"     quitB <- newButton "Quit"     remvB <- newButton "Remov"-    buttonBox <- (mkwIO playB) <++> (mkwIO downB) <++> (mkwIO quitB) <++> (mkwIO remvB)+    buttonBox <- mkwIO playB <++> mkwIO downB <++> mkwIO quitB <++> mkwIO remvB     b <- do-        bx <- (plainText "    Download it again?") <--> (return buttonBox)+        bx <- plainText "    Download it again?" <--> return buttonBox         setBoxSpacing bx 1         withPadding (padAll 1) bx     fg <- newFocusGroup

src/Main.hs view

@@ -105,13 +105,16 @@             onScePlay dlg $ \_ -> do                 Just (_, (itm, _)) <- getSelected lst                 justPlay itm+                chgls             onSceDown dlg $ \_ -> do                 Just (_, (itm, _)) <- getSelected lst                 playVid itm+                chgls             onSceQuit dlg $ const exitSuccess             onSceRemv dlg $ \_ -> do                 Just (_, (itm, _)) <- getSelected lst                 removeVid itm+                chgls              onSelectionChange lst $ \sle -> case sle of                 SelectionOn _ itm _ -> setText statBar =<< genStat itm

src/PrsVid.hs view

@@ -11,7 +11,7 @@  prsHtm :: T.Text -> [Video] prsHtm t = if null vs then [noVideo] else vs-    where vs = sortVid $ (prsVid t) ++ (prsFld t)+    where vs = sortVid $ prsVid t ++ prsFld t           noVideo = Video "No video in this folder." "" "" ""  prsVid :: T.Text -> [Video]

src/RealWorld.hs view

@@ -11,7 +11,6 @@ import System.Process import System.Directory import System.FilePath.Posix-import System.Exit import qualified Data.Text as T  -- play a video@@ -40,9 +39,11 @@         OSX   -> runCommand $ "open " ++ addq localloc ++ " -a vlc"         Linux -> runCommand $ "nohup vlc -f " ++ addq localloc ++ " &>/dev/null &"         _     -> error "OS unsupported!"-    exitSuccess+    return ()+    -- exitSuccess   where vn = T.unpack . vidName $ vid         vu = T.unpack . vidLink $ vid+        addq :: String -> String         addq s = "\"" ++ s ++ "\""  justPlay :: Video -> IO ()@@ -53,8 +54,10 @@         OSX   -> runCommand $ "open " ++ addq localloc ++ " -a vlc"         Linux -> runCommand $ "nohup vlc -f " ++ addq localloc ++ " &>/dev/null &"         _     -> error "OS unsupported!"-    exitSuccess+    return ()+    -- exitSuccess   where vn = T.unpack . vidName $ vid+        addq :: String -> String         addq s = "\"" ++ s ++ "\""      -- | remove a video @@ -62,7 +65,8 @@ removeVid vid = do     localDir <- getLocaldir     removeFile $ localDir </> vn-    exitSuccess+    return ()+    -- exitSuccess     where vn = T.unpack . vidName $ vid  -- | determine whether a video is downloaded

src/UI.hs view

@@ -13,6 +13,7 @@ import Graphics.Vty.Widgets.All import Data.IORef import Data.List+import Control.Concurrent  type WL = Widget (List Video FormattedText) type VidStat = ([Video], Video)@@ -32,8 +33,12 @@  filterVList :: VList -> (Video -> Bool) -> IO () filterVList vl@(VList wl _) ok = do-    storeState vl-    setListVideos wl . filter ok =<< getListVideos wl+    origVids <- getListVideos wl+    case filter ok origVids of+        [] -> return ()+        res -> do+            storeState vl+            setListVideos wl res  sortVList :: VList -> (Video -> Video -> Ordering) -> IO () sortVList vl@(VList wl _) cmp = do@@ -66,6 +71,7 @@ tryExit :: Widget FocusGroup -> Key -> [Modifier] -> IO Bool tryExit _ key _ = case key of     KChar 'q' -> exitSuccess+    KEsc      -> exitSuccess     _         -> return False  fex :: Video -> IO Bool@@ -108,15 +114,18 @@             Nothing -> return ()  colorDecide :: WL -> IO ()-colorDecide lst = -    onSelectionChange lst $ \sle -> case sle of-        SelectionOn _ itm _ -> if isFld itm-            then setFocusAttribute lst (black `on` magenta)-                    -- folder's color+colorDecide lst = do+    forkIO . forever $ do+        schedule $ do+            Just (_, (itm, _)) <- getSelected lst+            if isFld itm then+                setFocusAttribute lst (black `on` magenta)+                        -- folder's color             else fex itm >>= \case-                True  -> setFocusAttribute lst (black `on` red) -                         -- if video have been download, use red color-                False -> setFocusAttribute lst (black `on` cyan)-                         -- if video haven't been download, use cyan-        _                   -> return ()+                    True  -> setFocusAttribute lst (black `on` red) +                             -- if video have been download, use red color+                    False -> setFocusAttribute lst (black `on` cyan)+                             -- if video haven't been download, use cyan+        threadDelay 50000 -- 0.05 second+    return ()