diff --git a/DefendTheKing.cabal b/DefendTheKing.cabal
--- a/DefendTheKing.cabal
+++ b/DefendTheKing.cabal
@@ -1,5 +1,5 @@
 Name:                DefendTheKing
-Version:             0.2.1
+Version:             0.3
 Cabal-Version:       >= 1.2
 Synopsis:            A simple RTS game
 Category:            game, FRP
@@ -23,17 +23,15 @@
 Data-Files:          data/defend.font
 
 Executable defend
-  Executable:        defend
   HS-Source-Dirs:    src
   Main-IS:           defend.hs
   Other-Modules:     Geometry, Networking, ParseStun, Intro, Draw, Parse, NetMatching, NetEngine, Chess, GameLogic, Font
-  Build-Depends:     base >=2 && < 5, peakachu >= 0.2, GLUT, containers,
+  Build-Depends:     base >=2 && < 5, peakachu >= 0.3.0, GLUT, containers,
                      random, time, utility-ht, haskell98,
-                     network, HTTP, mtl, bytestring, binary,
+                     network, HTTP >= 4000.0.5, mtl, bytestring, binary,
                      MaybeT, zlib
   GHC-Options:       -O2 -Wall
 Executable defendFontEdit
-  Executable:        defendFontEdit
   HS-Source-Dirs:    src
   Main-IS:           defendFontEdit.hs
   Other-Modules:     Geometry
