yw05
/
ywatds
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge nodedb into track databse code; use fixnum for coordinates; use sb-sprof for profiling when available

master
y5nw 2021-08-23 23:49:46 +02:00
parent e5197b2f50
commit 7fb0e91f96
5 changed files with 46 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
dataserver.lisp
View File

@ -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

6
helpers.lisp
View File

@ -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))

41
nodedb.lisp
View File

@ -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)))))

39
tracks/database.lisp
View File

@ -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

4
ywatds.asd
View File

@ -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")