Using OpenGL’s blending to visualize congestion in convex routing (in Haskell)

This is a question posed in my randomized algorithms class. If you are routing in a network whose connectivity looks "more or less" like a convex figure, what does the congestion look like? A quick way to make an educated guess is to draw a bunch of random line segments in such a convex shape and see where the colors get the brightest:



This post is literate Haskell that will output that image, so save it to something like Congestion.lhs and run ghc --make Congestion.lhs. I started with the code from an old post and cut out the bits I didn’t need. The libraries used can be found here:

First, there is the usual administrivia.

> import Data.IORef
> import Data.List
> import Graphics.Rendering.OpenGL as GL hiding (map2)
> import Graphics.UI.Gtk as Gtk hiding (drawSegments, Color)
> import Graphics.UI.Gtk.OpenGL
> import System.Random

Any proper Haskell programmer will of course want to create an infinite list of random segments,

> type Point3 = Vertex3 GLfloat
> randomPoints :: IO [Point3]
> randomPoints = do
>   xgen <- newStdGen
>   ygen <- newStdGen
>   let xs = randomRs (-0.9,0.9) xgen
>   let ys = randomRs (-0.9,0.9) ygen
>   return $ map2 (\x y -> Vertex3 x y 0) xs ys
>     where  map2 f first second = map (uncurry f) (zip first second)

Then renderSegments is straightforward. I draw them very faint gray so that only in locations of congestion do we see brighter white.

> renderSegments :: [(Point3,Point3)] -> IO ()
> renderSegments segments = do
>   clear [ColorBuffer]
>   color3f (Color3 0.05 0.05 0.05)
>   mapM_ renderSegment segments
>     where
>     color3f = color :: Color3 GLfloat -> IO ()
>     renderSegment (start, end) = renderPrimitive LineStrip $ do vertex start
>                                                                 vertex end

There are a bunch of Gtk and OpenGL calls to add, yielding drawSegments below. The only thing to note is the setting of blendFunc and blendAdd which tell OpenGL to add the color that is already on a pixel to the color I’m trying to draw. It is really a cheap trick to get OpenGL to intersect my line segments and add up the totals for me. One gotcha that held me up is that these settings have to be within the glDrawableGLBegin and glDrawableGLEnd calls.

> drawSegments :: GLDrawingArea -> [(Point3,Point3)] -> IO Bool
> drawSegments canvas segments = do
>   -- This is all Gtk code, managing the internal structures
>   glContext <- glDrawingAreaGetGLContext canvas
>   glWin <- glDrawingAreaGetGLWindow canvas
>   (w,h) <- glDrawableGetSize glWin
>   glDrawableGLBegin glWin glContext
>   (pos, _) <- GL.get viewport
>   viewport $= (pos, Size (fromIntegral w) (fromIntegral h))
>   blend $= Enabled
>   blendFunc $= (One, One)
>   blendEquation $= FuncAdd
>   renderSegments segments
>   GL.flush -- except this
>   glDrawableSwapBuffers glWin
>   glDrawableGLEnd glWin
>   return True

And finally we just plug it all together with even more initialization code.

> main = do
>   initGUI
>   glConfig <- glConfigNew [GLModeRGBA, GLModeDouble]
>   initGL
>   startPoints <- randomPoints
>   endPoints <- randomPoints
>   let segments = take 10000 $ zip startPoints endPoints
>   canvas  <- glDrawingAreaNew glConfig
>   onExpose canvas (\_ -> drawSegments canvas segments)
>   window <- windowNew
>   Gtk.set window [ containerBorderWidth := 10,
>                    containerChild := canvas ]
>   onDestroy window mainQuit
>   widgetShowAll window
>   mainGUI

Leave a Reply

Fill in your details below or click an icon to log in: Logo

You are commenting using your account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s

%d bloggers like this: