(in-package :custom)
(use-package :oli)



(sd-defdialog 'am-rectangle-diagonal-lines
	:dialog-title "Rectangle diagonal lines"
	:toolbox-button :force
	:variables '(
  (rec-lines 
   :selection (*sd-anno-line-seltype*)
   :multiple-items t
   :title "Rectangle"
   :prompt-text "Select the four lines forming a rectangle."
   :after-input (sd-am-rectangle-diagonal-lines-fnc rec-lines line-color line-type current-color current-ltype))

  (options-exp-shr
   :title "Options"
   :expand-shrink (line-color line-type))

  (line-color
   :title "Color"
   :value-type :rgb-color
   :include-none-item t
   :persistent-data-storage t)

  (line-type
   :title "Line type"
   :range ((:SOLID :pixmap-name "solid-bmp")
           (:PHANTOM :pixmap-name "phantom-bmp")
           (:DOT_CENTER :pixmap-name "dotcenter-bmp")
           (:DOTTED :pixmap-name "dotted-bmp")
           (:DASHED :pixmap-name "dashed-bmp")
           (:DASH_CENTER :pixmap-name "dashcenter-bmp")
           (:LONG_DASHED :pixmap-name "longdashed-bmp")
           (:CENTER_DASH_DASH :pixmap-name "centerdashdash-bmp")))

		(current-color
   :initial-visible nil
 		:initial-value (sd-am-geo-attributes-struct-color 
                   (sd-am-inq-curr-geometry-attributes)))

		(current-ltype 
   :initial-visible nil
			:initial-value (sd-am-geo-attributes-struct-linetype 
                   (sd-am-inq-curr-geometry-attributes)))))



(defun sd-am-rectangle-diagonal-lines-fnc (rec-lines line-color line-type current-color current-ltype)
 (if (= (length rec-lines) 4)
  (let ((vec-res (sd-am-inq-rectangle-vec-res rec-lines)))
    
    (dolist (l1 vec-res)
     (dolist (l2 vec-res)
      (unless (equal l1 l2) 
       (when (sd-vec-colinear-p (first l1) (first l2))
        (let* (
         d1-spnt
         d1-epnt
         d2-spnt
         d2-epnt
         cmd-strng-d1
         cmd-strng-d2
         (l1-spnt (second l1))
         (l1-epnt (third l1))
         (l2-spnt (second l2))
         (l2-epnt (third l2))
         (owner (sd-get-annotator-reference :object (fourth l1)))
         (dvss (sd-vec-normalize (sd-vec-subtract l1-spnt l2-spnt)))
         (dvee (sd-vec-normalize (sd-vec-subtract l1-epnt l2-epnt)))
         (dvse (sd-vec-normalize (sd-vec-subtract l1-spnt l2-epnt)))
         (dves (sd-vec-normalize (sd-vec-subtract l1-epnt l2-spnt))))
         
          (cond
           ((not (sd-vec-colinear-p dvss dvee))
            (progn
             (setq d1-spnt l1-spnt)
             (setq d1-epnt l2-spnt)
             (setq d2-spnt l1-epnt)
             (setq d2-epnt l2-epnt)))
           ((not (sd-vec-colinear-p dvse dves))
            (progn
             (setq d1-spnt l1-spnt)
             (setq d1-epnt l2-epnt)
             (setq d2-spnt l1-epnt)
             (setq d2-epnt l2-spnt)))
           (t (progn
               (sd-display-error "None rectangular form selected.")
               (return-from sd-am-rectangle-diagonal-lines-fnc nil))))
               
          (setq cmd-strng-d1 
           (format nil "ag_create_dia_line ~a ~a ~a ~a ~a ~a '~a'" 
            d1-spnt d1-epnt line-type (sd-color-to-rgb line-color) current-ltype current-color owner))
          (setq cmd-strng-d2 
           (format nil "ag_create_dia_line ~a ~a ~a ~a ~a ~a '~a'" 
            d2-spnt d2-epnt line-type (sd-color-to-rgb line-color) current-ltype current-color owner))

          (sd-execute-annotator-command :cmd cmd-strng-d1)
          (sd-execute-annotator-command :cmd cmd-strng-d2)

          (return-from sd-am-rectangle-diagonal-lines-fnc nil)))))))

  (sd-display-message "Please select the four line forming a rectangle.")))



(defun sd-am-inq-rectangle-vec-res (rec-lines)
 (let (
  (vec-res (list))
  (scl (get-item-scale (first rec-lines))))

   (dolist (i rec-lines)
    (let* (
     (geo-props (sd-am-inq-specific-geo-props i))
     (spnt (sd-vec-scale (sd-am-line-struct-start-pnt geo-props) (/ 1 scl)))
     (epnt (sd-vec-scale (sd-am-line-struct-end-pnt geo-props) (/ 1 scl)))                     
     (dir-vec (sd-vec-normalize (sd-vec-subtract spnt epnt))))
      (push (list dir-vec spnt epnt i) vec-res)))

   vec-res))



(defun get-item-scale (item)
 (let* (
  (lname (sd-am-inq-unique-name item))
  (cmd-strng-scl (format nil "Docu_get_am_owner_of_upn '~a'" lname))
  (ret-val (sd-execute-annotator-function :fnc cmd-strng-scl)))
  
   (when ret-val
    (getf ret-val :scale))))



(sd-execute-annotator-command :cmd 
 "DEFINE ag_create_dia_line
   PARAMETER Pnt1
   PARAMETER Pnt2
   PARAMETER Ltype
   PARAMETER Lcolor
   PARAMETER Ltype_curr
   PARAMETER Lcolor_curr
   PARAMETER Edge_pointer
   
   LOCAL Curr_part
   LOCAL Owner
   
   INQ_SELECTED_ELEM GLOBAL POINTER Edge_pointer
   LET Owner (INQ 309)
   
   INQ_PART CURRENT
   LET Curr_part (INQ 302)
   EDIT_PART Owner
   LINE COLOR Lcolor LINEPATTERN Ltype TWO_PTS Pnt1 Pnt2
   LINE COLOR Lcolor_curr LINEPATTERN Ltype_curr
   EDIT_PART Curr_part
  END_DEFINE")