[ADD] Erste Einbindung eines Menüs zum Konfigurieren und Einfügen von Gerüstkomponenten; TODOs: Anzahl der Gerüstkompnenten Variabel machen und für den Benutzer die Anzahl der Baugruppe sichtbar machen; Vorkonfigurierte Baugruppen anbieten; Einfachere Auswahl mit Checkbox oder Input (Anzahl)
This commit is contained in:
Simon Hensch
@@ -1561,6 +1561,213 @@
|
||||
)
|
||||
|
||||
|
||||
;; ------------------------------------------------------------
|
||||
;; STRING-LISTE VERKETTEN
|
||||
;; ------------------------------------------------------------
|
||||
;; (ssg-join '("a" "b" "c") ",") -> "a,b,c"; leere Liste -> "".
|
||||
;; Alle Elemente muessen Strings sein (Zahlen vorher mit itoa/rtos wandeln).
|
||||
(defun ssg-join (lst sep / s erst)
|
||||
(setq s "" erst T)
|
||||
(foreach x lst
|
||||
(if erst
|
||||
(setq s x erst nil)
|
||||
(setq s (strcat s sep x))
|
||||
)
|
||||
)
|
||||
s
|
||||
)
|
||||
|
||||
|
||||
;; ------------------------------------------------------------
|
||||
;; REKURSIVER JSON-PARSER
|
||||
;; ------------------------------------------------------------
|
||||
;; Ergaenzung zu ssg-parse-json-array/ssg-cfg-parse-nested, die BEIDE
|
||||
;; zeilenbasiert und flach arbeiten und daher prinzipiell weder echte
|
||||
;; Verschachtelung noch mehrzeilige Arrays, maskierte Anfuehrungszeichen
|
||||
;; (\") oder Kommas innerhalb von Strings lesen koennen. Die beiden alten
|
||||
;; Parser bleiben unveraendert - ihre Konsumenten (Konfiguration, Sprache,
|
||||
;; VF-Spec) sind auf ihr Verhalten eingestellt.
|
||||
;;
|
||||
;; Abbildung: Objekt -> Alist (("key" . wert) ...), Array -> Liste,
|
||||
;; String -> STR, Zahl -> INT/REAL, true -> T, false/null -> nil.
|
||||
;; Da false und null beide nil ergeben, ist "Feld fehlt" nicht von
|
||||
;; "Feld ist false" unterscheidbar.
|
||||
;; \uXXXX wird nur fuer ASCII (< 128) aufgeloest, sonst "?" - echte
|
||||
;; Umlaute stehen in unseren Daten direkt als UTF-8 in der Datei.
|
||||
|
||||
(defun ssg-json-zeichen ( / )
|
||||
(if (<= *ssg-json-pos* *ssg-json-len*)
|
||||
(substr *ssg-json-txt* *ssg-json-pos* 1)
|
||||
)
|
||||
)
|
||||
|
||||
(defun ssg-json-weiter ( / )
|
||||
(setq *ssg-json-pos* (1+ *ssg-json-pos*))
|
||||
)
|
||||
|
||||
(defun ssg-json-leerraum ( / c)
|
||||
(while (and (setq c (ssg-json-zeichen))
|
||||
(member c '(" " "\t" "\r" "\n")))
|
||||
(ssg-json-weiter)
|
||||
)
|
||||
)
|
||||
|
||||
;; String ab dem oeffnenden Anfuehrungszeichen lesen, Escapes aufloesen.
|
||||
(defun ssg-json-string ( / c erg fertig code)
|
||||
(ssg-json-weiter)
|
||||
(setq erg "" fertig nil)
|
||||
(while (and (not fertig) (setq c (ssg-json-zeichen)))
|
||||
(cond
|
||||
((= c "\"") (setq fertig T) (ssg-json-weiter))
|
||||
((= c "\\")
|
||||
(ssg-json-weiter)
|
||||
(setq c (ssg-json-zeichen))
|
||||
;; equal statt = : nach dem Backslash kann das Textende erreicht sein
|
||||
;; (c = nil), und = ist mit nil-Argumenten nicht zuverlaessig.
|
||||
(cond
|
||||
((equal c "n") (setq erg (strcat erg "\n")) (ssg-json-weiter))
|
||||
((equal c "t") (setq erg (strcat erg "\t")) (ssg-json-weiter))
|
||||
((equal c "r") (setq erg (strcat erg "\r")) (ssg-json-weiter))
|
||||
;; AutoLISP kennt nur \\ \" \e \n \r \t - Backspace/Seitenvorschub
|
||||
;; daher ueber chr statt als Escape-Literal.
|
||||
((equal c "b") (setq erg (strcat erg (chr 8))) (ssg-json-weiter))
|
||||
((equal c "f") (setq erg (strcat erg (chr 12))) (ssg-json-weiter))
|
||||
((equal c "u")
|
||||
(ssg-json-weiter)
|
||||
(setq code (ssg-json-hex4))
|
||||
(setq erg (strcat erg (if (< code 128) (chr code) "?")))
|
||||
)
|
||||
;; \" \\ \/ und alles andere: Zeichen unveraendert uebernehmen
|
||||
(c (setq erg (strcat erg c)) (ssg-json-weiter))
|
||||
)
|
||||
)
|
||||
(T (setq erg (strcat erg c)) (ssg-json-weiter))
|
||||
)
|
||||
)
|
||||
erg
|
||||
)
|
||||
|
||||
;; Vier Hex-Ziffern lesen und als Zahl liefern (Position rueckt mit).
|
||||
(defun ssg-json-hex4 ( / i c code ziffer)
|
||||
(setq code 0 i 0)
|
||||
(while (< i 4)
|
||||
(setq c (ssg-json-zeichen))
|
||||
(if c
|
||||
(progn
|
||||
(setq ziffer
|
||||
(cond
|
||||
((and (>= (ascii c) 48) (<= (ascii c) 57)) (- (ascii c) 48))
|
||||
((and (>= (ascii c) 97) (<= (ascii c) 102)) (+ 10 (- (ascii c) 97)))
|
||||
((and (>= (ascii c) 65) (<= (ascii c) 70)) (+ 10 (- (ascii c) 65)))
|
||||
(T 0)
|
||||
)
|
||||
)
|
||||
(setq code (+ (* code 16) ziffer))
|
||||
(ssg-json-weiter)
|
||||
)
|
||||
(setq i 4)
|
||||
)
|
||||
(setq i (1+ i))
|
||||
)
|
||||
code
|
||||
)
|
||||
|
||||
;; Zahl bzw. true/false/null bis zum naechsten Trennzeichen lesen.
|
||||
(defun ssg-json-literal ( / start s c)
|
||||
(setq start *ssg-json-pos*)
|
||||
(while (and (setq c (ssg-json-zeichen))
|
||||
(not (member c '("," "}" "]" " " "\t" "\r" "\n"))))
|
||||
(ssg-json-weiter)
|
||||
)
|
||||
(setq s (substr *ssg-json-txt* start (- *ssg-json-pos* start)))
|
||||
(cond
|
||||
((= s "true") T)
|
||||
((= s "false") nil)
|
||||
((= s "null") nil)
|
||||
((vl-string-search "." s) (atof s))
|
||||
(T (atoi s))
|
||||
)
|
||||
)
|
||||
|
||||
(defun ssg-json-objekt ( / erg key c vorher)
|
||||
(ssg-json-weiter)
|
||||
(setq erg nil)
|
||||
(ssg-json-leerraum)
|
||||
(while (and (setq c (ssg-json-zeichen)) (/= c "}"))
|
||||
(setq vorher *ssg-json-pos*)
|
||||
(if (= c "\"")
|
||||
(progn
|
||||
(setq key (ssg-json-string))
|
||||
(ssg-json-leerraum)
|
||||
(if (equal (ssg-json-zeichen) ":") (ssg-json-weiter))
|
||||
(setq erg (cons (cons key (ssg-json-wert)) erg))
|
||||
)
|
||||
;; Komma oder unerwartetes Zeichen ueberspringen
|
||||
(ssg-json-weiter)
|
||||
)
|
||||
(ssg-json-leerraum)
|
||||
;; Schutz gegen Endlosschleife bei fehlerhafter Datei: kommt die Position
|
||||
;; nicht voran, wird zwangsweise weitergerueckt. Ein haengendes BricsCAD
|
||||
;; waere schlimmer als ein unvollstaendig gelesenes Objekt.
|
||||
(if (= vorher *ssg-json-pos*) (ssg-json-weiter))
|
||||
)
|
||||
(if (equal (ssg-json-zeichen) "}") (ssg-json-weiter))
|
||||
(reverse erg)
|
||||
)
|
||||
|
||||
(defun ssg-json-array ( / erg c vorher)
|
||||
(ssg-json-weiter)
|
||||
(setq erg nil)
|
||||
(ssg-json-leerraum)
|
||||
(while (and (setq c (ssg-json-zeichen)) (/= c "]"))
|
||||
(setq vorher *ssg-json-pos*)
|
||||
(if (= c ",")
|
||||
(ssg-json-weiter)
|
||||
(setq erg (cons (ssg-json-wert) erg))
|
||||
)
|
||||
(ssg-json-leerraum)
|
||||
(if (= vorher *ssg-json-pos*) (ssg-json-weiter))
|
||||
)
|
||||
(if (equal (ssg-json-zeichen) "]") (ssg-json-weiter))
|
||||
(reverse erg)
|
||||
)
|
||||
|
||||
(defun ssg-json-wert ( / c)
|
||||
(ssg-json-leerraum)
|
||||
(setq c (ssg-json-zeichen))
|
||||
(cond
|
||||
((null c) nil)
|
||||
((= c "{") (ssg-json-objekt))
|
||||
((= c "[") (ssg-json-array))
|
||||
((= c "\"") (ssg-json-string))
|
||||
(T (ssg-json-literal))
|
||||
)
|
||||
)
|
||||
|
||||
;; JSON-Text parsen. Rueckgabe: Struktur (siehe Abbildung oben).
|
||||
(defun ssg-json-parse (text / erg)
|
||||
(setq *ssg-json-txt* text
|
||||
*ssg-json-len* (strlen text)
|
||||
*ssg-json-pos* 1)
|
||||
(setq erg (ssg-json-wert))
|
||||
;; Quelltext nicht global stehen lassen - eine Datendatei haelt sonst
|
||||
;; dauerhaft mehrere KB in einer globalen Variablen fest.
|
||||
(setq *ssg-json-txt* nil *ssg-json-len* 0 *ssg-json-pos* 1)
|
||||
erg
|
||||
)
|
||||
|
||||
;; JSON-Datei parsen. Rueckgabe: Struktur oder nil, wenn die Datei fehlt.
|
||||
(defun ssg-json-laden (datei / zeilen)
|
||||
(setq zeilen (ssg-read-file-lines datei))
|
||||
(if zeilen (ssg-json-parse (ssg-join zeilen "\n")))
|
||||
)
|
||||
|
||||
;; Feld eines geparsten JSON-Objekts lesen.
|
||||
(defun ssg-json-get (obj key)
|
||||
(cdr (assoc key obj))
|
||||
)
|
||||
|
||||
|
||||
;; Verschachteltes JSON-Objekt parsen (1 Ebene tief)
|
||||
;; {"section": {"key": val, ...}, ...}
|
||||
;; -> (("section" ("key" . val) ...) ...)
|
||||
|
||||
Reference in New Issue
Block a user