;;==================================================================
;;==================================================================
;; os / 16.05.2006 08:59
;;==================================================================
;; sd-defdialog 'os-anno-posnr-erstellen
;; sd-defdialog 'os-anno-posnr-loesen
;; sd-defdialog 'os-anno-posnr-delete
;; sd-defdialog 'os-anno-posnr-zuordnen
;;==================================================================
;;==================================================================

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


(sd-defdialog 'os-anno-posnr-erstellen
  :dialog-title "Positionsnummern"
  ;:toolbox-button nil
  :variables
  '(
    (TXT_SET_AKTUELL) ;; aktuelle Text Einstellungen
    (REF_SET_AKTUELL) ;; aktuelle Refline Einstellungen
    (SKIZZEN_NAME)    ;; Name der Skizze
    (NEXTTEXT)        ;; Name + Increment wenn Nummer

    (ANS
       :selection *sd-anno-view-seltype*
       :prompt-text "Besitzeransicht angeben."
       :title "Ansicht"
       :after-input (setf ANS_NAME (sd-am-inq-name ANS))
       :multiple-items nil)

    (ANS_NAME
       :value-type :display-only
       :title "Ansichtsname")

    ("")

    (POS_TXT
       :value-type :string
       :prompt-text "Text fuer Positionsnummer angeben"
       :title "PositionsNr"
       :initial-value "10")

    (INCRE
       :value-type :positive-number
       :title "Inkrement"
       :initial-value 10
       :prompt-text "Inkrement fÏr Positionsnummer angeben.")

    (P_PNR
       :value-type :docupntcnp
       :prompt-text "Bezugspunkt fÏr Positionsnummer angeben."
       :title "Textposition"
       :after-input
          (sd-execute-annotator-command :cmd
              (format nil "LEADER_LINE ~A,~A" (oli::gpntdocu_x P_PNR) (oli::gpntdocu_y P_PNR)))
    );;P_PNR

    (P_END
       :value-type :docupntcnp
       :prompt-text "Endpunkt der Bezugslinie angeben."
       :title "Endposition"
       :after-input (progn
                      (pos-num-erstellen)
                      (setf P_PNR nil)
                      (setf P_END nil)
                      (setf POS_TXT NEXTTEXT)
                    );;progn
    );;P_END

    (TSIZE
       :range (2 3.5 5 7)
       :prompt-text "TextgrÎÞe fÏr Positionsnummer angeben."
       :title "TextgrÎÞe"
       :initial-value 5
    );;TSIZE

    (TFONT
       :range ("hp_i3098_v" "hp_i3098_c" "hp_block_v")
       :initial-value "hp_i3098_v"
       :prompt-text "Schriftart fÏr Positionsnummer angeben."
       :title "Schriftart")

    (GSIZE
       :value-type :positive-number
       :prompt-text "Abstand fÏr Punktgitter angeben."
       :title "Gitterabstand"
       :initial-value 10
       :after-input (sd-execute-annotator-command :cmd (format nil "GRID_FACTOR ~a" GSIZE)))

    ("Unterstrich")
    (OHNE_U
       :value-type :boolean
       :title "ohne"
       :toggle-type :grouped-toggle
       :initial-value t)
    (MIT_U
       :value-type :boolean
       :title "mit"
       :toggle-type :grouped-toggle)

    ("Pfeilart")
    (A_DOT
       :value-type :boolean
       :title "Punkt"
       :toggle-type :grouped-toggle
       :initial-value t)
    (A_ARROW
       :value-type :boolean
       :title "Pfeil"
       :toggle-type :grouped-toggle)

  );;variables

  :mutual-exclusion '((OHNE_U MIT_U) (A_DOT A_ARROW))

  :after-initialization '(init-action)

  :local-functions
  '(
    ;;==========================================================
    (init-action ()
      ;; Aktuelle Text Settings Speichern
      (setf TXT_SET_AKTUELL (sd-am-inq-curr-text-attributes))
      ;; Aktuelle RefLine Settings Speichern
      (setf REF_SET_AKTUELL (sd-am-inq-curr-ref-text-line-attributes))
      ;; Grid Anzeige einschalten
      (sd-execute-annotator-command :cmd (format nil "GRID_FACTOR ~a" GSIZE))
      (sd-execute-annotator-command :cmd "DOT_GRID ON")
      ;; Switches the variable checking off
      (sd-disable-must-variable-check)
    );;init-action

    ;;==========================================================
    (pos-num-erstellen ()
     (progn
      (sd-call-cmds
       (let (NONUM)
         ;; Prüfen ob POS_TXT = Nummer (NONUM = nil) oder Text (NONUM =0)
         (setf NONUM (position-if-not #'(lambda (substr) (digit-char-p (character substr))) POS_TXT))

         ;; Skizzenname erzeugen
         (if NONUM
            (setf SKIZZEN_NAME "GD_POSNR_txt")
            (setf SKIZZEN_NAME (format nil "GD_POSNR_~a" POS_TXT))
         );;if

         ;; Aufruf Macro zum Zeichnen der Positionsnummer/Text
         (os-anno-posnr-zeichnen)

         ;; Wenn Nummer dann hochzählen
         (if NONUM
            (setf NEXTTEXT POS_TXT)
            (setf NEXTTEXT (format nil "~a" (+ (read-from-string POS_TXT) INCRE)))
         );;if
       );;let
      );;sd-call-cmds
     );;progn
    );;pos-num-erstellen

    ;;==========================================================
    (os-anno-posnr-zeichnen ()
     (let (X_DIFF LINKS Y_DIFF UNTEN GAP P0 P1 NAME_OWNER)
       ;; Punkt P_PNR links von P_END
       (setf X_DIFF (- (oli::gpntdocu_x P_PNR) (oli::gpntdocu_x P_END)))
       (setf LINKS (< X_DIFF 0))
       (setf Y_DIFF (- (oli::gpntdocu_y P_PNR) (oli::gpntdocu_y P_END)))
       (setf UNTEN (< Y_DIFF 0))

       ;; Texteinstellungen setzen
       (sd-call-cmds (am_text_settings :frame "OFF" :size TSIZE :fill :OFF :ratio 1 :slant 0 :abs_angle 0 :linesp 1.5 :font1b TFONT :font2b "hp_kanji_c"))
       (cond
        ((= TSIZE 2)   (sd-call-cmds (am_text_settings :color :rgb 0,0,1))) ;;BLUE
        ((= TSIZE 3.5) (sd-call-cmds (am_text_settings :color :rgb 1,1,1))) ;;WHITE
        ((= TSIZE 5)   (sd-call-cmds (am_text_settings :color :rgb 1,1,0))) ;;YELLOW
        ((= TSIZE 7)   (sd-call-cmds (am_text_settings :color :rgb 0,1,0))) ;;GREEN
       );;cond

       (cond
        ((and (not LINKS) (not UNTEN))                 (sd-call-cmds (am_text_settings :adjust 1)));;Q1
        ((and (eq t LINKS) (not UNTEN))                (sd-call-cmds (am_text_settings :adjust 3)));;Q2
        ((and (eq t LINKS) (eq t UNTEN) (eq t OHNE_U)) (sd-call-cmds (am_text_settings :adjust 9)));;Q3 ohne Unterstrich
        ((and (eq t LINKS) (eq t UNTEN) (eq t MIT_U))  (sd-call-cmds (am_text_settings :adjust 3)));;Q3 mit Unterstrich
        ((and (not LINKS) (eq t UNTEN) (eq t OHNE_U))  (sd-call-cmds (am_text_settings :adjust 7)));;Q4 ohne Unterstrich
        ((and (not LINKS) (eq t UNTEN) (eq t MIT_U))   (sd-call-cmds (am_text_settings :adjust 1)));;Q4 mit Unterstrich
       );;cond

       ;; Skizze erzeugen
       (sd-am-create-sketch :name SKIZZEN_NAME :position P_PNR :owner_type :current-sheet)

       ;; Abstand Linie Text berechnen
       (setf GAP (/ TSIZE 5))

       ;; Textposition P0 berechnen
       (cond
        ;;Q1
        ((and (not LINKS) (not UNTEN))
         (setf P0 (sd-vec-add (make-gpnt2d :x (oli::gpntdocu_x P_PNR) :y (oli::gpntdocu_y P_PNR)) (make-gpnt2d :x GAP :y GAP))))
        ;;Q2
        ((and (eq t LINKS) (not UNTEN))
         (setf P0 (sd-vec-add (make-gpnt2d :x (oli::gpntdocu_x P_PNR) :y (oli::gpntdocu_y P_PNR)) (make-gpnt2d :x (- GAP) :y GAP))))
        ;;Q3 ohne Unterstrich
        ((and (eq t LINKS) (eq t UNTEN) (eq t OHNE_U))
         (setf P0 (sd-vec-add (make-gpnt2d :x (oli::gpntdocu_x P_PNR) :y (oli::gpntdocu_y P_PNR)) (make-gpnt2d :x (- GAP) :y (- GAP)))))
        ;;Q3 mit Unterstrich
        ((and (eq t LINKS) (eq t UNTEN) (eq t MIT_U))
         (setf P0 (sd-vec-add (make-gpnt2d :x (oli::gpntdocu_x P_PNR) :y (oli::gpntdocu_y P_PNR)) (make-gpnt2d :x (- GAP) :y GAP))))
        ;;Q4 ohne Unterstrich
        ((and (not LINKS) (eq t UNTEN) (eq t OHNE_U))
         (setf P0 (sd-vec-add (make-gpnt2d :x (oli::gpntdocu_x P_PNR) :y (oli::gpntdocu_y P_PNR)) (make-gpnt2d :x GAP :y (- GAP)))))
        ;;Q4 mit Unterstrich
        ((and (not LINKS) (eq t UNTEN) (eq t MIT_U))
         (setf P0 (sd-vec-add (make-gpnt2d :x (oli::gpntdocu_x P_PNR) :y (oli::gpntdocu_y P_PNR)) (make-gpnt2d :x GAP :y GAP))))
       );;cond

       ;; Besitzername erzeugen
       (setf NAME_OWNER (format nil "~a/~a" (sd-am-inq-curr-sheet-name) SKIZZEN_NAME))

       ;; Text erstellen
       (sd-am-create-text :text POS_TXT :position P0 :owner_type :sketch :owner NAME_OWNER)

       ;; Textlänge und Punkt P1 berechnen
       (when MIT_U
        (let (ME_F1 TLANG)
         ;; Textlänge berechnen
         (setf ME_F1 (format nil "DC4_inq_textlaenge \"/~a\"" NAME_OWNER))
         ;;***** ME 10 *****************************************************
         (sd-execute-annotator-command :cmd
          (format nil "~a~a~a~a~a~a~a~a~a~a~a~a~a~a~a"
          "DEFINE DC4_inq_textlaenge                                       "
          "  PARAMETER Uname                                               "
          "  LOCAL Cname                                                   "
          "  LOCAL Textlaenge                                              "
          "  INQ_ENV 7                                                     "
          "  LET Cname ('~'+(INQ 302))                                     "
          "  EDIT_PART Uname                                               "
          "  INQ_ENV 7                                                     "
          "  LET Textlaenge (STR (ABS((X_OF (INQ 101))-(X_OF (INQ 102))))) "
          "  EDIT_PART Cname                                               "
          "  LET lispstring (DOCU_CSTRING_TO_LSTRING Textlaenge)           "
          "  LET isopen (DOCU_OPEN_CONNECTION_TO_SD)                       "
          "  LET done (DOCU_ADD_LINE_TO_SD Textlaenge)                     "
          "  LET isclosed (DOCU_CLOSE_CONNECTION_TO_SD)                    "
          "END_DEFINE                                                      "
         ))
         ;;***** ME 10 - END ***********************************************
         (setf TLANG (+ (* 2 GAP) (sd-execute-annotator-function :fnc ME_F1)))
         ;; Punkt berechnen
         (if LINKS
           (setf P1 (sd-vec-add (make-gpnt2d :x (oli::gpntdocu_x P_PNR) :y (oli::gpntdocu_y P_PNR)) (make-gpnt2d :x (- TLANG) :y 0)))
           (setf P1 (sd-vec-add (make-gpnt2d :x (oli::gpntdocu_x P_PNR) :y (oli::gpntdocu_y P_PNR)) (make-gpnt2d :x TLANG :y 0)))
         );;if
        );;let
       );;when

       (setf P_PNR (make-gpnt2d :x (oli::gpntdocu_x P_PNR) :y (oli::gpntdocu_y P_PNR)))
       (setf P_END (make-gpnt2d :x (oli::gpntdocu_x P_END) :y (oli::gpntdocu_y P_END)))

       ;; RefLine Settings
       (sd-call-cmds (am_refl_settings :ref_line_type 1 :ref_color (sd-rgb-to-color 1,1,1) :ref_arrow_size 3.5))
       (if A_DOT
          (sd-call-cmds (am_refl_settings :ref_arrow_type 2)) ;; DOT Type
          (sd-call-cmds (am_refl_settings :ref_arrow_type 1)) ;; ARROW Type
       );;if

       ;; Leaderline erstellen
       (if MIT_U
          (sd-call-cmds (am_create_leader :owner (format nil "~a/~a" (sd-am-inq-curr-sheet-name) SKIZZEN_NAME) P1 P_PNR P_END :finish))
          (sd-call-cmds (am_create_leader :owner (format nil "~a/~a" (sd-am-inq-curr-sheet-name) SKIZZEN_NAME)  P_PNR P_END :finish))
       );;if

       ;; Skizze der Ansicht zuordnen
       (sd-call-cmds (am_sketch_owner :sketch (format nil "~a/~a" (sd-am-inq-curr-sheet-name) SKIZZEN_NAME) :owner_view ANS))

     );;let
    );;os-anno-posnr-zeichnen

    ;;==========================================================
    (clean-action ()
      ;; Text Settings zurücksetzen
      (sd-call-cmds (am_text_settings
                       :size       (sd-am-text-attributes-struct-size TXT_SET_AKTUELL)
                       :adjust     (docu::docu-convert-text-adjust-specification (sd-am-text-attributes-struct-adjust TXT_SET_AKTUELL) :number)
                       :frame      (sd-am-text-attributes-struct-frame TXT_SET_AKTUELL)
                       :fill       (sd-am-text-attributes-struct-fill TXT_SET_AKTUELL)
                       :ratio      (sd-am-text-attributes-struct-ratio TXT_SET_AKTUELL)
                       :slant      (sd-am-text-attributes-struct-slant TXT_SET_AKTUELL)
                       :abs_angle  (sd-am-text-attributes-struct-angle TXT_SET_AKTUELL)
                       :linesp     (sd-am-text-attributes-struct-linesp TXT_SET_AKTUELL)
                       :font1b     (sd-am-text-attributes-struct-font1b TXT_SET_AKTUELL)
                       :font2b     (sd-am-text-attributes-struct-font2b TXT_SET_AKTUELL)
                       :color :rgb (sd-am-text-attributes-struct-color TXT_SET_AKTUELL)))

      ;; RefLine Settings zurücksetzen
      (sd-call-cmds (am_refl_settings
                       :ref_line_type  (sd-am-ref-text-line-attributes-struct-linetype REF_SET_AKTUELL)
                       :ref_color      (sd-rgb-to-color (sd-am-ref-text-line-attributes-struct-color REF_SET_AKTUELL))
                       :ref_arrow_type (sd-am-ref-text-line-attributes-struct-arrow-type  REF_SET_AKTUELL)
                       :ref_arrow_size (sd-am-ref-text-line-attributes-struct-arrow-size  REF_SET_AKTUELL)))

      ;; Grid Anzeige ausschalten
      (sd-execute-annotator-command :cmd "DOT_GRID ALL OFF")
      (sd-execute-annotator-command :cmd "CANCEL")
    );;clean-action

  );;local-functions

  :cancel-action '(clean-action)

  :ok-action '(clean-action)

);;sd-defdialog

