mistangl/dxfmakros
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
d0fe890d7c9a850ece7cf702705fa6839f451ea5
dxfmakros/Lisp/vf_spec.lsp
T
Michael StanglandClaude Opus 4.8 d0fe890d7c Start-Ausgabe entschlacken: per-Modul-Banner auf je eine Zeile kuerzen 
Der SSG_LIB-Start gab ~50 Zeilen aus (mehrzeilige >>> ...geladen <<<-Banner mit
Befehlslisten/Block-Pfaden, ===-Trenner, Core-Modul-Auflistung, VarioFoerderer-
Typenliste). Fuer einen einfachen _QNEW-Start zu viel Rauschen.

Gekuerzt (nur die dicksten Bloecke, je Modul bleibt EINE knappe Zeile;
Fehler/Warnungen ALLE unveraendert erhalten):
- Kern-Module (ssg_core/dbg/dialog/layer/id): reine "X geladen"-Zeilen entfernt.
- Feature-Module: KreiselInsert/Gefaellestrecke/VarioFoerderer je auf eine
  ">>> X geladen"-Zeile; Befehlslisten, Modus-/Typen-Aufzaehlungen, Block-Pfade
  und ===-Trenner raus. VF-Submodule (vf_konstanten/standard/etage/linienzug/
  spec) Lade-Banner ganz entfernt (der Sammel-Header deckt sie ab).
- SSG_LIB_Commands "Dummy-Befehle registriert" entfernt.
- menu/SSG_LIB.mnl: ===-Trenner + Core-Auflistung raus; die doppelte
  "Einfuege-Modus 3D"-Zeile entfernt (S:STARTUP gibt sie ohnehin einmal aus).

Behalten (informativ / diagnostisch): [CFG] Config geladen: N Sektionen,
[LANG] N Texte geladen, alle FEHLER/WARNUNG-Zeilen, die Abschlusszeilen
"Alle Module geladen. Menue aktiv." + "Einfuege-Modus: 3D".

Reine Ausgabe-Reduktion, keine Logik geaendert. 243/243 LISP-Unit-Tests gruen;
alle Module laden fehlerfrei (Klammerbalance gegen HEAD unveraendert).

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-09-18 22:13:33 +02:00

