103 lines
3.6 KiB
Common Lisp
103 lines
3.6 KiB
Common Lisp
(defpackage :advtrains-serialize-lib
|
|
(:use :cl :parse-float)
|
|
(:nicknames :atsl)
|
|
(:export :from-file :from-stream :with-data-from-file))
|
|
(in-package :atsl)
|
|
|
|
(defmacro unescape (seq)
|
|
(alexandria:with-gensyms (replacef match)
|
|
`(flet ((,replacef (,match)
|
|
(string (ecase (char ,match 1)
|
|
(#\: #\:)
|
|
(#\n #\Newline)
|
|
(#\r #\Return)
|
|
(#\& #\&)))))
|
|
(cl-ppcre:regex-replace-all "&[:nr&]" ,seq #',replacef :simple-calls t))))
|
|
|
|
(defmacro string-to-value (seq table-allow)
|
|
(alexandria:with-gensyms (str datatype restdata)
|
|
`(let* ((,str ,seq)
|
|
(,datatype (char ,str 0))
|
|
(,restdata (subseq ,str 1)))
|
|
(ecase ,datatype
|
|
(#\T ,(if table-allow `'table `(error "table not allowed")))
|
|
(#\N (aux:parse-lua-number ,restdata))
|
|
(#\B (ecase (parse-integer ,restdata)
|
|
(0 nil)
|
|
(1 t)))
|
|
(#\S (unescape ,restdata))))))
|
|
|
|
(defmacro adjust-line (line)
|
|
`(string-right-trim '(#\Return) ,line))
|
|
|
|
(defmacro read-table-entry (line stream gett-f &key only)
|
|
(alexandria:with-gensyms (key value kv vt)
|
|
`(cl-ppcre:register-groups-bind
|
|
(,key ,value)
|
|
("^(.*[^&]):(.+)$" ,line)
|
|
(let ((,kv (string-to-value ,key nil))
|
|
(,vt (string-to-value ,value t)))
|
|
(if (and ,only (not (equal ,only ,kv)))
|
|
(values nil nil (if (equal ,vt 'table) (skip-table ,stream)))
|
|
(values t ,kv (if (equal ,vt 'table) (funcall ,gett-f ,stream) ,vt)))))))
|
|
|
|
(defmacro iterate-table-entries ((stream key val gett-f &key only) &body body)
|
|
(alexandria:with-gensyms (line use-entry-p)
|
|
(alexandria:once-only
|
|
(stream)
|
|
`(do ((,line (adjust-line (read-line ,stream nil))
|
|
(adjust-line (read-line ,stream nil))))
|
|
((or (null ,line) (string= ,line "E")))
|
|
(multiple-value-bind (,use-entry-p ,key ,val)
|
|
(read-table-entry ,line ,stream ,gett-f :only ,only)
|
|
(when ,use-entry-p ,@body))))))
|
|
|
|
(declaim (ftype (function (stream) null) skip-table))
|
|
(defun skip-table (stream)
|
|
;; note that this function partly duplicates parts of other functions/macros
|
|
(do ((line (adjust-line (read-line stream nil)) (adjust-line (read-line stream nil))))
|
|
((or (null line) (string= line "E")) nil)
|
|
(cl-ppcre:register-groups-bind
|
|
(v) ("^.*[^&]:(.).+$" line)
|
|
(if (string= v "T") (skip-table stream)))))
|
|
|
|
(declaim (ftype (function (stream &key (:only t)) list) read-table-as-alist))
|
|
(defun read-table-as-alist (stream &key only)
|
|
(let ((ht ()))
|
|
(iterate-table-entries
|
|
(stream kv vv #'read-table-as-alist :only only)
|
|
(let ((c (assoc kv ht :test #'equal)))
|
|
(if c
|
|
(setf (cdr c) vv)
|
|
(push (cons kv vv) ht))))
|
|
ht))
|
|
|
|
(declaim (ftype (function (stream &key (:only t)) hash-table) read-table-as-hash-table))
|
|
(defun read-table-as-hash-table (stream &key only)
|
|
(let ((ht (make-hash-table :test #'equal)))
|
|
(iterate-table-entries
|
|
(stream kv vv #'read-table-as-hash-table :only only)
|
|
(setf (gethash kv ht) vv))
|
|
ht))
|
|
|
|
(defmacro from-stream (stream restype &rest options)
|
|
(alexandria:with-gensyms (header sver)
|
|
(alexandria:once-only
|
|
(stream)
|
|
`(let* ((,header (adjust-line (read-line ,stream nil)))
|
|
(,sver (parse-integer (cl-ppcre:regex-replace "^LUA_SER v=([12])$" ,header "\\1"))))
|
|
(assert ,sver)
|
|
(,(ecase restype
|
|
(:alist 'read-table-as-alist)
|
|
(:hash-table 'read-table-as-hash-table))
|
|
,stream ,@options)))))
|
|
|
|
(defmacro from-file (filename restype &rest options)
|
|
(let ((stream (gensym)) (fn (gensym)))
|
|
`(let ((,fn ,filename))
|
|
(with-open-file (,stream ,fn)
|
|
(from-stream ,stream ,restype ,@options)))))
|
|
|
|
(defmacro with-data-from-file ((var &rest options) &body body)
|
|
`(let ((,var (from-file ,@options))) ,@body))
|