Building a text editor (Part 2)

In this installment, we will extend the text editor with some essential basic functionality: a menu bar and the ability to load and save files. Code which is new or changed from part 1 is highlighted in red (that’s most of the code in this case!)

The top level GUI function

Something which rapidly becomes an issue when coding real wxHaskell applications is the fact that there’s quite a bit of state which you find yourself passing around to many of the functions. In particular, you will often find that, say, and event handler for one control will want to perform some action(s) on other controls. You can, of course, pass all of this information around as curried function parameters, but it quickly gets out of hand.

The most common approach in wxHaskell applications is to create one or more types which hold the required state information and keep these in some suitable data structure. This way you only have one value to curry rather than several. GUIContext is the type we use in this application. It’s not really needed at this point in the evolution of our editor, but it will be useful later.

The Var type is conceptually rather similar to an MVar or an IORef. It’s a place to put mutable data, with the benefit that support is already built-in to wxHaskell. As with MVar and the like, it must be created (using varCreate) before it can be used.

  • guiWin contains the Frame which owns the controls in the text editor.
  • guiEditor is the textCtrl instance we use to display and edit text.
  • guiFile is a mutable variable used to hold the path to the file being edited. It is a Maybe type as a newly created file has no filename until it has been saved.
 > data GUIContext = GUICtx { guiWin    :: Frame (),
 >                            guiEditor :: TextCtrl (),
 >                            guiFile   :: Var (Maybe FilePath) > }
 > step2 :: IO ()
 > step2 =
 >  do
 >  win <- frame [text := "wxhNotepad - Step 2", visible := False]
 >  editor <- textCtrl win [font := fontFixed,
 >                          text := "Now the user can open a file, save it" ++
 >                                  "or save it with another name.\n" ++
 >                                  "Our program is smart enough to remember" ++
 >                                  "the path of the last opened/saved file\n" ++
 >                                  "Note that we're *not* catching any " ++
 >                                  "filesystem errors here.  That's left " ++
 >                                  "as homework for you :P"]
 >  filePath <- varCreate Nothing
 >  let guiCtx = GUICtx win editor filePath

In the last installment, we saw how to use the declarative approach to creating a menu in Graphics.UI.WX.Menu. You can also use the lower-level functions in Graphics.UI.WXCore, and that is what we do here. If you follow the documentation link, you will see that the documentation is extremely minimal. Typically is just gives the function type and a (very abbreviated) usage. To really understand what the function does, you will most likely need to refer to the wxWidgets C++ documentation for the equivalent function, so we’re going to see what that means in practice.

The first thing to realize is that you probably want a minimal ability to read C++, at least enough to understand a function signature and to guess how the parameters map to the Haskell function signature. It is also useful to have a notion of how object oriented design works, since there’s no getting away from the fact that wxWidgets, which underlies wxHaskell, is heavily object-oriented in its design.

Let’s take the example of menuAppend.

The wxHaskell documentation says: menuAppend :: Menu a -> Id -> String -> String -> Bool -> IO () with the further comment “usage: (menuAppend obj id text help isCheckable)”.

Now, there is a naming convention which is followed fairly consistently, and that is that the start of any function name in Graphics.UI.WXCore.WxcClassesXX is the same as the name of the equivalent wxWidgets class with the “wx” prefix lopped off (all wxWidgets classes and names are prefixed “wx” as the design of the library predates C++ namespaces). Once you have read the last sentence through a couple of times, you’ll realize that all I really meant to say is that we should go to the wxWidgets documentation and look for the class wxMenu. Furthermore (and again, this is a consistent naming convention), I am most likely interested in a function which performs an Append() operation on a wxMenu.

When we go to the documentation for wxMenu::Append() we see that there are three variants of wxMenu::Append(). For those who aren’t familiar with C++, I should explain that C++ lets a single function name be overloaded with different parameter types. Haskell doesn’t allow this, so our menuAppend function can only be the equivalent of one of these type signatures.

  • wxMenuItem* Append(int id, const wxString& item = “”, const wxString& helpString = “”, wxItemKind kind = wxITEM_NORMAL) Adds a string item to the end of the menu.
  • wxMenuItem* Append(int id, const wxString& item, wxMenu *subMenu, const wxString& helpString = “”) Adds a pull-right submenu to the end of the menu. Append the submenu to the parent menu after you have added your menu items, or accelerators may not be registered properly.
  • wxMenuItem* Append(wxMenuItem* menuItem) Adds a menu item object. This is the most generic variant of Append() method because it may be used for both items (including separators) and submenus and because you can also specify various extra properties of a menu item this way, such as bitmaps and fonts.

I hope it doesn’t require a “super C++ guru” to realise that the first of the list items above is the closest to our menuAppend function. Those who have really been paying attention may notice that there are actually several functions which start menuAppend, including menuAppendSub and menuAppendItem, and these are actually wrappers for the other two variants of wxMenu::Append(). The only other thing you need to observe to line the parameters up between the C++ and the Haskell versions of the functions is that there is an initial obj parameter in all of the Haskell functions. This is because you would normally use an object pointer or reference in C++ so that the C++ code:

mnuFile->Append(wxID_OPEN, "&Open...\tCtrl-o", "Open Page", 0);

is effectively rendered in Haskell as:

menuAppend mnuFile wxID_OPEN "&Open...\tCtrl-o" "Open Page" False

One other aspect of using the functions in Graphics.UI.WXCore.WxcClassesXX is that we have to care about having unique menu identifiers. The standard menu items (Open, Close, Save and the like) have standard identifiers, and we use them here.

 > mnuFile <- menuPane [text := "File"]
 > menuAppend mnuFile wxID_OPEN "&Open...\tCtrl-o" "Open Page" False
 > menuAppend mnuFile wxID_SAVE "&Save\tCtrl-s" "Save Page" False
 > menuAppend mnuFile wxID_SAVEAS "Save &as...\tCtrl-Shift-s" "Save Page as" False
 > menuAppend mnuFile wxID_CLOSE "&Close\tCtrl-W" "Close Page" False

When creating menu entries the WXCore way, we need to attach event handlers to each item. The evtHandlerOnMenuCommand :: EvtHandler a -> Id -> IO () -> IO () function associates a menu ID in a given window with an event handler.

It’s worth examining evtHandlerOnMenuCommand a little more closely. The first thing to notice is that I said that we associate an event handler with a window and a unique identifier. If you check back over the code, win is of type Frame (), but evtHandlerOnMenuCommand wants an EvtHandler a how does this work?

The underlying wxWidgets library is a piece of OO design in C++, and if you check the wxWidgets documentation for wxFrame (which is what a Frame is under the hood), it tells us that the inheritance hierarchy looks like the following (read ‘->’ as “inherits from”):

wxFrame -> wxTopLevelWindow -> wxWindow -> wxEvtHandler -> wxObject

This, in OO C++ jargon, means that a wxFrame is-a wxEvtHandler. Another way of saying this is that you can treat a wxFrame as a wxEvtHandler.

That’s all very well for C++, but we are working in Haskell, and Haskell doesn’t have objects. It turns out, though, that we can model the hierarchy of an OO design using types (although the approach doesn’t really support multiple inheritance very well).

If you go to the documentation for Frame (in Graphics.UI.WXCore.WxcClassTypes), you will find that the type of Frame turns out to be:

type Frame a = TopLevelWindow (CFrame a)
type TFrame a = TTopLevelWindow (CFrame a)
type CFrame a

This looks a little like the C++ inheritance hierarchy. Checking further:

type TopLevelWindow a = Window (CTopLevelWindow a)
type TTopLevelWindow a = TWindow (CTopLevelWindow a)
type CTopLevelWindow a
type Window a = EvtHandler (CWindow a)
type TWindow a = TEvtHandler (CWindow a)
type CWindow a

Haskell being a nice predictable and pure language, we can do some substitutions, and it turns out that our Frame () can be expressed as:

Frame () = EvtHandler ( CFrame () )

