The O'Haskell interface to Tk -- an overview

The Counter Example
Widgets
Configurable widgets
Events
Options
Window and canvas widgets
The Tk environment
Layout

The Counter Example

As a first example -- the "Hello world" example of GUI programming in O'Haskell -- we show here the complete code of a simple program that maintains an integer counter. When started, the program opens the following window on the screen:

The current counter value is displayed in the upper half of the window, while the lower half holds holds two buttons, one to quit the application and one to increase the counter value by one. In addition, the image above shows the window manager-specific decorations on top of the application window. Here is the code:

module Counter where

import Tk

struct Counter =
  incr  :: Action
  read :: Request Int

counter :: Template Counter
counter = template
            val := 0
          in struct
              incr = action val := val+1
              read = request return val

main tk = do  
  win <- tk.window [Title "Counter Example"]
  cnt <- counter
  lab <- win.label [Background white, Font "helvetica 16", 
                     Text "0", Anchor E]
  let incr = do
      cnt.incr
      v <- cnt.read
      lab.set [Text (show v)]
  qBut <- win.button [Text "Quit", Command tk.quit]
  iBut <- win.button [Text "Incr", Command incr]
  pack (lab ^^^ (qBut <<< iBut))
The program makes use of a record type Counter and a template for creating counter objects, which will not be discussed here.

The main procedure takes the Tk environment as argument. The type of main is (inferred to be) TkEnv -> Cmd (); executing a procedure of this type causes ohugs to start a Tk interpreter and set up the communication mentioned in the introduction.

main delegates to the environment tk to create the desired widgets: an application window win and, in this window, a label (a widget that can display (non-editable) text) and two buttons. On creation, each of the widgets is configured by passing it a list of options. The label is configured with background color, font and initial text, and anchor information (E means East, i.e. justify text to the right). Each of the buttons is passed an associated Command to be executed when the user clicks the mouse while the pointer is within the button. For the Incr button, this command sequence is defined in a locally declared brocedure. In the final line of code, the three widgets are packed using the layout combinators ^^^ (vertical composition) and <<< (horizontal composition). Packing also causes the window to be mapped onto the screen. main then terminates and the application silently waits for, and reacts to, user actions.

Widgets

The central notion in the Tk interface is that of a widget. A widget is an object of (some subtype of) the record type
struct Widget =
    ident   :: String
    destroy :: Action
    exists  :: Request Bool 
    focus, raise, lower :: Action
    bind    :: [Event] -> Action
Widgets are objects that have a unique identity (created by the system), that can be created and destroyed, that can take keyboard focus, that can be raised and lowered in the stacking order on screen and that, most importantly, can bind actions to events. For example, consider adding the following line to the main procedure in the counter example:
lab.bind [ButtonPress 1 (\_ -> lab.set [Background red])]
This gives the application an added behavior: if the user presses mouse button 1 when the mouse pointer is within the label lab, the background color of the label changes to red. To understand the details of this, we need to understand the notion of configurable widgets (which support the method set) and the datatype of events (which has ButtonPress as one of its constructors).

As we saw in the Counter example, buttons have as one option a Command to be executed when the user clicks mouse button 1. This binding could have been specified using the method bind; the option is just a convenience for a common and simple use of buttons. Buttons also have other default behaviors; they are highlighted when the mouse pointer passes over them, they change appearance when the mouse button is pressed over them etc.

Configurable widgets

All widgets are configurable, i.e. their options can be set (or changed) not only at creation, but also later by calling their set method. This is expressed by the declarations
struct Configurable a = 
    set     :: [a] -> Action
--  get     :: a -> Request String

struct ConfWidget a < Widget, Configurable a
The ConfWidget type is parameterized with the type of options it supports; this varies between widget types. While some options are general (i.e. Background), others are particular to just one widget type (i.e. Accelerator, which only applies to menu entries).

In the present version, the get method is not supported, since its type as given above is not very satisfactory; a better solution is envisaged when locally quantified types are added to O'Haskell.

One reason not to include the set method in the type Widget (and hence to dispose of Configurable) is that also some objects that are not widgets are configurable (e.g. images and menu entries).

Events

A subset of the hierarchy of datatypes of events presently supported is
type Pos = (Int, Int)

data ButtonPress = ButtonPress Int (Pos -> Cmd ())
                 | AnyButtonPress  (Int -> Pos -> Cmd ())

data MouseEvent > ButtonPress = 
           ButtonRelease Int (Pos -> Cmd ()) 
         | AnyButtonRelease (Int -> Pos -> Cmd ())
         | Motion Int (Pos -> Cmd ())
         | AnyMotion  (Pos -> Cmd ())
         | Double ButtonPress
         | Triple ButtonPress