diff --git a/data/defend.font b/data/defend.font
--- a/data/defend.font
+++ b/data/defend.font
@@ -1,1 +1,1 @@
-fromList [("",[[]]),("0",[[],[(-0.5,0.25),(-0.25,0.5),(0.25,0.5),(0.5,0.25),(0.5,-0.25),(0.25,-0.5),(-0.25,-0.5),(-0.5,-0.25)]]),("1",[[],[(-0.25,-0.75),(0.0,1.0),(0.25,0.75),(0.0,-1.0)]]),("2",[[],[(-0.75,0.5),(0.25,1.0),(0.5,0.75),(-0.25,-0.75),(0.5,0.0),(0.75,-0.25),(-0.25,-1.0),(-0.5,-0.75),(0.25,0.75)]]),("3",[[],[(-0.75,0.5),(0.25,1.0),(0.5,0.75),(-0.25,0.0),(0.5,0.25),(0.75,0.0),(-0.25,-1.0),(-0.5,-0.75),(0.5,0.0),(-0.25,-0.25),(-0.5,0.0),(0.25,0.75)]]),("4",[[],[(0.5,-0.5),(-0.75,-0.25),(-0.5,1.0),(-0.25,0.75),(-0.5,0.0),(0.25,-0.25),(0.75,1.0),(1.0,-0.75),(0.75,-1.0),(0.75,0.25)]]),("5",[[],[(0.75,1.0),(1.0,0.75),(-0.25,0.5),(0.0,0.0),(0.75,0.25),(1.0,-0.75),(0.0,-1.0),(-0.25,-0.75),(0.75,-0.5),(0.5,-0.25),(-0.25,-0.25),(-0.75,0.75)]]),("6",[[],[(0.75,1.0),(1.0,0.75),(-0.25,0.5),(0.0,0.0),(0.75,0.25),(1.0,-0.75),(-0.5,-1.0),(-0.75,-0.25),(-0.5,0.0),(-0.25,-0.75),(0.75,-0.5),(0.5,-0.25),(-0.25,-0.25),(-0.75,0.75)]]),("7",[[],[(-1.0,0.75),(1.0,1.0),(0.75,-1.0),(0.5,0.5)]]),("8",[[],[(-0.75,0.0),(-1.0,0.75),(0.75,1.0),(1.0,0.0),(-0.25,-0.25),(0.0,-0.75),(0.75,-0.75),(0.75,-0.5),(0.0,-0.5),(0.0,-0.25),(1.0,-0.25),(1.0,-1.0),(-0.25,-1.0),(-0.5,0.0),(0.75,0.25),(0.5,0.75),(-0.5,0.5),(-0.5,0.25)]]),("9",[[],[(-1.0,-0.75),(0.75,-0.5),(0.5,0.75),(-0.75,0.5),(-0.5,-0.25),(0.25,0.0),(-0.25,0.0),(-0.5,0.25),(0.25,0.5),(0.5,-0.25),(-0.75,-0.5),(-1.0,0.75),(0.75,1.0),(1.0,-0.75),(-0.75,-1.0)]]),("a",[[],[(-1.0,-1.0),(0.0,1.0),(1.0,-1.0),(0.0,-0.5)]]),("b",[[],[(-1.0,1.0),(1.0,0.5),(0.0,0.0),(1.0,-0.5),(-1.0,-1.0)]]),("bishop",[[],[(-1.0,-1.0),(0.0,1.0),(1.0,-1.0),(0.0,-0.5)]]),("c",[[],[(-1.0,0.0),(1.0,1.0),(0.0,0.0),(1.0,-1.0)]]),("d",[[],[(-1.0,1.0),(1.0,0.0),(-1.0,-1.0),(-0.5,0.0)]]),("e",[[],[(-1.0,0.0),(1.0,1.0),(0.25,0.25),(1.0,0.0),(0.25,-0.25),(1.0,-1.0)]]),("f",[[],[(-1.0,0.75),(1.0,1.0),(-0.25,0.25),(1.0,0.0),(0.0,-0.25),(-0.5,-1.0)]]),("g",[[],[(-0.25,-1.0),(-0.75,-0.5),(-1.0,0.25),(-0.75,0.75),(0.25,1.0),(1.0,0.75),(0.75,0.5),(0.25,0.75),(-0.5,0.5),(-0.75,0.25),(-0.5,-0.25),(-0.25,-0.75),(0.5,-0.5),(0.0,-0.25),(-0.25,0.0),(0.5,-0.25),(1.0,-0.5)]]),("h",[[],[(-1.0,1.0),(-0.75,1.0),(-0.5,0.25),(0.5,0.0),(0.75,1.0),(1.0,1.0),(1.0,-1.0),(0.75,-1.0),(0.5,-0.25),(-0.5,0.0),(-0.75,-1.0),(-1.0,-1.0)]]),("i",[[],[(-0.25,1.0),(0.5,1.0),(0.25,0.75),(0.0,-0.75),(0.25,-1.0),(-0.5,-1.0),(-0.25,-0.75),(0.0,0.75)]]),("j",[[],[(1.0,1.0),(0.75,0.75),(0.5,-0.5),(0.25,-0.75),(-0.25,-1.0),(-0.75,-0.75),(-1.0,-0.25),(-0.75,0.0),(-0.5,-0.5),(-0.25,-0.75),(0.25,-0.25),(0.5,0.75),(0.25,1.0)]]),("k",[[],[(-1.0,1.0),(-0.5,0.25),(1.0,1.0),(0.75,0.5),(-0.25,0.0),(0.75,-0.75),(0.25,-1.0),(-0.5,-0.25),(-0.75,-0.75),(-1.0,-1.0)]]),("king",[[],[(-0.75,-0.25),(0.0,-0.5),(0.75,-0.25),(0.75,-0.75),(-0.75,-0.75)],[(0.25,0.5),(0.5,0.75),(0.75,0.5),(0.5,0.25)],[(-0.75,0.5),(-0.5,0.75),(-0.25,0.5),(-0.5,0.25)]]),("knight",[[],[(-1.0,-1.0),(0.0,0.0),(-1.0,0.0),(1.0,1.0),(0.5,-1.0)]]),("l",[[],[(-0.75,1.0),(-0.5,-0.5),(1.0,-0.75),(-1.0,-1.0)]]),("m",[[],[(-1.0,-1.0),(-0.5,1.0),(0.0,-0.25),(0.5,1.0),(1.0,-1.0),(0.75,-0.75),(0.5,0.0),(0.0,-1.0),(-0.5,0.0),(-0.75,-0.75)]]),("n",[[],[(-1.0,-1.0),(-0.75,1.0),(0.5,-0.25),(0.75,0.75),(1.0,1.0),(0.75,-1.0),(-0.5,0.0),(-0.75,-0.75)]]),("o",[[],[(-1.0,0.5),(0.5,1.0),(1.0,-0.5),(-0.5,-1.0)]]),("p",[[],[(-1.0,1.0),(0.25,0.75),(0.75,0.5),(1.0,0.25),(0.75,-0.25),(-0.25,-0.5),(0.0,-1.0),(-0.75,-1.0)]]),("pawn",[[],[(-0.25,-0.5),(-0.5,-0.25),(-0.5,0.25),(-0.25,0.5),(0.25,0.5),(0.5,0.25),(0.5,-0.25),(0.25,-0.5)]]),("q",[[],[(0.0,-1.0),(0.25,-0.5),(-0.75,-0.25),(-1.0,0.25),(-0.75,0.5),(-0.25,0.75),(1.0,1.0),(0.75,-1.0)]]),("queen",[[],[(-1.0,-1.0),(-0.5,0.0),(-1.0,1.0),(-0.25,0.5),(0.0,1.0),(0.25,0.5),(1.0,1.0),(0.5,0.0),(1.0,-1.0),(0.0,-0.5)]]),("r",[[],[(-1.0,-1.0),(-0.75,1.0),(0.5,0.75),(0.75,0.5),(1.0,0.0),(0.25,-0.25),(0.75,-1.0),(0.25,-1.0),(-0.25,-0.25),(-0.5,-1.0)]]),("rook",[[],[(-1.0,1.0),(1.0,1.0),(0.5,0.5),(0.5,-0.5),(1.0,-1.0),(-1.0,-1.0),(-0.5,-0.5),(-0.5,0.5)]]),("s",[[],[(-0.75,0.75),(0.75,1.0),(1.0,0.75),(-0.25,0.5),(-0.5,0.25),(1.0,-0.25),(0.75,-0.75),(-0.75,-1.0),(-1.0,-0.75),(0.5,-0.5),(-1.0,0.0)]]),("t",[[],[(-1.0,0.75),(1.0,1.0),(0.75,0.75),(0.0,0.5),(0.25,-1.0),(0.0,-1.0),(-0.25,0.5),(-0.75,0.5)]]),("u",[[],[(-0.75,1.0),(-0.5,-0.5),(0.0,-0.75),(0.5,-0.5),(0.75,1.0),(1.0,0.75),(0.75,-0.75),(0.0,-1.0),(-0.75,-0.75),(-1.0,0.75)]]),("v",[[],[(-0.75,1.0),(0.0,-0.5),(0.75,1.0),(1.0,0.75),(0.0,-1.0),(-1.0,0.75)]]),("w",[[],[(-1.0,0.75),(-0.75,1.0),(-0.5,-0.5),(0.0,1.0),(0.5,-0.5),(0.75,1.0),(1.0,0.75),(0.5,-1.0),(0.0,0.0),(-0.5,-1.0)]]),("x",[[],[(-1.0,0.75),(-0.75,1.0),(0.0,0.25),(0.75,1.0),(1.0,0.75),(0.25,0.0),(1.0,-0.75),(0.75,-1.0),(0.0,-0.25),(-0.75,-1.0),(-1.0,-0.75),(-0.25,0.0)]]),("y",[[],[(-0.25,-0.25),(-1.0,0.75),(-0.75,1.0),(0.0,0.25),(0.75,1.0),(1.0,0.75),(0.25,-0.25),(0.25,-1.0),(-0.25,-1.0)]]),("z",[[(-0.5,-1.5)],[(-1.0,0.75),(0.75,1.0),(1.0,0.75),(0.75,0.25),(-0.25,-0.25),(0.75,-0.5),(1.0,-0.75),(-0.75,-1.0),(-1.0,-0.75),(-0.75,-0.25),(0.25,0.25),(-0.75,0.5)]])]
+fromList [("",[[]]),(".",[[],[(-0.25,0.0),(0.0,0.25),(0.25,0.0),(0.0,-0.25)]]),("0",[[],[(-0.5,0.25),(-0.25,0.5),(0.25,0.5),(0.5,0.25),(0.5,-0.25),(0.25,-0.5),(-0.25,-0.5),(-0.5,-0.25)]]),("1",[[],[(-0.25,-0.75),(0.0,1.0),(0.25,0.75),(0.0,-1.0)]]),("2",[[],[(-0.75,0.5),(0.25,1.0),(0.5,0.75),(-0.25,-0.75),(0.5,0.0),(0.75,-0.25),(-0.25,-1.0),(-0.5,-0.75),(0.25,0.75)]]),("3",[[],[(-0.75,0.5),(0.25,1.0),(0.5,0.75),(-0.25,0.0),(0.5,0.25),(0.75,0.0),(-0.25,-1.0),(-0.5,-0.75),(0.5,0.0),(-0.25,-0.25),(-0.5,0.0),(0.25,0.75)]]),("4",[[],[(0.5,-0.5),(-0.75,-0.25),(-0.5,1.0),(-0.25,0.75),(-0.5,0.0),(0.25,-0.25),(0.75,1.0),(1.0,-0.75),(0.75,-1.0),(0.75,0.25)]]),("5",[[],[(0.75,1.0),(1.0,0.75),(-0.25,0.5),(0.0,0.0),(0.75,0.25),(1.0,-0.75),(0.0,-1.0),(-0.25,-0.75),(0.75,-0.5),(0.5,-0.25),(-0.25,-0.25),(-0.75,0.75)]]),("6",[[],[(0.75,1.0),(1.0,0.75),(-0.25,0.5),(0.0,0.0),(0.75,0.25),(1.0,-0.75),(-0.5,-1.0),(-0.75,-0.25),(-0.5,0.0),(-0.25,-0.75),(0.75,-0.5),(0.5,-0.25),(-0.25,-0.25),(-0.75,0.75)]]),("7",[[],[(-1.0,0.75),(1.0,1.0),(0.75,-1.0),(0.5,0.5)]]),("8",[[],[(-0.75,0.0),(-1.0,0.75),(0.75,1.0),(1.0,0.0),(-0.25,-0.25),(0.0,-0.75),(0.75,-0.75),(0.75,-0.5),(0.0,-0.5),(0.0,-0.25),(1.0,-0.25),(1.0,-1.0),(-0.25,-1.0),(-0.5,0.0),(0.75,0.25),(0.5,0.75),(-0.5,0.5),(-0.5,0.25)]]),("9",[[],[(-1.0,-0.75),(0.75,-0.5),(0.5,0.75),(-0.75,0.5),(-0.5,-0.25),(0.25,0.0),(-0.25,0.0),(-0.5,0.25),(0.25,0.5),(0.5,-0.25),(-0.75,-0.5),(-1.0,0.75),(0.75,1.0),(1.0,-0.75),(-0.75,-1.0)]]),("a",[[],[(-1.0,-1.0),(0.0,1.0),(1.0,-1.0),(0.0,-0.5)]]),("b",[[],[(-1.0,1.0),(1.0,0.5),(0.0,0.0),(1.0,-0.5),(-1.0,-1.0)]]),("bishop",[[],[(-1.0,-1.0),(0.0,1.0),(1.0,-1.0),(0.0,-0.5)]]),("c",[[],[(-1.0,0.0),(1.0,1.0),(0.0,0.0),(1.0,-1.0)]]),("d",[[],[(-1.0,1.0),(1.0,0.0),(-1.0,-1.0),(-0.5,0.0)]]),("e",[[],[(-1.0,0.0),(1.0,1.0),(0.25,0.25),(1.0,0.0),(0.25,-0.25),(1.0,-1.0)]]),("f",[[],[(-1.0,0.75),(1.0,1.0),(-0.25,0.25),(1.0,0.0),(0.0,-0.25),(-0.5,-1.0)]]),("g",[[],[(-0.25,-1.0),(-0.75,-0.5),(-1.0,0.25),(-0.75,0.75),(0.25,1.0),(1.0,0.75),(0.75,0.5),(0.25,0.75),(-0.5,0.5),(-0.75,0.25),(-0.5,-0.25),(-0.25,-0.75),(0.5,-0.5),(0.0,-0.25),(-0.25,0.0),(0.5,-0.25),(1.0,-0.5)]]),("h",[[],[(-1.0,1.0),(-0.75,1.0),(-0.5,0.25),(0.5,0.0),(0.75,1.0),(1.0,1.0),(1.0,-1.0),(0.75,-1.0),(0.5,-0.25),(-0.5,0.0),(-0.75,-1.0),(-1.0,-1.0)]]),("i",[[],[(-0.25,1.0),(0.5,1.0),(0.25,0.75),(0.0,-0.75),(0.25,-1.0),(-0.5,-1.0),(-0.25,-0.75),(0.0,0.75)]]),("j",[[],[(1.0,1.0),(0.75,0.75),(0.5,-0.5),(0.25,-0.75),(-0.25,-1.0),(-0.75,-0.75),(-1.0,-0.25),(-0.75,0.0),(-0.5,-0.5),(-0.25,-0.75),(0.25,-0.25),(0.5,0.75),(0.25,1.0)]]),("k",[[],[(-1.0,1.0),(-0.5,0.25),(1.0,1.0),(0.75,0.5),(-0.25,0.0),(0.75,-0.75),(0.25,-1.0),(-0.5,-0.25),(-0.75,-0.75),(-1.0,-1.0)]]),("king",[[],[(-0.75,-0.25),(0.0,-0.5),(0.75,-0.25),(0.75,-0.75),(-0.75,-0.75)],[(0.25,0.5),(0.5,0.75),(0.75,0.5),(0.5,0.25)],[(-0.75,0.5),(-0.5,0.75),(-0.25,0.5),(-0.5,0.25)]]),("knight",[[],[(-1.0,-1.0),(0.0,0.0),(-1.0,0.0),(1.0,1.0),(0.5,-1.0)]]),("l",[[],[(-0.75,1.0),(-0.5,-0.5),(1.0,-0.75),(-1.0,-1.0)]]),("m",[[],[(-1.0,-1.0),(-0.5,1.0),(0.0,-0.25),(0.5,1.0),(1.0,-1.0),(0.75,-0.75),(0.5,0.0),(0.0,-1.0),(-0.5,0.0),(-0.75,-0.75)]]),("n",[[],[(-1.0,-1.0),(-0.75,1.0),(0.5,-0.25),(0.75,0.75),(1.0,1.0),(0.75,-1.0),(-0.5,0.0),(-0.75,-0.75)]]),("o",[[],[(-1.0,0.5),(0.5,1.0),(1.0,-0.5),(-0.5,-1.0)]]),("p",[[],[(-1.0,1.0),(0.25,0.75),(0.75,0.5),(1.0,0.25),(0.75,-0.25),(-0.25,-0.5),(0.0,-1.0),(-0.75,-1.0)]]),("pawn",[[],[(-0.25,-0.5),(-0.5,-0.25),(-0.5,0.25),(-0.25,0.5),(0.25,0.5),(0.5,0.25),(0.5,-0.25),(0.25,-0.5)]]),("q",[[],[(0.0,-1.0),(0.25,-0.5),(-0.75,-0.25),(-1.0,0.25),(-0.75,0.5),(-0.25,0.75),(1.0,1.0),(0.75,-1.0)]]),("queen",[[],[(-1.0,-1.0),(-0.5,0.0),(-1.0,1.0),(-0.25,0.5),(0.0,1.0),(0.25,0.5),(1.0,1.0),(0.5,0.0),(1.0,-1.0),(0.0,-0.5)]]),("r",[[],[(-1.0,-1.0),(-0.75,1.0),(0.5,0.75),(0.75,0.5),(1.0,0.0),(0.25,-0.25),(0.75,-1.0),(0.25,-1.0),(-0.25,-0.25),(-0.5,-1.0)]]),("rook",[[],[(-1.0,1.0),(1.0,1.0),(0.5,0.5),(0.5,-0.5),(1.0,-1.0),(-1.0,-1.0),(-0.5,-0.5),(-0.5,0.5)]]),("s",[[],[(-0.75,0.75),(0.75,1.0),(1.0,0.75),(-0.25,0.5),(-0.5,0.25),(1.0,-0.25),(0.75,-0.75),(-0.75,-1.0),(-1.0,-0.75),(0.5,-0.5),(-1.0,0.0)]]),("t",[[],[(-1.0,0.75),(1.0,1.0),(0.75,0.75),(0.0,0.5),(0.25,-1.0),(0.0,-1.0),(-0.25,0.5),(-0.75,0.5)]]),("u",[[],[(-0.75,1.0),(-0.5,-0.5),(0.0,-0.75),(0.5,-0.5),(0.75,1.0),(1.0,0.75),(0.75,-0.75),(0.0,-1.0),(-0.75,-0.75),(-1.0,0.75)]]),("v",[[],[(-0.75,1.0),(0.0,-0.5),(0.75,1.0),(1.0,0.75),(0.0,-1.0),(-1.0,0.75)]]),("w",[[],[(-1.0,0.75),(-0.75,1.0),(-0.5,-0.5),(0.0,1.0),(0.5,-0.5),(0.75,1.0),(1.0,0.75),(0.5,-1.0),(0.0,0.0),(-0.5,-1.0)]]),("x",[[],[(-1.0,0.75),(-0.75,1.0),(0.0,0.25),(0.75,1.0),(1.0,0.75),(0.25,0.0),(1.0,-0.75),(0.75,-1.0),(0.0,-0.25),(-0.75,-1.0),(-1.0,-0.75),(-0.25,0.0)]]),("y",[[],[(-0.25,-0.25),(-1.0,0.75),(-0.75,1.0),(0.0,0.25),(0.75,1.0),(1.0,0.75),(0.25,-0.25),(0.25,-1.0),(-0.25,-1.0)]]),("z",[[(-0.5,-1.5)],[(-1.0,0.75),(0.75,1.0),(1.0,0.75),(0.75,0.25),(-0.25,-0.25),(0.75,-0.5),(1.0,-0.75),(-0.75,-1.0),(-1.0,-0.75),(-0.75,-0.25),(0.25,0.25),(-0.75,0.5)]])]
diff --git a/src/Draw.hs b/src/Draw.hs
--- a/src/Draw.hs
+++ b/src/Draw.hs
@@ -70,8 +70,8 @@
       headingUp
       materialDiffuse Front $= bodyCol
       renderPrimitive Triangles .
