[mcclim-cvs] CVS mcclim/Experimental/freetype

[rgoldman]

Update of /project/mcclim/cvsroot/mcclim/Experimental/freetype
In directory clnet:/tmp/cvs-serv21551

Added Files:
	freetype-cffi.lisp freetype-fonts-cffi.lisp 
	freetype-package-cffi.lisp mcclim-freetype-cffi.asd 
Log Message:
First shot at a CFFI-based freetype to replace sbcl/cmucl-specific original.


--- /project/mcclim/cvsroot/mcclim/Experimental/freetype/freetype-cffi.lisp	2006/05/25 19:23:22	NONE
+++ /project/mcclim/cvsroot/mcclim/Experimental/freetype/freetype-cffi.lisp	2006/05/25 19:23:22	1.1
;;; automatically generated, hand tweaked, do not regenerate.

(in-package :freetype)

(define-foreign-library libfreetype
    (:unix (:or "libfreetype.so.6" "libfreetype"))
  (t (:default "libfreetype")))
(use-foreign-library libfreetype)

(defmacro define-alien-type (&rest rest)
  ;; cffi seems to have a much simpler model of pointer
  ;; types... [2006/05/23:rpg]
  (cond ((and (= (length rest) 2)
	      (eq (car (second rest)) '*))
	 `(defctype ,(first rest) :pointer))
	((error "Don't understand how to translate alien type definition ~S"
		`(define-alien-type , at rest)))))  

(defmacro define-alien-routine (name retval &rest args)
  `(defcfun ,name ,retval
     ,@(loop for (name type) in args
	     for new-type = (if (and (listp type)
				     (eq (car type) '*))
				:pointer
				type)
	     collect (list name new-type))))

(defmacro defcstruct (name &rest slots)
  `(cffi:defcstruct ,name 
     ,@(loop for (name type) in slots
	     for new-type = (if (and (listp type)
				     (eq (car type) '*))
				:pointer
				type)
	     collect (list name new-type))))
				     
(declaim (optimize (speed 3)))

(define-alien-type freetype:memory (* (struct freetype::memory-rec-)))
(define-alien-type freetype:stream (* (struct freetype::stream-rec-)))
(define-alien-type freetype:raster (* (struct freetype::raster-rec-)))
(define-alien-type freetype:list-node (* (struct freetype::list-node-rec-)))
(define-alien-type freetype:list (* (struct freetype::list-rec-)))
(define-alien-type freetype:library (* (struct freetype::library-rec-)))
(define-alien-type freetype:module (* (struct freetype::module-rec-)))
(define-alien-type freetype:driver (* (struct freetype::driver-rec-)))
(define-alien-type freetype:renderer (* (struct freetype::renderer-rec-)))
(define-alien-type freetype:char-map (* (struct freetype::char-map-rec-)))
(define-alien-type freetype:face-internal (* (struct freetype::face-internal-rec-)))
(define-alien-type freetype:slot-internal (* (struct freetype::slot-internal-rec-)))
(define-alien-type freetype:size-internal (* (struct freetype::size-internal-rec-)))

(defctype freetype:int16 :int16)

(defctype freetype:uint16 :uint16)

(defctype freetype:int32 :int32)

(defctype freetype:uint32 :uint32)

(defctype freetype:fast :int32)

(defctype freetype:ufast :uint32)

(defctype freetype:ptrdiff-t :int32)

(defctype freetype:size-t :uint32)

(defctype freetype:wchar-t :int32)

(defctype freetype:wint-t :uint32)

(defctype freetype:bool :uint8)

(defctype freetype:fword :int16)

(defctype freetype:ufword :uint16)

(defctype freetype:char :int8)

(defctype freetype:byte :uint8)

(defctype freetype:string :int8)

(defctype freetype:short :int16)

(defctype freetype:ushort :uint16)

(defctype freetype:int :int32)

(defctype freetype:uint :uint32)

(defctype freetype:long :long)

(defctype freetype:ulong :unsigned-long)

(defctype freetype:f2dot14 :int16)

(defctype freetype:f26dot6 :long)

(defctype freetype:fixed :long)

(defctype freetype:error :int32)

(defctype freetype:pointer :pointer)

(defctype freetype:offset freetype:size-t)

(defctype freetype:ptr-dist freetype:size-t)

(define-alien-type freetype:face (* freetype:face-rec))


(defcenum mod-err
    (:mod-err-base #.#x000)
  (:mod-err-autohint #.#x100) (:mod-err-cache #.#x200) (:mod-err-cff #.#x300)
  (:mod-err-cid #.#x400) (:mod-err-pcf #.#x500) (:mod-err-psaux #.#x600) (:mod-err-psnames #.#x700) (:mod-err-raster #.#x800)
  (:mod-err-sfnt #.#x900) (:mod-err-smooth #.#xA00) (:mod-err-true-type #.#xB00) (:mod-err-type1 #.#xC00)
  (:mod-err-winfonts #.#xD00)
  :mod-err-max)

(defcenum error-enum
 (:err-ok #.#x00) (:err-cannot-open-resource #.(+ #x01 0)) (:err-unknown-file-format #.(+ #x02 0))
  (:err-invalid-file-format #.(+ #x03 0)) (:err-invalid-version #.(+ #x04 0)) (:err-lower-module-version #.(+ #x05 0))
  (:err-invalid-argument #.(+ #x06 0)) (:err-unimplemented-feature #.(+ #x07 0)) (:err-invalid-glyph-index #.(+ #x10 0))
  (:err-invalid-character-code #.(+ #x11 0)) (:err-invalid-glyph-format #.(+ #x12 0)) (:err-cannot-render-glyph #.(+ #x13 0))
  (:err-invalid-outline #.(+ #x14 0)) (:err-invalid-composite #.(+ #x15 0)) (:err-too-many-hints #.(+ #x16 0))
  (:err-invalid-pixel-size #.(+ #x17 0)) (:err-invalid-handle #.(+ #x20 0)) (:err-invalid-library-handle #.(+ #x21 0))
  (:err-invalid-driver-handle #.(+ #x22 0)) (:err-invalid-face-handle #.(+ #x23 0)) (:err-invalid-size-handle #.(+ #x24 0))
  (:err-invalid-slot-handle #.(+ #x25 0)) (:err-invalid-char-map-handle #.(+ #x26 0)) (:err-invalid-cache-handle #.(+ #x27 0))
  (:err-invalid-stream-handle #.(+ #x28 0)) (:err-too-many-drivers #.(+ #x30 0)) (:err-too-many-extensions #.(+ #x31 0))
  (:err-out-of-memory #.(+ #x40 0)) (:err-unlisted-object #.(+ #x41 0)) (:err-cannot-open-stream #.(+ #x51 0))
  (:err-invalid-stream-seek #.(+ #x52 0)) (:err-invalid-stream-skip #.(+ #x53 0)) (:err-invalid-stream-read #.(+ #x54 0))
  (:err-invalid-stream-operation #.(+ #x55 0)) (:err-invalid-frame-operation #.(+ #x56 0))
  (:err-nested-frame-access #.(+ #x57 0)) (:err-invalid-frame-read #.(+ #x58 0)) (:err-raster-uninitialized #.(+ #x60 0))
  (:err-raster-corrupted #.(+ #x61 0)) (:err-raster-overflow #.(+ #x62 0)) (:err-raster-negative-height #.(+ #x63 0))
  (:err-too-many-caches #.(+ #x70 0)) (:err-invalid-opcode #.(+ #x80 0)) (:err-too-few-arguments #.(+ #x81 0))
  (:err-stack-overflow #.(+ #x82 0)) (:err-code-overflow #.(+ #x83 0)) (:err-bad-argument #.(+ #x84 0))
  (:err-divide-by-zero #.(+ #x85 0)) (:err-invalid-reference #.(+ #x86 0)) (:err-debug-op-code #.(+ #x87 0))
  (:err-endf-in-exec-stream #.(+ #x88 0)) (:err-nested-defs #.(+ #x89 0)) (:err-invalid-code-range #.(+ #x8A 0))
  (:err-execution-too-long #.(+ #x8B 0)) (:err-too-many-function-defs #.(+ #x8C 0))
  (:err-too-many-instruction-defs #.(+ #x8D 0)) (:err-table-missing #.(+ #x8E 0)) (:err-horiz-header-missing #.(+ #x8F 0))
  (:err-locations-missing #.(+ #x90 0)) (:err-name-table-missing #.(+ #x91 0)) (:err-cmap-table-missing #.(+ #x92 0))
  (:err-hmtx-table-missing #.(+ #x93 0)) (:err-post-table-missing #.(+ #x94 0)) (:err-invalid-horiz-metrics #.(+ #x95 0))
  (:err-invalid-char-map-format #.(+ #x96 0)) (:err-invalid-ppem #.(+ #x97 0)) (:err-invalid-vert-metrics #.(+ #x98 0))
  (:err-could-not-find-context #.(+ #x99 0)) (:err-invalid-post-table-format #.(+ #x9A 0))
  (:err-invalid-post-table #.(+ #x9B 0)) (:err-syntax-error #.(+ #xA0 0)) (:err-stack-underflow #.(+ #xA1 0)) :err-max)

(defctype freetype:alloc-func :pointer)

(defctype freetype:free-func :pointer)

(defctype freetype:realloc-func :pointer)

(defcstruct freetype::memory-rec-
    (freetype:user :pointer) (freetype:alloc freetype:alloc-func) (freetype:free freetype:free-func)
  (freetype:realloc freetype:realloc-func))

(defcunion freetype:stream-desc 
      (freetype:value :long) 
      (freetype:pointer :pointer))

(defctype freetype:stream-io :pointer)

(defctype freetype:stream-close :pointer)

(defcstruct freetype::stream-rec-
            (freetype:base (* :uint8))
            (freetype:size freetype:ulong)
            (freetype:pos freetype:ulong)
            (freetype:descriptor freetype:stream-desc)
            (freetype:pathname freetype:stream-desc)
            (freetype:read freetype:stream-io)
            (freetype:close freetype:stream-close)
            (freetype:memory freetype:memory)
            (freetype:cursor (* :uint8))
            (freetype:limit (* :uint8)))

(defctype freetype:pos :long)

(defcstruct freetype:vector (freetype:x freetype:pos) (freetype:y freetype:pos))

(defcstruct freetype:bbox
    (freetype:x-min freetype:pos) (freetype:y-min freetype:pos) (freetype:x-max freetype:pos)
    (freetype:y-max freetype:pos))

;; seems like pixel-mode- might possibly be an alias for this...
(defcenum freetype:pixel-mode
    (:ft-pixel-mode-none #.#o0) :ft-pixel-mode-mono :ft-pixel-mode-grays :ft-pixel-mode-pal2
  :ft-pixel-mode-pal4 :ft-pixel-mode-pal8 :ft-pixel-mode-rgb15 :ft-pixel-mode-rgb16 :ft-pixel-mode-rgb24 :ft-pixel-mode-rgb32
  :ft-pixel-mode-max)

;;; palette-mode-
(defcenum freetype:palette-mode
 (:ft-palette-mode-rgb #.#o0) :ft-palette-mode-rgba :ft-palettte-mode-max)

(defcstruct freetype:bitmap
 (freetype:rows :int32) (freetype:width :int32) (freetype:pitch :int32)
  (freetype:buffer (* :uint8)) (freetype:num-grays :int16) (freetype:pixel-mode :int8)
  (freetype:palette-mode :int8) (freetype:palette :pointer))

(defcstruct freetype:outline
 (freetype:n-contours :int16) (freetype:n-points :int16)
  (freetype:points (* freetype:vector)) (freetype:tags (* :int8)) (freetype:contours (* :int16))
  (freetype:flags :int32))

(defcenum freetype:outline-flags
 (:ft-outline-none #.#o0) (:ft-outline-owner #.1) (:ft-outline-even-odd-fill #.2)
  (:ft-outline-reverse-fill #.4) (:ft-outline-ignore-dropouts #.8) (:ft-outline-high-precision #.256)
  (:ft-outline-single-pass #.512))

(defctype freetype:outline-move-to-func :pointer)

(defctype freetype:outline-line-to-func :pointer)

(defctype freetype:outline-conic-to-func :pointer)

(defctype freetype:outline-cubic-to-func :pointer)

(defcstruct freetype:outline-funcs
  (freetype:move-to freetype:outline-move-to-func)
  (freetype:line-to freetype:outline-line-to-func) (freetype:conic-to freetype:outline-conic-to-func)
  (freetype:cubic-to freetype:outline-cubic-to-func) (freetype:shift :int32) (freetype:delta freetype:pos))

(defcenum freetype:glyph-format
  (:ft-glyph-format-none #.(logior (logior (logior (ash #o0 24) (ash #o0 16)) (ash #o0 8)) #o0))
  (:ft-glyph-format-composite
   #.(logior (logior (logior (ash #.(char-code #\c) 24) (ash #.(char-code #\o) 16)) (ash #.(char-code #\m) 8))
             #.(char-code #\p)))
  (:ft-glyph-format-bitmap
   #.(logior (logior (logior (ash #.(char-code #\b) 24) (ash #.(char-code #\i) 16)) (ash #.(char-code #\t) 8))
             #.(char-code #\s)))
  (:ft-glyph-format-outline
   #.(logior (logior (logior (ash #.(char-code #\o) 24) (ash #.(char-code #\u) 16)) (ash #.(char-code #\t) 8))
             #.(char-code #\l)))
  (:ft-glyph-format-plotter
   #.(logior (logior (logior (ash #.(char-code #\p) 24) (ash #.(char-code #\l) 16)) (ash #.(char-code #\o) 8))
             #.(char-code #\t))))

(defcstruct freetype:span
  (freetype:x :int16) (freetype:len :uint16) (freetype:coverage :uint8))

(defctype freetype:raster-span-func :pointer)

(defctype freetype:raster-bit-test-func :pointer)

(defctype freetype:raster-bit-set-func :pointer)

(defcenum freetype:raster-flag
  (:ft-raster-flag-default #.#o0) (:ft-raster-flag-aa #.1) (:ft-raster-flag-direct #.2) (:ft-raster-flag-clip #.4))

(defcstruct freetype:raster-params
  (freetype:target (* freetype:bitmap)) (freetype:source :pointer) (freetype:flags :int32)
  (freetype:gray-spans freetype:raster-span-func) (freetype:black-spans freetype:raster-span-func)
  (freetype:bit-test freetype:raster-bit-test-func) (freetype:bit-set freetype:raster-bit-set-func) (freetype:user :pointer)
  (freetype:clip-box freetype:bbox))

(defctype freetype:raster-new-func :pointer)

(defctype freetype:raster-done-func :pointer)

(defctype freetype:raster-reset-func :pointer)

(defctype freetype:raster-set-mode-func :pointer)

(defctype freetype:raster-render-func :pointer)

(defcstruct freetype:raster-funcs
 (freetype:glyph-format freetype:glyph-format) (freetype:raster-new freetype:raster-new-func)
  (freetype:raster-reset freetype:raster-reset-func) (freetype:raster-set-mode freetype:raster-set-mode-func)
  (freetype:raster-render freetype:raster-render-func) (freetype:raster-done freetype:raster-done-func))

(defcstruct freetype:unit-vector
 (freetype:x freetype:f2dot14) (freetype:y freetype:f2dot14))

(defcstruct freetype:matrix
 (freetype:xx freetype:fixed) (freetype:xy freetype:fixed) (freetype:yx freetype:fixed)
  (freetype:yy freetype:fixed))

(defctype freetype:generic-finalizer :pointer)

(defcstruct freetype:generic
 (freetype:data :pointer) (freetype:finalizer freetype:generic-finalizer))

(defcstruct freetype:list-node-rec
 (freetype:prev freetype:list-node) (freetype:next freetype:list-node) (freetype:data :pointer))

(defcstruct freetype:list-rec
 (freetype:head freetype:list-node) (freetype:tail freetype:list-node))

(defcstruct freetype:glyph-metrics
 (freetype:width freetype:pos) (freetype:height freetype:pos)
  (freetype:hori-bearing-x freetype:pos) (freetype:hori-bearing-y freetype:pos) (freetype:hori-advance freetype:pos)
  (freetype:vert-bearing-x freetype:pos) (freetype:vert-bearing-y freetype:pos) (freetype:vert-advance freetype:pos))

(defcstruct freetype:bitmap-size
 (freetype:height freetype:short) (freetype:width freetype:short))

(defctype freetype:sub-glyph :pointer)
;;    (struct freetype::sub-glyph-))

(defcstruct freetype:glyph-slot-rec
 (freetype:library freetype:library) (freetype:face (* (struct freetype::face-rec-)))
  (freetype:next (* (struct freetype::glyph-slot-rec-))) (freetype:flags freetype:uint) (freetype:generic freetype:generic)
  (freetype:metrics freetype:glyph-metrics) (freetype:linear-hori-advance freetype:fixed)
  (freetype:linear-vert-advance freetype:fixed) (freetype:advance freetype:vector) (freetype:format freetype:glyph-format)
  (freetype:bitmap freetype:bitmap) (freetype:bitmap-left freetype:int) (freetype:bitmap-top freetype:int)
  (freetype:outline freetype:outline) (freetype:num-subglyphs freetype:uint) (freetype:subglyphs (* freetype:sub-glyph))
  (freetype:control-data :pointer) (freetype:control-len :long) (freetype:other :pointer)
  (freetype:internal freetype:slot-internal))

(defcstruct freetype:size-metrics
 (freetype:x-ppem freetype:ushort) (freetype:y-ppem freetype:ushort)
  (freetype:x-scale freetype:fixed) (freetype:y-scale freetype:fixed) (freetype:ascender freetype:pos)
  (freetype:descender freetype:pos) (freetype:height freetype:pos) (freetype:max-advance freetype:pos))

(defcstruct freetype:size-rec
 (freetype:face (* (struct freetype::face-rec-))) (freetype:generic freetype:generic)
  (freetype:metrics freetype:size-metrics) (freetype:internal freetype:size-internal))

(defcstruct freetype:face-rec
 (freetype:num-faces freetype:long) (freetype:face-index freetype:long)
            (freetype:face-flags freetype:long) (freetype:style-flags freetype:long) (freetype:num-glyphs freetype:long)
            (freetype:family-name (* freetype:string)) (freetype:style-name (* freetype:string)) (freetype:num-fixed-sizes freetype:int)
            (freetype:available-sizes (* freetype:bitmap-size)) (freetype:num-charmaps freetype:int)
            (freetype:charmaps (* freetype:char-map)) (freetype:generic freetype:generic) (freetype:bbox freetype:bbox)
            (freetype:units-per-em freetype:ushort) (freetype:ascender freetype:short) (freetype:descender freetype:short)
            (freetype:height freetype:short) (freetype:max-advance-width freetype:short) (freetype:max-advance-height freetype:short)
            (freetype:underline-position freetype:short) (freetype:underline-thickness freetype:short)
            (freetype:glyph (* (struct freetype::glyph-slot-rec-)))
	    (freetype:size_s (* (struct freetype:size-rec))) (freetype:charmap freetype:char-map)
            (freetype:driver freetype:driver) (freetype:memory freetype:memory) (freetype:stream freetype:stream)
            (freetype:sizes-list freetype:list-rec) (freetype:autohint freetype:generic) (freetype:extensions :pointer)
            (freetype:internal freetype:face-internal))

(defcstruct freetype:size-rec
    (freetype:face (* freetype:face-rec))
  (freetype:generic freetype:generic)
  (freetype:metrics freetype:size-metrics)
  (freetype:internal freetype:size-internal))

(defcstruct freetype:glyph-slot-rec
 (freetype:library freetype:library) (freetype:face (* freetype:face-rec))
  (freetype:next (* (struct freetype::glyph-slot-rec-))) (freetype:flags freetype:uint) (freetype:generic freetype:generic)
  (freetype:metrics freetype:glyph-metrics) (freetype:linear-hori-advance freetype:fixed)
  (freetype:linear-vert-advance freetype:fixed) (freetype:advance freetype:vector) (freetype:format freetype:glyph-format)
  (freetype:bitmap freetype:bitmap) (freetype:bitmap-left freetype:int) (freetype:bitmap-top freetype:int)
  (freetype:outline freetype:outline) (freetype:num-subglyphs freetype:uint) (freetype:subglyphs (* freetype:sub-glyph))
  (freetype:control-data :pointer) (freetype:control-len :long) (freetype:other :pointer)
  (freetype:internal freetype:slot-internal))

(define-alien-type freetype:glyph-slot (* freetype:glyph-slot-rec))
(define-alien-type freetype:size (* freetype:size-rec))

(define-alien-routine ("FT_Init_FreeType" freetype:init-free-type) freetype:error (freetype::alibrary (* freetype:library)))

(define-alien-routine ("FT_Done_FreeType" freetype:done-free-type) freetype:error (freetype:library freetype:library))

(defcenum freetype:open-flags
  (:ft-open-memory #.1) (:ft-open-stream #.2) (:ft-open-pathname #.4) (:ft-open-driver #.8) (:ft-open-params #.16))

(defcstruct freetype:parameter (freetype:tag freetype:ulong) (freetype:data freetype:pointer))

(defcstruct freetype:open-args
 (freetype:flags freetype:open-flags) (freetype:memory-base (* freetype:byte))
  (freetype:memory-size freetype:long) (freetype:pathname (* freetype:string)) (freetype:stream freetype:stream)
  (freetype:driver freetype:module) (freetype:num-params freetype:int) (freetype:params (* freetype:parameter)))

(define-alien-routine ("FT_New_Face" freetype:new-face) freetype:error
  (freetype:library freetype:library)
  (freetype::filepathname :string)
  (freetype::face_index freetype:long)
  ;; this is a pointer to a pointer to a face-rec...
  (freetype::aface (* (* freetype:face-rec))))

(define-alien-routine ("FT_New_Memory_Face" freetype:new-memory-face) freetype:error (freetype:library freetype:library)
 (freetype::file_base (* freetype:byte)) (freetype::file_size freetype:long) (freetype::face_index freetype:long)
 (freetype::aface (* freetype:face)))

(define-alien-routine ("FT_Open_Face" freetype:open-face) freetype:error (freetype:library freetype:library)
 (freetype::args (* freetype:open-args)) (freetype::face_index freetype:long) (freetype::aface (* freetype:face)))

(define-alien-routine ("FT_Attach_File" freetype:attach-file) freetype:error (freetype:face freetype:face)
 (freetype::filepathname (* :int8)))

(define-alien-routine ("FT_Attach_Stream" freetype:attach-stream) freetype:error (freetype:face freetype:face)
 (freetype::parameters (* freetype:open-args)))

(define-alien-routine ("FT_Done_Face" freetype:done-face) freetype:error (freetype:face freetype:face))

(define-alien-routine ("FT_Set_Char_Size" freetype:set-char-size) freetype:error (freetype:face freetype:face)
 (freetype::char_width freetype:f26dot6) (freetype::char_height freetype:f26dot6) (freetype::horz_resolution freetype:uint)
 (freetype::vert_resolution freetype:uint))

(define-alien-routine ("FT_Set_Pixel_Sizes" freetype:set-pixel-sizes) freetype:error (freetype:face freetype:face)
 (freetype::pixel_width freetype:uint) (freetype::pixel_height freetype:uint))

(define-alien-routine ("FT_Load_Glyph" freetype:load-glyph) freetype:error (freetype:face freetype:face)
 (freetype::glyph_index freetype:uint) (freetype::load_flags freetype:int))


[90 lines skipped]
--- /project/mcclim/cvsroot/mcclim/Experimental/freetype/freetype-fonts-cffi.lisp	2006/05/25 19:23:22	NONE
+++ /project/mcclim/cvsroot/mcclim/Experimental/freetype/freetype-fonts-cffi.lisp	2006/05/25 19:23:22	1.1

[725 lines skipped]
--- /project/mcclim/cvsroot/mcclim/Experimental/freetype/freetype-package-cffi.lisp	2006/05/25 19:23:22	NONE
+++ /project/mcclim/cvsroot/mcclim/Experimental/freetype/freetype-package-cffi.lisp	2006/05/25 19:23:22	1.1

[807 lines skipped]
--- /project/mcclim/cvsroot/mcclim/Experimental/freetype/mcclim-freetype-cffi.asd	2006/05/25 19:23:22	NONE
+++ /project/mcclim/cvsroot/mcclim/Experimental/freetype/mcclim-freetype-cffi.asd	2006/05/25 19:23:22	1.1

[893 lines skipped]