+++ /dev/null
-/* guile-irrlicht --- GNU Guile bindings for Irrlicht Engine
-
- Copyright (C) 2020 Javier Sancho <jsf@jsancho.org>
-
- This file is part of guile-irrlicht.
-
- guile-irrlicht is free software; you can redistribute it and/or modify
- it under the terms of the GNU Lesser General Public License as
- published by the Free Software Foundation; either version 3 of the
- License, or (at your option) any later version.
-
- guile-irrlicht 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 Lesser General Public
- License along with guile-irrlicht. If not, see
- <http://www.gnu.org/licenses/>.
-*/
-
-#include <irrlicht/irrlicht.h>
-#include <libguile.h>
-
-#include "color.h"
-#include "gsubr.h"
-#include "material.h"
-#include "material-types.h"
-#include "wrapped.h"
-
-using namespace irr;
-
-SCM
-SMaterial_make (SCM rest)
-{
- SCM material_type;
- SCM ambient_color;
- SCM diffuse_color;
- SCM emissive_color;
- SCM specular_color;
- SCM shininess;
- SCM material_type_param;
- SCM material_type_param_2;
- SCM thickness;
- SCM z_buffer;
- SCM anti_aliasing;
- SCM color_mask;
- SCM color_material;
- SCM blend_operation;
- SCM polygon_offset_factor;
- SCM polygon_offset_direction;
- SCM wireframe;
- SCM point_cloud;
- SCM gouraud_shading;
- SCM lighting;
- SCM z_write_enable;
- SCM backface_culling;
- SCM frontface_culling;
- SCM fog_enable;
- SCM normalize_normals;
- SCM use_mip_maps;
-
- scm_c_bind_keyword_arguments
- ("video_SMaterial_make", rest, (scm_t_keyword_arguments_flags)0,
- scm_from_utf8_keyword ("material-type"), &material_type,
- scm_from_utf8_keyword ("ambient-color"), &ambient_color,
- scm_from_utf8_keyword ("diffuse-color"), &diffuse_color,
- scm_from_utf8_keyword ("emissive-color"), &emissive_color,
- scm_from_utf8_keyword ("specular-color"), &specular_color,
- scm_from_utf8_keyword ("shininess"), &shininess,
- scm_from_utf8_keyword ("material-type-param"), &material_type_param,
- scm_from_utf8_keyword ("material-type-param-2"), &material_type_param_2,
- scm_from_utf8_keyword ("thickness"), &thickness,
- scm_from_utf8_keyword ("z-buffer"), &z_buffer,
- scm_from_utf8_keyword ("anti-aliasing"), &anti_aliasing,
- scm_from_utf8_keyword ("color-mask"), &color_mask,
- scm_from_utf8_keyword ("color-material"), &color_material,
- scm_from_utf8_keyword ("blend-operation"), &blend_operation,
- scm_from_utf8_keyword ("polygon-offset-factor"), &polygon_offset_factor,
- scm_from_utf8_keyword ("polygon-offset-direction"), &polygon_offset_direction,
- scm_from_utf8_keyword ("wireframe"), &wireframe,
- scm_from_utf8_keyword ("point-cloud"), &point_cloud,
- scm_from_utf8_keyword ("gouraud-shading"), &gouraud_shading,
- scm_from_utf8_keyword ("lighting"), &lighting,
- scm_from_utf8_keyword ("z-write-enable"), &z_write_enable,
- scm_from_utf8_keyword ("backface-culling"), &backface_culling,
- scm_from_utf8_keyword ("frontface-culling"), &frontface_culling,
- scm_from_utf8_keyword ("fog-enable"), &fog_enable,
- scm_from_utf8_keyword ("normalize-normals"), &normalize_normals,
- scm_from_utf8_keyword ("use-mip-maps"), &use_mip_maps,
- SCM_UNDEFINED);
-
- video::SMaterial* material = new video::SMaterial ();
- material->MaterialType = scm_to_material_type(material_type);
- material->AmbientColor = scm_to_color (ambient_color);
- material->DiffuseColor = scm_to_color (diffuse_color);
- material->EmissiveColor = scm_to_color (emissive_color);
- material->SpecularColor = scm_to_color (specular_color);
- material->Shininess = scm_to_double (shininess);
- material->MaterialTypeParam = scm_to_double (material_type_param);
- material->MaterialTypeParam2 = scm_to_double (material_type_param_2);
- material->Thickness = scm_to_double (thickness);
- material->ZBuffer = scm_to_comparison_func (z_buffer);
- material->AntiAliasing = scm_to_anti_aliasing_mode (anti_aliasing);
- material->ColorMask = scm_to_color_plane (color_mask);
- material->ColorMaterial = scm_to_color_material (color_material);
- material->BlendOperation = scm_to_blend_operation (blend_operation);
- material->PolygonOffsetFactor = scm_to_uint8 (polygon_offset_factor);
- material->PolygonOffsetDirection = scm_to_polygon_offset (polygon_offset_direction);
- material->Wireframe = scm_to_bool (wireframe);
- material->PointCloud = scm_to_bool (point_cloud);
- material->GouraudShading = scm_to_bool (gouraud_shading);
- material->Lighting = scm_to_bool (lighting);
- material->ZWriteEnable = scm_to_bool (z_write_enable);
- material->BackfaceCulling = scm_to_bool (backface_culling);
- material->FrontfaceCulling = scm_to_bool (frontface_culling);
- material->FogEnable = scm_to_bool (fog_enable);
- material->NormalizeNormals = scm_to_bool (normalize_normals);
- material->UseMipMaps = scm_to_bool (use_mip_maps);
- return scm_from_irr_pointer ("<material>", (void*) material);
-}
-
-void
-init_material (void)
-{
- DEFINE_GSUBR ("SMaterial_make", 0, 0, 1, SMaterial_make);
-}
-
-video::E_ANTI_ALIASING_MODE
-scm_to_anti_aliasing_mode (SCM anti_aliasing_mode)
-{
- char* mode_name = scm_to_utf8_string (scm_symbol_to_string (anti_aliasing_mode));
- video::E_ANTI_ALIASING_MODE mode;
-
- if (!strcmp (mode_name, "off"))
- {
- mode = video::EAAM_OFF;
- }
- else if (!strcmp (mode_name, "simple"))
- {
- mode = video::EAAM_SIMPLE;
- }
- else if (!strcmp (mode_name, "quality"))
- {
- mode = video::EAAM_QUALITY;
- }
- else if (!strcmp (mode_name, "line-smooth"))
- {
- mode = video::EAAM_LINE_SMOOTH;
- }
- else if (!strcmp (mode_name, "point-smooth"))
- {
- mode = video::EAAM_POINT_SMOOTH;
- }
- else if (!strcmp (mode_name, "full-basic"))
- {
- mode = video::EAAM_FULL_BASIC;
- }
- else if (!strcmp (mode_name, "alpha-to-coverage"))
- {
- mode = video::EAAM_ALPHA_TO_COVERAGE;
- }
- else
- {
- scm_error (scm_arg_type_key, NULL, "Wrong anti aliasing mode: ~S",
- scm_list_1 (anti_aliasing_mode), scm_list_1 (anti_aliasing_mode));
- }
-
- free (mode_name);
- return mode;
-}
-
-video::E_BLEND_OPERATION
-scm_to_blend_operation (SCM blend_operation)
-{
- char* operation_name = scm_to_utf8_string (scm_symbol_to_string (blend_operation));
- video::E_BLEND_OPERATION operation;
-
- if (!strcmp (operation_name, "none"))
- {
- operation = video::EBO_NONE;
- }
- else if (!strcmp (operation_name, "add"))
- {
- operation = video::EBO_ADD;
- }
- else if (!strcmp (operation_name, "subtract"))
- {
- operation = video::EBO_SUBTRACT;
- }
- else if (!strcmp (operation_name, "rev-subtract"))
- {
- operation = video::EBO_REVSUBTRACT;
- }
- else if (!strcmp (operation_name, "min"))
- {
- operation = video::EBO_MIN;
- }
- else if (!strcmp (operation_name, "max"))
- {
- operation = video::EBO_MAX;
- }
- else if (!strcmp (operation_name, "min-factor"))
- {
- operation = video::EBO_MIN_FACTOR;
- }
- else if (!strcmp (operation_name, "max-factor"))
- {
- operation = video::EBO_MAX_FACTOR;
- }
- else if (!strcmp (operation_name, "min-alpha"))
- {
- operation = video::EBO_MIN_ALPHA;
- }
- else if (!strcmp (operation_name, "max-alpha"))
- {
- operation = video::EBO_MAX_ALPHA;
- }
- else
- {
- scm_error (scm_arg_type_key, NULL, "Wrong blend operation: ~S",
- scm_list_1 (blend_operation), scm_list_1 (blend_operation));
- }
-
- free (operation_name);
- return operation;
-}
-
-video::E_COLOR_MATERIAL
-scm_to_color_material (SCM color_material)
-{
- char* material_name = scm_to_utf8_string (scm_symbol_to_string (color_material));
- video::E_COLOR_MATERIAL material;
-
- if (!strcmp (material_name, "none"))
- {
- material = video::ECM_NONE;
- }
- else if (!strcmp (material_name, "diffuse"))
- {
- material = video::ECM_DIFFUSE;
- }
- else if (!strcmp (material_name, "ambient"))
- {
- material = video::ECM_AMBIENT;
- }
- else if (!strcmp (material_name, "emissive"))
- {
- material = video::ECM_EMISSIVE;
- }
- else if (!strcmp (material_name, "specular"))
- {
- material = video::ECM_SPECULAR;
- }
- else if (!strcmp (material_name, "diffuse-and-ambient"))
- {
- material = video::ECM_DIFFUSE_AND_AMBIENT;
- }
- else
- {
- scm_error (scm_arg_type_key, NULL, "Wrong color material: ~S",
- scm_list_1 (color_material), scm_list_1 (color_material));
- }
-
- free (material_name);
- return material;
-}
-
-video::E_COLOR_PLANE
-scm_to_color_plane (SCM color_plane)
-{
- char* plane_name = scm_to_utf8_string (scm_symbol_to_string (color_plane));
- video::E_COLOR_PLANE plane;
-
- if (!strcmp (plane_name, "none"))
- {
- plane = video::ECP_NONE;
- }
- else if (!strcmp (plane_name, "alpha"))
- {
- plane = video::ECP_ALPHA;
- }
- else if (!strcmp (plane_name, "red"))
- {
- plane = video::ECP_RED;
- }
- else if (!strcmp (plane_name, "green"))
- {
- plane = video::ECP_GREEN;
- }
- else if (!strcmp (plane_name, "blue"))
- {
- plane = video::ECP_BLUE;
- }
- else if (!strcmp (plane_name, "rgb"))
- {
- plane = video::ECP_RGB;
- }
- else if (!strcmp (plane_name, "all"))
- {
- plane = video::ECP_ALL;
- }
- else
- {
- scm_error (scm_arg_type_key, NULL, "Wrong color plane: ~S",
- scm_list_1 (color_plane), scm_list_1 (color_plane));
- }
-
- free (plane_name);
- return plane;
-}
-
-video::E_COMPARISON_FUNC
-scm_to_comparison_func (SCM comparison_func)
-{
- char* func_name = scm_to_utf8_string (scm_symbol_to_string (comparison_func));
- video::E_COMPARISON_FUNC func;
-
- if (!strcmp (func_name, "never"))
- {
- func = video::ECFN_NEVER;
- }
- else if (!strcmp (func_name, "less-equal"))
- {
- func = video::ECFN_LESSEQUAL;
- }
- else if (!strcmp (func_name, "equal"))
- {
- func = video::ECFN_EQUAL;
- }
- else if (!strcmp (func_name, "less"))
- {
- func = video::ECFN_LESS;
- }
- else if (!strcmp (func_name, "not-equal"))
- {
- func = video::ECFN_NOTEQUAL;
- }
- else if (!strcmp (func_name, "greater-equal"))
- {
- func = video::ECFN_GREATEREQUAL;
- }
- else if (!strcmp (func_name, "greater"))
- {
- func = video::ECFN_GREATER;
- }
- else if (!strcmp (func_name, "always"))
- {
- func = video::ECFN_ALWAYS;
- }
- else
- {
- scm_error (scm_arg_type_key, NULL, "Wrong comparison func: ~S",
- scm_list_1 (comparison_func), scm_list_1 (comparison_func));
- }
-
- free (func_name);
- return func;
-}
-
-video::E_POLYGON_OFFSET
-scm_to_polygon_offset (SCM polygon_offset)
-{
- char* offset_name = scm_to_utf8_string (scm_symbol_to_string (polygon_offset));
- video::E_POLYGON_OFFSET offset;
-
- if (!strcmp (offset_name, "back"))
- {
- offset = video::EPO_BACK;
- }
- else if (!strcmp (offset_name, "front"))
- {
- offset = video::EPO_FRONT;
- }
- else
- {
- scm_error (scm_arg_type_key, NULL, "Wrong polygon offset: ~S",
- scm_list_1 (polygon_offset), scm_list_1 (polygon_offset));
- }
-
- free (offset_name);
- return offset;
-}