packages feed

xturtle 0.0.7 → 0.0.8

raw patch · 7 files changed

+183/−181 lines, 7 files

Files

src/Graphics/X11/Turtle.hs view
@@ -2,6 +2,7 @@ 	Turtle,  	openField,+--	closeField, 	newTurtle,  	shape,@@ -27,51 +28,57 @@ 	xturtleVersion ) where -import Graphics.X11.TurtleDraw-import Graphics.X11.TurtleInput-import Control.Concurrent-import Control.Monad+import Graphics.X11.TurtleMove(+	Field, Layer, Character,+	forkIOX, openField, -- closeField,+	addCharacter, addLayer, layerSize,+	moveTurtle+ )+import Graphics.X11.TurtleInput(+	TurtleInput(..), TurtleState,+	getTurtleStates, getPosition, getPendown, undonum+ )+import Graphics.X11.TurtleShape(lookupShape, classic)+import Control.Concurrent(Chan, writeChan, threadDelay)+import Control.Monad(replicateM_, zipWithM_) import Prelude hiding(Left)-import Data.IORef-import Control.Arrow(second)+import Data.IORef(IORef, newIORef, readIORef, modifyIORef)  xturtleVersion :: (Int, String)-xturtleVersion = (1, "0.0.7")+xturtleVersion = (14, "0.0.8")  data Turtle = Turtle {+	layer :: Layer,+	character :: Character, 	inputChan :: Chan TurtleInput, 	states :: [TurtleState],-	stateNow :: IORef Int,-	layer :: Layer,-	character :: Character+	stateIndex :: IORef Int  }  newTurtle :: Field -> IO Turtle newTurtle f = do 	ch <- addCharacter f 	l <- addLayer f-	(c, sts) <- getTurtleStates classic-	sn <- newIORef 1+	(ic, sts) <- getTurtleStates classic+	si <- newIORef 1 	let	t = Turtle {-			inputChan = c,+			inputChan = ic, 			layer = l, 			character = ch, 			states = sts,-			stateNow = sn+			stateIndex = si 		 }-	_ <- forkIOX $ for2M_ sts $ turtleDraw ch l+	_ <- forkIOX $ zipWithM_ (moveTurtle ch l) sts $ tail sts 	return t  sendCommand :: Turtle -> TurtleInput -> IO ()-sendCommand Turtle{inputChan = c, stateNow = sn} ti = do-	modifyIORef sn (+ 1)+sendCommand Turtle{inputChan = c, stateIndex = si} ti = do+	modifyIORef si (+ 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+shape t = sendCommand t . Shape . lookupShape  shapesize :: Turtle -> Double -> IO () shapesize t = sendCommand t . ShapeSize@@ -84,6 +91,15 @@ left t = sendCommand t . Left right t = left t . negate +goto :: Turtle -> Double -> Double -> IO ()+goto t x y = sendCommand t $ Goto x y++home :: Turtle -> IO ()+home t = goto t 0 0 >> sendCommand t (Rotate 0)++clear :: Turtle -> IO ()+clear t = sendCommand t Clear+ circle :: Turtle -> Double -> IO () circle t r = do 	forward t (r * pi / 36)@@ -92,77 +108,26 @@ 	forward t (r * pi / 36) 	sendCommand t $ Undonum 74 -home :: Turtle -> IO ()-home t = goto t 0 0 >> rotate t 0+penup, pendown :: Turtle -> IO ()+penup = flip sendCommand Penup+pendown = flip sendCommand Pendown -clear :: Turtle -> IO ()-clear t@Turtle{layer = l} = do-	left t 0-	clearLayer l+undo :: Turtle -> IO ()+undo t = readIORef (stateIndex t)+	>>= flip replicateM_ (sendCommand t Undo) . undonum . (states t !!) +windowWidth, windowHeight :: Turtle -> IO Double+windowWidth = fmap fst . layerSize . layer+windowHeight = fmap snd . layerSize . layer+ position :: Turtle -> IO (Double, Double)-position Turtle{stateNow = sn, states = s} =-	fmap (getPosition . (s !!)) $ readIORef sn+position Turtle{stateIndex = si, states = s} =+	fmap (getPosition . (s !!)) $ readIORef si  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)-	 ]+isdown t = fmap (getPendown . (states t !!)) $ readIORef $ stateIndex t
− src/Graphics/X11/TurtleDraw.hs 
@@ -1,90 +0,0 @@-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)
src/Graphics/X11/TurtleInput.hs view
@@ -26,6 +26,7 @@ 	| Penup 	| Pendown 	| Undo+	| Clear 	| Forward Double 	| Left Double 	| Undonum Int@@ -51,10 +52,11 @@ nextTurtle t Pendown = (clearState t){pendown = True} nextTurtle t Penup = (clearState t){pendown = False} nextTurtle t (Undonum un) = (clearState t){undonum = un}+nextTurtle t (Clear) = (clearState t){clear = True} nextTurtle _ _ = error "not defined"  clearState :: TurtleState -> TurtleState-clearState t = t{line = False, undo = False, undonum = 1}+clearState t = t{line = False, undo = False, undonum = 1, clear = False}  inputToTurtle :: [TurtleState] -> TurtleState -> [TurtleInput] -> [TurtleState] inputToTurtle [] ts0 (Undo : tis) = ts0 : inputToTurtle [] ts0 tis
+ src/Graphics/X11/TurtleMove.hs view
@@ -0,0 +1,79 @@+module Graphics.X11.TurtleMove (+	Field,+	Layer,+	Character,++	forkIOX,+	openField,+	closeField,+	addLayer,+	addCharacter,+	layerSize,++	moveTurtle+) where++import Graphics.X11.TurtleState(TurtleState(..))+import Graphics.X11.WindowLayers(+	Field, Layer, Character,+	forkIOX, openField, closeField,+	addLayer, addCharacter, layerSize, clearLayer,+	drawLine, drawCharacter, drawCharacterAndLine, undoLayer+ )++import Control.Concurrent(threadDelay)+import Control.Monad(when, forM_)+import Control.Arrow((***))++type Pos = (Double, Double)++step :: Double+step = 10++moveSpeed :: Int+moveSpeed = 50000++stepDir :: Double+stepDir = 5++rotateSpeed :: Int+rotateSpeed = 10000++moveTurtle :: Character -> Layer -> TurtleState -> TurtleState -> IO ()+moveTurtle c l t0 t1 = do+	when (undo t1 && line t0) $ undoLayer l+	forM_ (getDirections (direction t0) (direction t1)) $ \d -> do+		drawTurtle c (shape t1) (size t1) d p0 Nothing+		threadDelay rotateSpeed+	forM_ (getPositions 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 (not (undo t1) && line t1) $ drawLine l x0 y0 x1 y1+	when (clear t1) $ clearLayer l+	where+	(tl, to) = if undo t1 then (t0, t1) else (t1, t0)+	lineOrigin = if line tl then Just $ position to else Nothing+	p0@(x0, y0) = position t0+	p1@(x1, y1) = position t1++getPositions :: Double -> Double -> Double -> Double -> [Pos]+getPositions x0 y0 x1 y1 = zip [x0, x0 + dx .. x1 - dx] [y0, y0 + dy .. y1 - dy]+	where+	dist = ((x1 - x0) ** 2 + (y1 - y0) ** 2) ** (1/2)+	dx = step * (x1 - x0) / dist+	dy = step * (y1 - y0) / dist++getDirections :: Double -> Double -> [Double]+getDirections ds de = [ds, ds + dd .. de - dd]+	where+	dd = if de > ds then stepDir else - stepDir++drawTurtle :: Character -> [Pos] -> Double -> Double -> Pos -> Maybe Pos -> 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)
+ src/Graphics/X11/TurtleShape.hs view
@@ -0,0 +1,45 @@+module Graphics.X11.TurtleShape(+	lookupShape,+	classic+ ) where++import Control.Arrow(second)+import Data.Maybe(fromMaybe)++lookupShape :: String -> [(Double, Double)]+lookupShape sn = fromMaybe (error errMsg) $ lookup sn shapeList+	where errMsg = "There is no shape named " ++ sn++shapeList :: [(String, [(Double, Double)])]+shapeList = [+	("classic", classic),+	("turtle", turtle)+ ]++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)+	 ]
src/Graphics/X11/TurtleState.hs view
@@ -11,7 +11,8 @@ 	pendown :: Bool, 	line :: Bool, 	undo :: Bool,-	undonum :: Int+	undonum :: Int,+	clear :: Bool  } deriving Show  initialTurtleState :: [(Double, Double)] -> TurtleState@@ -23,5 +24,6 @@ 	pendown = True, 	line = False, 	undo = False,-	undonum = 1+	undonum = 1,+	clear = False  }
xturtle.cabal view
@@ -2,7 +2,7 @@ cabal-version:	>= 1.6  name:		xturtle-version:	0.0.7+version:	0.0.8 stability:	experimental author:		Yoshikuni Jujo <PAF01143@nifty.ne.jp> maintainer:	Yoshikuni Jujo <PAF01143@nifty.ne.jp>@@ -32,6 +32,5 @@   Exposed-modules:	Graphics.X11.Turtle   Build-depends:	base > 3 && < 5, yjtools >= 0.9.13, convertible, X11   Ghc-options:		-Wall-  Other-modules:	Graphics.X11.WindowLayers,-    Graphics.X11.TurtleInput,-    Graphics.X11.TurtleDraw, Graphics.X11.TurtleState+  Other-modules:	Graphics.X11.WindowLayers, Graphics.X11.TurtleInput,+    Graphics.X11.TurtleMove, Graphics.X11.TurtleState, Graphics.X11.TurtleShape