You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

86 lines
3.2 KiB
Racket

#lang racket/base
(require "core.rkt")
(require net/url-structs net/base64 racket/file)
(provide (all-defined-out))
(module+ test (require rackunit))
(require racket/contract sugar)
(define/contract (base64-font-string? x)
(any/c . -> . boolean?)
((->string x) . starts-with? . "data:"))
(module+ test
(check-true (base64-font-string? "data:foobar"))
(check-false (base64-font-string? "foobar")))
(define/contract (font-format p)
(pathish? . -> . (or/c string? #f))
(case (get-ext (->path p))
[("eot") "embedded-opentype"]
[("woff") "woff"]
[("ttf" "otf") "truetype"] ; yep, in this CSS declaration, otf is considered 'truetype'
[("svg") "svg"]
[else #f]))
(module+ test
(check-equal? (font-format "foo.eot") "embedded-opentype")
(check-equal? (font-format "foo.woff") "woff")
(check-equal? (font-format "foo.ttf") "truetype")
(check-equal? (font-format "foo.otf") "truetype")
(check-equal? (font-format "foo.svg") "svg")
(check-false (font-format "foo")))
(define/contract (font-mime-type p)
(pathish? . -> . (or/c string? #f))
(case (get-ext (->path p))
[("eot") "application/vnd.ms-fontobject"]
[("woff") "application/font-woff"]
[("ttf") "application/x-font-truetype"]
[("otf") "application/x-font-opentype"]
[("svg") "image/svg+xml"]
[else #f]))
(module+ test
(check-equal? (font-mime-type "foo.eot") "application/vnd.ms-fontobject")
(check-equal? (font-mime-type (->url "foo.woff?bar=ino")) "application/font-woff")
(check-equal? (font-mime-type "foo.ttf") "application/x-font-truetype")
(check-equal? (font-mime-type "foo.otf") "application/x-font-opentype")
(check-equal? (font-mime-type "foo.svg") "image/svg+xml")
(check-false (font-mime-type "foo")))
(define/contract (path->base64-font-string p)
(pathish? . -> . base64-font-string?)
(define path (->path p))
;; for CSS, base64 encode needs to be done with no line separator
(format "data:~a;charset=utf-8;base64,~a" (font-mime-type p) (base64-encode (file->bytes path) #"")))
(define/contract (font-face-declaration font-family
src-url
#:font-style [font-style "normal"]
#:font-weight [font-weight "normal"]
#:font-stretch [font-stretch "normal"]
#:base64 [base64? #f])
((string? (or/c urlish? base64-font-string?))
(#:font-style string? #:font-weight string? #:font-stretch string? #:base64 boolean?)
. ->* . string?)
(let* [(url (->url src-url))
(url-value (if base64? (path->base64-font-string src-url) (->path url)))
(src (format "url('~a') format('~a')" url-value (font-format src-url)))]
(string-append "@font-face {\n"
(join-css-strings (map make-css-string
'(font-family font-style font-weight font-stretch src)
(list font-family font-style font-weight font-stretch src)))
"}")))
(define ffd font-face-declaration)
;;(module+ main
;;(display (ffd "Miso" "charter-regular.woff" #:font-style "italic" #:font-weight "700" #:base64 #t)))