Sophie

Sophie

distrib > Fedora > 16 > i386 > by-pkgid > 420a649e6f65db30aa7451f64d08ff92 > files > 1026

ghc-xmonad-contrib-devel-0.9.2-4.fc16.i686.rpm

<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html>
<head>
<!-- Generated by HsColour, http://code.haskell.org/~malcolm/hscolour/ -->
<title>XMonad/Hooks/ManageDocks.hs</title>
<link type='text/css' rel='stylesheet' href='hscolour.css' />
</head>
<body>
<pre><a name="line-1"></a><span class='hs-comment'>{-# LANGUAGE PatternGuards, FlexibleInstances, MultiParamTypeClasses #-}</span>
<a name="line-2"></a><span class='hs-comment'>{-# OPTIONS -fglasgow-exts #-}</span>
<a name="line-3"></a><span class='hs-comment'>-- deriving Typeable for ghc-6.6 compatibility, which is retained in the core</span>
<a name="line-4"></a><span class='hs-comment'>-----------------------------------------------------------------------------</span>
<a name="line-5"></a><span class='hs-comment'>-- |</span>
<a name="line-6"></a><span class='hs-comment'>-- Module       : XMonad.Hooks.ManageDocks</span>
<a name="line-7"></a><span class='hs-comment'>-- Copyright    : (c) Joachim Breitner &lt;mail@joachim-breitner.de&gt;</span>
<a name="line-8"></a><span class='hs-comment'>-- License      : BSD</span>
<a name="line-9"></a><span class='hs-comment'>--</span>
<a name="line-10"></a><span class='hs-comment'>-- Maintainer   : Joachim Breitner &lt;mail@joachim-breitner.de&gt;</span>
<a name="line-11"></a><span class='hs-comment'>-- Stability    : unstable</span>
<a name="line-12"></a><span class='hs-comment'>-- Portability  : unportable</span>
<a name="line-13"></a><span class='hs-comment'>--</span>
<a name="line-14"></a><span class='hs-comment'>-- This module provides tools to automatically manage 'dock' type programs,</span>
<a name="line-15"></a><span class='hs-comment'>-- such as gnome-panel, kicker, dzen, and xmobar.</span>
<a name="line-16"></a>
<a name="line-17"></a><span class='hs-keyword'>module</span> <span class='hs-conid'>XMonad</span><span class='hs-varop'>.</span><span class='hs-conid'>Hooks</span><span class='hs-varop'>.</span><span class='hs-conid'>ManageDocks</span> <span class='hs-layout'>(</span>
<a name="line-18"></a>    <span class='hs-comment'>-- * Usage</span>
<a name="line-19"></a>    <span class='hs-comment'>-- $usage</span>
<a name="line-20"></a>    <span class='hs-varid'>manageDocks</span><span class='hs-layout'>,</span> <span class='hs-varid'>checkDock</span><span class='hs-layout'>,</span> <span class='hs-conid'>AvoidStruts</span><span class='hs-layout'>,</span> <span class='hs-varid'>avoidStruts</span><span class='hs-layout'>,</span> <span class='hs-varid'>avoidStrutsOn</span><span class='hs-layout'>,</span>
<a name="line-21"></a>    <span class='hs-conid'>ToggleStruts</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span>
<a name="line-22"></a>    <span class='hs-conid'>SetStruts</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span>
<a name="line-23"></a>    <span class='hs-keyword'>module</span> <span class='hs-conid'>XMonad</span><span class='hs-varop'>.</span><span class='hs-conid'>Util</span><span class='hs-varop'>.</span><span class='hs-conid'>Types</span><span class='hs-layout'>,</span>
<a name="line-24"></a>
<a name="line-25"></a>    <span class='hs-comment'>-- for XMonad.Actions.FloatSnap</span>
<a name="line-26"></a>    <span class='hs-varid'>calcGap</span>
<a name="line-27"></a>    <span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-28"></a>
<a name="line-29"></a>
<a name="line-30"></a><span class='hs-comment'>-----------------------------------------------------------------------------</span>
<a name="line-31"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>XMonad</span>
<a name="line-32"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Foreign</span><span class='hs-varop'>.</span><span class='hs-conid'>C</span><span class='hs-varop'>.</span><span class='hs-conid'>Types</span> <span class='hs-layout'>(</span><span class='hs-conid'>CLong</span><span class='hs-layout'>)</span>
<a name="line-33"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span>
<a name="line-34"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>XMonad</span><span class='hs-varop'>.</span><span class='hs-conid'>Layout</span><span class='hs-varop'>.</span><span class='hs-conid'>LayoutModifier</span>
<a name="line-35"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>XMonad</span><span class='hs-varop'>.</span><span class='hs-conid'>Util</span><span class='hs-varop'>.</span><span class='hs-conid'>Types</span>
<a name="line-36"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>XMonad</span><span class='hs-varop'>.</span><span class='hs-conid'>Util</span><span class='hs-varop'>.</span><span class='hs-conid'>WindowProperties</span> <span class='hs-layout'>(</span><span class='hs-varid'>getProp32s</span><span class='hs-layout'>)</span>
<a name="line-37"></a>
<a name="line-38"></a><span class='hs-keyword'>import</span> <span class='hs-keyword'>qualified</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Set</span> <span class='hs-keyword'>as</span> <span class='hs-conid'>S</span>
<a name="line-39"></a>
<a name="line-40"></a><span class='hs-comment'>-- $usage</span>
<a name="line-41"></a><span class='hs-comment'>-- To use this module, add the following import to @~\/.xmonad\/xmonad.hs@:</span>
<a name="line-42"></a><span class='hs-comment'>--</span>
<a name="line-43"></a><span class='hs-comment'>-- &gt; import XMonad.Hooks.ManageDocks</span>
<a name="line-44"></a><span class='hs-comment'>--</span>
<a name="line-45"></a><span class='hs-comment'>-- The first component is a 'ManageHook' which recognizes these</span>
<a name="line-46"></a><span class='hs-comment'>-- windows and de-manages them, so that xmonad does not try to tile</span>
<a name="line-47"></a><span class='hs-comment'>-- them.  To enable it:</span>
<a name="line-48"></a><span class='hs-comment'>--</span>
<a name="line-49"></a><span class='hs-comment'>-- &gt; manageHook = ... &lt;+&gt; manageDocks</span>
<a name="line-50"></a><span class='hs-comment'>--</span>
<a name="line-51"></a><span class='hs-comment'>-- The second component is a layout modifier that prevents windows</span>
<a name="line-52"></a><span class='hs-comment'>-- from overlapping these dock windows.  It is intended to replace</span>
<a name="line-53"></a><span class='hs-comment'>-- xmonad's so-called \"gap\" support.  First, you must add it to your</span>
<a name="line-54"></a><span class='hs-comment'>-- list of layouts:</span>
<a name="line-55"></a><span class='hs-comment'>--</span>
<a name="line-56"></a><span class='hs-comment'>-- &gt; layoutHook = avoidStruts (tall ||| mirror tall ||| ...)</span>
<a name="line-57"></a><span class='hs-comment'>-- &gt;                   where  tall = Tall 1 (3/100) (1/2)</span>
<a name="line-58"></a><span class='hs-comment'>--</span>
<a name="line-59"></a><span class='hs-comment'>-- 'AvoidStruts' also supports toggling the dock gaps; add a keybinding</span>
<a name="line-60"></a><span class='hs-comment'>-- similar to:</span>
<a name="line-61"></a><span class='hs-comment'>--</span>
<a name="line-62"></a><span class='hs-comment'>-- &gt; ,((modm, xK_b     ), sendMessage ToggleStruts)</span>
<a name="line-63"></a><span class='hs-comment'>--</span>
<a name="line-64"></a><span class='hs-comment'>-- If you have multiple docks, you can toggle their gaps individually.</span>
<a name="line-65"></a><span class='hs-comment'>-- For example, to toggle only the top gap:</span>
<a name="line-66"></a><span class='hs-comment'>--</span>
<a name="line-67"></a><span class='hs-comment'>-- &gt; ,((modm .|. controlMask, xK_t), sendMessage $ ToggleStrut U)</span>
<a name="line-68"></a><span class='hs-comment'>--</span>
<a name="line-69"></a><span class='hs-comment'>-- Similarly, you can use 'D', 'L', and 'R' to individually toggle</span>
<a name="line-70"></a><span class='hs-comment'>-- gaps on the bottom, left, or right.</span>
<a name="line-71"></a><span class='hs-comment'>--</span>
<a name="line-72"></a><span class='hs-comment'>-- If you want certain docks to be avoided but others to be covered by</span>
<a name="line-73"></a><span class='hs-comment'>-- default, you can manually specify the sides of the screen on which</span>
<a name="line-74"></a><span class='hs-comment'>-- docks should be avoided, using 'avoidStrutsOn'.  For example:</span>
<a name="line-75"></a><span class='hs-comment'>--</span>
<a name="line-76"></a><span class='hs-comment'>-- &gt; layoutHook = avoidStrutsOn [U,L] (tall ||| mirror tall ||| ...)</span>
<a name="line-77"></a><span class='hs-comment'>--</span>
<a name="line-78"></a><span class='hs-comment'>-- /Important note/: if you are switching from manual gaps</span>
<a name="line-79"></a><span class='hs-comment'>-- (defaultGaps in your config) to avoidStruts (recommended, since</span>
<a name="line-80"></a><span class='hs-comment'>-- manual gaps will probably be phased out soon), be sure to switch</span>
<a name="line-81"></a><span class='hs-comment'>-- off all your gaps (with mod-b) /before/ reloading your config with</span>
<a name="line-82"></a><span class='hs-comment'>-- avoidStruts!  Toggling struts with a 'ToggleStruts' message will</span>
<a name="line-83"></a><span class='hs-comment'>-- not work unless your gaps are set to zero.</span>
<a name="line-84"></a><span class='hs-comment'>--</span>
<a name="line-85"></a><span class='hs-comment'>-- For detailed instructions on editing your key bindings, see</span>
<a name="line-86"></a><span class='hs-comment'>-- "XMonad.Doc.Extending#Editing_key_bindings".</span>
<a name="line-87"></a><span class='hs-comment'>--</span>
<a name="line-88"></a>
<a name="line-89"></a><a name="manageDocks"></a><span class='hs-comment'>-- | Detects if the given window is of type DOCK and if so, reveals</span>
<a name="line-90"></a><span class='hs-comment'>--   it, but does not manage it. If the window has the STRUT property</span>
<a name="line-91"></a><span class='hs-comment'>--   set, adjust the gap accordingly.</span>
<a name="line-92"></a><span class='hs-definition'>manageDocks</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>ManageHook</span>
<a name="line-93"></a><span class='hs-definition'>manageDocks</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>checkDock</span> <span class='hs-varop'>--&gt;</span> <span class='hs-varid'>doIgnore</span>
<a name="line-94"></a>
<a name="line-95"></a><a name="checkDock"></a><span class='hs-comment'>-- | Checks if a window is a DOCK or DESKTOP window</span>
<a name="line-96"></a><span class='hs-definition'>checkDock</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Query</span> <span class='hs-conid'>Bool</span>
<a name="line-97"></a><span class='hs-definition'>checkDock</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ask</span> <span class='hs-varop'>&gt;&gt;=</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>w</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>liftX</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>do</span>
<a name="line-98"></a>    <span class='hs-varid'>dock</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>getAtom</span> <span class='hs-str'>"_NET_WM_WINDOW_TYPE_DOCK"</span>
<a name="line-99"></a>    <span class='hs-varid'>desk</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>getAtom</span> <span class='hs-str'>"_NET_WM_WINDOW_TYPE_DESKTOP"</span>
<a name="line-100"></a>    <span class='hs-varid'>mbr</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>getProp32s</span> <span class='hs-str'>"_NET_WM_WINDOW_TYPE"</span> <span class='hs-varid'>w</span>
<a name="line-101"></a>    <span class='hs-keyword'>case</span> <span class='hs-varid'>mbr</span> <span class='hs-keyword'>of</span>
<a name="line-102"></a>        <span class='hs-conid'>Just</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>r</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-varid'>elem</span> <span class='hs-layout'>(</span><span class='hs-varid'>fromIntegral</span> <span class='hs-varid'>r</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>dock</span><span class='hs-layout'>,</span> <span class='hs-varid'>desk</span><span class='hs-keyglyph'>]</span>
<a name="line-103"></a>        <span class='hs-keyword'>_</span>        <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>return</span> <span class='hs-conid'>False</span>
<a name="line-104"></a>
<a name="line-105"></a><a name="getStrut"></a><span class='hs-comment'>-- | Gets the STRUT config, if present, in xmonad gap order</span>
<a name="line-106"></a><span class='hs-definition'>getStrut</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Window</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>X</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Strut</span><span class='hs-keyglyph'>]</span>
<a name="line-107"></a><span class='hs-definition'>getStrut</span> <span class='hs-varid'>w</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-108"></a>    <span class='hs-varid'>msp</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>getProp32s</span> <span class='hs-str'>"_NET_WM_STRUT_PARTIAL"</span> <span class='hs-varid'>w</span>
<a name="line-109"></a>    <span class='hs-keyword'>case</span> <span class='hs-varid'>msp</span> <span class='hs-keyword'>of</span>
<a name="line-110"></a>        <span class='hs-conid'>Just</span> <span class='hs-varid'>sp</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-varid'>parseStrutPartial</span> <span class='hs-varid'>sp</span>
<a name="line-111"></a>        <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>fmap</span> <span class='hs-layout'>(</span><span class='hs-varid'>maybe</span> <span class='hs-conid'>[]</span> <span class='hs-varid'>parseStrut</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span> <span class='hs-varid'>getProp32s</span> <span class='hs-str'>"_NET_WM_STRUT"</span> <span class='hs-varid'>w</span>
<a name="line-112"></a> <span class='hs-keyword'>where</span>
<a name="line-113"></a>    <span class='hs-varid'>parseStrut</span> <span class='hs-varid'>xs</span><span class='hs-keyglyph'>@</span><span class='hs-keyglyph'>[</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>parseStrutPartial</span> <span class='hs-varop'>.</span> <span class='hs-varid'>take</span> <span class='hs-num'>12</span> <span class='hs-varop'>$</span> <span class='hs-varid'>xs</span> <span class='hs-varop'>++</span> <span class='hs-varid'>cycle</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>minBound</span><span class='hs-layout'>,</span> <span class='hs-varid'>maxBound</span><span class='hs-keyglyph'>]</span>
<a name="line-114"></a>    <span class='hs-varid'>parseStrut</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>[]</span>
<a name="line-115"></a>
<a name="line-116"></a>    <span class='hs-varid'>parseStrutPartial</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>l</span><span class='hs-layout'>,</span> <span class='hs-varid'>r</span><span class='hs-layout'>,</span> <span class='hs-varid'>t</span><span class='hs-layout'>,</span> <span class='hs-varid'>b</span><span class='hs-layout'>,</span> <span class='hs-varid'>ly1</span><span class='hs-layout'>,</span> <span class='hs-varid'>ly2</span><span class='hs-layout'>,</span> <span class='hs-varid'>ry1</span><span class='hs-layout'>,</span> <span class='hs-varid'>ry2</span><span class='hs-layout'>,</span> <span class='hs-varid'>tx1</span><span class='hs-layout'>,</span> <span class='hs-varid'>tx2</span><span class='hs-layout'>,</span> <span class='hs-varid'>bx1</span><span class='hs-layout'>,</span> <span class='hs-varid'>bx2</span><span class='hs-keyglyph'>]</span>
<a name="line-117"></a>     <span class='hs-keyglyph'>=</span> <span class='hs-varid'>filter</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-varid'>n</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>n</span> <span class='hs-varop'>/=</span> <span class='hs-num'>0</span><span class='hs-layout'>)</span>
<a name="line-118"></a>        <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-conid'>L</span><span class='hs-layout'>,</span> <span class='hs-varid'>l</span><span class='hs-layout'>,</span> <span class='hs-varid'>ly1</span><span class='hs-layout'>,</span> <span class='hs-varid'>ly2</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-layout'>(</span><span class='hs-conid'>R</span><span class='hs-layout'>,</span> <span class='hs-varid'>r</span><span class='hs-layout'>,</span> <span class='hs-varid'>ry1</span><span class='hs-layout'>,</span> <span class='hs-varid'>ry2</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-layout'>(</span><span class='hs-conid'>U</span><span class='hs-layout'>,</span> <span class='hs-varid'>t</span><span class='hs-layout'>,</span> <span class='hs-varid'>tx1</span><span class='hs-layout'>,</span> <span class='hs-varid'>tx2</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-layout'>(</span><span class='hs-conid'>D</span><span class='hs-layout'>,</span> <span class='hs-varid'>b</span><span class='hs-layout'>,</span> <span class='hs-varid'>bx1</span><span class='hs-layout'>,</span> <span class='hs-varid'>bx2</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-119"></a>    <span class='hs-varid'>parseStrutPartial</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>[]</span>
<a name="line-120"></a>
<a name="line-121"></a><a name="calcGap"></a><span class='hs-comment'>-- | Goes through the list of windows and find the gap so that all</span>
<a name="line-122"></a><span class='hs-comment'>--   STRUT settings are satisfied.</span>
<a name="line-123"></a><span class='hs-definition'>calcGap</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>S</span><span class='hs-varop'>.</span><span class='hs-conid'>Set</span> <span class='hs-conid'>Direction2D</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>X</span> <span class='hs-layout'>(</span><span class='hs-conid'>Rectangle</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Rectangle</span><span class='hs-layout'>)</span>
<a name="line-124"></a><span class='hs-definition'>calcGap</span> <span class='hs-varid'>ss</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>withDisplay</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>dpy</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-keyword'>do</span>
<a name="line-125"></a>    <span class='hs-varid'>rootw</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>asks</span> <span class='hs-varid'>theRoot</span>
<a name="line-126"></a>    <span class='hs-comment'>-- We don't keep track of dock like windows, so we find all of them here</span>
<a name="line-127"></a>    <span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-varid'>wins</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>io</span> <span class='hs-varop'>$</span> <span class='hs-varid'>queryTree</span> <span class='hs-varid'>dpy</span> <span class='hs-varid'>rootw</span>
<a name="line-128"></a>    <span class='hs-varid'>struts</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-layout'>(</span><span class='hs-varid'>filter</span> <span class='hs-varid'>careAbout</span> <span class='hs-varop'>.</span> <span class='hs-varid'>concat</span><span class='hs-layout'>)</span> <span class='hs-varop'>`fmap`</span> <span class='hs-varid'>mapM</span> <span class='hs-varid'>getStrut</span> <span class='hs-varid'>wins</span>
<a name="line-129"></a>
<a name="line-130"></a>    <span class='hs-comment'>-- we grab the window attributes of the root window rather than checking</span>
<a name="line-131"></a>    <span class='hs-comment'>-- the width of the screen because xlib caches this info and it tends to</span>
<a name="line-132"></a>    <span class='hs-comment'>-- be incorrect after RAndR</span>
<a name="line-133"></a>    <span class='hs-varid'>wa</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>io</span> <span class='hs-varop'>$</span> <span class='hs-varid'>getWindowAttributes</span> <span class='hs-varid'>dpy</span> <span class='hs-varid'>rootw</span>
<a name="line-134"></a>    <span class='hs-keyword'>let</span> <span class='hs-varid'>screen</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>r2c</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Rectangle</span> <span class='hs-layout'>(</span><span class='hs-varid'>fi</span> <span class='hs-varop'>$</span> <span class='hs-varid'>wa_x</span> <span class='hs-varid'>wa</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>fi</span> <span class='hs-varop'>$</span> <span class='hs-varid'>wa_y</span> <span class='hs-varid'>wa</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>fi</span> <span class='hs-varop'>$</span> <span class='hs-varid'>wa_width</span> <span class='hs-varid'>wa</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>fi</span> <span class='hs-varop'>$</span> <span class='hs-varid'>wa_height</span> <span class='hs-varid'>wa</span><span class='hs-layout'>)</span>
<a name="line-135"></a>    <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>r</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>c2r</span> <span class='hs-varop'>$</span> <span class='hs-varid'>foldr</span> <span class='hs-layout'>(</span><span class='hs-varid'>reduce</span> <span class='hs-varid'>screen</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>r2c</span> <span class='hs-varid'>r</span><span class='hs-layout'>)</span> <span class='hs-varid'>struts</span>
<a name="line-136"></a>  <span class='hs-keyword'>where</span> <span class='hs-varid'>careAbout</span> <span class='hs-layout'>(</span><span class='hs-varid'>s</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>s</span> <span class='hs-varop'>`</span><span class='hs-conid'>S</span><span class='hs-varop'>.</span><span class='hs-varid'>member</span><span class='hs-varop'>`</span> <span class='hs-varid'>ss</span>
<a name="line-137"></a>
<a name="line-138"></a><a name="avoidStruts"></a><span class='hs-comment'>-- | Adjust layout automagically: don't cover up any docks, status</span>
<a name="line-139"></a><span class='hs-comment'>--   bars, etc.</span>
<a name="line-140"></a><span class='hs-definition'>avoidStruts</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>LayoutClass</span> <span class='hs-varid'>l</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>=&gt;</span> <span class='hs-varid'>l</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>ModifiedLayout</span> <span class='hs-conid'>AvoidStruts</span> <span class='hs-varid'>l</span> <span class='hs-varid'>a</span>
<a name="line-141"></a><span class='hs-definition'>avoidStruts</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>avoidStrutsOn</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>U</span><span class='hs-layout'>,</span><span class='hs-conid'>D</span><span class='hs-layout'>,</span><span class='hs-conid'>L</span><span class='hs-layout'>,</span><span class='hs-conid'>R</span><span class='hs-keyglyph'>]</span>
<a name="line-142"></a>
<a name="line-143"></a><a name="avoidStrutsOn"></a><span class='hs-comment'>-- | Adjust layout automagically: don't cover up docks, status bars,</span>
<a name="line-144"></a><span class='hs-comment'>--   etc. on the indicated sides of the screen.  Valid sides are U</span>
<a name="line-145"></a><span class='hs-comment'>--   (top), D (bottom), R (right), or L (left).</span>
<a name="line-146"></a><span class='hs-definition'>avoidStrutsOn</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>LayoutClass</span> <span class='hs-varid'>l</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>=&gt;</span>
<a name="line-147"></a>                 <span class='hs-keyglyph'>[</span><span class='hs-conid'>Direction2D</span><span class='hs-keyglyph'>]</span>
<a name="line-148"></a>              <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>l</span> <span class='hs-varid'>a</span>
<a name="line-149"></a>              <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>ModifiedLayout</span> <span class='hs-conid'>AvoidStruts</span> <span class='hs-varid'>l</span> <span class='hs-varid'>a</span>
<a name="line-150"></a><span class='hs-definition'>avoidStrutsOn</span> <span class='hs-varid'>ss</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>ModifiedLayout</span> <span class='hs-varop'>$</span> <span class='hs-conid'>AvoidStruts</span> <span class='hs-varop'>$</span> <span class='hs-conid'>S</span><span class='hs-varop'>.</span><span class='hs-varid'>fromList</span> <span class='hs-varid'>ss</span>
<a name="line-151"></a>
<a name="line-152"></a><a name="AvoidStruts"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>AvoidStruts</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>AvoidStruts</span> <span class='hs-layout'>(</span><span class='hs-conid'>S</span><span class='hs-varop'>.</span><span class='hs-conid'>Set</span> <span class='hs-conid'>Direction2D</span><span class='hs-layout'>)</span> <span class='hs-keyword'>deriving</span> <span class='hs-layout'>(</span> <span class='hs-conid'>Read</span><span class='hs-layout'>,</span> <span class='hs-conid'>Show</span> <span class='hs-layout'>)</span>
<a name="line-153"></a>
<a name="line-154"></a><a name="ToggleStruts"></a><span class='hs-comment'>-- | Message type which can be sent to an 'AvoidStruts' layout</span>
<a name="line-155"></a><a name="ToggleStruts"></a><span class='hs-comment'>--   modifier to alter its behavior.</span>
<a name="line-156"></a><a name="ToggleStruts"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>ToggleStruts</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>ToggleStruts</span>
<a name="line-157"></a>                  <span class='hs-keyglyph'>|</span> <span class='hs-conid'>ToggleStrut</span> <span class='hs-conid'>Direction2D</span>
<a name="line-158"></a>  <span class='hs-keyword'>deriving</span> <span class='hs-layout'>(</span><span class='hs-conid'>Read</span><span class='hs-layout'>,</span><span class='hs-conid'>Show</span><span class='hs-layout'>,</span><span class='hs-conid'>Typeable</span><span class='hs-layout'>)</span>
<a name="line-159"></a>
<a name="line-160"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>Message</span> <span class='hs-conid'>ToggleStruts</span>
<a name="line-161"></a>
<a name="line-162"></a><a name="SetStruts"></a><span class='hs-comment'>-- | SetStruts is a message constructor used to set or unset specific struts,</span>
<a name="line-163"></a><a name="SetStruts"></a><span class='hs-comment'>-- regardless of whether or not the struts were originally set. Here are some</span>
<a name="line-164"></a><a name="SetStruts"></a><span class='hs-comment'>-- example bindings:</span>
<a name="line-165"></a><a name="SetStruts"></a><span class='hs-comment'>--</span>
<a name="line-166"></a><a name="SetStruts"></a><span class='hs-comment'>-- Show all gaps:</span>
<a name="line-167"></a><a name="SetStruts"></a><span class='hs-comment'>--</span>
<a name="line-168"></a><a name="SetStruts"></a><span class='hs-comment'>-- &gt;   ,((modm .|. shiftMask  ,xK_b),sendMessage $ SetStruts [minBound .. maxBound] [])</span>
<a name="line-169"></a><a name="SetStruts"></a><span class='hs-comment'>--</span>
<a name="line-170"></a><a name="SetStruts"></a><span class='hs-comment'>-- Hide all gaps:</span>
<a name="line-171"></a><a name="SetStruts"></a><span class='hs-comment'>--</span>
<a name="line-172"></a><a name="SetStruts"></a><span class='hs-comment'>-- &gt;   ,((modm .|. controlMask,xK_b),sendMessage $ SetStruts [] [minBound .. maxBound])</span>
<a name="line-173"></a><a name="SetStruts"></a><span class='hs-comment'>--</span>
<a name="line-174"></a><a name="SetStruts"></a><span class='hs-comment'>-- Show only upper and left gaps:</span>
<a name="line-175"></a><a name="SetStruts"></a><span class='hs-comment'>--</span>
<a name="line-176"></a><a name="SetStruts"></a><span class='hs-comment'>-- &gt;   ,((modm .|. controlMask .|. shiftMask,xK_b),sendMessage $ SetStruts [U,L] [minBound .. maxBound])</span>
<a name="line-177"></a><a name="SetStruts"></a><span class='hs-comment'>--</span>
<a name="line-178"></a><a name="SetStruts"></a><span class='hs-comment'>-- Hide the bottom keeping whatever the other values were:</span>
<a name="line-179"></a><a name="SetStruts"></a><span class='hs-comment'>--</span>
<a name="line-180"></a><a name="SetStruts"></a><span class='hs-comment'>-- &gt;   ,((modm .|. controlMask .|. shiftMask,xK_g),sendMessage $ SetStruts [] [D])</span>
<a name="line-181"></a><a name="SetStruts"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>SetStruts</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>SetStruts</span> <span class='hs-layout'>{</span> <span class='hs-varid'>addedStruts</span>   <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Direction2D</span><span class='hs-keyglyph'>]</span>
<a name="line-182"></a>                           <span class='hs-layout'>,</span> <span class='hs-varid'>removedStruts</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Direction2D</span><span class='hs-keyglyph'>]</span> <span class='hs-comment'>-- ^ These are removed from the currently set struts before 'addedStruts' are added.</span>
<a name="line-183"></a>                           <span class='hs-layout'>}</span>
<a name="line-184"></a>  <span class='hs-keyword'>deriving</span> <span class='hs-layout'>(</span><span class='hs-conid'>Read</span><span class='hs-layout'>,</span><span class='hs-conid'>Show</span><span class='hs-layout'>,</span><span class='hs-conid'>Typeable</span><span class='hs-layout'>)</span>
<a name="line-185"></a>
<a name="line-186"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>Message</span> <span class='hs-conid'>SetStruts</span>
<a name="line-187"></a>
<a name="line-188"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>LayoutModifier</span> <span class='hs-conid'>AvoidStruts</span> <span class='hs-varid'>a</span> <span class='hs-keyword'>where</span>
<a name="line-189"></a>    <span class='hs-varid'>modifyLayout</span> <span class='hs-layout'>(</span><span class='hs-conid'>AvoidStruts</span> <span class='hs-varid'>ss</span><span class='hs-layout'>)</span> <span class='hs-varid'>w</span> <span class='hs-varid'>r</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-190"></a>        <span class='hs-varid'>nr</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>fmap</span> <span class='hs-layout'>(</span><span class='hs-varop'>$</span> <span class='hs-varid'>r</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>calcGap</span> <span class='hs-varid'>ss</span><span class='hs-layout'>)</span>
<a name="line-191"></a>        <span class='hs-varid'>runLayout</span> <span class='hs-varid'>w</span> <span class='hs-varid'>nr</span>
<a name="line-192"></a>
<a name="line-193"></a>    <span class='hs-varid'>pureMess</span> <span class='hs-layout'>(</span><span class='hs-conid'>AvoidStruts</span> <span class='hs-varid'>ss</span><span class='hs-layout'>)</span> <span class='hs-varid'>m</span>
<a name="line-194"></a>        <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Just</span> <span class='hs-conid'>ToggleStruts</span>    <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>fromMessage</span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Just</span> <span class='hs-varop'>$</span> <span class='hs-conid'>AvoidStruts</span> <span class='hs-layout'>(</span><span class='hs-varid'>toggleAll</span> <span class='hs-varid'>ss</span><span class='hs-layout'>)</span>
<a name="line-195"></a>        <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-conid'>ToggleStrut</span> <span class='hs-varid'>s</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>fromMessage</span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Just</span> <span class='hs-varop'>$</span> <span class='hs-conid'>AvoidStruts</span> <span class='hs-layout'>(</span><span class='hs-varid'>toggleOne</span> <span class='hs-varid'>s</span> <span class='hs-varid'>ss</span><span class='hs-layout'>)</span>
<a name="line-196"></a>        <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-conid'>SetStruts</span> <span class='hs-varid'>n</span> <span class='hs-varid'>k</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>fromMessage</span> <span class='hs-varid'>m</span>
<a name="line-197"></a>        <span class='hs-layout'>,</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>newSS</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>S</span><span class='hs-varop'>.</span><span class='hs-varid'>fromList</span> <span class='hs-varid'>n</span> <span class='hs-varop'>`</span><span class='hs-conid'>S</span><span class='hs-varop'>.</span><span class='hs-varid'>union</span><span class='hs-varop'>`</span> <span class='hs-layout'>(</span><span class='hs-varid'>ss</span> <span class='hs-conid'>S</span><span class='hs-varop'>.\\</span> <span class='hs-conid'>S</span><span class='hs-varop'>.</span><span class='hs-varid'>fromList</span> <span class='hs-varid'>k</span><span class='hs-layout'>)</span>
<a name="line-198"></a>        <span class='hs-layout'>,</span> <span class='hs-varid'>newSS</span> <span class='hs-varop'>/=</span> <span class='hs-varid'>ss</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Just</span> <span class='hs-varop'>$</span> <span class='hs-conid'>AvoidStruts</span> <span class='hs-varid'>newSS</span>
<a name="line-199"></a>        <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Nothing</span>
<a name="line-200"></a>      <span class='hs-keyword'>where</span> <span class='hs-varid'>toggleAll</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>S</span><span class='hs-varop'>.</span><span class='hs-varid'>null</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>S</span><span class='hs-varop'>.</span><span class='hs-varid'>fromList</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>minBound</span> <span class='hs-keyglyph'>..</span> <span class='hs-varid'>maxBound</span><span class='hs-keyglyph'>]</span>
<a name="line-201"></a>                        <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>S</span><span class='hs-varop'>.</span><span class='hs-varid'>empty</span>
<a name="line-202"></a>            <span class='hs-varid'>toggleOne</span> <span class='hs-varid'>x</span> <span class='hs-varid'>xs</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>x</span> <span class='hs-varop'>`</span><span class='hs-conid'>S</span><span class='hs-varop'>.</span><span class='hs-varid'>member</span><span class='hs-varop'>`</span> <span class='hs-varid'>xs</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>S</span><span class='hs-varop'>.</span><span class='hs-varid'>delete</span> <span class='hs-varid'>x</span> <span class='hs-varid'>xs</span>
<a name="line-203"></a>                           <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span>   <span class='hs-keyglyph'>=</span> <span class='hs-varid'>x</span> <span class='hs-varop'>`</span><span class='hs-conid'>S</span><span class='hs-varop'>.</span><span class='hs-varid'>insert</span><span class='hs-varop'>`</span> <span class='hs-varid'>xs</span>
<a name="line-204"></a>
<a name="line-205"></a>
<a name="line-206"></a><span class='hs-comment'>-- | (Direction, height\/width, initial pixel, final pixel).</span>
<a name="line-207"></a>
<a name="line-208"></a><a name="Strut"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>Strut</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-conid'>Direction2D</span><span class='hs-layout'>,</span> <span class='hs-conid'>CLong</span><span class='hs-layout'>,</span> <span class='hs-conid'>CLong</span><span class='hs-layout'>,</span> <span class='hs-conid'>CLong</span><span class='hs-layout'>)</span>
<a name="line-209"></a>
<a name="line-210"></a><span class='hs-comment'>-- | (Initial x pixel, initial y pixel,</span>
<a name="line-211"></a><span class='hs-comment'>--    final x pixel, final y pixel).</span>
<a name="line-212"></a>
<a name="line-213"></a><a name="RectC"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>RectC</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-conid'>CLong</span><span class='hs-layout'>,</span> <span class='hs-conid'>CLong</span><span class='hs-layout'>,</span> <span class='hs-conid'>CLong</span><span class='hs-layout'>,</span> <span class='hs-conid'>CLong</span><span class='hs-layout'>)</span>
<a name="line-214"></a>
<a name="line-215"></a><a name="fi"></a><span class='hs-definition'>fi</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Integral</span> <span class='hs-varid'>a</span><span class='hs-layout'>,</span> <span class='hs-conid'>Num</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=&gt;</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>b</span>
<a name="line-216"></a><span class='hs-definition'>fi</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fromIntegral</span>
<a name="line-217"></a>
<a name="line-218"></a><span class='hs-comment'>-- | Invertible conversion.</span>
<a name="line-219"></a>
<a name="line-220"></a><a name="r2c"></a><span class='hs-definition'>r2c</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Rectangle</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>RectC</span>
<a name="line-221"></a><span class='hs-definition'>r2c</span> <span class='hs-layout'>(</span><span class='hs-conid'>Rectangle</span> <span class='hs-varid'>x</span> <span class='hs-varid'>y</span> <span class='hs-varid'>w</span> <span class='hs-varid'>h</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>fi</span> <span class='hs-varid'>x</span><span class='hs-layout'>,</span> <span class='hs-varid'>fi</span> <span class='hs-varid'>y</span><span class='hs-layout'>,</span> <span class='hs-varid'>fi</span> <span class='hs-varid'>x</span> <span class='hs-varop'>+</span> <span class='hs-varid'>fi</span> <span class='hs-varid'>w</span> <span class='hs-comment'>-</span> <span class='hs-num'>1</span><span class='hs-layout'>,</span> <span class='hs-varid'>fi</span> <span class='hs-varid'>y</span> <span class='hs-varop'>+</span> <span class='hs-varid'>fi</span> <span class='hs-varid'>h</span> <span class='hs-comment'>-</span> <span class='hs-num'>1</span><span class='hs-layout'>)</span>
<a name="line-222"></a>
<a name="line-223"></a><span class='hs-comment'>-- | Invertible conversion.</span>
<a name="line-224"></a>
<a name="line-225"></a><a name="c2r"></a><span class='hs-definition'>c2r</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>RectC</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Rectangle</span>
<a name="line-226"></a><span class='hs-definition'>c2r</span> <span class='hs-layout'>(</span><span class='hs-varid'>x1</span><span class='hs-layout'>,</span> <span class='hs-varid'>y1</span><span class='hs-layout'>,</span> <span class='hs-varid'>x2</span><span class='hs-layout'>,</span> <span class='hs-varid'>y2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Rectangle</span> <span class='hs-layout'>(</span><span class='hs-varid'>fi</span> <span class='hs-varid'>x1</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>fi</span> <span class='hs-varid'>y1</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>fi</span> <span class='hs-varop'>$</span> <span class='hs-varid'>x2</span> <span class='hs-comment'>-</span> <span class='hs-varid'>x1</span> <span class='hs-varop'>+</span> <span class='hs-num'>1</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>fi</span> <span class='hs-varop'>$</span> <span class='hs-varid'>y2</span> <span class='hs-comment'>-</span> <span class='hs-varid'>y1</span> <span class='hs-varop'>+</span> <span class='hs-num'>1</span><span class='hs-layout'>)</span>
<a name="line-227"></a>
<a name="line-228"></a><span class='hs-comment'>-- TODO: Add these QuickCheck properties to the test suite, along with</span>
<a name="line-229"></a><span class='hs-comment'>-- suitable Arbitrary instances.</span>
<a name="line-230"></a>
<a name="line-231"></a><span class='hs-comment'>-- prop_r2c_c2r :: RectC -&gt; Bool</span>
<a name="line-232"></a><span class='hs-comment'>-- prop_r2c_c2r r = r2c (c2r r) == r</span>
<a name="line-233"></a>
<a name="line-234"></a><span class='hs-comment'>-- prop_c2r_r2c :: Rectangle -&gt; Bool</span>
<a name="line-235"></a><span class='hs-comment'>-- prop_c2r_r2c r = c2r (r2c r) == r</span>
<a name="line-236"></a>
<a name="line-237"></a><a name="reduce"></a><span class='hs-definition'>reduce</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>RectC</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Strut</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>RectC</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>RectC</span>
<a name="line-238"></a><span class='hs-definition'>reduce</span> <span class='hs-layout'>(</span><span class='hs-varid'>sx0</span><span class='hs-layout'>,</span> <span class='hs-varid'>sy0</span><span class='hs-layout'>,</span> <span class='hs-varid'>sx1</span><span class='hs-layout'>,</span> <span class='hs-varid'>sy1</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>s</span><span class='hs-layout'>,</span> <span class='hs-varid'>n</span><span class='hs-layout'>,</span> <span class='hs-varid'>l</span><span class='hs-layout'>,</span> <span class='hs-varid'>h</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>x0</span><span class='hs-layout'>,</span> <span class='hs-varid'>y0</span><span class='hs-layout'>,</span> <span class='hs-varid'>x1</span><span class='hs-layout'>,</span> <span class='hs-varid'>y1</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>s</span> <span class='hs-keyword'>of</span>
<a name="line-239"></a>    <span class='hs-conid'>L</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>p</span> <span class='hs-layout'>(</span><span class='hs-varid'>y0</span><span class='hs-layout'>,</span> <span class='hs-varid'>y1</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-layout'>(</span><span class='hs-varid'>mx</span> <span class='hs-varid'>x0</span> <span class='hs-varid'>sx0</span>    <span class='hs-layout'>,</span> <span class='hs-varid'>y0</span>       <span class='hs-layout'>,</span> <span class='hs-varid'>x1</span>       <span class='hs-layout'>,</span> <span class='hs-varid'>y1</span>       <span class='hs-layout'>)</span>
<a name="line-240"></a>    <span class='hs-conid'>R</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>p</span> <span class='hs-layout'>(</span><span class='hs-varid'>y0</span><span class='hs-layout'>,</span> <span class='hs-varid'>y1</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-layout'>(</span><span class='hs-varid'>x0</span>           <span class='hs-layout'>,</span> <span class='hs-varid'>y0</span>       <span class='hs-layout'>,</span> <span class='hs-varid'>mn</span> <span class='hs-varid'>x1</span> <span class='hs-varid'>sx1</span><span class='hs-layout'>,</span> <span class='hs-varid'>y1</span>       <span class='hs-layout'>)</span>
<a name="line-241"></a>    <span class='hs-conid'>U</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>p</span> <span class='hs-layout'>(</span><span class='hs-varid'>x0</span><span class='hs-layout'>,</span> <span class='hs-varid'>x1</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-layout'>(</span><span class='hs-varid'>x0</span>           <span class='hs-layout'>,</span> <span class='hs-varid'>mx</span> <span class='hs-varid'>y0</span> <span class='hs-varid'>sy0</span><span class='hs-layout'>,</span> <span class='hs-varid'>x1</span>       <span class='hs-layout'>,</span> <span class='hs-varid'>y1</span>       <span class='hs-layout'>)</span>
<a name="line-242"></a>    <span class='hs-conid'>D</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>p</span> <span class='hs-layout'>(</span><span class='hs-varid'>x0</span><span class='hs-layout'>,</span> <span class='hs-varid'>x1</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-layout'>(</span><span class='hs-varid'>x0</span>           <span class='hs-layout'>,</span> <span class='hs-varid'>y0</span>       <span class='hs-layout'>,</span> <span class='hs-varid'>x1</span>       <span class='hs-layout'>,</span> <span class='hs-varid'>mn</span> <span class='hs-varid'>y1</span> <span class='hs-varid'>sy1</span><span class='hs-layout'>)</span>
<a name="line-243"></a>    <span class='hs-keyword'>_</span>              <span class='hs-keyglyph'>-&gt;</span> <span class='hs-layout'>(</span><span class='hs-varid'>x0</span>           <span class='hs-layout'>,</span> <span class='hs-varid'>y0</span>       <span class='hs-layout'>,</span> <span class='hs-varid'>x1</span>       <span class='hs-layout'>,</span> <span class='hs-varid'>y1</span>       <span class='hs-layout'>)</span>
<a name="line-244"></a> <span class='hs-keyword'>where</span>
<a name="line-245"></a>    <span class='hs-varid'>mx</span> <span class='hs-varid'>a</span> <span class='hs-varid'>b</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>max</span> <span class='hs-varid'>a</span> <span class='hs-layout'>(</span><span class='hs-varid'>b</span> <span class='hs-varop'>+</span> <span class='hs-varid'>n</span><span class='hs-layout'>)</span>
<a name="line-246"></a>    <span class='hs-varid'>mn</span> <span class='hs-varid'>a</span> <span class='hs-varid'>b</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>min</span> <span class='hs-varid'>a</span> <span class='hs-layout'>(</span><span class='hs-varid'>b</span> <span class='hs-comment'>-</span> <span class='hs-varid'>n</span><span class='hs-layout'>)</span>
<a name="line-247"></a>    <span class='hs-varid'>p</span> <span class='hs-varid'>r</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>r</span> <span class='hs-varop'>`overlaps`</span> <span class='hs-layout'>(</span><span class='hs-varid'>l</span><span class='hs-layout'>,</span> <span class='hs-varid'>h</span><span class='hs-layout'>)</span>
<a name="line-248"></a>
<a name="line-249"></a><span class='hs-comment'>-- | Do the two ranges overlap?</span>
<a name="line-250"></a><span class='hs-comment'>--</span>
<a name="line-251"></a><span class='hs-comment'>-- Precondition for every input range @(x, y)@: @x '&lt;=' y@.</span>
<a name="line-252"></a><span class='hs-comment'>--</span>
<a name="line-253"></a><span class='hs-comment'>-- A range @(x, y)@ is assumed to include every pixel from @x@ to @y@.</span>
<a name="line-254"></a>
<a name="line-255"></a><a name="overlaps"></a><span class='hs-definition'>overlaps</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Ord</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>=&gt;</span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Bool</span>
<a name="line-256"></a><a name="overlaps"></a><span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span> <span class='hs-varop'>`overlaps`</span> <span class='hs-layout'>(</span><span class='hs-varid'>x</span><span class='hs-layout'>,</span> <span class='hs-varid'>y</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span>
<a name="line-257"></a>  <span class='hs-varid'>inRange</span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span> <span class='hs-varid'>x</span> <span class='hs-varop'>||</span> <span class='hs-varid'>inRange</span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span> <span class='hs-varid'>y</span> <span class='hs-varop'>||</span> <span class='hs-varid'>inRange</span> <span class='hs-layout'>(</span><span class='hs-varid'>x</span><span class='hs-layout'>,</span> <span class='hs-varid'>y</span><span class='hs-layout'>)</span> <span class='hs-varid'>a</span>
<a name="line-258"></a>  <span class='hs-keyword'>where</span>
<a name="line-259"></a>  <span class='hs-varid'>inRange</span> <span class='hs-layout'>(</span><span class='hs-varid'>i</span><span class='hs-layout'>,</span> <span class='hs-varid'>j</span><span class='hs-layout'>)</span> <span class='hs-varid'>k</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>i</span> <span class='hs-varop'>&lt;=</span> <span class='hs-varid'>k</span> <span class='hs-varop'>&amp;&amp;</span> <span class='hs-varid'>k</span> <span class='hs-varop'>&lt;=</span> <span class='hs-varid'>j</span>
</pre></body>
</html>