gloss 1.2.0.1 → 1.3.0.1

raw patch · 8 files changed

+161/−39 lines, 8 filesdep +bytestringPVP ok

version bump matches the API change (PVP)

Dependencies added: bytestring

API changes (from Hackage documentation)

Files

• Graphics/Gloss.hs +4/−0
• Graphics/Gloss/Data/Picture.hs +8/−2
• Graphics/Gloss/Data/Point.hs +1/−1
• Graphics/Gloss/Internals/Render/Bitmap.hs +59/−0
• Graphics/Gloss/Internals/Render/Common.hs +5/−0
• Graphics/Gloss/Internals/Render/Picture.hs +80/−34
• LICENSE +1/−1
• gloss.cabal +3/−1

@@ -31,6 +31,10 @@ -- -- @ -- Release Notes:+-- For 1.3.0:+--     New support for displaying bitmap files. (Thanks to Ben Lambert-Smith)+--     Various wibbles for GHC 7.1   +-- -- For 1.2.0: --     Cleaned up module hierarchy. --     Added line-line intersection utils.

@@ -7,7 +7,7 @@ 	, Picture(..)  	-- * Aliases for Picture constructors-	, blank, polygon, line, circle, thickCircle, text+	, blank, polygon, line, circle, thickCircle, text, bitmap 	, color, translate, rotate, scale 	, pictures @@ -22,6 +22,7 @@ import Graphics.Gloss.Data.Point import Graphics.Gloss.Data.Vector import Data.Monoid+import Data.ByteString   -- | A path through the x-y plane.@@ -49,6 +50,9 @@ 	-- | Some text to draw with a vector font. 	| Text		String +	-- | A bitmap image with a width, height and a ByteString holding the 32 bit RGBA bitmap data.+	| Bitmap	Int	Int 	ByteString+ 	-- Color ------------------------------------------ 	-- | A picture drawn with this color. 	| Color		Color  		Picture@@ -64,7 +68,6 @@ 	| Scale		Float	Float	Picture  	-- More Pictures ----------------------------------- 	-- | A picture consisting of several others. 	| Pictures	[Picture] 	deriving (Show, Eq)@@ -96,6 +99,9 @@  text :: String -> Picture text = Text++bitmap :: Int -> Int -> ByteString -> Picture+bitmap = Bitmap  color :: Color -> Picture -> Picture color = Color

