diff options
Diffstat (limited to '2d/wrappers/ftgl.scm')
| -rw-r--r-- | 2d/wrappers/ftgl.scm | 204 |
1 files changed, 0 insertions, 204 deletions
diff --git a/2d/wrappers/ftgl.scm b/2d/wrappers/ftgl.scm deleted file mode 100644 index 1ff42d7..0000000 --- a/2d/wrappers/ftgl.scm +++ /dev/null @@ -1,204 +0,0 @@ -;;; 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) - #:use-module (ice-9 format)) - -(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-foreign %ftgl-get-font-descender - float "ftglGetFontDescender" '(*)) - -(define-foreign %ftgl-get-font-ascender - float "ftglGetFontAscender" '(*)) - -(define (ftgl-create-texture-font filename) - (unless (file-exists? filename) - (throw 'font-not-found filename)) - (let ((font (%ftgl-create-texture-font (string->pointer filename)))) - (when (null-pointer? font) - (throw 'font-load-failure filename)) - (wrap-ftgl-font font))) - -(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)) - -(define (ftgl-get-font-descender font) - (%ftgl-get-font-descender (unwrap-ftgl-font font))) - -(define (ftgl-get-font-ascender font) - (%ftgl-get-font-ascender (unwrap-ftgl-font font))) - -(export ftgl-create-texture-font - ftgl-set-font-face-size - ftgl-render-font - ftgl-get-font-descender - ftgl-get-font-ascender) - -;;; -;;; SimpleLayout -;;; - -(define-wrapped-pointer-type <ftgl-simple-layout> - ftgl-simple-layout? - wrap-ftgl-simple-layout unwrap-ftgl-simple-layout - (lambda (r port) - (let ((simple-layout (unwrap-ftgl-simple-layout r))) - (format port - "<ftgl-simple-layout ~x>" - (pointer-address simple-layout))))) - -(define-foreign %ftgl-create-simple-layout - '* "ftglCreateSimpleLayout" '()) - -(define-foreign %ftgl-destroy-layout - void "ftglDestroyLayout" '(*)) - -(define-foreign %ftgl-set-layout-font - void "ftglSetLayoutFont" '(* *)) - -(define-foreign %ftgl-get-layout-font - '* "ftglGetLayoutFont" '(*)) - -(define-foreign %ftgl-set-layout-line-length - void "ftglSetLayoutLineLength" (list '* float)) - -(define-foreign %ftgl-get-layout-line-length - float "ftglGetLayoutLineLength" '(*)) - -(define-foreign %ftgl-set-layout-alignment - void "ftglSetLayoutAlignment" (list '* int)) - -(define-foreign %ftgl-get-layout-alignment - int "ftglGetLayoutAlignement" '(*)) - -(define-foreign %ftgl-set-layout-line-spacing - void "ftglSetLayoutLineSpacing" (list '* float)) - -;; For some reason this symbol is not found. -;; (define-foreign %ftgl-get-layout-line-spacing -;; float "ftglGetLayoutLineSpacing" '(*)) - -(define-foreign %ftgl-render-layout - void "ftglRenderLayout" (list '* '* int)) - -(define (ftgl-create-layout) - (wrap-ftgl-simple-layout - (%ftgl-create-simple-layout))) - -(define (ftgl-destroy-layout layout) - (%ftgl-destroy-layout (unwrap-ftgl-simple-layout layout))) - -(define (ftgl-set-layout-font layout font) - (%ftgl-set-layout-font (unwrap-ftgl-simple-layout layout) - (unwrap-ftgl-font font))) - -(define (ftgl-get-layout-font layout) - (wrap-ftgl-font - (%ftgl-get-layout-font (unwrap-ftgl-simple-layout layout)))) - -(define (ftgl-set-layout-line-length layout line-length) - (%ftgl-set-layout-line-length (unwrap-ftgl-simple-layout layout) - line-length)) - -(define (ftgl-get-layout-line-length layout) - (%ftgl-get-layout-line-length (unwrap-ftgl-simple-layout layout))) - -(define (ftgl-set-layout-alignment layout alignment) - (%ftgl-set-layout-alignment (unwrap-ftgl-simple-layout layout) - alignment)) - -(define (ftgl-get-layout-alignment layout) - (%ftgl-get-layout-alignment (unwrap-ftgl-simple-layout layout))) - -(define (ftgl-set-layout-line-spacing layout spacing) - (%ftgl-set-layout-line-spacing (unwrap-ftgl-simple-layout layout) - spacing)) - -(define (ftgl-render-layout layout text mode) - (%ftgl-render-layout (unwrap-ftgl-simple-layout layout) - (string->pointer text) - mode)) - -(export ftgl-create-layout - ftgl-destroy-layout - ftgl-set-layout-font - ftgl-get-layout-font - ftgl-set-layout-line-length - ftgl-get-layout-line-length - ftgl-set-layout-alignment - ftgl-get-layout-alignment - ftgl-set-layout-line-spacing - ftgl-render-layout) |