Since the CFrame a constructor doesn’t really do anything (it is called a “type witness”), all of this means that our Frame () is-a EvtHandler a, and we can use it in evtHandlerOnMenuCommand.

The other aspect of the event handlers is that, at least in this case, no useful information is provided by the event, so if you need to pass any information to the event handler, you most likely need to do this by currying the event handler function. In this case, while evtHandlerOnMenuCommand expects an event handler to have type IO (), the event handlers for the menu in this application typically include a curried guiCtx parameter which holds information about the controls and files used in the application.

> evtHandlerOnMenuCommand win wxID_OPEN $ openPage guiCtx
> evtHandlerOnMenuCommand win wxID_SAVE $ savePage guiCtx
> evtHandlerOnMenuCommand win wxID_SAVEAS $ savePageAs guiCtx
> evtHandlerOnMenuCommand win wxID_CLOSE $ windowClose win False >> return ()

The remainder of the function is pretty similar to step 1, except that we need to add the menu bar to the Frame by setting the menuBar property.

> set win [menuBar := [mnuFile]]
> set win [layout := fill $ widget editor, clientSize := sz 640 480]
> focusOn editor
> set win [visible := True]

Event Handlers

Much of the functionality of a GUI application in most widget toolkits is executed in response to events. A wxHaskell application is no exception to this rule, and much of the logic of any application you develop will reside in its event handlers.

The event handling functions below all have type GUIContext -> IO (), with the GUIContext carrying shared state information.

The openPage function is responsible for loading a file into the editor pane. In common with most GUI toolkits, wxHaskell provides the ability for the programmer to use standard dialog boxes for key functions such as loading and saving files, and some of the convenience functions provided make the use of these pretty straightforward. The fileOpenDialog function has the following signature:

fileOpenDialog :: Window a -> Bool -> Bool -> String
               -> [(String, [String])] -> FilePath
               -> FilePath -> IO (Maybe FilePath)

The parameters, in order, have the following purposes:

  • Parent window identifier
  • Bool which, if true, indicates that the application should remember the last selected directory.
  • Bool which, if true, indicates that read-only files can be selected
  • String containing the text for the dialog box frame
  • A list of tuples which define the filename selections offered by the dialog box. Each tuple (String, [String]) is a pair in which the first element is a String containing a description of the file type and the second element is a list of wildcard patterns denoting acceptable file extensions.
  • A String indicating the path to the initial directory (often set as the empty string, which indicates no default directory)
  • A String containing the default filename to choose (also often set to the empty string, which indicates no initial selection)

The result of invoking fileOpenDialog is a Maybe FilePath. If we have Nothing, then no file was selected and we simply return without doing anything.

If we have a Just path in which path is the complete path to the selected file, then we load the selected file into the text control, set the title of the Frame to include the filename loaded in the text control and remember the file location in the filePath mutable variable.

There are two ways in which you could load text into the TextCtrl, guiEditor. The first is to use normal Haskell file handling functions to load the file contents into a string and assign the text property of guiEditor to contain the string. The second, used here, is to use the WXCore function textCtrlLoadFile. I’ll also point out, once more, that the text property of a Frame (in this case guiWin) sets the text at the top of the Frame window.

> openPage GUICtx{guiWin = win, guiEditor = editor, guiFile = filePath} =
> do
>   maybePath <- fileOpenDialog win True True "Open file..."
>                               [("Haskells (*.hs)",["*.hs"]),
>                                ("Texts (*.txt)", ["*.txt"]),
>                                ("Any file (*.*)",["*.*"])]
>                               "" ""
>   case maybePath of
>     Nothing   -> -- The user cancelled... nothing to do
>                  return ()
>     Just path -> do
>                  textCtrlLoadFile editor path
>   set win [text := "wxhnotepad - " ++ path]
>   varSet filePath $ Just path

The function to save a file is very similar in structure to openPage. There is a convenience function fileSaveDialog which lets you select the name of a saved file using the standard file dialog for your platform, and a function textCtrlSaveFile which lets you save the contents of a text control to a file.

> savePageAs GUICtx{guiWin = win, guiEditor = editor, guiFile = filePath} =
> do
>   maybePath <- fileSaveDialog win True True "Save file..."
>                               [("Haskells (*.hs)",["*.hs"]),
>                                ("Texts (*.txt)", ["*.txt"]),
>                                ("Any file (*.*)",["*.*"])]
>                               "" ""
>   case maybePath of
>     Nothing   -> return ()
>     Just path -> do
>                  textCtrlSaveFile editor path
>                  set win [text := "wxhnotepad - " ++ path]
>                  varSet filePath $ Just path

The savePage function is a simple wrapper around savePageAs for the case when we want to save a file to the existing filename. The current filename is fetched from the filePath mutable variable. We use a guard to verify that we do, in fact, have a filename set allowing the save operation to be executed, and if we do not, we call savePageAs to pull up a dialog box.

> savePage guiCtx@GUICtx{guiWin = win, guiEditor = editor, guiFile = filePath} =
> do
>   maybePath <- varGet filePath
>   case maybePath of
>     Nothing   -> savePageAs guiCtx
>     Just path -> textCtrlSaveFile editor path >> return ()

An interesting reader exercise would be to modify the menu so that the savePage menu is only enabled when a filename is set. You will probably want the menuItemEnable function to assist in this modification. In this case the menu item would only be available when we have a filename, and the call to varGet filePath should always return a filename.

That completes step 2 of the text editor. Next time we will add undo / redo functionality.


Building a text editor (Part 1)

Edit: added cabal install information. Thanks Slaava!

This is the first post in a new series, aimed at wxHaskell beginners.

I did not write the code in this post. It was written by Fernando Benavides especially for this blog, and I’m extremely grateful for his help. The code is BSD3 licensed and under his copyright. You can fetch it as a cabal package (update: cabal install wxhnotepad), which is the best way to follow this tutorial. The fact that Fernando wrote the code means that in case of any disagreement between my commentary and the code, you should believe the code 🙂

I should also mention that Fernando is the author of λpage, which he describes as a Haskell scrapbook – you can think of it as a GUI-based and more featureful GHCi. It has several neat features: Hayoo integration and the ability to determine the kind of types are two stand-outs for me. I enjoyed checking it out, and find myself using it quite often. See what you think.

The first step in the tutorial is just about the most minimal wxHaskell application imaginable: a text editor without the ability to load or save text, no search and no replace. It’s a good start though, and in the next few posts it will develop into a usable notepad replacement.

Fernando has written the code in a particularly neat way – there are actually six versions of the editor, and you can call any of them from the main launcher screen. We’ll start with the launcher, since it is the main module for the program.

The Launcher

There are two libraries which make up wxHaskell:

  • WXCore, a fairly thin wrapper around wxWidgets (the C++ library which does most of the rendering). The functions in WXCore tend to require a style of programming similar to C++, although we at least benefit from Haskell type inference when using them.
  • WX, a higher-level library which enables a more declarative style of programming. As a general rule, you will probably want to use WX functions whenever possible and drop down to WXCore when WX does not do what you need. You will actually need to do this relatively often, as there are quite a few useful features in WXCore which do not have equivalents in WX.

At the top of any wxHaskell program, you will almost certainly want to import WXCore and WX, so:

> module Main where
> import Graphics.UI.WX
> import Graphics.UI.WXCore
> import Step1
> import Step2
> import Step3
> import Step4
> import Step5
> import Step6

Like every other Haskell program, wxHaskell applications start with main.

In this case we have a very simple main program, but in a more complex application you might have come command line option handling, configuration file handling or similar. However, the essential part of a wxHaskell application is a call to start with a sequence of IO actions which make up the GUI logic of your program.

For wxHaskell application programming, that’s all you really need to know about start-up, but for the curious (or those who have done some wxWidgets programming in C++), what is happening under the hood is that start creates an instance of a wxHaskell application class derived from wxApp and this instance uses the closure represented by gui in the implementation of wxApp::onInit().

> main :: IO ()
> main = start gui

The launcher is very simple. It consists of a Frame which has a menu and nothing else.

