- make-font can now create a font from a font-id (Xfont)

- added %font->fontstruct, resp. scx_Font_ID_To_Font_Struct for that.
- removed gcontext-font (see gcontext.scm)
- added comments.
This commit is contained in:
frese 2001-10-09 15:42:26 +00:00
parent 231afe173a
commit 9478e09049
3 changed files with 50 additions and 25 deletions

View File

@ -23,6 +23,11 @@ s48_value scx_GContext_Font(s48_value Xdisplay, s48_value Xgcontext) {
return SCX_ENTER_FONTSTRUCT(XQueryFont(dpy, gc));
}
s48_value scx_Font_ID_To_Font(s48_value Xdisplay, s48_value Xfont) {
return SCX_ENTER_FONTSTRUCT(XQueryFont(SCX_EXTRACT_DISPLAY(Xdisplay),
SCX_EXTRACT_FONT(Xfont)));
}
s48_value scx_Font_Path(s48_value Xdisplay) {
int n, i;
char** sa;
@ -191,4 +196,5 @@ void scx_init_font(void) {
S48_EXPORT_FUNCTION(scx_List_Font_Names);
S48_EXPORT_FUNCTION(scx_Font_Info);
S48_EXPORT_FUNCTION(scx_Char_Info);
S48_EXPORT_FUNCTION(scx_Font_ID_To_Font);
}

View File

@ -11,25 +11,37 @@
0
(real-font-Xfont font)))
;; creates a font object. name can be #f. if Xfont is #f then it is obtained
;; from the Xfontstruct.
;; creates a font object. name can be #f. Either Xfont or Xfontstruct
;; has to bes specified. if Xfont is #f then it is obtained from the
;; Xfontstruct. if Xfontstruct is #f it queried with XQueryFont - but
;; Xlib documentation says, that the resulting Font does not work
;; properly in all functions.
(define (make-font name Xfont Xfontstruct display finalize?)
(let ((maybe-font (font-list-find Xfontstruct)))
(if maybe-font
maybe-font
(let* ((Xfont (if Xfont Xfont
(%Get_Xfont Xfontstruct)))
(font (really-make-font name Xfont Xfontstruct display)))
(if finalize?
(add-finalizer! font unload-font)
(add-finalizer! font font-list-delete!))
(font-list-set! Xfontstruct font)
font))))
(if (not (or Xfont Xfontstruct))
(error "Not enough information the make the font. Either Xfont or Xfontstruct has to be specified." name Xfont Xfontstruct display finalize?))
(let ((Xfontstruct (if (not Xfontstruct)
(%font->fontstruct (display-Xdisplay display)
Xfont)
Xfontstruct)))
(let ((maybe-font (font-list-find Xfontstruct)))
(if maybe-font
maybe-font
(let* ((Xfont (if Xfont Xfont
(%Get_Xfont Xfontstruct)))
(font (really-make-font name Xfont Xfontstruct display)))
(if finalize?
(add-finalizer! font unload-font)
(add-finalizer! font font-list-delete!))
(font-list-set! Xfontstruct font)
font)))))
(import-lambda-definition %Get_Xfont (Xfontstruct)
"scx_Get_Xfont")
(import-lambda-definition %font->fontstruct (Xdisplay Xfont)
"scx_Font_ID_To_Font")
;; load-font loads a font by its name. See XLoadQueryFont.
(define (load-font display font-name)

View File

@ -1,12 +1,5 @@
(define (gcontext-font gcontext)
(let* ((display (gcontext-display gcontext))
(Xfontstruct (%gcontext-font
(display-Xdisplay display)
(gcontext-Xgcontext gcontext))))
(make-font #f #f Xfontstruct display #f)))
(import-lambda-definition %gcontext-font (Xdisplay Xgcontext)
"scx_GContext_Font")
;; list-font-names returns the names of all available fonts that match
;; the pattern. pattern has to be a string. See XListFonts.
(define (list-font-names display pattern)
(vector->list (%list-font-names (display-Xdisplay display)
@ -17,6 +10,9 @@
(import-lambda-definition %list-font-names (Xdisplay pattern)
"scx_List_Font_Names")
;; list-fonts returns all fonts that match the pattern. pattern has to
;; be string. See XListFonts.
(define (list-fonts display pattern)
(let ((v (%list-fonts (display-Xdisplay display)
(if (symbol? pattern)
@ -33,6 +29,9 @@
(import-lambda-definition %list-fonts (Xdisplay pattern)
"scx_List_Fonts")
;; font-properties returns an alist that maps atoms to the
;; corresponding values. See XFontStruct.
(define (font-properties font)
(let ((v (%font-properties (font-Xfontstruct font))))
(vector->list (vector-map! (lambda (XAtom-Val)
@ -43,6 +42,10 @@
(import-lambda-definition %font-properties (Xfontstruct)
"scx_Font_Properties")
;; font-property returns the value of specified
;; property. property-name has to be string or a symbol specifying an
;; atom. See XGetFontProperty.
(define (font-property font property-name)
(let ((atom (intern-atom (font-display font)
property-name)))
@ -52,6 +55,9 @@
(import-lambda-definition %font-property (Xfontstruct Xatom)
"scx_Font_Property")
;; font-path returns the (implementation and file system dependand)
;; path to the font files. See XGetFontPath, and XSetFontPath.
(define (font-path display)
(vector->list (%font-path (display-Xdisplay display))))
@ -69,7 +75,8 @@
(import-lambda-definition %set-font-path! (Xdisplay path)
"scx_Set_Font_Path")
;; ............
;; font-info returns a vector containing all information available for
;; the font. See XFontStruct.
(define (font-info font)
(%font-info (font-Xfontstruct font)))
@ -92,7 +99,8 @@
(define font-ascent (font-info-getter 7))
(define font-descent (font-info-getter 8))
;; ..................
;; char-info returns a vector containing font-dependand character
;; information. See also min/max/char-* functions below. See XFontStruct.
(define (char-info font index)
(%char-info (font-Xfontstruct font)
@ -144,7 +152,6 @@
"expected an integer between ")
index))))
(define (char-info-getter num)
(lambda (font index)
(vector-ref (char-info font index)