File: font-rendering.lisp

package info (click to toggle)
stumpwm 2:1.0.0-1
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, buster, sid
  • size: 1,216 kB
  • sloc: lisp: 13,721; makefile: 180; sh: 30
file content (66 lines) | stat: -rw-r--r-- 1,922 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66

(in-package :stumpwm)

(defgeneric font-exists-p (font))

(defgeneric open-font (display font))

(defgeneric close-font (font))

(defgeneric font-ascent (font))

(defgeneric font-descent (font))

(defgeneric font-height (font))

(defgeneric text-lines-height (font string))


(defgeneric text-line-width (font text &rest keys &key start end translate))


(defgeneric draw-image-glyphs (drawable gcontext
                               font
                               x y
                               sequence &rest keys &key start end translate width size))

;;;; X11 fonts
(defmethod font-exists-p ((font string))
  ;; if we can list the font then it exists
  (plusp (length (xlib:list-font-names *display* font :max-fonts 1))))

(defmethod open-font ((display xlib:display) (font string))
  (xlib:open-font display (first (xlib:list-font-names display font :max-fonts 1))))

(defmethod close-font ((font xlib:font))
  (xlib:close-font font))

(defmethod font-ascent ((font xlib:font))
  (xlib:font-ascent font))

(defmethod font-descent ((font xlib:font))
  (xlib:font-descent font))

(defmethod font-height ((font xlib:font))
  (+ (font-ascent font)
     (font-descent font)))

(defmethod text-line-width ((font xlib:font) text &rest keys &key (start 0) end translate)
  (declare (ignorable start end translate))
  (apply 'xlib:text-width font text keys))

(defmethod draw-image-glyphs (drawable 
                              gcontext
                              (font xlib:font)
                              x y
                              sequence &rest keys &key (start 0) end translate width size) 
  (declare (ignorable start end translate width size))
  (setf (xlib:gcontext-font gcontext) font)
  (apply 'xlib:draw-image-glyphs drawable 
         gcontext
         x y
         sequence keys))

(defmethod font-height ((fonts cons))
  (loop for font in fonts
        maximizing (font-height font)))