data Event > MouseEvent, KeyEvent, WindowEvent 
Each constructor takes as its last argument a callback procedure, which describes the commands to be executed when the user performs the action indicated by the constructor name. This procedure may have parameters, as for example for ButtonPress, where the callback procedure is before execution applied to the position (in pixel coordinates) within the widget of the mouse pointer. For AnyButtonPress, also the button number is given as argument to the call-back procedure.

In the extension to the counter example above, we did not care where in the label the button was clicked; anyhow we had to provide a function that ignores its argument as callback procedure.

Options


The options are also represented as a hierarchy of data types, with a bottom layer of some thirty single-constructor types, including the follwing:
data Background  = Background Color
data BorderWidth = BorderWidth Int
data Command     = Command (Cmd ())
data File        = File FilePath
data Fill        = Fill Color
data Font        = Font String
Three of these we already used in the counter example; the other three are used to specify width of the widget border in pixels, a file path from which to read data (an option for images) and a fill color for geometrical figures in canvases (see below under window widgets).

These single-constructor types are the base types in the formation of supertypes in two ways:

Window widgets


Most widgets (buttons, listboxes, sliders, etc) are created as children of a window, using one of the methods of the following record type:
-- top level windows

struct Window < BasicWindow WindowOpt, ManagedWindow

struct BasicWindow a < ConfWidget a, Container =
    button      :: [ButtonOpt]      -> Request Button
    canvas      :: [CanvasOpt]      -> Request Canvas
    checkButton :: [CheckButtonOpt] -> Request CheckButton
    entry       :: [EntryOpt]       -> Request Entry
    frame       :: [FrameOpt]       -> Request Frame
    label       :: [LabelOpt]       -> Request Label
    listBox     :: [ListBoxOpt]     -> Request ListBox
    menuButton  :: [MenuButtonOpt]  -> Request MenuButton
    radioButton :: [RadioButtonOpt] -> Request RadioButton
    scrollBar   :: [ScrollBarOpt]   -> Request ScrollBar
    slider      :: [SliderOpt]      -> Request Slider
    textEditor  :: [TextEditorOpt]  -> Request TextEditor
 
type Pos = (Int,Int)

struct ManagedWindow = 
    getGeometry :: Request (Pos,Pos)   -- size,position
    setSize     :: Pos -> Action
    setPosition :: Pos -> Action
    iconify     :: Action
    deiconify   :: Action

A Window is thus both a BasicWindow (with the possibility to contain various widgets) and a ManagedWindow (with methods to interact with the window manager). Before creating window widgets, we must already have created a window, using a method in the Tk Environment.

We give here only a brief summary of the window widget types; for details see the module excerpts page.

The Tk environment


The primitive Tk environment is an instance of
struct Tk =
    window    :: [WindowOpt]   -> Request Window
    bitmap    :: [BitmapOpt]   -> Request ConfBitmap
    photo     :: [PhotoOpt]    -> Request Photo
    delay     :: Int -> (String -> Cmd ()) -> Request String
    periodic  :: Int -> Cmd () -> Request Runnable
    bell      :: Action

struct TkEnv < Tk, StdEnv

struct Runnable = 
   start :: Action
   stop  :: Action

The method window creates a new top-level window. The window is not mapped onto screen until it is packed. bitmap creates a new bitmap (with only a foreground and a background color) read from a file (given by the File option); photo creates a full-color image, again from a file in GIF or PPM format. delay schedules a procedure for execution after a prescribed number of milliseconds, while periodic returns an object that schedules a procedure for periodic execution with prescribed time interval between executions. Both these two methods return immediately. Finally, bell just rings the bell.

Layout


Creating a window and various widgets in the window does not cause the window to be displayed on the screen. This is instead achieved by packing the widgets of the window, thereby specifying their layout. Sometimes one wants to build a reusable compound component with a predefined layout. This is achieved by creating the ingredients of the component in a Frame of the window, which allows them to be packed separately. This is used in TkUtil, where functions that build e.g. menu bars and radio groups are provided.

Layout, i.e. the relative placement of widgets within the window is prescribed by using a collection of functions working on Packable objects. Packable objects are all window widgets and, additionally, rows and columns of packable objects. Thus a Packable has a tree structure with window widgets at the leaves. Packables are built using

row, col :: [Packable] -> Packable
with the common shorthand combinators
p1 <<< p2 = row [p1,p2]
p1 ^^^ p2 = col [p1,p2]
Every window widget has a preferred size (width and height), which is determined either by the size of its content (text, image, etc) or by explicit setting of Width and Height options. It is then easy to determine a preferred size for a row (column) of widgets; just add their widths (heights) and take the maximum of their heights (widths). Packing components created in a window for some packable p causes the window's size to be set to the preferred size of p, the components to be laid out and the window to be mapped on the screen. Accordingly, windows do not support the Width and Height options.

The above description is adequate when all the packables fit perfectly in the assigned window size. In general, extra space for a packable may be available in both dimensions. By default, widgets expand to fill this space. for situations when this is not appropriate, further functions are provided.