tcl.c

Go to the documentation of this file.
00001 /*                           T C L . C
00002  * BRL-CAD
00003  *
00004  * Copyright (c) 1995-2012 United States Government as represented by
00005  * the U.S. Army Research Laboratory.
00006  *
00007  * This library is free software; you can redistribute it and/or
00008  * modify it under the terms of the GNU Lesser General Public License
00009  * version 2.1 as published by the Free Software Foundation.
00010  *
00011  * This library is distributed in the hope that it will be useful, but
00012  * WITHOUT ANY WARRANTY; without even the implied warranty of
00013  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
00014  * Lesser General Public License for more details.
00015  *
00016  * You should have received a copy of the GNU Lesser General Public
00017  * License along with this file; see the file named COPYING for more
00018  * information.
00019  */
00020 /** @addtogroup bntcl */
00021 /** @{ */
00022 /** @file libbn/tcl.c
00023  *
00024  * @brief
00025  * Tcl interfaces to all the LIBBN math routines.
00026  *
00027  */
00028 
00029 #include "common.h"
00030 
00031 #include <stdlib.h>
00032 #include <stdio.h>
00033 #include <math.h>
00034 #include <string.h>
00035 
00036 #include "tcl.h"
00037 
00038 #include "bu.h"
00039 #include "vmath.h"
00040 #include "bn.h"
00041 
00042 /* Support routines for the math functions */
00043 
00044 /* XXX Really need a decode_array function that uses atof(),
00045  * XXX so that junk like leading { and commas between inputs
00046  * XXX don't spoil the conversion.
00047  */
00048 
00049 int
00050 bn_decode_mat(fastf_t *m, const char *str)
00051 {
00052     if (BU_STR_EQUAL(str, "I")) {
00053         MAT_IDN(m);
00054         return 16;
00055     }
00056     if (*str == '{') str++;
00057 
00058     return sscanf(str,
00059                   "%lf %lf %lf %lf %lf %lf %lf %lf %lf %lf %lf %lf %lf %lf %lf %lf",
00060                   &m[0], &m[1], &m[2], &m[3], &m[4], &m[5], &m[6], &m[7],
00061                   &m[8], &m[9], &m[10], &m[11], &m[12], &m[13], &m[14], &m[15]);
00062 }
00063 
00064 
00065 int
00066 bn_decode_quat(fastf_t *q, const char *str)
00067 {
00068     if (*str == '{') str++;
00069     return sscanf(str, "%lf %lf %lf %lf", &q[0], &q[1], &q[2], &q[3]);
00070 }
00071 
00072 
00073 int
00074 bn_decode_vect(fastf_t *v, const char *str)
00075 {
00076     if (*str == '{') str++;
00077     return sscanf(str, "%lf %lf %lf", &v[0], &v[1], &v[2]);
00078 }
00079 
00080 
00081 int
00082 bn_decode_hvect(fastf_t *v, const char *str)
00083 {
00084     if (*str == '{') str++;
00085     return sscanf(str, "%lf %lf %lf %lf", &v[0], &v[1], &v[2], &v[3]);
00086 }
00087 
00088 
00089 void
00090 bn_encode_mat(struct bu_vls *vp, const mat_t m)
00091 {
00092     if (m == NULL) {
00093         bu_vls_putc(vp, 'I');
00094         return;
00095     }
00096 
00097     bu_vls_printf(vp, "%g %g %g %g  %g %g %g %g  %g %g %g %g  %g %g %g %g",
00098                   INTCLAMP(m[0]), INTCLAMP(m[1]), INTCLAMP(m[2]), INTCLAMP(m[3]),
00099                   INTCLAMP(m[4]), INTCLAMP(m[5]), INTCLAMP(m[6]), INTCLAMP(m[7]),
00100                   INTCLAMP(m[8]), INTCLAMP(m[9]), INTCLAMP(m[10]), INTCLAMP(m[11]),
00101                   INTCLAMP(m[12]), INTCLAMP(m[13]), INTCLAMP(m[14]), INTCLAMP(m[15]));
00102 }
00103 
00104 
00105 void
00106 bn_encode_quat(struct bu_vls *vp, const mat_t q)
00107 {
00108     bu_vls_printf(vp, "%g %g %g %g", V4INTCLAMPARGS(q));
00109 }
00110 
00111 
00112 void
00113 bn_encode_vect(struct bu_vls *vp, const mat_t v)
00114 {
00115     bu_vls_printf(vp, "%g %g %g", V3INTCLAMPARGS(v));
00116 }
00117 
00118 
00119 void
00120 bn_encode_hvect(struct bu_vls *vp, const mat_t v)
00121 {
00122     bu_vls_printf(vp, "%g %g %g %g", V4INTCLAMPARGS(v));
00123 }
00124 
00125 
00126 void
00127 bn_quat_distance_wrapper(double *dp, mat_t q1, mat_t q2)
00128 {
00129     *dp = quat_distance(q1, q2);
00130 }
00131 
00132 
00133 void
00134 bn_mat_scale_about_pt_wrapper(int *statusp, mat_t mat, const point_t pt, const double scale)
00135 {
00136     *statusp = bn_mat_scale_about_pt(mat, pt, scale);
00137 }
00138 
00139 
00140 static void
00141 bn_mat4x3pnt(fastf_t *o, mat_t m, point_t i)
00142 {
00143     MAT4X3PNT(o, m, i);
00144 }
00145 
00146 
00147 static void
00148 bn_mat4x3vec(fastf_t *o, mat_t m, vect_t i)
00149 {
00150     MAT4X3VEC(o, m, i);
00151 }
00152 
00153 
00154 static void
00155 bn_hdivide(fastf_t *o, const mat_t i)
00156 {
00157     HDIVIDE(o, i);
00158 }
00159 
00160 
00161 static void
00162 bn_vjoin1(fastf_t *o, const point_t pnt, double scale, const vect_t dir)
00163 {
00164     VJOIN1(o, pnt, scale, dir);
00165 }
00166 
00167 
00168 static void bn_vblend(mat_t a, fastf_t b, mat_t c, fastf_t d, mat_t e)
00169 {
00170     VBLEND2(a, b, c, d, e);
00171 }
00172 
00173 
00174 static struct math_func_link {
00175     char *name;
00176     void (*func)();
00177 } math_funcs[] = {
00178     {"bn_isect_line2_line2",    (void (*)())bn_isect_line2_line2},
00179     {"bn_isect_line3_line3",    (void (*)())bn_isect_line3_line3},
00180     {"mat_mul",            bn_mat_mul},
00181     {"mat_inv",            bn_mat_inv},
00182     {"mat_trn",            bn_mat_trn},
00183     {"matXvec",            bn_matXvec},
00184     {"mat4x3vec",          bn_mat4x3vec},
00185     {"mat4x3pnt",          bn_mat4x3pnt},
00186     {"hdivide",            bn_hdivide},
00187     {"vjoin1",             bn_vjoin1},
00188     {"vblend",             bn_vblend},
00189     {"mat_ae",             bn_mat_ae},
00190     {"mat_ae_vec",         bn_ae_vec},
00191     {"mat_aet_vec",        bn_aet_vec},
00192     {"mat_angles",         bn_mat_angles},
00193     {"mat_eigen2x2",       bn_eigen2x2},
00194     {"mat_fromto",         bn_mat_fromto},
00195     {"mat_xrot",           bn_mat_xrot},
00196     {"mat_yrot",           bn_mat_yrot},
00197     {"mat_zrot",           bn_mat_zrot},
00198     {"mat_lookat",         bn_mat_lookat},
00199     {"mat_vec_ortho",      bn_vec_ortho},
00200     {"mat_vec_perp",       bn_vec_perp},
00201     {"mat_scale_about_pt", bn_mat_scale_about_pt_wrapper},
00202     {"mat_xform_about_pt", bn_mat_xform_about_pt},
00203     {"mat_arb_rot",        bn_mat_arb_rot},
00204     {"quat_mat2quat",      quat_mat2quat},
00205     {"quat_quat2mat",      quat_quat2mat},
00206     {"quat_distance",      bn_quat_distance_wrapper},
00207     {"quat_double",        quat_double},
00208     {"quat_bisect",        quat_bisect},
00209     {"quat_slerp",         quat_slerp},
00210     {"quat_sberp",         quat_sberp},
00211     {"quat_make_nearest",  quat_make_nearest},
00212     {"quat_exp",           quat_exp},
00213     {"quat_log",           quat_log},
00214     {0, 0}
00215 };
00216 
00217 
00218 /**
00219  * B N _ M A T H _ C M D
00220  *@brief
00221  * Tcl wrappers for the math functions.
00222  *
00223  * This is where you should put clauses, in the below "if" statement, to add
00224  * Tcl support for the LIBBN math routines.
00225  */
00226 int
00227 bn_math_cmd(ClientData clientData, Tcl_Interp *interp, int argc, char **argv)
00228 {
00229     void (*math_func)();
00230     struct bu_vls result = BU_VLS_INIT_ZERO;
00231     struct math_func_link *mfl;
00232 
00233     mfl = (struct math_func_link *)clientData;
00234     math_func = mfl->func;
00235 
00236     if (math_func == bn_mat_mul) {
00237         mat_t o, a, b;
00238         if (argc < 3 || bn_decode_mat(a, argv[1]) < 16 ||
00239             bn_decode_mat(b, argv[2]) < 16) {
00240             bu_vls_printf(&result, "usage: %s matA matB", argv[0]);
00241             goto error;
00242         }
00243         bn_mat_mul(o, a, b);
00244         bn_encode_mat(&result, o);
00245     } else if (math_func == bn_mat_inv || math_func == bn_mat_trn) {
00246         mat_t o, a;
00247 
00248         if (argc < 2 || bn_decode_mat(a, argv[1]) < 16) {
00249             bu_vls_printf(&result, "usage: %s mat", argv[0]);
00250             goto error;
00251         }
00252         (*math_func)(o, a);
00253         bn_encode_mat(&result, o);
00254     } else if (math_func == bn_matXvec) {
00255         mat_t m;
00256         hvect_t i, o;
00257         if (argc < 3 || bn_decode_mat(m, argv[1]) < 16 ||
00258             bn_decode_hvect(i, argv[2]) < 4) {
00259             bu_vls_printf(&result, "usage: %s mat hvect", argv[0]);
00260             goto error;
00261         }
00262         bn_matXvec(o, m, i);
00263         bn_encode_hvect(&result, o);
00264     } else if (math_func == bn_mat4x3pnt) {
00265         mat_t m;
00266         point_t i, o;
00267         if (argc < 3 || bn_decode_mat(m, argv[1]) < 16 ||
00268             bn_decode_vect(i, argv[2]) < 3) {
00269             bu_vls_printf(&result, "usage: %s mat point", argv[0]);
00270             goto error;
00271         }
00272         bn_mat4x3pnt(o, m, i);
00273         bn_encode_vect(&result, o);
00274     } else if (math_func == bn_mat4x3vec) {
00275         mat_t m;
00276         vect_t i, o;
00277         if (argc < 3 || bn_decode_mat(m, argv[1]) < 16 ||
00278             bn_decode_vect(i, argv[2]) < 3) {
00279             bu_vls_printf(&result, "usage: %s mat vect", argv[0]);
00280             goto error;
00281         }
00282         bn_mat4x3vec(o, m, i);
00283         bn_encode_vect(&result, o);
00284     } else if (math_func == bn_hdivide) {
00285         hvect_t i;
00286         vect_t o;
00287         if (argc < 2 || bn_decode_hvect(i, argv[1]) < 4) {
00288             bu_vls_printf(&result, "usage: %s hvect", argv[0]);
00289             goto error;
00290         }
00291         bn_hdivide(o, i);
00292         bn_encode_vect(&result, o);
00293     } else if (math_func == bn_vjoin1) {
00294         point_t o;
00295         point_t b, d;
00296         fastf_t c;
00297 
00298         if (argc < 4) {
00299             bu_vls_printf(&result, "usage: %s pnt scale dir", argv[0]);
00300             goto error;
00301         }
00302         if (bn_decode_vect(b, argv[1]) < 3) goto error;
00303         if (Tcl_GetDouble(interp, argv[2], &c) != TCL_OK) goto error;
00304         if (bn_decode_vect(d, argv[3]) < 3) goto error;
00305 
00306         VJOIN1(o, b, c, d);     /* bn_vjoin1(o, b, c, d) */
00307         bn_encode_vect(&result, o);
00308 
00309     } else if (math_func == bn_vblend) {
00310         point_t a, c, e;
00311         fastf_t b, d;
00312 
00313         if (argc < 5) {
00314             bu_vls_printf(&result, "usage: %s scale pnt scale pnt", argv[0]);
00315             goto error;
00316         }
00317 
00318         if (Tcl_GetDouble(interp, argv[1], &b) != TCL_OK) goto error;
00319         if (bn_decode_vect(c, argv[2]) < 3) goto error;
00320         if (Tcl_GetDouble(interp, argv[3], &d) != TCL_OK) goto error;
00321         if (bn_decode_vect(e, argv[4]) < 3) goto error;
00322 
00323         VBLEND2(a, b, c, d, e)
00324             bn_encode_vect(&result, a);
00325 
00326     } else if (math_func == bn_mat_ae) {
00327         mat_t o;
00328         double az, el;
00329 
00330         if (argc < 3) {
00331             bu_vls_printf(&result, "usage: %s azimuth elevation", argv[0]);
00332             goto error;
00333         }
00334         if (Tcl_GetDouble(interp, argv[1], &az) != TCL_OK) goto error;
00335         if (Tcl_GetDouble(interp, argv[2], &el) != TCL_OK) goto error;
00336 
00337         bn_mat_ae(o, (fastf_t)az, (fastf_t)el);
00338         bn_encode_mat(&result, o);
00339     } else if (math_func == bn_ae_vec) {
00340         fastf_t az, el;
00341         vect_t v;
00342 
00343         if (argc < 2 || bn_decode_vect(v, argv[1]) < 3) {
00344             bu_vls_printf(&result, "usage: %s vect", argv[0]);
00345             goto error;
00346         }
00347 
00348         bn_ae_vec(&az, &el, v);
00349         bu_vls_printf(&result, "%g %g", az, el);
00350     } else if (math_func == bn_aet_vec) {
00351         fastf_t az, el, twist, accuracy;
00352         vect_t vec_ae, vec_twist;
00353 
00354         if (argc < 4 || bn_decode_vect(vec_ae, argv[1]) < 3 ||
00355             bn_decode_vect(vec_twist, argv[2]) < 3 ||
00356             sscanf(argv[3], "%lf", &accuracy) < 1) {
00357             bu_vls_printf(&result, "usage: %s vec_ae vec_twist accuracy",
00358                           argv[0]);
00359             goto error;
00360         }
00361 
00362         bn_aet_vec(&az, &el, &twist, vec_ae, vec_twist, accuracy);
00363         bu_vls_printf(&result, "%g %g %g", az, el, twist);
00364     } else if (math_func == bn_mat_angles) {
00365         mat_t o;
00366         double alpha, beta, ggamma;
00367 
00368         if (argc < 4) {
00369             bu_vls_printf(&result, "usage: %s alpha beta gamma", argv[0]);
00370             goto error;
00371         }
00372         if (Tcl_GetDouble(interp, argv[1], &alpha) != TCL_OK) goto error;
00373         if (Tcl_GetDouble(interp, argv[2], &beta) != TCL_OK) goto error;
00374         if (Tcl_GetDouble(interp, argv[3], &ggamma) != TCL_OK) goto error;
00375 
00376         bn_mat_angles(o, alpha, beta, ggamma);
00377         bn_encode_mat(&result, o);
00378     } else if (math_func == bn_eigen2x2) {
00379         fastf_t val1, val2;
00380         vect_t vec1, vec2;
00381         double a, b, c;
00382 
00383         if (argc < 4) {
00384             bu_vls_printf(&result, "usage: %s a b c", argv[0]);
00385             goto error;
00386         }
00387         if (Tcl_GetDouble(interp, argv[1], &a) != TCL_OK) goto error;
00388         if (Tcl_GetDouble(interp, argv[2], &c) != TCL_OK) goto error;
00389         if (Tcl_GetDouble(interp, argv[3], &b) != TCL_OK) goto error;
00390 
00391         bn_eigen2x2(&val1, &val2, vec1, vec2, (fastf_t)a, (fastf_t)b,
00392                     (fastf_t)c);
00393         bu_vls_printf(&result, "%g %g {%g %g %g} {%g %g %g}", INTCLAMP(val1), INTCLAMP(val2),
00394                       V3INTCLAMPARGS(vec1), V3INTCLAMPARGS(vec2));
00395     } else if (math_func == bn_mat_fromto) {
00396         mat_t o;
00397         vect_t from, to;
00398 
00399         if (argc < 3 || bn_decode_vect(from, argv[1]) < 3 ||
00400             bn_decode_vect(to, argv[2]) < 3) {
00401             bu_vls_printf(&result, "usage: %s vecFrom vecTo", argv[0]);
00402             goto error;
00403         }
00404         bn_mat_fromto(o, from, to);
00405         bn_encode_mat(&result, o);
00406     } else if (math_func == bn_mat_xrot || math_func == bn_mat_yrot ||
00407                math_func == bn_mat_zrot) {
00408         mat_t o;
00409         double s, c;
00410         if (argc < 3) {
00411             bu_vls_printf(&result, "usage: %s sinAngle cosAngle", argv[0]);
00412             goto error;
00413         }
00414         if (Tcl_GetDouble(interp, argv[1], &s) != TCL_OK) goto error;
00415         if (Tcl_GetDouble(interp, argv[2], &c) != TCL_OK) goto error;
00416 
00417         (*math_func)(o, s, c);
00418         bn_encode_mat(&result, o);
00419     } else if (math_func == bn_mat_lookat) {
00420         mat_t o;
00421         vect_t dir;
00422         int yflip;
00423         if (argc < 3 || bn_decode_vect(dir, argv[1]) < 3) {
00424             bu_vls_printf(&result, "usage: %s dir yflip", argv[0]);
00425             goto error;
00426         }
00427         if (Tcl_GetBoolean(interp, argv[2], &yflip) != TCL_OK) goto error;
00428 
00429         bn_mat_lookat(o, dir, yflip);
00430         bn_encode_mat(&result, o);
00431     } else if (math_func == bn_vec_ortho || math_func == bn_vec_perp) {
00432         vect_t ov, vec;
00433 
00434         if (argc < 2 || bn_decode_vect(vec, argv[1]) < 3) {
00435             bu_vls_printf(&result, "usage: %s vec", argv[0]);
00436             goto error;
00437         }
00438 
00439         (*math_func)(ov, vec);
00440         bn_encode_vect(&result, ov);
00441     } else if (math_func == bn_mat_scale_about_pt_wrapper) {
00442         mat_t o;
00443         vect_t v;
00444         double scale;
00445         int status;
00446 
00447         if (argc < 3 || bn_decode_vect(v, argv[1]) < 3) {
00448             bu_vls_printf(&result, "usage: %s pt scale", argv[0]);
00449             goto error;
00450         }
00451         if (Tcl_GetDouble(interp, argv[2], &scale) != TCL_OK) goto error;
00452 
00453         bn_mat_scale_about_pt_wrapper(&status, o, v, scale);
00454         if (status != 0) {
00455             bu_vls_printf(&result, "error performing calculation");
00456             goto error;
00457         }
00458         bn_encode_mat(&result, o);
00459     } else if (math_func == bn_mat_xform_about_pt) {
00460         mat_t o, xform;
00461         vect_t v;
00462 
00463         if (argc < 3 || bn_decode_mat(xform, argv[1]) < 16 ||
00464             bn_decode_vect(v, argv[2]) < 3) {
00465             bu_vls_printf(&result, "usage: %s xform pt", argv[0]);
00466             goto error;
00467         }
00468 
00469         bn_mat_xform_about_pt(o, xform, v);
00470         bn_encode_mat(&result, o);
00471     } else if (math_func == bn_mat_arb_rot) {
00472         mat_t o;
00473         point_t pt;
00474         vect_t dir;
00475         double angle;
00476 
00477         if (argc < 4 || bn_decode_vect(pt, argv[1]) < 3 ||
00478             bn_decode_vect(dir, argv[2]) < 3) {
00479             bu_vls_printf(&result, "usage: %s pt dir angle", argv[0]);
00480             goto error;
00481         }
00482         if (Tcl_GetDouble(interp, argv[3], &angle) != TCL_OK)
00483             return TCL_ERROR;
00484 
00485         bn_mat_arb_rot(o, pt, dir, (fastf_t)angle);
00486         bn_encode_mat(&result, o);
00487     } else if (math_func == quat_mat2quat) {
00488         mat_t mat;
00489         quat_t quat;
00490 
00491         if (argc < 2 || bn_decode_mat(mat, argv[1]) < 16) {
00492             bu_vls_printf(&result, "usage: %s mat", argv[0]);
00493             goto error;
00494         }
00495 
00496         quat_mat2quat(quat, mat);
00497         bn_encode_quat(&result, quat);
00498     } else if (math_func == quat_quat2mat) {
00499         mat_t mat;
00500         quat_t quat;
00501 
00502         if (argc < 2 || bn_decode_quat(quat, argv[1]) < 4) {
00503             bu_vls_printf(&result, "usage: %s quat", argv[0]);
00504             goto error;
00505         }
00506 
00507         quat_quat2mat(mat, quat);
00508         bn_encode_mat(&result, mat);
00509     } else if (math_func == bn_quat_distance_wrapper) {
00510         quat_t q1, q2;
00511         double d;
00512 
00513         if (argc < 3 || bn_decode_quat(q1, argv[1]) < 4 ||
00514             bn_decode_quat(q2, argv[2]) < 4) {
00515             bu_vls_printf(&result, "usage: %s quatA quatB", argv[0]);
00516             goto error;
00517         }
00518 
00519         bn_quat_distance_wrapper(&d, q1, q2);
00520         bu_vls_printf(&result, "%g", d);
00521     } else if (math_func == quat_double || math_func == quat_bisect ||
00522                math_func == quat_make_nearest) {
00523         quat_t oqot, q1, q2;
00524 
00525         if (argc < 3 || bn_decode_quat(q1, argv[1]) < 4 ||
00526             bn_decode_quat(q2, argv[2]) < 4) {
00527             bu_vls_printf(&result, "usage: %s quatA quatB", argv[0]);
00528             goto error;
00529         }
00530 
00531         (*math_func)(oqot, q1, q2);
00532         bn_encode_quat(&result, oqot);
00533     } else if (math_func == quat_slerp) {
00534         quat_t oq, q1, q2;
00535         double d;
00536 
00537         if (argc < 4 || bn_decode_quat(q1, argv[1]) < 4 ||
00538             bn_decode_quat(q2, argv[2]) < 4) {
00539             bu_vls_printf(&result, "usage: %s quat1 quat2 factor", argv[0]);
00540             goto error;
00541         }
00542         if (Tcl_GetDouble(interp, argv[3], &d) != TCL_OK) goto error;
00543 
00544         quat_slerp(oq, q1, q2, d);
00545         bn_encode_quat(&result, oq);
00546     } else if (math_func == quat_sberp) {
00547         quat_t oq, q1, qa, qb, q2;
00548         double d;
00549 
00550         if (argc < 6 || bn_decode_quat(q1, argv[1]) < 4 ||
00551             bn_decode_quat(qa, argv[2]) < 4 || bn_decode_quat(qb, argv[3]) < 4 ||
00552             bn_decode_quat(q2, argv[4]) < 4) {
00553             bu_vls_printf(&result, "usage: %s quat1 quatA quatB quat2 factor",
00554                           argv[0]);
00555             goto error;
00556         }
00557         if (Tcl_GetDouble(interp, argv[5], &d) != TCL_OK) goto error;
00558 
00559         quat_sberp(oq, q1, qa, qb, q2, d);
00560         bn_encode_quat(&result, oq);
00561     } else if (math_func == quat_exp || math_func == quat_log) {
00562         quat_t qout, qin;
00563 
00564         if (argc < 2 || bn_decode_quat(qin, argv[1]) < 4) {
00565             bu_vls_printf(&result, "usage: %s quat", argv[0]);
00566             goto error;
00567         }
00568 
00569         (*math_func)(qout, qin);
00570         bn_encode_quat(&result, qout);
00571     } else if (math_func == (void (*)())bn_isect_line3_line3) {
00572         double t, u;
00573         point_t pt, a;
00574         vect_t dir, c;
00575         int i;
00576         static const struct bn_tol tol = {
00577             BN_TOL_MAGIC, 0.0005, 0.0005*0.0005, 1e-6, 1-1e-6
00578         };
00579         if (argc != 5) {
00580             bu_vls_printf(&result,
00581                           "Usage: bn_isect_line3_line3 pt dir pt dir (%d args specified)",
00582                           argc-1);
00583             goto error;
00584         }
00585 
00586         if (bn_decode_vect(pt, argv[1]) < 3) {
00587             bu_vls_printf(&result, "bn_isect_line3_line3 no pt: %s\n", argv[0]);
00588             goto error;
00589         }
00590         if (bn_decode_vect(dir, argv[2]) < 3) {
00591             bu_vls_printf(&result, "bn_isect_line3_line3 no dir: %s\n", argv[0]);
00592             goto error;
00593         }
00594         if (bn_decode_vect(a, argv[3]) < 3) {
00595             bu_vls_printf(&result, "bn_isect_line3_line3 no a pt: %s\n", argv[0]);
00596             goto error;
00597         }
00598         if (bn_decode_vect(c, argv[4]) < 3) {
00599             bu_vls_printf(&result, "bn_isect_line3_line3 no c dir: %s\n", argv[0]);
00600             goto error;
00601         }
00602         i = bn_isect_line3_line3(&t, &u, pt, dir, a, c, &tol);
00603         if (i != 1) {
00604             bu_vls_printf(&result, "bn_isect_line3_line3 no intersection: %s\n", argv[0]);
00605             goto error;
00606         }
00607 
00608         VJOIN1(a, pt, t, dir);
00609         bn_encode_vect(&result, a);
00610 
00611     } else if (math_func == (void (*)())bn_isect_line2_line2) {
00612         double dist[2];
00613         point_t pt, a;
00614         vect_t dir, c;
00615         int i;
00616         static const struct bn_tol tol = {
00617             BN_TOL_MAGIC, 0.0005, 0.0005*0.0005, 1e-6, 1-1e-6
00618         };
00619 
00620         if (argc != 5) {
00621             bu_vls_printf(&result,
00622                           "Usage: bn_isect_line2_line2 pt dir pt dir (%d args specified)",
00623                           argc-1);
00624             goto error;
00625         }
00626 
00627         /* i = bn_isect_line2_line2 {0 0} {1 0} {1 1} {0 -1} */
00628 
00629         VSETALL(pt, 0.0);
00630         VSETALL(dir, 0.0);
00631         VSETALL(a, 0.0);
00632         VSETALL(c, 0.0);
00633 
00634         if (bn_decode_vect(pt, argv[1]) < 2) {
00635             bu_vls_printf(&result, "bn_isect_line2_line2 no pt: %s\n", argv[0]);
00636             goto error;
00637         }
00638         if (bn_decode_vect(dir, argv[2]) < 2) {
00639             bu_vls_printf(&result, "bn_isect_line2_line2 no dir: %s\n", argv[0]);
00640             goto error;
00641         }
00642         if (bn_decode_vect(a, argv[3]) < 2) {
00643             bu_vls_printf(&result, "bn_isect_line2_line2 no a pt: %s\n", argv[0]);
00644             goto error;
00645         }
00646         if (bn_decode_vect(c, argv[4]) < 2) {
00647             bu_vls_printf(&result, "bn_isect_line2_line2 no c dir: %s\n", argv[0]);
00648             goto error;
00649         }
00650         i = bn_isect_line2_line2(dist, pt, dir, a, c, &tol);
00651         if (i != 1) {
00652             bu_vls_printf(&result, "bn_isect_line2_line2 no intersection: %s\n", argv[0]);
00653             goto error;
00654         }
00655 
00656         VJOIN1(a, pt, dist[0], dir);
00657         bu_vls_printf(&result, "%g %g", V2INTCLAMPARGS(a));
00658 
00659     } else {
00660         bu_vls_printf(&result, "libbn/bn_tcl.c: math function %s not supported yet\n", argv[0]);
00661         goto error;
00662     }
00663 
00664     Tcl_AppendResult(interp, bu_vls_addr(&result), (char *)NULL);
00665     bu_vls_free(&result);
00666     return TCL_OK;
00667 
00668 error:
00669     Tcl_AppendResult(interp, bu_vls_addr(&result), (char *)NULL);
00670     bu_vls_free(&result);
00671     return TCL_ERROR;
00672 }
00673 
00674 
00675 int
00676 bn_cmd_noise_perlin(ClientData UNUSED(clientData),
00677                     Tcl_Interp *interp,
00678                     int argc,
00679                     char **argv)
00680 {
00681     point_t pt;
00682     double v;
00683 
00684     if (argc != 4) {
00685         Tcl_AppendResult(interp, "wrong # args: should be \"",
00686                          argv[0], " X Y Z \"",
00687                          NULL);
00688         return TCL_ERROR;
00689     }
00690 
00691     pt[X] = atof(argv[1]);
00692     pt[Y] = atof(argv[2]);
00693     pt[Z] = atof(argv[3]);
00694 
00695     v = bn_noise_perlin(pt);
00696     Tcl_SetObjResult(interp, Tcl_NewDoubleObj(v));
00697 
00698     return TCL_OK;
00699 }
00700 
00701 
00702 /**
00703  * usage: bn_noise_fbm X Y Z h_val lacunarity octaves
00704  *
00705  */
00706 int
00707 bn_cmd_noise(ClientData UNUSED(clientData),
00708              Tcl_Interp *interp,
00709              int argc,
00710              char **argv)
00711 {
00712     point_t pt;
00713     double h_val;
00714     double lacunarity;
00715     double octaves;
00716     double val;
00717 
00718     if (argc != 7) {
00719         Tcl_AppendResult(interp, "wrong # args: should be \"",
00720                          argv[0], " X Y Z h_val lacunarity octaves\"",
00721                          NULL);
00722         return TCL_ERROR;
00723     }
00724 
00725     pt[0] = atof(argv[1]);
00726     pt[1] = atof(argv[2]);
00727     pt[2] = atof(argv[3]);
00728 
00729     h_val = atof(argv[4]);
00730     lacunarity = atof(argv[5]);
00731     octaves = atof(argv[6]);
00732 
00733 
00734     if (BU_STR_EQUAL("bn_noise_turb", argv[0])) {
00735         val = bn_noise_turb(pt, h_val, lacunarity, octaves);
00736 
00737         Tcl_SetObjResult(interp, Tcl_NewDoubleObj(val));
00738     } else if (BU_STR_EQUAL("bn_noise_fbm", argv[0])) {
00739         val = bn_noise_fbm(pt, h_val, lacunarity, octaves);
00740         Tcl_SetObjResult(interp, Tcl_NewDoubleObj(val));
00741     } else {
00742         Tcl_AppendResult(interp, "Unknown noise type \"",
00743                          argv[0], "\"",  NULL);
00744         return TCL_ERROR;
00745     }
00746     return TCL_OK;
00747 }
00748 
00749 
00750 /**
00751  * @brief
00752  * usage: noise_slice xdim ydim inv h_val lac octaves dX dY dZ sX [sY sZ]
00753  *
00754  * The idea here is to get a whole slice of noise at once, thereby
00755  * avoiding the overhead of doing this in Tcl.
00756  */
00757 int
00758 bn_cmd_noise_slice(ClientData UNUSED(clientData),
00759                    Tcl_Interp *interp,
00760                    int argc,
00761                    char **argv)
00762 {
00763     double h_val;
00764     double lacunarity;
00765     double octaves;
00766 
00767     vect_t delta;       /* translation to noise space */
00768     vect_t scale;       /* scale to noise space */
00769     unsigned xdim;      /* # samples X direction */
00770     unsigned ydim;      /* # samples Y direction */
00771     unsigned xval, yval;
00772 #define NOISE_FBM 0
00773 #define NOISE_TURB 1
00774 
00775 #define COV186_UNUSED_CODE 0
00776 #if COV186_UNUSED_CODE
00777     int noise_type = NOISE_FBM;
00778 #endif
00779     double val;
00780     point_t pt;
00781 
00782     if (argc != 7) {
00783         Tcl_AppendResult(interp, "wrong # args: should be \"",
00784                          argv[0], " Xdim Ydim Zval h_val lacunarity octaves\"",
00785                          NULL);
00786         return TCL_ERROR;
00787     }
00788 
00789     xdim = atoi(argv[0]);
00790     ydim = atoi(argv[1]);
00791     VSETALL(delta, 0.0);
00792     VSETALL(scale, 1.);
00793     pt[Z] = delta[Z] = atof(argv[2]);
00794     h_val = atof(argv[3]);
00795     lacunarity = atof(argv[4]);
00796     octaves = atof(argv[5]);
00797 
00798 #define COV186_UNUSED_CODE 0
00799     /* Only NOISE_FBM is possible at this time, so comment out the switching for
00800      * NOISE_TURB. This may need to be deleted. */
00801 #if COV186_UNUSED_CODE
00802     switch (noise_type) {
00803         case NOISE_FBM:
00804 #endif
00805             for (yval = 0; yval < ydim; yval++) {
00806 
00807                 pt[Y] = yval * scale[Y] + delta[Y];
00808 
00809                 for (xval = 0; xval < xdim; xval++) {
00810                     pt[X] = xval * scale[X] + delta[X];
00811 
00812                     val = bn_noise_fbm(pt, h_val, lacunarity, octaves);
00813 
00814                 }
00815             }
00816 #if COV186_UNUSED_CODE
00817             break;
00818         case NOISE_TURB:
00819             for (yval = 0; yval < ydim; yval++) {
00820 
00821                 pt[Y] = yval * scale[Y] + delta[Y];
00822 
00823                 for (xval = 0; xval < xdim; xval++) {
00824                     pt[X] = xval * scale[X] + delta[X];
00825 
00826                     val = bn_noise_turb(pt, h_val, lacunarity, octaves);
00827 
00828                 }
00829             }
00830             break;
00831     }
00832 #endif
00833 
00834 
00835     pt[0] = atof(argv[1]);
00836     pt[1] = atof(argv[2]);
00837     pt[2] = atof(argv[3]);
00838 
00839     h_val = atof(argv[4]);
00840     lacunarity = atof(argv[5]);
00841     octaves = atof(argv[6]);
00842 
00843 
00844     if (BU_STR_EQUAL("bn_noise_turb", argv[0])) {
00845         val = bn_noise_turb(pt, h_val, lacunarity, octaves);
00846         Tcl_SetObjResult(interp, Tcl_NewDoubleObj(val));
00847     } else if (BU_STR_EQUAL("bn_noise_fbm", argv[0])) {
00848         val = bn_noise_fbm(pt, h_val, lacunarity, octaves);
00849         Tcl_SetObjResult(interp, Tcl_NewDoubleObj(val));
00850     } else {
00851         Tcl_AppendResult(interp, "Unknown noise type \"",
00852                          argv[0], "\"",  NULL);
00853         return TCL_ERROR;
00854     }
00855     return TCL_OK;
00856 }
00857 
00858 
00859 int
00860 bn_cmd_random(ClientData UNUSED(clientData),
00861               Tcl_Interp *interp,
00862               int argc,
00863               char **argv)
00864 {
00865     int val;
00866     const char *str;
00867     double rnd;
00868     char buf[32];
00869 
00870     if (argc != 2) {
00871         Tcl_AppendResult(interp, "Wrong # args:  Should be \"",
00872                          argv[0], " varname\"", NULL);
00873         return TCL_ERROR;
00874     }
00875 
00876     str=Tcl_GetVar(interp, argv[1], 0);
00877     if (!str) {
00878         Tcl_AppendResult(interp, "Error getting variable ",
00879                          argv[1], NULL);
00880         return TCL_ERROR;
00881     }
00882     val = atoi(str);
00883 
00884     if (val < 0) val = 0;
00885 
00886     rnd = BN_RANDOM(val);
00887 
00888     snprintf(buf, 32, "%d", val);
00889 
00890     if (!Tcl_SetVar(interp, argv[1], buf, 0)) {
00891         Tcl_AppendResult(interp, "Error setting variable ",
00892                          argv[1], NULL);
00893         return TCL_ERROR;
00894     }
00895 
00896     snprintf(buf, 32, "%g", rnd);
00897     Tcl_AppendResult(interp, buf, NULL);
00898     return TCL_OK;
00899 }
00900 
00901 
00902 /**
00903  * B N _ M A T _ P R I N T
00904  */
00905 void
00906 bn_tcl_mat_print(Tcl_Interp *interp,
00907                  const char *title,
00908                  const mat_t m)
00909 {
00910     char obuf[1024];    /* sprintf may be non-PARALLEL */
00911 
00912     bn_mat_print_guts(title, m, obuf, 1024);
00913     Tcl_AppendResult(interp, obuf, "\n", (char *)NULL);
00914 }
00915 
00916 
00917 /**
00918  * B N _ T C L _ S E T U P
00919  *@brief
00920  * Add all the supported Tcl interfaces to LIBBN routines to
00921  * the list of commands known by the given interpreter.
00922  */
00923 void
00924 bn_tcl_setup(Tcl_Interp *interp)
00925 {
00926     struct math_func_link *mp;
00927 
00928     for (mp = math_funcs; mp->name != NULL; mp++) {
00929         (void)Tcl_CreateCommand(interp, mp->name,
00930                                 (Tcl_CmdProc *)bn_math_cmd,
00931                                 (ClientData)mp,
00932                                 (Tcl_CmdDeleteProc *)NULL);
00933     }
00934 
00935     (void)Tcl_CreateCommand(interp, "bn_noise_perlin",
00936                             (Tcl_CmdProc *)bn_cmd_noise_perlin, (ClientData)NULL,
00937                             (Tcl_CmdDeleteProc *)NULL);
00938 
00939     (void)Tcl_CreateCommand(interp, "bn_noise_turb",
00940                             (Tcl_CmdProc *)bn_cmd_noise, (ClientData)NULL,
00941                             (Tcl_CmdDeleteProc *)NULL);
00942 
00943     (void)Tcl_CreateCommand(interp, "bn_noise_fbm",
00944                             (Tcl_CmdProc *)bn_cmd_noise, (ClientData)NULL,
00945                             (Tcl_CmdDeleteProc *)NULL);
00946 
00947     (void)Tcl_CreateCommand(interp, "bn_noise_slice",
00948                             (Tcl_CmdProc *)bn_cmd_noise_slice, (ClientData)NULL,
00949                             (Tcl_CmdDeleteProc *)NULL);
00950 
00951     (void)Tcl_CreateCommand(interp, "bn_random",
00952                             (Tcl_CmdProc *)bn_cmd_random, (ClientData)NULL,
00953                             (Tcl_CmdDeleteProc *)NULL);
00954 }
00955 
00956 
00957 /**
00958  * B N _ I N I T
00959  *@brief
00960  * Allows LIBBN to be dynamically loade to a vanilla tclsh/wish with
00961  * "load /usr/brlcad/lib/libbn.so"
00962  *
00963  * The name of this function is specified by TCL.
00964  */
00965 int
00966 Bn_Init(Tcl_Interp *interp)
00967 {
00968     bn_tcl_setup(interp);
00969     return TCL_OK;
00970 }
00971 
00972 
00973 /** @} */
00974 /*
00975  * Local Variables:
00976  * mode: C
00977  * tab-width: 8
00978  * indent-tabs-mode: t
00979  * c-file-style: "stroustrup"
00980  * End:
00981  * ex: shiftwidth=4 tabstop=8
00982  */
Generated on Tue Dec 11 13:14:28 2012 for LIBBN by  doxygen 1.6.3