> {-# LANGUAGE TypeSynonymInstances #-} Copyright (C) Jeremy O'Donoghue (jeremy.odonoghue@gmail.com) 2008-2010. All Rights Reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. The name of Jeremy O'Donoghue may not be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. Diff controls A simple diff control designed to show differences between two files. The control consists of the following components: /----------------------- panel -----------------------\ | /-- static text --\ /-- static text --\ | | \-----------------/ \-----------------/ | | /- window ------------\ /- window ------------\ /-\ | | | | | | | | | | | | | | | | | | | | | | | | | | \---------------------/ \---------------------/ \-/ | | /-------------------------------------------------\ | | | scroll bar | | | \-------------------------------------------------/ | \-----------------------------------------------------/ The diff text will be displayed in the panel areas, based on the output of a unified diff command (e.g. p4 diff2 -u) This generates output similar to the following (which has been cut down for clarity - it is therefore not accurate output) --- //depot/asic/sandbox/projects/WM7_rework/sources.inc 2009/04/23 19:29:40 +++ //depot/asic/sandbox/projects/VIRTIO_8650_APPS_2107/sources.inc 2009/07/09 06:55:53 @@ -120,12 +120,33 @@ WINCEOEM=1 WINCECPU=1 NOMIPS16CODE=1 -WARNISERROR=1 +!if "$(T_VIRTIO)" == "1" +WARNISERROR= +!else +WARNISERROR= +!endif DEPRECATE_UNSAFE_CRT=1 @@ -207,6 +228,13 @@ CDEFINES = $(CDEFINES) -Duldr !endif +!if "$(BSP_PANEL_MOUSE)" == "1" +CDEFINES = $(CDEFINES) -DFEATURE_PANEL_MOUSE +!endif + +!if "$(BSP_ROTATOR)" == "1" +CDEFINES = $(CDEFINES) -DFEATURE_ROTATOR +!endif Observations: +++ and --- identify the files being compared - indicates line deleted from sandbox which is present in source + indicates line added to source and not present in sandbox @@ -n1,m1 +n2,m2 @@ at line n1 in source, change m1 lines, at line n2 in sandbox, change m2 lines In the implementation, we show all lines prefixed with '+' in the right hand text box with a corresponding (maybe grey) blank line in the left hand box. Similarly, all lines prefixed with '-' are displayed in the left hand text box with a corresponding blank line in the right hand box. Lines with no prefix are shown on both sides, of course. Whenever we get a @@, we show an indication of the new position in each of the two files. In the case where a file is added or is not present in the source location, we show nothing at all. ================================================================================ > module Graphics.UI.WXContrib.WXDiffCtrl > ( diffViewer > , DiffViewer > , diffFiles > , diffFn > , font > , fontSize > , fontWeight > , fontFamily > , fontShape > , fontFace > , fontUnderline > , textBgcolor > , textColor > ) > where > > import Control.Monad (liftM) > import Data.Bits ((.|.)) > import qualified Data.Map as Map > import qualified Data.HashTable as Hash > import Data.List (replicate, foldl') > import Data.Maybe (fromJust) > import Foreign.Ptr (nullPtr) > import Graphics.UI.WX > import Graphics.UI.WXCore > import System.IO.Unsafe (unsafePerformIO) > import Graphics.UI.WXContrib.WXFontMetrics Define diffViewer as a subclass of Window. CDiffViewer is used as a witness type to assist in type safe casting. > type DiffViewer a = Panel (CDiffViewer a) > data CDiffViewer a = CDiffViewer Create an instance of a diffViewer control. In this case we create a panel as a child of the provided parent window. > 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 common control creation function. This creates the control inside a provided panel. > 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 The wxHaskell layout implementation is buggy in some circumstances (doesn't handle resizes as I would expect when window size exceeds minsize). Therefore, we create layout by hand. > 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 Connect event handlers for scroll bars. These require special handling because: a) wxHaskell does not have much special handling for ScrollBar instances which are not owned/controlled automatically by parent windows. 2) The required behaviour is pretty special anyway! Here we configure an event handler for all scroll 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 ] We respond to all scroll events. There is no difference in behaviour between the horizontal and vertical scroll bars - we just cause window to refresh on each event. > onScroll dv _ = > windowRefresh dv True ================================================================================ Execute diff command Execute the diff function and populate the map containing the diff strings, updating the state after execution and performing a display update. There is an underlying assumption that the filenames of the two files on which diff function will execute have been set. This is most easily guaranteed by calling 'runDiff' via 'whenDifflegal' Diff text is stored as a Map, keyed on line number. Maps offer an efficient mechanism for access to data, and should perform well even for large data sets (O(log n) insert, O(n) to fetch all keys, O(log n) lookup). Once created, the map is updated in the control global state. The window is refreshed here as the existing contents will clearly be invalidated by the diff operation. > runDiff win diff_fn orig update st = > diff_fn orig update >>= \strings -> > let map = Map.empty > diffs = parseDiffLines strings > map' = foldl' (\m (v, k) -> Map.insert k v m) map $ zip diffs [0..] > st' = st { dvs_txt = map' } in > dvSetState win st' >> > setVirtualCanvas win >> > windowRefresh win True There are two cases in which it is legitimate to execute the diff function: a) The files to be diffed change. In this case, runDiff is called from dvSetFiles, if and only if a diff function is also configured. b) The diff function changes. In this case runDiff is called from dvSetDiffFn (which is an inner function of the diffFn attribute. > whenDiffLegal win diff_runner = > dvGetState win >>= \st@(DVS _ fn1 fn2 _ _ _ _ may_diff _ _) -> > get fn1 text >>= \orig -> > get fn2 text >>= \update -> > if (length orig /= 0) && (length update /= 0) > then > case may_diff of > Just diff_fn -> diff_runner win diff_fn orig update st > Nothing -> return () > else > return () ================================================================================ Window Painting Most of the windows in the control can use their default paint functions, but the two viewports for outputting diff information are custom controls based on a Window type. These require special handling. The behaviour is slightly different here 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 On entry, win is the viewport window, DC is a suitable device context and the rectangle which needs to be updated are provided. > 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 Determine the viewable text, i.e. the text which should be displayed in the viewport we have opened on the virtual canvas. This is basically a question of working out the row and column at which to start display, and the row and column at which we finish display. Because the first few characters of the line contain characters which provide information about the nature of the diff information, we cannot actually truncate the lines to only the required text, and must instead provide this information back to the final renderer. We do this in a data structure. > 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 Fetching the displayable text has a minor complication: some lines in the diff hunk are not displayed in the diff windows (notably filenames and file location information - see the definition of countDiffLines). 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. The key values on the viewport text extend are: - the 'y' position tells us the first line to render of the displayable lines. This is dependent on the position of the vertical scroll bar, and is accounted for in calcViewporttextExtent; - the 'h' parameter tells us how many lines we need to render. > getDisplayableText win = > calcViewportTextExtent win >>= \r@(Rect x y w _) -> > dvGetState win >>= \(DVS _ _ _ _ _ _ _ _ _ map) -> > let keys' = drop y $ Map.keys map > (_, diff_lines) = foldl' (selectLines r map) (0,[]) keys' > disp_diff = RI (reverse diff_lines) x w in > return disp_diff Select lines which will be displayed on the viewport. Condition is: - 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. Note that it is legitimate to use fromJust on the output of Map.lookup because we have fetched keys in the map, and it cannot be modified during the execution of this function, so each lookup must succeed by definition. > selectLines :: Rect -> Map.Map Int DiffLine -> (Int, [DiffLine]) -> Int -> (Int, [DiffLine]) > selectLines (Rect _ y _ h) map acc@(disp_line_no, strs) key > | (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 > where > (DiffLine typ str) = fromJust $ Map.lookup key map Displayable returns True if a line is displayable in a viewport. > displayable AddLine = True > displayable DeleteLine = True > displayable CommonLine = True > displayable _ = False Render text in the selected font and colour scheme to the viewport windows. The renderDiff function is responsible for creating device contexts on which the rendering takes place and passes the actual rendering of text off to specific functions which perform the formatting for the relevant line type. The displayable text is determined in disp_txt. This takes the displayable text lines and removes the characters which need not be rendered to the viewport (basically drops undisplayed characters from the start and end of each line) When clipping the text to be displayed, we retain the first character from the diff text as this indicates which renderer to use. > 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 -- fst_col * (x_max + el) > 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)) Render a single line, selecting the appropriate renderer. > renderLine file_type (DiffLine t str) point dc = > (getRenderer t) file_type str point dc Determine which renderer function to use > getRenderer OrigFileLine = nullRenderer > getRenderer ChangeFileLine = nullRenderer > getRenderer RangeLine = nullRenderer > getRenderer AddLine = addRenderer > getRenderer DeleteLine = delRenderer > getRenderer CommonLine = ctxtRenderer > getRenderer _ = nullRenderer Indicate what diff hunk information is contained on a line: > data DiffLineType = CommonLine > | AddLine > | DeleteLine > | RangeLine > | OrigFileLine > | ChangeFileLine > | UnknownLine > deriving (Eq, Show) Determine the type of information represented in a diff line > getDiffLineType :: String -> DiffLineType > getDiffLineType ('-':'-':'-':_) = OrigFileLine > getDiffLineType ('+':'+':'+':_) = ChangeFileLine > getDiffLineType ('@':'@':_) = RangeLine > getDiffLineType ('+':_) = AddLine > getDiffLineType ('-':_) = DeleteLine > getDiffLineType (' ':_) = CommonLine > getDiffLineType _ = UnknownLine 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 DiffLines 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) Render Add line. This is presently configured to print added text in green. > 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 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 ================================================================================ State management The underlying wxWidgets library is highly stateful and there is no straightforward way to asbstract this, short of maintaining the whole GUI within a state monad. 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 control ID (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). Notice that the diff function and the formatting on each line are '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 stored in a separate structure, to keep things manageable. > 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. > 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 > } We maintain control state in a hash table. It is essential that this is not inlined. > {-# noinline dv_states #-} > dv_states :: Hash.HashTable Int DiffViewerState > dv_states = unsafePerformIO $ Hash.new (==) (fromIntegral) We provide functions to fetch and update the state of a given DiffViewer > 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. > dvModifyState fn w s = > dvGetState w >>= \dvs -> > let dvs' = fn dvs s in > dvSetState w dvs' ================================================================================ 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. Notice also that the diff function may be executed when the diffFn attribute is set. > 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. > 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 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 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 are 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 }) ================================================================================ Display contents of the diff boxes... The number of lines of diff information can be calculated as follows: - Any '---' and '+++' lines are ignored - Any '@@' lines are ignored - Lines starting ' ', '-' or '+' are displayable lines - Blank lines are displayable (a horizontal line) > countDiffLines map = Map.fold countDiffLines' 0 map > where > countDiffLines' (DiffLine typ _) acc | displayable typ = acc + 1 > | otherwise = acc Based on the fontmetrics for a device context on one of the file display windows (they are both the same in this respect), we can work out the size of a virtual window which would contain the entire diff text. 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 bars so that they range over the virtual canvas correctly. > 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 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). This is a key input into the calculation of the virtual canvas size. > 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 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). > 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 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. > 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 > return textExtent 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 updated to 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 ================================================================================ Colours We use 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