A GTK GUI for creating time-lapse videos
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.
Concepts of the current project source
The current project is split up into two main files:
initGUI builder <- builderNew builderAddFromFile builder "main.glade"
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.
See also: Gtk2Hs tutorial