Gifcurry 2.1.1.0 → 2.2.0.0
raw patch · 12 files changed
+1258/−463 lines, 12 filesdep +gi-gdkdep +gi-glibdep +gi-gobjectdep −gtk3
Dependencies added: gi-gdk, gi-glib, gi-gobject, gi-gtk, haskell-gi-base
Dependencies removed: gtk3
Files
- CHANGELOG.md +359/−0
- Gifcurry.cabal +18/−10
- LICENSE +23/−196
- README.md +61/−50
- lib/GtkMainSyncAsync.hs +62/−0
- lib/LICENSE +165/−0
- makefile +85/−0
- src/data/gui.glade +209/−42
- src/data/icon.ico binary
- src/data/icon2.ico binary
- src/gui/Main.hs +208/−139
- src/lib/Gifcurry.hs +68/−26
+ CHANGELOG.md view
@@ -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/)
Gifcurry.cabal view
@@ -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/
LICENSE view
@@ -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.
README.md view
@@ -6,7 +6,7 @@ ## Screenshots -+ ## 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
+ lib/GtkMainSyncAsync.hs view
@@ -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
+ lib/LICENSE view
@@ -0,0 +1,165 @@+ GNU LESSER GENERAL PUBLIC LICENSE+ Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ 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.
+ makefile view
@@ -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
src/data/gui.glade view
@@ -2,59 +2,99 @@ <!-- Generated with glade 3.20.0 --> <interface> <requires lib="gtk+" version="3.10"/>- <object class="GtkImage" id="create_icon">+ <object class="GtkImage" id="about-image"> <property name="visible">True</property> <property name="can_focus">False</property>+ <property name="stock">gtk-about</property>+ </object>+ <object class="GtkImage" id="create-icon">+ <property name="visible">True</property>+ <property name="can_focus">False</property> <property name="margin_top">5</property> <property name="margin_bottom">5</property> <property name="stock">gtk-save</property> <property name="icon_size">2</property> </object>- <object class="GtkImage" id="open_icon">+ <object class="GtkButton" id="no-button">+ <property name="label">gtk-no</property> <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="use_stock">True</property>+ <property name="always_show_image">True</property>+ </object>+ <object class="GtkImage" id="open-icon">+ <property name="visible">True</property> <property name="can_focus">False</property> <property name="margin_top">5</property> <property name="margin_bottom">5</property> <property name="stock">gtk-open</property> <property name="icon_size">2</property> </object>- <object class="GtkWindow" id="gifcurry_window">+ <object class="GtkWindow" id="gifcurry-window"> <property name="width_request">400</property> <property name="can_focus">False</property> <property name="valign">center</property>- <property name="title">Gifcurry - lettier.com</property>+ <property name="title">Gifcurry </property> <property name="resizable">False</property> <property name="window_position">mouse</property> <property name="default_width">400</property>- <property name="icon">icon2.ico</property>+ <property name="icon">icon.ico</property> <property name="gravity">center</property> <child>- <object class="GtkBox" id="app_box">+ <object class="GtkBox" id="app-box"> <property name="visible">True</property> <property name="can_focus">False</property> <property name="orientation">vertical</property> <child>- <object class="GtkFileChooserButton" id="input_file_button">+ <object class="GtkBox" id="file-input-about-box"> <property name="visible">True</property> <property name="can_focus">False</property>- <property name="tooltip_text" translatable="yes">Select an input file.</property>- <property name="do_overwrite_confirmation">True</property>- <property name="local_only">False</property>- <property name="title" translatable="yes">Select an Input File</property>+ <child>+ <object class="GtkFileChooserButton" id="input-file-button">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="tooltip_text" translatable="yes">Select an input file.</property>+ <property name="do_overwrite_confirmation">True</property>+ <property name="local_only">False</property>+ <property name="title" translatable="yes">Gifcurry - Select an Input File</property>+ </object>+ <packing>+ <property name="expand">True</property>+ <property name="fill">True</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <object class="GtkButton" id="about-button">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="tooltip_text" translatable="yes">Information about Gifcurry.</property>+ <property name="image">about-image</property>+ <property name="always_show_image">True</property>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="pack_type">end</property>+ <property name="position">1</property>+ </packing>+ </child> </object> <packing>- <property name="expand">True</property>- <property name="fill">True</property>+ <property name="expand">False</property>+ <property name="fill">False</property> <property name="position">0</property> </packing> </child> <child>- <object class="GtkBox" id="start_duration_box">+ <object class="GtkBox" id="start-duration-box"> <property name="visible">True</property> <property name="can_focus">False</property> <property name="homogeneous">True</property> <child>- <object class="GtkEntry" id="start_time_text_entry">+ <object class="GtkEntry" id="start-time-text-entry"> <property name="visible">True</property> <property name="can_focus">True</property> <property name="tooltip_text" translatable="yes">Start time.</property>@@ -70,7 +110,7 @@ </packing> </child> <child>- <object class="GtkEntry" id="duration_text_entry">+ <object class="GtkEntry" id="duration-text-entry"> <property name="visible">True</property> <property name="can_focus">True</property> <property name="tooltip_text" translatable="yes">Duration.</property>@@ -89,16 +129,16 @@ <packing> <property name="expand">False</property> <property name="fill">True</property>- <property name="position">1</property>+ <property name="position">2</property> </packing> </child> <child>- <object class="GtkBox" id="width_quality_box">+ <object class="GtkBox" id="width-quality-box"> <property name="visible">True</property> <property name="can_focus">False</property> <property name="homogeneous">True</property> <child>- <object class="GtkEntry" id="width_text_entry">+ <object class="GtkEntry" id="width-text-entry"> <property name="visible">True</property> <property name="can_focus">True</property> <property name="tooltip_text" translatable="yes">GIF width in px.</property>@@ -114,7 +154,7 @@ </packing> </child> <child>- <object class="GtkEntry" id="quality_text_entry">+ <object class="GtkEntry" id="quality-text-entry"> <property name="visible">True</property> <property name="can_focus">True</property> <property name="tooltip_text" translatable="yes">GIF quality from 1 to 100.</property>@@ -135,11 +175,11 @@ <packing> <property name="expand">True</property> <property name="fill">True</property>- <property name="position">2</property>+ <property name="position">3</property> </packing> </child> <child>- <object class="GtkFontButton" id="font_chooser_button">+ <object class="GtkFontButton" id="font-chooser-button"> <property name="name">font_chooser_button</property> <property name="visible">True</property> <property name="can_focus">True</property>@@ -147,7 +187,7 @@ <property name="tooltip_text" translatable="yes">Choose your desired font for the bottom and top text.</property> <property name="font">Sans 12</property> <property name="preview_text">I love making GIFs with Gifcurry!</property>- <property name="title" translatable="yes">Choose a Font</property>+ <property name="title" translatable="yes">Gifcurry - Choose a Font</property> <property name="use_font">True</property> <property name="show_style">False</property> <property name="show_size">False</property>@@ -159,7 +199,7 @@ </packing> </child> <child>- <object class="GtkEntry" id="top_text_text_entry">+ <object class="GtkEntry" id="top-text-text-entry"> <property name="visible">True</property> <property name="can_focus">True</property> <property name="tooltip_text" translatable="yes">Optional top text.</property>@@ -173,7 +213,7 @@ </packing> </child> <child>- <object class="GtkEntry" id="bottom_text_text_entry">+ <object class="GtkEntry" id="bottom-text-text-entry"> <property name="visible">True</property> <property name="can_focus">True</property> <property name="tooltip_text" translatable="yes">Optional bottom text.</property>@@ -188,7 +228,7 @@ </packing> </child> <child>- <object class="GtkSeparator" id="separator1">+ <object class="GtkSeparator" id="separator-1"> <property name="visible">True</property> <property name="can_focus">False</property> </object>@@ -199,12 +239,12 @@ </packing> </child> <child>- <object class="GtkFileChooserButton" id="output_file_path_button">+ <object class="GtkFileChooserButton" id="output-file-path-button"> <property name="visible">True</property> <property name="can_focus">False</property> <property name="tooltip_text" translatable="yes">Select an output folder.</property> <property name="action">select-folder</property>- <property name="title" translatable="yes">Select an Output Folder</property>+ <property name="title" translatable="yes">Gifcurry - Select an Output Folder</property> </object> <packing> <property name="expand">True</property>@@ -213,7 +253,7 @@ </packing> </child> <child>- <object class="GtkEntry" id="output_file_name_text_entry">+ <object class="GtkEntry" id="output-file-name-text-entry"> <property name="visible">True</property> <property name="can_focus">True</property> <property name="tooltip_text" translatable="yes">Output file name.</property>@@ -228,11 +268,11 @@ </packing> </child> <child>- <object class="GtkBox" id="frame_images_box">+ <object class="GtkBox" id="frame-images-box"> <property name="visible">True</property> <property name="can_focus">False</property> <child>- <object class="GtkImage" id="first_frame_image">+ <object class="GtkImage" id="first-frame-image"> <property name="visible">True</property> <property name="can_focus">False</property> <property name="tooltip_text" translatable="yes">First frame preview.</property>@@ -249,7 +289,7 @@ </packing> </child> <child>- <object class="GtkImage" id="last_frame_image">+ <object class="GtkImage" id="last-frame-image"> <property name="visible">True</property> <property name="can_focus">False</property> <property name="tooltip_text" translatable="yes">Last frame preview.</property>@@ -286,18 +326,18 @@ </packing> </child> <child>- <object class="GtkBox" id="save_open_box">+ <object class="GtkBox" id="save-open-box"> <property name="visible">True</property> <property name="can_focus">False</property> <property name="homogeneous">True</property> <child>- <object class="GtkButton" id="create_button">+ <object class="GtkButton" id="create-button"> <property name="label">Create</property> <property name="visible">True</property> <property name="can_focus">True</property> <property name="receives_default">True</property> <property name="tooltip_text" translatable="yes">Create the GIF.</property>- <property name="image">create_icon</property>+ <property name="image">create-icon</property> <property name="relief">half</property> <property name="image_position">top</property> <property name="always_show_image">True</property>@@ -309,13 +349,13 @@ </packing> </child> <child>- <object class="GtkButton" id="open_button">+ <object class="GtkButton" id="open-button"> <property name="label" translatable="yes">Open</property> <property name="visible">True</property> <property name="can_focus">True</property> <property name="receives_default">True</property> <property name="tooltip_text" translatable="yes">Open the GIF.</property>- <property name="image">open_icon</property>+ <property name="image">open-icon</property> <property name="relief">half</property> <property name="image_position">top</property> <property name="always_show_image">True</property>@@ -335,12 +375,12 @@ </packing> </child> <child>- <object class="GtkBox" id="link_box">+ <object class="GtkBox" id="link-box"> <property name="visible">True</property> <property name="can_focus">False</property> <property name="homogeneous">True</property> <child>- <object class="GtkLinkButton" id="giphy_link_button">+ <object class="GtkLinkButton" id="giphy-link-button"> <property name="label" translatable="yes">button</property> <property name="visible">True</property> <property name="can_focus">True</property>@@ -372,7 +412,7 @@ </packing> </child> <child>- <object class="GtkLinkButton" id="imgur_link_button">+ <object class="GtkLinkButton" id="imgur-link-button"> <property name="label" translatable="yes">button</property> <property name="visible">True</property> <property name="can_focus">True</property>@@ -396,7 +436,7 @@ </packing> </child> <child>- <object class="GtkBox" id="status_box">+ <object class="GtkBox" id="status-box"> <property name="visible">True</property> <property name="sensitive">False</property> <property name="can_focus">False</property>@@ -404,7 +444,7 @@ <property name="vexpand">True</property> <property name="baseline_position">top</property> <child>- <object class="GtkEntry" id="status_text_entry">+ <object class="GtkEntry" id="status-text-entry"> <property name="visible">True</property> <property name="sensitive">False</property> <property name="app_paintable">True</property>@@ -435,5 +475,132 @@ </child> </object> </child>+ <child type="titlebar">+ <placeholder/>+ </child>+ </object>+ <object class="GtkAboutDialog" id="about-dialog">+ <property name="can_focus">False</property>+ <property name="title" translatable="yes">Gifcurry - About</property>+ <property name="window_position">center</property>+ <property name="destroy_with_parent">True</property>+ <property name="icon_name">dialog-information</property>+ <property name="type_hint">dialog</property>+ <property name="skip_taskbar_hint">True</property>+ <property name="gravity">center</property>+ <property name="transient_for">gifcurry-window</property>+ <property name="attached_to">gifcurry-window</property>+ <property name="program_name">Gifcurry</property>+ <property name="version">2.2.0.0</property>+ <property name="copyright" translatable="yes">(C) 2016 David Lettier+lettier.com</property>+ <property name="website">https://github.com/lettier/gifcurry</property>+ <property name="website_label" translatable="yes">Update</property>+ <property name="license">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.</property>+ <property name="authors"> David Lettier</property>+ <property name="logo">icon.ico</property>+ <property name="license_type">custom</property>+ <child internal-child="vbox">+ <object class="GtkBox">+ <property name="can_focus">False</property>+ <property name="orientation">vertical</property>+ <property name="spacing">2</property>+ <child internal-child="action_area">+ <object class="GtkButtonBox">+ <property name="can_focus">False</property>+ <property name="layout_style">end</property>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <placeholder/>+ </child>+ </object>+ </child>+ <child>+ <placeholder/>+ </child>+ </object>+ <object class="GtkMessageDialog" id="long-gif-message-dialog">+ <property name="can_focus">False</property>+ <property name="title" translatable="yes">Gifcurry - Click Yes or No</property>+ <property name="window_position">center</property>+ <property name="destroy_with_parent">True</property>+ <property name="icon_name">dialog-question</property>+ <property name="type_hint">dialog</property>+ <property name="urgency_hint">True</property>+ <property name="gravity">center</property>+ <property name="transient_for">gifcurry-window</property>+ <property name="attached_to">gifcurry-window</property>+ <property name="message_type">warning</property>+ <property name="text" translatable="yes">Are you sure you want to make a GIF that long?</property>+ <child internal-child="vbox">+ <object class="GtkBox">+ <property name="can_focus">False</property>+ <property name="orientation">vertical</property>+ <property name="spacing">2</property>+ <child internal-child="action_area">+ <object class="GtkButtonBox">+ <property name="can_focus">False</property>+ <property name="homogeneous">True</property>+ <property name="layout_style">end</property>+ <child>+ <placeholder/>+ </child>+ <child>+ <placeholder/>+ </child>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="position">0</property>+ </packing>+ </child>+ </object>+ </child>+ <child>+ <placeholder/>+ </child>+ </object>+ <object class="GtkButton" id="yes-button">+ <property name="label">gtk-yes</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="use_stock">True</property>+ <property name="always_show_image">True</property> </object> </interface>
src/data/icon.ico view
binary file changed (4286 → 14398 bytes)
− src/data/icon2.ico
binary file changed (16958 → absent bytes)
src/gui/Main.hs view
@@ -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
src/lib/Gifcurry.hs view
@@ -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