-        forM (pixBody pix) .
-        mapM $ vert (pieceSize * 0.125)
+        forM_ (pixBody pix) .
+        mapM_ $ vert (pieceSize * 0.125)
       materialDiffuse Front $= outlineCol
       renderPrimitive Quads .
         forM (pixOutline pix) $ \outline ->
@@ -140,6 +140,6 @@
         Just p -> map (map t) . pixOutline . piecePix font $ pieceType p
       where
         t (x, y) = (pieceSize*x, pieceSize*y)
-    square = [((-1), (-1)), ((-1), 1), (1, 1), (1, (-1))]
+    square = [(-1, -1), (-1, 1), (1, 1), (1, -1)]
 
 
diff --git a/src/Font.hs b/src/Font.hs
--- a/src/Font.hs
+++ b/src/Font.hs
@@ -1,11 +1,11 @@
-module Font (
-  DefendFont, DrawPos, Pix(..),
-  loadFont
+module Font
+  ( DefendFont, DrawPos, Pix(..)
+  , loadFont, renderText
   ) where
 
 import Geometry (triangulatePolygon)
 
-import Data.Map (Map)
+import Data.Map (Map, (!))
 import Graphics.UI.GLUT (GLfloat)
 
 type DrawPos = (GLfloat, GLfloat)
@@ -28,4 +28,21 @@
         pixOutline = polygons,
         pixBody = triangulatePolygon =<< polygons
       }
