]> git.jsancho.org Git - guile-assimp.git/commitdiff
Praparing for autoconf
authorJavier Sancho <jsf@jsancho.org>
Thu, 7 Aug 2014 11:18:28 +0000 (13:18 +0200)
committerJavier Sancho <jsf@jsancho.org>
Thu, 7 Aug 2014 11:18:28 +0000 (13:18 +0200)
28 files changed:
Makefile.am [new file with mode: 0644]
acinclude.m4 [new file with mode: 0644]
assimp.scm [new file with mode: 0644]
assimp/low-level.scm [new file with mode: 0644]
assimp/low-level/cimport.scm [new file with mode: 0644]
assimp/low-level/color.scm [new file with mode: 0644]
assimp/low-level/material.scm [new file with mode: 0644]
assimp/low-level/matrix.scm [new file with mode: 0644]
assimp/low-level/mesh.scm [new file with mode: 0644]
assimp/low-level/postprocess.scm [new file with mode: 0644]
assimp/low-level/scene.scm [new file with mode: 0644]
assimp/low-level/types.scm [new file with mode: 0644]
assimp/low-level/vector.scm [new file with mode: 0644]
configure.ac [new file with mode: 0644]
env.in [new file with mode: 0644]
examples/sample-figl/sample-figl.scm
guile.am [new file with mode: 0644]
src/assimp.scm [deleted file]
src/low-level.scm [deleted file]
src/low-level/cimport.scm [deleted file]
src/low-level/color.scm [deleted file]
src/low-level/material.scm [deleted file]
src/low-level/matrix.scm [deleted file]
src/low-level/mesh.scm [deleted file]
src/low-level/postprocess.scm [deleted file]
src/low-level/scene.scm [deleted file]
src/low-level/types.scm [deleted file]
src/low-level/vector.scm [deleted file]

