xturtle 0.1.2 → 0.1.3

raw patch · 6 files changed

+59/−7 lines, 6 filesdep +Imlib

Dependencies added: Imlib

Files

• src/Graphics/X11/Turtle.hs +5/−1
• src/Graphics/X11/Turtle/Field.hs +9/−1
• src/Graphics/X11/Turtle/Input.hs +5/−1
• src/Graphics/X11/Turtle/Move.hs +2/−1
• src/Graphics/X11/Turtle/XTools.hs +36/−1
• xturtle.cabal +2/−2

@@ -28,6 +28,7 @@ 	setheading, 	circle, 	write,+	image, 	bgcolor, 	home, 	clear,@@ -97,7 +98,7 @@ --------------------------------------------------------------------------------  xturtleVersion :: (Int, String)-xturtleVersion = (48, "0.1.2")+xturtleVersion = (49, "0.1.3")  -------------------------------------------------------------------------------- @@ -184,6 +185,9 @@  write :: Turtle -> String -> Double -> String -> IO () write t fnt sz = input t . Write fnt sz++image :: Turtle -> FilePath -> Double -> Double -> IO ()+image t fp w h = input t $ PutImage fp w h  bgcolor :: ColorClass c => Turtle -> c -> IO () bgcolor t = input t . Bgcolor . getColor

@@ -20,6 +20,7 @@ 	drawLine, 	fillPolygon, 	writeString,+	drawImage, 	undoLayer, 	clearLayer, @@ -45,7 +46,7 @@ 	drawLineXT, writeStringXT, 	allocaXEvent, waitEvent, pending, nextEvent, getEvent, filterEvent, 	utf8LookupString, buttonPress, buttonRelease, xK_VoidSymbol)-import qualified Graphics.X11.Turtle.XTools as X(fillPolygon)+import qualified Graphics.X11.Turtle.XTools as X(fillPolygon, drawImage) import Graphics.X11.Turtle.Layers( 	Layers, Layer, Character, newLayers, redrawLayers, 	makeLayer, addDraw, setBackground, undoLayer, clearLayer,@@ -242,6 +243,13 @@ 	where ws bf = do 		(x, y) <- topLeft f xc yc 		writeStringXT (fDisplay f) (bf $ fBufs f) fname size clr x y str++drawImage :: Field -> Layer -> FilePath -> Double -> Double -> Double -> Double -> IO ()+drawImage f l fp xc yc w h = addDraw l (di undoBuf, di bgBuf)+	where di bf = do+		(x, y) <- topLeft f xc yc+		X.drawImage (fDisplay f) (bf $ fBufs f) (gcForeground $ fGCs f)+			fp x y (round w) (round h)  fillPolygon :: Field -> Layer -> [(Double, Double)] -> Color -> IO () fillPolygon f l psc clr = addDraw l (fp undoBuf, fp bgBuf)

@@ -38,6 +38,7 @@ 	| Goto Double Double 	| Rotate Double 	| Write String Double String+	| PutImage FilePath Double Double 	| Bgcolor Color 	| Undo 	| Clear@@ -80,7 +81,7 @@ 	fill = f, 	draw = if fill t && not f then Just fl else Nothing, 	drawed = if fill t && not f then fl : drawed t else drawed t,-	fillPoints = if f then [(x0, y0)] else []}+	fillPoints = [(x0, y0) | f]} 	where 	(x0, y0) = position t 	fl = Polyline (uncurry Center `map` fillPoints t)@@ -102,6 +103,9 @@ nextTurtle t (Write fnt sz str) = (clearState t){ 	draw = Just txt, drawed = txt : drawed t} 	where txt = Text (uncurry Center $ position t) sz (pencolor t) fnt str+nextTurtle t (PutImage fp w h) = (clearState t){+	draw = Just img, drawed = img : drawed t}+	where img = Image (uncurry Center $ position t) w h fp 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]}

