X-Git-Url: https://git.jsancho.org/?a=blobdiff_plain;f=src%2Fgui.cpp;h=bcc1cef441ff88c9da05f5d8832f8c0edba94b62;hb=15be0323f62a228707f616c25c4b87cd1d68766f;hp=2f7044bb437dea04b7fa807a2fd366dce7e6c7e0;hpb=da89e12dbf35ce6452e6a6e2eeb3f83eaeb94c97;p=guile-irrlicht.git

diff --git a/src/gui.cpp b/src/gui.cpp
index 2f7044b..bcc1cef 100644
--- a/src/gui.cpp
+++ b/src/gui.cpp
@@ -53,6 +53,7 @@ extern "C" {
 
     // Shared procedures (used by two or more objects)
     DEFINE_GSUBR ("add-button!", 1, 1, 1, irr_gui_addButton);
+    DEFINE_GSUBR ("get-font", 1, 1, 1, irr_gui_getFont);
     DEFINE_GSUBR ("set-override-color!", 2, 0, 0, irr_gui_setOverrideColor);
   }
 
@@ -76,6 +77,26 @@ extern "C" {
       }
   }
 
+  SCM
+  irr_gui_getFont (SCM wrapped_obj,
+                   SCM filename,
+                   SCM rest)
+  {
+    if (gui_environment_p (wrapped_obj))
+      {
+        return irr_gui_IGUIEnvironment_getFont (wrapped_obj, filename);
+      }
+    else if (gui_skin_p (wrapped_obj))
+      {
+        return irr_gui_IGUISkin_getFont (wrapped_obj, rest);
+      }
+    else
+      {
+        scm_error (scm_arg_type_key, NULL, "Cannot get font from object: ~S",
+                   scm_list_1 (wrapped_obj), scm_list_1 (wrapped_obj));
+      }
+  }
+
   SCM
   irr_gui_setOverrideColor (SCM wrapped_obj,
                             SCM color)