;;--------------------------------------------------------------------------*
;;  Copyright 2002  DC4 Technisches Büro GmbH                               *
;;                                                                          *
;;--------------------------------------------------------------------------*
;;  Dateiname: am_posnum.lsp
;;  Version  : 1.0     --> 02-03-06 ZYSSETdesign
;;  Datum    : 19.11.2002
;;  Author   : Gt
;;--------------------------------------------------------------------------*
;;  Modulbeschreibung: Positionsnummern und aehnliche Beschriftungen        *
;;                                                                          *
;;                                                                          *
;;                                                                          *
;;--------------------------------------------------------------------------*

;;--------------------------------------------------------------------------*
;;     in-packages                                                          *
;;--------------------------------------------------------------------------*

(in-package :custom)

;;--------------------------------------------------------------------------*
;;     use-packages                                                         *
;;--------------------------------------------------------------------------*

(use-package :OLI)

;;--------------------------------------------------------------------------*
;;     export                                                               *
;;--------------------------------------------------------------------------*

;;--------------------------------------------------------------------------*
;;     global variables                                                     *
;;--------------------------------------------------------------------------*

(defvar *dc4-anno-posnum-pos-text-string*)
(defvar *dc4-anno-posnum-pos-text-size*)
(defvar *dc4-anno-posnum-pos-text-farbe*)
(defvar *dc4-anno-posnum-pos-text-ratio*)
(defvar *dc4-anno-posnum-pos-text-slant*)
(defvar *dc4-anno-posnum-pos-text-font*)
(defvar *dc4-anno-posnum-pos-text-name*)
(defvar *dc4-anno-posnum-pos-grid-size*)

(setf *dc4-anno-posnum-pos-text-string* "1")
(setf *dc4-anno-posnum-pos-text-size* 5)
(setf *dc4-anno-posnum-pos-text-farbe* 1,1,1)
(setf *dc4-anno-posnum-pos-text-ratio* 1)
(setf *dc4-anno-posnum-pos-text-slant* 0)
(setf *dc4-anno-posnum-pos-text-font* nil)
(setf *dc4-anno-posnum-pos-text-name* "DC4_POSNR_1")
(setf *dc4-anno-posnum-pos-grid-size* 25)

;;--------------------------------------------------------------------------*
;;     dialogs                                                              *
;;--------------------------------------------------------------------------*

(sd-defdialog 'dc4-anno-posnum-posnr-create-dialog
:dialog-title "Positionsnummern"
:variables
  '(
    (ptext :value-type :string
           :prompt-text "Text fuer Positionsnummer angeben"
           :title "PositionsNr"
           :initial-value *dc4-anno-posnum-pos-text-string*
           :after-input (after-ptext-action)
    )
    (ppnt  :value-type :docupntcnp
           :prompt-text "Bezugspunkt fuer Positionsnummer angeben"
           :title "Textposition"
           :after-input (sd-execute-annotator-command :cmd
                         (format nil "LEADER_LINE ~A,~A"
                                   (oli::gpntdocu_x ppnt)
                                   (oli::gpntdocu_y ppnt)))
    )
    (epnt  :value-type :docupntcnp
           :prompt-text "Endpunkt der Bezugslinie angeben"
           :title "Endposition"
           :after-input (progn
                         (sd-execute-annotator-command :cmd
                          (format nil "CANCEL"))
                         (next-action)
                        );;progn
    )
    (tsize :value-type :positive-number
           :prompt-text "Textgroesse fuer Positionsnummer angeben."
           :title "Textgroesse"
           :initial-value *dc4-anno-posnum-pos-text-size*
           :after-input (after-tsize-action)
    )
    (tfont :range ("none")
           :initial-value *dc4-anno-posnum-pos-text-font*
           :prompt-text "Schriftart fuer Positionsnummer angeben."
           :title "Schriftart"
           :after-input (after-tfont-action)
    )
    (gsize :value-type :positive-number
           :prompt-text "Abstand fuer Punktgitter angeben."
           :title "Gitterabstand"
           :initial-value *dc4-anno-posnum-pos-grid-size*
           :after-input (after-gsize-action)
    )
   )
