diff --git a/GLUT.cabal b/GLUT.cabal --- a/GLUT.cabal +++ b/GLUT.cabal @@ -1,5 +1,5 @@ name: GLUT -version: 2.2.1.0 +version: 2.2.2.0 license: BSD3 license-file: LICENSE maintainer: Sven Panne @@ -157,12 +157,12 @@ ghc-options: -Wall if os(windows) && flag(UseNativeWindowsLibraries) cpp-options: "-DCALLCONV=stdcall" - extra-libraries: glut32 cc-options: "-DUSE_GETPROCADDRESS" + extra-libraries: glut32 else cpp-options: "-DCALLCONV=ccall" - extra-libraries: glut + cc-options: "-DUSE_DLSYM" if os(darwin) - cc-options: "-DUSE_NSADDRESSOFSYMBOL" + frameworks: GLUT else - cc-options: "-DUSE_DLSYM" + extra-libraries: glut diff --git a/Graphics/UI/GLUT/Raw/Tokens.hs b/Graphics/UI/GLUT/Raw/Tokens.hs --- a/Graphics/UI/GLUT/Raw/Tokens.hs +++ b/Graphics/UI/GLUT/Raw/Tokens.hs @@ -18,7 +18,7 @@ import Foreign.C.Types import Graphics.Rendering.OpenGL ( GLenum ) -glut_ACCUM :: GLenum +glut_ACCUM :: CUInt glut_ACCUM = 0x0004 glut_ACTION_CONTINUE_EXECUTION :: CInt @@ -45,31 +45,31 @@ glut_ALLOW_DIRECT_CONTEXT :: CInt glut_ALLOW_DIRECT_CONTEXT = 1 -glut_ALPHA :: GLenum +glut_ALPHA :: CUInt glut_ALPHA = 0x0008 glut_AUX :: GLenum glut_AUX = 0x1000 -glut_AUX1 :: GLenum +glut_AUX1 :: CUInt glut_AUX1 = 0x1000 -glut_AUX2 :: GLenum +glut_AUX2 :: CUInt glut_AUX2 = 0x2000 -glut_AUX3 :: GLenum +glut_AUX3 :: CUInt glut_AUX3 = 0x4000 -glut_AUX4 :: GLenum +glut_AUX4 :: CUInt glut_AUX4 = 0x8000 glut_BLUE :: CInt glut_BLUE = 0x0002 -glut_BORDERLESS :: GLenum +glut_BORDERLESS :: CUInt glut_BORDERLESS = 0x0800 -glut_CAPTIONLESS :: GLenum +glut_CAPTIONLESS :: CUInt glut_CAPTIONLESS = 0x0400 glut_CORE_PROFILE :: CInt @@ -153,7 +153,7 @@ glut_DEBUG :: CInt glut_DEBUG = 0x0001 -glut_DEPTH :: GLenum +glut_DEPTH :: CUInt glut_DEPTH = 0x0010 glut_DEVICE_IGNORE_KEY_REPEAT :: GLenum @@ -168,7 +168,7 @@ glut_DISPLAY_MODE_POSSIBLE :: GLenum glut_DISPLAY_MODE_POSSIBLE = 0x0190 -glut_DOUBLE :: GLenum +glut_DOUBLE :: CUInt glut_DOUBLE = 0x0002 glut_DOWN :: CInt @@ -246,7 +246,7 @@ glut_HIDDEN :: CInt glut_HIDDEN = 0x0000 -glut_INDEX :: GLenum +glut_INDEX :: CUInt glut_INDEX = 0x0001 glut_INIT_DISPLAY_MODE :: GLenum @@ -285,16 +285,16 @@ glut_JOYSTICK_BUTTONS :: GLenum glut_JOYSTICK_BUTTONS = 0x0266 -glut_JOYSTICK_BUTTON_A :: GLenum +glut_JOYSTICK_BUTTON_A :: CUInt glut_JOYSTICK_BUTTON_A = 0x0001 -glut_JOYSTICK_BUTTON_B :: GLenum +glut_JOYSTICK_BUTTON_B :: CUInt glut_JOYSTICK_BUTTON_B = 0x0002 -glut_JOYSTICK_BUTTON_C :: GLenum +glut_JOYSTICK_BUTTON_C :: CUInt glut_JOYSTICK_BUTTON_C = 0x0004 -glut_JOYSTICK_BUTTON_D :: GLenum +glut_JOYSTICK_BUTTON_D :: CUInt glut_JOYSTICK_BUTTON_D = 0x0008 glut_JOYSTICK_POLL_RATE :: GLenum @@ -390,7 +390,7 @@ glut_LEFT_BUTTON :: CInt glut_LEFT_BUTTON = 0x0000 -glut_LUMINANCE :: GLenum +glut_LUMINANCE :: CUInt glut_LUMINANCE = 0x0200 glut_MENU_IN_USE :: CInt @@ -405,7 +405,7 @@ glut_MIDDLE_BUTTON :: CInt glut_MIDDLE_BUTTON = 0x0001 -glut_MULTISAMPLE :: GLenum +glut_MULTISAMPLE :: CUInt glut_MULTISAMPLE = 0x0080 glut_NORMAL :: GLenum @@ -453,10 +453,10 @@ glut_RENDERING_CONTEXT :: GLenum glut_RENDERING_CONTEXT = 0x01FD -glut_RGB :: GLenum +glut_RGB :: CUInt glut_RGB = 0x0000 -glut_RGBA :: GLenum +glut_RGBA :: CUInt glut_RGBA = 0x0000 glut_RIGHT_BUTTON :: CInt @@ -474,16 +474,16 @@ glut_SCREEN_WIDTH_MM :: GLenum glut_SCREEN_WIDTH_MM = 0x00CA -glut_SINGLE :: GLenum +glut_SINGLE :: CUInt glut_SINGLE = 0x0000 -glut_SRGB :: GLenum +glut_SRGB :: CUInt glut_SRGB = 0x1000 -glut_STENCIL :: GLenum +glut_STENCIL :: CUInt glut_STENCIL = 0x0020 -glut_STEREO :: GLenum +glut_STEREO :: CUInt glut_STEREO = 0x0100 glut_TRANSPARENT_INDEX :: GLenum diff --git a/Graphics/UI/GLUT/Types.hs b/Graphics/UI/GLUT/Types.hs --- a/Graphics/UI/GLUT/Types.hs +++ b/Graphics/UI/GLUT/Types.hs @@ -76,6 +76,7 @@ | RightButton | WheelUp | WheelDown + | AdditionalButton Int deriving ( Eq, Ord, Show ) marshalMouseButton :: MouseButton -> CInt @@ -85,6 +86,7 @@ RightButton -> glut_RIGHT_BUTTON WheelUp -> glut_WHEEL_UP WheelDown -> glut_WHEEL_DOWN + AdditionalButton b -> fromIntegral b unmarshalMouseButton :: CInt -> MouseButton unmarshalMouseButton x @@ -93,7 +95,7 @@ | x == glut_RIGHT_BUTTON = RightButton | x == glut_WHEEL_UP = WheelUp | x == glut_WHEEL_DOWN = WheelDown - | otherwise = error ("unmarshalMouseButton: illegal value " ++ show x) + | otherwise = AdditionalButton (fromIntegral x) glut_WHEEL_UP :: CInt glut_WHEEL_UP = 3 diff --git a/examples/Misc/ExtractContours.hs b/examples/Misc/ExtractContours.hs --- a/examples/Misc/ExtractContours.hs +++ b/examples/Misc/ExtractContours.hs @@ -48,7 +48,7 @@ noOpCombiner :: Combiner DontCare noOpCombiner _newVertex _weightedProperties = 0 -star :: ComplexPolygon (Color3 GLclampf) +star :: ComplexPolygon (Color3 GLfloat) star = ComplexPolygon [ ComplexContour [ AnnotatedVertex (Vertex3 250 50 0) (Color3 1 0 1), @@ -57,7 +57,7 @@ AnnotatedVertex (Vertex3 250 150 0) (Color3 1 0 0), AnnotatedVertex (Vertex3 400 150 0) (Color3 0 1 0) ] ] -combineColors :: Combiner (Color3 GLclampf) +combineColors :: Combiner (Color3 GLfloat) combineColors _newVertex (WeightedProperties diff --git a/examples/OrangeBook/ogl2brick/Brick.hs b/examples/OrangeBook/ogl2brick/Brick.hs --- a/examples/OrangeBook/ogl2brick/Brick.hs +++ b/examples/OrangeBook/ogl2brick/Brick.hs @@ -5,11 +5,17 @@ See the file libraries/GLUT/LICENSE -} +import Prelude hiding ( sum ) +import Control.Applicative import Control.Monad +import Data.Foldable ( Foldable, sum ) import Data.IORef import System.Exit import Graphics.UI.GLUT +infixl 6 $+, $- +infixl 7 $* + inertiaThreshold, inertiaFactor :: GLfloat inertiaThreshold = 1 inertiaFactor = 0.5 @@ -21,7 +27,7 @@ timerFrequencyMillis :: Timeout timerFrequencyMillis = 20 -clearColors :: [Color4 GLfloat] +clearColors :: [Color4 GLclampf] clearColors = [ Color4 0.0 0.0 0.0 1, Color4 0.2 0.2 0.3 1, @@ -48,7 +54,7 @@ theScale :: IORef GLfloat, lastPosition :: IORef Position, shouldRotate :: IORef Bool, - colorCycle :: IORef [Color4 GLfloat], + colorCycle :: IORef [Color4 GLclampf], modelCycle :: IORef [IO ()], modifiers :: IORef Modifiers } @@ -56,9 +62,9 @@ makeState :: IO State makeState = do di <- newIORef initialDiff - li <- newIORef 0 + li <- newIORef (pure 0) ia <- newIORef initialInertia - io <- newIORef 0 + io <- newIORef (pure 0) sc <- newIORef 1 lp <- newIORef (Position (-1) (-1)) sr <- newIORef True @@ -78,32 +84,17 @@ modifiers = mo } -instance Num a => Num (Vector3 a) where - (Vector3 x1 y1 z1) + (Vector3 x2 y2 z2) = - Vector3 (x1 + x2) (y1 + y2) (z1 + z2) - (Vector3 x1 y1 z1) - (Vector3 x2 y2 z2) = - Vector3 (x1 - x2) (y1 - y2) (z1 - z2) - (Vector3 x1 y1 z1) * (Vector3 x2 y2 z2) = - Vector3 (x1 * x2) (y1 * y2) (z1 * z2) - negate (Vector3 x y z) = - Vector3 (negate x) (negate y) (negate z) - abs (Vector3 x y z) = - Vector3 (abs x) (abs y) (abs z) - signum (Vector3 x y z) = - Vector3 (signum x) (signum y) (signum z) - fromInteger i = - Vector3 (fromInteger i) (fromInteger i) (fromInteger i) - -fromScalar :: Num a => a -> Vector3 a -fromScalar s = Vector3 s s s +-- Our tiny vector math library... +($+), ($-), ($*) :: (Applicative t, Num a) => t a -> t a -> t a +($+) = liftA2 (+) +($-) = liftA2 (-) +($*) = liftA2 (*) -step :: (Num a, Ord a) => Vector3 a -> Vector3 a -> Vector3 a -step (Vector3 x1 y1 z1) (Vector3 x2 y2 z2) = - Vector3 (s x1 x2) (s y1 y2) (s z1 z2) - where s e x = if x < e then 0 else 1 +step :: (Applicative t, Num a, Ord a) => t a -> t a -> t a +step = liftA2 (\e x -> if x < e then 0 else 1) -dot :: Num a => Vector3 a -> Vector3 a -> a -dot (Vector3 x1 y1 z1) (Vector3 x2 y2 z2) = x1 * x2 + y1 * y2 + z1 * z2 +dot :: (Applicative t, Foldable t, Num a) => t a -> t a -> a +dot v1 v2 = sum (v1 $* v2) drawFace :: Normal3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat -> IO () @@ -208,7 +199,7 @@ resetState :: State -> IO () resetState state = do diff state $= initialDiff - lastIncr state $= 0 + lastIncr state $= pure 0 inertia state $= initialInertia theScale state $= 1 @@ -217,12 +208,12 @@ lastPosition state $= Position (-1) (-1) li <- get (lastIncr state) ia <- get (inertia state) - let t = fromScalar inertiaThreshold - f = fromScalar inertiaFactor - l = (1 - (step (-t) li)) * ((li + t) * f - ia) - r = (step t li) * ((li - t) * f - ia) - inertia state $= l + ia + r - lastIncr state $= 0 + let t = pure inertiaThreshold + f = pure inertiaFactor + l = (pure 1 $- (step (fmap negate t) li)) $* ((li $+ t) $* f $- ia) + r = (step t li) $* ((li $- t) $* f $- ia) + inertia state $= l $+ ia $+ r + lastIncr state $= pure 0 keyboard :: State -> KeyboardMouseCallback keyboard state key keyState mods _ = do @@ -238,13 +229,13 @@ (Char '-', Down) -> theScale state $~ (+ (- scaleIncrement)) (Char _, Down) -> printHelp (SpecialKey KeyHome, Down) -> resetState state - (SpecialKey KeyLeft, Down) -> diff state $~ (+ (- Vector3 1 0 0)) - (SpecialKey KeyRight, Down) -> diff state $~ (+ Vector3 1 0 0) - (SpecialKey KeyUp, Down) -> diff state $~ (+ (- Vector3 0 1 0)) - (SpecialKey KeyDown, Down) -> diff state $~ (+ Vector3 0 1 0) + (SpecialKey KeyLeft, Down) -> diff state $~ ($- Vector3 1 0 0) + (SpecialKey KeyRight, Down) -> diff state $~ ($+ Vector3 1 0 0) + (SpecialKey KeyUp, Down) -> diff state $~ ($- Vector3 0 1 0) + (SpecialKey KeyDown, Down) -> diff state $~ ($+ Vector3 0 1 0) (MouseButton LeftButton, Down) -> do - inertia state $= 0 - lastIncr state $= 0 + inertia state $= pure 0 + lastIncr state $= pure 0 (MouseButton LeftButton, Up) -> calcInertia state (_, _) -> return () @@ -259,16 +250,16 @@ when (xt /= -1) $ do mods <- get (modifiers state) if ctrl mods == Down - then do diff state $~ (+ Vector3 0 0 xl) + then do diff state $~ ($+ Vector3 0 0 xl) theScale state $~ (+ (yl * scaleFactor)) - else diff state $~ (+ li) + else diff state $~ ($+ li) timer :: State -> TimerCallback timer state = do rot <- get (shouldRotate state) when rot $ do ia <- get (inertia state) - diff state $~ (+ ia) + diff state $~ ($+ ia) postRedisplay Nothing addTimerCallback timerFrequencyMillis (timer state) diff --git a/examples/RedBook/Image.hs b/examples/RedBook/Image.hs --- a/examples/RedBook/Image.hs +++ b/examples/RedBook/Image.hs @@ -71,7 +71,7 @@ motion :: State -> MotionCallback motion state (Position x y) = do Size _ height <- get windowSize - let screenY = height - y + let screenY = fromIntegral height - y -- resolve overloading, not needed in "real" programs let rasterPos2i = rasterPos :: Vertex2 GLint -> IO () rasterPos2i (Vertex2 x screenY) diff --git a/examples/RedBook/Tess.hs b/examples/RedBook/Tess.hs --- a/examples/RedBook/Tess.hs +++ b/examples/RedBook/Tess.hs @@ -48,7 +48,7 @@ noOpCombiner :: Combiner DontCare noOpCombiner _newVertex _weightedProperties = 0 -star :: ComplexPolygon (Color3 GLclampf) +star :: ComplexPolygon (Color3 GLfloat) star = ComplexPolygon [ ComplexContour [ AnnotatedVertex (Vertex3 250 50 0) (Color3 1 0 1), @@ -57,7 +57,7 @@ AnnotatedVertex (Vertex3 250 150 0) (Color3 1 0 0), AnnotatedVertex (Vertex3 400 150 0) (Color3 0 1 0) ] ] -combineColors :: Combiner (Color3 GLclampf) +combineColors :: Combiner (Color3 GLfloat) combineColors _newVertex (WeightedProperties diff --git a/examples/RedBook/UnProject.hs b/examples/RedBook/UnProject.hs --- a/examples/RedBook/UnProject.hs +++ b/examples/RedBook/UnProject.hs @@ -31,7 +31,7 @@ v@(_, Size _ h) <- get viewport mvMatrix <- get (matrix (Just (Modelview 0))) :: IO (GLmatrix GLdouble) projMatrix <- get (matrix (Just Projection)) :: IO (GLmatrix GLdouble) - let realY = h - y -1 + let realY = fromIntegral h - y -1 putStrLn ("Coordinates at cursor are (" ++ show x ++", " ++ show realY ++ ")") w0 <- unProject (Vertex3 (fromIntegral x) (fromIntegral realY) 0) mvMatrix projMatrix v putStrLn ("World coords at z=0.0 are " ++ show w0)