+
+renderText :: DefendFont -> String -> [[DrawPos]]
+renderText font text =
+  concat . zipWith doLine lns $ zip rowCenters rowHeights
+  where
+    lns = lines text
+    rowHeights = map ((2 /) . fromIntegral . length) lns
+    top = sum rowHeights / 2
+    rowTops = scanl (-) top rowHeights
+    rowCenters = zipWith (flip (-) . (/ 2)) rowHeights rowTops
+    doLine line (mid, size) =
+      concat $ zipWith doLetter [(0 :: Int) ..] line
+      where
+        doLetter _ ' ' = []
+        doLetter off letter =
+          map (map (trans size (size * fromIntegral (2 * off + 1 - length line) / 2, mid))) . pixBody $ font ! [letter]
+    trans s (dx, dy) (sx, sy) = (dx+s*sx/2, dy+s*sy/2)
 
diff --git a/src/GameLogic.hs b/src/GameLogic.hs
--- a/src/GameLogic.hs
+++ b/src/GameLogic.hs
@@ -11,6 +11,7 @@
 
 data Move = Move
   { moveSrc :: BoardPos
+  , movePlayer :: PieceSide
   , moveIter :: Integer
   , moveDst :: BoardPos
   }
diff --git a/src/Intro.hs b/src/Intro.hs
--- a/src/Intro.hs
+++ b/src/Intro.hs
@@ -7,7 +7,6 @@
 import Control.Category
 import Control.FilterCategory
 import Control.Monad (forM_)