Any wxHaskell application requires a top level container window. This is almost always a Frame, although it is possible to use a Dialog as a container if you have a very simple form-type GUI in mind. If you want a menu, you will definitely need a Frame, and we want a menu.

It is worth a closer look at how the Frame is created and configured, since this is a model for creating many windows and controls in wxHaskell. The wxHaskell documentation for frame says that is has type frame :: [Prop (Frame ())] -> IO (Frame ()), and that it creates a top level frame window.

What does this [Prop (Frame ())] mean? Well, wxHaskell has a mechanism which lets you perform much of the configuration of the different window and widget types in a declarative fashion by setting (or reading back) Attributes. This is much nicer than mucking about with lots of individual functions, and tends to create code which is clear and easy to understand.

The precise meaning of [Prop (Frame ())] is that you may provide a list of Properties which are applicable to a Frame. Most of these properties have been grouped into typeclasses, and the documentation usually indicates which are supported by a given type (the usually here should be taken to say that if you try this for Frame, you will be disappointed to find out that the documentation doesn’t mention this at all…)

  • The text attribute is typically used to manipulate some form of meaningful text in a control. In the case of a Frame it sets the text in the window frame; in the case of a static text or text control it sets the text in the control.
  • The visible attribute is supported by most controls – it determines whether the control is visible or not.
  • The on attribute is more interesting. It is typically followed by an event name, and the pair is used to configure an event handler.

Thus, the short snippet of code below creates a Frame with the caption “wxhNotepad”, which is initially invisible and which calls a function, wxcAppExit when the Frame closing event is fired.

One other point of note: the set function can be used to set or change the properties of a window or control which has already been created (there is a related get function for reading values back as well). In this case we could have put the closing event handler into the property list we used when creating the frame, but in some cases (e.g. when you need to know the control identity to configure things correctly), you will need to use this
two (or more) phase approach.

 > gui :: IO ()
 > gui =
 >   do
 >     win <- frame [text := "wxhNotepad", visible := False]
 >     set win [on closing := wxcAppExit]

The say function is a convenience for launching a small information dialog box.

 > let say title desc = infoDialog win title desc

The main purpose of the launcher is to support the menu which lets you use the editor in each of its stages of development. There are a couple of ways of creating a menu (we’ll see the lower-level way later).

The simplest is to use menuPane to create a menu heading (e.g. ‘File’), menuItem to create an item in a menu (e.g. ‘Open’) and menuBar to set the menu for a frame. There are convenience functions for certain menu entries, notably the ‘Help’, ‘About’ and ‘Quit’ menu items, as these may require special handling on certain OS platforms, and using the convenience function ensures that you do this in the way expected on each OS.

It is worth quickly noting that for menu items, the text property is used for the menu text. Notice also that menu shortcuts and accelerators can be defined in the menu text itself. The wxWidgets documentation for wxMenu::Append() describes this format in detail.

 > mnuSteps <- menuPane [text := "Steps"]
 > menuItem mnuSteps [on command := step1,
 >    text := "Step &1 - Just a Text Field\tCtrl-1"]
 > menuItem mnuSteps [on command := step2,
 >    text := "Step &2 - Open / Save / Save As...\tCtrl-2"]
 > menuItem mnuSteps [on command := step3,
 >    text := "Step &3 - Undo / Redo...\tCtrl-3"]
 > menuItem mnuSteps [on command := step4,
 >    text := "Step &4 - Cut / Copy / Paste...\tCtrl-4"]
 > menuItem mnuSteps [on command := step5,
 >    text := "Step &5 - Find / Replace...\tCtrl-5"]
 > menuItem mnuSteps [on command := step6,
 >    text := "Step &6 - Toolbar / Statusbar / Context Menus\tCtrl-6"]
 > menuQuit mnuSteps [on command := wxcAppExit]
 > mnuHelp <- menuHelp []
 > menuAbout mnuHelp [on command := say "About wxHNotepad"
 >       "Author: Fernando Brujo Benavides\nWebsite:"]

Once we have created a menu, it needs to be assigned to our Frame, and this is done with the menuBar property mentioned earlier. Notice that the menuBar takes a list of menuPane instances.

We finally make the Frame visible. There’s a neat trick to note here: what we are trying to do is to create a Frame which contains nothing but a menu. This is no problem on OSX, but Windows and Linux don’t really support it. However, if you set the clientSize property of the Frame to (0,0) then you get much the same effect.

 > set win [menuBar := [mnuSteps, mnuHelp],
 > visible := True, clientSize := sz 0 0]

Text editor: step 1

This is the absolutely minimal, first stage text editor. It consists of nothing more than a text control inside a Frame. No menu. No dialogs and no real functionality. Perhaps the only aspect of interest is to note that
it is easy to make a wxHaskell application with more than one Frame, should you wish to.

Since this is the second time we have mentioned clientSize, it is probably worth a moment to explain what this means. There are several different ways to look at the size of a window. Two of the
most important are:

  • clientSize The size available for displaying information inside a window – i.e. if the clientSize is (640, 480), this means that there are 640 x 480 (width x height) pixels available for displaying information. Borders, window decorations and so on take up additional space.
  • virtualSize The size which would be needed to display all of the information contained in the window. Often the clientSize and virtualSize are the same, but if there is more information in the window than can be displayed fully (i.e. if you need a scroll bar) then the clientSize will be smaller than the virtualSize.

There is one new call in the snippet below: textCtrl constructs a text control. As parameters it requires a parent window (which in this case will be the Frame, win) and a list of properties. All non top-level windows require their parent as a parameter, since wxWidgets keeps windows in a hierarchy rooted at the top-level.

 > step1 =
 > do
 > win <- frame [text := "wxhNotepad - Step 1", visible := False]
 > editor <- textCtrl win [font := fontFixed,
 >           text := "This is our first step in the " ++
 >           "developing of our text editor.\n" ++
 >           "Just a big text area where " ++
 >           "the user can read and write text\n" ++
 >           "That's not much, but it's just the " ++
 >           "beginning..."]

In the following snippet, we use the Layout mechanism to help us to fit our textCtrl inside the frame.

Layout is a conceptually elegant mechanism which allows you to describe the way in which the windows in an application are arranged and organized in a declarative manner.

The reality is that some aspects of the way that Layout works are rather complex and subtle (so much so that Layout will probably be the subject of a blog article or two of its own in the near future), but in this demonstration, Layout will work very well for us. I’d just ask that you don’t get discouraged if you have issues with more complex arrangements of controls using Layout.

Layout is specified using the layout property. It consists of a sequence of combinator functions which must ultimately resolve to a Attr w Layout type. For the moment, we just need to know that:

  • widget requires a control as a parameter. It indicates how the specified control should be placed in the Layout.
  • fill is a Layout transformer which indicates that the Layout to which it is applied should stretch and expand into the available area.

The documentation for Layout will give a better feel for what is happening, if you would like to understand more, but please bear in mind that this is a fairly complex subject, since what Layout is actually doing is to create sizer instances from the Layout specification, and sizers are a fairly large subject in themselves.

 > set win [layout := fill $ widget editor,
 >          clientSize := sz 640 480]
 > focusOn editor
 > set win [visible := True]

Custom Controls in wxHaskell (part 5)

Window Painting

Most of the windows in the control will use their default paint functions, but since the two viewports for outputting diff information are based on a Window type, they will require special handling.

The behaviour required in a Window is slightly different depending on whether the original file or the changed file is being rendered. To indicate, we have a specific type, which
is curried into the selected on paint handler for each viewport.

 > data DVFileType = DVorig | DVchanged deriving Show

Now we can define a suitable custom paint handler. On entry, win is the viewport window, DC is a suitable device context which is provided by the framework and the rectangle represents the minimum area which needs to be updated.

When performing actions which might take a while (even for quite small values of ‘a while’), it is good practice to display a busy cursor

 > onPaint parent file_type win dc r@(Rect x y w h) =
 >     wxcBeginBusyCursor >>
 >     getDisplayableText parent >>= \render_info ->
 >     renderDiff file_type parent win dc render_info >>
 >     wxcEndBusyCursor

