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.7")
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, sts) <- getTurtleStates classic
sn <- newIORef 1
let t = Turtle {
inputChan = c,
layer = l,
character = ch,
states = sts,
stateNow = sn
}
_ <- forkIOX $ for2M_ sts $ turtleDraw ch l
return t
sendCommand :: Turtle -> TurtleInput -> IO ()
sendCommand Turtle{inputChan = c, stateNow = sn} ti = do
modifyIORef sn (+ 1)
writeChan c ti
threadDelay 10000
shape :: Turtle -> String -> IO ()
shape t "turtle" = sendCommand t $ Shape turtle
shape t "classic" = sendCommand t $ Shape classic
shape _ name = error $ "There is no shape named " ++ name
shapesize :: Turtle -> Double -> IO ()
shapesize t = sendCommand t . ShapeSize
forward, backward :: Turtle -> Double -> IO ()
forward t = sendCommand t . Forward
backward t = forward t . negate
left, right :: Turtle -> Double -> IO ()
left t = sendCommand t . Left
right t = left t . negate
circle :: Turtle -> Double -> IO ()
circle t 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)
sendCommand t $ Undonum 74
home :: Turtle -> IO ()
home t = goto t 0 0 >> rotate t 0
clear :: Turtle -> IO ()
clear t@Turtle{layer = l} = do
left t 0
clearLayer l
position :: Turtle -> IO (Double, Double)
position Turtle{stateNow = sn, states = s} =
fmap (getPosition . (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 = flip sendCommand Pendown
penup = flip sendCommand Penup
isdown :: Turtle -> IO Bool
isdown Turtle{states = s, stateNow = sn} =
fmap (getPendown . (s !!)) $ readIORef sn
goto :: Turtle -> Double -> Double -> IO ()
goto t x y = sendCommand t $ Goto x y
rotate :: Turtle -> Double -> IO ()
rotate t = sendCommand t . Rotate
undo :: Turtle -> IO ()
undo t = do
un <- getUndoNum t
replicateM_ un $ sendCommand t Undo
getUndoNum :: Turtle -> IO Int
getUndoNum Turtle{states = s, stateNow = sn} =
fmap (undonum . (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)
]