;; ================================================================
;; SPS_SKEL - TROEDIT: Attribute eines TRO-Markers bearbeiten
;; ================================================================
;; Befehl:  TROEDIT   -> Marker waehlen -> Dialog -> OK schreibt zurueck
;;
;; Bearbeitet die Attribute ID und TYPE eines Blocks TRO_SYM_*, die von
;; lib/tro_annotate.py eingefuegt wurden. Die Auswahlliste der Typen kommt aus
;; cad/tro_types.lsp (erzeugt mit "tro_annotate.py --emit-lisp"); fehlt die
;; Datei, ist TYPE ein freies Eingabefeld.
;;
;; Laden in BricsCAD:
;;   (load "<Pfad>/cad/tro_edit.lsp")
;; oder cad/ in die Supportpfade aufnehmen und per APPLOAD dauerhaft laden.
;;
;; Doppelklick statt Befehl: in der CUI unter "Doppelklick-Aktionen" fuer den
;; Objekttyp "Block-Referenz" den Befehl TROEDIT hinterlegen.
;;
;; Hinweis: der Dialog aendert nur die Attribute. Die *Form* des Markers gehoert
;; zur Blockdefinition des Typs - nach einer Typaenderung passt sie erst wieder,
;; wenn tro_annotate.py neu laeuft. Dasselbe gilt fuer FB_BLOCK, das aus dem Typ
;; abgeleitet ist.
;; ================================================================

(setq TRO:PREFIX "TRO_SYM_")

;; --- Hilfsfunktionen -------------------------------------------------------

(defun tro:attribs (blk / ent typ res)
  "Alle ATTRIB-Unterobjekte einer Blockreferenz als ((Tag . Entity) ...)."
  (setq ent (entnext blk) res '())
  (while (and ent
              (setq typ (cdr (assoc 0 (entget ent))))
              (= typ "ATTRIB"))
    (setq res (cons (cons (strcase (cdr (assoc 2 (entget ent)))) ent) res))
    (setq ent (entnext ent)))
  (reverse res))

(defun tro:get (attlist tag / pair)
  "Wert eines Attributs lesen, sonst \"\"."
  (if (setq pair (assoc (strcase tag) attlist))
    (cdr (assoc 1 (entget (cdr pair))))
    ""))

(defun tro:put (attlist tag value / pair data)
  "Wert eines Attributs schreiben. Gibt T zurueck, wenn das Attribut existiert."
  (if (setq pair (assoc (strcase tag) attlist))
    (progn
      (setq data (entget (cdr pair)))
      (entmod (subst (cons 1 value) (assoc 1 data) data))
      (entupd (cdr pair))
      T)
    nil))

(defun tro:index (item lst / i found)
  "Position von item in lst, sonst nil."
  (setq i 0 found nil)
  (foreach x lst
    (if (and (not found) (= (strcase x) (strcase item))) (setq found i))
    (setq i (1+ i)))
  found)

(defun tro:types ()
  "Gueltige Typen aus cad/tro_types.lsp, sonst nil."
  (if (not *TRO-TYPES*)
    (if (setq f (findfile "tro_types.lsp")) (load f)))
  *TRO-TYPES*)

;; --- Befehl ----------------------------------------------------------------

(defun c:TROEDIT (/ sel blk data name attlist types dcl dlg
                    cur-id cur-type new-id new-type idx result)

  ;; 1. Marker waehlen
  (setq sel (entsel "\nTRO-Marker waehlen: "))
  (if (not sel)
    (progn (princ "\nAbgebrochen.") (exit)))
  (setq blk  (car sel)
        data (entget blk))

  (if (/= (cdr (assoc 0 data)) "INSERT")
    (progn (princ "\nDas ist keine Blockreferenz.") (exit)))

  (setq name (cdr (assoc 2 data)))
  (if (/= (substr name 1 (strlen TRO:PREFIX)) TRO:PREFIX)
    (progn
      (princ (strcat "\nBlock \"" name "\" ist kein TRO-Marker (erwartet "
                     TRO:PREFIX "*)."))
      (exit)))

  (setq attlist (tro:attribs blk))
  (if (not (assoc "ID" attlist))
    (progn
      (princ "\nBlock hat kein Attribut ID - bitte neu beschriften lassen.")
      (exit)))

  (setq cur-id   (tro:get attlist "ID")
        cur-type (tro:get attlist "TYPE")
        types    (tro:types))

  ;; Typ des Blocks ergaenzen, falls er nicht in der Liste steht
  (if (and types (/= cur-type "") (not (tro:index cur-type types)))
    (setq types (append types (list cur-type))))
  (if (not types) (setq types (list cur-type)))

  ;; 2. Dialog laden
  (setq dcl (findfile "tro_edit.dcl"))
  (if (not dcl)
    (progn
      (princ "\ntro_edit.dcl nicht gefunden - cad/ in die Supportpfade legen.")
      (exit)))
  (setq dlg (load_dialog dcl))
  (if (not (new_dialog "tro_edit" dlg))
    (progn (unload_dialog dlg) (princ "\nDialog nicht ladbar.") (exit)))

  ;; 3. Felder fuellen
  (set_tile "blockname" (strcat "Block: " name))
  (set_tile "position"
            (strcat "Position: "
                    (rtos (car  (cdr (assoc 10 data))) 2 1) " / "
                    (rtos (cadr (cdr (assoc 10 data))) 2 1)))
  (set_tile "hint" "Form und FB_BLOCK folgen erst beim naechsten Lauf.")
  (set_tile "id" cur-id)

  (start_list "type")
  (foreach t types (add_list t))
  (end_list)
  (setq idx (tro:index cur-type types))
  (set_tile "type" (itoa (if idx idx 0)))

  ;; 4. Eingaben abholen
  (setq new-id cur-id new-type cur-type)
  (action_tile "id"   "(setq new-id (get_tile \"id\"))")
  (action_tile "type" "(setq new-type (nth (atoi (get_tile \"type\")) types))")
  (action_tile "accept"
               "(setq new-id (get_tile \"id\")
                      new-type (nth (atoi (get_tile \"type\")) types))
                (done_dialog 1)")
  (action_tile "cancel" "(done_dialog 0)")

  (setq result (start_dialog))
  (unload_dialog dlg)

  ;; 5. Zurueckschreiben
  (if (= result 1)
    (progn
      (if (= (vl-string-trim " " new-id) "")
        (princ "\nID darf nicht leer sein - nichts geaendert.")
        (progn
          (tro:put attlist "ID" new-id)
          (tro:put attlist "TYPE" new-type)
          (entupd blk)
          (princ (strcat "\n" name ": ID = " new-id ", TYPE = " new-type))
          (if (/= new-type cur-type)
            (princ "\nTyp geaendert - tro_annotate.py neu laufen lassen, damit Form und FB passen."))))
    )
    (princ "\nAbgebrochen."))
  (princ))

(princ "\nTROEDIT geladen. Befehl: TROEDIT")
(princ)