Gifcurry 0.1.0.6 → 0.1.1.0
raw patch · 6 files changed
+212/−71 lines, 6 files
Files
- Gifcurry.cabal +1/−1
- Gifcurry.hs +40/−33
- README.md +26/−4
- data/gui.glade +72/−31
- gui_src/Main.hs +73/−2
- ui.gif too large to diff
Gifcurry.cabal view
@@ -1,5 +1,5 @@ name: Gifcurry-version: 0.1.0.6+version: 0.1.1.0 synopsis: Create animated GIFs, overlaid with optional text, from video files. description: GIF creation utility. homepage: https://github.com/lettier/gifcurry
Gifcurry.hs view
@@ -5,50 +5,57 @@ import System.Environment import System.Process import System.IO.Temp+import System.Directory import System.Exit import Data.List import Control.Exception -gif [is, os, st, dr, wd, qa, ttx, btx] = do+gif [is, os, st, dr, wd, qa, ttx, btx] = withTempDirectory "." "frames" $ \tmpDir -> do putStrLn $ "\nInput file: " ++ is putStrLn $ "Start second: " ++ st putStrLn $ "Duration: " ++ dr ++ " seconds" putStrLn $ "GIF width: " ++ wd ++ "px" putStrLn $ "Quality: " ++ (quality qa) ++ "%"- putStrLn $ "Top text: " ++ (ttx)- putStrLn $ "Bottom text: " ++ (btx)+ putStrLn $ "Top text: " ++ ttx+ putStrLn $ "Bottom text: " ++ btx putStrLn $ "\nWriting temporary frames to... " ++ tmpDir- result <- try (readProcess "ffmpeg" [- "-nostats",- "-loglevel",- "panic",- "-an",- "-ss",- st,- "-i",- is,- "-t",- dr,- "-r",- "15",- "-q:v",- "2",- "-vf",- "scale=" ++ wd ++ ":-1",- "-f",- "image2",- tmpDir ++ "/%010d.png" ] "") :: IO (Either IOError String)- result <- case result of- Left ex -> return (1)- Right val -> return (0)- putStrLn $ "Writing your GIF to... " ++ os- result <- try (convert qa tmpDir os wd ttx btx) :: IO (Either IOError String)- result <- case result of- Left ex -> return (1)- Right val -> return (0)- putStrLn "Done."- return (result)+ fileExists <- doesFileExist is+ if fileExists+ then do+ result <- try (readProcess "ffmpeg" [+ "-nostats",+ "-loglevel",+ "panic",+ "-an",+ "-ss",+ st,+ "-i",+ is,+ "-t",+ dr,+ "-r",+ "15",+ "-q:v",+ "2",+ "-vf",+ "scale=" ++ wd ++ ":-1",+ "-f",+ "image2",+ tmpDir ++ "/%010d.png" ] "") :: IO (Either IOError String)+ result <- case result of+ Left ex -> return 1+ Right val -> return 0+ putStrLn $ "Writing your GIF to... " ++ os+ result <- try (convert qa tmpDir os wd ttx btx) :: IO (Either IOError String)+ result <- case result of+ Left ex -> return 1+ Right val -> return 0+ putStrLn "Done."+ return result+ else do+ putStrLn "Video file does not exist."+ return 0 convert qa dr os wd ttx btx = readProcess "convert" ([ "-quiet",
README.md view
@@ -70,9 +70,9 @@ sudo apt-get update sudo apt-get install ffmpeg imagemagick # Find the latest release at https://github.com/lettier/gifcurry/releases-wget https://github.com/lettier/gifcurry/releases/download/*/gifcurry*.tar.gz-tar xvfz gifcurry*.tar.gz-cd gifcurry*/bin+wget https://github.com/lettier/gifcurry/releases/download/*/gifcurry-linux*.tar.gz+tar xvfz gifcurry-linux*.tar.gz+cd gifcurry-linux*/bin ./gifcurry_gui ./gifcurry_cli ```@@ -90,7 +90,28 @@ ### Mac OS X El Capitan +#### Prebuilt+ ```+# If you don't have Homebrew+/usr/bin/ruby -e "$(curl -fsSL https://raw.githubusercontent.com/Homebrew/install/master/install)"+brew install ffmpeg+brew install imagemagick+brew install ghostscript+brew install wget+# Find the latest release at https://github.com/lettier/gifcurry/releases+wget https://github.com/lettier/gifcurry/releases/download/*/gifcurry-macosx*.tar.gz+tar xvfz gifcurry-macosx*.tar.gz+cd gifcurry-macosx*/bin+./gifcurry_gui+./gifcurry_cli+```++#### Build++```+# If you don't have Homebrew+/usr/bin/ruby -e "$(curl -fsSL https://raw.githubusercontent.com/Homebrew/install/master/install)" brew update brew install xcode brew install git@@ -105,6 +126,7 @@ brew install pango brew install ffmpeg brew install imagemagick+brew install ghostscript git clone git@github.com:lettier/gifcurry.git cd gifcurry cabal sandbox init@@ -112,7 +134,7 @@ cabal configure cabal install alex happy -j cabal install gtk2hs-buildtools -j-cabal install gifcurry -j --enable-relocatable+cabal install gifcurry -j cd .cabal-sandbox/bin/ ./gifcurry_gui ./gifcurry_cli
data/gui.glade view
@@ -16,9 +16,13 @@ <property name="stock">gtk-open</property> </object> <object class="GtkWindow" id="gifcurry_window">+ <property name="width_request">400</property> <property name="can_focus">False</property>+ <property name="valign">center</property> <property name="title">Gifcurry - lettier.com</property>+ <property name="resizable">False</property> <property name="window_position">mouse</property>+ <property name="default_width">400</property> <property name="icon">icon.ico</property> <property name="gravity">center</property> <child>@@ -32,6 +36,7 @@ <property name="can_focus">False</property> <property name="tooltip_text" translatable="yes">Select an input file.</property> <property name="do_overwrite_confirmation">True</property>+ <property name="local_only">False</property> <property name="title" translatable="yes">Select an Input File</property> </object> <packing>@@ -215,9 +220,57 @@ </packing> </child> <child>+ <object class="GtkBox" id="frame_images_box">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="homogeneous">True</property>+ <child>+ <object class="GtkImage" id="first_frame_image">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="tooltip_text" translatable="yes">First frame preview.</property>+ <property name="halign">center</property>+ <property name="valign">center</property>+ <property name="stock">gtk-missing-image</property>+ </object>+ <packing>+ <property name="expand">True</property>+ <property name="fill">True</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <object class="GtkImage" id="last_frame_image">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="tooltip_text" translatable="yes">Last frame preview.</property>+ <property name="opacity">0.96999999999999997</property>+ <property name="halign">center</property>+ <property name="valign">center</property>+ <property name="stock">gtk-missing-image</property>+ </object>+ <packing>+ <property name="expand">True</property>+ <property name="fill">True</property>+ <property name="pack_type">end</property>+ <property name="position">1</property>+ </packing>+ </child>+ </object>+ <packing>+ <property name="expand">True</property>+ <property name="fill">True</property>+ <property name="position">7</property>+ </packing>+ </child>+ <child>+ <placeholder/>+ </child>+ <child> <object class="GtkBox" id="save_open_box"> <property name="visible">True</property> <property name="can_focus">False</property>+ <property name="homogeneous">True</property> <child> <object class="GtkButton" id="create_button"> <property name="label">Create</property>@@ -259,13 +312,14 @@ <packing> <property name="expand">False</property> <property name="fill">True</property>- <property name="position">7</property>+ <property name="position">11</property> </packing> </child> <child> <object class="GtkBox" id="link_box"> <property name="visible">True</property> <property name="can_focus">False</property>+ <property name="homogeneous">True</property> <child> <object class="GtkLinkButton" id="giphy_link_button"> <property name="label" translatable="yes">button</property>@@ -302,58 +356,45 @@ <packing> <property name="expand">False</property> <property name="fill">True</property>- <property name="position">8</property>+ <property name="position">12</property> </packing> </child> <child> <object class="GtkBox" id="status_box"> <property name="visible">True</property>+ <property name="sensitive">False</property> <property name="can_focus">False</property>- <child>- <object class="GtkLabel" id="status_label">- <property name="visible">True</property>- <property name="can_focus">False</property>- <property name="xpad">5</property>- <property name="ypad">5</property>- <property name="label" translatable="yes">Status</property>- </object>- <packing>- <property name="expand">False</property>- <property name="fill">True</property>- <property name="position">0</property>- </packing>- </child>- <child>- <object class="GtkSeparator" id="separator2">- <property name="visible">True</property>- <property name="can_focus">False</property>- <property name="orientation">vertical</property>- </object>- <packing>- <property name="expand">False</property>- <property name="fill">True</property>- <property name="position">1</property>- </packing>- </child>+ <property name="hexpand">True</property>+ <property name="vexpand">True</property>+ <property name="baseline_position">top</property> <child> <object class="GtkEntry" id="status_text_entry"> <property name="visible">True</property>- <property name="can_focus">True</property>+ <property name="sensitive">False</property>+ <property name="app_paintable">True</property>+ <property name="can_focus">False</property>+ <property name="hexpand">True</property>+ <property name="vexpand">True</property> <property name="editable">False</property>+ <property name="has_frame">False</property> <property name="text" translatable="yes">Ready.</property>+ <property name="shadow_type">none</property> <property name="caps_lock_warning">False</property>+ <property name="primary_icon_stock">gtk-info</property>+ <property name="secondary_icon_activatable">False</property>+ <property name="secondary_icon_sensitive">False</property> </object> <packing> <property name="expand">True</property> <property name="fill">True</property>- <property name="position">2</property>+ <property name="position">0</property> </packing> </child> </object> <packing> <property name="expand">True</property> <property name="fill">True</property>- <property name="position">9</property>+ <property name="position">13</property> </packing> </child> </object>
gui_src/Main.hs view
@@ -4,6 +4,8 @@ import System.Directory import System.Process import System.Info+import System.IO.Temp+import Control.Monad import Data.Char import Data.List import Control.Concurrent@@ -33,16 +35,26 @@ open_button <- load_button builder "open_button" giphy_button <- load_button builder "giphy_link_button" imgur_button <- load_button builder "imgur_link_button"+ first_frame_image <- load_image builder "first_frame_image"+ last_frame_image <- load_image builder "last_frame_image" -- Bug in Glade does not allow setting the link button label. buttonSetLabel giphy_button "Giphy" buttonSetLabel imgur_button "Imgur" - entrySetText start_time_entry "0"- entrySetText duration_entry "10" entrySetText quality_entry "100" entrySetText width_entry "500" + input_file_button `on` fileChooserButtonFileSet $ do+ imageSetFromIconName first_frame_image "gtk-missing-image" IconSizeButton+ imageSetFromIconName last_frame_image "gtk-missing-image" IconSizeButton++ start_time_entry `on` editableChanged $+ make_first_frame_preview input_file_button start_time_entry duration_entry first_frame_image last_frame_image++ duration_entry `on` editableChanged $+ make_last_frame_preview input_file_button start_time_entry duration_entry last_frame_image+ create_button `on` buttonActivated $ do input_file_text <- fileChooserGetFilename input_file_button input_file_path_name <- case input_file_text of@@ -111,6 +123,8 @@ load_button b = builderGetObject b castToButton +load_image b = builderGetObject b castToImage+ build_builder = do builder <- builderNew glade_file <- getDataFileName "data/gui.glade"@@ -132,3 +146,60 @@ open_gif output_file_path_name = spawnCommand $ command ++ output_file_path_name where command = if "linux" `isInfixOf` (fmap toLower System.Info.os) then "xdg-open " else "open "++reset_image i = imageSetFromIconName i "gtk-missing-image" IconSizeButton++make_gif_preview ifpn ofpn st btxt = gif [+ ifpn,+ ofpn,+ st,+ "0.001",+ "200",+ "50",+ "",+ btxt ]++make_last_frame_preview ifb ste de lfi = do+ forkIO $+ withTempDirectory "." "previews" $ \tmpDir -> do+ input_file_text <- fileChooserGetFilename ifb+ input_file_path_name <- case input_file_text of+ Nothing -> return ""+ Just file_path_name -> return file_path_name+ start_time_text <- case (return $ entryGetText ste) of+ Nothing -> return ""+ Just start_time_text -> start_time_text+ duration_text <- case (return $ entryGetText de) of+ Nothing -> return ""+ Just duration_text -> duration_text+ if ((not (null input_file_path_name)) && (not (null start_time_text)) && (not (null duration_text))) then do+ let output_file_path_name = tmpDir ++ "/end.gif"+ let start_time_flt = read start_time_text :: Float+ let duration_flt = read duration_text :: Float+ let start_time = show $ start_time_flt + duration_flt+ result <- make_gif_preview input_file_path_name output_file_path_name start_time " LAST FRAME "+ if (result == 0)+ then imageSetFromFile lfi output_file_path_name+ else reset_image lfi+ else reset_image lfi+ return ()++make_first_frame_preview ifb ste de ffi lfi = do+ forkIO $ do+ withTempDirectory "." "previews" $ \tmpDir -> do+ input_file_text <- fileChooserGetFilename ifb+ input_file_path_name <- case input_file_text of+ Nothing -> return ""+ Just file_path_name -> return file_path_name+ start_time <- case (return $ entryGetText ste) of+ Nothing -> return ""+ Just start_time -> start_time+ if ((not (null input_file_path_name)) && (not (null start_time))) then do+ let output_file_path_name = tmpDir ++ "/start.gif"+ result <- make_gif_preview input_file_path_name output_file_path_name start_time " FIRST FRAME "+ if (result == 0)+ then imageSetFromFile ffi output_file_path_name+ else reset_image ffi+ else reset_image ffi+ make_last_frame_preview ifb ste de lfi+ return ()
ui.gif view
file too large to diff