#!/usr/local/bin/perl
##
## make.CursesFun.c -- make CursesFun.c
##
## Copyright (c) 2000 William Setzer
##
## You may distribute under the terms of either the Artistic License
## or the GNU General Public License, as specified in the README file.
use lib 'gen';
use Gen;
open OUT, "> CursesFun.c" or die "Can't open CursesFun.c: $!\n";
process_DATA_chunk \&print_line;
process_functions \&print_function;
close OUT;
###
## The helpers
#
sub print_line { print OUT @_ }
sub print_function {
my $fun = shift;
unless ($fun->{DOIT}) {
print OUT $fun->{LINE};
return;
}
my @decl;
my @retn;
my @argv;
if ($fun->{UNI}) {
push @decl, "WINDOW *win\t= c_win ? c_sv2window(ST(0), 0) : stdscr;";
push @decl, "int\tc_mret\t= c_x ? c_domove(win, ST(c_x-1), ST(c_x)) : OK;";
push @argv, "win";
}
foreach my $arg (@{$fun->{ARGV}}) {
my $pos = $fun->{UNI} ? $arg->{NUM} ? "c_arg+$arg->{NUM}" : "c_arg"
: $arg->{NUM};
my $A = "ST($pos)";
my $B = $arg->{SPEC}{B} || $pos;
my $N = $arg->{NAME};
my $T = length($arg->{DECL}) < 8 ? "\t" : "";
my $D = eval qq("$arg->{DECL}$T$arg->{NAME}\t= $arg->{M_DECL};");
if ($arg->{SPEC}{SHIFT}) {
splice @decl, $arg->{SPEC}{SHIFT}, 0, $D;
}
else {
push @decl, $D;
}
if ($arg->{M_RETN}) {
push @retn, eval qq("$arg->{M_RETN};");
}
push @argv, $arg->{SPEC}{AMP} ? "&" . $arg->{NAME} : $arg->{NAME};
}
my $pref = $fun->{SPEC}{CAST} ? "($fun->{DECL})" . $fun->{W} : $fun->{W};
my $call = $pref . $fun->{NAME} . "(" . join(", ", @argv) . ");";
if ($fun->{UNI}) {
if ($fun->{DECL} eq 'void') {
$call = "if (c_mret == OK) { $call }";
}
else {
$call = eval qq("c_mret == ERR ? $fun->{M_NULL} : $call");
}
}
if ($fun->{DECL} eq 'void') {
unshift @retn, $call;
}
else {
my $A = "ST(0)";
my $N = "ret";
push @decl, "$fun->{DECL}\tret\t= $call";
push @retn, "ST(0) = sv_newmortal();";
push @retn, eval qq("$fun->{M_RETN};");
}
push @decl, '' if @decl;
my $count = $fun->{UNI} ? "count" : "exact";
my $body = join "\n\t", @decl, @retn;
my $xsret = $fun->{DECL} ne 'void' ? 1 : 0;
print OUT Q<<AAA;
################
# XS(XS_Curses_$fun->{NAME})
# {
# dXSARGS;
# #ifdef C_\U$fun->{NAME}\E
# c_${count}args("$fun->{NAME}", items, $fun->{ARGC});
# {
# $body
# }
# XSRETURN($xsret);
# #else
# c_fun_not_there("$fun->{NAME}");
# XSRETURN(0);
# #endif
# }
#
################
AAA
}
sub print_function2 {
my $fun = shift;
return unless $fun->{DOIT};
return if $fun->{SPEC}{DUP};
my $S = " " x (3 - length $fun->{NUM});
print OUT Q<<AAA;
################
# #ifdef C_\U$fun->{NAME}\E
# case $S$fun->{NUM}: ret = 1; break;
# #endif
################
AAA
}
__END__
/* This file can be automatically generated; changes may be lost.
**
**
** CursesFun.c -- the functions
**
** Copyright (c) 1994-2000 William Setzer
**
** You may distribute under the terms of either the Artistic License
** or the GNU General Public License, as specified in the README file.
*/
PAUSE