(ns us.menzies.plot (:import (java.applet Applet) (java.awt BorderLayout GraphicsConfiguration GraphicsEnvironment EventQueue) (java.util Random) (com.sun.j3d.utils.applet MainFrame) (com.sun.j3d.utils.geometry ColorCube Sphere Box Cone Text2D) (com.sun.j3d.utils.universe SimpleUniverse) (com.sun.j3d.utils.behaviors.mouse MouseRotate MouseZoom) (com.sun.j3d.utils.behaviors.vp OrbitBehavior) (javax.media.j3d BranchGroup TransformGroup BoundingSphere Canvas3D GraphicsConfigTemplate3D Transform3D DirectionalLight AmbientLight ColoringAttributes Appearance Material) (javax.vecmath Point3d Point3f Vector3d Vector3f Color3f) (us.menzies.plot PlotWindow))) (def *trans*) (def *root*) (def *canvas*) (def *universe*) (def *applet*) (def *window*) (def *plot-window*) (def *color-black* (Color3f. 0.0 0.0 0.0)) (def *color-white* (Color3f. 1.0 1.0 1.0)) (def *light-default-color* (Color3f. 1.0 1.0 1.0)) (def *light-default-direction* (Vector3f. 0.0 0.0 -1.0)) (def *light-default-bounds* (BoundingSphere. (Point3d. 0.0 0.0 4.0) 6.0)) (defn create-directional-light ([] (create-directional-light *light-default-color*)) ([color] (create-directional-light color *light-default-direction*)) ([color direction] (create-directional-light color direction *light-default-bounds*)) ([color direction bounds] (doto (DirectionalLight. color direction) (.setInfluencingBounds bounds)))) (defn create-ambient-light ([] (create-ambient-light *light-default-color*)) ([color] (create-ambient-light color *light-default-bounds*)) ([color bounds] (doto (AmbientLight. color) (.setInfluencingBounds bounds)))) (defn create-axis-material [] (doto (Material.) (.setAmbientColor (Color3f. 0.8 0.8 0.8)) (.setDiffuseColor (Color3f. 0.9 0.9 0.9)) (.setSpecularColor (Color3f. 1.0 1.0 1.0)) (.setEmissiveColor (Color3f. 0.1 0.1 0.5)))) (def *axis-font* "Verdana") (def *axis-text-size* 18) (defn create-text-branch ([obj x y z] (create-text-branch obj x y z (* -1.0 x))) ([obj x y z i] (create-text-branch obj x y z i (BranchGroup.))) ([obj x y z i branch] (create-text-branch obj x y z i y z branch)) ([obj x y z i j k branch] (let [vect (Vector3f. x y z) verso (Vector3f. i j k) clone (.cloneTree obj)] (doto branch (.addChild (doto (TransformGroup.) (.setTransform (doto (Transform3D.) (.setTranslation vect))) (.addChild obj))) (.addChild (doto (TransformGroup.) (.setTransform (doto (Transform3D.) (.rotY Math/PI) (.setTranslation verso))) (.addChild clone))) (.compile))))) (defn create-text-group [] (let [xtext (Text2D. "x" *color-white* *axis-font* *axis-text-size* 1) ytext (Text2D. "y" *color-white* *axis-font* *axis-text-size* 1) ztext (Text2D. "z" *color-white* *axis-font* *axis-text-size* 1)] (doto (BranchGroup.) (.addChild (create-text-branch xtext 0.952 0.0 0.0 1.0)) (.addChild (create-text-branch ytext -0.02 1.01 0.0)) (.addChild (create-text-branch ztext -0.02 0.0 0.99)) (.compile)))) (defn create-transform-group [] (let [objTrans (TransformGroup.) bounds (BoundingSphere. (Point3d. 0.0 0.0 0.0) 100.0) axismat (create-axis-material) axisapp (doto (Appearance.) (.setMaterial axismat)) xaxis (Box. 1.0 0.005 0.005 axisapp) yaxis (Box. 0.005 1.0 0.005 axisapp) zaxis (Box. 0.005 0.005 1.0 axisapp)] (doto objTrans (.setCapability (. TransformGroup ALLOW_TRANSFORM_WRITE)) (.setCapability (. TransformGroup ALLOW_TRANSFORM_READ)) (.setCapability (. TransformGroup ALLOW_CHILDREN_EXTEND)) (.addChild xaxis) (.addChild yaxis) (.addChild zaxis) (.addChild (create-text-group))))) (defn create-scene-graph ([] (create-scene-graph (create-transform-group))) ([objTrans] (let [frontlightcolor (Color3f. 0.75 0.75 0.75) sidelightcolor (Color3f. 0.4 0.4 0.4)] (doto (BranchGroup.) (.setCapability (. BranchGroup ALLOW_CHILDREN_EXTEND)) (.addChild (create-directional-light frontlightcolor (Vector3f. 0.0 0.0 -1.0))) (.addChild (create-directional-light frontlightcolor (Vector3f. 0.0 0.0 1.0))) (.addChild (create-directional-light sidelightcolor (Vector3f. -1.0 0.0 0.0))) (.addChild (create-directional-light sidelightcolor (Vector3f. 1.0 0.0 0.0))) (.addChild (create-directional-light sidelightcolor (Vector3f. 0.0 -1.0 0.0))) (.addChild (create-directional-light sidelightcolor (Vector3f. 0.0 1.0 0.0))) (.addChild objTrans) (.compile))))) (def *point-default-size* 0.01) (def *point-default-specular-color* (Color3f. 0.8 0.8 0.8)) (defn create-point ([] (create-point 0.9 0.9 0.9)) ([r g b] (create-point r g b *point-default-size*)) ([r g b size] (let [sphere (Sphere. size) appearance (Appearance.) material (Material.) shademodel (. ColoringAttributes SHADE_GOURAUD) coloring (ColoringAttributes. r g b shademodel)] (.setAmbientColor material *color-black*) (.setDiffuseColor material (Color3f. r g b)) (.setSpecularColor material *point-default-specular-color*) (.setEmissiveColor material (Color3f. (/ r 2) (/ g 2) (/ b 2))) (.setMaterial appearance material) (.setColoringAttributes appearance coloring) (doto sphere (.setAppearance appearance))))) (defn plot-to ([scene x y z] (plot-to scene x y z (create-point))) ([scene x y z obj] (let [vect (Vector3d. x y z) branch (BranchGroup.) objTrans (TransformGroup.) transform (Transform3D.)] (.setTranslation transform vect) (.setTransform objTrans transform) (.addChild objTrans obj) (.addChild branch objTrans) (.compile branch) (.addChild scene branch)))) (defn plot-list ([scene lst] (plot-list scene lst (create-point))) ([scene lst obj] (doseq [each lst] (let [clone (.cloneTree obj)] (plot-to scene (first each) (second each) (last each) clone))))) (defn plot-plane-test ([] (plot-plane-test *trans*)) ([trans] (plot-plane-test trans 1000)) ([trans n] (plot-plane-test trans n 0.5)) ([trans n y] (let [random (Random.)] (dotimes [_ n] (plot-to trans (.nextFloat random) y (.nextFloat random) (create-point (.nextFloat random) (.nextFloat random) (.nextFloat random))))))) (defn plot-function ([func] (plot-function func 1000)) ([func n] (plot-function func n 1.0 1.0)) ([func n xrange yrange] (plot-function func n xrange yrange *trans*)) ([func n xrange yrange trans] (plot-function func n xrange yrange *trans* (create-point))) ([func n xrange yrange trans obj] (let [random (Random.)] (dotimes [_ n] (let [x (.nextFloat random) y (.nextFloat random)] (plot-to trans x y (func x y) (.cloneTree obj))))))) (defn colorize-heat [x y z] `(~y 0.0 ~(- 1.0 y))) (defn color-plot-all [lst colorfunc] (doseq [each lst] (let [x (first each) y (second each) z (last each) colorlist (colorfunc x y z) r (first colorlist) g (second colorlist) b (last colorlist)] (plot-to *trans* x y z (create-point r g b))))) (defn color-plot-function ([zfunc colorfunc] (color-plot-function zfunc colorfunc 1000)) ([zfunc colorfunc n] (color-plot-function zfunc colorfunc n 1.0 1.0)) ([zfunc colorfunc n xrange yrange] (color-plot-function zfunc colorfunc n xrange yrange *trans*)) ([zfunc colorfunc n xrange yrange trans] (let [random (Random.)] (dotimes [_ n] (let [x (.nextFloat random) y (.nextFloat random) z (zfunc x y) colorlist (colorfunc x y z) obj (create-point (first colorlist) (second colorlist) (last colorlist))] (plot-to trans x y z obj)))))) (defn get-default-configuration [] (let [env (GraphicsEnvironment/getLocalGraphicsEnvironment) gct (GraphicsConfigTemplate3D.)] (.getBestConfiguration (.getDefaultScreenDevice env) gct))) (defn get-default-canvas [] (Canvas3D. (get-default-configuration))) (defn create-universe ([] (create-universe (get-default-canvas))) ([canvas] (create-universe canvas (create-scene-graph))) ([canvas root] (let [universe (SimpleUniverse. canvas) viewplatform (.getViewingPlatform universe) viewtg (.getViewPlatformTransform viewplatform) orbit (doto (OrbitBehavior. canvas) (.setMinRadius 0.2) (.setRotationCenter (Point3d. 0.5 0.5 0.5)) (.setSchedulingBounds (BoundingSphere. (Point3d. 0.0 0.0 0.0) 8.0))) transform (Transform3D.)] (.setViewPlatformBehavior viewplatform orbit) (.setNominalViewingTransform viewplatform) (.addBranchGraph universe root) universe))) (defn create-applet ([] (create-applet (get-default-canvas))) ([canvas] (create-applet canvas (create-universe canvas))) ([canvas universe] (doto (Applet.) (.setLayout (BorderLayout.)) (.add "Center" canvas)))) (defn create-window ([] (create-window (create-applet))) ([applet] (create-window applet "Hello, Universe!")) ([applet title] (create-window applet title 256)) ([applet title wh] (create-window applet title wh wh)) ([applet title w h] (doto (MainFrame. applet w h) (.setTitle title)))) (defn start-plot-applet [] (def *trans* (create-transform-group)) (def *root* (create-scene-graph *trans*)) (def *canvas* (get-default-canvas)) (def *universe* (create-universe *canvas* *root*)) (def *applet* (create-applet *canvas* *universe*)) (def *window* (create-window *applet* "Modelling Intelligence Lab" 640 480))) (defn start-gui [] (def *trans* (create-transform-group)) (def *root* (create-scene-graph *trans*)) (def *plot-window* (PlotWindow.)) (def *canvas* (. *plot-window* canvas)) (def *universe* (create-universe *canvas* *root*)) (.setVisible *plot-window* true)) (defn plot ([x y z] (plot x y z (create-point))) ([x y z obj] (plot-to *trans* x y z obj))) (defn plot-all ([lst] (plot-list *trans* lst)) ([lst obj] (plot-list *trans* lst obj))) (defn -main [args] (create-window))