xturtle 0.0.10 → 0.0.11

raw patch · 4 files changed

+51/−11 lines, 4 files

Files

• src/Graphics/X11/Turtle.hs +17/−3
• src/Graphics/X11/TurtleMove.hs +3/−1
• src/Graphics/X11/WindowLayers.hs +30/−6
• xturtle.cabal +1/−1

@@ -23,6 +23,7 @@ 	xcor, 	ycor, 	heading,+	towards, 	distance,  	pendown,@@ -47,6 +48,8 @@  	windowWidth, 	windowHeight,+	onclick,+	waitField,  	xturtleVersion ) where@@ -55,7 +58,7 @@ 	Field, Layer, Character, 	forkIOX, openField, closeField, 	addCharacter, addLayer, layerSize, clearLayer, clearCharacter,-	addThread, fieldColor,+	addThread, fieldColor, onclick, waitField, 	moveTurtle  ) import Graphics.X11.TurtleInput(@@ -70,9 +73,10 @@ import Data.IORef(IORef, newIORef, readIORef, modifyIORef) import Data.Bits(shift, (.|.)) import Data.Word(Word8)+import Data.Fixed(mod')  xturtleVersion :: (Int, String)-xturtleVersion = (16, "0.0.9")+xturtleVersion = (18, "0.0.11")  data Turtle = Turtle { 	layer :: Layer,@@ -204,7 +208,17 @@ ycor = fmap snd . position  heading :: Turtle -> IO Double-heading t = fmap (direction . (states t !!)) $ readIORef $ stateIndex t+heading t = do+	deg <- getDegrees t+	dir <- fmap (direction . (states t !!)) $ readIORef $ stateIndex t+	return $ dir `mod'` deg++towards :: Turtle -> Double -> Double -> IO Double+towards t x0 y0 = do+	(x, y) <- position t+	deg <- getDegrees t+	let	dir = atan2 (y0 - y) (x0 - x) * deg / (2 * pi)+	return $ if dir < 0 then dir + deg else dir  distance :: Turtle -> Double -> Double -> IO Double distance t x0 y0 = do

@@ -13,6 +13,8 @@ 	clearCharacter, 	addThread, 	fieldColor,+	onclick,+	waitField,  	moveTurtle ) where@@ -25,7 +27,7 @@ 	drawLine, drawCharacter, drawCharacterAndLine, undoLayer, 	drawLineNotFlush, 	clearCharacter, addThread,-	fieldColor+	fieldColor, onclick, waitField  )  import Control.Concurrent(threadDelay)

@@ -5,6 +5,7 @@  	openField, 	closeField,+	waitField, 	fieldColor, 	layerSize, @@ -21,6 +22,8 @@ 	clearLayer, 	flushLayer, +	onclick,+ 	forkIOX, 	addThread ) where@@ -38,7 +41,7 @@ 	fillRectangle, fillPolygon, nonconvex, coordModeOrigin,  	setWMProtocols, selectInput, allocaXEvent, nextEvent,-	keyPressMask, exposureMask,+	keyPressMask, exposureMask, buttonPressMask,  	getGeometry, initThreads, connectionNumber, pending, destroyWindow  )@@ -59,6 +62,7 @@ 	killThread, threadDelay)  import System.Posix.Types+import Foreign.C.Types  data Field = Field{ 	fDisplay :: Display,@@ -78,7 +82,9 @@ 	fEvent :: Chan (Maybe Event), 	fClose :: Chan (), 	fClosed :: IORef Bool,-	fRunning :: IORef [ThreadId]+	fRunning :: IORef [ThreadId],+	fOnclick :: IORef (Double -> Double -> IO Bool),+	fEnd :: Chan ()  }  data Layer = Layer{@@ -108,7 +114,7 @@ 	setForeground dpy gcBG 0xffffff 	forM_ bufs $ \bf -> fillRectangle dpy bf gcBG 0 0 rWidth rHeight 	setWMProtocols dpy win [del]-	selectInput dpy win $ exposureMask .|. keyPressMask+	selectInput dpy win $ exposureMask .|. keyPressMask .|. buttonPressMask 	mapWindow dpy win 	[widthRef, heightRef] <- mapM newIORef [rWidth, rHeight] 	buffActions <- newIORef []@@ -119,6 +125,8 @@ 	close <- newChan 	closed <- newIORef False 	running <- newIORef []+	onclickRef <- newIORef $ const $ const $ return True+	endRef <- newChan 	writeChan wait () 	let f = Field{ 		fDisplay = dpy,@@ -138,7 +146,9 @@ 		fEvent = event, 		fClose = close, 		fClosed = closed,-		fRunning = running+		fRunning = running,+		fOnclick = onclickRef,+		fEnd = endRef 	 } 	_ <- forkIOX $ runLoop f 	flushWindow f@@ -155,7 +165,7 @@ 			writeChan (fEvent f) $ Just ev 		end <- readChan endc 		when end $ writeChan (fEvent f) Nothing-	(>> closeDisplay (fDisplay f)) $+	(>> (closeDisplay (fDisplay f) >> writeChan (fEnd f) ())) $ 		(>> destroyWindow (fDisplay f) (fWindow f)) $ doWhile_ $ do 		mev <- readChan $ fEvent f 		case mev of@@ -167,11 +177,17 @@ 				redrawAll f 				return True 			Just (KeyEvent{}) -> return True-			Just ev@(ClientMessageEvent{}) ->+			Just ev@ButtonEvent{} -> do+				pos <- convertPosRev f (ev_x ev) (ev_y ev)+				readIORef (fOnclick f) >>= ($ pos) . uncurry+			Just ev@ClientMessageEvent{} -> 				return $ convert (head $ ev_data ev) /= fDel f 			Nothing -> killThread th1 >> return False 			_ -> return True +onclick :: Field -> (Double -> Double -> IO Bool) -> IO ()+onclick f act = writeIORef (fOnclick f) act+ fieldColor :: Field -> Pixel -> IO () fieldColor f clr = do 	setForeground (fDisplay f) (fGCBG f) clr@@ -324,6 +340,11 @@ 	return $ (round . (+ width / 2) *** round . (+ height / 2) . negate) 		`map` ps +convertPosRev :: Field -> CInt -> CInt -> IO (Double, Double)+convertPosRev f x y = do+	(width, height) <- fieldSize f+	return $ (fromIntegral x - width / 2, fromIntegral (- y) + height / 2)+ fieldSize :: Field -> IO (Double, Double) fieldSize w = fmap (fromIntegral *** fromIntegral) $ winSize w @@ -371,3 +392,6 @@ 	ret <- act f 	writeChan (fWait f) () 	return ret++waitField :: Field -> IO ()+waitField = readChan . fEnd

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