The getDisplayableText function was described in the previous installment, and is responsible for working out which text to render. In this installment, we are more interested in the specifics of rendering the text.

The renderDiff function is responsible for rendering text to the device context which was passed in via the onPaint function. To do this effectively, we need to determine the space taken up by the text characters. Since this depends on the selected font, point size, whether bold and/or italic text is required and even (although not relevant to this example) the device to which the text is being rendered – the sizing may be slightly different on a printed page compared to the display, for example – wxHaskell provides a function, getFullTextExtent, which will help you to obtain this information:

getFullTextExtent :: DC a -> String -> IO (Size, Int, Int)

What getFullTextExtent does is to determine the dimensions of a given string using the currently selected font (including bold/italic, point size etc.). The Size parameter gives the rectangle from the font baseline into which the string will render. The first integer is the descent (i.e. the space taken below the font baseline by the descenders on characters such as y and p. The second integer is any additional vertical space (external leading) – this is usually zero.

For optimum display of text, you should really call getFullTextExtent on each string to render. This is relatively slow, but accurate. In this case, however, we don’t really care about the absolute accuracy, and are optimizing for use with monospace fonts. I use a small function, getFontMetrics which can be useful where speed of rendering is more important than precision.

The basic idea is to call getFullTextExtent on some different characters (I use “W”, “y” and “l”) to determine the (probably) maximum space required to render a single character in a given font. This works well in parctice on most fonts, although I would expect it to be unsuitable for some of the more fancy font designs.

With this in mind, the operation of renderDiff is fairly straightforward. All text is rendered starting from (0, 0) in the client area (remember – we are managing scroll bars manually), clipping any initial characters which are not required (clipText) and starting each new line the maximum number of vertical pixels required by the font plus an optional, user-defined vertical space (to separate the lines a little more, for enhanced readability).

The text to display (a list of String) is zipped with the y axis positions for each line of text (y_posns).

 > renderDiff file_type parent win dc (RI diff_lines fst_col width) =
 >     dvGetState parent >>= \(DVS _ _ _ _ _ _ _ _ (DVF fs col bgcol spc) _ ) ->
 >     getFontMetrics win fs >>= \(FontMetrics x_max y_max desc el) ->
 >     get win clientSize >>= \(Size w h) ->
 >     set win [ color := col, bgcolor := bgcol ] >>
 >     set dc [ font := fs ] >>
 >     let disp_diff = map clipText diff_lines
 >         x_pos     = 0
 >         y_posns   = map (\n -> n * (y_max + desc + spc)) [0..]
 >         diff_pos  = zip disp_diff y_posns in
 >     mapM_ (\(diff, y_pos) -> renderLine file_type diff (Point x_pos y_pos) dc) diff_pos
 >         where
 >           clipText (DiffLine t s) = DiffLine t (take width (drop fst_col s))

The renderLine function renders a single line, selecting the appropriate renderer, and depending on whether this is the original or the updated file.

 > renderLine file_type (DiffLine t str) point dc =
 >     (getRenderer t) file_type str point dc

Determine which renderer function to use. There are four options: text we do not want to render at all is rendered using nullRenderer; text which has been added is rendered using addRenderer; text which has been deleted is rendered using delRenderer and text which is the same in both files is rendered using ctxtRenderer.

 > getRenderer OrigFileLine   = nullRenderer
 > getRenderer ChangeFileLine = nullRenderer
 > getRenderer RangeLine      = nullRenderer
 > getRenderer AddLine        = addRenderer
 > getRenderer DeleteLine     = delRenderer
 > getRenderer CommonLine     = ctxtRenderer
 > getRenderer _              = nullRenderer

Render Add line. This is presently configured to print added text (i.e. text which is present in the modified file but not the original) in green. Note that the current implementation uses the somewhat unsatisfactory approach of using silver ‘#’ characters to indicate text which is not present. This is an obvious area for improvement.

 > addRenderer DVorig _ point dc =
 >     let spaces = replicate 100 '#' in
 >     setTextColours dc colour_silver colour_silver >>
 >     drawText dc spaces point []
 > addRenderer DVchanged txt point dc =
 >     setTextColours dc colour_green colour_white >>
 >     drawText dc txt point []

Render Delete line. This is presently configured to show deleted text (present in original but not in modified file) in red.

 > delRenderer DVorig txt point dc =
 >     setTextColours dc colour_red colour_white >>
 >     drawText dc txt point []
 > delRenderer DVchanged _ point dc =
 >     let spaces = replicate 100 '#' in
 >     setTextColours dc colour_silver colour_silver >>
 >     drawText dc spaces point []

Render Unchanged line

 > ctxtRenderer _ txt point dc =
 >     setTextColours dc colour_black colour_white >>
 >     drawText dc txt point []

Null renderer can be used when there is nothing to render.

 > nullRenderer _ _ _ _ =  return ()

Helper function for setting text colours

 > setTextColours dc fg bg = dcSetTextForeground dc fg >>
 >                           dcSetTextBackground dc bg

The virtual canvas

The control implementation is almost complete. The only thing which remains is to complete the management of the scroll bars and the associated virtual canvas size. These simplify scrolling calculations, and are re-calculated when the diff text changes.

Given the font metrics for a device context on a file display windows we can work out the size of a virtual window which would be large enough to contain the entire diff text. Notice that this implementation only really works for monospace fonts.

We set both of the diff client windows to have the virtual size of this notional canvas and we work within a viewport onto this virtual canvas. We also configure the scroll bar
so that they range over the virtual canvas correctly. The key aspect here is that the scroll bars are resized depending on the proportion of the underlying virtual canvas which can be displayed in the client window

 > setVirtualCanvas w =
 >     dvGetState w >>= \(DVS _ _ _ vp1 vp2 vs hs _ (DVF fs _ _ spacer) m) ->
 >     get vp1 clientSize >>= \cs1 ->
 >     get vp2 clientSize >>= \cs2 ->
 >     getFontMetrics vp1 fs >>= \(FontMetrics x_max y_max desc el) ->
 >     let textSize    = calcTextSize m
 >         char_height = y_max + desc + spacer
 >         char_width  = x_max + el
 >         canvas_sz   = sz (char_width * (sizeW textSize)) (char_height * (sizeH textSize)) in
 >     set vp1 [ virtualSize := canvas_sz ] >>
 >     set vp2 [ virtualSize := canvas_sz ] >>
 >     adjustScrollbars w

Adjust the scroll bars to represent the correct view over the data in the viewport. For the purposes of calculation, assume that both viewports are the same size (they
will be clipped anyway, so worst case is that we do a little more work than strictly required).

Scroll bars are configured with a range (number of rows/columns of text) and a thumb size (number of rows/columns visible in the viewport). We take care to save the current thumb position before adjusting.

 > adjustScrollbars w =
 >     dvGetState w >>= \(DVS _ _ _ _ _ vs hs _ _ map) ->
 >     calcViewportTextSize w >>= \(Size x_cs_txt y_cs_txt) ->
 >     let (Size x_txt y_txt) = calcTextSize map in
 >     -- Save scroll position before updating
 >     scrollBarGetThumbPosition vs >>= \vs_pos ->
 >     scrollBarGetThumbPosition hs >>= \hs_pos ->
 >     scrollBarSetScrollbar vs vs_pos y_cs_txt y_txt y_cs_txt True >>
 >     scrollBarSetScrollbar hs hs_pos x_cs_txt x_txt x_cs_txt True


I chose to define helpers to allow me to use a small subset of the standard colour names/spaces defined in the W3C CSS specification.

 > colour_silver  = colorRGB 192 192 192
 > colour_black   = colorRGB   0   0   0
 > colour_green   = colorRGB   0 128   0
 > colour_white   = colorRGB 255 255 255
 > colour_red     = colorRGB 255   0   0

Custom Controls in wxHaskell (part 4)

Deciding what to render

Our DiffCtrl has two viewport Window instances on which we will eventually be rendering the diff text. In this section, we consider what actually needs to be rendered.

The background is that most GUI toolsets support the concept of a viewport which provides a window over all of the data in a window. There is too much information to be able to fit everything into the area available to display, so we see only a part of it. In wxWidgets (and therefore wxHaskell), the key ideas are the virtualSize which represents the size a window would need to be to fit all of the displayable information into it and the clientSize which is the size actually available for displaying information in the application.

One option available to us is to simply render all of the information into the virtual canvas. This is fine, and works OK for controls which have automatic management of scroll bars (incidentally, if you do not set the virtualSize and clientSize parameters for such controls, Layout often fails since any size control size up to the virtualSize is possible and the Layout algorithm has a tendency to decide that something like a 1 x 1 control size is a good choice – almost certainly not what you had in mind).

There is a problem with rendering everything to the virtual canvas, and that is that rendering can take a while. If you have a very large data set, and a small window on it, you are expending processing time just to throw away most of what you did (because wxWidgets only displays the part of the rendered information which can be seen on the client Window). For reasons of responsiveness, many applications therefore don’t bother to render what you cannot see, and only render what is visible.

In this application, we are managing what is displayed in Windows manually, as well as keeping manual control of the scroll bars. Therefore, we really have to take care about what is going to be rendered to the Window instances ourselves.

A digression: unified diff output

Below is a fragment of the output from a unified diff command:

--- /path/to/original ''timestamp''
+++ /path/to/new      ''timestamp''
@@ -1,3 +1,4 @@
+This is an important notice! It should therefore be located at the beginning of this document!
 This part of the document has stayed the same from version to
@@ -5,16 +11,10 @@
 be shown if it doesn't change.  Otherwise, that would not be helping to
-compress the size of the changes.Determine the viewable text, i.e. the text which should be displayed in the viewport
  • The — prefix indicates that the line contains the name and timestamp of the ‘original’ file in the diff.
  • The +++ prefix indicates that the line contains the name and timestamp of the ‘modified’ file in the diff.
  • The @@ prefix indicates which lines have changed.
  • The + prefix indicates a line which has been added to the original to create the modified file.
  • The – prefix indicates a line which has been deleted from the original to create the modified file.
  • Lines starting with a space character are unchanged between the original and modified files.

It is worthwhile to point out that we don’t want to render filename, timestamp or line number information in the Window. Therefore, the number of lines of information returned from the diff command is not the same as the number of lines we need to render.

We can express this with a suitable data type:

> data DiffLineType = CommonLine
>                   | AddLine
>                   | DeleteLine
>                   | RangeLine
>                   | OrigFileLine
>                   | ChangeFileLine
>                   | UnknownLine
>                     deriving (Eq, Show)

It is very straightforward to determine the type of information represented in a diff line. It is probably an error if we don’t have one of the prefixes given above. Since I’m not sure how I will deal with such an error for now, UnknownLine has been created.

> getDiffLineType :: String -> DiffLineType
> getDiffLineType ('-':'-':'-':_) = OrigFileLine
> getDiffLineType ('+':'+':'+':_) = ChangeFileLine
> getDiffLineType ('@':'@':_)     = RangeLine
> getDiffLineType ('+':_)         = AddLine
> getDiffLineType ('-':_)         = DeleteLine
> getDiffLineType (' ':_)         = CommonLine
> getDiffLineType _               = UnknownLine

Now we have everything we need to parse the raw output from the diff command into something a little easier to work with. The lines from a diff run are represented in a data type containing the line type and the remaining text.

> data DiffLine = DiffLine DiffLineType String
>                 deriving Show

Parse diff lines into DiffLine data structures.

> parseDiffLines = map parseDiffLine
>     where
>       parseDiffLine s =
>           case getDiffLineType s of
>             OrigFileLine   -> DiffLine OrigFileLine   (drop 3 s)
>             ChangeFileLine -> DiffLine ChangeFileLine (drop 3 s)
>             RangeLine      -> DiffLine RangeLine      (drop 2 s)
>             AddLine        -> DiffLine AddLine        (tail s)
>             DeleteLine     -> DiffLine DeleteLine     (tail s)
>             CommonLine     -> DiffLine CommonLine     (tail s)
>             UnknownLine    -> DiffLine UnknownLine    (tail s)

It is now straightforward to determine whether a line from the diff command should be displayed in the viewport or not. Displayable returns True if a line is displayable in a viewport.

 > displayable AddLine    = True
 > displayable DeleteLine = True
 > displayable CommonLine = True
 > displayable _          = False

We are now in a position to determine how many lines of displayable text the diff command generated for us.

> countDiffLines map = Map.fold countDiffLines' 0 map
>     where
>     countDiffLines' (DiffLine typ _) acc | displayable typ = acc + 1
>                                          | otherwise       = acc

What can I show you today?

This is basically a question of working out the row and column of the displayable lines of text at which we start display, and the row and column at which we finish display.

Working out which columns to display is the more straightforward calculation, so I chose to represent this in a RenderInfo type which contains a line of diff text, the first column to be displayed and the length of text to display. Note that when making these calculations, if the calculations as integers are inexact (they often are), just render slightly more information than your display area. The surplus will be clipped, but it will clip showing (for example) partial characters, which is what you want.

In passing, I should note that since the first column and maximum to render are the same for all lines of text, I could probably have done without this data type.

 > data RenderInfo = RI { ri_txt      :: ![DiffLine]  -- | Text to render
 >                      , ri_firstcol :: !Int         -- | First column to be used in text
 >                      , ri_length   :: !Int         -- | Length of text to render
 >                      } deriving Show

The getDisplayableText function uses calcViewportTextExtent to determine the size of a rectangle (in rows and columns of characters) on which text can be displayed, and the selectLines function to select the correct number of displayable lines.

 > getDisplayableText win =
 >     calcViewportTextExtent win >>= \r@(Rect x _ w _) ->
 >     dvGetState win >>= \(DVS _ _ _ _ _ _ _ _ _ map) ->
 >     let (_, diff_lines) = Map.fold (selectLines r) (0,[]) map
 >         disp_diff  = RI diff_lines x w in
 >     return disp_diff

The selectLines function selects those lines which will be displayed on the viewport, based on the following criteria:

  • displayable lines with line number < y are above the viewport and not displayed
  • displayable lines between line number y and line number y + h are displayed
  • other lines are not displayed

In addition, note that as not all lines are displayable, we need to keep a separate account of the displayable line number as we iterate over the map. This is why we use (Int, [DiffLine]) as our accumulator, rather than just [DiffLine].

 > selectLines :: Rect -> DiffLine -> (Int, [DiffLine]) -> (Int, [DiffLine]
 > selectLines (Rect _ y _ h) (DiffLine typ str) acc@(disp_line_no, strs)
 >                 | (disp_line_no < y)     && (displayable typ) = (disp_line_no + 1, strs)
 >                 | (disp_line_no < y + h) && (displayable typ) = (disp_line_no + 1, (DiffLine typ str) : strs)
 >                 | otherwise                                   = acc

As noted earlier, calcViewportTextExtent determines a rectangle over the complete displayable diff text which will be displayed. This is straightforward: the scroll bars give the starting row/column from their current position. We know the end row/column by calculating the viewport text size. Thus we obtain a starting row/column and an end row/column to display.

I should note that the viewport text size is the number of rows and columns of text which will fit in the viewport. This is dependent on the size of text and font used, which is why it has been calculated separately from working out which rows/columns of text to display.

 > calcViewportTextExtent w =
 >     dvGetState w >>= \(DVS _ _ _ _ _ vs hs _ _ map) ->
 >     scrollBarGetThumbPosition vs >>= \top_left_y ->
 >     scrollBarGetThumbPosition hs >>= \top_left_x ->
 >     calcViewportTextSize w >>= \(Size bot_right_raw_x bot_right_raw_y) ->
 >     let (Size max_x max_y) = calcTextSize map
 >         width  = min bot_right_raw_x (max_x - top_left_x)
 >         height = min bot_right_raw_y (max_y - top_left_y)
 >         textExtent  = Rect top_left_x top_left_y width height in
 >     putStrLn ("calcViewportTextExtent textExtent:" ++ (show textExtent)) >>
 >     return textExtent

Calculate the number of rows and columns required to completely fit the diff text (i.e. the number of lines and the length of the longest line).

 > calcTextSize :: Map.Map Int DiffLine -> Size
 > calcTextSize m = sz (longestString m) (countDiffLines m)
 >     where
 >       longestString m = Map.fold (\(DiffLine _ str) max_now -> max (length str) max_now) 0 m

Calculate how much text we can fit into the viewport. This is straightforward: on each axis, the ratio of virtual canvas extent to viewport canvas extent (i.e. in device context units) is the same as the ratio of the total number of rows/columns to the viewable rows/columns.

Notice that the virtualSize is given a minimum size of (1,1). This is to ensure that no divide by zero error is possible when calculating x_cs_txt and y_cs_txt.

 > calcViewportTextSize w =
 >     dvGetState w >>= \(DVS _ _ _ vp1 _ _ _ _ _ map) ->
 >     get vp1 clientSize  >>= \(Size x_cs y_cs) ->
 >     get vp1 virtualSize >>= \(Size x_vs y_vs) ->
 >     let (Size x_vs_txt y_vs_txt) = calcTextSize map
 >         x_vs'    = max 1 x_vs
 >         y_vs'    = max 1 y_vs
 >         x_cs_txt = min ((x_cs * x_vs_txt) `div` x_vs') x_vs_txt
 >         y_cs_txt = min ((y_cs * y_vs_txt) `div` y_vs') y_vs_txt
 >         cs_txt   = sz x_cs_txt y_cs_txt in
 >     return cs_txt

Custom Controls in wxHaskell (part 3)

State management

Note to readers: this is an aspect of the control implementation which I find rather unsatisfactory, and I will be exploring alternative approaches at some point in the future.

It is difficult to get away from the fact that the wxWidgets library which underlies wxHaskell is a piece of classic object-oriented C++ design, and many of the abstractions it presents to the world are about maintaining and manipulating stateful information encapsulated inside objects.

While wxHaskell has some neat abstractions, such as Attributes and Layout, which allow a more declarative style of programming in places, at the core of design of most wxHaskell programs will be manipulations of different controls and the like.

There are several options open to anyone building an application:

  1. Pass the identities of all of the required controls around as parameters to the relevant functions. This is a properly functional approach, but quickly gets out of hand in a real application containing many widgets.
  2. Wrap the state information in a state monad stacked on top of the IO monad (most of the wxHaskell API lives in the IO monad). This is among the more principled approaches I can think of, but it wraps everything monad transformers, and tends to make my head hurt. We will explore this approach in some depth later, however.
  3. Use wxHaskell variables. A couple of the wxHaskell samples (notably BouncingBalls) do this.
  4. Manage state manually, using something like a hash table to store the required information.

When implementing a re-usable control, one aspect of state management which needs extra consideration is that your design needs to account for the possibility of multiple instances of the control.

The approach taken here is stateful, maintaining a per-control state (so that multiple controls could be used in an application if required). A hash table, keyed on the DiffControl ID (actually the Window ID of the Panel which was sub-classed to create the control – which is unique within a given wxWidgets application) maintains state for all control instances.

The control id is taken to be the identity of the outermost panel (i.e. the dvs_panel field of the DiffViewerState type).

DiffViewerState attempts to encapsulate all of the state required to maintain the control. Notice that the diff function and the formatting for the diff lines line have been made ‘pluggable’, enabling the diff function and the formatting to be adapted to user requirements.

> data DiffViewerState = DVS { dvs_panel :: DiffViewer ()
>                            , dvs_fn1   :: StaticText ()
>                            , dvs_fn2   :: StaticText ()
>                            , dvs_f1    :: Window ()
>                            , dvs_f2    :: Window ()
>                            , dvs_vsb   :: ScrollBar ()
>                            , dvs_hsb   :: ScrollBar ()
>                            , dvs_diff  :: Maybe (FilePath -> FilePath -> IO [String])
>                            , dvs_fmt   :: DiffViewerFormatting
>                            , dvs_txt   :: Map.Map Int DiffLine
>                            }

Formatting information is defined in a separate structure, to keep things manageable, with a Show instance required only to simplify debugging.

> data DiffViewerFormatting = DVF { dvf_font     :: !FontStyle
>                                 , dvf_colour   :: !Color
>                                 , dvf_bgcolour :: !Color
>                                 , dvf_spacer   :: !Int
>                                 } deriving Show

The default formatting is black text on white background, fixed width font in 8 point text. You may prefer something larger, but I like to fit as much text as possible on my screen.

> dvf_default = DVF { dvf_font     = FontStyle 8 FontModern ShapeNormal WeightNormal False "" wxFONTENCODING_DEFAULT
>                   , dvf_colour   = colorRGB   0   0   0
>                   , dvf_bgcolour = colorRGB 255 255 255 
>                   , dvf_spacer   = 0
>                   }

Define the hash table which maintains control state. This should not be inlined, as we require a single instance to be used throughout any application using the control. Notice that the use of unsafePerformIO is ‘safe’ as this code will be executed once, when the application starts up.

> {-# noinline dv_states #-}
> dv_states :: Hash.HashTable Int DiffViewerState
> dv_states = unsafePerformIO $ (==) (fromIntegral)

We provide functions to fetch and update the state of a given DiffViewer (remember, this is uniquely identified by the window ID of the DiffViewer control itself)

> dvGetState :: DiffViewer a -> IO DiffViewerState
> dvGetState dv =
>     windowGetId dv >>= \w ->
>     Hash.lookup dv_states w >>= \result ->
>     case result of
>       Just r  -> return r
>       Nothing -> error ("dvGetState: lookup failed for window ID: " ++ show w)

> dvSetState :: DiffViewer a -> DiffViewerState -> IO ()
> dvSetState dv st' =
>     windowGetId dv >>= \w ->
>     Hash.update dv_states w st' >>
>     return ()

A common idiom is to fetch the state in order to update the value of a single field. The dvModifyState function allows the updating to be expressed in terms of a function – normally one which will use record getters and setters to change the required field. This will allow us to use a somewhat declarative style in many state update cases. It works by applying a user-supplied function to a given field in DiffViewerState, with a supplied value. The order of parameters means that the function can often be curried so that only the new value and the required window need be supplied. We will make quite a bit of use of this when defining Attribute manipulations.

> dvModifyState fn w s =
>     dvGetState w >>= \dvs ->
>     let dvs' = fn dvs s in
>     dvSetState w dvs'


Attributes offer a convenient declarative-style wrapper around manipulations of control state. Better still, wxHaskell has defined a set of Attribute typeclasses which are shared by controls with similar features (e.g. the Literate typeclass is used by controls which allow the style (font, colour etc) of displayed text to be manipulated.

In this section, we will define our own unique attributes for the DiffCtrl, as well as making DiffCtrl an instance of the Literate typeclass.

Custom Attributes

Configure an attribute, diffFn, which will be used by the owning application to set the function which will perform the diff operation. Notice that it is possible for no diff function to be set, and this is the default when the control is instantiated (i.e. we use a Maybe a type here).

Notice also that the diff function might be executed when the diffFn attribute is set – the condition for execution being that the diff function is known and the names of the files to test are also known.

All Attributes require a setter and a getter function – the setter changes the attribute value and the getter fetches it. Note that it is quite usual for Attribute setters, in particular, to have significant side effects. In this case, setting the diffFn attribute (dvSetDiffFn) may cause the diff function to be executed. Similarly, we have already seen that setting the layout attribute on a container window causes sizers to be created and windows fitted to the sizers.

The type signature of an Attribute definition tells you a great deal about the anatomy of the system.

  1. The Attribute definition should allow for the required window type and all subclasses (i.e. anything derived from DiffCtrl will inherit the diffFn attribute). This also implies that DiffCtrl inherits all of the attributes of Panel and Window (since it derives from them). There is a big caveat, however, for anyone coming to Haskell from an OO language: you cannot override the attribute definition of a superclass in a derived class – Haskell is not C++. This has a slightly irritating consequence we will come back to later.
  2. The Attribute definition can contain any value type you like. In our case it is a Maybe (FilePath -> FilePath -> IO [String]) type, which you will probably recognise as a straightforward wrapper around the diff function.

Notice that we use dvModifyState to define the state update in a somewhat declarative form .

> diffFn :: Attr (DiffViewer a) (Maybe (FilePath -> FilePath -> IO [String]))
> diffFn = newAttr "diffFn" dvGetDiffFn dvSetDiffFn
>     where
>     dvGetDiffFn = (liftM dvs_diff) . dvGetState
>     dvSetDiffFn win diff_fn = 
>         dvModifyState (\st s -> st { dvs_diff = s } ) win diff_fn >>
>         whenDiffLegal win runDiff

The diffFiles attribute controls selection of the files to which diff function will be applied. When files are set, we clear the diff map (because our existing diff text is invalidated) and possibly (if the file names are non empty) run a new diff function. A consequence of this design is that setting the files to “” will clear the diff control. This should probably have been represented with a Maybe String value, but it works, so I’ll leave this as an exercise for the reader. In other respects, this really looks similar to the diffFn attribute definition.

One minor design note: I chose to require the FilePath values to be set in a tuple – it dod not seem to make much sense to me to allow these to be set individually, as the two filenames required seemed like an atomic feature of performing a diff operation.

> diffFiles :: Attr (DiffViewer a) (FilePath, FilePath)
> diffFiles = newAttr "diffFiles" dvGetFiles dvSetFiles
>     where
>     dvGetFiles win =
>         dvGetState win >>= \(DVS _ fn1 fn2 _ _ _ _ _ _ _) ->
>         get fn1 text >>= \txt1 ->
>         get fn2 text >>= \txt2 ->
>         return (txt1, txt2)
>     dvSetFiles win (txt1, txt2) =
>         dvGetState win >>= \st@(DVS _ fn1 fn2 _ _ _ _ _ _ _) ->
>         let st' = st { dvs_txt = Map.empty } in
>         set fn1 [text := txt1] >>
>         set fn2 [text := txt2] >>
>         dvSetState win st' >>
>         whenDiffLegal win runDiff

Incidentally, the irritating consequence of the fact that you cannot override the Attribute implementation of a superclass is that I cannot, for example, override the implementation of the Colored typeclass to allow the background and foreground colours of the windows in the control to be set together (the default implementation only does this for the Panel itself).

Making a control a member of an existing Attribute class

Note: the wxHaskell documentation says that Panel is an instance of Literate. This is incorrect (or the following would not work…)

The control has configurable fonts and the like, so it has been made an instance of Literate. Note, however, that changing textColor only affects unmodified text (modified text has pre-defined colour attributes).

> instance Literate (DiffViewer a) where
>     font          = newAttr "font"          dvGetFont          dvSetFont
>     fontSize      = newAttr "fontSize"      dvGetFontSize      dvSetFontSize
>     fontWeight    = newAttr "fontWeight"    dvGetFontWeight    dvSetFontWeight
>     fontFamily    = newAttr "fontFamily"    dvGetFontFamily    dvSetFontFamily
>     fontShape     = newAttr "fontShape"     dvGetFontShape     dvSetFontShape
>     fontFace      = newAttr "fontFace"      dvGetFontFace      dvSetFontFace
>     fontUnderline = newAttr "fontUnderline" dvGetFontUnderline dvSetFontUnderline
>     textColor     = newAttr "textColor"     dvGetTextColor     dvSetTextColor
>     textBgcolor   = newAttr "textBgcolor"   dvGetTextBgColor   dvSetTextBgColor

Some helper functions around dvModifyState make the implementation of the Literate setters quite neat.

Modify the dvs_fmt field in a DiffViewerState, applying an updating function to change the existing value in the field.

> dvModifyFmt  fn = dvModifyState (\dvs s -> dvs { dvs_fmt = fn (dvs_fmt dvs) s })

Modify the dvf_font field of the dvs_fmt field in a DiffViewerState, applying an updating function to change the existing value in the field.

> dvModifyFont fn = dvModifyFmt   (\dvf s -> dvf { dvf_font = fn (dvf_font dvf) s })

All of the Literate attribute getters and setters can now be expressed in terms of dvGetState, dvModifyFont or dvModifyFmt

> dvGetFont          = (liftM (dvf_font . dvs_fmt)) . dvGetState
> dvSetFont          = dvModifyFmt  (\st s -> st { dvf_font = s })
> dvGetFontSize      = (liftM _fontSize) . dvGetFont
> dvSetFontSize      = dvModifyFont (\st s -> st { _fontSize = s })
> dvGetFontWeight    = (liftM _fontWeight) . dvGetFont
> dvSetFontWeight    = dvModifyFont (\st s -> st { _fontWeight = s })
> dvGetFontFamily    = (liftM _fontFamily) . dvGetFont
> dvSetFontFamily    = dvModifyFont (\st s -> st { _fontFamily = s })
> dvGetFontShape     = (liftM _fontShape) . dvGetFont
> dvSetFontShape     = dvModifyFont (\st s -> st { _fontShape = s })
> dvGetFontFace      = (liftM _fontFace) . dvGetFont
> dvSetFontFace      = dvModifyFont (\st s -> st { _fontFace = s })
> dvGetFontUnderline = (liftM _fontUnderline) . dvGetFont
> dvSetFontUnderline = dvModifyFont (\st s -> st { _fontUnderline = s })
> dvGetTextColor     = (liftM (dvf_colour . dvs_fmt)) . dvGetState
> dvSetTextColor     = dvModifyFmt  (\st s -> st { dvf_colour = s })
> dvGetTextBgColor   = (liftM (dvf_bgcolour . dvs_fmt)) . dvGetState
> dvSetTextBgColor   = dvModifyFmt  (\st s -> st { dvf_bgcolour = s })

A digression into wxHaskell Layout

Eric Kow commented that it would be worthwhile to show the Layout version of the Diff control even though it doesn’t work correctly in this scenario (it works fine if the Layout is applied to an enclosing Frame instance).

Without further ado, here is the code for diffCtrl’ using Layout – you do not require the buildLayout function in this case at all. The Layout code is highlighted in red.

> diffViewer' p props =
>     do
>     let defaults   = [border := BorderStatic]
>     fn1 <- staticText p []
>     fn2 <- staticText p []
>     f1  <- window p []
>     f2  <- window p []
>     vsb <- scrollBarCreate p (-1) rectNull wxVERTICAL
>     hsb <- scrollBarCreate p (-1) rectNull wxHORIZONTAL
>     set f1 [ on paint := onPaint p DVorig f1 ]
>     set f2 [ on paint := onPaint p DVchanged f2 ]
>     let state  = DVS p fn1 fn2 f1 f2 vsb hsb Nothing dvf_default Map.empty
>         lay_fname w  = minsize (sz 400 (-1)) $ widget w
>         lay_diffp w  = minsize (sz 400 400)  $ fill $ widget w
>         lay_left     = column 5 [ lay_fname fn1, lay_diffp f1 ]
>         lay_right    = column 5 [ lay_fname fn1, lay_diffp f2 ]
>         layout'      = container p $ fill $ margin 5 $
>                            column 5 [ row 5 [ lay_left,
>                                               lay_right,
>                                               vfill $ widget vsb ],
>                                       hfill $ widget hsb ]
>     scrollBarSetEventHandler hsb (onScroll p hsb)
>     scrollBarSetEventHandler vsb (onScroll p vsb)
>     dvSetState p state
>     set p (defaults ++ props)
>     set p [layout := layout']
>     return p

To simplify explanation, I have split the layout into several components.

The first neat thing to notice is that constriction of layout is pure code – the transformation into sizers (which are bound the the IO monad) is done when the layout property is set on the owning DiffCtrl (Panel).Controls are specified by the widget (if they are ‘primitive’ widgets) and container (if they serve as containers for other widgets) combinators.

  • widget w tells the Layout system to insert a Window with identifier w in the appropriate location.
  • container p tells the Layout system that p is the container for the specified Layout. In the implementation, this means that Layout constructs a hierarchy of sizers which are owned by the container window.
  • minsize is a combinator which takes a Layout and gives it a minimum size. As an example, lay_fname w = minsize (sz 400 (-1)) $ widget w means insert the primitive control w and set a minimum width of 400 pixels (the -1 leaves the Layout to decide the best height).
  • row and column are combinators which lay out controls in rows and columns. In practice, this means that appropriate BoxSizer instances will be created into which the controls will be placed.
  • hfill, vfill and fill are combinators which request that the layout attempt to fill, either horizontally (hfill), vertically (vfill) or in both directions (fill) the available space. These are the combinators which prove problematic in our control in practice, and are the reason for defining the layout explicitly using Sizers.

The Layout will not become active until the layout Attribute has been set (set p [layout := layout’] in the code above). Setting the Layout in this way implicitly calls windowLayout and windowFit after the Sizers have been created.

Custom Controls in wxHaskell (part 2)

It may save you some typing to know that once this series is complete, I shall be publishing a Cabalized version of the Diff control on Hackage.

Subclassing the control

Witness types are used to represent the class hierarchy of the underlying wxWidgets library. The idea is that, for example, a Panel, which is a descendent of Window, can use all functions which accept a Window type.

Define diffViewer as a subclass of Window.

> type DiffViewer  a = Panel (CDiffViewer a)
> data CDiffViewer a = CDiffViewer

Creating the child windows

Create an instance of a diffViewer control.

In this case we create a panel as a child of the provided parent window, and set its style flags to indicate that the control will expand (horizontally and vertically) into the space allocated to it. We use the cast operator to convert the created panel and its properties into a DiffViewer related types. The cast operator is very dangerous, and should be used with great care (this is pretty much the only time you should need it in your wxHaskell life) – it operates essentially like the C cast operator!

> diffViewer :: Window a -> [Prop (DiffViewer ())] -> IO (DiffViewer ())
> diffViewer parent props =
>     do
>     p   <- panel parent [style := wxEXPAND]
>     let dv      = cast p
>         dvprops = castProps cast props
>     diffViewer' dv dvprops
>         where
>         cast :: Panel a -> DiffViewer ()
>         cast = objectCast

The diffViewer’ function does most of the work of creating and configuring the child windows in the control. These are all children of the panel, which is treated as the ‘owner’ of the control, and is the only window whose identity need be made visible outside of the control implementation.

A few things to note:

  • the diff output will be displayed on windows f1 and f2 – these use the Window type as we are going to take responsibility for painting this part of the control;
  • we create and manage scroll bars manually – this is because we wish to use the same scroll bars to scroll both of the windows containing diff information;
  • we are constructing a layout manually from sizers (call to buildLayout).
> diffViewer' p props =
>     do
>     fn1 <- staticText p [clientSize := sz 400 (-1)]
>     fn2 <- staticText p [clientSize := sz 400 (-1)]
>     f1  <- window p []
>     f2  <- window p []
>     vsb <- scrollBarCreate p (-1) rectNull wxVERTICAL
>     hsb <- scrollBarCreate p (-1) rectNull wxHORIZONTAL
>     set f1 [ on paint  := onPaint p DVorig f1 ]
>     set f2 [ on paint  := onPaint p DVchanged f2 ]
>     let state = DVS p fn1 fn2 f1 f2 vsb hsb Nothing dvf_default Map.empty
>         defaults = [border := BorderStatic]
>     scrollBarSetEventHandler hsb (onScroll p hsb)
>     scrollBarSetEventHandler vsb (onScroll p vsb)
>     dvSetState p state
>     set p (defaults ++ props)
>     buildLayout p fn1 fn2 f1 f2 vsb hsb
>     return p

Laying out the child windows

The wxHaskell layout implementation is buggy in some circumstances (it doesn’t seem to handle resizes as I would expect when window size exceeds minsize). Since we want the control to follow the size hints given by the owning application, we will use sizers to create a manual layout. In theory, wxHaskell layout should behave identically, but it doesn’t – that’s a bug to go and look for another day…

Since wxHaskell was originally designed to abstract the creation of sizers using layout, this code is rather low level, using functions from WXCore – you would be forgiven for thinking that it is just C++ implemented in Haskell, and that is essentially exactly what it is – most of the functions in WXCore are Haskell wrappers around the wxWidgets C++ API, which has the benefit that you can use the wxWidgets C++ API documentation to help to understand what most WXCore functions do.

The last two lines: the calls to windowLayout and windowFit are critical, and should be called before the application which uses the Diff control performs its own layout (they set the constraints for size which the application should respect when setting the size of its own windows).

> buildLayout p fn1 fn2 f1 f2 vsb hsb =
>     boxSizerCreate wxVERTICAL   >>= \p_sizer ->
>     boxSizerCreate wxHORIZONTAL >>= \h_sizer ->
>     boxSizerCreate wxVERTICAL   >>= \l_sizer ->
>     boxSizerCreate wxVERTICAL   >>= \r_sizer ->
>     sizerAddWindow l_sizer fn1     0 (wxALL .|. wxEXPAND) 5 nullPtr >>
>     sizerAddWindow l_sizer f1      1 wxEXPAND            10 nullPtr >>
>     sizerAddSizer  h_sizer l_sizer 1 wxEXPAND             5 nullPtr >>
>     sizerAddWindow r_sizer fn2     0 (wxALL .|. wxEXPAND) 5 nullPtr >>
>     sizerAddWindow r_sizer f2      1 wxEXPAND            10 nullPtr >>
>     sizerAddSizer  h_sizer r_sizer 1 wxEXPAND             5 nullPtr >>
>     sizerAddWindow h_sizer vsb     0 (wxALL .|. wxEXPAND) 5 nullPtr >>
>     sizerAddSizer  p_sizer h_sizer 1 wxEXPAND             5 nullPtr >>
>     sizerAddWindow p_sizer hsb     0 (wxALL .|. wxEXPAND) 5 nullPtr >>
>     windowSetSizer p p_sizer >>
>     windowLayout   p >>
>     windowFit      p

Scroll bars

In many cases, very little handling is required for scroll bars in wxHaskell since many of the common controls contain all the handling required for most purposes. However, as mentioned earlier, we are going to use a single set of control bars to control two client windows (one will contain the ‘original’ text and the other will contain the ‘updated’ text).

This code should serve as a simple example of custom scroll bar handling in wxHaskell.

Here we configure a custom event handler which provides the same handling for all scroll bar events. In more demanding applications (e.g. where the wxEVT_SCROLL_THUMBTRACK would cause too much processing to give smooth operation), you may want to do something a little different, perhaps by defining separate event handlers for different scroll bar events.

> scrollBarSetEventHandler window evtHandler =
>     windowOnEvent window events evtHandler (\evt -> evtHandler)
>         where
>           events = [ wxEVT_SCROLL_BOTTOM
>                    , wxEVT_SCROLL_LINEDOWN
>                    , wxEVT_SCROLL_LINEUP
>                    , wxEVT_SCROLL_PAGEDOWN
>                    , wxEVT_SCROLL_PAGEUP
>                    , wxEVT_SCROLL_THUMBRELEASE
>                    , wxEVT_SCROLL_THUMBTRACK
>                    , wxEVT_SCROLL_TOP ]

Define the ‘on scroll’ event handler for the scroll bars. In this case we can live with using the same event handler for both vertical and horizontal scroll bars as we will be updating the entire client area of the controlled windows on each scroll event (this is not too onerous, at least on my machine). This means that we just need to inform the parent window to refresh (i.e. repaint) the entire window next time the UI gets a chance to do so.

> onScroll dv _ =
>     windowRefresh dv True