module Graphics.X11.Turtle (
	Turtle,

	openField,
	newTurtle,

	shape,
	shapesize,
	forward,
	backward,
	left,
	right,
	goto,
	home,
	clear,
	circle,
	penup,
	pendown,
	undo,

	windowWidth,
	windowHeight,
	position,
	distance,
	isdown,

	xturtleVersion
) where

import Graphics.X11.TurtleDraw
import Graphics.X11.TurtleInput
import Control.Concurrent
import Control.Monad
import Prelude hiding(Left)
import Data.IORef
import Control.Arrow(second)

xturtleVersion :: (Int, String)
xturtleVersion = (1, "0.0.5b")

data Turtle = Turtle {
	inputChan :: Chan TurtleInput,
	states :: [TurtleState],
	stateNow :: IORef Int,
	layer :: Layer,
	character :: Character
 }

newTurtle :: Field -> IO Turtle
newTurtle f = do
	ch <- addCharacter f
	l <- addLayer f
	(c, ret) <- makeInput
	sn <- newIORef 1
	let	sts = drop 4 $ inputToTurtle [] initialTurtleState ret
		t = Turtle {
			inputChan = c,
			layer = l,
			character = ch,
			states = sts,
			stateNow = sn
		 }
	writeChan c $ Shape classic
	writeChan c $ ShapeSize 1
	writeChan c PenDown
	writeChan c $ Goto 0 0
	writeChan c $ RotateTo 0
	writeChan c $ Goto 0 0
	_ <- forkIOX $ for2M_ sts $ turtleDraw ch l
	return t

shape :: Turtle -> String -> IO ()
shape Turtle{inputChan = c, stateNow = sn} "turtle" = do
	modifyIORef sn (+ 1)
	writeChan c $ Shape turtle
shape Turtle{inputChan = c, stateNow = sn} "classic" = do
	modifyIORef sn (+ 1)
	writeChan c $ Shape classic
shape _ name = error $ "There is no shape named " ++ name

shapesize :: Turtle -> Double -> IO ()
shapesize Turtle{inputChan = c, stateNow = sn} size = do
	modifyIORef sn (+ 1)
	writeChan c $ ShapeSize size

forward, backward :: Turtle -> Double -> IO ()
forward Turtle{inputChan = c, stateNow = sn} len = do
	modifyIORef sn (+1)
	writeChan c $ Forward len
	threadDelay 10000
backward t = forward t . negate

left, right :: Turtle -> Double -> IO ()
left Turtle{inputChan = c, stateNow = sn} dd = do
	modifyIORef sn (+ 1)
	writeChan c $ Left dd
	threadDelay 10000
right t = left t . negate

circle :: Turtle -> Double -> IO ()
circle t@Turtle{inputChan = c, stateNow = sn} r = do
	forward t (r * pi / 36)
	left t 10
	replicateM_ 35 $ forward t (2 * r * pi / 36) >> left t 10
	forward t (r * pi / 36)
	writeChan c $ SetUndoNum 74
	modifyIORef sn (+ 1)

home :: Turtle -> IO ()
home t = modifyIORef (stateNow t) (+ 1) >> goto t 0 0 >> rotateTo t 0

clear :: Turtle -> IO ()
clear t@Turtle{layer = l} = do
	forward t 0
	clearLayer l

position :: Turtle -> IO (Double, Double)
position Turtle{stateNow = sn, states = s} =
	fmap (turtlePos . (s !!)) $ readIORef sn

distance :: Turtle -> Double -> Double -> IO Double
distance t x0 y0 = do
	(x, y) <- position t
	return $ ((x - x0) ** 2 + (y - y0) ** 2) ** (1 / 2)

windowWidth, windowHeight :: Turtle -> IO Double
windowWidth = fmap fst . layerSize . layer
windowHeight = fmap snd . layerSize . layer

pendown, penup :: Turtle -> IO ()
pendown Turtle{inputChan = c, stateNow = sn} = do
	modifyIORef sn (+ 1)
	writeChan c PenDown
penup Turtle{inputChan = c, stateNow = sn} = do
	modifyIORef sn (+ 1)
	writeChan c PenUp

isdown :: Turtle -> IO Bool
isdown Turtle{states = s, stateNow = sn} =
	fmap (turtlePenDown . (s !!)) $ readIORef sn

goto :: Turtle -> Double -> Double -> IO ()
goto Turtle{inputChan = c, stateNow = sn} x y = do
	modifyIORef sn (+ 1)
	writeChan c $ Goto x y

rotateTo :: Turtle -> Double -> IO ()
rotateTo Turtle{inputChan = c} d = writeChan c $ RotateTo d

undo :: Turtle -> IO ()
undo t@Turtle{inputChan = c, stateNow = sn} = do
	un <- getUndoNum t
	replicateM_ un $ do
		modifyIORef sn (+1)
		writeChan c Undo

getUndoNum :: Turtle -> IO Int
getUndoNum Turtle{states = s, stateNow = sn} =
	fmap (turtleUndoNum . (s!!)) $ readIORef sn

for2M_ :: [a] -> (a -> a -> IO b) -> IO ()
for2M_ xs f = zipWithM_ f xs $ tail xs

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)
	 ]