aboutsummaryrefslogtreecommitdiff
path: root/lib/Server
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Server')
-rw-r--r--lib/Server/ControlRoom.hs48
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