/* Define a C preprocessor symbol that can be used in interface files
   to distinguish between the SWIG language modules. */ 

#define SWIG_ALLEGRO_CL

#define %ffargs(...) %feature("ffargs", "1", ##__VA_ARGS__)
%ffargs(strings_convert="t");

/* typemaps for argument and result type conversions. */
%typemap(lin,numinputs=1)	SWIGTYPE 	"(cl::let (($out $in))\n  $body)";

%typemap(lout) bool, char, unsigned char, signed char,
               short, signed short, unsigned short,
               int, signed int, unsigned int,
               long, signed long, unsigned long,
               float, double, long double, char *, void *,
               enum SWIGTYPE    "(cl::setq ACL_ffresult $body)";
%typemap(lout) void "$body";
%typemap(lout) SWIGTYPE[ANY], SWIGTYPE *,
               SWIGTYPE &       
%{ (cl:let* ((address $body)
	  (new-inst (cl:make-instance '$lclass :foreign-address address)))
     (cl:when (cl:and $owner (cl:not (cl:zerop address)))
       (excl:schedule-finalization new-inst #'$ldestructor))
     (cl:setq ACL_ffresult new-inst)) %}

%typemap(lout) SWIGTYPE         "(cl::let* ((address $body)\n         (new-inst (cl::make-instance '$lclass :foreign-address address)))\n    (cl::unless (cl::zerop address)\n      (excl:schedule-finalization new-inst #'$ldestructor))\n    (cl::setq ACL_ffresult new-inst))";

%typemap(lisptype) bool "cl:boolean";
%typemap(lisptype) char "cl:character";
%typemap(lisptype) unsigned char "cl:integer";
%typemap(lisptype) signed char "cl:integer";

%typemap(ffitype) bool ":int";
%typemap(ffitype) char ":char";
%typemap(ffitype) unsigned char ":unsigned-char";
%typemap(ffitype) signed char ":char";
%typemap(ffitype) short, signed short ":short";
%typemap(ffitype) unsigned short ":unsigned-short";
%typemap(ffitype) int, signed int ":int";
%typemap(ffitype) unsigned int ":unsigned-int";
%typemap(ffitype) long, signed long ":long";
%typemap(ffitype) unsigned long ":unsigned-long";
%typemap(ffitype) float ":float";
%typemap(ffitype) double ":double";
%typemap(ffitype) char * "(* :char)";
%typemap(ffitype) void * "(* :void)";
%typemap(ffitype) void ":void";
%typemap(ffitype) enum SWIGTYPE ":int";
%typemap(ffitype) SWIGTYPE & "(* :void)";

%typemap(ctype) bool                       "int";
%typemap(ctype) char, unsigned char, signed char,
                short, signed short, unsigned short,
                int, signed int, unsigned int,
                long, signed long, unsigned long,
                float, double, long double, char *, void *, void,
                enum SWIGTYPE, SWIGTYPE *,
                SWIGTYPE[ANY], SWIGTYPE &  "$1_ltype";
%typemap(ctype) SWIGTYPE                   "$&1_type";

%typemap(in) bool                          "$1 = (bool)$input;";
%typemap(in) char, unsigned char, signed char,
             short, signed short, unsigned short,
             int, signed int, unsigned int,
             long, signed long, unsigned long,
             float, double, long double, char *, void *, void,
             enum SWIGTYPE, SWIGTYPE *,
             SWIGTYPE[ANY], SWIGTYPE &     "$1 = $input;";
%typemap(in) SWIGTYPE                      "$1 = *$input;";

/* We don't need to do any actual C-side typechecking, but need to
   use the precedence values to choose which overloaded function
   interfaces to generate when conflicts arise. */

/* predefined precedence values

Symbolic Name                   Precedence Value
------------------------------  ------------------
SWIG_TYPECHECK_POINTER           0  
SWIG_TYPECHECK_VOIDPTR           10 
SWIG_TYPECHECK_BOOL              15 
SWIG_TYPECHECK_UINT8             20 
SWIG_TYPECHECK_INT8              25 
SWIG_TYPECHECK_UINT16            30 
SWIG_TYPECHECK_INT16             35 
SWIG_TYPECHECK_UINT32            40 
SWIG_TYPECHECK_INT32             45 
SWIG_TYPECHECK_UINT64            50 
SWIG_TYPECHECK_INT64             55 
SWIG_TYPECHECK_UINT128           60 
SWIG_TYPECHECK_INT128            65 
SWIG_TYPECHECK_INTEGER           70 
SWIG_TYPECHECK_FLOAT             80 
SWIG_TYPECHECK_DOUBLE            90 
SWIG_TYPECHECK_COMPLEX           100 
SWIG_TYPECHECK_UNICHAR           110 
SWIG_TYPECHECK_UNISTRING         120 
SWIG_TYPECHECK_CHAR              130 
SWIG_TYPECHECK_STRING            140 
SWIG_TYPECHECK_BOOL_ARRAY        1015 
SWIG_TYPECHECK_INT8_ARRAY        1025 
SWIG_TYPECHECK_INT16_ARRAY       1035 
SWIG_TYPECHECK_INT32_ARRAY       1045 
SWIG_TYPECHECK_INT64_ARRAY       1055 
SWIG_TYPECHECK_INT128_ARRAY      1065 
SWIG_TYPECHECK_FLOAT_ARRAY       1080 
SWIG_TYPECHECK_DOUBLE_ARRAY      1090 
SWIG_TYPECHECK_CHAR_ARRAY        1130 
SWIG_TYPECHECK_STRING_ARRAY      1140
*/

%typecheck(SWIG_TYPECHECK_BOOL) bool { $1 = 1; };
%typecheck(SWIG_TYPECHECK_CHAR) char { $1 = 1; };
%typecheck(SWIG_TYPECHECK_FLOAT) float { $1 = 1; };
%typecheck(SWIG_TYPECHECK_DOUBLE) double { $1 = 1; };
%typecheck(SWIG_TYPECHECK_STRING) char * { $1 = 1; };
%typecheck(SWIG_TYPECHECK_INTEGER)
                    unsigned char, signed char,
                    short, signed short, unsigned short,
                    int, signed int, unsigned int,
                    long, signed long, unsigned long,
                    enum SWIGTYPE { $1 = 1; };
%typecheck(SWIG_TYPECHECK_POINTER) SWIGTYPE *, SWIGTYPE &,
                                   SWIGTYPE[ANY], SWIGTYPE { $1 = 1; };

/* This maps C/C++ types to Lisp classes for overload dispatch */

%typemap(lispclass) bool "t";
%typemap(lispclass) char "cl:character";
%typemap(lispclass) unsigned char, signed char,
                    short, signed short, unsigned short,
                    int, signed int, unsigned int,
                    long, signed long, unsigned long,
                    enum SWIGTYPE       "cl:integer";
%typemap(lispclass) float "cl:single-float";
%typemap(lispclass) double "cl:double-float";
%typemap(lispclass) char * "cl:string";

%typemap(out) bool                          "$result = (int)$1;";
%typemap(out) char, unsigned char, signed char,
              short, signed short, unsigned short,
              int, signed int, unsigned int,
              long, signed long, unsigned long,
              float, double, long double, char *, void *, void,
              enum SWIGTYPE, SWIGTYPE *,
              SWIGTYPE[ANY], SWIGTYPE &    "$result = $1;";
#ifdef __cplusplus
%typemap(out) SWIGTYPE                     "$result = new $1_type($1);";
#else
%typemap(out) SWIGTYPE {
  $result = ($&1_ltype) malloc(sizeof($1_type));
  memmove($result, &$1, sizeof($1_type));
}
#endif

//////////////////////////////////////////////////////////////
// UCS-2 string conversion

// should this be SWIG_TYPECHECK_CHAR?
%typecheck(SWIG_TYPECHECK_UNICHAR) wchar_t { $1 = 1; };

%typemap(in)        wchar_t "$1 = $input;";
%typemap(lin,numinputs=1)       wchar_t "(cl::let (($out (cl:char-code $in)))\n  $body)";
%typemap(lin,numinputs=1)       wchar_t* "(excl:with-native-string ($out $in
:external-format #+little-endian :fat-le #-little-endian :fat)\n
$body)"

%typemap(out)       wchar_t "$result = $1;";
%typemap(lout)      wchar_t "(cl::setq ACL_ffresult (cl::code-char $body))";
%typemap(lout)      wchar_t* "(cl::setq ACL_ffresult (excl:native-to-string $body
:external-format #+little-endian :fat-le #-little-endian :fat))";

%typemap(ffitype)   wchar_t ":unsigned-short";
%typemap(lisptype)  wchar_t "";
%typemap(ctype)     wchar_t "wchar_t";
%typemap(lispclass) wchar_t "cl:character";
%typemap(lispclass) wchar_t* "cl:string";
//////////////////////////////////////////////////////////////

/* name conversion for overloaded operators. */
#ifdef __cplusplus
%rename(__add__)	     *::operator+;
%rename(__pos__)	     *::operator+();
%rename(__pos__)	     *::operator+() const;

%rename(__sub__)	     *::operator-;
%rename(__neg__)	     *::operator-() const;
%rename(__neg__)	     *::operator-();

%rename(__mul__)	     *::operator*;
%rename(__deref__)	     *::operator*();
%rename(__deref__)	     *::operator*() const;

%rename(__div__)	     *::operator/;
%rename(__mod__)	     *::operator%;
%rename(__logxor__)	     *::operator^;
%rename(__logand__)	     *::operator&;
%rename(__logior__)	     *::operator|;
%rename(__lognot__)	     *::operator~();
%rename(__lognot__)	     *::operator~() const;

%rename(__not__)	     *::operator!();
%rename(__not__)	     *::operator!() const;

%rename(__assign__)	     *::operator=;

%rename(__add_assign__)      *::operator+=;
%rename(__sub_assign__)	     *::operator-=;
%rename(__mul_assign__)	     *::operator*=;
%rename(__div_assign__)	     *::operator/=;
%rename(__mod_assign__)	     *::operator%=;
%rename(__logxor_assign__)   *::operator^=;
%rename(__logand_assign__)   *::operator&=;
%rename(__logior_assign__)   *::operator|=;

%rename(__lshift__)	     *::operator<<;
%rename(__lshift_assign__)   *::operator<<=;
%rename(__rshift__)	     *::operator>>;
%rename(__rshift_assign__)   *::operator>>=;

%rename(__eq__)		     *::operator==;
%rename(__ne__)		     *::operator!=;
%rename(__lt__)		     *::operator<;
%rename(__gt__)		     *::operator>;
%rename(__lte__)	     *::operator<=;
%rename(__gte__)	     *::operator>=;

%rename(__and__)	     *::operator&&;
%rename(__or__)		     *::operator||;

%rename(__preincr__)	     *::operator++();
%rename(__postincr__)	     *::operator++(int);
%rename(__predecr__)	     *::operator--();
%rename(__postdecr__)	     *::operator--(int);

%rename(__comma__)	     *::operator,();
%rename(__comma__)	     *::operator,() const;

%rename(__member_ref__)      *::operator->;
%rename(__member_func_ref__) *::operator->*;

%rename(__funcall__)	     *::operator();
%rename(__aref__)	     *::operator[];
#endif

%insert("lisphead") %{
;; $Id: allegrocl.swg 9901 2007-08-16 18:39:50Z mutandiz $

(eval-when (compile load eval)

  ;; avoid compiling ef-templates at runtime
  (excl:find-external-format :fat)
  (excl:find-external-format :fat-le)

;;; You can define your own identifier converter if you want.
;;; Use the -identifier-converter command line argument to
;;; specify its name.

(eval-when (:compile-toplevel :load-toplevel :execute)
   (cl::defparameter *swig-export-list* nil))

(cl::defconstant *void* :..void..)

;; parsers to aid in finding SWIG definitions in files.
(cl::defun scm-p1 (form)
  (let* ((info (cl::second form))
	 (id (car info))
	 (id-args (if (eq (cl::car form) 'swig-dispatcher)
		      (cl::cdr info)
		      (cl::cddr info))))
    (cl::apply *swig-identifier-converter* id 
	   (cl::progn (cl::when (cl::eq (cl::car form) 'swig-dispatcher)
		    (cl::remf id-args :arities))
		  id-args))))

(cl::defmacro defswig1 (name (&rest args) &body body)
  `(cl::progn (cl::defmacro ,name ,args
	    ,@body)
	  (excl::define-simple-parser ,name scm-p1)) )

(cl::defmacro defswig2 (name (&rest args) &body body)
  `(cl::progn (cl::defmacro ,name ,args
	    ,@body)
	  (excl::define-simple-parser ,name second)))

(defun read-symbol-from-string (string)
  (cl::multiple-value-bind (result position)
      (cl::read-from-string string nil "eof" :preserve-whitespace t)
    (cl::if (cl::and (cl::symbolp result)
    	             (cl::eql position (cl::length string)))
        result
	(cl::multiple-value-bind (sym)
	    (cl::intern string)
	  sym))))

(cl::defun full-name (id type arity class)
  (cl::case type
    (:getter (cl::format nil "~@[~A_~]~A" class id))
    (:constructor (cl::format nil "new_~A~@[~A~]" id arity))
    (:destructor (cl::format nil "delete_~A" id))
    (:type (cl::format nil "ff_~A" id))
    (:slot id)
    (:ff-operator (cl::format nil "ffi_~A" id))
    (otherwise (cl::format nil "~@[~A_~]~A~@[~A~]"
                       class id arity))))
  
(cl::defun identifier-convert-null (id &key type class arity)
  (cl::if (cl::eq type :setter)
      `(cl::setf ,(identifier-convert-null
               id :type :getter :class class :arity arity))
      (read-symbol-from-string (full-name id type arity class))))

(cl::defun identifier-convert-lispify (cname &key type class arity)
  (cl::assert (cl::stringp cname))
  (cl::when (cl::eq type :setter)
    (cl::return-from identifier-convert-lispify
      `(cl::setf ,(identifier-convert-lispify
               cname :type :getter :class class :arity arity))))
  (cl::setq cname (full-name cname type arity class))
  (cl::if (cl::eq type :constant)
      (cl::setf cname (cl::format nil "*~A*" cname)))
  (cl::setf cname (excl::replace-regexp cname "_" "-"))
  (cl::let ((lastcase :other)
       	    newcase char res)
    (cl::dotimes (n (cl::length cname))
      (cl::setf char (cl::schar cname n))
      (excl::if* (cl::alpha-char-p char)
         then
              (cl::setf newcase (cl::if (cl::upper-case-p char) :upper :lower))

              (cl::when (cl::or (cl::and (cl::eq lastcase :upper)
	      				 (cl::eq newcase :lower))
                                (cl::and (cl::eq lastcase :lower)
					 (cl::eq newcase :upper)))
                ;; case change... add a dash
                (cl::push #\- res)
                (cl::setf newcase :other))

              (cl::push (cl::char-downcase char) res)

              (cl::setf lastcase newcase)

         else
              (cl::push char res)
              (cl::setf lastcase :other)))
    (read-symbol-from-string (cl::coerce (cl::nreverse res) 'string))))

(cl::defun id-convert-and-export (name &rest kwargs)
  (cl::multiple-value-bind (symbol package)
      (cl::apply *swig-identifier-converter* name kwargs)
    (cl::let ((args (cl::list (cl::if (cl::consp symbol)
    	     	    	         (cl::cadr symbol) symbol)
                      (cl::or package cl::*package*))))
      (cl::apply #'cl::export args)
      (cl::pushnew args *swig-export-list*))
    symbol))

(cl::defmacro swig-insert-id (name namespace &key (type :type) class)
  `(cl::let ((cl::*package* (cl::find-package ,(package-name-for-namespace namespace))))
    (id-convert-and-export ,name :type ,type :class ,class)))

(defswig2 swig-defconstant (string value)
  (cl::let ((symbol (id-convert-and-export string :type :constant)))
    `(cl::eval-when (compile load eval)
       (cl::defconstant ,symbol ,value))))

(cl::defun maybe-reorder-args (funcname arglist)
  ;; in the foreign setter function the new value will be the last argument
  ;; in Lisp it needs to be the first
  (cl::if (cl::consp funcname)
      (cl::append (cl::last arglist) (cl::butlast arglist))
      arglist))

(cl::defun maybe-return-value (funcname arglist)
  ;; setf functions should return the new value
  (cl::when (cl::consp funcname)
    `(,(cl::if (cl::consp (cl::car arglist))
           (cl::caar arglist)
           (cl::car arglist)))))

(cl::defun swig-anyvarargs-p (arglist)
  (cl::member :SWIG__varargs_ arglist))

(defswig1 swig-defun ((name &optional (mangled-name name)
                            &key (type :operator) class arity)
                      arglist kwargs
		      &body body)
  (cl::let* ((symbol (id-convert-and-export name :type type
                          :arity arity :class class))
             (mangle (excl::if* (cl::string-equal name mangled-name)
                      then (id-convert-and-export 
				    (cl::cond
					  ((cl::eq type :setter) (cl::format nil "~A-set" name))
					  ((cl::eq type :getter) (cl::format nil "~A-get" name))
					  (t name))
				    :type :ff-operator :arity arity :class class)
                      else (cl::intern mangled-name)))
         (defun-args (maybe-reorder-args
                      symbol
		      (cl::mapcar #'cl::car (cl::and (cl::not (cl::equal arglist '(:void)))
					 (cl::loop as i in arglist
					       when (cl::eq (cl::car i) :p+)
					       collect (cl::cdr i))))))
	 (ffargs (cl::if (cl::equal arglist '(:void))
	 	      arglist
		    (cl::mapcar #'cl::cdr arglist)))
	 )
    (cl::when (swig-anyvarargs-p ffargs)
      (cl::setq ffargs '()))
    `(cl::eval-when (compile load eval)
       (excl::compiler-let ((*record-xref-info* nil))
         (ff:def-foreign-call (,mangle ,mangled-name) ,ffargs ,@kwargs))
       (cl::macrolet ((swig-ff-call (&rest args)
                      (cl::cons ',mangle args)))
         (cl::defun ,symbol ,defun-args
           ,@body
           ,@(maybe-return-value symbol defun-args))))))

(defswig1 swig-defmethod ((name &optional (mangled-name name)
	  	                &key (type :operator) class arity)
                          ffargs kwargs
                          &body body)
  (cl::let* ((symbol (id-convert-and-export name :type type
                          :arity arity :class class))
         (mangle (cl::intern mangled-name))
         (defmethod-args (maybe-reorder-args
                          symbol
                          (cl::unless (cl::equal ffargs '(:void))
                            (cl::loop for (lisparg name dispatch) in ffargs
			    	  when (eq lisparg :p+)
                                  collect `(,name ,dispatch)))))
         (ffargs (cl::if (cl::equal ffargs '(:void))
                     ffargs
                     (cl::loop for (nil name nil . ffi) in ffargs
                           collect `(,name ,@ffi)))))
    `(cl::eval-when (compile load eval)
       (excl::compiler-let ((*record-xref-info* nil))
         (ff:def-foreign-call (,mangle ,mangled-name) ,ffargs ,@kwargs))
       (cl::macrolet ((swig-ff-call (&rest args)
                      (cl::cons ',mangle args)))
         (cl::defmethod ,symbol ,defmethod-args
           ,@body
           ,@(maybe-return-value symbol defmethod-args))))))

(defswig1 swig-dispatcher ((name &key (type :operator) class arities))
  (cl::let ((symbol (id-convert-and-export name
                         :type type :class class)))
    `(cl::eval-when (compile load eval)
       (cl::defun ,symbol (&rest args)
         (cl::case (cl::length args)
           ,@(cl::loop for arity in arities
                   for symbol-n = (id-convert-and-export name
                                           :type type :class class :arity arity)
                   collect `(,arity (cl::apply #',symbol-n args)))
	   (t (cl::error "No applicable wrapper-methods for foreign call ~a with args ~a of classes ~a" ',symbol args (cl::mapcar #'(cl::lambda (x) (cl::class-name (cl::class-of x))) args)))
	   )))))

(defswig2 swig-def-foreign-stub (name)
  (cl::let ((lsymbol (id-convert-and-export name :type :class))
	    (symbol (id-convert-and-export name :type :type)))
    `(cl::eval-when (compile load eval)
	(ff:def-foreign-type ,symbol (:class ))
	(cl::defclass ,lsymbol (ff:foreign-pointer) ()))))

(defswig2 swig-def-foreign-class (name supers &rest rest)
  (cl::let ((lsymbol (id-convert-and-export name :type :class))
	    (symbol (id-convert-and-export name :type :type)))
    `(cl::eval-when (compile load eval)
       (ff:def-foreign-type ,symbol ,@rest)
       (cl::defclass ,lsymbol ,supers
	 ((foreign-type :initform ',symbol :initarg :foreign-type
			:accessor foreign-pointer-type))))))

(defswig2 swig-def-foreign-type (name &rest rest)
  (cl::let ((symbol (id-convert-and-export name :type :type)))
    `(cl::eval-when (compile load eval)
       (ff:def-foreign-type ,symbol ,@rest))))

(defswig2 swig-def-synonym-type (synonym of ff-synonym)
  `(cl::eval-when (compile load eval)
     (cl::setf (cl::find-class ',synonym) (cl::find-class ',of))
     (ff:def-foreign-type ,ff-synonym (:struct ))))

(cl::defun package-name-for-namespace (namespace)
  (excl::list-to-delimited-string
   (cl::cons *swig-module-name*
         (cl::mapcar #'(cl::lambda (name)
                     (cl::string
                      (cl::funcall *swig-identifier-converter*
                               name
                               :type :namespace)))
                 namespace))
   "."))

(cl::defmacro swig-defpackage (namespace)
  (cl::let* ((parent-namespaces (cl::maplist #'cl::reverse (cl::cdr (cl::reverse namespace))))
             (parent-strings (cl::mapcar #'package-name-for-namespace
                                 parent-namespaces))
             (string (package-name-for-namespace namespace)))
    `(cl::eval-when (compile load eval)
      (cl::defpackage ,string
        (:use :swig :ff #+ignore '(:common-lisp :ff :excl)
              ,@parent-strings ,*swig-module-name*)
	(:import-from :cl :* :nil :t)))))

(cl::defmacro swig-in-package (namespace)
  `(cl::eval-when (compile load eval)
    (cl::in-package ,(package-name-for-namespace namespace))))

(defswig2 swig-defvar (name mangled-name &key type (ftype :unsigned-natural))
  (cl::let ((symbol (id-convert-and-export name :type type)))
    `(cl::eval-when (compile load eval)
      (ff:def-foreign-variable (,symbol ,mangled-name) :type ,ftype))))

) ;; eval-when

(cl::eval-when (compile eval)
  (cl::flet ((starts-with-p (str prefix)
              (cl::and (cl::>= (cl::length str) (cl::length prefix))
                (cl::string= str prefix :end1 (cl::length prefix)))))
    (cl::export (cl::loop for sym being each present-symbol of cl::*package*
                  when (cl::or (starts-with-p (cl::symbol-name sym) (cl::symbol-name :swig-))
                           (starts-with-p (cl::symbol-name sym) (cl::symbol-name :identifier-convert-)))
                  collect sym))))

%}



%{

#ifdef __cplusplus
#  define EXTERN   extern "C"
#else
#  define EXTERN   extern
#endif

#define EXPORT   EXTERN SWIGEXPORT

#include <string.h>
#include <stdlib.h>
%}