tclpkg-misc.cc

Go to the documentation of this file.
00001 /** @file tcl/tclpkg-misc.cc tcl interface package for miscellaneous
00002     functions */
00003 ///////////////////////////////////////////////////////////////////////
00004 //
00005 // Copyright (c) 1998-2004 California Institute of Technology
00006 // Copyright (c) 2004-2007 University of Southern California
00007 // Rob Peters <rjpeters at usc dot edu>
00008 //
00009 // created: Mon Nov  2 08:00:00 1998
00010 // commit: $Id: tclpkg-misc.cc 11876 2009-10-22 15:53:06Z icore $
00011 // $HeadURL: svn://isvn.usc.edu/software/invt/trunk/saliency/src/tcl/tclpkg-misc.cc $
00012 //
00013 // --------------------------------------------------------------------
00014 //
00015 // This file is part of GroovX
00016 //   [http://ilab.usc.edu/rjpeters/groovx/]
00017 //
00018 // GroovX is free software; you can redistribute it and/or modify it
00019 // under the terms of the GNU General Public License as published by
00020 // the Free Software Foundation; either version 2 of the License, or
00021 // (at your option) any later version.
00022 //
00023 // GroovX is distributed in the hope that it will be useful, but
00024 // WITHOUT ANY WARRANTY; without even the implied warranty of
00025 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
00026 // General Public License for more details.
00027 //
00028 // You should have received a copy of the GNU General Public License
00029 // along with GroovX; if not, write to the Free Software Foundation,
00030 // Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA.
00031 //
00032 ///////////////////////////////////////////////////////////////////////
00033 
00034 #ifndef GROOVX_TCL_TCLPKG_MISC_CC_UTC20050628161246_DEFINED
00035 #define GROOVX_TCL_TCLPKG_MISC_CC_UTC20050628161246_DEFINED
00036 
00037 #include "tcl/tclpkg-misc.h"
00038 
00039 // this file contains the implementations for some simple Tcl
00040 // functions that are basically wrappers for standard C library
00041 // functions, including rand(), sleep(), and usleep()
00042 
00043 #include "tcl/commandgroup.h"
00044 #include "tcl/list.h"
00045 #include "tcl/pkg.h"
00046 
00047 #include "rutz/backtrace.h"
00048 #include "rutz/backtraceformat.h"
00049 #include "rutz/error.h"
00050 #include "rutz/fstring.h"
00051 #include "rutz/rand.h"
00052 #include "rutz/sfmt.h"
00053 
00054 #include <unistd.h>
00055 
00056 #include "rutz/trace.h"
00057 
00058 namespace
00059 {
00060   rutz::urand generator;
00061 
00062   void usleepr(unsigned int usecs, unsigned int reps)
00063   {
00064     for ( ; reps > 0; --reps)
00065       ::usleep(usecs);
00066   }
00067 
00068   rutz::fstring backTrace()
00069   {
00070     rutz::backtrace bt;
00071     rutz::error::get_last_backtrace(bt);
00072     return rutz::format(bt);
00073   }
00074 
00075   rutz::fstring cmdUsage(tcl::call_context& ctx)
00076   {
00077     const char* name = ctx.get_arg<const char*>(1);
00078     tcl::command_group* cmd =
00079       tcl::command_group::lookup_original(ctx.interp(), name);
00080 
00081     if (cmd == 0)
00082       throw rutz::error("no such tcl::command_group", SRC_POS);
00083 
00084     return rutz::sfmt("%s resolves to %s\n%s",
00085                       name, cmd->resolved_name().c_str(),
00086                       cmd->usage().c_str());
00087   }
00088 
00089   unsigned long get_default_seed() { return rutz::default_rand_seed; }
00090   void set_default_seed(unsigned long x) { rutz::default_rand_seed = x; }
00091 
00092   rutz::fstring tcl_valuetype(tcl::obj obj)
00093   {
00094     return obj.tcltype_name();
00095   }
00096 
00097   double rand_draw(double min, double max)
00098   {
00099     return generator.fdraw_range(min, max);
00100   }
00101 
00102   tcl::list rand_draw_n(double min, double max, int n)
00103   {
00104     tcl::list result;
00105     for (int i = 0; i < n; ++i)
00106       result.append(rand_draw(min, max));
00107     return result;
00108   }
00109 }
00110 
00111 extern "C"
00112 int Misc_Init(Tcl_Interp* interp)
00113 {
00114 GVX_TRACE("Misc_Init");
00115 
00116   using namespace rutz;
00117 
00118   GVX_PKG_CREATE(pkg, interp, "Misc", "4.$Revision: 11876 $");
00119 
00120   pkg->def( "::rand", "min max", &rand_draw, SRC_POS);
00121   pkg->def( "::rand", "min max ?n=1?", &rand_draw_n, SRC_POS);
00122   pkg->def( "::srand", "seed",
00123             bind_first(mem_func(&rutz::urand::seed), &generator),
00124             SRC_POS );
00125 
00126   // use the standard library sleep() to sleep a specified # of seconds
00127   //
00128   // performance: performance is pretty good, considering that we're on
00129   // a seconds timescale with this command. It seems to use an extra
00130   // 9msec more than the specified delay
00131   pkg->def( "::sleep", "secs", &::sleep, SRC_POS );
00132 
00133   // use the standard library usleep() to sleep a specified # of microseconds
00134   //
00135   // performance: in a real Tcl script, this command chews up an
00136   // additional 9000usec more than the specified delay, unless the
00137   // specified number is < 10000, in which case this command invariably
00138   // takes ~19000 us (ugh)
00139   pkg->def( "::usleep", "usecs", &::usleep, SRC_POS );
00140 
00141   // use the standard library usleep() to repeatedly sleep a specified #
00142   // of microseconds
00143   //
00144   // performance: as with usleepCmd, there is some significant overhead
00145   // here. It is typically an extra 10000usec per loop iteration, but
00146   // again, as in usleepCmd, there seemse to be a minimum of ~20000usec
00147   // per iteration, even if the specified delay is 1.
00148   pkg->def( "::usleepr", "usecs reps", &usleepr, SRC_POS );
00149 
00150   pkg->def( "::bt", "", &backTrace, SRC_POS );
00151 
00152   pkg->def( "::default_rand_seed", "", &get_default_seed, SRC_POS );
00153   pkg->def( "::default_rand_seed", "seed", &set_default_seed, SRC_POS );
00154 
00155   pkg->def( "::tcl_valuetype", "value", &tcl_valuetype, SRC_POS );
00156 
00157   pkg->def_raw( "::?", tcl::arg_spec(2), "cmd_name", &cmdUsage, SRC_POS );
00158 
00159   GVX_PKG_RETURN(pkg);
00160 }
00161 
00162 static const char __attribute__((used)) vcid_groovx_tcl_tclpkg_misc_cc_utc20050628161246[] = "$Id: tclpkg-misc.cc 11876 2009-10-22 15:53:06Z icore $ $HeadURL: svn://isvn.usc.edu/software/invt/trunk/saliency/src/tcl/tclpkg-misc.cc $";
00163 #endif // !GROOVX_TCL_TCLPKG_MISC_CC_UTC20050628161246_DEFINED
Generated on Sun May 8 08:42:22 2011 for iLab Neuromorphic Vision Toolkit by  doxygen 1.6.3