packages feed

xturtle 0.0.9 → 0.0.10

raw patch · 6 files changed

+305/−93 lines, 6 files

Files

src/Graphics/X11/Turtle.hs view
@@ -1,48 +1,75 @@ module Graphics.X11.Turtle (+	Field, 	Turtle,  	openField,---	closeField,+	closeField, 	newTurtle,+	killTurtle, -	shape,-	shapesize, 	forward, 	backward,-	left, 	right,+	left, 	goto,+	setx,+	sety,+	setheading, 	home,-	clear, 	circle,-	penup,-	pendown, 	undo, -	windowWidth,-	windowHeight, 	position,+	xcor,+	ycor,+	heading, 	distance,++	pendown,+	penup, 	isdown, +	bgcolor,+	pencolor,+	pensize,++	clear,++	showturtle,+	hideturtle,+	isvisible,++	shape,+	shapesize,++	degrees,+	radians,++	windowWidth,+	windowHeight,+ 	xturtleVersion ) where  import Graphics.X11.TurtleMove( 	Field, Layer, Character,-	forkIOX, openField, -- closeField,-	addCharacter, addLayer, layerSize,+	forkIOX, openField, closeField,+	addCharacter, addLayer, layerSize, clearLayer, clearCharacter,+	addThread, fieldColor, 	moveTurtle  ) import Graphics.X11.TurtleInput( 	TurtleInput(..), TurtleState,-	getTurtleStates, getPosition, getPendown, undonum+	getTurtleStates, getPosition, getPendown, undonum, visible, direction  )+import qualified Graphics.X11.TurtleInput as S(degrees) import Graphics.X11.TurtleShape(lookupShape, classic)-import Control.Concurrent(Chan, writeChan, threadDelay)+import Control.Concurrent(Chan, writeChan, threadDelay, ThreadId, killThread) import Control.Monad(replicateM_, zipWithM_) import Prelude hiding(Left) import Data.IORef(IORef, newIORef, readIORef, modifyIORef)+import Data.Bits(shift, (.|.))+import Data.Word(Word8)  xturtleVersion :: (Int, String) xturtleVersion = (16, "0.0.9")@@ -52,7 +79,8 @@ 	character :: Character, 	inputChan :: Chan TurtleInput, 	states :: [TurtleState],-	stateIndex :: IORef Int+	stateIndex :: IORef Int,+	thread :: ThreadId  }  newTurtle :: Field -> IO Turtle@@ -66,11 +94,23 @@ 			layer = l, 			character = ch, 			states = sts,-			stateIndex = si+			stateIndex = si,+			thread = undefined 		 }-	_ <- forkIOX $ zipWithM_ (moveTurtle ch l) sts $ tail sts-	return t+	tid <- forkIOX $ zipWithM_ (moveTurtle ch l) sts $ tail sts+	addThread f tid+	return t{thread = tid} +killTurtle :: Turtle -> IO ()+killTurtle t = do+	clearLayer $ layer t+	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)@@ -87,13 +127,22 @@ forward t = sendCommand t . Forward backward t = forward t . negate -left, right :: Turtle -> Double -> IO ()+left, right, setheading :: Turtle -> Double -> IO () left t = sendCommand t . Left right t = left t . negate+setheading t = sendCommand t . Rotate  goto :: Turtle -> Double -> Double -> IO () goto t x y = sendCommand t $ Goto x y +setx, sety :: Turtle -> Double -> IO ()+setx t x = do+	(_, y) <- position t+	sendCommand 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) @@ -102,16 +151,42 @@  circle :: Turtle -> Double -> IO () circle t r = do+	deg <- getDegrees t 	forward t (r * pi / 36)-	left t 10-	replicateM_ 35 $ forward t (2 * r * pi / 36) >> left t 10+	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 +getDegrees :: Turtle -> IO Double+getDegrees Turtle{stateIndex = si, states = s} =+	fmap (S.degrees . (s !!)) $ readIORef si+ penup, pendown :: Turtle -> IO () penup = flip sendCommand Penup pendown = flip sendCommand Pendown +pencolor :: Turtle -> Word8 -> Word8 -> Word8 -> IO ()+pencolor t r_ g_ b_ = sendCommand t $ Pencolor c+	where+	c = shift r 16 .|. shift g 8 .|. b+	[r, g, b] = map fromIntegral [r_, g_, b_]++bgcolor :: Field -> Word8 -> Word8 -> Word8 -> IO ()+bgcolor f r_ g_ b_ = fieldColor f c+	where+	c = shift r 16 .|. shift g 8 .|. b+	[r, g, b] = map fromIntegral [r_, g_, b_]++pensize :: Turtle -> Int -> IO ()+pensize t = sendCommand t . Pensize++degrees :: Turtle -> Double -> IO ()+degrees t = sendCommand t . Degrees++radians :: Turtle -> IO ()+radians = flip degrees $ 2 * pi+ undo :: Turtle -> IO () undo t = readIORef (stateIndex t) 	>>= flip replicateM_ (sendCommand t Undo) . undonum . (states t !!)@@ -124,6 +199,13 @@ position Turtle{stateIndex = si, states = s} = 	fmap (getPosition . (s !!)) $ readIORef si +xcor, ycor :: Turtle -> IO Double+xcor = fmap fst . position+ycor = fmap snd . position++heading :: Turtle -> IO Double+heading t = fmap (direction . (states t !!)) $ readIORef $ stateIndex t+ distance :: Turtle -> Double -> Double -> IO Double distance t x0 y0 = do 	(x, y) <- position t@@ -131,3 +213,6 @@  isdown :: Turtle -> IO Bool isdown t = fmap (getPendown . (states t !!)) $ readIORef $ stateIndex t++isvisible :: Turtle -> IO Bool+isvisible t = fmap (visible . (states t !!)) $ readIORef $ stateIndex t
src/Graphics/X11/TurtleInput.hs view
@@ -5,10 +5,13 @@ 	getTurtleStates, 	getPosition, 	getPendown,-	undonum+	undonum,+	visible,+	direction,+	degrees ) where -import Graphics.X11.TurtleState(TurtleState(..), initialTurtleState)+import Graphics.X11.TurtleState(TurtleState(..), initialTurtleState, Color) import Control.Concurrent.Chan(Chan, newChan, getChanContents) import Prelude hiding(Left) @@ -25,35 +28,41 @@ 	| Rotate Double 	| Penup 	| Pendown+	| SetVisible Bool 	| Undo 	| Clear 	| Forward Double 	| Left Double 	| Undonum Int+	| Pencolor Color+	| Pensize Int+	| Degrees Double 	deriving Show  getTurtleStates :: [(Double, Double)] -> IO (Chan TurtleInput, [TurtleState]) getTurtleStates sh = do 	let	ts0 = initialTurtleState sh-	(c, tis) <- makeInput-	return (c, ts0 : ts0 : inputToTurtle [] ts0 tis)--makeInput :: IO (Chan TurtleInput, [TurtleInput])-makeInput = do 	c <- newChan 	tis <- getChanContents c-	return (c, tis)+	return (c, ts0 : ts0 : inputToTurtle [] ts0 tis)  nextTurtle :: TurtleState -> TurtleInput -> TurtleState nextTurtle t (Shape sh) = (clearState t){shape = sh} nextTurtle t (ShapeSize ss) = (clearState t){size = ss} nextTurtle t (Goto x y) = (clearState t){position = (x, y), line = pendown t,-	drawed = if pendown t then (position t, (x, y)) : drawed t else drawed t} +	drawed = if pendown t then (pencolor 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}+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 _ _ = error "not defined"  clearState :: TurtleState -> TurtleState@@ -65,9 +74,9 @@ 	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-	x = x0 + len * cos (dir * pi / 180)-	y = y0 + len * sin (dir * pi / 180) in+	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
src/Graphics/X11/TurtleMove.hs view
@@ -9,20 +9,27 @@ 	addLayer, 	addCharacter, 	layerSize,+	clearLayer,+	clearCharacter,+	addThread,+	fieldColor,  	moveTurtle ) where -import Graphics.X11.TurtleState(TurtleState(..))+import Graphics.X11.TurtleState(TurtleState(..), Color) import Graphics.X11.WindowLayers( 	Field, Layer, Character, 	forkIOX, openField, closeField, flushLayer, 	addLayer, addCharacter, layerSize, clearLayer,-	drawLine, drawCharacter, drawCharacterAndLine, undoLayer+	drawLine, drawCharacter, drawCharacterAndLine, undoLayer,+	drawLineNotFlush,+	clearCharacter, addThread,+	fieldColor  )  import Control.Concurrent(threadDelay)-import Control.Monad(when, forM_)+import Control.Monad(when, unless, forM_) import Control.Arrow((***))  type Pos = (Double, Double)@@ -34,25 +41,34 @@ moveSpeed = 50000  stepDir :: Double-stepDir = 5+stepDir = 1 / 72  rotateSpeed :: Int rotateSpeed = 10000 +dir :: TurtleState -> Double+dir t = direction t / degrees t+ moveTurtle :: Character -> Layer -> TurtleState -> TurtleState -> IO () moveTurtle c l t0 t1 = do 	when (undo t1 && line t0) $ do 		done <- undoLayer l-		when (not done) $ clearLayer l >> drawLines l (drawed t1)-	when (undo t1 && clear t0) $ drawLines l $ drawed t1-	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+		unless done $ clearLayer l >> drawLines l (pensize t1) (drawed t1)+	when (undo t1 && clear t0) $ drawLines l (pensize t1) $ drawed t1+	when (visible t1) $ do+		forM_ (getDirections (dir t0) (dir t1)) $ \d -> do+			drawTurtle c (pencolor t1) (shape t1) (size t1) d+				(pensize t1) p0 Nothing+			threadDelay rotateSpeed+		forM_ (getPositions x0 y0 x1 y1) $ \p -> do+			drawTurtle c (pencolor t1) (shape t1) (size t1)+				(dir t1) (pensize t1) p lineOrigin+			threadDelay moveSpeed+		drawTurtle c (pencolor t1) (shape t1) (size t1) (dir t1)+			(pensize t1) p1 lineOrigin+	unless (visible t1) $ clearCharacter c+	when (not (undo t1) && line t1) $+		drawLine l (pensize t1) (pencolor t1) x0 y0 x1 y1 >> flushLayer l 	when (clear t1) $ clearLayer l >> flushLayer l 	where 	(tl, to) = if undo t1 then (t0, t1) else (t1, t0)@@ -60,12 +76,14 @@ 	p0@(x0, y0) = position t0 	p1@(x1, y1) = position t1 -drawLines :: Layer -> [((Double, Double), (Double, Double))] -> IO ()-drawLines l ls = mapM_ (\((x0, y0), (x1, y1)) -> drawLine l x0 y0 x1 y1) $ reverse ls+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  getPositions :: Double -> Double -> Double -> Double -> [Pos]-getPositions x0 y0 x1 y1 = zip [x0, x0 + dx .. x1 - dx] [y0, y0 + dy .. y1 - dy]+getPositions x0 y0 x1 y1 = take num $ zip [x0, x0 + dx .. ] [y0, y0 + dy .. ] 	where+	num = floor $ dist / step 	dist = ((x1 - x0) ** 2 + (y1 - y0) ** 2) ** (1/2) 	dx = step * (x1 - x0) / dist 	dy = step * (y1 - y0) / dist@@ -75,11 +93,12 @@ 	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+drawTurtle :: Character -> Color -> [Pos] -> Double -> Double -> Int ->+	Pos -> Maybe Pos -> IO ()+drawTurtle c clr sh s d lw (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+	maybe (drawCharacter c clr sp)+		(\(x0, y0) -> (drawCharacterAndLine c clr sp lw x0 y0 px py)) org 	where-	rotatePoint (x, y) = let rad = d * pi / 180 in+	rotatePoint (x, y) = let rad = d * 2 * pi in 		(x * cos rad - y * sin rad, x * sin rad + y * cos rad)
src/Graphics/X11/TurtleState.hs view
@@ -1,19 +1,28 @@ module Graphics.X11.TurtleState ( 	TurtleState(..), 	initialTurtleState,+	Color ) where +import Data.Word(Word32)++type Color = Word32+ data TurtleState = TurtleState { 	shape :: [(Double, Double)], 	size :: Double, 	position :: (Double, Double), 	direction :: Double, 	pendown :: Bool,-	drawed :: [((Double, Double), (Double, Double))],+	drawed :: [(Color, (Double, Double), (Double, Double))], 	line :: Bool, 	undo :: Bool, 	undonum :: Int,-	clear :: Bool+	clear :: Bool,+	visible :: Bool,+	pencolor :: Color,+	pensize :: Int,+	degrees :: Double  } deriving Show  initialTurtleState :: [(Double, Double)] -> TurtleState@@ -27,5 +36,9 @@ 	line = False, 	undo = False, 	undonum = 1,-	clear = False+	clear = False,+	visible = True,+	pencolor = 0x000000,+	pensize = 0,+	degrees = 360  }
src/Graphics/X11/WindowLayers.hs view
@@ -5,25 +5,31 @@  	openField, 	closeField,+	fieldColor, 	layerSize,  	addLayer, 	addCharacter,  	drawLine,+	drawLineNotFlush, 	drawCharacter, 	drawCharacterAndLine,+	clearCharacter,  	undoLayer, 	clearLayer, 	flushLayer, -	forkIOX+	forkIOX,+	addThread ) where  import Graphics.X11(-	Display, Window, Pixmap, Atom, GC, Point(..), Dimension, Position,+	Display, Window, Pixmap, Atom, GC, Point(..), Dimension, Position, Pixel, +	setLineAttributes, lineSolid, capRound, joinRound,+ 	openDisplay, closeDisplay, flush, defaultScreen, rootWindow, 	whitePixel, blackPixel,	defaultDepth, 	createSimpleWindow, mapWindow, createPixmap, internAtom, createGC,@@ -34,7 +40,7 @@ 	setWMProtocols, selectInput, allocaXEvent, nextEvent, 	keyPressMask, exposureMask, -	getGeometry, initThreads+	getGeometry, initThreads, connectionNumber, pending, destroyWindow  ) import qualified Graphics.X11 as X (drawLine) import Graphics.X11.Xlib.Extras(Event(..), getEvent)@@ -45,11 +51,15 @@ import Data.List.Tools(modifyAt, setAt) import Data.Bool.Tools(whether) -import Control.Monad(replicateM, forM_)+import Control.Monad(replicateM, forM_, forever, replicateM_, when) import Control.Monad.Tools(doWhile_) import Control.Arrow((***))-import Control.Concurrent(forkIO, ThreadId, Chan, newChan, writeChan, readChan)+import Control.Concurrent(+	forkIO, ThreadId, Chan, newChan, writeChan, readChan, threadWaitRead,+	killThread, threadDelay) +import System.Posix.Types+ data Field = Field{ 	fDisplay :: Display, 	fWindow :: Window,@@ -64,7 +74,11 @@ 	fBuffed :: IORef [IO ()], 	fLayers :: IORef [[Bool -> IO ()]], 	fCharacters :: IORef [IO ()],-	fWait :: Chan ()+	fWait :: Chan (),+	fEvent :: Chan (Maybe Event),+	fClose :: Chan (),+	fClosed :: IORef Bool,+	fRunning :: IORef [ThreadId]  }  data Layer = Layer{@@ -101,6 +115,10 @@ 	layerActions <- newIORef [] 	characterActions <- newIORef [] 	wait <- newChan+	event <- newChan+	close <- newChan+	closed <- newIORef False+	running <- newIORef [] 	writeChan wait () 	let f = Field{ 		fDisplay = dpy,@@ -116,32 +134,77 @@ 		fBuffed = buffActions, 		fLayers = layerActions, 		fCharacters = characterActions,-		fWait = wait+		fWait = wait,+		fEvent = event,+		fClose = close,+		fClosed = closed,+		fRunning = running 	 } 	_ <- forkIOX $ runLoop f 	flushWindow f 	return f  runLoop :: Field -> IO ()-runLoop f = (>> closeField f) $	doWhile_ $ allocaXEvent $ \e -> do-	nextEvent (fDisplay f) e-	ev <- getEvent e-	case ev of-		ExposeEvent{} -> do-			(_, _, _, width, height, _, _) <--				getGeometry (fDisplay f) (fWindow f)-			writeIORef (fWidth f) width-			writeIORef (fHeight f) height-			redrawAll f-			return True-		KeyEvent{} -> return True-		ClientMessageEvent{} ->-			return $ convert (head $ ev_data ev) /= fDel f-		_ -> return True+runLoop f = allocaXEvent $ \e -> do+	endc <- waitInput f+	th1 <- forkIOX $ forever $ do+		evN <- pending $ fDisplay f+		replicateM_ (fromIntegral evN) $ do+			nextEvent (fDisplay f) e+			ev <- getEvent e+			writeChan (fEvent f) $ Just ev+		end <- readChan endc+		when end $ writeChan (fEvent f) Nothing+	(>> closeDisplay (fDisplay f)) $+		(>> destroyWindow (fDisplay f) (fWindow f)) $ doWhile_ $ do+		mev <- readChan $ fEvent f+		case mev of+			Just (ExposeEvent{}) -> do+				(_, _, _, width, height, _, _) <-+					getGeometry (fDisplay f) (fWindow f)+				writeIORef (fWidth f) width+				writeIORef (fHeight f) height+				redrawAll f+				return True+			Just (KeyEvent{}) -> return True+			Just ev@(ClientMessageEvent{}) ->+				return $ convert (head $ ev_data ev) /= fDel f+			Nothing -> killThread th1 >> return False+			_ -> return True +fieldColor :: Field -> Pixel -> IO ()+fieldColor f clr = do+	setForeground (fDisplay f) (fGCBG f) clr+	let bufs = [fUndoBuf f, fBG f, fBuf f]+	width <- readIORef $ fWidth f+	height <- readIORef $ fHeight f+	forM_ bufs $ \bf -> fillRectangle (fDisplay f) bf (fGCBG f) 0 0 width height+	redrawAll f++getConnection :: Field -> Fd+getConnection = Fd . connectionNumber . fDisplay++waitInput :: Field -> IO (Chan Bool)+waitInput f = do+	c <- newChan+	_ <- forkIOX $ forever $ do+		threadWaitRead $ getConnection f+		writeChan c False+	_ <- forkIO $ do+		readChan $ fClose f+		writeChan c True+	return c+ closeField :: Field -> IO ()-closeField = closeDisplay . fDisplay+closeField f = do+	readIORef (fRunning f) >>= mapM_ killThread+	threadDelay 100000+	writeChan (fClose f) ()+	writeIORef (fClosed f) True +addThread :: Field -> ThreadId -> IO ()+addThread f tid = modifyIORef (fRunning f) (tid :)+ layerSize :: Layer -> IO (Double, Double) layerSize = fieldSize . layerField @@ -161,20 +224,41 @@ 	writeIORef (fCharacters f) (cs ++ [return ()]) 	return Character{characterField = f, characterId = length cs} -drawLine :: Layer -> Double -> Double -> Double -> Double -> IO ()-drawLine l@Layer{layerField = f} x1 y1 x2 y2 = do-	drawLineBuf f fBG x1 y1 x2 y2 >> redrawCharacters f+runIfOpened :: Field -> IO a -> IO ()+runIfOpened f act = do+	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+	drawLineBuf f lw clr fBG x1 y1 x2 y2 	addLayerAction l $ whether-		(drawLineBuf f fUndoBuf x1 y1 x2 y2)-		(drawLineBuf f fBG x1 y1 x2 y2)+		(drawLineBuf f lw clr fUndoBuf x1 y1 x2 y2)+		(drawLineBuf f lw clr fBG x1 y1 x2 y2) -drawCharacter :: Character -> [(Double, Double)] -> IO ()-drawCharacter c = setCharacter c . fillPolygonBuf (characterField c)+drawLine :: Layer -> Int -> 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) -drawCharacterAndLine ::	Character -> [(Double, Double)] ->+clearCharacter :: Character -> IO ()+clearCharacter c = runIfOpened (characterField c) $+	setCharacter c $ return ()++drawCharacter :: Character -> Pixel -> [(Double, Double)] -> IO ()+drawCharacter c@Character{characterField = f} clr sh = do+	runIfOpened (characterField c) $ setCharacter c $ do+		setForeground (fDisplay f) (fGC f) clr+		fillPolygonBuf (characterField c) sh++drawCharacterAndLine ::	Character -> Pixel -> [(Double, Double)] -> Int -> 	Double -> Double -> Double -> Double -> IO ()-drawCharacterAndLine c@Character{characterField = f} ps x1 y1 x2 y2 =-	setCharacter c $ fillPolygonBuf f ps >> drawLineBuf f fBuf x1 y1 x2 y2+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  undoLayer :: Layer -> IO Bool undoLayer Layer{layerField = f, layerId = lid} = do@@ -226,9 +310,11 @@ 	fillPolygon (fDisplay f) (fBuf f) (fGC f) (map (uncurry Point) ps) 		nonconvex coordModeOrigin -drawLineBuf :: Field -> (Field -> Pixmap) ->+drawLineBuf :: Field -> Int -> Pixel -> (Field -> Pixmap) -> 	Double -> Double -> Double -> Double -> IO ()-drawLineBuf f@Field{fDisplay = dpy, fGC = gc} bf x1_ y1_ x2_ y2_ = do+drawLineBuf f@Field{fDisplay = dpy, fGC = gc} lw clr bf x1_ y1_ x2_ y2_ = do+	setForeground (fDisplay f) (fGC f) clr+	setLineAttributes (fDisplay f) (fGC f) (fromIntegral lw) lineSolid capRound joinRound 	[(x1, y1), (x2, y2)] <- convertPos f [(x1_, y1_), (x2_, y2_)] 	X.drawLine dpy (bf f) gc x1 y1 x2 y2 
xturtle.cabal view
@@ -2,7 +2,7 @@ cabal-version:	>= 1.6  name:		xturtle-version:	0.0.9+version:	0.0.10 stability:	experimental author:		Yoshikuni Jujo <PAF01143@nifty.ne.jp> maintainer:	Yoshikuni Jujo <PAF01143@nifty.ne.jp>