packages feed

Gifcurry-0.1.0.0: gui_src/Main.hs

-- David Lettier (C) 2016. http://www.lettier.com/

import System.Environment
import Control.Concurrent
import Graphics.UI.Gtk
import Graphics.UI.Gtk.Builder

import Paths_Gifcurry
import Gifcurry (gif)

main = do
  initGUI

  builder <- build_builder

  window                  <- load_window builder "gifcurry_window"
  start_time_entry        <- load_entry builder "start_time_text_entry"
  duration_entry          <- load_entry builder "duration_text_entry"
  width_entry             <- load_entry builder "width_text_entry"
  quality_entry           <- load_entry builder "quality_text_entry"
  top_text_entry          <- load_entry builder "top_text_text_entry"
  bottom_text_entry       <- load_entry builder "bottom_text_text_entry"
  output_file_name_entry  <- load_entry builder "output_file_name_text_entry"
  status_entry            <- load_entry builder "status_text_entry"
  input_file_button       <- load_fc_button builder "input_file_button"
  output_file_path_button <- load_fc_button builder "output_file_path_button"
  ok_button               <- load_button builder "ok_button"
  giphy_button            <- load_button builder "giphy_link_button"
  imgur_button            <- load_button builder "imgur_link_button"

  -- Bug in Glade does not allow setting the link button label.
  buttonSetLabel giphy_button "Giphy"
  buttonSetLabel imgur_button "Imgur"

  entrySetText start_time_entry "0"
  entrySetText duration_entry "10"
  entrySetText quality_entry "100"
  entrySetText width_entry "500"

  ok_button `on` buttonActivated $ do
    input_file_text <- fileChooserGetFilename input_file_button
    input_file_path_name <- case input_file_text of
      Nothing -> return ""
      Just file_path_name -> return file_path_name

    output_file_path_text <- fileChooserGetFilename output_file_path_button
    output_file_path <- case output_file_path_text of
      Nothing -> return ""
      Just dir -> return dir

    start_time <- entryGetText start_time_entry
    duration <- entryGetText duration_entry

    width <- entryGetText width_entry
    quality <- entryGetText quality_entry

    top_text <- entryGetText top_text_entry
    bottom_text <- entryGetText bottom_text_entry

    output_file_name <- entryGetText output_file_name_entry
    let output_gif_file_name = output_file_name ++ ".gif"
    let output_file_path_name = output_file_path ++ "/" ++ output_gif_file_name

    if ((length input_file_path_name) > 0 && (length output_file_path_name) > 5 && (length output_gif_file_name) > 4)
      then do
        forkIO $ do
          entrySetText status_entry "One GIF coming up!"
          gif [
            input_file_path_name,
            output_file_path_name,
            start_time,
            duration,
            width,
            quality,
            top_text,
            bottom_text ]
          entrySetText status_entry "Ready."
        return ()
      else do entrySetText status_entry "File paths are wrong."

    return ()

  on window objectDestroy mainQuit
  widgetShowAll window
  mainGUI

load_window b id = builderGetObject b castToWindow id

load_entry b id = builderGetObject b castToEntry id

load_fc_button b id = builderGetObject b castToFileChooserButton id

load_button b id = builderGetObject b castToButton id

build_builder = do
  builder <- builderNew
  glade_file <- getDataFileName "data/gui.glade"
  builderAddFromFile builder glade_file
  return builder