
I've appended a small set of patches to make VOP compile with the current GHC from CVS. The "modifySTRef" story is already fixed in the repository, so if you are *really* on the bleeding edge, those parts from the patch can be left out. And I'm sure the Simons will work really hard on the "Stack overflow" issue... (<= hint! ;-) Apart from those tiny glitches it works really cool. If I read the output correctly, I get a few hundred FPS?! BTW, is the C(++) part really necessary for performance? A "100% Haskell" solution would impress sceptics of functional programming even more... >:-) Cheers, S. diff -u -r VOP-Source-280202-orig/src/CSGPolyhedron.lhs VOP-Source-280202/src/CSGPolyhedron.lhs --- VOP-Source-280202-orig/src/CSGPolyhedron.lhs Thu Feb 28 21:34:38 2002 +++ VOP-Source-280202/src/CSGPolyhedron.lhs Mon Mar 4 19:13:42 2002 @@ -18,6 +18,10 @@ import Geometry(GExtendedPolygons(..), GTexture(..),GPlane(..)) +-- Today's GHC lacks this... >:-( +modifySTRef :: STRef s a -> (a -> a) -> ST s () +modifySTRef ref f = readSTRef ref >>= writeSTRef ref . f + -- ***************** Polyhedra (3D) data PolygonRef = PolygonRef Int Int Int @@ -90,7 +94,7 @@ ProtoEdge er pt pt' r r' p p') [ref .. ref+n-1] (sort a) (sort b)) ) [pfirst .. plast] - lastEdgeRef <- fmap (EdgeRef . (+ -1)) $ readSTRef curRef + lastEdgeRef <- fmap (EdgeRef . (+ (-1))) $ readSTRef curRef let pInfos3 = array pbounds $ map (\(pt,edges) -> (pt,map diff -u -r VOP-Source-280202-orig/src/Camera.lhs VOP-Source-280202/src/Camera.lhs --- VOP-Source-280202-orig/src/Camera.lhs Thu Feb 28 21:34:38 2002 +++ VOP-Source-280202/src/Camera.lhs Mon Mar 4 18:35:09 2002 @@ -27,6 +27,10 @@ import MatrixInverse +-- Today's GHC lacks this... >:-( +modifySTRef :: STRef s a -> (a -> a) -> ST s () +modifySTRef ref f = readSTRef ref >>= writeSTRef ref . f + data GCamera = GCamera { gcLocation :: Vertex3 Number, gcUp :: Vector3 Number, diff -u -r VOP-Source-280202-orig/src/ExternalResource.lhs VOP-Source-280202/src/ExternalResource.lhs --- VOP-Source-280202-orig/src/ExternalResource.lhs Thu Feb 28 21:34:38 2002 +++ VOP-Source-280202/src/ExternalResource.lhs Mon Mar 4 18:05:22 2002 @@ -48,12 +48,12 @@ retainExternalResource (ExternalResource a cnt) = do - updateIORef cnt (+1) + modifyIORef cnt (+1) return a releaseExternalResource (ExternalResource a cnt) = do - updateIORef cnt (+(-1)) + modifyIORef cnt (+(-1)) unsafeReadExternalResource (ExternalResource a _) = a \end{code} diff -u -r VOP-Source-280202-orig/src/PPMonad.lhs VOP-Source-280202/src/PPMonad.lhs --- VOP-Source-280202-orig/src/PPMonad.lhs Thu Feb 28 21:34:38 2002 +++ VOP-Source-280202/src/PPMonad.lhs Mon Mar 4 19:08:37 2002 @@ -115,7 +115,7 @@ data PPResult a = PPSuccess a PPState | PPFailure PPState | PPEndCollect PPState -newtype PP a = PP (PPState -> PPResult a) +data PP a = PP (PPState -> PPResult a) dePP (PP pp) = pp ppReturn x = PP (\state -> PPSuccess x state) diff -u -r VOP-Source-280202-orig/src/RenderGeometry.lhs VOP-Source-280202/src/RenderGeometry.lhs --- VOP-Source-280202-orig/src/RenderGeometry.lhs Thu Feb 28 21:34:38 2002 +++ VOP-Source-280202/src/RenderGeometry.lhs Mon Mar 4 19:15:52 2002 @@ -29,7 +29,7 @@ import FrameCache import VOPTypes(BlockTag(..)) -- import Trace -import IOExts +-- import IOExts -- trace str a = unsafePerformIO $ do -- putStr "trace: " ++ str ++ "\n" -- return a diff -u -r VOP-Source-280202-orig/src/TreeToGeometry.lhs VOP-Source-280202/src/TreeToGeometry.lhs --- VOP-Source-280202-orig/src/TreeToGeometry.lhs Thu Feb 28 21:34:38 2002 +++ VOP-Source-280202/src/TreeToGeometry.lhs Mon Mar 4 19:16:41 2002 @@ -16,7 +16,7 @@ import VOPTypes -- import VOPDeclarations(evaluateVector) import GL hiding (Fog) -import IOExts(trace,unsafePtrEq) +-- import IOExts(trace,unsafePtrEq) import Bounding import VOPUtils import Camera