xturtle 0.0.11 → 0.0.12

raw patch · 7 files changed

+66/−90 lines, 7 files

Files

• src/Graphics/X11/Turtle.hs +9/−7
• src/Graphics/X11/TurtleInput.hs +4/−3
• src/Graphics/X11/TurtleMove.hs +11/−11
• src/Graphics/X11/TurtleShape.hs +9/−40
• src/Graphics/X11/TurtleState.hs +18/−18
• src/Graphics/X11/WindowLayers.hs +14/−10
• xturtle.cabal +1/−1

@@ -57,7 +57,7 @@ import Graphics.X11.TurtleMove( 	Field, Layer, Character, 	forkIOX, openField, closeField,-	addCharacter, addLayer, layerSize, clearLayer, clearCharacter,+	addCharacter, addLayer, fieldSize, clearLayer, clearCharacter, 	addThread, fieldColor, onclick, waitField, 	moveTurtle  )@@ -66,7 +66,7 @@ 	getTurtleStates, getPosition, getPendown, undonum, visible, direction  ) import qualified Graphics.X11.TurtleInput as S(degrees)-import Graphics.X11.TurtleShape(lookupShape, classic)+import Graphics.X11.TurtleShape(lookupShape) import Control.Concurrent(Chan, writeChan, threadDelay, ThreadId, killThread) import Control.Monad(replicateM_, zipWithM_) import Prelude hiding(Left)@@ -76,9 +76,10 @@ import Data.Fixed(mod')  xturtleVersion :: (Int, String)-xturtleVersion = (18, "0.0.11")+xturtleVersion = (21, "0.0.12")  data Turtle = Turtle {+	field :: Field, 	layer :: Layer, 	character :: Character, 	inputChan :: Chan TurtleInput,@@ -91,9 +92,10 @@ newTurtle f = do 	ch <- addCharacter f 	l <- addLayer f-	(ic, sts) <- getTurtleStates classic+	(ic, sts) <- getTurtleStates $ lookupShape "classic" 	si <- newIORef 1 	let	t = Turtle {+			field = f, 			inputChan = ic, 			layer = l, 			character = ch,@@ -182,7 +184,7 @@ 	c = shift r 16 .|. shift g 8 .|. b 	[r, g, b] = map fromIntegral [r_, g_, b_] -pensize :: Turtle -> Int -> IO ()+pensize :: Turtle -> Double -> IO () pensize t = sendCommand t . Pensize  degrees :: Turtle -> Double -> IO ()@@ -196,8 +198,8 @@ 	>>= flip replicateM_ (sendCommand t Undo) . undonum . (states t !!)  windowWidth, windowHeight :: Turtle -> IO Double-windowWidth = fmap fst . layerSize . layer-windowHeight = fmap snd . layerSize . layer+windowWidth = fmap fst . fieldSize . field+windowHeight = fmap snd . fieldSize . field  position :: Turtle -> IO (Double, Double) position Turtle{stateIndex = si, states = s} =

@@ -35,7 +35,7 @@ 	| Left Double 	| Undonum Int 	| Pencolor Color-	| Pensize Int+	| Pensize Double 	| Degrees Double 	deriving Show @@ -48,9 +48,10 @@  nextTurtle :: TurtleState -> TurtleInput -> TurtleState nextTurtle t (Shape sh) = (clearState t){shape = sh}-nextTurtle t (ShapeSize ss) = (clearState t){size = ss}+nextTurtle t (ShapeSize ss) = (clearState t){shapesize = ss} nextTurtle t (Goto x y) = (clearState t){position = (x, y), line = pendown t,-	drawed = if pendown t then (pencolor t, position t, (x, y)) : drawed t else drawed t} +	drawed = if pendown t then (pencolor t, pensize t, position t, (x, y))+		: drawed t else drawed t}  nextTurtle t (Rotate d) = (clearState t){direction = d} nextTurtle t Pendown = (clearState t){pendown = True} nextTurtle t Penup = (clearState t){pendown = False}