;;==================================================================
;;==================================================================
(sd-defdialog 'os-anno-posnr-loesen
  :dialog-title "Zuordnen Blatt"
  ;:toolbox-button nil
  :variables
  '(
    (P_NR
       :selection *sd-anno-sketch-seltype*
       :prompt-text "Positionsnummer zum LÎsen von der Ansicht angeben."
       :title "PosNr"
       :multiple-items t
       :check-function
        #'(lambda (P_NR)
             (if (search "GD_POSNR_" (sd-am-inq-name P_NR) :test #'equal)
               :ok
               (values :error "Das ist keine Positionsnummer!")
             );;if
          );;lambda
       :after-input (progn
                      (posnum_loesen)
                      (setf P_NR nil)
                    );;progn
    );;P_NR
  );;variables
  :local-functions
  '(
    (posnum_loesen ()
      (dolist (eine_P_NR P_NR)
        (sd-call-cmds (am_sketch_owner :sketch eine_P_NR :owner_sheet (sd-am-inq-curr-sheet)))
      );;dolist
    );;posnum_loesen
  );;local-function
  :ok-action '()
);;sd-defdialog

;;==================================================================
;;==================================================================
(sd-defdialog 'os-anno-posnr-delete
  :dialog-title "LÎschen"
  ;:toolbox-button nil
  :variables
  '(
    (P_NR
       :selection *sd-anno-sketch-seltype*
       :prompt-text "Positionsnummer zum LÎschen angeben."
       :title "PosNr"
       :multiple-items t
       :check-function
        #'(lambda (P_NR)
             (if (search "GD_POSNR_" (sd-am-inq-name P_NR) :test #'equal)
               :ok
               (values :error "Das ist keine Positionsnummer!")
             );;if
          );;lambda
       :after-input (progn
                      (posnum_loeschen)
                      (setf P_NR nil)
                    );;progn
    );;P_NR
  );;variables
  :local-functions
  '(
    (posnum_loeschen ()
     (dolist (eine_P_NR P_NR)
       (sd-call-cmds (am_sketch_delete :sketch eine_P_NR :yes))
     );;dolist
   );;posnum_loeschen
  );;local-functions
  :ok-action '()
);;sd-defdialog

