diff options
Diffstat (limited to 'solid.scm')
| -rw-r--r-- | solid.scm | 58 |
1 files changed, 58 insertions, 0 deletions
@@ -570,6 +570,22 @@ (solid:node "Box" (sprintf #f "size %s" (coordinate3string geom))))) +;;@body +;;Returns a box of the specified @1, but with the y-axis of a texture +;;specified in @2 being applied along the longest dimension in @1. +(define (solid:lumber geometry appearance) + (define x (car geometry)) + (define y (cadr geometry)) + (define z (caddr geometry)) + (cond ((and (>= y x) (>= y z)) + (solid:box geometry appearance)) + ((and (>= x y) (>= x z)) + (solid:rotation '(0 0 1) 90 + (solid:box (list y x z) appearance))) + (else + (solid:rotation '(1 0 0) 90 + (solid:box (list x z y) appearance))))) + ;;@args radius height appearance ;;@args radius height ;;Returns a right cylinder with dimensions @code{(abs @1)} and @code{(abs @2)} @@ -693,6 +709,48 @@ ((negative? idx) (apply string-append lst))))))) +;;@args xz-array y appearance +;;@args xz-array y +;;@1 must be an @var{n}-by-2 array holding a sequence of coordinates +;;tracing a non-intersecting clockwise loop in the x-z plane. @0 will +;;close the sequence if the first and last coordinates are not the +;;same. +;; +;;@0 returns a capped prism @2 long. +(define (solid:prism xz-array y . appearance) + (define y/2 (/ y 2)) + (define dims (array-dimensions xz-array)) + ;;(define (sfbool bool) (if bool "TRUE" "FALSE")) + (if (not (eqv? 2 (cadr dims))) (slib:error 'solid:prism 'dimensions dims)) + (sprintf #f + "\ +Shape { + %s + geometry Extrusion { + convex FALSE + endCap TRUE + beginCap TRUE + spine [0 %g 0, 0 %g 0] + crossSection [%s] + } +} +" + (if (null? appearance) "" (car appearance)) + (- y/2) y/2 + (do ((str (if (and (= (array-ref xz-array (+ -1 (car dims)) 0) + (array-ref xz-array 0 0)) + (= (array-ref xz-array (+ -1 (car dims)) 1) + (array-ref xz-array 0 1))) + "" + (sprintf #f "%g, %g\n" + (array-ref xz-array (+ -1 (car dims)) 0) + (array-ref xz-array (+ -1 (car dims)) 1))) + (string-append str (sprintf #f " %g, %g\n" + (array-ref xz-array idx 0) + (array-ref xz-array idx 1)))) + (idx 0 (+ 1 idx))) + ((>= idx (car dims)) str)))) + ;;@args width height depth colorray appearance ;;@args width height depth appearance ;;@args width height depth |