1 /* guile-irrlicht --- GNU Guile bindings for Irrlicht Engine
3 Copyright (C) 2020 Javier Sancho <jsf@jsancho.org>
5 This file is part of guile-irrlicht.
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.
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.
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/>.
22 #include <irrlicht/irrlicht.h>
28 #include "gui-environment.h"
31 #include "primitive-types.h"
33 #include "scene-manager.h"
36 #include "video-driver.h"
42 init_video_driver (void)
44 init_video_driver_type ();
45 DEFINE_GSUBR ("begin-scene", 1, 0, 1, irr_video_beginScene);
46 DEFINE_GSUBR ("draw-vertex-primitive-list", 3, 0, 1, irr_video_drawVertexPrimitiveList);
47 DEFINE_GSUBR ("end-scene", 1, 0, 0, irr_video_endScene);
48 DEFINE_GSUBR ("get-fps", 1, 0, 0, irr_video_getFPS);
49 DEFINE_GSUBR ("get-texture", 2, 0, 0, irr_video_getTexture);
50 DEFINE_GSUBR ("get-video-driver", 1, 0, 0, irr_getVideoDriver);
51 DEFINE_GSUBR ("set-transform!", 3, 0, 0, irr_video_setTransform);
54 DEFINE_WRAPPED_TYPE (irr::video::IVideoDriver*, "video-driver",
55 init_video_driver_type, video_driver_p,
56 wrap_video_driver, unwrap_video_driver);
59 irr_video_beginScene (SCM wrapped_video_driver,
62 SCM back_buffer = scm_from_bool(1);
63 SCM z_buffer = scm_from_bool(1);
64 SCM color = scm_list_4 (scm_from_uint32 (255),
68 SCM video_data = scm_from_bool(0);
69 SCM source_rect = scm_from_bool(0);
71 scm_c_bind_keyword_arguments ("begin-scene", rest, (scm_t_keyword_arguments_flags)0,
72 scm_from_utf8_keyword ("back-buffer"), &back_buffer,
73 scm_from_utf8_keyword ("z-buffer"), &z_buffer,
74 scm_from_utf8_keyword ("color"), &color,
75 scm_from_utf8_keyword ("video-data"), &video_data,
76 scm_from_utf8_keyword ("source-rect"), &source_rect,
79 irr::video::IVideoDriver* driver = unwrap_video_driver (wrapped_video_driver);
80 irr::core::rect<irr::s32>* sourceRectAddress = 0;
81 if (!scm_is_false (source_rect))
83 irr::core::rect<irr::s32> sourceRect = scm_to_rect_s32 (source_rect);
84 sourceRectAddress = &sourceRect;
86 return scm_from_bool (driver->beginScene (scm_to_bool (back_buffer),
87 scm_to_bool (z_buffer),
89 irr::video::SExposedVideoData (),
94 irr_video_drawVertexPrimitiveList (SCM wrapped_video_driver,
99 SCM v_type = scm_from_utf8_symbol ("standard");
100 SCM p_type = scm_from_utf8_symbol ("triangles");
102 scm_c_bind_keyword_arguments ("draw-vertex-primitive-list", rest, (scm_t_keyword_arguments_flags)0,
103 scm_from_utf8_keyword ("vertex-type"), &v_type,
104 scm_from_utf8_keyword ("primitive-type"), &p_type,
107 // Build vertex array
108 irr::u32 vertex_count = scm_to_uint32 (scm_length (vertices));
109 irr::video::S3DVertex s3d_vertices [vertex_count];
110 for (int i = 0; i < vertex_count; i++)
112 irr::video::S3DVertex* vertex = unwrap_vertex3d (scm_list_ref (vertices, scm_from_int (i)));
113 s3d_vertices[i] = irr::video::S3DVertex (vertex->Pos,
120 irr::u32 index_count = scm_to_uint32 (scm_length (indices));
121 SCM flat_indices = scm_apply_0 (scm_eval_string (scm_from_utf8_string ("append")),
123 int flat_length = scm_to_int (scm_length (flat_indices));
124 irr::u32 c_indices [flat_length];
125 for (int i = 0; i < flat_length; i++)
127 c_indices[i] = scm_to_uint32 (scm_list_ref (flat_indices, scm_from_int (i)));
131 irr::video::IVideoDriver* driver = unwrap_video_driver (wrapped_video_driver);
132 driver->drawVertexPrimitiveList (&s3d_vertices[0],
136 scm_to_vertex_type (v_type),
137 scm_to_primitive_type (p_type),
138 irr::video::EIT_32BIT);
139 return SCM_UNSPECIFIED;
143 irr_video_endScene (SCM wrapped_video_driver)
145 irr::video::IVideoDriver* driver = unwrap_video_driver (wrapped_video_driver);
146 return scm_from_bool (driver->endScene ());
150 irr_video_getFPS (SCM wrapped_video_driver)
152 irr::video::IVideoDriver* driver = unwrap_video_driver (wrapped_video_driver);
153 return scm_from_int32 (driver->getFPS ());
157 irr_video_getTexture (SCM wrapped_video_driver,
160 irr::video::IVideoDriver* driver = unwrap_video_driver (wrapped_video_driver);
161 irr::video::ITexture* texture = driver->getTexture (scm_to_utf8_stringn (filename, NULL));
162 return wrap_texture (texture);
166 irr_video_setMaterial (SCM wrapped_video_driver,
169 irr::video::IVideoDriver* driver = unwrap_video_driver (wrapped_video_driver);
170 driver->setMaterial (*(unwrap_material (material)));
171 return SCM_UNSPECIFIED;
175 irr_video_setTransform (SCM wrapped_video_driver,
179 irr::video::IVideoDriver* driver = unwrap_video_driver (wrapped_video_driver);
180 driver->setTransform (scm_to_transformation_state (state),
181 scm_to_matrix4 (mat));
182 return SCM_UNSPECIFIED;
186 irr_getVideoDriver (SCM wrapped_obj)
188 irr::video::IVideoDriver* driver;
189 if (device_p (wrapped_obj))
191 driver = unwrap_device (wrapped_obj)->getVideoDriver ();
195 scm_error (scm_arg_type_key, NULL, "Cannot get video driver from object: ~S",
196 scm_list_1 (wrapped_obj), scm_list_1 (wrapped_obj));
198 return wrap_video_driver (driver);
201 irr::video::E_TRANSFORMATION_STATE
202 scm_to_transformation_state (SCM transformation_state)
204 char* state = scm_to_utf8_stringn (scm_symbol_to_string (transformation_state), NULL);
205 if (!strcmp (state, "view"))
207 return irr::video::ETS_VIEW;
209 else if (!strcmp (state, "world"))
211 return irr::video::ETS_WORLD;
213 else if (!strcmp (state, "projection"))
215 return irr::video::ETS_PROJECTION;
217 else if (!strcmp (state, "texture0"))
219 return irr::video::ETS_TEXTURE_0;
221 else if (!strcmp (state, "texture1"))
223 return irr::video::ETS_TEXTURE_1;
225 else if (!strcmp (state, "texture2"))
227 return irr::video::ETS_TEXTURE_2;
229 else if (!strcmp (state, "texture3"))
231 return irr::video::ETS_TEXTURE_3;
235 scm_error (scm_arg_type_key, NULL, "Wrong transformation state: ~S",
236 scm_list_1 (transformation_state), scm_list_1 (transformation_state));