xturtle 0.1.4 → 0.1.5

raw patch · 7 files changed

+54/−13 lines, 7 files

Files

• src/Graphics/X11/Turtle.hs +30/−7
• src/Graphics/X11/Turtle/Field.hs +7/−2
• src/Graphics/X11/Turtle/Input.hs +7/−1
• src/Graphics/X11/Turtle/Move.hs +2/−1
• src/Graphics/X11/Turtle/State.hs +4/−0
• src/Graphics/X11/Turtle/XTools.hs +3/−1
• xturtle.cabal +1/−1

@@ -39,6 +39,8 @@ 	flush,  	-- * change turtle state+	addshape,+	getshapes, 	shape, 	shapesize, 	speed,@@ -48,6 +50,8 @@ 	pendown, 	beginfill, 	endfill,+	beginpoly,+	endpoly, 	pencolor, 	pensize, 	degrees,@@ -69,6 +73,7 @@ 	onclick, 	onrelease, 	ondrag,+	onmotion, 	onkeypress,  	-- * save and load@@ -80,25 +85,26 @@ import Graphics.X11.Turtle.Data(nameToShape, nameToSpeed) import Graphics.X11.Turtle.Input( 	TurtleState, TurtleInput(..),-	turtleSeries, direction, visible, undonum, drawed)+	turtleSeries, direction, visible, undonum, drawed, polyPoints) import qualified Graphics.X11.Turtle.Input as S(position, degrees, pendown) import Graphics.X11.Turtle.Move( 	Field, Layer, Character, 	openField, closeField, forkField, waitField, fieldSize, flushField, 	moveTurtle, addLayer, clearLayer, addCharacter, clearCharacter,-	onclick, onrelease, ondrag, onkeypress)+	onclick, onrelease, ondrag, onmotion, 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)+import Data.IORef(IORef, newIORef, readIORef, modifyIORef) import Data.IORef.Tools(atomicModifyIORef_) import Data.Fixed(mod')+import Data.Maybe(fromJust)  --------------------------------------------------------------------------------  xturtleVersion :: (Int, String)-xturtleVersion = (50, "0.1.4")+xturtleVersion = (53, "0.1.5")  -------------------------------------------------------------------------------- @@ -110,7 +116,8 @@ 	states :: [TurtleState], 	inputs :: [TurtleInput], 	stateIndex :: IORef Int,-	thread :: ThreadId+	thread :: ThreadId,+	shapes :: IORef [(String, [(Double, Double)])]  }  class ColorClass a where getColor :: a -> Color@@ -130,6 +137,7 @@ 	(ic, tis, sts) <- turtleSeries 	si <- newIORef 1 	tid <- forkField f $ zipWithM_ (moveTurtle f ch l) sts $ tail sts+	shps <- newIORef $ map (\n -> (n, nameToShape n)) ["classic", "turtle"] 	let	t = Turtle { 			field = f, 			layer = l,@@ -138,7 +146,8 @@ 			states = sts, 			inputs = tis, 			stateIndex = si,-			thread = tid}+			thread = tid,+			shapes = shps} 	shape t "classic" >> input t (Undonum 0) 	return t @@ -214,8 +223,14 @@  -------------------------------------------------------------------------------- +addshape :: Turtle -> String -> [(Double, Double)] -> IO ()+addshape t n s = modifyIORef (shapes t) ((n, s) :)++getshapes :: Turtle -> IO [String]+getshapes t = fmap (map fst) $ readIORef (shapes t)+ shape :: Turtle -> String -> IO ()-shape t = input t . Shape . nameToShape+shape t n = readIORef (shapes t) >>= input t . Shape . fromJust . lookup n  shapesize :: Turtle -> Double -> Double -> IO () shapesize t sx sy = input t $ Shapesize sx sy@@ -236,6 +251,14 @@ beginfill, endfill :: Turtle -> IO () beginfill = (`input` SetFill True) endfill = (`input` SetFill False)++beginpoly :: Turtle -> IO ()+beginpoly = (`input` SetPoly True)++endpoly :: Turtle -> IO [(Double, Double)]+endpoly t@Turtle{stateIndex = si, states = s} = do+	input t $ SetPoly False+	fmap (polyPoints . (s !!)) $ readIORef si  pencolor :: ColorClass c => Turtle -> c -> IO () pencolor t = input t . Pencolor . getColor

@@ -34,6 +34,7 @@ 	onclick, 	onrelease, 	ondrag,+	onmotion, 	onkeypress ) where @@ -71,6 +72,7 @@  	fClick, fRelease :: IORef (Int -> Double -> Double -> IO Bool), 	fDrag :: IORef (Double -> Double -> IO ()),+	fMotion :: IORef (Double -> Double -> IO ()), 	fKeypress :: IORef (Char -> IO Bool), fPressed :: IORef Bool,  	fLayers :: IORef Layers, fRunning :: IORef [ThreadId],@@ -82,6 +84,7 @@ makeField dpy win bufs gcs ic del sizeRef ls = do 	[click, release] <- replicateM 2 $ newIORef $ \_ _ _ -> return True 	drag <- newIORef $ \_ _ -> return ()+	motion <- newIORef $ \_ _ -> return () 	keypress <- newIORef $ \_ -> return True 	pressed <- newIORef False 	running <- newIORef []@@ -91,7 +94,7 @@ 		fDisplay = dpy, fWindow = win, fBufs = bufs, fGCs = gcs, 		fIC = ic, fDel = del, fSize = sizeRef, -		fClick = click, fRelease = release, fDrag = drag,+		fClick = click, fRelease = release, fDrag = drag, fMotion = motion, 		fKeypress = keypress, fPressed = pressed,  		fLayers = ls,@@ -181,6 +184,7 @@ 		pos <- center (ev_x ev) (ev_y ev) 		whenM (readIORef $ fPressed f) $ 			readIORef (fDrag f) >>= ($ pos) . uncurry+		readIORef (fMotion f) >>= ($ pos) . uncurry 		return True 	ClientMessageEvent{} -> return $ convert (head $ ev_data ev) /= fDel f 	_ -> return True@@ -300,8 +304,9 @@ onclick, onrelease :: Field -> (Int -> Double -> Double -> IO Bool) -> IO () (onclick, onrelease) = (writeIORef .) *** (writeIORef .) $ (fClick, fRelease) -ondrag :: Field -> (Double -> Double -> IO ()) -> IO ()+ondrag, onmotion :: Field -> (Double -> Double -> IO ()) -> IO () ondrag = writeIORef . fDrag+onmotion = writeIORef . fMotion  onkeypress :: Field -> (Char -> IO Bool) -> IO () onkeypress = writeIORef . fKeypress

