TurtleInput.hs

module Graphics.X11.TurtleInput (
	TurtleState(turtlePos, turtleUndoNum, turtlePenDown),

	makeInput,
	inputToTurtle,
	TurtleInput(..),
	initialTurtleState
) where

import Control.Concurrent
import System.IO.Unsafe
import Graphics.X11.TurtleState
import Prelude hiding (Left)

data TurtleInput
	= Shape [(Double, Double)]
	| ShapeSize Double
	| Goto Double Double
	| RotateTo Double
	| PenUp
	| PenDown
	| Undo
	| Forward Double
	| Left Double
	| SetUndoNum Int
	deriving Show

makeInput :: IO (Chan TurtleInput, [TurtleInput])
makeInput = do
	c <- newChan
	ret <- getInput c
	return (c, ret)

getInput :: Chan TurtleInput -> IO [TurtleInput]
getInput c = unsafeInterleaveIO $ do
	ti <- readChan c
	tis <- getInput c
	return $ ti : tis

nextTurtle :: TurtleState -> TurtleState
nextTurtle t = TurtleState{
	turtleShape = turtleShape t,
	turtleSize = turtleSize t,
	turtlePos = turtlePos t,
	turtleDir = turtleDir t,
	turtlePenDown = turtlePenDown t,
	turtleUndo = False,
	turtleUndoNum = 1
 }

inputToTurtleNext :: [TurtleState] -> TurtleState -> [TurtleInput] -> [TurtleState]
inputToTurtleNext tsbs nts ti = nts : inputToTurtle tsbs nts ti

inputToTurtle :: [TurtleState] -> TurtleState -> [TurtleInput] -> [TurtleState]
inputToTurtle (tsb : tsbs) _ (Undo : ti) =
	tsb{turtleUndo = True } : inputToTurtle tsbs tsb{turtleUndo = True} ti
inputToTurtle tsbs ts0 (Shape sh : ti) =
	inputToTurtleNext (ts0 : tsbs) (nextTurtle ts0){turtleShape = sh} ti
inputToTurtle tsbs ts0 (ShapeSize ss : ti) =
	inputToTurtleNext (ts0 : tsbs) (nextTurtle ts0){turtleSize = ss} ti
inputToTurtle tsbs ts0 (Goto x y : ti) =
	inputToTurtleNext (ts0 : tsbs) (nextTurtle ts0){turtlePos = (x, y)} ti
inputToTurtle tsbs ts0 (RotateTo d : ti) =
	inputToTurtleNext (ts0 : tsbs) (nextTurtle ts0){turtleDir = d} ti
inputToTurtle tsbs ts0 (PenDown : ti) =
	inputToTurtleNext (ts0 : tsbs) (nextTurtle ts0){turtlePenDown = True} ti
inputToTurtle tsbs ts0 (PenUp : ti) =
	inputToTurtleNext (ts0 : tsbs) (nextTurtle ts0){turtlePenDown = False} ti
inputToTurtle tsbs ts0 (SetUndoNum un : ti) =
	inputToTurtleNext (ts0 : tsbs) (nextTurtle ts0){turtleUndoNum = un} ti
inputToTurtle tsbs ts0 (Forward len : ti) = let
	(x0, y0) = turtlePos ts0
	dir = turtleDir ts0
	x = x0 + len * cos (dir * pi / 180)
	y = y0 + len * sin (dir * pi / 180) in
	inputToTurtle tsbs ts0 (Goto x y : ti)
inputToTurtle tsbs ts0 (Left dd : ti) =
	inputToTurtle tsbs ts0 $ RotateTo (turtleDir ts0 + dd) : ti
inputToTurtle _ _ _ = error "bad condition in inputToTurtle"