xturtle 0.0.8 → 0.0.9

raw patch · 6 files changed

+37/−19 lines, 6 files

Files

• src/Graphics/X11/Turtle.hs +1/−1
• src/Graphics/X11/TurtleInput.hs +3/−2
• src/Graphics/X11/TurtleMove.hs +9/−3
• src/Graphics/X11/TurtleState.hs +2/−0
• src/Graphics/X11/WindowLayers.hs +21/−12
• xturtle.cabal +1/−1

@@ -45,7 +45,7 @@ import Data.IORef(IORef, newIORef, readIORef, modifyIORef)  xturtleVersion :: (Int, String)-xturtleVersion = (14, "0.0.8")+xturtleVersion = (16, "0.0.9")  data Turtle = Turtle { 	layer :: Layer,

@@ -47,12 +47,13 @@ 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}+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}  nextTurtle t (Rotate d) = (clearState t){direction = d} 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 t (Clear) = (clearState t){clear = True, drawed = []} nextTurtle _ _ = error "not defined"  clearState :: TurtleState -> TurtleState

@@ -16,7 +16,7 @@ import Graphics.X11.TurtleState(TurtleState(..)) import Graphics.X11.WindowLayers( 	Field, Layer, Character,-	forkIOX, openField, closeField,+	forkIOX, openField, closeField, flushLayer, 	addLayer, addCharacter, layerSize, clearLayer, 	drawLine, drawCharacter, drawCharacterAndLine, undoLayer  )@@ -41,7 +41,10 @@  moveTurtle :: Character -> Layer -> TurtleState -> TurtleState -> IO () moveTurtle c l t0 t1 = do-	when (undo t1 && line t0) $ undoLayer l+	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@@ -50,12 +53,15 @@ 		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+	when (clear t1) $ clearLayer l >> flushLayer 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++drawLines :: Layer -> [((Double, Double), (Double, Double))] -> IO ()+drawLines l ls = mapM_ (\((x0, y0), (x1, y1)) -> drawLine l 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]

@@ -9,6 +9,7 @@ 	position :: (Double, Double), 	direction :: Double, 	pendown :: Bool,+	drawed :: [((Double, Double), (Double, Double))], 	line :: Bool, 	undo :: Bool, 	undonum :: Int,@@ -22,6 +23,7 @@ 	position = (0, 0), 	direction = 0, 	pendown = True,+	drawed = [], 	line = False, 	undo = False, 	undonum = 1,

@@ -16,6 +16,7 @@  	undoLayer, 	clearLayer,+	flushLayer,  	forkIOX ) where@@ -144,6 +145,9 @@ layerSize :: Layer -> IO (Double, Double) layerSize = fieldSize . layerField +flushLayer :: Layer -> IO ()+flushLayer = flushWindow . layerField+ addLayer :: Field -> IO Layer addLayer f = do 	ls <- readIORef $ fLayers f@@ -172,11 +176,13 @@ drawCharacterAndLine c@Character{characterField = f} ps x1 y1 x2 y2 = 	setCharacter c $ fillPolygonBuf f ps >> drawLineBuf f fBuf x1 y1 x2 y2 -undoLayer :: Layer -> IO ()+undoLayer :: Layer -> IO Bool undoLayer Layer{layerField = f, layerId = lid} = do 	ls <- readIORef $ fLayers f-	writeIORef (fLayers f) $ modifyAt ls lid init-	redraw f+	if null $ ls !! lid then return False else do+		writeIORef (fLayers f) $ modifyAt ls lid init+		redraw f+		return True  clearLayer :: Layer -> IO () clearLayer Layer{layerField = f, layerId = lid} = do@@ -184,7 +190,8 @@ 	writeIORef (fLayers f) $ setAt ls lid [] 	buffed <- readIORef $ fBuffed f 	writeIORef (fBuffed f) $ setAt buffed lid $ return ()-	redrawAll f+	redrawBuf f+	redraw f  forkIOX :: IO () -> IO ThreadId forkIOX = (initThreads >>) . forkIO@@ -253,26 +260,28 @@ 	readIORef (fBuffed f) >>= sequence_  redraw :: Field -> IO ()-redraw f = do+redraw = withLock $ \f -> do 	(width, height) <- winSize f 	copyArea (fDisplay f) (fUndoBuf f) (fBG f) (fGC f) 0 0 width height 0 0-	readChan $ fWait f 	readIORef (fLayers f) >>= mapM_ ($ False) . concat+	copyArea (fDisplay f) (fBG f) (fBuf f) (fGC f) 0 0 width height 0 0 	readIORef (fCharacters f) >>= sequence_-	writeChan (fWait f) ()  redrawCharacters :: Field -> IO ()-redrawCharacters f = do+redrawCharacters = withLock $ \f -> do 	(width, height) <- winSize f-	readChan $ fWait f 	copyArea (fDisplay f) (fBG f) (fBuf f) (fGC f) 0 0 width height 0 0 	readIORef (fCharacters f) >>= sequence_-	writeChan (fWait f) ()  flushWindow :: Field -> IO ()-flushWindow f = do+flushWindow = withLock $ \f -> do 	(width, height) <- winSize f-	readChan $ fWait f 	copyArea (fDisplay f) (fBuf f) (fWindow f) (fGC f) 0 0 width height 0 0 	flush $ fDisplay f++withLock :: (Field -> IO a) -> Field -> IO a+withLock act f = do+	readChan $ fWait f+	ret <- act f 	writeChan (fWait f) ()+	return ret

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