1 files changed, 48 insertions, 0 deletions
diff --git a/lib/Server/ControlRoom.hs b/lib/Server/ControlRoom.hs
index ef3cb1e..ee0f686 100644
--- a/lib/Server/ControlRoom.hs
+++ b/lib/Server/ControlRoom.hs
@@ -70,6 +70,7 @@ mkYesod "ControlRoom" [parseRoutes|
 / RootR GET
 /trains TrainsR GET
 /train/id/#TripID/#Day TrainViewR GET
+/train/map/#TripID/#Day TrainMapViewR GET
 /train/announce/#TripID/#Day AnnounceR POST
 /train/del-announce/#UUID DelAnnounceR GET
 /token/block/#Token TokenBlock GET
@@ -131,6 +132,10 @@ instance Yesod ControlRoom where
              .blocked {
                background-color: red;
              }
+             #map {
+               width: 100%;
+               height: 50vh;
+             }
           <body>
             $forall (status, msg) <- msgs
               <p class="message #{status}">#{msg}
@@ -199,6 +204,7 @@ getTrainViewR trip day = do
         \ #{trainAnchorDelay} (_{MsgOnStationSequence (showFFloat (Just 3) trainAnchorSequence "")})
     $nothing
       <em> (_{MsgNone})
+  <p><a href="@{TrainMapViewR tripTripID day}">_{MsgMap}</a>
 <section>
   <h2>_{MsgStops}
   <ol>
@@ -238,6 +244,48 @@ getTrainViewR trip day = do
                 guessAtSeconds = extrapolateAtSeconds LinearExtrapolator
 
 
+getTrainMapViewR :: TripID -> Day -> Handler Html
+getTrainMapViewR tripId day = do
+  GTFS{..} <- getYesod <&> getGtfs
+  (widget, enctype) <- generateFormPost (announceForm day tripId)
+  case M.lookup tripId trips of
+    Nothing -> notFound
+    Just res@Trip{..} -> do defaultLayout $ [whamlet|
+<h1>_{MsgTrip} <a href="@{TrainViewR tripTripID day}">#{tripName res} _{Msgon} #{day}</a>
+<link rel="stylesheet" href="https://unpkg.com/leaflet@1.9.3/dist/leaflet.css"
+     integrity="sha256-kLaT2GOSpHechhsozzB+flnD+zUyjE2LlfWPgU04xyI="
+     crossorigin=""/>
+<script src="https://unpkg.com/leaflet@1.9.3/dist/leaflet.js"
+     integrity="sha256-WBkoXOwTeyKclOHuWtc+i2uENFpDZ9YPdf5Hf+D7ewM="
+     crossorigin=""></script>
+<div id="map">
+<p id="status">
+<script>
+  let map = L.map('map');
+
+  L.tileLayer('https://tile.openstreetmap.org/{z}/{x}/{y}.png', {
+      attribution: '&copy; <a href="https://www.openstreetmap.org/copyright">OpenStreetMap</a> contributors'
+  }).addTo(map);
+
+  ws = new WebSocket((location.protocol == "http:" ? "ws" : "wss") + "://" + location.host + "/api/train/subscribe/#{tripTripID}/#{day}");
+
+  var marker = null;
+
+  ws.onmessage = (msg) => {
+    let json = JSON.parse(msg.data);
+    if (marker === null) {
+      marker = L.marker([json.lat, json.long]);
+      marker.addTo(map);
+    } else {
+      marker.setLatLng([json.lat, json.long]);
+    }
+    map.setView([json.lat, json.long], 13);
+    document.getElementById("status").innerText = "_{MsgLastPing}: "+json.lat+","+json.long+" ("+json.timestamp+")";
+  }
+|]
+
+
+
 getTripsViewR :: Handler Html
 getTripsViewR = do
   GTFS{..} <- getYesod <&> getGtfs