module Graphics.X11.TurtleDraw (
Field,
Layer,
Character,
forkIOX,
openField,
addLayer,
addCharacter,
layerSize,
turtleDraw,
clearLayer
) where
import Graphics.X11.TurtleState(TurtleState(..))
import Graphics.X11.WindowLayers(
Field, Layer, Character,
forkIOX, openField, addLayer, addCharacter, layerSize, clearLayer,
drawLine, drawCharacter, drawCharacterAndLine, undoLayer
)
import Control.Concurrent(threadDelay)
import Control.Monad(when, forM_)
import Control.Arrow((***))
step :: Double
step = 10
moveSpeed :: Int
moveSpeed = 50000
stepDir :: Double
stepDir = 5
rotateSpeed :: Int
rotateSpeed = 10000
turtleDraw, turtleDrawNotUndo, turtleDrawUndo ::
Character -> Layer -> TurtleState -> TurtleState -> IO ()
turtleDraw c l t0 t1 = if undo t1
then turtleDrawUndo c l t0 t1
else turtleDrawNotUndo c l t0 t1
turtleDrawUndo c l t0 t1 = do
let p0@(x0, y0) = position t0
p1@(x1, y1) = position t1
lineOrigin = if line t0 then Just p1 else Nothing
when (line t0) $ undoLayer l
forM_ (getDirections (direction t0) (direction t1)) $ \d -> do
drawTurtle c (shape t1) (size t1) d p0 Nothing
threadDelay rotateSpeed
forM_ (getPoints x0 y0 x1 y1) $ \p -> do
drawTurtle c (shape t1) (size t1) (direction t1) p lineOrigin
threadDelay moveSpeed
drawTurtle c (shape t1) (size t1) (direction t1) p1 lineOrigin
turtleDrawNotUndo c l t0 t1 = do
let p0@(x0, y0) = position t0
p1@(x1, y1) = position t1
lineOrigin = if line t1 then Just p0 else Nothing
forM_ (getDirections (direction t0) (direction t1)) $ \d -> do
drawTurtle c (shape t1) (size t1) d p0 Nothing
threadDelay rotateSpeed
forM_ (getPoints x0 y0 x1 y1) $ \p -> do
drawTurtle c (shape t1) (size t1) (direction t1) p lineOrigin
threadDelay moveSpeed
drawTurtle c (shape t1) (size t1) (direction t1) p1 lineOrigin
when (line t1) $ drawLine l x0 y0 x1 y1
getPoints :: Double -> Double -> Double -> Double -> [(Double, Double)]
getPoints x1 y1 x2 y2 = zip [x1, x1 + dx .. x2 dx] [y1, y1 + dy .. y2 dy]
where
len = ((x2 x1) ** 2 + (y2 y1) ** 2) ** (1/2)
dx = (x2 x1) * step / len
dy = (y2 y1) * step / len
getDirections :: Double -> Double -> [Double]
getDirections ds de = [ds, ds + dd .. de dd]
where
dd = if de > ds then stepDir else stepDir
drawTurtle :: Character -> [(Double, Double)] -> Double -> Double ->
(Double, Double) -> Maybe (Double, Double) -> IO ()
drawTurtle c sh s d (px, py) org = do
let sp = map (((+ px) *** (+ py)) . rotatePoint . ((* s) *** (* s))) sh
maybe (drawCharacter c sp)
(\(x0, y0) -> (drawCharacterAndLine c sp x0 y0 px py)) org
where
rotatePoint (x, y) = let rad = d * pi / 180 in
(x * cos rad y * sin rad, x * sin rad + y * cos rad)