-import Data.Map ((!))
 import Data.Time.Clock
 import FRP.Peakachu.Backend.GLUT
 import FRP.Peakachu.Program
@@ -21,23 +20,6 @@
   where
     step Nothing x = Just (x, x)
     step (Just (_, start)) x = Just (x, start)
-
-renderText :: DefendFont -> String -> [[DrawPos]]
-renderText font text =
-  concat . zipWith doLine lns $ zip rowCenters rowHeights
-  where
-    lns = lines text
-    rowHeights = map ((2 /) . fromIntegral . length) lns
-    top = sum rowHeights / 2
-    rowTops = scanl (-) top rowHeights
-    rowCenters = zipWith (flip (-) . (/ 2)) rowHeights rowTops
-    doLine line (mid, size) =
-      concat $ zipWith doLetter [(0 :: Int) ..] line
-      where
-        doLetter _ ' ' = []
-        doLetter off letter =
-          map (map (trans size (size * fromIntegral (2 * off + 1 - length line) / 2, mid))) . pixBody $ font ! [letter]
-    trans s (dx, dy) (sx, sy) = (dx+s*sx/2, dy+s*sy/2)
 
 intro :: DefendFont -> Program UTCTime Image
 intro font =
diff --git a/src/NetEngine.hs b/src/NetEngine.hs
--- a/src/NetEngine.hs
+++ b/src/NetEngine.hs
@@ -75,23 +75,15 @@
   => NetEngPacket a i -> SockAddr -> NetEngineOutput a i
 outPacket = NEOPacket . (magic ++) . withPack compress . show
 
