From 6c0f21b276ad73f383a80fe00729c6520a6b874a Mon Sep 17 00:00:00 2001 From: stuebinm Date: Tue, 13 Dec 2022 00:30:21 +0100 Subject: simple realtime position map (what was that about doing the realtime stuff somewhere else and /not/ in this monolithic server thingie? oh well …) --- lib/Server/ControlRoom.hs | 48 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 48 insertions(+) (limited to 'lib/Server') 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; + } $forall (status, msg) <- msgs

#{msg} @@ -199,6 +204,7 @@ getTrainViewR trip day = do \ #{trainAnchorDelay} (_{MsgOnStationSequence (showFFloat (Just 3) trainAnchorSequence "")}) $nothing (_{MsgNone}) +

_{MsgMap}

_{MsgStops}
    @@ -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| +

    _{MsgTrip} #{tripName res} _{Msgon} #{day} + + +
    +

    +