@@ -1,5 +1,5 @@ {-# OPTIONS -fno-warn-missing-methods #-}-{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} module Graphics.Gloss.Data.Point 	( Point 	, pointInBox)

@@ -0,0 +1,59 @@+{-# OPTIONS -fwarn-incomplete-patterns #-}++-- | Helper functions for rendering bitmaps+module Graphics.Gloss.Internals.Render.Bitmap+	( reverseRGBA+	, bitmapPath  )+where+import Foreign+import qualified Data.ByteString as B+++-- | Generates the point path to display the bitmap centred+bitmapPath :: Float -> Float -> [(Float, Float)]+bitmapPath width height + = [(-width', -height'), (width', -height'), (width', height'), (-width', height')]+ where	width'  = width  / 2+	height' = height / 2+++-- | This is necessary as openGL reads pixel data as ABGR, rather than RGBA+reverseRGBA :: B.ByteString -> IO (Ptr Word8)+reverseRGBA orig + = do ptr  <- newArray $ B.unpack orig+      ptr' <- reverseRGBA' (B.length orig `div` 4) (castPtr ptr) 0+      return $ castPtr ptr'+++-- | Parses through pixel values, shifting the bytes into OpenGL ABGR order+reverseRGBA' :: Int -> Ptr Word32 -> Int -> IO (Ptr Word32)+reverseRGBA' len ptr count+ | count < len + = do	curr <- peekElemOff ptr count+      	let byte0 = shift (isolateByte0 curr) 24+      	let byte1 = shift (isolateByte1 curr) 8+      	let byte2 = shift (isolateByte2 curr) (-8)+      	let byte3 = shift (isolateByte3 curr) (-24)+      	pokeElemOff ptr count (byte0 .|. byte1 .|. byte2 .|. byte3)+      	reverseRGBA' len ptr (count + 1)++ | otherwise + = return ptr+++-- | These functions work as bit masks to isolate the Word8 components+isolateByte0 :: Word32 -> Word32+isolateByte0 word =+   word .&. (255 :: Word32)++isolateByte1 :: Word32 -> Word32+isolateByte1 word =+   word .&. (65280 :: Word32)++isolateByte2 :: Word32 -> Word32+isolateByte2 word =+   word .&. (16711680 :: Word32)++isolateByte3 :: Word32 -> Word32+isolateByte3 word =+   word .&. (4278190080 :: Word32)

@@ -14,3 +14,8 @@ gf :: Float -> GL.GLfloat {-# INLINE gf #-} gf x = unsafeCoerce x++-- | Used for similar reasons to above+gsizei :: Int -> GL.GLsizei+{-# INLINE gsizei #-}+gsizei x = unsafeCoerce x

@@ -11,10 +11,11 @@ import	Graphics.Gloss.Internals.Render.Options import	Graphics.Gloss.Internals.Render.Common import	Graphics.Gloss.Internals.Render.Circle-import	Graphics.UI.GLUT						(($=), get)-import	qualified Graphics.Rendering.OpenGL.GL				as GL-import	qualified Graphics.UI.GLUT					as GLUT-+import	Graphics.Gloss.Internals.Render.Bitmap+import	Graphics.UI.GLUT			(($=), get)+import	qualified Graphics.Rendering.OpenGL.GL	as GL+import	qualified Graphics.UI.GLUT		as GLUT+import   Control.Monad  -- ^ Render a picture using the given render options and viewport. renderPicture@@ -38,7 +39,6 @@ 	--  	let ?modeWireframe	= optionsWireframe renderS 	    ?modeColor		= optionsColor     renderS-	    ?scale		= viewPortScale    viewS 	    ?matProj		= matProj_ 	    ?viewport		= viewport_ 	    ?windowSize		= windowSize_@@ -47,15 +47,14 @@ 	setLineSmooth	(optionsLineSmooth renderS) 	setBlendAlpha	(optionsBlendAlpha renderS) 	-	drawPicture picture+	drawPicture (viewPortScale viewS) picture -drawPicture -	:: ( ?modeWireframe::Bool-	   , ?scale::Float-	   , ?modeColor::Bool) -	=> Picture -> IO ()	  +drawPicture+	:: ( ?modeWireframe :: Bool+	   , ?modeColor :: Bool) +	=> Float -> Picture -> IO ()	   -drawPicture picture+drawPicture circScale picture  = {-# SCC "drawComponent" #-}    case picture of @@ -81,10 +80,10 @@  	-- circle 	Circle radius-	 ->  renderCircle 0 0 ?scale radius 0+	 ->  renderCircle 0 0 circScale radius 0 	 	ThickCircle radius thickness-	 ->  renderCircle 0 0 ?scale radius thickness+	 ->  renderCircle 0 0 circScale radius thickness 	 	-- stroke text 	-- 	text looks wierd when we've got blend on,@@ -99,55 +98,102 @@ 	Color col p 	 |  ?modeColor 	 ->  {-# SCC "draw.color" #-}-   	     do-		oldColor 	 <- get GL.currentColor+   	     do	oldColor 	 <- get GL.currentColor  		let (r, g, b, a) = rgbaOfColor col -		GL.currentColor	-			$= GL.Color4 (gf r) (gf g) (gf b) (gf a)--		drawPicture p-+		GL.currentColor	 $= GL.Color4 (gf r) (gf g) (gf b) (gf a)+		drawPicture circScale p 		GL.currentColor	$= oldColor		  	 |  otherwise-	 -> 	drawPicture p+	 -> 	drawPicture circScale p   	-- ease up on GL.preservingMatrix 	--	This is an important optimisation for the Eden example, 	--	as it draws lots of translated circles. 	Translate posX posY (Circle radius)-	 -> renderCircle posX posY ?scale radius 0+	 -> renderCircle posX posY circScale radius 0  	Translate posX posY (ThickCircle radius thickness)-	 -> renderCircle posX posY ?scale radius thickness+	 -> renderCircle posX posY circScale radius thickness  	Translate tx ty (Rotate deg p) 	 -> GL.preservingMatrix-	     $ do	GL.translate (GL.Vector3 (gf tx) (gf ty) 0)-			GL.rotate (gf deg) (GL.Vector3 0 0 (-1))-			drawPicture p+	  $ do	GL.translate (GL.Vector3 (gf tx) (gf ty) 0)+		GL.rotate (gf deg) (GL.Vector3 0 0 (-1))+		drawPicture circScale p  	----- 	Translate tx ty	p 	 -> GL.preservingMatrix-	     $ do	GL.translate (GL.Vector3 (gf tx) (gf ty) 0)-			drawPicture p+	  $ do	GL.translate (GL.Vector3 (gf tx) (gf ty) 0)+		drawPicture circScale p  	Rotate deg p 	 -> GL.preservingMatrix-	     $ do	GL.rotate (gf deg) (GL.Vector3 0 0 (-1))-			drawPicture p+	  $ do	GL.rotate (gf deg) (GL.Vector3 0 0 (-1))+		drawPicture circScale p  	Scale sx sy p 	 -> GL.preservingMatrix-	     $ do	GL.scale (gf sx) (gf sy) 1-			drawPicture p+	  $ do	GL.scale (gf sx) (gf sy) 1+		let mscale	= max sx sy+		drawPicture (circScale * mscale) p 			+	-----+	Bitmap width height imgData+	 -> do	-- As OpenGL reads texture pixels as ABGR (instead of RGBA)+		--  each pixel's value needs to be reversed we also need to+		--  Convert imgData from ByteString to Ptr Word8+		imgData' <- reverseRGBA $ imgData++		-- Allocate texture handle for texture+		[texObject] <- GL.genObjectNames 1+		GL.textureBinding GL.Texture2D $= Just texObject++		-- Sets the texture in imgData as the current texture+		GL.texImage2D+			Nothing+			GL.NoProxy+			0+			GL.RGBA8+			(GL.TextureSize2D+				(gsizei width)+				(gsizei height))+			0+			(GL.PixelData GL.RGBA GL.UnsignedInt8888 imgData')+		-- Set up wrap and filtering mode+		GL.textureWrapMode GL.Texture2D GL.S $= (GL.Repeated, GL.Repeat)+		GL.textureWrapMode GL.Texture2D GL.T $= (GL.Repeated, GL.Repeat)+		GL.textureFilter   GL.Texture2D      $= ((GL.Nearest, Nothing), GL.Nearest)+		+		-- Enable texturing+		GL.texture GL.Texture2D $= GL.Enabled+		GL.textureFunction      $= GL.Combine+		+		-- Set current texture+		GL.textureBinding GL.Texture2D $= Just texObject+		+		-- Set to opaque+		GL.currentColor $= GL.Color4 1.0 1.0 1.0 1.0+		+		-- Draw textured polygon+		GL.renderPrimitive GL.Polygon+		 $ do zipWithM_+		        (\(pX, pY) (tX, tY)+			  -> do GL.texCoord $ GL.TexCoord2 (gf tX) (gf tY)+		           	GL.vertex   $ GL.Vertex2   (gf pX) (gf pY))++			(bitmapPath (fromIntegral width) (fromIntegral height))+			        [(0,0), (1.0,0), (1.0,1.0), (0,1.0)]++		-- Disable texturing+		GL.texture GL.Texture2D $= GL.Disabled+ 	Pictures ps-	 -> mapM_ drawPicture ps+	 -> mapM_ (drawPicture circScale) ps 	  -- Utils ------------------------------------------------------------------------------------------

@@ -1,4 +1,4 @@-Copyright (c) 2010 Benjamin Lippmeier +Copyright (c) 2010-2011 Benjamin Lippmeier    Permission is hereby granted, free of charge, to any person  obtaining a copy of this software and associated documentation

@@ -1,5 +1,5 @@ Name:                gloss-Version:             1.2.0.1+Version:             1.3.0.1 License:             MIT License-file:        LICENSE Author:              Ben Lippmeier@@ -25,6 +25,7 @@         base       == 4.*,         ghc-prim   == 0.2.*,         containers >= 0.3.0 && < 0.5.0,+        bytestring == 0.9.*,         OpenGL     == 2.4.*,         GLUT       == 2.2.* @@ -66,6 +67,7 @@         Graphics.Gloss.Internals.Interface.ViewPort.Motion         Graphics.Gloss.Internals.Interface.ViewPort.Reshape         Graphics.Gloss.Internals.Interface.Window+        Graphics.Gloss.Internals.Render.Bitmap         Graphics.Gloss.Internals.Render.Circle         Graphics.Gloss.Internals.Render.Common         Graphics.Gloss.Internals.Render.Options