@@ -33,7 +33,7 @@ 	forkField, flushField, fieldColor, 	addLayer, drawLine, writeString, undoLayer, clearLayer, fillPolygon, 	addCharacter, drawCharacter, drawCharacterAndLine, clearCharacter,-	onclick, onrelease, ondrag, onkeypress)+	onclick, onrelease, ondrag, onkeypress, drawImage) import Text.XML.YJSVG(SVG(..), Position(..))  import Control.Concurrent(threadDelay)@@ -82,6 +82,7 @@ 	where 	posToTup (Center x y) = (x, y) 	posToTup _ = error "not implemented"+drawSVG f l (Image (Center x0 y0) w h fp) = drawImage f l fp x0 y0 w h drawSVG _ _ (Fill _) = return () drawSVG _ _ _ = error "not implemented" 

@@ -34,6 +34,7 @@ 	fillPolygon, 	drawLineXT, 	writeStringXT,+	drawImage,  	-- * event 	allocaXEvent,@@ -64,7 +65,7 @@ 	allocaXEvent, pending, nextEvent, 	setWMProtocols, selectInput, button1MotionMask, buttonReleaseMask, 	buttonPressMask, keyPressMask, exposureMask,-	buttonPress, buttonRelease, xK_VoidSymbol, getGeometry)+	buttonPress, buttonRelease, xK_VoidSymbol, getGeometry, drawPoint) import qualified Graphics.X11 as X(fillPolygon) import Graphics.X11.Xlib.Extras(Event(..), getEvent) import Graphics.X11.Xft(@@ -83,6 +84,14 @@ import System.Posix.Types(Fd(..)) import Numeric(showFFloat) +import Data.IORef+import Data.IORef.Tools(atomicModifyIORef_)+import Foreign.Ptr+import Foreign.Storable+import Foreign.Marshal.Array+import Data.Word+import Graphics.Imlib+ --------------------------------------------------------------------------------  data Bufs = Bufs{@@ -179,3 +188,29 @@  waitEvent :: Display -> IO () waitEvent = threadWaitRead . Fd . connectionNumber++drawImage :: Display -> Drawable -> GC -> FilePath -> Position -> Position ->+	Dimension -> Dimension -> IO ()+drawImage dpy win gc fp x y w h = getPicture fp w h >>= drawPicture dpy win gc x y++getPicture :: FilePath -> Dimension -> Dimension -> IO (Dimension, Dimension, Ptr Word32)+getPicture fp nw nh = do+	img <- loadImageImmediately fp+	contextSetImage img+	w <- fmap fromIntegral imageGetWidth+	h <- fmap fromIntegral imageGetHeight+	nimg <- createCroppedScaledImage (0 :: Int) (0 :: Int) (w :: Int) (h :: Int) nw nh+	contextSetImage nimg+	dat <- imageGetData+	return (nw, nh, dat)++drawPicture :: Display -> Drawable -> GC -> Position -> Position ->+	(Dimension, Dimension, Ptr Word32) -> IO ()+drawPicture dpy win gc x0 y0 (w, h, dat) = do+	ptr <- newIORef dat+	forM_ [0 .. w * h - 1] $ \i -> do+		readIORef ptr >>= peek >>= setForeground dpy gc+		let	x = fromIntegral i `mod` w+			y = fromIntegral i `div` w+		drawPoint dpy win gc (x0 + fromIntegral x) (y0 + fromIntegral y)+		atomicModifyIORef_ ptr $ flip advancePtr 1

@@ -2,7 +2,7 @@ cabal-version:	>= 1.6  name:		xturtle-version:	0.1.2+version:	0.1.3 stability:	experimental author:		Yoshikuni Jujo <PAF01143@nifty.ne.jp> maintainer:	Yoshikuni Jujo <PAF01143@nifty.ne.jp>@@ -31,7 +31,7 @@   Hs-source-dirs:	src   Exposed-modules:	Graphics.X11.Turtle   Build-depends:	base > 3 && < 5, yjtools >= 0.9.14, convertible >= 1.0.8, X11,-    X11-xft <= 3.1, x11-xim, setlocale, yjsvg >= 0.1.13+    X11-xft <= 3.1, x11-xim, setlocale, yjsvg >= 0.1.13, Imlib >= 0.1.2   Ghc-options:		-Wall   Other-modules:	Graphics.X11.Turtle.Field, Graphics.X11.Turtle.Input,     Graphics.X11.Turtle.Move, Graphics.X11.Turtle.State, Graphics.X11.Turtle.Data,