diff --git a/dataserver.lisp b/dataserver.lisp index 4f73f8e..68f6023 100644 --- a/dataserver.lisp +++ b/dataserver.lisp @@ -5,7 +5,6 @@ ;; Databases (defparameter *ildb* nil) -(defparameter *nodedb* nil) (defparameter *trackdb* nil) (defparameter *trackdb-temp* nil) @@ -24,18 +23,14 @@ (defmacro savefilepath (name) `(uiop:subpathname *world-path* (concatenate 'string "advtrains_" ,name))) -(defmacro load-data () - (alexandria:with-gensyms (tdb tdbtemp) - `(progn - (setf *ildb* (atil:import-data (savefilepath "interlocking.ls"))) - (if *debugp* (progn (setf *nodedb* (ndb:import-data (savefilepath "ndb4.ls"))) - (multiple-value-bind (,tdb ,tdbtemp) - (tracks:import-data *nodedb*) - (psetf *trackdb* ,tdb *trackdb-temp* ,tdbtemp))) - (setf *trackdb* (tracks:import-data (ndb:import-data (savefilepath "ndb4.ls"))))) - (when *gcp* - #+sbcl(sb-ext:gc :full t)) - (hunchentoot:acceptor-log-message *server* :info "Database updated")))) +(defun load-data () + (let* ((ildb (atil:import-data (savefilepath "interlocking.ls")))) + (multiple-value-bind (tdb tdbtemp) (tracks:import-data (savefilepath "ndb4.ls")) + (if *debugp* (setf *trackdb-temp* tdbtemp)) + (psetf *ildb* ildb *trackdb* tdb))) + (when *gcp* + #+sbcl(sb-ext:gc :full t)) + (hunchentoot:acceptor-log-message *server* :info "Database updated")) (defmacro mainloop () `(loop (load-data) (sleep 20))) @@ -160,6 +155,7 @@ (defun start-server () (tracks:init-tracks) + (if *debugp* (break)) (load-data) (hunchentoot:start *server*) ;; loop until an error occurs diff --git a/helpers.lisp b/helpers.lisp index e9002c4..58d407b 100644 --- a/helpers.lisp +++ b/helpers.lisp @@ -23,9 +23,9 @@ (if (typep ,n 'ratio) (coerce ,n 'float) ,n)))) (defstruct v3d - (x 0 :type lua-number) - (y 0 :type lua-number) - (z 0 :type lua-number)) + (x 0 :type fixnum) + (y 0 :type fixnum) + (z 0 :type fixnum)) (defmacro v3d (x y z) `(make-v3d :x ,x :y ,y :z ,z)) diff --git a/nodedb.lisp b/nodedb.lisp deleted file mode 100644 index 8fe63b6..0000000 --- a/nodedb.lisp +++ /dev/null @@ -1,41 +0,0 @@ -(defpackage :nodedb - (:nicknames :ndb) - (:use :cl) - (:export :import-data :loopdb)) -(in-package :ndb) - -(defmacro loopdb ((db pos name param2) &body body) - (alexandria:with-gensyms (nodes names k v id) - (alexandria:once-only - (db) - `(loop with ,names = (car ,db) and ,nodes = (cdr ,db) - for ,k being the hash-keys of ,nodes using (hash-value ,v) - for ,id = (ash ,v -2) - for ,pos = ,k and ,name = (gethash ,id ,names) and ,param2 = (mod ,v 4) - do (progn ,@body))))) - -;; written based on https://gigamonkeys.com/book/practical-parsing-binary-files.html -(defun import-data (fn) - (with-open-file (stream fn :element-type '(unsigned-byte 8)) - (labels ((read-u8 () (read-byte stream nil nil)) - (read-u16 () (let ((msb (read-u8)) (lsb (read-u8))) - (if (and msb lsb) (+ (* 256 msb) lsb)))) - (read-int () (let ((i (read-u16))) (if i (- i 32768)))) - (read-ln () - (with-output-to-string (s) - (loop for c = (read-u8) while c for char = (code-char c) - until (char= char #\Newline) do (write-char char s)))) - (read-node-entry () - (let ((x (read-int)) (y (read-int)) (z (read-int)) (v (read-int))) - (if (and x y z v) (cons (aux:make-v3d :x x :y y :z z) v)))) - (validp (ent nodelist) - (and ent (gethash (ash (cdr ent) -2) nodelist)))) - (assert (= (read-u8) 1)) - (let ((nodelist (make-hash-table :test #'equal)) - (nodes (make-hash-table :test #'equalp))) - (loop repeat (read-int) - for id = (read-int) for name = (read-ln) - do (setf (gethash id nodelist) name)) - (loop for ent = (read-node-entry) while (validp ent nodelist) - do (setf (gethash (car ent) nodes) (cdr ent))) - (cons nodelist nodes))))) diff --git a/tracks/database.lisp b/tracks/database.lisp index dfef05a..a2bca96 100644 --- a/tracks/database.lisp +++ b/tracks/database.lisp @@ -70,14 +70,39 @@ (when (removable-p) (remhash pos tdb)))))) -(defun import-data (ndb) +;;; written based on https://gigamonkeys.com/book/practical-parsing-binary-files.html +;;; note that this implementation only reads nodes that are known to be tracks +(defun read-tracks-from-nodedb (fn) + (let ((tmpdb (make-hash-table :test #'equalp)) + (nodes (make-hash-table :test #'eql))) + (with-open-file (stream fn :element-type '(unsigned-byte 8)) + (labels ((read-u8 () (read-byte stream nil nil)) + (read-u16 () (let ((msb (read-u8)) (lsb (read-u8))) + (if (and msb lsb) (+ (* 256 msb) lsb)))) + (read-int () (let ((i (read-u16))) (if i (- i 32768)))) + (read-ln () + (with-output-to-string (s) + (loop for c = (read-u8) while c for char = (code-char c) + until (char= char #\Newline) do (write-char char s)))) + (read-node-entry () + (let ((x (read-int)) (y (read-int)) (z (read-int)) (v (read-int))) + (if (and x y z v) (cons (aux:make-v3d :x x :y y :z z) v)))) + (id->clist (ent) + (if ent (gethash (ash (cdr ent) -2) nodes)))) + (assert (= (read-u8) 1)) + (loop repeat (read-int) + for id = (read-int) for name = (read-ln) for clist = (gethash name *track->conns*) + when clist do (setf (gethash id nodes) clist)) + (loop for ent = (read-node-entry) for clist = (id->clist ent) while ent + when clist + do (let ((param2 (ldb (byte 2 0) (cdr ent)))) + (setf (gethash (car ent) tmpdb) + (adjust-conns-list-with-param2 clist param2 t)))) + tmpdb)))) + +(defun import-data (fn) (let ((tdb (make-track-database)) - ;; temporary track database to read in data to - (tmpdb (make-hash-table :test #'equalp))) - (ndb:loopdb - (ndb pos node param2) - (alexandria:when-let ((clist (gethash node *track->conns*))) - (setf (gethash pos tmpdb) (adjust-conns-list-with-param2 clist param2 t)))) + (tmpdb (read-tracks-from-nodedb fn))) (loop for pos being the hash-keys of tmpdb using (hash-value clist) for dirs = (conns-list-dirs clist) for connects = (make-empty-connects) do diff --git a/ywatds.asd b/ywatds.asd index a843a94..0d0d5ea 100644 --- a/ywatds.asd +++ b/ywatds.asd @@ -4,12 +4,12 @@ :version "0.1" :author "Y.W." :license "GNU AGPL 3 or later" - :depends-on ("asdf" "easy-routes" "cl-ppcre" "parse-float" "alexandria" "cl-json") + :depends-on ("asdf" "easy-routes" "cl-ppcre" "parse-float" "alexandria" "cl-json" + #+sbcl"sb-sprof") :serial t :components ((:file "helpers") (:file "graphviz") (:file "serialize-lib") - (:file "nodedb") (:module "tracks" :serial t :components ((:file "package")