diff --git a/src/Graphics/X11/CharAndBG.hs b/src/Graphics/X11/CharAndBG.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/X11/CharAndBG.hs
@@ -0,0 +1,340 @@
+module Graphics.X11.CharAndBG (
+	Field,
+	Turtle,
+	openField,
+	newTurtle,
+	goto,
+	rotate,
+	direction,
+	position,
+	shape,
+	shapesize,
+	undo,
+	clear,
+	setUndoN,
+	windowWidth,
+	windowHeight,
+	penup,
+	pendown,
+	isdown,
+
+	testModuleCharAndBG
+) where
+
+import Graphics.X11.WindowLayers
+import Control.Concurrent
+import Data.IORef
+import Control.Arrow
+import Control.Monad
+
+type Field = Win
+type Turtle = Square
+
+openField :: IO Field
+openField = do
+	w <- openWin
+	flushWin w
+	return w
+
+newTurtle :: Field -> IO Turtle
+newTurtle f = do
+	s <- newSquare f
+	showSquare s
+	return s
+
+goto :: Turtle -> Double -> Double -> IO ()
+goto t x y = do
+	(width, height) <- winSize (sWin t)
+	moveSquare (sWin t) t (x + width / 2) (- y + height / 2)
+
+rotate :: Turtle -> Double -> IO ()
+rotate t = rotateSquare t . negate
+
+direction :: Turtle -> IO Double
+direction = fmap negate . readIORef . sDir
+
+position :: Turtle -> IO (Double, Double)
+position t = do
+	(x_, y_) <- readIORef $ sPos t
+	(width, height) <- winSize (sWin t)
+	return (x_ - width / 2, - y_ + height / 2)
+
+undo, undoGen :: Turtle -> IO ()
+undoGen t = do
+	rot : rots <- readIORef $ sRotHist t
+	writeIORef (sRotHist t) rots
+	d <- readIORef $ sDir t
+	case rot of
+		Just r -> rotateGen t (d - r) >> return ()
+		Nothing -> undoSquare (sWin t) t
+
+undo t = do
+	n <- readIORef $ sUndoN t
+	ns <- readIORef $ sUndoNs t
+	case ns of
+		n' : ns' -> do
+			writeIORef (sUndoN t) n'
+			writeIORef (sUndoNs t) ns'
+		_ -> writeIORef (sUndoN t) 1
+	print n
+	replicateM_ n $ undoGen t
+
+setUndoN :: Turtle -> Int -> IO ()
+setUndoN t n = do
+	n0 <- readIORef $ sUndoN t
+	writeIORef (sUndoN t) n
+	modifyIORef (sUndoNs t) (n0 :)
+
+clear :: Turtle -> IO ()
+clear Square{sWin = w, sLayer = l} = clearLayer w l
+
+windowWidth, windowHeight :: Turtle -> IO Double
+windowWidth = fmap fst . winSize . sWin
+windowHeight = fmap snd . winSize . sWin
+
+penup, pendown :: Turtle -> IO ()
+penup = flip writeIORef False . sPenDown
+pendown = flip writeIORef True . sPenDown
+
+isdown :: Turtle -> IO Bool
+isdown = readIORef . sPenDown
+
+data Square = Square{
+	sLayer :: Layer,
+	sChar :: Character,
+	sPos :: IORef (Double, Double),
+	sHistory :: IORef [(Double, Double)],
+	sSize :: IORef Double,
+	sDir :: IORef Double,
+	sShape :: IORef [(Double, Double)],
+	sUndoN :: IORef Int,
+	sUndoNs :: IORef [Int],
+	sIsRotated :: IORef Bool,
+	sRotHist :: IORef [Maybe Double],
+	sPenDown :: IORef Bool,
+	sWin :: Win
+ }
+
+testModuleCharAndBG :: IO ()
+testModuleCharAndBG = main
+
+main :: IO ()
+main = do
+	w <- openWin
+	s <- newSquare w
+	s1 <- newSquare w
+	shape s1 "turtle"
+	shapesize s1 1
+	moveSquare w s 100 105
+	moveSquare w s1 200 30
+	moveSquare w s 50 300
+	moveSquare w s1 20 30
+	moveSquare w s 300 300
+	shapesize s1 2
+	undoSquare w s
+	moveSquare w s 300 400
+	rotateSquare s1 0
+	undoSquare w s
+	moveSquare w s 300 200
+	undoSquare w s
+	undoSquare w s1
+	undoSquare w s
+	getLine >> return ()
+
+newSquare :: Win -> IO Square
+newSquare w = do
+	l <- addLayer w
+	c <- addCharacter w
+	(width, height) <- winSize w
+	p <- newIORef (width / 2, height / 2)
+	h <- newIORef []
+	sr <- newIORef 1
+	dr <- newIORef 0
+	rsh <- newIORef classic
+	run <- newIORef 1
+	runs <- newIORef []
+	isr <- newIORef False
+	srh <- newIORef []
+	rpd <- newIORef True
+	return Square{
+		sLayer = l,
+		sChar = c,
+		sPos = p,
+		sHistory = h,
+		sSize = sr,
+		sWin = w,
+		sShape = rsh,
+		sDir = dr,
+		sUndoN = run,
+		sUndoNs = runs,
+		sIsRotated = isr,
+		sRotHist = srh,
+		sPenDown = rpd
+	 }
+
+shape :: Square -> String -> IO ()
+shape s@Square{sShape = rsh} name =
+	case name of
+		"turtle" -> do
+			writeIORef rsh turtle
+			showSquare s
+		"clasic" -> do
+			writeIORef rsh classic
+			showSquare s
+		_ -> return ()
+
+shapesize :: Square -> Double -> IO ()
+shapesize s size = do
+	writeIORef (sSize s) size
+	p <- readIORef $ sPos s
+	uncurry (moveSquare (sWin s) s) p
+
+step :: Double
+step = 10
+stepTime :: Int
+stepTime = 10000
+
+stepDir :: Double
+stepDir = 5
+stepDirTime :: Int
+stepDirTime = 10000
+
+getPoints :: Double -> Double -> Double -> Double -> [(Double, Double)]
+getPoints x1 y1 x2 y2 = let
+	len = ((x2 - x1) ** 2 + (y2 - y1) ** 2) ** (1/2)
+	dx = (x2 - x1) * step / len
+	dy = (y2 - y1) * step / len in
+	zip (takeWhile (before dx x2) [x1, x1 + dx ..])
+		(takeWhile (before dy y2) [y1, y1 + dy ..]) ++
+			[(x2, y2)]
+
+before :: (Num a, Ord a) => a -> a -> a -> Bool
+before d t x = signum d * t >= signum d * x
+
+showAnimation :: Bool -> Win -> Square -> Double -> Double -> Double -> Double -> IO ()
+showAnimation pd w s x1 y1 x2 y2 = do
+	(size, d, sh) <- getSizeDirShape s
+	if pd then setPolygonCharacterAndLine w (sChar s)
+				(getShape sh size d x2 y2) (x1, y1) (x2, y2)
+		else setPolygonCharacter w (sChar s) (getShape sh size d x2 y2)
+	bufToWin w
+	flushWin w
+
+getSizeDirShape :: Square -> IO (Double, Double, [(Double, Double)])
+getSizeDirShape s = do
+	size <- readIORef (sSize s)
+	d <- readIORef (sDir s)
+	sh <- readIORef (sShape s)
+	return (size, d, sh)
+
+showSquare :: Square -> IO ()
+showSquare s@Square{sWin = w} = do
+	(x, y) <- readIORef $ sPos s
+	(size, d, sh) <- getSizeDirShape s
+	setPolygonCharacter w (sChar s) (getShape sh size d x y)
+	bufToWin w
+	flushWin w
+
+moveSquare :: Win -> Square -> Double -> Double -> IO ()
+moveSquare w s@Square{sPos = p} x2 y2 = do
+	modifyIORef (sRotHist s) (Nothing :)
+	writeIORef (sIsRotated s) False
+	(x1, y1) <- readIORef p
+	modifyIORef (sHistory s) ((x1, y1) :)
+	pd <- readIORef $ sPenDown s
+	mapM_ (\(x, y) -> showAnimation pd w s x1 y1 x y >> threadDelay stepTime) $
+		getPoints x1 y1 x2 y2
+	writeIORef p (x2, y2)
+	when pd $ line w (sLayer s) x1 y1 x2 y2
+{-
+	setPolygonCharacter w (sChar s)
+		[(x2, y2), (x2 + 10, y2), (x2 + 10, y2 + 10), (x2, y2 + 10)]
+-}
+
+getDirections :: Double -> Double -> [Double]
+getDirections ds de = takeWhile beforeDir [ds, ds + dd ..] ++ [de]
+	where
+	sig = signum (de - ds)
+	dd = sig * stepDir
+	beforeDir x = sig * x < sig * de
+
+setDirSquare :: Square -> Double -> IO ()
+setDirSquare s@Square{sDir = dr} d = do
+	writeIORef dr d
+	showSquare s
+
+rotateSquare :: Square -> Double -> IO ()
+rotateSquare s d = do
+	d0 <- rotateGen s d
+	modifyIORef (sRotHist s) (Just (d - d0) :)
+rotateGen :: Square -> Double -> IO Double
+rotateGen s@Square{sDir = dr} d = do
+	d0 <- readIORef dr
+	mapM_ ((>> threadDelay stepDirTime) . setDirSquare s) $ getDirections d0 d
+	writeIORef dr (d `modd` 360)
+	return d0
+
+modd :: (Num a, Ord a) => a -> a -> a
+modd x y
+	| x < 0 = modd (x + y) y
+	| x < y = x
+	| otherwise = modd (x - y) y
+
+undoSquare :: Win -> Square -> IO ()
+undoSquare w s@Square{sLayer = l} = do
+	undoLayer w l
+	(x1, y1) <- readIORef $ sPos s
+	p@(x2, y2) : ps <- readIORef $ sHistory s
+--	moveSquare w s x y
+--	showAnimation w s x1 y1 x y
+	mapM_ (\(x, y) -> showAnimation True w s x2 y2 x y >> threadDelay 50000) $
+		getPoints x1 y1 x2 y2
+	writeIORef (sPos s) p
+	writeIORef (sHistory s) ps
+
+getShape ::
+	[(Double, Double)] -> Double -> Double -> Double -> Double -> [(Double, Double)]
+getShape sh s d x y =
+	map (uncurry (addDoubles (x, y)) . rotatePointD d . mulPoint s) sh
+
+classic :: [(Double, Double)]
+classic = clssc ++ reverse (map (second negate) clssc)
+	where
+	clssc = [
+		(- 10, 0),
+		(- 16, 6),
+		(0, 0)
+	 ]
+
+turtle :: [(Double, Double)]
+turtle = ttl ++ reverse (map (second negate) ttl)
+	where
+	ttl = [
+		(- 10, 0),
+		(- 8, - 3),
+		(- 10, - 5),
+		(- 7, - 9),
+		(- 5, - 6),
+		(0, - 8),
+		(4, - 7),
+		(6, - 10),
+		(8, - 7),
+		(7, - 5),
+		(10, - 2),
+		(13, - 3),
+		(16, 0)
+	 ]
+
+addDoubles :: (Double, Double) -> Double -> Double -> (Double, Double)
+addDoubles (x, y) dx dy = (x + dx, y + dy)
+
+rotatePointD :: Double -> (Double, Double) -> (Double, Double)
+rotatePointD = rotatePointR . (* pi) . (/ 180)
+
+rotatePointR :: Double -> (Double, Double) -> (Double, Double)
+rotatePointR rad (x, y) =
+	(x * cos rad - y * sin rad, x * sin rad + y * cos rad)
+
+mulPoint :: Double -> (Double, Double) -> (Double, Double)
+mulPoint s (x, y) = (x * s, y * s)
+
diff --git a/src/Graphics/X11/Turtle.hs b/src/Graphics/X11/Turtle.hs
--- a/src/Graphics/X11/Turtle.hs
+++ b/src/Graphics/X11/Turtle.hs
@@ -1,359 +1,63 @@
 module Graphics.X11.Turtle (
-	initTurtle,
-	closeTurtle,
+	Turtle,
+	openField,
+	newTurtle,
+	shape,
 	shapesize,
-	goto,
 	forward,
 	backward,
+	circle,
+	undo,
 	left,
 	right,
-	penup,
+	clear,
+	home,
 	pendown,
+	penup,
 	isdown,
-	home,
-	circle,
-	clear,
-	undoAll,
-	undo,
-	distance,
-
-	Position,
-	testModuleTurtle
+	distance
 ) where
 
