xturtle 0.0.17 → 0.1.0

raw patch · 10 files changed

+193/−153 lines, 10 filesdep ~yjtools

Dependency ranges changed: yjtools

Files

• src/Graphics/X11/Turtle.hs +105/−106
• src/Graphics/X11/Turtle/Data.hs +25/−0
• src/Graphics/X11/Turtle/Field.hs +19/−8
• src/Graphics/X11/Turtle/Input.hs +14/−4
• src/Graphics/X11/Turtle/Layers.hs +8/−8
• src/Graphics/X11/Turtle/Move.hs +7/−4
• src/Graphics/X11/Turtle/Shape.hs +0/−13
• src/Graphics/X11/Turtle/State.hs +6/−2
• src/Graphics/X11/Turtle/XTools.hs +6/−5
• xturtle.cabal +3/−3

@@ -23,11 +23,12 @@ 	goto, 	setx, 	sety,-	right, 	left,+	right, 	setheading, 	circle, 	write,+	bgcolor, 	home, 	clear, 	undo,@@ -36,12 +37,13 @@ 	shape, 	shapesize, 	speed,-	showturtle, 	hideturtle,-	pendown,+	showturtle, 	penup,+	pendown,+	beginfill,+	endfill, 	pencolor,-	bgcolor, 	pensize, 	degrees, 	radians,@@ -70,29 +72,31 @@ 	getSVG ) where +import Graphics.X11.Turtle.Data(nameToShape, nameToSpeed)+import Graphics.X11.Turtle.Input(+	TurtleState, TurtleInput(..),+	turtleSeries, direction, visible, undonum, drawed)+import qualified Graphics.X11.Turtle.Input as S(position, degrees, pendown) import Graphics.X11.Turtle.Move( 	Field, Layer, Character,-	forkField, openField, closeField,-	addCharacter, addLayer, fieldSize, clearLayer, clearCharacter,-	onclick, onrelease, ondrag, onkeypress, waitField,-	moveTurtle, flushField- )-import Graphics.X11.Turtle.Input(-	TurtleInput(..), TurtleState,-	turtleSeries, undonum, visible, direction,-	drawed- )-import qualified Graphics.X11.Turtle.Input as S(degrees, pendown, position)-import Graphics.X11.Turtle.Shape(nameToShape)+	openField, closeField, forkField, waitField, fieldSize, flushField,+	moveTurtle, addLayer, clearLayer, addCharacter, clearCharacter,+	onclick, onrelease, ondrag, onkeypress) import Text.XML.YJSVG(SVG(..), Color(..))+ import Control.Concurrent(Chan, writeChan, ThreadId, killThread) import Control.Monad(replicateM_, zipWithM_)-import Data.IORef(IORef, newIORef, readIORef, modifyIORef)+import Data.IORef(IORef, newIORef, readIORef)+import Data.IORef.Tools(atomicModifyIORef_) import Data.Fixed(mod') +--------------------------------------------------------------------------------+ xturtleVersion :: (Int, String)-xturtleVersion = (41, "0.0.17")+xturtleVersion = (46, "0.1.0") +--------------------------------------------------------------------------------+ data Turtle = Turtle { 	field :: Field, 	layer :: Layer,@@ -104,26 +108,34 @@ 	thread :: ThreadId  } +class ColorClass a where getColor :: a -> Color++instance ColorClass String where getColor = ColorName++instance (Integral r, Integral g, Integral b) => ColorClass (r, g, b) where+	getColor (r, g, b) =+		RGB (fromIntegral r) (fromIntegral g) (fromIntegral b)++--------------------------------------------------------------------------------+ newTurtle :: Field -> IO Turtle newTurtle f = do-	ch <- addCharacter f 	l <- addLayer f+	ch <- addCharacter f 	(ic, tis, sts) <- turtleSeries 	si <- newIORef 1+	tid <- forkField f $ zipWithM_ (moveTurtle f ch l) sts $ tail sts 	let	t = Turtle { 			field = f,-			inputChan = ic, 			layer = l, 			character = ch,+			inputChan = ic, 			states = sts, 			inputs = tis, 			stateIndex = si,-			thread = undefined-		 }-	tid <- forkField f $ zipWithM_ (moveTurtle f ch l) sts $ tail sts-	shape t "classic"-	sendCommand t $ Undonum 0-	return t{thread = tid}+			thread = tid}+	shape t "classic" >> input t (Undonum 0)+	return t  killTurtle :: Turtle -> IO () killTurtle t = flushField (field t) $ do@@ -131,46 +143,31 @@ 	clearCharacter $ character t 	killThread $ thread t -hideturtle, showturtle :: Turtle -> IO ()-hideturtle t = sendCommand t $ SetVisible False-showturtle t = sendCommand t $ SetVisible True--sendCommand :: Turtle -> TurtleInput -> IO ()-sendCommand Turtle{inputChan = c, stateIndex = si} ti = do-	modifyIORef si (+ 1)-	writeChan c ti--shape :: Turtle -> String -> IO ()-shape t = sendCommand t . Shape . nameToShape+input :: Turtle -> TurtleInput -> IO ()+input Turtle{inputChan = c, stateIndex = si} ti =+	atomicModifyIORef_ si (+ 1) >>writeChan c ti -shapesize :: Turtle -> Double -> Double -> IO ()-shapesize t sx sy = sendCommand t $ Shapesize sx sy+--------------------------------------------------------------------------------  forward, backward :: Turtle -> Double -> IO ()-forward t = sendCommand t . Forward+forward t = input t . Forward backward t = forward t . negate -left, right, setheading :: Turtle -> Double -> IO ()-left t = sendCommand t . TurnLeft-right t = left t . negate-setheading t = sendCommand t . Rotate- goto :: Turtle -> Double -> Double -> IO ()-goto t x y = sendCommand t $ Goto x y+goto t x y = input t $ Goto x y  setx, sety :: Turtle -> Double -> IO () setx t x = do 	(_, y) <- position t-	sendCommand t $ Goto x y+	input t $ Goto x y sety t y = do 	(x, _) <- position t-	sendCommand t $ Goto x y--home :: Turtle -> IO ()-home t = goto t 0 0 >> sendCommand t (Rotate 0)+	input t $ Goto x y -clear :: Turtle -> IO ()-clear t = sendCommand t Clear+left, right, setheading :: Turtle -> Double -> IO ()+left t = input t . TurnLeft+right t = left t . negate+setheading t = input t . Rotate  circle :: Turtle -> Double -> IO () circle t r = do@@ -179,69 +176,63 @@ 	left t (deg / 36) 	replicateM_ 35 $ forward t (2 * r * pi / 36) >> left t (deg / 36) 	forward t (r * pi / 36)-	sendCommand t $ Undonum 74+	input t $ Undonum 74 -getDegrees :: Turtle -> IO Double-getDegrees Turtle{stateIndex = si, states = s} =-	fmap (S.degrees . (s !!)) $ readIORef si+write :: Turtle -> String -> Double -> String -> IO ()+write t fnt sz = input t . Write fnt sz -penup, pendown :: Turtle -> IO ()-penup = flip sendCommand $ SetPendown False-pendown = flip sendCommand $ SetPendown True+bgcolor :: ColorClass c => Turtle -> c -> IO ()+bgcolor t = input t . Bgcolor . getColor -pencolor :: ColorClass c => Turtle -> c -> IO ()-pencolor t c = sendCommand t $ Pencolor $ getColor c+home :: Turtle -> IO ()+home t = goto t 0 0 >> setheading t 0 >> input t (Undonum 3) -class ColorClass a where-	getColor :: a -> Color+clear :: Turtle -> IO ()+clear t = input t Clear -instance ColorClass String where-	getColor = ColorName+undo :: Turtle -> IO ()+undo t = readIORef (stateIndex t)+	>>= flip replicateM_ (input t Undo) . undonum . (states t !!) -instance (Integral r, Integral g, Integral b) => ColorClass (r, g, b) where-	getColor (r, g, b) = RGB (fromIntegral r) (fromIntegral g) (fromIntegral b)+-------------------------------------------------------------------------------- -bgcolor :: ColorClass c => Turtle -> c -> IO ()-bgcolor t = sendCommand t . Bgcolor . getColor+shape :: Turtle -> String -> IO ()+shape t = input t . Shape . nameToShape -pensize :: Turtle -> Double -> IO ()-pensize t = sendCommand t . Pensize+shapesize :: Turtle -> Double -> Double -> IO ()+shapesize t sx sy = input t $ Shapesize sx sy  speed :: Turtle -> String -> IO ()-speed t "fastest" = do-	sendCommand t $ PositionStep Nothing-	sendCommand t $ DirectionStep Nothing-speed t "fast" = do-	sendCommand t $ PositionStep $ Just 60-	sendCommand t $ DirectionStep $ Just $ pi / 3-speed t "normal" = do-	sendCommand t $ PositionStep $ Just 20-	sendCommand t $ DirectionStep $ Just $ pi / 9-speed t "slow" = do-	sendCommand t $ PositionStep $ Just 10-	sendCommand t $ DirectionStep $ Just $ pi / 18-speed t "slowest" = do-	sendCommand t $ PositionStep $ Just 3-	sendCommand t $ DirectionStep $ Just $ pi / 60-speed _ _ = putStrLn "no such speed"+speed t str = case nameToSpeed str of+	Just (ps, ds) -> input t (PositionStep ps) >> input t (DirectionStep ds)+	Nothing -> putStrLn "no such speed" -degrees :: Turtle -> Double -> IO ()-degrees t = sendCommand t . Degrees+hideturtle, showturtle :: Turtle -> IO ()+hideturtle = (`input` SetVisible False)+showturtle = (`input` SetVisible True) -radians :: Turtle -> IO ()-radians = flip degrees $ 2 * pi+penup, pendown :: Turtle -> IO ()+penup = (`input` SetPendown False)+pendown = (`input` SetPendown True) -write :: Turtle -> String -> Double -> String -> IO ()-write t fnt sz = sendCommand t . Write fnt sz+beginfill, endfill :: Turtle -> IO ()+beginfill = (`input` SetFill True)+endfill = (`input` SetFill False) -undo :: Turtle -> IO ()-undo t = readIORef (stateIndex t)-	>>= flip replicateM_ (sendCommand t Undo) . undonum . (states t !!)+pencolor :: ColorClass c => Turtle -> c -> IO ()+pencolor t = input t . Pencolor . getColor -windowWidth, windowHeight :: Turtle -> IO Double-windowWidth = fmap fst . fieldSize . field-windowHeight = fmap snd . fieldSize . field+pensize :: Turtle -> Double -> IO ()+pensize t = input t . Pensize +degrees :: Turtle -> Double -> IO ()+degrees t = input t . Degrees++radians :: Turtle -> IO ()+radians = (`degrees` (2 * pi))++--------------------------------------------------------------------------------+ position :: Turtle -> IO (Double, Double) position Turtle{stateIndex = si, states = s} = 	fmap (S.position . (s !!)) $ readIORef si@@ -251,11 +242,15 @@ ycor = fmap snd . position  heading :: Turtle -> IO Double-heading t = do+heading t@Turtle{stateIndex = si, states = s} = do 	deg <- getDegrees t-	dir <- fmap ((* (deg / (2 * pi))) . direction . (states t !!)) $ readIORef $ stateIndex t+	dir <- fmap ((* (deg / (2 * pi))) . direction . (s !!)) $ readIORef si 	return $ dir `mod'` deg +getDegrees :: Turtle -> IO Double+getDegrees Turtle{stateIndex = si, states = s} =+	fmap (S.degrees . (s !!)) $ readIORef si+ towards :: Turtle -> Double -> Double -> IO Double towards t x0 y0 = do 	(x, y) <- position t@@ -268,19 +263,23 @@ 	(x, y) <- position t 	return $ ((x - x0) ** 2 + (y - y0) ** 2) ** (1 / 2) -isdown :: Turtle -> IO Bool+isdown, isvisible :: Turtle -> IO Bool isdown t = fmap (S.pendown . (states t !!)) $ readIORef $ stateIndex t--isvisible :: Turtle -> IO Bool isvisible t = fmap (visible . (states t !!)) $ readIORef $ stateIndex t +windowWidth, windowHeight :: Turtle -> IO Double+windowWidth = fmap fst . fieldSize . field+windowHeight = fmap snd . fieldSize . field++--------------------------------------------------------------------------------+ getInputs :: Turtle -> IO [TurtleInput] getInputs t = do 	i <- readIORef $ stateIndex t 	return $ take (i - 1) $ inputs t  sendInputs :: Turtle -> [TurtleInput] -> IO ()-sendInputs t = mapM_ (sendCommand t)+sendInputs t = mapM_ (input t)  getSVG :: Turtle -> IO [SVG] getSVG t = fmap (reverse . drawed . (states t !!)) $ readIORef $ stateIndex t

@@ -0,0 +1,25 @@+module Graphics.X11.Turtle.Data(nameToShape, nameToSpeed) where++import Control.Arrow(second, (&&&))++nameToShape :: String -> [(Double, Double)]+nameToShape "classic" = unfold [(- 10, 0), (- 16, 6), (0, 0)]+nameToShape "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)]+nameToShape name = error $ "There is no shape named " ++ name++unfold :: [(Double, Double)] -> [(Double, Double)]+unfold = uncurry (++) . (id &&& (reverse . map (second negate)))++nameToSpeed :: String -> Maybe (Maybe Double, Maybe Double)+nameToSpeed str = lookup str speedTable++speedTable :: [(String, (Maybe Double, Maybe Double))]+speedTable = [+	("fastest", (Nothing, Nothing)),+	("fast", (Just 60, Just $ pi / 3)),+	("normal", (Just 20, Just $ pi / 9)),+	("slow", (Just 10, Just $ pi / 18)),+	("slowest", (Just 3, Just $ pi / 60))+ ]

@@ -18,6 +18,7 @@ 	-- ** to Layer 	addLayer, 	drawLine,+	fillPolygon, 	writeString, 	undoLayer, 	clearLayer,@@ -41,9 +42,10 @@ 	GCs, gcForeground, gcBackground, Event(..), 	forkIOX, openWindow, destroyWindow, closeDisplay, windowSize, 	flush, getColorPixel, setForeground, copyArea, fillRectangle,-	fillPolygon, drawLineXT, writeStringXT,+	drawLineXT, writeStringXT, 	allocaXEvent, waitEvent, pending, nextEvent, getEvent, filterEvent, 	utf8LookupString, buttonPress, buttonRelease, xK_VoidSymbol)+import qualified Graphics.X11.Turtle.XTools as X(fillPolygon) import Graphics.X11.Turtle.Layers( 	Layers, Layer, Character, newLayers, redrawLayers, 	makeLayer, addDraw, setBackground, undoLayer, clearLayer,@@ -216,10 +218,11 @@  fieldColor :: Field -> Layer -> Color -> IO () fieldColor f l c = setBackground l $ do-	clr <- getColorPixel (fDisplay f) c-	(w, h) <- readIORef $ fSize f-	setForeground (fDisplay f) (gcBackground $ fGCs f) clr-	fillRectangle (fDisplay f) (undoBuf $ fBufs f) (gcBackground $ fGCs f) 0 0 w h+	getColorPixel (fDisplay f) c >>=+		maybe (return ())+			(setForeground (fDisplay f) (gcBackground $ fGCs f))+	readIORef (fSize f) >>= uncurry (fillRectangle+		(fDisplay f) (undoBuf $ fBufs f) (gcBackground $ fGCs f) 0 0)  -------------------------------------------------------------------------------- @@ -239,6 +242,14 @@ 		(x, y) <- topLeft f xc yc 		writeStringXT (fDisplay f) (bf $ fBufs f) fname size clr x y str +fillPolygon :: Field -> Layer -> [(Double, Double)] -> Color -> IO ()+fillPolygon f l psc clr = addDraw l (fp undoBuf, fp bgBuf)+	where fp bf = do+		ps <- mapM (fmap (uncurry Point) . uncurry (topLeft f)) psc+		getColorPixel (fDisplay f) clr >>= maybe (return ())+			(setForeground (fDisplay f) (gcForeground $ fGCs f))+		X.fillPolygon (fDisplay f) (bf $ fBufs f) (gcForeground $ fGCs f) ps+ drawLineBuf :: Field -> (Bufs -> Pixmap) -> Int -> Color -> 	Double -> Double -> Double -> Double -> IO () drawLineBuf f bf lw c x1_ y1_ x2_ y2_ = do@@ -268,9 +279,9 @@ drawShape :: Field -> Color -> [(Double, Double)] -> IO () drawShape f clr psc = do 	ps <- mapM (fmap (uncurry Point) . uncurry (topLeft f)) psc-	pxl <- getColorPixel (fDisplay f) clr-	setForeground (fDisplay f) (gcForeground $ fGCs f) pxl-	fillPolygon (fDisplay f) (topBuf $ fBufs f) (gcForeground $ fGCs f) ps+	getColorPixel (fDisplay f) clr >>= maybe (return ())+		(setForeground (fDisplay f) (gcForeground $ fGCs f))+	X.fillPolygon (fDisplay f) (topBuf $ fBufs f) (gcForeground $ fGCs f) ps  clearCharacter :: Character -> IO () clearCharacter c = setCharacter c $ return ()

@@ -29,6 +29,7 @@ 	| Pencolor Color 	| Pensize Double 	| SetPendown Bool+	| SetFill Bool 	| SetVisible Bool 	| Degrees Double 	| PositionStep (Maybe Double)@@ -72,6 +73,15 @@ nextTurtle t (Pencolor c) = (clearState t){pencolor = c} nextTurtle t (Pensize ps) = (clearState t){pensize = ps} nextTurtle t (SetPendown pd) = (clearState t){pendown = pd}+nextTurtle t (SetFill f) = (clearState t){+	fill = f,+	draw = if fill t && not f then Just fl else Nothing,+	drawed = if fill t && not f then fl : drawed t else drawed t,+	fillPoints = if f then [(x0, y0)] else []}+	where+	(x0, y0) = position t+	fl = Polyline (uncurry Center `map` fillPoints t)+		(pencolor t) (pencolor t) 0 nextTurtle t (SetVisible v) = (clearState t){visible = v} nextTurtle t (Degrees ds) = (clearState t){degrees = ds} nextTurtle t (PositionStep ps) = (clearState t){positionStep = ps}@@ -80,7 +90,8 @@ nextTurtle t (Goto x y) = (clearState t){ 	position = (x, y), 	draw = if pendown t then Just ln else Nothing,-	drawed = if pendown t then ln : drawed t else drawed t}+	drawed = if pendown t then ln : drawed t else drawed t,+	fillPoints = if fill t then (x, y) : fillPoints t else fillPoints t} 	where 	(x0, y0) = position t 	ln = Line (Center x0 y0) (Center x y) (pencolor t) (pensize t)@@ -89,9 +100,8 @@ 	draw = Just txt, drawed = txt : drawed t} 	where txt = Text (uncurry Center $ position t) sz (pencolor t) fnt str nextTurtle t (Bgcolor c) = (clearState t){-	bgcolor = c,-	drawed = init (drawed t) ++ [Fill c]}-nextTurtle t (Clear) = (clearState t){clear = True, drawed = []}+	bgcolor = c, drawed = init (drawed t) ++ [Fill c]}+nextTurtle t (Clear) = (clearState t){clear = True, drawed = [last $ drawed t]} nextTurtle _ _ = error "not defined"  clearState :: TurtleState -> TurtleState

@@ -20,6 +20,7 @@  import Control.Monad(when, unless) import Data.IORef(IORef, newIORef, readIORef, atomicModifyIORef)+import Data.IORef.Tools(atomicModifyIORef_) import Data.List.Tools(setAt, modifyAt)  --------------------------------------------------------------------------------@@ -60,10 +61,11 @@  }  makeLayer :: IORef Layers -> IO Layer-makeLayer rls = atomicModifyIORef rls $ \ls ->-	(ls{layers = layers ls ++ [[]], buffed = buffed ls ++ [return ()],+makeLayer rls = atomicModifyIORef rls $ \ls -> (ls{+		layers = layers ls ++ [[]],+		buffed = buffed ls ++ [return ()], 		background = background ls ++[return ()]},-		Layer{layerId = length $ layers ls, layerLayers = rls})+	Layer{layerId = length $ layers ls, layerLayers = rls})  makeCharacter :: IORef Layers -> IO Character makeCharacter rls = atomicModifyIORef rls $ \ls ->@@ -75,7 +77,7 @@  redrawLayers :: IORef Layers -> IO () redrawLayers rls = readIORef rls >>= \ls -> do-	sequence_ (background ls)+	sequence_ $ background ls 	clearLayersAction ls >> sequence_ (buffed ls) 	undoLayersAction ls >> mapM_ snd (concat $ layers ls) 	clearCharactersAction ls >> sequence_ (characters ls)@@ -94,7 +96,8 @@  setBackground :: Layer -> IO () -> IO () setBackground Layer{layerId = lid, layerLayers = rls} act = do-	atomicModifyIORef_ rls $ \ls -> ls{background = setAt (background ls) lid act}+	atomicModifyIORef_ rls $ \ls ->+		ls{background = setAt (background ls) lid act} 	redrawLayers rls  undoLayer :: Layer -> IO Bool@@ -120,6 +123,3 @@ 		ls{characters = setAt (characters ls) cid act} 	readIORef rls >>= \ls -> 		clearCharactersAction ls >> sequence_ (characters ls)--atomicModifyIORef_ :: IORef a -> (a -> a) -> IO ()-atomicModifyIORef_ ref f =  atomicModifyIORef ref $ \x -> (f x, ())

@@ -10,7 +10,6 @@ 	forkField, 	waitField, 	fieldSize,-	fieldColor,  	-- * draws 	flushField,@@ -32,7 +31,7 @@ 	Field, Layer, Character, 	openField, closeField, waitField, fieldSize, 	forkField, flushField, fieldColor,-	addLayer, drawLine, writeString, undoLayer, clearLayer,+	addLayer, drawLine, writeString, undoLayer, clearLayer, fillPolygon, 	addCharacter, drawCharacter, drawCharacterAndLine, clearCharacter, 	onclick, onrelease, ondrag, onkeypress) import Text.XML.YJSVG(SVG(..), Position(..))@@ -58,8 +57,8 @@ 		forM_ (positions t0 t1) $ \p -> flushField f $ 			drawT (direction t1) p >> threadDelay (interval t0) 		flushField f $ drawT (direction t1) $ position t1-	when (bgcolor t0 /= bgcolor t1) $ flushField f $ do-		fieldColor f l (bgcolor t1)+	when (bgcolor t0 /= bgcolor t1) $+		flushField f $ fieldColor f l $ bgcolor t1 	unless (undo t1) $ flushField f $ do 		when (visible t0 && not (visible t1)) $ clearCharacter c 		when (clear t1) $ clearLayer l@@ -76,6 +75,10 @@ 	drawLine f l lw clr x0 y0 x1 y1 drawSVG f l (Text (Center x y) sz clr fnt str) = 	writeString f l fnt sz clr x y str+drawSVG f l (Polyline ps fc _ 0) = fillPolygon f l (map posToTup ps) fc+	where+	posToTup (Center x y) = (x, y)+	posToTup _ = error "not implemented" drawSVG _ _ (Fill _) = return () drawSVG _ _ _ = error "not implemented" 

@@ -1,13 +0,0 @@-module Graphics.X11.Turtle.Shape(nameToShape) where--import Control.Arrow(second, (&&&))--nameToShape :: String -> [(Double, Double)]-nameToShape "classic" = unfold [(- 10, 0), (- 16, 6), (0, 0)]-nameToShape "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)]-nameToShape name = error $ "There is no shape named " ++ name--unfold :: [(Double, Double)] -> [(Double, Double)]-unfold = uncurry (++) . (id &&& (reverse . map (second negate)))

@@ -13,6 +13,7 @@ 	directionStep :: Maybe Double, 	interval :: Int, 	pendown :: Bool,+	fill :: Bool, 	pensize :: Double, 	pencolor :: Color, 	bgcolor :: Color,@@ -23,7 +24,8 @@ 	undo :: Bool, 	undonum :: Int, 	draw :: Maybe SVG,-	drawed :: [SVG]}+	drawed :: [SVG],+	fillPoints :: [(Double, Double)]} 	deriving Show  initialTurtleState :: TurtleState@@ -35,6 +37,7 @@ 	directionStep = Just $ pi / 18, 	interval = 10000, 	pendown = True,+	fill = False, 	pensize = 1, 	pencolor = RGB 0 0 0, 	bgcolor = RGB 255 255 255,@@ -45,4 +48,5 @@ 	undo = False, 	undonum = 0, 	draw = Nothing,-	drawed = [Fill $ RGB 255 255 255]}+	drawed = [Fill $ RGB 255 255 255],+	fillPoints = []}

@@ -133,11 +133,12 @@  -------------------------------------------------------------------------------- -getColorPixel :: Display -> Color -> IO Pixel-getColorPixel _ (RGB r g b) = return $ shift (fromIntegral r) 16 .|.+getColorPixel :: Display -> Color -> IO (Maybe Pixel)+getColorPixel _ (RGB r g b) = return $ Just $ shift (fromIntegral r) 16 .|. 	shift (fromIntegral g) 8 .|. fromIntegral b-getColorPixel dpy (ColorName cn) = fmap (color_pixel . fst) $-	allocNamedColor dpy (defaultColormap dpy $ defaultScreen dpy) cn+getColorPixel dpy (ColorName cn) = fmap (Just . color_pixel . fst)+	(allocNamedColor dpy (defaultColormap dpy $ defaultScreen dpy) cn) `catch`+		const (putStrLn "no such color" >> return Nothing)  fillPolygon :: Display -> Drawable -> GC -> [Point] -> IO () fillPolygon d w gc ps = X.fillPolygon d w gc ps nonconvex coordModeOrigin@@ -145,7 +146,7 @@ drawLineXT :: Display -> GC -> Drawable -> Int -> Color -> 	Position -> Position -> Position -> Position -> IO () drawLineXT dpy gc bf lw c x1 y1 x2 y2 = do-	getColorPixel dpy c >>= setForeground dpy gc+	getColorPixel dpy c >>= maybe (return ()) (setForeground dpy gc) 	setLineAttributes dpy gc (fromIntegral lw) lineSolid capRound joinRound 	drawLine dpy bf gc x1 y1 x2 y2 

@@ -2,7 +2,7 @@ cabal-version:	>= 1.6  name:		xturtle-version:	0.0.17+version:	0.1.0 stability:	experimental author:		Yoshikuni Jujo <PAF01143@nifty.ne.jp> maintainer:	Yoshikuni Jujo <PAF01143@nifty.ne.jp>@@ -30,9 +30,9 @@ library   Hs-source-dirs:	src   Exposed-modules:	Graphics.X11.Turtle-  Build-depends:	base > 3 && < 5, yjtools >= 0.9.13, convertible >= 1.0.8, X11,+  Build-depends:	base > 3 && < 5, yjtools >= 0.9.14, convertible >= 1.0.8, X11,     X11-xft <= 3.1, x11-xim, setlocale, yjsvg >= 0.1.13   Ghc-options:		-Wall   Other-modules:	Graphics.X11.Turtle.Field, Graphics.X11.Turtle.Input,-    Graphics.X11.Turtle.Move, Graphics.X11.Turtle.State, Graphics.X11.Turtle.Shape,+    Graphics.X11.Turtle.Move, Graphics.X11.Turtle.State, Graphics.X11.Turtle.Data,     Graphics.X11.Turtle.Layers, Graphics.X11.Turtle.XTools