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
Colours
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
A rock to wind a piece of string around 