66 lines
2.0 KiB
Common Lisp
66 lines
2.0 KiB
Common Lisp
(defpackage :ywatds
|
|
(:use :cl)
|
|
(:export :program-entry))
|
|
(in-package :ywatds)
|
|
|
|
(defparameter *ildb* nil)
|
|
|
|
(defun program-entry ()
|
|
(let* ((argv (uiop:command-line-arguments))
|
|
(worldpath (uiop:ensure-pathname (car argv)
|
|
:defaults (uiop:getcwd)
|
|
:ensure-directory t
|
|
:want-existing t
|
|
:ensure-absolute t))
|
|
(serverport (parse-integer (cadr argv)))
|
|
(server (make-instance 'easy-routes:routes-acceptor
|
|
:port serverport)))
|
|
(macrolet ((savefilepath (n)
|
|
`(uiop:subpathname worldpath (format nil "advtrains_~a" ,n)))
|
|
(load-data ()
|
|
`(progn
|
|
(setf *ildb* (atil:import-data (savefilepath "interlocking.ls"))))))
|
|
(ywsw:safe-text-route
|
|
("/dumpser/:p" :method :get) (&path (p 'string))
|
|
(format nil "~s" (atsl:from-file (savefilepath p) :alist)))
|
|
(ywsw:safe-text-route
|
|
("/pretty_dump/interlocking" :method :get) ()
|
|
(format nil "~s" *ildb*))
|
|
(ywsw:safe-json-route ("/tcbinfo" :method :get) () *ildb*)
|
|
(ywsw:safe-json-route
|
|
("/tcbinfo/:x/:y/:z" :method :get)
|
|
(&get
|
|
(ln :parameter-type 'string) (rc :parameter-type 'string)
|
|
(side :parameter-type 'string)
|
|
(next :parameter-type 'boolean)
|
|
&path (x 'integer) (y 'integer) (z 'integer))
|
|
(if (and x y z)
|
|
(let ((tcb (atil:find-tcb-at *ildb* (aux:make-v3d :x x :y y :z z))))
|
|
(cond
|
|
((not tcb) nil)
|
|
(side
|
|
(let ((tcbs (cond
|
|
((string-equal side "a") (atil:tcb-side-a tcb))
|
|
((string-equal side "b") (atil:tcb-side-b tcb))
|
|
(t nil))))
|
|
(cond
|
|
((not tcbs) nil)
|
|
((or ln rc)
|
|
(let ((route (atil:match-route (atil:tcbdata-routes tcbs)
|
|
(or ln "") (or rc ""))))
|
|
(cond
|
|
((not route) nil)
|
|
(next (atil:route-next route))
|
|
(t route))))
|
|
(t tcbs))))
|
|
(t tcb)))))
|
|
(hunchentoot:start server)
|
|
;; loop until an error occurs
|
|
(handler-case (loop do
|
|
(load-data)
|
|
(sleep 20))
|
|
(t (c) (format t "~&~a~%" c)))
|
|
(ignore-errors
|
|
(hunchentoot:stop server)
|
|
(uiop:quit)))))
|