scsh-conservatory
/
scx
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

+ fixed gc'ing for xft-color and xft-fontset objects (maybe...) 

+ provide more functions for xft-fontsets
+ accept scx's screen-type instead of the raw screen-number
+ added debugging functions XftPatternPrint(), XftFontSetPrint()
+ added XftDefaultHasRender()
This commit is contained in:
eknauel 2003-10-17 08:38:24 +00:00
parent abd03a7d7a
commit 6a7e9007d7
1 changed files with 83 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

95
scheme/libs/xft.scm
View File

@ -21,9 +21,12 @@
(define-exported-binding "xft-draw" :xft-draw)
(define-record-type xft-color :xft-color
(make-xft-color c-pointer)
(make-xft-color c-pointer display visual colormap)
xft-color?
(c-pointer xft-color-c-pointer))
(c-pointer xft-color-c-pointer)
(display xft-color-display set-xft-color-display!)
(visual xft-color-visual set-xft-color-visual!)
(colormap xft-color-colormap set-xft-color-colormap!))
(define-exported-binding "xft-color" :xft-color)
@ -35,9 +38,10 @@
(define-exported-binding "xft-objectset" :xft-objectset)
(define-record-type xft-fontset :xft-fontset
(make-xft-fontset c-pointer)
(really-make-xft-fontset c-pointer patterns)
xft-fontset?
(c-pointer xft-fontset-c-pointer))
(c-pointer xft-fontset-c-pointer)
(patterns xft-fontset-patterns set-xft-fontset-patterns!))
(define-exported-binding "xft-fontset" :xft-fontset)
@ -56,7 +60,8 @@
(define (scx-xft-font-match display screen xft-pattern)
(call-with-values
(lambda ()
(scx-xft-font-match-internal display screen xft-pattern))
(let ((screen-number (screen:number screen)))
(scx-xft-font-match-internal display screen-number xft-pattern)))
(lambda (result xft-pattern)
(add-finalizer! xft-pattern scx-xft-pattern-destroy)
(values result xft-pattern))))
@ -67,12 +72,14 @@
xft-font))
(define (scx-xft-font-open-name display screen name)
(let ((xft-font (scx-xft-font-open-name-internal display screen name)))
(let* ((screen-number (screen:number screen))
(xft-font (scx-xft-font-open-name-internal display screen-number name)))
(add-finalizer! xft-font scx-xft-font-close)
xft-font))
(define (scx-xft-font-open-xlfd display screen name)
(let ((xft-font (scx-xft-font-open-xlfd-internal display screen name)))
(let* ((screen-numer (screen:number screen))
(xft-font (scx-xft-font-open-xlfd-internal display screen-numer name)))
(add-finalizer! xft-font scx-xft-font-close)
xft-font))
@ -115,6 +122,38 @@
visual
(error "XftDrawVisual() unavailable in this version of Xft"))))
(define (scx-xft-list-fonts-pattern-objects display screen xft-pattern xft-objectset)
(let* ((screen-number (screen:number screen))
(fontset (scx-xft-list-fonts-pattern-objects-internal
display screen-number xft-pattern xft-objectset)))
(add-finalizer! fontset scx-xft-fontset-destroy)
fontset))
(define (make-xft-fontset)
(let ((fontset (scx-xft-fontset-create)))
(set-xft-fontset-patterns! fontset '())
(add-finalizer! fontset scx-xft-fontset-create)
fontset))
(define (scx-xft-fontset-add xft-fontset xft-pattern)
(set-xft-fontset-patterns!
xft-fontset (lset-adjoin eq? xft-pattern (xft-fontset-patterns xft-fontset)))
(scx-xft-fontset-add-internal xft-fontset xft-pattern))
(define (scx-xft-color-alloc-name display visual colormap name)
(let ((xft-color (scx-xft-color-alloc-name-internal display visual colormap name)))
(set-xft-color-display! xft-color display)
(set-xft-color-visual! xft-color visual)
(set-xft-color-colormap! xft-color colormap)
(add-finalizer! xft-color xft-color-finalizer)
xft-color))
(define (xft-color-finalizer xft-color)
(scx-xft-color-free (xft-color-display xft-color)
(xft-color-visual xft-color)
(xft-color-colormap xft-color)
xft-color))
;;; import values from C code
(define scx-xft-version-major
(shared-binding-ref
@ -163,7 +202,7 @@
"scx_XftPatternAdd")
(import-lambda-definition scx-xft-font-match-internal
(display screen xft-pattern)
(display screen-number xft-pattern)
"scx_XftFontMatch")
(import-lambda-definition scx-xft-font-open-pattern-internal
@ -171,11 +210,11 @@
"scx_XftFontOpenPattern")
(import-lambda-definition scx-xft-font-open-name-internal
(display screen name)
(display screen-number name)
"scx_XftFontOpenName")
(import-lambda-definition scx-xft-font-open-xlfd-internal
(display screen xlfd-name)
(display screen-number xlfd-name)
"scx_XftFontOpenXlfd")
(import-lambda-definition scx-xft-font-close
@ -242,7 +281,39 @@
(xft-objectset object)
"scx_XftObjectSetAdd")
(import-lambda-definition scx-xft-list-fonts-pattern-objects
(diplay screen xft-pattern xft-objectset)
(import-lambda-definition scx-xft-list-fonts-pattern-objects-internal
(display screen-number xft-pattern xft-objectset)
"scx_XftListFontsPatternObjects")
(import-lambda-definition scx-xft-fontset-create
()
"scx_XftFontSetCreate")
(import-lambda-definition scx-xft-fontset-destroy
(xft-fontset)
"scx_XftFontSetDestroy")
(import-lambda-definition scx-xft-fontset-add-internal
(xft-fontset xft-pattern)
"scx_XftFontSetAdd")
(import-lambda-definition scx-xft-color-alloc-name-internal
(display visual colormap name)
"scx_XftColorAllocName")
(import-lambda-definition scx-xft-color-free
(display visual colormap xft-color)
"scx_XftColorFree")
(import-lambda-definition scx-xft-pattern-print
(xft-pattern)
"scx_XftPatternPrint")
(import-lambda-definition scx-xft-fontset-print
(xft-fontset)
"scx_XftFontSetPrint")
(import-lambda-definition scx-xft-default-has-render?
(display)
"scx_XftDefaultHasRender")