diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,20 @@
+The MIT License (MIT)
+Copyright © 2014-2016 Tim Baumann, http://timbaumann.info
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the “Software”), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in
+all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+THE SOFTWARE.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/halma-gui.cabal b/halma-gui.cabal
new file mode 100644
--- /dev/null
+++ b/halma-gui.cabal
@@ -0,0 +1,38 @@
+name: halma-gui
+version: 0.1.1.0
+synopsis: GTK application for playing Halma
+description: Play Halma (aka Chinese Checkers) on your desktop against your friends or an AI
+homepage: https://github.com/timjb/halma
+license: MIT
+license-file: LICENSE
+author: Tim Baumann
+maintainer: tim@timbaumann.info
+copyright: 2015-2017 Tim Baumann
+category: Game
+build-type: Simple
+cabal-version: >= 1.10
+
+source-repository head
+  type: git
+  location: https://github.com/timjb/halma.git
+
+Executable halma-gui
+  Ghc-options: -threaded -Wall
+  default-language: Haskell2010
+  Hs-source-dirs: src
+  main-is: Main.hs
+  other-modules:
+    Game.Halma.GUI.State
+  build-depends:
+    halma >= 0.3.0.0,
+    base >= 4.6 && < 5,
+    diagrams-gtk >= 1.0.1.3 && < 1.5,
+    gtk >= 0.13.4 && < 0.15,
+    mtl,
+    diagrams-lib >= 1.3,
+    diagrams-cairo,
+    pipes >= 4.1.4 && < 4.4,
+    mvc >= 1.0.3 && < 1.2,
+    async >= 2.0.2 && < 2.2,
+    data-default,
+    timeit >= 1.0 && < 1.1
diff --git a/src/Game/Halma/GUI/State.hs b/src/Game/Halma/GUI/State.hs
new file mode 100644
--- /dev/null
+++ b/src/Game/Halma/GUI/State.hs
@@ -0,0 +1,31 @@
+module Game.Halma.GUI.State
+  ( HalmaState (..)
+  , initialHalmaState
+  ) where
+
+import Game.Halma.Board
+import Game.Halma.Configuration
+import Game.Halma.Rules
+import Game.TurnCounter
+
+import Data.Default (def)
+
+data HalmaState a
+  = HalmaState
+  { hsRuleOptions :: RuleOptions
+  , hsBoard :: HalmaBoard
+  , hsTurnCounter :: TurnCounter (Team, a)
+  , hsLastMoved :: Maybe (Int, Int)
+  } deriving (Eq, Show)
+
+initialHalmaState :: Configuration a -> HalmaState a
+initialHalmaState config =
+  let
+    (board, turnCounter) = newGame config
+  in
+    HalmaState
+      { hsRuleOptions = def
+      , hsBoard = board
+      , hsTurnCounter = turnCounter
+      , hsLastMoved = Nothing
+      }
diff --git a/src/Main.hs b/src/Main.hs
new file mode 100644
--- /dev/null
+++ b/src/Main.hs
@@ -0,0 +1,407 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+
+module Main (main) where
+
+import Game.Halma.Board
+import Game.Halma.Board.Draw
+import Game.Halma.Configuration
+import Game.Halma.GUI.State
+import Game.Halma.Rules
+import Game.TurnCounter
+import qualified Game.Halma.AI.Competitive as Competitive
+import qualified Game.Halma.AI.Ignorant as Ignorant
+
+import Control.Concurrent.Async (async, wait)
+import Control.Concurrent.MVar
+import Control.Monad (when)
+import Data.Maybe (isJust)
+import Diagrams.Prelude hiding ((<>), moveTo, set)
+import Diagrams.TwoD.Text (Text)
+import Diagrams.Backend.Cairo.Internal (Cairo)
+import Diagrams.Backend.Gtk
+import GHC.Conc (getNumCapabilities, setNumCapabilities)
+import Graphics.UI.Gtk hiding (get)
+import MVC
+import System.TimeIt
+import qualified Control.Monad.State.Strict as MS
+import qualified Data.Function as F
+import qualified Pipes.Prelude as PP
+
+centered, sizedCentered
+  :: (Transformable a, Enveloped a, V a ~ V2, N a ~ Double)
+  => SizeSpec V2 Double -> a -> a
+centered spec d = transform adjustT d
+  where
+    adjustT = translation $ (0.5 *. P (specToSize 0 spec)) .-. centerPoint d
+sizedCentered spec = centered spec . sized spec
+
+data State
+  = State
+  { stateConfig :: Configuration ()
+  , stateGame :: Maybe (HalmaState ())
+  } deriving (Show)
+
+startNewGame :: State -> State
+startNewGame state =
+  State
+    { stateConfig = stateConfig state
+    , stateGame = Just (initialHalmaState (stateConfig state))
+    }
+
+initialState :: State
+initialState = State (twoPlayersOnSmallGrid () ()) Nothing
+
+data HalmaViewState size
+  = HalmaViewState
+  { hvsBoard :: HalmaBoard
+  , hvsSelectedField :: Maybe (Int, Int)
+  , hvsHighlightedFields :: [(Int, Int)]
+  , hvsLastMoved :: Maybe (Int, Int)
+  , hvsFinishedPlayers :: [Team]
+  , hvsCompetitiveAIAllowed :: Bool
+  } deriving (Eq, Show)
+
+data ViewState where
+  MenuView  :: Configuration () -> ViewState
+  HalmaView :: HalmaViewState size -> ViewState
+
+deriving instance Show ViewState
+
+data QuitType
+  = QuitGame
+  | QuitApp
+  deriving (Show, Eq)
+
+data AIType
+  = Ignorant
+  | Competitive
+  deriving (Eq, Show)
+
+data ViewEvent
+  = Quit QuitType
+  | SetConfiguration (Configuration ())
+  | NewGame
+  | FieldClick (Int, Int)
+  | EmptyClick
+  | AIMove AIType
+  deriving (Eq, Show)
+
+currentTeam :: TurnCounter (Team, a) -> Team
+currentTeam counter = fst (currentPlayer counter)
+
+renderHalmaViewState
+  :: (V b ~ V2, N b ~ Double, Renderable (Path V2 Double) b)
+  => (Team -> Colour Double)
+  -> HalmaViewState size
+  -> QDiagram b V2 Double (Option (Last (Int, Int)))
+renderHalmaViewState teamColors halmaViewState =
+  drawBoard' (getGrid board) drawField
+  where
+    HalmaViewState
+      { hvsBoard = board
+      , hvsSelectedField = startPos
+      , hvsHighlightedFields = highlighted
+      , hvsLastMoved = lastMoved
+      } = halmaViewState
+    drawPiece piece lastMoved' =
+      let c = teamColors (pieceTeam piece)
+      in
+        circle 0.25
+        # fc c
+        # lc (if lastMoved' then darken 0.2 c else darken 0.5 c)
+        # if lastMoved' then lw medium else id
+    startField = startPos >>= flip lookupHalmaBoard board
+    drawField p =
+      (if Just p == startPos then lc black . lw thick else id) $
+      case (lookupHalmaBoard p board, startField) of
+        (Just piece, _) -> drawPiece piece (Just p == lastMoved)
+        (Nothing, Just piece) | p `elem` highlighted ->
+          drawPiece piece False # opacity 0.5
+        _ -> mempty
+
+data ButtonState a
+  = ButtonActive a
+  | ButtonInactive
+  | ButtonSelected
+  deriving (Eq, Show)
+
+button
+  :: (Renderable (Path V2 Double) b, Renderable (Text Double) b)
+  => String
+  -> ButtonState a
+  -> QDiagram b V2 Double (Option (Last a))
+button txt buttonState =
+  (label <> background) # value val' # padX 1.05 # padY 1.2
+  where
+    (label, background) = case buttonState of
+      ButtonActive _ ->
+        ( text txt # fontSizeO 13
+        , roundedRect 110 26 6 # fc lightgray
+        )
+      ButtonInactive ->
+        ( text txt # fontSizeO 13 # fc gray
+        , roundedRect 110 26 6 # fc lightgray # lc gray
+        )
+      ButtonSelected ->
+        ( text txt # fontSizeO 13
+        , roundedRect 110 26 6 # fc yellow # lc black # lw thick
+        )
+    val' =
+      case buttonState of
+        ButtonActive val -> Option (Just (Last val))
+        _ -> Option Nothing
+
+playerFinishedSign
+  :: (Renderable (Path V2 Double) b, Renderable (Text Double) b)
+  => Colour Double
+  -> QDiagram b V2 Double (Option (Last a))
+playerFinishedSign color =
+  (label <> background) # value (Option Nothing) # padX 1.05 # padY 1.5
+  where
+    label = text "finished" # fontSizeO 13
+    background = roundedRect 110 26 6 # fc color # lw none
+
+renderMenu
+  :: (Renderable (Path V2 Double) b, Renderable (Text Double) b)
+  => Configuration ()
+  -> QDiagram b V2 Double (Option (Last (Configuration ())))
+renderMenu config =
+  ((===) `F.on` (centerX . horizontal)) sizeButtons playerButtons
+  where
+    configButtonAction config' =
+      if config == config' then
+        ButtonSelected
+      else
+        ButtonActive config'
+    horizontal = foldl (|||) mempty
+    (sizeButtons, playerButtons) = allButtons
+    allButtons
+      :: (Renderable (Path V2 Double) b, Renderable (Text Double) b)
+      => ( [ QDiagram b V2 Double (Option (Last (Configuration ()))) ]
+         , [ QDiagram b V2 Double (Option (Last (Configuration ()))) ]
+         )
+    allButtons = case configurationGrid config of
+      SmallGrid ->
+        let
+          nopL =
+            case configurationPlayers config of
+              TwoPlayers () () -> TwoPlayers () ()
+              ThreePlayers () () () -> ThreePlayers () () ()
+              _ -> error "impossible"
+        in
+          ( [ button "Small Grid" ButtonSelected
+            , button "Large Grid" $ ButtonActive $ setLargeGrid config
+            ]
+          , [ button "Two Players" $ configButtonAction $ twoPlayersOnSmallGrid () ()
+            , button "Three Players" $ configButtonAction $ threePlayersOnSmallGrid () () ()
+            ] ++ map (flip button ButtonInactive) ["Four Players", "Five Players", "Six Players"]
+          )
+      LargeGrid ->
+        let
+          smallConfig =
+            case configurationPlayers config of
+              TwoPlayers () () -> twoPlayersOnSmallGrid () ()
+              _ -> threePlayersOnSmallGrid () () ()
+        in
+          ( [ button "Small Grid" $ ButtonActive smallConfig
+            , button "Large Grid" ButtonSelected
+            ]
+          , map (\(numStr, players') -> button (numStr ++ " Players") (configButtonAction (playersOnLargeGrid players'))) $
+            [ ("Two", TwoPlayers () ())
+            , ("Three", ThreePlayers () () ())
+            , ("Four", FourPlayers () () () ())
+            , ("Five", FivePlayers () () () () ())
+            , ("Six", SixPlayers () () () () () ())
+            ]
+          )
+
+renderViewState
+  :: (Team -> Colour Double)
+  -> (Double, Double)
+  -> ViewState
+  -> QDiagram Cairo V2 Double (Option (Last ViewEvent))
+renderViewState _teamColors (w,h) (MenuView config) =
+  let menuDiagram   = fmap (fmap SetConfiguration) <$> renderMenu config
+      newGameButton = button "New Game" (ButtonActive NewGame) # padY 1.5
+      reposition    = centered (dims (r2 (w, h))) . toGtkCoords
+  in reposition (menuDiagram === newGameButton)
+renderViewState teamColors (w,h) (HalmaView halmaViewState) =
+  let
+    resize = sizedCentered (dims (r2 (w, h))) . toGtkCoords . pad 1.05
+    buttons =
+      padY 1.3 $
+        quitGameButton
+        ===
+        padY 1.3 aiButtons
+    quitGameButton = button "Quit Game" $ ButtonActive $ Quit QuitGame
+    aiButtons =
+      button "AI Move" (aiButtonState Ignorant)
+      ===
+      if hvsCompetitiveAIAllowed halmaViewState then
+        button "Competitive" (aiButtonState Competitive)
+      else
+        mempty
+    aiButtonState aiMoveType =
+      if isJust (hvsSelectedField halmaViewState) then
+        ButtonInactive
+      else
+        ButtonActive $ AIMove aiMoveType
+    finishedSigns =
+      foldl (===) mempty $
+      map (playerFinishedSign . teamColors) $
+      hvsFinishedPlayers halmaViewState
+    field = resize (fmap (fmap FieldClick) <$> renderHalmaViewState teamColors halmaViewState)
+  in toGtkCoords (buttons === finishedSigns) `atop` field
+
+external :: Managed (View ViewState, Controller ViewEvent)
+external = managed $ \f -> do
+  _ <- initGUI
+  window <- windowNew
+  canvas <- drawingAreaNew
+  set window [ containerBorderWidth := 0, containerChild := canvas ]
+
+  viewState <- newEmptyMVar
+  (veOutput, veInput) <- spawn (bounded 1)
+
+  let
+    figure winSize =
+      fmap (maybe mempty (renderViewState defaultTeamColours winSize))
+           (tryReadMVar viewState)
+    resizedFigure = do
+      drawWin <- widgetGetDrawWindow canvas
+      (w, h) <- drawableGetSize drawWin
+      figure (fromIntegral w, fromIntegral h)
+    renderFigure = tryEvent $ do
+      win <- eventWindow
+      liftIO $ putStr "Render time: "
+      liftIO $ timeIt $ resizedFigure >>= renderToGtk win
+    updateViewState vs = do
+      _ <- tryTakeMVar viewState
+      putMVar viewState vs
+      widgetQueueDraw canvas -- send redraw request to canvas
+    handleClick = tryEvent $ do
+      _click <- eventClick
+      (x,y) <- eventCoordinates
+      fig <- liftIO resizedFigure
+      let result = runQuery (query fig) (P (r2 (x, y)))
+          event = maybe EmptyClick getLast $ getOption result
+      liftIO $ print event
+      void $ liftIO $ atomically $ send veOutput event
+    handleDestroy = do
+      _ <- atomically $ send veOutput $ Quit QuitApp
+      mainQuit
+
+  _ <- canvas `on` sizeRequest $ return (Requisition 650 450)
+  _ <- canvas `on` exposeEvent $ renderFigure
+  _ <- canvas `on` buttonPressEvent $ handleClick
+  _ <- window `onDestroy` handleDestroy
+
+  res <- async $ f (asSink updateViewState, asInput veInput)
+  widgetShowAll window
+  mainGUI
+  wait res
+
+gameLoop
+  :: Configuration ()
+  -> HalmaState ()
+  -> Pipe ViewEvent (HalmaViewState size) (MS.State State) QuitType
+gameLoop config halmaState = noSelectionLoop
+  where
+    HalmaState
+      { hsRuleOptions = ruleOptions
+      , hsBoard = board
+      , hsTurnCounter = turnCounter
+      , hsLastMoved = lastMoved
+      } = halmaState
+    team = currentTeam turnCounter
+    finishedPlayers = filter (hasFinished board) (fst <$> tcPlayers turnCounter)
+    competitiveAIAllowed = length (tcPlayers turnCounter) == 2
+    noSelectionLoop = do
+      yield
+        HalmaViewState
+        { hvsBoard = board
+        , hvsSelectedField = Nothing
+        , hvsHighlightedFields = []
+        , hvsLastMoved = lastMoved
+        , hvsFinishedPlayers = finishedPlayers
+        , hvsCompetitiveAIAllowed = competitiveAIAllowed
+        }
+      event <- await
+      case event of
+        EmptyClick -> noSelectionLoop
+        FieldClick p | (pieceTeam <$> lookupHalmaBoard p board) == Just team ->
+          selectionLoop p
+        FieldClick _ -> noSelectionLoop
+        AIMove Ignorant ->
+          performMove $
+            Ignorant.aiMove ruleOptions board (currentTeam turnCounter)
+        AIMove Competitive ->
+          performMove $
+            Competitive.aiMove ruleOptions board
+              (currentTeam turnCounter, currentTeam $ nextTurn turnCounter)
+        Quit quitType -> return quitType
+        _ -> return QuitApp
+    selectionLoop startPos = do
+      let possible = possibleMoves ruleOptions board startPos
+      yield
+        HalmaViewState
+          { hvsBoard = board
+          , hvsSelectedField = Just startPos
+          , hvsHighlightedFields = possible
+          , hvsLastMoved = Nothing
+          , hvsFinishedPlayers = finishedPlayers
+          , hvsCompetitiveAIAllowed = competitiveAIAllowed
+          }
+      event <- await
+      case event of
+        EmptyClick -> noSelectionLoop
+        FieldClick p | p `elem` possible ->
+          performMove Move { moveFrom = startPos, moveTo = p}
+        FieldClick p | (pieceTeam <$> lookupHalmaBoard p board) == Just team ->
+          selectionLoop p
+        FieldClick _ -> noSelectionLoop
+        Quit quitType -> return quitType
+        _ -> return QuitApp
+    performMove move = do
+      let
+        Right board' = movePiece move board
+        halmaState' =
+          HalmaState
+          { hsRuleOptions = ruleOptions
+          , hsBoard = board'
+          , hsTurnCounter = nextTurn turnCounter
+          , hsLastMoved = Just (moveTo move)
+          }
+      MS.put $ State config (Just halmaState')
+      gameLoop config halmaState'
+
+
+pipe :: Pipe ViewEvent ViewState (MS.State State) ()
+pipe = do
+  st@(State config mHalmaState) <- MS.get
+  case mHalmaState of
+    Just halmaState -> do
+      quitType <- gameLoop config halmaState >-> PP.map HalmaView
+      when (quitType == QuitGame) $
+        MS.put (State config Nothing) >> pipe
+    Nothing -> do
+      yield $ MenuView config
+      event <- await
+      case event of
+        SetConfiguration config' ->
+          MS.put (State config' Nothing) >> pipe
+        NewGame -> MS.put (startNewGame st) >> pipe
+        _ -> pipe
+
+main :: IO ()
+main = do
+  -- we need at least two threads:
+  -- * one for the GTK event loop
+  -- * one for the MVC pipeline
+  caps <- getNumCapabilities
+  when (caps < 2) $ setNumCapabilities 2
+  void $ runMVC initialState (asPipe pipe) external