diff --git a/Makefile.am b/Makefile.am
new file mode 100644 (file)
index 0000000..a9dc6ef
--- /dev/null
@@ -0,0 +1,39 @@
+## Process this file with automake to produce Makefile.in.
+##
+## guile-assimp, foreign interface to libassimp
+## Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
+##
+## This program is free software: you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation, either version 3 of the License, or
+## (at your option) any later version.
+##
+## This program 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 General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+include guile.am
+
+moddir=$(prefix)/share/guile/site/$(GUILE_EFFECTIVE_VERSION)
+godir=$(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/ccache
+
+SOURCES = \
+       assimp.scm \
+       assimp/low-level.scm \
+       assimp/low-level/cimport.scm \
+       assimp/low-level/color.scm \
+       assimp/low-level/material.scm \
+       assimp/low-level/matrix.scm \
+       assimp/low-level/mesh.scm \
+       assimp/low-level/postprocess.scm \
+       assimp/low-level/scene.scm \
+       assimp/low-level/types.scm \
+       assimp/low-level/vector.scm
+
+EXTRA_DIST += env.in COPYING examples README
+
+TESTS_ENVIRONMENT = $(top_builddir)/env $(GUILE) --no-auto-compile
diff --git a/acinclude.m4 b/acinclude.m4
new file mode 100644 (file)
index 0000000..441dcd4
--- /dev/null
@@ -0,0 +1,341 @@
+## Autoconf macros for working with Guile.
+##
+##   Copyright (C) 1998,2001, 2006, 2010, 2012, 2013, 2014 Free Software Foundation, Inc.
+##
+## This library 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.
+##
+## This library 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 library; if not, write to the Free Software
+## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+## 02110-1301 USA
+
+# serial 10
+
+## Index
+## -----
+##
+## GUILE_PKG -- find Guile development files
+## GUILE_PROGS -- set paths to Guile interpreter, config and tool programs
+## GUILE_FLAGS -- set flags for compiling and linking with Guile
+## GUILE_SITE_DIR -- find path to Guile "site" directory
+## GUILE_CHECK -- evaluate Guile Scheme code and capture the return value
+## GUILE_MODULE_CHECK -- check feature of a Guile Scheme module
+## GUILE_MODULE_AVAILABLE -- check availability of a Guile Scheme module
+## GUILE_MODULE_REQUIRED -- fail if a Guile Scheme module is unavailable
+## GUILE_MODULE_EXPORTS -- check if a module exports a variable
+## GUILE_MODULE_REQUIRED_EXPORT -- fail if a module doesn't export a variable
+
+## Code
+## ----
+
+## NOTE: Comments preceding an AC_DEFUN (starting from "Usage:") are massaged
+## into doc/ref/autoconf-macros.texi (see Makefile.am in that directory).
+
+# GUILE_PKG -- find Guile development files
+#
+# Usage: GUILE_PKG([VERSIONS])
+#
+# This macro runs the @code{pkg-config} tool to find development files
+# for an available version of Guile.
+#
+# By default, this macro will search for the latest stable version of
+# Guile (e.g. 2.0), falling back to the previous stable version
+# (e.g. 1.8) if it is available.  If no guile-@var{VERSION}.pc file is
+# found, an error is signalled.  The found version is stored in
+# @var{GUILE_EFFECTIVE_VERSION}.
+#
+# If @code{GUILE_PROGS} was already invoked, this macro ensures that the
+# development files have the same effective version as the Guile
+# program.
+#
+# @var{GUILE_EFFECTIVE_VERSION} is marked for substitution, as by
+# @code{AC_SUBST}.
+#
+AC_DEFUN([GUILE_PKG],
+ [PKG_PROG_PKG_CONFIG
+  _guile_versions_to_search="m4_default([$1], [2.0 1.8])"
+  if test -n "$GUILE_EFFECTIVE_VERSION"; then
+    _guile_tmp=""
+    for v in $_guile_versions_to_search; do
+      if test "$v" = "$GUILE_EFFECTIVE_VERSION"; then
+        _guile_tmp=$v
+      fi
+    done
+    if test -z "$_guile_tmp"; then
+      AC_MSG_FAILURE([searching for guile development files for versions $_guile_versions_to_search, but previously found $GUILE version $GUILE_EFFECTIVE_VERSION])
+    fi
+    _guile_versions_to_search=$GUILE_EFFECTIVE_VERSION
+  fi
+  GUILE_EFFECTIVE_VERSION=""
+  _guile_errors=""
+  for v in $_guile_versions_to_search; do
+    if test -z "$GUILE_EFFECTIVE_VERSION"; then
+      AC_MSG_NOTICE([checking for guile $v])
+      PKG_CHECK_EXISTS([guile-$v], [GUILE_EFFECTIVE_VERSION=$v], [])
+    fi
+  done
+
+  if test -z "$GUILE_EFFECTIVE_VERSION"; then
+    AC_MSG_ERROR([
+No Guile development packages were found.
+
+Please verify that you have Guile installed.  If you installed Guile
+from a binary distribution, please verify that you have also installed
+the development packages.  If you installed it yourself, you might need
+to adjust your PKG_CONFIG_PATH; see the pkg-config man page for more.
+])
+  fi
+  AC_MSG_NOTICE([found guile $GUILE_EFFECTIVE_VERSION])
+  AC_SUBST([GUILE_EFFECTIVE_VERSION])
+ ])
+
+# GUILE_FLAGS -- set flags for compiling and linking with Guile
+#
+# Usage: GUILE_FLAGS
+#
+# This macro runs the @code{pkg-config} tool to find out how to compile
+# and link programs against Guile.  It sets four variables:
+# @var{GUILE_CFLAGS}, @var{GUILE_LDFLAGS}, @var{GUILE_LIBS}, and
+# @var{GUILE_LTLIBS}.
+#
+# @var{GUILE_CFLAGS}: flags to pass to a C or C++ compiler to build code that
+# uses Guile header files.  This is almost always just one or more @code{-I}
+# flags.
+#
+# @var{GUILE_LDFLAGS}: flags to pass to the compiler to link a program
+# against Guile.  This includes @code{-lguile-@var{VERSION}} for the
+# Guile library itself, and may also include one or more @code{-L} flag
+# to tell the compiler where to find the libraries.  But it does not
+# include flags that influence the program's runtime search path for
+# libraries, and will therefore lead to a program that fails to start,
+# unless all necessary libraries are installed in a standard location
+# such as @file{/usr/lib}.
+#
+# @var{GUILE_LIBS} and @var{GUILE_LTLIBS}: flags to pass to the compiler or to
+# libtool, respectively, to link a program against Guile.  It includes flags
+# that augment the program's runtime search path for libraries, so that shared
+# libraries will be found at the location where they were during linking, even
+# in non-standard locations.  @var{GUILE_LIBS} is to be used when linking the
+# program directly with the compiler, whereas @var{GUILE_LTLIBS} is to be used
+# when linking the program is done through libtool.
+#
+# The variables are marked for substitution, as by @code{AC_SUBST}.
+#
+AC_DEFUN([GUILE_FLAGS],
+ [AC_REQUIRE([GUILE_PKG])
+  PKG_CHECK_MODULES(GUILE, [guile-$GUILE_EFFECTIVE_VERSION])
+
+  dnl GUILE_CFLAGS and GUILE_LIBS are already defined and AC_SUBST'd by
+  dnl PKG_CHECK_MODULES.  But GUILE_LIBS to pkg-config is GUILE_LDFLAGS
+  dnl to us.
+
+  GUILE_LDFLAGS=$GUILE_LIBS
+
+  dnl Determine the platform dependent parameters needed to use rpath.
+  dnl AC_LIB_LINKFLAGS_FROM_LIBS is defined in gnulib/m4/lib-link.m4 and needs
+  dnl the file gnulib/build-aux/config.rpath.
+  AC_LIB_LINKFLAGS_FROM_LIBS([GUILE_LIBS], [$GUILE_LDFLAGS], [])
+  GUILE_LIBS="$GUILE_LDFLAGS $GUILE_LIBS"
+  AC_LIB_LINKFLAGS_FROM_LIBS([GUILE_LTLIBS], [$GUILE_LDFLAGS], [yes])
+  GUILE_LTLIBS="$GUILE_LDFLAGS $GUILE_LTLIBS"
+
+  AC_SUBST([GUILE_EFFECTIVE_VERSION])
+  AC_SUBST([GUILE_CFLAGS])
+  AC_SUBST([GUILE_LDFLAGS])
+  AC_SUBST([GUILE_LIBS])
+  AC_SUBST([GUILE_LTLIBS])
+ ])
+
+# GUILE_SITE_DIR -- find path to Guile "site" directory
+#
+# Usage: GUILE_SITE_DIR
+#
+# This looks for Guile's "site" directory, usually something like
+# PREFIX/share/guile/site, and sets var @var{GUILE_SITE} to the path.
+# Note that the var name is different from the macro name.
+#
+# The variable is marked for substitution, as by @code{AC_SUBST}.
+#
+AC_DEFUN([GUILE_SITE_DIR],
+ [AC_REQUIRE([GUILE_PKG])
+  AC_MSG_CHECKING(for Guile site directory)
+  GUILE_SITE=`$PKG_CONFIG --print-errors --variable=sitedir guile-$GUILE_EFFECTIVE_VERSION`
+  AC_MSG_RESULT($GUILE_SITE)
+  if test "$GUILE_SITE" = ""; then
+     AC_MSG_FAILURE(sitedir not found)
+  fi
+  AC_SUBST(GUILE_SITE)
+ ])
+
+# GUILE_PROGS -- set paths to Guile interpreter, config and tool programs
+#
+# Usage: GUILE_PROGS([VERSION])
+#
+# This macro looks for programs @code{guile} and @code{guild}, setting
+# variables @var{GUILE} and @var{GUILD} to their paths, respectively.
+# If @code{guile} is not found, signal an error.
+#
+# By default, this macro will search for the latest stable version of
+# Guile (e.g. 2.0). x.y or x.y.z versions can be specified. If an older
+# version is found, the macro will signal an error.
+#
+# The effective version of the found @code{guile} is set to
+# @var{GUILE_EFFECTIVE_VERSION}.  This macro ensures that the effective
+# version is compatible with the result of a previous invocation of
+# @code{GUILE_FLAGS}, if any.
+#
+# As a legacy interface, it also looks for @code{guile-config} and
+# @code{guile-tools}, setting @var{GUILE_CONFIG} and @var{GUILE_TOOLS}.
+#
+# The variables are marked for substitution, as by @code{AC_SUBST}.
+#
+AC_DEFUN([GUILE_PROGS],
+ [AC_PATH_PROG(GUILE,guile)
+  _guile_required_version="m4_default([$1], [$GUILE_EFFECTIVE_VERSION])"
+  if test -z "$_guile_required_version"; then
+    _guile_required_version=2.0
+  fi
+  if test "$GUILE" = "" ; then
+      AC_MSG_ERROR([guile required but not found])
+  fi
+  AC_SUBST(GUILE)
+
+  _guile_effective_version=`$GUILE -c "(display (effective-version))"`
+  if test -z "$GUILE_EFFECTIVE_VERSION"; then
+    GUILE_EFFECTIVE_VERSION=$_guile_effective_version
+  elif test "$GUILE_EFFECTIVE_VERSION" != "$_guile_effective_version"; then
+    AC_MSG_ERROR([found development files for Guile $GUILE_EFFECTIVE_VERSION, but $GUILE has effective version $_guile_effective_version])
+  fi
+
+  _guile_major_version=`$GUILE -c "(display (major-version))"`
+  _guile_minor_version=`$GUILE -c "(display (minor-version))"`
+  _guile_micro_version=`$GUILE -c "(display (micro-version))"`
+  _guile_prog_version="$_guile_major_version.$_guile_minor_version.$_guile_micro_version"
+
+  AC_MSG_CHECKING([for Guile version >= $_guile_required_version])
+  _major_version=`echo $_guile_required_version | cut -d . -f 1`
+  _minor_version=`echo $_guile_required_version | cut -d . -f 2`
+  _micro_version=`echo $_guile_required_version | cut -d . -f 3`
+  if test "$_guile_major_version" -ge "$_major_version"; then
+    if test "$_guile_minor_version" -ge "$_minor_version"; then
+      if test -n "$_micro_version"; then
+        if test "$_guile_micro_version" -lt "$_micro_version"; then
+          AC_MSG_ERROR([Guile $_guile_required_version required, but $_guile_prog_version found])
+        fi
+      fi
+    elif test "$GUILE_EFFECTIVE_VERSION" == "$_major_version.$_minor_version" -a -z "$_micro_version"; then
+      # Allow prereleases that have the right effective version.
+      true
+    else
+      as_fn_error $? "Guile $_guile_required_version required, but $_guile_prog_version found" "$LINENO" 5
+    fi
+  else
+    AC_MSG_ERROR([Guile $_guile_required_version required, but $_guile_prog_version found])
+  fi
+  AC_MSG_RESULT([$_guile_prog_version])
+
+  AC_PATH_PROG(GUILD,guild)
+  AC_SUBST(GUILD)
+
+  AC_PATH_PROG(GUILE_CONFIG,guile-config)
+  AC_SUBST(GUILE_CONFIG)
+  if test -n "$GUILD"; then
+    GUILE_TOOLS=$GUILD
+  else
+    AC_PATH_PROG(GUILE_TOOLS,guile-tools)
+  fi
+  AC_SUBST(GUILE_TOOLS)
+ ])
+
+# GUILE_CHECK -- evaluate Guile Scheme code and capture the return value
+#
+# Usage: GUILE_CHECK_RETVAL(var,check)
+#
+# @var{var} is a shell variable name to be set to the return value.
+# @var{check} is a Guile Scheme expression, evaluated with "$GUILE -c", and
+#    returning either 0 or non-#f to indicate the check passed.
+#    Non-0 number or #f indicates failure.
+#    Avoid using the character "#" since that confuses autoconf.
+#
+AC_DEFUN([GUILE_CHECK],
+ [AC_REQUIRE([GUILE_PROGS])
+  $GUILE -c "$2" > /dev/null 2>&1
+  $1=$?
+ ])
+
+# GUILE_MODULE_CHECK -- check feature of a Guile Scheme module
+#
+# Usage: GUILE_MODULE_CHECK(var,module,featuretest,description)
+#
+# @var{var} is a shell variable name to be set to "yes" or "no".
+# @var{module} is a list of symbols, like: (ice-9 common-list).
+# @var{featuretest} is an expression acceptable to GUILE_CHECK, q.v.
+# @var{description} is a present-tense verb phrase (passed to AC_MSG_CHECKING).
+#
+AC_DEFUN([GUILE_MODULE_CHECK],
+         [AC_MSG_CHECKING([if $2 $4])
+         GUILE_CHECK($1,(use-modules $2) (exit ((lambda () $3))))
+         if test "$$1" = "0" ; then $1=yes ; else $1=no ; fi
+          AC_MSG_RESULT($$1)
+         ])
+
+# GUILE_MODULE_AVAILABLE -- check availability of a Guile Scheme module
+#
+# Usage: GUILE_MODULE_AVAILABLE(var,module)
+#
+# @var{var} is a shell variable name to be set to "yes" or "no".
+# @var{module} is a list of symbols, like: (ice-9 common-list).
+#
+AC_DEFUN([GUILE_MODULE_AVAILABLE],
+         [GUILE_MODULE_CHECK($1,$2,0,is available)
+         ])
+
+# GUILE_MODULE_REQUIRED -- fail if a Guile Scheme module is unavailable
+#
+# Usage: GUILE_MODULE_REQUIRED(symlist)
+#
+# @var{symlist} is a list of symbols, WITHOUT surrounding parens,
+# like: ice-9 common-list.
+#
+AC_DEFUN([GUILE_MODULE_REQUIRED],
+         [GUILE_MODULE_AVAILABLE(ac_guile_module_required, ($1))
+          if test "$ac_guile_module_required" = "no" ; then
+              AC_MSG_ERROR([required guile module not found: ($1)])
+          fi
+         ])
+
+# GUILE_MODULE_EXPORTS -- check if a module exports a variable
+#
+# Usage: GUILE_MODULE_EXPORTS(var,module,modvar)
+#
+# @var{var} is a shell variable to be set to "yes" or "no".
+# @var{module} is a list of symbols, like: (ice-9 common-list).
+# @var{modvar} is the Guile Scheme variable to check.
+#
+AC_DEFUN([GUILE_MODULE_EXPORTS],
+ [GUILE_MODULE_CHECK($1,$2,$3,exports `$3')
+ ])
+
+# GUILE_MODULE_REQUIRED_EXPORT -- fail if a module doesn't export a variable
+#
+# Usage: GUILE_MODULE_REQUIRED_EXPORT(module,modvar)
+#
+# @var{module} is a list of symbols, like: (ice-9 common-list).
+# @var{modvar} is the Guile Scheme variable to check.
+#
+AC_DEFUN([GUILE_MODULE_REQUIRED_EXPORT],
+ [GUILE_MODULE_EXPORTS(guile_module_required_export,$1,$2)
+  if test "$guile_module_required_export" = "no" ; then
+      AC_MSG_ERROR([module $1 does not export $2; required])
+  fi
+ ])
+
+## guile.m4 ends here
diff --git a/assimp.scm b/assimp.scm
new file mode 100644 (file)
index 0000000..11a3d09
--- /dev/null
@@ -0,0 +1,386 @@
+;;; guile-assimp, foreign interface to libassimp
+;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
+;;;
+;;; This program is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program 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 General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+
+(define-module (assimp)
+  #:use-module (assimp low-level)
+  #:use-module (assimp low-level cimport)
+  #:use-module (assimp low-level color)
+  #:use-module (assimp low-level material)
+  #:use-module (assimp low-level matrix)
+  #:use-module (assimp low-level mesh)
+  #:use-module (assimp low-level postprocess)
+  #:use-module (assimp low-level scene)
+  #:use-module (assimp low-level types)
+  #:use-module (assimp low-level vector)
+  #:use-module (system foreign)
+  #:export (ai-import-file
+           ai-release-import
+           ai-attach-predefined-log-stream
+           ai-transform-vec-by-matrix4
+           ai-multiply-matrix3
+           ai-multiply-matrix4
+           ai-identity-matrix3
+           ai-identity-matrix4
+           ai-transpose-matrix3
+           ai-transpose-matrix4)
+  #:re-export (ai-material-key
+              ai-process-steps
+              ai-process-convert-to-left-handed
+              ai-process-preset-target-realtime-fast
+              ai-process-preset-target-realtime-quality
+              ai-process-preset-target-realtime-max-quality
+              ai-default-log-stream
+              (aiDetachAllLogStreams . ai-detach-all-log-streams)))
+
+
+;;; Scenes
+
+(define-conversion-type parse-aiScene -> ai-scene
+  (flags (field 'mFlags))
+  (root-node (wrap (field 'mRootNode) wrap-ai-node))
+  (meshes (wrap (array (field 'mNumMeshes) (field 'mMeshes)) wrap-ai-mesh))
+  (materials (wrap (array (field 'mNumMaterials) (field 'mMaterials)) wrap-ai-material))
+  (animations (array (field 'mNumAnimations) (field 'mAnimations)))
+  (textures (array (field 'mNumTextures) (field 'mTextures)))
+  (lights (array (field 'mNumLights) (field 'mLights)))
+  (cameras (array (field 'mNumCameras) (field 'mCameras))))
+
+(export ai-scene?
+       ai-scene-contents
+       ai-scene-flags
+       ai-scene-root-node
+       ai-scene-meshes
+       ai-scene-materials
+       ai-scene-animations
+       ai-scene-textures
+       ai-scene-lights
+       ai-scene-cameras)
+
+
+;;; Nodes
+
+(define-conversion-type parse-aiNode -> ai-node
+  (name (sized-string (field 'mName)))
+  (transformation (wrap (parse-aiMatrix4x4 (field 'mTransformation) #:reverse #t) wrap-ai-matrix4x4))
+  (parent (wrap (field 'mParent) wrap-ai-node))
+  (children (wrap (array (field 'mNumChildren) (field 'mChildren)) wrap-ai-node))
+  (meshes (array (field 'mNumMeshes) (field 'mMeshes))))
+
+(export ai-node?
+       ai-node-contents
+       ai-node-name
+       ai-node-transformation
+       ai-node-parent
+       ai-node-children
+       ai-node-meshes)
+
+
+;;; Meshes
+
+(define-conversion-type parse-aiMesh -> ai-mesh
+  (name (sized-string (field 'mName)))
+  (primitive-types (field 'mPrimitiveTypes))
+  (vertices (wrap
+            (array (field 'mNumVertices) (field 'mVertices) #:element-size 12 #:element-proc get-element-address)
+            wrap-ai-vector3d))
+  (faces (wrap
+         (array (field 'mNumFaces) (field 'mFaces) #:element-size 8 #:element-proc get-element-address)
+         wrap-ai-face))
+  (normals (wrap
+           (array (field 'mNumVertices) (field 'mNormals) #:element-size 12 #:element-proc get-element-address)
+           wrap-ai-vector3d))
+  (tangents (wrap
+            (array (field 'mNumVertices) (field 'mTangents) #:element-size 12 #:element-proc get-element-address)
+            wrap-ai-vector3d))
+  (bitangents (wrap
+              (array (field 'mNumVertices) (field 'mBitangents) #:element-size 12 #:element-proc get-element-address)
+              wrap-ai-vector3d))
+  (colors (map
+          (lambda (c)
+            (wrap
+             (array (field 'mNumVertices) c #:element-size 16 #:element-proc get-element-address)
+             wrap-ai-color4d))
+          (field 'mColors)))
+  (texture-coords (map
+                  (lambda (tc)
+                    (wrap
+                     (array (field 'mNumVertices) tc #:element-size 12 #:element-proc get-element-address)
+                     wrap-ai-vector3d))
+                  (field 'mTextureCoords)))
+  (num-uv-components (field 'mNumUVComponents))
+  (bones (wrap (array (field 'mNumBones) (field 'mBones)) wrap-ai-bone))
+  (material-index (field 'mMaterialIndex)))
+
+(export ai-mesh?
+       ai-mesh-contents
+       ai-mesh-name
+       ai-mesh-primitive-types
+       ai-mesh-vertices
+       ai-mesh-faces
+       ai-mesh-normals
+       ai-mesh-tangents
+       ai-mesh-bitangents
+       ai-mesh-colors
+       ai-mesh-texture-coords
+       ai-mesh-num-uv-components
+       ai-mesh-bones
+       ai-mesh-material-index)
+
+
+;;; Materials
+
+(define-conversion-type parse-aiMaterial -> ai-material
+  (properties (array (field 'mNumProperties) (field 'mProperties)))
+  (num-allocated (field 'mNumAllocated)))
+
+(export ai-material?
+       ai-material-contents
+       ai-material-properties
+       ai-material-num-allocated)
+
+
+(define-public (ai-get-material-color mat color-type)
+  (let ((pmat (unwrap-ai-material mat))
+       (pkey (string->pointer (car color-type)))
+       (type (cadr color-type))
+       (index (caddr color-type))
+       (pout (parse-aiColor4D (make-list 4 0) #:reverse #t)))
+    (let ((res (aiGetMaterialColor pmat pkey type index pout)))
+      (if (< res 0)
+         res
+         (wrap-ai-color4d pout)))))
+
+(define-public (ai-get-material-float-array mat color-type max)
+  (let ((pmat (unwrap-ai-material mat))
+       (pkey (string->pointer (car color-type)))
+       (type (cadr color-type))
+       (index (caddr color-type))
+       (pout (bytevector->pointer (list->f32vector (make-list max 0))))
+       (pmax (bytevector->pointer (list->u32vector (list max)))))
+    (let ((res (aiGetMaterialFloatArray pmat pkey type index pout pmax)))
+      (if (< res 0)
+         res
+         (f32vector->list (pointer->bytevector pout max 0 'f32))))))
+
+(define-public (ai-get-material-integer-array mat color-type max)
+  (let ((pmat (unwrap-ai-material mat))
+       (pkey (string->pointer (car color-type)))
+       (type (cadr color-type))
+       (index (caddr color-type))
+       (pout (bytevector->pointer (list->s32vector (make-list max 0))))
+       (pmax (bytevector->pointer (list->u32vector (list max)))))
+    (let ((res (aiGetMaterialIntegerArray pmat pkey type index pout pmax)))
+      (if (< res 0)
+         res
+         (s32vector->list (pointer->bytevector pout max 0 's32))))))
+
+
+;;; Faces
+
+(define-conversion-type parse-aiFace -> ai-face
+  (indices (array (field 'mNumIndices) (field 'mIndices))))
+
+(export ai-face?
+       ai-face-contents
+       ai-face-indices)
+
+
+;;; Vectors
+
+(define-conversion-type parse-aiVector2D -> ai-vector2d
+  (x (field 'x))
+  (y (field 'y)))
+
+(export ai-vector2d?
+       ai-vector2d-contents
+       ai-vector2d-x
+       ai-vector2d-y)
+
+(define-conversion-type parse-aiVector3D -> ai-vector3d
+  (x (field 'x))
+  (y (field 'y))
+  (z (field 'z)))
+
+(export ai-vector3d?
+       ai-vector3d-contents
+       ai-vector3d-x
+       ai-vector3d-y
+       ai-vector3d-z)
+
+
+;;; Matrixes
+
+(define-conversion-type parse-aiMatrix3x3 -> ai-matrix3x3
+  (a1 (field 'a1))
+  (a2 (field 'a2))
+  (a3 (field 'a3))
+  (b1 (field 'b1))
+  (b2 (field 'b2))
+  (b3 (field 'b3))
+  (c1 (field 'c1))
+  (c2 (field 'c2))
+  (c3 (field 'c3)))
+
+(export ai-matrix3x3?
+       ai-matrix3x3-contents
+       ai-matrix3x3-a1
+       ai-matrix3x3-a2
+       ai-matrix3x3-a3
+       ai-matrix3x3-b1
+       ai-matrix3x3-b2
+       ai-matrix3x3-b3
+       ai-matrix3x3-c1
+       ai-matrix3x3-c2
+       ai-matrix3x3-c3)
+
+(define-conversion-type parse-aiMatrix4x4 -> ai-matrix4x4
+  (a1 (field 'a1))
+  (a2 (field 'a2))
+  (a3 (field 'a3))
+  (a4 (field 'a4))
+  (b1 (field 'b1))
+  (b2 (field 'b2))
+  (b3 (field 'b3))
+  (b4 (field 'b4))
+  (c1 (field 'c1))
+  (c2 (field 'c2))
+  (c3 (field 'c3))
+  (c4 (field 'c4))
+  (d1 (field 'd1))
+  (d2 (field 'd2))
+  (d3 (field 'd3))
+  (d4 (field 'd4)))
+
+(export ai-matrix4x4?
+       ai-matrix4x4-contents
+       ai-matrix4x4-a1
+       ai-matrix4x4-a2
+       ai-matrix4x4-a3
+       ai-matrix4x4-a4
+       ai-matrix4x4-b1
+       ai-matrix4x4-b2
+       ai-matrix4x4-b3
+       ai-matrix4x4-b4
+       ai-matrix4x4-c1
+       ai-matrix4x4-c2
+       ai-matrix4x4-c3
+       ai-matrix4x4-c4
+       ai-matrix4x4-d1
+       ai-matrix4x4-d2
+       ai-matrix4x4-d3
+       ai-matrix4x4-d4)
+
+
+;;; Colors
+
+(define-conversion-type parse-aiColor4D -> ai-color4d
+  (r (field 'r))
+  (g (field 'g))
+  (b (field 'b))
+  (a (field 'a)))
+
+(export ai-color4d?
+       ai-color4d-contents
+       ai-color4d-r
+       ai-color4d-g
+       ai-color4d-b
+       ai-color4d-a)
+
+
+;;; Bones
+
+(define-conversion-type parse-aiBone -> ai-bone
+  (name (sized-string (field 'mName)))
+  (weights (wrap
+           (array (field 'mNumWeights) (field 'mWeights) #:element-size 8 #:element-proc get-element-address)
+           wrap-ai-vertex-weight))
+  (offset-matrix (wrap (parse-aiMatrix4x4 (field 'mOffsetMatrix) #:reverse #t) wrap-ai-matrix4x4)))
+
+(export ai-bone?
+       ai-bone-contents
+       ai-bone-name
+       ai-bone-weights
+       ai-bone-offset-matrix)
+
+
+;;; Weights
+
+(define-conversion-type parse-aiVertexWeight -> ai-vertex-weight
+  (vertex-id (field 'mVertexId))
+  (weight (field 'mWeight)))
+
+(export ai-vertex-weight?
+       ai-vertex-weight-contents
+       ai-vertex-weight-vertex-id
+       ai-vertex-weight-weight)
+
+
+;;; Functions
+
+(define (ai-import-file filename flags)
+  (wrap-ai-scene
+   (aiImportFile (string->pointer filename)
+                flags)))
+
+(define (ai-release-import scene)
+  (aiReleaseImport (unwrap-ai-scene scene)))
+
+(define* (ai-attach-predefined-log-stream type #:optional file)
+  (aiAttachLogStream
+   (aiGetPredefinedLogStream
+    type
+    (if file
+       (string->pointer file)
+       %null-pointer))))
+
+(define (ai-transform-vec-by-matrix4 vec mat)
+  (let ((cvec (parse-aiVector3D (map cdr (ai-vector3d-contents vec)) #:reverse #t))
+       (cmat (parse-aiMatrix4x4 (map cdr (ai-matrix4x4-contents mat)) #:reverse #t)))
+    (aiTransformVecByMatrix4 cvec cmat)
+    (wrap-ai-vector3d cvec)))
+
+(define (ai-multiply-matrix3 m1 m2)
+  (let ((cm1 (parse-aiMatrix3x3 (map cdr (ai-matrix3x3-contents m1)) #:reverse #t))
+       (cm2 (parse-aiMatrix3x3 (map cdr (ai-matrix3x3-contents m2)) #:reverse #t)))
+    (aiMultiplyMatrix3 cm1 cm2)
+    (wrap-ai-matrix3x3 cm1)))
+
+(define (ai-multiply-matrix4 m1 m2)
+  (let ((cm1 (parse-aiMatrix4x4 (map cdr (ai-matrix4x4-contents m1)) #:reverse #t))
+       (cm2 (parse-aiMatrix4x4 (map cdr (ai-matrix4x4-contents m2)) #:reverse #t)))
+    (aiMultiplyMatrix4 cm1 cm2)
+    (wrap-ai-matrix4x4 cm1)))
+
+(define (ai-identity-matrix3)
+  (let ((cmat (parse-aiMatrix3x3 (make-list 9 0) #:reverse #t)))
+    (aiIdentityMatrix3 cmat)
+    (wrap-ai-matrix3x3 cmat)))
+
+(define (ai-identity-matrix4)
+  (let ((cmat (parse-aiMatrix4x4 (make-list 16 0) #:reverse #t)))
+    (aiIdentityMatrix4 cmat)
+    (wrap-ai-matrix4x4 cmat)))
+
+(define (ai-transpose-matrix3 mat)
+  (let ((cmat (parse-aiMatrix3x3 (map cdr (ai-matrix3x3-contents mat)) #:reverse #t)))
+    (aiTransposeMatrix3 cmat)
+    (wrap-ai-matrix3x3 cmat)))
+
+(define (ai-transpose-matrix4 mat)
+  (let ((cmat (parse-aiMatrix4x4 (map cdr (ai-matrix4x4-contents mat)) #:reverse #t)))
+    (aiTransposeMatrix4 cmat)
+    (wrap-ai-matrix4x4 cmat)))
diff --git a/assimp/low-level.scm b/assimp/low-level.scm
new file mode 100644 (file)
index 0000000..148b26d
--- /dev/null
@@ -0,0 +1,230 @@
+;;; guile-assimp, foreign interface to libassimp
+;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
+;;;
+;;; This program is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program 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 General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+
+(define-module (assimp low-level)
+  #:use-module (ice-9 iconv)
+  #:use-module (rnrs bytevectors)
+  #:use-module (system foreign))
+
+
+;;; Generic Functions
+
+(define (mk-string . args)
+  (string-concatenate
+   (map (lambda (a)
+         (if (string? a)
+             a
+             (symbol->string (syntax->datum a))))
+       args)))
+
+(define (lambda-mk-symbol x)
+  (lambda args
+    (datum->syntax x
+      (string->symbol
+       (apply mk-string args)))))
+
+
+;;; Parsers Definition
+
+(define-syntax define-struct-parser
+  (lambda (x)
+    (syntax-case x ()
+      ((_ name (field type) ...)
+       (with-syntax (((field-name ...) (map car #'((field type) ...)))
+                    ((field-type ...) (map cadr #'((field type) ...))))
+         #'(define* (name pointer-or-data #:key (reverse #f))
+            (cond (reverse
+                   (make-c-struct
+                    (list field-type ...)
+                    pointer-or-data))
+                  (else
+                   (map cons
+                        '(field-name ...)
+                        (parse-c-struct pointer-or-data (list field-type ...)))))))))))
+
+(export-syntax define-struct-parser)
+
+
+;;; Type Generation
+
+(define-syntax define-conversion-type
+  (lambda (x)
+    (define mk-symbol (lambda-mk-symbol x))
+    (syntax-case x (->)
+      ((_ parser -> name (field-name field-proc) ...)
+       (with-syntax ((type? (mk-symbol #'name "?"))
+                    (wrap-type (mk-symbol "wrap-" #'name))
+                    (unwrap-type (mk-symbol "unwrap-" #'name))
+                    (output-string (mk-string "#<" #'name " ~x>"))
+                    (type-contents (mk-symbol #'name "-contents"))
+                    (type-parse (mk-symbol #'name "-parse"))
+                    ((field-reader ...) (map (lambda (f) (mk-symbol #'name "-" (car f))) #'((field-name field-proc) ...))))
+         #'(begin
+            (define-wrapped-pointer-type name
+              type?
+              wrap-type unwrap-type
+              (lambda (x p)
+                (format p output-string
+                        (pointer-address (unwrap-type x)))))
+            (define (type-parse wrapped)
+              (let ((unwrapped (unwrap-type wrapped)))
+                (cond ((= (pointer-address unwrapped) 0)
+                       '())
+                      (else
+                       (parser unwrapped)))))
+            (define-type-contents type-contents type-parse (field-name field-proc) ...)
+            (define-field-reader field-reader type-parse field-proc)
+            ...
+            ))))))
+
+(define-macro (define-type-contents type-contents type-parse . fields)
+  `(define (,type-contents wrapped)
+     (let ((alist (,type-parse wrapped)))
+       (list ,@(map (lambda (f)
+                     `(cons ',(car f) ,(cadr f)))
+                   fields)))))
+
+(define-macro (define-field-reader field-reader type-parse body)
+  `(define (,field-reader wrapped)
+     (let ((alist (,type-parse wrapped)))
+       ,body)))
+
+(define-macro (field name)
+  `(assoc-ref alist ,name))
+
+(export-syntax define-conversion-type
+              field)
+
+
+;;; Support functions for type generation
+
+(define (bv-uint-ref pointer index)
+  (bytevector-uint-ref
+   (pointer->bytevector pointer 4 index)
+   0
+   (native-endianness)
+   4))
+
+(define* (array size root #:key (element-size 4) (element-proc bv-uint-ref))
+  (cond ((= (pointer-address root) 0)
+        '())
+       (else
+        (reverse
+         (let loop ((i 0) (res '()))
+           (cond ((= i size)
+                  res)
+                 (else
+                  (loop (+ i 1) (cons (element-proc root (* element-size i)) res)))))))))
+
+(define (get-element-address root-pointer offset)
+  (make-pointer (+ (pointer-address root-pointer) offset)))
+
+(define (sized-string s)
+  (cond (s
+        (bytevector->string
+         (u8-list->bytevector (list-head (cadr s) (car s)))
+         (fluid-ref %default-port-encoding)))
+       (else
+        #f)))
+
+(define (wrap pointers wrap-proc)
+  (define (make-wrap element)
+    (let ((pointer
+          (cond ((pointer? element)
+                 (if (= (pointer-address element) 0)
+                     #f
+                     element))
+                ((= element 0)
+                 #f)
+                (else
+                 (make-pointer element)))))
+      (cond (pointer
+            (wrap-proc pointer))
+           (else
+            #f))))
+  (cond ((list? pointers)
+        (map make-wrap pointers))
+       (else
+        (make-wrap pointers))))
+
+(export array
+       get-element-address
+       sized-string
+       wrap)
+
+
+;;; Function Mappers
+
+(define-syntax define-foreign-function
+  (lambda (x)
+    (syntax-case x (->)
+      ((_ ((foreign-lib name) arg-type ...) -> return-type)
+       (with-syntax ((name-string (datum->syntax x (symbol->string (syntax->datum #'name)))))
+         #'(define name
+            (pointer->procedure return-type
+                                (dynamic-func name-string foreign-lib)
+                                (list arg-type ...))))))))
+
+
+(define libassimp (dynamic-link "libassimp"))
+
+(define-syntax define-assimp-function
+  (syntax-rules (->)
+    ((_ (name arg-type ...) -> return-type)
+     (define-foreign-function ((libassimp name) arg-type ...) -> return-type))))
+
+
+(export-syntax define-foreign-function
+              define-assimp-function)
+
+
+;;; Enumerators and bitfields (copìed from figl code, thanks to Andy Wingo
+
+(define-syntax-rule (define-enumeration enumerator (name value) ...)
+  (define-syntax enumerator
+    (lambda (x)
+      (syntax-case x ()
+        ((_)
+         #''(name ...))
+        ((_ enum) (number? (syntax->datum #'enum))
+         #'enum)
+        ((_ enum)
+         #'(or (assq-ref `((name . ,(syntax->datum value)) ...)
+                        (syntax->datum #'enum))
+              (syntax-violation 'enumerator "invalid enumerated value"
+                                #'enum)))))))
+
+(define-syntax-rule (define-bitfield bitfield (name value) ...)
+  (define-syntax bitfield
+    (lambda (x)
+      (syntax-case x () 
+        ((_)
+         #''(name ...))
+        ((_ bit (... ...))
+         #`(logior
+            #,@(map
+                (lambda (bit)
+                  (let ((datum (syntax->datum bit)))
+                    (if (number? datum)
+                        datum
+                        (or (assq-ref '((name . value) ...) datum)
+                            (syntax-violation 'bitfield "invalid bitfield value"
+                                              bit)))))
+                #'(bit (... ...)))))))))
+
+(export-syntax define-enumeration
+              define-bitfield)
diff --git a/assimp/low-level/cimport.scm b/assimp/low-level/cimport.scm
new file mode 100644 (file)
index 0000000..7f0f259
--- /dev/null
@@ -0,0 +1,46 @@
+;;; guile-assimp, foreign interface to libassimp
+;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
+;;;
+;;; This program is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program 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 General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+
+(define-module (assimp low-level cimport)
+  #:use-module (assimp low-level)
+  #:use-module (system foreign)
+  #:export (aiImportFile
+           aiReleaseImport
+           aiGetPredefinedLogStream
+           aiAttachLogStream
+           aiDetachAllLogStreams
+           aiTransformVecByMatrix4
+           aiMultiplyMatrix3
+           aiMultiplyMatrix4
+           aiIdentityMatrix3
+           aiIdentityMatrix4
+           aiTransposeMatrix3
+           aiTransposeMatrix4))
+
+(define-assimp-function (aiImportFile '* unsigned-int) -> '*)
+(define-assimp-function (aiReleaseImport '*) -> void)
+(define-assimp-function (aiGetPredefinedLogStream unsigned-int '*) -> (list '* '* '*))
+(define-assimp-function (aiAttachLogStream '*) -> void)
+(define-assimp-function (aiDetachAllLogStreams) -> void)
+
+(define-assimp-function (aiTransformVecByMatrix4 '* '*) -> void)
+(define-assimp-function (aiMultiplyMatrix3 '* '*) -> void)
+(define-assimp-function (aiMultiplyMatrix4 '* '*) -> void)
+(define-assimp-function (aiIdentityMatrix3 '*) -> void)
+(define-assimp-function (aiIdentityMatrix4 '*) -> void)
+(define-assimp-function (aiTransposeMatrix3 '*) -> void)
+(define-assimp-function (aiTransposeMatrix4 '*) -> void)
diff --git a/assimp/low-level/color.scm b/assimp/low-level/color.scm
new file mode 100644 (file)
index 0000000..bc13274
--- /dev/null
@@ -0,0 +1,29 @@
+;;; guile-assimp, foreign interface to libassimp
+;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
+;;;
+;;; This program is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program 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 General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+
+(define-module (assimp low-level color)
+  #:use-module (assimp low-level)
+  #:use-module (system foreign))
+
+
+(define-struct-parser parse-aiColor4D
+  (r float)
+  (g float)
+  (b float)
+  (a float))
+
+(export parse-aiColor4D)
diff --git a/assimp/low-level/material.scm b/assimp/low-level/material.scm
new file mode 100644 (file)
index 0000000..2b3ade1
--- /dev/null
@@ -0,0 +1,68 @@
+;;; guile-assimp, foreign interface to libassimp
+;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
+;;;
+;;; This program is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program 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 General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+
+(define-module (assimp low-level material)
+  #:use-module (assimp low-level)
+  #:use-module (assimp low-level types)
+  #:use-module (system foreign)
+  #:export (parse-aiMaterial
+           parse-aiMaterialProperty
+           ai-material-key
+           aiGetMaterialColor
+           aiGetMaterialFloatArray
+           aiGetMaterialIntegerArray))
+
+
+(define-struct-parser parse-aiMaterialProperty
+  (mKey aiString-type)
+  (mSemantic unsigned-int)
+  (mIndex unsigned-int)
+  (mDataLength unsigned-int)
+  (mType unsigned-int)
+  (mData '*))
+
+(define-struct-parser parse-aiMaterial
+  (mProperties '*)
+  (mNumProperties unsigned-int)
+  (mNumAllocated unsigned-int))
+
+
+(define-enumeration
+  ai-material-key
+  (name '("?mat.name" 0 0))
+  (twosided '("$mat.twosided" 0 0))
+  (shading-model '("$mat.shadingm" 0 0))
+  (enable-wireframe '("$mat.wireframe" 0 0))
+  (blend-func '("$mat.blend" 0 0))
+  (opacity '("$mat.opacity" 0 0))
+  (bumpscaling '("$mat.bumpscaling" 0 0))
+  (shininess '("$mat.shininess" 0 0))
+  (reflectivity '("$mat.reflectivity" 0 0))
+  (shininess-strength '("$mat.shinpercent" 0 0))
+  (refracti '("$mat.refracti" 0 0))
+  (color-diffuse '("$clr.diffuse" 0 0))
+  (color-ambient '("$clr.ambient" 0 0))
+  (color-specular '("$clr.specular" 0 0))
+  (color-emissive '("$clr.emissive" 0 0))
+  (color-transparent '("$clr.transparent" 0 0))
+  (color-reflective '("$clr.reflective" 0 0))
+  (global-background-image '("?bg.global" 0 0)))
+
+
+(define-assimp-function (aiGetMaterialColor '* '* unsigned-int unsigned-int '*) -> int)
+(define-assimp-function (aiGetMaterialFloatArray '* '* unsigned-int unsigned-int '* '*) -> int)
+(define-assimp-function (aiGetMaterialIntegerArray '* '* unsigned-int unsigned-int '* '*) -> int)
diff --git a/assimp/low-level/matrix.scm b/assimp/low-level/matrix.scm
new file mode 100644 (file)
index 0000000..416b4d0
--- /dev/null
@@ -0,0 +1,53 @@
+;;; guile-assimp, foreign interface to libassimp
+;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
+;;;
+;;; This program is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program 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 General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+
+(define-module (assimp low-level matrix)
+  #:use-module (assimp low-level)
+  #:use-module (system foreign))
+
+
+(define-struct-parser parse-aiMatrix3x3
+  (a1 float)
+  (a2 float)
+  (a3 float)
+  (b1 float)
+  (b2 float)
+  (b3 float)
+  (c1 float)
+  (c2 float)
+  (c3 float))
+
+(define-struct-parser parse-aiMatrix4x4
+  (a1 float)
+  (a2 float)
+  (a3 float)
+  (a4 float)
+  (b1 float)
+  (b2 float)
+  (b3 float)
+  (b4 float)
+  (c1 float)
+  (c2 float)
+  (c3 float)
+  (c4 float)
+  (d1 float)
+  (d2 float)
+  (d3 float)
+  (d4 float))
+
+(export parse-aiMatrix3x3
+       parse-aiMatrix4x4)
diff --git a/assimp/low-level/mesh.scm b/assimp/low-level/mesh.scm
new file mode 100644 (file)
index 0000000..50d0bb8
--- /dev/null
@@ -0,0 +1,69 @@
+;;; guile-assimp, foreign interface to libassimp
+;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
+;;;
+;;; This program is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program 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 General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+
+(define-module (assimp low-level mesh)
+  #:use-module (assimp low-level)
+  #:use-module (assimp low-level types)
+  #:use-module (system foreign))
+
+
+(define-struct-parser parse-aiFace
+  (mNumIndices unsigned-int)
+  (mIndices '*))
+
+(export parse-aiFace)
+
+
+(define-struct-parser parser-aiVertexWeight
+  (mVertexId unsigned-int)
+  (mWeight float))
+
+(export parse-aiVertexWeight)
+
+
+(define-struct-parser parse-aiBone
+  (mName aiString-type)
+  (mNumWeights unsigned-int)
+  (mWeights '*)
+  (mOffsetMatrix aiMatrix4x4-type))
+
+(export parse-aiBone)
+
+
+(define AI_MAX_NUMBER_OF_COLOR_SETS #x8)
+(define AI_MAX_NUMBER_OF_TEXTURECOORDS #x8)
+
+(define-struct-parser parse-aiMesh
+  (mPrimitiveTypes unsigned-int)
+  (mNumVertices unsigned-int)
+  (mNumFaces unsigned-int)
+  (mVertices '*)
+  (mNormals '*)
+  (mTangents '*)
+  (mBitangents '*)
+  (mColors (make-list AI_MAX_NUMBER_OF_COLOR_SETS '*))
+  (mTextureCoords (make-list AI_MAX_NUMBER_OF_TEXTURECOORDS '*))
+  (mNumUVComponents (make-list AI_MAX_NUMBER_OF_TEXTURECOORDS unsigned-int))
+  (mFaces '*)
+  (mNumBones unsigned-int)
+  (mBones '*)
+  (mMaterialIndex unsigned-int)
+  (mName aiString-type)
+  (mNumAnimMeshes unsigned-int)
+  (mAnimMeshes '*))
+
+(export parse-aiMesh)
diff --git a/assimp/low-level/postprocess.scm b/assimp/low-level/postprocess.scm
new file mode 100644 (file)
index 0000000..20ca550
--- /dev/null
@@ -0,0 +1,92 @@
+;;; guile-assimp, foreign interface to libassimp
+;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
+;;;
+;;; This program is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program 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 General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+
+(define-module (assimp low-level postprocess)
+  #:use-module (assimp low-level)
+  #:export (ai-process-steps
+           ai-process-convert-to-left-handed
+           ai-process-preset-target-realtime-fast
+           ai-process-preset-target-realtime-quality
+           ai-process-preset-target-realtime-max-quality))
+
+
+(define-bitfield
+  ai-process-steps
+  (calc-tangent-space #x1)
+  (join-identical-vertices #x2)
+  (make-left-handed #x4)
+  (triangulate #x8)
+  (remove-component #x10)
+  (gen-normals #x20)
+  (gen-smooth-normals #x40)
+  (split-large-meshes #x80)
+  (pretransform-vertices #x100)
+  (limit-bone-weights #x200)
+  (validate-data-structure #x400)
+  (improve-cache-locality #x800)
+  (remove-redundant-materials #x1000)
+  (fix-infacing-normals #x2000)
+  (sort-by-ptype #x8000)
+  (find-degenerates #x10000)
+  (find-invalid-data #x20000)
+  (gen-UV-coords #x40000)
+  (transform-UV-coords #x80000)
+  (find-instances #x100000)
+  (optimize-meshes #x200000)
+  (optimize-graph #x400000)
+  (flip-UVs #x800000)
+  (flip-winding-order #x1000000)
+  (split-by-bone-count #x2000000)
+  (debone #x4000000))
+
+(define ai-process-convert-to-left-handed
+  (ai-process-steps
+   make-left-handed
+   flip-UVs
+   flip-winding-order))
+
+(define ai-process-preset-target-realtime-fast
+  (ai-process-steps
+   calc-tangent-space
+   gen-normals
+   join-identical-vertices
+   triangulate
+   gen-UV-coords
+   sort-by-ptype))
+
+(define ai-process-preset-target-realtime-quality
+  (ai-process-steps
+   calc-tangent-space
+   gen-smooth-normals
+   join-identical-vertices
+   improve-cache-locality
+   limit-bone-weights
+   remove-redundant-materials
+   split-large-meshes
+   triangulate
+   gen-UV-coords
+   sort-by-ptype
+   find-degenerates
+   find-invalid-data))
+
+(define ai-process-preset-target-realtime-max-quality
+  (+ ai-process-preset-target-realtime-quality
+     (ai-process-steps
+      find-instances
+      validate-data-structure
+      optimize-meshes
+      debone)))
diff --git a/assimp/low-level/scene.scm b/assimp/low-level/scene.scm
new file mode 100644 (file)
index 0000000..651ea3a
--- /dev/null
@@ -0,0 +1,53 @@
+;;; guile-assimp, foreign interface to libassimp
+;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
+;;;
+;;; This program is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program 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 General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+
+(define-module (assimp low-level scene)
+  #:use-module (assimp low-level)
+  #:use-module (assimp low-level types)
+  #:use-module (system foreign))
+
+
+(define-struct-parser parse-aiNode
+  (mName aiString-type)
+  (mTransformation aiMatrix4x4-type)
+  (mParent '*)
+  (mNumChildren unsigned-int)
+  (mChildren '*)
+  (mNumMeshes unsigned-int)
+  (mMeshes '*))
+
+(export parse-aiNode)
+
+
+(define-struct-parser parse-aiScene
+  (mFlags unsigned-int)
+  (mRootNode '*)
+  (mNumMeshes unsigned-int)
+  (mMeshes '*)
+  (mNumMaterials unsigned-int)
+  (mMaterials '*)
+  (mNumAnimations unsigned-int)
+  (mAnimations '*)
+  (mNumTextures unsigned-int)
+  (mTextures '*)
+  (mNumLights unsigned-int)
+  (mLights '*)
+  (mNumCameras unsigned-int)
+  (mCameras '*)
+  (mPrivate '*))
+
+(export parse-aiScene)
diff --git a/assimp/low-level/types.scm b/assimp/low-level/types.scm
new file mode 100644 (file)
index 0000000..20e2281
--- /dev/null
@@ -0,0 +1,38 @@
+;;; guile-assimp, foreign interface to libassimp
+;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
+;;;
+;;; This program is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program 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 General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+
+(define-module (assimp low-level types)
+  #:use-module (assimp low-level)
+  #:use-module (system foreign)
+  #:export (aiString-type
+           aiMatrix4x4-type
+           ai-default-log-stream))
+
+
+(define aiString-type
+  (list size_t (make-list 1024 int8)))
+
+(define aiMatrix4x4-type
+  (make-list 16 float))
+
+(define-enumeration
+  ai-default-log-stream
+  (file #x1)
+  (stdout #x2)
+  (stderr #x4)
+  (debugger #x8)
+  (ai-dls-enforce-enum-size #x7fffffff))
diff --git a/assimp/low-level/vector.scm b/assimp/low-level/vector.scm
new file mode 100644 (file)
index 0000000..49b9916
--- /dev/null
@@ -0,0 +1,33 @@
+;;; guile-assimp, foreign interface to libassimp
+;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
+;;;
+;;; This program is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program 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 General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+
+(define-module (assimp low-level vector)
+  #:use-module (assimp low-level)
+  #:use-module (system foreign))
+
+
+(define-struct-parser parse-aiVector2D
+  (x float)
+  (y float))
+
+(define-struct-parser parse-aiVector3D
+  (x float)
+  (y float)
+  (z float))
+
+(export parse-aiVector2D
+       parse-aiVector3D)
diff --git a/configure.ac b/configure.ac
new file mode 100644 (file)
index 0000000..a84de55
--- /dev/null
@@ -0,0 +1,35 @@
+dnl -*- Autoconf -*-
+
+AC_INIT(guile-assimp, 0.1.0)
+AC_COPYRIGHT([
+
+guile-assimp, foreign interface to libassimp
+Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or
+(at your option) any later version.
+
+This program 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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+])
+
+AC_CONFIG_SRCDIR(assimp.scm)
+AC_CONFIG_AUX_DIR([build-aux])
+AM_INIT_AUTOMAKE([color-tests -Wall -Wno-portability foreign])
+AM_SILENT_RULES([yes])
+
+GUILE_PKG([2.2 2.0])
+GUILE_PROGS
+
+AC_CONFIG_FILES([Makefile])
+AC_CONFIG_FILES([env], [chmod +x env])
+
+AC_OUTPUT
diff --git a/env.in b/env.in
new file mode 100644 (file)
index 0000000..db507ca
--- /dev/null
+++ b/env.in
@@ -0,0 +1,14 @@
+#!/bin/sh
+
+GUILE_LOAD_PATH=@abs_top_srcdir@:$GUILE_LOAD_PATH
+if test "@abs_top_srcdir@" != "@abs_top_builddir@"; then
+    GUILE_LOAD_PATH=@abs_top_builddir@:$GUILE_LOAD_PATH
+fi
+GUILE_LOAD_COMPILED_PATH=@abs_top_builddir@:$GUILE_LOAD_PATH
+PATH=@abs_top_builddir@/bin:$PATH
+
+export GUILE_LOAD_PATH
+export GUILE_LOAD_COMPILED_PATH
+export PATH
+
+exec "$@"
index b0b962391cd16c824d8b1ae496bd0027a19e13a4..871184c71fa31efdb9431377052c9256fc81e2e1 100755 (executable)
@@ -18,7 +18,7 @@
 ;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
 
-(use-modules (assimp assimp)
+(use-modules (assimp)
             (figl gl)
             (figl gl low-level)
             (figl glu)
diff --git a/guile.am b/guile.am
new file mode 100644 (file)
index 0000000..dc1e63f
--- /dev/null
+++ b/guile.am
@@ -0,0 +1,19 @@
+GOBJECTS = $(SOURCES:%.scm=%.go)
+
+nobase_mod_DATA = $(SOURCES) $(NOCOMP_SOURCES)
+nobase_go_DATA = $(GOBJECTS)
+
+# Make sure source files are installed first, so that the mtime of
+# installed compiled files is greater than that of installed source
+# files.  See
+# <http://lists.gnu.org/archive/html/guile-devel/2010-07/msg00125.html>
+# for details.
+guile_install_go_files = install-nobase_goDATA
+$(guile_install_go_files): install-nobase_modDATA
+
+CLEANFILES = $(GOBJECTS)
+EXTRA_DIST = $(SOURCES) $(NOCOMP_SOURCES)
+GUILE_WARNINGS = -Wunbound-variable -Warity-mismatch -Wformat
+SUFFIXES = .scm .go
+.scm.go:
+       $(AM_V_GEN)$(top_builddir)/env $(GUILE_TOOLS) compile $(GUILE_WARNINGS) -o "$@" "$<"
diff --git a/src/assimp.scm b/src/assimp.scm
deleted file mode 100644 (file)
index 3925805..0000000
+++ /dev/null
@@ -1,386 +0,0 @@
-;;; guile-assimp, foreign interface to libassimp
-;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
-;;;
-;;; This program is free software: you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation, either version 3 of the License, or
-;;; (at your option) any later version.
-;;;
-;;; This program 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 General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
-
-
-(define-module (assimp assimp)
-  #:use-module (assimp low-level)
-  #:use-module (assimp low-level cimport)
-  #:use-module (assimp low-level color)
-  #:use-module (assimp low-level material)
-  #:use-module (assimp low-level matrix)
-  #:use-module (assimp low-level mesh)
-  #:use-module (assimp low-level postprocess)
-  #:use-module (assimp low-level scene)
-  #:use-module (assimp low-level types)
-  #:use-module (assimp low-level vector)
-  #:use-module (system foreign)
-  #:export (ai-import-file
-           ai-release-import
-           ai-attach-predefined-log-stream
-           ai-transform-vec-by-matrix4
-           ai-multiply-matrix3
-           ai-multiply-matrix4
-           ai-identity-matrix3
-           ai-identity-matrix4
-           ai-transpose-matrix3
-           ai-transpose-matrix4)
-  #:re-export (ai-material-key
-              ai-process-steps
-              ai-process-convert-to-left-handed
-              ai-process-preset-target-realtime-fast
-              ai-process-preset-target-realtime-quality
-              ai-process-preset-target-realtime-max-quality
-              ai-default-log-stream
-              (aiDetachAllLogStreams . ai-detach-all-log-streams)))
-
-
-;;; Scenes
-
-(define-conversion-type parse-aiScene -> ai-scene
-  (flags (field 'mFlags))
-  (root-node (wrap (field 'mRootNode) wrap-ai-node))
-  (meshes (wrap (array (field 'mNumMeshes) (field 'mMeshes)) wrap-ai-mesh))
-  (materials (wrap (array (field 'mNumMaterials) (field 'mMaterials)) wrap-ai-material))
-  (animations (array (field 'mNumAnimations) (field 'mAnimations)))
-  (textures (array (field 'mNumTextures) (field 'mTextures)))
-  (lights (array (field 'mNumLights) (field 'mLights)))
-  (cameras (array (field 'mNumCameras) (field 'mCameras))))
-
-(export ai-scene?
-       ai-scene-contents
-       ai-scene-flags
-       ai-scene-root-node
-       ai-scene-meshes
-       ai-scene-materials
-       ai-scene-animations
-       ai-scene-textures
-       ai-scene-lights
-       ai-scene-cameras)
-
-
-;;; Nodes
-
-(define-conversion-type parse-aiNode -> ai-node
-  (name (sized-string (field 'mName)))
-  (transformation (wrap (parse-aiMatrix4x4 (field 'mTransformation) #:reverse #t) wrap-ai-matrix4x4))
-  (parent (wrap (field 'mParent) wrap-ai-node))
-  (children (wrap (array (field 'mNumChildren) (field 'mChildren)) wrap-ai-node))
-  (meshes (array (field 'mNumMeshes) (field 'mMeshes))))
-
-(export ai-node?
-       ai-node-contents
-       ai-node-name
-       ai-node-transformation
-       ai-node-parent
-       ai-node-children
-       ai-node-meshes)
-
-
-;;; Meshes
-
-(define-conversion-type parse-aiMesh -> ai-mesh
-  (name (sized-string (field 'mName)))
-  (primitive-types (field 'mPrimitiveTypes))
-  (vertices (wrap
-            (array (field 'mNumVertices) (field 'mVertices) #:element-size 12 #:element-proc get-element-address)
-            wrap-ai-vector3d))
-  (faces (wrap
-         (array (field 'mNumFaces) (field 'mFaces) #:element-size 8 #:element-proc get-element-address)
-         wrap-ai-face))
-  (normals (wrap
-           (array (field 'mNumVertices) (field 'mNormals) #:element-size 12 #:element-proc get-element-address)
-           wrap-ai-vector3d))
-  (tangents (wrap
-            (array (field 'mNumVertices) (field 'mTangents) #:element-size 12 #:element-proc get-element-address)
-            wrap-ai-vector3d))
-  (bitangents (wrap
-              (array (field 'mNumVertices) (field 'mBitangents) #:element-size 12 #:element-proc get-element-address)
-              wrap-ai-vector3d))
-  (colors (map
-          (lambda (c)
-            (wrap
-             (array (field 'mNumVertices) c #:element-size 16 #:element-proc get-element-address)
-             wrap-ai-color4d))
-          (field 'mColors)))
-  (texture-coords (map
-                  (lambda (tc)
-                    (wrap
-                     (array (field 'mNumVertices) tc #:element-size 12 #:element-proc get-element-address)
-                     wrap-ai-vector3d))
-                  (field 'mTextureCoords)))
-  (num-uv-components (field 'mNumUVComponents))
-  (bones (wrap (array (field 'mNumBones) (field 'mBones)) wrap-ai-bone))
-  (material-index (field 'mMaterialIndex)))
-
-(export ai-mesh?
-       ai-mesh-contents
-       ai-mesh-name
-       ai-mesh-primitive-types
-       ai-mesh-vertices
-       ai-mesh-faces
-       ai-mesh-normals
-       ai-mesh-tangents
-       ai-mesh-bitangents
-       ai-mesh-colors
-       ai-mesh-texture-coords
-       ai-mesh-num-uv-components
-       ai-mesh-bones
-       ai-mesh-material-index)
-
-
-;;; Materials
-
-(define-conversion-type parse-aiMaterial -> ai-material
-  (properties (array (field 'mNumProperties) (field 'mProperties)))
-  (num-allocated (field 'mNumAllocated)))
-
-(export ai-material?
-       ai-material-contents
-       ai-material-properties
-       ai-material-num-allocated)
-
-
-(define-public (ai-get-material-color mat color-type)
-  (let ((pmat (unwrap-ai-material mat))
-       (pkey (string->pointer (car color-type)))
-       (type (cadr color-type))
-       (index (caddr color-type))
-       (pout (parse-aiColor4D (make-list 4 0) #:reverse #t)))
-    (let ((res (aiGetMaterialColor pmat pkey type index pout)))
-      (if (< res 0)
-         res
-         (wrap-ai-color4d pout)))))
-
-(define-public (ai-get-material-float-array mat color-type max)
-  (let ((pmat (unwrap-ai-material mat))
-       (pkey (string->pointer (car color-type)))
-       (type (cadr color-type))
-       (index (caddr color-type))
-       (pout (bytevector->pointer (list->f32vector (make-list max 0))))
-       (pmax (bytevector->pointer (list->u32vector (list max)))))
-    (let ((res (aiGetMaterialFloatArray pmat pkey type index pout pmax)))
-      (if (< res 0)
-         res
-         (f32vector->list (pointer->bytevector pout max 0 'f32))))))
-
-(define-public (ai-get-material-integer-array mat color-type max)
-  (let ((pmat (unwrap-ai-material mat))
-       (pkey (string->pointer (car color-type)))
-       (type (cadr color-type))
-       (index (caddr color-type))
-       (pout (bytevector->pointer (list->s32vector (make-list max 0))))
-       (pmax (bytevector->pointer (list->u32vector (list max)))))
-    (let ((res (aiGetMaterialIntegerArray pmat pkey type index pout pmax)))
-      (if (< res 0)
-         res
-         (s32vector->list (pointer->bytevector pout max 0 's32))))))
-
-
-;;; Faces
-
-(define-conversion-type parse-aiFace -> ai-face
-  (indices (array (field 'mNumIndices) (field 'mIndices))))
-
-(export ai-face?
-       ai-face-contents
-       ai-face-indices)
-
-
-;;; Vectors
-
-(define-conversion-type parse-aiVector2D -> ai-vector2d
-  (x (field 'x))
-  (y (field 'y)))
-
-(export ai-vector2d?
-       ai-vector2d-contents
-       ai-vector2d-x
-       ai-vector2d-y)
-
-(define-conversion-type parse-aiVector3D -> ai-vector3d
-  (x (field 'x))
-  (y (field 'y))
-  (z (field 'z)))
-
-(export ai-vector3d?
-       ai-vector3d-contents
-       ai-vector3d-x
-       ai-vector3d-y
-       ai-vector3d-z)
-
-
-;;; Matrixes
-
-(define-conversion-type parse-aiMatrix3x3 -> ai-matrix3x3
-  (a1 (field 'a1))
-  (a2 (field 'a2))
-  (a3 (field 'a3))
-  (b1 (field 'b1))
-  (b2 (field 'b2))
-  (b3 (field 'b3))
-  (c1 (field 'c1))
-  (c2 (field 'c2))
-  (c3 (field 'c3)))
-
-(export ai-matrix3x3?
-       ai-matrix3x3-contents
-       ai-matrix3x3-a1
-       ai-matrix3x3-a2
-       ai-matrix3x3-a3
-       ai-matrix3x3-b1
-       ai-matrix3x3-b2
-       ai-matrix3x3-b3
-       ai-matrix3x3-c1
-       ai-matrix3x3-c2
-       ai-matrix3x3-c3)
-
-(define-conversion-type parse-aiMatrix4x4 -> ai-matrix4x4
-  (a1 (field 'a1))
-  (a2 (field 'a2))
-  (a3 (field 'a3))
-  (a4 (field 'a4))
-  (b1 (field 'b1))
-  (b2 (field 'b2))
-  (b3 (field 'b3))
-  (b4 (field 'b4))
-  (c1 (field 'c1))
-  (c2 (field 'c2))
-  (c3 (field 'c3))
-  (c4 (field 'c4))
-  (d1 (field 'd1))
-  (d2 (field 'd2))
-  (d3 (field 'd3))
-  (d4 (field 'd4)))
-
-(export ai-matrix4x4?
-       ai-matrix4x4-contents
-       ai-matrix4x4-a1
-       ai-matrix4x4-a2
-       ai-matrix4x4-a3
-       ai-matrix4x4-a4
-       ai-matrix4x4-b1
-       ai-matrix4x4-b2
-       ai-matrix4x4-b3
-       ai-matrix4x4-b4
-       ai-matrix4x4-c1
-       ai-matrix4x4-c2
-       ai-matrix4x4-c3
-       ai-matrix4x4-c4
-       ai-matrix4x4-d1
-       ai-matrix4x4-d2
-       ai-matrix4x4-d3
-       ai-matrix4x4-d4)
-
-
-;;; Colors
-
-(define-conversion-type parse-aiColor4D -> ai-color4d
-  (r (field 'r))
-  (g (field 'g))
-  (b (field 'b))
-  (a (field 'a)))
-
-(export ai-color4d?
-       ai-color4d-contents
-       ai-color4d-r
-       ai-color4d-g
-       ai-color4d-b
-       ai-color4d-a)
-
-
-;;; Bones
-
-(define-conversion-type parse-aiBone -> ai-bone
-  (name (sized-string (field 'mName)))
-  (weights (wrap
-           (array (field 'mNumWeights) (field 'mWeights) #:element-size 8 #:element-proc get-element-address)
-           wrap-ai-vertex-weight))
-  (offset-matrix (wrap (parse-aiMatrix4x4 (field 'mOffsetMatrix) #:reverse #t) wrap-ai-matrix4x4)))
-
-(export ai-bone?
-       ai-bone-contents
-       ai-bone-name
-       ai-bone-weights
-       ai-bone-offset-matrix)
-
-
-;;; Weights
-
-(define-conversion-type parse-aiVertexWeight -> ai-vertex-weight
-  (vertex-id (field 'mVertexId))
-  (weight (field 'mWeight)))
-
-(export ai-vertex-weight?
-       ai-vertex-weight-contents
-       ai-vertex-weight-vertex-id
-       ai-vertex-weight-weight)
-
-
-;;; Functions
-
-(define (ai-import-file filename flags)
-  (wrap-ai-scene
-   (aiImportFile (string->pointer filename)
-                flags)))
-
-(define (ai-release-import scene)
-  (aiReleaseImport (unwrap-ai-scene scene)))
-
-(define* (ai-attach-predefined-log-stream type #:optional file)
-  (aiAttachLogStream
-   (aiGetPredefinedLogStream
-    type
-    (if file
-       (string->pointer file)
-       %null-pointer))))
-
-(define (ai-transform-vec-by-matrix4 vec mat)
-  (let ((cvec (parse-aiVector3D (map cdr (ai-vector3d-contents vec)) #:reverse #t))
-       (cmat (parse-aiMatrix4x4 (map cdr (ai-matrix4x4-contents mat)) #:reverse #t)))
-    (aiTransformVecByMatrix4 cvec cmat)
-    (wrap-ai-vector3d cvec)))
-
-(define (ai-multiply-matrix3 m1 m2)
-  (let ((cm1 (parse-aiMatrix3x3 (map cdr (ai-matrix3x3-contents m1)) #:reverse #t))
-       (cm2 (parse-aiMatrix3x3 (map cdr (ai-matrix3x3-contents m2)) #:reverse #t)))
-    (aiMultiplyMatrix3 cm1 cm2)
-    (wrap-ai-matrix3x3 cm1)))
-
-(define (ai-multiply-matrix4 m1 m2)
-  (let ((cm1 (parse-aiMatrix4x4 (map cdr (ai-matrix4x4-contents m1)) #:reverse #t))
-       (cm2 (parse-aiMatrix4x4 (map cdr (ai-matrix4x4-contents m2)) #:reverse #t)))
-    (aiMultiplyMatrix4 cm1 cm2)
-    (wrap-ai-matrix4x4 cm1)))
-
-(define (ai-identity-matrix3)
-  (let ((cmat (parse-aiMatrix3x3 (make-list 9 0) #:reverse #t)))
-    (aiIdentityMatrix3 cmat)
-    (wrap-ai-matrix3x3 cmat)))
-
-(define (ai-identity-matrix4)
-  (let ((cmat (parse-aiMatrix4x4 (make-list 16 0) #:reverse #t)))
-    (aiIdentityMatrix4 cmat)
-    (wrap-ai-matrix4x4 cmat)))
-
-(define (ai-transpose-matrix3 mat)
-  (let ((cmat (parse-aiMatrix3x3 (map cdr (ai-matrix3x3-contents mat)) #:reverse #t)))
-    (aiTransposeMatrix3 cmat)
-    (wrap-ai-matrix3x3 cmat)))
-
-(define (ai-transpose-matrix4 mat)
-  (let ((cmat (parse-aiMatrix4x4 (map cdr (ai-matrix4x4-contents mat)) #:reverse #t)))
-    (aiTransposeMatrix4 cmat)
-    (wrap-ai-matrix4x4 cmat)))
diff --git a/src/low-level.scm b/src/low-level.scm
deleted file mode 100644 (file)
index 148b26d..0000000
+++ /dev/null
@@ -1,230 +0,0 @@
-;;; guile-assimp, foreign interface to libassimp
-;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
-;;;
-;;; This program is free software: you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation, either version 3 of the License, or
-;;; (at your option) any later version.
-;;;
-;;; This program 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 General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
-
-
-(define-module (assimp low-level)
-  #:use-module (ice-9 iconv)
-  #:use-module (rnrs bytevectors)
-  #:use-module (system foreign))
-
-
-;;; Generic Functions
-
-(define (mk-string . args)
-  (string-concatenate
-   (map (lambda (a)
-         (if (string? a)
-             a
-             (symbol->string (syntax->datum a))))
-       args)))
-
-(define (lambda-mk-symbol x)
-  (lambda args
-    (datum->syntax x
-      (string->symbol
-       (apply mk-string args)))))
-
-
-;;; Parsers Definition
-
-(define-syntax define-struct-parser
-  (lambda (x)
-    (syntax-case x ()
-      ((_ name (field type) ...)
-       (with-syntax (((field-name ...) (map car #'((field type) ...)))
-                    ((field-type ...) (map cadr #'((field type) ...))))
-         #'(define* (name pointer-or-data #:key (reverse #f))
-            (cond (reverse
-                   (make-c-struct
-                    (list field-type ...)
-                    pointer-or-data))
-                  (else
-                   (map cons
-                        '(field-name ...)
-                        (parse-c-struct pointer-or-data (list field-type ...)))))))))))
-
-(export-syntax define-struct-parser)
-
-
-;;; Type Generation
-
-(define-syntax define-conversion-type
-  (lambda (x)
-    (define mk-symbol (lambda-mk-symbol x))
-    (syntax-case x (->)
-      ((_ parser -> name (field-name field-proc) ...)
-       (with-syntax ((type? (mk-symbol #'name "?"))
-                    (wrap-type (mk-symbol "wrap-" #'name))
-                    (unwrap-type (mk-symbol "unwrap-" #'name))
-                    (output-string (mk-string "#<" #'name " ~x>"))
-                    (type-contents (mk-symbol #'name "-contents"))
-                    (type-parse (mk-symbol #'name "-parse"))
-                    ((field-reader ...) (map (lambda (f) (mk-symbol #'name "-" (car f))) #'((field-name field-proc) ...))))
-         #'(begin
-            (define-wrapped-pointer-type name
-              type?
-              wrap-type unwrap-type
-              (lambda (x p)
-                (format p output-string
-                        (pointer-address (unwrap-type x)))))
-            (define (type-parse wrapped)
-              (let ((unwrapped (unwrap-type wrapped)))
-                (cond ((= (pointer-address unwrapped) 0)
-                       '())
-                      (else
-                       (parser unwrapped)))))
-            (define-type-contents type-contents type-parse (field-name field-proc) ...)
-            (define-field-reader field-reader type-parse field-proc)
-            ...
-            ))))))
-
-(define-macro (define-type-contents type-contents type-parse . fields)
-  `(define (,type-contents wrapped)
-     (let ((alist (,type-parse wrapped)))
-       (list ,@(map (lambda (f)
-                     `(cons ',(car f) ,(cadr f)))
-                   fields)))))
-
-(define-macro (define-field-reader field-reader type-parse body)
-  `(define (,field-reader wrapped)
-     (let ((alist (,type-parse wrapped)))
-       ,body)))
-
-(define-macro (field name)
-  `(assoc-ref alist ,name))
-
-(export-syntax define-conversion-type
-              field)
-
-
-;;; Support functions for type generation
-
-(define (bv-uint-ref pointer index)
-  (bytevector-uint-ref
-   (pointer->bytevector pointer 4 index)
-   0
-   (native-endianness)
-   4))
-
-(define* (array size root #:key (element-size 4) (element-proc bv-uint-ref))
-  (cond ((= (pointer-address root) 0)
-        '())
-       (else
-        (reverse
-         (let loop ((i 0) (res '()))
-           (cond ((= i size)
-                  res)
-                 (else
-                  (loop (+ i 1) (cons (element-proc root (* element-size i)) res)))))))))
-
-(define (get-element-address root-pointer offset)
-  (make-pointer (+ (pointer-address root-pointer) offset)))
-
-(define (sized-string s)
-  (cond (s
-        (bytevector->string
-         (u8-list->bytevector (list-head (cadr s) (car s)))
-         (fluid-ref %default-port-encoding)))
-       (else
-        #f)))
-
-(define (wrap pointers wrap-proc)
-  (define (make-wrap element)
-    (let ((pointer
-          (cond ((pointer? element)
-                 (if (= (pointer-address element) 0)
-                     #f
-                     element))
-                ((= element 0)
-                 #f)
-                (else
-                 (make-pointer element)))))
-      (cond (pointer
-            (wrap-proc pointer))
-           (else
-            #f))))
-  (cond ((list? pointers)
-        (map make-wrap pointers))
-       (else
-        (make-wrap pointers))))
-
-(export array
-       get-element-address
-       sized-string
-       wrap)
-
-
-;;; Function Mappers
-
-(define-syntax define-foreign-function
-  (lambda (x)
-    (syntax-case x (->)
-      ((_ ((foreign-lib name) arg-type ...) -> return-type)
-       (with-syntax ((name-string (datum->syntax x (symbol->string (syntax->datum #'name)))))
-         #'(define name
-            (pointer->procedure return-type
-                                (dynamic-func name-string foreign-lib)
-                                (list arg-type ...))))))))
-
-
-(define libassimp (dynamic-link "libassimp"))
-
-(define-syntax define-assimp-function
-  (syntax-rules (->)
-    ((_ (name arg-type ...) -> return-type)
-     (define-foreign-function ((libassimp name) arg-type ...) -> return-type))))
-
-
-(export-syntax define-foreign-function
-              define-assimp-function)
-
-
-;;; Enumerators and bitfields (copìed from figl code, thanks to Andy Wingo
-
-(define-syntax-rule (define-enumeration enumerator (name value) ...)
-  (define-syntax enumerator
-    (lambda (x)
-      (syntax-case x ()
-        ((_)
-         #''(name ...))
-        ((_ enum) (number? (syntax->datum #'enum))
-         #'enum)
-        ((_ enum)
-         #'(or (assq-ref `((name . ,(syntax->datum value)) ...)
-                        (syntax->datum #'enum))
-              (syntax-violation 'enumerator "invalid enumerated value"
-                                #'enum)))))))
-
-(define-syntax-rule (define-bitfield bitfield (name value) ...)
-  (define-syntax bitfield
-    (lambda (x)
-      (syntax-case x () 
-        ((_)
-         #''(name ...))
-        ((_ bit (... ...))
-         #`(logior
-            #,@(map
-                (lambda (bit)
-                  (let ((datum (syntax->datum bit)))
-                    (if (number? datum)
-                        datum
-                        (or (assq-ref '((name . value) ...) datum)
-                            (syntax-violation 'bitfield "invalid bitfield value"
-                                              bit)))))
-                #'(bit (... ...)))))))))
-
-(export-syntax define-enumeration
-              define-bitfield)
diff --git a/src/low-level/cimport.scm b/src/low-level/cimport.scm
deleted file mode 100644 (file)
index 7f0f259..0000000
+++ /dev/null
@@ -1,46 +0,0 @@
-;;; guile-assimp, foreign interface to libassimp
-;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
-;;;
-;;; This program is free software: you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation, either version 3 of the License, or
-;;; (at your option) any later version.
-;;;
-;;; This program 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 General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
-
-
-(define-module (assimp low-level cimport)
-  #:use-module (assimp low-level)
-  #:use-module (system foreign)
-  #:export (aiImportFile
-           aiReleaseImport
-           aiGetPredefinedLogStream
-           aiAttachLogStream
-           aiDetachAllLogStreams
-           aiTransformVecByMatrix4
-           aiMultiplyMatrix3
-           aiMultiplyMatrix4
-           aiIdentityMatrix3
-           aiIdentityMatrix4
-           aiTransposeMatrix3
-           aiTransposeMatrix4))
-
-(define-assimp-function (aiImportFile '* unsigned-int) -> '*)
-(define-assimp-function (aiReleaseImport '*) -> void)
-(define-assimp-function (aiGetPredefinedLogStream unsigned-int '*) -> (list '* '* '*))
-(define-assimp-function (aiAttachLogStream '*) -> void)
-(define-assimp-function (aiDetachAllLogStreams) -> void)
-
-(define-assimp-function (aiTransformVecByMatrix4 '* '*) -> void)
-(define-assimp-function (aiMultiplyMatrix3 '* '*) -> void)
-(define-assimp-function (aiMultiplyMatrix4 '* '*) -> void)
-(define-assimp-function (aiIdentityMatrix3 '*) -> void)
-(define-assimp-function (aiIdentityMatrix4 '*) -> void)
-(define-assimp-function (aiTransposeMatrix3 '*) -> void)
-(define-assimp-function (aiTransposeMatrix4 '*) -> void)
diff --git a/src/low-level/color.scm b/src/low-level/color.scm
deleted file mode 100644 (file)
index bc13274..0000000
+++ /dev/null
@@ -1,29 +0,0 @@
-;;; guile-assimp, foreign interface to libassimp
-;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
-;;;
-;;; This program is free software: you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation, either version 3 of the License, or
-;;; (at your option) any later version.
-;;;
-;;; This program 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 General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
-
-
-(define-module (assimp low-level color)
-  #:use-module (assimp low-level)
-  #:use-module (system foreign))
-
-
-(define-struct-parser parse-aiColor4D
-  (r float)
-  (g float)
-  (b float)
-  (a float))
-
-(export parse-aiColor4D)
diff --git a/src/low-level/material.scm b/src/low-level/material.scm
deleted file mode 100644 (file)
index 2b3ade1..0000000
+++ /dev/null
@@ -1,68 +0,0 @@
-;;; guile-assimp, foreign interface to libassimp
-;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
-;;;
-;;; This program is free software: you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation, either version 3 of the License, or
-;;; (at your option) any later version.
-;;;
-;;; This program 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 General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
-
-
-(define-module (assimp low-level material)
-  #:use-module (assimp low-level)
-  #:use-module (assimp low-level types)
-  #:use-module (system foreign)
-  #:export (parse-aiMaterial
-           parse-aiMaterialProperty
-           ai-material-key
-           aiGetMaterialColor
-           aiGetMaterialFloatArray
-           aiGetMaterialIntegerArray))
-
-
-(define-struct-parser parse-aiMaterialProperty
-  (mKey aiString-type)
-  (mSemantic unsigned-int)
-  (mIndex unsigned-int)
-  (mDataLength unsigned-int)
-  (mType unsigned-int)
-  (mData '*))
-
-(define-struct-parser parse-aiMaterial
-  (mProperties '*)
-  (mNumProperties unsigned-int)
-  (mNumAllocated unsigned-int))
-
-
-(define-enumeration
-  ai-material-key
-  (name '("?mat.name" 0 0))
-  (twosided '("$mat.twosided" 0 0))
-  (shading-model '("$mat.shadingm" 0 0))
-  (enable-wireframe '("$mat.wireframe" 0 0))
-  (blend-func '("$mat.blend" 0 0))
-  (opacity '("$mat.opacity" 0 0))
-  (bumpscaling '("$mat.bumpscaling" 0 0))
-  (shininess '("$mat.shininess" 0 0))
-  (reflectivity '("$mat.reflectivity" 0 0))
-  (shininess-strength '("$mat.shinpercent" 0 0))
-  (refracti '("$mat.refracti" 0 0))
-  (color-diffuse '("$clr.diffuse" 0 0))
-  (color-ambient '("$clr.ambient" 0 0))
-  (color-specular '("$clr.specular" 0 0))
-  (color-emissive '("$clr.emissive" 0 0))
-  (color-transparent '("$clr.transparent" 0 0))
-  (color-reflective '("$clr.reflective" 0 0))
-  (global-background-image '("?bg.global" 0 0)))
-
-
-(define-assimp-function (aiGetMaterialColor '* '* unsigned-int unsigned-int '*) -> int)
-(define-assimp-function (aiGetMaterialFloatArray '* '* unsigned-int unsigned-int '* '*) -> int)
-(define-assimp-function (aiGetMaterialIntegerArray '* '* unsigned-int unsigned-int '* '*) -> int)
diff --git a/src/low-level/matrix.scm b/src/low-level/matrix.scm
deleted file mode 100644 (file)
index 416b4d0..0000000
+++ /dev/null
@@ -1,53 +0,0 @@
-;;; guile-assimp, foreign interface to libassimp
-;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
-;;;
-;;; This program is free software: you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation, either version 3 of the License, or
-;;; (at your option) any later version.
-;;;
-;;; This program 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 General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
-
-
-(define-module (assimp low-level matrix)
-  #:use-module (assimp low-level)
-  #:use-module (system foreign))
-
-
-(define-struct-parser parse-aiMatrix3x3
-  (a1 float)
-  (a2 float)
-  (a3 float)
-  (b1 float)
-  (b2 float)
-  (b3 float)
-  (c1 float)
-  (c2 float)
-  (c3 float))
-
-(define-struct-parser parse-aiMatrix4x4
-  (a1 float)
-  (a2 float)
-  (a3 float)
-  (a4 float)
-  (b1 float)
-  (b2 float)
-  (b3 float)
-  (b4 float)
-  (c1 float)
-  (c2 float)
-  (c3 float)
-  (c4 float)
-  (d1 float)
-  (d2 float)
-  (d3 float)
-  (d4 float))
-
-(export parse-aiMatrix3x3
-       parse-aiMatrix4x4)
diff --git a/src/low-level/mesh.scm b/src/low-level/mesh.scm
deleted file mode 100644 (file)
index 50d0bb8..0000000
+++ /dev/null
@@ -1,69 +0,0 @@
-;;; guile-assimp, foreign interface to libassimp
-;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
-;;;
-;;; This program is free software: you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation, either version 3 of the License, or
-;;; (at your option) any later version.
-;;;
-;;; This program 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 General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
-
-
-(define-module (assimp low-level mesh)
-  #:use-module (assimp low-level)
-  #:use-module (assimp low-level types)
-  #:use-module (system foreign))
-
-
-(define-struct-parser parse-aiFace
-  (mNumIndices unsigned-int)
-  (mIndices '*))
-
-(export parse-aiFace)
-
-
-(define-struct-parser parser-aiVertexWeight
-  (mVertexId unsigned-int)
-  (mWeight float))
-
-(export parse-aiVertexWeight)
-
-
-(define-struct-parser parse-aiBone
-  (mName aiString-type)
-  (mNumWeights unsigned-int)
-  (mWeights '*)
-  (mOffsetMatrix aiMatrix4x4-type))
-
-(export parse-aiBone)
-
-
-(define AI_MAX_NUMBER_OF_COLOR_SETS #x8)
-(define AI_MAX_NUMBER_OF_TEXTURECOORDS #x8)
-
-(define-struct-parser parse-aiMesh
-  (mPrimitiveTypes unsigned-int)
-  (mNumVertices unsigned-int)
-  (mNumFaces unsigned-int)
-  (mVertices '*)
-  (mNormals '*)
-  (mTangents '*)
-  (mBitangents '*)
-  (mColors (make-list AI_MAX_NUMBER_OF_COLOR_SETS '*))
-  (mTextureCoords (make-list AI_MAX_NUMBER_OF_TEXTURECOORDS '*))
-  (mNumUVComponents (make-list AI_MAX_NUMBER_OF_TEXTURECOORDS unsigned-int))
-  (mFaces '*)
-  (mNumBones unsigned-int)
-  (mBones '*)
-  (mMaterialIndex unsigned-int)
-  (mName aiString-type)
-  (mNumAnimMeshes unsigned-int)
-  (mAnimMeshes '*))
-
-(export parse-aiMesh)
diff --git a/src/low-level/postprocess.scm b/src/low-level/postprocess.scm
deleted file mode 100644 (file)
index 20ca550..0000000
+++ /dev/null
@@ -1,92 +0,0 @@
-;;; guile-assimp, foreign interface to libassimp
-;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
-;;;
-;;; This program is free software: you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation, either version 3 of the License, or
-;;; (at your option) any later version.
-;;;
-;;; This program 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 General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
-
-
-(define-module (assimp low-level postprocess)
-  #:use-module (assimp low-level)
-  #:export (ai-process-steps
-           ai-process-convert-to-left-handed
-           ai-process-preset-target-realtime-fast
-           ai-process-preset-target-realtime-quality
-           ai-process-preset-target-realtime-max-quality))
-
-
-(define-bitfield
-  ai-process-steps
-  (calc-tangent-space #x1)
-  (join-identical-vertices #x2)
-  (make-left-handed #x4)
-  (triangulate #x8)
-  (remove-component #x10)
-  (gen-normals #x20)
-  (gen-smooth-normals #x40)
-  (split-large-meshes #x80)
-  (pretransform-vertices #x100)
-  (limit-bone-weights #x200)
-  (validate-data-structure #x400)
-  (improve-cache-locality #x800)
-  (remove-redundant-materials #x1000)
-  (fix-infacing-normals #x2000)
-  (sort-by-ptype #x8000)
-  (find-degenerates #x10000)
-  (find-invalid-data #x20000)
-  (gen-UV-coords #x40000)
-  (transform-UV-coords #x80000)
-  (find-instances #x100000)
-  (optimize-meshes #x200000)
-  (optimize-graph #x400000)
-  (flip-UVs #x800000)
-  (flip-winding-order #x1000000)
-  (split-by-bone-count #x2000000)
-  (debone #x4000000))
-
-(define ai-process-convert-to-left-handed
-  (ai-process-steps
-   make-left-handed
-   flip-UVs
-   flip-winding-order))
-
-(define ai-process-preset-target-realtime-fast
-  (ai-process-steps
-   calc-tangent-space
-   gen-normals
-   join-identical-vertices
-   triangulate
-   gen-UV-coords
-   sort-by-ptype))
-
-(define ai-process-preset-target-realtime-quality
-  (ai-process-steps
-   calc-tangent-space
-   gen-smooth-normals
-   join-identical-vertices
-   improve-cache-locality
-   limit-bone-weights
-   remove-redundant-materials
-   split-large-meshes
-   triangulate
-   gen-UV-coords
-   sort-by-ptype
-   find-degenerates
-   find-invalid-data))
-
-(define ai-process-preset-target-realtime-max-quality
-  (+ ai-process-preset-target-realtime-quality
-     (ai-process-steps
-      find-instances
-      validate-data-structure
-      optimize-meshes
-      debone)))
diff --git a/src/low-level/scene.scm b/src/low-level/scene.scm
deleted file mode 100644 (file)
index 651ea3a..0000000
+++ /dev/null
@@ -1,53 +0,0 @@
-;;; guile-assimp, foreign interface to libassimp
-;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
-;;;
-;;; This program is free software: you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation, either version 3 of the License, or
-;;; (at your option) any later version.
-;;;
-;;; This program 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 General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
-
-
-(define-module (assimp low-level scene)
-  #:use-module (assimp low-level)
-  #:use-module (assimp low-level types)
-  #:use-module (system foreign))
-
-
-(define-struct-parser parse-aiNode
-  (mName aiString-type)
-  (mTransformation aiMatrix4x4-type)
-  (mParent '*)
-  (mNumChildren unsigned-int)
-  (mChildren '*)
-  (mNumMeshes unsigned-int)
-  (mMeshes '*))
-
-(export parse-aiNode)
-
-
-(define-struct-parser parse-aiScene
-  (mFlags unsigned-int)
-  (mRootNode '*)
-  (mNumMeshes unsigned-int)
-  (mMeshes '*)
-  (mNumMaterials unsigned-int)
-  (mMaterials '*)
-  (mNumAnimations unsigned-int)
-  (mAnimations '*)
-  (mNumTextures unsigned-int)
-  (mTextures '*)
-  (mNumLights unsigned-int)
-  (mLights '*)
-  (mNumCameras unsigned-int)
-  (mCameras '*)
-  (mPrivate '*))
-
-(export parse-aiScene)
diff --git a/src/low-level/types.scm b/src/low-level/types.scm
deleted file mode 100644 (file)
index 20e2281..0000000
+++ /dev/null
@@ -1,38 +0,0 @@
-;;; guile-assimp, foreign interface to libassimp
-;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
-;;;
-;;; This program is free software: you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation, either version 3 of the License, or
-;;; (at your option) any later version.
-;;;
-;;; This program 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 General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
-
-
-(define-module (assimp low-level types)
-  #:use-module (assimp low-level)
-  #:use-module (system foreign)
-  #:export (aiString-type
-           aiMatrix4x4-type
-           ai-default-log-stream))
-
-
-(define aiString-type
-  (list size_t (make-list 1024 int8)))
-
-(define aiMatrix4x4-type
-  (make-list 16 float))
-
-(define-enumeration
-  ai-default-log-stream
-  (file #x1)
-  (stdout #x2)
-  (stderr #x4)
-  (debugger #x8)
-  (ai-dls-enforce-enum-size #x7fffffff))
diff --git a/src/low-level/vector.scm b/src/low-level/vector.scm
deleted file mode 100644 (file)
index 49b9916..0000000
+++ /dev/null
@@ -1,33 +0,0 @@
-;;; guile-assimp, foreign interface to libassimp
-;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
-;;;
-;;; This program is free software: you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation, either version 3 of the License, or
-;;; (at your option) any later version.
-;;;
-;;; This program 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 General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
-
-
-(define-module (assimp low-level vector)
-  #:use-module (assimp low-level)
-  #:use-module (system foreign))
-
-
-(define-struct-parser parse-aiVector2D
-  (x float)
-  (y float))
-
-(define-struct-parser parse-aiVector3D
-  (x float)
-  (y float)
-  (z float))
-
-(export parse-aiVector2D
-       parse-aiVector3D)