ywatds/serialize-lib.lisp

94 lines
2.9 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)
(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)))
(values ,kv (if (equal ,vt 'table)
(funcall ,gett-f ,stream)
,vt))))))
(defmacro iterate-table-entries ((stream key val gett-f) &body body)
(alexandria:with-gensyms (line)
(alexandria:once-only
(stream)
`(do ((,line (adjust-line (read-line ,stream nil))
(adjust-line (read-line ,stream nil))))
((or (null ,line) (equal ,line "E")))
(multiple-value-bind (,key ,val)
(read-table-entry ,line ,stream ,gett-f)
,@body)))))
(declaim (ftype (function (stream) list) read-table-as-alist))
(defun read-table-as-alist (stream)
(let ((ht ()))
(iterate-table-entries
(stream kv vv #'read-table-as-alist)
(let ((c (assoc kv ht :test #'equal)))
(if c
(setf (cdr c) vv)
(push (cons kv vv) ht))))
ht))
(declaim (ftype (function (stream) hash-table) read-table-as-hash-table))
(defun read-table-as-hash-table (stream)
(let ((ht (make-hash-table :test #'equal)))
(iterate-table-entries
(stream kv vv #'read-table-as-hash-table)
(setf (gethash kv ht) vv))
ht))
(defmacro from-stream (stream restype)
(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)))))
(defmacro from-file (filename restype)
(let ((stream (gensym)) (fn (gensym)))
`(let ((,fn ,filename))
(with-open-file (,stream ,fn)
(from-stream ,stream ,restype)))))
(defmacro with-data-from-file ((var &rest options) &body body)
`(let ((,var (from-file ,@options))) ,@body))