diff src/scheme/view3d.scm @ 0:bf79fb79ee13

Initial Mercurial check in.

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/scheme/view3d.scm	Tue Jan 17 17:50:20 2012 +0000
@@ -0,0 +1,93 @@
+(import "samer.j3d.*")
+(import "samer.j3d.Util")
+
+
+(define (xform . nodes)
+	(define tg (javax.media.j3d.TransformGroup.))
+	(for-each (lambda (node) (.addChild tg node)) nodes)
+	tg)
+
+(define (branch . nodes)
+	(define bg (javax.media.j3d.BranchGroup.))
+	(for-each (lambda (node) (.addChild bg node)) nodes)
+	bg)
+
+(define (root3d . nodes)
+	(define r (Root.))
+	(for-each (lambda (node) (.addChild r node)) nodes)
+	r)
+	
+(define shape javax.media.j3d.Shape3D.)
+(define (appearance shape app) (.setAppearance shape app) shape)
+
+(define (manipulate tg)
+	(Util.mouseRotate tg)
+;	(Util.mouseTranslate tg)
+	(Util.mouseZoom tg)
+	tg)
+
+(define (rotating period) (lambda (x) (Util.addRotator period x)))
+	
+(put "lookfrom" "(10 20 64)")
+
+(define c3f javax.vecmath.Color3f.)
+(define (white) (c3f 1f 1f 1f))
+(define (green) (c3f 0.1f 1f 0.2f))
+
+
+(define (view3d vec points container mk-view)
+	(node (.getNode vec)
+	  (node "3d"
+		(define view (mk-view))
+		(define VG (ViewGroup.))
+		(define root
+			(root3d
+				(container (xform (manipulate (xform
+					(appearance (Axes.) (Util.color (green) (Util.alpha 0.5 (Util.wireframe))))
+					(shape 
+						(Points3DAlpha. points vec) 	
+						;(Points4D. points vec) 	
+						(Util.alpha 0 (Util.points)))
+				))))
+				VG
+			)
+		)
+		(.attachView VG view)
+		(addtask view)
+		(.compile root)
+		(.activate root)
+	  )
+	)
+)
+
+;;; immediate mode viewer:
+;	get root
+;	add viewer
+;   get renderer
+;   set geometry and appearance
+
+(define (view-patches x)
+	(define patches (Matrix. "PatchesMatrix" 512 6))
+	(put "stereo" #f)
+	(put "linewidth" 1)
+	;(addtask (.getTask (samer.j3d.J3DViewer. patches x)))
+	;(model (PatchArrayAlpha. points vec)		(flat (alpha 0.0 (patches))))
+)
+
+;		Optional background colour
+;		(Util.addBackground root 
+;			(javax.media.j3d.Background 
+;				(Color3f. 0.26f 0.23f 0.35f)));
+
+;;; appearance bundles
+'(
+	(define (pointy1) (alpha 0.8 (color '(0.8 0.6 1) (points))))
+	(define (pointy3) (color '(0.8 0.6 1) (points)))
+	(define (wireframe1) (color '(0.6 0.4 0.5) (transparent 0.4 (wireframe)))) 
+	(define (wireframe2) (color '(0.8 0.6 1) (transparent 0.7 (wireframe)))) 
+	(define (wireframe3) 
+		(define col (c3f 0.6 0.5 0.7))
+		(Util.material col col 48 (wireframe)))
+)
+
+