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