not-gloss 0.7.4.0 → 0.7.5.0

raw patch · 4 files changed

+135/−122 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• changelog.txt +3/−0
• not-gloss.cabal +1/−1
• src/Vis/Camera.hs +17/−7
• src/Vis/GlossColor.hs +114/−114

@@ -1,3 +1,6 @@+0.7.5.0:+- add z translation with middle mouse button+ 0.7.3.0: - add object models 

@@ -1,5 +1,5 @@ name:                not-gloss-version:             0.7.4.0+version:             0.7.5.0 stability:           Experimental synopsis:            Painless 3D graphics, no affiliation with gloss description:{

@@ -29,6 +29,7 @@                      , ballY :: GLint                       , leftButton :: GLint                      , rightButton :: GLint+                     , middleButton :: GLint                      }  makeCamera :: Camera0 -> Camera@@ -40,6 +41,7 @@                             , ballY = (-1)                             , leftButton = 0                             , rightButton = 0+                            , middleButton = 0                             }  setCamera :: Camera -> IO ()@@ -55,8 +57,8 @@     zc = z0 - rho'*sin(theta'*pi/180)  cameraMotion :: Camera -> Position -> Camera-cameraMotion (Camera phi0' theta0' rho0' (V3 x0 y0 z0) bx by lb rb) (Position x y) =-  Camera nextPhi nextTheta rho0' nextPos nextBallX nextBallY lb rb+cameraMotion (Camera phi0' theta0' rho0' (V3 x0 y0 z0) bx by lb rb mb) (Position x y) =+  Camera nextPhi nextTheta rho0' nextPos nextBallX nextBallY lb rb mb   where     deltaX       | bx == -1  = 0@@ -64,27 +66,32 @@     deltaY       | by == -1  = 0       | otherwise = fromIntegral (y - by)+    deltaZ+      | by == -1  = 0+      | otherwise = fromIntegral (y - by)     nextTheta'       | deltaY + theta0' >  80 =  80       | deltaY + theta0' < -80 = -80       | otherwise              = deltaY + theta0'     nextX = x0 + 0.003*rho0'*( -sin(phi0'*pi/180)*deltaX - cos(phi0'*pi/180)*deltaY)     nextY = y0 + 0.003*rho0'*(  cos(phi0'*pi/180)*deltaX - sin(phi0'*pi/180)*deltaY)+    nextZ = z0 - 0.001*rho0'*deltaZ      (nextPhi, nextTheta) = if lb == 1                            then (phi0' + deltaX, nextTheta')                            else (phi0', theta0') -    nextPos = if rb == 1-              then V3 nextX nextY z0-              else V3 x0 y0 z0+    nextPos+      | rb == 1 = V3 nextX nextY z0+      | mb == 1 = V3 x0 y0 nextZ+      | otherwise = V3 x0 y0 z0      nextBallX = x     nextBallY = y  cameraKeyboardMouse :: Camera -> Key -> KeyState -> Camera cameraKeyboardMouse camera key keyState =-  camera {rho = newRho, leftButton = lb, rightButton = rb, ballX = bx, ballY = by}+  camera {rho = newRho, leftButton = lb, rightButton = rb, middleButton = mb, ballX = bx, ballY = by}   where     (lb, reset0) = case (key, keyState) of (MouseButton LeftButton, Down) -> (1, True)                                            (MouseButton LeftButton, Up) -> (0, False)@@ -92,8 +99,11 @@     (rb, reset1) = case (key, keyState) of (MouseButton RightButton, Down) -> (1, True)                                            (MouseButton RightButton, Up) -> (0, False)                                            _ -> (rightButton camera, False)+    (mb, reset2) = case (key, keyState) of (MouseButton MiddleButton, Down) -> (1, True)+                                           (MouseButton MiddleButton, Up) -> (0, False)+                                           _ -> (middleButton camera, False)   -    (bx,by) = if reset0 || reset1 then (-1,-1) else (ballX camera, ballY camera)+    (bx,by) = if reset0 || reset1 || reset2 then (-1,-1) else (ballX camera, ballY camera)        newRho = case (key, keyState) of (MouseButton WheelUp, Down)   -> 0.9 * (rho camera)                                      (MouseButton WheelDown, Down) -> 1.1 * (rho camera)

@@ -1,5 +1,5 @@--- Copyright (c) 2010-2012 Benjamin Lippmeier --- +-- Copyright (c) 2010-2012 Benjamin Lippmeier+-- --  Permission is hereby granted, free of charge, to any person --  obtaining a copy of this software and associated documentation --  files (the "Software"), to deal in the Software without@@ -8,7 +8,7 @@ --  copies of the Software, and to permit persons to whom the --  Software is furnished to do so, subject to the following --  condition:--- +-- --  The above copyright notice and this permission notice shall be --  included in all copies or substantial portions of the Software. @@ -16,40 +16,40 @@  -- | Predefined and custom colors. module Vis.GlossColor-	( -	-- ** Color data type-	  Color-	, makeColor+        (+        -- ** Color data type+          Color+        , makeColor         , makeColor'         , makeColor8-	, rawColor-	, rgbaOfColor+        , rawColor+        , rgbaOfColor -	-- ** Color functions-	, mixColors-	, addColors-	, dim,   bright-	, light, dark+        -- ** Color functions+        , mixColors+        , addColors+        , dim,   bright+        , light, dark -	-- ** Pre-defined colors-	, greyN,  black,  white-	-- *** Primary-	, red,    green,  blue-	-- *** Secondary-	, yellow,     cyan,       magenta-	-	-- *** Tertiary-	, rose,   violet, azure, aquamarine, chartreuse, orange-	)+        -- ** Pre-defined colors+        , greyN,  black,  white+        -- *** Primary+        , red,    green,  blue+        -- *** Secondary+        , yellow,     cyan,       magenta++        -- *** Tertiary+        , rose,   violet, azure, aquamarine, chartreuse, orange+        ) where  -- | An abstract color value.---	We keep the type abstract so we can be sure that the components---	are in the required range. To make a custom color use 'makeColor'.+--      We keep the type abstract so we can be sure that the components+--      are in the required range. To make a custom color use 'makeColor'. data Color-	-- | Holds the color components. All components lie in the range [0..1.-	= RGBA  !Float !Float !Float !Float-	deriving (Show, Eq)+        -- | Holds the color components. All components lie in the range [0..1.+        = RGBA  !Float !Float !Float !Float+        deriving (Show, Eq)   instance Num Color where@@ -72,7 +72,7 @@  {-# INLINE signum #-}  signum (RGBA r1 g1 b1 _)         = RGBA (signum r1) (signum g1) (signum b1) 1-        +  {-# INLINE fromInteger #-}  fromInteger i   = let f = fromInteger i@@ -80,20 +80,20 @@   -- | Make a custom color. All components are clamped to the range  [0..1].-makeColor -	:: Float 	-- ^ Red component.-	-> Float 	-- ^ Green component.-	-> Float 	-- ^ Blue component.-	-> Float 	-- ^ Alpha component.-	-> Color+makeColor+        :: Float        -- ^ Red component.+        -> Float        -- ^ Green component.+        -> Float        -- ^ Blue component.+        -> Float        -- ^ Alpha component.+        -> Color  makeColor r g b a-	= clampColor -	$ RGBA r g b a+        = clampColor+        $ RGBA r g b a {-# INLINE makeColor #-}  --- | Make a custom color. +-- | Make a custom color. --   You promise that all components are clamped to the range [0..1] makeColor' :: Float -> Float -> Float -> Float -> Color makeColor' r g b a@@ -102,149 +102,149 @@   -- | Make a custom color. All components are clamped to the range [0..255].-makeColor8 -	:: Int 		-- ^ Red component.-	-> Int 		-- ^ Green component.-	-> Int 		-- ^ Blue component.-	-> Int 		-- ^ Alpha component.-	-> Color+makeColor8+        :: Int          -- ^ Red component.+        -> Int          -- ^ Green component.+        -> Int          -- ^ Blue component.+        -> Int          -- ^ Alpha component.+        -> Color  makeColor8 r g b a-	= clampColor -	$ RGBA 	(fromIntegral r / 255) -		(fromIntegral g / 255)-		(fromIntegral b / 255)-		(fromIntegral a / 255)+        = clampColor+        $ RGBA  (fromIntegral r / 255)+                (fromIntegral g / 255)+                (fromIntegral b / 255)+                (fromIntegral a / 255) {-# INLINE makeColor8 #-} -	+ -- | Take the RGBA components of a color. rgbaOfColor :: Color -> (Float, Float, Float, Float)-rgbaOfColor (RGBA r g b a)	= (r, g, b, a)+rgbaOfColor (RGBA r g b a)      = (r, g, b, a) {-# INLINE rgbaOfColor #-}-		 + -- | Make a custom color. --   Components should be in the range [0..1] but this is not checked. rawColor-	:: Float	-- ^ Red component.-	-> Float	-- ^ Green component.-	-> Float 	-- ^ Blue component.-	-> Float 	-- ^ Alpha component.-	-> Color+        :: Float        -- ^ Red component.+        -> Float        -- ^ Green component.+        -> Float        -- ^ Blue component.+        -> Float        -- ^ Alpha component.+        -> Color  rawColor = RGBA {-# INLINE rawColor #-}  --- Internal +-- Internal  -- | Clamp components of a color into the required range. clampColor :: Color -> Color clampColor cc- = let	(r, g, b, a)	= rgbaOfColor cc-   in	RGBA (min 1 r) (min 1 g) (min 1 b) (min 1 a)+ = let  (r, g, b, a)    = rgbaOfColor cc+   in   RGBA (min 1 r) (min 1 g) (min 1 b) (min 1 a)  -- | Normalise a color to the value of its largest RGB component. normaliseColor :: Color -> Color normaliseColor cc- = let	(r, g, b, a)	= rgbaOfColor cc-	m		= maximum [r, g, b]-   in	RGBA (r / m) (g / m) (b / m) a+ = let  (r, g, b, a)    = rgbaOfColor cc+        m               = maximum [r, g, b]+   in   RGBA (r / m) (g / m) (b / m) a   -- Color functions ------------------------------------------------------------  -- | Mix two colors with the given ratios.-mixColors -	:: Float 	-- ^ Ratio of first color.-	-> Float 	-- ^ Ratio of second color.-	-> Color 	-- ^ First color.-	-> Color 	-- ^ Second color.-	-> Color	-- ^ Resulting color.+mixColors+        :: Float        -- ^ Ratio of first color.+        -> Float        -- ^ Ratio of second color.+        -> Color        -- ^ First color.+        -> Color        -- ^ Second color.+        -> Color        -- ^ Resulting color.  mixColors ratio1 ratio2 c1 c2- = let	RGBA r1 g1 b1 a1	= c1-	RGBA r2 g2 b2 a2	= c2+ = let  RGBA r1 g1 b1 a1        = c1+        RGBA r2 g2 b2 a2        = c2 -	total	= ratio1 + ratio2-	m1	= ratio1 / total-	m2	= ratio2 / total+        total   = ratio1 + ratio2+        m1      = ratio1 / total+        m2      = ratio2 / total -   in	RGBA 	(m1 * r1 + m2 * r2)-		(m1 * g1 + m2 * g2)-		(m1 * b1 + m2 * b2)-		(m1 * a1 + m2 * a2)+   in   RGBA    (m1 * r1 + m2 * r2)+                (m1 * g1 + m2 * g2)+                (m1 * b1 + m2 * b2)+                (m1 * a1 + m2 * a2)   -- | Add RGB components of a color component-wise, then normalise---	them to the highest resulting one. The alpha components are averaged.+--      them to the highest resulting one. The alpha components are averaged. addColors :: Color -> Color -> Color addColors c1 c2- = let	RGBA r1 g1 b1 a1	= c1-	RGBA r2 g2 b2 a2	= c2+ = let  RGBA r1 g1 b1 a1        = c1+        RGBA r2 g2 b2 a2        = c2 -   in	normaliseColor -	 $ RGBA (r1 + r2)-		(g1 + g2)-		(b1 + b2)-		((a1 + a2) / 2)+   in   normaliseColor+         $ RGBA (r1 + r2)+                (g1 + g2)+                (b1 + b2)+                ((a1 + a2) / 2)   -- | Make a dimmer version of a color, scaling towards black. dim :: Color -> Color dim (RGBA r g b a)-	= RGBA (r / 1.2) (g / 1.2) (b / 1.2) a+        = RGBA (r / 1.2) (g / 1.2) (b / 1.2) a -	+ -- | Make a brighter version of a color, scaling towards white. bright :: Color -> Color bright (RGBA r g b a)-	= clampColor-	$ RGBA (r * 1.2) (g * 1.2) (b * 1.2) a+        = clampColor+        $ RGBA (r * 1.2) (g * 1.2) (b * 1.2) a   -- | Lighten a color, adding white. light :: Color -> Color light (RGBA r g b a)-	= clampColor-	$ RGBA (r + 0.2) (g + 0.2) (b + 0.2) a-	-	+        = clampColor+        $ RGBA (r + 0.2) (g + 0.2) (b + 0.2) a++ -- | Darken a color, adding black. dark :: Color -> Color dark (RGBA r g b a)-	= clampColor-	$ RGBA (r - 0.2) (g - 0.2) (b - 0.2) a+        = clampColor+        $ RGBA (r - 0.2) (g - 0.2) (b - 0.2) a   -- Pre-defined Colors --------------------------------------------------------- -- | A greyness of a given magnitude.-greyN 	:: Float 	-- ^ Range is 0 = black, to 1 = white.-	-> Color-greyN n		= RGBA n   n   n   1.0+greyN   :: Float        -- ^ Range is 0 = black, to 1 = white.+        -> Color+greyN n         = RGBA n   n   n   1.0  black, white :: Color-black		= RGBA 0.0 0.0 0.0 1.0-white		= RGBA 1.0 1.0 1.0 1.0+black           = RGBA 0.0 0.0 0.0 1.0+white           = RGBA 1.0 1.0 1.0 1.0  -- Colors from the additive color wheel. red, green, blue :: Color-red		= RGBA 1.0 0.0 0.0 1.0-green		= RGBA 0.0 1.0 0.0 1.0-blue		= RGBA 0.0 0.0 1.0 1.0+red             = RGBA 1.0 0.0 0.0 1.0+green           = RGBA 0.0 1.0 0.0 1.0+blue            = RGBA 0.0 0.0 1.0 1.0  -- secondary yellow, cyan, magenta :: Color-yellow		= addColors red   green-cyan		= addColors green blue-magenta		= addColors red   blue+yellow          = addColors red   green+cyan            = addColors green blue+magenta         = addColors red   blue  -- tertiary rose, violet, azure, aquamarine, chartreuse, orange :: Color-rose		= addColors red     magenta-violet		= addColors magenta blue-azure		= addColors blue    cyan-aquamarine	= addColors cyan    green-chartreuse	= addColors green   yellow-orange		= addColors yellow  red+rose            = addColors red     magenta+violet          = addColors magenta blue+azure           = addColors blue    cyan+aquamarine      = addColors cyan    green+chartreuse      = addColors green   yellow+orange          = addColors yellow  red