lib/ftgl.lisp

   1 (defpackage #:cl-glfw-ftgl
   2   (:nicknames #:ftgl)
   3   (:use #:cl #:cffi)
   4   (:export #:*default-font-search-path*
   5            #:attach-data
   6            #:attach-file
   7            #:create-bitmap-font
   8            #:create-buffer-font
   9            #:create-custom-font
  10            #:create-custom-glyph
  11            #:create-extrude-font
  12            #:create-extrude-font
  13            #:create-outline-font
  14            #:create-pixmap-font
  15            #:create-polygon-font
  16            #:create-texture-font
  17            #:destroy-font
  18            #:destroy-glyph
  19            #:destroy-layout
  20            #:encoding
  21            #:find-default-font
  22            #:font
  23            #:font-check-error
  24            #:ft-error
  25            #:get-font-advance
  26            #:get-font-ascender
  27            #:get-font-bbox
  28            #:get-font-char-map-count
  29            #:get-font-char-map-list
  30            #:get-font-descender
  31            #:get-font-error
  32            #:get-font-face-size
  33            #:get-font-line-height
  34            #:get-glyph-advance
  35            #:get-glyph-bbox
  36            #:get-glyph-error
  37            #:get-layout-bbox
  38            #:get-layout-error
  39            #:glyph
  40            #:layout
  41            #:mode
  42            #:render-font
  43            #:render-glyph
  44            #:render-layout
  45            #:render-mode
  46            #:set-font-char-map
  47            #:set-font-depth
  48            #:set-font-display-list
  49            #:set-font-face-size
  50            #:set-font-outset
  51            #:text-alignment))
  52
  53 (in-package #:cl-glfw-ftgl)
  54
  55 (define-foreign-library ftgl
  56   (:unix (:or "libftgl" "libftgl.so.2"))
  57   (t (:default "libftgl")))
  58 (use-foreign-library ftgl)
  59
  60 (defctype font :pointer)
  61 (defctype glyph :pointer)
  62 (defctype layout :pointer)
  63
  64 #.(progn
  65     (defun ft-enc-tag (str)
  66       (loop
  67          for ch across (reverse str)
  68          for i from 0 by 8
  69          summing (ash (char-code ch) i)))
  70     nil)
  71
  72 (defcenum encoding
  73     (:none 0)
  74   (:ms-symbol #.(ft-enc-tag "symb"))
  75   (:unicode #.(ft-enc-tag "unic"))
  76   (:sjis #.(ft-enc-tag "sjis"))
  77   (:gb2312 #.(ft-enc-tag "gb  "))
  78   (:big5 #.(ft-enc-tag "big5"))
  79   (:wansung #.(ft-enc-tag "wans"))
  80   (:johab #.(ft-enc-tag "joha"))
  81   (:adobe-standard #.(ft-enc-tag "ADOB"))
  82   (:adobe-expert #.(ft-enc-tag "ADBE"))
  83   (:adobe-custom #.(ft-enc-tag "ADBC"))
  84   (:adobe-latin-1 #.(ft-enc-tag "lat1"))
  85   (:old-latin-2 #.(ft-enc-tag "lat2"))
  86   (:apple-roman #.(ft-enc-tag "armn")))
  87
  88 (defcenum ft-error
  89   (:no-error                          0)
  90   (:cannot-open-resource           #x01)
  91   (:unknown-file-format            #x02)
  92   (:invalid-file-format            #x03)
  93   (:invalid-version                #x04)
  94   (:lower-module-version           #x05)
  95   (:invalid-argument               #x06)
  96   (:unimplemented-feature          #x07)
  97   (:invalid-table                  #x08)
  98   (:invalid-offset                 #x09)
  99   (:array-too-large                #x0A)
 100   (:invalid-glyph-index            #x10)
 101   (:invalid-character-code         #x11)
 102   (:invalid-glyph-format           #x12)
 103   (:cannot-render-glyph            #x13)
 104   (:invalid-outline                #x14)
 105   (:invalid-composite              #x15)
 106   (:too-many-hints                 #x16)
 107   (:invalid-pixel-size             #x17)
 108   (:invalid-handle                 #x20)
 109   (:invalid-library-handle         #x21)
 110   (:invalid-driver-handle          #x22)
 111   (:invalid-face-handle            #x23)
 112   (:invalid-size-handle            #x24)
 113   (:invalid-slot-handle            #x25)
 114   (:invalid-charmap-handle         #x26)
 115   (:invalid-cache-handle           #x27)
 116   (:invalid-stream-handle          #x28)
 117   (:too-many-drivers               #x30)
 118   (:too-many-extensions            #x31)
 119   (:out-of-memory                  #x40)
 120   (:unlisted-object                #x41)
 121   (:cannot-open-stream             #x51)
 122   (:invalid-stream-seek            #x52)
 123   (:invalid-stream-skip            #x53)
 124   (:invalid-stream-read            #x54)
 125   (:invalid-stream-operation       #x55)
 126   (:invalid-frame-operation        #x56)
 127   (:nested-frame-access            #x57)
 128   (:invalid-frame-read             #x58)
 129   (:raster-uninitialized           #x60)
 130   (:raster-corrupted               #x61)
 131   (:raster-overflow                #x62)
 132   (:raster-negative-height         #x63)
 133   (:too-many-caches                #x70)
 134   (:invalid-opcode                 #x80)
 135   (:too-few-arguments              #x81)
 136   (:stack-overflow                 #x82)
 137   (:code-overflow                  #x83)
 138   (:bad-argument                   #x84)
 139   (:divide-by-zero                 #x85)
 140   (:invalid-reference              #x86)
 141   (:debug-opcode                   #x87)
 142   (:endf-in-exec-stream            #x88)
 143   (:nested-defs                    #x89)
 144   (:invalid-coderange              #x8A)
 145   (:execution-too-long             #x8B)
 146   (:too-many-function-defs         #x8C)
 147   (:too-many-instruction-defs      #x8D)
 148   (:table-missing                  #x8E)
 149   (:horiz-header-missing           #x8F)
 150   (:locations-missing              #x90)
 151   (:name-table-missing             #x91)
 152   (:cmap-table-missing             #x92)
 153   (:hmtx-table-missing             #x93)
 154   (:post-table-missing             #x94)
 155   (:invalid-horiz-metrics          #x95)
 156   (:invalid-charmap-format         #x96)
 157   (:invalid-ppem                   #x97)
 158   (:invalid-vert-metrics           #x98)
 159   (:could-not-find-context         #x99)
 160   (:invalid-post-table-format      #x9A)
 161   (:invalid-post-table             #x9B)
 162   (:syntax-error                   #xA0)
 163   (:stack-underflow                #xA1)
 164   (:ignore                         #xA2)
 165   (:no-unicode-glyph-name          #xA3)
 166   (:missing-startfont-field        #xB0)
 167   (:missing-font-field             #xB1)
 168   (:missing-size-field             #xB2)
 169   (:missing-fontboundingbox-field  #xB3)
 170   (:missing-chars-field            #xB4)
 171   (:missing-startchar-field        #xB5)
 172   (:missing-encoding-field         #xB6)
 173   (:missing-bbx-field              #xB7)
 174   (:bbx-too-big                    #xB8)
 175   (:corrupted-font-header          #xB9)
 176   (:corrupted-font-glyphs          #xBA))
 177
 178 (defcenum render-mode
 179   (:front 1)
 180   (:back 2)
 181   (:side 4)
 182   (:all #xffff))
 183 (defcenum text-alignment
 184   (:left 0)
 185   (:center 1)
 186   (:right 2)
 187   (:justify 3))
 188
 189
 190 (defparameter *default-font-search-path*
 191   (list #+unix #P"/usr/share/fonts/**/FreeSans.ttf"
 192         #+unix #P"/usr/share/fonts/**/*.ttf"
 193         #+unix #P"/usr/X11/share/fonts/**/FreeSans.ttf"
 194         #+unix #P"/usr/X11/share/fonts/**/*.ttf"
 195         #+win32 #P"/WIN*/Fonts/verdana.ttf"
 196         #+win32 #P"/WIN*/Fonts/*.ttf"
 197         #+darwin #P"/Library/Fonts/Arial.ttf"
 198         #+darwin #P"/Library/Fonts/*.ttf")
 199   "A list of pathnames that should match to at least one TTF font. Patches Welcome.")
 200
 201
 202 (defun find-default-font ()
 203   (first (or (mapcan #'directory *default-font-search-path*)
 204              (error "Couldn't find any default TTF font!"))))
 205
 206
 207
 208
 209 (defun font-check-error (font)
 210   "Signals an error condition if font is flagged as having an error."
 211   (let ((ft-error (get-font-error font)))
 212     (unless (eql ft-error :no-error)
 213       (error "FreeType error: ~a." ft-error))))
 214
 215
 216 (defcfun ("ftglCreateCustomFont" %create-custom-font) font
 217   "Create a custom FTGL font object."
 218   (font-file-path :string)
 219   (data :pointer)
 220   (make-glyph-callback :pointer))
 221
 222 (defcfun ("ftglCreatePixmapFont" %create-pixmap-font) font
 223   "Create a specialised FTGLfont object for handling pixmap (grey scale) fonts."
 224   (file :string))
 225
 226 (defcfun ("ftglCreatePolygonFont" %create-polygon-font) font
 227   "Create a specialised FTGLfont object for handling tesselated polygon mesh fonts."
 228   (file :string))
 229
 230 (defcfun ("ftglCreateOutlineFont" %create-outline-font) font
 231   "Create a specialised FTGLfont object for handling vector outline fonts."
 232   (file :string))
 233
 234 (defcfun ("ftglCreateExtrudeFont" %create-extrude-font) font
 235   "Create a specialised FTGLfont object for handling extruded poygon fonts."
 236   (file :string))
 237
 238 (defcfun ("ftglCreateTextureFont" %create-texture-font) font
 239   "Create a specialised FTGLfont object for handling texture-mapped fonts."
 240   (file :string))
 241
 242 (defcfun ("ftglCreateBufferFont" %create-buffer-font) font
 243   "Create a specialised FTGLfont object for handling buffered fonts."
 244   (file :string))
 245
 246
 247 (defun create-buffer-font (&optional (filename (find-default-font)) (encoding :unicode))
 248   (let ((font (%create-buffer-font (namestring filename))))
 249     (if (cffi:null-pointer-p font)
 250         nil
 251         (prog1 font
 252           (font-check-error font)
 253           (set-font-char-map font encoding)
 254           (font-check-error font)))))
 255
 256 (defun create-extrude-font (&optional (filename (find-default-font)) (encoding :unicode))
 257   (let ((font (%create-extrude-font (namestring filename))))
 258     (if (cffi:null-pointer-p font)
 259         nil
 260         (prog1 font
 261           (font-check-error font)
 262           (set-font-char-map font encoding)
 263           (font-check-error font)))))
 264
 265 (defun create-outline-font (&optional (filename (find-default-font)) (encoding :unicode))
 266   (let ((font (%create-outline-font (namestring filename))))
 267     (if (cffi:null-pointer-p font)
 268         nil
 269         (prog1 font
 270           (font-check-error font)
 271           (set-font-char-map font encoding)
 272           (font-check-error font)))))
 273
 274 (defun create-pixmap-font  (&optional (filename (find-default-font)) (encoding :unicode))
 275   (let ((font (%create-pixmap-font (namestring filename))))
 276         (if (cffi:null-pointer-p font)
 277         nil
 278         (prog1 font
 279           (font-check-error font)
 280           (set-font-char-map font encoding)
 281           (font-check-error font)))))
 282
 283 (defun create-polygon-font (&optional (filename (find-default-font)) (encoding :unicode))
 284   (let ((font (%create-polygon-font (namestring filename))))
 285         (if (cffi:null-pointer-p font)
 286         nil
 287         (prog1 font
 288           (font-check-error font)
 289           (set-font-char-map font encoding)
 290           (font-check-error font)))))
 291
 292 (defun create-texture-font (&optional (filename (find-default-font)) (encoding :unicode))
 293   (let ((font (%create-texture-font (namestring filename))))
 294     (if (cffi:null-pointer-p font)
 295         nil
 296         (prog1 font
 297           (font-check-error font)
 298           (set-font-char-map font encoding)
 299           (font-check-error font)))))
 300
 301
 302
 303
 304
 305 (defcfun ("ftglDestroyFont" destroy-font) :void
 306   "Destroy an FTGL font object." (font font))
 307 (defcfun ("ftglAttachFile" attach-file) :int
 308   "Attach auxilliary file to font e.g."
 309   (font font)
 310   (path :string))
 311
 312 ;; XXX size is actually size_t
 313 (defcfun ("ftglAttachData" attach-data) :int
 314   "Attach auxilliary data to font, e.g."
 315   (font font)
 316   (data (:pointer :uint8))
 317   (size :int))
 318
 319 (defcfun ("ftglSetFontCharMap" set-font-char-map) :int
 320   "Set the character map for the face."
 321   (font font)
 322   (encoding encoding))
 323
 324 (defcfun ("ftglGetFontCharMapCount" get-font-char-map-count) :unsigned-int
 325   "Get the number of character maps in this face."
 326   (font font))
 327
 328 (defcfun ("ftglGetFontCharMapList" get-font-char-map-list) encoding
 329   "Get a list of character maps in this face."
 330   (font font))
 331
 332 (defcfun ("ftglSetFontFaceSize" set-font-face-size) :int
 333   "Set the char size for the current face."
 334   (font font)
 335   (size :unsigned-int)
 336   (res :unsigned-int))
 337
 338 (defcfun ("ftglGetFontFaceSize" get-font-face-size) :unsigned-int
 339   "Get the current face size in points (1/72 inch)."
 340   (font font))
 341
 342 (defcfun ("ftglSetFontDepth" set-font-depth) :void
 343   "Set the extrusion distance for the font."
 344   (font font)
 345   (depth :float))
 346
 347 (defcfun ("ftglSetFontOutset" set-font-outset) :void
 348   "Set the outset distance for the font."
 349   (font font)
 350   (front :float)
 351   (back :float))
 352
 353 (defcfun ("ftglSetFontDisplayList" set-font-display-list) :void
 354   "Enable or disable the use of Display Lists inside FTGL."
 355   (font font)
 356   (use-list :boolean))
 357
 358 (defcfun ("ftglGetFontAscender" get-font-ascender) :float
 359  "Get the global ascender height for the face."
 360  (font font))
 361
 362 (defcfun ("ftglGetFontDescender" get-font-descender) :float
 363   "Gets the global descender height for the face."
 364   (font font))
 365
 366 (defcfun ("ftglGetFontLineHeight" get-font-line-height) :float
 367   "Gets the line spacing for the font."
 368   (font font))
 369
 370 (defcfun ("ftglGetFontBBox" %get-font-bbox) :void
 371   "Get the bounding box for a string."
 372   (font font)
 373   (string :string)
 374   (len :int)
 375   (bounds (:pointer :float)))
 376
 377
 378 (defun get-font-bbox (font text length)
 379   "Returns the BBox of the text using font as 6 values."
 380   (cffi:with-foreign-object (bbox :float 6)
 381     (%get-font-bbox font text length bbox)
 382     (values (cffi:mem-aref bbox :float 0)
 383             (cffi:mem-aref bbox :float 1)
 384             (cffi:mem-aref bbox :float 2)
 385             (cffi:mem-aref bbox :float 3)
 386             (cffi:mem-aref bbox :float 4)
 387             (cffi:mem-aref bbox :float 5))))
 388
 389
 390 (defcfun ("ftglGetFontAdvance" get-font-advance) :float
 391   "Get the advance width for a string."
 392   (font font)
 393   (string :string))
 394
 395 (defcfun ("ftglRenderFont" render-font) :void "Render a string of characters."
 396  (font font)
 397  (string :string)
 398  (mode render-mode))
 399
 400 (defcfun ("ftglGetFontError" get-font-error) ft-error
 401  "Query a font for errors."
 402  (font font))
 403
 404 (defcfun ("ftglCreateCustomGlyph" create-custom-glyph) glyph
 405   "Create a custom FTGL glyph object."
 406   (base glyph)
 407   (data :pointer)
 408   (render-callback :pointer)
 409   (destroy-callback :pointer))
 410
 411 (defcfun ("ftglDestroyGlyph" destroy-glyph) :void
 412  "Destroy an FTGL glyph object."
 413  (glyph glyph))
 414
 415 (defcfun ("ftglRenderGlyph" %render-glyph) :void
 416   "Render a glyph at the current pen position and compute the corresponding advance."
 417   (glyph glyph)
 418   (penx :double)
 419   (peny :double)
 420   (render-mode render-mode)
 421   (advance-x (:pointer :double))
 422   (advance-y (:pointer :double)))
 423
 424
 425 (defun render-glyph (glyph penx peny render-mode)
 426   "Render a glyph at the current pen position and compute the corresponding advance."
 427   (cffi:with-foreign-objects ((advance-x :float 1)
 428                               (advance-y :float 1))
 429     (%render-glyph glyph penx peny render-mode advance-x advance-y)
 430     (values (cffi:mem-aref advance-x :float 0)
 431             (cffi:mem-aref advance-y :float 0))))
 432
 433 (defcfun ("ftglGetGlyphAdvance" get-glyph-advance) :float
 434   "Return the advance for a glyph."
 435   (glyph glyph))
 436
 437 (defcfun ("ftglGetGlyphBBox" %get-glyph-bbox) :void
 438   "Return the bounding box for a glyph."
 439   (glyph glyph)
 440   (bounds (:pointer :float)))
 441
 442 (defun get-glyph-bbox (glyph)
 443   "Returns the BBox of the glyph using 6 values."
 444   (cffi:with-foreign-object (bbox :float 6)
 445     (%get-glyph-bbox glyph bbox)
 446     (values (cffi:mem-aref bbox :float 0)
 447             (cffi:mem-aref bbox :float 1)
 448             (cffi:mem-aref bbox :float 2)
 449             (cffi:mem-aref bbox :float 3)
 450             (cffi:mem-aref bbox :float 4)
 451             (cffi:mem-aref bbox :float 5))))
 452
 453
 454 (defcfun ("ftglGetGlyphError" get-glyph-error) ft-error
 455   "Query a glyph for errors."
 456   (glyph glyph))
 457
 458 (defcfun ("ftglDestroyLayout" destroy-layout) :void
 459   "Destroy an FTGL layout object."
 460   (layout layout))
 461
 462 ;;(defcfun ("ftglGetLayoutBBox" get-layout-bbox) :void "Get the bounding box for a string." (layout layout) (string :string) (bounds (:pointer :float)))
 463
 464 (defcfun ("ftglRenderLayout" render-layout) :void
 465   "Render a string of characters."
 466   (layout layout)
 467   (string :string)
 468   (mode render-mode))
 469
 470 (defcfun ("ftglGetLayoutError" get-layout-error) ft-error
 471   "Query a layout for errors."
 472   (layout layout))