; experimental high level modelling functions for fluxus ; DocSection clay ; util functions ;; StartFunctionDoc ;; pdata-copy-prim name src dst ;; Description: ;; Copies a set of pdata from one primitive to another ;; Example: ;; (define sphere-a (build-sphere 10 10)) ; make two spheres ;; (define sphere-b (build-sphere 10 10)) ;; (grab sphere-a) ;; (recalc-normals 0) ; do something which changes the normals ;; (ungrab) ;; (pdata-copy-prim "n" sphere-b sphere-a) ; copy the normals from the other sphere ;; EndFunctionDoc (define (pdata-copy-prim name src dst) (define (inner i) (let ((d (pdata-get name i))) (grab dst) (pdata-set name i d) (ungrab)) (if (zero? i) 0 (inner (- i 1)))) (grab src) (inner (pdata-size)) (ungrab)) ;; StartFunctionDoc ;; duplicate-poly-prim type in ;; Description: ;; Duplicates a polygon primitive (you need to know the type though) ;; Example: ;; (define sphere (build-sphere 10 10)) ; make a sphere ;; (define copy (duplicate-polyprim 2 sphere)) ; a sphere is made from a quad list (2) ;; EndFunctionDoc (define (duplicate-polyprim type in) (grab in) (let ((out (build-polygons (pdata-size) type))) (pdata-copy-prim "p" in out) (pdata-copy-prim "n" in out) (pdata-copy-prim "t" in out) (pdata-copy-prim "c" in out) (ungrab) out)) ; deformation functions (define (deform-expand o amount) (define (inner n) (pdata-set "p" n (vadd (pdata-get "p" n) (vmul (pdata-get "n" n) amount))) (if (zero? n) 0 (inner (- n 1)))) (grab o) (inner (pdata-size)) (ungrab)) ; modelling functions (define extrude-verts 10) (define extrude-radius 0.1) (define extrude-tex-vincr 0.1) (define extrude-texv 0) (define (extrude-circle-shape-func deg dist pos) (turtle-turn (vector 0 deg 0)) (turtle-move dist)) (define extrude-shape-func extrude-circle-shape-func) (define (extrude-begin o) (turtle-attach o) (grab o) (turtle-reset) (set! extrude-texv 0)) (define (extrude-end) (recalc-normals 1) (ungrab)) (define (extrude-tex-vincr-set n) (set! extrude-tex-vincr n)) (define (extrude-verts-set n) (set! extrude-verts n)) (define (extrude-radius-set n) (set! extrude-radius n)) (define (extrude-shape-func-set func) (set! extrude-shape-func func)) (define (extrude-push) (define (inner n dist deg first) (let ((tx (vector (/ n extrude-verts) extrude-texv 0))) (cond (first (pdata-set "t" (turtle-position) tx) (turtle-vert) (turtle-skip 1)) ((zero? n) (pdata-set "t" (turtle-position) tx) (turtle-vert) (pdata-set "t" (turtle-position) tx) (turtle-vert)) (else (pdata-set "t" (turtle-position) tx) (turtle-vert) (pdata-set "t" (turtle-position) tx) (turtle-vert) (turtle-skip 2) (pdata-set "t" (turtle-position) tx) (turtle-vert) (turtle-skip 1)))) (cond ((zero? n) 0) (else (extrude-shape-func deg dist n) (inner (- n 1) dist deg #f)))) (turtle-move extrude-radius) (turtle-turn (vector 0 90 0)) ; move the texture coordinates (set! extrude-texv (+ extrude-texv extrude-tex-vincr)) (let ((p (turtle-position))) (let ((angle (/ 360 extrude-verts))) (inner extrude-verts (* (atan angle) extrude-radius) angle #t)) (turtle-turn (vector 0 0 90)) (turtle-move 1) (turtle-turn (vector 0 0 -90)) (turtle-seek (+ p 1)))) (define (extrude-pop) (define (inner n dist deg first) (let ((tx (vector (/ n extrude-verts) extrude-texv 0))) (cond (first (pdata-set "t" (turtle-position) tx) (turtle-vert) (turtle-skip 2) (pdata-set "t" (turtle-position) tx) (turtle-vert)) ((zero? n) (pdata-set "t" (turtle-position) tx) (turtle-vert) (pdata-set "t" (turtle-position) tx)) (else (pdata-set "t" (turtle-position) tx) (turtle-vert) (turtle-skip 1) (pdata-set "t" (turtle-position) tx) (turtle-vert) (turtle-skip 2) (pdata-set "t" (turtle-position) tx) (turtle-vert)))) (cond ((zero? n) 0) (else (extrude-shape-func deg dist n) (inner (- n 1) dist deg #f)))) ; move the texture coordinates (set! extrude-texv (+ extrude-texv extrude-tex-vincr)) (let ((angle (/ 360 extrude-verts))) (inner extrude-verts (* (atan angle) extrude-radius) angle #t)) (turtle-turn (vector 0 90 0)) (turtle-move extrude-radius) (turtle-turn (vector 0 180 0)) ) (define dirlight1 (vtransform (vector 1 0 0) (mrotate (vector 45 0 150)))) (define (toon-setup obj) (grab obj) (hint-unlit) (hint-multitex) (multitexture 0 (force-load-texture "gradient.png")) (multitexture 1 (force-load-texture "outline.png")) (pdata-copy "t" "t1") (ungrab)) (define (toon-shade obj) (grab obj) (toon-light (pdata-size)) (toon-outline (pdata-size) (vtransform (vector 0 0 0) (get-camera-transform)) (vtransform (vector 0 0 0) (get-transform))) (ungrab)) (define (toon-light n) (let ((lighting (vdot (pdata-get "n" n) dirlight1))) (if (< lighting 0) (set! lighting 0.1)) (if (> lighting 0.95) (set! lighting 0.95)) (pdata-set "t" n (vector lighting 1 0))) (if (< n 1) 0 (toon-light (- n 1)))) (define (toon-outline n camerapos obpos) (let ((v (vadd obpos (pdata-get "p" n)))) ; find the vertex in worldspace (let ((i (vnormalise (vsub camerapos v)))) ; incident direction (normalised) (pdata-set "t1" n (vector (vdot i (pdata-get "n" n)) 0 0)))) ; set s to the facing ratio (i dot n) (if (< n 0) 0 (toon-outline (- n 1) camerapos obpos)))