From 960bcf713792f6f160ae164ced8252179cca9ac4 Mon Sep 17 00:00:00 2001
From: y5nw <y5nw@localhost>
Date: Wed, 25 Aug 2021 15:04:46 +0200
Subject: [PATCH] Load interlocking data into track database

---
 dataserver.lisp      |  4 ++--
 tracks/database.lisp | 12 +++++++++---
 ywatds.asd           |  2 +-
 3 files changed, 12 insertions(+), 6 deletions(-)

diff --git a/dataserver.lisp b/dataserver.lisp
index 1355f88..d232215 100644
--- a/dataserver.lisp
+++ b/dataserver.lisp
@@ -36,7 +36,7 @@
 
 (defun load-data ()
   (let* ((ildb (atil:load-ildb *ildb-path*))
-	 (tdb (tracks:load-trackdb *nodedb-path*)))
+	 (tdb (tracks:load-trackdb *nodedb-path* ildb)))
     (psetf *ildb* ildb *trackdb* tdb)
     (when *gcp*
       #+sbcl(sb-ext:gc :full t))
@@ -118,7 +118,7 @@
 	      append (loop with side = (atil:make-tcbside :pos pos :side 1)
 			for i across (atil:tcbdata-routes (atil:tcb-side-b tcb))
 			append (list side (atil:route-next i))))))
-  (ywsw:safe-graphviz-route
+  (ywsw:safe-text-route
    graph-tracks ("/graph/paths" :method :get) ()
    ("Return a simple graph of paths")
    (tracks:gvdump *trackdb*))
diff --git a/tracks/database.lisp b/tracks/database.lisp
index 70c101a..ffb4ada 100644
--- a/tracks/database.lisp
+++ b/tracks/database.lisp
@@ -9,7 +9,7 @@
 ;;                CDDR representing the list of directions the train can move in
 (defstruct track
   (connects (make-empty-connects) :type (vector list 16))
-  (special nil :type list))
+  (special nil :type boolean))
 
 (defmacro get-track (trackdb pos)
   `(gethash ,pos ,trackdb))
@@ -35,8 +35,13 @@
 	   when (or (not ,no-eol-p) ,c)
 	   collect (cons ,c ,d))))))
 
+(defun mark-interlocking-tracks (tdb ildb)
+  ;; TODO: actually check whether the TCBs are useful
+  (loop for pos being the hash-keys of (atil:ildb-tcbs ildb) do
+       (alexandria:when-let ((track (gethash pos tdb)))
+	 (setf (track-special track) t))))
+
 (defun optimize-track-database (tdb)
-  (declare (optimize (debug 3)))
   (labels ((ndirs (c) (loop for i across c when i count i))
 	   (connect-dirs (from to dist)
 	     (with-track-at-ts (tdb from nil dir track)
@@ -96,7 +101,7 @@
 		      (adjust-conns-list-with-param2 clist param2 t))))
 	tmpdb))))
 
-(defun load-trackdb (fn)
+(defun load-trackdb (fn ildb)
   (let* ((tmpdb (read-tracks-from-nodedb fn))
 	 (tdb (make-hash-table :test #'equalp :size (hash-table-count tmpdb))))
     (loop for pos being the hash-keys of tmpdb using (hash-value clist)
@@ -131,6 +136,7 @@
 		(push dist (aref connects (dir-c i)))
 		(push adj (aref connects (dir-c i))))
 	   (setf (get-track tdb pos) (make-track :connects connects))))
+    (mark-interlocking-tracks tdb ildb)
     (optimize-track-database tdb)
     tdb))
 
diff --git a/ywatds.asd b/ywatds.asd
index b9d4ba0..bd58af9 100644
--- a/ywatds.asd
+++ b/ywatds.asd
@@ -10,6 +10,7 @@
     :components ((:file "helpers")
 		 (:file "graphviz")
 		 (:file "serialize-lib")
+		 (:file "interlocking")
 		 (:module "tracks"
 			  :serial t
 			  :components ((:file "package")
@@ -17,7 +18,6 @@
 				       (:file "registration")
 				       (:file "database")
 				       (:file "path")))
-		 (:file "interlocking")
 		 (:file "server-wrapper")
 		 (:file "dataserver"))
     ;; https://lispcookbook.github.io/cl-cookbook/scripting.html