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