home *** CD-ROM | disk | FTP | other *** search
/ vis-ftp.cs.umass.edu / vis-ftp.cs.umass.edu.tar / vis-ftp.cs.umass.edu / pub / Software / ASCENDER / ascendMar8.tar / UMass / BuildingFinder / Lisp / extrude.lisp < prev    next >
Lisp/Scheme  |  1995-04-12  |  1KB  |  42 lines
  1. (in-package 'cme)
  2.  
  3. #| ********old version that doesn't work very well
  4. (defun extrude-roof-curve (curve)
  5.   (let* ((extru (make-extrusion-from-vertex-list
  6.              (listarray (vertices curve))
  7.              (object-to-world-transform curve)
  8.              (world curve)))
  9.          (vlist (make-vertex-list-from-vertex-array (vertices curve)))
  10.          (vert (car vlist)))
  11.     (set-z-size extru (- (third vert)
  12.              (terrain-model-Z-at-XY
  13.                  (find-terrain-model (world curve))
  14.                  (car vert) (cadr vert)))) 
  15.     extru))
  16. |#
  17.  
  18.  
  19. (defun find-lowest-terrain-Z-under-curve (curve)
  20.   (let ((terrain (find-terrain-model (world curve)))
  21.     (vertlist (make-vertex-list-from-vertex-array (vertices curve))))
  22.     (apply #'min (mapcar #'(lambda (vert)
  23.                  (terrain-model-Z-at-XY
  24.                      terrain
  25.                  (car vert)
  26.                  (cadr vert)))
  27.              vertlist))))
  28.  
  29. (defun extrude-roof-curve (curve)
  30.   (let ((groundz (find-lowest-terrain-z-under-curve curve))
  31.     (roofz (vertex-obj-z (car (listarray (vertices curve))))))
  32.     (make-extrusion curve :bottom-z groundz :z-size (- groundz roofz))))
  33.  
  34.  
  35. (defun z-height-at-XY (xpos ypos zpos world)
  36.   (let* ((terrain (find-terrain-model world))
  37.      (ground (terrain-model-Z-at-XY terrain xpos ypos)))
  38.     (- zpos ground)))
  39.  
  40.  
  41.  
  42.