@@ -8,7 +8,7 @@ 	closeField, 	addLayer, 	addCharacter,-	layerSize,+	fieldSize, 	clearLayer, 	clearCharacter, 	addThread,@@ -23,7 +23,7 @@ import Graphics.X11.WindowLayers( 	Field, Layer, Character, 	forkIOX, openField, closeField, flushLayer,-	addLayer, addCharacter, layerSize, clearLayer,+	addLayer, addCharacter, fieldSize, clearLayer, 	drawLine, drawCharacter, drawCharacterAndLine, undoLayer, 	drawLineNotFlush, 	clearCharacter, addThread,@@ -55,18 +55,18 @@ moveTurtle c l t0 t1 = do 	when (undo t1 && line t0) $ do 		done <- undoLayer l-		unless done $ clearLayer l >> drawLines l (pensize t1) (drawed t1)-	when (undo t1 && clear t0) $ drawLines l (pensize t1) $ drawed t1+		unless done $ clearLayer l >> drawLines l (drawed t1)+	when (undo t1 && clear t0) $ drawLines l $ drawed t1 	when (visible t1) $ do 		forM_ (getDirections (dir t0) (dir t1)) $ \d -> do-			drawTurtle c (pencolor t1) (shape t1) (size t1) d+			drawTurtle c (pencolor t1) (shape t1) (shapesize t1) d 				(pensize t1) p0 Nothing 			threadDelay rotateSpeed 		forM_ (getPositions x0 y0 x1 y1) $ \p -> do-			drawTurtle c (pencolor t1) (shape t1) (size t1)+			drawTurtle c (pencolor t1) (shape t1) (shapesize t1) 				(dir t1) (pensize t1) p lineOrigin 			threadDelay moveSpeed-		drawTurtle c (pencolor t1) (shape t1) (size t1) (dir t1)+		drawTurtle c (pencolor t1) (shape t1) (shapesize t1) (dir t1) 			(pensize t1) p1 lineOrigin 	unless (visible t1) $ clearCharacter c 	when (not (undo t1) && line t1) $@@ -78,9 +78,9 @@ 	p0@(x0, y0) = position t0 	p1@(x1, y1) = position t1 -drawLines :: Layer -> Int -> [(Color, (Double, Double), (Double, Double))] -> IO ()-drawLines l lw ls =-	mapM_ (\(clr, (x0, y0), (x1, y1)) -> drawLineNotFlush l lw clr x0 y0 x1 y1) $ reverse ls+drawLines :: Layer -> [(Color, Double, (Double, Double), (Double, Double))] -> IO ()+drawLines l ls =+	mapM_ (\(clr, lw, (x0, y0), (x1, y1)) -> drawLineNotFlush l lw clr x0 y0 x1 y1) $ reverse ls  getPositions :: Double -> Double -> Double -> Double -> [Pos] getPositions x0 y0 x1 y1 = take num $ zip [x0, x0 + dx .. ] [y0, y0 + dy .. ]@@ -95,7 +95,7 @@ 	where 	dd = if de > ds then stepDir else - stepDir -drawTurtle :: Character -> Color -> [Pos] -> Double -> Double -> Int ->+drawTurtle :: Character -> Color -> [Pos] -> Double -> Double -> Double -> 	Pos -> Maybe Pos -> IO () drawTurtle c clr sh s d lw (px, py) org = do 	let sp = map (((+ px) *** (+ py)) . rotatePoint . ((* s) *** (* s))) sh

@@ -1,45 +1,14 @@-module Graphics.X11.TurtleShape(-	lookupShape,-	classic- ) where+module Graphics.X11.TurtleShape(lookupShape) where -import Control.Arrow(second)-import Data.Maybe(fromMaybe)+import Control.Arrow(second, (&&&))  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)+lookupShape "classic" = unfold [(- 10, 0), (- 16, 6), (0, 0)]+lookupShape "turtle" = unfold [+	(- 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)  ]--classic :: [(Double, Double)]-classic = clssc ++ reverse (map (second negate) clssc)-	where-	clssc = [-		(- 10, 0),-		(- 16, 6),-		(0, 0)-	 ]+lookupShape name = error $ "There is no shape named " ++ name -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)-	 ]+unfold :: [(Double, Double)] -> [(Double, Double)]+unfold = uncurry (++) . (id &&& (reverse . map (second negate)))

