diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,39 @@ ## Changelog +------------------------------------------------------------------------------- + +### 3.0.0.0 + +#### Added + +- Added a video preview using GStreamer +- Added start time and end time indicators to UI +- Added a save as video option to both the GUI and CLI +- Added a crop mode to the UI +- Added crop parameters to the CLI +- Added the following to the library interface + - `getOutputFileWithExtension` + - `getVideoWidthAndHeight` + - `defaultFontChoice` +- Added snap distribution + +#### Changed + +- Reconfigured the UI to show the preview off to the right along with the start and duration controls +- Changed the image first and last frame preview to be the fallback if GStreamer errors +- Changed text entries to spin buttons for better error checking + - The spin buttons provide better feedback about the min and max settings +- Moved the GUI preview code into a separate module +- Locked the GHC version to avoid build issues concerning haskell-gi and GHC 8.2.X +- Changed the logo and icon + +#### Removed + +- + +------------------------------------------------------------------------------- + ### 2.3.0.0 #### Added diff --git a/Gifcurry.cabal b/Gifcurry.cabal --- a/Gifcurry.cabal +++ b/Gifcurry.cabal @@ -1,7 +1,7 @@ name: Gifcurry -version: 2.3.0.0 +version: 3.0.0.0 synopsis: GIF creation utility. -description: Create animated GIFs, optionally overlaid with text, from video files. +description: Your open source video to GIF maker. homepage: https://github.com/lettier/gifcurry license: BSD3 license-file: LICENSE @@ -16,16 +16,17 @@ , LICENSE , CHANGELOG.md , ./lib/GtkMainSyncAsync.hs + , ./lib/GiCairoCairoBridge.hs , ./lib/LICENSE , ./src/dev/Paths_Gifcurry.hs , ./src/data/gifcurry-logo.svg - , ./src/data/gifcurry-icon.png + , ./src/data/gifcurry-icon.svg , ./makefile data-files: data/gui.glade , data/gifcurry-logo.svg - , data/gifcurry-icon.png + , data/gifcurry-icon.svg data-dir: ./src/ -cabal-version: >=1.10 +cabal-version: >= 1.10 source-repository head type: git @@ -46,19 +47,33 @@ executable gifcurry_gui main-is: Main.hs - build-depends: base >= 4.7 && < 5 - , haskell-gi-base == 0.20.* - , gi-glib == 2.0.* + build-depends: base == 4.9.* + , haskell-gi == 0.21.* + , haskell-gi-base == 0.21.* , gi-gobject == 2.0.* - , gi-gtk == 3.0.* + , gi-glib == 2.0.* , gi-gdk == 3.0.* + , gi-gtk == 3.0.* + , gi-cairo == 1.0.* + , gi-gst == 1.0.* + , gi-gstvideo == 1.0.* + , cairo == 0.13.* + , bytestring == 0.10.* , process >= 1.2 && <= 1.4.4 , temporary >= 1.2 && < 1.3 , directory == 1.3.* , text == 1.2.* , filepath == 1.4.* - other-modules: Paths_Gifcurry, GtkMainSyncAsync, Gifcurry - ghc-options: -threaded -with-rtsopts=-N -Wall -freverse-errors + , transformers == 0.5.* + other-modules: Paths_Gifcurry + , GuiRecords + , Gifcurry + , GuiPreview + , GuiMisc + + , GtkMainSyncAsync + , GiCairoCairoBridge + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -freverse-errors hs-source-dirs: ./lib/ , ./src/ , ./src/gui/ diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,254 +1,359 @@ -![Gifcurry](http://i.imgur.com/jhU7puN.png) +![Gifcurry](https://i.imgur.com/t6zJGR9.png) -# Gifcurry +# Tell me about Gifcurry. -Create animated GIFs, optionally overlaid with text, from video files. +Gifcurry is your only open source video to GIF maker built with Haskell. +Load a video, make some edits, and save it as a GIF—it's that easy. +Most video formats should work so go wild. +And since it's made with Haskell, you know it's good. -## Screenshots +For the command line averse, there is a GUI. +Die-hard terminal aficionado? Gifcurry has you covered with its CLI. +And for the Haskell programmers out there, there is also a library API. -![GUI](https://i.imgur.com/U8xnK82.gif) +Gifcurry can save your creation as a GIF or as a video. +So if you hate GIFs with a passion—no problem! +Just select "save as video" and do your part to rid the world of GIFs. -## Sample GIF +Enjoy memes? Great! Gifcurry can add text to the top and/or the bottom of your GIF. +Just type in some text for the top or type in some text for the bottom or type in +some pithy text for both the top and bottom—Gifcurry don't care. +Oh and you can select the font too so you're never too far from Comic Sans. -![Caminandes 3: Llamigos (2016) - Blender Foundation](https://i.imgur.com/FJW2gBc.gif) -Credit: [Caminandes 3: Llamigos (2016) - Blender Foundation](http://www.caminandes.com/) +Gifcurry caters to the power user with its crop tool. +You can crop from the left, the right, the top, and/or the bottom. +With Gifcurry, you can cut out anything you don't want. -## CLI Usage +Is Gifcurry another Electron app? No way! Gifcurry is 100% #electronfree. +No need to download more RAM, Gifcurry is light as a feather. +Run it all day, run it all year—you'll never notice. +I know what your thinkin', "Gifcurry is just FFMpeg and ImageMagick," but you'd be wrong. +Gifcurry hides all the goofy details so you can concentrate on what matters—the almighty GIF. +Making GIFs with Gifcurry is fun so try it out! + +## What do I need Gifcurry for? + +Need to show off that new UI feature in a pull request? Gifcurry. +Your template doesn't allow video in the hero image? Gifcurry. +No GIF of your favorite movie scene? Gifcurry. +Need a custom animated emoji for Slack? Gifcurry. +Have an idea of the perfect GIF to close out that email? Gifcurry. + +Gifcurry comes in handy for all sorts of scenarios. + +## What does the GUI look like? + +![GUI](https://i.imgur.com/oYQAyQY.png) +![GUI](https://i.imgur.com/er3AQjP.png) +![GUI](https://i.imgur.com/mW1Rsd1.png) +![GUI](https://i.imgur.com/IQqkxfB.png) +![GUI](https://i.imgur.com/NMadQxQ.png) + +## Got any sample GIFs? + +![GIF](https://i.imgur.com/alxcMli.gif) +![GIF](https://i.imgur.com/FUjIBm2.gif) + +## How do I use the command line interface (CLI)? + ```bash gifcurry_cli [OPTIONS] -Common flags: - -i --inputfile=FILE The input video file path and name. - -o --outputfile=ITEM The output GIF file path and name. - -s --starttime=NUM The start time (in seconds) for the first frame. - -d --durationtime=NUM How long the GIF lasts (in seconds) from the start - time. - -w --widthsize=INT How wide the GIF needs to be. Height will scale to - match. - -q --qualitypercent=NUM Ranges from 0.0 to 100.0. - -f --fontchoice=ITEM Choose your desired font for the top and bottom - text. - -t --toptext=ITEM The text you wish to add to the top of the GIF. - -b --bottomtext=ITEM The text you wish to add to the bottom of the GIF. - -? --help Display help message - -V --version Print version information - --numeric-version Print just the version number +FILE IO: + -i --input-file=FILE The input video file path and name. + -o --output-file=FILE The output GIF file path and name. + -m --save-as-video If present, saves the GIF as a video. +TIME: + -s --start-time=NUM The start time (in seconds) for the first frame. + -d --duration-time=NUM How long the GIF lasts (in seconds) from the + start time. +OUTPUT FILE SIZE: + -w --width-size=INT How wide the GIF needs to be. Height will scale + to match. + -q --quality-percent=NUM From 1 (very low quality) to 100 (the best + quality). Controls how many colors are used and how + many frames per second there are. +TEXT: + -f --font-choice=TEXT Choose your desired font for the top and bottom + text. + -t --top-text=TEXT The text you wish to add to the top of the GIF. + -b --bottom-text=TEXT The text you wish to add to the bottom of the + GIF. +CROP: + -L --left-crop=NUM The amount you wish to crop from the left. + -R --right-crop=NUM The amount you wish to crop from the right. + -T --top-crop=NUM The amount you wish to crop from the top. + -B --bottom-crop=NUM The amount you wish to crop from the bottom. +INFO: + -? --help Display help message + -V --version Print version information ``` -## CLI Example +## Got a CLI example? -```Bash -~/gifcurry ❯❯❯ ./gifcurry_cli \ - -i ./03_caminandes_llamigos_1080p.mp4 \ - -o ./out.gif \ - -s 42 \ - -d 4 \ - -w 600 \ - -q 100 \ - -f 'Roboto Condensed Bold Italic' \ - -t 'Download' \ - -b 'Gifcurry' +```text +gifcurry_cli \ +-i ~/Videos/video.mp4 -o ~/tmp/test -m \ +-L 25 -R 25 -T 25 -B 25 \ +-s 149.11 -d 1 \ +-f 'fira sans' -t 'Top Text' -b 'Bottom Text' - _____ _ __ -| __ (_)/ _| -| | \/_| |_ ___ _ _ _ __ _ __ _ _ -| | __| | _/ __| | | | '__| '__| | | | -| |_\ \ | || (__| |_| | | | | | |_| | - \____/_|_| \___|\__,_|_| |_| \__, | - __/ | - |___/ + ╓╦NÑ╫╫╫╫╫ÑNw, + , `Ñ╫╫╫╫Ñ `'╩╫╫╫Ñw ,╓ææµ ║▓▓⌐ ,▄▄▓▄ + ]╫Ñ Ñ╫╫╫ ,╫N ╙╫╫╫╫Ñ ╓▓▓▀╙╙▀╨ .╓, ,▓▓▌, ,╓╥╓, ,, ,,, ,, ,╓ ,, ,╓ ,, ., + ]╫╫╫Ñ '╫╫⌐ Ñ╫⌐ Ñ╫╫╫╫Ñ -▓▓M ╥╥╥╥ ▐▓▓ ▀▓▓▀▀ ▄▓▀╙▀▀ ▓▓Γ ╫▓▌ ╫▓▓▌▀ ▓▓▓▀▀╙▓▓ ▓▓▀ + ╩╫╫╫╫H ╠Ñ 1╫H ╫ '╫╫╫╫╣ ▓▓H ╙▐▓▓ ▐▓▓ ▓▓Γ ▐▓▓⌐ ▓▓Γ ╫▓▌ ╫▓▌ ▓▓▌ ║▓▌╢▓▌ + ]╫╫╫╫╫ ' j╫Å j╫H ╠╫╫╫╫ ╙▓▓▄▄▄▓▓ ▐▓▓ ▓▓Γ ▀▓▌▄▄▄ ▓▓▌▄▓▓▌ ╫▓▌ ▓▓▌ ▓▓▓▓ + Ñ╫╫╫╫N jÑ╬ .╫╫╫⌐ Ñ╫╬┘ └╙╙╙└ `└└ └└` ╙╙╙` ╙╙└`└` `└└ └└` ,▓▓▀ + ╨╫╫╫╫N '┘ ╬╫╫╫╫ ╩` ▀▀▀└ + `╙Ñ╫╫╫N╦╦╫╫╫╫╫╩ + `'╙╙╙╙'`` -Gifcurry 2.3.0.0 + +Gifcurry 3.0.0.0 (C) 2016 David Lettier lettier.com ----------------------------------------- +[INFO] Here are your settings. -Input file: ./03_caminandes_llamigos_1080p.mp4 -Output file: ./out.gif -Start second: 42.000 -Duration: 4.000 seconds -GIF width: 600px -Quality: 100.0% -Font Choice: Roboto Condensed Bold Italic -Top text: Download -Bottom text: Gifcurry +FILE IO: -Writing temporary frames to... ./frames13465 -Font matched: Roboto-Condensed-Bold-Italic -Writing your GIF to... ./out.gif -Done. -``` +Input File: /home/Videos/video.mp4 +Output File: /home/tmp/test.mp4 +Save As Video: Yes -## Dependencies +TIME: -### Run +Start Second: 149.110 +Duration Time: 1.000 seconds -* [GTK+](http://www.gtk.org/download/index.php) -* [FFmpeg](https://www.ffmpeg.org/download.html) -* [ImageMagick](http://www.imagemagick.org/script/download.php) +OUTPUT FILE SIZE: -### Build +Width Size: 500px +Quality Percent: 100.0% -* [Haskell](https://www.haskell.org/platform/) +TEXT: -## Install & Run +Font Choice: fira sans +Top Text: Top Text +Bottom Text: Bottom Text -### Linux +CROP: -#### [AppImage (GUI Only)](https://appimage.github.io/gifcurry/) +Left Crop: 25.000 +Right crop: 25.000 +Top Crop: 25.000 +Bottom Crop: 25.000 -```bash -# Install FFmpeg (https://www.ffmpeg.org/download.html) -# Install ImageMagick (https://www.imagemagick.org/script/download.php) -# Install GNU Wget (https://www.gnu.org/software/wget/) or download the AppImage with your browser -# Find the latest release at https://github.com/lettier/gifcurry/releases -# * equals the version number -# Download gifcurry-*-x86_64.AppImage -# Right click on the AppImage and allow the file to be executed as a program -wget https://github.com/lettier/gifcurry/releases/download/*/gifcurry-*-x86_64.AppImage -chmod a+x gifcurry-*-x86_64.AppImage -./gifcurry-*-x86_64.AppImage -# If you would like to install the AppImage, you can run the following -cd -wget "https://raw.githubusercontent.com/lettier/gifcurry/master/packaging/linux/gifcurry-gui-install.sh" -O "gifcurry-gui-install.sh" -chmod +x "gifcurry-gui-install.sh" -./gifcurry-gui-install.sh +[INFO] Writing the temporary frames to: /home/.cache/gifcurry/gifcurry-frames17389 +[INFO] Your font choice matched to "Fira-Sans". +[INFO] Saving your GIF to: /home/.cache/gifcurry/gifcurry-frames17389/finished-result.gif +[INFO] Saving your video to: /home/tmp/test.mp4 +[INFO] All done. ``` -#### Ubuntu/Mint +## How do I get a copy of Gifcurry? -```bash -# Install FFmpeg (https://www.ffmpeg.org/download.html) -# Install ImageMagick (https://www.imagemagick.org/script/download.php) -sudo add-apt-repository ppa:jonathonf/ffmpeg-3 -sudo apt-get update -sudo apt-get install ffmpeg imagemagick -# Install GNU Wget (https://www.gnu.org/software/wget/) -# Find the latest release at https://github.com/lettier/gifcurry/releases -# * equals the version number -wget https://github.com/lettier/gifcurry/releases/download/*/gifcurry-linux-*.tar.gz -tar -xvfz gifcurry-linux*.tar.gz -cd gifcurry-linux-*/bin -./gifcurry_cli -? -./gifcurry_gui -``` +Gifcurry works on Linux, Mac, and probably Windows (left me know). +Make sure you have FFmpeg, GStreamer, ImageMagick, and GTK+ installed on your machine. +To find the latest version of Gifcurry, head over to the +[releases page](https://github.com/lettier/gifcurry/releases). -#### Arch/Manjaro/Antergos +### I use Linux. +If you use Linux then the easiest way to grab a copy of Gifcurry is by downloading the +[AppImage](https://github.com/lettier/gifcurry/releases/download/3.0.0.0/gifcurry-3.0.0.0-x86_64.AppImage). +After you download the +[AppImage](https://github.com/lettier/gifcurry/releases/download/3.0.0.0/gifcurry-3.0.0.0-x86_64.AppImage), +right click on it, select permissions, and check the box near execute. +With that out of the way—you're all set—just double click on the AppImage +and the GUI will fire right up. + +You can also download and install the +[AppImage](https://github.com/lettier/gifcurry/releases/download/3.0.0.0/gifcurry-3.0.0.0-x86_64.AppImage) +using the handy +[AppImage install script](https://raw.githubusercontent.com/lettier/gifcurry/master/distribution/linux/app-image/gifcurry-app-image-install.sh) +(right click and save link as). +Download the script, right click on it, select permissions, check the box near execute, and double click on it. +You should now see Gifcurry listed alongside your other installed programs. + +If you want the CLI then download the +[prebuilt version](https://github.com/lettier/gifcurry/releases/download/3.0.0.0/gifcurry-linux-3.0.0.0.tar.gz) +for Linux, extract it, open up your terminal, +`cd` to the bin folder, and then run `gifcurry_cli -?`. +As an added bonus, inside the bin directory is the GUI version +too so now you have both. + +#### I use Arch/Manjaro/Antergos/pacman. + +If you'd rather install Gifcurry via pacman then copy the following into your terminal. + ```bash cd -# Install Git +# Install git. sudo pacman -S git -# Install Gifcurry from AUR +# Install Gifcurry. mkdir -p build_gifcurry cd build_gifcurry git clone https://aur.archlinux.org/gifcurry.git cd gifcurry makepkg -sic +# Run Gifcurry CLI and GUI. cd rm -rf build_gifcurry gifcurry_cli -? gifcurry_gui ``` -### Mac +#### I use Ubuntu/Mint/Debian/Deepin/snap. -#### Binaries +Gifcurry is available as a snap from [Snapcraft](https://snapcraft.io/). +If you don't already have `snap`, go ahead and install it using the command `sudo apt install snapd`. +You can install the +[Gifcurry snap](https://snapcraft.io/gifcurry) +right from your browser or via the command line. +For the command line route, paste the following into your terminal. + ```bash -# Install Homebrew -/usr/bin/ruby -e "$(curl -fsSL https://raw.githubusercontent.com/Homebrew/install/master/install)" -brew update -brew install ffmpeg -brew install imagemagick -brew install ghostscript -brew install wget -brew install gnome-icon-theme -# Find the latest release at https://github.com/lettier/gifcurry/releases -# * equals the version number -wget https://github.com/lettier/gifcurry/releases/download/*/gifcurry-macosx-*.tar.gz -tar xvfz gifcurry-macosx-*.tar.gz -cd gifcurry-macosx-*/bin -./gifcurry_cli -? -./gifcurry_gui +snap install gifcurry +sudo snap connect gifcurry:mount-observe +sudo snap connect gifcurry:removable-media +sudo snap connect gifcurry:raw-usb +gifcurry ``` -#### Compile +The +[Gifcurry snap](https://snapcraft.io/gifcurry) +only comes with the GUI. +If you want the CLI, download the +[prebuilt version](https://github.com/lettier/gifcurry/releases/download/3.0.0.0/gifcurry-linux-3.0.0.0.tar.gz) +for Linux. +### I use Mac. + +If you use Mac then you'll need to find the terminal. +Open Spotlight, type `Terminal`, and press enter. +You should see a window open that has black text +on a white background. + +With the terminal open, copy the following into the terminal to install Homebrew. + ```bash -# Install Homebrew /usr/bin/ruby -e "$(curl -fsSL https://raw.githubusercontent.com/Homebrew/install/master/install)" brew update -brew install xcode -brew install git -git clone git@github.com:lettier/gifcurry.git +``` + +After installing Homebrew, you'll need to install the right dependencies. + +```bash +xcode-select --install +brew install \ + wget \ + git \ + libffi \ + libsvg \ + librsvg \ + libav \ + libogg \ + libvorbis \ + pkg-config \ + gobject-introspection \ + cairo \ + gdk-pixbuf \ + gsettings-desktop-schemas \ + gtk+3 \ + gtk-mac-integration \ + gnome-icon-theme \ + openh264 \ + theora \ + ffmpeg \ + imagemagick \ + ghostscript \ + gstreamer \ + gst-libav \ + gst-plugins-base \ + gst-plugins-good +brew install --with-gtk+3 gst-plugins-bad +wget -qO- https://get.haskellstack.org/ | sh -s - -f +``` + +The next step is to download the Gifcurry source with a program called `git`. +After downloading the source, change directory (`cd`) into the Gifcurry folder. + +```bash +git clone https://github.com/lettier/gifcurry.git cd gifcurry/ -brew cask install haskell-platform -brew install pkg-config gobject-introspection cairo gdk-pixbuf gsettings-desktop-schemas \ - gtk+3 gtk-mac-integration ffmpeg imagemagick ghostscript gnome-icon-theme -stack setup -stack install hsc2hs -stack install -export PATH=$PATH:"$HOME/.local/bin/" -gifcurry_cli -? -gifcurry_gui ``` -### [Hackage](https://hackage.haskell.org/package/Gifcurry) +Now that you have the source, copy this into the terminal. +It's scary lookin' but it is telling the program that builds +Gifcurry where the `libffi` package configuration is. -#### Stack +```bash +LIBFFIPKGCONFIG=`find /usr/local/Cellar -path '*libffi*' -type d -name 'pkgconfig' 2>/dev/null | tr '\n' ':' | sed 's/:$//'` +export PKG_CONFIG_PATH=$PKG_CONFIG_PATH:$LIBFFIPKGCONFIG +``` +We're almost there. +With the `stack` program, install the Haskell specific dependencies and build Gifcurry. + ```bash -# Install GNU Wget (https://www.gnu.org/software/wget/) -# Install FFmpeg (https://www.ffmpeg.org/download.html) -# Install ImageMagick (https://www.imagemagick.org/script/download.php) -# Install Haskell (https://www.haskell.org/platform/) -# Find the latest version number at https://hackage.haskell.org/package/Gifcurry -# * equals the version number -wget https://hackage.haskell.org/package/Gifcurry-*/Gifcurry-*.tar.gz -tar -xvzf Gifcurry-*.tar.gz -cd Gifcurry-* stack setup +stack install alex happy +stack install gtk2hs-buildtools +stack install hsc2hs stack install -stack exec -- gifcurry_cli -? -stack exec -- gifcurry_gui ``` -#### Cabal +`stack` places the two Gifcurry programs into a special folder. +Copy the following into the terminal to create two shortcuts on your desktop. ```bash -# Install FFmpeg (https://www.ffmpeg.org/download.html) -# Install ImageMagick (https://www.imagemagick.org/script/download.php) -# Install Haskell (https://www.haskell.org/platform/) -cabal update -cabal install alex happy -j -cabal install gifcurry -j -cd ~/.cabal/bin -./gifcurry_cli -? -./gifcurry_gui +ln -s $HOME/.local/bin/gifcurry_cli $HOME/Desktop/gifcurry_cli +ln -s $HOME/.local/bin/gifcurry_gui $HOME/Desktop/gifcurry_gui ``` -### [Github](https://github.com/lettier/gifcurry) +You can now click on `gifcurry_gui` from your desktop or run `gifcurry_cli` from the terminal. +### I'm a Haskell developer. + +If you develop Haskell programs then the easiest way to build Gifcurry is with +[Haskell Stack](https://docs.haskellstack.org/en/stable/README/). +Copy the following into your terminal. + ```bash -# Install GNU Make (https://www.gnu.org/software/make/) -# Install FFmpeg (https://www.ffmpeg.org/download.html) -# Install ImageMagick (https://www.imagemagick.org/script/download.php) -# Install Haskell (https://www.haskell.org/platform/) -git clone git@github.com:lettier/gifcurry.git -cd gifcurry/ -make -make run_cli CLI_ARGS='-?' -make run_gui +git clone https://aur.archlinux.org/gifcurry.git +cd gifcurry +stack setup +stack install alex happy +stack install gtk2hs-buildtools +stack install hsc2hs +stack install +$HOME/.local/bin/gifcurry_cli -? +$HOME/.local/bin/gifcurry_gui ``` -## License +## What dependencies does Gifcurry use? +### To run Gifcurry. + +* [GTK+](http://www.gtk.org/download/index.php) +* [FFmpeg](https://www.ffmpeg.org/download.html) +* [GStreamer](https://gstreamer.freedesktop.org/download/) +* [ImageMagick](http://www.imagemagick.org/script/download.php) + +### To build Gifcurry. + +* [GObject Introspection](https://wiki.gnome.org/action/show/Projects/GObjectIntrospection) +* [Haskell](https://docs.haskellstack.org/en/stable/README/) + +## What is the license? + For license information, see [LICENSE](LICENSE). -## Copyright +## Who wrote Gifcurry? _(C) 2016 David Lettier_ [lettier.com](http://www.lettier.com/) diff --git a/lib/GiCairoCairoBridge.hs b/lib/GiCairoCairoBridge.hs new file mode 100644 --- /dev/null +++ b/lib/GiCairoCairoBridge.hs @@ -0,0 +1,31 @@ +-- original author: +-- Mirco "MacSlow" Mueller +-- +-- created: +-- 10.1.2006 (or so) +-- +-- http://www.gnu.org/licenses/licenses.html#GPL +-- +-- ported to Haskell (gtk2hs) by: +-- Duncan Coutts +-- +-- ported to haskell-gi from the gtk2hs port by: +-- Iñaki García Etxebarria +-- +-- Modified by David Lettier + +module GiCairoCairoBridge (renderWithContext) where + +import Control.Monad.Trans.Reader (runReaderT) +import qualified GI.Cairo +import Graphics.Rendering.Cairo.Internal (Render(runRender)) +import Graphics.Rendering.Cairo.Types (Cairo(Cairo)) +import Foreign.Ptr (castPtr) + +-- | This function bridges gi-cairo with the hand-written cairo +-- package. It takes a `GI.Cairo.Context` (as it appears in gi-cairo), +-- and a `Render` action (as in the cairo lib), and renders the +-- `Render` action into the given context. +renderWithContext :: GI.Cairo.Context -> Render () -> IO () +renderWithContext ct r = GI.Cairo.withManagedPtr ct $ \p -> + runReaderT (runRender r) (Cairo (castPtr p)) diff --git a/lib/GtkMainSyncAsync.hs b/lib/GtkMainSyncAsync.hs --- a/lib/GtkMainSyncAsync.hs +++ b/lib/GtkMainSyncAsync.hs @@ -33,10 +33,11 @@ {-# LANGUAGE OverloadedStrings #-} -module GtkMainSyncAsync ( - gtkMainSync - , gtkMainAsync - ) where +module GtkMainSyncAsync + ( gtkMainSync + , gtkMainAsync + ) + where import Control.Monad import Control.Concurrent @@ -59,4 +60,5 @@ gtkMainSyncBuildCallBack callback mVar = callback >>= putMVar mVar >> return False gtkMainAddCallback :: GI.GLib.SourceFunc -> IO () -gtkMainAddCallback callback = void $ GI.GLib.idleAdd GI.GLib.PRIORITY_DEFAULT callback +gtkMainAddCallback callback = + void $ GI.GLib.idleAdd GI.GLib.PRIORITY_DEFAULT callback diff --git a/makefile b/makefile --- a/makefile +++ b/makefile @@ -9,11 +9,11 @@ STACK_GHC_BIN=`$(STACK) path --compiler-bin` STACK_PATHS=$(STACK_PATH_LOCAL_BIN):$(STACK_GHC_BIN) CABAL=env PATH=$(PATH):$(STACK_PATHS) $(STACK_PATH_LOCAL_BIN)/cabal -VERSION='2.3.0.0' +VERSION='3.0.0.0' export PATH := $(PATH):$(STACK_PATH_LOCAL_BIN) -all: setup update sandbox_clean clean alex happy install_dependencies configure build install +all: setup update sandbox_clean clean alex happy haskell_gi gtk2hs_buildtools install_dependencies configure build install setup: $(STACK) setup && $(STACK) update && $(STACK) install Cabal && $(STACK) install cabal-install @@ -24,6 +24,12 @@ happy: setup $(STACK) install happy +haskell_gi: setup + $(STACK) install haskell-gi + +gtk2hs_buildtools: setup + $(STACK) install gtk2hs-buildtools + sandbox: setup $(CABAL) sandbox init @@ -65,10 +71,11 @@ --html-location='http://hackage.haskell.org/package/Gifcurry/docs' \ --contents-location='http://hackage.haskell.org/package/Gifcurry' && \ cp -R ./dist/doc/html/Gifcurry/ ./docs/Gifcurry-$(VERSION)-docs && \ - tar --format=ustar -zcvf './docs/Gifcurry-$(VERSION)-docs.tar.gz' './docs/Gifcurry-$(VERSION)-docs' + cd ./docs && \ + tar --format=ustar -cvf ./Gifcurry-$(VERSION)-docs.tar Gifcurry-$(VERSION)-docs # Begin Arch Linux Specific -arch_os_build_gifcurry: setup update clean sandbox_clean alex happy arch_os_install_dependencies arch_os_configure arch_os_build +arch_os_build_gifcurry: setup update clean sandbox_clean alex happy haskell_gi gtk2hs_buildtools arch_os_install_dependencies arch_os_configure arch_os_build arch_os_install_dependencies: sandbox $(CABAL) --require-sandbox install -j -w $(STACK_GHC_EXE) --force-reinstalls --reinstall --only-dependencies diff --git a/src/cli/Main.hs b/src/cli/Main.hs --- a/src/cli/Main.hs +++ b/src/cli/Main.hs @@ -4,114 +4,190 @@ lettier.com -} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE + DeriveDataTypeable + , NamedFieldPuns +#-} +{-# OPTIONS_GHC -fno-cse #-} +import Control.Monad import System.Console.CmdArgs import qualified Gifcurry -data CliArgs = CliArgs { - inputFile :: String - , outputFile :: String - , startTime :: Float - , durationTime :: Float - , widthSize :: Int - , qualityPercent :: Float - , fontChoice :: String - , topText :: String - , bottomText :: String - } deriving (Data, Typeable, Show, Eq) +data CliArgs = + CliArgs + { input_file :: String + , output_file :: String + , save_as_video :: Bool + , start_time :: Float + , duration_time :: Float + , width_size :: Int + , quality_percent :: Float + , font_choice :: String + , top_text :: String + , bottom_text :: String + , left_crop :: Float + , right_crop :: Float + , top_crop :: Float + , bottom_crop :: Float + } + deriving (Data, Typeable, Show, Eq) +programName :: String +programName = "gifcurry_cli" + info :: String -info = "Gifcurry " ++ Gifcurry.versionNumber ++ "\n(C) 2016 David Lettier\nlettier.com" +info = + unlines + [ logo + , "Gifcurry" ++ " " ++ Gifcurry.versionNumber + , "(C) 2016 David Lettier" + ,"lettier.com" + ] cliArgs :: CliArgs -cliArgs = CliArgs { - inputFile = "" &= typFile &= help "The input video file path and name." - , outputFile = "" &= typFile &= help "The output GIF file path and name." - , startTime = 0.0 &= help "The start time (in seconds) for the first frame." - , durationTime = 1.0 &= help "How long the GIF lasts (in seconds) from the start time." - , widthSize = 500 &= help "How wide the GIF needs to be. Height will scale to match." - , qualityPercent = 100.0 &= help "Ranges from 0.0 to 100.0." - , fontChoice = "default" &= help "Choose your desired font for the top and bottom text." - , topText = "" &= help "The text you wish to add to the top of the GIF." - , bottomText = "" &= help "The text you wish to add to the bottom of the GIF." - -- VERSION - } &= summary info - &= program "gifcurry_cli" +cliArgs = + CliArgs + { input_file + = "" + &= groupname "FILE IO" + &= typFile + &= help "The input video file path and name." + , output_file + = "" + &= groupname "FILE IO" + &= typFile + &= help "The output GIF file path and name." + , save_as_video + = False + &= groupname "FILE IO" + &= name "m" + &= help "If present, saves the GIF as a video." + , start_time + = 0.0 + &= groupname "TIME" + &= name "s" + &= help "The start time (in seconds) for the first frame." + , duration_time + = 1.0 + &= groupname "TIME" + &= help "How long the GIF lasts (in seconds) from the start time." + , width_size + = 500 + &= groupname "OUTPUT FILE SIZE" + &= help "How wide the GIF needs to be. Height will scale to match." + , quality_percent + = 100.0 + &= groupname "OUTPUT FILE SIZE" + &= help + ( "From 1 (very low quality) to 100 (the best quality). " + ++ "Controls how many colors are used and how many frames per second there are." + ) + , font_choice + = Gifcurry.defaultFontChoice + &= groupname "TEXT" + &= typ "TEXT" + &= help "Choose your desired font for the top and bottom text." + , top_text + = "" + &= groupname "TEXT" + &= typ "TEXT" + &= name "t" + &= help "The text you wish to add to the top of the GIF." + , bottom_text + = "" + &= groupname "TEXT" + &= typ "TEXT" + &= name "b" + &= help "The text you wish to add to the bottom of the GIF." + , left_crop + = 0.0 + &= groupname "CROP" + &= name "L" + &= help "The amount you wish to crop from the left." + , right_crop + = 0.0 + &= groupname "CROP" + &= name "R" + &= help "The amount you wish to crop from the right." + , top_crop + = 0.0 + &= groupname "CROP" + &= name "T" + &= help "The amount you wish to crop from the top." + , bottom_crop + = 0.0 + &= groupname "CROP" + &= name "B" + &= help "The amount you wish to crop from the bottom." + } + &= summary info + &= program programName + &= details ["Visit https://github.com/lettier/gifcurry for more information.", ""] main :: IO () main = do cliArgs' <- cmdArgs cliArgs let params = makeGifParams cliArgs' - printHeader + putStrLn info paramsValid <- Gifcurry.gifParamsValid params if paramsValid - then do - _ <- Gifcurry.gif params - return () - else printUsage + then void $ Gifcurry.gif params + else + putStrLn $ + "[INFO] Type \"" ++ programName ++ " -?\" for help." return () makeGifParams :: CliArgs -> Gifcurry.GifParams -makeGifParams CliArgs { - inputFile - , outputFile - , startTime - , durationTime - , widthSize - , qualityPercent - , fontChoice - , topText - , bottomText - } = Gifcurry.GifParams { - Gifcurry.inputFile = inputFile - , Gifcurry.outputFile = outputFile - , Gifcurry.startTime = startTime - , Gifcurry.durationTime = durationTime - , Gifcurry.widthSize = widthSize - , Gifcurry.qualityPercent = qualityPercent - , Gifcurry.fontChoice = fontChoice - , Gifcurry.topText = topText - , Gifcurry.bottomText = bottomText - } - -printUsage :: IO () -printUsage = putStrLn $ unwords [ - "\n" - , "Usage:" - , "\n\t" - , "$ gifcurry_cli \\" - , "\n\t" - , "-i inputFile \\" - , "\n\t" - , "-o outputFile \\" - , "\n\t" - , "-s startTime \\" - , "\n\t" - , "-d durationTime \\" - , "\n\t" - , "-w widthSize \\" - , "\n\t" - , "-q qualityPercent \\" - , "\n\t" - , "-f fontChoice \\" - , "\n\t" - , "-t topText \\" - , "\n\t" - , "-b bottomText" - ] +makeGifParams + CliArgs + { input_file + , output_file + , save_as_video + , start_time + , duration_time + , width_size + , quality_percent + , font_choice + , top_text + , bottom_text + , left_crop + , right_crop + , top_crop + , bottom_crop + } + = + Gifcurry.GifParams + { Gifcurry.inputFile = input_file + , Gifcurry.outputFile = output_file + , Gifcurry.saveAsVideo = save_as_video + , Gifcurry.startTime = start_time + , Gifcurry.durationTime = duration_time + , Gifcurry.widthSize = width_size + , Gifcurry.qualityPercent = quality_percent + , Gifcurry.fontChoice = font_choice + , Gifcurry.topText = top_text + , Gifcurry.bottomText = bottom_text + , Gifcurry.leftCrop = left_crop + , Gifcurry.rightCrop = right_crop + , Gifcurry.topCrop = top_crop + , Gifcurry.bottomCrop = bottom_crop + } -printHeader :: IO () -printHeader = mapM_ putStrLn [ - " _____ _ __ " - , "| __ (_)/ _| " - , "| | \\/_| |_ ___ _ _ _ __ _ __ _ _ " - , "| | __| | _/ __| | | | '__| '__| | | |" - , "| |_\\ \\ | || (__| |_| | | | | | |_| |" - , " \\____/_|_| \\___|\\__,_|_| |_| \\__, |" - , " __/ |" - , " |___/ " - , info - ] +logo :: String +logo = + unlines + [ "" + , " ╓╦NÑ╫╫╫╫╫ÑNw, " + , " , `Ñ╫╫╫╫Ñ `'╩╫╫╫Ñw ,╓ææµ ║▓▓⌐ ,▄▄▓▄ " + , " ]╫Ñ Ñ╫╫╫ ,╫N ╙╫╫╫╫Ñ ╓▓▓▀╙╙▀╨ .╓, ,▓▓▌, ,╓╥╓, ,, ,,, ,, ,╓ ,, ,╓ ,, ., " + , " ]╫╫╫Ñ '╫╫⌐ Ñ╫⌐ Ñ╫╫╫╫Ñ -▓▓M ╥╥╥╥ ▐▓▓ ▀▓▓▀▀ ▄▓▀╙▀▀ ▓▓Γ ╫▓▌ ╫▓▓▌▀ ▓▓▓▀▀╙▓▓ ▓▓▀" + , " ╩╫╫╫╫H ╠Ñ 1╫H ╫ '╫╫╫╫╣ ▓▓H ╙▐▓▓ ▐▓▓ ▓▓Γ ▐▓▓⌐ ▓▓Γ ╫▓▌ ╫▓▌ ▓▓▌ ║▓▌╢▓▌ " + , " ]╫╫╫╫╫ ' j╫Å j╫H ╠╫╫╫╫ ╙▓▓▄▄▄▓▓ ▐▓▓ ▓▓Γ ▀▓▌▄▄▄ ▓▓▌▄▓▓▌ ╫▓▌ ▓▓▌ ▓▓▓▓ " + , " Ñ╫╫╫╫N jÑ╬ .╫╫╫⌐ Ñ╫╬┘ └╙╙╙└ `└└ └└` ╙╙╙` ╙╙└`└` `└└ └└` ,▓▓▀ " + , " ╨╫╫╫╫N '┘ ╬╫╫╫╫ ╩` ▀▀▀└ " + , " `╙Ñ╫╫╫N╦╦╫╫╫╫╫╩ " + , " `'╙╙╙╙'`` " + , "" + ] diff --git a/src/data/gifcurry-icon.png b/src/data/gifcurry-icon.png deleted file mode 100644 Binary files a/src/data/gifcurry-icon.png and /dev/null differ diff --git a/src/data/gifcurry-icon.svg b/src/data/gifcurry-icon.svg new file mode 100644 --- /dev/null +++ b/src/data/gifcurry-icon.svg @@ -0,0 +1,139 @@ + + + + + + + image/svg+xml + + + + + + + + + + + + + + Gifcurr + λ + Gifcurr + λ + λ + Gifcurr + + + + © 2018 David Lettier + + diff --git a/src/data/gifcurry-logo.svg b/src/data/gifcurry-logo.svg --- a/src/data/gifcurry-logo.svg +++ b/src/data/gifcurry-logo.svg @@ -5,13 +5,15 @@ xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#" xmlns:svg="http://www.w3.org/2000/svg" xmlns="http://www.w3.org/2000/svg" - viewBox="0 0 384 384" - height="384" - width="384" + width="190.297mm" + height="54.21814mm" + viewBox="0 0 190.297 54.21814" version="1.1" - id="svg4247"> + id="svg8"> + + id="metadata5"> @@ -22,122 +24,192 @@ - + id="path6070" + d="M 26.895901,1.0049911 A 25.513393,25.513393 0 0 0 11.503043,6.5989714 c 0.133368,0.18103 0.263304,0.36156 0.393258,0.54208 a 25.513393,25.513393 0 0 1 15.683797,-6.1153903 25.513393,25.513393 0 0 0 -0.684197,-0.0207 z M 8.1420083,9.8240914 a 25.513393,25.513393 0 0 0 -6.250264,17.1860296 25.513393,25.513393 0 0 0 25.9973787,25.01191 25.513393,25.513393 0 0 0 0.382921,-0.0207 25.513393,25.513393 0 0 1 -25.3219667,-24.99124 25.513393,25.513393 0 0 1 5.66632,-16.52147 c -0.155829,-0.22395 -0.313022,-0.44708 -0.474389,-0.6645596 z" + style="display:inline;opacity:1;fill:#ff29ac;fill-opacity:1;fill-rule:evenodd;stroke:none;stroke-width:10;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:fill markers stroke" /> + id="path6068" + d="m 29.470937,1.0049911 a 25.513393,25.513393 0 0 0 -0.433565,0.0238 25.513393,25.513393 0 0 1 25.219134,24.9726399 l 5.3e-4,0.031 a 25.513393,25.513393 0 0 1 -5.50561,16.28325 c 0.1834,0.26966 0.3692,0.53514 0.56018,0.79478 a 25.513393,25.513393 0 0 0 6.17275,-17.07803 l -5.3e-4,-0.031 A 25.513393,25.513393 0 0 0 29.470937,1.0049911 Z M 45.500456,45.710271 a 25.513393,25.513393 0 0 1 -15.819712,6.28747 25.513393,25.513393 0 0 0 0.783415,0.0243 25.513393,25.513393 0 0 0 15.502927,-5.66839 c -0.1577,-0.21469 -0.31368,-0.42907 -0.46663,-0.64337 z" + style="display:inline;opacity:1;fill:#29ffa4;fill-opacity:1;fill-rule:evenodd;stroke:none;stroke-width:10;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:fill markers stroke" /> + style="display:inline;opacity:1;fill:#1b59a2;fill-opacity:1;fill-rule:evenodd;stroke:none;stroke-width:10;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:fill markers stroke" + d="M 28.483401,1.0049911 A 25.513393,25.513393 0 0 0 12.420817,7.1343314 c 3.454616,4.7973296 5.736982,9.5883596 8.496639,23.9385896 l 7.284826,-24.5793696 0.451135,0.11162 0.02223,-0.11162 c 7.861179,1.46742 10.534349,4.7168696 12.525849,13.2069396 3.15251,13.38741 5.09705,18.65842 7.79436,22.62188 a 25.513393,25.513393 0 0 0 5.50095,-16.28997 l -5.3e-4,-0.031 A 25.513393,25.513393 0 0 0 28.483401,1.0049911 Z M 9.1414303,10.482451 a 25.513393,25.513393 0 0 0 -5.662186,16.52767 25.513393,25.513393 0 0 0 25.9973787,25.01191 25.513393,25.513393 0 0 0 16.268773,-6.304 c -3.38483,-4.74042 -5.64381,-9.58763 -8.370031,-23.76393 l -7.28431,24.57938 -0.451652,-0.11162 -0.02222,0.11162 c -7.861171,-1.46742 -10.534351,-4.71687 -12.52585,-13.20695 -3.212296,-13.64125 -5.171564,-18.85363 -7.9499027,-22.84408 z m 22.5267897,0.85214 -7.606255,23.40684 h -2.148704 c 0.8393,3.5098 2.013317,5.65789 4.711855,6.95152 l 7.605739,-23.40736 h 2.149221 c -0.839229,-3.50953 -2.013754,-5.65733 -4.711856,-6.951 z" + id="path4679" /> + id="path4681" + d="M 28.237847,1.0049911 A 25.513393,25.513393 0 0 0 12.175263,7.1343314 c 3.454616,4.7973296 5.736982,9.5883596 8.496639,23.9385896 l 7.284826,-24.5793696 0.451135,0.11162 0.02223,-0.11162 c 7.861179,1.46742 10.534343,4.7168696 12.525843,13.2069396 3.15251,13.38741 5.09705,18.65842 7.79436,22.62188 a 25.513393,25.513393 0 0 0 5.50095,-16.28997 l -5.3e-4,-0.031 A 25.513393,25.513393 0 0 0 28.237847,1.0049911 Z M 8.8958763,10.482451 a 25.513393,25.513393 0 0 0 -5.662186,16.52767 25.513393,25.513393 0 0 0 25.9973787,25.01191 25.513393,25.513393 0 0 0 16.268767,-6.304 c -3.38483,-4.74042 -5.64381,-9.58763 -8.370025,-23.76393 l -7.28431,24.57938 -0.451652,-0.11162 -0.02222,0.11162 c -7.861171,-1.46742 -10.534351,-4.71687 -12.52585,-13.20695 -3.212296,-13.64125 -5.171564,-18.85363 -7.9499027,-22.84408 z m 22.5267897,0.85214 -7.606255,23.40684 h -2.148704 c 0.8393,3.5098 2.013317,5.65789 4.711855,6.95152 l 7.605739,-23.40736 h 2.149221 c -0.839229,-3.50953 -2.013754,-5.65733 -4.711856,-6.951 z" + style="display:inline;opacity:1;fill:#1b59a2;fill-opacity:1;fill-rule:evenodd;stroke:none;stroke-width:10;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:fill markers stroke" /> + id="path4648" + d="M 27.954234,1.0049911 A 25.513393,25.513393 0 0 0 11.89165,7.1343314 c 3.454616,4.7973296 5.736982,9.5883596 8.496639,23.9385896 l 7.284826,-24.5793696 0.451135,0.11162 0.02223,-0.11162 c 7.861179,1.46742 10.534346,4.7168696 12.525846,13.2069396 3.15251,13.38741 5.09705,18.65842 7.79436,22.62188 a 25.513393,25.513393 0 0 0 5.50095,-16.28997 l -5.3e-4,-0.031 A 25.513393,25.513393 0 0 0 27.954234,1.0049911 Z M 8.6122633,10.482451 a 25.513393,25.513393 0 0 0 -5.662186,16.52767 25.513393,25.513393 0 0 0 25.9973787,25.01191 25.513393,25.513393 0 0 0 16.26877,-6.304 c -3.38483,-4.74042 -5.64381,-9.58763 -8.370028,-23.76393 l -7.28431,24.57938 -0.451652,-0.11162 -0.02222,0.11162 C 21.226845,45.066061 18.553665,41.816611 16.562166,33.326531 13.34987,19.685281 11.390602,14.472901 8.6122633,10.482451 Z m 22.5267897,0.85214 -7.606255,23.40684 h -2.148704 c 0.8393,3.5098 2.013317,5.65789 4.711855,6.95152 l 7.605739,-23.40736 h 2.149221 c -0.839229,-3.50953 -2.013754,-5.65733 -4.711856,-6.951 z" + style="display:inline;opacity:1;fill:#5294e2;fill-opacity:1;fill-rule:evenodd;stroke:none;stroke-width:10;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:fill markers stroke" /> + d="m 71.302315,9.6945374 c -6.561666,0 -11.712222,4.5155556 -11.712222,12.8058336 0,8.360834 3.739444,12.841111 11.218334,12.841111 3.069166,0 6.244166,-0.9525 8.784166,-2.575277 V 20.665927 h -9.348611 l 0.564445,4.092222 h 3.175 v 5.538611 c -1.023056,0.564445 -2.116667,0.811389 -3.316112,0.811389 -3.386666,0 -5.08,-2.187222 -5.08,-8.607778 0,-6.067778 2.54,-8.607778 5.961945,-8.607778 1.975555,0 3.316111,0.599722 4.974167,1.869722 l 2.928055,-3.069166 C 77.440649,10.92926 74.865371,9.6945374 71.302315,9.6945374 Z" + style="font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;font-size:35.27777863px;line-height:125%;font-family:'Fira Sans';-inkscape-font-specification:'Fira Sans Bold';font-variant-ligatures:normal;font-variant-caps:normal;font-variant-numeric:normal;font-feature-settings:normal;text-align:start;letter-spacing:0px;word-spacing:0px;writing-mode:lr-tb;text-anchor:start;fill:#2e323c;fill-opacity:1;stroke:none;stroke-width:0.26458332px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" + id="path5020" /> + d="m 86.102446,6.1314818 c -1.940278,0 -3.280833,1.3758334 -3.280833,3.1750001 0,1.7991671 1.340555,3.1750001 3.280833,3.1750001 1.940278,0 3.316111,-1.375833 3.316111,-3.1750001 0,-1.7991667 -1.375833,-3.1750001 -3.316111,-3.1750001 z m 2.822222,9.8777782 h -5.573889 v 18.7325 h 5.573889 z" + style="font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;font-size:35.27777863px;line-height:125%;font-family:'Fira Sans';-inkscape-font-specification:'Fira Sans Bold';font-variant-ligatures:normal;font-variant-caps:normal;font-variant-numeric:normal;font-feature-settings:normal;text-align:start;letter-spacing:0px;word-spacing:0px;writing-mode:lr-tb;text-anchor:start;fill:#2e323c;fill-opacity:1;stroke:none;stroke-width:0.26458332px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" + id="path5022" /> + d="m 101.84516,12.093426 c 0.81139,0 1.86972,0.176389 2.92805,0.705556 l 1.51695,-3.6336112 c -1.37584,-0.7055556 -3.175,-1.1994445 -5.11528,-1.1994445 -4.797779,0 -7.16139,2.7869447 -7.16139,6.3852777 v 1.658056 h -2.822223 v 3.880555 H 94.01349 V 34.74176 h 5.573889 V 19.889815 h 3.810001 l 0.59972,-3.880555 h -4.409721 v -1.446389 c 0,-1.763889 0.635001,-2.469445 2.257781,-2.469445 z" + style="font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;font-size:35.27777863px;line-height:125%;font-family:'Fira Sans';-inkscape-font-specification:'Fira Sans Bold';font-variant-ligatures:normal;font-variant-caps:normal;font-variant-numeric:normal;font-feature-settings:normal;text-align:start;letter-spacing:0px;word-spacing:0px;writing-mode:lr-tb;text-anchor:start;fill:#2e323c;fill-opacity:1;stroke:none;stroke-width:0.26458332px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" + id="path5024" /> + d="m 113.58218,15.409538 c -5.60916,0 -9.17222,4.162777 -9.17222,10.124722 0,5.926667 3.52778,9.807222 9.27806,9.807222 2.57527,0 4.58611,-0.846666 6.31472,-2.2225 l -2.43417,-3.457222 c -1.34055,0.846667 -2.25778,1.27 -3.59833,1.27 -2.2225,0 -3.70417,-1.27 -3.70417,-5.432778 0,-4.198055 1.37583,-5.820833 3.77472,-5.820833 1.27,0 2.36361,0.423333 3.56306,1.340555 l 2.39889,-3.316111 c -1.79917,-1.516944 -3.81,-2.293055 -6.42056,-2.293055 z" + style="font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;font-size:35.27777863px;line-height:125%;font-family:'Fira Sans';-inkscape-font-specification:'Fira Sans Bold';font-variant-ligatures:normal;font-variant-caps:normal;font-variant-numeric:normal;font-feature-settings:normal;text-align:start;letter-spacing:0px;word-spacing:0px;writing-mode:lr-tb;text-anchor:start;fill:#2e323c;fill-opacity:1;stroke:none;stroke-width:0.26458332px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" + id="path5026" /> + d="m 137.80919,16.00926 h -5.57388 v 13.0175 c -0.81139,1.411111 -1.86973,2.187222 -3.03389,2.187222 -1.16417,0 -1.79917,-0.564444 -1.79917,-2.469444 V 16.00926 h -5.57389 v 13.440833 c 0,3.633612 1.72861,5.891389 5.22111,5.891389 2.46945,0 4.30389,-0.987777 5.67972,-2.963333 l 0.24695,2.363611 h 4.83305 z" + style="font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;font-size:35.27777863px;line-height:125%;font-family:'Fira Sans';-inkscape-font-specification:'Fira Sans Bold';font-variant-ligatures:normal;font-variant-caps:normal;font-variant-numeric:normal;font-feature-settings:normal;text-align:start;letter-spacing:0px;word-spacing:0px;writing-mode:lr-tb;text-anchor:start;fill:#2e323c;fill-opacity:1;stroke:none;stroke-width:0.26458332px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" + id="path5028" /> + d="m 152.35301,15.480093 c -2.15194,0 -3.98639,1.552222 -4.83305,4.162778 l -0.45861,-3.633611 h -4.86834 v 18.7325 h 5.57389 v -9.278056 c 0.59972,-2.8575 1.55222,-4.586111 3.88056,-4.586111 0.635,0 1.09361,0.105834 1.69333,0.246945 l 0.88195,-5.3975 c -0.59973,-0.176389 -1.16417,-0.246945 -1.86973,-0.246945 z" + style="font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;font-size:35.27777863px;line-height:125%;font-family:'Fira Sans';-inkscape-font-specification:'Fira Sans Bold';font-variant-ligatures:normal;font-variant-caps:normal;font-variant-numeric:normal;font-feature-settings:normal;text-align:start;letter-spacing:0px;word-spacing:0px;writing-mode:lr-tb;text-anchor:start;fill:#2e323c;fill-opacity:1;stroke:none;stroke-width:0.26458332px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" + id="path5030" /> + d="m 166.47791,15.480093 c -2.15195,0 -3.98639,1.552222 -4.83306,4.162778 l -0.45861,-3.633611 h -4.86833 v 18.7325 h 5.57389 v -9.278056 c 0.59972,-2.8575 1.55222,-4.586111 3.88055,-4.586111 0.635,0 1.09361,0.105834 1.69333,0.246945 l 0.88195,-5.3975 c -0.59972,-0.176389 -1.16417,-0.246945 -1.86972,-0.246945 z" + style="font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;font-size:35.27777863px;line-height:125%;font-family:'Fira Sans';-inkscape-font-specification:'Fira Sans Bold';font-variant-ligatures:normal;font-variant-caps:normal;font-variant-numeric:normal;font-feature-settings:normal;text-align:start;letter-spacing:0px;word-spacing:0px;writing-mode:lr-tb;text-anchor:start;fill:#2e323c;fill-opacity:1;stroke:none;stroke-width:0.26458332px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" + id="path5032" /> + d="m 172.69367,42.749608 -0.67028,-3.81 c 3.59833,-0.564444 4.72722,-1.516944 5.75028,-4.198055 h -1.97556 l -5.67972,-18.062223 5.50333,-1.27 3.42195,15.063612 c 1.34055,-8.11389 2.46944,-11.430001 4.72722,-15.063612 l 5.36222,1.763889 c -2.50472,3.386667 -3.66889,6.914445 -5.89139,16.333611 -1.51694,6.561667 -4.48028,8.360834 -10.54805,9.242778 z" + style="font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;font-size:35.27777863px;line-height:125%;font-family:'Fira Sans';-inkscape-font-specification:'Fira Sans Bold';text-align:start;letter-spacing:0px;word-spacing:0px;writing-mode:lr-tb;text-anchor:start;display:inline;fill:#2e323c;fill-opacity:1;stroke:none;stroke-width:0.26458332px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" + id="path4938" /> - - - - - - - - - - - (C) DAVID LETTIER - Gifcurry + d="m 71.138413,9.6945374 c -6.561667,0 -11.712222,4.5155556 -11.712222,12.8058336 0,8.360834 3.739444,12.841111 11.218333,12.841111 3.069167,0 6.244167,-0.9525 8.784167,-2.575277 V 20.665927 H 70.08008 l 0.564444,4.092222 h 3.175 v 5.538611 c -1.023055,0.564445 -2.116666,0.811389 -3.316111,0.811389 -3.386667,0 -5.08,-2.187222 -5.08,-8.607778 0,-6.067778 2.54,-8.607778 5.961945,-8.607778 1.975555,0 3.316111,0.599722 4.974166,1.869722 L 79.28758,12.693149 C 77.276747,10.92926 74.701469,9.6945374 71.138413,9.6945374 Z" + style="font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;font-size:35.27777863px;line-height:125%;font-family:'Fira Sans';-inkscape-font-specification:'Fira Sans Bold';font-variant-ligatures:normal;font-variant-caps:normal;font-variant-numeric:normal;font-feature-settings:normal;text-align:start;letter-spacing:0px;word-spacing:0px;writing-mode:lr-tb;text-anchor:start;fill:#2e323c;fill-opacity:1;stroke:none;stroke-width:0.26458332px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1" + id="path5042" /> + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/src/data/gui.glade b/src/data/gui.glade --- a/src/data/gui.glade +++ b/src/data/gui.glade @@ -1,531 +1,1230 @@ - - - - - - - - - True - False - gtk-about - - - True - False - 5 - 5 - gtk-save - 2 - - - gtk-no - True - True - True - True - True - - - True - False - 5 - 5 - gtk-open - 2 - - - 400 - False - center - Gifcurry - False - mouse - 400 - gifcurry-icon.png - center - - - True - False - vertical - - - True - False - - - True - False - Select an input file. - True - False - Gifcurry - Select an Input File - - - True - True - 0 - - - - - True - True - True - Information about Gifcurry. - about-image - True - - - False - False - end - 1 - - - - - False - False - 0 - - - - - True - False - True - - - True - True - Start time. - none - gtk-media-play - Start Time (seconds) - number - - - False - True - 0 - - - - - True - True - Duration. - 0 - gtk-media-stop - Duration (seconds) - number - - - False - True - 1 - - - - - False - True - 2 - - - - - True - False - True - - - True - True - GIF width in px. - none - gtk-justify-fill - Width (pixels) - number - - - False - True - 0 - - - - - True - True - GIF quality from 1 to 100. - 3 - 3 - 3 - gtk-preferences - Quality [1-100] - number - - - True - True - 1 - - - - - True - True - 3 - - - - - font_chooser_button - True - True - True - Choose your desired font for the bottom and top text. - Sans 12 - I love making GIFs with Gifcurry! - Gifcurry - Choose a Font - True - False - False - - - True - True - 4 - - - - - True - True - Optional top text. - gtk-italic - Optional top text. - - - True - True - 5 - - - - - True - True - Optional bottom text. - gtk-italic - Text will show up at the bottom of the GIF. - Optional bottom text. - - - False - True - 6 - - - - - True - False - - - False - True - 7 - - - - - True - False - Select an output folder. - select-folder - Gifcurry - Select an Output Folder - - - True - True - 8 - - - - - True - True - Output file name. - none - gtk-file - Output file name. - - - False - True - 9 - - - - - True - False - - - True - False - First frame preview. - center - center - gtk-discard - 0 - 0 - - - True - True - 0 - - - - - True - False - Last frame preview. - center - center - gtk-discard - 0 - 0 - - - True - True - end - 1 - - - - - True - False - vertical - - - False - True - 2 - - - - - True - True - 10 - - - - - True - False - True - - - Create - True - True - True - Create the GIF. - create-icon - half - top - True - - - True - True - 0 - - - - - Open - True - True - True - Open the GIF. - open-icon - half - top - True - - - True - True - end - 1 - - - - - False - True - 11 - - - - - True - False - True - - - button - True - True - True - https://giphy.com/create/upload - end - https://giphy.com/create/upload - - - True - True - 0 - - - - - True - False - False - False - baseline - baseline - vertical - - - False - False - 1 - - - - - button - True - True - True - https://www.imgur.com/ - start - https://imgur.com/upload - - - True - True - end - 2 - - - - - False - True - 12 - - - - - True - False - False - True - True - top - - - True - False - True - False - True - True - False - False - Ready. - none - False - gtk-about - False - False - - - True - True - 0 - - - - - True - True - 13 - - - - - - - - - - False - Gifcurry - About - center - True - dialog-information - dialog - True - center - gifcurry-window - gifcurry-window - Gifcurry - 2.3.0.0 +Copyright (c) 2016 David Lettier +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of the nor the + names of its contributors may be used to endorse or promote products + derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL BE LIABLE FOR ANY +DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +Author: David Lettier + +--> + + + + + + + + + True + False + gtk-about + 3 + + + 100 + 1 + + + True + False + gtk-cut + + + 1 + + + True + False + gtk-dnd-multiple + + + True + True + False + True + True + vertical + + + True + True + False + + + True + True + False + + + True + True + False + This is the first frame of the GIF. + True + gtk-missing-image + 0 + + + -1 + + + + + True + False + True + + + 1 + + + + + True + True + 0 + + + + + True + False + False + vertical + + + False + True + 1 + + + + + True + True + False + + + True + True + False + This is the last frame of the GIF. + True + gtk-missing-image + 0 + + + -1 + + + + + True + False + True + + + 1 + + + + + True + True + 2 + + + + + False + True + 1 + + + + + True + False + True + + + First Frame + True + False + False + False + Last Frame + 0.98999999999999999 + True + True + + + True + True + 0 + + + + + Last Frame + True + False + False + False + False + First Frame + True + True + + + True + True + end + 1 + + + + + True + True + end + 4 + + + + + 100 + 1 + + + gtk-no + True + True + True + True + True + + + True + False + 5 + 5 + gtk-open + 2 + + + 1 + 100 + 100 + 1 + + + 100 + 1 + + + True + False + 5 + 5 + gtk-save + 2 + + + True + False + gtk-save + + + 1 + + + True + False + gtk-italic + + + 100 + 1 + + + True + False + gtk-sort-descending + + + True + False + gtk-media-record + + + True + True + False + This is a video preview of the GIF. + True + True + vertical + + + True + True + False + + + True + True + False + vertical + + + + + + -1 + + + + + True + False + + + + + True + True + 0 + + + + + 1 + 3840 + 500 + 1 + + + True + False + gtk-justify-fill + + + 900 + True + False + Gifcurry + mouse + 1000 + gifcurry-icon.svg + center + + + True + True + False + True + True + vertical + + + True + False + + + in-file-chooser-button + True + False + Where is the video you want to make a GIF from? + True + True + Gifcurry - Select an Input Video + + + True + True + 0 + + + + + True + True + True + What is Gifcurry? + about-image + True + + + False + False + end + 1 + + + + + False + False + 1 + + + + + True + True + False + True + True + + + 400 + True + False + True + vertical + + + Width & Quality + width-quality-percent-toggle-button + True + True + False + True + width-toggle-button-image + True + + + False + True + 0 + + + + + False + True + + + width-size-spin-button + True + True + How wide is the GIF? + 500 + 0.13 + gtk-justify-fill + False + False + False + Width Size (pixels) + number + width-size-adjustment + 2 + True + True + if-valid + 500 + + + False + True + 2 + + + + + quality-percent-spin-button + True + True + What is the quality? + 3 + 3 + 100 + 1 + gtk-select-color + False + False + False + Quality Percent + number + quality-percent-adjustment + 2 + True + True + if-valid + 100 + + + False + True + 3 + + + + + False + True + 1 + + + + + True + False + + + False + True + 2 + + + + + Crop + crop-toggle-button + True + True + False + True + crop-toggle-button-image + True + + + False + True + 3 + + + + + False + vertical + + + True + False + True + + + True + True + How much to crop from the left? + gtk-goto-last + False + False + False + Left Crop + digits + left-crop-adjustment + 2 + 2 + True + if-valid + + + False + True + 0 + + + + + True + True + How much to crop from the right? + gtk-goto-first + False + False + False + Right Crop + digits + right-crop-adjustment + 2 + 2 + True + if-valid + + + False + True + 1 + + + + + False + True + 0 + + + + + True + False + True + + + True + True + How much to crop from the top? + gtk-goto-bottom + False + False + False + Top Crop + digits + top-crop-adjustment + 2 + 2 + True + if-valid + + + False + True + 0 + + + + + True + True + How much to crop from the bottom? + gtk-goto-top + False + False + False + digits + bottom-crop-adjustment + 2 + 2 + True + if-valid + + + False + True + 1 + + + + + False + True + 1 + + + + + False + True + 4 + + + + + True + False + + + False + True + 6 + + + + + Top & Bottom Text + top-bottom-text-toggle-button + True + True + False + True + top-bottom-text-toggle-button-image + True + + + False + True + 7 + + + + + False + vertical + + + True + True + What text should go on top? + gtk-italic + False + False + False + Top Text (optional) + + + True + True + 0 + + + + + True + True + What text should go on the bottom? + gtk-italic + False + False + False + Bottom Text (optional) + + + True + True + 1 + + + + + font_chooser_button + True + True + True + What font would you like? + Sans 12 + I love making GIFs with Gifcurry! + Gifcurry - Choose a Font + True + False + False + + + False + True + 2 + + + + + False + True + 8 + + + + + True + False + + + False + True + 9 + + + + + Save & Open + save-open-toggle-button + True + True + False + True + save-toggle-button-image + True + + + False + True + 10 + + + + + False + vertical + + + True + False + True + + + Save as GIF + True + True + False + Save the file as a GIF? + gif-icon-image + True + False + save-as-video-radio-button + + + False + True + 0 + + + + + Save as Video + True + True + False + Save the file as a video? + video-icon-image + True + False + save-as-gif-radio-button + + + False + True + end + 1 + + + + + False + True + 0 + + + + + True + True + Which folder do you want to save to? + select-folder + Gifcurry - Pick a Folder + + + False + True + 1 + + + + + out-file-name-entry + True + True + What is the file name? + gtk-file + False + Output File Name + + + False + True + 2 + + + + + True + False + True + + + False + + + True + True + 0 + + + + + Save + True + True + True + Click here to save the file. + save-icon + True + + + True + True + 1 + + + + + Open + True + True + True + Click here to open the file. + open-icon + True + + + True + True + end + 2 + + + + + False + True + 3 + + + + + False + True + 11 + + + + + True + False + + + False + True + 12 + + + + + Upload + upload-toggle-button + True + True + False + True + upload-toggle-button-image + True + + + False + True + 13 + + + + + False + + + Giphy + giphy-upload-button + True + True + True + Click here to upload to Giphy. + True + + + False + True + 0 + + + + + True + False + False + False + baseline + vertical + + + False + True + 1 + + + + + Imgur + imgur-upload-button + True + True + True + Click here to upload to Imgur. + True + + + False + True + end + 2 + + + + + False + True + 14 + + + + + False + True + 0 + + + + + True + False + vertical + + + False + True + 1 + + + + + True + False + True + True + vertical + + + 600 + True + True + False + True + True + vertical + + + + + + True + True + 0 + + + + + True + False + True + vertical + + + True + False + True + + + start-time-spin-button + 150 + True + True + What is the start time? + True + 0.00 + True + gtk-indent + False + False + False + Start Time (seconds) + digits + start-time-adjustment + 1 + 2 + True + if-valid + + + False + True + 0 + + + + + duration-time-spin-button + 150 + True + True + How long does the GIF run? + True + 0.00 + gtk-refresh + False + False + False + Duration Time (seconds) + digits + duration-time-adjustment + 1 + 2 + True + if-valid + + + False + True + end + 1 + + + + + False + True + 0 + + + + + True + False + True + 0.029999999999999999 + 0.029999999999999999 + + + False + True + 3 + + + + + True + False + True + 0.01 + 0.01 + True + + + False + True + end + 4 + + + + + False + True + end + 1 + + + + + True + True + end + 2 + + + + + True + True + 2 + + + + + True + False + False + True + top + + + True + False + True + True + True + False + False + Ready. + none + False + gtk-info + False + False + False + False + + + False + True + 0 + + + + + False + True + end + 3 + + + + + + + + + + False + Gifcurry - About + center + True + dialog-information + dialog + True + center + gifcurry-window + gifcurry-window + Gifcurry + 3.0.0.0 (C) 2016 David Lettier lettier.com https://github.com/lettier/gifcurry diff --git a/src/gui/GuiMisc.hs b/src/gui/GuiMisc.hs new file mode 100644 --- /dev/null +++ b/src/gui/GuiMisc.hs @@ -0,0 +1,66 @@ +{- + Gifcurry + (C) 2018 David Lettier + lettier.com +-} + +{-# LANGUAGE OverloadedStrings #-} + +module GuiMisc where + +import System.Directory +import Text.Read +import Data.Int +import Data.Maybe +import Data.Text +import qualified GI.Gtk + +enumToInt32 :: (Enum a, Ord a) => a -> Int32 +enumToInt32 enum = fromIntegral (fromEnum enum) :: Int32 + +floatToInt32 :: Float -> Int32 +floatToInt32 f = enumToInt32 (round f :: Int) + +int32ToDouble :: Int32 -> Double +int32ToDouble = fromIntegral + +int32ToFloat :: Int32 -> Float +int32ToFloat = fromIntegral + +entryGetMaybeFloat :: GI.Gtk.Entry -> IO (Maybe Float) +entryGetMaybeFloat entry = do + text <- Data.Text.strip <$> GI.Gtk.entryGetText entry + let containsPeriod = isJust $ Data.Text.find (== '.') text + let string = Data.Text.unpack text + let maybeFloat = readMaybe (string ++ if containsPeriod then "0" else "") :: Maybe Float + return maybeFloat + +entryGetFloat :: GI.Gtk.Entry -> Float -> IO Float +entryGetFloat entry nothing = do + maybeFloat <- entryGetMaybeFloat entry + return $ fromMaybe nothing maybeFloat + +entryGetMaybeInt :: GI.Gtk.Entry -> IO (Maybe Int) +entryGetMaybeInt entry = do + text <- Data.Text.strip <$> GI.Gtk.entryGetText entry + let string = Data.Text.unpack text + let maybeInt = readMaybe string :: Maybe Int + return maybeInt + +fileChooserButtonGetString :: GI.Gtk.FileChooserButton -> IO String +fileChooserButtonGetString = + fmap + (Data.Text.unpack . Data.Text.strip . Data.Text.pack . fromMaybe "") + . GI.Gtk.fileChooserGetFilename + +fileChooserButtonGetFilePath :: GI.Gtk.FileChooserButton -> IO String +fileChooserButtonGetFilePath fileChooserButton = do + result <- fileChooserButtonGetString fileChooserButton + fileExist <- doesFileExist result + return $ + if fileExist + then result + else "" + +safeDivide :: (Fractional a, Eq a) => a -> a -> Maybe a +safeDivide n d = if d == 0.0 then Nothing else Just $ n / d diff --git a/src/gui/GuiPreview.hs b/src/gui/GuiPreview.hs new file mode 100644 --- /dev/null +++ b/src/gui/GuiPreview.hs @@ -0,0 +1,591 @@ +{- + Gifcurry + (C) 2018 David Lettier + lettier.com +-} + +{-# LANGUAGE + OverloadedStrings + , NamedFieldPuns +#-} + +module GuiPreview where + +import GHC.Float +import System.FilePath +import System.IO.Temp +import Data.Int +import Data.Maybe +import Data.Text +import Data.List +import Data.Bits +import Data.IORef +import Data.GI.Base.Properties +import Control.Monad +import Control.Concurrent +import qualified GI.GLib +import qualified GI.Gtk +import qualified GI.Gst +import qualified GI.Cairo +import qualified GiCairoCairoBridge +import qualified Graphics.Rendering.Cairo as GRC + +import qualified Gifcurry + ( gif + , GifParams(..) + , defaultGifParams + ) +import qualified GtkMainSyncAsync (gtkMainSync, gtkMainAsync) +import qualified GuiRecords as GR +import GuiMisc + +blankPreviewIcon :: String +blankPreviewIcon = "gtk-discard" + +framePreviewDirectoryName :: String +framePreviewDirectoryName = "gifcurry-frame-previews" + +buildVideoPreviewWidgetAndPlaybinElement :: IO (Maybe GI.Gtk.Widget, Maybe GI.Gst.Element) +buildVideoPreviewWidgetAndPlaybinElement = do + maybeGtkSink <- GI.Gst.elementFactoryMake "gtksink" (Just "MultimediaPlayerGtkSink") + maybeVideoPreviewWidget <- + case maybeGtkSink of + Nothing -> return Nothing + Just gtkSink -> + Data.GI.Base.Properties.getObjectPropertyObject gtkSink "widget" GI.Gtk.Widget + maybePlaybinElement <- GI.Gst.elementFactoryMake "playbin" (Just "MultimediaPlayerPlaybin") + case (maybeVideoPreviewWidget, maybePlaybinElement) of + (Just videoPreviewWidget, Just playbinElement) -> do + -- Turns off the subtitles. + let flags = flip setBit 10 $ flip setBit 9 $ flip setBit 4 $ flip setBit 1 $ bit 0 + _ <- Data.GI.Base.Properties.setObjectPropertyObject playbinElement "video-sink" maybeGtkSink + _ <- Data.GI.Base.Properties.setObjectPropertyBool playbinElement "force-aspect-ratio" True + _ <- Data.GI.Base.Properties.setObjectPropertyDouble playbinElement "volume" 0.0 + _ <- Data.GI.Base.Properties.setObjectPropertyInt playbinElement "flags" flags + _ <- GI.Gtk.widgetShow videoPreviewWidget + return () + _ -> return () + return (maybeVideoPreviewWidget, maybePlaybinElement) + +runGuiPreview :: GR.GuiComponents -> IO () +runGuiPreview + guiComponents@GR.GuiComponents + { GR.maybeVideoPreviewWidget = (Just videoPreviewWidget) + , GR.maybePlaybinElement = (Just _) + , GR.mainPreviewBox + , GR.videoPreviewBox + , GR.videoPreviewOverlayChildBox + , GR.videoPreviewDrawingArea + } + = do + mainPreviewBoxChildCount <- + Data.List.length <$> GI.Gtk.containerGetChildren mainPreviewBox + when (mainPreviewBoxChildCount <= 0) $ + GI.Gtk.boxPackStart mainPreviewBox videoPreviewBox True True 0 + videoPreviewOverlayChildBoxChildCount <- + Data.List.length <$> GI.Gtk.containerGetChildren videoPreviewOverlayChildBox + when (videoPreviewOverlayChildBoxChildCount <= 0) $ do + _ <- GI.Gtk.boxPackStart videoPreviewOverlayChildBox videoPreviewWidget True True 0 + _ <- GI.Gtk.onWidgetDraw + videoPreviewDrawingArea + (drawCropGrid guiComponents videoPreviewDrawingArea) + return () + runPreviewLoopIfNotRunning + guiComponents $ + preview guiComponents videoPreview +runGuiPreview + guiComponents@GR.GuiComponents + { GR.mainPreviewBox + , GR.imagesPreviewBox + , GR.firstFramePreviewImageDrawingArea + , GR.lastFramePreviewImageDrawingArea + } + = do + childrenCount <- Data.List.length <$> GI.Gtk.containerGetChildren mainPreviewBox + when (childrenCount <= 0) $ do + _ <- GI.Gtk.boxPackStart mainPreviewBox imagesPreviewBox True True 0 + _ <- GI.Gtk.onWidgetDraw + firstFramePreviewImageDrawingArea + (drawCropGrid guiComponents firstFramePreviewImageDrawingArea) + _ <- GI.Gtk.onWidgetDraw + lastFramePreviewImageDrawingArea + (drawCropGrid guiComponents lastFramePreviewImageDrawingArea) + return () + runPreviewLoopIfNotRunning + guiComponents $ + preview guiComponents firstAndLastFramePreview + +runPreviewLoopIfNotRunning :: GR.GuiComponents -> IO Bool -> IO () +runPreviewLoopIfNotRunning + GR.GuiComponents + { GR.guiPreviewStateRef } + f + = do + loopRunning <- getLoopRunning + unless loopRunning $ + void $ + GI.GLib.timeoutAdd + GI.GLib.PRIORITY_DEFAULT + 1 + f + where + getLoopRunning :: IO Bool + getLoopRunning = + readIORef guiPreviewStateRef >>= + \ x -> return $ GR.loopRunning x + +preview + :: GR.GuiComponents + -> ( GR.GuiComponents + -> GR.GuiPreviewState + -> String + -> Float + -> Float + -> Float + -> Float + -> IO () + ) + -> IO Bool +preview + guiComponents@GR.GuiComponents + { GR.inFileChooserButton + , GR.startTimeSpinButton + , GR.durationTimeSpinButton + , GR.guiPreviewStateRef + , GR.inVideoPropertiesRef + } + f + = do + GR.InVideoProperties + { GR.inVideoWidth + , GR.inVideoHeight + } <- readIORef inVideoPropertiesRef + guiPreviewState <- readIORef guiPreviewStateRef + inFilePath <- fileChooserButtonGetFilePath inFileChooserButton + startTime <- double2Float <$> GI.Gtk.spinButtonGetValue startTimeSpinButton + durationTime <- double2Float <$> GI.Gtk.spinButtonGetValue durationTimeSpinButton + let invalidInFilePath = inFilePath == "" + let invalidStartTime = startTime < 0.0 + let invalidDurationTime = durationTime <= 0.0 + let invalidInVideoWidth = inVideoWidth <= 0.0 + let invalidInVideoHeight = inVideoHeight <= 0.0 + let inputInvalid = + invalidInFilePath + || invalidStartTime + || invalidDurationTime + || invalidInVideoWidth + || invalidInVideoHeight + if not inputInvalid + then + f + guiComponents + guiPreviewState + inFilePath + startTime + durationTime + inVideoWidth + inVideoHeight + else + resetWindow guiComponents + atomicWriteIORef guiPreviewStateRef + guiPreviewState + { GR.maybeInFilePath = if invalidInFilePath then Nothing else Just inFilePath + , GR.maybeStartTime = if invalidStartTime then Nothing else Just startTime + , GR.maybeDurationTime = if invalidDurationTime then Nothing else Just durationTime + , GR.loopRunning = True + } + return True + +videoPreview + :: GR.GuiComponents + -> GR.GuiPreviewState + -> String + -> Float + -> Float + -> Float + -> Float + -> IO () +videoPreview + GR.GuiComponents + { GR.window + , GR.cropToggleButton + , GR.mainPreviewBox + , GR.videoPreviewBox + , GR.maybePlaybinElement = (Just playbinElement) + } + GR.GuiPreviewState + { GR.maybeInFilePath + , GR.maybeStartTime + } + inFilePath + startTime + durationTime + inVideoWidth + inVideoHeight + = do + GI.Gtk.widgetShow videoPreviewBox + sizePreviewAndWindow + handleChanges + handleCropMode + where + sizePreviewAndWindow :: IO () + sizePreviewAndWindow = do + let widthRatio = inVideoWidth / inVideoHeight + let heightRatio = inVideoHeight / inVideoWidth + let previewWidth = + if inVideoWidth >= inVideoHeight + then desiredPreviewSize + else desiredPreviewSize * widthRatio + let previewHeight = + if inVideoWidth < inVideoHeight + then desiredPreviewSize + else desiredPreviewSize * heightRatio + let previewWidth' = floatToInt32 previewWidth + let previewHeight' = floatToInt32 previewHeight + GI.Gtk.widgetSetSizeRequest + window + previewWidth' + (-1) + GI.Gtk.widgetSetSizeRequest + mainPreviewBox + previewWidth' + previewHeight' + resizeWindow window + handleChanges :: IO () + handleChanges = do + (couldQueryDuration, videoDuration) <- + GI.Gst.elementQueryDuration playbinElement GI.Gst.FormatTime + (couldQueryPosition, videoPosition) <- + GI.Gst.elementQueryPosition playbinElement GI.Gst.FormatTime + let endTime = startTime + durationTime + let startTimeInNano = secondsToNanoseconds startTime + let endTimeInNano = secondsToNanoseconds endTime + let inFilePathChanged = fromMaybe "" maybeInFilePath /= inFilePath + let startTimeChanged = fromMaybe (-1.0) maybeStartTime /= startTime + let startOver = + (couldQueryDuration && couldQueryPosition && videoDuration > 0) + && ( videoPosition >= videoDuration + || videoPosition >= endTimeInNano + || videoPosition < startTimeInNano + ) + let seekToStart = startTimeChanged || inFilePathChanged || startOver + when inFilePathChanged $ do + _ <- GI.Gst.elementSetState playbinElement GI.Gst.StateNull + Data.GI.Base.Properties.setObjectPropertyString + playbinElement + "uri" + (Just $ pack $ "file://" ++ inFilePath) + _ <- Data.GI.Base.Properties.setObjectPropertyDouble playbinElement "volume" 0.0 + resizeWindow window + when seekToStart $ do + _ <- GI.Gst.elementSetState playbinElement GI.Gst.StatePaused + _ <- GI.Gst.elementSeekSimple + playbinElement + GI.Gst.FormatTime + [GI.Gst.SeekFlagsFlush] + startTimeInNano + _ <- GI.Gst.elementSetState playbinElement GI.Gst.StatePlaying + return () + handleCropMode :: IO () + handleCropMode = do + cropModeEnabled <- GI.Gtk.getToggleButtonActive cropToggleButton + if cropModeEnabled + then + void $ Data.GI.Base.Properties.setObjectPropertyBool + playbinElement + "force-aspect-ratio" + False + else + void $ Data.GI.Base.Properties.setObjectPropertyBool + playbinElement + "force-aspect-ratio" + True +videoPreview _ _ _ _ _ _ _ = return () + +firstAndLastFramePreview + :: GR.GuiComponents + -> GR.GuiPreviewState + -> String + -> Float + -> Float + -> Float + -> Float + -> IO () +firstAndLastFramePreview + GR.GuiComponents + { GR.window + , GR.imagesPreviewBox + , GR.firstFrameImage + , GR.lastFrameImage + , GR.firstFramePreviewImageDrawingArea + , GR.lastFramePreviewImageDrawingArea + , GR.temporaryDirectory + } + GR.GuiPreviewState + { GR.maybeInFilePath + , GR.maybeStartTime + , GR.maybeDurationTime + } + inFilePath + startTime + durationTime + _ + _ + = do + GI.Gtk.widgetShow imagesPreviewBox + handleChanges + redrawDrawingAreas + where + handleChanges :: IO () + handleChanges = do + let inFilePathChanged = + fromMaybe "" maybeInFilePath /= inFilePath + let startTimeChanged = + fromMaybe (-1.0) maybeStartTime /= startTime + let durationTimeChanged = + fromMaybe (-1.0) maybeDurationTime /= durationTime + let firstAndLastFrameDirty = inFilePathChanged || startTimeChanged + let lastFrameDirty = not firstAndLastFrameDirty && durationTimeChanged + when firstAndLastFrameDirty $ + makeFirstAndLastFramePreview + inFilePath + startTime + durationTime + firstFrameImage + lastFrameImage + temporaryDirectory + window + when lastFrameDirty $ + makeLastFramePreview + inFilePath + startTime + durationTime + lastFrameImage + temporaryDirectory + window + redrawDrawingAreas :: IO () + redrawDrawingAreas = do + GI.Gtk.widgetQueueDraw firstFramePreviewImageDrawingArea + GI.Gtk.widgetQueueDraw lastFramePreviewImageDrawingArea + +drawCropGrid :: GR.GuiComponents -> GI.Gtk.DrawingArea -> GI.Cairo.Context -> IO Bool +drawCropGrid + GR.GuiComponents + { GR.cropToggleButton + , GR.leftCropSpinButton + , GR.rightCropSpinButton + , GR.topCropSpinButton + , GR.bottomCropSpinButton + , GR.inVideoPropertiesRef + } + drawingArea + context + = do + GR.InVideoProperties + { GR.inVideoWidth + , GR.inVideoHeight + } <- readIORef inVideoPropertiesRef + cropModeEnabled <- GI.Gtk.getToggleButtonActive cropToggleButton + drawingAreaWidth <- + int32ToDouble <$> GI.Gtk.widgetGetAllocatedWidth drawingArea + drawingAreaHeight <- + int32ToDouble <$> GI.Gtk.widgetGetAllocatedHeight drawingArea + left <- (/ 100.0) <$> GI.Gtk.spinButtonGetValue leftCropSpinButton + right <- (/ 100.0) <$> GI.Gtk.spinButtonGetValue rightCropSpinButton + top <- (/ 100.0) <$> GI.Gtk.spinButtonGetValue topCropSpinButton + bottom <- (/ 100.0) <$> GI.Gtk.spinButtonGetValue bottomCropSpinButton + when (cropModeEnabled && inVideoWidth >= 0.0 && inVideoHeight >= 0.0) $ + GiCairoCairoBridge.renderWithContext context $ do + GRC.setSourceRGBA 0.0 0.0 0.0 0.8 + GRC.setLineWidth 1.0 + -- Left + GRC.rectangle 0.0 0.0 (left * drawingAreaWidth) drawingAreaHeight + GRC.fill + -- Right + GRC.rectangle + (drawingAreaWidth - right * drawingAreaWidth) + 0.0 + (right * drawingAreaWidth) + drawingAreaHeight + GRC.fill + -- Top + GRC.rectangle 0.0 0.0 drawingAreaWidth (top * drawingAreaHeight) + GRC.fill + -- Bottom + GRC.rectangle + 0.0 + (drawingAreaHeight - bottom * drawingAreaHeight) + drawingAreaWidth + (bottom * drawingAreaHeight) + GRC.fill + return False + +resetWindow :: GR.GuiComponents -> IO () +resetWindow + GR.GuiComponents + { GR.window + , GR.mainPreviewBox + , GR.imagesPreviewBox + , GR.videoPreviewBox + } + = do + GI.Gtk.widgetSetSizeRequest + window + 900 + (-1) + GI.Gtk.widgetSetSizeRequest + mainPreviewBox + (floatToInt32 desiredPreviewSize) + (-1) + GI.Gtk.widgetHide imagesPreviewBox + GI.Gtk.widgetHide videoPreviewBox + resizeWindow window + +resizeWindow :: GI.Gtk.Window -> IO () +resizeWindow window = + void $ GI.Gtk.windowResize window 1 1 + +makeFirstAndLastFramePreview + :: String + -> Float + -> Float + -> GI.Gtk.Image + -> GI.Gtk.Image + -> System.FilePath.FilePath + -> GI.Gtk.Window + -> IO () +makeFirstAndLastFramePreview + inFilePath + startTime + durationTime + firstFrameImage + lastFrameImage + temporaryDirectory + window + = do + void $ forkIO $ + withTempDirectory + temporaryDirectory + framePreviewDirectoryName $ + \ tmpDir -> do + let outFilePath = tmpDir ++ "/gifcurry-first-frame-preview.gif" + let inputValid = not (Data.List.null inFilePath) && startTime >= 0.0 + void $ + setOrResetFramePrevew + inputValid + inFilePath + outFilePath + startTime + firstFrameImage + "" + window + makeLastFramePreview + inFilePath + startTime + durationTime + lastFrameImage + temporaryDirectory + window + +makeLastFramePreview + :: String + -> Float + -> Float + -> GI.Gtk.Image + -> System.FilePath.FilePath + -> GI.Gtk.Window + -> IO () +makeLastFramePreview + inFilePath + startTime + durationTime + lastFrameImage + temporaryDirectory + window + = + void $ forkIO $ + withTempDirectory + temporaryDirectory + framePreviewDirectoryName $ + \ tmpdir -> do + let startTime' = startTime + durationTime + let outFilePath = tmpdir ++ "/gifcurry-last-frame-preview.gif" + let inputValid = startTime' > 0.0 && not (Data.List.null inFilePath) + void $ + setOrResetFramePrevew + inputValid + inFilePath + outFilePath + startTime' + lastFrameImage + "" + window + +setOrResetFramePrevew + :: Bool + -> String + -> String + -> Float + -> GI.Gtk.Image + -> String + -> GI.Gtk.Window + -> IO () +setOrResetFramePrevew False _ _ _ image _ window = + GtkMainSyncAsync.gtkMainAsync $ do + resetImage image + resizeWindow window +setOrResetFramePrevew + True + inFilePath + outFilePath + time + image + overlay + window + = do + result <- makeImagePreview inFilePath outFilePath time overlay + case result of + Left _ -> + void $ updatePreviewFrame "" image False + Right filePath -> + void $ updatePreviewFrame filePath image True + GtkMainSyncAsync.gtkMainAsync $ resizeWindow window + +makeImagePreview + :: String + -> String + -> Float + -> String + -> IO (Either IOError String) +makeImagePreview inputFile outputFile startTime bottomText = + Gifcurry.gif $ + Gifcurry.defaultGifParams + { Gifcurry.inputFile = inputFile + , Gifcurry.outputFile = outputFile + , Gifcurry.saveAsVideo = False + , Gifcurry.startTime = startTime + , Gifcurry.durationTime = 0.001 + , Gifcurry.widthSize = 300 + , Gifcurry.qualityPercent = 50.0 + , Gifcurry.bottomText = bottomText + } + +updatePreviewFrame :: String -> GI.Gtk.Image -> Bool -> IO () +updatePreviewFrame filePath image True = + GtkMainSyncAsync.gtkMainSync (GI.Gtk.imageSetFromFile image (Just filePath)) +updatePreviewFrame _ image False = + GtkMainSyncAsync.gtkMainSync (resetImage image) + +resetImage :: GI.Gtk.Image -> IO () +resetImage image = + GI.Gtk.imageSetFromIconName + image + (Just $ pack blankPreviewIcon) + (enumToInt32 GI.Gtk.IconSizeButton) + +secondsToNanoseconds :: Float -> Int64 +secondsToNanoseconds s = + fromIntegral (round (s * 1000000000.0) :: Integer) :: Int64 + +desiredPreviewSize :: Float +desiredPreviewSize = 600.0 diff --git a/src/gui/GuiRecords.hs b/src/gui/GuiRecords.hs new file mode 100644 --- /dev/null +++ b/src/gui/GuiRecords.hs @@ -0,0 +1,104 @@ +{- + Gifcurry + (C) 2018 David Lettier + lettier.com +-} + +module GuiRecords where + +import Data.IORef +import qualified GI.Gtk +import GI.Gst + +data GuiComponents = + GuiComponents + { window :: GI.Gtk.Window + , startTimeSpinButton :: GI.Gtk.SpinButton + , durationTimeSpinButton :: GI.Gtk.SpinButton + , widthSizeSpinButton :: GI.Gtk.SpinButton + , qualityPercentSpinButton :: GI.Gtk.SpinButton + , leftCropSpinButton :: GI.Gtk.SpinButton + , rightCropSpinButton :: GI.Gtk.SpinButton + , topCropSpinButton :: GI.Gtk.SpinButton + , bottomCropSpinButton :: GI.Gtk.SpinButton + , inFileChooserButton :: GI.Gtk.FileChooserButton + , outFileChooserButton :: GI.Gtk.FileChooserButton + , fontChooserButton :: GI.Gtk.FontButton + , saveButton :: GI.Gtk.Button + , openButton :: GI.Gtk.Button + , yesGtkButton :: GI.Gtk.Button + , noGtkButton :: GI.Gtk.Button + , aboutButton :: GI.Gtk.Button + , giphyUploadButton :: GI.Gtk.Button + , imgurUploadButton :: GI.Gtk.Button + , saveAsVideoRadioButton :: GI.Gtk.RadioButton + , widthQualityPercentToggleButton :: GI.Gtk.ToggleButton + , cropToggleButton :: GI.Gtk.ToggleButton + , topBottomTextToggleButton :: GI.Gtk.ToggleButton + , saveOpenToggleButton :: GI.Gtk.ToggleButton + , uploadToggleButton :: GI.Gtk.ToggleButton + , startTimeAdjustment :: GI.Gtk.Adjustment + , durationTimeAdjustment :: GI.Gtk.Adjustment + , widthSizeAdjustment :: GI.Gtk.Adjustment + , qualityPercentAdjustment :: GI.Gtk.Adjustment + , outFileNameEntry :: GI.Gtk.Entry + , topTextEntry :: GI.Gtk.Entry + , bottomTextEntry :: GI.Gtk.Entry + , statusEntry :: GI.Gtk.Entry + , mainPreviewBox :: GI.Gtk.Box + , imagesPreviewBox :: GI.Gtk.Box + , videoPreviewBox :: GI.Gtk.Box + , videoPreviewOverlayChildBox :: GI.Gtk.Box + , widthQualityPercentBox :: GI.Gtk.Box + , cropSpinButtonsBox :: GI.Gtk.Box + , topBottomTextFontChooserBox :: GI.Gtk.Box + , saveOpenBox :: GI.Gtk.Box + , uploadBox :: GI.Gtk.Box + , videoPreviewDrawingArea :: GI.Gtk.DrawingArea + , firstFramePreviewImageDrawingArea :: GI.Gtk.DrawingArea + , lastFramePreviewImageDrawingArea :: GI.Gtk.DrawingArea + , firstFrameImage :: GI.Gtk.Image + , lastFrameImage :: GI.Gtk.Image + , longGifGtkMessageDialog :: GI.Gtk.MessageDialog + , aboutDialog :: GI.Gtk.AboutDialog + , startTimeLevelBar :: GI.Gtk.LevelBar + , endTimeLevelBar :: GI.Gtk.LevelBar + , saveSpinner :: GI.Gtk.Spinner + , maybeVideoPreviewWidget :: Maybe GI.Gtk.Widget + , maybePlaybinElement :: Maybe GI.Gst.Element + , temporaryDirectory :: FilePath + , guiPreviewStateRef :: IORef GuiPreviewState + , inVideoPropertiesRef :: IORef InVideoProperties + } + +data GuiPreviewState = + GuiPreviewState + { maybeInFilePath :: Maybe String + , maybeStartTime :: Maybe Float + , maybeDurationTime :: Maybe Float + , loopRunning :: Bool + } + +data InVideoProperties = + InVideoProperties + { inVideoDuration :: Float + , inVideoWidth :: Float + , inVideoHeight :: Float + } + +defaultGuiPreviewState :: GuiPreviewState +defaultGuiPreviewState = + GuiPreviewState + { maybeInFilePath = Nothing + , maybeStartTime = Nothing + , maybeDurationTime = Nothing + , loopRunning = False + } + +defaultInVideoProperties :: InVideoProperties +defaultInVideoProperties = + InVideoProperties + { inVideoDuration = 0.0 + , inVideoWidth = 0.0 + , inVideoHeight = 0.0 + } diff --git a/src/gui/Main.hs b/src/gui/Main.hs --- a/src/gui/Main.hs +++ b/src/gui/Main.hs @@ -4,336 +4,870 @@ lettier.com -} -{-# LANGUAGE OverloadedStrings #-} - -import System.Directory -import System.Process -import System.FilePath -import System.Info -import System.IO.Temp -import Text.Read -import Data.Int -import Data.Maybe -import Data.Either -import Data.Char -import Data.Text -import Data.List -import Control.Monad -import Control.Concurrent -import Data.GI.Base -import GI.GObject -import qualified GI.Gtk - -import Paths_Gifcurry -import qualified Gifcurry ( - gif - , GifParams(..) - , defaultGifParams - , gifParamsValid - , getVideoDurationInSeconds - , findOrCreateTemporaryDirectory - ) -import qualified GtkMainSyncAsync (gtkMainSync, gtkMainAsync) - -main :: IO () -main = do - _ <- GI.Gtk.init Nothing - - builder <- buildBuilder - - window <- builderGetObject GI.Gtk.Window builder "gifcurry-window" - startTimeEntry <- builderGetObject GI.Gtk.Entry builder "start-time-text-entry" - durationTimeEntry <- builderGetObject GI.Gtk.Entry builder "duration-text-entry" - widthEntry <- builderGetObject GI.Gtk.Entry builder "width-text-entry" - qualityEntry <- builderGetObject GI.Gtk.Entry builder "quality-text-entry" - topTextEntry <- builderGetObject GI.Gtk.Entry builder "top-text-text-entry" - bottomTextEntry <- builderGetObject GI.Gtk.Entry builder "bottom-text-text-entry" - outputFileNameEntry <- builderGetObject GI.Gtk.Entry builder "output-file-name-text-entry" - statusEntry <- builderGetObject GI.Gtk.Entry builder "status-text-entry" - inputFileButton <- builderGetObject GI.Gtk.FileChooserButton builder "input-file-button" - outputFilePathButton <- builderGetObject GI.Gtk.FileChooserButton builder "output-file-path-button" - fontChooserButton <- builderGetObject GI.Gtk.FontButton builder "font-chooser-button" - createButton <- builderGetObject GI.Gtk.Button builder "create-button" - openButton <- builderGetObject GI.Gtk.Button builder "open-button" - giphyButton <- builderGetObject GI.Gtk.Button builder "giphy-link-button" - imgurButton <- builderGetObject GI.Gtk.Button builder "imgur-link-button" - firstFrameImage <- builderGetObject GI.Gtk.Image builder "first-frame-image" - lastFrameImage <- builderGetObject GI.Gtk.Image builder "last-frame-image" - longGifGtkMessageDialog <- builderGetObject GI.Gtk.MessageDialog builder "long-gif-message-dialog" - yesGtkButton <- builderGetObject GI.Gtk.Button builder "yes-button" - noGtkButton <- builderGetObject GI.Gtk.Button builder "no-button" - aboutButton <- builderGetObject GI.Gtk.Button builder "about-button" - aboutDialog <- builderGetObject GI.Gtk.AboutDialog builder "about-dialog" - - -- Bug in Glade does not allow setting the link button label. - GI.Gtk.buttonSetLabel giphyButton "Giphy" - GI.Gtk.buttonSetLabel imgurButton "Imgur" - - GI.Gtk.entrySetText qualityEntry "100" - GI.Gtk.entrySetText widthEntry "500" - - -- Glade does not allow us to use the response ID nicknames so we setup them up programmatically here. - GI.Gtk.dialogAddActionWidget longGifGtkMessageDialog yesGtkButton (enumToInt32 GI.Gtk.ResponseTypeYes) - GI.Gtk.dialogAddActionWidget longGifGtkMessageDialog noGtkButton (enumToInt32 GI.Gtk.ResponseTypeNo) - - temporaryDirectory <- Gifcurry.findOrCreateTemporaryDirectory - - _ <- GI.Gtk.onFileChooserButtonFileSet inputFileButton $ do - setStatusEntryReady statusEntry - GI.Gtk.imageSetFromIconName firstFrameImage - (Just $ pack blankPreviewIcon) (enumToInt32 GI.Gtk.IconSizeButton) - GI.Gtk.imageSetFromIconName lastFrameImage - (Just $ pack blankPreviewIcon) (enumToInt32 GI.Gtk.IconSizeButton) - inputFilePathName <- inputFileButtonGetText inputFileButton - maybeDuration <- Gifcurry.getVideoDurationInSeconds ( - Gifcurry.defaultGifParams { Gifcurry.inputFile = inputFilePathName } - ) - let duration = fromMaybe 0.5 maybeDuration - 0.5 - let durationText = if duration == 0.0 then "" else pack (show duration) - let startText = if duration == 0.0 then "" else "0.0" - _ <- GI.Gtk.entrySetText startTimeEntry startText - _ <- GI.Gtk.entrySetText durationTimeEntry durationText - unless (Data.Text.null startText || Data.Text.null durationText) ( - makeFirstFramePreview - inputFileButton - startTimeEntry - durationTimeEntry - firstFrameImage - lastFrameImage - temporaryDirectory - ) - - _ <- GI.Gtk.onEditableChanged startTimeEntry $ - makeFirstFramePreview - inputFileButton - startTimeEntry - durationTimeEntry - firstFrameImage - lastFrameImage - temporaryDirectory - - _ <- GI.Gtk.onEditableChanged durationTimeEntry $ - makeLastFramePreview - inputFileButton - startTimeEntry - durationTimeEntry - lastFrameImage - temporaryDirectory - - _ <- GI.Gtk.onWidgetButtonReleaseEvent createButton $ \ _ -> do - inputFilePathName <- inputFileButtonGetText inputFileButton - startTime <- entryGetFloat startTimeEntry (-1.0) - durationTime <- entryGetFloat durationTimeEntry (-1.0) - widthSize' <- entryGetFloat widthEntry 0.0 - let widthSize = truncate widthSize' - qualityPercent <- entryGetFloat qualityEntry (-1.0) - fontChoice <- GI.Gtk.fontButtonGetFontName fontChooserButton - topText <- GI.Gtk.entryGetText topTextEntry - bottomText <- GI.Gtk.entryGetText bottomTextEntry - (_, outputFilePathName) <- assembleOutputFilePathName outputFilePathButton outputFileNameEntry - let params = Gifcurry.defaultGifParams { - Gifcurry.inputFile = inputFilePathName - , Gifcurry.outputFile = outputFilePathName - , Gifcurry.startTime = startTime - , Gifcurry.durationTime = durationTime - , Gifcurry.widthSize = widthSize - , Gifcurry.qualityPercent = qualityPercent - , Gifcurry.fontChoice = unpack fontChoice - , Gifcurry.topText = unpack topText - , Gifcurry.bottomText = unpack bottomText - } - paramsValid <- Gifcurry.gifParamsValid params - setStatusEntryReady statusEntry - if paramsValid - then do - longGifGtkMessageDialogResponse <- if durationTime >= durationTimeWarningLevel - then GI.Gtk.dialogRun longGifGtkMessageDialog - else return (enumToInt32 GI.Gtk.ResponseTypeYes) - when (longGifGtkMessageDialogResponse == enumToInt32 GI.Gtk.ResponseTypeYes) $ - void $ forkOS $ do - GtkMainSyncAsync.gtkMainAsync $ GI.Gtk.entrySetText statusEntry "One GIF coming up!" - success <- (ioSuccess . Gifcurry.gif) params - if not success - then GtkMainSyncAsync.gtkMainAsync $ GI.Gtk.entrySetText statusEntry "Did not work. Check your settings." - else do - _ <- forkOS $ GtkMainSyncAsync.gtkMainAsync $ openGifCommand outputFilePathName - GtkMainSyncAsync.gtkMainAsync $ setStatusEntryReady statusEntry - else GI.Gtk.entrySetText statusEntry "Settings are wrong." - return True - - _ <- GI.Gtk.onWidgetButtonReleaseEvent openButton $ \ _ -> do - (_, outputFilePathName) <- assembleOutputFilePathName outputFilePathButton outputFileNameEntry - fileExists <- doesFileExist outputFilePathName - if fileExists - then void $ forkIO $ GtkMainSyncAsync.gtkMainAsync $ openGifCommand outputFilePathName - else GI.Gtk.entrySetText statusEntry "GIF does not exist. Check your settings." - return True - - _ <- GI.Gtk.onWidgetButtonReleaseEvent aboutButton $ \ _ -> GI.Gtk.dialogRun aboutDialog >> return True - - _ <- GI.Gtk.onDialogResponse longGifGtkMessageDialog (\ _ -> GI.Gtk.widgetHide longGifGtkMessageDialog) - _ <- GI.Gtk.onDialogResponse aboutDialog (\ _ -> GI.Gtk.widgetHide aboutDialog) - - _ <- GI.Gtk.onWidgetDestroy window GI.Gtk.mainQuit - - GI.Gtk.widgetShowAll window - GI.Gtk.main - -buildBuilder :: IO GI.Gtk.Builder -buildBuilder = do - gladeFile <- getDataFileName "data/gui.glade" - GI.Gtk.builderNewFromFile (pack gladeFile) - -builderGetObject :: - (GI.GObject.GObject b, GI.Gtk.IsBuilder a) => - (Data.GI.Base.ManagedPtr b -> b) -> - a -> - Prelude.String -> - IO b -builderGetObject objectTypeClass builder objectId = - fromJust <$> GI.Gtk.builderGetObject builder (pack objectId) >>= - GI.Gtk.unsafeCastTo objectTypeClass - -inputFileButtonGetText :: GI.Gtk.FileChooserButton -> IO String -inputFileButtonGetText inputFileButton = do - inputFilePathName <- fileChooserButtonGetText inputFileButton - fileExist <- doesFileExist inputFilePathName - if fileExist then return inputFilePathName else return "" - -durationTimeWarningLevel :: Float -durationTimeWarningLevel = 10.0 - -entryGetFloat :: GI.Gtk.Entry -> Float -> IO Float -entryGetFloat e nothing = fmap (\ t -> fromMaybe nothing (readMaybe (unpack t) :: Maybe Float)) (GI.Gtk.entryGetText e) - -assembleOutputFilePathName :: GI.Gtk.FileChooserButton -> GI.Gtk.Entry -> IO (String, String) -assembleOutputFilePathName outputFilePathButton outputFileNameEntry = do - outputFilePath <- fileChooserButtonGetText outputFilePathButton - outputFileName <- unpack . Data.Text.strip <$> GI.Gtk.entryGetText outputFileNameEntry - let outputGifFileName = outputFileName ++ ".gif" - let outputFilePathName = - if (not . Data.List.null) outputFilePath - then outputFilePath ++ [System.FilePath.pathSeparator] ++ outputGifFileName - else outputGifFileName - return (outputGifFileName, outputFilePathName) - -fileChooserButtonGetText :: GI.Gtk.FileChooserButton -> IO String -fileChooserButtonGetText = - fmap (Data.Text.unpack . Data.Text.strip . Data.Text.pack . fromMaybe "") . GI.Gtk.fileChooserGetFilename - -openGifCommand :: String -> IO () -openGifCommand outputFilePathName = do - fileExists <- doesFileExist outputFilePathName - when fileExists $ void (spawnCommand (command ++ "\"" ++ outputFilePathName ++ "\"")) - where - command :: String - command = if "linux" `Data.List.isInfixOf` fmap Data.Char.toLower System.Info.os - then "xdg-open " - else "open " - -blankPreviewIcon :: String -blankPreviewIcon = "gtk-discard" - -resetImage :: GI.Gtk.Image -> IO () -resetImage image = - GI.Gtk.imageSetFromIconName - image - (Just $ pack blankPreviewIcon) - (enumToInt32 GI.Gtk.IconSizeButton) - -makeGifPreview :: String -> String -> Float -> String -> IO (Either IOError String) -makeGifPreview inputFile outputFile startTime bottomText = Gifcurry.gif $ Gifcurry.defaultGifParams { - Gifcurry.inputFile = inputFile - , Gifcurry.outputFile = outputFile - , Gifcurry.startTime = startTime - , Gifcurry.durationTime = 0.001 - , Gifcurry.widthSize = 200 - , Gifcurry.qualityPercent = 50.0 - , Gifcurry.bottomText = bottomText - } - -ioSuccess :: IO (Either IOError String) -> IO Bool -ioSuccess = fmap isRight - -framePreviewDirectoryName :: String -framePreviewDirectoryName = "gifcurry-frame-previews" - -makeLastFramePreview :: - GI.Gtk.FileChooserButton -> - GI.Gtk.Entry -> - GI.Gtk.Entry -> - GI.Gtk.Image -> - System.FilePath.FilePath -> - IO () -makeLastFramePreview - inputFileButton - startTimeEntry - durationTimeEntry - lastFrameImage - temporaryDirectory - = - void $ forkIO $ - withTempDirectory temporaryDirectory framePreviewDirectoryName $ \ tmpdir -> do - inputFilePathName <- inputFileButtonGetText inputFileButton - startTimeText <- GI.Gtk.entryGetText startTimeEntry - durationTimeText <- GI.Gtk.entryGetText durationTimeEntry - startTime' <- entryGetFloat startTimeEntry (-1.0) - durationTime <- entryGetFloat durationTimeEntry 0.001 - let startTimeTextValid = (not . Data.List.null) (unpack startTimeText) - let durationTimeTextValid = (not . Data.List.null) (unpack durationTimeText) - let startTime = startTime' + durationTime - let outputFilePathName = tmpdir ++ "/gifcurry-last-frame-preview.gif" - let doSet = startTimeTextValid && - durationTimeTextValid && - not (Data.List.null inputFilePathName) && - (startTime > 0.0) - _ <- setOrResetFramePrevew doSet inputFilePathName outputFilePathName startTime lastFrameImage " LAST FRAME " - return() - -makeFirstFramePreview :: - GI.Gtk.FileChooserButton -> - GI.Gtk.Entry -> - GI.Gtk.Entry -> - GI.Gtk.Image -> - GI.Gtk.Image -> - System.FilePath.FilePath -> - IO () -makeFirstFramePreview - inputFileButton - startTimeEntry - durationTimeEntry - firstFrameImage - lastFrameImage - temporaryDirectory - = - void $ forkIO $ do - withTempDirectory temporaryDirectory framePreviewDirectoryName $ \ tmpDir -> do - inputFilePathName <- inputFileButtonGetText inputFileButton - startTime <- entryGetFloat startTimeEntry (-1.0) - let outputFilePathName = tmpDir ++ "/gifcurry-first-frame-preview.gif" - let doSet = not (Data.List.null inputFilePathName) && (startTime >= 0.0) - _ <- setOrResetFramePrevew doSet inputFilePathName outputFilePathName startTime firstFrameImage " FIRST FRAME " - return () - makeLastFramePreview - inputFileButton - startTimeEntry - durationTimeEntry - lastFrameImage - temporaryDirectory - -setOrResetFramePrevew :: Bool -> String -> String -> Float -> GI.Gtk.Image -> String -> IO () -setOrResetFramePrevew False _ _ _ image _ = GtkMainSyncAsync.gtkMainAsync $ resetImage image -setOrResetFramePrevew True inputFilePathName outputFilePathName time image overlay = do - success <- ioSuccess (makeGifPreview inputFilePathName outputFilePathName time overlay) - _ <- updatePreviewFrame outputFilePathName image success - return() - -updatePreviewFrame :: String -> GI.Gtk.Image -> Bool -> IO () -updatePreviewFrame filePathName image True = GtkMainSyncAsync.gtkMainSync (GI.Gtk.imageSetFromFile image (Just filePathName)) -updatePreviewFrame _ image False = GtkMainSyncAsync.gtkMainSync (resetImage image) - -setStatusEntryReady :: GI.Gtk.Entry -> IO () -setStatusEntryReady = flip GI.Gtk.entrySetText "Ready." - -enumToInt32 :: (Enum a, Ord a) => a -> Int32 -enumToInt32 enum = fromIntegral (fromEnum enum) :: Int32 +{-# LANGUAGE + OverloadedStrings + , NamedFieldPuns +#-} + +import GHC.Float +import System.Directory +import System.FilePath +import System.Process +import Text.Printf +import Data.Maybe +import Data.Text +import qualified Data.ByteString.Char8 +import Data.List +import Data.IORef +import Data.Word +import Control.Monad +import Control.Concurrent +import Control.Exception +import Data.GI.Base +import qualified GI.GLib +import qualified GI.GObject +import qualified GI.Gdk +import qualified GI.Gtk +import GI.Gst + +import Paths_Gifcurry +import qualified Gifcurry + ( gif + , GifParams(..) + , defaultGifParams + , gifParamsValid + , getVideoDurationInSeconds + , getOutputFileWithExtension + , getVideoWidthAndHeight + , findOrCreateTemporaryDirectory + ) +import qualified GtkMainSyncAsync (gtkMainAsync) +import GuiMisc +import qualified GuiRecords as GR +import qualified GuiPreview + +durationTimeWarningLevel :: Float +durationTimeWarningLevel = 10.0 + +main :: IO () +main = do + _ <- GI.Gst.init Nothing + _ <- GI.Gtk.init Nothing + + builder <- buildBuilder + + window <- builderGetObject GI.Gtk.Window builder "gifcurry-window" + startTimeSpinButton <- builderGetObject GI.Gtk.SpinButton builder "start-time-spin-button" + durationTimeSpinButton <- builderGetObject GI.Gtk.SpinButton builder "duration-time-spin-button" + widthSizeSpinButton <- builderGetObject GI.Gtk.SpinButton builder "width-size-spin-button" + qualityPercentSpinButton <- builderGetObject GI.Gtk.SpinButton builder "quality-percent-spin-button" + leftCropSpinButton <- builderGetObject GI.Gtk.SpinButton builder "left-crop-spin-button" + rightCropSpinButton <- builderGetObject GI.Gtk.SpinButton builder "right-crop-spin-button" + topCropSpinButton <- builderGetObject GI.Gtk.SpinButton builder "top-crop-spin-button" + bottomCropSpinButton <- builderGetObject GI.Gtk.SpinButton builder "bottom-crop-spin-button" + inFileChooserButton <- builderGetObject GI.Gtk.FileChooserButton builder "in-file-chooser-button" + outFileChooserButton <- builderGetObject GI.Gtk.FileChooserButton builder "out-file-chooser-button" + fontChooserButton <- builderGetObject GI.Gtk.FontButton builder "font-chooser-button" + saveButton <- builderGetObject GI.Gtk.Button builder "save-button" + openButton <- builderGetObject GI.Gtk.Button builder "open-button" + yesGtkButton <- builderGetObject GI.Gtk.Button builder "yes-button" + noGtkButton <- builderGetObject GI.Gtk.Button builder "no-button" + aboutButton <- builderGetObject GI.Gtk.Button builder "about-button" + giphyUploadButton <- builderGetObject GI.Gtk.Button builder "giphy-upload-button" + imgurUploadButton <- builderGetObject GI.Gtk.Button builder "imgur-upload-button" + saveAsVideoRadioButton <- builderGetObject GI.Gtk.RadioButton builder "save-as-video-radio-button" + widthQualityPercentToggleButton <- builderGetObject GI.Gtk.ToggleButton builder "width-quality-percent-toggle-button" + cropToggleButton <- builderGetObject GI.Gtk.ToggleButton builder "crop-toggle-button" + topBottomTextToggleButton <- builderGetObject GI.Gtk.ToggleButton builder "top-bottom-text-toggle-button" + saveOpenToggleButton <- builderGetObject GI.Gtk.ToggleButton builder "save-open-toggle-button" + uploadToggleButton <- builderGetObject GI.Gtk.ToggleButton builder "upload-toggle-button" + startTimeAdjustment <- builderGetObject GI.Gtk.Adjustment builder "start-time-adjustment" + durationTimeAdjustment <- builderGetObject GI.Gtk.Adjustment builder "duration-time-adjustment" + widthSizeAdjustment <- builderGetObject GI.Gtk.Adjustment builder "width-size-adjustment" + qualityPercentAdjustment <- builderGetObject GI.Gtk.Adjustment builder "quality-percent-adjustment" + outFileNameEntry <- builderGetObject GI.Gtk.Entry builder "out-file-name-entry" + topTextEntry <- builderGetObject GI.Gtk.Entry builder "top-text-entry" + bottomTextEntry <- builderGetObject GI.Gtk.Entry builder "bottom-text-entry" + statusEntry <- builderGetObject GI.Gtk.Entry builder "status-entry" + mainPreviewBox <- builderGetObject GI.Gtk.Box builder "main-preview-box" + imagesPreviewBox <- builderGetObject GI.Gtk.Box builder "images-preview-box" + videoPreviewBox <- builderGetObject GI.Gtk.Box builder "video-preview-box" + videoPreviewOverlayChildBox <- builderGetObject GI.Gtk.Box builder "video-preview-overlay-child-box" + widthQualityPercentBox <- builderGetObject GI.Gtk.Box builder "width-quality-percent-box" + cropSpinButtonsBox <- builderGetObject GI.Gtk.Box builder "crop-spin-buttons-box" + topBottomTextFontChooserBox <- builderGetObject GI.Gtk.Box builder "top-bottom-text-font-chooser-box" + saveOpenBox <- builderGetObject GI.Gtk.Box builder "save-open-box" + uploadBox <- builderGetObject GI.Gtk.Box builder "upload-box" + videoPreviewDrawingArea <- builderGetObject GI.Gtk.DrawingArea builder "video-preview-drawing-area" + firstFramePreviewImageDrawingArea <- builderGetObject GI.Gtk.DrawingArea builder "first-frame-preview-image-drawing-area" + lastFramePreviewImageDrawingArea <- builderGetObject GI.Gtk.DrawingArea builder "last-frame-preview-image-drawing-area" + firstFrameImage <- builderGetObject GI.Gtk.Image builder "first-frame-image" + lastFrameImage <- builderGetObject GI.Gtk.Image builder "last-frame-image" + longGifGtkMessageDialog <- builderGetObject GI.Gtk.MessageDialog builder "long-gif-message-dialog" + aboutDialog <- builderGetObject GI.Gtk.AboutDialog builder "about-dialog" + startTimeLevelBar <- builderGetObject GI.Gtk.LevelBar builder "start-time-level-bar" + endTimeLevelBar <- builderGetObject GI.Gtk.LevelBar builder "end-time-level-bar" + saveSpinner <- builderGetObject GI.Gtk.Spinner builder "save-spinner" + + -- Glade does not allow us to use the response ID nicknames so we setup them up programmatically here. + GI.Gtk.dialogAddActionWidget longGifGtkMessageDialog yesGtkButton (enumToInt32 GI.Gtk.ResponseTypeYes) + GI.Gtk.dialogAddActionWidget longGifGtkMessageDialog noGtkButton (enumToInt32 GI.Gtk.ResponseTypeNo) + + (maybeVideoPreviewWidget, maybePlaybinElement) <- + GuiPreview.buildVideoPreviewWidgetAndPlaybinElement + + temporaryDirectory <- Gifcurry.findOrCreateTemporaryDirectory + + guiPreviewStateRef <- newIORef GR.defaultGuiPreviewState + + inVideoPropertiesRef <- newIORef GR.defaultInVideoProperties + + let guiComponents = + GR.GuiComponents + { GR.window = window + , GR.startTimeSpinButton = startTimeSpinButton + , GR.durationTimeSpinButton = durationTimeSpinButton + , GR.widthSizeSpinButton = widthSizeSpinButton + , GR.qualityPercentSpinButton = qualityPercentSpinButton + , GR.leftCropSpinButton = leftCropSpinButton + , GR.rightCropSpinButton = rightCropSpinButton + , GR.topCropSpinButton = topCropSpinButton + , GR.bottomCropSpinButton = bottomCropSpinButton + , GR.inFileChooserButton = inFileChooserButton + , GR.outFileChooserButton = outFileChooserButton + , GR.fontChooserButton = fontChooserButton + , GR.saveButton = saveButton + , GR.openButton = openButton + , GR.yesGtkButton = yesGtkButton + , GR.noGtkButton = noGtkButton + , GR.aboutButton = aboutButton + , GR.giphyUploadButton = giphyUploadButton + , GR.imgurUploadButton = imgurUploadButton + , GR.saveAsVideoRadioButton = saveAsVideoRadioButton + , GR.widthQualityPercentToggleButton = widthQualityPercentToggleButton + , GR.cropToggleButton = cropToggleButton + , GR.topBottomTextToggleButton = topBottomTextToggleButton + , GR.saveOpenToggleButton = saveOpenToggleButton + , GR.uploadToggleButton = uploadToggleButton + , GR.startTimeAdjustment = startTimeAdjustment + , GR.durationTimeAdjustment = durationTimeAdjustment + , GR.widthSizeAdjustment = widthSizeAdjustment + , GR.qualityPercentAdjustment = qualityPercentAdjustment + , GR.outFileNameEntry = outFileNameEntry + , GR.topTextEntry = topTextEntry + , GR.bottomTextEntry = bottomTextEntry + , GR.statusEntry = statusEntry + , GR.mainPreviewBox = mainPreviewBox + , GR.imagesPreviewBox = imagesPreviewBox + , GR.videoPreviewBox = videoPreviewBox + , GR.videoPreviewOverlayChildBox = videoPreviewOverlayChildBox + , GR.widthQualityPercentBox = widthQualityPercentBox + , GR.cropSpinButtonsBox = cropSpinButtonsBox + , GR.topBottomTextFontChooserBox = topBottomTextFontChooserBox + , GR.saveOpenBox = saveOpenBox + , GR.uploadBox = uploadBox + , GR.videoPreviewDrawingArea = videoPreviewDrawingArea + , GR.firstFramePreviewImageDrawingArea = firstFramePreviewImageDrawingArea + , GR.lastFramePreviewImageDrawingArea = lastFramePreviewImageDrawingArea + , GR.firstFrameImage = firstFrameImage + , GR.lastFrameImage = lastFrameImage + , GR.longGifGtkMessageDialog = longGifGtkMessageDialog + , GR.aboutDialog = aboutDialog + , GR.startTimeLevelBar = startTimeLevelBar + , GR.endTimeLevelBar = endTimeLevelBar + , GR.saveSpinner = saveSpinner + , GR.maybeVideoPreviewWidget = maybeVideoPreviewWidget + , GR.maybePlaybinElement = maybePlaybinElement + , GR.temporaryDirectory = temporaryDirectory + , GR.guiPreviewStateRef = guiPreviewStateRef + , GR.inVideoPropertiesRef = inVideoPropertiesRef + } + + _ <- hideWidgetsOnRealize guiComponents + + _ <- handleInputFileChoice guiComponents + _ <- handleSpinButtons guiComponents + _ <- handleSaveButtonClick guiComponents + _ <- handleOpenButtonClick guiComponents + _ <- handleDialogs guiComponents + _ <- handleSidebarSectionToggleButtons guiComponents + _ <- handleUploadButtons guiComponents + _ <- handleWindow guiComponents + _ <- handleGuiPreview guiComponents + + GI.Gtk.main + +buildBuilder :: IO GI.Gtk.Builder +buildBuilder = do + gladeFile <- getDataFileName "data/gui.glade" + GI.Gtk.builderNewFromFile (pack gladeFile) + +builderGetObject + :: (GI.GObject.GObject b, GI.Gtk.IsBuilder a) + => (Data.GI.Base.ManagedPtr b -> b) + -> a + -> String + -> IO b +builderGetObject objectTypeClass builder objectId = + fromJust <$> GI.Gtk.builderGetObject builder (pack objectId) >>= + GI.Gtk.unsafeCastTo objectTypeClass + +handleInputFileChoice :: GR.GuiComponents -> IO () +handleInputFileChoice + guiComponents@GR.GuiComponents + { GR.inFileChooserButton + , GR.startTimeSpinButton + , GR.durationTimeSpinButton + , GR.leftCropSpinButton + , GR.rightCropSpinButton + , GR.topCropSpinButton + , GR.bottomCropSpinButton + , GR.widthSizeSpinButton + , GR.qualityPercentSpinButton + , GR.topTextEntry + , GR.bottomTextEntry + , GR.outFileNameEntry + , GR.statusEntry + , GR.inVideoPropertiesRef + } + = + void $ GI.Gtk.onFileChooserButtonFileSet inFileChooserButton $ do + inFilePath <- fileChooserButtonGetFilePath inFileChooserButton + maybeVideoDuration <- + Gifcurry.getVideoDurationInSeconds + Gifcurry.defaultGifParams + { Gifcurry.inputFile = inFilePath } + maybeWidthHeight <- + Gifcurry.getVideoWidthAndHeight + Gifcurry.defaultGifParams + { Gifcurry.inputFile = inFilePath } + case (maybeVideoDuration, maybeWidthHeight) of + (Just videoDuration', Just (width, height)) -> do + atomicWriteIORef inVideoPropertiesRef $ + GR.defaultInVideoProperties + { GR.inVideoDuration = videoDuration' + , GR.inVideoWidth = width + , GR.inVideoHeight = height + } + let videoDuration = float2Double videoDuration' + let startTimeFraction = 0.25 + let startTime = videoDuration * startTimeFraction + let endTime = startTime * 3 + let durationTime = endTime - startTime + let videoDurationText = Data.Text.pack $ printf "%.3f" videoDuration + _ <- updateStartAndDurationTimeSpinButtonRanges guiComponents + _ <- GI.Gtk.spinButtonSetValue startTimeSpinButton startTime + _ <- GI.Gtk.spinButtonSetValue durationTimeSpinButton durationTime + _ <- updateStatusEntryAsync statusEntry 1 $ + Data.Text.concat + [ "That video is about " + , videoDurationText + , " seconds long." + ] + return () + _ -> do + atomicWriteIORef inVideoPropertiesRef GR.defaultInVideoProperties + _ <- updateStartAndDurationTimeSpinButtonRanges guiComponents + _ <- GI.Gtk.spinButtonSetValue startTimeSpinButton 0.0 + _ <- GI.Gtk.spinButtonSetValue durationTimeSpinButton 0.0 + _ <- updateStatusEntryAsync statusEntry 1 "Is that a video?" + return () + syncStartAndDurationTimeSpinButtons guiComponents + resetTextEntries + resetWidthAndQualityPercentSpinButtons + resetCropSpinButtons + where + resetTextEntries :: IO () + resetTextEntries = do + let textEntries = + [ topTextEntry + , bottomTextEntry + , outFileNameEntry + ] + mapM_ + (flip GI.Gtk.entrySetText "") + textEntries + resetWidthAndQualityPercentSpinButtons :: IO () + resetWidthAndQualityPercentSpinButtons = do + GI.Gtk.spinButtonSetValue widthSizeSpinButton 500 + GI.Gtk.spinButtonSetValue qualityPercentSpinButton 100 + resetCropSpinButtons :: IO () + resetCropSpinButtons = do + let spinButtons = + [ leftCropSpinButton + , rightCropSpinButton + , topCropSpinButton + , bottomCropSpinButton + ] + mapM_ + (flip GI.Gtk.spinButtonSetValue 0.0) + spinButtons + +handleSpinButtons :: GR.GuiComponents -> IO () +handleSpinButtons + guiComponents@GR.GuiComponents + { GR.startTimeSpinButton + , GR.durationTimeSpinButton + , GR.widthSizeSpinButton + , GR.qualityPercentSpinButton + , GR.leftCropSpinButton + , GR.rightCropSpinButton + , GR.topCropSpinButton + , GR.bottomCropSpinButton + , GR.statusEntry + , GR.inVideoPropertiesRef + } + = do + _ <- GI.Gtk.onSpinButtonValueChanged + startTimeSpinButton + handleStartTimeSpinButton + _ <- GI.Gtk.onSpinButtonValueChanged + durationTimeSpinButton + handleDurationTimeSpinButton + _ <- GI.Gtk.onSpinButtonValueChanged + widthSizeSpinButton + handleWidthSizeSpinButton + _ <- GI.Gtk.onSpinButtonValueChanged + qualityPercentSpinButton + handleQualityPercentSpinButton + _ <- GI.Gtk.onSpinButtonValueChanged + leftCropSpinButton + (handleCropSpinButton leftCropSpinButton rightCropSpinButton "left") + _ <- GI.Gtk.onSpinButtonValueChanged + rightCropSpinButton + (handleCropSpinButton rightCropSpinButton leftCropSpinButton "right") + _ <- GI.Gtk.onSpinButtonValueChanged + topCropSpinButton + (handleCropSpinButton topCropSpinButton bottomCropSpinButton "top") + _ <- GI.Gtk.onSpinButtonValueChanged + bottomCropSpinButton + (handleCropSpinButton bottomCropSpinButton topCropSpinButton "bottom") + return () + where + handleStartTimeSpinButton :: IO () + handleStartTimeSpinButton = do + startTime <- double2Float <$> GI.Gtk.spinButtonGetValue startTimeSpinButton + _ <- setSpinButtonFraction startTimeSpinButton + if startTime < 0.0 + then do + GI.Gtk.entrySetText statusEntry "The start time is wrong." + highlightSpinButton startTimeSpinButton + else do + GI.Gtk.entrySetText statusEntry "Ready." + unhighlightSpinButton startTimeSpinButton + void $ syncStartAndDurationTimeSpinButtons guiComponents + handleDurationTimeSpinButton :: IO () + handleDurationTimeSpinButton = do + startTime <- double2Float <$> GI.Gtk.spinButtonGetValue startTimeSpinButton + durationTime <- double2Float <$> GI.Gtk.spinButtonGetValue durationTimeSpinButton + videoDuration <- inVideoDuration + _ <- GI.Gtk.setEntryProgressFraction durationTimeSpinButton 0.5 + _ <- setSpinButtonFraction durationTimeSpinButton + if + durationTime < 0.0 + || durationTime > (videoDuration - startTime) + || durationTime > videoDuration + then do + GI.Gtk.entrySetText statusEntry "The duration time is wrong." + highlightSpinButton durationTimeSpinButton + else do + GI.Gtk.entrySetText statusEntry "Ready." + unhighlightSpinButton durationTimeSpinButton + void $ syncStartAndDurationTimeSpinButtons guiComponents + handleWidthSizeSpinButton :: IO () + handleWidthSizeSpinButton = do + widthSize <- double2Float <$> GI.Gtk.spinButtonGetValue widthSizeSpinButton + _ <- setSpinButtonFraction widthSizeSpinButton + if widthSize <= 0.0 + then do + GI.Gtk.entrySetText statusEntry "The width size is wrong." + highlightSpinButton widthSizeSpinButton + else do + GI.Gtk.entrySetText statusEntry "Ready." + unhighlightSpinButton widthSizeSpinButton + handleQualityPercentSpinButton :: IO () + handleQualityPercentSpinButton = do + qualityPercent <- double2Float <$> GI.Gtk.spinButtonGetValue qualityPercentSpinButton + _ <- setSpinButtonFraction qualityPercentSpinButton + if qualityPercent <= 0.0 || qualityPercent > 100.0 + then do + GI.Gtk.entrySetText statusEntry "The quality percent is wrong." + highlightSpinButton qualityPercentSpinButton + else do + GI.Gtk.entrySetText statusEntry "Ready." + unhighlightSpinButton qualityPercentSpinButton + handleCropSpinButton :: GI.Gtk.SpinButton -> GI.Gtk.SpinButton -> Text -> IO () + handleCropSpinButton a b t = do + cropValue <- double2Float <$> GI.Gtk.spinButtonGetValue a + _ <- setSpinButtonFraction a + if cropValue < 0.0 || cropValue > 100.0 + then do + GI.Gtk.entrySetText statusEntry $ Data.Text.concat ["The ", t, " crop is wrong."] + highlightSpinButton a + else do + GI.Gtk.entrySetText statusEntry "Ready." + unhighlightSpinButton a + syncCropSpinButtons a b + syncCropSpinButtons :: GI.Gtk.SpinButton -> GI.Gtk.SpinButton -> IO () + syncCropSpinButtons a b = do + aValue <- GI.Gtk.spinButtonGetValue a + bValue <- GI.Gtk.spinButtonGetValue b + when (aValue + bValue >= 100) $ do + let newValue = 100.0 - aValue - 1.0 + let newValue' = if newValue < 0.0 then 0.0 else newValue + void $ GI.Gtk.spinButtonSetValue b newValue' + return () + inVideoDuration :: IO Float + inVideoDuration = + GR.inVideoDuration <$> readIORef inVideoPropertiesRef + +handleSaveButtonClick :: GR.GuiComponents -> IO () +handleSaveButtonClick + GR.GuiComponents + { GR.inFileChooserButton + , GR.outFileChooserButton + , GR.outFileNameEntry + , GR.saveButton + , GR.openButton + , GR.fontChooserButton + , GR.saveAsVideoRadioButton + , GR.startTimeSpinButton + , GR.durationTimeSpinButton + , GR.widthSizeSpinButton + , GR.qualityPercentSpinButton + , GR.leftCropSpinButton + , GR.rightCropSpinButton + , GR.topCropSpinButton + , GR.bottomCropSpinButton + , GR.topTextEntry + , GR.bottomTextEntry + , GR.statusEntry + , GR.longGifGtkMessageDialog + , GR.saveSpinner + } + = + void $ GI.Gtk.onWidgetButtonReleaseEvent saveButton $ \ _ -> do + inFilePath <- fileChooserButtonGetFilePath inFileChooserButton + startTime <- double2Float <$> GI.Gtk.spinButtonGetValue startTimeSpinButton + durationTime <- double2Float <$> GI.Gtk.spinButtonGetValue durationTimeSpinButton + widthSize <- double2Float <$> GI.Gtk.spinButtonGetValue widthSizeSpinButton + qualityPercent <- double2Float <$> GI.Gtk.spinButtonGetValue qualityPercentSpinButton + leftCrop <- double2Float <$> GI.Gtk.spinButtonGetValue leftCropSpinButton + rightCrop <- double2Float <$> GI.Gtk.spinButtonGetValue rightCropSpinButton + topCrop <- double2Float <$> GI.Gtk.spinButtonGetValue topCropSpinButton + bottomCrop <- double2Float <$> GI.Gtk.spinButtonGetValue bottomCropSpinButton + fontChoice <- GI.Gtk.fontButtonGetFontName fontChooserButton + topText <- GI.Gtk.entryGetText topTextEntry + bottomText <- GI.Gtk.entryGetText bottomTextEntry + saveAsVideo <- GI.Gtk.toggleButtonGetActive saveAsVideoRadioButton + outFilePath <- outFileChooserButtonGetFilePath outFileChooserButton outFileNameEntry + let params = + Gifcurry.defaultGifParams + { Gifcurry.inputFile = inFilePath + , Gifcurry.outputFile = outFilePath + , Gifcurry.saveAsVideo = saveAsVideo + , Gifcurry.startTime = startTime + , Gifcurry.durationTime = durationTime + , Gifcurry.widthSize = truncate widthSize + , Gifcurry.qualityPercent = qualityPercent + , Gifcurry.fontChoice = unpack fontChoice + , Gifcurry.topText = unpack topText + , Gifcurry.bottomText = unpack bottomText + , Gifcurry.leftCrop = leftCrop + , Gifcurry.rightCrop = rightCrop + , Gifcurry.topCrop = topCrop + , Gifcurry.bottomCrop = bottomCrop + } + paramsValid <- Gifcurry.gifParamsValid params + GI.Gtk.entrySetText statusEntry "Ready." + if paramsValid + then do + longGifGtkMessageDialogResponse <- + if durationTime >= durationTimeWarningLevel + then GI.Gtk.dialogRun longGifGtkMessageDialog + else return (enumToInt32 GI.Gtk.ResponseTypeYes) + when (longGifGtkMessageDialogResponse == enumToInt32 GI.Gtk.ResponseTypeYes) $ do + GI.Gtk.widgetSetSensitive saveButton False + GI.Gtk.widgetSetSensitive openButton False + GI.Gtk.widgetHide saveButton + GI.Gtk.widgetShow saveSpinner + GI.Gtk.setSpinnerActive saveSpinner True + void $ forkOS $ do + GtkMainSyncAsync.gtkMainAsync $ + GI.Gtk.entrySetText statusEntry "One GIF coming up!" + result <- Gifcurry.gif params + case result of + Left _ -> + GtkMainSyncAsync.gtkMainAsync $ + GI.Gtk.entrySetText statusEntry "Didn't work. Check your settings." + Right filePath -> do + _ <- + forkOS $ + GtkMainSyncAsync.gtkMainAsync $ + openLocalFileWithDefaultProgram filePath + GtkMainSyncAsync.gtkMainAsync $ GI.Gtk.entrySetText statusEntry "Ready." + GtkMainSyncAsync.gtkMainAsync $ do + GI.Gtk.setSpinnerActive saveSpinner False + GI.Gtk.widgetHide saveSpinner + GI.Gtk.widgetShow saveButton + GI.Gtk.widgetSetSensitive saveButton True + GI.Gtk.widgetSetSensitive openButton True + else GI.Gtk.entrySetText statusEntry "The settings are wrong." + return True + +handleOpenButtonClick :: GR.GuiComponents -> IO () +handleOpenButtonClick + GR.GuiComponents + { GR.openButton + , GR.saveAsVideoRadioButton + , GR.outFileChooserButton + , GR.outFileNameEntry + , GR.statusEntry + } + = + void $GI.Gtk.onWidgetButtonReleaseEvent openButton $ \ _ -> do + saveAsVideo <- GI.Gtk.toggleButtonGetActive saveAsVideoRadioButton + outFilePath <- outFileChooserButtonGetFilePath outFileChooserButton outFileNameEntry + let outFilePath' = + Gifcurry.getOutputFileWithExtension $ + Gifcurry.defaultGifParams + { Gifcurry.outputFile = outFilePath, Gifcurry.saveAsVideo = saveAsVideo } + fileExists <- doesFileExist outFilePath' + if fileExists + then do + GI.Gtk.entrySetText statusEntry "Ready." + void $ + forkIO $ + GtkMainSyncAsync.gtkMainAsync $ + openLocalFileWithDefaultProgram outFilePath' + else GI.Gtk.entrySetText statusEntry "Couldn't find the file. Check your settings." + return True + +handleDialogs :: GR.GuiComponents -> IO () +handleDialogs + GR.GuiComponents + { GR.aboutDialog + , GR.longGifGtkMessageDialog + , GR.aboutButton + } + = do + _ <- GI.Gtk.onWidgetButtonReleaseEvent + aboutButton + (\ _ -> GI.Gtk.dialogRun aboutDialog >> return True) + _ <- GI.Gtk.onDialogResponse + longGifGtkMessageDialog + (\ _ -> GI.Gtk.widgetHide longGifGtkMessageDialog) + _ <- GI.Gtk.onDialogResponse + aboutDialog + (\ _ -> GI.Gtk.widgetHide aboutDialog) + return () + +-- GI.Gtk.Expander does not work. +-- While it visually hides its children, they are still present +-- in terms of activation. This prevents the children of +-- other expanded sections from working. +-- This workaround emulates the expander functionality. +handleSidebarSectionToggleButtons :: GR.GuiComponents -> IO () +handleSidebarSectionToggleButtons + GR.GuiComponents + { GR.widthQualityPercentToggleButton + , GR.cropToggleButton + , GR.topBottomTextToggleButton + , GR.saveOpenToggleButton + , GR.uploadToggleButton + , GR.widthQualityPercentBox + , GR.cropSpinButtonsBox + , GR.topBottomTextFontChooserBox + , GR.saveOpenBox + , GR.uploadBox + } + = do + let toggleButtons = + [ widthQualityPercentToggleButton + , cropToggleButton + , topBottomTextToggleButton + , saveOpenToggleButton + , uploadToggleButton + ] + let boxes = + [ widthQualityPercentBox + , cropSpinButtonsBox + , topBottomTextFontChooserBox + , saveOpenBox + , uploadBox + ] + mapM_ + (\ (toggleButton, box) -> + void $ + GI.Gtk.onToggleButtonToggled toggleButton $ + handleOnToggle + toggleButton + box + toggleButtons + ) $ + Data.List.zip toggleButtons boxes + where + handleOnToggle :: GI.Gtk.ToggleButton -> GI.Gtk.Box -> [GI.Gtk.ToggleButton] -> IO () + handleOnToggle toggleButton box toggleButtons = do + active <- GI.Gtk.toggleButtonGetActive toggleButton + if active + then do + GI.Gtk.widgetShow box + mapM_ + (\ x -> + isNotToggleButton x >>= \ b -> when b $ GI.Gtk.setToggleButtonActive x False + ) + toggleButtons + else + GI.Gtk.widgetHide box + where + isNotToggleButton :: GI.Gtk.ToggleButton -> IO Bool + isNotToggleButton x = do + a <- GI.Gtk.widgetGetName toggleButton + b <- GI.Gtk.widgetGetName x + return $ a /= b + +handleUploadButtons :: GR.GuiComponents -> IO () +handleUploadButtons + GR.GuiComponents + { GR.giphyUploadButton + , GR.imgurUploadButton + } + = + mapM_ + (\ (button, link) -> + GI.Gtk.onButtonClicked button $ openUriWithDefaultProgram link + ) + [ (giphyUploadButton, "https://giphy.com/upload/") + , (imgurUploadButton, "https://imgur.com/upload") + ] + +handleGuiPreview :: GR.GuiComponents -> IO () +handleGuiPreview = GuiPreview.runGuiPreview + +handleWindow :: GR.GuiComponents -> IO () +handleWindow GR.GuiComponents { GR.window } = do + -- Setting the window to resizable false causes the video + -- to load at its natural size. + -- This workaround locks the window size which is required + -- to get accurate crop measurements. + geometry <- GI.Gdk.newZeroGeometry + GI.Gdk.setGeometryMinWidth geometry 1 + GI.Gdk.setGeometryMaxWidth geometry 1 + GI.Gdk.setGeometryMinHeight geometry 1 + GI.Gdk.setGeometryMaxHeight geometry 1 + GI.Gtk.windowSetGeometryHints + window + (Just window) + (Just geometry) + [GI.Gdk.WindowHintsMinSize, GI.Gdk.WindowHintsMaxSize] + _ <- GI.Gtk.onWidgetDestroy window GI.Gtk.mainQuit + GI.Gtk.widgetShowAll window + +openLocalFileWithDefaultProgram :: String -> IO () +openLocalFileWithDefaultProgram filePath = do + fileExists <- doesFileExist filePath + when fileExists $ openUriWithDefaultProgram filePath + +openUriWithDefaultProgram :: String -> IO () +openUriWithDefaultProgram uri = do + maybeFileOpenCommand <- determineFileOpenCommand + case maybeFileOpenCommand of + Just fileOpenCommand -> + void $ spawnCommand $ fileOpenCommand ++ " \"" ++ uri ++ "\"" + _ -> return () + where + determineFileOpenCommand :: IO (Maybe String) + determineFileOpenCommand = do + uname <- tryReadProcess "uname" ["-a"] + swVers <- tryReadProcess "sw_vers" [] + ver <- tryReadProcess "ver" [] + let linuxCommand = "xdg-open" + let macCommand = "open" + let windowsCommand = "explorer" + case (uname, swVers, ver) of + (Right s, _, _) -> + case (containsText "darwin" s, containsText "linux" s) of + (True, _) -> return $ Just macCommand + (_, True) -> return $ Just linuxCommand + _ -> return Nothing + (_, Right s, _) -> returnIf "mac" s macCommand + (_, _, Right s) -> returnIf "windows" s windowsCommand + _ -> return Nothing + where + tryReadProcess :: String -> [String] -> IO (Either IOError String) + tryReadProcess process params = try $ readProcess process params [] + returnIf :: Text -> String -> String -> IO (Maybe String) + returnIf needle haystack command = + if containsText needle haystack + then return $ Just command + else return Nothing + containsText :: Text -> String -> Bool + containsText needle haystack = + Data.Text.isInfixOf + needle + (Data.Text.toLower $ Data.Text.pack haystack) + +outFileChooserButtonGetFilePath :: GI.Gtk.FileChooserButton -> GI.Gtk.Entry -> IO String +outFileChooserButtonGetFilePath outFileChooserButton outFileNameEntry = do + filePath <- fileChooserButtonGetString outFileChooserButton + fileName <- Data.Text.unpack . Data.Text.strip <$> GI.Gtk.entryGetText outFileNameEntry + if Data.List.null filePath + then return fileName + else do + isDirectory <- System.Directory.doesDirectoryExist filePath + if isDirectory + then return $ System.FilePath.combine filePath fileName + else return fileName + +highlightSpinButton :: GI.Gtk.SpinButton -> IO () +highlightSpinButton = highlightWidget "spinbutton" " entry " + +unhighlightSpinButton :: GI.Gtk.SpinButton -> IO () +unhighlightSpinButton = unhighlightWidget "spinbutton" " entry " + +highlightWidget :: GI.Gtk.IsWidget a => Text -> Text -> a -> IO () +highlightWidget namePrefix namePostfix = + styleWidget namePrefix namePostfix "{ background-color: #ff4757; color: #f1f2f6; }" + +unhighlightWidget :: GI.Gtk.IsWidget a => Text -> Text -> a -> IO () +unhighlightWidget namePrefix namePostfix = + styleWidget namePrefix namePostfix "{}" + +styleWidget :: GI.Gtk.IsWidget a => Text -> Text -> Text -> a -> IO() +styleWidget namePrefix namePostfix style widget = do + name <- GI.Gtk.widgetGetName widget + provider <- GI.Gtk.cssProviderGetDefault + let css = + Data.ByteString.Char8.pack $ + Data.Text.unpack $ + Data.Text.concat + [ namePrefix + , "#" + , name + , namePostfix + , " " + , style + ] + GI.Gtk.cssProviderLoadFromData provider css + styleContext <- GI.Gtk.widgetGetStyleContext widget + void $ + GI.Gtk.styleContextAddProvider + styleContext + provider + (fromIntegral GI.Gtk.STYLE_PROVIDER_PRIORITY_USER :: Word32) + +updateStatusEntryAsync :: GI.Gtk.Entry -> Word32 -> Text -> IO () +updateStatusEntryAsync statusEntry seconds message = + void $ GI.GLib.timeoutAdd + GI.GLib.PRIORITY_DEFAULT + seconds $ do + GtkMainSyncAsync.gtkMainAsync $ + GI.Gtk.entrySetText statusEntry message + return False + +setSpinButtonFraction :: GI.Gtk.SpinButton -> IO () +setSpinButtonFraction spinButton = do + (_, maxValue) <- GI.Gtk.spinButtonGetRange spinButton + value <- GI.Gtk.spinButtonGetValue spinButton + let fraction = if maxValue <= 0.0 then 0.0 else abs $ value / maxValue + void $ GI.Gtk.setEntryProgressFraction spinButton fraction + +updateStartAndDurationTimeSpinButtonRanges :: GR.GuiComponents -> IO () +updateStartAndDurationTimeSpinButtonRanges + GR.GuiComponents + { GR.startTimeSpinButton + , GR.durationTimeSpinButton + , GR.inVideoPropertiesRef + } + = do + videoDuration <- float2Double . GR.inVideoDuration <$> readIORef inVideoPropertiesRef + let buffer = if videoDuration * 0.01 > 0.1 then 0.1 else videoDuration * 0.01 + _ <- GI.Gtk.spinButtonSetRange startTimeSpinButton 0.0 (videoDuration - buffer) + _ <- GI.Gtk.spinButtonSetRange durationTimeSpinButton buffer videoDuration + return () + +updateStartAndDurationTimeSpinButtonFractions :: GR.GuiComponents -> IO () +updateStartAndDurationTimeSpinButtonFractions + GR.GuiComponents + { GR.startTimeSpinButton + , GR.durationTimeSpinButton + } + = do + _ <- setSpinButtonFraction startTimeSpinButton + _ <- setSpinButtonFraction durationTimeSpinButton + return () + +syncStartAndDurationTimeSpinButtons :: GR.GuiComponents -> IO () +syncStartAndDurationTimeSpinButtons + guiComponents@GR.GuiComponents + { GR.startTimeSpinButton + , GR.durationTimeSpinButton + , GR.inVideoPropertiesRef + } + = do + startTime <- GI.Gtk.spinButtonGetValue startTimeSpinButton + durationTime <- GI.Gtk.spinButtonGetValue durationTimeSpinButton + videoDuration <- float2Double . GR.inVideoDuration <$> readIORef inVideoPropertiesRef + let maxDurationTime = + if videoDuration - startTime <= 0.0 then 0.0 else videoDuration - startTime + let durationTime' = + if durationTime > maxDurationTime then maxDurationTime else durationTime + let startTime' = if startTime >= videoDuration then videoDuration else startTime + _ <- updateStartAndDurationTimeSpinButtonRanges guiComponents + _ <- GI.Gtk.spinButtonSetValue startTimeSpinButton startTime' + _ <- GI.Gtk.spinButtonSetValue durationTimeSpinButton durationTime' + updateStartAndDurationTimeSpinButtonFractions guiComponents + updateStartAndEndTimeLevelBars guiComponents + +updateStartAndEndTimeLevelBars :: GR.GuiComponents -> IO () +updateStartAndEndTimeLevelBars + GR.GuiComponents + { GR.startTimeSpinButton + , GR.durationTimeSpinButton + , GR.startTimeLevelBar + , GR.endTimeLevelBar + , GR.inVideoPropertiesRef + } + = do + startTime <- GI.Gtk.spinButtonGetValue startTimeSpinButton + durationTime <- GI.Gtk.spinButtonGetValue durationTimeSpinButton + videoDuration <- float2Double . GR.inVideoDuration <$> readIORef inVideoPropertiesRef + let endTime = startTime + durationTime + let endTime' = videoDuration - endTime + _ <- GI.Gtk.levelBarSetMinValue startTimeLevelBar 0.0 + _ <- GI.Gtk.levelBarSetMinValue endTimeLevelBar 0.0 + _ <- GI.Gtk.levelBarSetMaxValue startTimeLevelBar $ checkValue videoDuration + _ <- GI.Gtk.levelBarSetMaxValue endTimeLevelBar $ checkValue videoDuration + _ <- GI.Gtk.levelBarSetValue startTimeLevelBar $ checkValue startTime + _ <- GI.Gtk.levelBarSetValue endTimeLevelBar $ checkValue endTime' + return () + where + checkValue :: Double -> Double + checkValue v = if v <= levelBarBuffer then levelBarBuffer else v + levelBarBuffer :: Double + levelBarBuffer = 0.03 + +hideWidgetsOnRealize :: GR.GuiComponents -> IO () +hideWidgetsOnRealize + GR.GuiComponents + { GR.saveSpinner + , GR.widthQualityPercentBox + , GR.cropSpinButtonsBox + , GR.topBottomTextFontChooserBox + , GR.saveOpenBox + , GR.uploadBox + } + = do + hideOnRealize saveSpinner + let boxes = + [ widthQualityPercentBox + , cropSpinButtonsBox + , topBottomTextFontChooserBox + , saveOpenBox + , uploadBox + ] + mapM_ hideOnRealize boxes + where + hideOnRealize :: GI.Gtk.IsWidget a => a -> IO () + hideOnRealize w = void $ GI.Gtk.onWidgetRealize w $ GI.Gtk.widgetHide w diff --git a/src/lib/Gifcurry.hs b/src/lib/Gifcurry.hs --- a/src/lib/Gifcurry.hs +++ b/src/lib/Gifcurry.hs @@ -4,19 +4,26 @@ lettier.com -} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE + OverloadedStrings + , NamedFieldPuns +#-} -- | Produces GIFs using FFmpeg and ImageMagick. -- The main function is 'gif'. -module Gifcurry ( - gif - , GifParams(..) - , defaultGifParams - , gifParamsValid - , versionNumber - , getVideoDurationInSeconds - , findOrCreateTemporaryDirectory - ) where +module Gifcurry + ( gif + , GifParams(..) + , defaultGifParams + , defaultFontChoice + , gifParamsValid + , versionNumber + , getVideoDurationInSeconds + , getOutputFileWithExtension + , getVideoWidthAndHeight + , findOrCreateTemporaryDirectory + ) +where import System.Process import System.IO.Temp @@ -26,14 +33,17 @@ import Data.Maybe import Data.List import Data.Text +import Data.Either import Text.Printf import Control.Exception import Control.Monad -- | The data type record required by 'gif'. -data GifParams = GifParams { - inputFile :: String +data GifParams = + GifParams + { inputFile :: String , outputFile :: String + , saveAsVideo :: Bool , startTime :: Float , durationTime :: Float , widthSize :: Int @@ -41,17 +51,24 @@ , fontChoice :: String , topText :: String , bottomText :: String - } deriving (Show, Read) + , leftCrop :: Float + , rightCrop :: Float + , topCrop :: Float + , bottomCrop :: Float + } + deriving (Show, Read) -- | The version number. versionNumber :: String -versionNumber = "2.3.0.0" +versionNumber = "3.0.0.0" -- | Specifies default parameters for 'startTime', 'durationTime', 'widthSize', 'qualityPercent', and 'fontChoice'. defaultGifParams :: GifParams -defaultGifParams = GifParams { - inputFile = "" +defaultGifParams = + GifParams + { inputFile = "" , outputFile = "" + , saveAsVideo = False , startTime = 0.0 , durationTime = 1.0 , widthSize = 500 @@ -59,7 +76,11 @@ , fontChoice = defaultFontChoice , topText = "" , bottomText = "" - } + , leftCrop = 0.0 + , rightCrop = 0.0 + , topCrop = 0.0 + , bottomCrop = 0.0 + } -- | Inputs 'GifParams' and outputs either an IO IOError or IO String. -- @@ -76,68 +97,135 @@ -- else return () -- @ gif :: GifParams -> IO (Either IOError String) -gif gifParams = do +gif + gifParams@GifParams { saveAsVideo } + = do temporaryDirectory <- findOrCreateTemporaryDirectory - withTempDirectory temporaryDirectory "gifcurry-frames" $ \tmpdir -> do - printGifParams gifParams tmpdir - validParams <- gifParamsValid gifParams - if validParams - then do - fFMpegResult <- tryFfmpeg gifParams tmpdir - let fFMpegSuccess = eitherBool fFMpegResult - if fFMpegSuccess - then do - fontMatch <- getFontMatch gifParams - let gifParams' = gifParams { fontChoice = fontMatch } - putStrLn $ "Writing your GIF to: " ++ - outputFile gifParams - convertResult <- tryConvert gifParams' tmpdir - let convertSuccess = eitherBool convertResult - if convertSuccess - then putStrLn "Done." - else putStrLn "[Error] Something went wrong with ImageMagick." - return convertResult - else do - putStrLn "[Error] Something went wrong with FFmpeg." - return fFMpegResult - else return $ Left (userError "[Error] Invalid params.") + withTempDirectory temporaryDirectory "gifcurry-frames" $ \ tempDir -> + handleFrameExtraction tempDir + >>= handleFrameMerge tempDir + >>= handleGifToVideoConversion where + handleFrameExtraction :: String -> IO (Either IOError Float) + handleFrameExtraction tempDir = do + printGifParams gifParams + validParams <- gifParamsValid gifParams + if validParams + then do + frameRate <- + validateAndAdjustFrameRate gifParams <$> + getVideoAverageFrameRateInSeconds gifParams + result <- extractFrames gifParams tempDir frameRate + case result of + Left x -> do + putStrLn "[ERROR] Something went wrong with FFmpeg." + return $ Left x + Right _ -> return $ Right frameRate + else return $ Left $ userError "Invalid params." + handleFrameMerge :: String -> Either IOError Float -> IO (Either IOError String) + handleFrameMerge tempDir (Right frameRate) = do + fontMatch <- getFontMatch gifParams + let gifParams' = gifParams { fontChoice = fontMatch } + result <- mergeFramesIntoGif gifParams' tempDir frameRate + case result of + Left x -> do + putStrLn "[ERROR] Something went wrong with ImageMagick." + return $ Left x + Right gifFilePath -> return $ Right gifFilePath + handleFrameMerge _ (Left x) = return $ Left x + handleGifToVideoConversion :: Either IOError String -> IO (Either IOError String) + handleGifToVideoConversion (Right gifFilePath) = + if saveAsVideo + then do + result <- convertGifToVideo gifParams gifFilePath + case result of + Left x -> do + putStrLn "[ERROR] Something went wrong with FFmpeg." + return $ Left x + Right outputFileWithExtension -> do + putStrLn "[INFO] All done." + return $ Right outputFileWithExtension + else do + putStrLn "[INFO] All done." + return $ Right gifFilePath + handleGifToVideoConversion result@(Left _) = return result getFontMatch :: GifParams -> IO String getFontMatch GifParams { topText = "", bottomText = "" } = defaultFontMatch getFontMatch gifParams' = do fontNames <- getListOfFontNames let match = bestFontNameMatch (fontChoiceOrDefault gifParams') fontNames - putStrLn $ "Font matched: " ++ match + putStrLn $ "[INFO] Your font choice matched to \"" ++ match ++ "\"." return match defaultFontMatch :: IO String - defaultFontMatch = putStrLn "Using the default font." >> return defaultFontChoice - eitherBool :: Either a b -> Bool - eitherBool = either (const False) (const True) + defaultFontMatch = putStrLn "[INFO] Using the default font." >> return defaultFontChoice --- | Outputs True or False if the parameters in the GifParams record are valid. --- Looks at 'inputFile', 'outputFile', 'startTime', 'durationTime', 'widthSize', and 'qualityPercent'. +-- | Outputs `True` or `False` if the parameters in the `GifParams` record are valid. gifParamsValid :: GifParams -> IO Bool -gifParamsValid GifParams { - inputFile = ipf - , outputFile = opf - , startTime = st - , durationTime = dt - , widthSize = ws - , qualityPercent = qp - , topText = _ - , bottomText = _ - } = do - inputFileExists <- case Prelude.length ipf of +gifParamsValid + GifParams + { inputFile + , outputFile + , startTime + , durationTime + , widthSize + , qualityPercent + , leftCrop + , rightCrop + , topCrop + , bottomCrop + } + = do + inputFileExists <- + case Prelude.length inputFile of 0 -> return False - _ -> doesFileExist ipf - unless inputFileExists $ putStrLn "\n[Error] Input video file does not exist." - let fileNameValid = (not . Data.Text.null . Data.Text.strip . Data.Text.pack . System.FilePath.takeBaseName) opf - let fileNameExtValid = ".gif" == (Data.Text.toLower . Data.Text.pack . System.FilePath.takeExtension) opf - let outputFileValid = fileNameValid && fileNameExtValid - unless outputFileValid $ putStrLn "\n[Error] Output GIF file is invalid." - let valid = inputFileExists && outputFileValid && (st >= 0.0) && (dt > 0.0) && (ws > 0) && (qp > 0.0) - unless valid $ putStrLn "\n[Error] Invalid params." - return valid + _ -> doesFileExist inputFile + let widthSize' = fromIntegral widthSize :: Float + let outputFileValid = not $ Data.Text.null $ Data.Text.strip $ Data.Text.pack outputFile + let startTimeValid = startTime >= 0.0 + let durationTimeValid = durationTime > 0.0 + let widthSizeValid = widthSize >= 1 + let qualityPercentValid = qualityPercent >= 1.0 && qualityPercent <= 100.0 + let leftCropValid = cropValid leftCrop + let rightCropValid = cropValid rightCrop + let topCropValid = cropValid topCrop + let bottomCropValid = cropValid bottomCrop + let leftRightCropValid = cropValid (leftCrop + rightCrop) + let topBottomCropValid = cropValid (topCrop + bottomCrop) + let widthLeftRightCropSizeValid = + (widthSize' - (widthSize' * (leftCrop / 100.0)) - (widthSize' * (rightCrop / 100.0))) >= 1.0 + unless inputFileExists $ printError "Input video file does not exist." + unless outputFileValid $ printInvalid "Output File" + unless startTimeValid $ printInvalid "Start Time" + unless durationTimeValid $ printInvalid "Duration Time" + unless widthSizeValid $ printInvalid "Width Size" + unless qualityPercentValid $ printInvalid "Quality Percent" + unless leftCropValid $ printInvalid "Left Crop" + unless rightCropValid $ printInvalid "Right Crop" + unless topCropValid $ printInvalid "Top Crop" + unless bottomCropValid $ printInvalid "Bottom Crop" + unless leftRightCropValid $ printInvalid "Left and Right Crop" + unless topBottomCropValid $ printInvalid "Top and Bottom Crop" + unless widthLeftRightCropSizeValid $ printError "Width Size too small with Left and Right Crop." + let valid = + inputFileExists + && outputFileValid + && startTimeValid + && durationTimeValid + && widthSizeValid + && qualityPercentValid + && leftCropValid + && rightCropValid + && topCropValid + && bottomCropValid + && widthLeftRightCropSizeValid + return valid + where + cropValid :: Float -> Bool + cropValid c = c >= 0.0 && c <= 100.0 + printInvalid :: String -> IO () + printInvalid s = printError $ s ++ " is invalid." + printError :: String -> IO () + printError s = putStrLn $ "[ERROR] " ++ s -- | Returns the duration of the video in seconds if successful. -- @@ -151,12 +239,71 @@ -- Just float -> float -- @ getVideoDurationInSeconds :: GifParams -> IO (Maybe Float) -getVideoDurationInSeconds gifParams = tryFfprobe gifParams >>= result +getVideoDurationInSeconds GifParams { inputFile } = tryFfprobe params >>= result where result :: Either IOError String -> IO (Maybe Float) result (Left _) = return Nothing result (Right durationString) = return (readMaybe durationString :: Maybe Float) + params :: [String] + params = + [ "-i" + , inputFile + , "-v" + , "quiet" + , "-show_entries" + , "format=duration" + , "-of" + , "default=noprint_wrappers=1:nokey=1" + ] +-- | Returns the width and height of the video if successful. +-- If the width and/or height of the video is <= 0, it will +-- return nothing. +getVideoWidthAndHeight :: GifParams -> IO (Maybe (Float, Float)) +getVideoWidthAndHeight GifParams { inputFile } = tryFfprobe params >>= result + where + result :: Either IOError String -> IO (Maybe (Float, Float)) + result (Left _) = return Nothing + result (Right widthHeightString) = + case (maybeWidth, maybeHeight) of + (Just width, Just height) -> + if width >= 0.0 && height > 0.0 + then return $ Just (width, height) + else return Nothing + _ -> return Nothing + where + maybeWidth :: Maybe Float + maybeWidth = + case widthHeightTexts of + (widthText:_) -> maybeFloat widthText + _ -> Nothing + maybeHeight :: Maybe Float + maybeHeight = + case widthHeightTexts of + (_:heightText:_) -> maybeFloat heightText + _ -> Nothing + maybeFloat :: Text -> Maybe Float + maybeFloat t = readMaybe (Data.Text.unpack t) :: Maybe Float + widthHeightTexts :: [Text] + widthHeightTexts = + (Data.List.map Data.Text.strip . Data.Text.lines) widthHeightText + widthHeightText :: Text + widthHeightText = + Data.Text.strip $ Data.Text.pack widthHeightString + params :: [String] + params = + [ "-i" + , inputFile + , "-v" + , "error" + , "-select_streams" + , "v:0" + , "-show_entries" + , "stream=width,height" + , "-of" + , "default=noprint_wrappers=1:nokey=1" + ] + -- | Finds or creates the temporary directory for Gifcurry. -- This directory is used for storing temporary frames. findOrCreateTemporaryDirectory :: IO FilePath @@ -165,121 +312,284 @@ System.Directory.createDirectoryIfMissing True filePath return filePath -printGifParams :: GifParams -> String -> IO () +-- | Adds the proper file extension to the 'outputFile' depending on 'saveAsVideo'. +getOutputFileWithExtension :: GifParams -> String +getOutputFileWithExtension GifParams { outputFile, saveAsVideo } = + outputFile + ++ "." + ++ (if saveAsVideo then videoExtension else gifExtension) + +-- | Returns the default font choice used if no font choice is specified. +defaultFontChoice :: String +defaultFontChoice = "sans" + +gifOutputFile :: String -> String +gifOutputFile outputFile = + getOutputFileWithExtension $ + defaultGifParams { outputFile = outputFile, saveAsVideo = False } + +videoOutputFile :: String -> String +videoOutputFile outputFile = + getOutputFileWithExtension $ + defaultGifParams { outputFile = outputFile, saveAsVideo = True } + +defaultFrameRate :: Float +defaultFrameRate = 12.0 + +validateAndAdjustFrameRate :: GifParams -> Maybe Float -> Float +validateAndAdjustFrameRate gifParams = + frameRateBasedOnQualityPercent gifParams . maybeFrameRateOrDefaultFrameRate + +maybeFrameRateOrDefaultFrameRate :: Maybe Float -> Float +maybeFrameRateOrDefaultFrameRate (Just frameRate) = + if frameRate <= defaultFrameRate then defaultFrameRate else frameRate +maybeFrameRateOrDefaultFrameRate Nothing = defaultFrameRate + +frameRateBasedOnQualityPercent :: GifParams -> Float -> Float +frameRateBasedOnQualityPercent GifParams { qualityPercent } frameRate = + if result <= defaultFrameRate then defaultFrameRate else result + where + result :: Float + result = frameRate * (qualityPercent / 100.0) + +getVideoAverageFrameRateInSeconds :: GifParams -> IO (Maybe Float) +getVideoAverageFrameRateInSeconds GifParams { inputFile } = tryFfprobe params >>= result + where + result :: Either IOError String -> IO (Maybe Float) + result (Left _) = return Nothing + result (Right avgFrameRateString) = return $ processString avgFrameRateString + where + processString :: String -> Maybe Float + processString = + divideMaybeFloats . textsToMaybeFloats . filterNullTexts . splitText . cleanString + cleanString :: String -> Text + cleanString = Data.Text.strip . Data.Text.pack + splitText :: Text -> [Text] + splitText = Data.Text.split (== '/') + filterNullTexts :: [Text] -> [Text] + filterNullTexts = Data.List.filter (not . Data.Text.null) + textsToMaybeFloats :: [Text] -> [Maybe Float] + textsToMaybeFloats = + Data.List.filter isJust + . Data.List.map (\ s -> readMaybe (Data.Text.unpack s) :: Maybe Float) + divideMaybeFloats :: [Maybe Float] -> Maybe Float + divideMaybeFloats (Just n:Just d:_) = + if d <= 0 || n <= 0 then Nothing else Just $ n / d + divideMaybeFloats _ = Nothing + params :: [String] + params = + [ "-v" + , "error" + , "-select_streams" + , "v:0" + , "-show_entries" + , "stream=avg_frame_rate" + , "-of" + , "default=noprint_wrappers=1:nokey=1" + , inputFile + ] + +tryFfprobe :: [String] -> IO (Either IOError String) +tryFfprobe params = try $ readProcess "ffprobe" params [] + +printGifParams :: GifParams -> IO () printGifParams - GifParams { - inputFile = ipf - , outputFile = opf - , startTime = st - , durationTime = dt - , widthSize = ws - , qualityPercent = qp - , fontChoice = fc - , topText = tt - , bottomText = bt - } - tmpdir = mapM_ putStrLn [ - "\n----------------------------------------\n" - , "Input file: " ++ ipf - , "Output file: " ++ opf - , "Start second: " ++ printf "%.3f" st - , "Duration: " ++ printf "%.3f" dt ++ " seconds" - , "GIF width: " ++ show ws ++ "px" - , "Quality: " ++ show (qualityPercentClamp qp) ++ "%" - , "Font Choice: " ++ fc - , "Top text: " ++ tt - , "Bottom text: " ++ bt + gifParams@GifParams + { inputFile + , saveAsVideo + , startTime + , durationTime + , widthSize + , qualityPercent + , fontChoice + , topText + , bottomText + , leftCrop + , rightCrop + , topCrop + , bottomCrop + } + = + putStrLn $ + Prelude.unlines + [ "[INFO] Here are your settings." , "" - , "Writing temporary frames to: " ++ tmpdir - ] + , "FILE IO:" + , "" + , "Input File: " ++ inputFile + , "Output File: " ++ getOutputFileWithExtension gifParams + , "Save As Video: " ++ if saveAsVideo then "Yes" else "No" + , "" + , "TIME:" + , "" + , "Start Second: " ++ printFloat startTime + , "Duration Time: " ++ printFloat durationTime ++ " seconds" + , "" + , "OUTPUT FILE SIZE:" + , "" + , "Width Size: " ++ show widthSize ++ "px" + , "Quality Percent: " ++ show (qualityPercentClamp qualityPercent) ++ "%" + , "" + , "TEXT:" + , "" + , "Font Choice: " ++ fontChoice + , "Top Text: " ++ topText + , "Bottom Text: " ++ bottomText + , "" + , "CROP:" + , "" + , "Left Crop: " ++ printFloat leftCrop + , "Right crop: " ++ printFloat rightCrop + , "Top Crop: " ++ printFloat topCrop + , "Bottom Crop: " ++ printFloat bottomCrop + ] + where + printFloat :: Float -> String + printFloat = printf "%.3f" frameFileExtension :: String frameFileExtension = "png" -tryFfmpeg :: GifParams -> String -> IO (Either IOError String) -tryFfmpeg - GifParams { - inputFile = ipf - , startTime = st - , durationTime = dt - , widthSize = ws - } - tmpdir = try(readProcess "ffmpeg" params []) - where - sts = printf "%.3f" st - dts = printf "%.3f" dt - wss = show ws - params = [ - "-nostats" - , "-loglevel" - , "panic" - , "-an" - , "-ss" - , sts - , "-i" - , ipf - , "-t" - , dts - , "-r" - , "12" - , "-q:v" - , "31" - , "-vf" - , "scale=" ++ wss ++ ":-1" - , "-f" - , "image2" - , tmpdir ++ "/%010d." ++ frameFileExtension - ] +gifExtension :: String +gifExtension = "gif" -tryFfprobe :: GifParams -> IO (Either IOError String) -tryFfprobe GifParams { inputFile = ipf } = try(readProcess "ffprobe" params []) +videoExtension :: String +videoExtension = "mp4" + +extractFrames :: GifParams -> String -> Float -> IO (Either IOError String) +extractFrames + GifParams + { inputFile + , startTime + , durationTime + , widthSize + , leftCrop + , rightCrop + , topCrop + , bottomCrop + } + tempDir + frameRate + = do + putStrLn $ "[INFO] Writing the temporary frames to: " ++ tempDir + try $ readProcess "ffmpeg" params [] where - params = [ - "-i" - , ipf - , "-v" - , "quiet" - , "-show_entries" - , "format=duration" - , "-of" - , "default=noprint_wrappers=1:nokey=1" + startTime' :: String + startTime' = printf "%.3f" startTime + durationTime' :: String + durationTime' = printf "%.3f" durationTime + widthSize' :: String + widthSize' = show widthSize + frameRate' :: String + frameRate' = show $ maybeFrameRateOrDefaultFrameRate (Just frameRate) + params :: [String] + params = + [ "-nostats" + , "-loglevel" + , "fatal" + , "-an" + , "-ss" + , startTime' + , "-i" + , inputFile + , "-t" + , durationTime' + , "-r" + , frameRate' + , "-q:v" + , "31" + , "-vf" + , "scale=" + ++ widthSize' + ++ ":-1" + ++",crop=w=iw*(1-" + ++ show ((leftCrop + rightCrop) / 100.0) + ++ "):h=ih*(1-" + ++ show ((topCrop + bottomCrop) / 100.0) + ++ "):x=iw*" + ++ show (leftCrop / 100.0) + ++ ":y=ih*" + ++ show (topCrop / 100.0) + ++ ":exact=1" + , "-f" + , "image2" + , tempDir ++ "/%010d." ++ frameFileExtension ] -tryConvert :: GifParams -> String -> IO (Either IOError String) -tryConvert - GifParams { - outputFile = opf - , qualityPercent = qp - , fontChoice = fc - , topText = tt - , bottomText = bt - } - tmpdir = do - maybeWidthHeight <- maybeGetFirstFrameFilePath tmpdir >>= maybeGetFirstFrameWidthHeight - let params = [ - "-quiet" - , "-delay" - , "8.3" - , tmpdir ++ "/*." ++ frameFileExtension - , "-coalesce" - , "-colors" - , show $ ncolors qp - , "-dither" - , "FloydSteinberg" - , "-layers" - , "remove-dups" - , "-layers" - , "compare-any" - , "-layers" - , "optimize-transparency" - , "-loop" - , "0" - ] - ++ annotate fc maybeWidthHeight tt "north" - ++ annotate fc maybeWidthHeight bt "south" - ++ [opf] - try (readProcess "convert" params []) +mergeFramesIntoGif :: GifParams -> String -> Float -> IO (Either IOError String) +mergeFramesIntoGif + GifParams + { outputFile + , saveAsVideo + , qualityPercent + , fontChoice + , topText + , bottomText + } + tempDir + frameRate + = do + maybeWidthHeight <- + maybeGetFirstFrameFilePath tempDir + >>= maybeGetFirstFrameWidthHeight + let frameRate' = maybeFrameRateOrDefaultFrameRate (Just frameRate) + let delay = show $ 100.0 / frameRate' + let outputFile' = + if saveAsVideo + then tempDir ++ "/finished-result.gif" + else gifOutputFile outputFile + let params = + [ "-quiet" + , "-delay" + , delay + , tempDir ++ "/*." ++ frameFileExtension + , "-coalesce" + , "-colors" + , show $ ncolors qualityPercent + , "-dither" + , "FloydSteinberg" + , "-layers" + , "remove-dups" + , "-layers" + , "compare-any" + , "-layers" + , "optimize-transparency" + , "-loop" + , "0" + ] + ++ annotate fontChoice maybeWidthHeight topText "north" + ++ annotate fontChoice maybeWidthHeight bottomText "south" + ++ [outputFile'] + putStrLn $ "[INFO] Saving your GIF to: " ++ outputFile' + result <- try $ readProcess "convert" params [] + if isLeft result + then return result + else return (Right outputFile') +convertGifToVideo :: GifParams -> String -> IO (Either IOError String) +convertGifToVideo GifParams { outputFile } gifFilePath = do + let outputFile' = videoOutputFile outputFile + let params = + [ "-nostats" + , "-loglevel" + , "fatal" + , "-y" + , "-i" + , gifFilePath + , "-movflags" + , "faststart" + , "-pix_fmt" + , "yuv420p" + , "-vf" + , "scale=trunc(iw/2)*2:trunc(ih/2)*2" + , outputFile' + ] + putStrLn $ "[INFO] Saving your video to: " ++ outputFile' + result <- try $ readProcess "ffmpeg" params [] + if isLeft result + then return result + else return (Right outputFile') + qualityPercentClamp :: Float -> Float qualityPercentClamp qp | qp > 100.0 = 100.0 @@ -292,36 +602,39 @@ | qpc >= 100.0 = 256 | otherwise = truncate (qpc / 100.0 * 256.0) where + qpc :: Float qpc = qualityPercentClamp qp annotate :: String -> Maybe (Int, Int) -> String -> String -> [String] -annotate fontChoiceArg maybeWidthHeight text topBottom = [ - "-gravity" - , topBottom - ] ++ fontSetting fontChoiceArg ++ [ - "-stroke" - , "#000C" - , "-strokewidth" - , "10" - , "-density" - , "96" - , "-pointsize" - , pointsize - , "-annotate" - , "+0+10" - , text - , "-stroke" - , "none" - , "-fill" - , "white" - , "-density" - , "96" - , "-pointsize" - , pointsize - , "-annotate" - , "+0+10" - , text +annotate fontChoiceArg maybeWidthHeight text topBottom = + [ "-gravity" + , topBottom ] + ++ fontSetting fontChoiceArg + ++ + [ "-stroke" + , "#000C" + , "-strokewidth" + , "10" + , "-density" + , "96" + , "-pointsize" + , pointsize + , "-annotate" + , "+0+10" + , text + , "-stroke" + , "none" + , "-fill" + , "white" + , "-density" + , "96" + , "-pointsize" + , pointsize + , "-annotate" + , "+0+10" + , text + ] where pointsize :: String pointsize = show $ pointSize maybeWidthHeight text @@ -385,15 +698,17 @@ getListOfFontNames :: IO [Text] getListOfFontNames = do (_, stdout, _) <- readProcessWithExitCode "convert" ["-list", "font"] [] - let fontNames = Prelude.map (Data.Text.strip . Data.Text.drop 5 . Data.Text.strip) $ - Prelude.filter (Data.Text.isInfixOf "font:" . Data.Text.toLower) $ - Data.Text.splitOn "\n" $ - Data.Text.strip $ - Data.Text.pack stdout + let fontNames = + Prelude.map (Data.Text.strip . Data.Text.drop 5 . Data.Text.strip) $ + Prelude.filter (Data.Text.isInfixOf "font:" . Data.Text.toLower) $ + Data.Text.splitOn "\n" $ + Data.Text.strip $ + Data.Text.pack stdout return fontNames maybeGetFirstFrameFilePath :: String -> IO (Maybe FilePath) -maybeGetFirstFrameFilePath tmpdir = try (makeAbsolute tmpdir) >>= tryListDir >>= maybeFirstFilePath +maybeGetFirstFrameFilePath tempDir = + try (makeAbsolute tempDir) >>= tryListDir >>= maybeFirstFilePath where tryListDir :: Either IOError FilePath -> IO (FilePath, Either IOError [FilePath]) tryListDir (Left y) = return ("", Left y) @@ -407,16 +722,21 @@ maybeGetFirstFrameWidthHeight Nothing = return Nothing maybeGetFirstFrameWidthHeight (Just dir) = readProcessWithExitCode "identify" [dir] [] >>= - \ (_, stdout, _) -> maybeConvertWidthHeightString $ findWidthHeightString $ splitOn " " $ Data.Text.pack stdout + \ (_, stdout, _) -> + maybeConvertWidthHeightString $ + findWidthHeightString $ + splitOn " " $ + Data.Text.pack stdout where findWidthHeightString :: [Text] -> Text findWidthHeightString (_:_:c:_:_:_:_:_:_:_) = c findWidthHeightString _ = "" maybeConvertWidthHeightString :: Text -> IO (Maybe (Int, Int)) maybeConvertWidthHeightString "" = return Nothing - maybeConvertWidthHeightString s = if Prelude.length splitOnX == 2 - then return (Just (pluckWidth splitOnX, pluckHeight splitOnX)) - else return Nothing + maybeConvertWidthHeightString s = + if Prelude.length splitOnX == 2 + then return (Just (pluckWidth splitOnX, pluckHeight splitOnX)) + else return Nothing where splitOnX :: [Text] splitOnX = splitOn "x" $ Data.Text.toLower s @@ -427,13 +747,11 @@ pluckHeight (_:y:_) = read (Data.Text.unpack y) :: Int pluckHeight _ = 0 -defaultFontChoice :: String -defaultFontChoice = "sans" - fontChoiceOrDefault :: GifParams -> String fontChoiceOrDefault GifParams { fontChoice = fontName } = if Data.List.null cleanedFontName then defaultFontChoice else cleanedFontName where + cleanedFontName :: String cleanedFontName = (Data.Text.unpack . Data.Text.strip . Data.Text.pack) fontName