Schoenenberger_Systeme_GmbH/dxfmakros
3
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity
Files
40e833169555a5197ba59892e1ef66082f78b17d
dxfmakros/Lisp/vf_spec.lsp
T
s.ayadi 2dd5382060 [FEAT] Weitere Objekte der Anlage in hundm05.json bauen (Kreisel) 
tests/testdata/hundm05.json enthaelt jetzt neben den 5 Spec-Ketten auch
andere Objekte der Anlage - erkennbar am Feld "function", im Format der
jeweiligen Einzel-Testdaten (ein Kreisel also wie in kreisel_tests.json).
Damit beschreibt EINE Datei die ganze Anlage.

- tests/test_hundm05.lsp: hundm05:bau-zusatzobjekte sammelt alle Objekte mit
  "function" und baut sie; hundm05:bau-kreisel ruft kreisel-insert-script
  (wie tests/test_kreisel.lsp) und liefert einen Ergebnis-Record in derselben
  Form wie die Ketten. Eigener ssg-start-Rahmen mit ATTREQ/ATTDIA 0, weil
  vsp-bau-datei seinen schon geschlossen hat und (command "_.INSERT" ...)
  sonst nach Attributwerten fragt. Je Objekt gefangen, damit ein Fehler die
  restlichen nicht mitnimmt.
- Lisp/vf_spec.lsp: "kind" ist jetzt ein Record-Feld (Default "linienzug")
  statt eines Literals in vsp-result-json - so schreibt vsp-results-schreiben
  beide Objektarten in EINE Ergebnisdatei.
- lib/vf_spec_export.py: Objekte der Ziel-Datei, die keine Kette beschreiben,
  werden beim Neuschreiben unveraendert ans Dateiende uebernommen. Ohne das
  waere jeder von Hand ergaenzte Eintrag beim naechsten Generatorlauf weg -
  die Datei ist erzeugt UND handgepflegt. spec_aus_flachen_objekten
  ueberspringt sie jetzt statt zu werfen, genau wie vsp-gruppieren in LISP.
- tests/test_hundm05.py: die Ketten-Tests filtern auf kind "linienzug"
  (Records ohne das Feld stammen aus aelteren Laeufen und waren nur Ketten);
  neue Klasse TestZusatzobjekte prueft Status, expect_block_prefix,
  expect_hoehe (Attribut HOEHE), expect_kreiselart (KREISELART) und den
  Einfuegepunkt - dieselben Erwartungsfelder wie tests/test_kreisel.py.
- tests/test_vf_spec.py: neuer Test, dass die Zusatzobjekte die
  Ketten-Zerlegung nicht beeinflussen - auch nicht, wenn sie mitten zwischen
  den Sektionen stehen (der eingetragene Kreisel stand zunaechst inmitten
  der Sub-Knoten von Kette 5; nach dem Regenerieren steht er am Dateiende).

Verifiziert: 118 pytest-Tests gruen, Spec-Regenerierung uebernimmt das
Zusatzobjekt (58 Objekte), beide .lsp lint-sauber. Die Kreisel-Tests warten
auf den naechsten TEST_HUNDM05-Lauf.

Co-Authored-By: Claude Opus 5 (1M context) <noreply@anthropic.com>
2026-09-03 14:49:46 +02:00

958 lines
41 KiB
Common Lisp
Raw Blame History

