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