packages feed

scenegraph 0.1.0.1 → 0.1.0.2

raw patch · 44 files changed

+3/−670 lines, 44 filesdep ~basedep ~fgl

Dependency ranges changed: base, fgl

Files

− CHANGES 
@@ -1,4 +0,0 @@-Version 0.1.0.1
-
-Rename SimpleViewPort.hs to SimpleViewport
-Fix the deprecated language pragmas
− data/Snow.tga

binary file changed (1423654 → absent bytes)

− data/ankhlite_wht.tga

binary file changed (12306 → absent bytes)

− data/ankhlite_ylw.blend.tga

binary file changed (12306 → absent bytes)

− data/ankhlite_ylw.tga

binary file changed (12306 → absent bytes)

− data/bounce_effects.tga

binary file changed (196626 → absent bytes)

− data/font.tga

binary file changed (262188 → absent bytes)

− data/gold_groove.tga

binary file changed (98322 → absent bytes)

− data/gold_trim01.tga

binary file changed (49170 → absent bytes)

− data/gold_trim02.tga

binary file changed (49170 → absent bytes)

− data/gold_trim03.tga

binary file changed (6162 → absent bytes)

− data/heiro_01.tga

binary file changed (196626 → absent bytes)

− data/leaf.tga

binary file changed (49170 → absent bytes)

− data/oldbrk_01.tga

binary file changed (196626 → absent bytes)

− data/oldbrk_01broken13.tga

binary file changed (196626 → absent bytes)

− data/oldbrk_03.tga

binary file changed (196626 → absent bytes)

− data/oldbrk_03_bloody.tga

binary file changed (196626 → absent bytes)

− data/oldstone2.tga

binary file changed (196626 → absent bytes)

− data/oldstone2_bas01.tga

binary file changed (196626 → absent bytes)

− data/oldstone2_bas03.tga

binary file changed (196626 → absent bytes)

− data/oldstone2_bas04.tga

binary file changed (196626 → absent bytes)

− data/oldstone2_bas05.tga

binary file changed (196626 → absent bytes)

− data/oldstone2_bas06.tga

binary file changed (196626 → absent bytes)

− data/oldstone2_bas07.tga

binary file changed (196626 → absent bytes)

− data/oldstone2_step.tga

binary file changed (12306 → absent bytes)

− data/oldstone2_trim01.tga

binary file changed (49170 → absent bytes)

− data/oldstone2_trim02.tga

binary file changed (98322 → absent bytes)

− data/oldstone2grooved.tga

binary file changed (196626 → absent bytes)

− data/oldstone_ramses.tga

binary file changed (196626 → absent bytes)

− data/plant_egy.tga

binary file changed (49170 → absent bytes)

− data/sand_egy.tga

binary file changed (196626 → absent bytes)

− data/stei_tele2.tga

binary file changed (196626 → absent bytes)

scenegraph.cabal view
@@ -1,5 +1,5 @@ Name:           scenegraph
-Version:        0.1.0.1
+Version:        0.1.0.2
 Copyright:      Mark Wassell 2009
 License:        BSD3
 license-file:	LICENSE
@@ -8,7 +8,7 @@ Stability:	experimental
 Homepage:       http://www.haskell.org/haskellwiki/SceneGraph
 Category:       Graphics
-Build-Depends:  base,mtl,hmatrix,OpenGL>=2.2,GLUT>=2.1,haskell98,containers,fgl,array,old-time,process
+Build-Depends:  base>=3 && < 5,mtl,hmatrix,OpenGL>=2.2,GLUT>=2.1,haskell98,containers,fgl == 5.4.2.2,array,old-time,process
 build-type:	Simple
 tested-with:	GHC==6.10.1
 Synopsis:       Scene Graph
