5 (defclass glrepl-font
()
6 ((height :initform
128 :reader bitmap-height-of
) ;; 15 up
7 (width :initform
128 :reader bitmap-width-of
) ;; 16 across
8 (pathname :initform
(merge-pathnames #P
"VeraMono.ttf") :initarg
:pathname
:reader pathname-of
)
9 (images :initform
(make-array 128) :reader images-of
)))
12 (defparameter *bitmap-height
* 128) ;; 15 up
13 (defparameter *bitmap-width
* 128) ;; 16 across
14 (defparameter *font-pathname
* (merge-pathnames #P
"VeraMono.ttf"))
15 (defparameter *font-images
* (make-array 128))
17 ;; note that these are 7 bit fonts since I'm avoiding the horrors of encoding for now
18 ;; probably the correct way to do this is to decode on the fly and cache font textures
19 ;; but deadlines are DEADlines...
22 (defun make-font (font-pathname)
23 (let ((result (make-instance 'glrepl-font
:pathname font-pathname
)))
25 (for i from
0 below
128)
26 (vecto:with-canvas
(:width
(bitmap-width-of result
) :height
(bitmap-height-of result
))
27 (let ((repl-font (vecto:get-font
(pathname-of result
)))
28 (repl-letter (string (code-char i
))))
29 (vecto:set-font repl-font
12)
30 (when (zpb-ttf:glyph-exists-p
(code-char i
) repl-font
)
33 (vecto:set-rgba-fill
0.0 0.0 0.0 0.0)
35 (vecto:set-rgba-fill
1.0 1.0 1.0 1.0)
36 (vecto:translate
52 24) ;; to do -- these are magic numbers -- should be computed from bitmap width & height
38 (vecto:draw-centered-string
0 0 repl-letter
)
39 (when (alpha-char-p (code-char i
))
40 (vecto:save-png
(merge-pathnames (concatenate 'string
(string (code-char i
)) ".png"))))
41 (vecto:with-graphics-state
42 (setf (aref (images-of result
) i
)
43 (make-instance 'rgba-image
:width
(bitmap-width-of result
) :height
(bitmap-height-of result
)))
45 (for x from
0 below
(bitmap-width-of result
))
47 (for y from
0 below
(bitmap-height-of result
))
48 (setf (pixel-xy (aref (images-of result
) i
) x y
) ;; #XFF000000
50 (aref (zpng::data-array
(vecto::image vecto
::*graphics-state
*)) y x
0)
51 (aref (zpng::data-array
(vecto::image vecto
::*graphics-state
*)) y x
1)
52 (aref (zpng::data-array
(vecto::image vecto
::*graphics-state
*)) y x
2)
53 (aref (zpng::data-array
(vecto::image vecto
::*graphics-state
*)) y x
3))
55 (update-image (aref (images-of result
) i
))))
56 (error () (format t
"Skipping char ~A~&" i
)))))))))
58 (defun destroy-font (font)
60 (for i from
0 below
128)
61 (when (typep (aref (images-of font
) i
) 'rgba-image
)
62 (destroy-image (aref (images-of font
) i
))
63 (setf (aref (images-of font
) i
) NIL
))))
65 ;; to do -- check bounding boxes are all sane..
69 ;; (zpb-ttf:with-font-loader (fnt (merge-pathnames #P"VeraMono.ttf"))
70 ;; (format t "Font Bounding box ~A~%" (zpb-ttf::bounding-box fnt))
72 ;; (for i from 0 to 128)
73 ;; (format t "~A ~A~%"
74 ;; (if (zpb-ttf:glyph-exists-p (code-char i) fnt) "Exists" "Nonexistent")
75 ;; (zpb-ttf::string-bounding-box (string (code-char i)) fnt))))