@@ -9,36 +9,36 @@ type Color = Word32  data TurtleState = TurtleState {-	shape :: [(Double, Double)],-	size :: Double, 	position :: (Double, Double), 	direction :: Double,+	degrees :: Double, 	pendown :: Bool,-	drawed :: [(Color, (Double, Double), (Double, Double))],-	line :: Bool,+	pensize :: Double,+	pencolor :: Color,+	shape :: [(Double, Double)],+	shapesize :: Double,+	visible :: Bool,+	clear :: Bool, 	undo :: Bool,+	line :: Bool, 	undonum :: Int,-	clear :: Bool,-	visible :: Bool,-	pencolor :: Color,-	pensize :: Int,-	degrees :: Double+	drawed :: [(Color, Double, (Double, Double), (Double, Double))]  } deriving Show  initialTurtleState :: [(Double, Double)] -> TurtleState initialTurtleState sh = TurtleState {-	shape = sh,-	size = 1, 	position = (0, 0), 	direction = 0,+	degrees = 360, 	pendown = True,-	drawed = [],-	line = False,+	pensize = 0,+	pencolor = 0x000000,+	shape = sh,+	shapesize = 1,+	visible = True,+	clear = False, 	undo = False,+	line = False, 	undonum = 1,-	clear = False,-	visible = True,-	pencolor = 0x000000,-	pensize = 0,-	degrees = 360+	drawed = []  }

@@ -7,7 +7,7 @@ 	closeField, 	waitField, 	fieldColor,-	layerSize,+	fieldSize,  	addLayer, 	addCharacter,@@ -221,9 +221,6 @@ addThread :: Field -> ThreadId -> IO () addThread f tid = modifyIORef (fRunning f) (tid :) -layerSize :: Layer -> IO (Double, Double)-layerSize = fieldSize . layerField- flushLayer :: Layer -> IO () flushLayer = flushWindow . layerField @@ -245,19 +242,24 @@ 	cl <- readIORef $ fClosed f 	if cl then return () else act >> return () -drawLineNotFlush :: Layer -> Int -> Pixel -> Double -> Double -> Double -> Double -> IO ()-drawLineNotFlush l@Layer{layerField = f} lw clr x1 y1 x2 y2 = runIfOpened f $ do+drawLineNotFlush ::+	Layer -> Double -> Pixel -> Double -> Double -> Double -> Double -> IO ()+drawLineNotFlush l@Layer{layerField = f} lw_ clr x1 y1 x2 y2 = runIfOpened f $ do 	drawLineBuf f lw clr fBG x1 y1 x2 y2 	addLayerAction l $ whether 		(drawLineBuf f lw clr fUndoBuf x1 y1 x2 y2) 		(drawLineBuf f lw clr fBG x1 y1 x2 y2)+	where+	lw = round lw_ -drawLine :: Layer -> Int -> Pixel -> Double -> Double -> Double -> Double -> IO ()-drawLine l@Layer{layerField = f} lw clr x1 y1 x2 y2 = runIfOpened f $ do+drawLine :: Layer -> Double -> Pixel -> Double -> Double -> Double -> Double -> IO ()+drawLine l@Layer{layerField = f} lw_ clr x1 y1 x2 y2 = runIfOpened f $ do 	drawLineBuf f lw clr fBG x1 y1 x2 y2 >> redrawCharacters f 	addLayerAction l $ whether 		(drawLineBuf f lw clr fUndoBuf x1 y1 x2 y2) 		(drawLineBuf f lw clr fBG x1 y1 x2 y2)+	where+	lw = round lw_  clearCharacter :: Character -> IO () clearCharacter c = runIfOpened (characterField c) $@@ -269,12 +271,14 @@ 		setForeground (fDisplay f) (fGC f) clr 		fillPolygonBuf (characterField c) sh -drawCharacterAndLine ::	Character -> Pixel -> [(Double, Double)] -> Int ->+drawCharacterAndLine ::	Character -> Pixel -> [(Double, Double)] -> Double -> 	Double -> Double -> Double -> Double -> IO ()-drawCharacterAndLine c@Character{characterField = f} clr ps lw x1 y1 x2 y2 = do+drawCharacterAndLine c@Character{characterField = f} clr ps lw_ x1 y1 x2 y2 = do 	runIfOpened f $ setCharacter c $ do 		setForeground (fDisplay f) (fGC f) clr 		fillPolygonBuf f ps >> drawLineBuf f lw clr fBuf x1 y1 x2 y2+	where+	lw = round lw_  undoLayer :: Layer -> IO Bool undoLayer Layer{layerField = f, layerId = lid} = do

@@ -2,7 +2,7 @@ cabal-version:	>= 1.6  name:		xturtle-version:	0.0.11+version:	0.0.12 stability:	experimental author:		Yoshikuni Jujo <PAF01143@nifty.ne.jp> maintainer:	Yoshikuni Jujo <PAF01143@nifty.ne.jp>