Graphical User Interface with Gtk

1. Graphical User Interface with GTK

1 Graphical User Interface with GTK

1.1 Overview

GTK is cross-platform GUI toolkit written in C available for Linux, Mac Osx and Windows. The Haskell package Gtk2HS provides bindings to it through the foreign function interface FFI.

Installation

1. Install GTK libraries:

Linux: (Manjaro / Arch Linux)

$ sudo pacman -S gobject-introspection gobject-introspection-runtime gtksourceview3 webkitgtk webkit2gtk

Install gtk2hs (gtk 2.0) package and Haskell 7.10.2

$ stack --resolver lts-3.22 --install-ghc install gtk datetime  # Install gtk 2.0 bindings
$ stack --resolver lts-3.22 --install-ghc install gtk3 datetime # Install gtk 3.0 bindings

This section will use gtk3 (gtk 3.0) package due to it support glade3 generated layout files unlike the gtk (gtk 2.0), despite most of documentation and examples be available for gtk 2.0.

1.2 GUI Terminology

Widget - GUI component or item such as button, text box, entry, menu and etc.
Container - Widget that can allocate space for other widgets and contain them such as Window, hbox, vbox and so on.
- hbox - aligns widgets in a horizontal way.
- vbox - aligns widgets in a vertical way
Event loop - Infinite loop generally running in a single thread which scans for inputs and calls the registered callbacks (aka event handling) when some event happens. The event loop is generally not exposed to the application developer.
Event - Notification provided by the GUI event-loop which can call an callback function (aka event-handling) registered by the application programmer.
Callback or event handler - Function provided by the application programmer that will be called by the GUI event loop when some event happens. Example: function called when the user clicks in a button.
Event driven or asyncrhonous - GUI Programming is event-driven or asyncrhonous. The program doesn't wait for some input to arrive or poll some input. Instead of doing that the program only needs to register the event handlers to the events that it will react. The event loop calls the event handlers associated to an event when it happens. The drawback of this approach is the loss of control and the possibility of callback hell.

GUI Challenges:

GUI design, look and feel are hard to specify programatically because the code must be recompiled if the GUI is modified, changes in the GUI may break the GUI code and end-users may want to change it to fit better their needs. So it is hard to develop a complex GUI without a GUI builder such as Glade for Gtk, QT Designer for QT and so on.
The event handlers or callbacks execution must finish as soon as possible and avoid blocking IO or perform any task that operation that blocks GUI event loop thread.
Any long running computation like run Haskell getLine that waits the user enter an input or an http request or anything that does not finish soon or blocks the GUI event loop thread must run in another thread in order to avoid the GUI crashing or freezing and it becoming unresponsive.
Callbacks are written in continuation passing style what makes it hard to reason about and to compose and it can also lead to callback-hell, when there is multiple nested callback function.
Many GUI toolkits like GTK are not thread-safe. The GUI functions can only be called from the GUI event loop thread.
The communication between callbacks requires global variables or global mutable references what can lead to race conditions and make the code hard to understand and debug.

See:

1.3 Gtk3 functions and types

Package Documentation

Package Gtk2

gtk Binding to the Gtk+ graphical user interface library.

Package Gtk3

gtk3 Binding to the Gtk+ 3 graphical user interface library

Useful Functions for Gtk

Function / type		Signature	Description
Module Data.IORef
newIORef	::	a -> IO (IORef a)	Create new IO Reference initialized with some value.
readIORef	::	IORef a -> IO a	Read IO reference.
writeIORef	::	writeIORef :: IORef a -> a -> IO ()	Update IO reference
modifyIORef	::	IORef a -> (a -> a) -> IO ()	Apply function to IO reference value and update it.

Module Control.Concurrent
forkIO	::	IO () -> IO ThreadId	Run IO action in a new lightweight thread
forkIOS	::	IO () -> IO ThreadId	Run IO action in a new os (aka native) thread
killThread	::	ThreadId -> IO ()	Stop a thread given its ID
threadDelay	::	threadDelay :: Int -> IO ()	Pause current thread for N micro seconds (us) or N x 1e-6 seconds.

Gtk Functions

Function / type		Singature	Description
initGUI	::	IO ()	Initialize Gtk
mainGUI	::	IO ()	Run Gtk event loop.

widgetShowAll	::	WidgetClass self => self -> IO ()

