FieldTrip-0.2: examples/src/Perf.hs

{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -Wall #-}
----------------------------------------------------------------------
-- |
-- Module      :  Perf
-- Copyright   :  (c) Andy J Gill and Conal Elliott 2008
-- License     :  BSD3
-- 
-- Maintainer  :  conal@conal.net
-- Stability   :  experimental
-- 
-- Try get peformance better
----------------------------------------------------------------------

-- module Test where

-- import Data.Monoid
-- import Control.Applicative

import Graphics.Rendering.OpenGL (Color)
-- import Graphics.FieldTrip.Glut 

-- import Data.Derivative ((:>))

import Graphics.FieldTrip.Misc
-- import Graphics.FieldTrip.Geometry2
import Graphics.FieldTrip.Geometry3
-- import Graphics.FieldTrip.Transform
-- import Graphics.FieldTrip.Transform3
import Graphics.FieldTrip.Vector2
import Graphics.FieldTrip.Vector3
import Graphics.FieldTrip.Color
import Graphics.FieldTrip.Image
-- import Graphics.FieldTrip.Render

import qualified Graphics.FieldTrip.ParamSurf as P
import Graphics.FieldTrip.ParamSurf hiding (torus)

-- import Data.Behavior
-- import Data.Reactive

import Data.VectorSpace
import Data.MemoTrie
-- import System.Environment	
-- import Data.Cross
-- import Debug.Trace

import Graphics.FieldTrip.Normal3
import System.Time
import Data.Derivative
import Data.IORef
import System.IO.Unsafe

torusCrate :: Geometry3
torusCrate = colorG blue $ surfG fun

main :: IO ()
main = do
        () <- return () -- stops the rest from being a CAF

	writeIORef counterVar 0

	let fun2 :: Vector2 R -> VN3 R
            fun2 v = vsurf fun v
	let sz       = 49
            numVerts = sqr (succ sz)

	putStrLn ("Test: " ++ show numVerts ++ " vertices")

	clock <- newClock
        -- getClockTime >>= print

	sequence_ [ p `seq` n `seq` return ()
                  | x <- map (/sz) [0..sz]
		  , y <- map (/sz) [0..sz]
		  , let VN p n = fun2 (Vector2 x y) ]
	-- getClockTime >>= print
        t <- clock
        putStrLn $ show t ++ " seconds.  " ++
                   show (numVerts / t) ++ " vertices per second."

        count <- readIORef counterVar

	putStrLn $ "Count == " ++ show count
        putStrLn $ "Count/vertex == " ++ show (fromIntegral count / numVerts)

-- A provider of relative time
type Clock = IO R

newClock :: IO Clock
newClock = currRelTime `fmap` getClockTime

-- Get the current time in seconds, relative to a start 'ClockTime'.
currRelTime :: ClockTime -> IO R
currRelTime (TOD sec0 pico0) = fmap delta getClockTime
 where
   delta (TOD sec pico) =
     fromIntegral (sec-sec0) + 1.0e-12 * fromIntegral (pico-pico0)


sqr :: Num a => a -> a
sqr a = a * a

fun :: Surf (Vector2 R :> R)
fun v = 0 ^/ magnitude r1
  where
    r1 = unvector3D (normalV (vector3D (tt v)))

tt :: Surf (Vector2 R :> R)
tt = P.torus 1 (1/2)

normalV :: Vector2 R :> Vector3 R -> Vector2 R :> Vector3 R
normalV v = d (Left ()) `cross3` d (Right ())
   where
     d = untrie (derivative v)

	-- vector3F :: Three (Vector2 R :> R) -> Vector2 R :> Vector3 R
	-- vector3F (u,v,w) = liftA3 Vector3 u v w

	-- unvector3F :: Vector2 R :> Vector3 R -> Three (Vector2 R :> R)
	-- unvector3F d = (vector3x <$> d, vector3y <$> d, vector3z <$> d)


cross3X :: (Vector2 R :> Vector3 R) -> (Vector2 R :> Vector3 R) -> Vector2 R :> Vector3 R
cross3X = distrib cross3X'

-- when i replaced the recursive cross3X with (^+^), the cross3X per
-- vertex drops from 73 to 1.  but the running time stays about the same.

cross3X' :: Vector3 R -> Vector3 R -> Vector3 R
Vector3 ax ay az `cross3X'` Vector3 bx by bz = counter $
	    Vector3 (ay * bz - az * by)
	            (az * bx - ax * bz)
	            (ax * by - ay * bx)


--	let v = P.torus 1 (1/2) xy
--	((fmap (\ v -> v ^+^ (0 *^ normal v)) tt)) xy
--             displace (P.torus 1 (1/2)) (\ (_,_) -> 0) -- (stretchH eggcrateH)

--tt = P.torus 1 (1/2)
--tt = \ (u,v) -> (u,v,u*v)
--tt = revolve (const (1,0) ^+^ (1/2) *^ liftA2 (,) cosU sinU)

testH :: HeightField (Vector2 R :> R) -> Geometry3
testH = surfG . hfSurf . stretchH

testH' :: Color c => Image c -> HeightField (Vector2 R :> R) -> Geometry3
testH' im = flip surfG' im . hfSurf . stretchH

stretchH :: Fractional s => HeightField s -> HeightField s
stretchH hf = (/ 5) . hf . (* 5)

ptor :: Color c => Image c -> Geometry3
ptor = surfG' (P.torus 1 (1/2))

groovy :: ImageC
groovy (s,t) =
  rgba (sinU (3*s+5*t)) (cosU (5*t-3*s)) (sinU (3*s+5*t)) ((1+sinU (5*s*t) / 2))

redTorus, greenCyl :: Geometry3
redTorus = colorG red   $ torus 1 (1/2)
greenCyl = colorG green $ cylinder (1/3) 3


{-# NOINLINE counterVar #-}
counterVar :: IORef Int
counterVar = unsafePerformIO $ newIORef 0

{-# NOINLINE counter #-}
counter :: a -> a
counter a = unsafePerformIO $ do
		val <- readIORef counterVar
		writeIORef counterVar $! succ val
		return $ a