gearbox 1.0.0.4 → 1.0.0.5
raw patch · 2 files changed
+50/−50 lines, 2 filesdep ~OpenGLRaw
Dependency ranges changed: OpenGLRaw
Files
- GearBox.hs +43/−43
- gearbox.cabal +7/−7
GearBox.hs view
@@ -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
gearbox.cabal view
@@ -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: .- * <http://mathr.co.uk/blog/2012-01-12_gearbox.html>+ * <https://mathr.co.uk/blog/2012-01-12_gearbox.html> -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