:after-initialization '(init-action)
:local-functions
  '(
    (init-action ()
     (let ()
      (sd-set-range 'tfont (docu::sd-am-inq-loaded-fonts))
      (sd-execute-annotator-command :cmd (format nil "GRID_FACTOR ~a" gsize))
      (sd-execute-annotator-command :cmd "DOT_GRID ON")
      (sd-disable-must-variable-check)
     )
    )
    (after-ans-action ()
     (let ()
      (docu::am_geo_set_domain :2dview ans complete)
     )
    )
    (after-ptext-action ()
     (let (testseq nonum num text nexttext)
      (setf *dc4-anno-posnum-pos-text-name* (format nil "DC4_POSNR_~a" ptext))
     )
    )
    (after-tsize-action ()
     (let ()
      (setf *dc4-anno-posnum-pos-text-size* tsize)
      (cond
       ((and (>= tsize 3.5) (< tsize 5)) (setf *dc4-anno-posnum-pos-text-farbe* 1,0,0))
       ((< tsize 3.5) (setf *dc4-anno-posnum-pos-text-farbe* 1,1,0))
       (t (setf *dc4-anno-posnum-pos-text-farbe* 1,1,1))
      );;cond
     )
    )
    (after-tfont-action ()
     (let ()
      (setf *dc4-anno-posnum-pos-text-font* tfont)
     )
    )
    (after-gsize-action ()
     (let ()
      (setf *dc4-anno-posnum-pos-grid-size* gsize)
      (sd-execute-annotator-command :cmd (format nil "GRID_FACTOR ~a" gsize))
     )
    )
    (next-action ()
     (let (testseq nonum num text nexttext)
      (sd-execute-annotator-command :cmd "DOT_GRID ALL OFF")
      (setf *dc4-anno-posnum-pos-text-name* (format nil "DC4_POSNR_~a" ptext))
      (dc4-am-posnum-label-zeichnen ppnt epnt ptext)
      (setf testseq (subseq ptext 0 (length ptext)))
      (setf nonum
       (position-if-not
        #'(lambda (substr)
           (let ()
            (digit-char-p (character substr))
           );;let
          );;lambda
       testseq)
      );;setf
      (if nonum
       (progn
        (cond
         ((= nonum 0) (setf nexttext ptext))
         (t
          (progn
           (setf num (read-from-string (subseq ptext 0 nonum)))
           (setf text (subseq ptext nonum (length ptext)))
           (setf nexttext (format nil "~a~a" (+ num 1) text))
          );;progn
         )
        );;cond
       );;progn
       (progn
        (setf num (read-from-string ptext))
        (setf nexttext (format nil "~a" (+ num 1)))
       );;progn
      );;if
      (setf *dc4-anno-posnum-pos-text-string* nexttext)
     )
    )
    (clean-action ()
     (let ()
      (sd-execute-annotator-command :cmd "DOT_GRID ALL OFF")
      (sd-execute-annotator-command :cmd "CANCEL")
     )
    )
   )
 :cancel-action
    '(clean-action)
 :ok-action
    '(clean-action)
)

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

(sd-defdialog 'dc4-anno-posnum-posnr-owner-dialog
:dialog-title "Zuordnen"
:variables
  '(
    (pnum  :selection *sd-anno-sketch-seltype*
           :prompt-text "Positionsnummer zum Zuordnen angeben."
           :title "PosNr"
           :multiple-items t
           :check-function
            #'(lambda (pnum)
                (let (name)
                 (setf name (sd-am-inq-name pnum))
                 (if (search "DC4_POSNR_" name :test #'equal)
                   :ok
                   (values :error "Das ist keine Positionsnummer!")
                 );;if
                );;let
              );;lambda
    )
    (ans   :selection *sd-anno-view-seltype*
           :prompt-text "Ansicht als Besitzer angeben."
           :title "Ansicht"
           :multiple-items nil
    )
   )
