diff --git a/Setup.lhs b/Setup.lhs
new file mode 100644
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,3 @@
+#!/usr/bin/env runhaskell
+> import Distribution.Simple
+> main = defaultMain
diff --git a/haskgame.cabal b/haskgame.cabal
new file mode 100644
--- /dev/null
+++ b/haskgame.cabal
@@ -0,0 +1,41 @@
+Name:                haskgame
+Version:             0.0.1
+Cabal-Version:       >= 1.2
+Synopsis:            Purely FunctionaL User Interface
+Category:            graphics
+Description:
+  This package contains a set of composable purely funcitonal widgets
+  and a mainloop adapter to adapt the widgets to run in IO.
+  It is currently based on SDL.
+  .
+  Project wiki page: <http://haskell.org/haskellwiki/HaskGame>
+  .
+  Git repository is at: <http://github.com/Peaker/haskgame>
+  .
+  &#169; 2009 by Eyal Lotem; BSD3 license.
+
+Author:              Eyal Lotem
+Maintainer:          eyal.lotem@gmail.com
+--Homepage:            http://haskell.org/haskellwiki/HaskGame
+--Package-Url:         http://code.haskell.org/HaskGame
+Copyright:           (c) 2008 by Eyal Lotem
+License:             BSD3
+Stability:           experimental
+build-type:          Simple
+
+Library
+  hs-Source-Dirs:      src
+  Extensions:
+-- SDL-ttf prior to 0.5.5 can be used on x86-32, but on x86-64 bugs
+-- render it unusable
+  Build-Depends:       base, haskell98, containers, SDL, SDL-ttf >= 0.5.5
+  Exposed-Modules:     Graphics.UI.HaskGame,
+                       Graphics.UI.HaskGame.Color,
+                       Graphics.UI.HaskGame.Font,
+                       Graphics.UI.HaskGame.Key,
+                       Graphics.UI.HaskGame.Keys,
+                       Graphics.UI.HaskGame.Rect,
+                       Graphics.UI.HaskGame.Vector2
+  Other-Modules:       Graphics.UI.HaskGame.Utils
+  ghc-options:         -Wall
+--  ghc-prof-options:    -prof -auto-all 
diff --git a/src/Graphics/UI/HaskGame.hs b/src/Graphics/UI/HaskGame.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/UI/HaskGame.hs
@@ -0,0 +1,73 @@
+{-# OPTIONS -Wall -O2 #-}
+
+module Graphics.UI.HaskGame
+    (Surface,Event
+    ,createRGBSurface,blit,fillRect,fillSurface
+    ,withInit,getEvents,surfaceSize,setVideoMode
+    )
+where
+
+import qualified Graphics.UI.SDL as SDL
+import qualified Graphics.UI.HaskGame.Rect as Rect
+import qualified Graphics.UI.HaskGame.Font as Font
+import qualified Graphics.UI.HaskGame.Utils as Utils
+import Graphics.UI.HaskGame.Color(Color(..))
+import Graphics.UI.HaskGame.Vector2(Vector2(..))
+import Control.Monad(liftM)
+
+-- Commented out for 6.8's lack of the new Exception
+-- import Control.Exception(throwIO)
+
+type Surface = SDL.Surface
+type Event = SDL.Event
+
+whileM :: Monad m => (a -> Bool) -> m a -> m [a]
+whileM cond element = do
+  value <- element
+  if cond value
+    then liftM (value:) (whileM cond element)
+    else return []
+
+createRGBSurface :: Vector2 Int -> IO Surface
+createRGBSurface (Vector2 w h) = do
+  surface <- SDL.createRGBSurface [SDL.SWSurface]
+     w h 32 0xFF 0xFF00 0xFF0000 0x00000000
+  SDL.displayFormatAlpha surface
+
+blit :: Surface -> Vector2 Int -> Surface -> IO ()
+blit dest pos src = do
+  SDL.blitSurface src Nothing dest (Just . Rect.makePosRect $ pos)
+  return ()
+
+sdlFillRect :: Surface -> Maybe Rect.Rect -> Color -> IO ()
+sdlFillRect surface mRect color = do
+  fillerPixel <- pixel surface color
+  SDL.fillRect surface mRect fillerPixel
+  return ()
+
+fillSurface :: Surface -> Color -> IO ()
+fillSurface surface color = sdlFillRect surface Nothing color
+
+fillRect :: Surface -> Rect.Rect -> Color -> IO ()
+fillRect surface rect color = sdlFillRect surface (Just rect) color
+
+initKeyRepeat :: IO ()
+initKeyRepeat = Utils.ioBoolToError "enableKeyRepeat failed" $ SDL.enableKeyRepeat 150 10
+
+withInit :: IO () -> IO ()
+withInit = SDL.withInit [SDL.InitEverything] .
+           Utils.bracket__ initKeyRepeat (return ()) .
+           Font.withInit
+
+pixel :: Surface -> Color -> IO SDL.Pixel
+pixel surface (Color r g b) = SDL.mapRGB (SDL.surfaceGetPixelFormat surface) r g b
+
+getEvents :: IO [Event]
+getEvents = whileM (/=SDL.NoEvent) SDL.pollEvent
+
+surfaceSize :: Surface -> Vector2 Int
+surfaceSize surface = Vector2 (SDL.surfaceGetWidth surface)
+                              (SDL.surfaceGetHeight surface)
+
+setVideoMode :: Int -> Int -> Int -> IO Surface
+setVideoMode xres yres colorDepth = SDL.setVideoMode xres yres colorDepth [SDL.DoubleBuf]
diff --git a/src/Graphics/UI/HaskGame/Color.hs b/src/Graphics/UI/HaskGame/Color.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/UI/HaskGame/Color.hs
@@ -0,0 +1,11 @@
+{-# OPTIONS -Wall -O2 #-}
+
+module Graphics.UI.HaskGame.Color(Color(..))
+where
+
+import Data.Word(Word8)
+
+data Color
+  = Color {colorRed :: Word8,
+           colorGreen :: Word8,
+           colorBlue :: Word8}
diff --git a/src/Graphics/UI/HaskGame/Font.hs b/src/Graphics/UI/HaskGame/Font.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/UI/HaskGame/Font.hs
@@ -0,0 +1,33 @@
+{-# OPTIONS -Wall -O2 #-}
+
+module Graphics.UI.HaskGame.Font
+    (Font
+    ,renderText,textSize
+    ,defaultFont,withInit)
+where
+
+import qualified Graphics.UI.SDL as SDL
+import qualified Graphics.UI.SDL.TTF as TTF
+import qualified Graphics.UI.HaskGame.Utils as Utils
+import Graphics.UI.HaskGame.Color(Color(..))
+import Graphics.UI.HaskGame.Vector2(Vector2(..))
+
+type Font = TTF.Font
+
+renderText :: Font -> String -> Color -> IO SDL.Surface
+renderText font text (Color r g b) = if null text
+                             then
+                                 SDL.createRGBSurface [] 0 0 0 0 0 0 0
+                             else
+                                 TTF.renderTextBlended font text (SDL.Color r g b)
+
+textSize :: Font -> String -> IO (Vector2 Int)
+textSize font text = do
+  (w, h) <- TTF.textSize font text
+  return $ Vector2 w h
+
+defaultFont :: Int -> IO Font
+defaultFont = TTF.openFont "/usr/share/fonts/truetype/freefont/FreeSerifBold.ttf"
+
+withInit :: IO () -> IO ()
+withInit = Utils.bracket__ (Utils.ioBoolToError "TTF init failure" TTF.init) TTF.quit
diff --git a/src/Graphics/UI/HaskGame/Key.hs b/src/Graphics/UI/HaskGame/Key.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/UI/HaskGame/Key.hs
@@ -0,0 +1,64 @@
+{-# OPTIONS_GHC -Wall -O2 #-}
+
+module Graphics.UI.HaskGame.Key
+    (keyOfEvent
+    ,ModKey(..),KeyGroup(..)
+    ,singletonKeyGroup,asKeyGroup,keyName
+    ,Mods(..),noMods,shift,ctrl,alt
+    ,Keysym)
+where
+
+import qualified Graphics.UI.SDL as SDL
+import qualified Data.Set as Set
+
+type Keysym = SDL.Keysym
+data Mods = MkMods { isShift, isCtrl, isAlt :: Bool }
+  deriving (Eq, Ord, Show, Read)
+data ModKey = ModKey Mods SDL.SDLKey
+  deriving (Eq, Ord, Show)
+data KeyGroup = KeyGroup {
+      keyGroupName :: String
+    , keyGroupKeys :: Set.Set ModKey
+}
+  deriving (Eq, Ord, Show)
+
+singletonKeyGroup :: ModKey -> KeyGroup
+singletonKeyGroup key = KeyGroup (keyName key) (Set.singleton key)
+
+asKeyGroup :: Mods -> SDL.SDLKey -> KeyGroup
+asKeyGroup = (fmap . fmap) singletonKeyGroup ModKey
+
+modsName :: Mods -> String
+modsName mods =
+    let shiftStr = if isShift mods then "Shift+" else ""
+        ctrlStr  = if isCtrl mods then "Ctrl+" else ""
+        altStr   = if isAlt mods then "Alt+" else ""
+    in concat [shiftStr, ctrlStr, altStr]
+
+keyName :: ModKey -> String
+keyName (ModKey mods sdlkey) = modsName mods ++ SDL.getKeyName sdlkey
+
+noMods, shift, ctrl, alt :: Mods
+noMods = MkMods False False False
+shift = noMods{isShift=True}
+ctrl = noMods{isCtrl=True}
+alt = noMods{isAlt=True}
+
+modsOf :: [SDL.Modifier] -> Mods
+modsOf mods =
+    MkMods (any (`elem` mods)
+            [SDL.KeyModLeftShift,
+             SDL.KeyModRightShift,
+             SDL.KeyModShift])
+           (any (`elem` mods)
+            [SDL.KeyModLeftCtrl,
+             SDL.KeyModRightCtrl,
+             SDL.KeyModCtrl])
+           (any (`elem` mods)
+            [SDL.KeyModLeftAlt,
+             SDL.KeyModRightAlt,
+             SDL.KeyModAlt])
+
+keyOfEvent :: Keysym -> ModKey
+keyOfEvent keySym = ModKey (modsOf $ SDL.symModifiers keySym)
+                           (SDL.symKey keySym)
diff --git a/src/Graphics/UI/HaskGame/Keys.hs b/src/Graphics/UI/HaskGame/Keys.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/UI/HaskGame/Keys.hs
@@ -0,0 +1,194 @@
+{-# OPTIONS_GHC -Wall -O2 #-}
+
+module Graphics.UI.HaskGame.Keys
+    (KeyGroup(..),allGroups,groupsOfKey,keysUnicode
+    ,printableGroup,digitsGroup,lettersGroup
+    ,upperCaseGroup,lowerCaseGroup,arrowsGroup
+    )
+where
+
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+import qualified Graphics.UI.SDL as SDL
+import Graphics.UI.HaskGame.Key
+    (noMods, shift, ModKey(..), KeyGroup(..)
+    ,singletonKeyGroup)
+
+inGroup :: ModKey -> KeyGroup -> Bool
+key `inGroup` group = key `Set.member` (keyGroupKeys group)
+
+groupsOfKey :: ModKey -> [KeyGroup]
+groupsOfKey key = singletonKeyGroup key :
+                  filter (key `inGroup`) allGroups
+
+allGroups :: [KeyGroup]
+allGroups =
+    [printableGroup
+    ,digitsGroup
+    ,lettersGroup
+    ,upperCaseGroup
+    ,lowerCaseGroup
+    ,arrowsGroup
+    ]
+
+combineGroups :: String -> [KeyGroup] -> KeyGroup
+combineGroups name groups = KeyGroup name (Set.unions . map keyGroupKeys $ groups)
+
+keysSetOfUnicode :: Map.Map ModKey String -> Set.Set ModKey
+keysSetOfUnicode = Set.fromList . Map.keys
+
+printableGroup, digitsGroup, lettersGroup,
+  upperCaseGroup, lowerCaseGroup, arrowsGroup :: KeyGroup
+lettersGroup = combineGroups "Letters" [upperCaseGroup, lowerCaseGroup]
+printableGroup = KeyGroup "Printable" . keysSetOfUnicode $ keysUnicode
+digitsGroup = KeyGroup "Digits" . keysSetOfUnicode $ digitsUnicode
+upperCaseGroup = KeyGroup "Upper-case letters" . keysSetOfUnicode $ upperCaseUnicode
+lowerCaseGroup = KeyGroup "Lower-case letters" . keysSetOfUnicode $ lowerCaseUnicode
+arrowsGroup = KeyGroup "Arrows" $
+              Set.fromList [ModKey noMods SDL.SDLK_LEFT
+                           ,ModKey noMods SDL.SDLK_RIGHT
+                           ,ModKey noMods SDL.SDLK_UP
+                           ,ModKey noMods SDL.SDLK_DOWN]
+
+lowerCaseUnicode, upperCaseUnicode, digitsUnicode :: Map.Map ModKey String
+lowerCaseUnicode = Map.fromList $
+    [(ModKey noMods SDL.SDLK_a, "a")
+    ,(ModKey noMods SDL.SDLK_b, "b")
+    ,(ModKey noMods SDL.SDLK_c, "c")
+    ,(ModKey noMods SDL.SDLK_d, "d")
+    ,(ModKey noMods SDL.SDLK_e, "e")
+    ,(ModKey noMods SDL.SDLK_f, "f")
+    ,(ModKey noMods SDL.SDLK_g, "g")
+    ,(ModKey noMods SDL.SDLK_h, "h")
+    ,(ModKey noMods SDL.SDLK_i, "i")
+    ,(ModKey noMods SDL.SDLK_j, "j")
+    ,(ModKey noMods SDL.SDLK_k, "k")
+    ,(ModKey noMods SDL.SDLK_l, "l")
+    ,(ModKey noMods SDL.SDLK_m, "m")
+    ,(ModKey noMods SDL.SDLK_n, "n")
+    ,(ModKey noMods SDL.SDLK_o, "o")
+    ,(ModKey noMods SDL.SDLK_p, "p")
+    ,(ModKey noMods SDL.SDLK_q, "q")
+    ,(ModKey noMods SDL.SDLK_r, "r")
+    ,(ModKey noMods SDL.SDLK_s, "s")
+    ,(ModKey noMods SDL.SDLK_t, "t")
+    ,(ModKey noMods SDL.SDLK_u, "u")
+    ,(ModKey noMods SDL.SDLK_v, "v")
+    ,(ModKey noMods SDL.SDLK_w, "w")
+    ,(ModKey noMods SDL.SDLK_x, "x")
+    ,(ModKey noMods SDL.SDLK_y, "y")
+    ,(ModKey noMods SDL.SDLK_z, "z")
+    ]
+upperCaseUnicode = Map.fromList $
+    [(ModKey shift SDL.SDLK_a, "A")
+    ,(ModKey shift SDL.SDLK_b, "B")
+    ,(ModKey shift SDL.SDLK_c, "C")
+    ,(ModKey shift SDL.SDLK_d, "D")
+    ,(ModKey shift SDL.SDLK_e, "E")
+    ,(ModKey shift SDL.SDLK_f, "F")
+    ,(ModKey shift SDL.SDLK_g, "G")
+    ,(ModKey shift SDL.SDLK_h, "H")
+    ,(ModKey shift SDL.SDLK_i, "I")
+    ,(ModKey shift SDL.SDLK_j, "J")
+    ,(ModKey shift SDL.SDLK_k, "K")
+    ,(ModKey shift SDL.SDLK_l, "L")
+    ,(ModKey shift SDL.SDLK_m, "M")
+    ,(ModKey shift SDL.SDLK_n, "N")
+    ,(ModKey shift SDL.SDLK_o, "O")
+    ,(ModKey shift SDL.SDLK_p, "P")
+    ,(ModKey shift SDL.SDLK_q, "Q")
+    ,(ModKey shift SDL.SDLK_r, "R")
+    ,(ModKey shift SDL.SDLK_s, "S")
+    ,(ModKey shift SDL.SDLK_t, "T")
+    ,(ModKey shift SDL.SDLK_u, "U")
+    ,(ModKey shift SDL.SDLK_v, "V")
+    ,(ModKey shift SDL.SDLK_w, "W")
+    ,(ModKey shift SDL.SDLK_x, "X")
+    ,(ModKey shift SDL.SDLK_y, "Y")
+    ,(ModKey shift SDL.SDLK_z, "Z")
+    ]
+digitsUnicode = Map.fromList $
+    [(ModKey noMods SDL.SDLK_0, "0")
+    ,(ModKey noMods SDL.SDLK_1, "1")
+    ,(ModKey noMods SDL.SDLK_2, "2")
+    ,(ModKey noMods SDL.SDLK_3, "3")
+    ,(ModKey noMods SDL.SDLK_4, "4")
+    ,(ModKey noMods SDL.SDLK_5, "5")
+    ,(ModKey noMods SDL.SDLK_6, "6")
+    ,(ModKey noMods SDL.SDLK_7, "7")
+    ,(ModKey noMods SDL.SDLK_8, "8")
+    ,(ModKey noMods SDL.SDLK_9, "9")
+    ,(ModKey shift SDL.SDLK_KP0, "0")
+    ,(ModKey shift SDL.SDLK_KP1, "1")
+    ,(ModKey shift SDL.SDLK_KP2, "2")
+    ,(ModKey shift SDL.SDLK_KP3, "3")
+    ,(ModKey shift SDL.SDLK_KP4, "4")
+    ,(ModKey shift SDL.SDLK_KP5, "5")
+    ,(ModKey shift SDL.SDLK_KP6, "6")
+    ,(ModKey shift SDL.SDLK_KP7, "7")
+    ,(ModKey shift SDL.SDLK_KP8, "8")
+    ,(ModKey shift SDL.SDLK_KP9, "9")
+    ]
+
+keysUnicode :: Map.Map ModKey String
+keysUnicode = Map.unions
+              [lowerCaseUnicode
+              ,upperCaseUnicode
+              ,digitsUnicode,
+               Map.fromList
+               [(ModKey noMods SDL.SDLK_SPACE, " ")
+               ,(ModKey noMods SDL.SDLK_EXCLAIM, "!")
+               ,(ModKey noMods SDL.SDLK_QUOTEDBL, "\"")
+               ,(ModKey noMods SDL.SDLK_HASH, "#")
+               ,(ModKey noMods SDL.SDLK_DOLLAR, "$")
+               ,(ModKey noMods SDL.SDLK_AMPERSAND, "&")
+               ,(ModKey noMods SDL.SDLK_QUOTE, "'")
+               ,(ModKey noMods SDL.SDLK_LEFTPAREN, "(")
+               ,(ModKey noMods SDL.SDLK_RIGHTPAREN, ")")
+               ,(ModKey noMods SDL.SDLK_ASTERISK, "*")
+               ,(ModKey noMods SDL.SDLK_PLUS, "+")
+               ,(ModKey noMods SDL.SDLK_COMMA, ",")
+               ,(ModKey noMods SDL.SDLK_MINUS, "-")
+               ,(ModKey noMods SDL.SDLK_PERIOD, ".")
+               ,(ModKey noMods SDL.SDLK_SLASH, "/")
+               ,(ModKey noMods SDL.SDLK_COLON, ":")
+               ,(ModKey noMods SDL.SDLK_SEMICOLON, ";")
+               ,(ModKey noMods SDL.SDLK_LESS, "<")
+               ,(ModKey noMods SDL.SDLK_EQUALS, "=")
+               ,(ModKey noMods SDL.SDLK_GREATER, ">")
+               ,(ModKey noMods SDL.SDLK_QUESTION, "?")
+               ,(ModKey noMods SDL.SDLK_AT, "@")
+               ,(ModKey noMods SDL.SDLK_LEFTBRACKET, "[")
+               ,(ModKey noMods SDL.SDLK_BACKSLASH, "\\")
+               ,(ModKey noMods SDL.SDLK_RIGHTBRACKET, "]")
+               ,(ModKey noMods SDL.SDLK_UNDERSCORE, "_")
+               ,(ModKey noMods SDL.SDLK_BACKQUOTE, "`")
+
+               ,(ModKey shift SDL.SDLK_QUOTE, "\"")
+               ,(ModKey shift SDL.SDLK_COMMA, "<")
+               ,(ModKey shift SDL.SDLK_MINUS, "_")
+               ,(ModKey shift SDL.SDLK_PERIOD, ">")
+               ,(ModKey shift SDL.SDLK_SLASH, "?")
+               ,(ModKey shift SDL.SDLK_0, ")")
+               ,(ModKey shift SDL.SDLK_1, "!")
+               ,(ModKey shift SDL.SDLK_2, "@")
+               ,(ModKey shift SDL.SDLK_3, "#")
+               ,(ModKey shift SDL.SDLK_4, "$")
+               ,(ModKey shift SDL.SDLK_5, "%")
+               ,(ModKey shift SDL.SDLK_6, "^")
+               ,(ModKey shift SDL.SDLK_7, "&")
+               ,(ModKey shift SDL.SDLK_8, "*")
+               ,(ModKey shift SDL.SDLK_9, "(")
+               ,(ModKey shift SDL.SDLK_SEMICOLON, ":")
+               ,(ModKey shift SDL.SDLK_EQUALS, "+")
+               ,(ModKey shift SDL.SDLK_LEFTBRACKET, "{")
+               ,(ModKey shift SDL.SDLK_BACKSLASH, "|")
+               ,(ModKey shift SDL.SDLK_RIGHTBRACKET, "}")
+               ,(ModKey shift SDL.SDLK_BACKQUOTE, "~")
+               ,(ModKey shift SDL.SDLK_KP_PERIOD, ".")
+               ,(ModKey shift SDL.SDLK_KP_DIVIDE, "/")
+               ,(ModKey shift SDL.SDLK_KP_MULTIPLY, "*")
+               ,(ModKey shift SDL.SDLK_KP_MINUS, "-")
+               ,(ModKey shift SDL.SDLK_KP_PLUS, "+")
+               ,(ModKey shift SDL.SDLK_KP_EQUALS, "=")
+               ]]
diff --git a/src/Graphics/UI/HaskGame/Rect.hs b/src/Graphics/UI/HaskGame/Rect.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/UI/HaskGame/Rect.hs
@@ -0,0 +1,59 @@
+module Graphics.UI.HaskGame.Rect
+    (Rect
+    ,rectToVectors
+    ,vectorsToRect
+    ,makeRect
+    ,vectorsToPVectors, pVectorsToVectors
+    ,inRect
+    ,rectPos, rectSize
+    ,rectX, rectY, rectW, rectH
+    ,makePosRect
+    ,unionRects)
+where
+
+import qualified Graphics.UI.SDL as SDL
+import Graphics.UI.HaskGame.Vector2(Vector2(..), vector2first, vector2second)
+import Control.Arrow(first, second)
+import Control.Applicative(liftA2)
+
+type Rect = SDL.Rect
+type Endo a = a -> a
+type Two a = (a, a)
+
+rectToVectors :: Rect -> Two (Vector2 Int)
+rectToVectors (SDL.Rect x y w h) = (Vector2 x y, Vector2 w h)
+
+vectorsToRect :: Two (Vector2 Int) -> Rect
+vectorsToRect (Vector2 x y, Vector2 w h) = SDL.Rect x y w h
+
+makeRect :: Vector2 Int -> Vector2 Int -> Rect
+makeRect = curry vectorsToRect
+
+-- Rect to Positional vectors
+vectorsToPVectors, pVectorsToVectors :: Endo (Two (Vector2 Int))
+vectorsToPVectors (p, s) = (p, p+s)
+pVectorsToVectors (p1, p2) = (p1, p2-p1)
+
+inRect :: Endo (Two (Vector2 Int)) -> Endo Rect
+inRect f = vectorsToRect . f . rectToVectors
+
+rectPos, rectSize :: Endo (Vector2 Int) -> Endo Rect
+rectPos = inRect . first
+rectSize = inRect . second
+
+rectX, rectY, rectW, rectH :: Endo Int -> Endo Rect
+rectX = rectPos . vector2first
+rectY = rectPos . vector2second
+rectW = rectSize . vector2first
+rectH = rectSize . vector2second
+
+makePosRect :: Vector2 Int -> Rect
+makePosRect (Vector2 x y) = SDL.Rect x y 0 0
+
+unionRects :: Rect -> Rect -> Rect
+unionRects r1 r2 =
+    let (tl1, br1) = vectorsToPVectors . rectToVectors $ r1
+        (tl2, br2) = vectorsToPVectors . rectToVectors $ r2
+    in vectorsToRect . pVectorsToVectors $
+           ((liftA2 min tl1 tl2),
+            (liftA2 max br1 br2))
diff --git a/src/Graphics/UI/HaskGame/Utils.hs b/src/Graphics/UI/HaskGame/Utils.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/UI/HaskGame/Utils.hs
@@ -0,0 +1,19 @@
+{-# OPTIONS -Wall -O2 #-}
+
+module Graphics.UI.HaskGame.Utils
+    (bracket__,ioBoolToError)
+where
+
+import qualified IO
+
+bracket__ :: IO () -> IO () -> IO () -> IO ()
+bracket__ pre post code = IO.bracket_ pre (const post) code
+
+ioBoolToError :: String -> IO Bool -> IO ()
+ioBoolToError errStr act = do
+  isSuccess <- act
+  if isSuccess
+    then return ()
+    else error errStr
+-- Commented out for 6.8's lack of the new Exception
+--       throwIO . userError $ errStr
diff --git a/src/Graphics/UI/HaskGame/Vector2.hs b/src/Graphics/UI/HaskGame/Vector2.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/UI/HaskGame/Vector2.hs
@@ -0,0 +1,40 @@
+{-# OPTIONS -Wall -O2 #-}
+
+module Graphics.UI.HaskGame.Vector2
+    (Vector2(Vector2)
+    ,vector2first,vector2second
+    ,vector2fst,vector2snd)
+where
+
+import Control.Applicative(Applicative(..), liftA2)
+
+data Vector2 a = Vector2 !a !a
+  -- Note the Ord instance is obviously not a mathematical one
+  -- (Vectors aren't ordinals!). Useful to have in a binary search
+  -- tree though.
+  deriving (Eq, Ord, Show, Read)
+
+type Endo a = a -> a
+
+vector2fst, vector2snd :: Vector2 a -> a
+vector2fst (Vector2 x _) = x
+vector2snd (Vector2 _ y) = y
+vector2first, vector2second :: Endo a -> Endo (Vector2 a)
+vector2first f (Vector2 x y) = Vector2 (f x) y
+vector2second f (Vector2 x y) = Vector2 x (f y)
+
+instance Functor Vector2 where
+  fmap f (Vector2 x y) = Vector2 (f x) (f y)
+instance Applicative Vector2 where
+  pure x = Vector2 x x
+  Vector2 f g <*> Vector2 x y = Vector2 (f x) (g y)
+
+-- An improper Num instance, for convenience
+instance (Eq a, Show a, Num a) => Num (Vector2 a) where
+  (+) = liftA2 (+)
+  (-) = liftA2 (-)
+  (*) = liftA2 (*)
+  abs = fmap abs
+  negate = fmap negate
+  signum = fmap signum
+  fromInteger = pure . fromInteger