/* TclFloat.pmc
 *  Copyright (C) 2001-2003, The Perl Foundation.
 *  SVN Info
 *     $Id: tclfloat.pmc 15821 2006-11-26 07:31:19Z mdiep $
 *  Overview:
 *     These are the vtable functions for the TclFloat base class
 *  Data Structure and Algorithms:
 *  History:
 *  Notes:
 *  References:
 */

#include "parrot/parrot.h"
#include <assert.h>

pmclass TclFloat
    dynpmc
    extends TclObject
    extends Float
    does    float
    group   tcl_group
    hll     Tcl
    maps    Float
{

    STRING* get_string () {
        UINTVAL buflen;
        int check_flag;
        STRING *buff;
        STRING *dot;
        STRING *e;
        STRING *dot_zero;
        STRING *_precision = string_from_cstring(INTERP, "$tcl_precision", 14);
        STRING *_tcl = string_from_cstring(INTERP, "tcl", 3);

        PMC * const root_ns = INTERP->root_namespace;
        PMC * const hll_ns  = VTABLE_get_pmc_keyed_str(INTERP, root_ns, _tcl);
        PMC * precision_pmc =
            Parrot_find_global_op(INTERP, hll_ns, _precision, NULL);
        INTVAL* precision = VTABLE_get_integer(INTERP, precision_pmc);

        if (precision == 0)
            precision = 16; /* RT#40639: hack to approximate right output.*/

        buff  = Parrot_sprintf_c(INTERP, "%.*vg", precision, PMC_num_val(SELF));

        /*
         * this sprintf variant will return something that looks like
         * an int if it can : if we have no decimal point then tack on
         * on and return
         */
        dot = string_from_cstring(INTERP,".",1);
        e   = string_from_cstring(INTERP,"e",1);

        if (string_str_index(INTERP,buff,dot,0) == -1
         && string_str_index(INTERP,buff,e,0) == -1) {
            dot_zero = string_from_cstring(INTERP,".0",2);
            buff = string_append(INTERP, buff, dot_zero);
            return buff;
        }

        check_flag = 0;
        buflen = string_length(INTERP,buff);
        while (buflen) {
               if (string_index(INTERP,buff,buflen-1) == '0') {
                       buflen--;
                       check_flag = 1;
               }
               else {
                       break;
               }
        }

        /* truncate the string */
        buff->strlen = buflen;
        buff->bufused = buflen;
        return buff;
    }

    METHOD PMC* interpret() {
        return SELF;
    }
}

/*
 * Local variables:
 *   c-file-style: "parrot"
 * End:
 * vim: expandtab shiftwidth=4:
 */