− src/Calc.hs 
@@ -1,37 +0,0 @@-module Calc where
-
-
-data Calculator = Calculator { replace :: Bool,
-                               operand :: Maybe String,
-                               operator :: Maybe String,
-                               register :: String } deriving Show
-                               
-newCalculator = Calculator True Nothing Nothing "0"
-
-
-applyCalc :: Calculator -> String -> Calculator
-applyCalc calc "+" = calc { replace=True,
-                        operand = Just (register calc),
-                        operator = Just "+" }
-applyCalc calc "=" = doCalc calc
-applyCalc calc "c" = newCalculator
-applyCalc calc "ce" = calc { replace=True, register="0" }
-applyCalc calc str = if replace calc then
-                     calc { replace=False,register=str }
-                 else
-                     calc { register = (register calc) ++ str}
-                     
-doCalc calc = let x = read $ maybe "0" id (operand calc ) 
-                  y = read $ register calc
-              in case (operator calc) of
-                    Just "+" -> calc { replace=True,register = show $ x + y,operand= Just $ show y }
-                    _ -> calc
-                        
-                        
-calcString = foldl applyCalc newCalculator 
-
-t1 = calcString [ "1", "+", "1", "=", "=", "="]
-
-t2 = calcString [ "2", "+", "5", "=","="]
-
-
− src/Example.hs 
@@ -1,29 +0,0 @@-----------------------------------------------------------------------
--- |
--- Module      :  Main
--- Copyright   :  (c) Mark Wassell 2008
--- License     :  LGPL
--- 
--- Maintainer  :  mwassell@bigpond.net.au
--- Stability   :  experimental
--- Portability :  portable
--- 
--- Example scenegraphs. See SimpleViewPort.hs for how to navigate around the
--- scene. See Library.hs for the construction of the examples
-----------------------------------------------------------------------
-module Main where
-
-import Graphics.SceneGraph
-
--- Button and 'Hello World' text.
-ex1 = runScene sceneButton 
-
-ex2 = runScene $ osgt $ cube 0.5 `colour` Green `scale` v1x 40 `translate` vy 2 <+> camera `translate` vy (-10) <+> light `translate` vz 10 
-
--- An Ancient Egyptian Calculator
-ex3 = runScene calculator
-
--- Tux the penguin
-ex4 = runScene tuxAndToys
-
-
− src/ExampleReactive.hs 
@@ -1,43 +0,0 @@-module Main where
-
-import Graphics.SceneGraph
-import Graphics.SceneGraph.Reactive
-
-import Control.Concurrent.MVar
-import Control.Monad.State
-import Control.Applicative hiding ( (<*>) )
-import Control.Concurrent (yield, forkIO, killThread, threadDelay, ThreadId,forkOS)
-
-import Data.Reactive
-import Data.IORef
-import Data.Monoid
-
-import Calc
-
-calc = runSceneReactive calculator sceneButtonReactive
-
---
--- To get at the string to display we fmap register to the calculator
---
-sceneButtonReactive :: SGM (Event Action)
-sceneButtonReactive = do
-        snk <- getNodeByLabel "txt" >>= mkText
-        ce <- calcEvent
-        return $ snk <$> (fmap register ce )
-  
--- Build a Calculator event. Build up the button events and 
--- append these events together.
-calcEvent :: SGM (Event Calculator)
-calcEvent = do 
-        btnList <- mapM mkCalcBtn ["0","1","2","3","4","5","6","7","8","9","c", "+","=" ]
-        return $ scanlE applyCalc newCalculator $ foldr mappend mempty btnList 
-
-
--- Turn passive button in the scene graph into an active one that 
--- provides an event that returns 'lbl'   
-mkCalcBtn :: [Char] -> SGM (Event String)   
-mkCalcBtn lbl = do
-          ev <- getNodeByLabel ("btn" ++ lbl) >>= mkButton
-          return $ fmap (const lbl) ev
-            
-
src/Graphics/SceneGraph/Basic.hs view
@@ -37,7 +37,7 @@ import Data.Array hiding (bounds)
 import Data.IORef
 import Data.Graph.Inductive hiding (mkNode,context)
-import Data.Sequence hiding (empty,fromList)
+import Data.Sequence hiding (empty,fromList,filter,zip)
 import Data.Tree
 import Data.List hiding (group,union)
 import qualified Data.Map as M
