Another fluxus friday adventure…
; a simple realtime cloth simulation model (clear) (texture (load-texture "test2.png")) (define rez 25) ; resolution of nurbs patch (define dist 0.1) ; the desired spring length (define p ; setup the nurbs primitive (with-state (backfacecull 0) ; we wanna see the back (ambient 0.2) (rotate (vector -90 0 0)) (scale (vector 8 4 4)) (build-nurbs-plane (- rez 1) (- rez 1)))) (with-primitive p (pdata-add "vel" "v")) (define (spring a b) ; return vector trying to keep the length (let ((d (vsub a b))) ; between the two input points constant (vmul d (- dist (vmag d))))) (every-frame (with-primitive p (pdata-index-map! ; for each control vertex (lambda (i v p) (let ((x (modulo i rez)) ; get the x and y from (y (quotient i rez))) ; the index (if (> x 0) ; we want to 'pin' the top row of cvs (vmul (vadd v (spring p (pdata-ref "p" (- i 1))) (if (< x (- rez 1)) ; deal with the edges (spring p (pdata-ref "p" (+ i 1))) (vector 0 0 0)) (if (> y 0) (spring p (pdata-ref "p" (- i rez))) (vector 0 0 0)) (if (< y (- rez 1)) (spring p (pdata-ref "p" (+ i rez))) (vector 0 0 0)) ; add constant gravity (vector 0 0 -0.001)) 0.995) v))) "vel" "p") (pdata-op "+" "p" "vel") ; add velocity to the vertex positions (recalc-normals 1))) ; setup the lights (light-diffuse 0 (vector 0 0 0)) (define l (make-light 'point 'free)) (light-diffuse l (vector 1 1 1)) (light-position l (vector 10 300 -10)) (light-specular l (vector 1 1 1)) (light-ambient l (vector 0.3 0.3 0.3))