:after-initialization '(sd-disable-must-variable-check)
:local-functions
  '(
    (next-action ()
     (let ()
      (dc4-am-posnum-label-zuordnen pnum ans)
      (setf pnum nil)
     )
    )
   )
 :ok-action
    '(next-action)
)

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

(sd-defdialog 'dc4-anno-posnum-posnr-sheet-dialog
:dialog-title "Loesen"
:variables
  '(
    (pnum  :selection *sd-anno-sketch-seltype*
           :prompt-text "Positionsnummer zum Loesen von der Ansicht angeben."
           :title "PosNr"
           :multiple-items t
           :check-function
            #'(lambda (pnum)
                (let (name)
                 (setf name (sd-am-inq-name pnum))
                 (if (search "DC4_POSNR_" name :test #'equal)
                   :ok
                   (values :error "Das ist keine Positionsnummer!")
                 );;if
                );;let
              );;lambda
    )
   )
:after-initialization '(sd-disable-must-variable-check)
:local-functions
  '(
    (next-action ()
     (let ()
      (dc4-am-posnum-label-loesen pnum)
      (setf pnum nil)
     )
    )
   )
 :ok-action
    '(next-action)
)

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

(sd-defdialog 'dc4-anno-posnum-posnr-delete-dialog
:dialog-title "Loeschen"
:variables
  '(
    (pnum  :selection *sd-anno-sketch-seltype*
           :prompt-text "Positionsnummer zum Loeschen angeben."
           :title "PosNr"
           :multiple-items t
           :check-function
            #'(lambda (pnum)
                (let (name)
                 (setf name (sd-am-inq-name pnum))
                 (if (search "DC4_POSNR_" name :test #'equal)
                   :ok
                   (values :error "Das ist keine Positionsnummer!")
                 );;if
                );;let
              );;lambda
    )
   )
:after-initialization '(sd-disable-must-variable-check)
:local-functions
  '(
    (next-action ()
     (let ()
      (dc4-am-posnum-label-loeschen pnum)
      (setf pnum nil)
     )
    )
   )
 :ok-action
    '(next-action)
)

;;***************************************************************************
;;     FUNCTIONS                                                            *
;;***************************************************************************

