diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,359 @@ +# [Gifcurry](https://github.com/lettier/gifcurry) + +## Changelog + +### Version + +2.2.0.0 + +#### Downstreams + +- [Hackage](https://hackage.haskell.org/package/Gifcurry-2.2.0.0) +- [Docker](https://hub.docker.com/r/lettier/gifcurry/) +- [Arch Linux AUR](https://aur.archlinux.org/packages/gifcurry) + +#### Added + +- Loading a video now populates the start and duration fields + - Duration is the length of the entire video in seconds +- Confirmation dialog if duration is >= 10 seconds +- `getVideoDurationInSeconds` to the library public API +- Error checking +- File path compatibility +- About dialog +- GNU Make targets for Arch Linux +- `stack.yaml` +- CHANGELOG.md + +#### Changed + +- Icon file +- Switched from gtk2hs to haskell-gi +- Switched from Cabal to Haskell stack +- Code clean up +- README install and run instructions +- README graphics +- GUI widget IDs +- Fixed the ImageMagick null font issue + - ImageMagick assumes `~/.magick/type.xml` exists + - Instead of `default`, it searches for the first match to `sans` if no font is specified +- Temporary file directory names where frames and GIFs are built + +#### Removed + +- Old icon from cabal file +- Altered icon from GUI file + +------------------------------------------------------------------------------- + +### Version + +2.1.1.0 + +#### Downstreams + +- [Hackage](https://hackage.haskell.org/package/Gifcurry-2.1.1.0) + +#### Added + +- + +#### Changed + +- Fixed cabal file +- Altered optimization +- Updated to work with GHC 8.0.2 +- Updated README to work with Hackage + +#### Removed + +- + +------------------------------------------------------------------------------- + +### Version + +2.1.0.0 + +#### Downstreams + +- [Hackage](https://hackage.haskell.org/package/Gifcurry-2.1.0.0) + +#### Added + +- Font selection capabilities +- Font selection to the GUI +- A fontChoice parameter to the CLI +- A makefile + +#### Changed + +- Updated the logo +- Updated the icon +- Fixed font scaling +- Updated dependencies for macOS Sierra +- Updated README +- Reorganized project structure +- Fixed compiler warnings + +#### Removed + +- + +------------------------------------------------------------------------------- + +### Version + +2.0.0.2 + +#### Downstreams + +- [Hackage](https://hackage.haskell.org/package/Gifcurry-2.0.0.2) + +#### Added + +- + +#### Changed + +- Fixed a bug where the first and last frame previews were not updating + +#### Removed + +- + +------------------------------------------------------------------------------- + +### Version + +2.0.0.1 + +#### Downstreams + +- [Hackage](https://hackage.haskell.org/package/Gifcurry-2.0.0.1) + +#### Added + +- `postGUIAsync` + +#### Changed + +- Bumped dependencies up (mainly GHC 8.0) +- [Char] to String + +#### Removed + +- + +------------------------------------------------------------------------------- + +### Version + +2.0.0.0 + +#### Downstreams + +- [Hackage](https://hackage.haskell.org/package/Gifcurry-2.0.0.0) + +#### Added + +- Type signatures +- More error checking to the GUI + +#### Changed + +- Refactored code +- Made CLI more flexible concerning input options + +#### Removed + +- + +------------------------------------------------------------------------------- + +### Version + +0.1.1.0 + +#### Downstreams + +- [Hackage](https://hackage.haskell.org/package/Gifcurry-0.1.1.0) + +#### Added + +- First and last frame preview +- Further file exists error checking + +#### Changed + +- Disabled GUI re-sizing +- Simplified GUI + +#### Removed + +- + +------------------------------------------------------------------------------- + +### Version + +0.1.0.6 + +#### Downstreams + +- + +#### Added + +- + +#### Changed + +- Updated GIF open method to work for Mac OS X + +#### Removed + +- + +------------------------------------------------------------------------------- + +### Version + +0.1.0.5 + +#### Downstreams + +- [Hackage](https://hackage.haskell.org/package/Gifcurry-0.1.0.5) + +#### Added + +- + +#### Changed + +- Downgraded GTK requirement from 3.16 to 3.10 + +#### Removed + +- + +------------------------------------------------------------------------------- + +### Version + +0.1.0.4 + +#### Downstreams + +- [Hackage](https://hackage.haskell.org/package/Gifcurry-0.1.0.4) + +#### Added + +- + +#### Changed + +- + +#### Removed + +- + +------------------------------------------------------------------------------- + +### Version + +0.1.0.3 + +#### Downstreams + +- [Hackage](https://hackage.haskell.org/package/Gifcurry-0.1.0.3) + +#### Added + +- + +#### Changed + +- + +#### Removed + +- + +------------------------------------------------------------------------------- + +### Version + +0.1.0.2 + +#### Downstreams + +- [Hackage](https://hackage.haskell.org/package/Gifcurry-0.1.0.2) + +#### Added + +- + +#### Changed + +- + +#### Removed + +- + +------------------------------------------------------------------------------- + +### Version + +0.1.0.1 + +#### Downstreams + +- [Hackage](https://hackage.haskell.org/package/Gifcurry-0.1.0.1) + +#### Added + +- + +#### Changed + +- + +#### Removed + +- + +------------------------------------------------------------------------------- + +### Version + +0.1.0.0 + +#### Downstreams + +- [Hackage](https://hackage.haskell.org/package/Gifcurry-0.1.0.0) + +#### Added + +- + +#### Changed + +- + +#### Removed + +- + +------------------------------------------------------------------------------- + +## License + +See [LICENSE](LICENSE). + +## Copyright + +(C) 2017 David Lettier +[lettier.com](http://www.lettier.com/) diff --git a/Gifcurry.cabal b/Gifcurry.cabal --- a/Gifcurry.cabal +++ b/Gifcurry.cabal @@ -1,9 +1,9 @@ name: Gifcurry -version: 2.1.1.0 +version: 2.2.0.0 synopsis: GIF creation utility. description: Create animated GIFs, optionally overlaid with text, from video files. homepage: https://github.com/lettier/gifcurry -license: Apache-2.0 +license: BSD3 license-file: LICENSE author: Lettier maintainer: Lettier @@ -13,12 +13,15 @@ , Graphics build-type: Simple extra-source-files: README.md + , LICENSE + , CHANGELOG.md + , ./lib/GtkMainSyncAsync.hs + , ./lib/LICENSE , ./src/dev/Paths_Gifcurry.hs , ./src/data/icon.ico - , ./src/data/icon2.ico + , ./makefile data-files: data/gui.glade , data/icon.ico - , data/icon2.ico data-dir: ./src/ cabal-version: >=1.10 @@ -36,21 +39,26 @@ , filepath == 1.4.* hs-source-dirs: ./src , ./src/lib/ - ghc-options: -Wall + ghc-options: -Wall -freverse-errors default-language: Haskell2010 executable gifcurry_gui main-is: Main.hs build-depends: base >= 4.7 && < 5 - , gtk3 >= 0.14 && < 0.15 + , haskell-gi-base == 0.20.* + , gi-glib == 2.0.* + , gi-gobject == 2.0.* + , gi-gtk == 3.0.* + , gi-gdk == 3.0.* , process >= 1.2 && <= 1.4.4 , temporary >= 1.2 && < 1.3 , directory == 1.3.* , text == 1.2.* , filepath == 1.4.* - other-modules: Paths_Gifcurry, Gifcurry - ghc-options: -threaded -with-rtsopts=-N -Wall - hs-source-dirs: ./src/ + other-modules: Paths_Gifcurry, GtkMainSyncAsync, Gifcurry + ghc-options: -threaded -with-rtsopts=-N -Wall -freverse-errors + hs-source-dirs: ./lib/ + , ./src/ , ./src/gui/ , ./src/lib/ default-language: Haskell2010 @@ -65,7 +73,7 @@ , text == 1.2.* , filepath == 1.4.* other-modules: Gifcurry - ghc-options: -Wall + ghc-options: -Wall -freverse-errors hs-source-dirs: ./src/ , ./src/cli/ , ./src/lib/ diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,202 +1,29 @@ - - Apache License - Version 2.0, January 2004 - http://www.apache.org/licenses/ - - TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION - - 1. Definitions. - - "License" shall mean the terms and conditions for use, reproduction, - and distribution as defined by Sections 1 through 9 of this document. - - "Licensor" shall mean the copyright owner or entity authorized by - the copyright owner that is granting the License. - - "Legal Entity" shall mean the union of the acting entity and all - other entities that control, are controlled by, or are under common - control with that entity. For the purposes of this definition, - "control" means (i) the power, direct or indirect, to cause the - direction or management of such entity, whether by contract or - otherwise, or (ii) ownership of fifty percent (50%) or more of the - outstanding shares, or (iii) beneficial ownership of such entity. - - "You" (or "Your") shall mean an individual or Legal Entity - exercising permissions granted by this License. - - "Source" form shall mean the preferred form for making modifications, - including but not limited to software source code, documentation - source, and configuration files. - - "Object" form shall mean any form resulting from mechanical - transformation or translation of a Source form, including but - not limited to compiled object code, generated documentation, - and conversions to other media types. - - "Work" shall mean the work of authorship, whether in Source or - Object form, made available under the License, as indicated by a - copyright notice that is included in or attached to the work - (an example is provided in the Appendix below). - - "Derivative Works" shall mean any work, whether in Source or Object - form, that is based on (or derived from) the Work and for which the - editorial revisions, annotations, elaborations, or other modifications - represent, as a whole, an original work of authorship. For the purposes - of this License, Derivative Works shall not include works that remain - separable from, or merely link (or bind by name) to the interfaces of, - the Work and Derivative Works thereof. - - "Contribution" shall mean any work of authorship, including - the original version of the Work and any modifications or additions - to that Work or Derivative Works thereof, that is intentionally - submitted to Licensor for inclusion in the Work by the copyright owner - or by an individual or Legal Entity authorized to submit on behalf of - the copyright owner. For the purposes of this definition, "submitted" - means any form of electronic, verbal, or written communication sent - to the Licensor or its representatives, including but not limited to - communication on electronic mailing lists, source code control systems, - and issue tracking systems that are managed by, or on behalf of, the - Licensor for the purpose of discussing and improving the Work, but - excluding communication that is conspicuously marked or otherwise - designated in writing by the copyright owner as "Not a Contribution." - - "Contributor" shall mean Licensor and any individual or Legal Entity - on behalf of whom a Contribution has been received by Licensor and - subsequently incorporated within the Work. - - 2. Grant of Copyright License. Subject to the terms and conditions of - this License, each Contributor hereby grants to You a perpetual, - worldwide, non-exclusive, no-charge, royalty-free, irrevocable - copyright license to reproduce, prepare Derivative Works of, - publicly display, publicly perform, sublicense, and distribute the - Work and such Derivative Works in Source or Object form. - - 3. Grant of Patent License. Subject to the terms and conditions of - this License, each Contributor hereby grants to You a perpetual, - worldwide, non-exclusive, no-charge, royalty-free, irrevocable - (except as stated in this section) patent license to make, have made, - use, offer to sell, sell, import, and otherwise transfer the Work, - where such license applies only to those patent claims licensable - by such Contributor that are necessarily infringed by their - Contribution(s) alone or by combination of their Contribution(s) - with the Work to which such Contribution(s) was submitted. If You - institute patent litigation against any entity (including a - cross-claim or counterclaim in a lawsuit) alleging that the Work - or a Contribution incorporated within the Work constitutes direct - or contributory patent infringement, then any patent licenses - granted to You under this License for that Work shall terminate - as of the date such litigation is filed. - - 4. Redistribution. You may reproduce and distribute copies of the - Work or Derivative Works thereof in any medium, with or without - modifications, and in Source or Object form, provided that You - meet the following conditions: - - (a) You must give any other recipients of the Work or - Derivative Works a copy of this License; and - - (b) You must cause any modified files to carry prominent notices - stating that You changed the files; and - - (c) You must retain, in the Source form of any Derivative Works - that You distribute, all copyright, patent, trademark, and - attribution notices from the Source form of the Work, - excluding those notices that do not pertain to any part of - the Derivative Works; and - - (d) If the Work includes a "NOTICE" text file as part of its - distribution, then any Derivative Works that You distribute must - include a readable copy of the attribution notices contained - within such NOTICE file, excluding those notices that do not - pertain to any part of the Derivative Works, in at least one - of the following places: within a NOTICE text file distributed - as part of the Derivative Works; within the Source form or - documentation, if provided along with the Derivative Works; or, - within a display generated by the Derivative Works, if and - wherever such third-party notices normally appear. The contents - of the NOTICE file are for informational purposes only and - do not modify the License. You may add Your own attribution - notices within Derivative Works that You distribute, alongside - or as an addendum to the NOTICE text from the Work, provided - that such additional attribution notices cannot be construed - as modifying the License. - - You may add Your own copyright statement to Your modifications and - may provide additional or different license terms and conditions - for use, reproduction, or distribution of Your modifications, or - for any such Derivative Works as a whole, provided Your use, - reproduction, and distribution of the Work otherwise complies with - the conditions stated in this License. - - 5. Submission of Contributions. Unless You explicitly state otherwise, - any Contribution intentionally submitted for inclusion in the Work - by You to the Licensor shall be under the terms and conditions of - this License, without any additional terms or conditions. - Notwithstanding the above, nothing herein shall supersede or modify - the terms of any separate license agreement you may have executed - with Licensor regarding such Contributions. - - 6. Trademarks. This License does not grant permission to use the trade - names, trademarks, service marks, or product names of the Licensor, - except as required for reasonable and customary use in describing the - origin of the Work and reproducing the content of the NOTICE file. - - 7. Disclaimer of Warranty. Unless required by applicable law or - agreed to in writing, Licensor provides the Work (and each - Contributor provides its Contributions) on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or - implied, including, without limitation, any warranties or conditions - of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A - PARTICULAR PURPOSE. You are solely responsible for determining the - appropriateness of using or redistributing the Work and assume any - risks associated with Your exercise of permissions under this License. - - 8. Limitation of Liability. In no event and under no legal theory, - whether in tort (including negligence), contract, or otherwise, - unless required by applicable law (such as deliberate and grossly - negligent acts) or agreed to in writing, shall any Contributor be - liable to You for damages, including any direct, indirect, special, - incidental, or consequential damages of any character arising as a - result of this License or out of the use or inability to use the - Work (including but not limited to damages for loss of goodwill, - work stoppage, computer failure or malfunction, or any and all - other commercial damages or losses), even if such Contributor - has been advised of the possibility of such damages. - - 9. Accepting Warranty or Additional Liability. While redistributing - the Work or Derivative Works thereof, You may choose to offer, - and charge a fee for, acceptance of support, warranty, indemnity, - or other liability obligations and/or rights consistent with this - License. However, in accepting such obligations, You may act only - on Your own behalf and on Your sole responsibility, not on behalf - of any other Contributor, and only if You agree to indemnify, - defend, and hold each Contributor harmless for any liability - incurred by, or claims asserted against, such Contributor by reason - of your accepting any such warranty or additional liability. - - END OF TERMS AND CONDITIONS +BSD 3-Clause License - APPENDIX: How to apply the Apache License to your work. +Copyright (c) 2016, David Lettier +All rights reserved. - To apply the Apache License to your work, attach the following - boilerplate notice, with the fields enclosed by brackets "[]" - replaced with your own identifying information. (Don't include - the brackets!) The text should be enclosed in the appropriate - comment syntax for the file format. We also recommend that a - file or class name and description of purpose be included on the - same "printed page" as the copyright notice for easier - identification within third-party archives. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: - Copyright 2016 David Lettier +* Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at +* 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. - http://www.apache.org/licenses/LICENSE-2.0 +* Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products derived from + this software without specific prior written permission. - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. +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 THE COPYRIGHT HOLDER OR CONTRIBUTORS 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. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -6,7 +6,7 @@ ## Screenshots -![GUI](https://i.imgur.com/QxX0eXT.gif) +![GUI](https://i.imgur.com/U8xnK82.gif) ## Sample GIF @@ -51,10 +51,12 @@ __/ | |___/ -Gifcurry 2.1.1.0 +Gifcurry 2.2.0.0 (C) 2016 David Lettier lettier.com +---------------------------------------- + Input file: ./03_caminandes_llamigos_1080p.mp4 Output file: ./out.gif Start second: 42.000 @@ -74,52 +76,57 @@ ## Dependencies * [Haskell](https://www.haskell.org/platform/) - * [alex](https://hackage.haskell.org/package/alex) - * [happy](https://hackage.haskell.org/package/happy) - * [gtk2hs-buildtools](https://hackage.haskell.org/package/gtk2hs-buildtools) - * [cmdargs](https://hackage.haskell.org/package/cmdargs) - * [System.IO.Temp (temporary)](https://hackage.haskell.org/package/temporary) - * [Graphics.UI.Gtk (gtk)](https://hackage.haskell.org/package/gtk3) - * [System.Directory (directory)](https://hackage.haskell.org/package/directory) - * [System.FilePath (filepath)](https://hackage.haskell.org/package/filepath) * [FFmpeg](https://www.ffmpeg.org/download.html) * [ImageMagick](http://www.imagemagick.org/script/download.php) * [GTK+](http://www.gtk.org/download/index.php) ## Install & Run -### Ubuntu/Mint +### Linux +#### Ubuntu/Mint + ```bash -# Install FFmpeg & ImageMagick +# Install FFmpeg (https://www.ffmpeg.org/download.html) +# Install ImageMagick (https://www.imagemagick.org/script/download.php) sudo add-apt-repository ppa:kirillshkrogalev/ffmpeg-next sudo apt-get update sudo apt-get install ffmpeg imagemagick +# Install Haskell (https://www.haskell.org/platform/) +# Install GNU Wget (https://www.gnu.org/software/wget/) # Find the latest release at https://github.com/lettier/gifcurry/releases -wget https://github.com/lettier/gifcurry/releases/download/*/gifcurry-linux*.tar.gz -tar xvfz gifcurry-linux*.tar.gz -cd gifcurry-linux*/bin +# * 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_gui ./gifcurry_cli -? ``` -### Arch Linux +#### Arch/Manjaro ```bash -# Install FFmpeg and ImageMagick -# Install yaourt (https://archlinux.fr/yaourt-en) -# AUR package: https://aur.archlinux.org/packages/gifcurry/ -yaourt -S gifcurry +cd +# Install Git +sudo pacman -S git +# Install Gifcurry from AUR +mkdir -p build_gifcurry +cd build_gifcurry +git clone https://aur.archlinux.org/gifcurry.git +cd gifcurry +makepkg -sic +cd +rm -rf build_gifcurry gifcurry_gui gifcurry_cli -? ``` -### macOS Sierra +### Mac #### Binaries ```bash -# If you don't have Homebrew +# If you do not have Homebrew /usr/bin/ruby -e "$(curl -fsSL https://raw.githubusercontent.com/Homebrew/install/master/install)" brew install ffmpeg brew install imagemagick @@ -127,9 +134,10 @@ brew install wget brew install gnome-icon-theme # Find the latest release at https://github.com/lettier/gifcurry/releases -wget https://github.com/lettier/gifcurry/releases/download/*/gifcurry-macosx*.tar.gz -tar xvfz gifcurry-macosx*.tar.gz -cd gifcurry-macosx*/bin +# * 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_gui ./gifcurry_cli -? ``` @@ -137,7 +145,7 @@ #### Compile ```bash -# If you don't have Homebrew +# If you do not have Homebrew /usr/bin/ruby -e "$(curl -fsSL https://raw.githubusercontent.com/Homebrew/install/master/install)" brew update brew install xcode @@ -160,7 +168,6 @@ cabal sandbox init cabal update cabal install alex happy -j -cabal install gtk2hs-buildtools -j cabal install gifcurry -j cd .cabal-sandbox/bin/ ./gifcurry_gui @@ -169,12 +176,32 @@ ### Hackage +#### Stack + ```bash -# Install ghc and cabal-install -# Install ffmpeg and imagemagick +# 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 +stack exec -- gifcurry_gui +stack exec -- gifcurry_cli -? +``` + +#### Cabal + +```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 gtk2hs-buildtools -j cabal install gifcurry -j cd ~/.cabal/bin ./gifcurry_gui @@ -184,31 +211,15 @@ ### Github ```bash -# Install ghc and cabal-install -# Install ffmpeg and imagemagick -# Install GNU Make +# 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_gui make run_cli CLI_ARGS='-?' - -# Or you can do - -# Install ghc and cabal-install -# Install ffmpeg and imagemagick -git clone git@github.com:lettier/gifcurry.git -cd gifcurry/ -cabal sandbox init -cabal update -cabal install alex happy -j -cabal install gtk2hs-buildtools -j -cabal install -j --dependencies-only -cabal configure -cabal build -j -cabal install -j --enable-relocatable -./.cabal-sandbox/bin/gifcurry_gui -./.cabal-sandbox/bin/gifcurry_cli -? ``` ## License diff --git a/lib/GtkMainSyncAsync.hs b/lib/GtkMainSyncAsync.hs new file mode 100644 --- /dev/null +++ b/lib/GtkMainSyncAsync.hs @@ -0,0 +1,62 @@ +{- + Gifcurry + (C) 2017 David Lettier + lettier.com + + Based on the following works. + + - https://github.com/gtk2hs/gtk2hs/blob/master/gtk/Graphics/UI/Gtk/General/General.chs#L177 + - https://github.com/gtk2hs/gtk2hs/blob/master/gtk/Graphics/UI/Gtk/General/General.chs#L188 + + Modified to work with haskell-gi (https://github.com/haskell-gi). + + Original license: + + GIMP Toolkit (GTK) General + + Author : Axel Simon, Manuel M. T. Chakravarty + + Created: 8 December 1998 + + Copyright (C) 2000..2005 Axel Simon, Manuel M. T. Chakravarty + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. +-} + +{-# LANGUAGE OverloadedStrings #-} + +module GtkMainSyncAsync ( + gtkMainSync + , gtkMainAsync + ) where + +import Control.Monad +import Control.Concurrent +import GI.GLib hiding (String, IOError) + +gtkMainSync :: IO a -> IO a +gtkMainSync callback = + newEmptyMVar >>= + gtkMainSyncSetupCallBack callback >>= + takeMVar + +gtkMainAsync :: IO () -> IO () +gtkMainAsync callback = gtkMainAddCallback (callback >> return False) + +gtkMainSyncSetupCallBack :: IO a -> MVar a -> IO (MVar a) +gtkMainSyncSetupCallBack callback mVar = + gtkMainAddCallback (gtkMainSyncBuildCallBack callback mVar) >> return mVar + +gtkMainSyncBuildCallBack :: IO a -> MVar a -> IO Bool +gtkMainSyncBuildCallBack callback mVar = callback >>= putMVar mVar >> return False + +gtkMainAddCallback :: GI.GLib.SourceFunc -> IO () +gtkMainAddCallback callback = void $ GI.GLib.idleAdd GI.GLib.PRIORITY_DEFAULT callback diff --git a/lib/LICENSE b/lib/LICENSE new file mode 100644 --- /dev/null +++ b/lib/LICENSE @@ -0,0 +1,165 @@ + GNU LESSER GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + + This version of the GNU Lesser General Public License incorporates +the terms and conditions of version 3 of the GNU General Public +License, supplemented by the additional permissions listed below. + + 0. Additional Definitions. + + As used herein, "this License" refers to version 3 of the GNU Lesser +General Public License, and the "GNU GPL" refers to version 3 of the GNU +General Public License. + + "The Library" refers to a covered work governed by this License, +other than an Application or a Combined Work as defined below. + + An "Application" is any work that makes use of an interface provided +by the Library, but which is not otherwise based on the Library. +Defining a subclass of a class defined by the Library is deemed a mode +of using an interface provided by the Library. + + A "Combined Work" is a work produced by combining or linking an +Application with the Library. The particular version of the Library +with which the Combined Work was made is also called the "Linked +Version". + + The "Minimal Corresponding Source" for a Combined Work means the +Corresponding Source for the Combined Work, excluding any source code +for portions of the Combined Work that, considered in isolation, are +based on the Application, and not on the Linked Version. + + The "Corresponding Application Code" for a Combined Work means the +object code and/or source code for the Application, including any data +and utility programs needed for reproducing the Combined Work from the +Application, but excluding the System Libraries of the Combined Work. + + 1. Exception to Section 3 of the GNU GPL. + + You may convey a covered work under sections 3 and 4 of this License +without being bound by section 3 of the GNU GPL. + + 2. Conveying Modified Versions. + + If you modify a copy of the Library, and, in your modifications, a +facility refers to a function or data to be supplied by an Application +that uses the facility (other than as an argument passed when the +facility is invoked), then you may convey a copy of the modified +version: + + a) under this License, provided that you make a good faith effort to + ensure that, in the event an Application does not supply the + function or data, the facility still operates, and performs + whatever part of its purpose remains meaningful, or + + b) under the GNU GPL, with none of the additional permissions of + this License applicable to that copy. + + 3. Object Code Incorporating Material from Library Header Files. + + The object code form of an Application may incorporate material from +a header file that is part of the Library. You may convey such object +code under terms of your choice, provided that, if the incorporated +material is not limited to numerical parameters, data structure +layouts and accessors, or small macros, inline functions and templates +(ten or fewer lines in length), you do both of the following: + + a) Give prominent notice with each copy of the object code that the + Library is used in it and that the Library and its use are + covered by this License. + + b) Accompany the object code with a copy of the GNU GPL and this license + document. + + 4. Combined Works. + + You may convey a Combined Work under terms of your choice that, +taken together, effectively do not restrict modification of the +portions of the Library contained in the Combined Work and reverse +engineering for debugging such modifications, if you also do each of +the following: + + a) Give prominent notice with each copy of the Combined Work that + the Library is used in it and that the Library and its use are + covered by this License. + + b) Accompany the Combined Work with a copy of the GNU GPL and this license + document. + + c) For a Combined Work that displays copyright notices during + execution, include the copyright notice for the Library among + these notices, as well as a reference directing the user to the + copies of the GNU GPL and this license document. + + d) Do one of the following: + + 0) Convey the Minimal Corresponding Source under the terms of this + License, and the Corresponding Application Code in a form + suitable for, and under terms that permit, the user to + recombine or relink the Application with a modified version of + the Linked Version to produce a modified Combined Work, in the + manner specified by section 6 of the GNU GPL for conveying + Corresponding Source. + + 1) Use a suitable shared library mechanism for linking with the + Library. A suitable mechanism is one that (a) uses at run time + a copy of the Library already present on the user's computer + system, and (b) will operate properly with a modified version + of the Library that is interface-compatible with the Linked + Version. + + e) Provide Installation Information, but only if you would otherwise + be required to provide such information under section 6 of the + GNU GPL, and only to the extent that such information is + necessary to install and execute a modified version of the + Combined Work produced by recombining or relinking the + Application with a modified version of the Linked Version. (If + you use option 4d0, the Installation Information must accompany + the Minimal Corresponding Source and Corresponding Application + Code. If you use option 4d1, you must provide the Installation + Information in the manner specified by section 6 of the GNU GPL + for conveying Corresponding Source.) + + 5. Combined Libraries. + + You may place library facilities that are a work based on the +Library side by side in a single library together with other library +facilities that are not Applications and are not covered by this +License, and convey such a combined library under terms of your +choice, if you do both of the following: + + a) Accompany the combined library with a copy of the same work based + on the Library, uncombined with any other library facilities, + conveyed under the terms of this License. + + b) Give prominent notice with the combined library that part of it + is a work based on the Library, and explaining where to find the + accompanying uncombined form of the same work. + + 6. Revised Versions of the GNU Lesser General Public License. + + The Free Software Foundation may publish revised and/or new versions +of the GNU Lesser General Public License from time to time. Such new +versions will be similar in spirit to the present version, but may +differ in detail to address new problems or concerns. + + Each version is given a distinguishing version number. If the +Library as you received it specifies that a certain numbered version +of the GNU Lesser General Public License "or any later version" +applies to it, you have the option of following the terms and +conditions either of that published version or of any later version +published by the Free Software Foundation. If the Library as you +received it does not specify a version number of the GNU Lesser +General Public License, you may choose any version of the GNU Lesser +General Public License ever published by the Free Software Foundation. + + If the Library as you received it specifies that a proxy can decide +whether future versions of the GNU Lesser General Public License shall +apply, that proxy's public statement of acceptance of any version is +permanent authorization for you to choose that version for the +Library. diff --git a/makefile b/makefile new file mode 100644 --- /dev/null +++ b/makefile @@ -0,0 +1,85 @@ +# (C) 2016 David Lettier +# lettier.com + +.RECIPEPREFIX != ps + +STACK=stack --allow-different-user +STACK_PATH_LOCAL_BIN=`$(STACK) path --local-bin` +STACK_GHC_EXE=`$(STACK) path --compiler-exe` +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.2.0.0' + +export PATH := $(PATH):$(STACK_PATH_LOCAL_BIN) + +all: setup update sandbox_clean clean alex happy install_dependencies configure build install + +setup: + + $(STACK) setup && $(STACK) update && $(STACK) install Cabal && $(STACK) install cabal-install + +alex: setup + $(STACK) install alex + +happy: setup + $(STACK) install happy + +sandbox: setup + $(CABAL) sandbox init + +clean: setup + $(CABAL) clean + +check: setup + $(CABAL) check + +sandbox_clean: setup + $(CABAL) sandbox init && $(CABAL) sandbox delete && $(CABAL) sandbox init + +update: sandbox + $(CABAL) --require-sandbox update + +install_dependencies: sandbox + $(CABAL) --require-sandbox install -j -w $(STACK_GHC_EXE) --only-dependencies + +configure: sandbox + $(CABAL) --require-sandbox configure -w $(STACK_GHC_EXE) + +build: configure + $(CABAL) --require-sandbox build -j + +install: build + $(CABAL) --require-sandbox install -j -w $(STACK_GHC_EXE) --enable-relocatable + +release: check build + $(CABAL) sdist + +run_gui: install + ./.cabal-sandbox/bin/gifcurry_gui + +run_cli: install + ./.cabal-sandbox/bin/gifcurry_cli $(CLI_ARGS) + +build_docs: setup + $(CABAL) haddock --hyperlink-source \ + --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' + +# 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_install_dependencies: sandbox + $(CABAL) --require-sandbox install -j -w $(STACK_GHC_EXE) --force-reinstalls --reinstall --only-dependencies + +arch_os_configure: sandbox + $(CABAL) --require-sandbox configure -w $(STACK_GHC_EXE) --prefix=$(PREFIX) + +arch_os_build: arch_os_configure + $(CABAL) --require-sandbox build -j + +arch_os_install_gifcurry: arch_os_build + $(CABAL) --require-sandbox copy --destdir=$(DESTDIR) +# End Arch Linux Specific diff --git a/src/data/gui.glade b/src/data/gui.glade --- a/src/data/gui.glade +++ b/src/data/gui.glade @@ -2,59 +2,99 @@ - + 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 - lettier.com + Gifcurry False mouse 400 - icon2.ico + icon.ico center - + True False vertical - + True False - Select an input file. - True - False - Select an Input File + + + 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 + + - True - True + False + False 0 - + True False True - + True True Start time. @@ -70,7 +110,7 @@ - + True True Duration. @@ -89,16 +129,16 @@ False True - 1 + 2 - + True False True - + True True GIF width in px. @@ -114,7 +154,7 @@ - + True True GIF quality from 1 to 100. @@ -135,11 +175,11 @@ True True - 2 + 3 - + font_chooser_button True True @@ -147,7 +187,7 @@ Choose your desired font for the bottom and top text. Sans 12 I love making GIFs with Gifcurry! - Choose a Font + Gifcurry - Choose a Font True False False @@ -159,7 +199,7 @@ - + True True Optional top text. @@ -173,7 +213,7 @@ - + True True Optional bottom text. @@ -188,7 +228,7 @@ - + True False @@ -199,12 +239,12 @@ - + True False Select an output folder. select-folder - Select an Output Folder + Gifcurry - Select an Output Folder True @@ -213,7 +253,7 @@ - + True True Output file name. @@ -228,11 +268,11 @@ - + True False - + True False First frame preview. @@ -249,7 +289,7 @@ - + True False Last frame preview. @@ -286,18 +326,18 @@ - + True False True - + Create True True True Create the GIF. - create_icon + create-icon half top True @@ -309,13 +349,13 @@ - + Open True True True Open the GIF. - open_icon + open-icon half top True @@ -335,12 +375,12 @@ - + True False True - + button True True @@ -372,7 +412,7 @@ - + button True True @@ -396,7 +436,7 @@ - + True False False @@ -404,7 +444,7 @@ True top - + True False True @@ -435,5 +475,132 @@ + + + + + + False + Gifcurry - About + center + True + dialog-information + dialog + True + center + gifcurry-window + gifcurry-window + Gifcurry + 2.2.0.0 + (C) 2016 David Lettier +lettier.com + https://github.com/lettier/gifcurry + Update + BSD 3-Clause License + +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 copyright holder 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 THE COPYRIGHT HOLDER OR CONTRIBUTORS 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. + David Lettier + icon.ico + custom + + + False + vertical + 2 + + + False + end + + + False + False + 0 + + + + + + + + + + + + + False + Gifcurry - Click Yes or No + center + True + dialog-question + dialog + True + center + gifcurry-window + gifcurry-window + warning + Are you sure you want to make a GIF that long? + + + False + vertical + 2 + + + False + True + end + + + + + + + + + False + False + 0 + + + + + + + + + + gtk-yes + True + True + True + True + True diff --git a/src/data/icon.ico b/src/data/icon.ico Binary files a/src/data/icon.ico and b/src/data/icon.ico differ diff --git a/src/data/icon2.ico b/src/data/icon2.ico deleted file mode 100644 Binary files a/src/data/icon2.ico and /dev/null differ diff --git a/src/gui/Main.hs b/src/gui/Main.hs --- a/src/gui/Main.hs +++ b/src/gui/Main.hs @@ -4,216 +4,285 @@ 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 Graphics.UI.Gtk +import Data.GI.Base +import GI.GObject +import qualified GI.Gtk import Paths_Gifcurry -import qualified Gifcurry (gif, GifParams(..), defaultGifParams, gifParamsValid) +import qualified Gifcurry ( + gif + , GifParams(..) + , defaultGifParams + , gifParamsValid + , getVideoDurationInSeconds + ) +import qualified GtkMainSyncAsync (gtkMainSync, gtkMainAsync) main :: IO () main = do - _ <- initGUI + _ <- GI.Gtk.init Nothing builder <- buildBuilder - window <- loadWindow builder "gifcurry_window" - startTimeEntry <- loadEntry builder "start_time_text_entry" - durationTimeEntry <- loadEntry builder "duration_text_entry" - widthEntry <- loadEntry builder "width_text_entry" - qualityEntry <- loadEntry builder "quality_text_entry" - topTextEntry <- loadEntry builder "top_text_text_entry" - bottomTextEntry <- loadEntry builder "bottom_text_text_entry" - outputFileNameEntry <- loadEntry builder "output_file_name_text_entry" - statusEntry <- loadEntry builder "status_text_entry" - inputFileButton <- loadFileChooserButton builder "input_file_button" - outputFilePathButton <- loadFileChooserButton builder "output_file_path_button" - fontChooserButton <- loadFontChooserButton builder "font_chooser_button" - createButton <- loadButton builder "create_button" - openButton <- loadButton builder "open_button" - giphyButton <- loadButton builder "giphy_link_button" - imgurButton <- loadButton builder "imgur_link_button" - firstFrameImage <- loadImage builder "first_frame_image" - lastFrameImage <- loadImage builder "last_frame_image" + 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. - buttonSetLabel giphyButton "Giphy" - buttonSetLabel imgurButton "Imgur" + GI.Gtk.buttonSetLabel giphyButton "Giphy" + GI.Gtk.buttonSetLabel imgurButton "Imgur" - entrySetText qualityEntry "100" - entrySetText widthEntry "500" + GI.Gtk.entrySetText qualityEntry "100" + GI.Gtk.entrySetText widthEntry "500" - _ <- inputFileButton `on` fileChooserButtonFileSet $ do - imageSetFromIconName firstFrameImage blankPreviewIcon IconSizeButton - imageSetFromIconName lastFrameImage blankPreviewIcon IconSizeButton + -- 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) - _ <- startTimeEntry `on` editableChanged $ + _ <- 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 + ) + + _ <- GI.Gtk.onEditableChanged startTimeEntry $ makeFirstFramePreview inputFileButton startTimeEntry durationTimeEntry firstFrameImage lastFrameImage - _ <- durationTimeEntry `on` editableChanged $ + _ <- GI.Gtk.onEditableChanged durationTimeEntry $ makeLastFramePreview inputFileButton startTimeEntry durationTimeEntry lastFrameImage - _ <- createButton `on` buttonActivated $ do + _ <- 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 <- fontButtonGetFontName fontChooserButton - topText <- entryGetText topTextEntry - bottomText <- entryGetText bottomTextEntry + 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.inputFile = inputFilePathName + , Gifcurry.outputFile = outputFilePathName + , Gifcurry.startTime = startTime + , Gifcurry.durationTime = durationTime + , Gifcurry.widthSize = widthSize , Gifcurry.qualityPercent = qualityPercent - , Gifcurry.fontChoice = fontChoice - , Gifcurry.topText = topText - , Gifcurry.bottomText = bottomText + , Gifcurry.fontChoice = unpack fontChoice + , Gifcurry.topText = unpack topText + , Gifcurry.bottomText = unpack bottomText } paramsValid <- Gifcurry.gifParamsValid params + setStatusEntryReady statusEntry if paramsValid - then void $ forkOS $ do - postGUIAsync $ entrySetText statusEntry "One GIF coming up!" - success <- (ioSuccess . Gifcurry.gif) params - if not success - then postGUIAsync $ entrySetText statusEntry "Did not work. Check your settings." - else do - _ <- forkOS $ postGUIAsync $ openGifCommand outputFilePathName - postGUIAsync $ entrySetText statusEntry "Ready." - else entrySetText statusEntry "Settings are wrong." + 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 - _ <- openButton `on` buttonActivated $ do + _ <- GI.Gtk.onWidgetButtonReleaseEvent openButton $ \ _ -> do (_, outputFilePathName) <- assembleOutputFilePathName outputFilePathButton outputFileNameEntry fileExists <- doesFileExist outputFilePathName if fileExists - then void $ forkIO $ postGUIAsync $ openGifCommand outputFilePathName - else entrySetText statusEntry "GIF does not exist. Check your settings." - - _ <- on window objectDestroy mainQuit - - widgetShowAll window - mainGUI - -loadWindow :: Builder -> (String -> IO Window) -loadWindow b = builderGetObject b castToWindow - -loadEntry :: Builder -> (String -> IO Entry) -loadEntry b = builderGetObject b castToEntry + then void $ forkIO $ GtkMainSyncAsync.gtkMainAsync $ openGifCommand outputFilePathName + else GI.Gtk.entrySetText statusEntry "GIF does not exist. Check your settings." + return True -loadFileChooserButton :: Builder -> (String -> IO FileChooserButton) -loadFileChooserButton b = builderGetObject b castToFileChooserButton + _ <- GI.Gtk.onWidgetButtonReleaseEvent aboutButton $ \ _ -> GI.Gtk.dialogRun aboutDialog >> return True -loadFontChooserButton :: Builder -> (String -> IO FontButton) -loadFontChooserButton b = builderGetObject b castToFontButton + _ <- GI.Gtk.onDialogResponse longGifGtkMessageDialog (\ _ -> GI.Gtk.widgetHide longGifGtkMessageDialog) + _ <- GI.Gtk.onDialogResponse aboutDialog (\ _ -> GI.Gtk.widgetHide aboutDialog) -loadButton :: Builder -> (String -> IO Button) -loadButton b = builderGetObject b castToButton + _ <- GI.Gtk.onWidgetDestroy window GI.Gtk.mainQuit -loadImage :: Builder -> (String -> IO Image) -loadImage b = builderGetObject b castToImage + GI.Gtk.widgetShowAll window + GI.Gtk.main -buildBuilder :: IO Builder +buildBuilder :: IO GI.Gtk.Builder buildBuilder = do - builder <- builderNew gladeFile <- getDataFileName "data/gui.glade" - builderAddFromFile builder gladeFile - return builder + GI.Gtk.builderNewFromFile (pack gladeFile) -inputFileButtonGetText :: FileChooserButton -> IO String +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 - inputFileButtonText <- fileChooserGetFilename inputFileButton - inputFilePathName <- case inputFileButtonText of - Nothing -> return "" - Just inputFilePathName -> return inputFilePathName + inputFilePathName <- fileChooserButtonGetText inputFileButton fileExist <- doesFileExist inputFilePathName if fileExist then return inputFilePathName else return "" -entryGetFloat :: Entry -> Float -> IO Float -entryGetFloat e nothing = fmap (\ t -> fromMaybe nothing (readMaybe t :: Maybe Float)) (entryGetText e) +durationTimeWarningLevel :: Float +durationTimeWarningLevel = 10.0 -assembleOutputFilePathName :: FileChooserButton -> Entry -> IO (String, String) +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 - outputFilePathText <- fileChooserGetFilename outputFilePathButton - outputFilePath <- case outputFilePathText of - Nothing -> return "" - Just dir -> return dir - outputFileName <- entryGetText outputFileNameEntry + outputFilePath <- fileChooserButtonGetText outputFilePathButton + outputFileName <- unpack . Data.Text.strip <$> GI.Gtk.entryGetText outputFileNameEntry let outputGifFileName = outputFileName ++ ".gif" - let outputFilePathName = outputFilePath ++ "/" ++ outputGifFileName + 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)) + when fileExists $ void (spawnCommand (command ++ "\"" ++ outputFilePathName ++ "\"")) where command :: String - command = if "linux" `isInfixOf` fmap toLower System.Info.os then "xdg-open " else "open " + command = if "linux" `Data.List.isInfixOf` fmap Data.Char.toLower System.Info.os + then "xdg-open " + else "open " blankPreviewIcon :: String blankPreviewIcon = "gtk-discard" -resetImage :: Image -> IO () -resetImage image = imageSetFromIconName image blankPreviewIcon IconSizeButton +resetImage :: GI.Gtk.Image -> IO () +resetImage image = + GI.Gtk.imageSetFromIconName + image + (Just $ pack blankPreviewIcon) + (enumToInt32 GI.Gtk.IconSizeButton) -makeGifPreview :: String -> String -> Float -> String -> String -> IO (Either IOError String) -makeGifPreview inputFile outputFile startTime fontChoice bottomText = Gifcurry.gif $ Gifcurry.defaultGifParams { - Gifcurry.inputFile = inputFile - , Gifcurry.outputFile = outputFile - , Gifcurry.startTime = startTime - , Gifcurry.durationTime = 0.001 - , Gifcurry.widthSize = 200 +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.fontChoice = fontChoice - , Gifcurry.bottomText = bottomText + , Gifcurry.bottomText = bottomText } ioSuccess :: IO (Either IOError String) -> IO Bool ioSuccess = fmap isRight -makeLastFramePreview :: FileChooserButton -> Entry -> Entry -> Image -> IO () -makeLastFramePreview inputFileButton startTimeEntry durationTimeEntry lastFrameImage = do - _ <- forkIO $ - withTempDirectory "." "previews" $ \tmpdir -> do - inputFilePathName <- inputFileButtonGetText inputFileButton - startTime <- entryGetFloat startTimeEntry (-1.0) - durationTime <- entryGetFloat durationTimeEntry 0.001 - let startTime' = startTime + durationTime - if not (null inputFilePathName) && (startTime' > 0.0) then do - let outputFilePathName = tmpdir ++ "/end.gif" - success <- ioSuccess $ makeGifPreview inputFilePathName outputFilePathName startTime' "default" " LAST FRAME " - if success - then postGUISync $ imageSetFromFile lastFrameImage outputFilePathName - else postGUISync $ resetImage lastFrameImage - else postGUIAsync $ resetImage lastFrameImage - return () +framePreviewDirectoryName :: String +framePreviewDirectoryName = "gifcurry-frame-previews" -makeFirstFramePreview :: FileChooserButton -> Entry -> Entry -> Image -> Image -> IO () -makeFirstFramePreview inputFileButton startTimeEntry durationTimeEntry firstFrameImage lastFrameImage = do - _ <- forkIO $ do - withTempDirectory "." "previews" $ \tmpDir -> do - inputFilePathName <- inputFileButtonGetText inputFileButton - startTime <- entryGetFloat startTimeEntry (-1.0) - if not (null inputFilePathName) && (startTime >= 0.0) then do - let outputFilePathName = tmpDir ++ "/start.gif" - success <- ioSuccess $ makeGifPreview inputFilePathName outputFilePathName startTime "default" " FIRST FRAME " - if success - then postGUISync $ imageSetFromFile firstFrameImage outputFilePathName - else postGUISync $ resetImage firstFrameImage - else postGUISync $ resetImage firstFrameImage +makeLastFramePreview :: GI.Gtk.FileChooserButton -> GI.Gtk.Entry -> GI.Gtk.Entry -> GI.Gtk.Image -> IO () +makeLastFramePreview inputFileButton startTimeEntry durationTimeEntry lastFrameImage = + void $ forkIO $ + withTempDirectory "." 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 -> IO () +makeFirstFramePreview inputFileButton startTimeEntry durationTimeEntry firstFrameImage lastFrameImage = + void $ forkIO $ do + withTempDirectory "." 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 - return () + +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 diff --git a/src/lib/Gifcurry.hs b/src/lib/Gifcurry.hs --- a/src/lib/Gifcurry.hs +++ b/src/lib/Gifcurry.hs @@ -14,6 +14,7 @@ , defaultGifParams , gifParamsValid , versionNumber + , getVideoDurationInSeconds ) where import System.Process @@ -43,7 +44,7 @@ -- | The version number. versionNumber :: String -versionNumber = "2.1.1.0" +versionNumber = "2.2.0.0" -- | Specifies default parameters for 'startTime', 'durationTime', 'widthSize', 'qualityPercent', and 'fontChoice'. defaultGifParams :: GifParams @@ -54,7 +55,7 @@ , durationTime = 1.0 , widthSize = 500 , qualityPercent = 100.0 - , fontChoice = "default" + , fontChoice = defaultFontChoice , topText = "" , bottomText = "" } @@ -75,7 +76,7 @@ -- @ gif :: GifParams -> IO (Either IOError String) gif gifParams = - withTempDirectory "." "frames" $ \tmpdir -> do + withTempDirectory "." "gifcurry-frames" $ \tmpdir -> do printGifParams gifParams tmpdir validParams <- gifParamsValid gifParams if validParams @@ -86,7 +87,8 @@ then do fontMatch <- getFontMatch gifParams let gifParams' = gifParams { fontChoice = fontMatch } - putStrLn $ "Writing your GIF to... " ++ outputFile gifParams + putStrLn $ "Writing your GIF to: " ++ + outputFile gifParams convertResult <- tryConvert gifParams' tmpdir let convertSuccess = eitherBool convertResult if convertSuccess @@ -98,21 +100,15 @@ return fFMpegResult else return $ Left (userError "[Error] Invalid params.") where - runFontMatch :: GifParams -> Bool - runFontMatch GifParams { fontChoice = _, topText = "", bottomText = "" } = False - runFontMatch GifParams { fontChoice = "default", topText = _, bottomText = _ } = False - runFontMatch _ = True getFontMatch :: GifParams -> IO String - getFontMatch gifParams' - | runFontMatch gifParams' = do - fontNames <- getListOfFontNames - let match = bestFontNameMatch (fontChoice gifParams') fontNames - putStrLn $ "Font matched: " ++ match - return match - | otherwise = defaultAction - where - defaultAction :: IO String - defaultAction = putStrLn "Using the default font." >> return "default" + getFontMatch GifParams { topText = "", bottomText = "" } = defaultFontMatch + getFontMatch gifParams' = do + fontNames <- getListOfFontNames + let match = bestFontNameMatch (fontChoiceOrDefault gifParams') fontNames + putStrLn $ "Font matched: " ++ 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) @@ -133,12 +129,32 @@ 0 -> return False _ -> doesFileExist ipf unless inputFileExists $ putStrLn "\n[Error] Input video file does not exist." - let outputFileValid = Prelude.length opf > 5 - unless outputFileValid $ putStrLn "\n[Error] Output GIF file is blank." - let valid = inputFileExists && outputFileValid && (st >= 0.0) && (dt >= 0.0) && (ws > 0) && (qp > 0.0) + 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 +-- | Returns the duration of the video in seconds if successful. +-- +-- @ +-- import qualified Gifcurry (getVideoDurationInSeconds) +-- -- ... +-- let params = Gifcurry.defaultGifParams { Gifcurry.inputFile = ".\/in.mov" } +-- maybeDuration <- Gifcurry.getVideoDurationInSeconds params +-- let duration = case maybeDuration of +-- Nothing -> 0.0 +-- Just float -> float +-- @ +getVideoDurationInSeconds :: GifParams -> IO (Maybe Float) +getVideoDurationInSeconds gifParams = tryFfprobe gifParams >>= result + where + result :: Either IOError String -> IO (Maybe Float) + result (Left _) = return Nothing + result (Right durationString) = return (readMaybe durationString :: Maybe Float) + printGifParams :: GifParams -> String -> IO () printGifParams GifParams { @@ -153,7 +169,8 @@ , bottomText = bt } tmpdir = mapM_ putStrLn [ - "\nInput file: " ++ ipf + "\n----------------------------------------\n" + , "Input file: " ++ ipf , "Output file: " ++ opf , "Start second: " ++ printf "%.3f" st , "Duration: " ++ printf "%.3f" dt ++ " seconds" @@ -162,7 +179,8 @@ , "Font Choice: " ++ fc , "Top text: " ++ tt , "Bottom text: " ++ bt - , "\nWriting temporary frames to... " ++ tmpdir + , "" + , "Writing temporary frames to: " ++ tmpdir ] frameFileExtension :: String @@ -203,6 +221,20 @@ , tmpdir ++ "/%010d." ++ frameFileExtension ] +tryFfprobe :: GifParams -> IO (Either IOError String) +tryFfprobe GifParams { inputFile = ipf } = try(readProcess "ffprobe" params []) + where + params = [ + "-i" + , ipf + , "-v" + , "quiet" + , "-show_entries" + , "format=duration" + , "-of" + , "default=noprint_wrappers=1:nokey=1" + ] + tryConvert :: GifParams -> String -> IO (Either IOError String) tryConvert GifParams { @@ -307,8 +339,7 @@ fontSetting :: String -> [String] fontSetting "" = [] -fontSetting "default" = [] -fontSetting fc = ["-font", fc] +fontSetting font = ["-font", font] bestFontNameMatch :: String -> [Text] -> String bestFontNameMatch _ [] = "default" @@ -380,8 +411,19 @@ splitOnX :: [Text] splitOnX = splitOn "x" $ Data.Text.toLower s pluckWidth :: [Text] -> Int - pluckWidth (x:_:_) = read (Data.Text.unpack x) :: Int + pluckWidth (x:_:_) = read (Data.Text.unpack x) :: Int pluckWidth _ = 0 pluckHeight :: [Text] -> Int 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 = (Data.Text.unpack . Data.Text.strip . Data.Text.pack) fontName