-import Graphics.X11.World
-import Data.IORef
-import Data.List
-import System.IO.Unsafe
-import Control.Arrow (second)
-import Control.Monad.Tools
+import Graphics.X11.CharAndBG
 import Control.Monad
-import Control.Concurrent
-import Data.Maybe
 
-world :: IORef World
-world = unsafePerformIO $ newIORef undefined
+forward, backward, forwardNotSetUndo :: Turtle -> Double -> IO ()
+forward t dist = do
+	setUndoN t 1
+	forwardNotSetUndo t dist
 
-windowWidth :: IO Double
-windowWidth = readIORef world >>= fmap fst . getWindowSize
+forwardNotSetUndo t dist = do
+	dir <- direction t
+	(x0, y0) <- position t
+	let	xd = dist * cos (dir * pi / 180)
+		yd = dist * sin (dir * pi / 180)
+	goto t (x0 + xd) (y0 + yd)
 
-windowHeight :: IO Double
-windowHeight = readIORef world >>= fmap snd . getWindowSize
 
-position :: IO (Double, Double)
-position = do
-	w <- readIORef world
-	(x, y) <- getCursorPos w
-	width <- windowWidth
-	height <- windowHeight
-	return (x - width / 2, height / 2 - y)
-
-distance :: Double -> Double -> IO Double
-distance x0 y0 = do
-	(x, y) <- position
-	return $ ((x - x0) ** 2 + (y - y0) ** 2) ** (1 / 2)
-
-pastDrawLines :: IORef [Maybe (((Double, Double), Double), Buf -> IO ())]
-pastDrawLines = unsafePerformIO $ newIORef []
-
-putToPastDrawLines :: (Double, Double) -> Double -> (Buf -> IO ()) -> IO ()
-putToPastDrawLines tpos tdir dl = do
-	pdls <- readIORef pastDrawLines
-	if length pdls < 300
-		then do
-			writeIORef pastDrawLines $ pdls ++ [Just ((tpos, tdir), dl)]
-		else do
-			maybe (return ()) (($ UndoBuf) . snd) $ head pdls
-			writeIORef pastDrawLines $ tail pdls ++ [Just ((tpos, tdir), dl)]
-
-setUndoPoint :: IO ()
-setUndoPoint = modifyIORef pastDrawLines $ (++ [Nothing])
-
-data PenState = PenUp | PenDown
-
-data Order = Forward Double | Left Double | Undo deriving Show
-
-doesPenDown :: PenState -> Bool
-doesPenDown PenUp = False
-doesPenDown PenDown = True
-
-penState :: IORef PenState
-penState = unsafePerformIO $ newIORef PenDown
-
-testModuleTurtle :: IO ()
-testModuleTurtle = main
-
-main :: IO ()
-main = do
-	putStrLn "module Turtle"
-	initTurtle
-	w <- readIORef world
-	redrawLines
-	withEvent w () $ \() ev ->
-		case ev of
-			ExposeEvent{} -> do
-				drawWorld w
-				return ((), True)
-			KeyEvent{} -> do
-				ch <- eventToChar w ev
-				return ((), (ch /= 'q'))
-			ClientMessageEvent{} ->
-				return ((), not $ isDeleteEvent w ev)
-			AnyEvent{ev_event_type = 14} ->
-				return ((), True)
-			_ -> error $ "not implemented for event " ++ show ev
-	closeTurtle
-
-orderChan :: IORef (Chan Order)
-orderChan = unsafePerformIO $ newChan >>= newIORef
-
-getOrders :: IO [Order]
-getOrders = unsafeInterleaveIO $ do
-	o <- readIORef orderChan >>= readChan
-	os <- getOrders
-	return $ o : os
-
-initTurtle :: IO ()
-initTurtle = do
-	w <- openWorld
-	setCursorPos w 100 200
-	setCursorDir w 0
-	setCursorSize w 2
-	setCursorShape w displayTurtle
-	drawWorld w
-	flushWorld w
-	writeIORef world w
-	width <- windowWidth
-	height <- windowHeight
-	setCursorPos w (width / 2) (height / 2)
-	drawWorld w
-	flushWorld w
-
-shapesize :: Double -> IO ()
-shapesize s = do
-	w <- readIORef world
-	setCursorSize w s
-	drawWorld w
-	flushWorld w
-
-goto, rawGoto :: Double -> Double -> IO ()
-goto x y = do
-	width <- windowWidth
-	height <- windowHeight
-	rawGoto (x + width / 2) (- y + height / 2)
-		>> setUndoPoint
-rawGoto xTo yTo = do
-	w <- readIORef world
-	(x0, y0) <- getCursorPos w
-	let	step = 10
-		distX = xTo - x0
-		distY = yTo - y0
-		dist = (distX ** 2 + distY ** 2) ** (1 / 2)
-		dx = step * distX / dist
-		dy = step * distY / dist
-	(x', y') <- if (dist <= step) then return (x0, y0) else doWhile (x0, y0) $ \(x, y) -> do
-		let	nx = x + dx
-			ny = y + dy
-		setCursorPos w nx ny
-		drawLine w x y nx ny
-		drawWorld w
-		flushWorld w
-		threadDelay 20000
-		return ((nx, ny),
-			(nx + dx - x0) ** 2 + (ny + dy - y0) ** 2 < dist ** 2)
-	setCursorPos w xTo yTo
-	drawLine w x' y' xTo yTo
-	drawWorld w
-	flushWorld w
-
-forward, rawForward :: Double -> IO ()
-forward len = rawForward len >> setUndoPoint
-rawForward len = do
-	w <- readIORef world
-	(x0, y0) <- getCursorPos w
-	d <- getCursorDir w
-	let	rad = d * pi / 180
-		nx' = x0 + len * cos rad
-		ny' = y0 + len * sin rad
-	rawGoto nx' ny'
-
-backward :: Double -> IO ()
-backward = forward . negate
-
-penup :: IO ()
-penup = writeIORef penState PenUp
-
-pendown :: IO ()
-pendown = writeIORef penState PenDown
-
-isdown :: IO Bool
-isdown = do
-	ps <- readIORef penState
-	return $ case ps of
-		PenUp -> False
-		PenDown -> True
-
-drawLine :: World -> Double -> Double -> Double -> Double -> IO ()
-drawLine w x1 y1 x2 y2 = do
-	let act buf = do
-		ps <- readIORef penState
-		when (doesPenDown ps) $
-			lineToBG w buf (round x1) (round y1) (round x2) (round y2)
-	act BG
-	dir <- readIORef world >>= getCursorDir 
-	putToPastDrawLines (x2, y2) dir act
-
-redrawLines :: IO ()
-redrawLines = do
-	w <- readIORef world
-	dls <- fmap (map fromJust . filter isJust) $ readIORef pastDrawLines
-	clear
-	flip mapM_ dls $ \dl -> do
-		snd dl BG
-		drawWorld w
-		flushWorld w
-		threadDelay 20000
-
-undoAll :: IO ()
-undoAll = do
-	w <- readIORef world
-	dls <- fmap (map fromJust . filter isJust) $ readIORef pastDrawLines
-	flip mapM_ (zip (reverse $ map fst dls) $ map sequence_ $ reverse $ inits
-		$ map (($ BG) . snd) dls)
-		$ \((pos, dir), dl) -> do
-		cleanBG w BG
-		dl
-		uncurry (setCursorPos w) pos
-		setCursorDir w dir
-		drawWorld w
-		flushWorld w
-		threadDelay 20000
-
-undo :: IO ()
-undo = do
-	w <- readIORef world
-	dls <- fmap init $ readIORef pastDrawLines
-	let	draw = map (map fromJust . filter isJust)
-			$ takeWhile (isJust . last) $ reverse $ inits dls
-		draw1 = map fromJust $ filter isJust $ head
-			$ dropWhile (isJust . last) $ reverse $ inits dls
-		draw' = draw ++ [draw1]
-	flip mapM_ (zip (reverse $ map (fst . fromJust) $ filter isJust dls )
-		$ map sequence_
-		$ map (map (($ BG) . snd)) draw') $ \((pos, dir), dl) -> do
-		cleanBG w BG
-		undoBufToBG w
-		dl
-		uncurry (setCursorPos w) pos
-		setCursorDir w dir
-		drawWorld w
-		flushWorld w
-		threadDelay 20000
-	modifyIORef pastDrawLines $ reverse . dropWhile isJust . tail . reverse
-
-rotateBy :: Double -> IO ()
-rotateBy dd = do
-	w <- readIORef world
-	d0 <- getCursorDir w
-	let	nd = (d0 + dd) `gMod` 360
-	setCursorDir w nd
-	drawWorld w
-	flushWorld w
-	pos <- getCursorPos w
-	putToPastDrawLines pos nd $ const (return ())
-
-rotateTo :: Double -> IO ()
-rotateTo d = do
-	w <- readIORef world
-	d0 <- getCursorDir w
-	let	step = 5
-		dd = d - d0
-	replicateM_ (abs dd `gDiv` step) $
-		rotateBy (signum dd * step) >> threadDelay 10000
-	setCursorDir w d
-	drawWorld w
-	flushWorld w
-
-rotate, rawRotate :: Double -> IO ()
-rotate d = rawRotate d >> setUndoPoint
-rawRotate d = do
-	w <- readIORef world
-	d0 <- getCursorDir w
-	rotateTo $ d0 + d
-
-gDiv :: (Num a, Ord a, Integral b) => a -> a -> b
-x `gDiv` y
-	| x >= y = 1 + (x - y) `gDiv` y
-	| otherwise = 0
-
-gMod :: (Num a, Ord a) => a -> a -> a
-x `gMod` y
-	| x >= y = (x - y) `gMod` y
-	| otherwise = x
-
-right :: Double -> IO ()
-right = rotate
-
-left :: Double -> IO ()
-left = rotate . negate
-
-circle :: Position -> IO ()
-circle r = replicateM_ 36 $ do
-	rawForward $ (2 * fromIntegral r * pi / 36 :: Double)
-	rawRotate (- 10)
-
-home :: IO ()
-home = goto 0 0 >> rotateTo 0
-
-clear :: IO ()
-clear = do
-	w <- readIORef world
-	cleanBG w BG
-	drawWorld w >> flushWorld w
-	pos <- getCursorPos w
-	dir <- getCursorDir w
-	putToPastDrawLines pos dir $ cleanBG w
-
-closeTurtle :: IO ()
-closeTurtle = readIORef world >>= closeWorld
-
-displayTurtle :: World -> Double -> Double -> Double -> Double -> IO ()
-displayTurtle w s d x y =
-	makeFilledPolygonCursor w $ map (uncurry $ addPoint $ Point (round x) (round y))
-		$ map (rotatePointD d)
-		$ map (mulPoint s) turtle
-
-addPoint :: Point -> Position -> Position -> Point
-addPoint (Point x y) dx dy = Point (x + dx) (y + dy)
+backward t = forward t . negate
 
-rotatePointD :: Double -> (Position, Position) -> (Position, Position)
-rotatePointD = rotatePointR . (* pi) . (/ 180)
+left, right :: Turtle -> Double -> IO ()
+left t dd = do
+	dir <- direction t
+	rotate t (dir + dd)
 
-rotatePointR :: Double -> (Position, Position) -> (Position, Position)
-rotatePointR rad (x, y) =
-	(x `mul` cos rad - y `mul` sin rad, x `mul` sin rad + y `mul` cos rad)
+right t = left t . negate
 
-mulPoint :: Double -> (Position, Position) -> (Position, Position)
-mulPoint s (x, y) = (x `mul` s, y `mul` s)
+circle :: Turtle -> Double -> IO ()
+circle t r = do
+	setUndoN t 73
+	forwardNotSetUndo t (r * pi / 36)
+	left t 10
+	replicateM_ 35 $ forwardNotSetUndo t (2 * r * pi / 36) >>
+		left t 10
+	forwardNotSetUndo t (r * pi / 36)
 
-mul :: (Integral a, RealFrac b) => a -> b -> a
-x `mul` y = round $ fromIntegral x * y
+home :: Turtle -> IO ()
+home t = do
+	goto t 0 0
+	rotate t 0
 
-turtle :: [(Position, Position)]
-turtle = ttl ++ reverse (map (second negate) ttl)
-	where
-	ttl = [
-		(- 10, 0),
-		(- 8, - 3),
-		(- 10, - 5),
-		(- 7, - 9),
-		(- 5, - 6),
-		(0, - 8),
-		(4, - 7),
-		(6, - 10),
-		(8, - 7),
-		(7, - 5),
-		(10, - 2),
-		(13, - 3),
-		(16, 0)
-	 ]
+distance :: Turtle -> Double -> Double -> IO Double
+distance t x0 y0 = do
+	(x, y) <- position t
+	return $ ((x - x0) ** 2 + (y - y0) ** 2) ** (1 / 2)
diff --git a/src/Graphics/X11/WindowLayers.hs b/src/Graphics/X11/WindowLayers.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/X11/WindowLayers.hs
@@ -0,0 +1,304 @@
+module Graphics.X11.WindowLayers (
+	Win,
+	openWin,
+	flushWin,
+	winSize,
+
+	clearUndoBuf,
+--	lineUndoBuf,
+	clearBG,
+	fillPolygonBuf,
+
+--	lineWin,
+	changeColor,
+	putSome,
+	line,
+
+	undoBufToBG,
+	bgToBuf,
+	bufToWin,
+
+	addExposeAction,
+	setExposeAction,
+	setCharacterAction,
+	setCharacter,
+	setPolygonCharacter,
+	setPolygonCharacterAndLine,
+--	undoAction,
+	addLayer,
+	addCharacter,
+
+	undoLayer,
+	clearLayer,
+
+	Layer,
+	Character,
+) where
+
+import Graphics.X11(
+	Window, Pixmap, Atom,
+
+	openDisplay, closeDisplay, flush, defaultScreen, rootWindow,
+	whitePixel, blackPixel,	defaultDepth,
+	createSimpleWindow, mapWindow, createPixmap, internAtom, createGC,
+
+	setForeground, copyArea,
+	drawLine, fillRectangle, fillPolygon, nonconvex, coordModeOrigin,
+
+	setWMProtocols, selectInput, allocaXEvent, nextEvent,
+	keyPressMask, exposureMask,
+
+	getGeometry, initThreads
+ )
+import Graphics.X11.Xlib.Extras(Event(..), getEvent)
+import Graphics.X11.Xlib.Types
+import Control.Monad.Tools(doWhile_)
+import Control.Arrow((***))
+import Control.Concurrent(forkIO)
+import Data.IORef(IORef, newIORef, readIORef, writeIORef, modifyIORef)
+import Data.Bits((.|.))
+import Data.Convertible(convert)
+
+data Win = Win{
+	wDisplay :: Display,
+	wWindow :: Window,
+	wGC :: GC,
+	wGCWhite :: GC,
+	wDel :: Atom,
+	wUndoBuf :: Pixmap,
+	wBG :: Pixmap,
+	wBuf :: Pixmap,
+	wWidth :: IORef Dimension,
+	wHeight :: IORef Dimension,
+	wExpose :: IORef [[Bool -> IO ()]],
+	wBuffed :: IORef [IO ()],
+	wChars :: IORef [IO ()]
+ }
+
+data Layer = Layer Int
+data Character = Character Int
+
+openWin :: IO Win
+openWin = do
+	_ <- initThreads
+	dpy <- openDisplay ""
+	del <- internAtom dpy "WM_DELETE_WINDOW" True
+	let	scr = defaultScreen dpy
+	root <- rootWindow dpy scr
+	(_, _, _, rWidth, rHeight, _, _) <- getGeometry dpy root
+	let	black = blackPixel dpy scr
+		white = whitePixel dpy scr
+		depth = defaultDepth dpy scr
+	undoBuf <- createPixmap dpy root rWidth rHeight depth
+	bg <- createPixmap dpy root rWidth rHeight depth
+	buf <- createPixmap dpy root rWidth rHeight depth
+	win <- createSimpleWindow dpy root 0 0 rWidth rHeight 1 black white
+	gc <- createGC dpy win
+	gcWhite <- createGC dpy win
+	setForeground dpy gcWhite 0xffffff
+	fillRectangle dpy bg gcWhite 0 0 rWidth rHeight
+	fillRectangle dpy buf gcWhite 0 0 rWidth rHeight
+	fillRectangle dpy undoBuf gcWhite 0 0 rWidth rHeight
+	setWMProtocols dpy win [del]
+	selectInput dpy win $ exposureMask .|. keyPressMask
+	mapWindow dpy win
+	widthRef <- newIORef rWidth
+	heightRef <- newIORef rHeight
+	exposeAction <- newIORef []
+	buffedAction <- newIORef []
+	charActions <- newIORef []
+	let w = Win dpy win gc gcWhite del undoBuf bg buf widthRef heightRef
+		exposeAction buffedAction charActions
+	_ <- forkIO $ (>> closeDisplay dpy) $ (initThreads >>) $ withEvent w $ \ev ->
+		case ev of
+			ExposeEvent{} -> do
+				(_, _, _, width, height, _, _) <-
+					getGeometry (wDisplay w) (wWindow w)
+				writeIORef (wWidth w) width
+				writeIORef (wHeight w) height
+				readIORef exposeAction >>= mapM_ ($ False) . concat
+				readIORef charActions >>= sequence_
+				bufToWin w
+				flushWin w
+				return True
+			KeyEvent{} -> return True
+			ClientMessageEvent{} ->
+				return $ not $ isDeleteEvent w ev
+			_ -> return True
+	return w
+	where
+	withEvent w act = doWhile_ $ allocaXEvent $ \e -> do
+		nextEvent (wDisplay w) e
+		getEvent e >>= act
+	isDeleteEvent w ev@ClientMessageEvent{} =
+		convert (head $ ev_data ev) == wDel w
+	isDeleteEvent _ _ = False
+
+undoN :: Int
+undoN = 300
+
+clearLayer :: Win -> Layer -> IO ()
+clearLayer w l@(Layer lid) = do
+	setExposeAction w l (const $ const $ return ())
+	buffed <- readIORef $ wBuffed w
+	writeIORef (wBuffed w) $
+		take lid buffed ++ [return ()] ++ drop (lid + 1) buffed
+	nBuffed <- readIORef $ wBuffed w
+	clearUndoBuf w
+	sequence_ nBuffed
+	undoBufToBG w
+	readIORef (wExpose w) >>= mapM_ ($ False) . concat
+	bgToBuf w
+	readIORef (wChars w) >>= sequence_
+	bufToWin w
+	flushWin w
+
+addExposeAction :: Win -> Layer -> (Win -> Bool -> IO ()) -> IO ()
+addExposeAction w@Win{wExpose = we} (Layer lid) act = do
+	ls <- readIORef we
+	let	theLayer = ls !! lid
+		newLayer = theLayer ++ [act w]
+	if length newLayer > undoN
+		then do	head newLayer True
+			buffed <- readIORef $ wBuffed w
+			writeIORef (wBuffed w) $ take lid buffed ++
+				[buffed !! lid >> head newLayer True] ++
+				drop (lid + 1) buffed
+			writeIORef we $ take lid ls ++ [tail newLayer] ++ drop (lid + 1) ls
+		else writeIORef we $ take lid ls ++ [newLayer] ++ drop (lid + 1) ls
+
+setExposeAction :: Win -> Layer -> (Win -> Bool -> IO ()) -> IO ()
+setExposeAction w@Win{wExpose = we} (Layer lid) act = do
+	ls <- readIORef we
+	writeIORef we $ take lid ls ++ [[act w]] ++ drop (lid + 1) ls
+
+undoLayer :: Win -> Layer -> IO ()
+undoLayer w@Win{wExpose = we} (Layer lid) = do
+	ls <- readIORef we
+	writeIORef we $ take lid ls ++ [init (ls !! lid)] ++ drop (lid + 1) ls
+	undoBufToBG w
+	readIORef we >>= mapM_ ($ False) . concat
+	bgToBuf w
+	readIORef (wChars w) >>= sequence_
+--	bufToWin w
+--	flushWin w
+
+setCharacter :: Win -> Character -> IO () -> IO ()
+setCharacter w c act = do
+	bgToBuf w
+	setCharacterAction w c act
+	readIORef (wChars w) >>= sequence_
+--	bufToWin w
+--	flushWin w
+
+setCharacterAction :: Win -> Character -> IO () -> IO ()
+setCharacterAction Win{wChars = wc} (Character cid) act = do
+	cs <- readIORef wc
+	writeIORef wc $ take cid cs ++ [act] ++ drop (cid + 1) cs
+
+addLayer :: Win -> IO Layer
+addLayer Win{wExpose = we, wBuffed = wb} = do
+	ls <- readIORef we
+	modifyIORef we (++ [[]])
+	modifyIORef wb (++ [return ()])
+	return $ Layer $ length ls
+
+addCharacter :: Win -> IO Character
+addCharacter Win{wChars = wc} = do
+	cs <- readIORef wc
+	modifyIORef wc (++ [return ()])
+	return $ Character $ length cs
+
+{-
+undoAction :: Win -> Layer -> IO ()
+undoAction w@Win{wExpose = we} (Layer lid) = do
+	clearWin w
+	modifyIORef we init
+	readIORef we >>= sequence_
+	flushWin w
+-}
+
+winSize :: Win -> IO (Double, Double)
+winSize w = fmap (fromIntegral *** fromIntegral) $ winSizeRaw w
+
+winSizeRaw :: Win -> IO (Dimension, Dimension)
+winSizeRaw w = do
+	width <- readIORef $ wWidth w
+	height <- readIORef $ wHeight w
+	return (width, height)
+
+undoBufToBG :: Win -> IO ()
+undoBufToBG w = do
+	(width, height) <- winSizeRaw w
+	copyArea (wDisplay w) (wUndoBuf w) (wBG w) (wGC w) 0 0 width height 0 0
+
+bgToBuf :: Win -> IO ()
+bgToBuf w = do
+	(width, height) <- winSizeRaw w
+	copyArea (wDisplay w) (wBG w) (wBuf w) (wGC w) 0 0 width height 0 0
+
+bufToWin :: Win -> IO ()
+bufToWin w = do
+	(width, height) <- winSizeRaw w
+	copyArea (wDisplay w) (wBuf w) (wWindow w) (wGC w) 0 0 width height 0 0
+
+fillPolygonBuf :: Win -> [(Double, Double)] -> IO ()
+fillPolygonBuf w ps = fillPolygon (wDisplay w) (wBuf w) (wGC w) (map dtp ps)
+						nonconvex coordModeOrigin
+	where
+	dtp (x, y) = Point (round x) (round y)
+
+setPolygonCharacter :: Win -> Character -> [(Double, Double)] -> IO ()
+setPolygonCharacter w c ps = setCharacter w c (fillPolygonBuf w ps)
+
+setPolygonCharacterAndLine ::
+	Win -> Character -> [(Double, Double)] -> (Double, Double) ->
+		(Double, Double) -> IO ()
+setPolygonCharacterAndLine w c ps (x1, y1) (x2, y2) =
+	setCharacter w c (fillPolygonBuf w ps >> lineBuf w x1 y1 x2 y2)
+
+putSome :: Win -> (Double, Double) -> IO ()
+putSome w (x, y) = do
+	bgToBuf w
+	fillPolygonBuf w [(x, y), (x + 10, y), (x + 10, y + 10), (x, y + 10)]
+	bufToWin w
+	flushWin w
+
+line :: Win -> Layer -> Double -> Double -> Double -> Double -> IO ()
+line w l x1 y1 x2 y2 = do
+	lineWin w x1 y1 x2 y2
+	addExposeAction w l $ \w' buf -> if buf
+		then lineUndoBuf w' x1 y1 x2 y2
+		else lineWin w' x1 y1 x2 y2
+
+lineWin :: Win -> Double -> Double -> Double -> Double -> IO ()
+lineWin w x1_ y1_ x2_ y2_ = do
+	drawLine (wDisplay w) (wBG w) (wGC w) x1 y1 x2 y2
+	bgToBuf w
+	readIORef (wChars w) >>= sequence_
+--	bufToWin w
+	where	[x1, y1, x2, y2] = map round [x1_, y1_, x2_, y2_]
+
+lineUndoBuf :: Win -> Double -> Double -> Double -> Double -> IO ()
+lineUndoBuf w x1_ y1_ x2_ y2_ =
+	drawLine (wDisplay w) (wUndoBuf w) (wGC w) x1 y1 x2 y2
+	where	[x1, y1, x2, y2] = map round [x1_, y1_, x2_, y2_]
+
+lineBuf :: Win -> Double -> Double -> Double -> Double -> IO ()
+lineBuf w x1_ y1_ x2_ y2_ =
+	drawLine (wDisplay w) (wBuf w) (wGC w) x1 y1 x2 y2
+	where	[x1, y1, x2, y2] = map round [x1_, y1_, x2_, y2_]
+
+clearBG :: Win -> IO ()
+clearBG w = winSizeRaw w >>=
+	uncurry (fillRectangle (wDisplay w) (wBG w) (wGCWhite w) 0 0)
+
+clearUndoBuf :: Win -> IO ()
+clearUndoBuf w = winSizeRaw w >>=
+	uncurry (fillRectangle (wDisplay w) (wUndoBuf w) (wGCWhite w) 0 0)
+
+flushWin :: Win -> IO ()
+flushWin = flush . wDisplay
+
+changeColor :: Win -> Pixel -> IO ()
+changeColor w = setForeground (wDisplay w) (wGC w)
diff --git a/src/Graphics/X11/World.hs b/src/Graphics/X11/World.hs
deleted file mode 100644
--- a/src/Graphics/X11/World.hs
+++ /dev/null
@@ -1,177 +0,0 @@
-module Graphics.X11.World (
-	World,
-	openWorld,
-	setCursorPos,
-	getCursorPos,
-	setCursorDir,
-	getCursorDir,
-	setCursorSize,
-	setCursorShape,
-	drawWorld,
-	undoBufToBG,
-	closeWorld,
-	withEvent,
-	flushWorld,
-	eventToChar,
-	isDeleteEvent,
-	makeFilledPolygonCursor,
-	lineToBG,
-	cleanBG,
-	getWindowSize,
-	Buf(..),
-
-	Event(..),
-	Position,
-	Dimension,
-	Point(..),
-	testModuleWorld
-) where
-
-import Graphics.X11
-import Graphics.X11.Xlib.Extras
-import Data.IORef
-import Data.Bits
-import Data.Char
-import Data.Convertible
-import Control.Monad.Tools
-
-data World = World{
-	wDisplay :: Display,
-	wWindow :: Window,
-	wGC :: GC,
-	wDel :: Atom,
-	wBG :: Pixmap,
-	wBuf :: Pixmap,
-	wUndoBuf :: Pixmap,
-	wPos :: IORef (Double, Double),
-	wDir :: IORef Double,
-	wSize :: IORef Double,
-	wShape :: IORef (World -> Double -> Double -> Double -> Double -> IO ())
- }
-
-getWindowSize :: World -> IO (Double, Double)
-getWindowSize w = do
-	(_, _, _, width, height, _, _) <- getGeometry (wDisplay w) (wWindow w)
-	return (fromIntegral width, fromIntegral height)
-
-setCursorPos :: World -> Double -> Double -> IO ()
-setCursorPos w x y = writeIORef (wPos w) (x, y)
-
-getCursorPos :: World -> IO (Double, Double)
-getCursorPos w = readIORef (wPos w)
-
-setCursorDir :: World -> Double -> IO ()
-setCursorDir w d = writeIORef (wDir w) d
-
-getCursorDir :: World -> IO Double
-getCursorDir w = readIORef (wDir w)
-
-setCursorSize :: World -> Double -> IO ()
-setCursorSize w s = writeIORef (wSize w) s
-
-setCursorShape ::
-	World -> (World -> Double -> Double -> Double -> Double -> IO ()) -> IO ()
-setCursorShape w s = writeIORef (wShape w) s
-
-testModuleWorld :: IO ()
-testModuleWorld = main
-
-main :: IO ()
-main = do
-	putStrLn "module World"
-	w <- openWorld
-	withEvent w () $ \() ev ->
-		case ev of
-			ExposeEvent{} -> return ((), True)
-			KeyEvent{} -> do
-				ch <- eventToChar w ev
-				return ((), ch /= 'q')
-			ClientMessageEvent{} ->
-				return ((), not $ isDeleteEvent w ev)
-			_ -> error $ "not implemented for event " ++ show ev
-	closeWorld w
-
-openWorld :: IO World
-openWorld = do
-	dpy <- openDisplay ""
-	del <- internAtom dpy "WM_DELETE_WINDOW" True
-	let	scr = defaultScreen dpy
-	root <- rootWindow dpy scr
-	(_, _, _, width, height, _, _) <- getGeometry dpy root
-	let	black = blackPixel dpy scr
-		white = whitePixel dpy scr
-	win <- createSimpleWindow dpy root 0 0 width height 1 black white
-	bg <- createPixmap dpy root width height $ defaultDepth dpy scr
-	buf <- createPixmap dpy root width height $ defaultDepth dpy scr
-	undoBuf <- createPixmap dpy root width height $ defaultDepth dpy scr
-	gc <- createGC dpy win
-	gc' <- createGC dpy win
-	setForeground dpy gc' 0xffffff
-	fillRectangle dpy bg gc' 0 0 width height
-	fillRectangle dpy buf gc' 0 0 width height
-	fillRectangle dpy undoBuf gc' 0 0 width height
-	setWMProtocols dpy win [del]
-	selectInput dpy win $ exposureMask .|. keyPressMask
-	mapWindow dpy win
-	flush dpy
-	initPos <- newIORef undefined
-	initDir <- newIORef undefined
-	initSize <- newIORef undefined
-	initShape <- newIORef undefined
-	return $ World dpy win gc del bg buf undoBuf initPos initDir initSize initShape
-
-closeWorld :: World -> IO ()
-closeWorld = closeDisplay . wDisplay
-
-drawWorld :: World -> IO ()
-drawWorld w = do
-	(_, _, _, width, height, _, _) <- getGeometry (wDisplay w) (wWindow w)
-	copyArea (wDisplay w) (wBG w) (wBuf w) (wGC w) 0 0 width height 0 0
-	(x, y) <- readIORef $ wPos w
-	d <- readIORef $ wDir w
-	s <- readIORef $ wSize w
-	displayCursor <- readIORef $ wShape w
-	displayCursor w s d x y
-	copyArea (wDisplay w) (wBuf w) (wWindow w) (wGC w) 0 0 width height 0 0
-
-undoBufToBG :: World -> IO ()
-undoBufToBG w = do
-	(_, _, _, width, height, _, _) <- getGeometry (wDisplay w) (wWindow w)
-	copyArea (wDisplay w) (wUndoBuf w) (wBG w) (wGC w) 0 0 width height 0 0
-
-
-withEvent :: World -> s -> (s -> Event -> IO (s, Bool)) -> IO s
-withEvent w stat0 act = doWhile stat0 $ \stat -> allocaXEvent $ \e -> do
-	nextEvent (wDisplay w) e
-	getEvent e >>= act stat
-
-eventToChar :: World -> Event -> IO Char
-eventToChar w ev =
-	fmap (chr . fromEnum) $ keycodeToKeysym (wDisplay w) (ev_keycode ev) 0
-
-isDeleteEvent :: World -> Event -> Bool
-isDeleteEvent w ev@ClientMessageEvent{} = convert (head $ ev_data ev) == wDel w
-isDeleteEvent _ _ = False
-
-makeFilledPolygonCursor :: World -> [Point] -> IO ()
-makeFilledPolygonCursor w ps =
-	fillPolygon (wDisplay w) (wBuf w) (wGC w) ps nonconvex coordModeOrigin
-
-data Buf = BG | UndoBuf
-
-lineToBG :: World -> Buf -> Position -> Position -> Position -> Position -> IO ()
-lineToBG w BG x1 y1 x2 y2 = drawLine (wDisplay w) (wBG w) (wGC w) x1 y1 x2 y2
-lineToBG w UndoBuf x1 y1 x2 y2 = drawLine (wDisplay w) (wUndoBuf w) (wGC w) x1 y1 x2 y2
-
-cleanBG :: World -> Buf -> IO ()
-cleanBG w b = do
-	(_, _, _, width, height, _, _) <- getGeometry (wDisplay w) (wWindow w)
-	gc <- createGC (wDisplay w) (wWindow w)
-	setForeground (wDisplay w) gc 0xffffff
-	let buf = case b of
-		BG -> wBG w
-		UndoBuf -> wUndoBuf w
-	fillRectangle (wDisplay w) buf gc 0 0 width height
-
-flushWorld :: World -> IO ()
-flushWorld = flush . wDisplay
diff --git a/xturtle.cabal b/xturtle.cabal
--- a/xturtle.cabal
+++ b/xturtle.cabal
@@ -2,7 +2,7 @@
 cabal-version:	>= 1.6
 
 name:		xturtle
-version:	0.0.2
+version:	0.0.4
 stability:	experimental
 author:		Yoshikuni Jujo <PAF01143@nifty.ne.jp>
 maintainer:	Yoshikuni Jujo <PAF01143@nifty.ne.jp>
@@ -16,9 +16,10 @@
   In ghci
   .
   > :m Graphics.X11.Turtle
-  > initTurtle
-  > forward 100
-  > left 50
+  > f <- openField
+  > t <- newTurtle f
+  > forward f 100
+  > left f 50
   .
   etc
 
@@ -31,4 +32,4 @@
   Exposed-modules:	Graphics.X11.Turtle
   Build-depends:	base > 3 && < 5, yjtools, convertible, X11
   Ghc-options:		-Wall
-  Other-modules:	Graphics.X11.World
+  Other-modules:	Graphics.X11.WindowLayers, Graphics.X11.CharAndBG