− src/Graphics/SceneGraph/Matrix.hs 
@@ -1,52 +0,0 @@-{-# LANGUAGE  MultiParamTypeClasses, FunctionalDependencies, 
-    TypeSynonymInstances #-}
-module Graphics.SceneGraph.Matrix where
-
--- Warning: Because this matrix is going to get passed directly to GL we convert to GL space
--- here. 
-
-import Graphics.Rendering.OpenGL hiding (Matrix)
-import Graphics.SceneGraph.Vector
-import Data.List
-import Numeric.LinearAlgebra -- (inv, (><),toLists,Matrix,Vector,mul,fromLists,toList,fromList )
-
-type MatrixD = Matrix GLdouble
-
-identityMatrix :: MatrixD
-identityMatrix = fromLists [ [1,0,0,0], [0,1,0,0], [0,0,1,0],[0,0,0,1]]
-
-asMatrix :: VectorD -> MatrixD
-asMatrix vec = let v = toList vec
-               in fromLists [ [1, 0, 0, v!!0],[ 0, 1, 0, v!!2],[ 0, 0, 1 , (-(v!!1))],[ 0, 0, 0, 1] ]
-
-translateM :: VectorD -> MatrixD -> MatrixD 
-translateM v m = (asMatrix v) `multiply` m
-
-
-translatePostM :: VectorD -> MatrixD -> MatrixD 
-translatePostM v m = m `multiply` (asMatrix v)
-
-scaleM :: VectorD -> MatrixD -> MatrixD
-scaleM vec m = let v = toList vec
-             in m `multiply` (fromLists  [ [ v!!0,0,0,0],[ 0, v!!2,0,0],[ 0, 0, (-(v!!1)),0],[ 0, 0, 0, 1] ])
-
--- | Build rotational transform matrix for rotate of ''theta'' around a vector.
-rotateM' :: ((Element a)) => a -> Vector a -> Matrix a
-rotateM' theta v = fromLists [ [ t*x*x  + c, t*x*y-s*z, t*x*z + s*y, 0],
-                    [ t*x*y+s*z, t*y*y + c, t*y*z - s*x , 0], 
-                    [ t*x*z-s*y, t*y*z + s*x, t*z*z+c, 0],
-                    [0,0,0,1]]
-                  where t = 1 - cos theta
-                        c = cos theta
-                        s = sin theta
-                        [x',y',z'] = toList v
-                        [x,y,z] = [x',z',(-y')]
-           
-rotateM theta v m = (rotateM' theta v) `multiply` m 
-
-rotatePostM theta v m = m `multiply` (rotateM' theta v)
-                    
-
-mulV :: MatrixD  -> VectorD -> VectorD 
-mulV m v = head $ toColumns $ m `multiply` (asColumn v)
-
− src/Graphics/SceneGraph/MySTM.hs 
@@ -1,30 +0,0 @@-{-# LANGUAGE  MultiParamTypeClasses, FunctionalDependencies, 
-    TypeSynonymInstances, TypeOperators #-}
-{--
-  At some point I was going to use STM. Rather than change the code back, just use the 
-  primitive mappings to MVar.
---}
-
-module Graphics.SceneGraph.MySTM where
-
-import Data.IORef
-import Control.Concurrent.MVar
-
-type STM a = IO a
-
-atomically :: MVar Bool -> STM a -> IO a
-atomically sem f = withMVar sem (\_ -> f)
-
-unsafeIOToSTM :: IO a -> STM a
-unsafeIOToSTM = id
-
-type TVar a = IORef a
-
-readTVar :: TVar a -> STM a
-readTVar = readIORef 
-
-writeTVar :: TVar a -> a -> STM ()
-writeTVar = writeIORef
-
-newTVar :: a -> STM (TVar a)
-newTVar = newIORef
− src/Graphics/SceneGraph/Reactive.hs 
@@ -1,124 +0,0 @@-   
-----------------------------------------------------------------------
--- |
--- Module      :  Graphics.SceneGraph.Reactive
--- Copyright   :  (c) Mark Wassell 2008
--- License     :  LGPL
--- 
--- Maintainer  :  mwassell@bigpond.net.au
--- Stability   :  experimental
--- Portability :  portable
--- 
--- This module provides the ability to 'enliven' a scene with widgets
--- which act as sources of events and are sinks. For example button widgets
--- and text string display areas.
---
--- runSceneReactive takes a scene and an instance of SGM monad. The latter
--- would have been built up to provide a series of actions to enliven
--- the scene. The monad is run prior to passing the scene to the viewport 
--- engine.
-----------------------------------------------------------------------
-
-module Graphics.SceneGraph.Reactive where
-
-import Data.Reactive
-import Graphics.SceneGraph.Basic
-import Control.Monad.State
-import Control.Concurrent.MVar
-import Graphics.SceneGraph.MySTM
-import Graphics.SceneGraph.SimpleViewport
-import Data.IORef
-import Graphics.Rendering.OpenGL.GL.BasicTypes (GLdouble)
-import Data.Graph.Inductive (Node)
-
-import Graphics.SceneGraph.SimpleViewport (GSRef,GraphicsState(..))
-
-data Widget = Button Scene | Slider Scene | Wheel Scene  | WText Scene
-
-
-{-- 
-   The widget building functions below assume the following structure in the 
-   scene graph for the following widgets:
-   
-        Simple Button:   Handler -> Switch -> Material -> Sphere
-                                           -> Material -> Sphere
-
-        Button -> Group -> Group -> Transform -> Material -> Transform -> Torus
-                                    Transform -> Material -> Cube
-                        -> Transform -> Simple Button
-
-        Slider == Same as button in structure BUT has a different output and the button can slide.
- 
-        Text = Text 
---}
-
--- | This monad allows us to compose widget building actions on the scene.
-type SGM  = StateT (Scene,MVar Bool ,GSRef) IO
-
-
-getNodeByLabel :: String -> SGM Node
-getNodeByLabel lbl = do
-                       ((sg,_),_,_) <- get
-                       return $ getByLabel sg lbl
-
--- | Turn the supplied node into an button style widget
--- Int needs to reference a handler
-mkButton :: Int -> SGM (Event Bool)
-mkButton nde = do
-             ((sg,start),sem,ref) <- get
-             let nde' = findHandlerDown sg nde
-             -- lift $ putStrLn $ "handler " ++ show nde'
-             (ev,snk') <- lift $ mkEvent
-             let snk _ = snk' True
-             let (SceneNode ide (Handler (Just (f,_)) dh)) = llab sg nde'
-                 sg' = replaceNode'' sg (SceneNode ide (Handler (Just (f,snk)) dh ))
-             put ((sg',start),sem,ref)
-             return $ ev
-
--- | Turn the referenced node into a slider style widget
-mkSlider :: Int -> SGM (Event GLdouble)
-mkSlider nde = do
-             ((sg,start),sem,ref) <- get
-             (ev,snk) <- lift $ mkEvent
-             let (SceneNode ide (Handler ch (Just (f,_)))) = llab sg nde
-                 sg' = replaceNode'' sg (SceneNode ide (Handler ch (Just (f,snk)) ))
-             put ((sg',start),sem,ref)
-             return $ ev
-
-
-doText ::  Int  -> MVar Bool -> GSRef ->  Sink String
-doText nde sem ref a = updateNode nde sem ref (Text $ a)
-
-updateNode :: Node -> MVar Bool -> IORef GraphicsState -> SceneData -> IO ()
-updateNode nde sem ref dte = atomically sem $ do 
-                          gs <- readIORef ref
-                          case gsScene gs of
-                                 Just (gr,start) -> do
-                                                let   (SceneNode lab _) = llab gr nde
-                                                      gr' = replaceNode'' gr (SceneNode lab dte)
-                                                writeIORef ref (gs { gsDisplayList=Nothing,gsScene = Just (gr',start)})
-                                                return ()
-                                 _ -> return ()
-
--- | Turn the referenced node into a text sink widget
-mkText ::  Int -> SGM (Sink String)
-mkText nde = do
-             ((sg,_),sem,ref) <- get
-             let nde' = findTextDown sg nde
-             return $ doText nde' sem ref
-
-
--- | Run a scene with supplied Event Action builder
-runSceneReactive :: Scene -> SGM (Event Action) -> IO ()
-runSceneReactive scene sr  = do
-           sem <- newMVar True
-           ref <- newTVar newState
-           
-           -- We have pass sem and ref as these are need when the widgets are 
-           -- doing something when we run the scene.
-           (x, (scene',sem,ref)) <- runStateT sr  (scene,sem,ref)
-           modifyIORef ref  (\s -> s { gsScene = Just scene' })
-           forkE x
-
-           setupGUI sem ref
-
− src/Graphics/SceneGraph/ReadImage.hs 
@@ -1,68 +0,0 @@-{-
-   ReadImage.hs (adapted from readImage.c which is (c) Silicon Graphics, Inc.)
-   Copyright (c) Sven Panne 2002-2004 <sven.panne@aedion.de>
-   This file is part of HOpenGL and distributed under a BSD-style license
-   See the file libraries/GLUT/LICENSE
-
-   This module has been modified to read both color and alpha data necessary for transparent textures in OpenGL.
-
-   Support for reading a file of raw RGB data:
-      4 bytes big-endian width
-      4 bytes big-endian height
-      width * height RGBA byte quadruples (the original module reads width * height RGB byte triples)
--}
-
-module Graphics.SceneGraph.ReadImage ( readImage ) where
-
-import Data.Word ( Word8, Word32 )
-import Control.Exception ( bracket )
-import Control.Monad ( liftM, when )
-import System.IO ( Handle, IOMode(ReadMode), openBinaryFile, hGetBuf, hClose )
-import System.IO.Error ( mkIOError, eofErrorType )
-import Foreign ( Ptr, alloca, mallocBytes, Storable(..) )
-import Graphics.UI.GLUT
-
--- This is probably overkill, but anyway...
-newtype Word32BigEndian = Word32BigEndian Word32
-
-word32BigEndianToGLsizei :: Word32BigEndian -> GLsizei
-word32BigEndianToGLsizei (Word32BigEndian x) = fromIntegral x
-
-instance Storable Word32BigEndian where
-   sizeOf ~(Word32BigEndian x) = sizeOf x
-   alignment ~(Word32BigEndian x) = alignment x
-   peek ptr = do
-      let numBytes = sizeOf (undefined :: Word32BigEndian)
-      bytes <- mapM (peekByteOff ptr) [ 0 ..  numBytes - 1 ] :: IO [Word8]
-      let value = foldl (\val byte -> val * 256 + fromIntegral byte) 0 bytes
-      return $ Word32BigEndian value
-   poke = error ""
-
--- This is the reason for all this stuff above...
-readGLsizei :: Handle -> IO GLsizei
-readGLsizei handle =
-   alloca $ \buf -> do
-      hGetBufFully handle buf (sizeOf (undefined :: Word32BigEndian))
-      liftM word32BigEndianToGLsizei $ peek buf
-
--- A handy variant of hGetBuf with additional error checking
-hGetBufFully :: Handle -> Ptr a -> Int -> IO ()
-hGetBufFully handle ptr numBytes = do
-   bytesRead <- hGetBuf handle ptr numBytes
-   when (bytesRead /= numBytes) $
-      ioError $ mkIOError eofErrorType "hGetBufFully" (Just handle) Nothing
-
-
--- Closing a file is nice, even when an error occurs during reading.
-withBinaryFile :: FilePath -> (Handle -> IO a) -> IO a
-withBinaryFile filePath = bracket (openBinaryFile filePath ReadMode) hClose
-
-readImage :: FilePath -> IO (Maybe (Size, PixelData a))
-readImage filePath =
-   withBinaryFile filePath $ \handle -> do
-      width <- readGLsizei handle
-      height <- readGLsizei handle
-      let numBytes = fromIntegral (4 * width * height)  -- changed the 3 to a 4 to make space for our alpha data.
-      buf <- mallocBytes numBytes
-      hGetBufFully handle buf numBytes
-      return $ Just (Size width height, PixelData RGBA UnsignedByte buf)  -- changed the PixelFormat constructor here from RGB to RGBA, to account for our alpha data.
− src/Graphics/SceneGraph/TGA.hs 
@@ -1,102 +0,0 @@-{- TGA.hs; Mun Hon Cheong (mhch295@cse.unsw.edu.au) 2005
-
-This module was based on lesson 24 from neon helium productions
-http://nehe.gamedev.net/data/lessons/lesson.asp?lesson=24
-
-The TGA format is a used bitmap image file format. They are
-quite easy to load compared to other formats and have
-good support in image editors. All that has to be done is
-read the header to determine the dimensions and pixel format.
-Then the bytes have to be swapped and can be used by OPenGL.
-
-If you see a texture that is upside down, just open it in your
-editor and flip it vertically. Somtimes the TGA file is stored
-with its pixels upside down.
-
--}
-
-
-
-module Graphics.SceneGraph.TGA where
-
-import Data.Word ( Word8, Word32 )
-import Control.Exception ( bracket )
-import Control.Monad ( liftM, when )
-import System.IO ( Handle, IOMode(ReadMode), openBinaryFile, hGetBuf, hClose )
-import System.IO.Error ( mkIOError, eofErrorType )
-import Foreign ( Ptr, alloca, mallocBytes, Storable(..) )
-import Foreign.Marshal.Array
-import Foreign.Marshal.Alloc
-import Foreign.Ptr
-import Graphics.UI.GLUT
-
-
-withBinaryFile' :: FilePath -> (Handle -> IO a) -> IO a
-withBinaryFile' filePath = bracket (openBinaryFile filePath ReadMode) hClose
-
-
--- reads a *.tga file
-readTga :: FilePath -> IO (Maybe (Size, PixelData Word8))
-readTga filePath =
-   withBinaryFile' filePath $ \handle -> do
-   buf <- mallocBytes 6 :: IO(Ptr Word8)
-   --the first 12 bytes of the header aren't used
-   hGetBuf handle buf 6
-   hGetBuf handle buf 6
-   hGetBuf handle buf 6
-   header <- peekArray 6 buf
-   let w1       = (fromIntegral (header!!1))*256 :: Int
-   let width    = w1 + (fromIntegral (header!!0))
-   let h1       = (fromIntegral (header!!3))*256 :: Int
-   let height   = h1 + (fromIntegral (header!!2))
-   let bitspp   = (fromIntegral (header!!4))
-   let numBytes = (bitspp `div` 8) * width * height
-   --allocate memory for the image
-   image <- mallocBytes numBytes
-   hGetBuf handle image numBytes
-   --define whether the pixels are in RGB or RGBA format.
-   pixelFormat <- getFormat (fromIntegral bitspp)
-   free buf
-   --convert the pixels which are in BGR/BGRA to RGB/RGBA
-   swapBytes' image (bitspp `div` 8) (width * height)
-   print ("loaded "++filePath)
-   return $ Just (Size (fromIntegral width) (fromIntegral height),
-               PixelData pixelFormat UnsignedByte image)
-
-
--- converts the image from bgr/bgra to rgb/rgba
--- perhaps the opengl bgra extension could be
--- used to avoid this
-swapBytes' :: Ptr Word8 -> Int -> Int -> IO()
-swapBytes' image bytespp size =
-   case bytespp of
-      3 -> do mapM_ (swapByteRGB.(plusPtr image).(bytespp*)) [0..(size-1)]
-      4 -> do mapM_ (swapByteRGBA.(plusPtr image).(bytespp*)) [0..(size-1)]
-
-
--- converts from bgr to rgb
-swapByteRGB :: Ptr Word8 -> IO()
-swapByteRGB ptr = do
-   [b,g,r] <- peekArray 3 ptr
-   pokeArray ptr [r,g,b]
-
-
--- converts from bgra to rgba
-swapByteRGBA :: Ptr Word8 -> IO()
-swapByteRGBA ptr = do
-   [b,g,r,a] <- peekArray 4 ptr
-   pokeArray ptr [r,g,b,a]
-
-
--- returns the pixel format given the bits per pixel
-getFormat :: Int ->  IO(PixelFormat)
-getFormat bpp = do
-   case bpp of
-      (32) ->  return RGBA
-      (24) ->  return RGB
-
-
-
-
-
-
− src/Graphics/SceneGraph/Utils.hs 
@@ -1,5 +0,0 @@-module Graphics.SceneGraph.Utils where
-
-
-head' s [] = error s
-head' s (x:_) = x
− src/Graphics/SceneGraph/VectorSpace.hs 
@@ -1,173 +0,0 @@-{-
-******************************************************************************
-*                                  A F R P                                   *
-*                                                                            *
-*       Module:		AFRPVectorSpace					     *
-*       Purpose:	Vector space type relation and basic instances.	     *
-*	Authors:	Henrik Nilsson and Antony Courtney		     *
-*                                                                            *
-*             Copyright (c) Yale University, 2003                            *
-*                                                                            *
-******************************************************************************
--}
-
-module Vinci.VectorSpace where
-
-import Graphics.Rendering.OpenGL (Vector3 (..), Vertex3 (..) )
-
-------------------------------------------------------------------------------
--- Vector space type relation
-------------------------------------------------------------------------------
-
-infixr *^
-infixl ^/
-infix 7 `dot`
-infixl 6 ^+^, ^-^
-
--- Maybe norm and normalize should not be class methods, in which case
--- the constraint on the coefficient space (a) should (or, at least, could)
--- be Fractional (roughly a Field) rather than Floating.
-
--- Minimal instance: zeroVector, (*^), (^+^), dot
-class Floating a => VectorSpace v a | v -> a where
-    zeroVector   :: v
-    (*^)         :: a -> v -> v
-    (^/)         :: v -> a -> v
-    negateVector :: v -> v
-    (^+^)        :: v -> v -> v
-    (^-^)        :: v -> v -> v
-    dot          :: v -> v -> a
-    norm	 :: v -> a
-    normalize	 :: v -> v
-
-    v ^/ a = (1/a) *^ v
-
-    negateVector v = (-1) *^ v
-
-    v1 ^-^ v2 = v1 ^+^ negateVector v2
-
-    norm v = sqrt (v `dot` v)
-
-    normalize v = if nv /= 0 then v ^/ nv else error "normalize: zero vector"
-        where
-	    nv = norm v
-
-------------------------------------------------------------------------------
--- Vector space instances for Float and Double
-------------------------------------------------------------------------------
-
-instance VectorSpace Float Float where
-    zeroVector = 0
-
-    a *^ x = a * x
-
-    x ^/ a = x / a
-
-    negateVector x = (-x)
-
-    x1 ^+^ x2 = x1 + x2
-
-    x1 ^-^ x2 = x1 - x2
-
-    x1 `dot` x2 = x1 * x2
-
-
-instance VectorSpace Double Double where
-    zeroVector = 0
-
-    a *^ x = a * x
-
-    x ^/ a = x / a
-
-    negateVector x = (-x)
-
-    x1 ^+^ x2 = x1 + x2
-
-    x1 ^-^ x2 = x1 - x2
-
-    x1 `dot` x2 = x1 * x2
-
-
-------------------------------------------------------------------------------
--- Vector space instances for small tuples of Floating
-------------------------------------------------------------------------------
-
-instance Floating a => VectorSpace (a,a) a where
-    zeroVector = (0,0)
-
-    a *^ (x,y) = (a * x, a * y)
-
-    (x,y) ^/ a = (x / a, y / a)
-
-    negateVector (x,y) = (-x, -y)
-
-    (x1,y1) ^+^ (x2,y2) = (x1 + x2, y1 + y2)
-
-    (x1,y1) ^-^ (x2,y2) = (x1 - x2, y1 - y2)
-
-    (x1,y1) `dot` (x2,y2) = x1 * x2 + y1 * y2
-
-
-instance Floating a => VectorSpace (a,a,a) a where
-    zeroVector = (0,0,0)
-
-    a *^ (x,y,z) = (a * x, a * y, a * z)
-
-    (x,y,z) ^/ a = (x / a, y / a, z / a)
-
-    negateVector (x,y,z) = (-x, -y, -z)
-
-    (x1,y1,z1) ^+^ (x2,y2,z2) = (x1+x2, y1+y2, z1+z2)
-
-    (x1,y1,z1) ^-^ (x2,y2,z2) = (x1-x2, y1-y2, z1-z2)
-
-    (x1,y1,z1) `dot` (x2,y2,z2) = x1 * x2 + y1 * y2 + z1 * z2
-
-
-instance Floating a => VectorSpace (a,a,a,a) a where
-    zeroVector = (0,0,0,0)
-
-    a *^ (x,y,z,u) = (a * x, a * y, a * z, a * u)
-
-    (x,y,z,u) ^/ a = (x / a, y / a, z / a, u / a)
-
-    negateVector (x,y,z,u) = (-x, -y, -z, -u)
-
-    (x1,y1,z1,u1) ^+^ (x2,y2,z2,u2) = (x1+x2, y1+y2, z1+z2, u1+u2)
-
-    (x1,y1,z1,u1) ^-^ (x2,y2,z2,u2) = (x1-x2, y1-y2, z1-z2, u1-u2)
-
-    (x1,y1,z1,u1) `dot` (x2,y2,z2,u2) = x1 * x2 + y1 * y2 + z1 * z2 + u1 * u2
-
-
-instance Floating a => VectorSpace (a,a,a,a,a) a where
-    zeroVector = (0,0,0,0,0)
-
-    a *^ (x,y,z,u,v) = (a * x, a * y, a * z, a * u, a * v)
-
-    (x,y,z,u,v) ^/ a = (x / a, y / a, z / a, u / a, v / a)
-
-    negateVector (x,y,z,u,v) = (-x, -y, -z, -u, -v)
-
-    (x1,y1,z1,u1,v1) ^+^ (x2,y2,z2,u2,v2) = (x1+x2, y1+y2, z1+z2, u1+u2, v1+v2)
-
-    (x1,y1,z1,u1,v1) ^-^ (x2,y2,z2,u2,v2) = (x1-x2, y1-y2, z1-z2, u1-u2, v1-v2)
-
-    (x1,y1,z1,u1,v1) `dot` (x2,y2,z2,u2,v2) =
-        x1 * x2 + y1 * y2 + z1 * z2 + u1 * u2 + v1 * v2
-
-
-
-instance Floating a => VectorSpace (Vector3 a) a where
-   zeroVector = Vector3 0 0 0
-   a *^ (Vector3 x y z) = Vector3 (a*x)  (a*y) (a*z)
-   (Vector3 x y z) ^/ a = Vector3 (x/a) (y/a) (z/a)
-
-   negateVector (Vector3 x y z) = Vector3 (-x) (-y) (-z)
-
-   (Vector3 x1 y1 z1) ^+^ (Vector3 x2 y2 z2) = Vector3 (x1+x2) (y1+y2) (z1+z2)
-   (Vector3 x1 y1 z1) ^-^ (Vector3 x2 y2 z2) = Vector3 (x1-x2) (y1-y2) (z1-z2)
-   (Vector3 x1 y1 z1) `dot` (Vector3 x2 y2 z2) =  x1 * x2 + y1 * y2 + z1 * z2
-
-
-asVec (Vertex3 x y z) = Vector3 x y z