;;==================================================================
;; am_posnum_v13.lsp
;;==================================================================
;; os / 10.11.2006 10:02
;;==================================================================
;; 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 Texteinstellungen
    (GEO_SET_AKTUELL) ;;aktuelle Geoeinstellungen
    (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

    ("Texteinstellungen")
    (TSIZE
       :range (2 2.5 3.5 5 7)
       :prompt-text "TextgrÎÞe fÏr Positionsnummer angeben."
       :title "TextgrÎÞe"
       :initial-value 5
       #|
       :after-input
        (progn
          (cond
            ((= TSIZE 2)   (setf TFARBE 0,0,1)) ;;BLUE
            ((= TSIZE 3.5) (setf TFARBE 1,1,1)) ;;WHITE
            ((= TSIZE 5)   (setf TFARBE 1,1,0)) ;;YELLOW
            ((= TSIZE 7)   (setf TFARBE 0,1,0)) ;;GREEN
          );;cond
        );;progn
      |#
    );;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)))

    (TFARBE
        :value-type :rgb-color
        :initial-value (sd-rgb-to-color 1,1,1)
        :title (sd-multi-lang-string "Color" :german "Farbe"))
#|
                   r g b
                   -----
        BLACK    : 0 0 0
        RED      : 1 0 0
        GREEN    : 0 1 0
        YELLOW   : 1 1 0
        BLUE     : 0 0 1
        MAGENTA  : 1 0 1
        CYAN     : 0 1 1
        WHITE    : 1 1 1
|#


    ("")
    (T_B
       :value-type :boolean
       :title "mit Balloon"
       :toggle-type :grouped-toggle
       :initial-value t)
    (T_O
       :value-type :boolean
       :title "ohne"
       :toggle-type :grouped-toggle)

    ("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)

  );;variables

  :mutual-exclusion '( (OHNE_U MIT_U) (T_B T_O) )

  :after-initialization '(init-action)

  :local-functions
  '(
    ;;==========================================================
    (init-action ()
      ;; Aktuelle Text Settings Speichern
      (setf TXT_SET_AKTUELL (sd-am-inq-curr-text-attributes))
      ;; Aktuelle Geo Settings Speichern
      (setf GEO_SET_AKTUELL (sd-am-inq-curr-geometry-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 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 :size TSIZE
                                       :fill :OFF
                                       :ratio 1
                                       :slant 0
                                       :abs_angle 0
                                       :linesp 1.5
                                       :font1b TFONT
                                       :font2b "hp_kanji_c"
                                       :color TFARBE))
       (if T_B
          (sd-call-cmds (am_text_settings :frame "BALLOON"))
          (sd-call-cmds (am_text_settings :frame "OFF"))
       );;if

       (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))

       ;; ME10 zum Schreiben des Textes - wesentlich schneller bei vielen Ansichten als < sd-am-create-text >
       (oli::sd-execute-annotator-command :cmd "DEFINE Gd_create_text
         PARAMETER My_text
         PARAMETER Pos
         PARAMETER Sketch_id
         LOCAL curr_part
         INQ_PART '.'
         LET curr_part (inq 301)
         EDIT_PART Sketch_id
       	 TEXT My_text Pos
         EDIT_PART curr_part
       END_DEFINE")

       ;; Text erstellen
       ;(sd-am-create-text :text POS_TXT :position P0 :owner_type :sketch :owner NAME_OWNER)
       (oli::sd-execute-annotator-command :cmd (format nil "Gd_create_text '~a' ~a '~a'" POS_TXT P0 SKIZZEN_NAME))

       ;; Linienfarbe und Art setzen
       (am_geo_default :color :rgb 1,1,1)
       (am_geo_default :line_type :SOLID)

       ;; Unterstrich zeichnen
       (when MIT_U
        (let (MEF TLANG P1)
         ;; Textlänge berechnen
         (setf MEF (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 MEF)))
         ;; 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
         ;; Unterstrich zeichnen
         (sd-am-create-geo-straight :2pos (list P_PNR P1) :owner_type :sketch :owner NAME_OWNER)
        );;let
       );;when

       ;; Linie Textposition - Endposition zeichnen
       (sd-am-create-geo-straight :2pos (list P_PNR P_END) :owner_type :sketch :owner NAME_OWNER)

       ;; Punkt zeichnen
       #|
       (am_geo_default :pen_size (/ TSIZE 8))
       (am_geo_default :color :rgb 0,1,0)
       (sd-am-create-geo-circular :radius (list P_END (/ TSIZE 10)) :owner_type :sketch :owner NAME_OWNER)
       (am_geo_default :color :rgb 1,1,1)
       (am_geo_default :pen_size 0.0)
       |#

       ;; 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
      (let (ADJUST_WERT) ;;bis Version 13
           (cond
             ((string= (sd-am-text-attributes-struct-adjust TXT_SET_AKTUELL) "LOWER-LEFT")  (setf ADJUST_WERT 1))
             ((string= (sd-am-text-attributes-struct-adjust TXT_SET_AKTUELL) "LOWER-MID")   (setf ADJUST_WERT 2))
             ((string= (sd-am-text-attributes-struct-adjust TXT_SET_AKTUELL) "LOWER-RIGHT") (setf ADJUST_WERT 3))
             ((string= (sd-am-text-attributes-struct-adjust TXT_SET_AKTUELL) "MID-LEFT")    (setf ADJUST_WERT 4))
             ((string= (sd-am-text-attributes-struct-adjust TXT_SET_AKTUELL) "CENTER")      (setf ADJUST_WERT 5))
             ((string= (sd-am-text-attributes-struct-adjust TXT_SET_AKTUELL) "MID-RIGHT")   (setf ADJUST_WERT 6))
             ((string= (sd-am-text-attributes-struct-adjust TXT_SET_AKTUELL) "UPPER-LEFT")  (setf ADJUST_WERT 7))
             ((string= (sd-am-text-attributes-struct-adjust TXT_SET_AKTUELL) "UPPER-MID")   (setf ADJUST_WERT 8))
             ((string= (sd-am-text-attributes-struct-adjust TXT_SET_AKTUELL) "UPPER-RIGHT") (setf ADJUST_WERT 9))
           );;cond
           (sd-call-cmds (am_text_settings :adjust ADJUST_WERT))
      );;let
      (sd-call-cmds
        (am_text_settings
           :size (sd-am-text-attributes-struct-size TXT_SET_AKTUELL)
           ;;ab Version 14
           ;: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)))

      ;; Geo Settings zurücksetzen
      (sd-call-cmds (am_geo_default :color :rgb (sd-am-geo-attributes-struct-color GEO_SET_AKTUELL)))
      ;;(sd-call-cmds (am_geo_default :pen_size 0.0))
      (sd-call-cmds (am_geo_default :line_type (sd-am-geo-attributes-struct-linetype GEO_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

;; eof ====