;; ============================================================
;; GeruestInsert.lsp - Geruest-Baugruppen konfigurieren und einfuegen
;;
;; Liest data/json/geruest.json (rekursiv per ssg-json-laden),
;; laesst den Nutzer im Dialog dcl/geruest.dcl eine Basis-Variante, beliebige
;; Anbauteile, Laenge und Farbe waehlen, und fuegt das Ergebnis als Block
;; GR_<id>_<Zeitstempel> ein.
;;
;; Der Block wird - wie KREISEL_n/VF_n - selbst zusammengebaut: die Dummy-DWG
;; aus data/geruest liefert nur die Geometrie, das Attribut-Schema kommt aus
;; *geruest-attrib-defs*. Damit kann kein Attribut still verlorengehen, wenn
;; die Dummy-DWG einen Tag nicht kennt (ssg-attrib-set-on schreibt nur Tags,
;; die als ATTDEF existieren).
;;
;; Das GR_-Praefix ist nicht kosmetisch: SSG_BLOCKEDIT haelt jeden Block mit
;; TEILEART-Attribut fuer ein Omniflo-Element (SSG_LIB_Commands.lsp). Der
;; Doppelklick-Dispatcher erkennt Geruest-Bloecke an diesem Praefix.
;;
;; Befehle: GERUEST_ROHRABHAENGER, GERUEST_SAEULE_2ZOLL,
;;          GERUEST_SAEULE_1ZOLL, GERUEST_WANDBEFESTIGUNG
;; ============================================================

(vl-load-com)

;; Attribut-Schema des Wrapper-Blocks. Die Dummy-DWG darf eigene Tags
;; mitbringen - die bleiben erhalten (ssg-attrib-merge).
;; "ID" (leer vorbelegt, wie bei Kreisel/VF_n/GF_n) ist Voraussetzung dafuer,
;; dass ssg-id-check-all dem Block ueberhaupt eine ID zuweisen kann -
;; ssg-attrib-set-on schreibt nur auf ein bereits vorhandenes ATTDEF, siehe
;; oben. Ohne diesen Eintrag bliebe ID fuer immer leer (csv:read-attribs
;; exportiert dann eben kein "ID"-Feld statt eines Werts).
(if (null *geruest-attrib-defs*)
  (setq *geruest-attrib-defs*
    '(("ID"          "")
      ("ARTINR"      "")
      ("LAENGE"      "")
      ("BEZEICHNUNG" "")
      ("TEILEART"    "")
      ("FARBE"       "")
      ("LAYER"       "")
    )
  )
)

(if (null *geruest-block-counter*) (setq *geruest-block-counter* 0))


;; ============================================================
;; DATEN
;; ============================================================

(defun geruest-data-verzeichnis ( / )
  (cond
    ((getenv "DXFM_DATA") (vl-string-translate "\\" "/" (getenv "DXFM_DATA")))
    ((getenv "DXFMAKRO")
      (strcat (vl-string-translate "\\" "/" (getenv "DXFMAKRO")) "/data"))
  )
)

(defun geruest-json-pfad ( / basis)
  (if (setq basis (geruest-data-verzeichnis))
    (strcat basis "/json/geruest.json")
  )
)

(defun geruest-dummy-pfad (datei / basis)
  (if (and datei (setq basis (geruest-data-verzeichnis)))
    (strcat basis "/geruest/" datei)
  )
)

;; Datendatei einmal je Zeichnungssitzung laden.
(defun geruest-daten ( / pfad)
  (if (null *geruest-daten*)
    (progn
      (setq pfad (geruest-json-pfad))
      (cond
        ((null pfad) (princ (ssg-text "gr-fehler-datenpfad")))
        ((null (findfile pfad)) (princ (ssg-textf "gr-fehler-json-fehlt" (list pfad))))
        (T
          (setq *geruest-daten* (ssg-json-laden pfad))
          (if (null *geruest-daten*)
            (princ (ssg-textf "gr-fehler-json-lesbar" (list pfad)))
          )
        )
      )
    )
  )
  *geruest-daten*
)

