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

;;;-------------------------------------------------------------------------------------------------
;;; Constants
;;;-------------------------------------------------------------------------------------------------

(defconstant +resolution+ 0.0001)

;;;-------------------------------------------------------------------------------------------------
;;; Global Variables
;;;-------------------------------------------------------------------------------------------------

(defparameter *all-groups* nil)
(defparameter *remaining-lines* nil)
(defparameter +scaled-width+ 0)
(defparameter *get-connected-contours-side* nil)
(defparameter *get-connected-contours-recover-state-list* nil)

;; (defparameter *global-group* nil)

;; Kommentare für zukünftige Verwendung
;; 3D- Geometrie ermitteln, die aktualisiert wurde (kann im Aktualisierungs-Event verwendet werden, um ungültige Microjoint Linien zu finden)
;; INQ_SELECTED_ELEM SELECT SUBTREE INFOS 'MICROJOINT_INFO:*' AND SUBTREE INFOS "RC: sys eq" SUBTRACT SUBTREE INFOS "RC: equal" SUBTRACT SUBTREE INFOS "ADU: *" CONFIRM
;;

;;;-------------------------------------------------------------------------------------------------
;;; Dialogs
;;;-------------------------------------------------------------------------------------------------

(sd-defdialog 'get-connected-contours
  :dialog-title "Konturen einlesen"
  :toolbox-button nil

	:variables
	'(
    (my_view
      :title "Ansicht"
      :selection (*sd-anno-view-seltype* *sd-anno-flat-seltype*)
      :after-input (set-correct-line-length)
    )
    ("-")
    (zoom_view
      :title "Ansicht zoomen"
      :toggle-type :wide-toggle
      :push-action (when my_view (docu::docu-vp-fit-to-part (sd-am-inq-unique-name my_view)))
    )
    ("-")
    (btn_determine
      :title "Ermittle Konturen"
      :toggle-type :wide-toggle
      :push-action (determine-contours)
    )
    (num_display
      :title "0/0"
      :toggle-type :wide-toggle
      :title-alignment :center
      :initial-visible nil
      :push-action (pprint num)
    )
    (num
      :value-type :number
      :initial-visible nil
      :initial-value 0
      :after-input
        (when micro-joint-groups
          (cond
            ((= num (length micro-joint-groups))
              (sd-set-variable-status 'next :enable nil)
              (sd-set-variable-status 'finish :visible t)
            )
            ((= num 1)
              (sd-set-variable-status 'prev :enable nil)
              (when (= 1 (length micro-joint-groups))
                (sd-set-variable-status 'next :enable nil)
                (sd-set-variable-status 'finish :visible t)
              )
            )
            (t
              (sd-set-variable-status 'prev :enable t)
              (sd-set-variable-status 'next :enable t)
              (sd-set-variable-status 'finish :visible nil)
            )
          )
          (sd-set-variable-status 'num_display :title (format nil "~a/~a" num (length micro-joint-groups)))
        )
    );; num
    (automatic
      :title "automatisch erstellen"
      :value-type :boolean
      :toggle-type :wide-toggle
      :initial-value t
      :initial-visible nil
    )
    (create_lines
      :title "Start"
      :toggle-type :wide-toggle
      :initial-visible nil
      :push-action (create-laser-lines)
    )
    (prev
      :title "Vorher"
      :size :half
      :toggle-type :grouped-toggle
      :title-alignment :center
      :initial-visible nil
      :initial-enable nil
      :push-action (prev-action)
    )
    (next
      :title "Nächste"
      :size :half
      :toggle-type :grouped-toggle
      :title-alignment :center
      :initial-visible nil
      :initial-enable nil
      :push-action (next-action)
    )
    (finish
      :title "Abschließen"
      :toggle-type :wide-toggle
      :title-alignment :center
      :initial-visible nil
      :initial-enable t
      :push-action (finish-action)
    )
    (other_side
      :title "Andere Seite"
      :toggle-type :wide-toggle
      :initial-visible nil
      :push-action (reset-and-invert-equidistant)
    )
    (PARAMETERS
      :expand-shrink (microjoint_width scaled_width)
    )
    (microjoint_width
      :value-type :positive-length
      :initial-value 0.2
      :persistent-data-storage t
      :after-input (set-correct-line-length)
    )
    (scaled_width
      :value-type :positive-length
      :initial-value microjoint_width
      :initial-enable nil
    )
    (micro-joint-groups)
    (micro-joint-groups-processed)
    (curr_uid)

  ); variables
  :ok-action '(complete-action)
  :cancel-action '(sd-execute-annotator-command :cmd "ST_reset_highlight_microjoint_elem")
  :local-functions
  '(
    (finish-action ()
      (let ()
        (sd-execute-annotator-command :cmd "ST_reset_highlight_microjoint_elem")
        (sd-set-variable-status 'automatic :visible nil)
        (sd-set-variable-status 'prev :visible nil)
        (sd-set-variable-status 'next :visible nil)
        (sd-set-variable-status 'create_lines :visible nil)
        (sd-set-variable-status 'num_display :visible nil)
        (sd-set-variable-status 'finish :visible nil)
        (sd-execute-annotator-command :cmd "SHOW GLOBAL ALL RGB_COLOR 0.8 0.8 0.8")
        (sd-execute-annotator-command :cmd "ST_highlight_microjoint_elements_by_info 'MICROJOINT_INFO: dir-not-equal' RED")
        (sd-execute-annotator-command :cmd "ST_highlight_microjoint_elements_by_info 'MICROJOINT_INFO: not-orthogonal' RED")
        (sd-execute-annotator-command :cmd "ST_highlight_microjoint_elements_by_info 'MICROJOINT_INFO: no-line-or-arc' RED")
      )
    )
    (create-laser-lines ()
      (sd-execute-annotator-command :cmd "ST_reset_highlight_microjoint_elem")
      (if automatic
        (progn
          (sd-set-variable-status 'automatic :enable nil)
          (sd-set-variable-status 'create_lines :enable nil)
          (dolist (group micro-joint-groups)
            (next-action)
          )
          (sd-set-variable-status 'finish :visible t)
          (when my_view (docu::docu-vp-fit-to-part (sd-am-inq-unique-name my_view)))
        )
        (progn
          (sd-set-variable-status 'automatic :enable nil)
          (sd-set-variable-status 'create_lines :enable nil)
          (sd-set-variable-status 'next :enable t)
          (next-action)
        )
      )
    )
    (set-correct-line-length ()
      (when my_view
        (setf scaled_width (* microjoint_width (sd-am-view-struct-scale (sd-am-inq-view my_view))))
        (pprint (list "scaled_width: " scaled_width))
        (setf +scaled-width+ scaled_width)
      )
    )
    (complete-action ()
      (let (hide-list)
        (sd-execute-annotator-command :cmd "ST_reset_highlight_microjoint_elem")
        (dolist (group micro-joint-groups-processed)
          (dolist (elem group)
            (when (sd-execute-annotator-function :fnc (format nil "ST_get_specific_elem_info '~a' 'MICROJOINT_INFO: contour-OK' ''" (sd-get-annotator-reference :object (getf elem :sel-item))))
              (push (getf elem :sel-item) hide-list)
            )
          )
        )
        (sd-call-cmds (am_hide hide-list))
      )
    )
    (next-action ()
      (setf *get-connected-contours-side* nil)
      (sd-set-variable-status 'num :value (incf num))
      (highlight-group)
      (zoom-group)
      (push (sd-set-model-checkpoint) *get-connected-contours-recover-state-list*)
      (create-uid)
      (create-equidistant-me10) ;; nil)
      (push-group-processed)
      (highlight-group)
    )
    (prev-action ()
      (pop-group-processed)
      (setf *get-connected-contours-side* nil)
      (sd-set-variable-status 'num :value (decf num))
      (highlight-group)
      (zoom-group)
      (sd-return-to-model-checkpoint (pop *get-connected-contours-recover-state-list*))
      (sd-return-to-model-checkpoint (pop *get-connected-contours-recover-state-list*))
      (push (sd-set-model-checkpoint) *get-connected-contours-recover-state-list*)
      (create-uid)
      (create-equidistant-me10) ;;  nil)
      (push-group-processed)
      (highlight-group)
    )
    (reset-and-invert-equidistant ()
      (sd-return-to-model-checkpoint (pop *get-connected-contours-recover-state-list*))
      (push (sd-set-model-checkpoint) *get-connected-contours-recover-state-list*)
      (setf *get-connected-contours-side* (not *get-connected-contours-side*))
      (create-uid)
      (create-equidistant-me10) ;;  *get-connected-contours-side*)
      (highlight-group)
    )
    (create-uid ()
      (setf curr_uid (sd-gen-unique-filename ""))
    )
    (push-group-processed ()
      (let (group)
        (setf group (nth (- num 1) micro-joint-groups))
        (attach-group-info group curr_uid)
        (push group micro-joint-groups-processed)
      )
    )
    (attach-group-info (group uid)
      (let (pointer-list i)
        (setf pointer-list (mapcar #'(lambda (a) (sd-get-annotator-reference :object (getf a :sel-item))) group))
        (pprint pointer-list)
        (sd-execute-annotator-command :cmd (format nil "CREATE_LTAB 'ST-pointer-ltab'"))
        (setf i 0)
        (dolist (pntr pointer-list)
          (incf i)
          (sd-execute-annotator-command :cmd (format nil "WRITE_LTAB 'ST-pointer-ltab' ~a 1 '~a'" i pntr))
        )
        (sd-execute-annotator-command :cmd (format nil "ST_attach_info_to_elem 'ST-pointer-ltab' 'MICROJOINT_INFO: GROUP-ID: ~a'" uid))
      )
    )
    (pop-group-processed ()
      (let ()
        (pop micro-joint-groups-processed)
      )
    )
    (highlight-group ()
      (let ()
        (setf group (nth (- num 1) micro-joint-groups))
        (sd-execute-annotator-command :cmd "ST_reset_highlight_microjoint_elem")
        (dolist (elem group)
          (sd-execute-annotator-command :cmd (format nil "ST_highlight_microjoint_elem '~a'" (sd-get-annotator-reference :object (getf elem :sel-item))))
        )
      )
    )
    (zoom-group ()
      (let (group-edgepoints)
        (setf group-edgepoints (get-group-edgepoints (nth (- num 1) micro-joint-groups)))
        (sd-call-cmds (docu_generic_window_vp (first group-edgepoints) (second group-edgepoints)))
        (sd-execute-annotator-command :cmd "WINDOW ZOOM -1.2")
      )
    )
    (zoom-view ()
      (let (view-coords)
        (setf view-coords (sd-execute-annotator-function :fnc Docu_inq_part_box_coords (sd-get-annotator-reference :object my_view)))
        (sd-call-cmds (docu_generic_window_vp (getf view-coords :LL) (getf view-coords :UR)))
      )
    )
    (hide-group ()
      (let (group)
        (setf group (nth (- num 1) micro-joint-groups))
        (sd-call-cmds (am_hide ))
      )
    )
    (create-equidistant (other-side)
      (let ()
        ;; (pprint my_view)
        ;; (pprint (getf (nth (- num 1) micro-joint-groups) :sel-item))
        ;; (pprint (/ microjoint_width 2))
        ;; (pprint (format nil "create-equidistant ~a" other-side))
        (sd-execute-annotator-command :cmd "ADD_CURRENT_INFO 'MICROJOINT_INFO: LASER-CUT-CONTOUR'")
        (sd-execute-annotator-command :cmd (format nil "ADD_CURRENT_INFO 'MICROJOINT_INFO: GROUP-ID: ~a'" curr_uid))
        (sd-call-cmds
          (if other-side
            (am_geo_equidistance
              :owner my_view
              :contour (getf (first (nth (- num 1) micro-joint-groups)) :sel-item)
              :distance (- (/ microjoint_width 2) 0.0000001)
              :side
            )
            (am_geo_equidistance
              :owner my_view
              :contour (getf (first (nth (- num 1) micro-joint-groups)) :sel-item)
              :distance (- (/ microjoint_width 2) 0.0000001)
            )
          )
        )
        (sd-execute-annotator-command :cmd "CHANGE_CURRENT_INFO 'MICROJOINT_INFO: *' ''")
      )
    )
    (create-equidistant-auto ()
      (let (cp)
        (sd-execute-annotator-command :cmd "ADD_CURRENT_INFO 'MICROJOINT_INFO: LASER-CUT-CONTOUR'")
        (sd-execute-annotator-command :cmd (format nil "ADD_CURRENT_INFO 'MICROJOINT_INFO: GROUP-ID: ~a'" curr_uid))
        (setf cp (sd-set-model-checkpoint))
        (sd-call-cmds
          (am_geo_equidistance
            :owner my_view
            :contour (getf (first (nth (- num 1) micro-joint-groups)) :sel-item)
            :distance (/ microjoint_width 2)
          )
        )
        (setf cnt (sd-execute-annotator-function :fnc (format nil "ST_get_elem_count_with_info 'MICROJOINT_INFO: GROUP-ID: ~a' 'MICROJOINT_INFO: LASER-CUT-CONTOUR'" curr_uid)))
        (pprint (list (format nil "ST_get_elem_count_with_info 'MICROJOINT_INFO: GROUP-ID: ~a' 'MICROJOINT_INFO: LASER-CUT-CONTOUR'" curr_uid) cnt (length (nth (- num 1) micro-joint-groups))))
        (when (/= (+ cnt 2) (length (nth (- num 1) micro-joint-groups)))
          (sd-return-to-model-checkpoint cp)
          (sd-call-cmds
            (am_geo_equidistance
              :owner my_view
              :contour (getf (first (nth (- num 1) micro-joint-groups)) :sel-item)
              :distance (/ microjoint_width 2)
              :side
            )
          )
        )
        (setf cnt (sd-execute-annotator-function :fnc (format nil "ST_get_elem_count_with_info 'MICROJOINT_INFO: GROUP-ID: ~a' 'MICROJOINT_INFO: LASER-CUT-CONTOUR'" curr_uid)))
        (pprint (list (format nil "ST_get_elem_count_with_info 'MICROJOINT_INFO: GROUP-ID: ~a' 'MICROJOINT_INFO: LASER-CUT-CONTOUR'" curr_uid) cnt (length (nth (- num 1) micro-joint-groups))))
        (when (/= (+ cnt 2) (length (nth (- num 1) micro-joint-groups)))
          (pprint "KONTUR nicht OK!")
          (sd-return-to-model-checkpoint cp)
            (sd-execute-annotator-command :cmd (format nil "CHANGE_ELEM_INFO 'MICROJOINT_INFO: contour-OK' 'MICROJOINT_INFO: contour-NOK' SELECT GLOBAL INFOS 'MICROJOINT_INFO: GROUP-ID: ~a' CONFIRM END" curr_uid))
            (sd-call-cmds
            (am_geo_equidistance
              :owner my_view
              :contour (getf (first (nth (- num 1) micro-joint-groups)) :sel-item)
              :distance (/ microjoint_width 2)
            )
          )
        )
        (sd-execute-annotator-command :cmd "CHANGE_CURRENT_INFO 'MICROJOINT_INFO: *' ''")
      )
    )
    (create-equidistant-me10 ()
      (let (cp)
        (pprint "view")
        (pprint (sd-get-annotator-reference :object my_view))
        (pprint "sel_item erste Linie")
        (pprint (getf (first (nth (- num 1) micro-joint-groups)) :sel-item))
        (pprint "Pointer erste Linie")
        (pprint (sd-get-annotator-reference :object (getf (first (nth (- num 1) micro-joint-groups)) :sel-item)))
        (pprint "sel_item letzte Linie")
        (pprint (getf (first (last (nth (- num 1) micro-joint-groups))) :sel-item))
        (pprint "Pointer letzte Linie")
        (pprint (sd-get-annotator-reference :object (getf (first (last (nth (- num 1) micro-joint-groups))) :sel-item)))
        (sd-execute-annotator-command :cmd (format nil "ST_create_microjoint_equidistant '~a' '~a' '~a' ~a '~a' '~a'" 
                                                                                             (sd-get-annotator-reference :object my_view) 
                                                                                             (sd-get-annotator-reference :object (getf (first (nth (- num 1) micro-joint-groups)) :sel-item)) 
                                                                                             (sd-get-annotator-reference :object (getf (first (last (nth (- num 1) micro-joint-groups))) :sel-item))
                                                                                             (/ microjoint_width 2)
                                                                                             "MICROJOINT_INFO: LASER-CUT-CONTOUR"
                                                                                             (format nil "MICROJOINT_INFO: GROUP-ID: ~a" curr_uid)
                                                                                             ))
      )
    )
    (determine-contours ()
      (let (sel-items
            elements
            is-micro-joint)

        ;; get sel-items of all lines and arcs of annotation docu-view
        (if (sd-am-flat-p my_view)
            (setf sel-items
              (sd-call-cmds
                (get_selection
                  :focus_type (list *sd-anno-line-seltype* *sd-anno-arc-seltype*)
                  :select :by_flat_docu_geo my_view)))
            (setf sel-items
              (sd-call-cmds
                (get_selection
                  :focus_type (list *sd-anno-line-seltype* *sd-anno-arc-seltype*)
                  :select :by_view_docu_geo my_view))))

        ;; remove eleme already having microjoint group info
        (pprint (list "sel-items 1: " (length sel-items)))
        (setf sel-items (remove-if #'elem-has-microjoint-group-info-p sel-items))
        (pprint (list "sel-items 2: " (length sel-items)))

        ;; inq geo-props of each sel-item and create a list of plists
        (setf elements
          (mapcar
            #'(lambda (sel-item)
                (list
                  :sel-item sel-item
                  :struct (sd-am-inq-specific-geo-props sel-item)))
            sel-items))

        (setf *all-groups* nil)

        ;; get all connected lines
        (group-connected-lines elements)

        (format t "~%connected groups: ~a" (length *all-groups*))

        ;; remove groups with only one element
        (setf *all-groups* (remove-if #'(lambda (group) (= (length group) 1)) *all-groups*))
        (pprint (list "*all-groups*: " *all-groups*))

        (dolist (group *all-groups*)
          (when (micro-joint-p group)
            (pprint (list "List rotated :" (not (equal *global-group* group))))
            (push *global-group* micro-joint-groups)
            (dolist (elem group)
              (sd-execute-annotator-command :cmd (format nil "ST_cleanup_microjoint_elem_info '~a'" (sd-get-annotator-reference :object (getf elem :sel-item))))
              (sd-execute-annotator-command :cmd (format nil "ST_mark_microjoint_elem '~a' '~a'" (sd-get-annotator-reference :object (getf elem :sel-item)) "contour-OK"))
            )
          );; when
        );; dolist
        (when micro-joint-groups
          ;; (sd-set-variable-status 'num :value 0)
          (sd-set-variable-status 'num_display :visible t)
          (sd-set-variable-status 'btn_determine :visible nil)
          (sd-set-variable-status 'next :visible t)
          (sd-set-variable-status 'prev :visible t)
          ;; (sd-set-variable-status 'other_side :visible t)
          (sd-set-variable-status 'automatic :visible t)
          (sd-set-variable-status 'create_lines :visible t)
          ;; (create-laser-lines)
          (sd-execute-annotator-command :cmd "ST_highlight_microjoint_elements_by_info 'MICROJOINT_INFO: contour-OK' GREEN")
          (sd-execute-annotator-command :cmd "ST_highlight_microjoint_elements_by_info 'MICROJOINT_INFO: dir-not-equal' RED")
          (sd-execute-annotator-command :cmd "ST_highlight_microjoint_elements_by_info 'MICROJOINT_INFO: not-orthogonal' RED")
          (sd-execute-annotator-command :cmd "ST_highlight_microjoint_elements_by_info 'MICROJOINT_INFO: no-line-or-arc' RED")
          (sd-execute-annotator-command :cmd "ST_highlight_microjoint_elements_by_info 'MICROJOINT_INFO: not-2-adjacent-lines' RED")
          (sd-set-variable-status 'num_display :title (format nil "~a/~a" num (length micro-joint-groups)))
        )
      );; let
    );; determine-contours

  ); local-functions

); sd-defdialog


;;;-------------------------------------------------------------------------------------------------
;;; Functions
;;;-------------------------------------------------------------------------------------------------

(defun micro-joint-p (group)
  (let (line-elements
        adjacent-elements
        line-vector
        vec1
        vec2
        is-micro-joint
        i
        first-line)
    ;; (pprint "micro-joint-p")
    (setf line-elements
      (remove-if-not
        #'(lambda (element)
            (when (sd-am-line-struct-p (getf element :struct))
              (correct-line-length-p (getf element :struct))))
        group))

    ;; (pprint (length line-elements))
    (when (>= (length line-elements) 2)
      (setf is-micro-joint t)
      (print (length line-elements))
      (setf i 0)
      (setf first-line nil)
      (dolist (line line-elements)
        (setf line-vector (get-line-vector (getf line :struct)))

        (setf adjacent-elements (get-adjacent-elements line group))
        (if (= 2 (length adjacent-elements))
          (progn
            (setf vec1 (get-vector (getf line :struct) (getf (first adjacent-elements) :struct)))
            (setf vec2 (get-vector (getf line :struct) (getf (second adjacent-elements) :struct)))
            ;; (pprint vec1)
            ;; (pprint vec2)
            (if (and vec1 vec2)
              (progn
                (unless (sd-vec-dir-equal-p vec1 vec2)
                  (print "direction not equal")
                  (setf is-micro-joint nil)
                  (sd-execute-annotator-command :cmd (format nil "ST_mark_microjoint_elem '~a' '~a'" (sd-get-annotator-reference :object (getf line :sel-item)) "dir-not-equal"))
                  ; (sd-call-cmds
                      ; (am_geo2d_prop
                        ; :start (getf line :sel-item)
                        ; :select_done
                        ; :color 16711680
                        ; :done))
                )

                (unless (and (vec-orthogonal-p line-vector vec1)
                            (vec-orthogonal-p line-vector vec2))
                  (print "not orthogonal")
                  (setf is-micro-joint nil)
                  (sd-execute-annotator-command :cmd (format nil "ST_mark_microjoint_elem '~a' '~a'" (sd-get-annotator-reference :object (getf line :sel-item)) "not-orthogonal"))
                  ; (sd-call-cmds
                    ; (am_geo2d_prop
                      ; :start (getf line :sel-item)
                      ; :select_done
                      ; :color 16711680
                      ; :done))
                )
              )
              (progn
                (print "no line or arc")
                (setf is-micro-joint nil)
                (sd-execute-annotator-command :cmd (format nil "ST_mark_microjoint_elem '~a' '~a'" (sd-get-annotator-reference :object (getf line :sel-item)) "no-line-or-arc"))
              )
            )
          )
          (progn
            (pprint "not 2 adjacent lines")
            (setf is-micro-joint nil)
            (sd-execute-annotator-command :cmd (format nil "ST_mark_microjoint_elem '~a' '~a'" (sd-get-annotator-reference :object (getf line :sel-item)) "not-2-adjacent-lines"))
          )
        )
        (when (and is-micro-joint (= i 0))
          (setf first-line line)
          (incf i)
        )
      )
      (when is-micro-joint
        (setf group (rotate-group-elements group first-line))
        (setf *global-group* group)
      )
      (format t "is-micro-joint: ~a" is-micro-joint)
      (return-from micro-joint-p is-micro-joint)
    )
  )
)

;;--------------------------------------------------------------------------------------------------

(defun rotate-group-elements (group first-line)
  (let (temp-group i)
    (setf i 0)
    (loop
      (incf i)
      (if (> i 100) (return))
      (pprint i)
      (setf temp-group (butlast group))
      (push (first (last group)) temp-group)
      (setf group temp-group)
      (when (equal first-line (first group)) (return))
    )
    group
  )
)

;;--------------------------------------------------------------------------------------------------

(defun elem-has-microjoint-group-info-p (elem)
  (sd-execute-annotator-function :fnc (format nil "ST_get_specific_elem_info '~a' 'MICROJOINT_INFO: GROUP-ID: *' ''" (sd-get-annotator-reference :object elem)))
)

;;--------------------------------------------------------------------------------------------------

(defun get-vector (line struct)
  (cond
    ((sd-am-line-struct-p struct)
      (get-line-vector-2 struct (structs-connected-p line struct)))
    ((sd-am-arc-struct-p struct)
      (get-tangent-vector struct (structs-connected-p line struct)))
    (t
      (sd-display-alert "Keine Linie oder Bogen")
      ;; (pprint (list line struct))
      nil
    )))

;;--------------------------------------------------------------------------------------------------

(defun vec-orthogonal-p (vec1 vec2)
  (sd-num-equal-p (sd-vec-scalar-product vec1 vec2) 0
    :resolution +resolution+))

;;--------------------------------------------------------------------------------------------------

(defun get-tangent-vector (arc point)
  (let (center
        start-pnt
        dx
        dy)

    (setf center (sd-am-arc-struct-center arc))
    (setf start-pnt (sd-am-arc-struct-start-pnt arc))

    (setf dx (- (gpnt2d_x point) (gpnt2d_x center)))
    (setf dy (- (gpnt2d_y point) (gpnt2d_y center)))

    (if (points-equal-p point start-pnt)
        (make-gpnt2d :x (- dy) :y dx)
        (make-gpnt2d :x dy :y (- dx)))))

;;--------------------------------------------------------------------------------------------------

(defun get-adjacent-elements (line group)
  (let (adjacent-elements)

    (setf group (remove line group :test #'equal))

    (dolist (elem group)
      (when (structs-connected-p (getf line :struct) (getf elem :struct))
        (when elem (push elem adjacent-elements))))
    adjacent-elements))

;;--------------------------------------------------------------------------------------------------

(defun correct-line-length-p (line)
  (sd-num-equal-p (line-length line) +scaled-width+
    :resolution +resolution+))

;;--------------------------------------------------------------------------------------------------

(defun line-length (line)
  (sd-vec-length (get-line-vector line)))

;;--------------------------------------------------------------------------------------------------

(defun get-line-vector (line)
  (sd-vec-subtract
    (sd-am-line-struct-end-pnt line)
    (sd-am-line-struct-start-pnt line)))

;;--------------------------------------------------------------------------------------------------

(defun get-line-vector-2 (line point)
  (if (points-equal-p (sd-am-line-struct-start-pnt line) point)
      (sd-vec-subtract
        (sd-am-line-struct-end-pnt line)
        (sd-am-line-struct-start-pnt line))
      (sd-vec-subtract
        (sd-am-line-struct-start-pnt line)
        (sd-am-line-struct-end-pnt line))))

;;--------------------------------------------------------------------------------------------------

(defun points-equal-p (p1 p2)
  (sd-vec-equal-p p1 p2
    :resolution +resolution+))

;;--------------------------------------------------------------------------------------------------

(defun structs-connected-p (s1 s2)
  (let (s1-start-pnt
        s1-end-pnt
        s2-start-pnt
        s2-end-pnt)

    (cond
      ((sd-am-line-struct-p s1)
        (setf s1-start-pnt (sd-am-line-struct-start-pnt s1))
        (setf s1-end-pnt (sd-am-line-struct-end-pnt s1)))
      ((sd-am-arc-struct-p s1)
        (setf s1-start-pnt (sd-am-arc-struct-start-pnt s1))
        (setf s1-end-pnt (sd-am-arc-struct-end-pnt s1))))

    (cond
      ((sd-am-line-struct-p s2)
        (setf s2-start-pnt (sd-am-line-struct-start-pnt s2))
        (setf s2-end-pnt (sd-am-line-struct-end-pnt s2)))
      ((sd-am-arc-struct-p s2)
        (setf s2-start-pnt (sd-am-arc-struct-start-pnt s2))
        (setf s2-end-pnt (sd-am-arc-struct-end-pnt s2))))

    (cond
      ((points-equal-p s1-start-pnt s2-start-pnt)
        (return-from structs-connected-p s1-start-pnt))
      ((points-equal-p s1-start-pnt s2-end-pnt)
        (return-from structs-connected-p s1-start-pnt))
      ((points-equal-p s1-end-pnt s2-start-pnt)
        (return-from structs-connected-p s1-end-pnt))
      ((points-equal-p s1-end-pnt s2-end-pnt)
        (return-from structs-connected-p s1-end-pnt))
      (t
        (return-from structs-connected-p nil)))))

;;--------------------------------------------------------------------------------------------------

(defun find-connected-lines (current-line group)
  (let (connected)

    (setf *remaining-lines* (remove current-line *remaining-lines*))
    (setf connected
      (loop for line in *remaining-lines*
            when (structs-connected-p (getf current-line :struct) (getf line :struct))
            return line))

    (if connected
        (progn
          (setf *remaining-lines* (remove connected *remaining-lines*))
          (find-connected-lines
            connected
            (cons connected group)))
        (when group
          (push group *all-groups*)))))

;;--------------------------------------------------------------------------------------------------

(defun group-connected-lines (elements)
  (setf *remaining-lines* elements)
  (loop while *remaining-lines* do
    (find-connected-lines (first *remaining-lines*) (list (first *remaining-lines*)))))

;;--------------------------------------------------------------------------------------------------

(defun get-group-edgepoints (group)
  (let (startpt endpt pnt-list x-low x-high y-low y-high)
    (dolist (elem group)
      (if (sd-am-line-struct-p (getf elem :struct))
        (progn
          (setf startpt (sd-am-line-struct-start-pnt (getf elem :struct)))
          (setf endpt  (sd-am-line-struct-end-pnt (getf elem :struct)))
        )
        (progn
          (setf startpt (sd-am-arc-struct-start-pnt (getf elem :struct)))
          (setf endpt  (sd-am-arc-struct-end-pnt (getf elem :struct)))
        )
      )
      (when (and startpt endpt)
        (push startpt pnt-list)
        (push endpt pnt-list)
        (setf starpt nil)
        (setf endpt nil)
      )
    )
    (pprint pnt-list)
    (dolist (pnt pnt-list)
      (if x-low
        (when (< (gpnt2d_x pnt) x-low)
          (setf x-low (gpnt2d_x pnt))
        )
        (setf x-low (gpnt2d_x pnt))
      )
      (if x-high
        (when (> (gpnt2d_x pnt) x-high)
          (setf x-high (gpnt2d_x pnt))
        )
        (setf x-high (gpnt2d_x pnt))
      )
      (if y-low
        (when (< (gpnt2d_y pnt) y-low)
          (setf y-low (gpnt2d_y pnt))
        )
        (setf y-low (gpnt2d_y pnt))
      )
      (if y-high
        (when (> (gpnt2d_y pnt) y-high)
          (setf y-high (gpnt2d_y pnt))
        )
        (setf y-high (gpnt2d_y pnt))
      )
    )
    (list (make-gpnt2d :x x-low :y y-low) (make-gpnt2d :x x-high :y y-high))
  )
)

#|
 LISP-Fehler:
No value for (SETF TEST::X-LOW (GPNT2D_X TEST::PNT)).
 |#
;;--------------------------------------------------------------------------------------------------
;; ME10 Makros
;;--------------------------------------------------------------------------------------------------

(sd-execute-annotator-command :cmd
 (format nil "~{ ~a~}"
  (list
"DEFINE ST_create_microjoint_equidistant"
"PARAMETER View"
"PARAMETER First_elem"
"PARAMETER Last_elem"
"PARAMETER Distance"
"PARAMETER Info1"
"PARAMETER Info2"
  "LOCAL Pid"
  "LOCAL Temp_info"
  "LOCAL Side_pnt"
  "LOCAL Startpnt"
  "INQ_PART '.'"
  "LET Pid (INQ 302)"
  "INQ_SELECTED_ELEM GLOBAL POINTER View"
  "EDIT_PART (INQ 312)"
  "INQ_PART '.'"
  "EDIT_PART (INQ 902)"
  "LET First_elem_pnt ST_get_point_on_elem First_elem"
  "LET Last_elem_pnt ST_get_point_on_elem Last_elem"
  "St_get_equidist_startpnt First_elem Last_elem"
  "LET Startpnt Ret_val"
  "LET Side_pnt Ret_val2"
  "LET Temp_info (STR TIME)"
  )
 )
)
(sd-execute-annotator-command :cmd
 (format nil "~{ ~a~}"
  (list
  "ADD_CURRENT_INFO Info1"
  "ADD_CURRENT_INFO Info2"
  "ADD_CURRENT_INFO Temp_info END"
  "TRAP_ERROR"
  "EQUIDISTANCE Distance Startpnt First_elem_pnt Last_elem_pnt Side_pnt END"
  "IF (CHECK_ERROR)"
    "INQ_SELECTED_ELEM First_elem"
    "POINT MAGENTA (INQ 102) END"
  "END_IF"
  "POINT GREEN Startpnt RED First_elem_pnt BLUE Last_elem_pnt CYAN Side_pnt END"
  "CREATE_SUBPART Temp_info INFOS Temp_info END"
  "CHANGE_CURRENT_INFO Temp_info ''"
  "CHANGE_CURRENT_INFO Info1 ''"
  "CHANGE_CURRENT_INFO Info2 ''"
  "EDIT_PART PARENT"
  "GATHER PART Temp_info END"
  "SMASH_SUBPART Temp_info END"
  "CHANGE_ELEM_INFO Temp_info '' INFOS Temp_info END"
  "EDIT_PART Pid"
"END_DEFINE"
  )
 )
)

(sd-execute-annotator-command :cmd
 (format nil "~{ ~a~}"
  (list
  ;; Punkt auf Element ermitteln
  ;; Linie: (Vektor Startpunkt + Vektor Endpunkt)/2
  ;; Bogen: Radius-Vektor um halben Bogenwinkel rotiert
"DEFINE ST_get_point_on_elem"
"PARAMETER Elem_pntr"
  "INQ_SELECTED_ELEM POINTER Elem_pntr"
  "IF ((INQ 403) = LINE)"
    "(((INQ 101)+(INQ 102))/2)"
  "ELSE"
    "((ROT ((INQ 102)-(INQ 101)) (((INQ 5)-(INQ 4))/2))+(INQ 101))"
  "END_IF"
"END_DEFINE"
  )
 )
)

(sd-execute-annotator-command :cmd
 (format nil "~{ ~a~}"
  (list
  ;; Startpunkt innerhalb der Kontur ermitteln
  ;; Vektor der angrenzenden Linie in den Mittelpunkt der Startlinie verschieben und kürzen
  ;; Wenn angrenzenden Linie = Bogen: Radius-Vektor 90° um Startpunkt gedreht = Tangente
  ;; Vorgabe: Element 1 ist immer eine Linie (Abschluss der Microjoint-Kontur)
"DEFINE St_get_equidist_startpnt"
"PARAMETER Elem_pntr1"
"PARAMETER Elem_pntr2"
  "LOCAL EType2"
  "LOCAL SPnt1"
  "LOCAL EPnt1"
  "LOCAL MPnt1"
  "LOCAL SPnt2"
  "LOCAL EPnt2"
  "LOCAL MPnt2"
  "LOCAL CPnt"
  "INQ_SELECTED_ELEM POINTER Elem_pntr1"
  ;; erstes Element ist immer eine Linie
  "LET SPnt1 (INQ 101)"
  "LET EPnt1 (INQ 102)"
  ;; Mittelpunkt der Linie = Startpunkt für Vektor der die Seite der Äquidistanten angibt (Seite angeben)
  "LET MPnt1 ((SPnt1+EPnt1)/2)"
  "INQ_SELECTED_ELEM POINTER Elem_pntr2"
  "LET EType2 (INQ 403)"
  "IF (EType2 = LINE)"
    "LET SPnt2 (INQ 101)"
    "LET EPnt2 (INQ 102)"
    ;; Mittelpunkt der Linie = Richtungsvektor für Seite der Äquidistanten
    "LET Vec2 ((SPnt2+EPnt2)/2)"
  "ELSE"
    "LET SPnt2 (INQ 102)"
    "LET EPnt2 (INQ 103)"
    "LET MPnt2 (INQ 101)"
    ;; Etmitteln, welche Punkte der beiden Elemente deckungsgleich sind --> Radius-Vektor um +/-90° drehen
    "IF ((SPnt2 = SPnt1) OR (Spnt2 = EPnt1))"
      "LET Vec2 ((ROT (SPnt2-MPnt2) 90))"
    "ELSE"
      "LET Vec2 ((ROT (EPnt2-MPnt2) -90))" 
    "END_IF"
  "END_IF"
  ;; Startpunkt der Äquidistanten = deckungsgleicher Punkt am ersten Element
  "IF ((SPnt1 = SPnt2) OR (SPnt1 = Epnt2))"
    "LET CPnt SPnt1"
  "ELSE"
    "LET CPnt EPnt1"
  "END_IF"
  ;; Vektor für Seite normalisieren und kürzen - provisorisch *0.1
  "LET Vec2 ST_vec_normalize Vec2"
  "LET Vec2 (Vec2 *0.1 + Mpnt1)"
  "LET Ret_val Cpnt"
  "LET Ret_val2 Vec2"
"END_DEFINE"
  )
 )
)

(sd-execute-annotator-command :cmd
 (format nil "~{ ~a~}"
  (list
  ;; Vektor normalisieren = Vektor durch Länge dividieren
  ;; Länge = Wurzel (X²+Y²)
"DEFINE ST_vec_normalize"
"PARAMETER Vec"
  "(Vec / (SQRT ((SQR (X_OF Vec))+(SQR (Y_OF Vec)))))"
"END_DEFINE"
  )
 )
)

(sd-execute-annotator-command :cmd
 (format nil "~{ ~a~}"
  (list
"DEFINE ST_get_specific_elem_info"
  "PARAMETER Pntr"
  "PARAMETER Info"
  "PARAMETER Info2"
  "LOCAL Ok"
  "LET Ok 'NIL'"
  "IF (Info2 <> '')"
    "INQ_SELECTED_ELEM SELECT GLOBAL POINTER Pntr AND GLOBAL INFOS Info AND GLOBAL INFOS Info2 CONFIRM"
    "DISPLAY_NO_WAIT (INQ 14)"
  "ELSE"
    "INQ_SELECTED_ELEM SELECT GLOBAL POINTER Pntr AND GLOBAL INFOS Info CONFIRM"
    "DISPLAY_NO_WAIT (INQ 14)"
  "END_IF"
  "IF (INQ 14)"
    "LET Ok 'T'"
  "END_IF"
  "LET Isopen (DOCU_OPEN_CONNECTION_TO_SD)"
  "LET Done (DOCU_ADD_LINE_TO_SD Ok)"
  "LET Isclosed (DOCU_CLOSE_CONNECTION_TO_SD)"
"END_DEFINE"
  )
 )
)

(sd-execute-annotator-command :cmd
 (format nil "~{ ~a~}"
  (list
"DEFINE ST_get_elem_count_with_info"
  "PARAMETER Info"
  "PARAMETER Info2"
  "LOCAL Cnt"
  "IF (Info2 <> '')"
    "INQ_SELECTED_ELEM SELECT GLOBAL INFOS Info AND GLOBAL INFOS Info2 CONFIRM"
  "ELSE"
    "INQ_SELECTED_ELEM SELECT GLOBAL INFOS Info CONFIRM"
  "END_IF"
  "LET Cnt (STR (INQ 14))"
  "LET Isopen (DOCU_OPEN_CONNECTION_TO_SD)"
  "LET Done (DOCU_ADD_LINE_TO_SD Cnt)"
  "LET Isclosed (DOCU_CLOSE_CONNECTION_TO_SD)"
"END_DEFINE"
  )
 )
)

(sd-execute-annotator-command :cmd
 (format nil "~{ ~a~}"
  (list
"DEFINE ST_attach_info_to_elem"
  "PARAMETER Ltab"
  "PARAMETER Info"
  "LOCAL i"
  "LET i 0"
  "WHILE (i < (LTAB_ROWS Ltab))"
    "LET i (i + 1)"
    "ADD_ELEM_INFO Info SELECT GLOBAL POINTER (READ_LTAB Ltab i 1) CONFIRM END"
  "END_WHILE"
"END_DEFINE"
  )
 )
)

(sd-execute-annotator-command :cmd
 (format nil "~{ ~a~}"
  (list
"DEFINE ST_mark_microjoint_elem"
  "PARAMETER Pntr"
  "PARAMETER Info"
  "LOCAL I"
  "TRAP_ERROR"
  "ADD_ELEM_INFO ('MICROJOINT_INFO: '+Info) SELECT GLOBAL POINTER Pntr CONFIRM END"
  "LET I (CHECK_ERROR)"
"END_DEFINE"
  )
 )
)

(sd-execute-annotator-command :cmd
 (format nil "~{ ~a~}"
  (list
"DEFINE ST_highlight_microjoint_elem"
  "PARAMETER Pntr"
  "LOCAL I"
  "TRAP_ERROR"
  "SHOW GLOBAL POINTER Pntr GREEN"
  "LET I (CHECK_ERROR)"
"END_DEFINE"
  )
 )
)

(sd-execute-annotator-command :cmd
 (format nil "~{ ~a~}"
  (list
"DEFINE ST_highlight_microjoint_elements_by_info"
  "PARAMETER Info"
  "PARAMETER Highlight_color"
  "LOCAL I"
  "TRAP_ERROR"
  "SHOW GLOBAL INFOS Info Highlight_color"
  "LET I (CHECK_ERROR)"
"END_DEFINE"
  )
 )
)

(sd-execute-annotator-command :cmd
 (format nil "~{ ~a~}"
  (list
"DEFINE ST_reset_highlight_microjoint_elem"
  "LOCAL I"
  "TRAP_ERROR"
  ;; "SHOW GLOBAL INFOS 'MICROJOINT_INFO: contour*' ON"
  "SHOW GLOBAL ALL ON"
  "LET I (CHECK_ERROR)"
"END_DEFINE"
  )
 )
)

(sd-execute-annotator-command :cmd
 (format nil "~{ ~a~}"
  (list
"DEFINE ST_cleanup_microjoint_elem_info"
  "PARAMETER Pntr"
  "TRAP_ERROR"
  "CHANGE_ELEM_INFO 'MICROJOINT_INFO: *' '' SELECT GLOBAL POINTER Pntr CONFIRM END"
  "LET I (CHECK_ERROR)"
"END_DEFINE"
  )
 )
)

(sd-execute-annotator-command :cmd
 (format nil "~{ ~a~}"
  (list
"DEFINE ST_clear_all_microjoint_infos"
  "DELETE SELECT GLOBAL INFOS 'MICROJOINT_INFO: LASER-CUT-CONTOUR' AND GLOBAL INFOS 'ADU: *' CONFIRM END"
  "DELETE SELECT GLOBAL INFOS 'MICROJOINT_INFO: elem-invalid' AND GLOBAL INFOS 'ADU: *' CONFIRM END"
  "CHANGE_ELEM_INFO 'DOCU_MARKED_AS_INVISIBLE' '' SELECT GLOBAL INFOS 'MICROJOINT_INFO:*' AND GLOBAL INFOS 'DOCU_MARKED_AS_INVISIBLE' CONFIRM END"
  "CHANGE_ELEM_INFO 'DOCU_MARKED_FOR_DELETE*' '' SELECT GLOBAL INFOS 'MICROJOINT_INFO:*' AND GLOBAL INFOS 'DOCU_MARKED_FOR_DELETE*' CONFIRM END"
  "SHOW SELECT GLOBAL INFOS 'MICROJOINT_INFO:*' CONFIRM ON"
  "CHANGE_ELEM_INFO 'MICROJOINT_INFO: *' '' SELECT GLOBAL INFOS 'MICROJOINT_INFO:*' CONFIRM END"
"END_DEFINE"
  )
 )
)

(sd-execute-annotator-command :cmd
 (format nil "~{ ~a~}"
  (list
"DEFINE ST_clear_invalid_microjoint_infos"
  "DELETE SELECT GLOBAL INFOS 'MICROJOINT_INFO: elem-invalid' AND GLOBAL INFOS 'ADU: *' CONFIRM END"
  "CHANGE_ELEM_INFO 'DOCU_MARKED_AS_INVISIBLE' '' SELECT GLOBAL INFOS 'MICROJOINT_INFO: elem-invalid' AND GLOBAL INFOS 'DOCU_MARKED_AS_INVISIBLE' CONFIRM END"
  "CHANGE_ELEM_INFO 'DOCU_MARKED_FOR_DELETE*' '' SELECT GLOBAL INFOS 'MICROJOINT_INFO: elem-invalid' AND GLOBAL INFOS 'DOCU_MARKED_FOR_DELETE*' CONFIRM END"
  "SHOW SELECT GLOBAL INFOS 'MICROJOINT_INFO: elem-invalid' CONFIRM ON"
  "CHANGE_ELEM_INFO 'MICROJOINT_INFO: *' '' SELECT GLOBAL INFOS 'MICROJOINT_INFO:*' CONFIRM END"
"END_DEFINE"
  )
 )
)

(sd-execute-annotator-command :cmd
 (format nil "~{ ~a~}"
  (list
"DEFINE ST_mark_microjoint_elem_invalid"
"LOCAL I"
"LOCAL Elem_ltab"
"LOCAL Info_ltab"
"LOCAL Info"
  "INQ_SELECTED_ELEM SELECT GLOBAL INFOS 'MICROJOINT_INFO:*' AND GLOBAL INFOS 'RC: sys eq' SUBTRACT GLOBAL INFOS 'RC: equal' CONFIRM"
  "LET I 0"
  "LET Elem_ltab 'microjoint-ltab'"
  "CREATE_LTAB Elem_ltab"
  "WHILE (INQ 14)"
    "LET I (I + 1)"
    "LET Info (INQ 1000)"
    "WHILE (Info <> 'END-OF-LIST')"
      "IF (MATCH Info 'MICROJOINT_INFO: GROUP-ID: *')"
        "SELECT_FROM_LTAB Elem_ltab SORTED 2 = Info END"
        "IF (NOT (LTAB_ROWS 'sys_select'))"
          "WRITE_LTAB Elem_ltab i 1 (INQ 332)"
          "WRITE_LTAB Elem_ltab i 2 Info"
        "END_IF"
      "END_IF"
      "LET Info (INQ 1001)"
    "END_WHILE"
    "INQ_NEXT_ELEM"
  "END_WHILE"
  )
 )
)
(sd-execute-annotator-command :cmd
 (format nil "~{ ~a~}"
  (list
  "LET I 0"
  "WHILE (I < (LTAB_ROWS Elem_ltab))"
    "LET I (I + 1)"
    "LET Info (READ_LTAB Elem_ltab I 2)"
    "INQ_SELECTED_ELEM SELECT GLOBAL INFOS Info CONFIRM"
    "WHILE (INQ 14)"
      "CHANGE_COLOR RED SELECT GLOBAL POINTER (INQ 332) AND GLOBAL INFOS 'ADU: *' CONFIRM END"
      "CHANGE_ELEM_INFO 'MICROJOINT_INFO: *' 'MICROJOINT_INFO: elem-invalid' SELECT GLOBAL POINTER (INQ 332) CONFIRM END "
      "CHANGE_ELEM_INFO 'DOCU_MARKED_AS_INVISIBLE' '' SELECT GLOBAL POINTER (INQ 332) CONFIRM END"
      "CHANGE_ELEM_INFO 'DOCU_MARKED_FOR_DELETE*' '' SELECT GLOBAL POINTER (INQ 332) CONFIRM END"
      "SHOW GLOBAL POINTER (INQ 332) ON"
      "INQ_NEXT_ELEM"
    "END_WHILE"
  "END_WHILE"
"END_DEFINE"
  )
 )
)