;;==================================================================
;;==================================================================
(sd-defdialog 'os-anno-posnr-zuordnen
  :dialog-title "Zuordnen Ansicht"
  ;:toolbox-button nil
  :variables
  '(
    (ANS
       :selection *sd-anno-view-seltype*
       :prompt-text "Ansicht als Besitzer angeben."
       :title "Ansicht"
       :after-input (setf ANS_NAME (sd-am-inq-name ANS))
       :multiple-items nil)

    (ANS_NAME
       :value-type :display-only
       :title " Ansichtsname")

    ("")

    (P_NR
       :selection *sd-anno-sketch-seltype*
       :prompt-text "Positionsnummer zum Zuordnen angeben."
       :title "PosNr"
       :multiple-items t
       :check-function
        #'(lambda (P_NR)
             (if (search "GD_POSNR_" (sd-am-inq-name P_NR) :test #'equal)
               :ok
               (values :error "Das ist keine Positionsnummer!")
             );;if
          );;lambda
       :after-input (progn
                      (posnum_zuordnen)
                      (setf P_NR nil)
                    );;progn
    );;P_NR
  );;variables
  :after-initialization '(sd-disable-must-variable-check)
  :local-functions
  '(
    (posnum_zuordnen ()
      (dolist (eine_P_NR P_NR)
        (sd-call-cmds (am_sketch_owner :sketch eine_P_NR :owner_view ANS))
      );;dolist
    );;posnum_zuordnen
  );;local-functions
  :ok-action '()
);;sd-defdialog

;;=== END