Function: math-format-radix-float

math-format-radix-float is an autoloaded and byte-compiled function defined in calc-bin.el.gz.

Signature

(math-format-radix-float A PREC)

Source Code

;; Defined in /usr/src/emacs/lisp/calc/calc-bin.el.gz
(defun math-format-radix-float (a _prec)
  (let ((fmt (car calc-float-format))
	(figs (nth 1 calc-float-format))
	(point calc-point-char)
	(str nil)
        pos)
    (if (eq fmt 'fix)
	(let* ((afigs (math-abs figs))
	       (fp (math-float-parts a (> afigs 0)))
	       (calc-internal-prec (+ 3 (max (nth 2 fp)
					     (math-convert-radix-digits
					      afigs t))))
	       (int (car fp))
	       (frac (math-round (math-mul (math-normalize (nth 1 fp))
					   (math-radix-float-power afigs)))))
	  (if (not (and (math-zerop frac) (math-zerop int) (< figs 0)))
	      (let ((math-radix-explicit-format nil))
		(let ((calc-group-digits nil))
		  (setq str (if (> afigs 0) (math-format-number frac) ""))
		  (if (< (length str) afigs)
		      (setq str (concat (make-string (- afigs (length str)) ?0)
					str))
		    (if (> (length str) afigs)
			(setq str (substring str 1)
			      int (math-add int 1))))
		  (setq str (concat (math-format-number int) point str)))
		(when calc-group-digits
		  (setq str (math-group-float str))))
	    (setq figs 0))))
    (or str
	(let* ((prec calc-internal-prec)
	       (afigs (if (> figs 0)
			  figs
			(max 1 (+ figs
				  (1- (math-convert-radix-digits
				       (max prec
					    (math-numdigs (nth 1 a)))))))))
	       (calc-internal-prec (+ 3 (math-convert-radix-digits afigs t)))
	       (explo -1) (vlo (math-radix-float-power explo))
	       (exphi 1) (vhi (math-radix-float-power exphi))
	       expmid vmid eadj)
	  (setq a (math-normalize a))
	  (if (Math-zerop a)
	      (setq explo 0)
	    (if (math-lessp-float '(float 1 0) a)
		(while (not (math-lessp-float a vhi))
		  (setq explo exphi vlo vhi
			exphi (math-mul exphi 2)
			vhi (math-radix-float-power exphi)))
	      (while (math-lessp-float a vlo)
		(setq exphi explo vhi vlo
		      explo (math-mul explo 2)
		      vlo (math-radix-float-power explo))))
	    (while (not (eq (math-sub exphi explo) 1))
	      (setq expmid (math-div2 (math-add explo exphi))
		    vmid (math-radix-float-power expmid))
	      (if (math-lessp-float a vmid)
		  (setq exphi expmid vhi vmid)
		(setq explo expmid vlo vmid)))
	    (setq a (math-div-float a vlo)))
	  (let* ((sc (math-round (math-mul a (math-radix-float-power
					      (1- afigs)))))
		 (math-radix-explicit-format nil))
	    (let ((calc-group-digits nil))
	      (setq str (math-format-number sc))))
	  (if (> (length str) afigs)
	      (setq str (substring str 0 -1)
		    explo (1+ explo)))
	  (if (and (eq fmt 'float)
		   (math-lessp explo (+ (if (= figs 0)
					    (1- (math-convert-radix-digits
						 prec))
					  afigs)
					calc-display-sci-high 1))
		   (math-lessp calc-display-sci-low explo))
	      (let ((dpos (1+ explo)))
		(cond ((<= dpos 0)
		       (setq str (concat "0" point (make-string (- dpos) ?0)
					 str)))
		      ((> dpos (length str))
		       (setq str (concat str (make-string (- dpos (length str))
							  ?0) point)))
		      (t
		       (setq str (concat (substring str 0 dpos) point
					 (substring str dpos)))))
		(setq explo nil))
	    (setq eadj (if (eq fmt 'eng)
			   (min (math-mod explo 3) (length str))
			 0)
		  str (concat (substring str 0 (1+ eadj)) point
			      (substring str (1+ eadj)))))
	  (setq pos (length str))
	  (while (eq (aref str (1- pos)) ?0) (setq pos (1- pos)))
	  (and explo (eq (aref str (1- pos)) ?.) (setq pos (1- pos)))
	  (setq str (substring str 0 pos))
	  (when calc-group-digits
	    (setq str (math-group-float str)))
	  (if explo
	      (let ((estr (let ((calc-number-radix 10)
				(calc-group-digits nil))
                            (math-format-number
                             (math-sub explo eadj)))))
		(setq str (if (or (memq calc-language '(math maple))
				  (> calc-number-radix 14))
			      (format "%s*%d.^%s" str calc-number-radix estr)
			    (format "%se%s" str estr)))))))
    str))