view org/util.org @ 317:bb3f8a4af87f

removed references to defvar from clojure.contrib.def since the def from 1.4 now allows for docstrings
author Robert McIntyre <rlm@mit.edu>
date Tue, 28 Feb 2012 14:04:21 -0600
parents 7e7f8d6d9ec5
children 52de8a36edde
line wrap: on
line source
1 #+title: Clojure Utilities for jMonkeyEngine3
2 #+author: Robert McIntyre
3 #+email: rlm@mit.edu
4 #+description:
5 #+keywords: JME3, clojure, import, utilities
6 #+SETUPFILE: ../../aurellem/org/setup.org
7 #+INCLUDE: ../../aurellem/org/level-0.org
9 [TABLE-OF-CONTENTS]
11 These are a collection of functions to make programming jMonkeyEngine
12 in clojure easier.
14 * Imports
16 #+name: import
17 #+begin_src clojure :results silent
18 (ns cortex.import
19 (:require swank.util.class-browse))
21 (defn permissive-import
22 [classname]
23 (eval `(try (import '~classname)
24 (catch java.lang.Exception e#
25 (println "couldn't import " '~classname))))
26 classname)
28 (defn jme-class? [classname]
29 (and
30 (.startsWith classname "com.jme3.")
31 ;; Don't import the LWJGL stuff since it can throw exceptions
32 ;; upon being loaded.
33 (not (re-matches #".*Lwjgl.*" classname))))
35 (defn jme-classes
36 "returns a list of all jme3 classes"
37 []
38 (filter
39 jme-class?
40 (map :name
41 swank.util.class-browse/available-classes)))
43 (defn mega-import-jme3
44 "Import ALL the jme classes. For REPL use."
45 []
46 (doall
47 (map (comp permissive-import symbol) (jme-classes))))
48 #+end_src
50 jMonkeyEngine3 has a plethora of classes which can be overwhelming to
51 manage. This code uses reflection to import all of them. Once I'm
52 happy with the general structure of a namespace I can deal with
53 importing only the classes it actually needs.
55 The =mega-import-jme3= is quite useful for debugging purposes since
56 it allows completion for almost all of JME's classes from the REPL.
58 Out of curiosity, let's see just how many classes =mega-import-jme3=
59 imports:
61 #+begin_src clojure :exports both :results output
62 (println (clojure.core/count (cortex.import/jme-classes)) "classes")
63 #+end_src
65 #+results:
66 : 955 classes
69 * Utilities
71 The utilities here come in three main groups:
72 - Changing settings in a running =Application=
73 - Creating objects
74 - Debug Actions
75 - Visualizing objects
77 *** Changing Settings
79 #+name: util
80 #+begin_src clojure
81 (ns cortex.util
82 "Utility functions for making jMonkeyEngine3 easier to program from
83 clojure."
84 {:author "Robert McIntyre"}
85 (:use cortex.world)
86 (:import com.jme3.math.Vector3f)
87 (:import com.jme3.math.Quaternion)
88 (:import com.jme3.asset.TextureKey)
89 (:import com.jme3.bullet.control.RigidBodyControl)
90 (:import com.jme3.bullet.collision.shapes.GImpactCollisionShape)
91 (:import com.jme3.scene.shape.Box)
92 (:import com.jme3.scene.Node)
93 (:import com.jme3.scene.shape.Sphere)
94 (:import com.jme3.light.AmbientLight)
95 (:import com.jme3.light.DirectionalLight)
96 (:import (com.jme3.math Triangle ColorRGBA))
97 (:import com.jme3.bullet.BulletAppState)
98 (:import com.jme3.material.Material)
99 (:import com.jme3.scene.Geometry)
100 (:import java.awt.image.BufferedImage)
101 (:import javax.swing.JPanel)
102 (:import javax.swing.JFrame)
103 (:import javax.swing.SwingUtilities)
104 (:import com.jme3.scene.plugins.blender.BlenderModelLoader)
105 (:import (java.util.logging Level Logger)))
107 (defvar println-repl
108 (bound-fn [& args] (apply println args))
109 "println called from the LWJGL thread will not go to the REPL, but
110 instead to whatever terminal started the JVM process. This function
111 will always output to the REPL")
113 (defn position-camera
114 "Change the position of the in-world camera."
115 [world #^Vector3f position #^Quaternion rotation]
116 (doto (.getCamera world)
117 (.setLocation position)
118 (.setRotation rotation)))
120 (defn enable-debug
121 "Turn on debug wireframes for every object in this simulation."
122 [world]
123 (.enableDebug
124 (.getPhysicsSpace
125 (.getState
126 (.getStateManager world)
127 BulletAppState))
128 (asset-manager)))
130 (defn speed-up
131 "Increase the dismally slow speed of the world's camera."
132 [world]
133 (.setMoveSpeed (.getFlyByCamera world)
134 (float 60))
135 (.setRotationSpeed (.getFlyByCamera world)
136 (float 3))
137 world)
140 (defn no-logging
141 "Disable all of jMonkeyEngine's logging."
142 []
143 (.setLevel (Logger/getLogger "com.jme3") Level/OFF))
145 (defn set-accuracy
146 "Change the accuracy at which the World's Physics is calculated."
147 [world new-accuracy]
148 (let [physics-manager
149 (.getState
150 (.getStateManager world) BulletAppState)]
151 (.setAccuracy
152 (.getPhysicsSpace physics-manager)
153 (float new-accuracy))))
156 (defn set-gravity
157 "In order to change the gravity of a scene, it is not only necessary
158 to set the gravity variable, but to \"tap\" every physics object in
159 the scene to reactivate physics calculations."
160 [world gravity]
161 (traverse
162 (fn [geom]
163 (if-let
164 ;; only set gravity for physical objects.
165 [control (.getControl geom RigidBodyControl)]
166 (do
167 (.setGravity control gravity)
168 ;; tappsies!
169 (.applyImpulse control Vector3f/ZERO Vector3f/ZERO))))
170 (.getRootNode world)))
172 (defn add-element
173 "Add the Spatial to the world's environment"
174 ([world element node]
175 (.addAll
176 (.getPhysicsSpace
177 (.getState
178 (.getStateManager world)
179 BulletAppState))
180 element)
181 (.attachChild node element))
182 ([world element]
183 (add-element world element (.getRootNode world))))
185 (defn apply-map
186 "Like apply, but works for maps and functions that expect an
187 implicit map and nothing else as in (fn [& {}]).
188 ------- Example -------
189 (defn demo [& {:keys [www] :or {www \"oh yeah\"} :as env}]
190 (println www))
191 (apply-map demo {:www \"hello!\"})
192 -->\"hello\""
193 [fn m]
194 (apply fn (reduce #(into %1 %2) [] m)))
196 (defn map-vals
197 "Transform a map by applying a function to its values,
198 keeping the keys the same."
199 [f m] (zipmap (keys m) (map f (vals m))))
201 (defn runonce
202 "Decorator. returns a function which will run only once.
203 Inspired by Halloway's version from Lancet."
204 {:author "Robert McIntyre"}
205 [function]
206 (let [sentinel (Object.)
207 result (atom sentinel)]
208 (fn [& args]
209 (locking sentinel
210 (if (= @result sentinel)
211 (reset! result (apply function args))
212 @result)))))
215 #+end_src
217 #+results: util
218 : #'cortex.util/runonce
221 *** Creating Basic Shapes
223 #+name: shapes
224 #+begin_src clojure :results silent
225 (in-ns 'cortex.util)
227 (defn load-bullet
228 "Running this function unpacks the native bullet libraries and makes
229 them available."
230 []
231 (let [sim (world (Node.) {} no-op no-op)]
232 (doto sim
233 (.enqueue
234 (fn []
235 (.stop sim)))
236 (.start))))
239 (defrecord shape-description
240 [name
241 color
242 mass
243 friction
244 texture
245 material
246 position
247 rotation
248 shape
249 physical?
250 GImpact?
251 ])
253 (defvar base-shape
254 (shape-description.
255 "default-shape"
256 false
257 ;;ColorRGBA/Blue
258 1.0 ;; mass
259 1.0 ;; friction
260 ;; texture
261 "Textures/Terrain/BrickWall/BrickWall.jpg"
262 ;; material
263 "Common/MatDefs/Misc/Unshaded.j3md"
264 Vector3f/ZERO
265 Quaternion/IDENTITY
266 (Box. Vector3f/ZERO 0.5 0.5 0.5)
267 true
268 false)
269 "Basic settings for shapes.")
271 (defn make-shape
272 [#^shape-description d]
273 (let [asset-manager (asset-manager)
274 mat (Material. asset-manager (:material d))
275 geom (Geometry. (:name d) (:shape d))]
276 (if (:texture d)
277 (let [key (TextureKey. (:texture d))]
278 ;;(.setGenerateMips key true)
279 ;;(.setTexture mat "ColorMap" (.loadTexture asset-manager key))
280 ))
281 (if (:color d) (.setColor mat "Color" (:color d)))
282 (.setMaterial geom mat)
283 (if-let [rotation (:rotation d)] (.rotate geom rotation))
284 (.setLocalTranslation geom (:position d))
285 (if (:physical? d)
286 (let [physics-control
287 (if (:GImpact d)
288 ;; Create an accurate mesh collision shape if desired.
289 (RigidBodyControl.
290 (doto (GImpactCollisionShape.
291 (.getMesh geom))
292 (.createJmeMesh)
293 ;;(.setMargin 0)
294 )
295 (float (:mass d)))
296 ;; otherwise use jme3's default
297 (RigidBodyControl. (float (:mass d))))]
298 (.addControl geom physics-control)
299 ;;(.setSleepingThresholds physics-control (float 0) (float 0))
300 (.setFriction physics-control (:friction d))))
301 geom))
303 (defn box
304 ([l w h & {:as options}]
305 (let [options (merge base-shape options)]
306 (make-shape (assoc options
307 :shape (Box. l w h)))))
308 ([] (box 0.5 0.5 0.5)))
310 (defn sphere
311 ([r & {:as options}]
312 (let [options (merge base-shape options)]
313 (make-shape (assoc options
314 :shape (Sphere. 32 32 (float r))))))
315 ([] (sphere 0.5)))
317 (defn x-ray
318 "A useful material for debugging -- it can be seen no matter what
319 object occludes it."
320 [#^ColorRGBA color]
321 (doto (Material. (asset-manager)
322 "Common/MatDefs/Misc/Unshaded.j3md")
323 (.setColor "Color" color)
324 (-> (.getAdditionalRenderState)
325 (.setDepthTest false))))
327 (defn node-seq
328 "Take a node and return a seq of all its children
329 recursively. There will be no nodes left in the resulting
330 structure"
331 [#^Node node]
332 (tree-seq #(isa? (class %) Node) #(.getChildren %) node))
334 (defn nodify
335 "Take a sequence of things that can be attached to a node and return
336 a node with all of them attached"
337 ([name children]
338 (let [node (Node. name)]
339 (dorun (map #(.attachChild node %) children))
340 node))
341 ([children] (nodify "" children)))
343 (defn load-blender-model
344 "Load a .blend file using an asset folder relative path."
345 [^String model]
346 (.loadModel
347 (doto (asset-manager)
348 (.registerLoader BlenderModelLoader
349 (into-array String ["blend"]))) model))
352 #+end_src
355 *** Debug Actions
356 #+name: debug-actions
357 #+begin_src clojure :results silent
358 (in-ns 'cortex.util)
360 (defn basic-light-setup
361 "returns a sequence of lights appropriate for fully lighting a scene"
362 []
363 (conj
364 (doall
365 (map
366 (fn [direction]
367 (doto (DirectionalLight.)
368 (.setDirection direction)
369 (.setColor ColorRGBA/White)))
370 [;; six faces of a cube
371 Vector3f/UNIT_X
372 Vector3f/UNIT_Y
373 Vector3f/UNIT_Z
374 (.mult Vector3f/UNIT_X (float -1))
375 (.mult Vector3f/UNIT_Y (float -1))
376 (.mult Vector3f/UNIT_Z (float -1))]))
377 (doto (AmbientLight.)
378 (.setColor ColorRGBA/White))))
380 (defn light-up-everything
381 "Add lights to a world appropriate for quickly seeing everything
382 in the scene. Adds six DirectionalLights facing in orthogonal
383 directions, and one AmbientLight to provide overall lighting
384 coverage."
385 [world]
386 (dorun
387 (map
388 #(.addLight (.getRootNode world) %)
389 (basic-light-setup))))
391 (defn fire-cannon-ball
392 "Creates a function that fires a cannon-ball from the current game's
393 camera. The cannon-ball will be attached to the node if provided, or
394 to the game's RootNode if no node is provided."
395 ([node]
396 (fn [game value]
397 (if (not value)
398 (let [camera (.getCamera game)
399 cannon-ball
400 (sphere 0.7
401 :material "Common/MatDefs/Misc/Unshaded.j3md"
402 :color ColorRGBA/White
403 :name "cannonball!"
404 :position
405 (.add (.getLocation camera)
406 (.mult (.getDirection camera) (float 1)))
407 :mass 3)] ;200 0.05
408 (.setLinearVelocity
409 (.getControl cannon-ball RigidBodyControl)
410 (.mult (.getDirection camera) (float 50))) ;50
411 (add-element game cannon-ball (if node node (.getRootNode
412 game)))
413 cannon-ball))))
414 ([]
415 (fire-cannon-ball false)))
417 (def standard-debug-controls
418 {"key-space" (fire-cannon-ball)})
421 (defn tap [obj direction force]
422 (let [control (.getControl obj RigidBodyControl)]
423 (.applyTorque
424 control
425 (.mult (.getPhysicsRotation control)
426 (.mult (.normalize direction) (float force))))))
429 (defn with-movement
430 [object
431 [up down left right roll-up roll-down :as keyboard]
432 forces
433 [root-node
434 keymap
435 initialization
436 world-loop]]
437 (let [add-keypress
438 (fn [state keymap key]
439 (merge keymap
440 {key
441 (fn [_ pressed?]
442 (reset! state pressed?))}))
443 move-up? (atom false)
444 move-down? (atom false)
445 move-left? (atom false)
446 move-right? (atom false)
447 roll-left? (atom false)
448 roll-right? (atom false)
450 directions [(Vector3f. 0 1 0)(Vector3f. 0 -1 0)
451 (Vector3f. 0 0 1)(Vector3f. 0 0 -1)
452 (Vector3f. -1 0 0)(Vector3f. 1 0 0)]
453 atoms [move-left? move-right? move-up? move-down?
454 roll-left? roll-right?]
456 keymap* (reduce merge
457 (map #(add-keypress %1 keymap %2)
458 atoms
459 keyboard))
461 splice-loop (fn []
462 (dorun
463 (map
464 (fn [sym direction force]
465 (if @sym
466 (tap object direction force)))
467 atoms directions forces)))
469 world-loop* (fn [world tpf]
470 (world-loop world tpf)
471 (splice-loop))]
472 [root-node
473 keymap*
474 initialization
475 world-loop*]))
477 (import com.jme3.font.BitmapText)
478 (import com.jme3.scene.control.AbstractControl)
479 (import com.aurellem.capture.IsoTimer)
481 (defn display-dilated-time
482 "Shows the time as it is flowing in the simulation on a HUD display.
483 Useful for making videos."
484 [world timer]
485 (let [font (.loadFont (asset-manager) "Interface/Fonts/Default.fnt")
486 text (BitmapText. font false)]
487 (.setLocalTranslation text 300 (.getLineHeight text) 0)
488 (.addControl
489 text
490 (proxy [AbstractControl] []
491 (controlUpdate [tpf]
492 (.setText text (format
493 "%.2f"
494 (float (/ (.getTime timer) 1000)))))
495 (controlRender [_ _])))
496 (.attachChild (.getGuiNode world) text)))
497 #+end_src
500 *** Viewing Objects
502 #+name: world-view
503 #+begin_src clojure :results silent
504 (in-ns 'cortex.util)
506 (defprotocol Viewable
507 (view [something]))
509 (extend-type com.jme3.scene.Geometry
510 Viewable
511 (view [geo]
512 (view (doto (Node.)(.attachChild geo)))))
514 (extend-type com.jme3.scene.Node
515 Viewable
516 (view
517 [node]
518 (.start
519 (world
520 node
521 {}
522 (fn [world]
523 (enable-debug world)
524 (set-gravity world Vector3f/ZERO)
525 (light-up-everything world))
526 no-op))))
528 (extend-type com.jme3.math.ColorRGBA
529 Viewable
530 (view
531 [color]
532 (view (doto (Node.)
533 (.attachChild (box 1 1 1 :color color))))))
535 (defprotocol Textual
536 (text [something]
537 "Display a detailed textual analysis of the given object."))
539 (extend-type com.jme3.scene.Node
540 Textual
541 (text [node]
542 (println "Total Vertexes: " (.getVertexCount node))
543 (println "Total Triangles: " (.getTriangleCount node))
544 (println "Controls :")
545 (dorun (map #(text (.getControl node %)) (range (.getNumControls node))))
546 (println "Has " (.getQuantity node) " Children:")
547 (doall (map text (.getChildren node)))))
549 (extend-type com.jme3.animation.AnimControl
550 Textual
551 (text [control]
552 (let [animations (.getAnimationNames control)]
553 (println "Animation Control with " (count animations) " animation(s):")
554 (dorun (map println animations)))))
556 (extend-type com.jme3.animation.SkeletonControl
557 Textual
558 (text [control]
559 (println "Skeleton Control with the following skeleton:")
560 (println (.getSkeleton control))))
562 (extend-type com.jme3.bullet.control.KinematicRagdollControl
563 Textual
564 (text [control]
565 (println "Ragdoll Control")))
567 (extend-type com.jme3.scene.Geometry
568 Textual
569 (text [control]
570 (println "...geo...")))
572 (extend-type Triangle
573 Textual
574 (text [t]
575 (println "Triangle: " \newline (.get1 t) \newline
576 (.get2 t) \newline (.get3 t))))
578 #+end_src
580 Here I make the =Viewable= protocol and extend it to JME's types. Now
581 JME3's =hello-world= can be written as easily as:
583 #+begin_src clojure :results silent
584 (cortex.util/view (cortex.util/box))
585 #+end_src
588 * COMMENT code generation
589 #+begin_src clojure :tangle ../src/cortex/import.clj
590 <<import>>
591 #+end_src
594 #+begin_src clojure :tangle ../src/cortex/util.clj :noweb yes
595 <<util>>
596 <<shapes>>
597 <<debug-actions>>
598 <<world-view>>
599 #+end_src