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 / functions.lisp~ < prev    next >
Lisp/Scheme  |  1994-01-24  |  8KB  |  260 lines
  1. (in-package 'cme)
  2.  
  3. (DEF-FOREIGN-CALLABLE-SWITCH (GET-INTERACTOR-DFCS (:NAME "get_interactor")
  4.                               (:RETURN-TYPE C-HANDLE))
  5.                              ((OPTIONALS-USED :SIGNED-32BIT)
  6.                   (PANE C-HANDLE))
  7.                              (IF (ZEROP OPTIONALS-USED)
  8.                                  (ic::GET-INTERACTOR)
  9.                                  (ic::GET-INTERACTOR PANE)))
  10.  
  11.  
  12. ;;; External Function Definitions
  13. ;;;
  14. ;;;
  15.  
  16.  
  17. (DEF-FOREIGN-FUNCTION-SWITCH (FIND-POLYGONS (:NAME "find_polygons")
  18.                               (:RETURN-TYPE :LISP))
  19.                  (SENSITIVITY :DOUBLE-FLOAT)
  20.                  (CONSTRAIN :BOOLEAN)
  21.                  (MANUAL :BOOLEAN)
  22.                  (2.5DFILES :BOOLEAN)
  23.                  (X1 :SIGNED-32BIT)
  24.                  (Y1 :SIGNED-32BIT)
  25.                  (X2 :SIGNED-32BIT)
  26.                  (Y2 :SIGNED-32BIT)
  27.                  (K  :SIGNED-32BIT)
  28.                  (PANECHOICE C-HANDLE))
  29.  
  30. (DEF-FOREIGN-FUNCTION-SWITCH (DRAWLINES (:NAME "drawLines")
  31.                              (:RETURN-TYPE :SIGNED-32BIT))
  32.                            )
  33.  
  34. (DEF-FOREIGN-FUNCTION-SWITCH (FIND-INTERSECTIONS (:NAME "computeIntersections")
  35.                 (:RETURN-TYPE :LISP))
  36.                 (LINE-FILE :STRING)
  37.             )
  38.  
  39. (DEF-FOREIGN-FUNCTION-SWITCH (ACQUIRE-MODEL (:NAME "acquireModel")
  40.                 (:RETURN-TYPE :SIGNED-32BIT))
  41.                     (SENSITIVITY :DOUBLE-FLOAT)
  42.                 (CONSTRAIN :BOOLEAN)
  43.                  (RegionSize :DOUBLE-FLOAT)
  44.                 (Overlap :DOUBLE-FLOAT))
  45.  
  46.  
  47.  
  48.  
  49. (def-foreign-function-switch (set-building-parameters
  50.                      (:name "set_building_parameters")
  51.                 (:return-type :signed-32bit))
  52.                 (angle-error :double-float)
  53.                 (line-endpoint-window :double-float)
  54.                 (search-angle :double-float)
  55.                 (support-column :double-float)
  56.                 (min-line-support :double-float)
  57.                 (token-support :double-float)
  58.                 (token-window :double-float))
  59.  
  60. (def-foreign-function-switch (draw-corner-data (:name "drawcorners")
  61.                 (:return-type :signed-32bit))
  62.                 (file :STRING))
  63.  
  64. (DEF-FOREIGN-FUNCTION-SWITCH (DRAWPOINTS (:NAME "drawcorners")
  65.                              (:RETURN-TYPE :SIGNED-32BIT))
  66.             (filename :string))
  67.  
  68. (defun list-project-to-world (proj u v 3d-w)
  69.   (multiple-value-bind (x y z)
  70.      (cme::project-to-world
  71.         proj
  72.         (coerce u 'double-float)
  73.         (coerce v 'double-float)
  74.         3d-w)
  75.      (vector x y z)))
  76.  
  77. (defun list-project-to-world-kp (proj u v z0)
  78.   (multiple-value-bind (x y z)
  79.      (cme::project-to-world
  80.         proj
  81.         (coerce u 'double-float)
  82.         (coerce v 'double-float)
  83.     (coerce z0 'double-float))
  84.      (vector x y z)))
  85.  
  86.  
  87.  
  88. ;;
  89. ;; Link to Lisp code to check if image support exists for a grouping
  90. ;; between two corners.
  91. ;;
  92. (def-foreign-callable-switch (image-line-support-dfcs 
  93.                 (:name "image_line_support")
  94.                 (:return-type :double-float))
  95.                  ((image c-handle)
  96.                   (u1 :double-float)
  97.                   (v1 :double-float)
  98.                   (u2 :double-float)
  99.                   (v2 :double-float)
  100.                   (width :double-float)
  101.                   (percentage :double-float))
  102.     (cme::image-line-support image u1 v1 u2 v2 width percentage))
  103.  
  104.  
  105. ;;
  106. ;;
  107. ;; Added to allow projections from 2d to 3d
  108.  
  109. (DEF-FOREIGN-CALLABLE-SWITCH (PROJECT-TO-WORLD-DFCS (:NAME "project_to_world")
  110.                               (:RETURN-TYPE C-HANDLE))
  111.                              ((ARG_0 C-HANDLE) (ARG_1 :DOUBLE-FLOAT)
  112.                               (ARG_2 :DOUBLE-FLOAT) (ARG_3 C-HANDLE))
  113.                              (CME::LIST-PROJECT-TO-WORLD ARG_0 ARG_1 ARG_2 ARG_3))
  114.  
  115. (DEF-FOREIGN-CALLABLE-SWITCH (PROJECT-TO-WORLD-KP-DFCS
  116.              (:NAME "project_to_world_KP")
  117.                               (:RETURN-TYPE C-HANDLE))
  118.                              ((ARG_0 C-HANDLE) (ARG_1 :DOUBLE-FLOAT)
  119.                               (ARG_2 :DOUBLE-FLOAT) (ARG_3 :DOUBLE-FLOAT))
  120.                              (CME::LIST-PROJECT-TO-WORLD-KP ARG_0 ARG_1 ARG_2 ARG_3))
  121.  
  122.  
  123. (DEF-FOREIGN-CALLABLE-SWITCH (LINES-FORM-CORNER-P-DFCS
  124.              (:NAME "lines_form_corner")
  125.                 (:RETURN-TYPE (:POINTER LCI::DOUBLE_2)))
  126.                 ((ARG_0 C-HANDLE)
  127.                  (ARG_1 :DOUBLE-FLOAT)
  128.                  (ARG_2 :DOUBLE-FLOAT)
  129.                  (ARG_3 :DOUBLE-FLOAT)
  130.                  (ARG_4 :DOUBLE-FLOAT)
  131.                  (ARG_5 :DOUBLE-FLOAT)
  132.                  (ARG_6 :DOUBLE-FLOAT)
  133.                  (ARG_7 :DOUBLE-FLOAT)
  134.                  (ARG_8 :DOUBLE-FLOAT)
  135.                  (ARG_9 :DOUBLE-FLOAT))
  136. (CME::LINES-FORM-CORNER-P ARG_0 ARG_1 ARG_2 ARG_3 ARG_4 ARG_5 ARG_6 ARG_7 ARG_8 ARG_9))
  137.                 
  138.  
  139. ;;
  140. ;;
  141. ;; Code to allow 3d world capture
  142. ;;
  143. ;;
  144. (DEF-FOREIGN-CALLABLE-SWITCH (GET-3D-IMAGE-WORLD-DFCS
  145.                      (:NAME "get_3d_image_world")
  146.                 (:RETURN-TYPE C-HANDLE))
  147.                  ((ARG_0 :SIGNED-32BIT))
  148.                 (CME::GET-3D-IMAGE-WORLD ARG_0))
  149.  
  150. (DEF-FOREIGN-CALLABLE-SWITCH (GET-PROJ-MATRIX-DFCS
  151.                      (:NAME "get_projection_matrix")
  152.                 (:RETURN-TYPE C-HANDLE))
  153.                  ((ARG_0 :C-HANDLE))
  154.                 (CME::GET-PROJ-MATRIX ARG_0))
  155.  
  156.  
  157. ;;
  158. ;; Extrusion of Rooftops
  159. (DEF-FOREIGN-CALLABLE-SWITCH (EXTRUDE-ROOF-CURVE-DFCS
  160.                      (:NAME "extrude_roof_curve")
  161.                 (:RETURN-TYPE C-HANDLE)) 
  162.                  ((ARG_0 :C-HANDLE))
  163.                 (CME::EXTRUDE-ROOF-CURVE ARG_0))
  164.  
  165. ;;
  166. ;; Compute Z coordinate given a point in the world
  167. ;;
  168. ;;
  169. (DEF-FOREIGN-CALLABLE-SWITCH (Z-HEIGHT-AT-XY-DFCS
  170.                 (:NAME "z_height_at_xy")
  171.                 (:RETURN-TYPE :DOUBLE-FLOAT))
  172.                 ((ARG_0    :DOUBLE-FLOAT)
  173.                 (ARG_1  :DOUBLE-FLOAT)
  174.                 (ARG_2  :DOUBLE-FLOAT)
  175.                 (ARG_3  :C-HANDLE))
  176.             (Z-HEIGHT-AT-XY ARG_0 ARG_1 ARG_2 ARG_3))
  177.                 
  178.  
  179.  
  180.  
  181. ;;
  182. ;;
  183. ;; Added to allow C Calls to the Fatlines.
  184. ;;
  185. ;;
  186. (DEF-FOREIGN-CALLABLE-SWITCH (DRAW-FAT-LINE-DFCS (:NAME "draw_fat_line")
  187.                               (:RETURN-TYPE :LISP))
  188.                              ((ARG_0 C-HANDLE) (ARG_1 :DOUBLE-FLOAT)
  189.                               (ARG_2 :DOUBLE-FLOAT) (ARG_3 :DOUBLE-FLOAT)
  190.                               (ARG_4 :DOUBLE-FLOAT) (ARG_5 :DOUBLE-FLOAT))
  191.                              (CME::NEW-DRAW-LINE ARG_0 ARG_1 ARG_2
  192.                                             ARG_3 ARG_4 ARG_5))
  193.  
  194. (DEF-FOREIGN-CALLABLE-SWITCH (DRAW-FAT-POINT-DFCS (:NAME "draw_fat_point")
  195.                               (:RETURN-TYPE :LISP))
  196.                              ((ARG_0 C-HANDLE) (ARG_1 :DOUBLE-FLOAT)
  197.                               (ARG_2 :DOUBLE-FLOAT) (ARG_3 :DOUBLE-FLOAT))
  198.                              (CME::NEW-DRAW-POINT ARG_0 ARG_1 ARG_2
  199.                                              ARG_3))
  200.  
  201. (DEF-FOREIGN-CALLABLE-SWITCH (FLUSH-DISPLAY-DFCS (:NAME "flush_display")
  202.                               (:RETURN-TYPE :LISP))
  203.                              ((ARG_0 C-HANDLE)) 
  204.                              (CME::FLUSH-DISPLAY ARG_0))
  205.  
  206. (DEF-FOREIGN-CALLABLE-SWITCH (SET-IOR-ALU-DFCS (:NAME "set_ior_alu")
  207.                               (:RETURN-TYPE :LISP))
  208.                              ((ARG_0 C-HANDLE)) 
  209.                              (cme::SET-IOR-ALU ARG_0))
  210.  
  211. (DEF-FOREIGN-CALLABLE-SWITCH (READ-TEC-PROJECTION-DFCS (:NAME "read_tec_projection")
  212.     (:RETURN-TYPE C-HANDLE))
  213.     ()
  214.     (read-tec-projection "75.hdr"))
  215.  
  216. ;;(DEF-FOREIGN-FUNCTION-SWITCH (GET-IMAGE-NAME-DFCS (:NAME "get_image_name")
  217. ;;                (:RETURN-TYPE :POINTER :CHARACTER))
  218. ;;                ()
  219. ;;                (cme::name (get-2d-world (top-image))))
  220.  
  221. (DEF-FOREIGN-CALLABLE-SWITCH (TEC-PROJECT-POINT-DFCS (:NAME "tec_project_point")    (:RETURN-TYPE C-HANDLE))
  222.     ((ARG_0 C-HANDLE)
  223.     (ARG_1 :DOUBLE-FLOAT)
  224.     (ARG_2 :DOUBLE-FLOAT)
  225.     (ARG_3 :DOUBLE-FLOAT))
  226.     (tec-project-point ARG_0 ARG_1 ARG_2 ARG_3))
  227.  
  228. (DEF-FOREIGN-CALLABLE-SWITCH (TEC-BACKPROP-POINT-DFCS (:NAME "backprop_point")
  229.     (:RETURN-TYPE C-HANDLE))
  230.     ((ARG_0 :SIGNED-32BIT)
  231.      (ARG_1 :DOUBLE-FLOAT)
  232.      (ARG_2 :DOUBLE-FLOAT))
  233.     (backproject-point ARG_0 ARG_1 ARG_2))
  234.     
  235. ;;;
  236. ;;;
  237. ;;; Load external Lisp declarations.
  238. ;;;
  239. ;;;
  240. (LOAD "$CMEHOME/radius/alv-ugv1/tec-header-input.lisp")
  241. (LOAD (full-umass-path "BuildingFinder/Lisp/orientation.lisp"))
  242. (LOAD (full-umass-path "BuildingFinder/Lisp/extrude.lisp"))
  243. (LOAD (full-umass-path "BuildingFinder/Lisp/fat-lines-patch.lisp"))
  244. (LOAD (full-umass-path "BuildingFinder/Lisp/correct_angle.lisp"))
  245. (LOAD (full-umass-path "BuildingFinder/Lisp/cvv.lisp"))
  246.  
  247.  
  248. ;;(defmethod make-extrusion ((object 3d-closed-curve) &rest initargs
  249. ;;               &key bottom-z z-size)
  250. ;; (ignore bottom-z z-size)
  251. ;;(add-object 
  252. ;; (apply 'make-extrusion-from-vertex-list
  253. ;;       (loop for vertex being the array-elements of (vertices object)
  254. ;;         collect vertex )
  255. ;;       (object-to-world-transform object)
  256. ;;       (get-3d-world object)
  257. ;;       initargs )
  258. ;;   (selected-feature-set (world object))
  259. ;;    ))
  260.