Skip to content
Browse files

Hierarchical reorganization of code into RSAGL.Math, RSAGL.FRP, RSAGL…

….Modeling, RSAGL.Animation, RSAGL.Scene, and RSAGL.RayTrace. A problem with this commit is that most of RSAGL is recompiled for the demo/test programs.
  • Loading branch information...
1 parent 3cb4a23 commit 2901b060415e764fd8b482c43d8a1001fc3858b0 @clanehin committed Apr 16, 2009
Showing with 576 additions and 717 deletions.
  1. +0 −73 Makefile
  2. +143 −18 RSAGL/Main.hs → ModelView.hs
  3. +0 −142 Models/PlanetRingMoon.hs
  4. +6 −6 {RSAGL → }/ProcessColors.hs
  5. +13 −0 RSAGL/Animation.hs
  6. +8 −8 RSAGL/{ → Animation}/Animation.lhs
  7. +12 −12 RSAGL/{ → Animation}/AnimationExtras.lhs
  8. +12 −12 RSAGL/{ → Animation}/InverseKinematics.lhs
  9. +6 −6 RSAGL/{ → Animation}/Joint.lhs
  10. +5 −5 RSAGL/{ → Animation}/KinematicSensors.lhs
  11. +1 −1 RSAGL/{ → Auxiliary}/ApplicativeWrapper.hs
  12. +1 −1 RSAGL/{ → Auxiliary}/Auxiliary.hs
  13. +5 −5 RSAGL/Extras/ColorPhysics.hs
  14. +9 −9 RSAGL/Extras/Sky.hs
  15. +10 −0 RSAGL/FRP.hs
  16. +1 −1 RSAGL/{ → FRP}/ArrowTransformerOptimizer.lhs
  17. +5 −5 RSAGL/{ → FRP}/Edge.lhs
  18. +24 −24 RSAGL/{ → FRP}/FRP.lhs
  19. +17 −17 RSAGL/{ → FRP}/FRPBase.hs
  20. +1 −1 RSAGL/{ → FRP}/StatefulArrow.lhs
  21. +5 −5 RSAGL/{ → FRP}/SwitchedArrow.lhs
  22. +6 −6 RSAGL/{ → FRP}/ThreadedArrow.lhs
  23. +3 −3 RSAGL/{ → FRP}/Time.lhs
  24. +23 −0 RSAGL/Math.hs
  25. +2 −2 RSAGL/{ → Math}/AbstractVector.lhs
  26. +19 −19 RSAGL/{ → Math}/Affine.hs
  27. +2 −2 RSAGL/{ → Math}/Angle.hs
  28. +8 −8 RSAGL/{ → Math}/Curve.hs
  29. +8 −8 RSAGL/{ → Math}/CurveExtras.lhs
  30. +3 −3 RSAGL/{ → Math}/Homogenous.hs
  31. +2 −2 RSAGL/{ → Math}/Interpolation.lhs
  32. +3 −3 RSAGL/{ → Math}/Matrix.lhs
  33. +5 −5 RSAGL/{ → Math}/Orthagonal.lhs
  34. +4 −4 RSAGL/{ → Math}/RK4.lhs
  35. +4 −4 RSAGL/{ → Math}/Ray.lhs
  36. +4 −4 RSAGL/{ → Math}/Vector.lhs
  37. +3 −3 RSAGL/{ → Math}/WrappedAffine.hs
  38. +13 −0 RSAGL/Modeling.hs
  39. +3 −3 RSAGL/{ → Modeling}/BakedModel.hs
  40. +4 −4 RSAGL/{ → Modeling}/BoundingBox.lhs
  41. +3 −3 RSAGL/{ → Modeling}/Color.lhs
  42. +6 −6 RSAGL/{ → Modeling}/Deformation.lhs
  43. +7 −7 RSAGL/{ → Modeling}/Extrusion.lhs
  44. +6 −6 RSAGL/{ → Modeling}/Material.hs
  45. +22 −21 RSAGL/{ → Modeling}/Model.lhs
  46. +16 −16 RSAGL/{ → Modeling}/ModelingExtras.lhs
  47. +4 −4 RSAGL/{ → Modeling}/Noise.lhs
  48. +1 −1 RSAGL/{ → Modeling}/OpenGLPrimitives.hs
  49. +4 −4 RSAGL/{ → Modeling}/Optimization.lhs
  50. +2 −2 RSAGL/{ → Modeling}/RSAGLColors.hs
  51. +6 −6 RSAGL/{ → Modeling}/Tesselation.lhs
  52. +6 −6 RSAGL/{ → RayTrace}/RayTrace.lhs
  53. +6 −6 RSAGL/{ → RayTrace}/Scattering.lhs
  54. +9 −0 RSAGL/Scene.hs
  55. +4 −4 RSAGL/{ → Scene}/CoordinateSystems.lhs
  56. +1 −1 RSAGL/{ → Scene}/LODCache.hs
  57. +5 −5 RSAGL/{ → Scene}/LightSource.hs
  58. +10 −10 RSAGL/{ → Scene}/Scene.lhs
  59. +0 −137 RSAGL/rsagl.tex
  60. +14 −14 {RSAGL → }/Tests.hs
  61. +41 −24 rsagl.cabal
