;;; formout.scm - Quick formatted output.
;;;               Version 0.5
;;;
;;; Copyright (c) 1995 Harvey J. Stein (hjstein@math.huji.ac.il)
;;; This code is freely usable and distributable as long as this
;;; heading remains.

;;; Overview
;;; I developed this library because other formatted output routines I
;;; found for scheme (namely format & printf from slib) proved to be
;;; either horribly slow (the former) or insufficiently powerful (the
;;; latter).
;;;
;;; This library addresses this problem by pre-compiling the format
;;; strings.  This is a big win when you have to do lots of formatting
;;; with a few format statements.
;;;
;;; Usage is as follows.
;;;   (formout:make-fmt-fcn format-string) returns a lambda of 2 args.
;;;   When called with the 1st arg being a port & the 2nd being a
;;;   piece of data, this routine will output the data to the
;;;   specified port according to the format string from which it was
;;;   constructed.
;;;
;;;   The format string may be such as:
;;;      ~s   - Output like write (quotes around strings, ...).
;;;             Argument must be a string.
;;;      ~10s - Output like write, but in a 10 character wide field,
;;;             padded on the right with spaces.
;;;     ~-10s - Same as ~10s, but pad on left with spaces.
;;;     ~@10s - Same as ~-10s.
;;;       ~a  - Output like display (no quotes around strings, ...).
;;;             Argument must be a string.
;;;       ... - Same prefixes as in s case.
;;;      ~10f - Output a number in a field of width 10, padded with
;;;             spaces on the left.  If the number is exact, no
;;;             decimal point is output.  If the number is inexact,
;;;             a decimal place is output.  The output will be in
;;;             exponential format if number->string returns it as
;;;             such.
;;;     ~-10f - Same as prev, but pad on right.
;;;    ~10,3f - Output a number in a field of width 10, padded on
;;;             left, but print to 3 decimal places.  If the number is
;;;             exact, it's the same as ~10f.
;;;   ~-10,3f - Same as previous, but pad on right.
;;;   ~@...f  - Same as ~-...f.
;;;
;;;   Port can be #t (to use stdout), #f (to output as a string), or
;;;   actually truely be a port.
;;;
;;;   Note: Using other format strings can give rise to errors when
;;;   compiling the format string, or when executing the compiled
;;;   function.
;;;
;;;   Note: In all cases, if the field is too small, the field is
;;;   increased in size until the data fits.
;;;
;;; Bugs/To do:
;;;   -Add more format specs (like all the (useful) common lisp).
;;;   -Generalize formout to take a string with these sorts of escapes
;;;    inside, instead of only strings containing 1 escape and nothing
;;;    else.
;;;   -Speed up the final lambda output.  Currently it's about 20
;;;    times faster than slib's format (in stk), but it could be
;;;    faster.  For example, the format string is parsed, but the
;;;    lambda returned does things like branching depending upon
;;;    whether the embedded width is positive or negative.  That
;;;    branch can be pre-compiled.


(define formout:make-fmt-fcn #f)

(let ()

(define (realformout port data wid prec)
  (let* ((s (number->string data))
	 (pnt (string-index "." s))
	 (exp (string-index "e" s))
	 (sl (string-length s)))
    (cond (exp
	   (realformout port
			(string->number (substring s 0 exp))
			(- wid (- sl exp))
			(max 0(- prec (- sl exp))))
	   (stringformoutnonquoted port
			  (substring s exp sl)
			  (- sl exp)))
	  (pnt
	   (stringformoutnonquoted port
			  (string-append
			   (substring s 0 (min sl (+ pnt prec 1)))
			   (make-string (max 0 (- prec (- sl pnt 1))) #\0))
			  (- wid)))
	  (else
	   (stringformoutnonquoted port s (- wid))))))

(define (stringformoutquoted port data wid)
  (let* ((l (string-length data))
	 (p (make-string (max 0 (- (abs wid) l 2)) #\space)))
    (case port
      (#t (cond ((< wid 0)
		 (display p)
		 (write data))
		(else
		 (write data)
		 (display p))))
      (#f (cond ((< wid 0)
		 (string-append p "#\"" data "#\""))
		(else
		 (string-append "#\"" data "#\"" p))))
      (else (cond ((< wid 0)
		   (display p port)
		   (write data port))
		  (else
		   (write data port)
		   (display p port)))))))



(define (stringformoutnonquoted port data wid)
  (let* ((l (string-length data))
	 (p (make-string (max 0 (- (abs wid) l)) #\space)))
    (case port
      (#t (cond ((< wid 0)
		 (display (string-append p data)))
		(else
		 (display (string-append data p)))))
      (#f (cond ((< wid 0)
		 (string-append p data))
		(else
		 (string-append data p))))
      (else (cond ((< wid 0)
		   (display (string-append p data) port))
		  (else
		   (display (string-append data p) port)))))))

	  

(define (make-fmt-fcn s)
  (let* ((sl        (string-length s))
	 (at-pos    (if (string-index "@" s) (string-index "@" s) 0))
	 (spec (substring s (+ at-pos 1) (- sl 1)))
	 (comma-pos (string-index "," spec))
	 (typ       (string-ref s (- sl 1)))
	 (wid-mult (if (= at-pos 0) 1 -1))
	 (wid (* wid-mult (string->number
			   (if comma-pos (substring spec 0 comma-pos)
			       spec))))
	 (prec (if comma-pos (string->number (substring spec
							(+ comma-pos 1)
							(string-length spec)))
		   0)))
;;    (format #t "sl = ~s, at-pos = ~s, comma-pos = ~s, typ = ~s\n"
;;	    sl at-pos comma-pos typ)
;;    (format #t "wid-mult = ~s, spec = ~s, wid = ~s, prec = ~s\n"
;;	    wid-mult spec wid prec)
    (case typ
      ((#\s #\S)
       (lambda (p d) (stringformoutquoted p d wid)))
      ((#\a #\A)
       (lambda (p d) (stringformoutnonquoted p d wid)))
      ((#\f #\F)
       (lambda (p d) (realformout p d wid prec))))))
	   

(set! formout:make-fmt-fcn make-fmt-fcn)
)

(provide "formout")