47 lines
1.5 KiB
Common Lisp
47 lines
1.5 KiB
Common Lisp
|
(defpackage :advtrains-interlocking
|
||
|
|
(:use :cl)
|
||
|
|
(:nicknames :atil)
|
||
|
|
(:export :import-data))
|
||
|
|
(in-package :atil)
|
||
|
|
|
||
|
|
(defstruct tcbdata
|
||
|
|
(ts nil :type (or string null))
|
||
|
|
(signal-pos nil :type (or aux:v3d null)))
|
||
|
|
|
||
|
|
(defstruct tcb
|
||
|
|
(pos (error "no position specified") :type aux:v3d)
|
||
|
|
(side-a (error "TCB has no side A") :type tcbdata)
|
||
|
|
(side-b (error "TCB has no side B") :type tcbdata))
|
||
|
|
|
||
|
|
(defmethod print-object ((obj tcb) stream)
|
||
|
|
(let ((*standard-output* stream))
|
||
|
|
(with-accessors ((pos tcb-pos) (a tcb-side-a) (b tcb-side-b)) obj
|
||
|
|
(print-unreadable-object (obj stream)
|
||
|
|
(format stream "TCB AT ~a " pos)
|
||
|
|
(pprint-newline :mandatory)
|
||
|
|
(pprint-indent :current 0)
|
||
|
|
(format stream "SIDE A ~a " a)
|
||
|
|
(pprint-newline :mandatory)
|
||
|
|
(format stream "SIDE B ~a" b)))))
|
||
|
|
|
||
|
|
(defmacro read-tcb-side (side)
|
||
|
|
(alexandria:with-gensyms (ts)
|
||
|
|
(alexandria:once-only
|
||
|
|
(side)
|
||
|
|
`(let ((,ts (gethash "ts_id" ,side nil)))
|
||
|
|
(make-tcbdata :ts ,ts
|
||
|
|
:signal-pos (ignore-errors (aux:hash-table-to-v3d (gethash "signal" ,side))))))))
|
||
|
|
|
||
|
|
(defun import-data (fn)
|
||
|
|
(let ((ht (atsl:from-file fn :hash-table)))
|
||
|
|
(let ((tcbs (aux:adj-vector-of 'tcb)))
|
||
|
|
(loop
|
||
|
|
for poss being each hash-key of (gethash "tcbs" ht)
|
||
|
|
using (hash-value tcb)
|
||
|
|
for pos = (aux:string-to-v3d poss)
|
||
|
|
and side-a = (read-tcb-side (gethash 1 tcb))
|
||
|
|
and side-b = (read-tcb-side (gethash 2 tcb))
|
||
|
|
for tcbobj = (make-tcb :pos pos :side-a side-a :side-b side-b)
|
||
|
|
do (vector-push-extend tcbobj tcbs))
|
||
|
|
tcbs)))
|