summaryrefslogtreecommitdiff
path: root/2d
diff options
context:
space:
mode:
Diffstat (limited to '2d')
-rw-r--r--2d/wrappers/ftgl.scm89
1 files changed, 89 insertions, 0 deletions
diff --git a/2d/wrappers/ftgl.scm b/2d/wrappers/ftgl.scm
new file mode 100644
index 0000000..6c94840
--- /dev/null
+++ b/2d/wrappers/ftgl.scm
@@ -0,0 +1,89 @@
+;;; guile-2d
+;;; Copyright (C) 2013 David Thompson <dthompson2@worcester.edu>
+;;;
+;;; Guile-2d is free software: you can redistribute it and/or modify it
+;;; under the terms of the GNU Lesser General Public License as
+;;; published by the Free Software Foundation, either version 3 of the
+;;; License, or (at your option) any later version.
+;;;
+;;; Guile-2d is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;; Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this program. If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Quick and dirty wrapper for the FTGL library.
+;;
+;;; Code:
+
+(define-module (2d wrappers ftgl)
+ #:use-module (system foreign)
+ #:use-module (2d wrappers util))
+
+(define libftgl (dynamic-link "libftgl"))
+
+(define-syntax-rule (define-foreign name ret string-name args)
+ (define name
+ (pointer->procedure ret (dynamic-func string-name libftgl) args)))
+
+;;;
+;;; Enums
+;;;
+
+(define-enumeration ftgl-render-mode
+ (front #x0001)
+ (back #x0002)
+ (side #x0004)
+ (all #xffff))
+
+(define-enumeration ftgl-text-alignment
+ (left 0)
+ (center 1)
+ (right 2)
+ (justify 3))
+
+(export ftgl-render-mode
+ ftgl-text-alignment)
+
+;;;
+;;; Fonts
+;;;
+
+(define-wrapped-pointer-type <ftgl-font>
+ ftgl-font?
+ wrap-ftgl-font unwrap-ftgl-font
+ (lambda (r port)
+ (let ((font (unwrap-ftgl-font r)))
+ (format port
+ "<ftgl-font ~x>"
+ (pointer-address font)))))
+
+(define-foreign %ftgl-create-texture-font
+ '* "ftglCreateTextureFont" '(*))
+
+(define-foreign %ftgl-set-font-face-size
+ void "ftglSetFontFaceSize" (list '* unsigned-int unsigned-int))
+
+(define-foreign %ftgl-render-font
+ void "ftglRenderFont" (list '* '* unsigned-int))
+
+(define (ftgl-create-texture-font filename)
+ (wrap-ftgl-font
+ (%ftgl-create-texture-font (string->pointer filename))))
+
+(define (ftgl-set-font-face-size font size res)
+ (%ftgl-set-font-face-size (unwrap-ftgl-font font) size res))
+
+(define (ftgl-render-font font text render-mode)
+ (%ftgl-render-font (unwrap-ftgl-font font)
+ (string->pointer text)
+ render-mode))
+
+(export ftgl-create-texture-font
+ ftgl-set-font-face-size
+ ftgl-render-font)