Alp Mestanogullari's Blog

Playing around Control.Concurrent and Network.Curl.Download

Posted in Uncategorized by alpmestan on 2009/09/27

Hi,

I’ve been playing with Control.Concurrent and Network.Curl.Download today, willing to write a program that would spawn threads to download web pages… It’s now done !

Here is the Haskell code, minimally commented (I think the Control.Concurrent doc is enough explicit, and my explanations wouldn’t be better).

module Main where

import Control.Concurrent -- multithreading related functions and types
import Control.Exception
import Network.Curl.Download -- HTTP page download related functions and types
import System.IO
import System.Time

-- like it is said on 
-- http://www.haskell.org/ghc/docs/latest/html/libraries/base/Control-Concurrent.html
-- it lets you block the main thread until all the children terminates     
waitForChildren :: MVar [MVar ()] -> IO ()
waitForChildren children = do
  cs  return ()
    m:ms -> do
       putMVar children ms
       takeMVar m
       waitForChildren children

-- creates a new thread within the thread syncrhonization mechanism
forkChild :: MVar [MVar ()] -> IO () -> IO ThreadId
forkChild children io = do
    mvar <- newEmptyMVar
    childs <- takeMVar children
    putMVar children (mvar:childs)
    forkIO (io `finally` putMVar mvar ())

-- downloads the content of the web page and then saves it into a file in the current directory
doDl url = do
  Right content <- openURIString url
  let filename = (takeWhile (/= '/') . drop 7 $ url) ++ ".html"
  writeFile filename content
     
-- spawns 8 threads to download the corresponding web pages and then waits for the 8 threads to terminate before exiting
main = do
  children <- newMVar []
  mapM_ (forkChild children . doDl) ["http://www.haskell.org/", "http://java.sun.com/", "http://www.developpez.com/", "http://xkcd.com/", "http://donsbot.wordpress.com", "http://comonad.com/reader/", "http://blog.mestan.fr/", "http://alpmestan.wordpress.com/"]       
  waitForChildren children

Now, let’s compile it :

ghc -threaded --make Main.hs -o hsmultidl

and execute it, with the -N2 option (2 cores on my computer here) to the RunTime System, and RTS informations (-s option) :

$ time ./hsmultidl +RTS -N2 -s
./hsmultidl +RTS -N2 -s 
      11,470,748 bytes allocated in the heap
      11,930,464 bytes copied during GC
       1,726,380 bytes maximum residency (4 sample(s))
          85,004 bytes maximum slop
               5 MB total memory in use (0 MB lost due to fragmentation)

  Generation 0:    17 collections,     0 parallel,  0.02s,  0.03s elapsed
  Generation 1:     4 collections,     1 parallel,  0.02s,  0.06s elapsed

  Parallel GC work balance: 1.00 (155513 / 155242, ideal 2)

  Task  0 (worker) :  MUT time:   0.00s  (  0.00s elapsed)
                      GC  time:   0.00s  (  0.00s elapsed)

  Task  1 (worker) :  MUT time:   0.00s  (  0.00s elapsed)
                      GC  time:   0.00s  (  0.00s elapsed)

  Task  2 (worker) :  MUT time:   0.00s  (  1.60s elapsed)
                      GC  time:   0.00s  (  0.05s elapsed)

  Task  3 (worker) :  MUT time:   0.01s  (  1.60s elapsed)
                      GC  time:   0.02s  (  0.02s elapsed)

  Task  4 (worker) :  MUT time:   0.00s  (  1.62s elapsed)
                      GC  time:   0.00s  (  0.00s elapsed)

  Task  5 (worker) :  MUT time:   0.00s  (  1.62s elapsed)
                      GC  time:   0.00s  (  0.00s elapsed)

  Task  6 (worker) :  MUT time:   0.00s  (  1.62s elapsed)
                      GC  time:   0.01s  (  0.01s elapsed)

  Task  7 (worker) :  MUT time:   0.00s  (  1.61s elapsed)
                      GC  time:   0.00s  (  0.00s elapsed)

  Task  8 (worker) :  MUT time:   0.01s  (  1.61s elapsed)
                      GC  time:   0.00s  (  0.01s elapsed)

  Task  9 (worker) :  MUT time:   0.00s  (  1.62s elapsed)
                      GC  time:   0.00s  (  0.00s elapsed)

  Task 10 (worker) :  MUT time:   0.00s  (  1.61s elapsed)
                      GC  time:   0.00s  (  0.00s elapsed)

  Task 11 (worker) :  MUT time:   0.00s  (  1.61s elapsed)
                      GC  time:   0.00s  (  0.00s elapsed)

  Task 12 (worker) :  MUT time:   0.00s  (  1.61s elapsed)
                      GC  time:   0.00s  (  0.00s elapsed)

  Task 13 (worker) :  MUT time:   0.00s  (  1.61s elapsed)
                      GC  time:   0.00s  (  0.00s elapsed)

  INIT  time    0.00s  (  0.00s elapsed)
  MUT   time    0.02s  (  1.61s elapsed)
  GC    time    0.04s  (  0.09s elapsed)
  EXIT  time    0.00s  (  0.01s elapsed)
  Total time    0.05s  (  1.71s elapsed)

  %GC time      80.0%  (5.4% elapsed)

  Alloc rate    1,147,304,260 bytes per MUT second

  Productivity  13.3% of total user, 0.4% of total elapsed

