|
@@ -1,3 +1,5 @@
|
|
|
+#include "Utils.hpp"
|
|
|
+
|
|
|
#include <locale>
|
|
|
#include <ctime>
|
|
|
|
|
@@ -135,44 +137,6 @@ const std::string& data_dir()
|
|
|
|
|
|
} // namespace Slic3r
|
|
|
|
|
|
-#ifdef SLIC3R_HAS_BROKEN_CROAK
|
|
|
-
|
|
|
-// Some Strawberry Perl builds (mainly the latest 64bit builds) have a broken mechanism
|
|
|
-// for emiting Perl exception after handling a C++ exception. Perl interpreter
|
|
|
-// simply hangs. Better to show a message box in that case and stop the application.
|
|
|
-
|
|
|
-#include <stdarg.h>
|
|
|
-#include <stdio.h>
|
|
|
-#include <stdlib.h>
|
|
|
-#include <string.h>
|
|
|
-
|
|
|
-#ifdef WIN32
|
|
|
-#include <Windows.h>
|
|
|
-#endif
|
|
|
-
|
|
|
-void confess_at(const char *file, int line, const char *func, const char *format, ...)
|
|
|
-{
|
|
|
- char dest[1024*8];
|
|
|
- va_list argptr;
|
|
|
- va_start(argptr, format);
|
|
|
- vsprintf(dest, format, argptr);
|
|
|
- va_end(argptr);
|
|
|
-
|
|
|
- char filelinefunc[1024*8];
|
|
|
- sprintf(filelinefunc, "\r\nin function: %s\r\nfile: %s\r\nline: %d\r\n", func, file, line);
|
|
|
- strcat(dest, filelinefunc);
|
|
|
- strcat(dest, "\r\n Closing the application.\r\n");
|
|
|
- #ifdef WIN32
|
|
|
- ::MessageBoxA(NULL, dest, "Slic3r Prusa Edition", MB_OK | MB_ICONERROR);
|
|
|
- #endif
|
|
|
-
|
|
|
- // Give up.
|
|
|
- printf(dest);
|
|
|
- exit(-1);
|
|
|
-}
|
|
|
-
|
|
|
-#else
|
|
|
-
|
|
|
#include <xsinit.h>
|
|
|
|
|
|
void
|
|
@@ -202,7 +166,88 @@ confess_at(const char *file, int line, const char *func,
|
|
|
#endif
|
|
|
}
|
|
|
|
|
|
-#endif
|
|
|
+void PerlCallback::register_callback(void *sv)
|
|
|
+{
|
|
|
+ if (! SvROK((SV*)sv) || SvTYPE(SvRV((SV*)sv)) != SVt_PVCV)
|
|
|
+ croak("Not a Callback %_ for PerlFunction", (SV*)sv);
|
|
|
+ if (m_callback)
|
|
|
+ SvSetSV((SV*)m_callback, (SV*)sv);
|
|
|
+ else
|
|
|
+ m_callback = newSVsv((SV*)sv);
|
|
|
+}
|
|
|
+
|
|
|
+void PerlCallback::deregister_callback()
|
|
|
+{
|
|
|
+ if (m_callback) {
|
|
|
+ sv_2mortal((SV*)m_callback);
|
|
|
+ m_callback = nullptr;
|
|
|
+ }
|
|
|
+}
|
|
|
+
|
|
|
+void PerlCallback::call()
|
|
|
+{
|
|
|
+ if (! m_callback)
|
|
|
+ return;
|
|
|
+ dSP;
|
|
|
+ ENTER;
|
|
|
+ SAVETMPS;
|
|
|
+ PUSHMARK(SP);
|
|
|
+ PUTBACK;
|
|
|
+ perl_call_sv(SvRV((SV*)m_callback), G_DISCARD);
|
|
|
+ FREETMPS;
|
|
|
+ LEAVE;
|
|
|
+}
|
|
|
+
|
|
|
+void PerlCallback::call(int i)
|
|
|
+{
|
|
|
+ if (! m_callback)
|
|
|
+ return;
|
|
|
+ dSP;
|
|
|
+ ENTER;
|
|
|
+ SAVETMPS;
|
|
|
+ PUSHMARK(SP);
|
|
|
+ XPUSHs(sv_2mortal(newSViv(i)));
|
|
|
+ PUTBACK;
|
|
|
+ perl_call_sv(SvRV((SV*)m_callback), G_DISCARD);
|
|
|
+ FREETMPS;
|
|
|
+ LEAVE;
|
|
|
+}
|
|
|
+
|
|
|
+void PerlCallback::call(int i, int j)
|
|
|
+{
|
|
|
+ if (! m_callback)
|
|
|
+ return;
|
|
|
+ dSP;
|
|
|
+ ENTER;
|
|
|
+ SAVETMPS;
|
|
|
+ PUSHMARK(SP);
|
|
|
+ XPUSHs(sv_2mortal(newSViv(i)));
|
|
|
+ XPUSHs(sv_2mortal(newSViv(j)));
|
|
|
+ PUTBACK;
|
|
|
+ perl_call_sv(SvRV((SV*)m_callback), G_DISCARD);
|
|
|
+ FREETMPS;
|
|
|
+ LEAVE;
|
|
|
+}
|
|
|
+
|
|
|
+/*
|
|
|
+void PerlCallback::call(const std::vector<int> &ints)
|
|
|
+{
|
|
|
+ if (! m_callback)
|
|
|
+ return;
|
|
|
+ dSP;
|
|
|
+ ENTER;
|
|
|
+ SAVETMPS;
|
|
|
+ PUSHMARK(SP);
|
|
|
+ AV* av = newAV();
|
|
|
+ for (int i : ints)
|
|
|
+ av_push(av, newSViv(i));
|
|
|
+ XPUSHs(av);
|
|
|
+ PUTBACK;
|
|
|
+ perl_call_sv(SvRV((SV*)m_callback), G_DISCARD);
|
|
|
+ FREETMPS;
|
|
|
+ LEAVE;
|
|
|
+}
|
|
|
+*/
|
|
|
|
|
|
#ifdef WIN32
|
|
|
#ifndef NOMINMAX
|