;; ============================================================
;; TRO_EDIT.LSP - TRO-Marker einfuegen und bearbeiten
;;
;; Verwaltet die Attribute ID und TYPE eines TRO_*-Blocks. Die Marker
;; werden in der Regel von sps_skel (lib/tro_annotate.py) in eine Kopie der
;; Zeichnung eingefuegt; ein Marker ist ein Block TRO_SYM_<Typ> mit den
;; Attributen
;;   ID, TYPE           sichtbar
;;   FB_BLOCK           sichtbar (nur wenn mit --fb beschriftet)
;;   ITEMS, CONFIDENCE, SEPARATORS   unsichtbar, reine Daten
;;
;; Aufruf TRO_INSERT (neuen Marker einfuegen):
;;   - Menue SSG_LIB > TRO > Marker einfuegen
;;   - direkt: TRO_INSERT
;;   Fuegt eine bestehende TRO_SYM_<Typ>-Blockdefinition ein - die Form
;;   entsteht nur ueber tro_annotate.py, TRO_INSERT zeichnet keine neue.
;;   Ohne einen frueheren Lauf mit dem gewuenschten Typ bricht der Befehl
;;   mit einem Hinweis ab.
;;
;; Aufruf TRO_EDIT (Attribute eines bestehenden Markers aendern):
;;   - Doppelklick auf den Marker  -> ***DOUBLECLICK [INSERT] -> SSG_BLOCKEDIT
;;   - EATTEDIT                    -> c:EATTEDIT -> SSG_BLOCKEDIT
;;   - Menue SSG_LIB > TRO > Marker bearbeiten
;;   - direkt: TRO_EDIT
;;   Der Dispatcher SSG_BLOCKEDIT (SSG_LIB_Commands.lsp) leitet Blocknamen
;;   "TRO_*" hierher.
;;
;; Die Auswahlliste der Typen kommt aus tro_types.lsp, die sps_skel mit
;;   lib/tro_annotate.py --emit-lisp
;; nach DXFM_LISP schreibt. Fehlt die Datei, bleibt bei TRO_EDIT nur der
;; aktuelle Typ des Blocks in der Liste; TRO_INSERT bricht dann ab (siehe
;; tro-insert-kein-typ).
;;
;; Grenze: TRO_EDIT aendert nur die Attribute, TRO_INSERT nur die Position -
;; die *Form* des Markers gehoert zur Blockdefinition des Typs und
;; FB_BLOCK ist aus dem Typ abgeleitet; beides passt erst nach einem neuen
;; Lauf von tro_annotate.py wieder.
;;
;; Setzt ssg_core.lsp (ssg-start/ssg-end, ssg-attrib-*) und ssg_lang.lsp voraus.
;; ============================================================

(setq *tro-block-prefix* "TRO_SYM_")


;; ------------------------------------------------------------
;; Gueltige TRO-Typen laden (aus tro_types.lsp, erzeugt aus dem Katalog)
;; ------------------------------------------------------------
(defun tro-typen-laden ( / datei)
  (if (null *TRO-TYPES*)
    (progn
      (setq datei
        (cond
          ((and (boundp '*ssg-lisp-pfad*) *ssg-lisp-pfad*
                (findfile (strcat *ssg-lisp-pfad* "/tro_types.lsp")))
           (strcat *ssg-lisp-pfad* "/tro_types.lsp"))
          ((getenv "DXFM_LISP")
           (findfile (strcat (vl-string-translate "\\" "/" (getenv "DXFM_LISP"))
                             "/tro_types.lsp")))
          (t (findfile "tro_types.lsp"))
        )
      )
      (if datei (load datei))
    )
  )
  *TRO-TYPES*
)


;; ------------------------------------------------------------
;; Position eines Elements in einer Liste (nil wenn nicht enthalten)
;; ------------------------------------------------------------
(defun tro-index (item lst / i pos)
  (setq i 0 pos nil)
  (foreach x lst
    (if (and (null pos) (= (strcase x) (strcase item))) (setq pos i))
    (setq i (1+ i))
  )
  pos
)


;; ------------------------------------------------------------
;; Auswahlliste aufbauen: Katalogtypen, der aktuelle Typ immer enthalten
;; ------------------------------------------------------------
(defun tro-typliste (aktueller / liste)
  (setq liste (tro-typen-laden))
  (if (and aktueller (/= aktueller "") (null (tro-index aktueller liste)))
    (setq liste (append liste (list aktueller)))
  )
  (if liste liste (list (if aktueller aktueller "")))
)


;; ------------------------------------------------------------
;; Zahl mit fuehrenden Nullen auf gegebene Breite auffuellen
;; ------------------------------------------------------------
(defun tro-id-format (n breite / s)
  (setq s (itoa n))
  (while (< (strlen s) breite) (setq s (strcat "0" s)))
  (strcat "TRO" s)
)


;; ------------------------------------------------------------
;; Naechste freie TRO-Kennung vorschlagen.
;; Sucht ueber alle TRO_*-Blockinstanzen die hoechste Zahl hinter "TRO"
;; (Format wie in sps_skel, lib/tro_flow.py: "TRO" + Zahl) und schlaegt die
;; naechste vor, in derselben Stellenbreite wie der bisherige Bestand
;; (Default 2-stellig, wenn noch keine TROs in der Zeichnung sind).
;; ------------------------------------------------------------
(defun tro-naechste-id ( / ss i ent attribs id-val rest num maxnum breite)
  (setq maxnum 0 breite 2)
  (if (setq ss (ssget "_X" (list '(0 . "INSERT") '(2 . "TRO_*"))))
    (progn
      (setq i 0)
      (while (setq ent (ssname ss i))
        (setq attribs (ssg-attrib-read ent))
        (setq id-val (cdr (assoc "ID" attribs)))
        (if (and id-val (>= (strlen id-val) 4)
                 (= (strcase (substr id-val 1 3)) "TRO"))
          (progn
            (setq rest (substr id-val 4))
            (setq num (atoi rest))
            (if (> num maxnum) (setq maxnum num))
            (if (> (strlen rest) breite) (setq breite (strlen rest)))
          )
        )
        (setq i (1+ i))
      )
    )
  )
  (tro-id-format (1+ maxnum) breite)
)


;; ------------------------------------------------------------
;; Layer fuer einen neuen Marker ermitteln.
;; Uebernimmt den Layer einer bereits vorhandenen Instanz desselben Blocks
;; (Farbgruppen-Layer stammen aus tro_annotate.py/build_layers), sonst der
;; aktuell aktive Layer.
;; ------------------------------------------------------------
(defun tro-marker-layer (bname / ss)
  (if (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 bname))))
    (cdr (assoc 8 (entget (ssname ss 0))))
    (getvar "CLAYER")
  )
)