recordMutableGen_sync: 0
gc_alloc_block_sync: 0
whitehole_spin: 0
gen[0].steps[0].sync_todo: 0
gen[0].steps[0].sync_large_objects: 0
gen[0].steps[1].sync_todo: 0
gen[0].steps[1].sync_large_objects: 0
gen[1].steps[0].sync_todo: 0
gen[1].steps[0].sync_large_objects: 0

real	0m1.714s
user	0m0.050s
sys	0m0.037s

(there isn’t a significant difference whether I activate the -N2 option or not, for 8 pages, but I guess there would be for 100, 1000, … — maybe more on that soon !)

I’m now wondering if it would be that much insane to use my 3D Text Rendering application to render the HTML code of the pages in a 3D OpenGL/GLUT context. Would it ? :)

Tagged with: ,

3D Text Rendering in Haskell with FTGL

Posted in Uncategorized by alpmestan on 2009/09/27

Hi,

While I was writing a sort of password manager for my personal use (in Haskell) — actually, a friend of mine was doing the same in Java, so there was some competition :-) — I decided that just printing the password in the terminal wasn’t enough, at all. That’s why I decided to look at how it was possible to render text easily inside an OpenGL context, with possibly some depth given to each letter.

You know what ? Nearly like every time you look for some library in Haskell, you find it ! Mine was ftgl. You can, with only few lines, while in an OpenGL context, create some 3D text from given text and (TrueType) font and render it.

Since it is really easy to get working, here’s a little howto.

- be sure to have libftgl (the C version of the library), glut (often freeglut3 in distro repositories) and opengl correctly installed.
– be sure to have the Haskell OpenGL binding installed, and also GLUT (thus we can get a working 3D context in a (GLUT) window quite easily).
– get the Haskell binding of FTGL from hackage using cabal : cabal install ftgl.

Then you can try to play around the following code, that you may want to compile with ghc –make hs3dtext.hs -o hs3dtext.

module Main where

import Data.List
import Data.IORef
import Graphics.Rendering.OpenGL
import Graphics.Rendering.FTGL
import Graphics.UI.GLUT
import System.IO

main :: IO ()
main = do
  (_, _) <- getArgsAndInitialize
  initialDisplayMode $= [DoubleBuffered]
  createWindow "3D Text Renderer"
  angle <- newIORef 0.0
  font <- createExtrudeFont "FreeSans.ttf"
  setFontFaceSize font 7 7
  setFontDepth font 1.0
  displayCallback $= display "Haskell" angle font
  idleCallback $= Just (animate angle)
  mainLoop

display text angle font = do
  clear [ColorBuffer]
  loadIdentity
  scale 0.04 0.05 (0.5 :: GLfloat)
  a > 179 of
    True  -> angle $= -180
    False -> angle $= a + 0.03
  postRedisplay Nothing

Don’t forget to get FreeSans.ttf from anywhere for it to work. The depth of the letters here is 1.0, you can play with it, but it doesn’t look as well as it does like I pasted.

Here is a cool screenshot :-)

Screen

Enjoy !

Tagged with: ,
Follow

Get every new post delivered to your Inbox.

Join 251 other followers