;;--------------------------------------------------------------------------*
;;     Funktion: dc4-am-posnum-label-zeichnen                               *
;;                                                                          *
;;               Postionsnummer als Label Zeichnen                          *
;;                                                                          *
;;     Parameter : tpkt ... Punkt fuer Text                                 *
;;                 ppkt ... Endpunkt Bezugslinie                            *
;;                 numtext ... Text fuer Label                              *
;;                                                                          *
;;     Returnwert: t ... alles ok                                           *
;;                 nil ... sonst                                            *
;;                                                                          *
;;  Geppert 11.11.01                                                        *
;;-------------------------------------------------------------------------*/
(defun dc4-am-posnum-label-zeichnen (tpkt ppkt numtext)
 (let (ret tp pp xdiff lr gap fehler testseq sketch_name tmp_sketch_name name_p1 p0 p1 p2 mef tlang ohne_warn)

  (setf tp (make-gpnt2d :x (oli::gpntdocu_x tpkt)
                        :y (oli::gpntdocu_y tpkt)))

  (setf pp (make-gpnt2d :x (oli::gpntdocu_x ppkt)
                        :y (oli::gpntdocu_y ppkt)))

  (setf xdiff (- (oli::gpntdocu_x tpkt) (oli::gpntdocu_x ppkt)))
  (setf lr (< xdiff 0))

  ;; Texteinstellungen setzen
  (am_text_settings :size *dc4-anno-posnum-pos-text-size*)
  (am_text_settings :color :rgb *dc4-anno-posnum-pos-text-farbe*)
  (am_text_settings :ratio *dc4-anno-posnum-pos-text-ratio*)
  (am_text_settings :slant *dc4-anno-posnum-pos-text-slant*)
  (am_text_settings :font1b *dc4-anno-posnum-pos-text-font*)
  (am_text_settings :abs_angle 0.0)
  (am_text_settings :frame "OFF")
  (if lr
   (am_text_settings :adjust 3)
   (am_text_settings :adjust 1)
  );;if
  (setf gap (/ *dc4-anno-posnum-pos-text-size* 5))
  ;; die Skizze erzeugen
  (oli::sd-am-set-default-owner :sketch :current-sheet)
  (setf fehler nil)
  (setf testseq (subseq *dc4-anno-posnum-pos-text-name* 0 (length *dc4-anno-posnum-pos-text-name*)))
  (setf sketch_name
   (remove-if-not
    #'(lambda (substr)
       (let ()
        (if (or (alphanumericp (character substr)) (string= substr "_")) t nil)
       );;let
      );;lambda
   testseq)
  );;setf
  (setf tmp_sketch_name (format nil "~a_TEMP" sketch_name))
  (sd-call-cmds (AM_SKETCH_CREATE :GO :OK :sketch_name tmp_sketch_name
                     :REF_POINT tpkt)
      :failure (setf fehler t))

  (when fehler
    (progn
      (display "dc4-am-posnum-label-zeichnen")
      (display "Unerwarteter Fehler beim Erzeugen der Skizze :")
      (display (sd-inq-error-obj :message))
    )
  )

  (setf curr_sheet_name (sd-am-inq-curr-sheet-name))
  (setf name_pl (format nil "~a/~a" curr_sheet_name tmp_sketch_name))

  ;; alles was nun kommt, soll zur Skizze gehoeren
  (oli::sd-am-set-default-owner :geo :sketch name_pl)
  (oli::sd-am-set-default-owner :text :sketch name_pl)

  ;;Text einzeichnen
  (if lr
   (setf p0 (sd-vec-add tp (make-gpnt2d :x (- 0 gap) :y gap)))
   (setf p0 (sd-vec-add tp (make-gpnt2d :x gap :y gap)))
  );;if
  (setf ohne_warn docu::*docu-hide-wrong-owner-warning*)
  (setf docu::*docu-hide-wrong-owner-warning* t)
  (sd-call-cmds (AM_CREATE_TEXT  :DOCU-TEXT numtext p0) :failure (setf fehler t))
  (setf docu::*docu-hide-wrong-owner-warning* ohne_warn)
  (setf mef (format nil "DC4_inq_textlaenge \"/~a\"" name_pl))
  (setf tlang (+ (* 2 gap) (sd-execute-annotator-function :fnc mef)))

  ;; die Unterstreichnung zeichnen
  ;;(AM_GEO_DEFAULT :color :rgb 1,1,1)
  ;;(AM_GEO_DEFAULT :line_type :SOLID)
  ;;(if lr(setf p1 (sd-vec-add tp (make-gpnt2d :x (- 0 tlang) :y 0)))
  ;;(setf p1 (sd-vec-add tp (make-gpnt2d :x (+ 0 tlang) :y 0))))
  ;;;if (setf ohne_warn docu::*docu-hide-wrong-owner-warning*)
  ;;(setf docu::*docu-hide-wrong-owner-warning* t)
  ;;(sd-call-cmds (AM_GEO_LINE_2POS :GO :OK tp p1) :failure (setf fehler t))
  ;;(setf docu::*docu-hide-wrong-owner-warning* ohne_warn)


  ;; die Bezugslinie zeichnen
  (AM_GEO_DEFAULT :color :rgb 1,1,0)
  (AM_GEO_DEFAULT :line_type :SOLID)
  (setf ohne_warn docu::*docu-hide-wrong-owner-warning*)
  (setf docu::*docu-hide-wrong-owner-warning* t)
  (sd-am-create-geo-straight :2pos (list TP PP)  :owner_type :sketch  :owner NAME_PL)
  ;;(sd-call-cmds (AM_GEO_LINE_2POS :GO :OK tp pp) :failure (setf fehler t))
  (AM_GEO_DEFAULT :pen_size 0.75(/ *dc4-anno-posnum-pos-text-size* 10))
  (sd-call-cmds (AM_GEO_CIRCLE :GO :OK pp 0.2(/ *dc4-anno-posnum-pos-text-size* 20)) :failure (setf fehler t))
  (AM_GEO_DEFAULT :pen_size 0.0)
  (setf docu::*docu-hide-wrong-owner-warning* ohne_warn)


  ;; die Skizze umbenennen
  ;;(display "Umbenennen")
  (sd-call-cmds (AM_SKETCH_RENAME :sketch name_pl :new_name sketch_name))

  (oli::put-buffer "dc4-anno-posnum-posnr-create-dialog")
  ret
 )
)

