1 (uiop:define-package
#:lw2.fonts
2 (:use
#:cl
#:iterate
#:sb-thread
#:lw2.fonts-modules
#:lw2.html-reader
#:lw2.utils
#:lw2.resources
)
3 (:export
#:fonts-source
#:google-fonts-source
#:obormot-fonts-source
4 #:generate-fonts-html-headers
)
5 (:recycle
#:lw2-viewer
))
7 (in-package #:lw2.fonts
)
9 (named-readtables:in-readtable html-reader
)
11 ;;;; google-fonts-source
13 (defmethod call-with-fonts-source-resources ((fonts-source google-fonts-source
) fn
)
16 (defmethod generate-fonts-html-headers ((fonts-source google-fonts-source
))
17 <link rel
="stylesheet" href
="https://use.fontawesome.com/releases/v5.7.2/css/all.css" integrity
="sha384-fnmOCqbTlWIlj8LyTjo7mOUStjsKC4pOpQbqyi7RrhN7udi9RwhKkMHpvLbHG9Sr" crossorigin
="anonymous">
18 <link rel
="stylesheet" href
="https://fonts.googleapis.com/css?family=PT+Serif:400,400i,700,700i|Assistant:400,600,800">)
20 ;;;; obormot-fonts-source
22 (defparameter *obormot-fonts-stylesheet-uris
*
23 '("https://fonts.obormot.net/?fonts=InconsolataGW,CharterGW,ConcourseGW,MundoSans,SourceSansPro,Raleway,ProximaNova,TiredOfCourier,AnonymousPro,InputSans,InputSansNarrow,InputSansCondensed,GaramondPremierPro,TriplicateCode,TradeGothic,NewsGothicBT,Caecilia,SourceSerifPro,SourceCodePro"
24 "https://fonts.obormot.net/?fonts=BitmapFonts,FontAwesomeGW,GW-Symbols&base64encode=1"))
25 ;(defparameter *obormot-fonts-stylesheet-uris* '("https://fonts.greaterwrong.com/?fonts=*"))
27 (defvar *fonts-redirect-data
* nil
)
28 (declaim (type (or null
(unsigned-byte 63)) *fonts-redirect-last-update
*))
29 (sb-ext:defglobal
*fonts-redirect-last-update
* nil
)
30 (sb-ext:defglobal
*fonts-redirect-lock
* (make-mutex))
31 (sb-ext:defglobal
*fonts-redirect-thread
* nil
)
33 (defun update-obormot-fonts ()
34 (with-atomic-file-replacement (out-stream (asdf:system-relative-pathname
:lw2-viewer
"www/fonts.css") :element-type
'character
)
36 (for uri in
*obormot-fonts-stylesheet-uris
*)
37 (for response
= (dex:get uri
38 :headers
(alist "referer" (lw2.sites
::site-uri
(first lw2.sites
::*sites
*)) "accept" "text/css,*/*;q=0.1")
41 (with-input-from-string (in-stream response
)
42 (iter (for line in-stream in-stream using
#'read-line
)
43 (for replaced
= (ppcre:regex-replace
"url\\(['\"](?=https?://fonts.obormot.net/)" line
"\\&https://fonts.greaterwrong.com/"))
44 (write-string replaced out-stream
)
45 (terpri out-stream
)))))
46 (setf *fonts-redirect-last-update
* (get-unix-time)))
48 (defun update-obormot-fonts-async ()
49 (unless *fonts-redirect-thread
*
50 (setf *fonts-redirect-thread
*
51 (make-thread (lambda ()
52 (update-obormot-fonts)
53 (setf *fonts-redirect-thread
* nil
))
54 :name
"obormot fonts update"))))
56 (defun maybe-update-obormot-fonts ()
57 (let ((current-time (get-unix-time)))
58 (with-mutex (*fonts-redirect-lock
*)
59 (let ((last-update *fonts-redirect-last-update
*))
61 (when (>= current-time
(+ last-update
(* 60 60)))
62 (update-obormot-fonts-async))
63 (update-obormot-fonts))))))
65 (defmethod call-with-fonts-source-resources ((fonts-source obormot-fonts-source
) fn
)
66 (maybe-update-obormot-fonts)
67 (with-resource-bindings ((:preconnect
"https://s3.amazonaws.com/")
68 (:style
"/fonts.css"))
71 (defmethod generate-fonts-html-headers ((fonts-source obormot-fonts-source
))