141 lines
2.8 KiB
C
141 lines
2.8 KiB
C
/*
|
|
Report generator for TinyCobol
|
|
Wrapper for tcl interpreter
|
|
|
|
Recife, Brazil, 2001 -- Rildo Pragana
|
|
*/
|
|
|
|
//#define LOAD_TK
|
|
#include <tcl.h>
|
|
|
|
#ifdef LOAD_TK
|
|
#include <tk.h>
|
|
#endif
|
|
|
|
#include <stdio.h>
|
|
#include <stdlib.h>
|
|
#include <stdarg.h>
|
|
|
|
#define min(x,y) ((x)<(y) ? (x) : (y))
|
|
|
|
Tcl_Interp *interp;
|
|
int error_code;
|
|
#ifdef LOAD_TK
|
|
Tk_Window mainwin;
|
|
#endif
|
|
char script[] = "reportGen.tcl";
|
|
|
|
void tcl_do_exit() {
|
|
char *einf;
|
|
einf = Tcl_GetVar(interp,"errorInfo",TCL_GLOBAL_ONLY);
|
|
fprintf(stderr,"*** ReportGen ERROR from Tcl interpreter:\n%s\n",einf);
|
|
exit(1);
|
|
}
|
|
|
|
int rep_initiate(char *rep, char *lay) {
|
|
char *r;
|
|
int argc=0;
|
|
char *argv[]= { "tinycobol", ""};
|
|
char *cmdbuf=malloc(200);
|
|
|
|
interp = Tcl_CreateInterp();
|
|
#ifdef LOAD_TK
|
|
mainwin = Tk_MainWindow(interp);
|
|
#endif
|
|
Tcl_AppInit(interp);
|
|
if (Tcl_EvalFile(interp, script) != TCL_OK) {
|
|
r=Tcl_GetStringResult(interp);
|
|
tcl_do_exit();
|
|
}
|
|
strcpy(cmdbuf,"Initiate ");
|
|
strcat(cmdbuf,rep);
|
|
strcat(cmdbuf," ");
|
|
strcat(cmdbuf,lay);
|
|
if (Tcl_Eval(interp,cmdbuf) != TCL_OK) {
|
|
r=Tcl_GetStringResult(interp);
|
|
tcl_do_exit();
|
|
}
|
|
free(cmdbuf);
|
|
}
|
|
|
|
int rep_terminate() {
|
|
char *r;
|
|
|
|
if (Tcl_Eval(interp,"Terminate") != TCL_OK) {
|
|
r=Tcl_GetStringResult(interp);
|
|
tcl_do_exit();
|
|
}
|
|
Tcl_DeleteInterp(interp);
|
|
}
|
|
|
|
int rep_generate( char *record, ... ) {
|
|
char *r;
|
|
char *cmdbuf;
|
|
char tmp[20];
|
|
int pointer,i,nargs,reclen;
|
|
char *nbstr,*rlstr;
|
|
va_list args;
|
|
va_start(args,record);
|
|
|
|
nbstr = Tcl_GetVar(interp,"nbreaks",TCL_GLOBAL_ONLY);
|
|
Tcl_GetInt(interp,nbstr,&nargs);
|
|
|
|
rlstr = Tcl_GetVar(interp,"reclength",TCL_GLOBAL_ONLY);
|
|
Tcl_GetInt(interp,rlstr,&reclen);
|
|
|
|
cmdbuf = malloc(strlen(record)+(nargs+1)*20);
|
|
strcpy(cmdbuf,"Generate \{");
|
|
strncat(cmdbuf,record,reclen);
|
|
strcat(cmdbuf,"}");
|
|
|
|
for (i=0;i<nargs;i++) {
|
|
pointer = va_arg(args,int);
|
|
sprintf(tmp," 0x%x", pointer);
|
|
strcat(cmdbuf,tmp);
|
|
}
|
|
va_end(args);
|
|
|
|
if (Tcl_Eval(interp,cmdbuf) != TCL_OK) {
|
|
r=Tcl_GetStringResult(interp);
|
|
tcl_do_exit();
|
|
}
|
|
free(cmdbuf);
|
|
}
|
|
|
|
int set_register( ClientData clientData,
|
|
Tcl_Interp *interp,
|
|
int argc, char *argv[]) {
|
|
int *reg,val;
|
|
|
|
if (argc != 3) {
|
|
interp->result = "usage: set_register reg_addr value";
|
|
return TCL_ERROR;
|
|
}
|
|
|
|
if (Tcl_GetInt(interp,argv[1],(int *)®) != TCL_OK) {
|
|
return TCL_ERROR;
|
|
}
|
|
if (Tcl_GetInt(interp,argv[2],(int *)&val) != TCL_OK) {
|
|
return TCL_ERROR;
|
|
}
|
|
*reg = val;
|
|
return TCL_OK;
|
|
}
|
|
|
|
int
|
|
Tcl_AppInit(Tcl_Interp *interp) {
|
|
if (Tcl_Init(interp) == TCL_ERROR) {
|
|
return TCL_ERROR;
|
|
}
|
|
#ifdef LOAD_TK
|
|
if (Tk_Init(interp) == TCL_ERROR) {
|
|
return TCL_ERROR;
|
|
}
|
|
Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit);
|
|
Tcl_SetVar(interp, "tcl_rcFileName", "~/.wishrc", TCL_GLOBAL_ONLY);
|
|
#endif
|
|
Tcl_CreateCommand(interp, "set_register", set_register, NULL, NULL);
|
|
return TCL_OK;
|
|
}
|
|
|