Widget Layout
vBoxNew	::	Bool -> Int IO -> VBox	Create new VBox container
hBoxNew	::	Bool -> Int IO -> HBox	Create new HBox container
containerAdd	::	(WidgetClass widget, ContainerClass self) => self -> widget -> IO ()	Add widget to a container widget like Window.


Widget Constructors
windowNew	::	IO Window	Create new window

buttonNew	::	IO Button	Create new button
buttonNewWithLabel	::	string -> IO Button	Create button with label

drawingAreaNew	::	IO DrawingArea	Create new drawing area (canvas)
labelNew	::	Maybe string -> IO Label	Create new label
entryNew	::	IO Entry	Create new entry (single-line text input)

Window Functions
windowSetDefaultSize	::	WindowClass self => self -> Int -> Int -> IO ()	Set default window size - window, width, height
windowGetDefaultSize	::	WindowClass self => self -> IO (Int, Int)	Get window default size - (width, height)

Event Handling
on	::	object -> Signal object callback -> callback -> IO (ConnectId object)	Register callback

Note: The type string is:

> :t Gtk.labelNew
Gtk.labelNew
  :: System.Glib.UTFString.GlibString string =>
     Maybe string -> IO Label
>

1.4 Examples

1.4.1 Simple GUI

Screenshot:

File: gui1.hs

import Graphics.UI.Gtk
import Graphics.UI.Gtk.Gdk.EventM
import qualified Graphics.UI.Gtk.Gdk.Events as E

import Control.Monad.Trans 

main :: IO ()    
main = do
  initGUI  -- Start Gtk. Must be called before creating the widgets

  -- Create Widgets 
  window  <- windowNew

  btn     <- buttonNew                       
  set btn [ buttonLabel := "Click me!" ]

  containerAdd window btn 

  widgetShowAll window

  -- Set up events and register callbacks (aka event handlers)
  --                 
  on btn buttonPressEvent $ tryEvent $ liftIO $ putStrLn "I was clicked"

  -- Exit application if the user click on exit button 
  on window deleteEvent $ liftIO mainQuit >> return False   

  mainGUI  -- Start GTK event loop and and react to events.

Running:

$ stack --resolver lts-3.22 runhaskell /tmp/gui1.hs    # Now it works

1.4.2 GUI with long running task - Clock display

Screenshot:

File: clockDisplay.hs

import Control.Concurrent (forkIO,  forkOS, threadDelay)    
import Data.IORef 
import Control.Monad (forever)
import Control.Monad.Trans (liftIO)

import qualified Data.DateTime as Date

import Graphics.UI.Gtk

-- 1 second dealy = 1 million us = 1 sec   
delay1sec = 1000000 

ignore :: IO a -> IO ()
ignore ioAction = do
  _ <- ioAction
  return ()

{-| Run IO action in infinite loop in a new thread, 
    without block Gtk main thread.  

threadLopp delayMilliSeconds GtkIOAction 

-}         
threadLoop :: Int -> IO () -> IO ()
threadLoop delay ioAction = do
    forkIO $ forever $ do  
      threadsEnter         -- Acquire the global Gtk lock
      ioAction             -- Perform Gtk interaction like update widget 
      threadsLeave         -- Release the global Gtk lock
      threadDelay delay    -- Delay in us               
    return ()

driveDisplay :: Entry -> IO ()
driveDisplay entry = do
    acc <- newIORef 0 
    ignore $ forkIO $ forever $ do
      counter <- readIORef acc             
      entrySetText entry $ show counter
      writeIORef acc (counter + 1)
      threadDelay delay1sec


driveDisplayClock :: Entry -> IO ()
driveDisplayClock entry =
    threadLoop delay1sec $ do
      localTime <- show . Date.toClockTime <$> Date.getCurrentTime
      entrySetText entry $ localTime      


main :: IO ()
main = do
  initGUI -- Init Gtk 

  -- Create main window 
  window  <- windowNew

  -- Create new user input or entry            
  display <- entryNew


  set window  [ windowTitle           := "Clock time App"
               ,windowDefaultWidth    := 300
               ,windowDefaultHeight   := 100
               ,windowResizable       := True
               ,containerBorderWidth := 2  
              ]

  -- Add entry to window 
  containerAdd window display              

  -- entrySetText display "Display Message"
  -- driveDisplay display
  driveDisplayClock display

  ---------------------------------------------
  -- Set Signals or Events callbacks         --
  ---------------------------------------------

  -- Exit app when the window is deleted (User clicks exit button).
  on window deleteEvent $ liftIO mainQuit >> return False

  -- Display Widget 
  widgetShowAll window

  -- Start GUI Event loop 
  mainGUI