;;--------------------------------------------------------------------------*
;;     Funktion: dc4-am-posnum-label-zuordnen                               *
;;                                                                          *
;;               Postionsnummer zu Ansicht zuordnen                         *
;;                                                                          *
;;     Parameter : pnum ... Skizze                                          *
;;                 ans ...  Ansicht                                         *
;;                                                                          *
;;     Returnwert: t ... alles ok                                           *
;;                 nil ... sonst                                            *
;;                                                                          *
;;  Geppert 31.01.02                                                        *
;;-------------------------------------------------------------------------*/

(defun dc4-am-posnum-label-zuordnen (pnum ans)
 (let (kind)
  (dolist (kind pnum)
   (sd-call-cmds (AM_SKETCH_OWNER :sketch kind :owner_view ans))
  );;dolist
  (oli::put-buffer "dc4-anno-posnum-posnr-owner-dialog")
 )
)

;;--------------------------------------------------------------------------*
;;     Funktion: dc4-am-posnum-label-loesen                                 *
;;                                                                          *
;;               Postionsnummer aktuellem Blatt zuordnen                    *
;;                                                                          *
;;     Parameter : pnum ... Skizze                                          *
;;                                                                          *
;;     Returnwert: t ... alles ok                                           *
;;                 nil ... sonst                                            *
;;                                                                          *
;;  Geppert 31.01.02                                                        *
;;-------------------------------------------------------------------------*/

(defun dc4-am-posnum-label-loesen (pnum)
 (let (kind)
  (dolist (kind pnum)
   (sd-call-cmds (AM_SKETCH_OWNER :sketch kind :owner_sheet (sd-am-inq-curr-sheet)))
  );;dolist
  (oli::put-buffer "dc4-anno-posnum-posnr-sheet-dialog")
 )
)

;;--------------------------------------------------------------------------*
;;     Funktion: dc4-am-posnum-label-loeschen                               *
;;                                                                          *
;;               Postionsnummer Loeschen                                    *
;;                                                                          *
;;     Parameter : pnum ... Skizze                                          *
;;                                                                          *
;;     Returnwert: t ... alles ok                                           *
;;                 nil ... sonst                                            *
;;                                                                          *
;;  Geppert 11.11.01                                                        *
;;-------------------------------------------------------------------------*/
(defun dc4-am-posnum-label-loeschen (pnum)
 (let (kind)
  (dolist (kind pnum)
   (sd-call-cmds (AM_SKETCH_DELETE :sketch kind :yes))
  );;dolist
  (oli::put-buffer "dc4-anno-posnum-posnr-delete-dialog")
 )
)

;;***************************************************************************
;;     ME10                                                                 *
;;***************************************************************************

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