packages feed

gluturtle 0.0.23 → 0.0.26

raw patch · 3 files changed

+43/−12 lines, 3 files

Files

gluturtle.cabal view
@@ -2,7 +2,7 @@ cabal-version:	>= 1.6  name:		gluturtle-version:	0.0.23+version:	0.0.26 stability:	alpha author:		Yoshikuni Jujo <PAF01143@nifty.ne.jp> maintainer:	Yoshikuni Jujo <PAF01143@nifty.ne.jp>
src/Graphics/UI/GLUT/Turtle/Field.hs view
@@ -4,7 +4,7 @@ 	initialize,  	-- * types and classes-	Field,+	Field(fRunning), 	Layer, 	Character, 	Coordinates(..),@@ -115,7 +115,10 @@  	fPrompt :: IORef String, -	fLayers :: IORef Layers+	fLayers :: IORef Layers,++	fRunning :: IORef Bool,+	fBusy :: IORef Bool  }  addLayer :: Field -> IO Layer@@ -136,6 +139,8 @@  openField :: String -> Int -> Int -> IO Field openField name w h = do+	fb <- newIORef False+	fr <- newIORef False 	fw <- newIORef w 	fh <- newIORef h 	layers <- newLayers 0 (return ()) (return ()) (return ())@@ -152,11 +157,7 @@ 	initialWindowSize $= Size (fromIntegral w) (fromIntegral h) 	wt <- createWindow name 	wc <- createWindow "console"-	currentWindow $= Just wt-	displayCallback $= (sequence_ . catMaybes =<< readIORef actions)-	currentWindow $= Just wc-	displayCallback $= (sequence_ . catMaybes =<< readIORef actions)-	G.addTimerCallback 10 (timerAction $ do+	let act = do 		currentWindow $= Just wt 		G.clearColor $= G.Color4 0 0 0 0 		G.clear [G.ColorBuffer]@@ -171,7 +172,13 @@ 		ss1 <- readIORef str 		ss2 <- readIORef str2 		zipWithM_ (printString (-2.8)) [-1800, -1600 .. 1800] (reverse ss1 ++ ss2)-		swapBuffers)+		swapBuffers+	currentWindow $= Just wt+	displayCallback $= act+	currentWindow $= Just wc+	displayCallback $= act+--	G.keyboardMouseCallback $= Just (\_ _ _ _ -> act)+--	G.addTimerCallback 10 $ timerAction act 	G.reshapeCallback $= Just (\size -> G.viewport $= (G.Position 0 0, size)) 	let f = Field{ 		fCoordinates = CoordCenter,@@ -187,9 +194,20 @@ 		fConsoleWindow = wc, 		fPrompt = prmpt, -		fBgcolor = bgc+		fBgcolor = bgc,++		fBusy = fb,+		fRunning = fr 	 }-	G.keyboardMouseCallback $= Just (keyboardProc f)+	G.keyboardMouseCallback $= Just (\k ks m p -> do+		keyboardProc f k ks m p+		act+		busy <- readIORef $ fBusy f+		when (k == G.Char '\r' && not busy) $ do+			writeIORef (fBusy f) True+			G.addTimerCallback 10 $ timerActionN f 10 act)+--	G.keyboardMouseCallback $= Just (\_ _ _ _ -> act)+--	G.addTimerCallback 10 $ timerAction act 	return f  printString :: GLfloat -> GLfloat -> String -> IO ()@@ -207,6 +225,15 @@ timerAction act = do 	_ <- act 	G.addTimerCallback 10 $ timerAction act++timerActionN :: Field -> Int -> IO a -> IO ()+-- timerActionN f 0 _ = writeIORef (fBusy f) False+timerActionN f n act = do+	b <- readIORef $ fRunning f+	if b then act >> G.addTimerCallback 10 (timerActionN f undefined act)+		else act >> writeIORef (fBusy f) False+--	_ <- act+--	G.addTimerCallback 10 $ timerActionN f (n - 1) act  -- data InputType = XInput | End | Timer
src/Graphics/UI/GLUT/Turtle/Move.hs view
@@ -40,7 +40,7 @@  import Graphics.UI.GLUT.Turtle.State(TurtleState(..), makeShape) import Graphics.UI.GLUT.Turtle.Field(prompt, initialize, setFieldSize,-	Field, Layer, Character, Coordinates(..),+	Field(fRunning), Layer, Character, Coordinates(..), 	openField, closeField, waitField, coordinates, topleft, center, 	fieldSize, forkField, flushField, clearLayer, 	clearCharacter, addLayer, addCharacter,@@ -55,6 +55,8 @@ import Control.Monad(when, unless, forM_) import Data.Maybe(isJust) +import Data.IORef+ --------------------------------------------------------------------------------  moveTurtle :: Field -> Character -> Layer -> TurtleState -> TurtleState -> IO ()@@ -68,11 +70,13 @@ 			undoField f 			when (visible t1) $ drawTtl (direction t0) $ position t0 	when (visible t1) $ do+		writeIORef (fRunning f) True 		forM_ (directions t0 t1) $ \dir -> fl $ 			drawTtl dir (position t0) >> threadDelay (interval t0) 		forM_ (positions w h t0 t1) $ \p -> fl $ 			drawTtl (direction t1) p >> threadDelay (interval t0) 		fl $ drawTtl (direction t1) $ position t1+		writeIORef (fRunning f) False 	when (visible t0 && not (visible t1)) $ fl $ clearCharacter f 	when (clear t1) $ fl $ clearLayer l 	unless (undo t1) $ fl $ maybe (return ()) (drawSVG f l) (draw t1)