Running as script:

$ stack --resolver lts-3.22 --install-ghc runhaskell clockDisplay.hs

Compiling:

$ stack --resolver lts-3.22 --install-ghc exec -- ghc -threaded clockDisplay.hs  
Linking clockDisplay ...

$ ./clockDisplay

1.4.3 Build Interface with Glade

Specifying a GUI pragmatically is not viable for a complex GUI application because each layout change will require the code to be changed and recompiled. The Glade 3 (glade for gtk3) GUI builder generate a XML layout containing the GUI specifications. The GUI library can read it, build the widgets automatically and display the user interface.

Screenshot:

Glade Gtk Builder

GUI application

How it works ?

The displayed exchange rate BRL/USD (USD to BRL - Brazilian Reals) or Brazilian Reals per USD is a random number updated every 2 seconds within the range 3.0 +- 2.0 or 1.0 (3.0 - 2.0) to 5.0 (3.0 + 2.0).

The user enters the amount of USD and the equivalent BRL amount is displayed every time the user changes in input or the exchange rate is updated. Example: If the current exchange rate is BRL/USD is 2.0 and the "amount in USD" is 100.0 the 'Total in BRL' will be 200.0.

When the user press the button 'Sum' current amount in BRL 'Total in BRL' is add to the reference totalSumRef and the current sum is displayed in the field 'Total Sum'.

File: Converter.hs