;; ============================================================
;; vf_spec.lsp - VF-Linienzug aus Eingabedaten bauen (ohne GUI/Konsole)
;; ============================================================
;; Stufe 1 des Fahrplans in doc/TODO-plan-vf-interactive.md.
;;
;; Eine SPEC beschreibt eine Kette in Domaenenwerten ("links", "winkel",
;; "aussen", ja/nein) statt in Menue-Codes: lesbar, schreibbar, versionierbar.
;; Dieses Modul uebersetzt sie in ein Eingabe-Journal und laesst den
;; UNVERAENDERTEN Bau-Ablauf darueber laufen:
;;
;; Spec --vsp-journal--> Journal --vfl-journal-replay-start-->
;; vf-linienzug-modus --> VF_n-Block (mit Journal-XDATA)
;;
;; Warum ueber das Journal und nicht direkt in die Bau-Funktionen: der Block
;; traegt danach dasselbe SSG_VF_EDIT-Journal wie eine handgebaute Kette und
;; bleibt per Doppelklick editierbar und 2D/3D-konvertierbar (Invariante I1
;; im Fahrplan). Kein Journal-Konsument muss etwas von Specs wissen.
;;
;; Die Grammatik (welche Frage in welcher Reihenfolge) ist die von
;; vf-linienzug-modus. Gegenstueck in Python: lib/vf_spec_export.py
;; (SpecSchreiber) - beide MUESSEN dieselbe Tokenfolge liefern. Der Rundlauf
;; gegen die 5 echten HundM-Ketten ist dort abgesichert
;; (tests/test_vf_spec.py), die LISP-Seite in tests/test_vf_spec.lsp.
;;
;; Fehlerverhalten: fail fast. Was die Spec nicht hergibt, wird NICHT
;; geraten - vsp-journal sammelt alle Verstoesse und liefert nil, dann wird
;; nichts gebaut (Invariante I3 im Fahrplan).
;;
;; Praefix vsp- (vf spec). NICHT vfs- - das gehoert vf_standard.lsp.
;; ============================================================
;; Nachladen fuers isolierte Testen (im Normalbetrieb laedt vf_core.lsp
;; dieses Modul NACH vf_linienzug.lsp, dann ist alles schon da).
;; Muster: ssg_ks_insert in vf_core.lsp.
(if (null (car (atoms-family 1 '("VFL-JOURNAL-REPLAY-START"))))
(if (and (car (atoms-family 1 '("SSG-LISP-DATEI-PFAD")))
(findfile (ssg-lisp-datei-pfad "vf_linienzug.lsp")))
(load (ssg-lisp-datei-pfad "vf_linienzug.lsp"))))
;; ============================================================
;; TEIL 1: CODE-TABELLEN
;; ============================================================
;; Links der Domaenenwert (Spec), rechts der Journal-Code. Die Spec kennt
;; KEINE Codes - sie sind eine Eigenschaft des Dialogs, nicht der Anlage.
;; Ausnahme: AS-/ES-Winkel und Bogen-/Kurvenwinkel stehen auch im Journal als
;; WERT ("90", 30) und bleiben darum Werte.
(setq *vsp-tab-seite* '(("links" . "1") ("rechts" . "2")))
(setq *vsp-tab-variante* '(("aussen" . "1") ("innen" . "2")))
(setq *vsp-tab-gefaelle* '(("hoehe" . "1") ("winkel" . "2")))
(setq *vsp-tab-verteilung* '(("haelfte" . "1") ("einlauf" . "2")))
(setq *vsp-tab-im-vf* '(("horizontal" . "1") ("vario-kurve" . "2")
("auf-ab" . "3")))
(setq *vsp-tab-endpunkt* '(("motorstation" . "1") ("weiter" . "2")
("kettenende" . "3")))
(setq *vsp-tab-ende3* '(("ja-mit-es" . "1") ("ja-ohne-es" . "2")
("nein" . "3")))
(setq *vsp-tab-ende2* '(("ja-mit-es" . "1") ("nein" . "2")))
;; Glied -> Menue-Code. Der Code haengt am Frame: die ERSTE Sektion laeuft
;; ohne Frame und bekommt 4 Optionen (kein GF-Bogen - es gibt noch keine
;; Richtung, an die er anschliessen koennte), jede spaetere 5.
(setq *vsp-menu-start* '(("Linie-GF" . "1") ("Linie-VF" . "2")
("Horizontal-VF" . "3") ("Linie" . "4")))
(setq *vsp-menu-weiter* '(("GF-Bogen" . "1") ("Linie-GF" . "2")
("Linie-VF" . "3") ("Horizontal-VF" . "4")
("Linie" . "5")))
;; ============================================================
;; TEIL 2: HILFEN
;; ============================================================
(if (not (boundp '*vsp-fehler*)) (setq *vsp-fehler* nil))
(if (not (boundp '*vsp-tok*)) (setq *vsp-tok* nil))
(if (not (boundp '*vsp-erster-dl*)) (setq *vsp-erster-dl* T))
(if (not (boundp '*vsp-wo*)) (setq *vsp-wo* "Spec"))
(if (not (boundp '*vsp-prompts*)) (setq *vsp-prompts* 0))
;; Erzwungene Bau-Dimension ("2D"/"3D") fuer einen ganzen Lauf. nil = die
;; Spec bzw. die Sitzung entscheidet. Muss JE KETTE neu gesetzt werden,
;; darum in vsp-bau-aus-spec und nicht einmal aussen: der Abbruch-Handler in
;; vf-linienzug-modus setzt *ssg-ils-dim* zurueck.
(if (not (boundp '*vsp-dim-override*)) (setq *vsp-dim-override* nil))
;; Fehler sammeln (aeltester zuerst) statt beim ersten abzubrechen: eine
;; handgeschriebene Spec hat selten genau einen Tippfehler.
(defun vsp-fehler (txt)
(setq *vsp-fehler* (append *vsp-fehler* (list (strcat *vsp-wo* ": " txt))))
(dbgmsg (strcat "SPEC-FEHLER: " *vsp-wo* ": " txt))
txt)
;; Wahrheitswert aus der Spec lesen. Das JSON traegt 1/0 (ssg-cfg-parse-value
;; kennt kein true/false), eine LISP-Spec T/nil - und ACHTUNG: in AutoLISP ist
;; 0 WAHR, ein blosses (if v ...) waere also falsch.
(defun vsp-ja-p (v)
(cond ((null v) nil)
((eq v T) T)
((numberp v) (/= v 0))
((= (type v) 'STR)
(if (member (strcase v t) '("1" "t" "ja" "yes" "true")) T nil))
(T T)))
(defun vsp-ja-code (v) (if (vsp-ja-p v) "1" "2"))
(defun vsp-werte-text (tab / s first)
(setq s "" first T)
(foreach p tab
(if (not first) (setq s (strcat s ", ")))
(setq s (strcat s (car p)) first nil))
s)
;; Domaenenwert -> Journal-Code. Unbekannter Wert = Spec-Fehler samt Liste
;; der erlaubten Werte (die Meldung ist die halbe Dokumentation).
(defun vsp-code (tab wert name / paar)
(setq paar (if (and wert (= (type wert) 'STR)) (assoc wert tab) nil))
(cond
(paar (cdr paar))
;; Rohen Code durchreichen: ein aus einem Journal zurueckgelesener Wert
;; darf direkt als "1"/"2"/... in der Spec stehen.
((and wert (= (type wert) 'STR) (member wert (mapcar 'cdr tab))) wert)
(T (vsp-fehler (strcat "Feld \"" name "\" hat Wert "
(if wert (vl-princ-to-string wert) "nil")
" - erlaubt: " (vsp-werte-text tab)))
nil)))
;; --- Token-Ausgabe (Journal in Bau-Reihenfolge) ---
;; Kinds wie im Journal auf der XDATA: PT (Punktliste), DL/REAL (Realzahl),
;; INT (Ganzzahl), STR/STEP (String).
(defun vsp-raus (kind wert)
(setq *vsp-tok* (cons (cons kind wert) *vsp-tok*)))
(defun vsp-zahl (kind v name)
(if (numberp v)
(vsp-raus kind (float v))
(progn
(vsp-fehler (strcat "Feld \"" name "\" fehlt oder ist keine Zahl"))
;; Trotzdem einen Platzhalter setzen, damit der Rest der Spec noch
;; geprueft werden kann - gebaut wird bei Fehlern ohnehin nichts.
(vsp-raus kind 0.0))))
(defun vsp-ganz (v name)
(if (numberp v)
(vsp-raus "INT" (fix v))
(progn (vsp-fehler (strcat "Feld \"" name "\" fehlt oder ist keine Zahl"))
(vsp-raus "INT" 0))))
;; Werte, die auch im Journal als Wert stehen (AS-/ES-Winkel): als String.
(defun vsp-wert-str (v name)
(cond ((and v (= (type v) 'STR)) (vsp-raus "STR" v))
((numberp v) (vsp-raus "STR" (itoa (fix v))))
(T (vsp-fehler (strcat "Feld \"" name "\" fehlt"))
(vsp-raus "STR" ""))))
(defun vsp-code-raus (tab wert name / c)
(setq c (vsp-code tab wert name))
(vsp-raus "STR" (if c c "")))
;; ============================================================
;; TEIL 3: SPEC -> JOURNAL
;; ============================================================
;; Reiner Emitter: keine Geometrie, keine Rueckfrage, nur Felder in Tokens.
;;
;; Spec-Struktur (so, wie vsp-gruppieren sie aus dem flachen JSON baut):
;; spec = (kopf sektionen)
;; kopf = Alist mit spec_id, start_punkt, start_hoehe, as, as_winkel,
;; as_seite; optional modus, dim, beschreibung
;; sektionen = Liste von (sek subs)
;; sek = Alist mit glied + Feldern des Glieds
;; subs = Liste von Alists mit sub + Feldern (nur bei VF-Einheiten)
(defun vsp-kopf (spec) (car spec))
(defun vsp-sektionen (spec) (cadr spec))
(defun vsp-sek-felder (s) (car s))
(defun vsp-sek-subs (s) (cadr s))
(defun vsp-spec-id (kopf / v)
(setq v (ssg-val kopf "spec_id"))
(if v v "(ohne spec_id)"))
;; Segmentlaenge, und NUR beim allerersten Segment der Kette die gesnappte
;; Fahrtrichtung: vfl-in-abstand journalisiert die Richtung nur bei freier
;; Richtungswahl (hz-vorgabe nil), jedes weitere Segment erbt sie vom
;; Vorgaenger. Ein hz an spaeterer Stelle wuerde die ganze Replay-Queue um
;; einen Eintrag verschieben - darum hier ein harter Fehler.
(defun vsp-linie (quelle / hz)
(vsp-zahl "DL" (ssg-val quelle "dl") "dl")
(setq hz (ssg-val quelle "hz"))
(cond
(*vsp-erster-dl*
(vsp-zahl "REAL" hz "hz (Pflicht beim ersten Segment der Kette)")
(setq *vsp-erster-dl* nil))
(hz
(vsp-fehler (strcat "Feld \"hz\" ist nur beim ERSTEN Segment der Kette"
" erlaubt - jedes weitere erbt die Fahrtrichtung"
" vom Vorgaenger und hat keinen Journal-Eintrag")))))
;; Winkelwahl (vfl-waehle-winkel) steht nur im Journal, wenn mehrere
;; Kandidatenwinkel gueltig waren - das haengt an der real gemessenen
;; Restlaenge und ist vorab nicht immer bekannt. Fehlt das Feld und der Bau
;; braucht die Antwort, greift der Headless-Riegel und nennt die Fundstelle.
(defun vsp-winkel-idx (quelle / v)
(setq v (ssg-val quelle "winkel_idx"))
(if v (vsp-ganz v "winkel_idx")))
(defun vsp-praeambel (kopf / punkt)
(setq *vsp-wo* "start")
(setq punkt (ssg-val kopf "start_punkt"))
(if (and punkt (listp punkt) (>= (length punkt) 3))
(vsp-raus "PT" (mapcar 'float punkt))
(progn
(vsp-fehler "Feld \"start_punkt\" braucht [x, y, z] in EINER Zeile")
(vsp-raus "PT" '(0.0 0.0 0.0))))
(vsp-zahl "REAL" (ssg-val kopf "start_hoehe") "start_hoehe")
(vsp-raus "STR" (vsp-ja-code (ssg-val kopf "as")))
(if (vsp-ja-p (ssg-val kopf "as"))
(progn
(vsp-wert-str (ssg-val kopf "as_winkel") "as_winkel")
(vsp-code-raus *vsp-tab-seite* (ssg-val kopf "as_seite") "as_seite"))))
(defun vsp-sektion (sek subs erster / label tab code art)
(setq label (ssg-val sek "glied"))
(setq *vsp-wo* (strcat "Sektion " (if label label "(ohne glied)")))
(cond
((null label) (vsp-fehler "Feld \"glied\" fehlt"))
;; ES-Glied: KEINE Menue-Antwort. Die Kettenende-Frage steht beim
;; Vorgaenger, das ES-Glied selbst besteht nur aus Winkel und Seite.
((= label "ES")
(vsp-raus "STEP" "ES")
(vsp-wert-str (ssg-val sek "winkel") "winkel")
(vsp-code-raus *vsp-tab-seite* (ssg-val sek "seite") "seite"))
(T
(setq tab (if erster *vsp-menu-start* *vsp-menu-weiter*))
(setq code (cdr (assoc label tab)))
(if (null code)
(vsp-fehler
(strcat "Glied \"" label "\" ist an dieser Stelle nicht waehlbar"
(if erster
" (erste Sektion laeuft ohne Frame, darum kein GF-Bogen)"
"")
" - erlaubt: " (vsp-werte-text tab))))
(vsp-raus "STEP" label)
(vsp-raus "STR" (if code code ""))
(cond
((= label "GF-Bogen")
(vsp-ganz (ssg-val sek "winkel") "winkel")
(vsp-code-raus *vsp-tab-seite* (ssg-val sek "seite") "seite"))
((= label "Linie-GF")
(vsp-linie sek)
(setq art (ssg-val sek "gefaelle"))
(vsp-code-raus *vsp-tab-gefaelle* art "gefaelle")
(if (= art "hoehe")
(vsp-zahl "REAL" (ssg-val sek "hoehe") "hoehe")
(vsp-zahl "REAL" (ssg-val sek "winkel") "winkel"))
(vsp-code-raus *vsp-tab-ende3* (ssg-val sek "ende") "ende"))
((= label "Linie-VF")
(vsp-linie sek)
(vsp-zahl "REAL" (ssg-val sek "hoehe") "hoehe")
(vsp-winkel-idx sek)
(vsp-vf-einheit sek subs nil))
((= label "Horizontal-VF")
(vsp-linie sek)
(vsp-vf-einheit sek subs T))
((= label "Linie")
(vsp-linie sek)
(vsp-zahl "REAL" (ssg-val sek "hoehe") "hoehe")
(vsp-winkel-idx sek)
;; vfl-segment-entscheidung waehlt selbst zwischen reiner
;; Gefaellestrecke (dann folgt direkt das ES-Glied) und VF-Einheit.
;; Was es war, steht in segment_typ - das zu raten waere
;; Geometrie-Raten.
(setq art (ssg-val sek "segment_typ"))
(cond ((= art "VF") (vsp-vf-einheit sek subs nil))
((= art "GF") nil)
(T (vsp-fehler (strcat "Feld \"segment_typ\" fehlt oder ist"
" unbekannt - erlaubt: GF, VF")))))
(T (vsp-fehler
(strcat "unbekanntes Glied \"" label "\" - erlaubt: "
(vsp-werte-text *vsp-menu-weiter*) ", ES")))))))
;; VF-Einheit: GF-Verteilung, erster Koerper, Fortsetzungsschleife bis
;; Motorstation/Kettenende, Abschluss.
;;
;; erst-hor spiegelt die winkel1-Verzweigung in vfl-vf-einheit: NUR der
;; horizontale Erstkoerper laeuft durch vfl-baue-horizontal-koerper und
;; stellt darum Separator vor/nach schon vorab. Ein gewinkelter Erstkoerper
;; wird ohne jede Frage gebaut.
;;
;; Die Endpunkt-Antwort ("Ist der Endpunkt der Foerderer?") wird im Ablauf an
;; zwei Stellen gestellt - am Schleifenkopf und am Ende von
;; vfl-baue-horizontal-koerper (von dort als vor-antwort weitergegeben). In
;; der flachen Queue liegt sie aber IMMER an derselben Position: direkt nach
;; den Werten des Vorgaenger-Knotens. Darum genau EIN Code je sub.
(defun vsp-vf-einheit (sek subs erst-hor / n i wahl letzter ende)
(vsp-code-raus *vsp-tab-verteilung* (ssg-val sek "gf_verteilung")
"gf_verteilung")
(if erst-hor
(progn
(vsp-raus "STR" (vsp-ja-code (ssg-val sek "vf_sep_vor")))
(vsp-raus "STR" (vsp-ja-code (ssg-val sek "vf_sep_nach")))))
(setq n (length subs))
(if (= n 0)
(vsp-fehler (strcat "VF-Einheit ohne sub-Knoten - sie muss mit"
" motorstation oder kettenende enden")))
(setq i 0)
(foreach sub subs
(setq i (1+ i) letzter (= i n))
(setq wahl (ssg-val sub "sub"))
(setq *vsp-wo* (strcat "Sektion " (ssg-val sek "glied") " / sub "
(itoa i) " (" (if wahl wahl "ohne sub") ")"))
(cond
((null wahl) (vsp-fehler "Feld \"sub\" fehlt"))
((= wahl "motorstation")
(if (not letzter)
(vsp-fehler (strcat "motorstation beendet die VF-Einheit, es folgen"
" aber noch weitere subs")))
(vsp-code-raus *vsp-tab-endpunkt* "motorstation" "sub"))
((= wahl "kettenende")
(if (not letzter)
(vsp-fehler (strcat "kettenende beendet die VF-Einheit, es folgen"
" aber noch weitere subs")))
(vsp-code-raus *vsp-tab-endpunkt* "kettenende" "sub")
(vsp-raus "STR" (vsp-ja-code (ssg-val sub "es")))
(vsp-linie sub)
(vsp-zahl "REAL" (ssg-val sub "hoehe") "hoehe")
(vsp-winkel-idx sub))
(T
(if letzter
(vsp-fehler (strcat "letzter sub ist \"" wahl "\" - die VF-Einheit"
" muss mit motorstation oder kettenende enden")))
(vsp-code-raus *vsp-tab-endpunkt* "weiter" "sub")
(vsp-code-raus *vsp-tab-im-vf* wahl "sub")
(cond
((= wahl "horizontal")
(vsp-linie sub)
(vsp-raus "STR" (vsp-ja-code (ssg-val sub "sep_vor")))
(vsp-raus "STR" (vsp-ja-code (ssg-val sub "sep_nach"))))
((= wahl "vario-kurve")
(vsp-raus "STEP" "Vario-Kurve")
(vsp-ganz (ssg-val sub "winkel") "winkel")
(vsp-code-raus *vsp-tab-seite* (ssg-val sub "seite") "seite")
(vsp-code-raus *vsp-tab-variante* (ssg-val sub "variante")
"variante"))
((= wahl "auf-ab")
(vsp-linie sub)
(vsp-zahl "REAL" (ssg-val sub "hoehe") "hoehe")
(vsp-winkel-idx sub))))))
;; --- Abschluss (vfl-vf-einheit-abschluss) ---
;; "zielpunkt-ohne-es": Kette endet direkt am Zielpunkt, keine Frage.
;; "automatisch": Glied "Linie" bzw. erreichter Zielpunkt - das
;; ES-Glied folgt ohne Frage (als eigene Sektion).
;; sonst wird gefragt; bei "nein" zusaetzlich der Separator.
(setq *vsp-wo* (strcat "Sektion " (ssg-val sek "glied") " / vf_ende"))
(setq ende (ssg-val sek "vf_ende"))
(cond
((null ende)
(vsp-fehler (strcat "Feld \"vf_ende\" fehlt - erlaubt: "
(vsp-werte-text *vsp-tab-ende2*)
", automatisch, zielpunkt-ohne-es")))
((or (= ende "zielpunkt-ohne-es") (= ende "automatisch")) nil)
(T
(vsp-code-raus *vsp-tab-ende2* ende "vf_ende")
(if (/= ende "ja-mit-es")
(vsp-raus "STR" (vsp-ja-code (ssg-val sek "vf_separator")))))))
;; Spec -> Vorwaerts-Journal. Rueckgabe: Journal, oder nil wenn die Spec
;; Fehler hat (dann stehen sie in *vsp-fehler*).
(defun vsp-journal (spec / sektionen i)
(setq *vsp-fehler* nil *vsp-tok* nil *vsp-erster-dl* T *vsp-wo* "Spec")
(cond
((null (vsp-kopf spec)) (vsp-fehler "Kopf-Objekt fehlt") nil)
(T
(vsp-praeambel (vsp-kopf spec))
(setq sektionen (vsp-sektionen spec) i 0)
(if (null sektionen) (vsp-fehler "Spec hat keine Sektionen"))
(foreach s sektionen
(setq i (1+ i))
(vsp-sektion (vsp-sek-felder s) (vsp-sek-subs s) (= i 1)))
(if *vsp-fehler* nil (reverse *vsp-tok*)))))
;; Nur pruefen, nichts bauen: liefert die Fehlerliste (nil = Spec in
;; Ordnung). Nutzt bewusst denselben Emitter - zwei getrennte Regelwerke
;; wuerden auseinanderlaufen.
(defun vsp-pruefen (spec)
(vsp-journal spec)
*vsp-fehler*)
;; ============================================================
;; TEIL 4: FLACHES JSON LESEN
;; ============================================================
;; ssg-load-json/ssg-parse-json-array liest ZEILENWEISE und FLACH: jedes "{"
;; beginnt ein Objekt, Verschachtelung ist unmoeglich, Zahlen-Arrays muessen
;; in EINER Zeile stehen. Darum dieselbe Form wie tests/testdata/hundm05.json:
;; ein Kopf-Objekt ("spec_id"), dann Sektionen ("glied") und deren Sub-Knoten
;; ("sub") in Reihenfolge. Erzeugt von lib/vf_spec_export.py.
(defun vsp-gruppieren (objekte / specs kopf sektionen sek subs)
(setq specs '() kopf nil sektionen '() sek nil subs '())
(foreach obj objekte
(cond
((ssg-val obj "spec_id")
;; offene Sektion und offene Spec abschliessen
(if sek (setq sektionen (cons (list sek (reverse subs)) sektionen)))
(setq sek nil subs '())
(if kopf (setq specs (cons (list kopf (reverse sektionen)) specs)))
(setq kopf obj sektionen '()))
((ssg-val obj "glied")
(if sek (setq sektionen (cons (list sek (reverse subs)) sektionen)))
(setq sek obj subs '()))
((ssg-val obj "sub")
(if sek
(setq subs (cons obj subs))
(princ (strcat "\n[VF_SPEC] WARNUNG: sub-Objekt ohne vorangehendes"
" glied - ignoriert"))))
(T nil)))
(if sek (setq sektionen (cons (list sek (reverse subs)) sektionen)))
(if kopf (setq specs (cons (list kopf (reverse sektionen)) specs)))
(reverse specs))
(defun vsp-json-laden (datei / daten)
(cond
((null (findfile datei))
(princ (strcat "\n[VF_SPEC] FEHLER: " datei " nicht gefunden."))
nil)
((null (setq daten (ssg-load-json datei)))
(princ (strcat "\n[VF_SPEC] FEHLER: " datei " nicht lesbar."
" Stehen die Zahlen-Arrays in EINER Zeile?"))
nil)
(T (vsp-gruppieren daten))))
;; ============================================================
;; TEIL 5: HEADLESS-RAHMEN
;; ============================================================
;; Drei Schalter plus zaehlende Stubs. Die Stubs sind das zweite Netz: der
;; Riegel *vfl-headless* deckt alle vfl-in-*-Wrapper ab, ein Prompt aus einem
;; Nebenpfad liefe daran vorbei. Jeder Stub-Aufruf erhoeht *vsp-prompts* -
;; der Zaehler ist der positive Beweis "kein Prompt erreicht" im Record.
;;
;; ssget/entsel werden BEWUSST nicht gestubbt: vf-next-number braucht
;; (ssget "X" ...), um die naechste freie VF-Nummer zu finden. Die einzige
;; ssget im Bau-Pfad sitzt in vfl-in-selection und ist ueber den Riegel
;; abgedeckt.
;;
;; OSMODE/ATTREQ/ATTDIA setzt der Aufrufer per ssg-start (siehe
;; c:VF_SPEC_BAU) - ohne ATTREQ/ATTDIA 0 fragt jedes (command "_.INSERT" ...)
;; nach Attributwerten und der Lauf haengt.
(defun vsp-stub-warnung (was)
(setq *vsp-prompts* (1+ *vsp-prompts*))
(princ (strcat "\n[VF_SPEC] WARNUNG: Live-Eingabe erreicht (" was ")"
" - Spec passt nicht zum Ablauf."))
nil)
(defun vsp-stub-getpoint (a b) (vsp-stub-warnung "getpoint"))
(defun vsp-stub-getstring (a) (vsp-stub-warnung "getstring"))
(defun vsp-stub-getint (a) (vsp-stub-warnung "getint"))
(defun vsp-stub-getreal (a) (vsp-stub-warnung "getreal"))
(defun vsp-stub-alert (msg)
(setq *vsp-prompts* (1+ *vsp-prompts*))
(princ (strcat "\n[VF_SPEC] ALERT (unterdrueckt): " (if msg msg "")))
(princ))
(defun vsp-headless-an ()
(setq *vsp-alt-getpoint* vfl-getpoint
*vsp-alt-getstring* getstring
*vsp-alt-getint* getint
*vsp-alt-getreal* getreal
*vsp-alt-alert* alert)
(setq vfl-getpoint vsp-stub-getpoint
getstring vsp-stub-getstring
getint vsp-stub-getint
getreal vsp-stub-getreal
alert vsp-stub-alert)
(setq *vsp-alt-wizard* (if (boundp '*vfl-wizard-mode*) *vfl-wizard-mode*))
(setq *vsp-alt-headless* (if (boundp '*vfl-headless*) *vfl-headless*))
(setq *vfl-wizard-mode* nil)
(setq *vfl-headless* T)
(if (car (atoms-family 1 '("SSG-GUI-AUS"))) (ssg-gui-aus))
(setq *vsp-prompts* 0)
(princ))
(defun vsp-headless-aus ()
(setq vfl-getpoint *vsp-alt-getpoint*
getstring *vsp-alt-getstring*
getint *vsp-alt-getint*
getreal *vsp-alt-getreal*
alert *vsp-alt-alert*)
(setq *vfl-wizard-mode* *vsp-alt-wizard*)
(setq *vfl-headless* *vsp-alt-headless*)
(if (car (atoms-family 1 '("SSG-GUI-AN"))) (ssg-gui-an))
(princ))
;; ============================================================
;; TEIL 6: ERGEBNIS-RECORD
;; ============================================================
;; Der Record traegt die Antwort auf "ist das die Kette der Vorlage?":
;; Status, Block, Einfuegepunkt, Attribute, offene Journal-Werte, Glied-Folge
;; (soll und ist), Prompt-Zaehler, Meldungen. Das vollstaendige Journal steht
;; NICHT im Record - es ist schon in der Spec und in der XDATA des gebauten
;; Blocks, eine dritte Kopie waere nur Ballast.
;;
;; Der Record ist eine Alist mit FESTER Feldreihenfolge: vsp-rec-neu legt
;; alle Felder an, vsp-set ersetzt eines. AutoLISP hat kein rplacd - subst
;; liefert eine NEUE Liste, der Aufrufer muss sie also zurueckbinden
;; (setq rec (vsp-set rec ...)).
(defun vsp-rec-neu (sid)
(list (cons "spec_id" sid)
;; kind unterscheidet die Objektarten in EINER Ergebnisdatei: die
;; Testdaten enthalten neben den Ketten auch andere Objekte der
;; Anlage (Kreisel u.a., siehe tests/test_hundm05.lsp).
(cons "kind" "linienzug")
(cons "status" "?")
(cons "dimension" "?")
(cons "block_name" nil)
(cons "block_handle" nil)
(cons "insert_point" nil)
(cons "eingaben_gesamt" 0)
(cons "eingaben_offen" 0)
(cons "glieder_soll" nil)
(cons "glieder_ist" nil)
(cons "journal_diff" nil)
(cons "prompts" 0)
(cons "meldungen" nil)
(cons "spec_fehler" nil)
(cons "fehler_text" nil)
(cons "attribs" nil)))
(defun vsp-set (rec name wert / paar)
(setq paar (assoc name rec))
(if paar
(subst (cons name wert) paar rec)
(progn
(princ (strcat "\n[VF_SPEC] WARNUNG: Record-Feld " name " unbekannt"))
rec)))
(defun vsp-json-escape (s / out i c)
(setq out "" i 1)
(while (<= i (strlen s))
(setq c (substr s i 1))
(setq out (cond ((= c "\"") (strcat out "\\\""))
((= c "\\") (strcat out "\\\\"))
((= c "\n") (strcat out " "))
(T (strcat out c))))
(setq i (1+ i)))
out)
(defun vsp-json-str (s)
(if s (strcat "\"" (vsp-json-escape s) "\"") "null"))
(defun vsp-json-liste (lst / s first)
(setq s "[" first T)
(foreach x lst
(if (not first) (setq s (strcat s ", ")))
(setq s (strcat s (vsp-json-str x)) first nil))
(strcat s "]"))
(defun vsp-json-int (v) (if (numberp v) (itoa (fix v)) "0"))
(defun vsp-punkt-text (p)
(if (and p (listp p) (>= (length p) 3))
(strcat (rtos (car p) 2 1) ", " (rtos (cadr p) 2 1) ", "
(rtos (caddr p) 2 1))
"0.0, 0.0, 0.0"))
(defun vsp-attrib-text (attribs / s first tag val)
(setq s "" first T)
(foreach att attribs
(setq tag (car att) val (cdr att))
(if (not first) (setq s (strcat s ",")))
(setq s (strcat s "\n " (vsp-json-str tag) ": "
(vsp-json-str (if val val ""))))
(setq first nil))
s)
(defun vsp-result-json (rec / json)
(setq json (strcat " {\n"
" \"spec_id\": " (vsp-json-str (ssg-val rec "spec_id")) ",\n"
" \"kind\": " (vsp-json-str (ssg-val rec "kind")) ",\n"
" \"status\": " (vsp-json-str (ssg-val rec "status")) ",\n"
" \"dimension\": " (vsp-json-str (ssg-val rec "dimension")) ",\n"
" \"block_name\": " (vsp-json-str (ssg-val rec "block_name")) ",\n"
" \"block_handle\": " (vsp-json-str (ssg-val rec "block_handle")) ",\n"
" \"insert_point\": [" (vsp-punkt-text (ssg-val rec "insert_point"))
"],\n"
" \"eingaben_gesamt\": " (vsp-json-int (ssg-val rec "eingaben_gesamt"))
",\n"
" \"eingaben_offen\": " (vsp-json-int (ssg-val rec "eingaben_offen"))
",\n"
" \"glieder_soll\": " (vsp-json-liste (ssg-val rec "glieder_soll"))
",\n"
" \"glieder_ist\": " (vsp-json-liste (ssg-val rec "glieder_ist"))
",\n"
" \"journal_diff\": " (vsp-json-str (ssg-val rec "journal_diff"))
",\n"
" \"prompts\": " (vsp-json-int (ssg-val rec "prompts")) ",\n"
" \"meldungen\": " (vsp-json-liste (ssg-val rec "meldungen"))
",\n"
" \"spec_fehler\": " (vsp-json-liste (ssg-val rec "spec_fehler"))
",\n"
" \"fehler_text\": " (vsp-json-str (ssg-val rec "fehler_text"))
",\n"
" \"actual_attributes\": {"))
(strcat json (vsp-attrib-text (ssg-val rec "attribs")) "\n }\n }"))
(defun vsp-results-schreiben (records datei / f first)
(setq f (open datei "w"))
(if (null f)
(progn (princ (strcat "\n[VF_SPEC] FEHLER: " datei " nicht schreibbar."))
nil)
(progn
(write-line "[" f)
(setq first T)
(foreach r records
(if (not first) (write-line "," f))
(write-line (vsp-result-json r) f)
(setq first nil))
(write-line "]" f)
(close f)
(princ (strcat "\n[VF_SPEC] " (itoa (length records))
" Ergebnis(se) -> " datei))
T)))
;; ============================================================
;; TEIL 7: BAUEN
;; ============================================================
;; Nicht verbrauchte Werte in der Replay-Queue (STEP-Marker zaehlen nicht -
;; die entstehen beim Replay neu).
(defun vsp-queue-rest ( / n)
(setq n 0)
(foreach e *vfl-replay-queue*
(if (/= (car e) "STEP") (setq n (1+ n))))
n)
(defun vsp-headless-fehler-text ( / f)
(if (and (boundp '*vfl-headless-fehler*) *vfl-headless-fehler*)
(progn
(setq f *vfl-headless-fehler*)
(strcat (cdr (assoc "was" f)) " @ " (cdr (assoc "ort" f))))
nil))
(defun vsp-dim-text ( / d)
(setq d (if (car (atoms-family 1 '("SSG-ILS-DIM-AKTUELL")))
(ssg-ils-dim-aktuell) nil))
(if d d "?"))
(defun vsp-lib-noetig-p ()
(or (not (boundp '*lib-initialized*)) (null *lib-initialized*)
(not (boundp 'bogen-auf)) (null bogen-auf)))
;; Block suchen: VORWAERTS ab dem Stand vor dem Bau. AutoLISP kennt kein
;; entprev, und (entlast) ist nach dem Bau nicht der Block - danach entstehen
;; noch Beschriftungstexte. Ohne Marker (ab-ent nil) wird die ganze Zeichnung
;; geprueft.
(defun vsp-block-suchen (pref ab-ent / ent found ed bn)
(setq ent (if (and ab-ent (entget ab-ent)) (entnext ab-ent) (entnext)))
(while ent
(setq ed (entget ent) bn (cdr (assoc 2 ed)))
(if (and ed (= (cdr (assoc 0 ed)) "INSERT") bn
(>= (strlen bn) (strlen pref))
(= (substr bn 1 (strlen pref)) pref))
(setq found ent))
(setq ent (entnext ent)))
found)
;; Glied-Folgen vergleichen. Rueckgabe: nil bei Gleichheit, sonst ein Text,
;; der die erste Abweichung nennt. Das ist der Desync-Detektor, der auch dann
;; greift, wenn die Queue zufaellig aufgeht: eine geometrisch abgewiesene
;; Sektion wirft keinen Fehler, sie verbraucht nur weniger Eintraege - die
;; Glied-Folge weicht dann aber ab.
(defun vsp-glieder-diff (soll ist / i a b diff)
(setq i 0 diff nil)
(while (and (null diff) (or soll ist))
(setq i (1+ i) a (car soll) b (car ist))
(if (not (= (if a a "") (if b b "")))
(setq diff (strcat "Glied " (itoa i) ": erwartet " (if a a "(nichts)")
", gebaut " (if b b "(nichts)")))
(setq soll (cdr soll) ist (cdr ist))))
diff)
;; Das aus der Spec erzeugte Journal gegen das beim Bau NEU aufgezeichnete
;; stellen. Beide muessen Token fuer Token gleich sein: der Replay gibt jeden
;; Wert an denselben Wrapper, der ihn wieder journalisiert - passt der Ablauf
;; zur Spec, entsteht dasselbe Journal.
;;
;; Das ist der SCHAERFSTE Desync-Detektor. Offene Queue-Werte und die
;; Glied-Folge zeigen nur grobe Abweichungen; ein einzelner Wert, der an der
;; falschen Stelle verbraucht wird, kann beide passieren lassen und trotzdem
;; andere Geometrie erzeugen. Rueckgabe: nil bei Gleichheit, sonst ein Text
;; mit der ersten Abweichung.
(defun vsp-journal-diff (soll ist / i a b diff)
(setq i 0 diff nil)
(while (and (null diff) (or soll ist))
(setq i (1+ i) a (car soll) b (car ist))
(cond
((null a) (setq diff (strcat "Token " (itoa i) ": Spec zu Ende, gebaut "
(vl-princ-to-string b))))
((null b) (setq diff (strcat "Token " (itoa i) ": erwartet "
(vl-princ-to-string a) ", gebaut nichts")))
((not (equal a b))
(setq diff (strcat "Token " (itoa i) ": erwartet "
(vl-princ-to-string a) ", gebaut "
(vl-princ-to-string b))))
(T (setq soll (cdr soll) ist (cdr ist)))))
diff)
;; Eine Kette aus einer Spec bauen. Rueckgabe: Ergebnis-Record (Alist).
;; Die Klammer um vf-linienzug-modus ist dieselbe wie in
;; tests/test_hm_recformat.lsp: *error* sichern, fangen, *error* zurueck. Weil
;; gefangen wird, laeuft der Abbruch-Handler der Modus-Funktion NICHT - eine
;; abgebrochene Kette bleibt also als lose Geometrie liegen und ist per
;; c:VF_SEKTION_RESTORE rettbar (vfl-segment-xdata-sichern hat pro Iteration
;; schon SSG_VF_EDIT_SEG/_PRE geschrieben).
(defun vsp-bau-aus-spec (spec / kopf sid journal rec vor-ent alt-error err
offen hl meld ist-glieder soll-glieder diff
ist-journal jdiff ent ed dim)
(setq kopf (vsp-kopf spec))
(setq sid (vsp-spec-id kopf))
(setq journal (vsp-journal spec))
(setq soll-glieder (if journal (vfl-journal-glieder journal) nil))
(setq rec (vsp-rec-neu sid))
(setq rec (vsp-set rec "spec_fehler" *vsp-fehler*))
(setq rec (vsp-set rec "glieder_soll" soll-glieder))
(setq rec (vsp-set rec "eingaben_gesamt" (if journal (length journal) 0)))
(princ (strcat "\n [SPEC] " sid))
(cond
;; --- Spec fehlerhaft: nichts bauen ---
((null journal)
(princ (strcat "\n " (itoa (length *vsp-fehler*))
" Spec-Fehler, nichts gebaut:"))
(foreach f *vsp-fehler* (princ (strcat "\n - " f)))
(setq rec (vsp-set rec "status" "spec-fehler"))
(setq rec (vsp-set rec "dimension" (vsp-dim-text)))
rec)
(T
;; Dimension je Kette neu setzen: der Abbruch-Handler in
;; vf-linienzug-modus setzt *ssg-ils-dim* zurueck, eine abgebrochene
;; Kette wuerde die folgenden sonst in der falschen Dimension bauen.
;; Vorrang: expliziter Lauf-Override (Testbefehle _2D/_3D) vor dem
;; Feld in der Spec. Ist keines gesetzt, gilt die Sitzung.
(setq dim (if (and (boundp '*vsp-dim-override*) *vsp-dim-override*)
*vsp-dim-override*
(ssg-val kopf "dim")))
(if dim (setq *ssg-ils-dim* dim))
(setq rec (vsp-set rec "dimension" (vsp-dim-text)))
(princ (strcat " -> " (itoa (length journal)) " Journal-Eintraege, "
(itoa (length soll-glieder)) " Glieder, Dimension "
(vsp-dim-text)))
(setq vor-ent (entlast))
(setq alt-error *error*)
(vfl-journal-reset)
(vfl-journal-replay-start journal)
(setq err (vl-catch-all-apply 'vf-linienzug-modus '()))
(setq offen (vsp-queue-rest))
;; Diagnose VOR dem Reset sichern (vfl-journal-reset loescht sie).
(setq ist-journal (reverse *vfl-journal*))
(setq ist-glieder (vfl-journal-glieder ist-journal))
(setq hl (vsp-headless-fehler-text))
(setq meld (if (boundp '*vfl-meldungen*) *vfl-meldungen* nil))
(setq *error* alt-error)
(vfl-journal-reset)
(setq rec (vsp-set rec "eingaben_offen" offen))
(setq rec (vsp-set rec "glieder_ist" ist-glieder))
(setq rec (vsp-set rec "prompts" *vsp-prompts*))
(setq rec (vsp-set rec "meldungen" meld))
(setq ent (vsp-block-suchen "VF_" vor-ent))
(if ent
(progn
(setq ed (entget ent))
(setq rec (vsp-set rec "block_name" (cdr (assoc 2 ed))))
(setq rec (vsp-set rec "block_handle" (cdr (assoc 5 ed))))
(setq rec (vsp-set rec "insert_point" (cdr (assoc 10 ed))))
(setq rec (vsp-set rec "attribs" (ssg-attrib-read ent)))))
(setq diff (vsp-glieder-diff soll-glieder ist-glieder))
(setq jdiff (vsp-journal-diff journal ist-journal))
(setq rec (vsp-set rec "journal_diff" jdiff))
(cond
(hl
(princ (strcat "\n DESYNC: " hl))
(setq rec (vsp-set rec "status" "desync"))
(setq rec (vsp-set rec "fehler_text" hl)))
((vl-catch-all-error-p err)
(princ (strcat "\n ABBRUCH: "
(vl-catch-all-error-message err)))
(setq rec (vsp-set rec "status" "abbruch"))
(setq rec (vsp-set rec "fehler_text"
(vl-catch-all-error-message err))))
((> offen 0)
(princ (strcat "\n DESYNC: " (itoa offen)
" Journal-Werte nicht verbraucht"))
(setq rec (vsp-set rec "status" "desync"))
(setq rec (vsp-set rec "fehler_text"
(strcat (itoa offen)
" Journal-Werte nicht verbraucht"))))
(diff
(princ (strcat "\n DESYNC: " diff))
(setq rec (vsp-set rec "status" "desync"))
(setq rec (vsp-set rec "fehler_text" diff)))
;; Feinster Detektor zuletzt: Queue geht auf, Glied-Folge stimmt -
;; aber ein Wert wurde an anderer Stelle verbraucht als geplant.
(jdiff
(princ (strcat "\n DESYNC (Journal): " jdiff))
(setq rec (vsp-set rec "status" "desync"))
(setq rec (vsp-set rec "fehler_text" jdiff)))
((null ent)
(princ "\n FEHLER: kein VF_-Block entstanden")
(setq rec (vsp-set rec "status" "abbruch"))
(setq rec (vsp-set rec "fehler_text" "kein VF_-Block entstanden")))
(meld
(princ (strcat "\n WARNUNG: " (itoa (length meld))
" Meldung(en) aus dem Bau"))
(foreach m meld (princ (strcat "\n - " m)))
(setq rec (vsp-set rec "status" "warnung")))
(T
(princ (strcat " -> Block " (cdr (assoc 2 (entget ent)))))
(setq rec (vsp-set rec "status" "executed"))))
rec)))
;; Mehrere Specs bauen. Der Headless-Rahmen wird EINMAL aussen gesetzt (siehe
;; c:VF_SPEC_BAU); die Schleife fangt je Kette, damit ein Fehler nach dem Bau
;; nicht die restlichen Ketten mitnimmt.
(defun vsp-bau-liste (specs / out rec sid)
(setq out '())
(foreach spec specs
(setq sid (vsp-spec-id (vsp-kopf spec)))
(setq rec (vl-catch-all-apply 'vsp-bau-aus-spec (list spec)))
(if (vl-catch-all-error-p rec)
(progn
(princ (strcat "\n [SPEC] " sid " - Ausnahme: "
(vl-catch-all-error-message rec)))
(setq rec (vsp-set (vsp-set (vsp-set (vsp-rec-neu sid)
"status" "abbruch")
"dimension" (vsp-dim-text))
"fehler_text" (vl-catch-all-error-message rec)))))
(setq out (cons rec out)))
(reverse out))
;; ============================================================
;; TEIL 8: BEFEHL
;; ============================================================
;; Fragt nichts. Spec-Datei aus DXFM_VF_SPEC, sonst
;; tests/testdata/hundm05.json (die Ketten der Anlage HundM);
;; tests/output.
;; ssg-ensure gibt es nur, wenn das Menue geladen wurde (SSG_LIB.mnl). Im
;; .scr-Testlauf laedt Lisp/ssg_load.lsp die Module direkt - dann fehlt der
;; Loader und der Aufruf darf nicht abbrechen.
(defun vsp-modul-sichern (modul)
(if (car (atoms-family 1 '("SSG-ENSURE")))
(vl-catch-all-apply 'ssg-ensure (list modul))))
(defun vsp-bilanz (records / ok rest)
(setq ok 0 rest 0)
(foreach r records
(if (= (ssg-val r "status") "executed")
(setq ok (1+ ok))
(setq rest (1+ rest))))
(princ (strcat "\n================================================"
"\n Ergebnis: " (itoa ok) " OK, " (itoa rest) " Fehler"
"\n================================================")))
;; Eine Spec-Datei bauen. Rueckgabe: Liste der Ergebnis-Records (nil, wenn
;; die Datei nicht lesbar war). Schreibt NICHTS - das entscheidet der
;; Aufrufer (der Befehl legt die Datei selbst ab, der Testrunner ueber
;; <name>:export-results). Genutzt von c:VF_SPEC_BAU UND von
;; tests/test_hundm05.lsp, damit es nur EINEN Weg gibt, der Geometrie aus
;; einer Spec erzeugt.
(defun vsp-bau-datei (datei / specs records alt-dim)
(vsp-modul-sichern "Gefaellestrecke")
(setq specs (vsp-json-laden datei))
(cond
((null specs)
(princ "\n[VF_SPEC] Keine Specs gelesen - Abbruch.")
nil)
(T
(ssg-start "VF_SPEC_BAU" '(("OSMODE") ("CECOLOR") ("ATTREQ") ("ATTDIA")))
;; Ohne ATTREQ/ATTDIA 0 fragt jedes (command "_.INSERT" ...) nach
;; Attributwerten - der wahrscheinlichste Haenger im Batch.
(setvar "OSMODE" 0)
(setvar "ATTREQ" 0)
(setvar "ATTDIA" 0)
(if (vsp-lib-noetig-p) (init-bibliothek))
(setq alt-dim (if (boundp '*ssg-ils-dim*) *ssg-ils-dim*))
(princ (strcat "\n " (itoa (length specs)) " Spec(s), Dimension "
(vsp-dim-text)))
(vsp-headless-an)
;; Die Stubs MUESSEN auch nach einem unerwarteten Fehler zurueck -
;; sonst bleiben getstring/getpoint/alert der Sitzung ersetzt.
(setq records (vl-catch-all-apply 'vsp-bau-liste (list specs)))
(vsp-headless-aus)
(setq *ssg-ils-dim* alt-dim)
(if (vl-catch-all-error-p records)
(progn
(princ (strcat "\n[VF_SPEC] FEHLER in der Spec-Schleife: "
(vl-catch-all-error-message records)))
(setq records '())))
(vsp-bilanz records)
(ssg-end)
records)))
;; Standard-Spec-Datei: DXFM_VF_SPEC, sonst die HundM-Ketten.
(defun vsp-standard-datei ( / datei)
(setq datei (getenv "DXFM_VF_SPEC"))
(if (or (null datei) (= datei ""))
(setq datei (strcat (getenv "DXFMAKRO") "/tests/testdata/hundm05.json")))
datei)
;; Ergebnis-Datei zur Spec-Datei: gleicher Basisname, Endung _results.json,
;; im Testausgabe-Verzeichnis. Damit schreibt ein Lauf mit hundm05.json nach
;; hundm05_results.json - dieselbe Datei, die der Testrunner erwartet, also
;; keine zweite Kopie derselben Ergebnisse.
;; NICHT DXFM_RESULTS als Verzeichnis: das sind die Sivas-/CSV-Exporte, dort
;; wuerde die Datei ausserhalb des Testbaums landen.
(defun vsp-ziel-datei (spec-datei / verz)
(setq verz (getenv "DXFM_VF_SPEC_OUT"))
(if (or (null verz) (= verz ""))
(setq verz (strcat (getenv "DXFMAKRO") "/tests/output")))
(strcat verz "/" (vl-filename-base spec-datei) "_results.json"))
(defun c:VF_SPEC_BAU ( / datei ziel records)
(setq datei (vsp-standard-datei))
(setq ziel (vsp-ziel-datei datei))
(princ (strcat "\n================================================"
"\n VF_SPEC_BAU - " datei
"\n================================================"))
(setq records (vsp-bau-datei datei))
(if records
(progn
(vl-mkdir (vl-filename-directory ziel))
(vsp-results-schreiben records ziel)))
(princ))
(princ "\n[vf_spec] geladen (VF_SPEC_BAU)")
(princ)
Reference in New Issue View Git Blame Copy Permalink