View
73 Makefile
@@ -1,73 +0,0 @@
-not-a-makefile-based-project:
- @echo "This isn't a Makefile-based project!"
- @echo "You probably want to: runghc Setup.hs configure/build/install"
-
-all : doc tests
-
-doc :
- pdflatex -output-directory RSAGL rsagl.tex && cp RSAGL/rsagl.pdf ./
-
-tests: rsagl-tests rsagl-modelview
-
-rsagl-tests-prof :
- ghc --version
- -rm -f rsagl-tests.tix
- ghc -fext-core -fhpc -prof -auto-all -caf-all -O2 -Wall -fno-warn-type-defaults --make RSAGL/Tests.hs -main-is RSAGL.Tests.main -o rsagl-tests-prof ${GHC_OPTS}
-
-rsagl-tests :
- ghc --version
- ghc -fext-core -threaded -Wall -fno-warn-type-defaults -O2 -fexcess-precision --make RSAGL/Tests.hs -main-is RSAGL.Tests.main -o rsagl-tests ${GHC_OPTS}
-
-rsagl-modelview-prof:
- ghc --version
- -rm -f rsagl-modelview.tix
- ghc -fext-core -fhpc -prof -auto-all -caf-all -lglut -O2 -Wall -fno-warn-type-defaults --make RSAGL/Main.hs -main-is RSAGL.Main.main -o rsagl-modelview-prof ${GHC_OPTS}
-
-rsagl-modelview:
- ghc --version
- ghc -fext-core -threaded -lglut -Wall -fno-warn-type-defaults -fexcess-precision -O2 --make RSAGL/Main.hs -main-is RSAGL.Main.main -o rsagl-modelview ${GHC_OPTS}
-
-colors:
- ghc -lglut -O2 --make RSAGL/ProcessColors.hs -main-is RSAGL.ProcessColors.main -o rsagl-process-colors
- ./rsagl-process-colors
-
-hpc-metrics: rsagl-tests-prof rsagl-modelview-prof
- -rm -f rsagl-tests.tix
- -rm -f rsagl-modelview.tix
- -rm -f rsagl-sum.tix
- ./rsagl-tests-prof
- ./rsagl-modelview-prof
- hpc sum --union rsagl-tests.tix rsagl-modelview-prof > rsagl-sum.tix
- hpc markup rsagl-sum.tix
-
-clean :
- -rm -f RSAGL/*.dvi
- -rm -f RSAGL/*.hcr
- -rm -f RSAGL/*.aux
- -rm -f RSAGL/*.log
- -rm -f RSAGL/*.pdf
- -rm -f RSAGL/*.toc
- -rm -f RSAGL/*.hi
- -rm -f RSAGL/*.o
- -rm -f RSAGL/*.out
- -rm -f Models/*.o
- -rm -f Models/*.hi
- -rm -f Models/*.hcr
- -rm -f rsagl-tests
- -rm -f rsagl-tests-prof
- -rm -f rsagl-modelview
- -rm -f rsagl-modelview-prof
- -rm -f rsagl-process-colors
- -rm -f rsagl.pdf
- -rm -f ./rsagl-modelview.aux
- -rm -f ./rsagl-modelview.hp
- -rm -f ./rsagl-modelview.pdf
- -rm -f ./rsagl-modelview.ps
- -rm -f ./*.tix
- -rm -f hpc_index_alt.html hpc_index_exp.html hpc_index_fun.html hpc_index.html
- -rm -f ./.hpc/*
- -rmdir ./.hpc
- -rm -f ./*.hs.html
- -rm -f ./*.lhs.html
-
-.PHONY : clean doc tests all rsagl-modelview rsagl-modelview-prof rsagl-tests rsagl-tests-prof colors hpc-metrics
View
161 RSAGL/Main.hs → ModelView.hs
@@ -1,34 +1,30 @@
{-# LANGUAGE Arrows #-}
-module RSAGL.Main
+module Main
(main,
displayModel)
where
import Data.IORef
import System.IO
-import Graphics.UI.GLUT as GLUT
+import Graphics.UI.GLUT as GLUT hiding (specular,scale,translate,rotate)
import Graphics.Rendering.OpenGL.GLU.Errors
-import RSAGL.Model
-import Models.PlanetRingMoon
-import RSAGL.Time
+import System.Random
+import RSAGL.Modeling
+import RSAGL.FRP
+import RSAGL.Animation
+import RSAGL.Scene
+import RSAGL.Math
+import RSAGL.Scene.LODCache
+import RSAGL.RayTrace.RayTrace as RT
+import RSAGL.Extras.Sky
+import RSAGL.Math.CurveExtras
+import RSAGL.Auxiliary.Auxiliary
import Control.Monad
-import RSAGL.Angle
import System.Exit
import RSAGL.Bottleneck
-import RSAGL.LODCache
-import RSAGL.Scene
-import RSAGL.FRP
-import RSAGL.Animation
-import RSAGL.AnimationExtras
-import RSAGL.ThreadedArrow
import Control.Arrow
-import RSAGL.Vector
-import RSAGL.CoordinateSystems
-import qualified RSAGL.Affine as Affine
-import RSAGL.ModelingExtras
-import RSAGL.InverseKinematics
-import RSAGL.LightSource
+import qualified RSAGL.Math.Affine as Affine
test_quality :: Integer
test_quality = 2^14
@@ -176,3 +172,132 @@ rsaglTimerCallback :: Window -> IO ()
rsaglTimerCallback window =
do addTimerCallback timer_callback_millis (rsaglTimerCallback window)
postRedisplay $ Just window
+
+
+
+ring :: Modeling ()
+ring = model $ do openDisc origin_point_3d (Vector3D 0 1 0) 0.75 1.0
+ material $
+ do transparent $ pure $ alpha 0.25 purple
+ specular 2 $ pure purple
+ bumps $ waves 0.2 0.01
+ twoSided True
+
+planet :: Modeling ()
+planet = model $
+ do RSAGL.Modeling.sphere (Point3D 0 0 0) 0.65
+ deform $ constrain (\(SurfaceVertex3D (Point3D x y z) _) -> x > 0 && y > 0 && z > 0) $
+ RT.shadowDeform (Vector3D (-1) (-1) (-1)) (map (RT.plane (Point3D 0 0 0)) [Vector3D 1 0 0,Vector3D 0 1 0,Vector3D 0 0 1])
+ let land_vs_water land water = pattern (cloudy 26 0.4) [(0,water),(0.5,water),(0.51,land),(1,land)]
+ let grass_and_mountains = pattern (cloudy 81 0.25) [(0.4,pattern (cloudy 99 0.1) [(0.0,pure brown),(1.0,pure slate_gray)]),(0.5,pure forest_green)]
+ let land_and_water = land_vs_water grass_and_mountains (pure blue)
+ let cities bright dark = land_vs_water (pattern (cloudy 5 0.1) [(0.0,bright),(0.5,dark)]) (dark)
+ let planet_surface = pattern (gradient (Point3D 0 0 0) (Vector3D 0 0.65 0))
+ [(-0.9,pure white),(-0.85,land_and_water),(0.85,land_and_water),(0.9,pure white)]
+ let planet_interior inner_core outer_core crust = pattern (spherical (Point3D 0 0 0) 0.65)
+ [(0.0,inner_core),(0.25,inner_core),(0.5,outer_core),(0.95,outer_core),(1.0,crust)]
+ material $
+ do pigment $ planet_interior (pure blackbody) (pure blackbody) $ cities (pure black) planet_surface
+ emissive $ planet_interior (pure yellow) (pure red) $ cities (pure $ scaleRGB 0.2 white) (pure blackbody)
+ specular 20 $ planet_interior (pure blackbody) (pure blackbody) $ land_vs_water (pure blackbody) (pure white)
+
+moon :: Modeling ()
+moon = model $
+ do RSAGL.Modeling.sphere (Point3D 0 0 0) 0.2
+ material $ pigment $ pattern (cloudy 8 0.05) [(0.0,pure slate_gray),(1.0,pure white)]
+ regenerateNormals
+
+monolith :: Modeling ()
+monolith = model $
+ do smoothbox 0.1 (Point3D 4 9 1) (Point3D (-4) (-9) (-1))
+ affine (translate $ Vector3D 0 9 0)
+ affine (scale' 0.20)
+ material $
+ do pigment $ pure blackbody
+ specular 100 $ pure white
+
+ground :: Modeling ()
+ground = model $
+ do closedDisc (Point3D 0 (-0.1) 0) (Vector3D 0 1 0) 30
+ regenerateNormals
+ material $ pigment $ pattern (cloudy 27 1.0) [(0.0,pure brown),(1.0,pure forest_green)]
+ affine $ translate (Vector3D 0 (-0.1) 0)
+
+station :: Modeling ()
+station = model $
+ do model $
+ do torus 0.5 0.1
+ openCone (Point3D (-0.5) 0 0,0.02) (Point3D 0.5 0 0,0.02)
+ openCone (Point3D 0 0 (-0.5),0.02) (Point3D 0 0 0.5,0.02)
+ closedCone (Point3D 0 0.2 0,0.2) (Point3D 0 (-0.2) 0,0.2)
+ material $
+ do pigment $ pure silver
+ specular 100 $ pure silver
+ model $
+ do box (Point3D (-0.15) 0.19 (-0.05)) (Point3D 0.15 0.21 0.05)
+ material $ emissive $ pure white
+ sequence_ $ dropRandomElements 30 (mkStdGen 19) $ concatMap (rotationGroup (Vector3D 0 1 0) 40) $
+ [window_box,
+ transformAbout (Point3D 0.5 0 0) (rotateZ $ fromDegrees 25) window_box,
+ transformAbout (Point3D 0.5 0 0) (rotateZ $ fromDegrees (-25)) window_box,
+ transformAbout (Point3D 0.5 0 0) (rotateZ $ fromDegrees 50) window_box,
+ transformAbout (Point3D 0.5 0 0) (rotateZ $ fromDegrees (-50)) window_box]
+ where window_box = model $
+ do quadralateral (Point3D 0.51 (-0.105) 0.03) (Point3D 0.49 (-0.105) 0.03)
+ (Point3D 0.49 (-0.105) (-0.03)) (Point3D 0.51 (-0.105) (-0.03))
+ quadralateral (Point3D 0.51 0.105 (-0.03)) (Point3D 0.49 0.105 (-0.03))
+ (Point3D 0.49 0.105 0.03) (Point3D 0.51 0.105 0.03)
+ material $
+ do pigment $ pure black
+ emissive $ pure white
+ tesselationHintComplexity 0
+ fixed (3,3)
+
+orb :: Modeling ()
+orb = model $
+ do sor $ linearInterpolation $ points2d
+ [(-0.001,0.4),
+ (0.5,0.45),
+ (0.5,0.4),
+ (0.6,0.4),
+ (0.6,0.6),
+ (0.5,0.6),
+ (0.5,0.55),
+ (-0.001,0.6)]
+ sequence_ $ rotationGroup (Vector3D 0 1 0) 5 $
+ tube $ zipCurve (,) (pure 0.05) $ smoothCurve 3 0.4 $ loopedLinearInterpolation $ points3d
+ [(0.4,0.2,0.4),
+ (0.4,0.8,0.8),
+ (-0.4,0.8,0.8),
+ (-0.4,0.2,0.4)]
+ regularPrism (Point3D 0 0.5 0,0.5) (Point3D 0 1.0 0,-0.001) 4
+ material $
+ do pigment $ pure gold
+ specular 64 $ pure silver
+
+glow_orb :: Modeling ()
+glow_orb = translate (Vector3D 0 1 0) $
+ do closedDisc (Point3D 0 0 0) (Vector3D 0 1 0) 1
+ material $ emissive $ pattern (spherical (Point3D 0 0 0) 1) [(0.0,pure $ scaleRGB 1.5 white),(0.25,pure white),(0.95,pure blackbody)]
+
+orb_upper_leg :: Modeling ()
+orb_upper_leg = model $
+ do tube $ zipCurve (,) (pure 0.05) $ linearInterpolation [Point3D 0 0 0,Point3D 0 0.1 0.5,Point3D 0 0 1]
+ RSAGL.Modeling.sphere (Point3D 0 0 1) 0.05
+ material $
+ do pigment $ pure gold
+ specular 64 $ pure silver
+
+orb_lower_leg :: Modeling ()
+orb_lower_leg = model $
+ do openCone (Point3D 0 0 0,0.05) (Point3D 0 0 1,0)
+ material $
+ do pigment $ pure gold
+ specular 64 $ pure silver
+
+sky :: Modeling ()
+sky = model $
+ do skyHemisphere (Point3D 0 0 0) (Vector3D 0 1 0) 1.0
+ affine $ scale $ Vector3D 5 1 5
+ material $ atmosphereScatteringMaterial earth_atmosphere [(rotate (Vector3D 0 0 1) (fromTimeOfDayHMS 0 15 0) $ Vector3D 1 0 0,gray 1)] (dynamicSkyFilter 0.2 1.0)
+
View
142 Models/PlanetRingMoon.hs
@@ -1,142 +0,0 @@
-module Models.PlanetRingMoon
- (planet,ring,moon,ground,monolith,station,orb,glow_orb,orb_upper_leg,orb_lower_leg,Models.PlanetRingMoon.sky)
- where
-
-import RSAGL.Model
-import RSAGL.Vector
-import RSAGL.ModelingExtras
-import qualified RSAGL.RayTrace as RT
-import RSAGL.Affine
-import RSAGL.Auxiliary
-import System.Random
-import RSAGL.Angle
-import RSAGL.CurveExtras
-import RSAGL.Curve
-import RSAGL.Extras.Sky as Sky
-
-ring :: Modeling ()
-ring = model $ do openDisc origin_point_3d (Vector3D 0 1 0) 0.75 1.0
- material $
- do transparent $ pure $ alpha 0.25 purple
- specular 2 $ pure purple
- bumps $ waves 0.2 0.01
- twoSided True
-
-planet :: Modeling ()
-planet = model $
- do sphere (Point3D 0 0 0) 0.65
- deform $ constrain (\(SurfaceVertex3D (Point3D x y z) _) -> x > 0 && y > 0 && z > 0) $
- RT.shadowDeform (Vector3D (-1) (-1) (-1)) (map (RT.plane (Point3D 0 0 0)) [Vector3D 1 0 0,Vector3D 0 1 0,Vector3D 0 0 1])
- let land_vs_water land water = pattern (cloudy 26 0.4) [(0,water),(0.5,water),(0.51,land),(1,land)]
- let grass_and_mountains = pattern (cloudy 81 0.25) [(0.4,pattern (cloudy 99 0.1) [(0.0,pure brown),(1.0,pure slate_gray)]),(0.5,pure forest_green)]
- let land_and_water = land_vs_water grass_and_mountains (pure blue)
- let cities bright dark = land_vs_water (pattern (cloudy 5 0.1) [(0.0,bright),(0.5,dark)]) (dark)
- let planet_surface = pattern (gradient (Point3D 0 0 0) (Vector3D 0 0.65 0))
- [(-0.9,pure white),(-0.85,land_and_water),(0.85,land_and_water),(0.9,pure white)]
- let planet_interior inner_core outer_core crust = pattern (spherical (Point3D 0 0 0) 0.65)
- [(0.0,inner_core),(0.25,inner_core),(0.5,outer_core),(0.95,outer_core),(1.0,crust)]
- material $
- do pigment $ planet_interior (pure blackbody) (pure blackbody) $ cities (pure black) planet_surface
- emissive $ planet_interior (pure yellow) (pure red) $ cities (pure $ scaleRGB 0.2 white) (pure blackbody)
- specular 20 $ planet_interior (pure blackbody) (pure blackbody) $ land_vs_water (pure blackbody) (pure white)
-
-moon :: Modeling ()
-moon = model $
- do sphere (Point3D 0 0 0) 0.2
- material $ pigment $ pattern (cloudy 8 0.05) [(0.0,pure slate_gray),(1.0,pure white)]
- regenerateNormals
-
-monolith :: Modeling ()
-monolith = model $
- do smoothbox 0.1 (Point3D 4 9 1) (Point3D (-4) (-9) (-1))
- affine (translate $ Vector3D 0 9 0)
- affine (scale' 0.20)
- material $
- do pigment $ pure blackbody
- specular 100 $ pure white
-
-ground :: Modeling ()
-ground = model $
- do closedDisc (Point3D 0 (-0.1) 0) (Vector3D 0 1 0) 30
- regenerateNormals
- material $ pigment $ pattern (cloudy 27 1.0) [(0.0,pure brown),(1.0,pure forest_green)]
- affine $ translate (Vector3D 0 (-0.1) 0)
-
-station :: Modeling ()
-station = model $
- do model $
- do torus 0.5 0.1
- openCone (Point3D (-0.5) 0 0,0.02) (Point3D 0.5 0 0,0.02)
- openCone (Point3D 0 0 (-0.5),0.02) (Point3D 0 0 0.5,0.02)
- closedCone (Point3D 0 0.2 0,0.2) (Point3D 0 (-0.2) 0,0.2)
- material $
- do pigment $ pure silver
- specular 100 $ pure silver
- model $
- do box (Point3D (-0.15) 0.19 (-0.05)) (Point3D 0.15 0.21 0.05)
- material $ emissive $ pure white
- sequence_ $ dropRandomElements 30 (mkStdGen 19) $ concatMap (rotationGroup (Vector3D 0 1 0) 40) $
- [window_box,
- transformAbout (Point3D 0.5 0 0) (rotateZ $ fromDegrees 25) window_box,
- transformAbout (Point3D 0.5 0 0) (rotateZ $ fromDegrees (-25)) window_box,
- transformAbout (Point3D 0.5 0 0) (rotateZ $ fromDegrees 50) window_box,
- transformAbout (Point3D 0.5 0 0) (rotateZ $ fromDegrees (-50)) window_box]
- where window_box = model $
- do quadralateral (Point3D 0.51 (-0.105) 0.03) (Point3D 0.49 (-0.105) 0.03)
- (Point3D 0.49 (-0.105) (-0.03)) (Point3D 0.51 (-0.105) (-0.03))
- quadralateral (Point3D 0.51 0.105 (-0.03)) (Point3D 0.49 0.105 (-0.03))
- (Point3D 0.49 0.105 0.03) (Point3D 0.51 0.105 0.03)
- material $
- do pigment $ pure black
- emissive $ pure white
- tesselationHintComplexity 0
- fixed (3,3)
-
-orb :: Modeling ()
-orb = model $
- do sor $ linearInterpolation $ points2d
- [(-0.001,0.4),
- (0.5,0.45),
- (0.5,0.4),
- (0.6,0.4),
- (0.6,0.6),
- (0.5,0.6),
- (0.5,0.55),
- (-0.001,0.6)]
- sequence_ $ rotationGroup (Vector3D 0 1 0) 5 $
- tube $ zipCurve (,) (pure 0.05) $ smoothCurve 3 0.4 $ loopedLinearInterpolation $ points3d
- [(0.4,0.2,0.4),
- (0.4,0.8,0.8),
- (-0.4,0.8,0.8),
- (-0.4,0.2,0.4)]
- regularPrism (Point3D 0 0.5 0,0.5) (Point3D 0 1.0 0,-0.001) 4
- material $
- do pigment $ pure gold
- specular 64 $ pure silver
-
-glow_orb :: Modeling ()
-glow_orb = translate (Vector3D 0 1 0) $
- do closedDisc (Point3D 0 0 0) (Vector3D 0 1 0) 1
- material $ emissive $ pattern (spherical (Point3D 0 0 0) 1) [(0.0,pure $ scaleRGB 1.5 white),(0.25,pure white),(0.95,pure blackbody)]
-
-orb_upper_leg :: Modeling ()
-orb_upper_leg = model $
- do tube $ zipCurve (,) (pure 0.05) $ linearInterpolation [Point3D 0 0 0,Point3D 0 0.1 0.5,Point3D 0 0 1]
- sphere (Point3D 0 0 1) 0.05
- material $
- do pigment $ pure gold
- specular 64 $ pure silver
-
-orb_lower_leg :: Modeling ()
-orb_lower_leg = model $
- do openCone (Point3D 0 0 0,0.05) (Point3D 0 0 1,0)
- material $
- do pigment $ pure gold
- specular 64 $ pure silver
-
-sky :: Modeling ()
-sky = model $
- do skyHemisphere (Point3D 0 0 0) (Vector3D 0 1 0) 1.0
- affine $ scale $ Vector3D 5 1 5
- material $ atmosphereScatteringMaterial earth_atmosphere [(rotate (Vector3D 0 0 1) (fromTimeOfDayHMS 0 15 0) $ Vector3D 1 0 0,gray 1)] (dynamicSkyFilter 0.2 1.0)
-
View
12 RSAGL/ProcessColors.hs → ProcessColors.hs
@@ -1,8 +1,8 @@
-module RSAGL.ProcessColors
+module Main
(main)
where
-import RSAGL.Material
+import RSAGL.Modeling.Material
import Control.Monad
import Data.List
import Numeric
@@ -20,8 +20,8 @@ cteToHaskell :: ColorTableEntry -> String
cteToHaskell (ColorTableEntry s r g b) = s ++ " :: RGB\n" ++ s ++ " = rgb256 " ++ (show r) ++ " " ++ (show g) ++ " " ++ (show b) ++ "\n"
wrapHaskellModule :: [ColorTableEntry] -> String -> String
-wrapHaskellModule cte s = ("module RSAGL.RSAGLColors (" ++ (listColors cte) ++ ") where") ++
- "\n\nimport RSAGL.Material\n\n" ++ s
+wrapHaskellModule cte s = ("module RSAGL.Modeling.RSAGLColors (" ++ (listColors cte) ++ ") where") ++
+ "\n\nimport RSAGL.Modeling.Material\n\n" ++ s
listColors :: [ColorTableEntry] -> String
listColors = concat . intersperse "," . map cte_name
@@ -57,5 +57,5 @@ colorTablesToHTML color_tables =
main :: IO ()
main = do color_tables <- liftM (map readColorTableEntry . lines) $ readFile "rsagl-rgb.txt"
- writeFile "RSAGL/RSAGLColors.hs" $ wrapHaskellModule color_tables $ (unlines . map cteToHaskell) color_tables
- writeFile "rsagl-rgb.html" $ wrapHTMLFile $ colorTablesToHTML color_tables
+ writeFile "RSAGL/Modeling/RSAGLColors.hs" $ wrapHaskellModule color_tables $ (unlines . map cteToHaskell) color_tables
+ writeFile "rsagl-rgb.html" $ wrapHTMLFile $ colorTablesToHTML color_tables
View
13 RSAGL/Animation.hs
@@ -0,0 +1,13 @@
+module RSAGL.Animation
+ (module RSAGL.Animation.AnimationExtras,
+ module RSAGL.Animation.Animation,
+ module RSAGL.Animation.InverseKinematics,
+ module RSAGL.Animation.Joint,
+ module RSAGL.Animation.KinematicSensors)
+ where
+
+import RSAGL.Animation.AnimationExtras
+import RSAGL.Animation.Animation
+import RSAGL.Animation.InverseKinematics
+import RSAGL.Animation.Joint
+import RSAGL.Animation.KinematicSensors
View
16 RSAGL/Animation.lhs → RSAGL/Animation/Animation.lhs
@@ -5,7 +5,7 @@ The \texttt{AniM} monad and the \texttt{AniA} arrow support frame time, affine t
\begin{code}
{-# LANGUAGE Arrows, MultiParamTypeClasses, FlexibleInstances, GeneralizedNewtypeDeriving #-}
-module RSAGL.Animation
+module RSAGL.Animation.Animation
(AniM,
TimePlusSceneAccumulator,
frameTime,
@@ -20,14 +20,14 @@ module RSAGL.Animation
runAnimationObject)
where
-import RSAGL.Time
-import RSAGL.Scene
+import RSAGL.FRP.Time
+import RSAGL.Scene.Scene
import Control.Monad.State
-import RSAGL.CoordinateSystems
-import RSAGL.Angle
-import RSAGL.Vector
-import RSAGL.Affine
-import RSAGL.FRP
+import RSAGL.Scene.CoordinateSystems
+import RSAGL.Math.Angle
+import RSAGL.Math.Vector
+import RSAGL.Math.Affine
+import RSAGL.FRP.FRP
import Control.Concurrent.MVar
import Control.Arrow.Transformer.State as StateArrow
\end{code}
View
24 RSAGL/AnimationExtras.lhs → RSAGL/Animation/AnimationExtras.lhs
@@ -3,7 +3,7 @@
\begin{code}
{-# LANGUAGE Arrows #-}
-module RSAGL.AnimationExtras
+module RSAGL.Animation.AnimationExtras
(rotationA,
animateA,
rotateA,
@@ -16,19 +16,19 @@ module RSAGL.AnimationExtras
accelerationModel)
where
-import RSAGL.Vector
-import RSAGL.FRP
-import RSAGL.Time
-import RSAGL.AbstractVector
+import RSAGL.Math.Vector
+import RSAGL.FRP.FRP
+import RSAGL.FRP.Time
+import RSAGL.Math.AbstractVector
import Control.Arrow
import Control.Arrow.Operations
-import RSAGL.CoordinateSystems
-import RSAGL.Affine
-import RSAGL.Angle
-import RSAGL.Scene
-import RSAGL.Model
-import RSAGL.Affine
-import RSAGL.WrappedAffine
+import RSAGL.Scene.CoordinateSystems
+import RSAGL.Math.Affine
+import RSAGL.Math.Angle
+import RSAGL.Scene.Scene
+import RSAGL.Modeling.Model
+import RSAGL.Math.Affine
+import RSAGL.Math.WrappedAffine
import Control.Monad
\end{code}
View
24 RSAGL/InverseKinematics.lhs → RSAGL/Animation/InverseKinematics.lhs
@@ -3,7 +3,7 @@
\begin{code}
{-# LANGUAGE Arrows, UndecidableInstances #-}
-module RSAGL.InverseKinematics
+module RSAGL.Animation.InverseKinematics
(leg,
Leg,
jointAnimation,
@@ -16,17 +16,17 @@ module RSAGL.InverseKinematics
import Control.Arrow
import Control.Arrow.Operations
import Data.Fixed
-import RSAGL.Vector
-import RSAGL.FRP
-import RSAGL.Affine
-import RSAGL.CoordinateSystems
-import RSAGL.KinematicSensors
-import RSAGL.Vector
-import RSAGL.Joint
-import RSAGL.Time
-import RSAGL.AbstractVector
-import RSAGL.Angle
-import RSAGL.Edge
+import RSAGL.Math.Vector
+import RSAGL.FRP.FRP
+import RSAGL.Math.Affine
+import RSAGL.Scene.CoordinateSystems
+import RSAGL.Animation.KinematicSensors
+import RSAGL.Math.Vector
+import RSAGL.Animation.Joint
+import RSAGL.FRP.Time
+import RSAGL.Math.AbstractVector
+import RSAGL.Math.Angle
+import RSAGL.FRP.Edge
\end{code}
\subsection{The Foot}
View
12 RSAGL/Joint.lhs → RSAGL/Animation/Joint.lhs
@@ -3,15 +3,15 @@
Joints are a basic essential element of the RSAGL inverse kinematics subsystem.
\begin{code}
-module RSAGL.Joint
+module RSAGL.Animation.Joint
(Joint(..),
joint) where
-import RSAGL.Vector
-import RSAGL.Affine
-import RSAGL.Interpolation
-import RSAGL.CoordinateSystems
-import RSAGL.Orthagonal
+import RSAGL.Math.Vector
+import RSAGL.Math.Affine
+import RSAGL.Math.Interpolation
+import RSAGL.Scene.CoordinateSystems
+import RSAGL.Math.Orthagonal
\end{code}
\texttt{Joint} is the result of computing a joint. It provides AffineTransformations that describe the orientations of the bases of the components of the joint.
View
10 RSAGL/KinematicSensors.lhs → RSAGL/Animation/KinematicSensors.lhs
@@ -3,16 +3,16 @@
These are various composable modules that provide physics information for the inverse kinematics system.
\begin{code}
-module RSAGL.KinematicSensors
+module RSAGL.Animation.KinematicSensors
(odometer)
where
import Control.Arrow
import Control.Arrow.Operations
-import RSAGL.Vector
-import RSAGL.FRP
-import RSAGL.CoordinateSystems
-import RSAGL.Time
+import RSAGL.Math.Vector
+import RSAGL.FRP.FRP
+import RSAGL.Scene.CoordinateSystems
+import RSAGL.FRP.Time
\end{code}
\subsection{Odometer}
View
2 RSAGL/ApplicativeWrapper.hs → RSAGL/Auxiliary/ApplicativeWrapper.hs
@@ -1,6 +1,6 @@
{-# LANGUAGE FlexibleContexts #-}
-module RSAGL.ApplicativeWrapper
+module RSAGL.Auxiliary.ApplicativeWrapper
(ApplicativeWrapper(..),
fromPure,
toApplicative,
View
2 RSAGL/Auxiliary.hs → RSAGL/Auxiliary/Auxiliary.hs
@@ -1,4 +1,4 @@
-module RSAGL.Auxiliary
+module RSAGL.Auxiliary.Auxiliary
(doubles,
loopedDoubles,
consecutives,
View
10 RSAGL/Extras/ColorPhysics.hs
@@ -4,10 +4,10 @@ module RSAGL.Extras.ColorPhysics
blackBodyRGB,
spectralRGB) where
-import RSAGL.Color
-import RSAGL.AbstractVector
-import RSAGL.Auxiliary
-import RSAGL.Interpolation
+import RSAGL.Modeling.Color
+import RSAGL.Math.AbstractVector
+import RSAGL.Auxiliary.Auxiliary
+import RSAGL.Math.Interpolation
-- | Evaluates planck's law respecting blackbody radiation.
-- Accepts temperature in Kelvins (K) and wavelength in nanometers (nm).
@@ -33,7 +33,7 @@ blackBodyRGB t = spectralRGB (blackBody t)
-- | Interprets a spectral function as an 'RGB' color by sampling in the red, green, blue, and indigo wavelengths.
-- This is pretty rough, and actually interprets monochromatic spectral yellow or monochromatic spectral cyan as
-- black, for example. It also does not take into account the relative responsiveness of the human eye to
--- red and green, for example, so passing @'plancksLaw' 5800@ directly to this function results in bright green.
+-- different wavelengths, so passing @'plancksLaw' 5800@ directly to this function results in bright green.
spectralRGB :: (Double -> Double) -> RGB
spectralRGB f = rgb
(abstractAverage $ (map (f . (flip lerp (625,740))) $ zeroToOne 5) ++ [f 415])
View
18 RSAGL/Extras/Sky.hs
@@ -14,21 +14,21 @@ module RSAGL.Extras.Sky
atmosphereScatteringMaterial)
where
-import RSAGL.Scattering
-import RSAGL.Ray
-import RSAGL.RayTrace
-import RSAGL.Vector
-import RSAGL.Color
-import RSAGL.Angle
-import RSAGL.ApplicativeWrapper
+import RSAGL.Math.Ray
+import RSAGL.RayTrace.RayTrace
+import RSAGL.RayTrace.Scattering
+import RSAGL.Math.Vector
+import RSAGL.Modeling.Color
+import RSAGL.Math.Angle
+import RSAGL.Auxiliary.ApplicativeWrapper
import Data.Monoid
import Data.Maybe as Maybe
import Data.List as List
import Data.Ord
-import qualified RSAGL.Model as Model
+import qualified RSAGL.Modeling.Model as Model
import Control.Monad
import System.Random
-import RSAGL.Model hiding (sphere)
+import RSAGL.Modeling.Model hiding (sphere)
-- | An atmosphere that is fairly typical of the earth.
earth_atmosphere :: Atmosphere
View
10 RSAGL/FRP.hs
@@ -0,0 +1,10 @@
+module RSAGL.FRP
+ (module RSAGL.FRP.Edge,
+ module RSAGL.FRP.FRP,
+ module RSAGL.FRP.Time)
+ where
+
+import RSAGL.FRP.Edge
+import RSAGL.FRP.FRP
+import RSAGL.FRP.Time
+
View
2 RSAGL/ArrowTransformerOptimizer.lhs → RSAGL/FRP/ArrowTransformerOptimizer.lhs
@@ -6,7 +6,7 @@ and representing pure computations as lifted pure computations.
\begin{code}
{-# LANGUAGE GADTs, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}
-module RSAGL.ArrowTransformerOptimizer
+module RSAGL.FRP.ArrowTransformerOptimizer
(ArrowTransformerOptimizer,
raw,
collapseArrowTransformer)
View
10 RSAGL/Edge.lhs → RSAGL/FRP/Edge.lhs
@@ -5,7 +5,7 @@ Edge detection works for all inputs that implement Eq, and is simply a mechanism
\begin{code}
{-# LANGUAGE Arrows #-}
-module RSAGL.Edge
+module RSAGL.FRP.Edge
(Edge(..),
edge,
edgeBy,
@@ -21,10 +21,10 @@ module RSAGL.Edge
started)
where
-import RSAGL.AbstractVector
-import RSAGL.FRP as FRP
-import RSAGL.SwitchedArrow as SwitchedArrow
-import RSAGL.Time
+import RSAGL.Math.AbstractVector
+import RSAGL.FRP.FRP as FRP
+import RSAGL.FRP.SwitchedArrow as SwitchedArrow
+import RSAGL.FRP.Time
import Control.Arrow
import Control.Arrow.Operations
import Control.Arrow.Transformer
View
48 RSAGL/FRP.lhs → RSAGL/FRP/FRP.lhs
@@ -13,17 +13,17 @@ and the arrow-embedding operations from FRPBase.
{-# LANGUAGE Arrows, UndecidableInstances, ExistentialQuantification, EmptyDataDecls, MultiParamTypeClasses, FlexibleInstances, Rank2Types #-}
-module RSAGL.FRP
+module RSAGL.FRP.FRP
(FRPX,
FRP1,
Threaded,
FRP,
- RSAGL.FRP.switchContinue,
- RSAGL.FRP.switchTerminate,
- RSAGL.FRP.spawnThreads,
- RSAGL.FRP.killThreadIf,
- RSAGL.FRP.statefulContext,
- RSAGL.FRP.threadIdentity,
+ RSAGL.FRP.FRP.switchContinue,
+ RSAGL.FRP.FRP.switchTerminate,
+ RSAGL.FRP.FRP.spawnThreads,
+ RSAGL.FRP.FRP.killThreadIf,
+ RSAGL.FRP.FRP.statefulContext,
+ RSAGL.FRP.FRP.threadIdentity,
frpTest,
FRPProgram,
newFRPProgram,
@@ -37,8 +37,8 @@ module RSAGL.FRP
threadTime,
frpContext,
frp1Context,
- RSAGL.FRP.withState,
- RSAGL.FRP.withExposedState,
+ RSAGL.FRP.FRP.withState,
+ RSAGL.FRP.FRP.withExposedState,
ThreadedArrow.ThreadIdentity,
ThreadedArrow.nullaryThreadIdentity,
ThreadedArrow.maybeThreadIdentity,
@@ -47,13 +47,13 @@ module RSAGL.FRP
where
import Prelude hiding ((.),id)
-import RSAGL.AbstractVector
-import RSAGL.Time
-import RSAGL.StatefulArrow as StatefulArrow
-import RSAGL.SwitchedArrow as SwitchedArrow
-import RSAGL.ThreadedArrow as ThreadedArrow
-import RSAGL.FRPBase as FRPBase
-import RSAGL.RK4
+import RSAGL.Math.AbstractVector
+import RSAGL.FRP.Time
+import RSAGL.FRP.StatefulArrow as StatefulArrow
+import RSAGL.FRP.SwitchedArrow as SwitchedArrow
+import RSAGL.FRP.ThreadedArrow as ThreadedArrow
+import RSAGL.FRP.FRPBase as FRPBase
+import RSAGL.Math.RK4
import Control.Category
import Control.Arrow
import Control.Arrow.Operations
@@ -141,7 +141,7 @@ statefulContext_ :: (Arrow a,ArrowChoice a,ArrowApply a) =>
StatefulArrow a (j,FRPState) (p,FRPState) -> FRPX any t i o a j p
statefulContext_ sa = proc i ->
do frpstate <- FRP (lift fetch) -< ()
- (o,frpstate') <- RSAGL.FRP.statefulContext sa -< (i,frpstate)
+ (o,frpstate') <- RSAGL.FRP.FRP.statefulContext sa -< (i,frpstate)
FRP (lift store) -< frpstate'
returnA -< o
\end{code}
@@ -153,14 +153,14 @@ withState :: (Arrow a,ArrowChoice a,ArrowApply a) =>
(forall x. j -> [(t,x)] -> [(t,(p,x))] -> [x]) ->
[(t,FRPX Threaded t j p (StateArrow s a) j p)] -> s -> FRPX any u i o a j [(t,p)]
withState manageThreads threads s = statefulContext_ $
- StatefulArrow.withState (RSAGL.FRP.statefulForm manageThreads threads) s
+ StatefulArrow.withState (RSAGL.FRP.FRP.statefulForm manageThreads threads) s
withExposedState :: (Arrow a,ArrowChoice a,ArrowApply a) =>
(forall x. j -> [(t,x)] -> [(t,(p,x))] -> [x]) ->
[(t,FRPX Threaded t j p (StateArrow s a) j p)] -> FRPX any u i o a (j,s) ([(t,p)],s)
-withExposedState manageThreads threads = RSAGL.FRP.statefulContext_ $
+withExposedState manageThreads threads = RSAGL.FRP.FRP.statefulContext_ $
(arr $ \((i,s),frpstate) -> ((i,frpstate),s))
- >>> (StatefulArrow.withExposedState $ RSAGL.FRP.statefulForm manageThreads threads)
+ >>> (StatefulArrow.withExposedState $ RSAGL.FRP.FRP.statefulForm manageThreads threads)
>>> (arr $ \((o,frpstate'),s') -> ((o,s'),frpstate'))
\end{code}
@@ -173,7 +173,7 @@ statefulForm :: (Arrow a,ArrowChoice a,ArrowApply a) =>
statefulForm manageThreads = StatefulArrow.withExposedState . FRPBase.statefulForm manageThreads . map (second fromFRP)
frpTest :: [FRP i o (->) i o] -> [i] -> [[o]]
-frpTest frps is = map (map snd . fst) $ runStateMachine (RSAGL.FRP.statefulForm nullaryThreadIdentity $ (map $ \x -> ((),x)) frps) $
+frpTest frps is = map (map snd . fst) $ runStateMachine (RSAGL.FRP.FRP.statefulForm nullaryThreadIdentity $ (map $ \x -> ((),x)) frps) $
zip is frp_test_states
frp_test_states :: [FRPState]
@@ -189,7 +189,7 @@ newFRPProgram :: (Arrow a,ArrowChoice a,ArrowApply a) =>
newFRPProgram manageThreads frps = newFRP1Program (frpContext manageThreads frps)
newFRP1Program :: (Arrow a,ArrowChoice a,ArrowApply a) => FRP1 i o a i o -> FRPProgram a i o
-newFRP1Program frp1 = FRPProgram (RSAGL.FRP.statefulForm nullaryThreadIdentity [((),frp1Context frp1)] >>> arr (first $ map snd)) Nothing
+newFRP1Program frp1 = FRPProgram (RSAGL.FRP.FRP.statefulForm nullaryThreadIdentity [((),frp1Context frp1)] >>> arr (first $ map snd)) Nothing
updateFRPProgram :: (Arrow a,ArrowChoice a,ArrowApply a) => FRPProgram a i o -> a (i,Time) (o,FRPProgram a i o)
updateFRPProgram (FRPProgram sa old_run) = proc (i,new_t) ->
@@ -262,9 +262,9 @@ your intention, you might use \texttt{whenJust <<< sticky isJust Nothing}.
whenJust :: (ArrowChoice a,ArrowApply a) => (forall x y. FRP1 x y a j p) -> FRPX any t i o a (Maybe j) (Maybe p)
whenJust actionA = frp1Context whenJust_
where whenJust_ = proc i ->
- do RSAGL.FRP.switchContinue -< (maybe (Just whenNothing_) (const Nothing) i,i)
+ do RSAGL.FRP.FRP.switchContinue -< (maybe (Just whenNothing_) (const Nothing) i,i)
arr (Just) <<< actionA -< fromMaybe (error "whenJust: impossible case") i
whenNothing_ = proc i ->
- do RSAGL.FRP.switchContinue -< (fmap (const whenJust_) i,i)
+ do RSAGL.FRP.FRP.switchContinue -< (fmap (const whenJust_) i,i)
returnA -< Nothing
\end{code}
View
34 RSAGL/FRPBase.hs → RSAGL/FRP/FRPBase.hs
@@ -1,24 +1,24 @@
{-# LANGUAGE Arrows, MultiParamTypeClasses, ExistentialQuantification, FlexibleInstances, Rank2Types #-}
-- | The 'FRPBase' arrow is a composite of the 'StatefulArrow' and 'ThreadedArrow' intended to support functional reactive programming.
-module RSAGL.FRPBase
+module RSAGL.FRP.FRPBase
(FRPBase,
-- * Switching Operators
- RSAGL.FRPBase.switchContinue,
- RSAGL.FRPBase.switchTerminate,
+ RSAGL.FRP.FRPBase.switchContinue,
+ RSAGL.FRP.FRPBase.switchTerminate,
-- * Threading Operators
- RSAGL.FRPBase.spawnThreads,
- RSAGL.FRPBase.killThreadIf,
- RSAGL.FRPBase.threadIdentity,
+ RSAGL.FRP.FRPBase.spawnThreads,
+ RSAGL.FRP.FRPBase.killThreadIf,
+ RSAGL.FRP.FRPBase.threadIdentity,
-- * Embedding One FRPBase Instance in Another
- RSAGL.FRPBase.frpBaseContext,
+ RSAGL.FRP.FRPBase.frpBaseContext,
-- * Embedding Explicit Underlying State
- RSAGL.FRPBase.withState,
- RSAGL.FRPBase.withExposedState,
+ RSAGL.FRP.FRPBase.withState,
+ RSAGL.FRP.FRPBase.withExposedState,
-- * Embedding a StatefulArrow in an FRPBase Arrow
- RSAGL.FRPBase.statefulContext,
+ RSAGL.FRP.FRPBase.statefulContext,
-- * The StatefulArrow form of an FRPBase Arrow
- RSAGL.FRPBase.statefulForm)
+ RSAGL.FRP.FRPBase.statefulForm)
where
import Prelude hiding ((.),id)
@@ -27,9 +27,9 @@ import Data.Monoid
import Control.Arrow
import Control.Arrow.Transformer
import Control.Arrow.Transformer.State
-import RSAGL.StatefulArrow as StatefulArrow
-import RSAGL.ThreadedArrow as ThreadedArrow
-import RSAGL.ArrowTransformerOptimizer
+import RSAGL.FRP.StatefulArrow as StatefulArrow
+import RSAGL.FRP.ThreadedArrow as ThreadedArrow
+import RSAGL.FRP.ArrowTransformerOptimizer
-- | FRPBase is a composite arrow in which the StatefulArrow is layered on top of the ThreadedArrow.
newtype FRPBase t i o a j p = FRPBase (
@@ -74,19 +74,19 @@ threadIdentity = FRPBase $ lift ThreadedArrow.threadIdentity
frpBaseContext :: (Arrow a,ArrowChoice a,ArrowApply a) =>
(forall x. j -> [(t,x)] -> [(t,(p,x))] -> [x]) ->
[(t,FRPBase t j p a j p)] -> FRPBase u i o a j [(t,p)]
-frpBaseContext manageThreads threads = FRPBase $ raw $ statefulTransform lift (RSAGL.FRPBase.statefulForm manageThreads threads)
+frpBaseContext manageThreads threads = FRPBase $ raw $ statefulTransform lift (RSAGL.FRP.FRPBase.statefulForm manageThreads threads)
-- | See 'RSAGL.StatefulArrow.withState'.
withState :: (Arrow a,ArrowChoice a,ArrowApply a,Monoid p) =>
(forall x. j -> [(t,x)] -> [(t,(p,x))] -> [x]) ->
[(t,FRPBase t j p (StateArrow s a) j p)] -> s -> FRPBase t i o a j [(t,p)]
-withState manageThreads threads s = FRPBase $ raw $ statefulTransform lift $ StatefulArrow.withState (RSAGL.FRPBase.statefulForm manageThreads threads) s
+withState manageThreads threads s = FRPBase $ raw $ statefulTransform lift $ StatefulArrow.withState (RSAGL.FRP.FRPBase.statefulForm manageThreads threads) s
-- | See 'RSAGL.StatefulArrow.withExposedState'
withExposedState :: (Arrow a,ArrowChoice a,ArrowApply a,Monoid p) =>
(forall x. j -> [(t,x)] -> [(t,(p,x))] -> [x]) ->
[(t,FRPBase t j p (StateArrow s a) j p)] -> FRPBase t i o a (j,s) ([(t,p)],s)
-withExposedState manageThreads threads = statefulContext $ StatefulArrow.withExposedState $ RSAGL.FRPBase.statefulForm manageThreads threads
+withExposedState manageThreads threads = statefulContext $ StatefulArrow.withExposedState $ RSAGL.FRP.FRPBase.statefulForm manageThreads threads
-- | The 'statefulContext' combinator allows a 'StatefulArrow' to be embedded in an 'FRPBase', with
-- the provision that the 'StatefulArrow' does not have access to the threading operators.
View
2 RSAGL/StatefulArrow.lhs → RSAGL/FRP/StatefulArrow.lhs
@@ -9,7 +9,7 @@ that will be evaluated on the next iteration.
\begin{code}
{-# LANGUAGE Arrows, ExistentialQuantification, MultiParamTypeClasses, FlexibleInstances, Rank2Types #-}
-module RSAGL.StatefulArrow
+module RSAGL.FRP.StatefulArrow
(StatefulArrow(..),
StatefulFunction,
stateContext,
View
10 RSAGL/SwitchedArrow.lhs → RSAGL/FRP/SwitchedArrow.lhs
@@ -10,19 +10,19 @@ execution of the current iteration of) the switched arrow.
\begin{code}
{-# LANGUAGE Arrows, MultiParamTypeClasses, FlexibleInstances #-}
-module RSAGL.SwitchedArrow
+module RSAGL.FRP.SwitchedArrow
(SwitchedArrow,
SwitchedFunction,
switchContinue,
switchTerminate,
statefulForm,
runStateful,
- RSAGL.SwitchedArrow.withState,
- RSAGL.SwitchedArrow.withExposedState)
+ RSAGL.FRP.SwitchedArrow.withState,
+ RSAGL.FRP.SwitchedArrow.withExposedState)
where
import Prelude hiding ((.),id)
-import RSAGL.StatefulArrow as StatefulArrow
+import RSAGL.FRP.StatefulArrow as StatefulArrow
import Control.Arrow.Operations
import Control.Arrow.Transformer.Error
import Control.Arrow.Transformer.State
@@ -111,7 +111,7 @@ withState :: (Arrow a,ArrowChoice a,ArrowApply a) =>
withState switch2 f = StatefulArrow.withState (statefulForm switch1) (error "withState: undefined")
where switch1 = proc i ->
do lift store -< f i
- RSAGL.SwitchedArrow.switchContinue -< (Just switch2,i)
+ RSAGL.FRP.SwitchedArrow.switchContinue -< (Just switch2,i)
returnA -< error "withState: unreachable code"
withExposedState :: (Arrow a,ArrowChoice a,ArrowApply a) =>
View
12 RSAGL/ThreadedArrow.lhs → RSAGL/FRP/ThreadedArrow.lhs
@@ -12,19 +12,19 @@ it provides neither parallelism nor concurency.
\begin{code}
{-# LANGUAGE Arrows, ExistentialQuantification, Rank2Types, MultiParamTypeClasses, FlexibleInstances #-}
-module RSAGL.ThreadedArrow
+module RSAGL.FRP.ThreadedArrow
(ThreadIdentity,
nullaryThreadIdentity,
maybeThreadIdentity,
unionThreadIdentity,
ThreadedFunction,
ThreadedArrow,
- RSAGL.ThreadedArrow.switchContinue,
- RSAGL.ThreadedArrow.switchTerminate,
+ RSAGL.FRP.ThreadedArrow.switchContinue,
+ RSAGL.FRP.ThreadedArrow.switchTerminate,
spawnThreads,
killThreadIf,
threadIdentity,
- RSAGL.ThreadedArrow.statefulForm)
+ RSAGL.FRP.ThreadedArrow.statefulForm)
where
import Prelude hiding ((.),id)
@@ -33,8 +33,8 @@ import Control.Arrow
import Control.Arrow.Operations
import Control.Arrow.Transformer
import Control.Arrow.Transformer.State
-import RSAGL.SwitchedArrow as SwitchedArrow
-import RSAGL.StatefulArrow as StatefulArrow
+import RSAGL.FRP.SwitchedArrow as SwitchedArrow
+import RSAGL.FRP.StatefulArrow as StatefulArrow
import Data.Maybe
import Data.List
View
6 RSAGL/Time.lhs → RSAGL/FRP/Time.lhs
@@ -9,7 +9,7 @@ This time library is designed to support real-time animation.
\begin{code}
{-# LANGUAGE TypeSynonymInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses #-}
-module RSAGL.Time
+module RSAGL.FRP.Time
(Time,
Rate,
Acceleration,
@@ -35,12 +35,12 @@ module RSAGL.Time
withTime)
where
-import RSAGL.AbstractVector
+import RSAGL.Math.AbstractVector
import System.Time
import Control.Monad
import Data.Fixed
import Data.Ratio
-import RSAGL.Affine
+import RSAGL.Math.Affine
newtype Time = Time Pico deriving (Show,Eq,Ord)
newtype Rate a = Rate a deriving (Show,Eq,Ord,AffineTransformable)
View
23 RSAGL/Math.hs
@@ -0,0 +1,23 @@
+module RSAGL.Math (
+ module RSAGL.Math.AbstractVector,
+ module RSAGL.Math.Affine,
+ module RSAGL.Math.Angle,
+ module RSAGL.Math.Curve,
+ module RSAGL.Math.Interpolation,
+ module RSAGL.Math.Matrix,
+ module RSAGL.Math.Orthagonal,
+ module RSAGL.Math.Ray,
+ module RSAGL.Math.RK4,
+ module RSAGL.Math.Vector)
+ where
+
+import RSAGL.Math.AbstractVector
+import RSAGL.Math.Affine
+import RSAGL.Math.Angle
+import RSAGL.Math.Curve
+import RSAGL.Math.Interpolation
+import RSAGL.Math.Matrix
+import RSAGL.Math.Orthagonal
+import RSAGL.Math.Ray
+import RSAGL.Math.RK4
+import RSAGL.Math.Vector
View
4 RSAGL/AbstractVector.lhs → RSAGL/Math/AbstractVector.lhs
@@ -4,7 +4,7 @@ The \texttt{AbstractVector} typeclass provides some basic operations sufficient
\begin{code}
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, UndecidableInstances #-}
-module RSAGL.AbstractVector
+module RSAGL.Math.AbstractVector
(AbstractVector,
AbstractZero(..),
AbstractAdd(..),
@@ -20,7 +20,7 @@ module RSAGL.AbstractVector
import Data.Fixed
import Data.List
import Control.Applicative
-import RSAGL.ApplicativeWrapper
+import RSAGL.Auxiliary.ApplicativeWrapper
\end{code}
\subsection{Abstract Vectors and Differences}
View
38 RSAGL/Affine.hs → RSAGL/Math/Affine.hs
@@ -1,5 +1,5 @@
-- | Affine Transformations of Arbitrary Geometric Objects
-module RSAGL.Affine
+module RSAGL.Math.Affine
(AffineTransformable(..),
scale',
inverseTransform,
@@ -11,16 +11,16 @@ module RSAGL.Affine
where
import Graphics.Rendering.OpenGL.GL as GL hiding (R)
-import RSAGL.Vector
-import RSAGL.Matrix
-import RSAGL.Angle
-import RSAGL.Homogenous
+import RSAGL.Math.Vector
+import RSAGL.Math.Matrix
+import RSAGL.Math.Angle
+import RSAGL.Math.Homogenous
import Data.Maybe
-- | 'AffineTransformable' objects are subject to affine transformations using matrix multiplication.
class AffineTransformable a where
-- | Apply an affine transformation, defined by a 4x4 matrix. (This is the only required method.)
- transform :: RSAGL.Matrix.Matrix -> a -> a
+ transform :: RSAGL.Math.Matrix.Matrix -> a -> a
-- | Scale an entity along the @x@ @y@ and @z@ axes. For example, @scale (Vector3D 2 3 4)@ will make an object twice as wide, three times as tall,
-- and four times as deep. It may be helpful to think of the vector as a control point on the vertex of a unit cube.
scale :: Vector3D -> a -> a
@@ -34,30 +34,30 @@ class AffineTransformable a where
rotate vector angle = transform $ rotationMatrix vector angle
-- | Specific rotation around the x-axis.
rotateX :: Angle -> a -> a
- rotateX = RSAGL.Affine.rotate (Vector3D 1 0 0)
+ rotateX = RSAGL.Math.Affine.rotate (Vector3D 1 0 0)
-- | Specific rotation around the y-axis.
rotateY :: Angle -> a -> a
- rotateY = RSAGL.Affine.rotate (Vector3D 0 1 0)
+ rotateY = RSAGL.Math.Affine.rotate (Vector3D 0 1 0)
-- | Specific rotation around the z-axis.
rotateZ :: Angle -> a -> a
- rotateZ = RSAGL.Affine.rotate (Vector3D 0 0 1)
+ rotateZ = RSAGL.Math.Affine.rotate (Vector3D 0 0 1)
-- | Apply the inverse of an affine transformation, defined by a 4x4 matrix.
{-# INLINE inverseTransform #-}
-inverseTransform :: (AffineTransformable a) => RSAGL.Matrix.Matrix -> a -> a
+inverseTransform :: (AffineTransformable a) => RSAGL.Math.Matrix.Matrix -> a -> a
inverseTransform m = transform (matrixInverse m)
-- | Specific scale preserving proportions.
{-# INLINE scale' #-}
scale' :: (AffineTransformable a) => Double -> a -> a
-scale' x = RSAGL.Affine.scale (Vector3D x x x)
+scale' x = RSAGL.Math.Affine.scale (Vector3D x x x)
-- | Apply a function under an affine transformation. @withTransformation m id@ is an identity if @m@ is invertable.
{-# INLINE withTransformation #-}
-withTransformation :: (AffineTransformable a) => RSAGL.Matrix.Matrix -> (a -> a) -> a -> a
+withTransformation :: (AffineTransformable a) => RSAGL.Math.Matrix.Matrix -> (a -> a) -> a -> a
withTransformation m f = inverseTransform m . f . transform m
--- | Apply a function treating a particular point as the origin. For example, combining 'transformAbout' with 'RSAGL.Affine.rotate'
+-- | Apply a function treating a particular point as the origin. For example, combining 'transformAbout' with 'RSAGL.Math.Affine.rotate'
-- performs a rotation about an arbitrary point rather than the origin.
{-# INLINE transformAbout #-}
transformAbout :: (AffineTransformable a) => Point3D -> (a -> a) -> a -> a
@@ -68,19 +68,19 @@ transformAbout center f = withTransformation (translateToFrom origin_point_3d ce
-- and the first point as the desired position of the model.
{-# INLINE translateToFrom #-}
translateToFrom :: (AffineTransformable a) => Point3D -> Point3D -> a -> a
-translateToFrom a b = RSAGL.Affine.translate (vectorToFrom a b)
+translateToFrom a b = RSAGL.Math.Affine.translate (vectorToFrom a b)
-- | Specific rotation along the shortest path that brings the second vector in line with the first.
{-# INLINE rotateToFrom #-}
rotateToFrom :: (AffineTransformable a) => Vector3D -> Vector3D -> a -> a
-rotateToFrom u v = RSAGL.Affine.rotate c a
+rotateToFrom u v = RSAGL.Math.Affine.rotate c a
where c = vectorNormalize $ vectorScale (-1) $ fromMaybe (fst $ orthos u) $ aNonZeroVector $ crossProduct u v
a = angleBetween u v
-- | Specific scale along an arbitary axis.
{-# INLINE scaleAlong #-}
scaleAlong :: (AffineTransformable a) => Vector3D -> Double -> a -> a
-scaleAlong v u = withTransformation (rotateToFrom (Vector3D 0 1 0) v $ identityMatrix 4) (RSAGL.Affine.scale (Vector3D 1 u 1))
+scaleAlong v u = withTransformation (rotateToFrom (Vector3D 0 1 0) v $ identityMatrix 4) (RSAGL.Math.Affine.scale (Vector3D 1 u 1))
instance AffineTransformable a => AffineTransformable (Maybe a) where
transform m = fmap (transform m)
@@ -94,7 +94,7 @@ instance (AffineTransformable a,AffineTransformable b) => AffineTransformable (a
instance (AffineTransformable a,AffineTransformable b,AffineTransformable c) => AffineTransformable (a,b,c) where
transform m (a,b,c) = (transform m a,transform m b,transform m c)
-instance AffineTransformable RSAGL.Matrix.Matrix where
+instance AffineTransformable RSAGL.Math.Matrix.Matrix where
transform mat = matrixMultiply mat
instance AffineTransformable Vector3D where
@@ -126,8 +126,8 @@ instance AffineTransformable Point3D where
c = cosine a
instance AffineTransformable SurfaceVertex3D where
- transform m (SurfaceVertex3D p v) = SurfaceVertex3D (RSAGL.Affine.transform m p) (RSAGL.Affine.transform (matrixTranspose $ matrixInverse m) v)
- translate vector (SurfaceVertex3D p v) = SurfaceVertex3D (RSAGL.Affine.translate vector p) v
+ transform m (SurfaceVertex3D p v) = SurfaceVertex3D (RSAGL.Math.Affine.transform m p) (RSAGL.Math.Affine.transform (matrixTranspose $ matrixInverse m) v)
+ translate vector (SurfaceVertex3D p v) = SurfaceVertex3D (RSAGL.Math.Affine.translate vector p) v
-- | The IO monad itself is AffineTransformable. This is done by wrapping the IO action in an OpenGL transformation.
instance AffineTransformable (IO a) where
View
4 RSAGL/Angle.hs → RSAGL/Math/Angle.hs
@@ -1,5 +1,5 @@
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
-module RSAGL.Angle
+module RSAGL.Math.Angle
(Angle,
BoundAngle(..),
fromDegrees,
@@ -34,7 +34,7 @@ module RSAGL.Angle
where
import Data.Fixed
-import RSAGL.AbstractVector
+import RSAGL.Math.AbstractVector
-- | An angular value.
newtype Angle = Radians Double deriving (Show)
View
16 RSAGL/Curve.hs → RSAGL/Math/Curve.hs
@@ -1,5 +1,5 @@
{-# LANGUAGE GeneralizedNewtypeDeriving, ExistentialQuantification, Rank2Types #-}
-module RSAGL.Curve
+module RSAGL.Math.Curve
(Curve,
zipCurve,
iterateCurve,
@@ -41,18 +41,18 @@ module RSAGL.Curve
integrateCurve)
where
-import RSAGL.Vector
-import RSAGL.Angle
-import RSAGL.Auxiliary
-import RSAGL.Affine
+import RSAGL.Math.Vector
+import RSAGL.Math.Angle
+import RSAGL.Auxiliary.Auxiliary
+import RSAGL.Math.Affine
import Data.List
import Data.Maybe
import Control.Parallel.Strategies
import Control.Applicative
-import RSAGL.AbstractVector
+import RSAGL.Math.AbstractVector
import Debug.Trace
-import RSAGL.BoundingBox
-import RSAGL.Interpolation
+import RSAGL.Modeling.BoundingBox
+import RSAGL.Math.Interpolation
import Data.Fixed
-- | A parametric function that is aware of it's own sampling interval. The first parameter is the sampling interval, while the second is the curve input parameter.
View
16 RSAGL/CurveExtras.lhs → RSAGL/Math/CurveExtras.lhs
@@ -1,7 +1,7 @@
\section{Specific and Interpolated Curves}
\begin{code}
-module RSAGL.CurveExtras
+module RSAGL.Math.CurveExtras
(sphericalCoordinates,
cylindricalCoordinates,
toroidalCoordinates,
@@ -17,13 +17,13 @@ module RSAGL.CurveExtras
loopCurve)
where
-import RSAGL.Curve
-import RSAGL.Interpolation
-import RSAGL.Vector
-import RSAGL.Angle
-import RSAGL.Auxiliary
-import RSAGL.AbstractVector
-import RSAGL.Affine
+import RSAGL.Math.Curve
+import RSAGL.Math.Interpolation
+import RSAGL.Math.Vector
+import RSAGL.Math.Angle
+import RSAGL.Auxiliary.Auxiliary
+import RSAGL.Math.AbstractVector
+import RSAGL.Math.Affine
import Control.Arrow
\end{code}
View
6 RSAGL/Homogenous.hs → RSAGL/Math/Homogenous.hs
@@ -1,10 +1,10 @@
-module RSAGL.Homogenous
+module RSAGL.Math.Homogenous
(Homogenous(..),
transformHomogenous)
where
-import RSAGL.Vector
-import RSAGL.Matrix
+import RSAGL.Math.Vector
+import RSAGL.Math.Matrix
-- | Entities such as points and vectors that can be represented as matrices. The 'Homogenous' typeclass is
-- an easy way to implement affine transformations on these types.
View
4 RSAGL/Interpolation.lhs → RSAGL/Math/Interpolation.lhs
@@ -1,7 +1,7 @@
\section{RSAGL.Interpolation}
\begin{code}
-module RSAGL.Interpolation
+module RSAGL.Math.Interpolation
(lerp,
lerpClamped,
lerpBetween,
@@ -12,7 +12,7 @@ module RSAGL.Interpolation
lerpMap)
where
-import RSAGL.AbstractVector
+import RSAGL.Math.AbstractVector
import Data.Ord
import Data.Map as Map
import Data.Maybe
View
6 RSAGL/Matrix.lhs → RSAGL/Math/Matrix.lhs
@@ -2,7 +2,7 @@
\begin{code}
-module RSAGL.Matrix
+module RSAGL.Math.Matrix
(Matrix,
matrix,
columnMatrix4,
@@ -27,8 +27,8 @@ module RSAGL.Matrix
where
import Data.List
-import RSAGL.Angle
-import RSAGL.Vector
+import RSAGL.Math.Angle
+import RSAGL.Math.Vector
import Data.Array.ST
import Data.Array.Base
\end{code}
View
10 RSAGL/Orthagonal.lhs → RSAGL/Math/Orthagonal.lhs
@@ -4,16 +4,16 @@ It's useful to work with the set of coordinate systems restricted to those that
This is because these coordinate systems are the only ones that describe rigid objects.
\begin{code}
-module RSAGL.Orthagonal
+module RSAGL.Math.Orthagonal
(up,down,left,right,forward,backward,
orthagonalFrame,
modelLookAt,
FUR)
where
-import RSAGL.Affine
-import RSAGL.Vector
-import RSAGL.Matrix
+import RSAGL.Math.Affine
+import RSAGL.Math.Vector
+import RSAGL.Math.Matrix
\end{code}
\texttt{FUR} stands for Forward Up Right. It's used to specify arbitrary orthagonal coordinate systems given any combination
@@ -77,7 +77,7 @@ third parameter will \texttt{(up \$ Vector3D 0 1 0)}.
\begin{code}
modelLookAt :: (AffineTransformable a) => Point3D -> FUR (Either Point3D Vector3D) -> FUR (Either Point3D Vector3D) -> a -> a
-modelLookAt pos primaryish secondaryish = RSAGL.Affine.translate (vectorToFrom pos origin_point_3d) . orthagonalFrame primary secondary
+modelLookAt pos primaryish secondaryish = RSAGL.Math.Affine.translate (vectorToFrom pos origin_point_3d) . orthagonalFrame primary secondary
where primary = fmap (either (`vectorToFrom` pos) id) primaryish
secondary = fmap (either (`vectorToFrom` pos) id) secondaryish
\end{code}
View
8 RSAGL/RK4.lhs → RSAGL/Math/RK4.lhs
@@ -3,15 +3,15 @@
Haskell implementation of RK4.
\begin{code}
-module RSAGL.RK4
+module RSAGL.Math.RK4
(rk4,
integrateRK4,
rk4',
integrateRK4')
where
-import RSAGL.AbstractVector
-import RSAGL.Time
+import RSAGL.Math.AbstractVector
+import RSAGL.FRP.Time
\end{code}
\begin{code}
@@ -44,4 +44,4 @@ integrateRK4 addPV diffF = genericIntegrate $ rk4 addPV diffF
integrateRK4' :: (AbstractVector v) => (p -> v -> p) -> (Time -> p -> Rate v -> Acceleration v) -> (p,Rate v) -> Time -> Time -> Integer -> (p,Rate v)
integrateRK4' addPV diffF = genericIntegrate $ rk4' addPV diffF
-\end{code}
+\end{code}
View
8 RSAGL/Ray.lhs → RSAGL/Math/Ray.lhs
@@ -1,17 +1,17 @@
\section{Ray.hs}
\begin{code}
-module RSAGL.Ray
+module RSAGL.Math.Ray
(Ray3D(..),
projectRay,
distanceAlong,
angleFrom,
normalizeRay)
where
-import RSAGL.Vector
-import RSAGL.Angle
-import RSAGL.Affine
+import RSAGL.Math.Vector
+import RSAGL.Math.Angle
+import RSAGL.Math.Affine
\end{code}
\subsection{Rays in 3-space}
View
8 RSAGL/Vector.lhs → RSAGL/Math/Vector.lhs
@@ -2,7 +2,7 @@
\begin{code}
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FunctionalDependencies, PatternGuards #-}
-module RSAGL.Vector
+module RSAGL.Math.Vector
(Point3D(..),
origin_point_3d,
Vector3D(..),
@@ -42,10 +42,10 @@ module RSAGL.Vector
import Data.Maybe
import Control.Parallel.Strategies
-import RSAGL.Angle
-import RSAGL.Auxiliary
+import RSAGL.Math.Angle
+import RSAGL.Auxiliary.Auxiliary
import System.Random
-import RSAGL.AbstractVector
+import RSAGL.Math.AbstractVector
\end{code}
\subsection{Generic 3-dimensional types and operations}
View
6 RSAGL/WrappedAffine.hs → RSAGL/Math/WrappedAffine.hs
@@ -1,11 +1,11 @@
-module RSAGL.WrappedAffine
+module RSAGL.Math.WrappedAffine
(WrappedAffine(..),
wrapAffine,
unwrapAffine)
where
-import RSAGL.Affine
-import RSAGL.CoordinateSystems
+import RSAGL.Math.Affine
+import RSAGL.Scene.CoordinateSystems
-- | WrappedAffine stores up affine transformations that are commited only when the entity is unwrapped. In this way we can store affine transformations
-- for entities that can not be directly transformed, or for which delaying transformation an optimization.
View
13 RSAGL/Modeling.hs
@@ -0,0 +1,13 @@
+module RSAGL.Modeling
+ (module RSAGL.Modeling.BoundingBox,
+ module RSAGL.Modeling.Deformation,
+ module RSAGL.Modeling.Extrusion,
+ module RSAGL.Modeling.ModelingExtras,
+ module RSAGL.Modeling.Model)
+ where
+
+import RSAGL.Modeling.BoundingBox
+import RSAGL.Modeling.Deformation
+import RSAGL.Modeling.Extrusion
+import RSAGL.Modeling.ModelingExtras
+import RSAGL.Modeling.Model
View
6 RSAGL/BakedModel.hs → RSAGL/Modeling/BakedModel.hs
@@ -1,4 +1,4 @@
-module RSAGL.BakedModel
+module RSAGL.Modeling.BakedModel
(BakedSurface,
bakeSurface,
freeSurface,
@@ -12,8 +12,8 @@ import Graphics.Rendering.OpenGL.GL.VertexSpec
import Graphics.Rendering.OpenGL.GL.BeginEnd
import Graphics.Rendering.OpenGL.GL.StateVar
import Graphics.Rendering.OpenGL.GL.BasicTypes
-import RSAGL.OpenGLPrimitives
-import RSAGL.Tesselation hiding (tesselatedElementToOpenGL)
+import RSAGL.Modeling.OpenGLPrimitives
+import RSAGL.Modeling.Tesselation hiding (tesselatedElementToOpenGL)
import Control.Monad
data BakedFragment = BakedFragment {
View
8 RSAGL/BoundingBox.lhs → RSAGL/Modeling/BoundingBox.lhs
@@ -3,16 +3,16 @@
Implements simple bounding boxes and spheres.
\begin{code}
-module RSAGL.BoundingBox
+module RSAGL.Modeling.BoundingBox
(BoundingBox,
Bound3D(..),
boundingCenterRadius,
minimalDistanceToBoundingBox)
where
-import RSAGL.Vector
-import RSAGL.Interpolation
-import RSAGL.Affine
+import RSAGL.Math.Vector
+import RSAGL.Math.Interpolation
+import RSAGL.Math.Affine
import Data.List
data BoundingBox = BoundingBox {
View
6 RSAGL/Color.lhs → RSAGL/Modeling/Color.lhs
@@ -2,7 +2,7 @@
\begin{code}
{-# LANGUAGE MultiParamTypeClasses #-}
-module RSAGL.Color
+module RSAGL.Modeling.Color
(RGB(..),
RGBA(..),
rgba,
@@ -28,8 +28,8 @@ module RSAGL.Color
import Control.Parallel.Strategies
import Graphics.Rendering.OpenGL.GL.VertexSpec
-import RSAGL.AbstractVector
-import RSAGL.Interpolation
+import RSAGL.Math.AbstractVector
+import RSAGL.Math.Interpolation
\end{code}
\texttt{addColor} paints a color on top of another color using the additive color system. For example, \texttt{red `addColor` green == yellow}.
View
12 RSAGL/Deformation.lhs → RSAGL/Modeling/Deformation.lhs
@@ -7,15 +7,15 @@ The \texttt{Deformation} typeclass describes any affine or non-affine transforma
\begin{code}
{-# OPTIONS_GHC -fglasgow-exts #-}
-module RSAGL.Deformation
+module RSAGL.Modeling.Deformation
(Deformation,DeformationClass(..),constrain)
where
-import RSAGL.Vector
-import RSAGL.Matrix
-import RSAGL.Affine
-import RSAGL.Auxiliary
-import RSAGL.CoordinateSystems
+import RSAGL.Math.Vector
+import RSAGL.Math.Matrix
+import RSAGL.Math.Affine
+import RSAGL.Auxiliary.Auxiliary
+import RSAGL.Scene.CoordinateSystems
type Deformation = Either (SurfaceVertex3D -> Point3D) (SurfaceVertex3D -> SurfaceVertex3D)
View
14 RSAGL/Extrusion.lhs → RSAGL/Modeling/Extrusion.lhs
@@ -1,19 +1,19 @@
\section{Extrusions}
\begin{code}
-module RSAGL.Extrusion
+module RSAGL.Modeling.Extrusion
(extrude,
extrudeTube,
extrudePrism)
where
-import RSAGL.Curve
-import RSAGL.CurveExtras
-import RSAGL.Vector
-import RSAGL.Affine
+import RSAGL.Math.Curve
+import RSAGL.Math.CurveExtras
+import RSAGL.Math.Vector
+import RSAGL.Math.Affine
import Control.Applicative
-import RSAGL.CoordinateSystems
-import RSAGL.Orthagonal
+import RSAGL.Scene.CoordinateSystems
+import RSAGL.Math.Orthagonal
import Data.Maybe
\end{code}
View
12 RSAGL/Material.hs → RSAGL/Modeling/Material.hs
@@ -4,20 +4,20 @@
-- including procedural textures but not including anything touching the normal vector, such
-- as bumpiness. Materials are handled using layers.
--
-module RSAGL.Material
- (module RSAGL.Color,
+module RSAGL.Modeling.Material
+ (module RSAGL.Modeling.Color,
MaterialLayer,MaterialSurface,Material,materialIsEmpty,
toLayers,materialLayerSurface,materialLayerRelevant,materialComplexity,materialLayerToOpenGLWrapper,
isOpaqueLayer,
- diffuseLayer,RSAGL.Material.specularLayer,transparentLayer,emissiveLayer,filteringLayer)
+ diffuseLayer,RSAGL.Modeling.Material.specularLayer,transparentLayer,emissiveLayer,filteringLayer)
where
import Data.Maybe
import Data.Monoid
import Control.Applicative
-import RSAGL.Color
-import RSAGL.Curve
-import RSAGL.ApplicativeWrapper
+import RSAGL.Modeling.Color
+import RSAGL.Math.Curve
+import RSAGL.Auxiliary.ApplicativeWrapper
import Control.Parallel.Strategies
import Graphics.Rendering.OpenGL.GL.Colors
import Graphics.Rendering.OpenGL.GL.StateVar
View
43 RSAGL/Model.lhs → RSAGL/Modeling/Model.lhs
@@ -5,7 +5,7 @@ RSAGL.Model seeks to provide a complete set of high-level modelling primitives f
\begin{code}
{-# OPTIONS_GHC -fglasgow-exts #-}
-module RSAGL.Model
+module RSAGL.Modeling.Model
(Model,
Modeling,
ModelingM,
@@ -55,24 +55,20 @@ module RSAGL.Model
deform)
where
-import RSAGL.Curve
-import RSAGL.CurveExtras
-import RSAGL.Auxiliary
+import RSAGL.Math
+import RSAGL.Math.CurveExtras
+import RSAGL.Auxiliary.Auxiliary
import Control.Applicative
-import RSAGL.ApplicativeWrapper
+import RSAGL.Auxiliary.ApplicativeWrapper
import Data.Traversable (sequenceA)
-import RSAGL.Deformation
-import RSAGL.Vector
-import RSAGL.Material
-import RSAGL.Tesselation
-import RSAGL.Optimization
-import RSAGL.Interpolation
-import RSAGL.Affine
-import RSAGL.CoordinateSystems
-import RSAGL.Angle
-import RSAGL.Color
-import RSAGL.Extrusion
-import RSAGL.BoundingBox
+import RSAGL.Modeling.Deformation
+import RSAGL.Modeling.Material
+import RSAGL.Modeling.Tesselation
+import RSAGL.Modeling.Optimization
+import RSAGL.Scene.CoordinateSystems
+import RSAGL.Modeling.Color
+import RSAGL.Modeling.Extrusion
+import RSAGL.Modeling.BoundingBox
import Data.List as List
import Data.Maybe
import qualified Control.Monad.State as State
@@ -83,10 +79,11 @@ import Graphics.Rendering.OpenGL.GL.BasicTypes
import Graphics.Rendering.OpenGL.GL.Colors (lightModelTwoSide,Face(..))
import Graphics.Rendering.OpenGL.GL.StateVar as StateVar
import Graphics.Rendering.OpenGL.GL.Polygons
-import RSAGL.OpenGLPrimitives
-import RSAGL.BakedModel hiding (tesselatedElementToOpenGL)
+import RSAGL.Modeling.OpenGLPrimitives
+import RSAGL.Modeling.BakedModel hiding (tesselatedElementToOpenGL)
import Data.IORef
import Control.Monad
+import Control.Exception
\end{code}
\subsection{Modeling Monad}
@@ -353,15 +350,15 @@ openCone (a,a_radius) (b,b_radius) = model $
-- | A flat disc with a hole in the middle, defined in terms of it's center, normal vector, inner (hole) radius and outer radius.
openDisc :: (Monoid attr) => Point3D -> Vector3D -> Double -> Double -> Modeling attr
-openDisc p up inner_radius outer_radius = model $
+openDisc p up_vector inner_radius outer_radius = model $
do generalSurface $ Right $
cylindricalCoordinates $ \(u,v) ->
(Point3D (lerp v (inner_radius,outer_radius) * cosine u)
0
(lerp v (inner_radius,outer_radius) * sine u),
Vector3D 0 1 0)
tesselationHintComplexity $ round $ (max outer_radius inner_radius / (abs $ outer_radius - inner_radius))
- affine $ translateToFrom p origin_point_3d . rotateToFrom up (Vector3D 0 1 0)
+ affine $ translateToFrom p origin_point_3d . rotateToFrom up_vector (Vector3D 0 1 0)
closedDisc :: (Monoid attr) => Point3D -> Vector3D -> Double -> Modeling attr
closedDisc center up_vector radius = model $
@@ -441,7 +438,11 @@ instance ModelType IntermediateModel where
instance ModelType BakedModel where
toIntermediateModel (BakedModel im) = im
+disable_baked_models :: Bool -- in case of segfaults, BakedModel is the #1 suspect
+disable_baked_models = True
+
bakeModel :: IntermediateModel -> IO BakedModel
+bakeModel im | disable_baked_models = evaluate (im `using` rnf) >> (return $ BakedModel im)
bakeModel (IntermediateModel surfaces) = liftM (BakedModel . IntermediateModel) $ forM surfaces $ \imsurface ->
do layers <- forM (imsurface_layers imsurface) $ \imlayer ->
do b <- (newIORef . Just) =<< bakeSurface (materialLayerToOpenGLWrapper $ imlayer_material imlayer)
View
32 RSAGL/ModelingExtras.lhs → RSAGL/Modeling/ModelingExtras.lhs
@@ -4,7 +4,7 @@
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
-module RSAGL.ModelingExtras
+module RSAGL.Modeling.ModelingExtras
(smoothbox,
regularPrism,
heightField,
@@ -25,28 +25,28 @@ module RSAGL.ModelingExtras
disregardSurfaceNormals,
ColorFunction,
Pattern,
- module RSAGL.RSAGLColors,
- module RSAGL.Material,
- module RSAGL.ApplicativeWrapper,
+ module RSAGL.Modeling.RSAGLColors,
+ module RSAGL.Modeling.Material,
+ module RSAGL.Auxiliary.ApplicativeWrapper,
module Control.Applicative)
where
import Graphics.Rendering.OpenGL.GL.BasicTypes
-import RSAGL.Noise
-import RSAGL.RSAGLColors
+import RSAGL.Modeling.Noise
+import RSAGL.Modeling.RSAGLColors
import Control.Applicative
-import RSAGL.ApplicativeWrapper
-import RSAGL.Vector
-import RSAGL.Material
-import RSAGL.Affine
-import RSAGL.Model
+import RSAGL.Auxiliary.ApplicativeWrapper
+import RSAGL.Math.Vector
+import RSAGL.Modeling.Material
+import RSAGL.Math.Affine
+import RSAGL.Modeling.Model
import System.Random
-import RSAGL.Interpolation
+import RSAGL.Math.Interpolation
import Data.Monoid
-import RSAGL.Auxiliary
-import RSAGL.Angle
-import RSAGL.Ray
-import RSAGL.RSAGLColors
+import RSAGL.Auxiliary.Auxiliary
+import RSAGL.Math.Angle
+import RSAGL.Math.Ray
+import RSAGL.Modeling.RSAGLColors
\end{code}