1 /*  Curses.c
2 **
3 **  Copyright (c) 1994-2000  William Setzer
4 **
5 **  You may distribute under the terms of either the Artistic License
6 **  or the GNU General Public License, as specified in the README file.
7 */
8 
9 #define _XOPEN_SOURCE_EXTENDED 1  /* We expect wide character functions */
10 
11 #include "CursesDef.h"
12 #include "CursesTyp.h"
13 #include "c-config.h"
14 
15 /* c-config.h above includes Ncurses header files that define macro
16    'instr'.  Unfortunately, perl.h (below) also defines 'instr'.
17    Fortunately, we don't need the Curses version -- we use
18    winstr(stdscr, ...) instead.  So we undef instr here to avoid a compiler
19    warning about the redeclaration.
20 
21    Similarly, c-config.h may define a macro "tab", while the word
22    "tab" is used in perl.h another way, so we undefine it to avoid
23    a nasty syntax error.
24 
25    "term.h" pollutes the name space with hundreds of other macros too.
26    We'll probably have to add to this list; maybe someday we should
27    just undef them all, since we don't use them.
28 
29    "bool" is another, and is more problematic.  Sometimes, ncurses.h
30    defines that explicitly and that's bad, but sometimes it does it
31    by including <stdbool.h>, and that's fine.  In the former case,
32    we should undefine it now, but in the latter we can't, because then
33    a subsequent #include <stdbool.h> (by something we #include below)
34    won't define bool because stdbool.h has already been included.
35 
36    We're going to leave bool alone now and wait for someone to report
37    that it breaks something.  With a real example, we can then plan how
38    to work around this unfortunate ncurses.h behavior.  We once had a
39    #undef bool.h in the Mac OSX hints file, so someone presumably found
40    it necessary.  But we have also had a Mac OSX system on which compile
41    failed _because_ of that undef, for the reason described above.
42  */
43 
44 #undef instr
45 #undef tab
46 
47 #include <EXTERN.h>  /* Needed by <perl.h> */
48 #include <perl.h>
49 #include <XSUB.h>
50 /* I don't know why NEED_sv_2pv_flags is necessary, but ppport.h doesn't
51    work right without it.  Maybe a bug in Devel::PPPort?  */
52 #define NEED_sv_2pv_flags
53 #include "ppport.h"
54     /* Defines PERL_REVISION, etc. (if perl.h doesn't) */
55 
56 #ifndef C_PANELFUNCTION
57 #  define PANEL int
58 #endif
59 
60 #ifndef C_MENUFUNCTION
61 #  define MENU int
62 #  define ITEM int
63 #endif
64 
65 #ifndef C_FORMFUNCTION
66 #  define FORM int
67 #  define FIELD int
68 #endif
69 
70 /* Before 1.17 (September 2007), we undefined macro 'SP' here, for
71    the Pdcurses case only.  I don't know why, but it caused the build
72    with Pdcurses to fail, so we took it out.  'SP' is
73    defined in Perl's CORE/pp.h via our inclusion of perl.h above.
74 */
75 
76 #if PERL_VERSION >= 6
77 #define HAVE_PERL_UTF8_TO_UV 1
78 #define HAVE_PERL_UV_TO_UTF8 1
79 #else
80 #define HAVE_PERL_UTF8_TO_UV 0
81 #define HAVE_PERL_UV_TO_UTF8 0
82 #endif
83 
84 #if PERL_VERSION >= 7
85 #define HAVE_PERL_UTF8_TO_UVCHR 1
86 #define HAVE_PERL_UVCHR_TO_UTF8 1
87 #else
88 #define HAVE_PERL_UTF8_TO_UVCHR 0
89 #define HAVE_PERL_UVCHR_TO_UTF8 0
90 #endif
91 
92 #if PERL_VERSION >= 16 /* really 15.something */
93 #define HAVE_PERL_UTF8_TO_UVCHR_BUF 1
94 #else
95 #define HAVE_PERL_UTF8_TO_UVCHR_BUF 0
96 #endif
97 
98 /*
99 ** Begin support variables and functions
100 */
101 
102 static char *c_function;
103 static int   c_win, c_x, c_arg;
104 
105 static void
c_countargs(fn,nargs,base)106 c_countargs(fn, nargs, base)
107 char *fn;
108 int nargs;
109 int base;
110 {
111     switch (nargs - base)
112     {
113     case 0:  c_win = 0; c_x = 0; c_arg = 0; break;
114     case 1:  c_win = 1; c_x = 0; c_arg = 1; break;
115     case 2:  c_win = 0; c_x = 1; c_arg = 2; break;
116     case 3:  c_win = 1; c_x = 2; c_arg = 3; break;
117     default:
118     croak("Curses function '%s' called with too %s arguments", fn,
119           nargs < base ? "few" : "many");
120     }
121     c_function = fn;
122 }
123 
124 static void
c_exactargs(fn,nargs,base)125 c_exactargs(fn, nargs, base)
126 char *fn;
127 int nargs;
128 int base;
129 {
130     if (nargs != base)
131     croak("Curses function '%s' called with too %s arguments", fn,
132           nargs < base ? "few" : "many" );
133 
134     c_function = fn;
135 }
136 
137 static int
c_domove(win,sv_y,sv_x)138 c_domove(win, sv_y, sv_x)
139 WINDOW *win;
140 SV *sv_y;
141 SV *sv_x;
142 {
143     int y = (int)SvIV(sv_y);
144     int x = (int)SvIV(sv_x);
145 
146     return wmove(win, y, x);
147 }
148 
149 static void
c_fun_not_there(fn)150 c_fun_not_there(fn)
151 char *fn;
152 {
153     croak("Curses function '%s' is not defined in your Curses library", fn);
154 }
155 
156 static void
c_var_not_there(fn)157 c_var_not_there(fn)
158 char *fn;
159 {
160     croak("Curses variable '%s' is not defined in your Curses library", fn);
161 }
162 
163 static void
c_con_not_there(fn)164 c_con_not_there(fn)
165 char *fn;
166 {
167     croak("Curses constant '%s' is not defined in your Curses library", fn);
168 }
169 
170 /*
171 ** Begin complex type conversion routines
172 */
173 
174 static chtype
c_sv2chtype(sv)175 c_sv2chtype(sv)
176 SV *sv;
177 {
178     if (SvPOK(sv)) {
179         char *tmp = SvPV_nolen(sv);
180         return (chtype)(unsigned char)tmp[0];
181     }
182     return (chtype)SvIV(sv);
183 }
184 
185 static void
c_chtype2sv(sv,ch)186 c_chtype2sv(sv, ch)
187 SV *sv;
188 chtype ch;
189 {
190     if (ch == ERR || ch > 255) { sv_setiv(sv, (I32)ch); }
191     else {
192     char tmp[2];
193     tmp[0] = (char)ch;
194     tmp[1] = (char)0;
195     sv_setpv(sv, tmp);
196     }
197 }
198 
199 static FIELD *
c_sv2field(sv,argnum)200 c_sv2field(sv, argnum)
201 SV *sv;
202 int argnum;
203 {
204     if (sv_derived_from(sv, "Curses::Field"))
205     return (FIELD *)SvIV((SV*)SvRV(sv));
206     if (argnum >= 0)
207     croak("argument %d to Curses function '%s' is not a Curses field",
208           argnum, c_function);
209     else
210     croak("argument is not a Curses field");
211 }
212 
213 static void
c_field2sv(SV * const svP,FIELD * const fieldP)214 c_field2sv(SV *    const svP,
215            FIELD * const fieldP) {
216 /*----------------------------------------------------------------------------
217   Make *svP a reference to a scalar whose value is the numerical
218   equivalent of 'fieldP' and which is blessed into the hypothetical
219   package "Curses::Field".
220 -----------------------------------------------------------------------------*/
221     sv_setref_pv(svP, "Curses::Field", (void*)fieldP);
222 }
223 
224 static FORM *
c_sv2form(sv,argnum)225 c_sv2form(sv, argnum)
226 SV *sv;
227 int argnum;
228 {
229     if (sv_derived_from(sv, "Curses::Form"))
230     return (FORM *)SvIV((SV*)SvRV(sv));
231     if (argnum >= 0)
232     croak("argument %d to Curses function '%s' is not a Curses form",
233           argnum, c_function);
234     else
235     croak("argument is not a Curses form");
236 }
237 
238 static void
c_form2sv(sv,val)239 c_form2sv(sv, val)
240 SV *sv;
241 FORM *val;
242 {
243     sv_setref_pv(sv, "Curses::Form", (void*)val);
244 }
245 
246 static ITEM *
c_sv2item(sv,argnum)247 c_sv2item(sv, argnum)
248 SV *sv;
249 int argnum;
250 {
251     if (sv_derived_from(sv, "Curses::Item"))
252     return (ITEM *)SvIV((SV*)SvRV(sv));
253     if (argnum >= 0)
254     croak("argument %d to Curses function '%s' is not a Curses item",
255           argnum, c_function);
256     else
257     croak("argument is not a Curses item");
258 }
259 
260 
261 
262 static void
c_item2sv(SV * const svP,ITEM * const valP)263 c_item2sv(SV *   const svP,
264           ITEM * const valP) {
265 /*----------------------------------------------------------------------------
266    Make *svP a reference to a new scalar whose implementation value is
267    'valP' and which is blessed into class Curses::Item.
268 
269    Caller can pass the referenced scalar to other functions of the Curses
270    module, which can recover the ITEM * from it.
271 -----------------------------------------------------------------------------*/
272     sv_setref_pv(svP, "Curses::Item", (void*)valP);
273 }
274 
275 
276 
277 static MENU *
c_sv2menu(sv,argnum)278 c_sv2menu(sv, argnum)
279 SV *sv;
280 int argnum;
281 {
282     if (sv_derived_from(sv, "Curses::Menu"))
283     return (MENU *)SvIV((SV*)SvRV(sv));
284     if (argnum >= 0)
285     croak("argument %d to Curses function '%s' is not a Curses menu",
286           argnum, c_function);
287     else
288     croak("argument is not a Curses menu");
289 }
290 
291 static void
c_menu2sv(sv,val)292 c_menu2sv(sv, val)
293 SV *sv;
294 MENU *val;
295 {
296     sv_setref_pv(sv, "Curses::Menu", (void*)val);
297 }
298 
299 static PANEL *
c_sv2panel(sv,argnum)300 c_sv2panel(sv, argnum)
301 SV *sv;
302 int argnum;
303 {
304     if (sv_derived_from(sv, "Curses::Panel"))
305     return (PANEL *)SvIV((SV*)SvRV(sv));
306     if (argnum >= 0)
307     croak("argument %d to Curses function '%s' is not a Curses panel",
308           argnum, c_function);
309     else
310     croak("argument is not a Curses panel");
311 }
312 
313 static void
c_panel2sv(sv,val)314 c_panel2sv(sv, val)
315 SV *sv;
316 PANEL *val;
317 {
318     sv_setref_pv(sv, "Curses::Panel", (void*)val);
319 }
320 
321 static SCREEN *
c_sv2screen(sv,argnum)322 c_sv2screen(sv, argnum)
323 SV *sv;
324 int argnum;
325 {
326     if (sv_derived_from(sv, "Curses::Screen"))
327     return (SCREEN *)SvIV((SV*)SvRV(sv));
328     if (argnum >= 0)
329     croak("argument %d to Curses function '%s' is not a Curses screen",
330           argnum, c_function);
331     else
332     croak("argument is not a Curses screen");
333 }
334 
335 static void
c_screen2sv(sv,val)336 c_screen2sv(sv, val)
337 SV *sv;
338 SCREEN *val;
339 {
340     sv_setref_pv(sv, "Curses::Screen", (void*)val);
341 }
342 
343 static WINDOW *
c_sv2window(sv,argnum)344 c_sv2window(sv, argnum)
345 SV *sv;
346 int argnum;
347 {
348     if (sv_derived_from(sv, "Curses::Window")) {
349       WINDOW *ret = (WINDOW *)SvIV((SV*)SvRV(sv));
350       return ret;
351     }
352     if (argnum >= 0)
353     croak("argument %d to Curses function '%s' is not a Curses window",
354           argnum, c_function);
355     else
356     croak("argument is not a Curses window");
357 }
358 
359 static void
c_window2sv(sv,val)360 c_window2sv(sv, val)
361 SV *sv;
362 WINDOW *val;
363 {
364     sv_setref_pv(sv, "Curses::Window", (void*)val);
365 }
366 
367 
368 static void
c_setchar(sv,name)369 c_setchar(sv, name)
370 SV *sv;
371 char *name;
372 {
373     int len  = SvLEN(sv);
374 
375     if (len > 0) {
376         name[len - 1] = 0;
377 
378     SvCUR(sv) = strlen(name);
379     SvPOK_only(sv);
380     *SvEND(sv) = 0;
381     }
382 }
383 
384 static void
c_setchtype(sv,name)385 c_setchtype(sv, name)
386 SV *sv;
387 chtype *name;
388 {
389     int n   = 0;
390     int rs  = sizeof(chtype);
391     int len = SvLEN(sv);
392 
393     if (len - len % rs > rs) {            /* find even multiple of rs */
394         name[len - len % rs - rs] = 0;
395 
396     while (*name++) { n++; }
397 
398     SvCUR(sv) = n;
399     SvPOK_only(sv);
400     *(chtype *)SvEND(sv) = 0;
401     }
402 }
403 
404 static void
c_setmevent(sv)405 c_setmevent(sv)
406 SV *sv;
407 {
408     SvCUR(sv) = sizeof(MEVENT);
409     SvPOK_only(sv);
410 }
411 
412 
413 #if ((HAVE_PERL_UVCHR_TO_UTF8 || HAVE_PERL_UV_TO_UTF8) && \
414     (HAVE_PERL_UTF8_TO_UVCHR_BUF || HAVE_PERL_UTF8_TO_UVCHR || \
415      HAVE_PERL_UTF8_TO_UV))
416   #include "CursesWide.c"
417   #define HAVE_WIDE_SV_HELPER 1
418 #else
419   #define HAVE_WIDE_SV_HELPER 0
420 #endif
421 
422 /*
423 **  Cheesy, I know.  But it works.
424 */
425 
426 
427 #include "CursesFun.c"
428 #if HAVE_WIDE_SV_HELPER
429   #include "CursesFunWide.c"
430   #define HAVE_WIDE_XS_FUNCTIONS 1
431 #else
432   #define HAVE_WIDE_XS_FUNCTIONS 0
433 #endif
434 #include "CursesVar.c"
435 #include "CursesCon.c"
436 #include "CursesBoot.c"
437