;; ------------------------------------------------------------
;; C:TRO_INSERT - neuen TRO-Marker einfuegen
;;
;; Fuegt eine bestehende TRO_SYM_<Typ>-Blockdefinition an einem gewaehlten
;; Punkt ein und setzt ID und TYPE. Die Blockdefinition (Form, Farbe)
;; entsteht nur ueber sps_skel (lib/tro_annotate.py) - ohne einen frueheren
;; Lauf mit dem gewuenschten Typ bricht der Befehl mit einem Hinweis ab.
;; ------------------------------------------------------------
(defun c:TRO_INSERT ( / liste dcl-pfad dat ergebnis typ id pt bname lay
                        oldAttreq oldAttdia)

  (ssg-start "TRO_INSERT" nil)

  (setq liste (tro-typliste nil))
  (if (or (null liste) (equal liste (list "")))
    (progn
      (alert (ssg-text "tro-insert-kein-typ"))
      (ssg-end)
      (exit)
    )
  )

  ;; --- Dialog: Typ + Kennung ---------------------------------------------
  (setq dcl-pfad (strcat (getenv "DXFM_DCL") "/tro_insert.dcl"))
  (setq dat (load_dialog dcl-pfad))
  (if (not (new_dialog "tro_insert" dat))
    (progn
      (alert (ssg-textf "tro-edit-dialog-fehlt" (list dcl-pfad)))
      (ssg-end)
      (exit)
    )
  )

  (start_list "type")
  (foreach typname liste (add_list typname))
  (end_list)
  (set_tile "type" "0")
  (set_tile "id" (tro-naechste-id))
  (set_tile "hinweis" (ssg-text "tro-insert-hinweis"))

  (setq typ (car liste))
  (action_tile "type" "(setq typ (nth (atoi (get_tile \"type\")) liste))")
  (action_tile "id"   "(setq id (get_tile \"id\"))")
  (action_tile "accept"
    (strcat "(setq typ (nth (atoi (get_tile \"type\")) liste)"
            "      id  (get_tile \"id\"))"
            "(done_dialog 1)"))
  (action_tile "cancel" "(done_dialog 0)")

  (setq ergebnis (start_dialog))
  (unload_dialog dat)

  (if (/= ergebnis 1)
    (progn (ssg-end) (exit))
  )
  (if (= (vl-string-trim " " id) "")
    (progn (alert (ssg-text "tro-edit-id-leer")) (ssg-end) (exit))
  )

  ;; --- Blockdefinition pruefen --------------------------------------------
  (setq bname (strcat *tro-block-prefix* typ))
  (if (not (tblsearch "BLOCK" bname))
    (progn
      (alert (ssg-textf "tro-insert-kein-block" (list bname)))
      (ssg-end)
      (exit)
    )
  )

  ;; --- Einfuegepunkt -------------------------------------------------------
  (setq pt (getpoint (ssg-text "tro-insert-prompt-punkt")))
  (if (null pt)
    (progn (ssg-end) (exit))
  )

  ;; --- Einfuegen ------------------------------------------------------------
  (setq lay (tro-marker-layer bname))
  (command "_LAYER" "_M" lay "")
  (setq oldAttreq (getvar "ATTREQ") oldAttdia (getvar "ATTDIA"))
  (setvar "ATTREQ" 0)
  (setvar "ATTDIA" 0)
  (command "_.INSERT" bname pt 1 1 0)
  (setvar "ATTREQ" oldAttreq)
  (setvar "ATTDIA" oldAttdia)

  (ssg-attrib-set-on (entlast)
    (list (cons "ID" id) (cons "TYPE" typ) (cons "CONFIDENCE" "manuell")))
  (entupd (entlast))

  (princ (ssg-textf "tro-insert-eingefuegt" (list id typ)))
  (ssg-end)
)


