gluturtle 0.0.12 → 0.0.13

raw patch · 3 files changed

+28/−6 lines, 3 files

Files

• gluturtle.cabal +1/−1
• src/Graphics/UI/GLUT/Turtle/Field.hs +23/−3
• tests/testGLUT.hs +4/−2

@@ -2,7 +2,7 @@ cabal-version:	>= 1.6  name:		gluturtle-version:	0.0.12+version:	0.0.13 stability:	alpha author:		Yoshikuni Jujo <PAF01143@nifty.ne.jp> maintainer:	Yoshikuni Jujo <PAF01143@nifty.ne.jp>

@@ -112,7 +112,7 @@ openField name w h = do 	layers <- newLayers 0 (return ()) (return ()) (return ()) 	action <- newIORef $ return ()-	actions <- newIORef []+	actions <- newIORef [makeFieldColor $ RGB 255 255 255] 	str <- newIORef [""] 	str2 <- newIORef [] 	inputtext <- newIORef $ const $ return True@@ -198,8 +198,17 @@ flushField _f _real act = act  fieldColor :: Field -> Layer -> Color -> IO ()-fieldColor _f _l _clr = return ()+fieldColor f _l clr =+	atomicModifyIORef_ (fActions f) ((++ [makeFieldColor clr]) . init) +makeFieldColor clr = preservingMatrix $ do+	G.color $ colorToColor4 clr+	renderPrimitive Quads $ mapM_ vertex [+		G.Vertex2 (-1) (-1),+		G.Vertex2 (-1) 1,+		G.Vertex2 1 1,+		G.Vertex2 1 (-1) :: Vertex2 GLfloat ]+ --------------------------------------------------------------------------------  drawLine :: Field -> Layer -> Double -> Color -> Position -> Position -> IO ()@@ -222,6 +231,13 @@ 	(fromIntegral r / 255) (fromIntegral g / 255) (fromIntegral b / 255) 0 colorToColor4 _ = error "colorToColor4: not implemented" +makeQuads :: Field -> [Position] -> Color -> IO ()+makeQuads f ps c =+	preservingMatrix $ do+		G.color $ colorToColor4 c+		renderPrimitive Quads $+			mapM_ (vertex . positionToVertex3 f) ps+ makeCharacterAction :: Field -> [Position] -> Color -> Color -> Double -> IO () makeCharacterAction f ps c lc lw = 	preservingMatrix $ do@@ -278,7 +294,11 @@ drawImage _f _ _fp _pos _w _h = return ()  fillRectangle :: Field -> Layer -> Position -> Double -> Double -> Color -> IO ()-fillRectangle _f _ _p _w _h _clr = return ()+fillRectangle f _ p w h clr = do return ()+{-+	atomicModifyIORef_ (fActions f) (makeQuads f [+		Center 0 0, Center 0 100, Center 100 100, Center 100 0] clr])+-}  fillPolygon :: Field -> Layer -> [Position] -> Color -> Color -> Double -> IO () fillPolygon f _ ps clr lc lw =

@@ -12,8 +12,8 @@ 	t <- newTurtle f 	oninputtext f (processInput f t) --	speed t "slowest"-	fillcolor t ((255, 255, 255) :: (Int, Int, Int))-	pencolor t ((255, 255, 255) :: (Int, Int, Int))+--	fillcolor t ((255, 255, 255) :: (Int, Int, Int))+--	pencolor t ((255, 255, 255) :: (Int, Int, Int)) --	threadDelay 1000000 --	left t 45 --	forward t 100@@ -40,4 +40,6 @@ processInput _ t "0very1very2very3very4very5very6very7very8very9very0very-long-line" 	= putStrLn "very long line" >> return True processInput _ t "hide" = hideturtle t >> return True+processInput _ t "bred" = bgcolor t ((255, 0, 0) :: (Int, Int, Int)) >> return True+processInput _ t "bgreen" = bgcolor t ((0, 255, 0) :: (Int, Int, Int)) >> return True processInput _ _ _ = return True