{-# language PackageImports #-}

import Control.Concurrent (forkIO,  forkOS, threadDelay)    
import Data.IORef 
import Control.Monad (forever)
import Control.Monad.Trans
import qualified Data.DateTime as Date

import Graphics.UI.Gtk
import Graphics.UI.Gtk.Builder

import System.Random (randomRIO)    

import Text.Read (readMaybe)
import Text.Printf (printf)


parseDouble :: String -> Maybe Double 
parseDouble text = readMaybe text 

formatDouble :: Double -> String 
formatDouble = printf "%.3f"

-- 1 second dealy = 1 million us = 1 sec   
delay1sec = 1000000 

-- Execute an IO action in a infinite loop and
-- in a regular time interval given in us.
--
clockUpdate :: Int -> IO () -> IO ()
clockUpdate delay ioAction = do
    forkIO $ forever $ do  
      threadsEnter         -- Acquire the global Gtk lock
      ioAction             -- Perform Gtk interaction like update widget 
      threadsLeave         -- Release the global Gtk lock
      threadDelay delay    -- Delay in us               
    return ()

driveClockDisplays :: Entry -> Entry -> Entry -> IO ()
driveClockDisplays amountEntry rateDisplay totalSumDisplay = undefined 


getAmount :: Entry -> IORef Double -> IO (Maybe Double)
getAmount amountEntry rateRef = do
  rate     <- readIORef rateRef
  amount   <- parseDouble <$> entryGetText amountEntry
  return $ fmap (\ x -> x * rate) amount            

clockUpdateGUI :: Int -> Entry -> Entry -> (IORef Double) -> IO () -> IO ()
clockUpdateGUI delay timeDisplay rateDisplay rateRef action =
    clockUpdate delay $ do
      rnd <- randomRIO (-2.0, 2.0)
      let nextRate = rnd + 3.0
      writeIORef rateRef nextRate
      action   


updateAmount :: Entry -> Entry -> IORef Double -> IO ()
updateAmount amountEntry totalDisplay rateRef = do
  rate     <- readIORef rateRef  
  amount   <- getAmount amountEntry rateRef              
  case amount of
    Nothing      -> entrySetText totalDisplay "Error: Invalid input"

    Just amount' -> do let total = rate * amount'
                       entrySetText totalDisplay (formatDouble total)

updateRate :: Int -> Entry -> Entry -> Entry ->  IORef Double -> IO ()
updateRate delay rateDisplay amountEntry totalDisplay rateRef = do
  clockUpdate delay $ do 
    rnd <- randomRIO (-2.0, 2.0)
    let nextRate = rnd + 3.0
    writeIORef rateRef nextRate                
    entrySetText rateDisplay $ formatDouble nextRate
    updateAmount amountEntry totalDisplay rateRef

updateTimeDisplay :: Entry -> IO ()
updateTimeDisplay entry = do
  clockUpdate delay1sec $ do
    localTime <- show . Date.toClockTime <$> Date.getCurrentTime
    entrySetText entry $ localTime        

clearTotalSum :: Entry -> IORef Double -> IO ()
clearTotalSum totalSumDisplay totalSumRef = do
  writeIORef totalSumRef 0.0
  entrySetText totalSumDisplay "0.0"  
  putStrLn "Total sum set to 0.0"

updateTotalSum :: Entry -> Entry ->  IORef Double -> IORef Double -> IO ()
updateTotalSum amountEntry totalSumDisplay rateRef totalSumRef = do
  amount   <- getAmount amountEntry rateRef
  totalSum <- readIORef totalSumRef
  case amount of
    Nothing       -> return ()
    Just amount'  -> do let nextTotal = amount' + totalSum
                        writeIORef totalSumRef nextTotal
                        entrySetText totalSumDisplay (formatDouble nextTotal)  

main :: IO ()    
main = do
  initGUI -- Start Gtk 

  -- Application State - (Mutable references )
  rateRef     <- newIORef 2.5
  totalSumRef <- newIORef 0.0      

  {- ========= Set up widgets and GUI layout ========= -}

  -- Load GUI layout from XML file built by glade2 GUI builder.
  --
  builder         <- builderNew
  builderAddFromFile builder "converter2.glade"


  let getEntry objID   =  builderGetObject builder castToEntry objID
  let getButton objID  =  builderGetObject builder castToButton objID  

  window          <- builderGetObject builder castToWindow "mainWindow"
  buttonSum       <- getButton "buttonSum"       -- Sum total amount in BRL to total sum
  buttonClear     <- getButton "buttonClear"     -- Clear total sum 

  amountEntry     <- getEntry "amountEntry"      -- USD amount entry          
  rateDisplay     <- getEntry "rateDisplay"      -- Display exchange rate in USD/BRL
  totalDisplay    <- getEntry "totalDisplay"     -- Display total amount in BRL
  totalSumDisplay <- getEntry "totalSumDisplay"  -- Display total sum in BRL               
  timeDisplay     <- getEntry "timeDisplay"      -- Display user local time

  widgetShowAll window

  {- ======= Initialize Widget ====== -}

  entrySetText amountEntry "3.0"
  clearTotalSum totalSumDisplay totalSumRef               

  {- ======= Set up events  ========== -}

  on window deleteEvent $ liftIO mainQuit >> return False


  -- let updateGUIHandler     = updateGUI amountEntry rateDisplay totalDisplay totalSumDisplay rateRef 
  let updateTotalSumHandler = updateTotalSum amountEntry totalSumDisplay rateRef totalSumRef
  let updateAmountHandler   = updateAmount amountEntry totalDisplay rateRef

  on buttonSum buttonReleaseEvent $ tryEvent $ liftIO $ updateTotalSumHandler

  on buttonClear buttonReleaseEvent $ tryEvent $ liftIO $ clearTotalSum totalSumDisplay totalSumRef

  on amountEntry keyReleaseEvent $ tryEvent $ liftIO $ updateAmountHandler

  {- ===== Run long-running background tasks ====== -}

  -- Update time display every 1 second    
  updateTimeDisplay timeDisplay

  -- Update exchange rate each 2 seconds 
  updateRate (2 * delay1sec) rateDisplay amountEntry totalDisplay rateRef

  -- on window deleteEvent $ liftIO mainQuit >> return False

  putStrLn "GUI application started. Up and running. OK."
  mainGUI -- Start Gtk Event loop

File: converter2.glade - Generated by glade3 GUI builder. This file can be edited in Glade.

<?xml version="1.0" encoding="UTF-8"?>
<!-- Generated with glade 3.20.0 -->
<interface>
  <requires lib="gtk+" version="3.20"/>
  <object class="GtkWindow" id="mainWindow">
    <property name="can_focus">False</property>
    <property name="default_width">500</property>
    <child>
      <object class="GtkGrid">
        <property name="width_request">400</property>
        <property name="height_request">300</property>
        <property name="visible">True</property>
        <property name="can_focus">False</property>
        <property name="margin_top">1</property>
        <property name="margin_bottom">1</property>
        <property name="hexpand">False</property>
        <property name="vexpand">False</property>
        <property name="row_spacing">5</property>
        <property name="column_homogeneous">True</property>
        <child>
          <object class="GtkLabel">
            <property name="visible">True</property>
            <property name="can_focus">False</property>
            <property name="margin_right">30</property>
            <property name="label" translatable="yes">Exchange Rate BRL/USD</property>
          </object>
          <packing>
            <property name="left_attach">0</property>
            <property name="top_attach">0</property>
          </packing>
        </child>
        <child>
          <object class="GtkLabel">
            <property name="visible">True</property>
            <property name="can_focus">False</property>
            <property name="margin_right">77</property>
            <property name="label" translatable="yes">Amount in USD</property>
          </object>
          <packing>
            <property name="left_attach">0</property>
            <property name="top_attach">1</property>
          </packing>
        </child>
        <child>
          <object class="GtkLabel">
            <property name="visible">True</property>
            <property name="can_focus">False</property>
            <property name="margin_right">80</property>
            <property name="label" translatable="yes">Total in BRL</property>
          </object>
          <packing>
            <property name="left_attach">0</property>
            <property name="top_attach">2</property>
          </packing>
        </child>
        <child>
          <object class="GtkButton" id="buttonSum">
            <property name="label" translatable="yes">Sum</property>
            <property name="visible">True</property>
            <property name="can_focus">True</property>
            <property name="receives_default">True</property>
          </object>
          <packing>
            <property name="left_attach">0</property>
            <property name="top_attach">3</property>
          </packing>
        </child>
        <child>
          <object class="GtkButton" id="buttonClear">
            <property name="label" translatable="yes">Clear</property>
            <property name="visible">True</property>
            <property name="can_focus">True</property>
            <property name="receives_default">True</property>
          </object>
          <packing>
            <property name="left_attach">1</property>
            <property name="top_attach">3</property>
          </packing>
        </child>
        <child>
          <object class="GtkLabel">
            <property name="visible">True</property>
            <property name="can_focus">False</property>
            <property name="margin_right">80</property>
            <property name="label" translatable="yes">Total Sum</property>
          </object>
          <packing>
            <property name="left_attach">0</property>
            <property name="top_attach">4</property>
          </packing>
        </child>
        <child>
          <object class="GtkEntry" id="rateDisplay">
            <property name="visible">True</property>
            <property name="can_focus">True</property>
          </object>
          <packing>
            <property name="left_attach">1</property>
            <property name="top_attach">0</property>
          </packing>
        </child>
        <child>
          <object class="GtkEntry" id="amountEntry">
            <property name="visible">True</property>
            <property name="can_focus">True</property>
          </object>
          <packing>
            <property name="left_attach">1</property>
            <property name="top_attach">1</property>
          </packing>
        </child>
        <child>
          <object class="GtkEntry" id="totalDisplay">
            <property name="visible">True</property>
            <property name="can_focus">True</property>
          </object>
          <packing>
            <property name="left_attach">1</property>
            <property name="top_attach">2</property>
          </packing>
        </child>
        <child>
          <object class="GtkEntry" id="totalSumDisplay">
            <property name="visible">True</property>
            <property name="can_focus">True</property>
          </object>
          <packing>
            <property name="left_attach">1</property>
            <property name="top_attach">4</property>
          </packing>
        </child>
        <child>
          <object class="GtkEntry" id="timeDisplay">
            <property name="visible">True</property>
            <property name="can_focus">True</property>
          </object>
          <packing>
            <property name="left_attach">1</property>
            <property name="top_attach">5</property>
          </packing>
        </child>
        <child>
          <object class="GtkLabel">
            <property name="visible">True</property>
            <property name="can_focus">False</property>
            <property name="margin_right">80</property>
            <property name="label" translatable="yes">Time</property>
          </object>
          <packing>
            <property name="left_attach">0</property>
            <property name="top_attach">5</property>
          </packing>
        </child>
      </object>
    </child>
    <child>
      <placeholder/>
    </child>
  </object>
</interface>

Run as script:

$ stack --resolver lts-3.22 --install-ghc runhaskell Converter.hs 
Total sum set to 0.0
GUI application started. Up and running. OK.

Compile:

$ stack --resolver lts-3.22 --install-ghc exec -- ghc -threaded Converter.hs 
[1 of 1] Compiling Main             ( Converter.hs, Converter.o )
Linking Converter ...


$ ./Converter 
Total sum set to 0.0
GUI application started. Up and running. OK.