]> git.jsancho.org Git - guile-irrlicht.git/blob - src/material.cpp
fix gsubr limits
[guile-irrlicht.git] / src / material.cpp
1 /* guile-irrlicht --- GNU Guile bindings for Irrlicht Engine
2
3    Copyright (C) 2020 Javier Sancho <jsf@jsancho.org>
4
5    This file is part of guile-irrlicht.
6
7    guile-irrlicht is free software; you can redistribute it and/or modify
8    it under the terms of the GNU Lesser General Public License as
9    published by the Free Software Foundation; either version 3 of the
10    License, or (at your option) any later version.
11
12    guile-irrlicht is distributed in the hope that it will be useful, but
13    WITHOUT ANY WARRANTY; without even the implied warranty of
14    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
15    General Public License for more details.
16
17    You should have received a copy of the GNU Lesser General Public
18    License along with guile-irrlicht. If not, see
19    <http://www.gnu.org/licenses/>.
20 */
21
22 #include <irrlicht/irrlicht.h>
23 #include <libguile.h>
24
25 #include "color.h"
26 #include "gsubr.h"
27 #include "material.h"
28 #include "material-types.h"
29
30
31 using namespace irr;
32
33
34 SCM
35 video_SMaterial_make (SCM rest)
36 {
37   SCM material_type;
38   SCM ambient_color;
39   SCM diffuse_color;
40   SCM emissive_color;
41   SCM specular_color;
42   SCM shininess;
43   SCM material_type_param;
44   SCM material_type_param_2;
45   SCM thickness;
46   SCM z_buffer;
47   SCM anti_aliasing;
48   SCM color_mask;
49   SCM color_material;
50   SCM blend_operation;
51   SCM polygon_offset_factor;
52   SCM polygon_offset_direction;
53   SCM wireframe;
54   SCM point_cloud;
55   SCM gouraud_shading;
56   SCM lighting;
57   SCM z_write_enable;
58   SCM backface_culling;
59   SCM frontface_culling;
60   SCM fog_enable;
61   SCM normalize_normals;
62   SCM use_mip_maps;
63
64   scm_c_bind_keyword_arguments
65     ("video_SMaterial_make", rest, (scm_t_keyword_arguments_flags)0,
66      scm_from_utf8_keyword ("material-type"), &material_type,
67      scm_from_utf8_keyword ("ambient-color"), &ambient_color,
68      scm_from_utf8_keyword ("diffuse-color"), &diffuse_color,
69      scm_from_utf8_keyword ("emissive-color"), &emissive_color,
70      scm_from_utf8_keyword ("specular-color"), &specular_color,
71      scm_from_utf8_keyword ("shininess"), &shininess,
72      scm_from_utf8_keyword ("material-type-param"), &material_type_param,
73      scm_from_utf8_keyword ("material-type-param-2"), &material_type_param_2,
74      scm_from_utf8_keyword ("thickness"), &thickness,
75      scm_from_utf8_keyword ("z-buffer"), &z_buffer,
76      scm_from_utf8_keyword ("anti-aliasing"), &anti_aliasing,
77      scm_from_utf8_keyword ("color-mask"), &color_mask,
78      scm_from_utf8_keyword ("color-material"), &color_material,
79      scm_from_utf8_keyword ("blend-operation"), &blend_operation,
80      scm_from_utf8_keyword ("polygon-offset-factor"), &polygon_offset_factor,
81      scm_from_utf8_keyword ("polygon-offset-direction"), &polygon_offset_direction,
82      scm_from_utf8_keyword ("wireframe"), &wireframe,
83      scm_from_utf8_keyword ("point-cloud"), &point_cloud,
84      scm_from_utf8_keyword ("gouraud-shading"), &gouraud_shading,
85      scm_from_utf8_keyword ("lighting"), &lighting,
86      scm_from_utf8_keyword ("z-write-enable"), &z_write_enable,
87      scm_from_utf8_keyword ("backface-culling"), &backface_culling,
88      scm_from_utf8_keyword ("frontface-culling"), &frontface_culling,
89      scm_from_utf8_keyword ("fog-enable"), &fog_enable,
90      scm_from_utf8_keyword ("normalize-normals"), &normalize_normals,
91      scm_from_utf8_keyword ("use-mip-maps"), &use_mip_maps,
92      SCM_UNDEFINED);
93
94   video::SMaterial* material = new video::SMaterial ();
95   material->MaterialType = scm_to_material_type(material_type);
96   material->AmbientColor = scm_to_color (ambient_color);
97   material->DiffuseColor = scm_to_color (diffuse_color);
98   material->EmissiveColor = scm_to_color (emissive_color);
99   material->SpecularColor = scm_to_color (specular_color);
100   material->Shininess = scm_to_double (shininess);
101   material->MaterialTypeParam = scm_to_double (material_type_param);
102   material->MaterialTypeParam2 = scm_to_double (material_type_param_2);
103   material->Thickness = scm_to_double (thickness);
104   material->ZBuffer = scm_to_comparison_func (z_buffer);
105   material->AntiAliasing = scm_to_anti_aliasing_mode (anti_aliasing);
106   material->ColorMask = scm_to_color_plane (color_mask);
107   material->ColorMaterial = scm_to_color_material (color_material);
108   material->BlendOperation = scm_to_blend_operation (blend_operation);
109   material->PolygonOffsetFactor = scm_to_uint8 (polygon_offset_factor);
110   material->PolygonOffsetDirection = scm_to_polygon_offset (polygon_offset_direction);
111   material->Wireframe = scm_to_bool (wireframe);
112   material->PointCloud = scm_to_bool (point_cloud);
113   material->GouraudShading = scm_to_bool (gouraud_shading);
114   material->Lighting = scm_to_bool (lighting);
115   material->ZWriteEnable = scm_to_bool (z_write_enable);
116   material->BackfaceCulling = scm_to_bool (backface_culling);
117   material->FrontfaceCulling = scm_to_bool (frontface_culling);
118   material->FogEnable = scm_to_bool (fog_enable);
119   material->NormalizeNormals = scm_to_bool (normalize_normals);
120   material->UseMipMaps = scm_to_bool (use_mip_maps);
121   return scm_from_pointer ((void*) material, NULL);
122 }
123
124
125 extern "C" {
126
127   void
128   init_material (void)
129   {
130     DEFINE_GSUBR ("video_SMaterial_make", 0, 0, 1, video_SMaterial_make);
131   }
132
133 }
134
135
136 video::E_ANTI_ALIASING_MODE
137 scm_to_anti_aliasing_mode (SCM anti_aliasing_mode)
138 {
139   char* mode = scm_to_utf8_stringn (scm_symbol_to_string (anti_aliasing_mode), NULL);
140   if (!strcmp (mode, "off"))
141     {
142       return video::EAAM_OFF;
143     }
144   else if (!strcmp (mode, "simple"))
145     {
146       return video::EAAM_SIMPLE;
147     }
148   else if (!strcmp (mode, "quality"))
149     {
150       return video::EAAM_QUALITY;
151     }
152   else if (!strcmp (mode, "line-smooth"))
153     {
154       return video::EAAM_LINE_SMOOTH;
155     }
156   else if (!strcmp (mode, "point-smooth"))
157     {
158       return video::EAAM_POINT_SMOOTH;
159     }
160   else if (!strcmp (mode, "full-basic"))
161     {
162       return video::EAAM_FULL_BASIC;
163     }
164   else if (!strcmp (mode, "alpha-to-coverage"))
165     {
166       return video::EAAM_ALPHA_TO_COVERAGE;
167     }
168   else
169     {
170       scm_error (scm_arg_type_key, NULL, "Wrong anti aliasing mode: ~S",
171                  scm_list_1 (anti_aliasing_mode), scm_list_1 (anti_aliasing_mode));
172     }
173 }
174
175
176 video::E_BLEND_OPERATION
177 scm_to_blend_operation (SCM blend_operation)
178 {
179   char* operation = scm_to_utf8_stringn (scm_symbol_to_string (blend_operation), NULL);
180   if (!strcmp (operation, "none"))
181     {
182       return video::EBO_NONE;
183     }
184   else if (!strcmp (operation, "add"))
185     {
186       return video::EBO_ADD;
187     }
188   else if (!strcmp (operation, "subtract"))
189     {
190       return video::EBO_SUBTRACT;
191     }
192   else if (!strcmp (operation, "rev-subtract"))
193     {
194       return video::EBO_REVSUBTRACT;
195     }
196   else if (!strcmp (operation, "min"))
197     {
198       return video::EBO_MIN;
199     }
200   else if (!strcmp (operation, "max"))
201     {
202       return video::EBO_MAX;
203     }
204   else if (!strcmp (operation, "min-factor"))
205     {
206       return video::EBO_MIN_FACTOR;
207     }
208   else if (!strcmp (operation, "max-factor"))
209     {
210       return video::EBO_MAX_FACTOR;
211     }
212   else if (!strcmp (operation, "min-alpha"))
213     {
214       return video::EBO_MIN_ALPHA;
215     }
216   else if (!strcmp (operation, "max-alpha"))
217     {
218       return video::EBO_MAX_ALPHA;
219     }
220   else
221     {
222       scm_error (scm_arg_type_key, NULL, "Wrong blend operation: ~S",
223                  scm_list_1 (blend_operation), scm_list_1 (blend_operation));
224     }
225 }
226
227
228 video::E_COLOR_MATERIAL
229 scm_to_color_material (SCM color_material)
230 {
231   char* material = scm_to_utf8_stringn (scm_symbol_to_string (color_material), NULL);
232   if (!strcmp (material, "none"))
233     {
234       return video::ECM_NONE;
235     }
236   else if (!strcmp (material, "diffuse"))
237     {
238       return video::ECM_DIFFUSE;
239     }
240   else if (!strcmp (material, "ambient"))
241     {
242       return video::ECM_AMBIENT;
243     }
244   else if (!strcmp (material, "emissive"))
245     {
246       return video::ECM_EMISSIVE;
247     }
248   else if (!strcmp (material, "specular"))
249     {
250       return video::ECM_SPECULAR;
251     }
252   else if (!strcmp (material, "diffuse-and-ambient"))
253     {
254       return video::ECM_DIFFUSE_AND_AMBIENT;
255     }
256   else
257     {
258       scm_error (scm_arg_type_key, NULL, "Wrong color material: ~S",
259                  scm_list_1 (color_material), scm_list_1 (color_material));
260     }
261 }
262
263
264 video::E_COLOR_PLANE
265 scm_to_color_plane (SCM color_plane)
266 {
267   char* plane = scm_to_utf8_stringn (scm_symbol_to_string (color_plane), NULL);
268   if (!strcmp (plane, "none"))
269     {
270       return video::ECP_NONE;
271     }
272   else if (!strcmp (plane, "alpha"))
273     {
274       return video::ECP_ALPHA;
275     }
276   else if (!strcmp (plane, "red"))
277     {
278       return video::ECP_RED;
279     }
280   else if (!strcmp (plane, "green"))
281     {
282       return video::ECP_GREEN;
283     }
284   else if (!strcmp (plane, "blue"))
285     {
286       return video::ECP_BLUE;
287     }
288   else if (!strcmp (plane, "rgb"))
289     {
290       return video::ECP_RGB;
291     }
292   else if (!strcmp (plane, "all"))
293     {
294       return video::ECP_ALL;
295     }
296   else
297     {
298       scm_error (scm_arg_type_key, NULL, "Wrong color plane: ~S",
299                  scm_list_1 (color_plane), scm_list_1 (color_plane));
300     }
301 }
302
303
304 video::E_COMPARISON_FUNC
305 scm_to_comparison_func (SCM comparison_func)
306 {
307   char* func = scm_to_utf8_stringn (scm_symbol_to_string (comparison_func), NULL);
308   if (!strcmp (func, "never"))
309     {
310       return video::ECFN_NEVER;
311     }
312   else if (!strcmp (func, "less-equal"))
313     {
314       return video::ECFN_LESSEQUAL;
315     }
316   else if (!strcmp (func, "equal"))
317     {
318       return video::ECFN_EQUAL;
319     }
320   else if (!strcmp (func, "less"))
321     {
322       return video::ECFN_LESS;
323     }
324   else if (!strcmp (func, "not-equal"))
325     {
326       return video::ECFN_NOTEQUAL;
327     }
328   else if (!strcmp (func, "greater-equal"))
329     {
330       return video::ECFN_GREATEREQUAL;
331     }
332   else if (!strcmp (func, "greater"))
333     {
334       return video::ECFN_GREATER;
335     }
336   else if (!strcmp (func, "always"))
337     {
338       return video::ECFN_ALWAYS;
339     }
340   else
341     {
342       scm_error (scm_arg_type_key, NULL, "Wrong comparison func: ~S",
343                  scm_list_1 (comparison_func), scm_list_1 (comparison_func));
344     }
345 }
346
347
348 video::E_POLYGON_OFFSET
349 scm_to_polygon_offset (SCM polygon_offset)
350 {
351   char* offset = scm_to_utf8_stringn (scm_symbol_to_string (polygon_offset), NULL);
352   if (!strcmp (offset, "back"))
353     {
354       return video::EPO_BACK;
355     }
356   else if (!strcmp (offset, "front"))
357     {
358       return video::EPO_FRONT;
359     }
360   else
361     {
362       scm_error (scm_arg_type_key, NULL, "Wrong polygon offset: ~S",
363                  scm_list_1 (polygon_offset), scm_list_1 (polygon_offset));
364     }
365 }