xturtle 0.1.0 → 0.1.2

raw patch · 6 files changed

+52/−21 lines, 6 files

Files

• src/Graphics/X11/Turtle.hs +16/−2
• src/Graphics/X11/Turtle/Field.hs +9/−8
• src/Graphics/X11/Turtle/Input.hs +9/−2
• src/Graphics/X11/Turtle/Move.hs +9/−6
• src/Graphics/X11/Turtle/State.hs +8/−2
• xturtle.cabal +1/−1

@@ -32,6 +32,10 @@ 	home, 	clear, 	undo,+	sleep,+	flushoff,+	flushon,+	flush,  	-- * change turtle state 	shape,@@ -93,7 +97,7 @@ --------------------------------------------------------------------------------  xturtleVersion :: (Int, String)-xturtleVersion = (46, "0.1.0")+xturtleVersion = (48, "0.1.2")  -------------------------------------------------------------------------------- @@ -138,7 +142,7 @@ 	return t  killTurtle :: Turtle -> IO ()-killTurtle t = flushField (field t) $ do+killTurtle t = flushField (field t) True $ do 	clearLayer $ layer t 	clearCharacter $ character t 	killThread $ thread t@@ -193,6 +197,16 @@ undo :: Turtle -> IO () undo t = readIORef (stateIndex t) 	>>= flip replicateM_ (input t Undo) . undonum . (states t !!)++sleep :: Turtle -> Int -> IO ()+sleep t = input t . Sleep++flushoff, flushon :: Turtle -> IO ()+flushoff = (`input` SetFlush False)+flushon = (`input` SetFlush True)++flush :: Turtle -> IO ()+flush = (`input` Flush)  -------------------------------------------------------------------------------- 

@@ -52,7 +52,7 @@ 	makeCharacter, setCharacter) import Text.XML.YJSVG(Color(..)) -import Control.Monad(forever, replicateM)+import Control.Monad(forever, replicateM, when) import Control.Monad.Tools(doWhile_, doWhile, whenM) import Control.Arrow((***)) import Control.Concurrent(@@ -154,7 +154,7 @@  processEvent :: Field -> XEventPtr -> Event -> IO Bool processEvent f e ev = case ev of-	ExposeEvent{} -> flushField f $ do+	ExposeEvent{} -> flushField f True $ do 		windowSize (fDisplay f) (fWindow f) >>= writeIORef (fSize f) 		redrawLayers $ fLayers f 		return True@@ -205,14 +205,15 @@ 	modifyIORef (fRunning f) (tid :) 	return tid -flushField :: Field -> IO a -> IO a-flushField f act = do+flushField :: Field -> Bool -> IO a -> IO a+flushField f real act = do 	readChan $ fLock f 	ret <- act-	(w, h) <- readIORef $ fSize f-	copyArea (fDisplay f) (topBuf $ fBufs f) (fWindow f)-		(gcForeground $ fGCs f) 0 0 w h 0 0-	flush $ fDisplay f+	when real $ do+		(w, h) <- readIORef $ fSize f+		copyArea (fDisplay f) (topBuf $ fBufs f) (fWindow f)+			(gcForeground $ fGCs f) 0 0 w h 0 0+		flush $ fDisplay f 	writeChan (fLock f) () 	return ret 

@@ -43,6 +43,9 @@ 	| Clear 	| Forward Double 	| TurnLeft Double+	| Sleep Int+	| SetFlush Bool+	| Flush 	deriving (Show, Read)  turtleSeries :: IO (Chan TurtleInput, [TurtleInput], [TurtleState])@@ -101,8 +104,12 @@ 	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 = [last $ drawed t]}+nextTurtle t Clear = (clearState t){clear = True, drawed = [last $ drawed t]}+nextTurtle t (Sleep time) = (clearState t){sleep = Just time}+nextTurtle t (SetFlush ss) = (clearState t){stepbystep = ss}+nextTurtle t Flush = (clearState t){flush = True} nextTurtle _ _ = error "not defined"  clearState :: TurtleState -> TurtleState-clearState t = t{undonum = 1, undo = False, clear = False, draw = Nothing}+clearState t = t{undonum = 1, undo = False, clear = False, draw = Nothing,+	sleep = Nothing, flush = False}

@@ -45,25 +45,28 @@ --------------------------------------------------------------------------------  moveTurtle :: Field -> Character -> Layer -> TurtleState -> TurtleState -> IO ()+moveTurtle _ _ _ _ TurtleState{sleep = Just t} = threadDelay $ 1000 * t+moveTurtle f _ _ _ TurtleState{flush = True} = flushField f True $ return () moveTurtle f c l t0 t1 = do-	when (undo t1) $ flushField f $ do+	when (undo t1) $ flushField f fl $ do 		when (clear t0) redraw 		when (isJust $ draw t0) $ do 			unlessM (undoLayer l) $ clearLayer l >> redraw 			when (visible t1) $ drawT (direction t1) $ position t0 	when (visible t1) $ do-		forM_ (directions t0 t1) $ \dir -> flushField f $+		forM_ (directions t0 t1) $ \dir -> flushField f fl $ 			drawT dir (position t0) >> threadDelay (interval t0)-		forM_ (positions t0 t1) $ \p -> flushField f $+		forM_ (positions t0 t1) $ \p -> flushField f fl $ 			drawT (direction t1) p >> threadDelay (interval t0)-		flushField f $ drawT (direction t1) $ position t1+		flushField f fl $ drawT (direction t1) $ position t1 	when (bgcolor t0 /= bgcolor t1) $-		flushField f $ fieldColor f l $ bgcolor t1-	unless (undo t1) $ flushField f $ do+		flushField f fl $ fieldColor f l $ bgcolor t1+	unless (undo t1) $ flushField f fl $ do 		when (visible t0 && not (visible t1)) $ clearCharacter c 		when (clear t1) $ clearLayer l 		maybe (return ()) (drawSVG f l) (draw t1) 	where+	fl = stepbystep t0 	redraw = mapM_ (drawSVG f l) $ reverse $ drawed t1 	drawT d p = drawTurtle f c t1 d p lineOrigin 	lineOrigin	| undo t1 && pendown t0 = Just $ position t1

@@ -25,7 +25,10 @@ 	undonum :: Int, 	draw :: Maybe SVG, 	drawed :: [SVG],-	fillPoints :: [(Double, Double)]}+	fillPoints :: [(Double, Double)],+	sleep :: Maybe Int,+	stepbystep :: Bool,+	flush :: Bool} 	deriving Show  initialTurtleState :: TurtleState@@ -49,4 +52,7 @@ 	undonum = 0, 	draw = Nothing, 	drawed = [Fill $ RGB 255 255 255],-	fillPoints = []}+	fillPoints = [],+	sleep = Nothing,+	stepbystep = True,+	flush = False}

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