diff --git a/GearBox.hs b/GearBox.hs --- a/GearBox.hs +++ b/GearBox.hs @@ -30,7 +30,7 @@ , swapBuffers , fullScreenToggle ) -import Graphics.Rendering.OpenGL.Raw +import Graphics.GL import System.Exit (exitSuccess) -- 4x4 matrix type @@ -94,7 +94,7 @@ -- draw a textured quad unitQuad :: IO () unitQuad = do - glBegin gl_QUADS + glBegin GL_QUADS glTexCoord2f 0 0 glVertex2f (-1) (-1) glTexCoord2f 1 0 @@ -149,21 +149,21 @@ ] -- iterated function system from gear to gears glViewport 0 0 (fromIntegral $ w_tsize ifs) (fromIntegral $ w_tsize ifs) - glMatrixMode gl_PROJECTION + glMatrixMode GL_PROJECTION glLoadIdentity glOrtho (-1) 1 (-1) 1 (-1) 1 - glMatrixMode gl_MODELVIEW + glMatrixMode GL_MODELVIEW glLoadIdentity - glBindFramebuffer gl_FRAMEBUFFER (fbo ifs) + glBindFramebuffer GL_FRAMEBUFFER (fbo ifs) glUseProgram (fromIntegral $ p_shift ifs) glUniform1i (p_shift_u_t ifs) 0 to <- fmap last $ forM (take passes . ((True, (t_source ifs, t_ping ifs)) :) . zip (repeat False) $ (iterate swap (t_ping ifs, t_pong ifs))) $ \(pass1, (ping, pong)) -> do - glBindTexture gl_TEXTURE_2D ping - glGenerateMipmap gl_TEXTURE_2D - glFramebufferTexture2D gl_FRAMEBUFFER gl_COLOR_ATTACHMENT0 gl_TEXTURE_2D pong 0 - glClear (fromIntegral gl_COLOR_BUFFER_BIT) + glBindTexture GL_TEXTURE_2D ping + glGenerateMipmap GL_TEXTURE_2D + glFramebufferTexture2D GL_FRAMEBUFFER GL_COLOR_ATTACHMENT0 GL_TEXTURE_2D pong 0 + glClear (fromIntegral GL_COLOR_BUFFER_BIT) forM_ ([0 .. 6 :: Int] `zip` transforms) $ \(w, m) -> do let sk = case w of 0 -> 0 @@ -172,30 +172,30 @@ glUniform1f (p_shift_u_k ifs) sk loadMatrix $ (if pass1 && not k then rotateXY (pi / 30) else identity) <> m unitQuad - glBindTexture gl_TEXTURE_2D 0 - glFramebufferTexture2D gl_FRAMEBUFFER gl_COLOR_ATTACHMENT0 gl_TEXTURE_2D 0 0 + glBindTexture GL_TEXTURE_2D 0 + glFramebufferTexture2D GL_FRAMEBUFFER GL_COLOR_ATTACHMENT0 GL_TEXTURE_2D 0 0 return pong glUseProgram 0 - glBindFramebuffer gl_FRAMEBUFFER 0 + glBindFramebuffer GL_FRAMEBUFFER 0 -- display the output scaled to the window let w = fromIntegral $ w_width ifs h = fromIntegral $ w_height ifs glViewport 0 0 w h - glClear (fromIntegral gl_COLOR_BUFFER_BIT) - glMatrixMode gl_PROJECTION + glClear (fromIntegral GL_COLOR_BUFFER_BIT) + glMatrixMode GL_PROJECTION glLoadIdentity let (ax, ay) | w >= h = (1, fromIntegral h / fromIntegral w) | otherwise = (fromIntegral w / fromIntegral h, 1) glOrtho (-ax) ax (-ay) ay (-1) 1 - glMatrixMode gl_MODELVIEW + glMatrixMode GL_MODELVIEW glLoadIdentity - glBindTexture gl_TEXTURE_2D to - glGenerateMipmap gl_TEXTURE_2D + glBindTexture GL_TEXTURE_2D to + glGenerateMipmap GL_TEXTURE_2D loadMatrix $ scale 1.5 <> scale (s ** negate ((p0 / (2 * pi)) `mod'` 1)) <> rotateXY (- 2 * p) unitQuad - glBindTexture gl_TEXTURE_2D 0 + glBindTexture GL_TEXTURE_2D 0 -- animate modifyIORef ifsR $ \ifs' -> let w_frame' = w_frame ifs' + 1 @@ -221,19 +221,19 @@ shader :: String -> IO (Either String GLuint) shader frag = do p <- glCreateProgram - f <- glCreateShader gl_FRAGMENT_SHADER + f <- glCreateShader GL_FRAGMENT_SHADER withCString frag $ \s -> with s $ \src -> do glShaderSource (fromIntegral f) 1 (castPtr src) nullPtr glCompileShader (fromIntegral f) glAttachShader p f glLinkProgram (fromIntegral p) alloca $ \sp -> do - glGetProgramiv (fromIntegral p) gl_LINK_STATUS sp + glGetProgramiv (fromIntegral p) GL_LINK_STATUS sp success <- peek sp if (success == 0) then alloca $ \lp -> do - glGetProgramiv (fromIntegral p) gl_INFO_LOG_LENGTH lp + glGetProgramiv (fromIntegral p) GL_INFO_LOG_LENGTH lp l <- peek lp poke lp 0 allocaArray (fromIntegral l) $ \lg -> do @@ -248,15 +248,15 @@ newTexture size = alloca $ \pt -> do glGenTextures 1 pt t <- peek pt - glBindTexture gl_TEXTURE_2D t + glBindTexture GL_TEXTURE_2D t let s = fromIntegral size - glTexImage2D gl_TEXTURE_2D 0 (fromIntegral gl_RGBA) s s 0 - gl_RGBA gl_UNSIGNED_BYTE (nullPtr :: Ptr GLubyte) - glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MIN_FILTER (fromIntegral gl_LINEAR_MIPMAP_LINEAR) - glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MAG_FILTER (fromIntegral gl_LINEAR) - glTexParameteri gl_TEXTURE_2D gl_TEXTURE_WRAP_S (fromIntegral gl_CLAMP_TO_EDGE) - glTexParameteri gl_TEXTURE_2D gl_TEXTURE_WRAP_T (fromIntegral gl_CLAMP_TO_EDGE) - glBindTexture gl_TEXTURE_2D 0 + glTexImage2D GL_TEXTURE_2D 0 (fromIntegral GL_RGBA) s s 0 + GL_RGBA GL_UNSIGNED_BYTE (nullPtr :: Ptr GLubyte) + glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER (fromIntegral GL_LINEAR_MIPMAP_LINEAR) + glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER (fromIntegral GL_LINEAR) + glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S (fromIntegral GL_CLAMP_TO_EDGE) + glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T (fromIntegral GL_CLAMP_TO_EDGE) + glBindTexture GL_TEXTURE_2D 0 return t -- keyboard callback @@ -284,10 +284,10 @@ p_shift_u_k' <- withCString "k" $ glGetUniformLocation p_shift' . castPtr Right p_gear' <- shader gear_frag_src -- misc setup - glHint gl_GENERATE_MIPMAP_HINT gl_NICEST - glEnable gl_TEXTURE_2D - glEnable gl_BLEND - glBlendFunc gl_SRC_ALPHA gl_ONE_MINUS_SRC_ALPHA + glHint GL_GENERATE_MIPMAP_HINT GL_NICEST + glEnable GL_TEXTURE_2D + glEnable GL_BLEND + glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA glClearColor 0.25 0.25 0.5 0 -- allocate textures [t_source', t_ping', t_pong'] <- replicateM 3 (newTexture tsize') @@ -304,22 +304,22 @@ } -- render the gear texture glViewport 0 0 (fromIntegral tsize') (fromIntegral tsize') - glMatrixMode gl_PROJECTION + glMatrixMode GL_PROJECTION glLoadIdentity glOrtho (-1) 1 (-1) 1 (-1) 1 - glMatrixMode gl_MODELVIEW + glMatrixMode GL_MODELVIEW glLoadIdentity - glBindFramebuffer gl_FRAMEBUFFER fbo' - glFramebufferTexture2D gl_FRAMEBUFFER gl_COLOR_ATTACHMENT0 gl_TEXTURE_2D t_source' 0 - glClear (fromIntegral gl_COLOR_BUFFER_BIT) + glBindFramebuffer GL_FRAMEBUFFER fbo' + glFramebufferTexture2D GL_FRAMEBUFFER GL_COLOR_ATTACHMENT0 GL_TEXTURE_2D t_source' 0 + glClear (fromIntegral GL_COLOR_BUFFER_BIT) glUseProgram (fromIntegral p_gear') unitQuad glUseProgram 0 - glFramebufferTexture2D gl_FRAMEBUFFER gl_COLOR_ATTACHMENT0 gl_TEXTURE_2D 0 0 - glBindFramebuffer gl_FRAMEBUFFER 0 - glBindTexture gl_TEXTURE_2D t_source' - glGenerateMipmap gl_TEXTURE_2D - glBindTexture gl_TEXTURE_2D 0 + glFramebufferTexture2D GL_FRAMEBUFFER GL_COLOR_ATTACHMENT0 GL_TEXTURE_2D 0 0 + glBindFramebuffer GL_FRAMEBUFFER 0 + glBindTexture GL_TEXTURE_2D t_source' + glGenerateMipmap GL_TEXTURE_2D + glBindTexture GL_TEXTURE_2D 0 -- set callbacks reshapeCallback $= Just (reshape ifsR) displayCallback $= display ifsR diff --git a/gearbox.cabal b/gearbox.cabal --- a/gearbox.cabal +++ b/gearbox.cabal @@ -1,5 +1,5 @@ Name: gearbox -Version: 1.0.0.4 +Version: 1.0.0.5 Synopsis: zooming rotating fractal gears graphics demo Description: OpenGL gearbox iterated function system. Usage: @gearbox quality@ where quality is an integer between @@ -9,9 +9,9 @@ . Blog post: . - * + * -Homepage: http://code.mathr.co.uk/gearbox +Homepage: https://code.mathr.co.uk/gearbox License: GPL-3 License-file: LICENSE Author: Claude Heiland-Allen @@ -25,15 +25,15 @@ Build-depends: base < 5, GLUT == 2.7.*, - OpenGLRaw == 2.3.*, + OpenGLRaw == 3.2.*, Vec == 1.0.* GHC-options: -Wall Source-repository head type: git - location: http://code.mathr.co.uk/gearbox.git + location: https://code.mathr.co.uk/gearbox.git Source-repository this type: git - location: http://code.mathr.co.uk/gearbox.git - tag: v1.0.0.4 + location: https://code.mathr.co.uk/gearbox.git + tag: v1.0.0.5