Permalink
Browse files

FT_Bitmap_* functions

  • Loading branch information...
rpav committed Jan 31, 2012
1 parent f9ec343 commit c01af5612eca6a4157a47203347e1ea3f269fd5f
Showing with 96 additions and 35 deletions.
  1. +2 −1 cl-freetype2.asd
  2. +15 −0 src/bitmap.lisp
  3. +43 −0 src/ffi/ft2-bitmap.lisp
  4. +36 −34 src/render.lisp
View
@@ -30,7 +30,8 @@
(:file "ft2-face")
(:file "ft2-glyph")
(:file "ft2-size")
- (:file "ft2-outline")))
+ (:file "ft2-outline")
+ (:file "ft2-bitmap")))
(:file "init")
(:file "face")
View
@@ -1,5 +1,20 @@
(in-package :freetype2)
+ ;; Basic bitmap functions
+
+(defun bitmap-new (&optional (library *library*))
+ (make-wrapper (bitmap &bitmap ft-bitmap)
+ (ft-bitmap-new &bitmap)
+ (ft-bitmap-done library &bitmap)))
+
+(export 'bitmap-new)
+
+(defun bitmap-convert (bitmap alignment &optional (library *library*))
+ (let ((target (bitmap-new library)))
+ (ft-bitmap-convert library bitmap target alignment)))
+
+(export 'bitmap-convert)
+
;; String utility
(defun string-pixel-width (face string &optional (load-flags '(:default)))
"Get the pixel width of STRING in FACE given LOAD-FLAGS."
View
@@ -0,0 +1,43 @@
+(in-package :freetype2-ffi)
+
+ ;; C: Bitmap functions
+
+(defcfun ("FT_Bitmap_New" ft-bitmap-new) :void
+ (abitmap :pointer))
+
+(export 'ft-bitmap-new)
+
+(defcfun ("FT_Bitmap_Copy" ft-bitmap-copy) ft-error
+ (library ft-library)
+ (source :pointer)
+ (target :pointer))
+
+(export 'ft-bitmap-copy)
+
+(defcfun ("FT_Bitmap_Embolden" ft-bitmap-embolden) ft-error
+ (library ft-library)
+ (bitmap :pointer)
+ (x-strength ft-pos)
+ (y-strength ft-pos))
+
+(export 'ft-bitmap-embolden)
+
+(defcfun ("FT_Bitmap_Convert" ft-bitmap-convert) ft-error
+ (library ft-library)
+ (source :pointer)
+ (target :pointer)
+ (alignment :int))
+
+(export 'ft-bitmap-convert)
+
+(defcfun ("FT_GlyphSlot_Own_Bitmap" ft-glyphslot-own-bitmap) ft-error
+ (slot ft-glyphslot))
+
+(export 'ft-glyphslot-own-bitmap)
+
+(defcfun ("FT_Bitmap_Done" ft-bitmap-done) ft-error
+ (library ft-library)
+ (bitmap :pointer))
+
+(export 'ft-bitmap-done)
+
View
@@ -27,7 +27,8 @@ for instance, within the [`DO-STRING-RENDER`](#DO-STRING-RENDER) loop."
(direction :left-right)
(load-function 'default-load-render)
(baseline-y-p nil)
- (offsets-p t))
+ (offsets-p t)
+ (with-char nil))
&body body)
"Load, render, and compute metrics for each character in STRING in
an optimal manner. `FACE` should be set up appropriately (e.g., size).
@@ -46,44 +47,45 @@ set (default), will calculate `LEFT` offset into `X`. This is
critical for correct inter-glyph spacing, but some things (e.g. Cairo)
calculate this separately."
(once-only (face string)
- (with-gensyms (c1 c2 x y left top
+ (with-gensyms (c2 x y left top
advance max-ascender len
kern vertical-p)
- `(let ((,max-ascender (face-ascender-pixels ,face))
- (,len (length ,string))
- (,vertical-p (or (eq ,direction :up-down) (eq ,direction :down-up))))
- (loop with ,x = 0.0 and ,y = 0.0
- for i from 0 below ,len
- as ,c1 = (aref ,string i)
- as ,c2 = (if (< i (1- ,len))
- (aref ,string (1+ i))
- nil)
- as ,kern = (if (and ,c2 (not ,vertical-p))
- (get-kerning ,face ,c1 ,c2)
- 0.0)
- do
- (let (,bitmap-var ,advance ,left ,top)
- (multiple-value-setq (,bitmap-var ,advance ,left ,top)
+ (let ((c1 (or with-char (gensym))))
+ `(let ((,max-ascender (face-ascender-pixels ,face))
+ (,len (length ,string))
+ (,vertical-p (or (eq ,direction :up-down) (eq ,direction :down-up))))
+ (loop with ,x = 0.0 and ,y = 0.0
+ for i from 0 below ,len
+ as ,c1 = (aref ,string i)
+ as ,c2 = (if (< i (1- ,len))
+ (aref ,string (1+ i))
+ nil)
+ as ,kern = (if (and ,c2 (not ,vertical-p))
+ (get-kerning ,face ,c1 ,c2)
+ 0.0)
+ do
+ (let (,bitmap-var ,advance ,left ,top)
+ (multiple-value-setq (,bitmap-var ,advance ,left ,top)
(funcall ,(if (symbolp load-function)
- `(function ,load-function)
- load-function)
+ `(function ,load-function)
+ load-function)
,face ,c1 ,vertical-p))
- ,(unless (eq load-function 'default-load-render)
- `(unless ,bitmap-var
- (multiple-value-setq (,bitmap-var ,advance ,left ,top)
- (default-load-render ,face ,c1 ,vertical-p))))
- (case ,direction
- (:right-left (decf ,x (+ ,advance ,kern)))
- (:down-up (decf ,y ,advance)))
+ ,(unless (eq load-function 'default-load-render)
+ `(unless ,bitmap-var
+ (multiple-value-setq (,bitmap-var ,advance ,left ,top)
+ (default-load-render ,face ,c1 ,vertical-p))))
+ (case ,direction
+ (:right-left (decf ,x (+ ,advance ,kern)))
+ (:down-up (decf ,y ,advance)))
- (let ((,x-var (round ,(if offsets-p `(+ ,x ,left) x)))
- (,y-var (round ,(if baseline-y-p
- `(+ ,y ,max-ascender)
- `(+ ,y (- ,max-ascender ,top))))))
- ,@body)
+ (let ((,x-var (round ,(if offsets-p `(+ ,x ,left) x)))
+ (,y-var (round ,(if baseline-y-p
+ `(+ ,y ,max-ascender)
+ `(+ ,y (- ,max-ascender ,top))))))
+ ,@body)
- (case ,direction
- (:left-right (incf ,x (+ ,advance ,kern)))
- (:up-down (incf ,y ,advance)))))))))
+ (case ,direction
+ (:left-right (incf ,x (+ ,advance ,kern)))
+ (:up-down (incf ,y ,advance))))))))))
(export 'do-string-render)

0 comments on commit c01af56

Please sign in to comment.