mandulia-0.4: src/Julia.hs

{-# LANGUAGE ForeignFunctionInterface #-}
{-
Mandulia -- Mandelbrot/Julia explorer
Copyright (C) 2010  Claude Heiland-Allen <claudiusmaximus@goto10.org>

This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>.
-}

module Julia(Julia(..), score, JuliaJob(..), juliaWorker) where

import Control.Monad (forever)
import Foreign.Ptr (Ptr)
import Foreign.C.Types

import Graphics.UI.GLUT

import Image
import JobQueue
import ResourcePool
import StatsLogger(time, Logger)
import Utils

data Julia =
  Julia
    { jId    :: Integer
    , jLevel :: Int
    , jCX    :: Double
    , jCY    :: Double
    }
  deriving (Show, Read)

instance Eq Julia where
  j == k = jId j == jId k

instance Ord Julia where
  j `compare` k = jId j `compare` jId k

score :: Double -> Double -> Double -> Julia -> Double
score level cx cy j =
  let dcx = cx - jCX j
      dcy = cy - jCY j
      r2 = dcx * dcx + dcy * dcy
      dl = fromIntegral (jLevel j) - level
  in  sqrt r2 * phi ** dl
  -- see also: Poincaré half-plane distance metric
  -- 2 * atanh ( magnitude (z1 - z2) / magnitude (z1 - conjugate z2) )
  -- http://en.wikipedia.org/wiki/Poincar%C3%A9_metric
  -- #Metric_and_volume_element_on_the_Poincar.C3.A9_plane

data JuliaJob =
  JuliaJob
    { jCoords :: Julia
    , jDoneAction :: Maybe (Either (Julia, TextureObject) (Julia, (IO TextureObject, IO ())))
    }

instance Eq JuliaJob where
  j == k = jCoords j == jCoords k

foreign import ccall safe "rjulia.h julia_new"
  c_juliaNew    :: CInt -> CInt -> IO (Ptr ())

{-
foreign import ccall safe "rjulia.h julia_delete"
  c_juliaDelete :: Ptr () -> IO ()
-}

foreign import ccall safe "rjulia.h julia"
  c_julia       :: Ptr () -> Ptr () -> CDouble -> CDouble -> IO ()

juliaWorker :: Logger -> Int -> Int -> ResourcePool Image -> JobQueue JuliaJob -> IO ()
juliaWorker logStats w h is js = do
  c <- c_juliaNew (fromIntegral w) (fromIntegral h)
  forever $ do
    i <- acquire is
    withJob js $ \j -> do
      (dtC,_) <- time $ c_julia c (iBuffer i) (realToFrac . jCX . jCoords $ j) (realToFrac . jCY . jCoords $ j)
      logStats "compute" dtC
      return j
        { jDoneAction = Just . Right $ (jCoords j, 
            ( do
                t <- upload i
                release is i
                return t
            , release is i
            ) )
        }