Input.hs

module Graphics.X11.Turtle.Input (
	TurtleState,
	TurtleInput(..),

	getTurtleStates,
	position,
	pendown,
	undonum,
	visible,
	direction,
	degrees,
	drawed,
) where

import Graphics.X11.Turtle.State(TurtleState(..), initialTurtleState)
import Control.Concurrent.Chan(Chan, newChan, getChanContents)
import Prelude hiding(Left)
import Text.XML.YJSVG(SVG(..), Color(..), Position(..))

data TurtleInput
	= Shape [(Double, Double)]
	| ShapeSize Double
	| Goto Double Double
	| Rotate Double
	| Penup
	| Pendown
	| SetVisible Bool
	| Undo
	| Clear
	| Forward Double
	| Left Double
	| Undonum Int
	| Pencolor Color
	| Pensize Double
	| Degrees Double
	| Write String Double String
	deriving (Show, Read)

getTurtleStates :: IO (Chan TurtleInput, [TurtleInput], [TurtleState])
getTurtleStates = do
	let	ts0 = initialTurtleState
	c <- newChan
	tis <- getChanContents c
	return (c, tis, ts0 : ts0 : inputToTurtle [] ts0 tis)

nextTurtle :: TurtleState -> TurtleInput -> TurtleState
nextTurtle t (Shape sh) = (clearState t){shape = sh}
nextTurtle t (ShapeSize ss) = (clearState t){shapesize = ss}
nextTurtle t (Goto x y) = (clearState t){position = (x, y),
	drawed = if pendown t then ln : drawed t else drawed t,
	draw = if pendown t then Just ln else Nothing}
	where
	ln = Line (uncurry Center $ position t) (Center x y) (pencolor t)
		(pensize t)
nextTurtle t (Rotate d) = (clearState t){direction = d}
nextTurtle t Pendown = (clearState t){pendown = True}
nextTurtle t Penup = (clearState t){pendown = False}
nextTurtle t (SetVisible v) = (clearState t){visible = v}
nextTurtle t (Undonum un) = (clearState t){undonum = un}
nextTurtle t (Clear) = (clearState t){clear = True, drawed = []}
nextTurtle t (Pencolor c) = (clearState t){pencolor = c}
nextTurtle t (Pensize ps) = (clearState t){pensize = ps}
nextTurtle t (Degrees ds) = (clearState t){
	degrees = ds,
	direction = direction t * ds / degrees t
 }
nextTurtle t (Write fnt sz str) = (clearState t){
	draw = Just d, drawed = d : drawed t
 }
	where
	(x, y) = position t
	d = Text (Center x y) sz (pencolor t) fnt str
nextTurtle _ _ = error "not defined"

clearState :: TurtleState -> TurtleState
clearState t = t{undo = False, undonum = 1, clear = False, draw = Nothing}

inputToTurtle :: [TurtleState] -> TurtleState -> [TurtleInput] -> [TurtleState]
inputToTurtle [] ts0 (Undo : tis) = ts0 : inputToTurtle [] ts0 tis
inputToTurtle (tsb : tsbs) _ (Undo : tis) =
	let ts1 = tsb{undo = True} in ts1 : inputToTurtle tsbs ts1 tis
inputToTurtle tsbs ts0 (Forward len : tis) = let
	(x0, y0) = position ts0
	dir = direction ts0 / degrees ts0
	x = x0 + len * cos (dir * 2 * pi)
	y = y0 + len * sin (dir * 2 * pi) in
	inputToTurtle tsbs ts0 $ Goto x y : tis
inputToTurtle tsbs ts0 (Left dd : tis) =
	inputToTurtle tsbs ts0 $ Rotate (direction ts0 + dd) : tis
inputToTurtle tsbs ts0 (ti : tis) =
	let ts1 = nextTurtle ts0 ti in ts1 : inputToTurtle (ts0 : tsbs) ts1 tis
inputToTurtle _ _ [] = error "no more input"