;; Baugruppe ueber ihr ASCII-Feld "id" suchen. Der aeussere JSON-Schluessel
;; ("Rohrabhaenger" mit Umlaut, "2\" Saeulen" mit Anfuehrungszeichen) taugt
;; dafuer nicht - er ist aus ASCII-Quelltext nicht vergleichbar.
(defun geruest-baugruppe (id / erg)
  (foreach eintrag (geruest-daten)
    ;; equal statt = : fehlt einer Baugruppe das id-Feld, liefert ssg-json-get
    ;; nil - = ist mit nil-Argumenten nicht zuverlaessig.
    (if (and (null erg)
             (listp (cdr eintrag))
             (equal (ssg-json-get (cdr eintrag) "id") id))
      (setq erg (cdr eintrag))
    )
  )
  erg
)


;; ============================================================
;; TEILE AUSWERTEN
;; ============================================================

;; Anzeigename eines Eintrags: benannte Gruppe ("name") oder Einzelteil
;; ("artikel").
(defun geruest-eintrag-name (eintrag / n)
  (setq n (ssg-json-get eintrag "name"))
  (if (and n (= (type n) 'STR) (/= n ""))
    n
    (ssg-json-get eintrag "artikel")
  )
)

(defun geruest-menge (eintrag / m)
  (setq m (ssg-json-get eintrag "menge"))
  (if (and m (numberp m) (> m 0)) (fix m) 1)
)

;; Sivas-ID als String. Im JSON stehen rein numerische IDs als Zahl
;; (Projektkonvention), zusammengesetzte Codes waeren Strings.
(defun geruest-id-string (wert)
  (cond
    ((null wert) nil)
    ((= (type wert) 'STR) wert)
    ((= (type wert) 'INT) (itoa wert))
    ((= (type wert) 'REAL) (rtos wert 2 0))
  )
)

(defun geruest-wiederholen (wert n / erg i)
  (setq erg nil i 0)
  (if wert
    (while (< i n)
      (setq erg (cons wert erg))
      (setq i (1+ i))
    )
  )
  erg
)

;; Alle Artikelnummern eines Eintrags, jede gemaess "menge" wiederholt.
;; Benannte Gruppen ("teile") werden rekursiv aufgeloest.
(defun geruest-artikelnummern (eintrag / erg teile)
  (setq erg nil)
  (setq teile (ssg-json-get eintrag "teile"))
  (if teile
    (foreach teil teile
      (setq erg (append erg (geruest-artikelnummern teil)))
    )
    (setq erg (geruest-wiederholen
                (geruest-id-string (ssg-json-get eintrag "sivas_id"))
                (geruest-menge eintrag)))
  )
  erg
)


;; ============================================================
;; DIALOG
;; ============================================================

;; "0 3 5" -> (0 3 5). Rueckgabe von get_tile bei multiple_select.
(defun geruest-indizes (s / erg tok i c)
  (setq erg nil tok "" i 1)
  (if (null s) (setq s ""))
  (while (<= i (strlen s))
    (setq c (substr s i 1))
    (if (= c " ")
      (progn
        (if (/= tok "") (setq erg (cons (atoi tok) erg)))
        (setq tok "")
      )
      (setq tok (strcat tok c))
    )
    (setq i (1+ i))
  )
  (if (/= tok "") (setq erg (cons (atoi tok) erg)))
  (reverse erg)
)

;; Dialog zeigen. Rueckgabe:
;;   (variante-index (anbau-indizes) laenge-string farbe-string) oder nil
(defun geruest-dialog (bg / dcl-pfad dat varianten anbauteile attr laenge-def
                         farb-opts frei-opt fertig rueckgabe ergebnis
                         dlg-variante dlg-anbau dlg-laenge dlg-farbe dlg-frei
                         min-l max-l wert-l farbe-txt)
  (setq dcl-pfad (strcat (getenv "DXFM_DCL") "/geruest.dcl"))
  (setq varianten  (ssg-json-get bg "geometrie_varianten"))
  (setq anbauteile (ssg-json-get bg "anbaugruppen"))
  (setq attr       (ssg-json-get bg "attribute"))
  (setq laenge-def (if attr (ssg-json-get attr "Laenge")))
  (setq farb-opts  (if attr (ssg-json-get attr "Farbe")))
  (setq min-l (if laenge-def (ssg-json-get laenge-def "min")))
  (setq max-l (if laenge-def (ssg-json-get laenge-def "max")))

  ;; Farboptionen + freie Option ans Listenende; Index davon merkt sich der
  ;; Callback, um das Freitextfeld freizuschalten.
  (setq *geruest-farb-liste* nil *geruest-frei-idx* -1)
  (if farb-opts
    (progn
      (setq *geruest-farb-liste* (ssg-json-get farb-opts "optionen"))
      (if (ssg-json-get farb-opts "frei_erlaubt")
        (progn
          (setq frei-opt (ssg-json-get farb-opts "frei_option"))
          (if (null frei-opt) (setq frei-opt "Individuell"))
          (setq *geruest-frei-idx* (length *geruest-farb-liste*))
          (setq *geruest-farb-liste*
                (append *geruest-farb-liste* (list frei-opt)))
        )
      )
    )
  )

  (setq dlg-variante "0" dlg-anbau "" dlg-laenge "" dlg-farbe "0" dlg-frei "")
  (setq fertig nil rueckgabe nil)

  ;; Schleife, damit der Dialog nach einer ungueltigen Laenge mit den
  ;; bisherigen Eingaben erneut erscheint (Projektmuster, vgl. vf_linienzug).
  (while (not fertig)
    (setq dat (load_dialog dcl-pfad))
    (if (or (< dat 0) (not (new_dialog "geruest" dat)))
      (progn
        (alert (ssg-text "gr-fehler-dcl"))
        (setq fertig T)
      )
      (progn
        (set_tile "kopf" (ssg-textf "gr-dlg-kopf"
                           (list (ssg-json-get bg "teileart"))))

        (start_list "variante")
        (foreach v varianten (add_list (geruest-eintrag-name v)))
        (end_list)
        (set_tile "variante" dlg-variante)

        (start_list "anbau")
        (foreach a anbauteile (add_list (geruest-eintrag-name a)))
        (end_list)
        (if (/= dlg-anbau "") (set_tile "anbau" dlg-anbau))

        ;; Laenge/Farbe nur bei Baugruppen mit "attribute"-Block
        (if laenge-def
          (set_tile "laenge" dlg-laenge)
          (mode_tile "laenge" 1)
        )
        (if *geruest-farb-liste*
          (progn
            (start_list "farbe")
            (foreach f *geruest-farb-liste* (add_list f))
            (end_list)
            (set_tile "farbe" dlg-farbe)
            (set_tile "farbe_frei" dlg-frei)
            (mode_tile "farbe_frei"
              (if (= (atoi dlg-farbe) *geruest-frei-idx*) 0 1))
            (action_tile "farbe"
              "(mode_tile \"farbe_frei\" (if (= (atoi $value) *geruest-frei-idx*) 0 1))")
          )
          (progn
            (mode_tile "farbe" 1)
            (mode_tile "farbe_frei" 1)
          )
        )

        (action_tile "accept"
          (strcat "(setq dlg-variante (get_tile \"variante\"))"
                  "(setq dlg-anbau    (get_tile \"anbau\"))"
                  "(setq dlg-laenge   (get_tile \"laenge\"))"
                  "(setq dlg-farbe    (get_tile \"farbe\"))"
                  "(setq dlg-frei     (get_tile \"farbe_frei\"))"
                  "(done_dialog 1)"))
        (action_tile "cancel" "(done_dialog 0)")
        (setq ergebnis (start_dialog))
        (unload_dialog dat)

        (cond
          ((/= ergebnis 1) (setq fertig T))
          ;; Laenge pruefen - Bereichspruefung erfolgt im Projekt immer nach
          ;; done_dialog, DCL kann das nicht.
          ((and laenge-def
                (progn (setq wert-l (atof dlg-laenge))
                       (or (= (ssg-cfg-trim dlg-laenge) "")
                           (and min-l (< wert-l min-l))
                           (and max-l (> wert-l max-l)))))
            (alert (ssg-textf "gr-alert-laenge"
                     (list dlg-laenge
                           (if min-l (rtos min-l 2 0) "0")
                           (if max-l (rtos max-l 2 0) "-"))))
          )
          (T
            (setq farbe-txt
              (cond
                ((null *geruest-farb-liste*) "")
                ((= (atoi dlg-farbe) *geruest-frei-idx*) dlg-frei)
                (T (nth (atoi dlg-farbe) *geruest-farb-liste*))
              )
            )
            (setq rueckgabe (list (atoi dlg-variante)
                                  (geruest-indizes dlg-anbau)
                                  (if laenge-def dlg-laenge "")
                                  (if farbe-txt farbe-txt "")))
            (setq fertig T)
          )
        )
      )
    )
  )
  rueckgabe
)


;; ============================================================
;; BLOCK BAUEN UND EINFUEGEN
;; ============================================================

;; Eindeutiger Blockname. ssg-timestamp hat Sekundenaufloesung - bei zwei
;; Aufrufen in derselben Sekunde wird ein Zaehler angehaengt (Muster aus
;; OmniModulInsert.lsp).
(defun geruest-blockname (id / bname)
  (setq bname (strcat "GR_" id "_" (ssg-timestamp)))
  (while (tblsearch "BLOCK" bname)
    (setq *geruest-block-counter* (1+ *geruest-block-counter*))
    (setq bname (strcat "GR_" id "_" (ssg-timestamp) "_"
                        (itoa *geruest-block-counter*)))
  )
  bname
)

;; Dummy-Geometrie + eigene ATTDEFs zu einem Block zusammenfassen und am
;; gewaehlten Punkt einfuegen. werte = alist der berechneten Attributwerte.
;; Rueckgabe: (blockname . entity) oder nil.
(defun geruest-block-bauen (bg werte pt / datei dummy lastEnt dummyEnt e ss
                               bname blockEnt dummy-attribs attribs)
  (setq datei (ssg-json-get bg "dummy"))
  (setq dummy (geruest-dummy-pfad datei))
  (if (or (null dummy) (null (findfile dummy)))
    (progn
      (princ (ssg-textf "gr-fehler-dummy" (list (if dummy dummy datei))))
      nil
    )
    (progn
      (setvar "ATTREQ" 0)
      (setvar "ATTDIA" 0)
      (setvar "OSMODE" 0)
      (setq lastEnt (entlast))

      ;; Dummy bei (0,0,0) einfuegen - seine Attribute liefern u.a. die
      ;; LAYER-Vorgabe.
      (command "_.INSERT" dummy (list 0.0 0.0 0.0) 1 1 0)
      (setq dummyEnt (entlast))
      (setq dummy-attribs (ssg-attrib-read dummyEnt))

      ;; Unser Schema gewinnt an Struktur, die Dummy-Werte an Inhalt:
      ;; ssg-attrib-merge legt alle Tags aus *geruest-attrib-defs* an und
      ;; uebernimmt zusaetzlich alle Tags der Dummy-DWG.
      (setq attribs (ssg-attrib-merge dummy-attribs *geruest-attrib-defs*))
      (foreach paar werte
        (if (assoc (car paar) attribs)
          (setq attribs (subst paar (assoc (car paar) attribs) attribs))
          (setq attribs (append attribs (list paar)))
        )
      )

      (ssg-attrib-make-defs (ssg-attrib-alist-to-defs attribs) 50.0)

      ;; Alles Neue seit lastEnt einsammeln (Dummy-INSERT + ATTDEFs)
      (setq ss (ssadd))
      (setq e (if lastEnt (entnext lastEnt) (entnext)))
      (while e
        (ssadd e ss)
        (setq e (entnext e))
      )

      (setq bname (geruest-blockname (ssg-json-get bg "id")))
      (command "_.-BLOCK" bname (list 0.0 0.0 0.0) ss "")

      ;; Stand VOR dem Einfuegen merken: bricht der Nutzer die Drehung mit ESC
      ;; ab, entsteht kein neues INSERT und (entlast) zeigt auf ein voellig
      ;; fremdes Objekt - ohne diesen Vergleich wuerden dessen Attribute
      ;; ueberschrieben.
      (setq lastEnt (entlast))
      ;; pause = Drehwinkel interaktiv am Cursor
      (command "_.INSERT" bname pt 1 1 pause)
      ;; Laufende Einfuegung sicher beenden (z.B. ESC waehrend der Drehung)
      (if (> (getvar "CMDACTIVE") 0) (command))
      (if (> (getvar "CMDACTIVE") 0) (command))

      (setq blockEnt (entlast))
      (if (and blockEnt (not (eq blockEnt lastEnt))
               (= (cdr (assoc 0 (entget blockEnt))) "INSERT"))
        (progn
          (ssg-attrib-set-on blockEnt attribs)
          (ssg-block-layer-vorgabe blockEnt bname attribs)
          (cons bname blockEnt)
        )
      )
    )
  )
)


;; ============================================================
;; ABLAUF
;; ============================================================

(defun geruest-run (id / bg wahl varianten anbauteile variante gewaehlt
                       artnr bezeichnung teile-namen werte pt ergebnis)
  (setq bg (geruest-baugruppe id))
  (cond
    ((null bg)
      (if (geruest-daten) (princ (ssg-textf "gr-fehler-baugruppe" (list id))))
    )
    ((null (setq varianten (ssg-json-get bg "geometrie_varianten")))
      (princ (ssg-textf "gr-fehler-keine-varianten" (list id)))
    )
    (T
      (setq anbauteile (ssg-json-get bg "anbaugruppen"))
      (setq wahl (geruest-dialog bg))
      (if (null wahl)
        (princ (ssg-text "gr-abgebrochen"))
        (progn
          (setq variante (nth (car wahl) varianten))
          (setq gewaehlt nil)
          (foreach i (cadr wahl)
            (if (< i (length anbauteile))
              (setq gewaehlt (append gewaehlt (list (nth i anbauteile))))
            )
          )

          ;; ARTINR: jede Sivas-ID so oft, wie "menge" es vorgibt
          (setq artnr (geruest-artikelnummern variante))
          (foreach a gewaehlt
            (setq artnr (append artnr (geruest-artikelnummern a)))
          )

          ;; BEZEICHNUNG: mit " + " verketten - die Artikelbezeichnungen
          ;; enthalten selbst Kommas ("ROHR R 1\" 33,7 x 2,6").
          (setq teile-namen (list (ssg-json-get bg "teileart")
                                  (geruest-eintrag-name variante)))
          (foreach a gewaehlt
            (setq teile-namen (append teile-namen
                                (list (geruest-eintrag-name a))))
          )
          (setq bezeichnung (ssg-join teile-namen " + "))

          (setq werte (list (cons "ARTINR"      (ssg-join artnr ","))
                            (cons "BEZEICHNUNG" bezeichnung)
                            (cons "TEILEART"    (ssg-json-get bg "teileart"))))
          (if (/= (caddr wahl) "")
            (setq werte (append werte (list (cons "LAENGE" (caddr wahl))))))
          (if (/= (cadddr wahl) "")
            (setq werte (append werte (list (cons "FARBE" (cadddr wahl))))))

          (setq pt (getpoint (ssg-text "gr-prompt-einfuegepunkt")))
          (if (null pt)
            (princ (ssg-text "gr-abgebrochen"))
            (progn
              (ssg-start "Geruest" '(("OSMODE") ("ATTREQ") ("ATTDIA")))
              (setq ergebnis (geruest-block-bauen bg werte pt))
              (ssg-end)
              (if ergebnis
                (princ (ssg-textf "gr-fertig"
                         (list (ssg-json-get bg "teileart") (car ergebnis))))
              )
            )
          )
        )
      )
    )
  )
  (princ)
)


(defun c:GERUEST_ROHRABHAENGER   () (geruest-run "Rohrabhaenger"))
(defun c:GERUEST_SAEULE_2ZOLL    () (geruest-run "Saeulen_2Zoll"))
(defun c:GERUEST_SAEULE_1ZOLL    () (geruest-run "Saeulen_1Zoll"))
(defun c:GERUEST_WANDBEFESTIGUNG () (geruest-run "Wandbefestigung"))

(princ "\nGeruestInsert.lsp geladen. Befehle: GERUEST_ROHRABHAENGER, GERUEST_SAEULE_2ZOLL, GERUEST_SAEULE_1ZOLL, GERUEST_WANDBEFESTIGUNG")
(princ)