Browse Source

wobsite!

master
eta 3 months ago
parent
commit
7302b8829c
  1. 19
      govuk.css
  2. 9
      trackernet.lisp
  3. 382
      wobsite.lisp

19
govuk.css

File diff suppressed because one or more lines are too long

9
trackernet.lisp

@ -556,6 +556,15 @@
(when score
(parse-integer score))))
(defun redis-last-cpk (key)
"Gets the CONSPACK-decoded value of the last element of the sorted set with the Redis KEY."
(let ((data (first
(red:zrevrangebyscore key "+inf" "-inf"
:limit (cons "0" "1")
:withscores t))))
(when data
(cpk-unbase64 data))))
(defun redis-cpk-sorted-set-all (key)
"Gets all elements of the sorted set KEY, alongside their scores, CONSPACK-decoding each element."
(let ((data

382
wobsite.lisp

@ -0,0 +1,382 @@
(defpackage :intertube-web
(:use :cl))
(in-package :intertube-web)
(setf (cl-who:html-mode) :html5)
(defparameter *title* "intertube")
(defvar *accent-colour* "#1d70b8")
(defun with-rendering-context (func)
(who:with-html-output-to-string (*standard-output* nil
:prologue t)
(:html
:lang "en"
(:head
(:meta
:charset "utf-8")
(:title
(who:esc *title*))
(:meta
:name "viewport"
:content "width=device-width, initial-scale=1, viewport-fit=cover")
(:link
:href "/styles.css"
:rel "stylesheet"))
(:body
:class "govuk-template__body"
(:a
:href "#main-content"
:class "govuk-skip-link"
"Skip to main content")
(:header
:class "govuk-header"
:role "banner"
(:div
:class "govuk-header__container govuk-width-container"
:style (format nil "border-bottom: 10px solid ~A;"
*accent-colour*)
(:div
:class "govuk-header__logo"
(:a
:href "/"
:class "govuk-header__link govuk-header__link--homepage"
(:span
:class "govuk-header__logotype-text"
"intertube")))))
(:div
:class "govuk-width-container"
(:main
:class "govuk-main-wrapper"
:id "main-content"
:role "main"
(who:str (funcall func))))
(:footer
:class "govuk-footer"
:role "contentinfo"
(:div
:class "govuk-width-container"
(:div
:class "govuk-footer__meta"
(:div
:class "govuk-footer__meta-item govuk-footer__meta-item--grow"
(:span
:class "govuk-footer__licence-description"
"This webpage may contain wiggly donkers.")))))))))
(defmacro render (() &body body)
`(with-rendering-context
(lambda ()
(who:with-html-output-to-string (*standard-output* nil
:prologue nil)
,@body))))
(hunchentoot:define-easy-handler (css :uri "/styles.css") ()
(hunchentoot:handle-static-file "./govuk.css"))
(defun html-rgb-colour (r g b)
(format nil "#~2,'0x~2,'0x~2,'0x" r g b))
(defparameter *tube-line-data*
'(("Bakerloo" "B" (178 99 0))
("Central" "C" (220 36 31))
("Circle" "H" (255 211 41))
("District" "D" (0 125 50))
("Hammersmith & City" "H" (244 169 190))
("Jubilee" "J" (161 165 167))
("Metropolitan" "M" (155 0 88))
("Northern" "N" (0 0 0))
("Piccadilly" "P" (0 25 168))
("Victoria" "V" (0 152 216))
("Waterloo & City" "W" (147 206 186)))
"A list of Tube line data, in the format (NAME TRACKERNET-CODE RGB-COLOUR)")
(defun tube-line-by-code (code)
(find-if (lambda (d) (string= (second d) code))
*tube-line-data*))
(defparameter *govuk-go-arrow-svg*
"<svg class=\"govuk-button__start-icon\" xmlns=\"http://www.w3.org/2000/svg\" width=\"17.5\" height=\"19\" viewBox=\"0 0 33 40\" aria-hidden=\"true\" focusable=\"false\">)
<path fill=\"currentColor\" d=\"M0 0h13l20 20-20 20H0l20-20z\" />
</svg>")
(defun train-objects-on-line (code)
(let ((active (trackernet::trains-active-on-line code)))
(mapcan (lambda (active-key)
(let* ((train-id (subseq active-key #.(length "X-active-")))
(whole-key (format nil "~A-train-~A" code train-id))
(data (trackernet::redis-last-cpk whole-key)))
(when data
(list data))))
active)))
(defun group-trains-by-destination (train-list)
(let ((dests (make-hash-table :test 'equal)))
(loop
for (observer train-obj) in train-list
do (let ((dest (or (trackernet::destination-desc train-obj)
"???")))
(unless (gethash dest dests)
(setf (gethash dest dests) nil))
(push (list observer train-obj) (gethash dest dests))))
(sort
(alexandria:hash-table-alist dests)
(lambda (a b)
(string< (car a) (car b))))))
(defun string-base64 (str)
(qbase64:encode-bytes
(flexi-streams:string-to-octets
str)))
(defun display-trackernet-train (train)
(who:with-html-output-to-string (*standard-output* nil
:prologue nil)
(:tr
:class "train-desc govuk-table__row"
(:td ; Train ID
:class "govuk-table__cell id-field no-phones"
(who:esc (trackernet::train-id train)))
(:td ; Set/trip number
:class "govuk-table__cell"
(let* ((trip-no (trackernet::trip-no train))
(set-no (trackernet::set-no train))
(class (if (string= trip-no "0")
"govuk-tag govuk-tag--green"
"govuk-tag govuk-tag--pink")))
(unless (string= set-no "000")
(who:htm
(:strong
:class class
(who:esc set-no)
(unless (string= trip-no "0")
(who:str " ×")
(who:esc trip-no)))))))
(:td ; LCID
:class "govuk-table__cell id-field no-phones"
(unless (string= (trackernet::lcid train) "0")
(who:esc (trackernet::lcid train))))
(:td ; Destination
:class "govuk-table__cell govuk-!-width-two-thirds"
(:span
(who:esc (or
(trackernet::location-desc train)
"<somewhere>"))
(who:str " ")
(:strong
:class "govuk-tag govuk-tag--grey train-track-code"
(who:esc (trackernet::track-code train))))))))
(hunchentoot:define-easy-handler (line :uri "/line") (code)
(let ((line-data (tube-line-by-code code)))
(unless line-data
(setf (hunchentoot:return-code*) 404)
(hunchentoot:abort-request-handler "not found lol"))
(let* ((*accent-colour* (apply #'html-rgb-colour (third line-data)))
(active-trains (train-objects-on-line code))
(grouped (group-trains-by-destination active-trains)))
(render ()
(:a
:class "govuk-back-link"
:href "/"
"All Tube lines")
(:span
:class "govuk-caption-xl"
"Line overview")
(:h1
:class "govuk-heading-xl"
(who:fmt "~A line"
(first line-data)))
(:p
:class "govuk-body-l"
(:strong
(who:str (length active-trains)))
" trains on the line as of "
(:span
:class "id-field"
(who:esc
(local-time:format-timestring
nil
(local-time:now)
:format
'((:year 4) #\- (:month 2) #\- (:day 2) #\Space
(:hour 2) #\: (:min 2) #\: (:sec 2)))))
".")
(:p
:class "govuk-body"
"Jump to: "
(loop
with len = (length grouped)
for (group . trains) in grouped
for i from 1
do (who:htm
(:a
:class "govuk-link"
:href (format nil "#~A"
(string-base64 group))
(who:esc group)))
unless (eql len i)
do (who:str " &middot; ")))
(:details
:class "govuk-details"
(:summary
:class "govuk-details__summary"
(:span
:class "govuk-details__summary-text"
"What do the columns mean?"))
(:div
:class "govuk-details__text"
(:ul
(:li
(:p
:class "govuk-body"
(:strong "TrainID")
(who:esc
" is a unique identifier given in the open data feeds. It's not entirely clear what, if anything, it correlates to in real life.")))
(:li
(:p
:class "govuk-body"
(:strong "LCID")
(who:esc
" (Leading Car ID) ostensibly identifies the leading car of the train in some way. We use this as our primary means of tracking trains.")))
(:li
(:p
:class "govuk-body"
(:strong "Track codes")
" "
(:strong
:class "govuk-tag govuk-tag--grey"
"ABCDEF")
(who:esc
" are arbitrary pieces of text describing a piece of track on the line. ")))
(:li
(:p
:class "govuk-body"
(:strong "WTT")
(who:esc
" gives the Train Number as found in the TfL ")
(:a
:href "https://tfl.gov.uk/corporate/publications-and-reports/working-timetables"
"Working Timetables (WTT)")
(who:esc
". These are keyed in by train operators at the start of their journey, and can be moved around by Line Controllers if necessary.")
(:ul
(:li
(:p
:class "govuk-body"
(:strong
:class "govuk-tag govuk-tag--pink"
"NNN ×R")
(who:esc
" denotes a train with WTT number NNN, on its Rth trip of the day.")))
(:li
(:p
:class "govuk-body"
(:strong
:class "govuk-tag govuk-tag--green"
"NNN")
(who:esc
" denotes a train with WTT number NNN, on its first run of the day (or where no trip number info is available).")))))))))
(loop
for (group . trains) in grouped
do (who:htm
(:h2
:class "govuk-heading-l"
:id (string-base64 group)
(who:esc group))
(:table
:class "tube-line-list govuk-table"
(:thead
:class "govuk-table__head"
(:tr
:class "govuk-table__row"
(:th
:class "govuk-table__header no-phones"
(:abbr
:title "TrackerNet unique identifier"
"TrainID"))
(:th
:class "govuk-table__header"
(:abbr
:title "Working Timetable train number"
"WTT"))
(:th
:class "govuk-table__header no-phones"
(:abbr
:title "Leading Car ID (LCID)"
"LCID"))
(:th
:class "govuk-table__header govuk-!-width-two-thirds"
"Current location")))
(:tbody
:class "govuk-table__body"
(loop
for (reporter train) in (sort trains #'string<
:key (lambda (trn)
(trackernet::train-id (second trn))))
do (who:str (display-trackernet-train train)))))))))))
(hunchentoot:define-easy-handler (root :uri "/") ()
(render ()
(:h1
:class "govuk-heading-xl"
"Explore the London Underground")
(:p
:class "govuk-body-l"
"Get real-time, second-by-second updates on the movements of Tube trains. ")
(:table
:class "tube-line-list govuk-table"
(:thead
:class "govuk-table__head"
(:tr
:class "govuk-table__row"
(:th
:class "govuk-table__header"
"Line")
(:th
:class "govuk-table__header"
"Data status")
(:th
:class "govuk-table__header"
"Go")))
(:tbody
:class "govuk-table__body"
(loop
for (name code rgb) in *tube-line-data*
do (let ((ntrains (length (trackernet::trains-active-on-line code))))
(who:htm
(:tr
:class "tube-line govuk-table__row"
(:td
:class "tube-line-name govuk-table__cell"
(who:esc name))
(if (> ntrains 0)
(who:htm
(:td
:class "tube-line-status govuk-table__cell"
(:strong
:class "govuk-tag govuk-tag--turquoise"
(who:fmt "~A trains" ntrains))))
(who:htm
(:td
:class "tube-line-status govuk-table__cell"
(:strong
:class "govuk-tag govuk-tag--grey"
"Inactive"))))
(:td
:class "govuk-table__cell"
(:a
:class "govuk-button govuk-button__start tube-line-button"
:style (format nil "background: ~A;"
(apply #'html-rgb-colour rgb))
:role "button"
:draggable "false"
:href (format nil "/line?code=~A" code)
(who:str *govuk-go-arrow-svg*)))))))))))
(push (hunchentoot:create-folder-dispatcher-and-handler "/fonts/" "./fonts/")
hunchentoot:*dispatch-table*)
(defun start-webserver ()
(hunchentoot:start (make-instance 'hunchentoot:easy-acceptor :port 5000)))
Loading…
Cancel
Save