diff --git a/DefendTheKing.cabal b/DefendTheKing.cabal
--- a/DefendTheKing.cabal
+++ b/DefendTheKing.cabal
@@ -1,5 +1,5 @@
 Name:                DefendTheKing
-Version:             0.2
+Version:             0.2.1
 Cabal-Version:       >= 1.2
 Synopsis:            A simple RTS game
 Category:            game, FRP
@@ -26,7 +26,7 @@
   Executable:        defend
   HS-Source-Dirs:    src
   Main-IS:           defend.hs
-  Other-Modules:     Geometry, Networking, ParseStun, Intro, Draw
+  Other-Modules:     Geometry, Networking, ParseStun, Intro, Draw, Parse, NetMatching, NetEngine, Chess, GameLogic, Font
   Build-Depends:     base >=2 && < 5, peakachu >= 0.2, GLUT, containers,
                      random, time, utility-ht, haskell98,
                      network, HTTP, mtl, bytestring, binary,
diff --git a/src/Chess.hs b/src/Chess.hs
new file mode 100644
--- /dev/null
+++ b/src/Chess.hs
@@ -0,0 +1,184 @@
+module Chess (
+  PieceType(..), BoardPos, PieceSide(..), Piece(..), Board(..),
+  chessStart, pieceAt, possibleMoves
+  ) where
+
+import Control.Monad (guard)
+import Data.Foldable (Foldable, all, any, toList)
+import Prelude hiding (all, any, null)
+
+data PieceType =
+  Pawn | Knight | Bishop | Rook | Queen | King
+  deriving (Eq, Read, Show)
+
+type BoardPos = (Integer, Integer)
+
+data PieceSide = Black | White
+  deriving (Eq, Read, Show)
+
+data Piece = Piece {
+  pieceSide :: PieceSide,
+  pieceType :: PieceType,
+  piecePos :: BoardPos,
+  pieceMoved :: Bool
+}
+
+data Board = Board {
+  boardPieces :: [Piece],
+  boardLastMove :: Maybe (Piece, BoardPos)
+}
+
+chessStart :: Board
+chessStart =
+  Board {
+    boardPieces =
+      concat (zipWith headRowItems [0..7] headRowTypes) ++
+      [Piece side Pawn (x, y) False |
+      x <- [0..7], (side, y) <- [(White, 1), (Black, 6)]],
+    boardLastMove = Nothing
+  }
+  where
+    headRowTypes = [Rook, Knight, Bishop, Queen, King, Bishop, Knight, Rook]
+    headRowItems x t = do
+      (col, row) <- [(White, 0), (Black, 7)]
+      return $ Piece col t (x, row) False
+
+addPos :: BoardPos -> BoardPos -> BoardPos
+addPos (xa, ya) (xb, yb) = (xa+xb, ya+yb)
+
+rays :: PieceType -> [[BoardPos]]
+rays Knight = do
+  a <- [1, -1]
+  b <- [2, -2]
+  [[(a, b)], [(b, a)]]
+rays Bishop = do
+  dx <- [1, -1]
+  dy <- [1, -1]
+  return $ iterate (addPos (dx, dy)) (dx, dy)
+rays Rook = do
+  (dx, dy) <- [(-1, 0), (1, 0), (0, -1), (0, 1)]
+  return $ iterate (addPos (dx, dy)) (dx, dy)
+rays Queen = rays Bishop ++ rays Rook
+rays King = map (take 1) $ rays Queen
+rays Pawn = []
+
+pieceAt :: Board -> BoardPos -> Maybe Piece
+pieceAt board pos =
+  case filter ((== pos) . piecePos) (boardPieces board) of
+    [] -> Nothing
+    (x : _) -> Just x
+
+takeUntilIncluding :: (a -> Bool) -> [a] -> [a]
+takeUntilIncluding _ [] = []
+takeUntilIncluding func (x : xs)
+  | func x = [x]
+  | otherwise = x : takeUntilIncluding func xs
+
+null :: Foldable t => t a -> Bool
+null = all (const False)
+
+possibleMoves :: Board -> Piece -> [(BoardPos, Board)]
+possibleMoves board piece =
+  simpleMoves ++ otherMoves (pieceType piece)
+  where
+    simpleMoves = do
+      relRay <- rays (pieceType piece)
+      dst <-
+        takeUntilIncluding (not . null . pieceAt board) .
+        takeWhile notBlocked $
+        map (addPos src) relRay
+      return $ simpleMove dst
+    src@(srcX, _) = piecePos piece
+    move updPiece clearPos dst =
+      (dst, newBoard)
+      where
+        newBoard =
+          Board {
+            boardPieces =
+              newPieceState :
+              filter (not . (`elem` [src, clearPos]) . piecePos)
+              (boardPieces board),
+            boardLastMove = Just (newPieceState, src)
+          }
+        newPieceState =
+          updPiece { piecePos = dst, pieceMoved = True }
+    simpleMove dst = move piece dst dst
+    inBoard (x, y) = 0 <= x && x < 8 && 0 <= y && y < 8
+    isOtherSide = (/= pieceSide piece) . pieceSide
+    notBlocked pos =
+      inBoard pos &&
+      all isOtherSide (pieceAt board pos)
+    promotionRow = pawnStartRow + 6 * forward
+    pawnMove dst@(_, dy)
+      | dy /= promotionRow = simpleMove dst
+      | otherwise = move (piece { pieceType = Queen }) dst dst
+    otherMoves Pawn =
+      (enPassant (boardLastMove board) ++) $
+      map pawnMove .
+      filter inBoard $
+      moveForward ++
+      filter (any isOtherSide . pieceAt board)
+        [(sx-1, sy+forward), (sx+1, sy+forward)] ++
+      do
+        guard $ sy == pawnStartRow
+        guard . not $ null moveForward
+        guard . null $ pieceAt board sprintDst
+        return sprintDst
+      where
+        moveForward = filter (null . pieceAt board) [(sx, sy+forward)]
+        sprintDst = (sx, sy+forward*2)
+        enPassant Nothing = []
+        enPassant (Just (lpiece, (mx, my)))
+          | py /= sy = []
+          | abs (mx-sx) /= 1 = []
+          | abs (py-my) /= 2 = []
+          | pieceType lpiece /= Pawn = []
+          | pieceSide lpiece == pieceSide piece = []
+          | not (null (pieceAt board dst)) = []
+          | otherwise = [move piece prevPos dst]
+          where
+            dst = (mx, sy+forward)
+            prevPos@(_, py) = piecePos lpiece
+    otherMoves King = do
+      guard . not $ pieceMoved piece
+      (rookX, direction) <- [(0, -1), (7, 1)]
+      let
+        dangerZone =
+          map fst $
+          concatMap (possibleMoves board) dangers
+        dangers = filter isDanger $ boardPieces board
+        isDanger p =
+          pieceSide p /= pieceSide piece &&
+          (pieceMoved p || pieceType p /= King)
+        rookDstX = srcX + direction
+        kingDstX = srcX + 2*direction
+        putInRow x = (x, sy)
+        clearPath = map putInRow [srcX + direction, srcX + direction*2 .. rookX - direction]
+        safePath = map putInRow [srcX, srcX + direction]
+        rookPos = (rookX, sy)
+        kingDst = (kingDstX, sy)
+        newKingState =
+          piece { piecePos = kingDst, pieceMoved = True }
+      rook <- toList $ pieceAt board rookPos
+      guard $ Rook == pieceType rook
+      guard . not . pieceMoved $ rook
+      guard . all (null . pieceAt board) $ clearPath
+      guard . all (`notElem` dangerZone) $ safePath
+      let
+        newRookState =
+          rook { piecePos = (rookDstX, sy), pieceMoved = True }
+        newBoard =
+          Board {
+            boardPieces =
+              [newKingState, newRookState] ++
+              filter (not . (`elem` [src, rookPos]) . piecePos)
+              (boardPieces board),
+            boardLastMove = Just (newKingState, src)
+          }
+      return (kingDst, newBoard)
+    otherMoves _ = []
+    (forward, pawnStartRow)
+      | pieceSide piece == White = (1, 1)
+      | otherwise = (-1, 6)
+    (sx, sy) = src
+
diff --git a/src/Font.hs b/src/Font.hs
new file mode 100644
--- /dev/null
+++ b/src/Font.hs
@@ -0,0 +1,31 @@
+module Font (
+  DefendFont, DrawPos, Pix(..),
+  loadFont
+  ) where
+
+import Geometry (triangulatePolygon)
+
+import Data.Map (Map)
+import Graphics.UI.GLUT (GLfloat)
+
+type DrawPos = (GLfloat, GLfloat)
+
+data Pix = Pix {
+  pixOutline :: [[DrawPos]],
+  -- | pixBody can (and is) be calculated from pixOutline
+  -- it is in Pix for memoing this calculation.
+  pixBody :: [[DrawPos]]
+}
+
+type DefendFont = Map String Pix
+
+loadFont :: String -> DefendFont
+loadFont =
+  fmap loadChar . read
+  where
+    loadChar polygons =
+      Pix {
+        pixOutline = polygons,
+        pixBody = triangulatePolygon =<< polygons
+      }
+
diff --git a/src/GameLogic.hs b/src/GameLogic.hs
new file mode 100644
--- /dev/null
+++ b/src/GameLogic.hs
@@ -0,0 +1,44 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
+
+module GameLogic
+  ( Move(..), PartialData(..), visibleSquares
+  ) where
+
+import Chess
+
+import Control.Monad (guard)
+import Data.List (group, partition, sort)
+
+data Move = Move
+  { moveSrc :: BoardPos
+  , moveIter :: Integer
+  , moveDst :: BoardPos
+  }
+  deriving (Read, Show)
+
+class PartialData a b where
+  getPartial :: b -> a
+
+instance PartialData a a where
+  getPartial = id
+
+instance PartialData a b => PartialData a (c -> b) where
+  getPartial x = getPartial (x undefined)
+
+sortNub :: Ord a => [a] -> [a]
+sortNub = map head . group . sort
+
+visibleSquares :: PieceSide -> Board -> [BoardPos]
+visibleSquares side board =
+  sortNub $ (goodPieces >>= sees) ++ (evilPieces >>= threats)
+  where
+    (goodPieces, evilPieces) =
+      partition ((== side) . pieceSide) (boardPieces board)
+    theKings = filter ((== King) . pieceType) goodPieces
+    [theKing] = theKings
+    sees p = piecePos p : map fst (possibleMoves board p)
+    threats p = do
+      guard . not . null $ theKings
+      guard $ piecePos theKing `elem` sees p
+      return $ piecePos p
+
diff --git a/src/NetEngine.hs b/src/NetEngine.hs
new file mode 100644
--- /dev/null
+++ b/src/NetEngine.hs
@@ -0,0 +1,226 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module NetEngine
+  ( NetEngineOutput(..), NetEngineInput(..)
+  , netEngine
+  , gNEOMove, gNEOPacket, gNEOSetIterTimer
+  , gNEOPeerConnected, gNEOGameIteration
+  ) where
+
+import Control.Applicative
+import Control.Category
+import Control.FilterCategory
+import Codec.Compression.Zlib (decompress, compress)
+import Control.Monad ((>=>))
+import Data.ADT.Getters
+import Data.ByteString.Lazy.Char8 (ByteString, pack, unpack)
+import Data.Function (on)
+import Data.List (isPrefixOf, partition)
+import Data.Map (Map, delete, fromList, insert, lookup, toList)
+import Data.Monoid (Monoid(..))
+import FRP.Peakachu.Program
+import Network.Socket (SockAddr)
+import Prelude hiding ((.), id, lookup)
+
+data NetEngineState moveType idType = NetEngineState
+  { neLocalQueue :: [(Integer, moveType)]
+  , neQueue :: Map (Integer, idType) moveType
+  , nePeers :: [idType]
+  , nePeerAddrs :: [SockAddr]
+  , neWaitingForPeers :: Bool
+  , neGameIteration :: Integer
+  , neOutputMove :: moveType
+  , neLatencyIters :: Integer
+  , neMyPeerId :: idType
+  }
+
+data NetEngineOutput moveType idType
+  = NEOMove moveType
+  | NEOPeerConnected idType
+  | NEOPacket String SockAddr
+  | NEOSetIterTimer
+  | NEOGameIteration Integer
+  deriving Show
+$(mkADTGetters ''NetEngineOutput)
+
+data NetEngineInput moveType
+  = NEIMove Integer moveType
+  | NEIPacket String SockAddr
+  | NEIMatching [SockAddr]
+  | NEIIterTimer
+  | NEITransmitTimer
+$(mkADTGetters ''NetEngineInput)
+
+data NetEngineMid moveType idType
+  = AInput (NetEngineInput moveType)
+  | AState (NetEngineState moveType idType)
+$(mkADTGetters ''NetEngineMid)
+
+data HelloType = LetsPlay | WereOn
+  deriving (Read, Show, Eq)
+
+data NetEngPacket m i
+  = Moves (Map (Integer, i) m)
+  | Hello i HelloType
+  deriving (Read, Show)
+
+magic :: String
+magic = "dtkffod!"
+
+atP :: FilterCategory cat => (a -> Maybe b) -> cat a b
+atP = mapMaybeC
+
+outPacket
+  :: (Show a, Show i)
+  => NetEngPacket a i -> SockAddr -> NetEngineOutput a i
+outPacket = NEOPacket . (magic ++) . withPack compress . show
+
+withPrev :: MergeProgram a (a, a)
+withPrev = (,) <$> delayP (1::Int) <*> id
+
+atChgOf :: Eq b
+  => (a -> b) -> MergeProgram a a
+atChgOf onfunc =
+  arrC snd . filterC (uncurry (on (/=) onfunc)) . withPrev
+
+netEngine
+  :: ( Monoid moveType, Ord peerIdType
+     , Read moveType, Read peerIdType
+     , Show moveType, Show peerIdType
+     )
+  => peerIdType
+  -> MergeProgram
+     (NetEngineInput moveType)
+     (NetEngineOutput moveType peerIdType)
+netEngine myPeerId =
+  mconcat
+  [ NEOSetIterTimer <$ singleValueP
+  , mconcat
+    [ mconcat
+      [ NEOMove . neOutputMove <$> id
+      , NEOSetIterTimer <$ id
+      , NEOGameIteration . neGameIteration <$> id
+      ] . atChgOf neGameIteration . atP gAState
+    , mconcat
+      [ outPacket (Hello myPeerId WereOn)
+        <$> flattenC
+        . arrC nePeerAddrs
+      , arrC NEOPeerConnected
+        . filterC (/= myPeerId)
+        . flattenC
+        . arrC nePeers
+      ]
+      . atChgOf nePeerAddrs
+      . atP gAState
+    , flattenC 
+      . ( sendMoves
+          <$> (lstP gAState <* atP (gAInput >=> gNEITransmitTimer))
+        )
+    ]
+    . mconcat
+    [ AState <$> scanlP netEngineStep (startState myPeerId)
+    , arrC AInput
+    ]
+  , outPacket (Hello myPeerId LetsPlay) <$> flattenC . atP gNEIMatching
+  -- for warnings
+  , unwarn gNEIIterTimer
+  , unwarn gNEIMove
+  , unwarn gNEIPacket
+  ]
+  where
+    unwarn x = undefined <$> filterC (const False) . atP x
+    sendMoves state =
+      outPacket (Moves (neQueue state)) <$> nePeerAddrs state
+
+startState
+  :: (Monoid moveType, Ord peerIdType)
+  => peerIdType -> NetEngineState moveType peerIdType
+startState myPeerId =
+  NetEngineState
+  { neLocalQueue = []
+  , neQueue =
+      fromList
+      [ ((i, myPeerId), mempty)
+      | i <- [0 .. latencyIters-1]
+      ]
+  , nePeers = [myPeerId]
+  , nePeerAddrs = mempty
+  , neWaitingForPeers = False
+  , neGameIteration = 0
+  , neOutputMove = mempty
+  , neLatencyIters = latencyIters
+  , neMyPeerId = myPeerId
+  }
+  where
+    latencyIters = 5
+
+netEngineStep
+  :: (Monoid a, Ord i, Read a, Read i)
+  => NetEngineState a i -> NetEngineInput a -> NetEngineState a i
+netEngineStep state (NEIMove iter move) =
+  state { neLocalQueue = (iter, move) : neLocalQueue state }
+netEngineStep state NEIIterTimer = netEngineNextIter state
+netEngineStep state (NEIPacket contents sender)
+  | isPrefixOf magic contents =
+    processPacket state sender
+    . read . withPack decompress
+    . drop (length magic) $ contents
+  | otherwise = state
+netEngineStep state _ = state
+
+withPack :: (ByteString -> ByteString) -> String -> String
+withPack = (unpack .) . (. pack)
+
+processPacket
+  :: (Monoid a, Ord i)
+  => NetEngineState a i -> SockAddr -> NetEngPacket a i
+  -> NetEngineState a i
+processPacket state sender (Hello peerId _)
+  | length (nePeers state) > 1 = state
+  | otherwise =
+    (startState myPeerId)
+    { nePeers = [myPeerId, peerId]
+    , nePeerAddrs = [sender]
+    }
+  where
+    myPeerId = neMyPeerId state
+processPacket state _ (Moves moves)
+  | neWaitingForPeers state = netEngineNextIter updState
+  | otherwise = updState
+  where
+    updState =
+      state
+      { neQueue =
+          mappend (neQueue state) . fromList
+          . filter ((>= neGameIteration state) . fst . fst)
+          . toList $ moves
+      }
+
+netEngineNextIter ::
+  (Monoid a, Ord i) => NetEngineState a i -> NetEngineState a i
+netEngineNextIter ne =
+  case peerMoves of
+    Nothing -> ne { neWaitingForPeers = True }
+    Just move ->
+      ne
+      { neLocalQueue = futureMoves
+      , neQueue =
+          insert moveKey (mconcat (snd <$> nextMoves)) $
+          foldr delete (neQueue ne) delKeys
+      , neGameIteration = iter + 1
+      , neOutputMove = move
+      , neWaitingForPeers = False
+      }
+  where
+    (nextMoves, futureMoves) =
+      partition ((<= nextMoveIter) . fst)
+      . neLocalQueue $ ne
+    nextMoveIter = iter + neLatencyIters ne
+    moveKey = (nextMoveIter, neMyPeerId ne)
+    iter = neGameIteration ne
+    moveKeys = (,) iter <$> nePeers ne
+    delKeys = (,) (iter - neLatencyIters ne) <$> nePeers ne
+    peerMoves =
+      mconcat <$>
+      sequence ((`lookup` neQueue ne) <$> moveKeys)
+
diff --git a/src/NetMatching.hs b/src/NetMatching.hs
new file mode 100644
--- /dev/null
+++ b/src/NetMatching.hs
@@ -0,0 +1,63 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module NetMatching where
+
+import Networking
+import Parse
+
+import Control.Category
+import Control.FilterCategory
+import Control.Monad (guard)
+import Data.ADT.Getters
+import Data.List (intercalate)
+import Data.Map (delete, insert, lookup)
+import Data.Monoid (Monoid(..))
+import FRP.Peakachu.Program
+import Network.Socket (SockAddr)
+import Prelude hiding ((.), id, lookup)
+
+data MatchingIn a
+  = DoMatching [SockAddr] a
+  | MITimerEvent a
+  | MIHttp (Maybe String) a
+
+data MatchingOut a
+  = MatchingResult [SockAddr] a
+  | MOSetRetryTimer a
+  | MOHttp String a
+  deriving Show
+$(mkADTGetters ''MatchingOut)
+
+netMatching :: (Ord a, ProgCat prog) => prog (MatchingIn a) (MatchingOut a)
+netMatching =
+  mapMaybeC snd . scanlP step (mempty, Nothing)
+  where
+    step (state, _) (DoMatching addrs tag) =
+      (newState, req newState tag)
+      where
+        newState = insert tag addrs state
+    step (state, _) (MIHttp response tag) =
+      case parseDifferentAddresses state tag response of
+      Nothing ->
+        ( state
+        , Just $ MOSetRetryTimer tag
+        )
+      Just res ->
+        ( delete tag state
+        , Just $ MatchingResult res tag
+        )
+    step (state, _) (MITimerEvent tag) = (state, req state tag)
+    req state tag =
+      fmap
+        ( (`MOHttp` tag)
+        . ("http://defendtheking.nfshost.com/match.cgi?" ++)
+        )
+      . formatAddrs state $ tag
+    formatAddrs state =
+      fmap (intercalate "," . map show) . (`lookup` state)
+    parseDifferentAddresses state tag response = do
+      text <- response
+      myAddrText <- formatAddrs state tag
+      guard $ myAddrText /= text
+      mapM parseSockAddr . split ',' $ text
+
diff --git a/src/Parse.hs b/src/Parse.hs
new file mode 100644
--- /dev/null
+++ b/src/Parse.hs
@@ -0,0 +1,8 @@
+module Parse (split) where
+
+split :: Eq a => a -> [a] -> [[a]]
+split char =
+  map (takeWhile (/= char)) .
+  takeWhile (not . null) .
+  iterate (drop 1 . dropWhile (/= char))
+