A GTK GUI for creating time-lapse videos

posted on 2013-08-09

I had another time-lapse experiment and had to open my browser to find out what the command was to create a video form the separate images. Wanting to do some GTK in Haskell, I decided to write a GUI to automate it. I posted the program on github. Here I'll give a short overview of what programming GTK in Haskell was about.

Screenshot of v0.0.1

Concepts of the current project source

The current project is split up into two main files: main.glade and src/Main.hs.

The main.glade file is a definition of all the GUI components. If you ever worked with HTML, glade and Haskell is much like HTML and Javascript. Each element has an id which you use to then reference it. An interpreter called GTK Builder will read the XML and instantiate all the buttons and components.

initGUI
builder <- builderNew
builderAddFromFile builder "main.glade"

Besides the builderAddFromFile there is also an builderAddFromString. This can be used to embed the XML in the binary at a later state.

Now that we have the window, we use the builder to get the different elements

addFileButton <- builderGetObject builder castToButton "addFileButton"
executeButton <- builderGetObject builder castToButton "executeButton"
mainWindow <- builderGetObject builder castToWindow "mainWindow"

Note that each of the lines needs an appropriate caseToSomething to make the type of the resulting element the right type.

For events there seem to be two approaches. Using a corresponding "onEvent" method

onClicked addFileButton (addFileToSelectionList mainWindow fileList)
onClicked executeButton (createTimelapseFrom fileList)

, or using a more DSL like "on"

on mainWindow objectDestroy mainQuit

The latter seems to be the nicest, but I could not find a way of getting the "click" event to work with that same notation.

One of the most frustrating parts of working with GTK was having to deal with the TreeModel and TreeView abstractions when I wanted to create a simple list. Having Googled together some code, I ended up with the following code:

initializeFileList :: Builder -> IO (ListStore String)
initializeFileList builder = do
    fileList <- listStoreNew []
    col <- treeViewColumnNew
    treeViewColumnSetTitle col "Images"
    renderer <- cellRendererTextNew
    cellLayoutPackStart col renderer False
    cellLayoutSetAttributes col renderer fileList (\c -> [cellText := c])
    fileListTreeView <- builderGetObject builder castToTreeView "fileListing"
    treeViewAppendColumn fileListTreeView col
    treeViewSetModel fileListTreeView fileList
    treeViewSetHeadersVisible fileListTreeView True
    return fileList

The whole thing is done by setting up a column with a cell renderer and finally returns the ListStore.

The ListStore is a simple mutable list (via the IO monad) and is very simple to work with:

mapM_ (listStoreAppend listModel) newFiles

To get the listStore into the onClick handler, I used partial application (see the earlier onClick calls). The event handler function shows a dialog and then adds all selected files to the list:

addFileToSelectionList window listModel = do
    dialog <- fileChooserDialogNew Nothing (Just window) FileChooserActionOpen [
        ("Cancel", ResponseCancel),
        ("Add", ResponseAccept)
        ]
    fileChooserSetSelectMultiple dialog True
    widgetShow dialog
    response <- dialogRun dialog

    case response of
          ResponseCancel -> return ()
          ResponseAccept -> do newFiles <- fileChooserGetFilenames dialog
                               mapM_ (listStoreAppend listModel) newFiles
    widgetDestroy dialog
    return ()

Well, that's about all the Haskell code that is interesting to read. To do the real work, I symlink the files in sequnce:

files <- listStoreToList fileListStore
--Create symlinks to get sequenced numbers
removeAndRecreate "/tmp/timelapse"
foldM_ tmpSymlink 0 files

and then call gst-launch to create a single timelapse video from a gstreamer pipeline that collects it all. In bash, the whole procedure is as follows:

#!/bin/bash
shopt -s nocaseglob

#Create a collection symlink
echo "Symlink"
SLDIR=/tmp/timelapse
rm -rf "$SLDIR"
mkdir "$SLDIR"
let i=0
for f in *.jpg; do
    ln -s "`readlink -f "$f"`" "$SLDIR"/"$i".jpg
    let i=i+1
done

gst-launch-0.10 multifilesrc location="/tmp/timelapse/%d.jpg" \
    caps="image/jpeg,framerate=25/1" ! \
    jpegdec ! videorate ! theoraenc drop-frames=false ! oggmux ! \
    filesink location="/tmp/timelapse.ogg"

From the GUI I spawn xterm to show the output of the gst-launch execution and after that close the whole GUI. This makes for a very simple and extremely rough GUI, but it works! If you want to hack, change, fix, package or comment: you can fork me on github or download release 0.0.1.