diff --git a/changelog.txt b/changelog.txt --- a/changelog.txt +++ b/changelog.txt @@ -1,3 +1,6 @@ +0.7.5.0: +- add z translation with middle mouse button + 0.7.3.0: - add object models diff --git a/not-gloss.cabal b/not-gloss.cabal --- a/not-gloss.cabal +++ b/not-gloss.cabal @@ -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:{ diff --git a/src/Vis/Camera.hs b/src/Vis/Camera.hs --- a/src/Vis/Camera.hs +++ b/src/Vis/Camera.hs @@ -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) diff --git a/src/Vis/GlossColor.hs b/src/Vis/GlossColor.hs --- a/src/Vis/GlossColor.hs +++ b/src/Vis/GlossColor.hs @@ -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