;;;; "table.scm" Bluestone table on patio.
;; Copyright 2001, 2002 Aubrey Jaffer

(require 'solid)
(define inch 25.4e-3)			; 25.4.mm

(define bluestone
  (solid:texture "greystone.jpg" (solid:color '(.3 .3 .5) .65)))
(define douglas-fir
  (solid:texture "wood_g.jpg" (solid:color '(.7 .4 .2) .5)))

(define slab (solid:box '(20.5 2 12) bluestone))

(define leg (solid:box '(1.25 22 1.25) douglas-fir))
(define long-rail
  (solid:rotation '(0 0 1) 90
		  (solid:box '(.75 15.5 .75) douglas-fir)))
(define short-rail
  (solid:rotation '(1 0 0) 90
		  (solid:box '(.75 9 .75) douglas-fir)))
(define style (solid:cylinder .375 -4 douglas-fir))

(define table
  (solid:translation
   '(0 11 0)
   (solid:translation '(0 12 0) slab)
   (solid:translation
    '(0 3 0)
    (solid:center-array-of 2 2 short-rail '(15.5 0 0) '(0 4 0))
    (solid:center-array-of 2 2 style '(15.5 0 0) '(0 0 1.5)))
   (solid:translation
    '(0 5 0)
    (solid:center-array-of 2 2 long-rail '(0 4 0) '(0 0 9))
    (solid:center-array-of 3 2 style '(1.5 0 0) '(0 0 9)))
   (solid:center-array-of 2 2 leg '(15.5 0 0) '(0 0 9))))

(define patio
  (let ((repeat 9))
    (solid:translation
     '(0 -1.5 0)
     (solid:box `(,(* 15 repeat) 3 ,(* 15 repeat))
		(solid:texture "paver.jpg"
			       (solid:color '(1 .9 .95) .4)
			       repeat)))))

(define curios
  (solid:translation
   '(0 24 0)
   (solid:translation
    '(-7 2 4)
    (solid:pyramid 4 4 (solid:color '#(1 .8 0) .4 '#(1 .9 .5) .8)))
   (solid:translation
    '(0 0.95 0)
    (solid:rotation '(0 0 1)
		    (+ -90 (/ (asin (/ .036 .32)) pi/180))
		    (solid:scale (/ inch) (solid:arrow))))))

(vrml-to-file
 "table.wrl"
 (world:info "Bluestone Table")
 "NavigationInfo {headlight FALSE avatarSize [0.01, 0.01, 0.01]}"

 (solid:translation '(0 .35 0) (scene:viewpoint "Photo" 1.2 0 -16))
 (solid:translation '(0 .5 0) (scene:viewpoints 1.3))
 (scene:sky-and-dirt)
 (scene:sun 42 340 9 2 1.5)
 (solid:scale inch
	      (solid:rotation '(0 1 0) 21
			      curios
			      table)
	      patio))

(system "freewrl --geometry 480x576 table.wrl")