-withPrev :: MergeProgram a (a, a)
+withPrev :: Program 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
+atChgOf :: Eq b => (a -> b) -> Program 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)
+  :: (Monoid moveType, Ord peerIdType, Read moveType, Read peerIdType, Show moveType, Show peerIdType)
+  => peerIdType -> Program (NetEngineInput moveType) (NetEngineOutput moveType peerIdType)
 netEngine myPeerId =
   mconcat
   [ NEOSetIterTimer <$ singleValueP
@@ -161,7 +153,7 @@
   state { neLocalQueue = (iter, move) : neLocalQueue state }
 netEngineStep state NEIIterTimer = netEngineNextIter state
 netEngineStep state (NEIPacket contents sender)
-  | isPrefixOf magic contents =
+  | magic `isPrefixOf` contents =
     processPacket state sender
     . read . withPack decompress
     . drop (length magic) $ contents
diff --git a/src/NetMatching.hs b/src/NetMatching.hs
--- a/src/NetMatching.hs
+++ b/src/NetMatching.hs
@@ -28,7 +28,7 @@
   deriving Show
 $(mkADTGetters ''MatchingOut)
 
-netMatching :: (Ord a, ProgCat prog) => prog (MatchingIn a) (MatchingOut a)
+netMatching :: Ord a => Program (MatchingIn a) (MatchingOut a)
 netMatching =
   mapMaybeC snd . scanlP step (mempty, Nothing)
   where
diff --git a/src/Networking.hs b/src/Networking.hs
--- a/src/Networking.hs
+++ b/src/Networking.hs
@@ -21,7 +21,8 @@
 import Data.List (nub)
 import Data.Map ((!), insert)
 import Data.Monoid (Monoid(..))
-import FRP.Peakachu.Backend (Backend(..), Sink(..))
+import FRP.Peakachu.Backend (Backend(..))
+import FRP.Peakachu.Backend.Internal (Sink(..))
 import Network.BSD (getHostByName, getHostName, hostAddress)
 import Network.HTTP (getRequest, rspBody, simpleHTTP)
 import Network.Socket (
@@ -50,7 +51,7 @@
     socketsVar <- newMVar mempty
     let
       consume (CreateUdpListenSocket stunServer tag) = do
-        forkIO $ do
+        _ <- forkIO $ do
           (sock, addrs) <-
             getHostAddrByName stunServer >>=
             createListenUdpSocket . SockAddrInet stunPort
@@ -62,7 +63,7 @@
         return ()
       consume (SendTo msg addr tag) = do
         sockets <- readMVar socketsVar
-        sendTo (sockets ! tag) msg addr
+        _ <- sendTo (sockets ! tag) msg addr
         return ()
     return mempty
       { sinkConsume = consume
@@ -76,7 +77,7 @@
     }
   where
     consume handler (url, tag) = do
-      forkIO $ do
+      _ <- forkIO $ do
         eresp <- simpleHTTP . getRequest $ url
         case eresp of
           Left _ -> handler (Nothing, tag)
@@ -116,13 +117,13 @@
 udpGetInternetAddr :: SockAddr -> Socket -> IO SockAddr
 udpGetInternetAddr stunServer sock = do
   gotResponseVar <- newMVar False
-  forkIO . fix $ \resume -> do
+  _ <- forkIO . fix $ \resume -> do
     gotResponse <- readMVar gotResponseVar
     unless gotResponse $ do
       requestRaw <-
         fmap ("\0\1\0\0" ++) .
         replicateM 16 . fmap chr $ randomRIO (0, 255)
-      sendTo sock requestRaw stunServer
+      _ <- sendTo sock requestRaw stunServer
       threadDelay 500000 -- 0.5 second
       resume
   (responseRaw, _, _) <- recvFrom sock 1024
diff --git a/src/defend.hs b/src/defend.hs
--- a/src/defend.hs
+++ b/src/defend.hs
@@ -13,7 +13,7 @@
 import Control.Applicative
 import Control.Category
 import Control.FilterCategory
-import Control.Monad ((>=>), guard, join)
+import Control.Monad ((>=>), forM_, guard, join)
 import Data.ADT.Getters
 import Data.Function (fix)
 import Data.List (foldl')
@@ -21,6 +21,7 @@
 import Data.Maybe (fromMaybe, isNothing)
 import Data.Monoid
 import Data.Time.Clock
+import Data.Traversable (sequenceA)
 import FRP.Peakachu
 import FRP.Peakachu.Program
 import FRP.Peakachu.Backend.GLUT
@@ -54,6 +55,7 @@
   | OHttp String
   | OPrint String
   | Exit
+  | AText String
   | ABoard Board
   | ASelection Move
   | AQueueMove Move
@@ -64,6 +66,8 @@
   | AMoveLimits (Map MoveLimitType Integer)
   | AGameIteration Integer
   | ALoopback MyNode
+  | ADrawTimes UTCTime
+  | AReadyForGame
 $(mkADTGetters ''MyNode)
 
 maybeMinimumOn :: Ord b => (a -> b) -> [a] -> Maybe a
@@ -85,7 +89,7 @@
   maybeMinimumOn (distance drawPos . board2screen . fst) . possibleMoves board <$>
   pieceAt board src
 
-keyState :: Key -> MergeProgram (GlutToProgram a) KeyState
+keyState :: Key -> Program (GlutToProgram a) KeyState
 keyState key =
   (lstPs . Just) Up (gKeyboardMouseEvent >=> f)
   where
@@ -105,7 +109,7 @@
 gGlut :: MyNode -> Maybe (GlutToProgram MyTimers)
 gGlut = (fmap . fmap) snd gIGlut
 
-matching :: MergeProgram MyNode MyNode
+matching :: Program MyNode MyNode
 matching =
   mconcat
   [ OHttp . fst <$> atP gMOHttp
@@ -120,7 +124,7 @@
   , uncurry DoMatching <$> atP (gIUdp >=> gUdpSocketAddresses)
   ]
 
-neteng :: Integer -> MergeProgram MyNode MyNode
+neteng :: Integer -> Program MyNode MyNode
 neteng myPeerId =
   mconcat
   [ OGlut (SetTimer 25 TimerTransmit) <$
@@ -151,26 +155,40 @@
       | myPeerId < peerId = Black
       | otherwise = White
 
+drawText :: DefendFont -> String -> Image
+drawText font text =
+  Image $ do
+    lighting $= Disabled
+    color $ Color4 0.25 0 0.5 (0.5 :: GLfloat)
+    renderPrimitive Triangles
+      . (forM_ . join) (renderText font text)
+      $ \(x, y) ->
+      vertex $ Vertex4 (x/2) (y/2) 0 1
+
+gNothing :: Maybe a -> Maybe ()
+gNothing Nothing = Just ()
+gNothing _ = Nothing
+
 game :: Integer -> DefendFont -> Program MyNode MyNode
 game myPeerId font =
-  runMergeProg $
   takeWhileP (isNothing . gExit)
   . mconcat
   [ id
-  , OGlut . DrawImage . mappend glStyle
-    <$> (mappend
-      <$> (draw font
-        <$ atP gGlut
-        <*> lstP gABoard
+  , OGlut . DrawImage . mconcat
+    <$ atP gADrawTimes
+    <*> sequenceA
+    [ pure glStyle
+    , draw font
+        <$> lstP gABoard
         <*> lstP gASelection
         <*> mouseMotion
         <*> lstP gASide
         <*> lstP gAGameIteration
-        )
-      <*> MergeProg (intro font) . arrC fst . atP gIGlut
-      )
-  , OUdp (CreateUdpListenSocket stunServer ()) <$ singleValueP
+    , drawText font <$> lstP gAText
+    , intro font . atP gADrawTimes
+    ]
   , Exit <$ atP (gGlut >=> gKeyboardMouseEvent >=> quitButton)
+  , OPrint "Got Udp Addr\n" <$ atP (gIUdp >=> gUdpSocketAddresses)
   ]
   -- loopback because board affects moves and vice versa
   . loopbackP (
@@ -181,18 +199,60 @@
     . addP calculateSelection
     . addP calculateBoard
   )
+  . addP emptyP
+  . addP (
+    withAppendProgram2
+    mappend
+    ( atP (const Nothing)
+    . takeWhileP (isNothing . gAReadyForGame)
+    )
+    ( mconcat
+      [ matching
+      , OUdp (CreateUdpListenSocket stunServer ()) <$ singleValueP
+      ]
+    )
+  )
   . mconcat
   [ id
+  , drawTimes
   , ASide Nothing <$ singleValueP
-  -- contact http server
-  , matching
+  , mconcat
+    [ AText <$> atP id
+    , AReadyForGame <$ atP gNothing
+    , AText "" <$ atP gNothing
+    ]
+    . arrC head
+    . takeWhileP (not . null)
+    . scanlP (flip (const tail)) instructions
+    . atP (gGlut >=> gKeyboardMouseEvent >=> space)
   ]
   where
+    instructions =
+      map Just
+      [ "welcome.\nget ready to\ndefend\nthe king.\npress space."
+      , "drag and drop\nsome pieces.\nhit spacebar\nto resume."
+      , "there are no turns.\nwhen the cursor\nis green\n"
+        ++ "you can move.\nspace for more."
+      , "when you\ndefend\nthe king\nyou will not\n"
+        ++ "see the whole\nbattlefield.\nspace to see\nmore instructions."
+      , "you will only\nsee the squares\nin reach of\n"
+        ++ "your army.\nspace for\nnext message.."
+      , "press space again\nto battle\nagainst a real\nking\n"
+        ++ "like you.\nexcept evil."
+      ] ++ [Nothing]
     globalMoveLimit = 20
     pieceMoveLimit = 50
+    drawTimes =
+      ADrawTimes <$> atP snd
+      . scanlP drawTimeStep (Nothing, Nothing)
+      . arrC fst . atP gIGlut
+    drawTimeStep (Nothing, _) now = (Just now, Just now)
+    drawTimeStep (Just prev, _) now
+      | diffUTCTime now prev > 0.03 = (Just now, Just now)
+      | otherwise = (Just prev, Nothing)
     resetOnResetBoard prog =
-      MergeProg . runAppendProg . genericCycle $
-      AppendProg prog . takeWhileP (isNothing . (gALoopback >=> gAResetBoard))
+      runAppendProg . genericCycle $
+      AppendProg prog . (AppendProg . takeWhileP) (isNothing . (gALoopback >=> gAResetBoard))
     calculateBoard =
       resetOnResetBoard $
       ABoard <$> scanlP (foldl doMove) chessStart
@@ -202,6 +262,8 @@
       [ Left . ALoopback <$> filterC (isNothing . gALoopback)
       , Right <$> id
       ]
+    space (Char ' ', Down, _, _) = Just ()
+    space _ = Nothing
     quitButton (Char 'q', _, _, _) = Just ()
     quitButton _ = Nothing
     mouseMotion = (lstPs . Just) (0, 0) (gGlut >=> gMouseMotionEvent)
@@ -214,7 +276,7 @@
     calculateSelection =
       (rid .) $ aSelection
       <$> lstP gABoard
-      <*> arrC snd . scanlP drag (Up, Move (0, 0) 0) .
+      <*> arrC snd . scanlP drag (Up, Move (0, 0) White 0) .
         ((,)
         <$> keyState (MouseButton LeftButton) . lstP gGlut
         <*> (calcMoveIter
@@ -230,8 +292,7 @@
     calculateLimits =
       resetOnResetBoard $
       AMoveLimits <$> scanlP updateLimits mempty
-      . runMergeProg
-        ( (,)
+      . ( (,)
           <$> atP gAQueueMove
           <*> lstP (gALoopback >=> gAGameIteration)
         )
@@ -250,13 +311,13 @@
       where
         f k = findWithDefault 0 k limits
     doMove board move =
-      fromMaybe board
-      $ pieceAt board (moveSrc move)
-      >>= lookup (moveDst move) . possibleMoves board
+      fromMaybe board $ do
+        piece <- pieceAt board . moveSrc $ move
+        guard $ pieceSide piece == movePlayer move
+        lookup (moveDst move) . possibleMoves board $ piece
     selectionSrc board side pos =
-      fmap Move
-      . maybeMinimumOn (distance pos . board2screen)
-      . fmap piecePos
+      fmap (Move <$> piecePos <*> pieceSide)
+      . maybeMinimumOn (distance pos . board2screen . piecePos)
       . filter ((&&)
         <$> (/= Just False) . (<$> side) . (==) . pieceSide
         <*> canMove board)
diff --git a/src/defendFontEdit.hs b/src/defendFontEdit.hs
--- a/src/defendFontEdit.hs
+++ b/src/defendFontEdit.hs
@@ -72,18 +72,18 @@
   Image $ do
     color $ Color4 0.1 0.3 0.1 (1 :: GLfloat)
     renderPrimitive Triangles .
-      forM (addPoint polygons cpos) $ \poly ->
-      forM ((
+      forM_ (addPoint polygons cpos) $ \poly ->
+      forM_ ((
         filter ((== 3) . length) .
         map (expandPolygon (-0.01)) .
         triangulatePolygon
         ) poly) .
-      mapM $ \(x, y) ->
+      mapM_ $ \(x, y) ->
       vertex $ Vertex2 x y
-    forM gridLines $ \x ->
-      forM gridLines $ \y ->
+    forM_ gridLines $ \x ->
+      forM_ gridLines $ \y ->
       drawPoint x y 0.03 (Color4 0.5 0.5 0.5 1)
-    forM (concat polygons) $ \(x, y) ->
+    forM_ (concat polygons) $ \(x, y) ->
       drawPoint x y 0.07 (Color4 0.3 1 0.2 1)
     drawPoint cx cy 0.05 (Color4 1 0.2 0.2 1)
     currentRasterPosition $= Vertex4 (-1) (-1) 0 (1 :: GLfloat)
@@ -103,7 +103,6 @@
 
 gameProc :: Program MyIn MyOut
 gameProc =
-  runMergeProg $
   mconcat
   [ GlutO . DrawImage <$> (draw <$> lstP gAFont <*> lstP gAText <*> lstP gAPos)
   , FileO <$> mconcat
@@ -130,8 +129,8 @@
     , ADoSave <$ mapMaybeC (clicka (Char 's') (Modifiers Up Up Down))
     , AClick <$> mapMaybeC clicksFunc
     ] . mapMaybeC (gGlut >=> gKeyboardMouseEvent)
-  , APos <$> toGrid <$> lstP (gGlut >=> gMouseMotionEvent)
-  , AFont <$> read . fst <$> lstP (gFileI >=> gFileData)
+  , APos <$> toGrid <$> mapMaybeC (gGlut >=> gMouseMotionEvent)
+  , AFont <$> read . fst <$> mapMaybeC (gFileI >=> gFileData)
   ]
   where
     typedText (c, s, m, _) = do