packages feed

gluturtle 0.0.4 → 0.0.5

raw patch · 8 files changed

+122/−199 lines, 8 files

Files

gluturtle.cabal view
@@ -2,7 +2,7 @@ cabal-version:	>= 1.6  name:		gluturtle-version:	0.0.4+version:	0.0.5 stability:	alpha author:		Yoshikuni Jujo <PAF01143@nifty.ne.jp> maintainer:	Yoshikuni Jujo <PAF01143@nifty.ne.jp>@@ -34,8 +34,10 @@ executable		testTurtle   Hs-source-dirs:	tests, src   Main-is:		testGLUT.hs+  Ghc-options:		-Wall  executable		randomTurtle   Hs-source-dirs:	tests, src   Main-is:		randomTurtle.hs   Build-depends:	random+  Ghc-options:		-Wall
src/Graphics/UI/GLUT/Turtle.hs view
@@ -91,7 +91,9 @@ 	isdown, 	isvisible, 	windowWidth,-	windowHeight+	windowHeight,++	outputString ) where  import Graphics.UI.GLUT.Turtle.Data(shapeTable, speedTable)@@ -103,7 +105,8 @@ 	Field, Coordinates(..), openField, closeField, waitField, 	topleft, center, coordinates, fieldSize, forkField, flushField, 	addLayer, clearLayer, addCharacter, clearCharacter, moveTurtle,-	oninputtext, onclick, onrelease, ondrag, onmotion, onkeypress, ontimer)+	oninputtext, onclick, onrelease, ondrag, onmotion, onkeypress, ontimer,+	outputString) import Text.XML.YJSVG(SVG(..), Position(..), Color(..)) import qualified Text.XML.YJSVG as S(center, topleft)
src/Graphics/UI/GLUT/Turtle/Field.hs view
@@ -36,6 +36,8 @@ 	drawCharacterAndLine, 	clearCharacter, +	outputString,+ 	-- * event driven 	oninputtext, 	onclick,@@ -49,8 +51,7 @@ 	addCharacter ) where -import System.Exit-import Control.Applicative+import Control.Monad  import Graphics.UI.GLUT.Turtle.Triangles @@ -58,28 +59,20 @@ 	createWindow, Vertex2(..), renderPrimitive, vertex, PrimitiveMode(..), 	preservingMatrix, GLfloat, swapBuffers, ($=), displayCallback, 	initialDisplayMode, initialWindowSize, Size(..),-	DisplayMode(..), flush, Vertex3(..)+	DisplayMode(..), flush  ) import qualified Graphics.UI.GLUT as G  import Graphics.UI.GLUT.Turtle.Layers(-	Layers, Layer, Character, newLayers, redrawLayers,-	makeLayer, background, addDraw, undoLayer, clearLayer,+	Layers, Layer, Character, newLayers,+	makeLayer, undoLayer, clearLayer, 	makeCharacter, character) import Text.XML.YJSVG(Position(..), Color(..)) -import Control.Monad(when, unless, forever, replicateM, forM_, join)-import Control.Monad.Tools(doWhile_, doWhile)-import Control.Arrow((***))-import Control.Concurrent(-	ThreadId, forkIO, killThread, threadDelay,-	Chan, newChan, readChan, writeChan)+-- import Control.Monad(when, unless, forever, replicateM, forM_, join)+import Control.Concurrent(ThreadId, forkIO) import Data.IORef(IORef, newIORef, readIORef, writeIORef) import Data.IORef.Tools(atomicModifyIORef_)-import Data.Maybe(fromMaybe)-import Data.List(delete)-import Data.Convertible(convert)-import Data.Function.Tools(const2, const3)  -------------------------------------------------------------------------------- @@ -92,14 +85,16 @@ 	fActions :: IORef [IO ()],  	fString :: IORef String,-	fString2 :: IORef String,+	fString2 :: IORef [String],  	fInputtext :: IORef (String -> IO Bool),  	fLayers :: IORef Layers  } +addLayer :: Field -> IO Layer addLayer = makeLayer . fLayers+addCharacter :: Field -> IO Character addCharacter = makeCharacter . fLayers  --------------------------------------------------------------------------------@@ -113,42 +108,23 @@ 	action <- newIORef $ return () 	actions <- newIORef [] 	str <- newIORef ""-	str2 <- newIORef "coi rodo"+	str2 <- newIORef [] 	inputtext <- newIORef $ const $ return True  	initialDisplayMode $= [RGBMode, DoubleBuffered]-	initialWindowSize $= Size 640 480-	createWindow "field"-	displayCallback $= (do-		sequence_ =<< readIORef actions) -- testAction+	initialWindowSize $= Size 640 640+	_ <- createWindow "field"+	displayCallback $= (sequence_ =<< readIORef actions) 	G.addTimerCallback 10 (timerAction $ do 		G.clearColor $= G.Color4 0 0 0 0 		G.clear [G.ColorBuffer] 		sequence_ =<< readIORef actions 		join $ readIORef action 		G.lineWidth $= 1.0-		preservingMatrix $ do-			G.scale (0.0005 :: GLfloat)  0.0005 0.0005-			G.clearColor $= G.Color4 0 0 0 0-			G.color (G.Color4 0 1 0 0 :: G.Color4 GLfloat)-			w <- G.stringWidth G.Roman "Stroke font"-			G.translate (G.Vector3 (-2.5 * (fromIntegral w))-				(-1600) 0 ::-				G.Vector3 GLfloat)-			G.renderString G.Roman =<< readIORef str-		preservingMatrix $ do-			G.scale (0.0005 :: GLfloat)  0.0005 0.0005-			G.clearColor $= G.Color4 0 0 0 0-			G.color (G.Color4 0 1 0 0 :: G.Color4 GLfloat)-			w <- G.stringWidth G.Roman "Stroke font"-			G.translate (G.Vector3 (-2.5 * (fromIntegral w))-				(-1400) 0 ::-				G.Vector3 GLfloat)-			G.renderString G.Roman =<< readIORef str2+		printString (-2.5) (-1800) =<< readIORef str+		zipWithM_ (printString (-2.5)) [-1600, -1400 .. 0] =<< readIORef str2 		swapBuffers) 	G.reshapeCallback $= Just (\size -> G.viewport $= (G.Position 0 0, size))-	print "main loop go"-	print "main loop" 	let f = Field{ 		fCoordinates = CoordCenter, 		fLayers = layers,@@ -161,14 +137,23 @@ 	G.keyboardMouseCallback $= Just (keyboardProc f) 	return f +printString :: GLfloat -> GLfloat -> String -> IO ()+printString x y str =+	preservingMatrix $ do+		G.scale (0.0005 :: GLfloat)  0.0005 0.0005+		G.clearColor $= G.Color4 0 0 0 0+		G.color (G.Color4 0 1 0 0 :: G.Color4 GLfloat)+		w <- G.stringWidth G.Roman "Stroke font"+		G.translate (G.Vector3 (x * fromIntegral w)+			y 0 :: G.Vector3 GLfloat)+		G.renderString G.Roman str++timerAction :: IO a -> IO () timerAction act = do-	act+	_ <- act 	G.addTimerCallback 10 $ timerAction act -data InputType = XInput | End | Timer--waitInput :: Field -> IO (Chan ())-waitInput f = newChan+-- data InputType = XInput | End | Timer  closeField :: Field -> IO () closeField _ = return ()@@ -189,68 +174,43 @@ --------------------------------------------------------------------------------  forkField :: Field -> IO () -> IO ThreadId-forkField f act = do-	tid <- forkIO act-	return tid+forkField _f = forkIO  flushField :: Field -> Bool -> IO a -> IO a-flushField f real act = act+flushField _f _real act = act  fieldColor :: Field -> Layer -> Color -> IO ()-fieldColor f l clr = return ()+fieldColor _f _l _clr = return ()  -------------------------------------------------------------------------------- -drawLayer f l drw = addDraw l (drw, drw)- drawLine :: Field -> Layer -> Double -> Color -> Position -> Position -> IO ()-drawLine f l w c p q = do+drawLine f _ w c p q = do 	atomicModifyIORef_ (fActions f) (makeLineAction p q c w :) --	G.addTimerCallback 1 $ makeLineAction p q c --	swapBuffers 	flush-{- do-	preservingMatrix $ do-		renderPrimitive Quads $ mapM_ vertex [-			Vertex3 0.10 0.10 0.0,-			Vertex3 (-0.10) 0.10 0.0,-			Vertex3 (-0.10) (-0.10) 0.0,-			Vertex3 0.10 (-0.10) 0.0 :: Vertex3 GLfloat-		 ]-	swapBuffers -} -testAction = do-	G.loadIdentity-	preservingMatrix $ do-		renderPrimitive Lines $ mapM_ vertex [-			Vertex3 0.10 0.10 0.0,-			Vertex3 (-0.10) 0.10 0.0,-			Vertex3 (-0.10) (-0.10) 0.0,-			Vertex3 0.10 (-0.10) 0.0 :: Vertex3 GLfloat-		 ]---	swapBuffers- makeLineAction :: Position -> Position -> Color -> Double -> IO ()-makeLineAction p q c w = do-	preservingMatrix $ do-		G.lineWidth $= fromRational (toRational w)-		G.color $ colorToColor4 c -- (G.Color4 1 0 0 0 :: G.Color4 GLfloat)-		renderPrimitive Lines $ mapM_ vertex [-			positionToVertex3 p,-			positionToVertex3 q ]---	swapBuffers+makeLineAction p q c w = preservingMatrix $ do+	G.lineWidth $= fromRational (toRational w)+	G.color $ colorToColor4 c -- (G.Color4 1 0 0 0 :: G.Color4 GLfloat)+	renderPrimitive Lines $ mapM_ vertex [+		positionToVertex3 p,+		positionToVertex3 q ]  colorToColor4 :: Color -> G.Color4 GLfloat colorToColor4 (RGB r g b) = G.Color4 	(fromIntegral r / 255) (fromIntegral g / 255) (fromIntegral b / 255) 0+colorToColor4 _ = error "colorToColor4: not implemented"  makeCharacterAction :: [Position] -> Color -> Color -> Double -> IO () makeCharacterAction ps c lc lw = 	preservingMatrix $ do-		print ps 		G.color $ colorToColor4 c-		renderPrimitive Triangles $ mapM_ (vertex . positionToVertex3) $-			map posToPosition $ triangleToPositions $+		renderPrimitive Triangles $+			mapM_ (vertex . positionToVertex3 . posToPosition) $+			triangleToPositions $ 			toTriangles $ map positionToPos ps --		renderPrimitive Polygon $ mapM_ (vertex . positionToVertex3) ps 		G.lineWidth $= fromRational (toRational lw)@@ -264,6 +224,7 @@  positionToPos :: Position -> Pos positionToPos (Center x y) = (x, y)+positionToPos _ = error "positionToPos: not implemented"  posToPosition :: Pos -> Position posToPosition (x, y) = Center x y@@ -272,38 +233,42 @@ positionToVertex3 (Center x y) = 	Vertex2 (fromRational $ toRational x / 300) 		(fromRational $ toRational y / 300 + 0.2)+positionToVertex3 _ = error "positionToVertex3: not implemented"  writeString :: Field -> Layer -> String -> Double -> Color -> Position -> 	String -> IO ()-writeString f l fname size clr pos str = return ()+writeString _f _ _fname _size _clr _pos _str = return ()  drawImage :: Field -> Layer -> FilePath -> Position -> Double -> Double -> IO ()-drawImage f l fp pos w h = return ()+drawImage _f _ _fp _pos _w _h = return ()  fillRectangle :: Field -> Layer -> Position -> Double -> Double -> Color -> IO ()-fillRectangle f l p w h clr = return ()+fillRectangle _f _ _p _w _h _clr = return ()  fillPolygon :: Field -> Layer -> [Position] -> Color -> Color -> Double -> IO ()-fillPolygon f l ps clr lc lw = do+fillPolygon f _ ps clr lc lw = 	atomicModifyIORef_ (fActions f) (makeCharacterAction ps clr lc lw :)  --------------------------------------------------------------------------------  drawCharacter :: Field -> Character -> Color -> Color -> [Position] -> Double -> IO ()-drawCharacter f ch fc c ps lw = return ()+drawCharacter f _ fclr clr sh lw = writeIORef (fAction f) $+	makeCharacterAction sh fclr clr lw  drawCharacterAndLine ::	Field -> Character -> Color -> Color -> [Position] -> 	Double -> Position -> Position -> IO ()-drawCharacterAndLine f ch fclr clr sh lw p q =-	writeIORef (fAction f) $ do-		makeLineAction p q clr lw-		makeCharacterAction sh fclr clr lw+drawCharacterAndLine f _ fclr clr sh lw p q = writeIORef (fAction f) $ do+	makeLineAction p q clr lw+	makeCharacterAction sh fclr clr lw  clearCharacter :: Character -> IO () clearCharacter ch = character ch $ return ()  -------------------------------------------------------------------------------- +outputString :: Field -> String -> IO ()+outputString f = atomicModifyIORef_ (fString2 f) . (:)+ oninputtext :: Field -> (String -> IO Bool) -> IO () oninputtext = writeIORef . fInputtext @@ -321,17 +286,17 @@ onkeypress _ _ = return ()  ontimer :: Field -> Int -> IO Bool -> IO ()-ontimer f t fun = return ()+ontimer _ _ _ = return ()  keyboardProc :: Field -> G.Key -> G.KeyState -> G.Modifiers -> G.Position -> IO ()-keyboardProc f (G.Char 'q') _ _ _ = exitWith ExitSuccess keyboardProc f (G.Char '\r') G.Down _ _ = do 	str <- readIORef $ fString f-	($ str) =<< readIORef (fInputtext f)-	writeIORef (fString2 f) str+	atomicModifyIORef_ (fString2 f) (str :) 	writeIORef (fString f) ""+	continue <- ($ str) =<< readIORef (fInputtext f)+	unless continue G.leaveMainLoop keyboardProc f (G.Char '\b') G.Down _ _ = atomicModifyIORef_ (fString f) init keyboardProc f (G.Char c) state _ _-	| state == G.Down = print c >> atomicModifyIORef_ (fString f) (++ [c])+	| state == G.Down = atomicModifyIORef_ (fString f) (++ [c]) 	| otherwise = return () keyboardProc _ _ _ _ _ = return ()
src/Graphics/UI/GLUT/Turtle/Move.hs view
@@ -28,7 +28,9 @@ 	onkeypress, 	ontimer, 	addLayer,-	addCharacter+	addCharacter,++	outputString ) where  import Graphics.UI.GLUT.Turtle.State(TurtleState(..), makeShape)@@ -39,13 +41,13 @@ 	clearCharacter, addLayer, addCharacter, 	oninputtext, onclick, onrelease, ondrag, onmotion, onkeypress, ontimer, 	fieldColor, drawLine, fillRectangle, fillPolygon, writeString,-	drawImage, undoField, undoLayer, drawCharacter, drawCharacterAndLine)+	drawImage, undoField, drawCharacter, drawCharacterAndLine,+	outputString) import Text.XML.YJSVG(SVG(..), Position(..)) import qualified Text.XML.YJSVG as S(topleft)  import Control.Concurrent(threadDelay) import Control.Monad(when, unless, forM_)-import Control.Monad.Tools(unlessM) import Data.Maybe(isJust)  --------------------------------------------------------------------------------@@ -58,7 +60,6 @@ 	when (undo t1) $ fl $ do 		when (clear t0) redraw 		when (isJust $ draw t0) $ do---			unlessM (undoLayer l) $ clearLayer l >> redraw 			undoField f 			when (visible t1) $ drawTtl (direction t0) $ position t0 	when (visible t1) $ do
src/Graphics/UI/GLUT/Turtle/TriangleTools.hs view
@@ -1,8 +1,6 @@ module Graphics.UI.GLUT.Turtle.TriangleTools ( 	Pos, 	far,---	maximumIndex,---	distance2, 	index3, 	deleteIndex, @@ -22,6 +20,7 @@ far :: [Pos] -> Int far = maximumIndex . map distance2 +deleteOnline :: [Pos] -> [Pos] deleteOnline xs = init $ tail $ dol $ last xs : xs ++ [head xs]  dol :: [Pos] -> [Pos]@@ -29,6 +28,7 @@ dol (a : ps@(b : ps'@(c : _))) 	| online (a, b, c) = a : dol ps' 	| otherwise = a : dol ps+dol _ = error "dol: not implemented"  maximumIndex :: Ord a => [a] -> Int maximumIndex = fst . maximumIndexGen@@ -48,40 +48,24 @@ 	| otherwise = (i + 1, x') 	where 	(i, x') = maximumIndexGen xs+maximumIndexGen _ = error "maximumIndexGen: not implemented" +draw :: [Pos] -> [(Pos, Pos, Pos)] -> IO () draw pl trs = do 	prgName <- getProgName 	rawArgs <- getArgs-	args <- initialize prgName rawArgs-	createWindow "GLTest"+	_args <- initialize prgName rawArgs+	_ <- createWindow "GLTest" 	displayCallback $= do-		color $ (Color4 1 1 1 0 :: Color4 GLfloat)+		color (Color4 1 1 1 0 :: Color4 GLfloat) 		drawTriangles trs -- [((50, 50), (-50, -50), (0, 50))]-		color $ (Color4 1 0 0 0 :: Color4 GLfloat)+		color (Color4 1 0 0 0 :: Color4 GLfloat) 		drawPolyline pl -- [(50, 50), (-50, -50), (0, 50), (-50, 80)] 		swapBuffers 		flush 	mainLoop -main = do-	prgName <- getProgName-	rawArgs <- getArgs-	args <- initialize prgName rawArgs-	createWindow "GLTest"-	displayCallback $= displayScene-	mainLoop--displayScene = do---	drawTriangles [(50, 50), (-50, -50), (0, 50)]-	drawPolyline [(50, 50), (-50, -50), (0, 50), (-50, 80)]-	swapBuffers-	flush--drawObject = preservingMatrix $-	renderPrimitive Lines $ mapM_ vertex [-		Vertex2 (-0.5) (-0.5),-		Vertex2 0.5 0.5 :: Vertex2 GLfloat ]-+drawTriangles :: [(Pos, Pos, Pos)] -> IO () drawTriangles ps = preservingMatrix $ 	renderPrimitive Triangles $ mapM_ vertex $ trianglesToVertex2 ps @@ -94,6 +78,7 @@ toVertex2 (x, y) = Vertex2 	(fromRational $ toRational x / 20) (fromRational $ toRational y / 20) +drawPolyline :: [Pos] -> IO () drawPolyline ps = preservingMatrix $ 	renderPrimitive LineLoop $ mapM_ (vertex . toVertex2) ps @@ -108,30 +93,10 @@ 	(xd, yd) = (xa - xb, ya - yb) 	(xe, ye) = (xc - xb, yc - yb) +distance2 :: Floating a => (a, a) -> a distance2 (x, y) = x ** 2 + y ** 2 -maximum3 :: Ord a => [a] -> (a, a, a)-maximum3 xs = maximum3Gen $ last xs : xs ++ [head xs]--maximum3Gen :: Ord a => [a] -> (a, a, a)-maximum3Gen [x, y, z] = (x, y, z)-maximum3Gen (x : xs@(y : z : _))-	| y > y' = (x, y, z)-	| otherwise = p-	where-	p@(x', y', z') = maximum3Gen xs--maximumby3 :: Ord b => (a -> b) -> [a] -> (a, a, a)-maximumby3 b xs = maximumby3Gen b $ last xs : xs ++ [head xs]--maximumby3Gen :: Ord b => (a -> b) -> [a] -> (a, a, a)-maximumby3Gen _ [x, y, z] = (x, y, z)-maximumby3Gen b (x : xs@(y : z : _))-	| b y > b y' = (x, y, z)-	| otherwise = p-	where-	p@(_, y', _) = maximumby3Gen b xs-+maximumby32 :: Ord b => (a -> b) -> [a] -> ((a, a, a), [a]) maximumby32 b xs = maximumby3Gen2 b $ last xs : xs ++ [head xs]  maximumby3Gen2 :: Ord b => (a -> b) -> [a] -> ((a, a, a), [a])@@ -141,6 +106,7 @@ 	| otherwise = (t, x : ps) 	where 	(t@(_, y', _), ps) = maximumby3Gen2 b ys+maximumby3Gen2 _ _ = error "maximumby3Gen2: not implemented"  distant3 :: [Pos] -> ((Pos, Pos, Pos), [Pos]) distant3 ps = let (t, ps') = maximumby32 distance2 ps in (t, init $ tail ps')@@ -156,14 +122,6 @@ 	where 	(xd, yd) = (xa - xb, ya - yb) 	(xe, ye) = (xc - xb, yc - yb)--deleteOnlineGen :: (Pos, Pos, Pos) -> (Pos, Pos)-deleteOnlineGen (p1@(x1, _), p2@(x2, _), p3@(x3, _))-	| not $ online (p1, p2, p3) = error "not online"-	| x1 > x3 = deleteOnlineGen (p3, p2, p1)-	| x2 < x1 = (p2, p3)-	| x1 <=x2 && x2 <= x3 = (p1, p3)-	| x3 < x2 = (p1, p2)  pa, pb, pc, pd, pe :: Pos pa = (0, 4)
src/Graphics/UI/GLUT/Turtle/Triangles.hs view
@@ -2,18 +2,8 @@  import Graphics.UI.GLUT.Turtle.TriangleTools -ps = [pa, pb, pc, pd]-ps' = [(1, 3), (2.1, 2), (3, 3.1), (5, 2), (4, 1), (2, 1.5), (1, 1.1)]--main = draw ps' $ toTriangles ps'- toTriangles :: [Pos] -> [(Pos, Pos, Pos)]-toTriangles ps = toTrianglesTop ps'---	| isRight tri = toTrianglesTop ps'---	| otherwise = toTrianglesTop $ reverse ps'-	where-	ps' = deleteOnline ps-	(tri, rest) = distant3 ps+toTriangles = toTrianglesTop . deleteOnline  toTrianglesTop :: [Pos] -> [(Pos, Pos, Pos)] toTrianglesTop [a, b, c] = [(a, b, c)]
tests/randomTurtle.hs view
@@ -1,35 +1,34 @@ module Main where  import Graphics.UI.GLUT.Turtle-import Graphics.UI.GLUT.Turtle.Field import Graphics.UI.GLUT(initialize, addTimerCallback, mainLoop) import System.Random import System.Environment import Control.Monad-import Control.Concurrent import Data.Word  main :: IO () main = do 	prgName <- getProgName 	rawArgs <- getArgs-	args <- initialize prgName rawArgs+	_args <- initialize prgName rawArgs 	f <- openField 	t <- newTurtle f --	pencolor t "white" 	pensize t 3-	pencolor t (255, 255, 255)+	pencolor t ((255, 255, 255) :: (Int, Int, Int)) 	preprocess t 	(x0, y0) <- position t 	addTimerCallback 100 $ timerProc $ draw t x0 y0 	mainLoop +timerProc :: IO a -> IO () timerProc act = do-	act+	_ <- act 	addTimerCallback 20 $ timerProc act  randomWord8 :: IO Word8-randomWord8 = fmap fromIntegral $ (randomRIO (0, 255) :: IO Int)+randomWord8 = fmap fromIntegral (randomRIO (0, 255) :: IO Int)  randomTurtle :: Turtle -> IO () randomTurtle t = do@@ -52,6 +51,7 @@ 	pendown t 	position t >>= print +draw :: Turtle -> Double -> Double -> IO () draw t x0 y0 = do 	d <- randomRIO (- 180, 180) 	r <- randomWord8@@ -60,5 +60,5 @@ 	pencolor t (r, g, b) 	left t d 	forward t 15-	d <- distance t x0 y0-	when (d > 100) $ undo t+	dist <- distance t x0 y0+	when (dist > 100) $ undo t
tests/testGLUT.hs view
@@ -1,34 +1,38 @@ import Graphics.UI.GLUT.Turtle-import Graphics.UI.GLUT-import Control.Concurrent+import Graphics.UI.GLUT hiding (position)  import System.Environment +main :: IO () main = do 	prgName <- getProgName 	rawArgs <- getArgs-	args <- initialize prgName rawArgs+	_args <- initialize prgName rawArgs 	f <- openField 	t <- newTurtle f-	oninputtext f (processInput t)+	oninputtext f (processInput f t) --	speed t "slowest"-	fillcolor t (255, 255, 255)-	pencolor t (255, 255, 255)+	fillcolor t ((255, 255, 255) :: (Int, Int, Int))+	pencolor t ((255, 255, 255) :: (Int, Int, Int)) --	threadDelay 1000000 --	left t 45 --	forward t 100 	mainLoop -processInput t "forward" = forward t 100 >> return True-processInput t "left" = left t 90 >> return True-processInput t "begin" = beginfill t >> return True-processInput t "end" = endfill t >> return True-processInput t "turtle" = shape t "turtle" >> return True-processInput t "stamp" = stamp t >> return True-processInput t "bold" = pensize t 3 >> return True-processInput t "big" = shapesize t 3 3 >> return True-processInput t "blue" = pencolor t (0, 0, 255) >> return True-processInput t "fblue" = fillcolor t (0, 0, 255) >> return True-processInput t "yellow" = pencolor t (255, 255, 0) >> return True-processInput t "normal" = pensize t 1 >> return True-processInput t _ = return True+processInput :: Field -> Turtle -> String -> IO Bool+processInput _ t "forward" = forward t 100 >> return True+processInput _ t "left" = left t 90 >> return True+processInput _ t "begin" = beginfill t >> return True+processInput _ t "end" = endfill t >> return True+processInput _ t "turtle" = shape t "turtle" >> return True+processInput _ t "stamp" = stamp t >> return True+processInput _ t "bold" = pensize t 3 >> return True+processInput _ t "big" = shapesize t 3 3 >> return True+processInput _ t "blue" = pencolor t ((0, 0, 255) :: (Int, Int, Int)) >> return True+processInput _ t "fblue" = fillcolor t ((0, 0, 255) :: (Int, Int, Int)) >> return True+processInput _ t "yellow" = pencolor t ((255, 255, 0) :: (Int, Int, Int)) >> return True+processInput _ t "normal" = pensize t 1 >> return True+processInput _ _ "exit" = return False+processInput f t "position" = position t >>= outputString f . show >> return True+processInput _ t "penup" = penup t >> return True+processInput _ _ _ = return True