Team Fortress 2 Source Code as on 22/4/2020
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

208 lines
4.2 KiB

  1. /* */
  2. %insert("header") "swiglabels.swg"
  3. %insert("header") "swigerrors.swg"
  4. %insert("init") "swiginit.swg"
  5. %insert("runtime") "swigrun.swg"
  6. %insert("runtime") "rrun.swg"
  7. %init %{
  8. SWIGEXPORT void SWIG_init(void) {
  9. %}
  10. #define %Rruntime %insert("s")
  11. #define SWIG_Object SEXP
  12. #define VOID_Object R_NilValue
  13. #define %append_output(obj) SET_VECTOR_ELT($result, $n, obj)
  14. %define %set_constant(name, obj) %begin_block
  15. SEXP _obj = obj;
  16. assign(name, _obj);
  17. %end_block %enddef
  18. %define %raise(obj,type,desc)
  19. return R_NilValue;
  20. %enddef
  21. %insert("sinit") "srun.swg"
  22. %insert("sinitroutine") %{
  23. SWIG_init();
  24. SWIG_InitializeModule(0);
  25. %}
  26. %include <typemaps/swigmacros.swg>
  27. %typemap(in) (double *x, int len) %{
  28. $1 = REAL(x);
  29. $2 = Rf_length(x);
  30. %}
  31. /* XXX
  32. Need to worry about inheritance, e.g. if B extends A
  33. and we are looking for an A[], then B elements are okay.
  34. */
  35. %typemap(scheck) SWIGTYPE[ANY]
  36. %{
  37. # assert(length($input) > $1_dim0)
  38. assert(all(sapply($input, class) == "$R_class"))
  39. %}
  40. %typemap(out) void "";
  41. %typemap(in) int *, int[ANY] %{
  42. $1 = INTEGER($input);
  43. %}
  44. %typemap(in) double *, double[ANY] %{
  45. $1 = REAL($input);
  46. %}
  47. /* Shoul dwe recycle to make the length correct.
  48. And warn if length() > the dimension.
  49. */
  50. %typemap(scheck) SWIGTYPE [ANY] %{
  51. # assert(length($input) >= $1_dim0)
  52. %}
  53. /* Handling vector case to avoid warnings,
  54. although we just use the first one. */
  55. %typemap(scheck) unsigned int %{
  56. assert(length($input) == 1 && $input >= 0, "All values must be non-negative")
  57. %}
  58. %typemap(scheck) int %{
  59. if(length($input) > 1) {
  60. Rf_warning("using only the first element of $input")
  61. }
  62. %}
  63. %include <typemaps/swigmacros.swg>
  64. %include <typemaps/fragments.swg>
  65. %include <rfragments.swg>
  66. %include <ropers.swg>
  67. %include <typemaps/swigtypemaps.swg>
  68. %include <rtype.swg>
  69. %apply int[ANY] { enum SWIGTYPE[ANY] };
  70. %typemap(in,noblock=1) enum SWIGTYPE[ANY] {
  71. $1 = %reinterpret_cast(INTEGER($input), $1_ltype);
  72. }
  73. %typemap(in,noblock=1,fragment="SWIG_strdup") char* {
  74. $1 = %reinterpret_cast(SWIG_strdup(CHAR(STRING_ELT($input, 0))), $1_ltype);
  75. }
  76. %typemap(freearg,noblock=1) char* {
  77. free($1);
  78. }
  79. %typemap(in,noblock=1,fragment="SWIG_strdup") char *[ANY] {
  80. $1 = %reinterpret_cast(SWIG_strdup(CHAR(STRING_ELT($input, 0))), $1_ltype);
  81. }
  82. %typemap(freearg,noblock=1) char *[ANY] {
  83. free($1);
  84. }
  85. %typemap(in,noblock=1,fragment="SWIG_strdup") char[ANY] {
  86. $1 = SWIG_strdup(CHAR(STRING_ELT($input, 0)));
  87. }
  88. %typemap(freearg,noblock=1) char[ANY] {
  89. free($1);
  90. }
  91. %typemap(in,noblock=1,fragment="SWIG_strdup") char[] {
  92. $1 = SWIG_strdup(CHAR(STRING_ELT($input, 0)));
  93. }
  94. %typemap(freearg,noblock=1) char[] {
  95. free($1);
  96. }
  97. %typemap(memberin) char[] %{
  98. if ($input) strcpy($1, $input);
  99. else
  100. strcpy($1, "");
  101. %}
  102. %typemap(globalin) char[] %{
  103. if ($input) strcpy($1, $input);
  104. else
  105. strcpy($1, "");
  106. %}
  107. %typemap(out,noblock=1) char*
  108. { $result = $1 ? Rf_mkString(%reinterpret_cast($1,char *)) : R_NilValue; }
  109. %typemap(in,noblock=1) char {
  110. $1 = %static_cast(CHAR(STRING_ELT($input, 0))[0],$1_ltype);
  111. }
  112. %typemap(out) char
  113. {
  114. char tmp[2] = "x";
  115. tmp[0] = $1;
  116. $result = Rf_mkString(tmp);
  117. }
  118. %typemap(in,noblock=1) int {
  119. $1 = %static_cast(INTEGER($input)[0], $1_ltype);
  120. }
  121. %typemap(out,noblock=1) int
  122. "$result = Rf_ScalarInteger($1);";
  123. %typemap(in,noblock=1) bool
  124. "$1 = LOGICAL($input)[0] ? true : false;";
  125. %typemap(out,noblock=1) bool
  126. "$result = Rf_ScalarLogical($1);";
  127. %typemap(in,noblock=1) unsigned int,
  128. unsigned long,
  129. float,
  130. double,
  131. long
  132. {
  133. $1 = %static_cast(REAL($input)[0], $1_ltype);
  134. }
  135. %typemap(out,noblock=1) unsigned int *
  136. "$result = ScalarReal(*($1));";
  137. %Rruntime %{
  138. setMethod('[', "ExternalReference",
  139. function(x,i,j, ..., drop=TRUE)
  140. if (!is.null(x$"__getitem__"))
  141. sapply(i, function(n) x$"__getitem__"(i=as.integer(n-1))))
  142. setMethod('[<-' , "ExternalReference",
  143. function(x,i,j, ..., value)
  144. if (!is.null(x$"__setitem__")) {
  145. sapply(1:length(i), function(n)
  146. x$"__setitem__"(i=as.integer(i[n]-1), x=value[n]))
  147. x
  148. })
  149. setAs('ExternalReference', 'character',
  150. function(from) {if (!is.null(from$"__str__")) from$"__str__"()})
  151. setMethod('print', 'ExternalReference',
  152. function(x) {print(as(x, "character"))})
  153. %}