diff --git a/fontland/fontland/font-path.rkt b/fontland/fontland/font-path.rkt index 80528b73..4447ef42 100644 --- a/fontland/fontland/font-path.rkt +++ b/fontland/fontland/font-path.rkt @@ -40,24 +40,27 @@ (define name-string (path->string name)) (regexp-match (string-downcase (substring family-name 0 (min 6 (string-length family-name)))) (string-downcase name-string))) +;; this function follows c sample +;; https://gist.github.com/CallumDev/7c66b3f9cf7a876ef75f + (define (family->path family-name #:bold [bold? #f] #:italic [italic? #f]) ;; create a configuration & invoke it (fc-config-set-current (fc-config-create)) (define fontsets (force fontsets-promise)) (cond [(ormap values fontsets) - ;; query pattern syntax - ;; https://www.freedesktop.org/software/fontconfig/fontconfig-user.html#AEN36 - (define query-pattern (fc-name-parse (string->bytes/utf-8 (format "~a:weight=~a:slant=~a" family-name (if bold? 200 80) (if italic? 100 0))))) - (fc-config-substitute query-pattern 'FcMatchPattern) - ;; https://www.freedesktop.org/software/fontconfig/fontconfig-devel/fcdefaultsubstitute.html - ;; Supplies default values for underspecified font patterns - (fc-default-substitute query-pattern) - (define result-pattern (fc-font-set-match fontsets query-pattern)) - (define result - (and result-pattern (bytes->path (fc-pattern-get-string result-pattern #"file" 0)))) - (cond - [(and result (probably-successful-match? family-name result)) result] - [else #false])] + ;; query pattern syntax + ;; https://www.freedesktop.org/software/fontconfig/fontconfig-user.html#AEN36 + (define query-pattern + (fc-name-parse (string->bytes/utf-8 (format "~a:weight=~a:slant=~a" family-name (if bold? 200 80) (if italic? 100 0))))) + (fc-config-substitute query-pattern 'FcMatchPattern) + ;; https://www.freedesktop.org/software/fontconfig/fontconfig-devel/fcdefaultsubstitute.html + ;; Supplies default values for underspecified font patterns + (fc-default-substitute query-pattern) + (define result-pattern (fc-font-set-match fontsets query-pattern)) + (define result + (and result-pattern (bytes->path (fc-pattern-get-string result-pattern #"file" 0)))) + (cond + [(and result (probably-successful-match? family-name result)) result] + [else #false])] [else #false])) - \ No newline at end of file