;;-----------------------------------------------------------------------------
;;                                               for CoCreate OneSpace Designer
;;  Description:
;;    add function sd-am-pnt-equal-p to compare points of Annotation module
;;
;;-----------------------------------------------------------------------------
;;
;;  Filename   : sd_am_pnt_equal_p.lsp
;;                to be loaded from within <custdir>/ANNOTATION/am_customize
;;  Version    : 1.0
;;  Datum      : 06dez2009
;;  Author     : der_Wolfgang@forum@cad.de
;;  Download   : osd.cad.de (sooner or later)
;;  SD-Version : developed with 15.50 / PE20 - executed with ----, too
;;
;;-----------------------------------------------------------------------------
;;
;;  (sd-am-pnt-equal-p /point1/ /point2/
;;                  :resolution /resolution/)
;;
;;  *Description:*
;;      Checks if the difference between two points is equivalent to the
;;      null point (0,0) within the specified geometric resolution
;;      (or the default resolution of 1e-6).
;;
;;  *Parameters:*
;;      *point1* and *point2* {GPNTDOCU or GPNT2D}
;;          The points to compare.
;;      *:resolution* {NUMBER [1e-6]}
;;          The geometric resolution (accuracy).
;;
;;  *Return value:*
;;      T - if the points are equal
;;      NIL - if the points are not equal
;;-----------------------------------------------------------------------------

(in-package :oli)
(export 'sd-am-pnt-equal-p)

(defun sd-am-pnt-equal-p (pnt1 pnt2 &key (resolution (sd-inq-default-geo-resolution)))
  (cond
    ((not (or (gpnt2d-p pnt1) (frame2::gpntdocu-p pnt1)))
     (values nil :type-mismatch-pnt-1))
    ((not (or (gpnt2d-p pnt2) (frame2::gpntdocu-p pnt2)))
     (values nil :type-mismatch-pnt-2))
    ((not (numberp resolution))
     (values nil :type-mismatch-resolution))
    ;; parameters are fine, lets compare the points
    (T
     (let (x1 x2 y1 y2)
       (if (gpnt2d-p pnt1)
         (setq x1 (gpnt2d_x pnt1)
               y1 (gpnt2d_y pnt1))
         (setq x1 (gpntdocu_x pnt1)
               y1 (gpntdocu_y pnt1))
         )
       (if (gpnt2d-p pnt2)
         (setq x2 (gpnt2d_x pnt2)
               y2 (gpnt2d_y pnt2))
         (setq x2 (gpntdocu_x pnt2)
               y2 (gpntdocu_y pnt2))
         )
       (and
         (sd-num-equal-p x1 x2 :resolution resolution)
         (sd-num-equal-p y1 y2 :resolution resolution)
         )
      ) ;; end let
     )
  ) ;; end cond parameter check
)

;;-----------------------------------------------------------------------------
;;  test calls..   disabled by default
;;-----------------------------------------------------------------------------
(when nil
 (sd-show-console-window)
 ;(trace sd-am-pnt-equal-p) ;; only if problems appear
 (setf (symbol-function 'make-gpntdocu) #'frame2::make-gpntdocu)
 (let ((i 0) res)
  (dolist (test `(;; list of 1st pnt 2nd pnt resolution + expected result
                  (,(make-gpnt2d   :x 1.3 :y 1.3)  ,(make-gpnt2d   :x 1.3 :y 1.3) 0.1 T)
                  (,(make-gpntdocu :x 1.3 :y 1.3)  ,(make-gpntdocu :x 1.3 :y 1.3) 0.1 T)
                  (,(make-gpnt2d   :x 1.3 :y 1.3)  ,(make-gpntdocu :x 1.3 :y 1.3) 0.1 T)
                  (,(make-gpntdocu :x 1.3 :y 1.3)  ,(make-gpnt2d   :x 1.3 :y 1.3) 0.1 T)
                                                                             
                  (,(make-gpnt2d :x 1 :y 1) :bad 0.1 NIL)
                  (:bad ,(make-gpnt2d :x 1 :y 1) 0.1 NIL)
                  (,(make-gpntdocu :x 1 :y 1)     ,(make-gpntdocu :x 1 :y 1) :bad NIL)

                  (,(make-gpntdocu :x 1.2 :y 1.0) ,(make-gpntdocu :x 1.0 :y 1.0) 0.2 T)
                  (,(make-gpntdocu :x 1.0 :y 1.2) ,(make-gpntdocu :x 1.0 :y 1.0) 0.2 T)
                  (,(make-gpntdocu :x 1.0 :y 1.0) ,(make-gpntdocu :x 1.2 :y 1.0) 0.2 T)
                  (,(make-gpntdocu :x 1.0 :y 1.0) ,(make-gpntdocu :x 1.0 :y 1.2) 0.2 T)

                  (,(make-gpntdocu :x 1.2 :y 1.0) ,(make-gpntdocu :x 1.0 :y 1.0) 0.1 NIL)
                  (,(make-gpntdocu :x 1.0 :y 1.2) ,(make-gpntdocu :x 1.0 :y 1.0) 0.1 NIL)
                  (,(make-gpntdocu :x 1.0 :y 1.0) ,(make-gpntdocu :x 1.2 :y 1.0) 0.1 NIL)
                  (,(make-gpntdocu :x 1.0 :y 1.0) ,(make-gpntdocu :x 1.0 :y 1.2) 0.1 NIL)
                  
                  (,(make-gpntdocu :x 1.2 :y 1.0) ,(make-gpnt2d :x 1.0 :y 1.0) 0.1 NIL)
                  (,(make-gpntdocu :x 1.0 :y 1.2) ,(make-gpnt2d :x 1.0 :y 1.0) 0.1 NIL)
                  (,(make-gpntdocu :x 1.0 :y 1.0) ,(make-gpnt2d :x 1.2 :y 1.0) 0.1 NIL)
                  (,(make-gpntdocu :x 1.0 :y 1.0) ,(make-gpnt2d :x 1.0 :y 1.2) 0.1 NIL)

                  (,(make-gpnt2d :x 1.2 :y 1.0) ,(make-gpntdocu :x 1.0 :y 1.0) 0.1 NIL)
                  (,(make-gpnt2d :x 1.0 :y 1.2) ,(make-gpntdocu :x 1.0 :y 1.0) 0.1 NIL)
                  (,(make-gpnt2d :x 1.0 :y 1.0) ,(make-gpntdocu :x 1.2 :y 1.0) 0.1 NIL)
                  (,(make-gpnt2d :x 1.0 :y 1.0) ,(make-gpntdocu :x 1.0 :y 1.2) 0.1 NIL)
                  ))                                                      
    (incf i)
    (setq res (sd-am-pnt-equal-p (nth 0 test) (nth 1 test) :resolution (nth 2 test)))
    (format T "~&~A sd-am-pnt-equal-p test case ~3D~%" 
        (if (eql res (nth 3 test)) "TEST:OK" "TEST:ERROR") i)
   ))
  (untrace sd-am-pnt-equal-p)
  )