void myIdleFunc(void)
{
//------------------------------------------------------------
// This must be done in any Tcl app, to allow Tcl/Tk to handle
// events
while (Tk_DoOneEvent(TK_DONT_WAIT)) {};
//------------------------------------------------------------
// This is called once every time through the main loop. It
// pushes changes in the C variables over to Tcl.
if (Tclvar_mainloop()) {
fprintf(stderr,"Tclvar Mainloop failed\n");
}
// See if we are done.
if (g_quit) {
cleanup();
exit(0);
}
// See if there are any more messages from the server and then sleep
// a little while so that we don't eat the whole CPU.
g_ti->mainloop();
vrpn_SleepMsecs(5);
}
// checkEvents:
// Processes both Tk and TCL events.
//
void animTcl::checkEvents(void)
{
if( UsingTk == FALSE)
while(Tcl_DoOneEvent(TCL_DONT_WAIT) != 0) ;
else
while(Tk_DoOneEvent(TK_DONT_WAIT) != 0) ;
}
CAMLprim value camltk_dooneevent(value flags)
{
int ret;
CheckInit();
ret = Tk_DoOneEvent(convert_flag_list(flags, event_flag_table));
return Val_int(ret);
}
void
ParadynTkGUI::DoPendingTkEvents( void )
{
// We use Tk_DoOneEvent (w/o blocking) to soak up and process
// pending tk events, if any. Returns as soon as there are no
// tk events to process.
// NOTE: This includes (as it should) tk idle events.
// NOTE: This is basically the same as Tcl_Eval(interp, "update"), but
// who wants to incur the expense of tcl parsing?
while(Tk_DoOneEvent(TK_DONT_WAIT) > 0)
{
// nothing else to do
}
}
jump_addr gui_call( void )
{
Tcl_Interp *interp;
int rc = 0;
COUNT_ARGS_AT_LEAST(1);
if (EQ(REG0,FALSE_OBJ))
{
COUNT_ARGS(1);
interp = Tcl_CreateInterp();
REG0 = RAW_PTR_TO_OBJ( interp );
}
else if (arg_count_reg > 2 && EQ(REG1,int2fx(4)))
{
obj info;
COUNT_ARGS(3);
interp = (Tcl_Interp *)OBJ_TO_RAW_PTR(REG0);
/* this hook creates a Scheme procedure
for calling the given Tcl command
The arguments to the scheme procedure had
better be strings, fixnums, or symbols.
*/
info = bvec_alloc( sizeof(Tcl_CmdInfo), byte_vector_class );
/*printf( "seeking info on `%s'\n", string_text(REG2) );*/
if (!Tcl_GetCommandInfo( interp,
(char *)string_text(REG2),
(Tcl_CmdInfo *)PTR_TO_DATAPTR(info) ))
{
REG0 = make_string( "command not found" );
REG1 = int2fx(1);
RETURN(1);
}
REG0 = make2(closure_class,
make4(bindingenvt_class,
NIL_OBJ,
info,
RAW_PTR_TO_OBJ(interp),
REG2 ),
make2(template_class,
JUMP_ADDR_TO_OBJ(tcl_gateway),
ZERO));
RETURN1();
}
else
{
COUNT_ARGS(2);
interp = (Tcl_Interp *)OBJ_TO_RAW_PTR(REG0);
if (EQ(REG1,int2fx(0)))
{
switch_hw_regs_back_to_os();
main_tk_win = Tk_CreateMainWindow( interp, NULL, "rs", "RScheme" );
if (!main_tk_win)
{
switch_hw_regs_into_scheme();
goto tcl_error;
}
printf( "main window = %#x\n", main_tk_win );
/*
Tk_GeometryRequest( main_tk_win, 200, 200 );
*/
Tcl_SetVar(interp, "tcl_interactive","0", TCL_GLOBAL_ONLY);
Tcl_CreateCommand(interp,
"scheme-callback",
the_callback,
(ClientData)0,
NULL);
switch_hw_regs_into_scheme();
if ((rc = Tcl_Init(interp)) == TCL_ERROR) {
goto tcl_error;
}
if ((rc = Tk_Init(interp)) == TCL_ERROR) {
goto tcl_error;
}
}
else if (EQ(REG1,int2fx(2)))
{
Tk_MakeWindowExist( main_tk_win );
RETURN0();
}
else if (EQ(REG1,int2fx(1)))
{
evts = NIL_OBJ;
switch_hw_regs_back_to_os();
Tk_DoOneEvent(TK_ALL_EVENTS|TK_DONT_WAIT);
switch_hw_regs_into_scheme();
REG0 = evts;
RETURN(1);
}
else if (EQ(REG1,int2fx(3)))
{
evts = NIL_OBJ;
/* flush events */
switch_hw_regs_back_to_os();
while (Tk_DoOneEvent(TK_ALL_EVENTS|TK_DONT_WAIT));
switch_hw_regs_into_scheme();
REG0 = evts;
RETURN(1);
}
else
{
assert( STRING_P(REG1) );
rc = Tcl_Eval( interp, (char *)string_text(REG1) );
}
REG0 = make_string( interp->result );
}
RETURN(1);
tcl_error:
REG0 = make_string( interp->result );
REG1 = int2fx(rc);
RETURN(2);
}
int DAS_gain( ClientData clientData ,
char *srcname,
double pkttime,
uchar_t *packet )
{
char cmdstr[256];
char errmsg[512], msg[512];
char key[256];
int nchan;
struct DasPreHdr hdr;
DPars *dp;
int i, skip_bytes, doff, chbytes;
uchar_t *tmphdr;
ushort_t gain, chid, val;
short tmpval;
TclOrb *tclorb = (TclOrb *) clientData;
Srcname parts ;
split_srcname(srcname, &parts) ;
memcpy( &key[0], packet, 256);
tmphdr = (uchar_t *) &key[0];
memcpy( &tmpval, tmphdr, sizeof(short ));
tmphdr += sizeof(short );
hdr.hdrsiz = ntohs( tmpval );
/*
printf("src=%s size=%d\n", srcname, hdr.hdrsiz);
fflush(stdout);
*/
/* skip to the 'doff'(offset to real data) value in orb header */
/* skipping: hdrtype+pkttype+pktsize+
calib+srate+
datatype+nsamp+nchan */
skip_bytes = 0;
skip_bytes = sizeof(short)+sizeof(short)+sizeof(short)+
sizeof(float)+ sizeof(float)+
sizeof(short)+sizeof(short)+sizeof(short);
tmphdr += sizeof(short); /* skip hdrtype valuse */
tmphdr += sizeof(short); /* skip pkttype valuse */
tmphdr += sizeof(short); /* skip pktsize valuse */
tmphdr += sizeof(float); /* skip calib valuse */
tmphdr += sizeof(float); /* skip samprate valuse */
tmphdr += sizeof(short); /* skip datatype valuse */
tmphdr += sizeof(short); /* skip nsamp valuse */
tmphdr += sizeof(short); /* skip nchan valuse */
/* get doff value */
memcpy( &tmpval, tmphdr, sizeof( short ));
doff = ntohs( tmpval );
nchan = packet[hdr.hdrsiz+NCHAN];
/*
printf("doff=%d ch=%d\n", doff, nchan);
fflush(stdout);
*/
if (nchan <= 0 || nchan > 9 ) {
sprintf( errmsg, "Wrong number of channels - %d (%0x)!!!", nchan, packet[hdr.hdrsiz+NCHAN] );
sprintf( &msg[0], "%s {%s} \0", ERR_PROC, errmsg);
Tcl_Eval ( tclorb->interp, msg );
while ( Tk_DoOneEvent (TK_DONT_WAIT) )
;
return 0;
}
doff += hdr.hdrsiz;
for ( i = 0; i < nchan; i++ ) {
chid = (uchar_t) packet[doff];
gain = (uchar_t) packet[doff+1];
val = (uchar_t)packet[doff+2]*256 + (uchar_t)packet[doff+3];
chbytes = val;
/*
printf("id=%d gain=%d byte=%d\n", chid, gain, chbytes);
fflush(stdout);
*/
sprintf (key, "%s_chan%d\0", parts.src_sta, chid );
dp = ( DPars *) getarr (tclorb->dpars, key);
if ( dp != 0) {
if(gain == 2)
sprintf ( &cmdstr[0],
"%s {%s} {x32} {none}\0", tclorb->parcallback, dp->widget );
else if(gain == 1)
sprintf ( &cmdstr[0],
"%s {%s} {x1} {none}\0", tclorb->parcallback, dp->widget );
else {
sprintf( errmsg, "Unknown gain value - %d for channel %d!", gain, chid);
sprintf( &msg[0], "%s {%s} \0", ERR_PROC, errmsg);
Tcl_Eval ( tclorb->interp, msg );
while ( Tk_DoOneEvent (TK_DONT_WAIT) )
;
return 0;
}
if (tclorb->verbose > 0) {
printf ("%s\n", cmdstr );
fflush (stdout);
}
Tcl_Eval (tclorb->interp, cmdstr );
}
doff += CHDATA_OFF+chbytes;
}
return 1;
}