1134 lines
51 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")))
;; Vorwahl "Wie soll die Laenge der Gefaellestrecke bestimmt werden?"
;; (vfl-menu in vf-linienzug-modus, wahl="Linie-GF"). Die innere Wahl im
;; Steigend-Sonderfall (Endpunkt/Hoehe) nutzt dieselbe Tabelle - dort sind
;; nur die Codes "1"/"2" gueltig, "steigend" kommt dort nie vor.
(setq *vsp-tab-gf-laenge-modus* '(("endpunkt" . "1") ("hoehe" . "2")
("steigend" . "3")))
(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")))
;; Richtungswahl fuer "auf-ab", wenn die Kette bereits FLACH ankommt
;; (vfl-frage-auf-ab-richtung: "1"=Auf, "2"=Ab) - siehe vsp-vf-einheit.
(setq *vsp-tab-richtung* '(("auf" . "1") ("ab" . "2")))
(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 (Kettenanfang) und bekommt 6 Optionen - GF-Bogen UND Vario-Kurve
;; sind seit der "Fortsetzung einer bestehenden Teilkette"-Erweiterung
;; (vf_linienzug.lsp, vfl-naechstes-element-header-Zweig ohne frame) AUCH am
;; Kettenanfang waehlbar (Referenzrichtung kommt dann aus einem KS_AUS am
;; Startpunkt statt aus einem Frame) - NICHT mehr nur 4 Optionen wie fruecher.
;; Jede spaetere Sektion (Frame existiert bereits) hat weiterhin 5 Optionen
;; (GF-Bogen ist dort IMMER Option 1, kein Vario-Kurve-Sonderfall noetig - eine
;; Vario-Kurve wird dort ueber die VF-Einheit selbst erreicht). Beide Tabellen
;; MUESSEN exakt zur Options-Reihenfolge in vf-linienzug-modus passen (siehe
;; dortiger Kommentar "Kettenanfang: 6 Optionen statt 4") - ein Regressions-Fund
;; 2026-09-12 (TEST_HUNDM05 baute "GF-Bogen" statt "Linie-GF" als erstes Glied,
;; weil diese Tabelle noch die alte 4-Optionen-Zuordnung hatte).
(setq *vsp-menu-start* '(("GF-Bogen" . "1") ("Vario-Kurve" . "2")
("Linie-GF" . "3") ("Linie-VF" . "4")
("Horizontal-VF" . "5") ("Linie" . "6")))
(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))
;; Ausgabe-Flag von vsp-sektion (siehe dort): T, wenn eine "Linie-GF"-Sektion
;; mit ende="ja-mit-es" die NAECHSTE Sektion (das ES-Glied) bereits inline
;; mitverarbeitet hat - vsp-journal ueberspringt sie dann beim Weiterzaehlen.
(if (not (boundp '*vsp-es-verbraucht*)) (setq *vsp-es-verbraucht* 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 optional die gesnappte Fahrtrichtung. Feldpraesenz
;; entscheidet, NICHT *vsp-erster-dl*: die eingefrorene Aufzeichnung
;; (hm_recformat.json) journalisiert die Richtung nur beim allerersten
;; Segment der ganzen Kette, der heutige Ablauf (linienzug_tests.json/
;; -stufe2.json, 2026-09-12) dagegen bei JEDEM Segment neu, auch nach einer
;; Vario-Kurve oder einem neuen Glied. Beim ALLERERSTEN Segment MUSS die
;; Richtung dabeistehen (die Kette hat noch keine geerbte).
(defun vsp-linie (quelle / hz)
(vsp-zahl "DL" (ssg-val quelle "dl") "dl")
(setq hz (ssg-val quelle "hz"))
(cond
((and *vsp-erster-dl* (null hz))
(vsp-fehler "Feld \"hz\" fehlt (Pflicht beim ersten Segment der Kette)"))
(hz
(vsp-zahl "REAL" hz "hz")))
(setq *vsp-erster-dl* nil))
;; Reine Richtungswahl OHNE Laenge (vfl-in-richtung: journalisiert NUR REAL,
;; kein DL-Token) - fuer den Kettenanfang-Fall der Zielhoehe-zuerst-Zweige
;; ("Linie-GF" modus="hoehe"/"steigend"+"hoehe"), wo noch keine Laenge
;; bekannt ist. Nur beim allerersten Segment der Kette relevant (sonst gar
;; kein Aufruf, siehe Aufrufer) - toggelt *vsp-erster-dl* wie vsp-linie.
(defun vsp-richtung (quelle)
(vsp-zahl "REAL" (ssg-val quelle "hz") "hz (Richtungswahl, kein DL noetig)")
(setq *vsp-erster-dl* nil))
;; 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")))
;; Stufe-2-Fallback (vfl-frage-gf2-minimum in vf_linienzug.lsp): steht nur im
;; Journal, wenn die am Kettenende automatisch berechnete GF2-Laenge UNTER
;; der ueblichen Mindestlaenge liegt (Stufe 1 - Winkeltabelle - hat dann
;; keinen gueltigen Kandidaten geliefert). "ja" = mit der exakt berechneten
;; (kuerzeren) Laenge bauen, "nein" = auf die Mindestlaenge auffuellen. Faellt
;; die Frage nicht an, kein Journal-Eintrag - wie vsp-winkel-idx.
(defun vsp-gf2-bestaetigung (quelle / v)
(setq v (ssg-val quelle "gf2_exakt_bauen"))
(if v (vsp-raus "STR" (vsp-ja-code v))))
;; Ziel-Hoehe fuer den GF1-Einlauf einer mit "Horizontal-VF" eroeffneten
;; VF-Einheit (vfl-prompt-hoehe-eingang-gf1). Optional, weil die Frage NUR
;; kommt, wenn der Eingang komplett neu gebaut wird - das ist der Fall, den
;; vfl-eingang-modus-bestimmen mit nil beantwortet: echter Kettenanfang MIT
;; AS-Element bzw. Anschluss an eine fertige VF-Einheit ("letzter-typ"="VF"),
;; und am Kettenanfang OHNE AS auch dann, wenn der KS_AUS-Scan die GF-Familie
;; erkennt oder der Nutzer die 3-Optionen-Rueckfrage mit "2" beantwortet.
;; Folgt die Sektion dagegen auf GF/Separator/Vario-Kurve, gibt es kein neues
;; GF1 und damit keine Frage - dann fehlt das Feld. Ob der Fall ansteht, haengt
;; am Zustand der Zeichnung und kann hier nicht berechnet werden; die Spec sagt
;; es, geraten wird nichts.
;; "auto" (statt einer Zahl): die Frage kommt zwar (siehe oben), aber es
;; wird bewusst KEINE Zahl vorgegeben - genau wie eine leere Konsolen-
;; Eingabe (getreal liefert dann nil) laesst das den Bauablauf seinen
;; eigenen, aus dem Fussabdruck der festen Elemente berechneten Vorschlag
;; nehmen (vfl-baue-horizontal-koerper-Aufrufstelle: "(if (null hoehe-neu)
;; (setq hoehe-neu (- (caddr p-aktuell) fest-drop)))"). Dafuer wird ein
;; "NIL"-Token (Wert nil) statt "REAL" ausgegeben - vfl-replay-pop liefert
;; dafuer (nil) zurueck, was vfl-in-value als "keine Antwort" erkennt und
;; genauso behandelt wie eine leere Live-Eingabe.
(defun vsp-eingang-hoehe (quelle / v)
(setq v (ssg-val quelle "eingang_hoehe"))
(cond
((null v) nil)
((and (= (type v) 'STR) (= (strcase v) "AUTO")) (vsp-raus "NIL" nil))
(T (vsp-zahl "REAL" v "eingang_hoehe"))))
(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"))))
;; naechste: Felder der NAECHSTEN Top-Level-Sektion (oder nil) - wird nur fuer
;; "Linie-GF" gebraucht (siehe dort). *vsp-es-verbraucht* (Ausgabe-Flag, vom
;; Aufrufer vsp-journal gelesen): T, wenn diese Sektion die naechste (das
;; ES-Glied) bereits mitverarbeitet hat - der Aufrufer muss sie dann beim
;; Weiterzaehlen ueberspringen.
(defun vsp-sektion (sek subs erster naechste / label tab code art modus smodus ende-wert)
(setq *vsp-es-verbraucht* nil)
(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")
;; Vorwahl "laenge_modus" (endpunkt/hoehe/steigend, Default
;; "endpunkt" - deckt alte Specs ohne dieses Feld ab, identisch
;; zum bisherigen alleinigen Ablauf). "steigend" ist der
;; Sonderfall (GF bis 3 Grad steigend, KEIN Separator, eigene
;; innere Endpunkt/Hoehe-Wahl "steigend_modus"). Die DL(+hz)-
;; Eingabe (vsp-linie) faellt bei "hoehe"/"steigend"+"hoehe" NUR
;; beim allerersten Segment der Kette an (Kettenanfang braucht
;; einen Pick fuer die freie Richtung; jedes weitere Segment erbt
;; die Richtung vom Vorgaenger ohne eigenen Pick) - siehe erster.
(setq modus (ssg-val sek "laenge_modus"))
(if (null modus) (setq modus "endpunkt"))
(vsp-code-raus *vsp-tab-gf-laenge-modus* modus "laenge_modus")
;; NEU (2026-09-12): "Ist das Kettenende?" wird im Bau-Ablauf jetzt
;; SOFORT nach der Laenge-Modus-Wahl gefragt (vor Separator/
;; Gefaelle) - vorher lief die Frage erst nach dem Bau. Bei
;; "ja-mit-es" fragt vf-linienzug-modus DIREKT im Anschluss auch
;; ES-Winkel/-Seite (damit deren Fussabdruck schon in die
;; Laengenberechnung eingeht) - die Spec beschreibt das ES-Element
;; aber weiterhin als EIGENE, nachfolgende Sektion (glied="ES",
;; siehe dort) fuer bessere Lesbarkeit. vsp-journal muss die beiden
;; Tokengruppen daher HIER zusammenziehen: "ende" + (bei ja-mit-es)
;; die Winkel/Seite-Tokens der naechsten Sektion, vorgezogen. Die
;; eigentliche ES-Sektion wird dadurch bereits vollstaendig
;; verbraucht - vsp-journal ueberspringt sie danach (siehe
;; *vsp-es-verbraucht*), sonst kaemen ihre Tokens ein zweites Mal.
(setq ende-wert (ssg-val sek "ende"))
(vsp-code-raus *vsp-tab-ende3* ende-wert "ende")
(if (= ende-wert "ja-mit-es")
(cond
((null naechste)
(vsp-fehler "ende=\"ja-mit-es\", aber keine folgende ES-Sektion vorhanden"))
((/= (ssg-val naechste "glied") "ES")
(vsp-fehler "ende=\"ja-mit-es\" erwartet eine direkt folgende Sektion mit glied=\"ES\""))
(T
(vsp-wert-str (ssg-val naechste "winkel") "winkel (ES, vorgezogen)")
(vsp-code-raus *vsp-tab-seite* (ssg-val naechste "seite") "seite (ES, vorgezogen)")
(setq *vsp-es-verbraucht* T))))
(cond
((= modus "steigend")
(setq smodus (ssg-val sek "steigend_modus"))
(if (null smodus) (setq smodus "endpunkt"))
(vsp-code-raus *vsp-tab-gf-laenge-modus* smodus "steigend_modus")
(if (= smodus "endpunkt")
(vsp-linie sek)
(if erster (vsp-richtung sek)))
(if (= smodus "hoehe")
(vsp-zahl "REAL" (ssg-val sek "hoehe") "hoehe"))
(vsp-zahl "REAL" (ssg-val sek "winkel") "winkel"))
((= modus "hoehe")
(if erster (vsp-richtung sek))
(vsp-raus "STR" (vsp-ja-code (ssg-val sek "sep_vor")))
(vsp-raus "STR" (vsp-ja-code (ssg-val sek "sep_nach")))
(vsp-zahl "REAL" (ssg-val sek "hoehe") "hoehe")
(vsp-zahl "REAL" (ssg-val sek "winkel") "winkel"))
(T ;; "endpunkt"
(vsp-linie sek)
(vsp-raus "STR" (vsp-ja-code (ssg-val sek "sep_vor")))
(vsp-raus "STR" (vsp-ja-code (ssg-val sek "sep_nach")))
(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")))
)
)
((= 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-eingang-hoehe 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)
;; GF-Verteilung: beim horizontalen Erstkoerper wird sie NICHT gefragt - die
;; Aufrufstelle in vf-linienzug-modus gibt "2" (alles am Einlauf) fest vor
;; (vfl-vf-einheit-abschluss, Argument gf-verteilung-fest), weil L_GF dort nur
;; der strukturelle Mindest-Eingang ist. Ein "gf_verteilung"-Feld an einer
;; Horizontal-VF-Sektion bleibt darum wirkungslos (alte Specs tragen es noch).
(if (not erst-hor)
(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")))
;; Mit ES: Winkel+Seite werden SCHON HIER erfragt (vfl-frage-es-seite,
;; inkl. eigenem STEP-Marker) und nicht erst im Abschluss - sie
;; bestimmen den ES-Fussabdruck, der in die Streckenzerlegung eingeht.
;; Darum stehen sie am sub und nicht in einer eigenen ES-Sektion.
(if (vsp-ja-p (ssg-val sub "es"))
(progn
(vsp-raus "STEP" "ES")
(vsp-wert-str (ssg-val sub "es_winkel") "es_winkel")
(vsp-code-raus *vsp-tab-seite* (ssg-val sub "es_seite") "es_seite")))
(vsp-linie sub)
(vsp-zahl "REAL" (ssg-val sub "hoehe") "hoehe")
(vsp-winkel-idx sub)
(vsp-gf2-bestaetigung 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)
;; Zwei Auspraegungen, unterschieden per Feldpraesenz (kein
;; separates Modus-Flag noetig - "richtung" IST die Aussage):
;; kommt die Kette schon FLACH an (vfl-frame-flach-p), fragt
;; vf-linienzug-modus NICHT nach einer Zielhoehe, sondern nach der
;; Richtung (Auf/Ab) und waehlt den Winkel aus einer Kandidaten-
;; tabelle (vfl-waehle-winkel-hoehen-tabelle) - winkel_idx dabei
;; wie bei GF-Bogen/Vario-Kurve nur, wenn mehrere Kandidaten
;; gueltig waren. Kommt sie NICHT flach an (die urspruengliche,
;; einzige Auspraegung), wird weiterhin direkt eine Zielhoehe
;; erfragt. Welcher Fall ansteht, haengt am Zustand der Zeichnung
;; und wird hier nicht geraten - die Spec sagt es ueber die
;; Anwesenheit von "richtung".
(if (ssg-val sub "richtung")
(progn
(vsp-code-raus *vsp-tab-richtung* (ssg-val sub "richtung")
"richtung")
(vsp-winkel-idx sub))
(progn
(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*).
;; Index-basierte Schleife (statt foreach) - noetig, damit "Linie-GF" bei
;; ende="ja-mit-es" die naechste Sektion (das ES-Glied) vorziehen UND danach
;; ueberspringen kann (siehe vsp-sektion/*vsp-es-verbraucht*).
(defun vsp-journal (spec / sektionen n i s naechste)
(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))
(setq n (length sektionen))
(if (null sektionen) (vsp-fehler "Spec hat keine Sektionen"))
(setq i 0)
(while (< i n)
(setq s (nth i sektionen))
(setq naechste (if (< (1+ i) n) (vsp-sek-felder (nth (1+ i) sektionen)) nil))
(vsp-sektion (vsp-sek-felder s) (vsp-sek-subs s) (= i 0) naechste)
(setq i (+ i (if *vsp-es-verbraucht* 2 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)
(princ)
Reference in New Issue View Git Blame Copy Permalink