;;--------------------------------------------------------------------------*
;;  Copyright 2003  DC4 Technisches Büro GmbH                               *
;;                                                                          *
;;--------------------------------------------------------------------------*
;;  Dateiname: am_direction.lsp
;;  Version  : 1.0
;;  Datum    : 16.10.2003
;;  Author   : Gt

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

;;--------------------------------------------------------------------------*

(sd-defdialog 'dc4-anno-ansicht-mit-rcht-dialog
:dialog-title "Ans. mit Richtung"
:variables
  '(
    (dirvec)
    (dirpnt)
    (schnittlist)
    (alphalist :initial-value '("A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O" "P" "Q" "R" "S" "T" "U" "V" "W" "X" "Y" "Z"))
    (ans   :selection *sd-anno-view-seltype*
           :prompt-text "Uebergeordnete Ansicht angeben."
           :title "UeberAnsicht"
           :multiple-items nil
           :after-input (after-ans-action)
    )
    (ppnt  :value-type :docupntcnp
           :prompt-text "Bezugspunkt fuer Ansichtspfeil angeben"
           :title "Pfeilposition"
           :after-input (sd-execute-annotator-command :cmd
                         (format nil "LEADER_LINE ~A,~A"
                                   (oli::gpntdocu_x ppnt)
                                   (oli::gpntdocu_y ppnt)))
    )
    (rpnt  :value-type :docupntcnp
           :prompt-text "Endpunkt fuer Ansichtsrichtung angeben"
           :title "Richtung"
           :after-input (progn
                         (after-rpnt-action)
                         (sd-execute-annotator-command :cmd
                          (format nil "CANCEL"))
                        );;progn
    )
    (lab   :value-type :string
           :prompt-text "Beschriftung angeben"
           :title "Beschriftung"
           :initial-value "Z"
           :initial-enable nil
           :check-function #'(lambda (lab) (if (find (string-upcase lab) schnittlist :test #'string=) :err :ok))
           :confirmation
              (:Err :dialog :warning
                       :prompt "Es gibt schon eine Ansicht mit diesem Namen!"
                       :severity :high
                       :cancel-cleanup (setf lab nil)
                       :ok-cleanup (setf lab nil)
              )
    )
   )
:local-functions
  '(
    (check-sections ()
     (let (vs vw vn nlst an bpos)
      (when ans
       (progn
        (setf vs (sd-am-view-struct-view-set (sd-am-inq-view ans)))
        (setf nlst (list))
        (dolist (vw (sd-am-view-set-struct-views (sd-am-inq-view-set vs)))
         (when (getf vw  :VIEW-2D)
          (progn
           (setf vn (sd-am-view-struct-name (sd-am-inq-view (getf vw  :VIEW-2D))))
           (when (= (length vn) 3)
            (when (and (char= (char vn 0) (char vn 2)) (char= (char vn 1) (char "-" 0)))
             (progn
              (setf an (char-upcase (char vn 0)))
              (setf nlst (nconc nlst (list an)))
             );;progn
            );;when
           );;when
          );;progn
         );;when
        );;dolist
        (setf schnittlist (sort nlst #'string<))
       );;progn
      );;when
     );;let
    )
    (after-ans-action ()
     (let (vs vw vn nlst an bpos)
      (check-sections)
      (setf bpos (mismatch (reverse alphalist) (reverse schnittlist) :test #'string=))
      (setf lab (elt (reverse alphalist) bpos))
      (sd-set-variable-status 'lab :enable t)
     );;let
    )
    (after-rpnt-action ()
     (let (pp rp)
      (setf pp (make-gpnt2d :x (oli::gpntdocu_x ppnt)
                            :y (oli::gpntdocu_y ppnt)))
      (setf rp (make-gpnt2d :x (oli::gpntdocu_x rpnt)
                            :y (oli::gpntdocu_y rpnt)))
      (setf dirvec (sd-vec-normalize (sd-vec-subtract rp pp)))
      (setf dirpnt (sd-vec-add rp dirvec))
     );;let
    )
    (next-action ()
     (let ()
      (dc4-anno-create-directional-view ans ppnt dirvec lab)
     )
    )
    (clean-action ()
     (let ()
      (sd-execute-annotator-command :cmd "CANCEL")
     )
    )
   )
 :cancel-action
    '(clean-action)
 :ok-action
    '(progn (clean-action) (next-action))
)

;;--------------------------------------------------------------------------*

(defun dc4-anno-config-section-for-directional-view ()
 (let ()
  (docu::config-section
   :docu_section_line_geo_color        'BLACK         ;;or 'RED, 'GREEN, ...
   :docu_section_line_segm_mode        'NONE          ;;or 'SEGM_NO_OVERLAP
   :docu_section_line_label_offset     '7.0
   :docu_section_view_label_prefix     "Ansicht"
  )
 );;let
)

(defun dc4-anno-config-section-for-sectional-view ()
 (let ()
  (docu::config-section
   :docu_section_line_geo_color        'YELLOW        ;;or 'RED, 'GREEN, ...
   :docu_section_line_segm_mode        'SEGM_OVERLAP  ;;or 'SEGM_NO_OVERLAP
   :docu_section_line_label_offset     '7.0
   :docu_section_view_label_prefix     "Schnitt"
  )
 );;let
)

(defun dc4-anno-create-directional-view (ans ppnt dirvec lab)
 (let (masst ursp w3d dirvec3d rotv3d rotvec p1 p2 p3 fehler)
  (setf masst (read-from-string (sd-am-sheet-struct-scale (sd-am-inq-sheet (sd-am-view-struct-sheet (sd-am-inq-view ans))))))
  (setf ursp (make-gpnt3d :x 0 :y 0 :z 0))
  (setf w3d (make-gpnt3d :x 0 :y 0 :z 1))
  (setf dirvec3d (make-gpnt3d :x (gpnt2d_x dirvec) :y (gpnt2d_y dirvec) :z 0))
  (setf rotv3d (sd-vec-rotate dirvec3d (/ pi -2) :point ursp :direction w3d))
  (setf rotvec (make-gpnt2d :x (gpnt3d_x rotv3d) :y (gpnt3d_y rotv3d)))
  (setf p1 (make-gpnt2d :x (oli::gpntdocu_x ppnt)
                        :y (oli::gpntdocu_y ppnt)))
  (setf p1 (sd-vec-scale p1 (/ 1 masst)))
  (setf p2 (sd-vec-add p1 (sd-vec-scale rotvec 0.01)))
  (dc4-anno-config-section-for-directional-view)
  (AM_CREATE_SECTION :PARENT_VIEW ans :SECTION-SURFACE :OFF :SECTION-LINE :LINE-TWOPTS p1 p2 :ACCEPT :SECTION-LABEL (string-upcase lab) complete)
  (dc4-anno-config-section-for-sectional-view)
 );;let
)