Code generated from the RealtimeAV Workshop [20060807-11]
; a experiment in using the turtle to create a
; constantly regenerating procedural shape from
; a static triangle strip. there are lots of
; obvious problems with this technique, and bugs
; in this implementation - but it's still capable
; of some interesting things (note: to do this
; properly fluxus needs an operation to "rotate"
; the vertex data around in memory)
; triangle strips are laid out like this:
;
; 0___2___4___6
; | /| /| /|
; | / | / | / |
; |/__|/__|/__|
; 1 3 5 7
;
; where the numbers indicate the vertex
; positions in the list (= pdata indices)
; make a circle - skipping a vert each time,
; so builds one side of a vertex strip.
; this represents the cross section of the
; shape we are building
(define (circle count radius)
(define (loop i angle)
(turtle-move radius)
(turtle-turn (vector 0 angle 0))
(turtle-vert)
(turtle-skip 1)
(if (zero? (- i 1))
0
(loop (- i 1) angle)))
(turtle-push)
(loop count (/ 360 count))
(turtle-pop))
; build the next level of shape, made out of
; the circles above - assembles it two circles
; at a time, building the triangle strip into
; rings - effectively extruding the circles
; into a tube
(define (shape circlecount shapecount)
(circle circlecount 1) ; draw a circle of radius 1
(turtle-skip (- (- (* circlecount 2) 1))) ; skip backwards by some algorithm? :)
(turtle-turn (vector 0 0 90)) ; turn to face the direction of the tube
(turtle-turn (vector 5 0 0)) ; turn half of the bend amount
(turtle-move 2) ; move forward
(turtle-turn (vector 5 0 0)) ; turn the second half of the bend amount
(turtle-turn (vector 0 0 -90)) ; face the direction to draw the circle
(circle circlecount 1) ; draw the second circle
(turtle-skip -1) ; set up for the next circle
(if (zero? shapecount)
0
(shape circlecount (- shapecount 1))))
(clear)
(backfacecull 0)
(define o (build-polygons 500 0)) ; make an arbitary length triangle strip
(turtle-attach o) ; attach the turtle builder to it
(turtle-reset)
(define nexttime 0) ; adding to the strip each frame is way too fast, so
; use the timer to slow down...
(define (update)
(cond ((< nexttime (time))
(set! nexttime (+ (time) 0.1)) ; do this every 0.1 seconds
(grab o)
(shape 12 1)
(recalc-normals 0)
(ungrab))))
(every-frame (update))
; virualtim
;
; reads muscle data from osc and uses it to control a
; physical arm model
; turn on full debugging
(debug-enable 'debug)
(debug-enable 'backtrace)
(read-enable 'positions)
; makes an arm segment - a bone and a joint connecting it
; with the input attachto object - can be used for chaining
; together objects
(define (make-arm-seg attachto axis)
(push)
(scale (vector 0.4 0.4 2))
(let ((bone (build-cube)))
(pop)
(grab bone)
(let ((jointpos (vtransform (vector 0 0 -0.5) (get-transform))))
(ungrab)
(active-box bone)
(let ((joint (build-hingejoint attachto bone jointpos axis)))
(joint-param joint "LoStop" -2)
(joint-param joint "HiStop" 2)
(joint-param joint "FMax" 100)
(joint-param joint "FudgeFactor" 0)
(list bone joint)))))
(define (arm-seg-get-bone arm-seg)
(list-ref arm-seg 0))
(define (arm-seg-get-joint arm-seg)
(list-ref arm-seg 1))
(define (make-arm)
(push)
(translate (vector 0 1.5 0))
(scale (vector 1 3 2))
(let ((torso (build-cube)))
(pop)
(active-box torso)
(build-fixedjoint torso)
(translate (vector 0 2.6 2.2))
(let ((upper-arm (make-arm-seg torso (vector 0 1 0))))
(translate (vector 0 0 2.2))
(let ((lower-arm (make-arm-seg (arm-seg-get-bone upper-arm) (vector 1 0 0))))
(translate (vector 0 0 1.4))
(scale (vector 1 1 0.3))
(let ((hand (make-arm-seg (arm-seg-get-bone lower-arm) (vector 1 0 0))))
(list upper-arm lower-arm hand))))))
(osc-source "9999")
(define (arm-update arm)
(let ((shoulder (arm-seg-get-joint (list-ref arm 0)))
(elbow (arm-seg-get-joint (list-ref arm 1)))
(wrist (arm-seg-get-joint (list-ref arm 2))))
(define (drain-upper)
(cond
((osc-msg "/bodydata/1/upper")
(display (osc 0))(newline)
(joint-angle shoulder 1 (* (osc 0) 2))
(drain-upper))))
(define (drain-lower)
(cond
((osc-msg "/bodydata/1/lower")
(display (osc 0))(newline)
(joint-angle elbow 1 (* (osc 0) 2))
(drain-lower))))
; (joint-angle shoulder 1 1)
(drain-upper)
(drain-lower)))
(gravity (vector 0 -0.01 0))
(show-axis 1)
(clear)
(collisions 1)
(ground-plane (vector 0 1 0) 0)
(push)
(scale (vector 10 10 10))
(rotate (vector 90 0 0))
(build-plane)
(pop)
(define arm (make-arm))
(define (update)
(arm-update arm))
(every-frame (update))
; a sound and muscle controlled tube doodler
; includes texture coordinate generation, and
; automatic tracking camera
(define (circle n radius s)
(define (loop i angle)
(turtle-move radius)
(turtle-turn (vector 0 angle 0))
(turtle-vert)
(pdata-set "t" (turtle-position) (vector (/ n i) (* s 0.1) 0))
(turtle-skip 1)
(if (zero? (- i 1))
0
(loop (- i 1) angle)))
(turtle-push)
(loop n (/ 360 n))
(turtle-pop))
(define lastwidth 1)
(define turnx 0)
(define turny 0)
(define (shape c n)
(set! turnx (gh 2))
(set! turny (gh 3))
(if (> turnx 90) (set! turnx 90))
(if (> turny 90) (set! turny 90))
(circle c lastwidth n)
(turtle-skip (- (- (* c 2) 1)))
(turtle-turn (vector 0 0 90))
(turtle-turn (vmul (vector turnx turny 0) 0.1))
(turtle-move 2)
(turtle-turn (vmul (vector turnx turny 0) 0.1))
(turtle-turn (vector 0 0 -90))
(set! lastwidth (+ (* lastwidth 0.9) (* (gh 8) 0.001)))
(circle c lastwidth (+ n 1))
(turtle-skip -1)
(if (zero? n)
0
(shape c (- n 1))))
(clear)
(backfacecull 0)
(clear-colour (vector 0 0 0))
;(hint-wire)
;(hint-unlit)
;(texture (load-texture "rhod.png"))
(define o (build-polygons 5000 0))
(turtle-attach o)
(turtle-reset)
(gain 100)
(define camera (build-locator))
(lock-camera camera)
(camera-lag 0.01)
(define nexttime 0)
(define (update)
(cond ((< nexttime (time))
(set! nexttime (+ (time) 0.1))
; move the camera
(grab o)
(let ((t (pdata-get "p" (modulo (- (turtle-position) 1) (pdata-size)))))
(grab camera)
(identity)
(translate t)
(ungrab))
; regenerate the shape
(shape 12 1)
(recalc-normals 0)
(ungrab))))
(every-frame (update))
– Dave Griffiths - 16 Sep 2006