commit c8eaefa4c6f4bc6d4d0a6e67318c3032a5c90d54 Author: nixo Date: Sun Jan 17 12:15:53 2021 +0100 Init diff --git a/.dir-locals.el b/.dir-locals.el new file mode 100644 index 0000000..37f6de9 --- /dev/null +++ b/.dir-locals.el @@ -0,0 +1,8 @@ +((scheme-mode + . + ((eval . (put 'call-with-window 'scheme-indent-function 1)) + (eval . (put 'call-with-renderer 'scheme-indent-function 1)) + (eval . (put 'surface-parse-match 'scheme-indent-function 1)) + (eval . (put 'pixel-format-parse-match 'scheme-indent-function 1)) + (eval . (put 'palette-parse-match 'scheme-indent-function 1)) + (eval . (put 'color-parse-match 'scheme-indent-function 1))))) diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..bde866b --- /dev/null +++ b/.gitignore @@ -0,0 +1,11 @@ +/Makefile +/Makefile.in +/aclocal.m4 +/autom4te.cache +/build-aux +/config.log +/config.status +/configure +/pre-inst-env +*.go +/sdl2/config.scm diff --git a/AUTHORS b/AUTHORS new file mode 100644 index 0000000..43a5356 --- /dev/null +++ b/AUTHORS @@ -0,0 +1 @@ +Nicolò Balzarotti \ No newline at end of file diff --git a/COPYING b/COPYING new file mode 100644 index 0000000..65c5ca8 --- /dev/null +++ b/COPYING @@ -0,0 +1,165 @@ + GNU LESSER GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + + This version of the GNU Lesser General Public License incorporates +the terms and conditions of version 3 of the GNU General Public +License, supplemented by the additional permissions listed below. + + 0. Additional Definitions. + + As used herein, "this License" refers to version 3 of the GNU Lesser +General Public License, and the "GNU GPL" refers to version 3 of the GNU +General Public License. + + "The Library" refers to a covered work governed by this License, +other than an Application or a Combined Work as defined below. + + An "Application" is any work that makes use of an interface provided +by the Library, but which is not otherwise based on the Library. +Defining a subclass of a class defined by the Library is deemed a mode +of using an interface provided by the Library. + + A "Combined Work" is a work produced by combining or linking an +Application with the Library. The particular version of the Library +with which the Combined Work was made is also called the "Linked +Version". + + The "Minimal Corresponding Source" for a Combined Work means the +Corresponding Source for the Combined Work, excluding any source code +for portions of the Combined Work that, considered in isolation, are +based on the Application, and not on the Linked Version. + + The "Corresponding Application Code" for a Combined Work means the +object code and/or source code for the Application, including any data +and utility programs needed for reproducing the Combined Work from the +Application, but excluding the System Libraries of the Combined Work. + + 1. Exception to Section 3 of the GNU GPL. + + You may convey a covered work under sections 3 and 4 of this License +without being bound by section 3 of the GNU GPL. + + 2. Conveying Modified Versions. + + If you modify a copy of the Library, and, in your modifications, a +facility refers to a function or data to be supplied by an Application +that uses the facility (other than as an argument passed when the +facility is invoked), then you may convey a copy of the modified +version: + + a) under this License, provided that you make a good faith effort to + ensure that, in the event an Application does not supply the + function or data, the facility still operates, and performs + whatever part of its purpose remains meaningful, or + + b) under the GNU GPL, with none of the additional permissions of + this License applicable to that copy. + + 3. Object Code Incorporating Material from Library Header Files. + + The object code form of an Application may incorporate material from +a header file that is part of the Library. You may convey such object +code under terms of your choice, provided that, if the incorporated +material is not limited to numerical parameters, data structure +layouts and accessors, or small macros, inline functions and templates +(ten or fewer lines in length), you do both of the following: + + a) Give prominent notice with each copy of the object code that the + Library is used in it and that the Library and its use are + covered by this License. + + b) Accompany the object code with a copy of the GNU GPL and this license + document. + + 4. Combined Works. + + You may convey a Combined Work under terms of your choice that, +taken together, effectively do not restrict modification of the +portions of the Library contained in the Combined Work and reverse +engineering for debugging such modifications, if you also do each of +the following: + + a) Give prominent notice with each copy of the Combined Work that + the Library is used in it and that the Library and its use are + covered by this License. + + b) Accompany the Combined Work with a copy of the GNU GPL and this license + document. + + c) For a Combined Work that displays copyright notices during + execution, include the copyright notice for the Library among + these notices, as well as a reference directing the user to the + copies of the GNU GPL and this license document. + + d) Do one of the following: + + 0) Convey the Minimal Corresponding Source under the terms of this + License, and the Corresponding Application Code in a form + suitable for, and under terms that permit, the user to + recombine or relink the Application with a modified version of + the Linked Version to produce a modified Combined Work, in the + manner specified by section 6 of the GNU GPL for conveying + Corresponding Source. + + 1) Use a suitable shared library mechanism for linking with the + Library. A suitable mechanism is one that (a) uses at run time + a copy of the Library already present on the user's computer + system, and (b) will operate properly with a modified version + of the Library that is interface-compatible with the Linked + Version. + + e) Provide Installation Information, but only if you would otherwise + be required to provide such information under section 6 of the + GNU GPL, and only to the extent that such information is + necessary to install and execute a modified version of the + Combined Work produced by recombining or relinking the + Application with a modified version of the Linked Version. (If + you use option 4d0, the Installation Information must accompany + the Minimal Corresponding Source and Corresponding Application + Code. If you use option 4d1, you must provide the Installation + Information in the manner specified by section 6 of the GNU GPL + for conveying Corresponding Source.) + + 5. Combined Libraries. + + You may place library facilities that are a work based on the +Library side by side in a single library together with other library +facilities that are not Applications and are not covered by this +License, and convey such a combined library under terms of your +choice, if you do both of the following: + + a) Accompany the combined library with a copy of the same work based + on the Library, uncombined with any other library facilities, + conveyed under the terms of this License. + + b) Give prominent notice with the combined library that part of it + is a work based on the Library, and explaining where to find the + accompanying uncombined form of the same work. + + 6. Revised Versions of the GNU Lesser General Public License. + + The Free Software Foundation may publish revised and/or new versions +of the GNU Lesser General Public License from time to time. Such new +versions will be similar in spirit to the present version, but may +differ in detail to address new problems or concerns. + + Each version is given a distinguishing version number. If the +Library as you received it specifies that a certain numbered version +of the GNU Lesser General Public License "or any later version" +applies to it, you have the option of following the terms and +conditions either of that published version or of any later version +published by the Free Software Foundation. If the Library as you +received it does not specify a version number of the GNU Lesser +General Public License, you may choose any version of the GNU Lesser +General Public License ever published by the Free Software Foundation. + + If the Library as you received it specifies that a proxy can decide +whether future versions of the GNU Lesser General Public License shall +apply, that proxy's public statement of acceptance of any version is +permanent authorization for you to choose that version for the +Library. diff --git a/Makefile.am b/Makefile.am new file mode 100644 index 0000000..c7d56b1 --- /dev/null +++ b/Makefile.am @@ -0,0 +1,56 @@ +# guile-fontconfig --- FFI bindings for FontConfig +# Copyright © 2021 Nicolò Balzarotti +# +# This file is part of guile-fontconfig. +# +# Guile-fontconfig is free software; you can redistribute it and/or +# modify it under the terms of the GNU Lesser General Public License +# as published by the Free Software Foundation; either version 3 of +# the License, or (at your option) any later version. +# +# Guile-fontconfig is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with guile-fontconfig. If not, see +# . + +GOBJECTS = $(SOURCES:%.scm=%.go) + +nobase_mod_DATA = $(SOURCES) $(NOCOMP_SOURCES) +nobase_go_DATA = $(GOBJECTS) + +# Make sure source files are installed first, so that the mtime of +# installed compiled files is greater than that of installed source +# files. See +# +# for details. +guile_install_go_files = install-nobase_goDATA +$(guile_install_go_files): install-nobase_modDATA + +CLEANFILES = $(GOBJECTS) +EXTRA_DIST = $(SOURCES) $(NOCOMP_SOURCES) +GUILE_WARNINGS = -Wunbound-variable -Warity-mismatch -Wformat +SUFFIXES = .scm .go +.scm.go: + $(AM_V_GEN)$(top_builddir)/pre-inst-env $(GUILE_TOOLS) compile $(GUILE_WARNINGS) -o "$@" "$<" + +moddir=$(prefix)/share/guile/site/$(GUILE_EFFECTIVE_VERSION) +godir=$(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/site-ccache + +SOURCES = \ + fontconfig.scm \ + fontconfig/bindings.scm \ + fontconfig/config.scm \ + fontconfig/object-set.scm \ + fontconfig/pattern.scm + +EXTRA_DIST += \ + pre-inst-env.in \ + README \ + guix.scm \ + examples/example.scm + +.PHONY: publish diff --git a/README b/README new file mode 100644 index 0000000..7894048 --- /dev/null +++ b/README @@ -0,0 +1,77 @@ +-*- mode: org -*- + +Guile-FontConfig provides Guile Scheme bindings for the FontConfig C +shared library. The bindings are written in pure Scheme by using +Guile's foreign function interface. + +* Requirements + + Guile-FontConfig currently depends on the following packages: + + - GNU Guile >= 2.0.9 + - FontConfig + - GNU Make + - GNU pkg-config + + When building from a Git checkout, the following additional packages + are required: + + - GNU Autoconf + - GNU Automake + - GNU Texinfo + +* Installing + + Guile-FontConfig uses the standard GNU build system, so installation + requires the usual incantations: + + #+BEGIN_SRC sh + ./configure + make + make install + #+END_SRC + + When building from a Git checkout, the following spell is necessary + before running any of the above commands: + + #+BEGIN_SRC sh + ./bootstrap + #+END_SRC + + GNU Guix users may install the current development snapshot + described in =guix.scm= with the following command: + + #+BEGIN_SRC sh + guix package -f guix.scm + #+END_SRC + +* Developing + + To build the source code from a Git checkout, run the following: + + #+BEGIN_SRC sh + ./bootstrap + ./configure + make + #+END_SRC + + To start a Guile REPL with a pre-configured load path for using + guile-fontconfig, use the =pre-inst-env= script: + + #+BEGIN_SRC sh + ./pre-inst-env guile + #+END_SRC + + GNU Guix users may create a development environment with all of the + necessary dependencies by running the following command: + + #+BEGIN_SRC sh + guix environment -l guix.scm + #+END_SRC + +* Contact & Credits + + Bug reports and patches may be sent to . + + This repository and this library is based on David Thomson's + Guile-SDL2, available [[https://dthompson.us/projects/guile-sdl2.html][here]] and distributed under GNU LGPLv3+. diff --git a/bootstrap b/bootstrap new file mode 100755 index 0000000..872167c --- /dev/null +++ b/bootstrap @@ -0,0 +1,3 @@ +#!/bin/sh + +autoreconf -vif diff --git a/configure.ac b/configure.ac new file mode 100644 index 0000000..3dc4d34 --- /dev/null +++ b/configure.ac @@ -0,0 +1,44 @@ +# -*- Autoconf -*- +# +# guile-fontconfig --- FFI bindings for FontConfig +# Copyright © 2021 Nicolò Balzarotti +# +# This file is part of guile-fontconfig. +# +# Guile-fontconfig is free software; you can redistribute it and/or +# modify it under the terms of the GNU Lesser General Public License +# as published by the Free Software Foundation; either version 3 of +# the License, or (at your option) any later version. +# +# Guile-fontconfig is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with guile-fontconfig. If not, see +# . + +AC_INIT(guile-fontconfig, 0.0.1) +AC_CONFIG_SRCDIR(fontconfig) +AC_CONFIG_AUX_DIR([build-aux]) +AM_INIT_AUTOMAKE([color-tests -Wall -Wno-portability foreign]) +AM_SILENT_RULES([yes]) + +AC_CONFIG_FILES([Makefile fontconfig/config.scm]) +AC_CONFIG_FILES([pre-inst-env], [chmod +x pre-inst-env]) + +GUILE_PKG([3.0 2.2 2.0]) +GUILE_PROGS + +PKG_CHECK_MODULES([FONTCONFIG], [fontconfig]) +PKG_CHECK_VAR([FONTCONFIG_LIBDIR], [fontconfig], [libdir]) +AC_MSG_CHECKING([FONTCONFIG library path]) +AS_IF([test "x$FONTCONFIG_LIBDIR" = "x"], [ + AC_MSG_FAILURE([unable to find FontConfig library directory]) +], [ + AC_MSG_RESULT([$FONTCONFIG_LIBDIR]) +]) +AC_SUBST([FONTCONFIG_LIBDIR]) + +AC_OUTPUT diff --git a/examples/example.scm b/examples/example.scm new file mode 100644 index 0000000..283c985 --- /dev/null +++ b/examples/example.scm @@ -0,0 +1,22 @@ +(use-modules (fontconfig)) + +(let ((pattern (make-pattern + '((family "JuliaMono"))))) + (map + (lambda (pat) + (format #t " +--------------------- +Font located at: ~A +Style & Family: ~A ~A +Fc Match String: ~A +" + (pattern-get pat "file") + (pattern-get pat "style") + (pattern-get pat "family") + (pattern->format pat "%{=fcmatch}"))) + (pattern-list pattern))) + +(let ((pattern (make-pattern '()))) + (format #t "There are a total of ~A fonts!\n" (length (pattern-list pattern)))) + +(display (make-pattern)) diff --git a/fontconfig.scm b/fontconfig.scm new file mode 100644 index 0000000..1076661 --- /dev/null +++ b/fontconfig.scm @@ -0,0 +1,28 @@ +;;; guile-fontconfig --- FFI bindings for FontConfig +;;; Copyright © 2021 Nicolò Balzarotti +;;; +;;; This file is part of guile-fontconfig. +;;; +;;; Guile-fontconfig is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU Lesser General Public License +;;; as published by the Free Software Foundation; either version 3 of +;;; the License, or (at your option) any later version. +;;; +;;; Guile-fontconifg is distributed in the hope that it will be +;;; useful, but WITHOUT ANY WARRANTY; without even the implied +;;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +;;; See the GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU Lesser General Public +;;; License along with guile-fontconfig. If not, see +;;; . + +;;; Code: + +(define-module (fontconfig) + #:use-module (fontconfig pattern) + #:use-module (fontconfig object-set) + #:re-export (make-pattern + pattern-list pattern-get + pattern->string pattern->format + make-object-set)) diff --git a/fontconfig/bindings.scm b/fontconfig/bindings.scm new file mode 100644 index 0000000..8a69ed7 --- /dev/null +++ b/fontconfig/bindings.scm @@ -0,0 +1,114 @@ +;;; guile-fontconfig --- FFI bindings for FontConfig +;;; Copyright © 2021 Nicolò Balzarotti +;;; +;;; This file is part of guile-fontconfig. +;;; +;;; Guile-fontconfig is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU Lesser General Public License +;;; as published by the Free Software Foundation; either version 3 of +;;; the License, or (at your option) any later version. +;;; +;;; Guile-fontconfig is distributed in the hope that it will be +;;; useful, but WITHOUT ANY WARRANTY; without even the implied +;;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +;;; See the GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU Lesser General Public +;;; License along with guile-fontconfig. If not, see +;;; . + +;;; Commentary: +;; +;; Low-level FFI bindings. +;; +;;; Code: + +(define-module (fontconfig bindings) + #:use-module (fontconfig config) + #:use-module (system foreign) + #:export (fontconfig-func + define-foreign + + fontconfig-pattern-create fontconfig-pattern-destroy + fontconfig-object-set-destroy)) + +(define fontconfig-func + (let ((lib (dynamic-link %libfontconfig))) + (lambda (return-type function-name arg-types) + "Return a procedure for the foreign function FUNCTION-NAME in +the FontConfig shared library. That function must return a value of +RETURN-TYPE and accept arguments of ARG-TYPES." + (pointer->procedure return-type + (dynamic-func function-name lib) + arg-types)))) + +(define-syntax-rule (define-foreign name return-type func-name arg-types) + (define-public name + (fontconfig-func return-type func-name arg-types))) + + +;;; +;;; Initialization +;;; + +(define-foreign fontconfig-init-load-config-and-fonts + '* "FcInitLoadConfigAndFonts" '()) + +(define-foreign fontconfig-finalize + void "FcFini" '()) + + +;;; +;;; Version +;;; + +(define-foreign fontconfig-get-version + int "FcGetVersion" '()) + + +;;; +;;; Pattern +;;; + +(define-foreign fontconfig-pattern-create + '* "FcPatternCreate" '()) + +(define fontconfig-pattern-destroy + (dynamic-func "FcPatternDestroy" (dynamic-link %libfontconfig))) + +(define-foreign fontconfig-pattern-add-string + int "FcPatternAddString" '(* * *)) + +(define-foreign fontconfig-pattern-add-double + int "FcPatternAddDouble" `(* * ,double)) + +(define-foreign fontconfig-pattern-add-integer + int "FcPatternAddInteger" `(* * ,int)) + +(define-foreign fontconfig-pattern-add-bool + int "FcPatternAddBool" `(* * ,int)) + +(define-foreign fontconfig-name-unparse + '* "FcNameUnparse" '(*)) + +(define-foreign fontconfig-pattern-format + '* "FcPatternFormat" '(* *)) + +;; FcResult (FcPattern *p, const char *object, int id, FcValue *v); +(define-foreign fontconfig-pattern-get + int "FcPatternGet" `(* * ,int *)) + +;;; +;;; Object Set +;;; +(define-foreign fontconfig-object-set-create + '* "FcObjectSetCreate" '()) + +(define-foreign fontconfig-object-set-add + int "FcObjectSetAdd" '(* *)) + +(define-foreign fontconfig-font-list + '* "FcFontList" '(* * *)) + +(define fontconfig-object-set-destroy + (dynamic-func "FcObjectSetDestroy" (dynamic-link %libfontconfig))) diff --git a/fontconfig/config.scm b/fontconfig/config.scm new file mode 100644 index 0000000..a4b7664 --- /dev/null +++ b/fontconfig/config.scm @@ -0,0 +1,24 @@ +;;; guile-fontconfig --- FFI bindings for FontConfig +;;; Copyright © 2021 Nicolò Balzarotti +;;; +;;; This file is part of guile-fontconfig. +;;; +;;; Guile-fontconfig is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU Lesser General Public License +;;; as published by the Free Software Foundation; either version 3 of +;;; the License, or (at your option) any later version. +;;; +;;; Guile-fontconfig is distributed in the hope that it will be +;;; useful, but WITHOUT ANY WARRANTY; without even the implied +;;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +;;; See the GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU Lesser General Public +;;; License along with guile-fontconfig. If not, see +;;; . + +(define-module (fontconfig config) + #:export (%libfontconfig)) + +(define %libfontconfig + "/gnu/store/y9fdy234r6hqiacd7hgwlmbdsngbp8p1-fontconfig-2.13.1/lib/libfontconfig.so") diff --git a/fontconfig/config.scm.in b/fontconfig/config.scm.in new file mode 100644 index 0000000..92230eb --- /dev/null +++ b/fontconfig/config.scm.in @@ -0,0 +1,24 @@ +;;; guile-fontconfig --- FFI bindings for FontConfig +;;; Copyright © 2021 Nicolò Balzarotti +;;; +;;; This file is part of guile-fontconfig. +;;; +;;; Guile-fontconfig is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU Lesser General Public License +;;; as published by the Free Software Foundation; either version 3 of +;;; the License, or (at your option) any later version. +;;; +;;; Guile-fontconfig is distributed in the hope that it will be +;;; useful, but WITHOUT ANY WARRANTY; without even the implied +;;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +;;; See the GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU Lesser General Public +;;; License along with guile-fontconfig. If not, see +;;; . + +(define-module (fontconfig config) + #:export (%libfontconfig)) + +(define %libfontconfig + "@FONTCONFIG_LIBDIR@/libfontconfig.so") diff --git a/fontconfig/object-set.scm b/fontconfig/object-set.scm new file mode 100644 index 0000000..855ba41 --- /dev/null +++ b/fontconfig/object-set.scm @@ -0,0 +1,40 @@ +;;; guile-fontconfig --- FFI bindings for FontConfig +;;; Copyright © 2021 Nicolò Balzarotti +;;; +;;; This file is part of guile-fontconfig. +;;; +;;; Guile-fontconfig is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU Lesser General Public License +;;; as published by the Free Software Foundation; either version 3 of +;;; the License, or (at your option) any later version. +;;; +;;; Guile-fontconfig is distributed in the hope that it will be +;;; useful, but WITHOUT ANY WARRANTY; without even the implied +;;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +;;; See the GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU Lesser General Public +;;; License along with guile-fontconfig. If not, see +;;; . + +(define-module (fontconfig object-set) + #:use-module ((fontconfig bindings) #:prefix ffi:) + #:use-module (system foreign) + #:export (make-object-set + unwrap-object-set + object-set-add!)) + +(define-wrapped-pointer-type + object-set? + wrap-object-set unwrap-object-set + (lambda (pattern port) + (format port "#"))) + +(define (make-object-set) + (let* ((ptr (ffi:fontconfig-object-set-create)) + (object-set (wrap-object-set ptr))) + (set-pointer-finalizer! ptr ffi:fontconfig-object-set-destroy) + object-set)) + +(define (object-set-add! os attr) + (ffi:fontconfig-object-set-add (unwrap-object-set os) (string->pointer attr))) diff --git a/fontconfig/pattern.scm b/fontconfig/pattern.scm new file mode 100644 index 0000000..0b650bd --- /dev/null +++ b/fontconfig/pattern.scm @@ -0,0 +1,156 @@ +;;; guile-fontconfig --- FFI bindings for FontConfig +;;; Copyright © 2021 Nicolò Balzarotti +;;; +;;; This file is part of guile-fontconfig. +;;; +;;; Guile-fontconfig is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU Lesser General Public License +;;; as published by the Free Software Foundation; either version 3 of +;;; the License, or (at your option) any later version. +;;; +;;; Guile-fontconfig is distributed in the hope that it will be +;;; useful, but WITHOUT ANY WARRANTY; without even the implied +;;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +;;; See the GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU Lesser General Public +;;; License along with guile-fontconfig. If not, see +;;; . + +(define-module (fontconfig pattern) + #:use-module (ice-9 match) + #:use-module ((fontconfig bindings) #:prefix ffi:) + #:use-module (fontconfig object-set) + #:use-module (rnrs bytevectors) + #:use-module (srfi srfi-26) + #:use-module (system foreign) + #:export (make-pattern + pattern-get + pattern-list pattern->string pattern->format)) + +(define %string-attrs + '(family + style foundry file lang + fullname familylang stylelang fullnamelang + compatibility fontformat fontfeatures namelang + prgname hash postscriptname)) + +(define %double-attrs + '(size aspect pixelsize scale dpi)) + +(define %integer-attrs + '(slant weight spacing hintstyle width index rgba fontversion lcdfilter)) + +(define %bool-attrs + '(antialias + histing verticallayout autohint outline scalable + minspace embolden embeddedbitmap decorative)) + +(define-wrapped-pointer-type + pattern? + wrap-pattern unwrap-pattern + (lambda (pattern port) (format port "#"))) + +(define symbol->pointer + (compose string->pointer symbol->string)) + +(define (pattern-add-string pattern attr value) + (ffi:fontconfig-pattern-add-string + (unwrap-pattern pattern) (symbol->pointer attr) (string->pointer value))) +(define (pattern-add-double pattern attr value) + (ffi:fontconfig-pattern-add-double + (unwrap-pattern pattern) (symbol->pointer attr) value)) +(define (pattern-add-integer pattern attr value) + (ffi:fontconfig-pattern-add-integer + (unwrap-pattern pattern) (symbol->pointer attr) value)) +(define (pattern-add-bool pattern attr value) + (ffi:fontconfig-pattern-add-bool + (unwrap-pattern pattern) (symbol->pointer attr) (if value 1 0))) + +(define* (make-pattern #:optional (args '())) + (define bool? (cute member <> %bool-attrs)) + (define int? (cute member <> %integer-attrs)) + (define double? (cute member <> %double-attrs)) + (define string? (cute member <> %string-attrs)) + (let* ((ptr (ffi:fontconfig-pattern-create)) + (pattern + (if (null-pointer? ptr) + (error "make-pattern" "failed to create pattern") + (wrap-pattern ptr)))) + (set-pointer-finalizer! ptr ffi:fontconfig-pattern-destroy) + (map (lambda (args) + (apply (match args + (((? bool? attr) value) pattern-add-bool) + (((? int? attr) value) pattern-add-integer) + (((? double? attr) value) pattern-add-double) + (((? string? attr) value) pattern-add-string)) + pattern args)) + args) + pattern)) + +(define (font-list pattern os) + (ffi:fontconfig-font-list + %null-pointer (unwrap-pattern pattern) (unwrap-object-set os))) + +(define (char*->pointer pointer offset) + (dereference-pointer + (bytevector->pointer + (pointer->bytevector pointer int (* int offset))))) + +(define (pattern->string pattern) + (pointer->string + (ffi:fontconfig-name-unparse (unwrap-pattern pattern)))) + +(define (make-font-list nfont sfont fonts) + (map (compose wrap-pattern (cute char*->pointer fonts <>)) + (iota nfont))) + +;; https://www.freedesktop.org/software/fontconfig/fontconfig-devel/fcpatternformat.html +(define* (pattern->format pattern #:optional (format "%{=fclist}")) + (let ((ptr (ffi:fontconfig-pattern-format + (unwrap-pattern pattern) (string->pointer format)))) + (if (null-pointer? ptr) + (error "pattern->format" "invalid format") + (pointer->string ptr)) + ;; FIXME: How to FREE ptr! + )) + +(define %fc-types + '(fc-unknown ; -1 + fc-void + fc-integer + fc-double + fc-string + fc-bool + fc-matrix + fc-charset + fc-ftface + fc-langset + fc-range)) + +(define (int->fc-type int) + (list-ref %fc-types (1+ int))) + +(define (fontconfig-value ptr) + (match-let* (((type ptr) (parse-c-struct ptr `(,int *))) + (type (int->fc-type type))) + (match type + ;; Other types are not implemented + ('fc-void *unspecified*) + ('fc-string (pointer->string ptr)) + (_ (error "fontconfig-value" "NOT IMPLEMENTED YET!"))))) + +(define (pattern-get pattern attr) + (let ((out (bytevector->pointer (make-bytevector (* int 2))))) + (ffi:fontconfig-pattern-get + (unwrap-pattern pattern) (string->pointer attr) 0 out) + (fontconfig-value out))) + +(define (pointer->font-list ptr) + (apply make-font-list (parse-c-struct ptr `(,int ,int *)))) + +(define (pattern-list pattern) + (let ((os (make-object-set))) + (for-each (cute object-set-add! os <>) + '("family" "style" "file")) + (pointer->font-list (font-list pattern os)))) diff --git a/guix.scm b/guix.scm new file mode 100644 index 0000000..5bf0f7d --- /dev/null +++ b/guix.scm @@ -0,0 +1,92 @@ +;;; guile-fontconfig --- FFI bindings for FontConfig +;;; Copyright © 2021 Nicolò Balzarotti +;;; +;;; This file is part of guile-fontconfig. +;;; +;;; Guile-fontconfig is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU Lesser General Public License +;;; as published by the Free Software Foundation; either version 3 of +;;; the License, or (at your option) any later version. +;;; +;;; Guile-fontconfig is distributed in the hope that it will be +;;; useful, but WITHOUT ANY WARRANTY; without even the implied +;;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +;;; See the GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU Lesser General Public +;;; License along with guile-fontconfig. If not, see +;;; . + +;;; Commentary: +;; +;; GNU Guix development package. To build and install, run: +;; +;; guix package -f guix.scm +;; +;; To use as the basis for a development environment, run: +;; +;; guix environment -l guix.scm +;; +;;; Code: + +(use-modules (ice-9 match) + (ice-9 popen) + (ice-9 rdelim) + (srfi srfi-1) + (srfi srfi-26) + (guix gexp) + (guix packages) + (guix licenses) + (guix git-download) + (guix build-system gnu) + ((guix build utils) #:select (with-directory-excursion)) + (gnu packages) + (gnu packages autotools) + (gnu packages guile) + (gnu packages pkg-config) + (gnu packages fontutils) + (gnu packages texinfo)) + +(define %source-dir (dirname (current-filename))) + +(define git-file? + (let* ((pipe (with-directory-excursion %source-dir + (open-pipe* OPEN_READ "git" "ls-files"))) + (files (let loop ((lines '())) + (match (read-line pipe) + ((? eof-object?) + (reverse lines)) + (line + (loop (cons line lines)))))) + (status (close-pipe pipe))) + (lambda (file stat) + (match (stat:type stat) + ('directory #t) + ((or 'regular 'symlink) + (any (cut string-suffix? <> file) files)) + (_ #f))))) + +(package + (name "guile-fontconfig") + (version "0.0.1") + (source (local-file %source-dir #:recursive? #t #:select? git-file?)) + (build-system gnu-build-system) + (arguments + '(#:make-flags '("GUILE_AUTO_COMPILE=0") + #:phases + (modify-phases %standard-phases + (add-after 'unpack 'bootstrap + (lambda _ (zero? (system* "sh" "bootstrap"))))))) + (native-inputs + `(("autoconf" ,autoconf) + ("automake" ,automake) + ("pkg-config" ,pkg-config) + ("texinfo" ,texinfo))) + (inputs + `(("guile" ,guile-3.0) + ("fontconfig" ,fontconfig))) + (synopsis "Guile bindings for FontConfig") + (description "Guile-fontconfig provides pure Guile Scheme bindings to the +FontConfig C shared library via the foreign function interface.") + (home-page "") + (license lgpl3+)) diff --git a/pre-inst-env.in b/pre-inst-env.in new file mode 100644 index 0000000..0ba4f4d --- /dev/null +++ b/pre-inst-env.in @@ -0,0 +1,32 @@ +#!/bin/sh + +# guile-fontconfig --- FFI bindings for FONTCONFIG +# Copyright © 2021 Nicolò Balzarotti +# +# This file is part of guile-fontconfig. +# +# Guile-fontconfig is free software; you can redistribute it and/or +# modify it under the terms of the GNU Lesser General Public License +# as published by the Free Software Foundation; either version 3 of +# the License, or (at your option) any later version. +# +# Guile-fontconfig is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with guile-fontconfig. If not, see +# . + +abs_top_srcdir="`cd "@abs_top_srcdir@" > /dev/null; pwd`" +abs_top_builddir="`cd "@abs_top_builddir@" > /dev/null; pwd`" + +GUILE_LOAD_COMPILED_PATH="$abs_top_builddir${GUILE_LOAD_COMPILED_PATH:+:}$GUILE_LOAD_COMPILED_PATH" +GUILE_LOAD_PATH="$abs_top_builddir:$abs_top_srcdir${GUILE_LOAD_PATH:+:}:$GUILE_LOAD_PATH" +export GUILE_LOAD_COMPILED_PATH GUILE_LOAD_PATH + +PATH="$abs_top_builddir/scripts:$PATH" +export PATH + +exec "$@"