@@ -14,6 +14,7 @@ 	visible, 	undonum, 	drawed,+	polyPoints ) where  import Graphics.X11.Turtle.State(TurtleState(..), initialTurtleState)@@ -30,6 +31,7 @@ 	| Pensize Double 	| SetPendown Bool 	| SetFill Bool+	| SetPoly Bool 	| SetVisible Bool 	| Degrees Double 	| PositionStep (Maybe Double)@@ -86,6 +88,9 @@ 	(x0, y0) = position t 	fl = Polyline (uncurry Center `map` fillPoints t) 		(pencolor t) (pencolor t) 0+nextTurtle t (SetPoly p) = (clearState t){+	poly = p,+	polyPoints = if p then [position t] else polyPoints t} nextTurtle t (SetVisible v) = (clearState t){visible = v} nextTurtle t (Degrees ds) = (clearState t){degrees = ds} nextTurtle t (PositionStep ps) = (clearState t){positionStep = ps}@@ -95,7 +100,8 @@ 	position = (x, y), 	draw = if pendown t then Just ln else Nothing, 	drawed = if pendown t then ln : drawed t else drawed t,-	fillPoints = if fill t then (x, y) : fillPoints t else fillPoints t}+	fillPoints = if fill t then (x, y) : fillPoints t else fillPoints t,+	polyPoints = if poly t then (x, y) : polyPoints t else polyPoints t} 	where 	(x0, y0) = position t 	ln = Line (Center x0 y0) (Center x y) (pencolor t) (pensize t)

@@ -23,6 +23,7 @@ 	onclick, 	onrelease, 	ondrag,+	onmotion, 	onkeypress ) where @@ -33,7 +34,7 @@ 	forkField, flushField, fieldColor, 	addLayer, drawLine, writeString, undoLayer, clearLayer, fillPolygon, 	addCharacter, drawCharacter, drawCharacterAndLine, clearCharacter,-	onclick, onrelease, ondrag, onkeypress, drawImage)+	onclick, onrelease, ondrag, onmotion, onkeypress, drawImage) import Text.XML.YJSVG(SVG(..), Position(..))  import Control.Concurrent(threadDelay)

@@ -14,6 +14,7 @@ 	interval :: Int, 	pendown :: Bool, 	fill :: Bool,+	poly :: Bool, 	pensize :: Double, 	pencolor :: Color, 	bgcolor :: Color,@@ -26,6 +27,7 @@ 	draw :: Maybe SVG, 	drawed :: [SVG], 	fillPoints :: [(Double, Double)],+	polyPoints :: [(Double, Double)], 	sleep :: Maybe Int, 	stepbystep :: Bool, 	flush :: Bool}@@ -41,6 +43,7 @@ 	interval = 10000, 	pendown = True, 	fill = False,+	poly = False, 	pensize = 1, 	pencolor = RGB 0 0 0, 	bgcolor = RGB 255 255 255,@@ -53,6 +56,7 @@ 	draw = Nothing, 	drawed = [Fill $ RGB 255 255 255], 	fillPoints = [],+	polyPoints = [], 	sleep = Nothing, 	stepbystep = True, 	flush = False}

@@ -65,6 +65,7 @@ 	allocaXEvent, pending, nextEvent, 	setWMProtocols, selectInput, button1MotionMask, buttonReleaseMask, 	buttonPressMask, keyPressMask, exposureMask,+	pointerMotionMask, 	buttonPress, buttonRelease, xK_VoidSymbol, getGeometry, drawPoint) import qualified Graphics.X11 as X(fillPolygon) import Graphics.X11.Xlib.Extras(Event(..), getEvent)@@ -131,7 +132,8 @@ 	forM_ bufs $ \bf -> fillRectangle dpy bf gcBG 0 0 rWidth rHeight 	setWMProtocols dpy win [del] 	selectInput dpy win $ fevent .|. exposureMask .|. keyPressMask .|.-		buttonPressMask .|. buttonReleaseMask .|. button1MotionMask+		buttonPressMask .|. buttonReleaseMask .|. button1MotionMask .|.+		pointerMotionMask 	size <- mapWindow dpy win >> windowSize dpy win 	return (dpy, win, Bufs ub bb tb, GCs gc gcBG, ic, del, size) 

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