;; ------------------------------------------------------------
;; C:TRO_EDIT - Dialog fuer einen TRO-Marker
;; ------------------------------------------------------------
(defun c:TRO_EDIT ( / ss ent ed bname attribs
                      alt-id alt-type alt-fb int-id
                      neu-id neu-type
                      liste idx dcl-pfad dat ergebnis)

  ;; Implied Selection VOR ssg-start pruefen (ssg-start hebt Selektion auf)
  (setq ss (ssget "I"))
  (if (and ss (= (sslength ss) 1)
           (= (cdr (assoc 0 (entget (ssname ss 0)))) "INSERT"))
    (setq ent (ssname ss 0))
  )

  (ssg-start "TRO_EDIT" nil)

  ;; Marker auswaehlen (falls nicht vorselektiert)
  (if (null ent)
    (progn
      (princ (ssg-text "cmd-block-auswaehlen"))
      (setq ss (ssget ":S" '((0 . "INSERT"))))
      (if ss (setq ent (ssname ss 0)))
    )
  )
  (if (null ent)
    (progn (princ (ssg-text "cmd-kein-block-ausgewaehlt")) (ssg-end) (exit))
  )

  (setq ed    (entget ent)
        bname (cdr (assoc 2 ed)))
  (if (not (wcmatch bname "TRO_*"))
    (progn
      (alert (ssg-textf "tro-edit-kein-tro" (list bname)))
      (ssg-end)
      (exit)
    )
  )

  ;; --- aktuelle Attribute lesen ----------------------------------------
  (setq attribs  (ssg-attrib-read ent)
        alt-id   (cdr (assoc "ID" attribs))
        alt-type (cdr (assoc "TYPE" attribs))
        alt-fb   (cdr (assoc "FB_BLOCK" attribs))
        int-id   (cdr (assoc "UID" attribs)))

  (if (null alt-id)
    (progn
      (alert (ssg-textf "tro-edit-kein-id-attribut" (list bname)))
      (ssg-end)
      (exit)
    )
  )
  (if (null alt-type) (setq alt-type ""))

  ;; --- Dialog -----------------------------------------------------------
  (setq dcl-pfad (strcat (getenv "DXFM_DCL") "/tro_edit.dcl"))
  (setq dat (load_dialog dcl-pfad))
  (if (not (new_dialog "tro_edit" dat))
    (progn
      (alert (ssg-textf "tro-edit-dialog-fehlt" (list dcl-pfad)))
      (ssg-end)
      (exit)
    )
  )

  (setq liste (tro-typliste alt-type)
        idx   (tro-index alt-type liste))

  (set_tile "blockname" (ssg-textf "tro-edit-block" (list bname)))
  (set_tile "fb" (ssg-textf "tro-edit-fb"
                   (list (if alt-fb alt-fb "-") (if int-id int-id "-"))))
  (set_tile "hinweis" (ssg-text "tro-edit-hinweis"))
  (set_tile "id" alt-id)
  (start_list "type")
  (foreach typ liste (add_list typ))
  (end_list)
  (set_tile "type" (itoa (if idx idx 0)))

  (setq neu-id alt-id neu-type alt-type)
  (action_tile "id"   "(setq neu-id (get_tile \"id\"))")
  (action_tile "type" "(setq neu-type (nth (atoi (get_tile \"type\")) liste))")
  (action_tile "accept"
    (strcat "(setq neu-id (get_tile \"id\")"
            "      neu-type (nth (atoi (get_tile \"type\")) liste))"
            "(done_dialog 1)"))
  (action_tile "cancel" "(done_dialog 0)")

  (setq ergebnis (start_dialog))
  (unload_dialog dat)

  ;; --- zurueckschreiben -------------------------------------------------
  (if (= ergebnis 1)
    (if (= (vl-string-trim " " neu-id) "")
      (alert (ssg-text "tro-edit-id-leer"))
      (progn
        (ssg-attrib-set-on ent (list (cons "ID" neu-id) (cons "TYPE" neu-type)))
        (entupd ent)
        (princ (ssg-textf "tro-edit-gespeichert" (list neu-id neu-type)))
        (if (/= neu-type alt-type)
          (princ (ssg-text "tro-edit-typ-geaendert"))
        )
      )
    )
  )

  (ssg-end)
  (princ)
)


(prompt "\nTro_Edit.lsp geladen - Befehle: TRO_INSERT, TRO_EDIT")
(princ)