summaryrefslogtreecommitdiff
path: root/2d/wrappers
diff options
context:
space:
mode:
Diffstat (limited to '2d/wrappers')
-rw-r--r--2d/wrappers/ftgl.scm204
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)